Browse Source

put the LIS in LISP

Tobias Waldekranz.com 8 years ago
parent
commit
69b1362bbb
3 changed files with 140 additions and 136 deletions
  1. 87 57
      node.c
  2. 18 63
      node.h
  3. 35 16
      ply.c

+ 87 - 57
node.c

1
 #include <assert.h>
1
 #include <assert.h>
2
 #include <ctype.h>
2
 #include <ctype.h>
3
 #include <inttypes.h>
3
 #include <inttypes.h>
4
+#include <search.h>
5
+#include <stdarg.h>
4
 #include <stdio.h>
6
 #include <stdio.h>
5
 #include <stdlib.h>
7
 #include <stdlib.h>
6
 
8
 
7
 #include "node.h"
9
 #include "node.h"
8
 
10
 
9
-void nprint(node_t *n, FILE *fp)
11
+void node_print(node_t *n, FILE *fp)
10
 {
12
 {
11
 	switch (n->ntype) {
13
 	switch (n->ntype) {
12
-	case N_CONS:
13
-		fputs("<CONS>", fp);
14
-		break;
15
-	case N_OP:
16
-		fputc(n->op, fp);
14
+	case N_LIST:
15
+		fputs("()", fp);
17
 		break;
16
 		break;
18
 	case N_IDENT:
17
 	case N_IDENT:
19
 		fputs(n->ident, fp);
18
 		fputs(n->ident, fp);
28
 	default:
27
 	default:
29
 		fputs("<INVALID>", fp);
28
 		fputs("<INVALID>", fp);
30
 	}
29
 	}
30
+
31
+	/* if (n->type) { */
32
+	/* 	fputc(' ', fp); */
33
+	/* 	type_dump(n->type, fp); */
34
+	/* } */
31
 }
35
 }
32
 
36
 
37
+struct node_dump_info {
38
+	FILE *fp;
39
+	int indent;
40
+};
41
+
33
 int __node_dump_pre(node_t *n, void *_info)
42
 int __node_dump_pre(node_t *n, void *_info)
34
 {
43
 {
35
-	ndump_info_t *info = _info;
44
+	struct node_dump_info *info = _info;
36
 
45
 
37
 	switch (n->ntype) {
46
 	switch (n->ntype) {
38
-	case N_CONS:
47
+	case N_LIST:
48
+		fprintf(info->fp, "%s%*s(",
49
+			info->indent? "\n" : "",
50
+			info->indent, "");
39
 		info->indent += 2;
51
 		info->indent += 2;
40
 		break;
52
 		break;
41
 
53
 
42
 	default:
54
 	default:
43
-		fprintf(info->fp, "%*s", info->indent, "");
44
-		nprint(n, info->fp);
45
-		fputc('\n', info->fp);
55
+		if (n->prev) {
56
+			node_t *c;
57
+
58
+			for (c = n->next; c; c = c->next) {
59
+				if (c->ntype == N_LIST) {
60
+					fprintf(info->fp, "\n%*s",
61
+						info->indent, "");
62
+					break;
63
+				}
64
+			}
65
+
66
+			if (!c)
67
+				fputc(' ', info->fp);
68
+		}
69
+
70
+		node_print(n, info->fp);
46
 	}
71
 	}
47
 
72
 
48
 	return 0;
73
 	return 0;
50
 
75
 
51
 int __node_dump_post(node_t *n, void *_info)
76
 int __node_dump_post(node_t *n, void *_info)
52
 {
77
 {
53
-	ndump_info_t *info = _info;
54
-	node_t *next;
78
+	struct node_dump_info *info = _info;
79
+	node_t *c;
80
+
81
+	
82
+	if (n->ntype != N_LIST)
83
+		return 0;
55
 
84
 
56
-	if (n->ntype == N_CONS)
57
-		info->indent -= 2;
85
+	info->indent -= 2;
58
 
86
 
87
+	for (c = n->list; c; c = c->next) {
88
+		if (c->ntype == N_LIST) {
89
+			fprintf(info->fp, "\n%*s)", info->indent, "");
90
+			return 0;
91
+		}
92
+	}
93
+
94
+	fputc(')', info->fp);
59
 	return 0;
95
 	return 0;
60
 }
96
 }
61
 
97
 
62
-void ndump(node_t *n, ndump_info_t *info)
98
+void node_dump(node_t *n, FILE *fp)
63
 {
99
 {
100
+	struct node_dump_info info = {
101
+		.fp = fp,
102
+	};
64
 
103
 
65
-	nwalk(n, __node_dump_pre, __node_dump_post, info);
104
+	node_walk(n, __node_dump_pre, __node_dump_post, &info);
66
 }
105
 }
67
 
106
 
68
 
107
 
69
-int nwalk(node_t *n,
70
-	  int (*pre)(node_t *, void *),
71
-	  int (*post)(node_t *, void *),
72
-	  void *ctx)
108
+int node_walk(node_t *n,
109
+	      int (*pre)(node_t *, void *),
110
+	      int (*post)(node_t *, void *),
111
+	      void *ctx)
73
 {
112
 {
74
 	int err = 0;
113
 	int err = 0;
75
 	
114
 	
76
 	if (pre && (err = pre(n, ctx)))
115
 	if (pre && (err = pre(n, ctx)))
77
 		return err;
116
 		return err;
78
 
117
 
79
-	if (n->ntype == N_CONS) {
80
-		err = ncar(n) ? nwalk(ncar(n), pre, post, ctx) : 0;
81
-		if (err)
82
-			return err;
118
+	if (n->ntype == N_LIST) {
119
+		node_t *c;
83
 
120
 
84
-		err = ncdr(n) ? nwalk(ncdr(n), pre, post, ctx) : 0;
85
-		if (err)
86
-			return err;
121
+		for (c = n->list; c; c = c->next) {
122
+			err = node_walk(c, pre, post, ctx);
123
+			if (err)
124
+				return err;
125
+		}
87
 	}
126
 	}
88
 
127
 
89
 	if (post && (err = post(n, ctx)))
128
 	if (post && (err = post(n, ctx)))
93
 }
132
 }
94
 
133
 
95
 
134
 
96
-/* high-level constructors */
97
-
98
-node_t *ncall(char *name, node_t *args)
99
-{
100
-	return ncons(nop('('), ncons(nident(name), args));
101
-}
102
-
103
-node_t *nmap(char *name, node_t *key)
104
-{
105
-	return ncons(nop('{'), ncons(nident(name), key));
106
-}
107
-
108
-/* basic constructors */
135
+/* constructors */
109
 
136
 
110
 static node_t *__node(ntype_t ntype)
137
 static node_t *__node(ntype_t ntype)
111
 {
138
 {
116
 	return n;
143
 	return n;
117
 }
144
 }
118
 
145
 
119
-node_t *ncons(node_t *car, node_t *cdr)
146
+node_t *node_list(node_t *head)
120
 {
147
 {
121
-	node_t *n = __node(N_CONS);
122
-
123
-	assert(car);
124
-	car->up = n;
148
+	node_t *n = __node(N_LIST);
125
 
149
 
126
-	if (cdr)
127
-		cdr->up = n;
128
-
129
-	n->cons.car = car;
130
-	n->cons.cdr = cdr;
150
+	n->list = head;
131
 	return n;
151
 	return n;
132
 }
152
 }
133
 
153
 
134
-node_t *nop(op_t op)
154
+node_t *node_vlist(node_t *head, ...)
135
 {
155
 {
136
-	node_t *n = __node(N_OP);
137
-	n->op = op;
156
+        va_list ap;
157
+	node_t *n, *next;
158
+
159
+	n = node_list(head);
160
+	
161
+        va_start(ap, head);
162
+        while ((next = va_arg(ap, node_t *))) {
163
+		insque(next, head);
164
+		head = next;
165
+        }
166
+        va_end(ap);
167
+
138
 	return n;
168
 	return n;
139
 }
169
 }
140
 
170
 
141
-node_t *nident(char *name)
171
+node_t *node_ident(char *name)
142
 {
172
 {
143
 	node_t *n = __node(N_IDENT);
173
 	node_t *n = __node(N_IDENT);
144
 	n->ident = name;
174
 	n->ident = name;
145
 	return n;
175
 	return n;
146
 }
176
 }
147
 
177
 
148
-node_t *nnum(int64_t num)
178
+node_t *node_num(int64_t num)
149
 {
179
 {
150
 	node_t *n = __node(N_NUM);
180
 	node_t *n = __node(N_NUM);
151
 	n->num = num;
181
 	n->num = num;
152
 	return n;
182
 	return n;
153
 }
183
 }
154
 
184
 
155
-node_t *nstring(char *string)
185
+node_t *node_string(char *string)
156
 {
186
 {
157
 	node_t *n = __node(N_STRING);
187
 	node_t *n = __node(N_STRING);
158
 	n->string = string;
188
 	n->string = string;

+ 18 - 63
node.h

8
 
8
 
9
 typedef struct node node_t;
9
 typedef struct node node_t;
10
 
10
 
11
-struct cons {
12
-	node_t *car;
13
-	node_t *cdr;
14
-};
15
-
16
-typedef enum op {
17
-	OP_AGG = '@',
18
-	OP_CALL = '(',
19
-	OP_DEREF = '*',
20
-	OP_DOT = '.',
21
-	OP_MAP = '{',
22
-} op_t;
23
-
24
 typedef enum ntype {
11
 typedef enum ntype {
25
-	N_CONS,
26
-
27
-	N_OP,
12
+	N_LIST,
28
 	N_IDENT,
13
 	N_IDENT,
29
 	N_NUM,
14
 	N_NUM,
30
 	N_STRING,
15
 	N_STRING,
31
 } ntype_t;
16
 } ntype_t;
32
 
17
 
33
 struct node {
18
 struct node {
34
-	ntype_t ntype;
19
+	node_t *next, *prev;
35
 
20
 
21
+	ntype_t ntype;
36
 	union {
22
 	union {
37
-		/* atom_t atom; */
38
-		struct cons cons;
39
-
40
-		op_t op;
23
+		node_t *list;
41
 		char *ident;
24
 		char *ident;
42
 		int64_t num;
25
 		int64_t num;
43
 		char *string;
26
 		char *string;
44
 	};
27
 	};
45
 
28
 
46
-	node_t *up;
47
 	type_t *type;
29
 	type_t *type;
48
 };
30
 };
49
 
31
 
50
 /* debug */
32
 /* debug */
51
-typedef struct ndump_info {
52
-	FILE *fp;
53
-	int indent;
54
-} ndump_info_t;
55
-
56
-void ndump(node_t *n, ndump_info_t *info);
57
-
33
+void node_dump(node_t *n, FILE *fp);
58
 
34
 
59
 typedef int (*walk_fn)(node_t *, void *);
35
 typedef int (*walk_fn)(node_t *, void *);
60
-int nwalk(node_t *n, walk_fn pre, walk_fn post, void *ctx);
61
-
62
-/* high-level constructors */
63
-node_t *ncall(char *name, node_t *args);
64
-node_t *nmap (char *name, node_t *key);
36
+int node_walk(node_t *n, walk_fn pre, walk_fn post, void *ctx);
65
 
37
 
66
 
38
 
67
-/* basic constructors */
68
-node_t *ncons  (node_t *car, node_t *cdr);
69
-node_t *nop    (op_t op);
70
-node_t *nident (char *name);
71
-node_t *nnum   (int64_t num);
72
-node_t *nstring(char *string);
39
+/* constructors */
40
+node_t *node_list  (node_t *head);
41
+node_t *node_vlist (node_t *head, ...);
73
 
42
 
43
+node_t *node_ident (char *name);
44
+node_t *node_num   (int64_t num);
45
+node_t *node_string(char *string);
74
 
46
 
75
-/* utilities */
76
-
77
-static inline int nop_is(node_t *n, op_t op)
78
-{
79
-	if (!n || (n->ntype != N_OP))
80
-		return 0;
81
-
82
-	return n->op == op;
83
-}
84
-
85
-static inline node_t *ncar(node_t *n)
47
+static inline node_t *node_head(node_t *n)
86
 {
48
 {
87
-	if (!n || (n->ntype != N_CONS))
49
+	if (!n)
88
 		return NULL;
50
 		return NULL;
89
 
51
 
90
-	return n->cons.car;
91
-}
52
+	for (; n->prev; n = n->prev);
92
 
53
 
93
-static inline node_t *ncdr(node_t *n)
94
-{
95
-	if (!n || (n->ntype != N_CONS))
96
-		return NULL;
97
-
98
-	return n->cons.cdr;
54
+	return n;
99
 }
55
 }
100
 
56
 
101
-static inline node_t *nup(node_t *n)
57
+static inline node_t *node_prev(node_t *n)
102
 {
58
 {
103
-
104
-	return n? n->up : NULL;
59
+	return n ? n->prev : NULL;
105
 }
60
 }
106
 
61
 
107
 #endif	/* _PLY_NODE_H */
62
 #endif	/* _PLY_NODE_H */

+ 35 - 16
ply.c

56
 	prog->locals = &locals;
56
 	prog->locals = &locals;
57
 	prog->globals = &globals;
57
 	prog->globals = &globals;
58
 
58
 
59
+	/* (@ ('{' reads ((pid))) (quantize arg2)) */
59
 	prog->probe = "k:SyS_read"; /* { reads{pid()} @ quantize(arg2) } */
60
 	prog->probe = "k:SyS_read"; /* { reads{pid()} @ quantize(arg2) } */
60
 	prog->ast =
61
 	prog->ast =
61
-		ncons(nop('@'),
62
-		      ncons(
63
-			      nmap("reads", ncons(ncall("pid", NULL), NULL)),
64
-			      ncall("quantize", ncons(nident("arg2"), NULL))
65
-			      )
62
+		node_list(
63
+			node_vlist(node_ident("@"),
64
+				   node_vlist(node_ident("{"),
65
+					      node_ident("reads"),
66
+					      node_list(node_ident("pid"))
67
+					      , NULL),
68
+				   node_vlist(node_ident("quantize"),
69
+					      node_ident("arg2")
70
+					      , NULL)
71
+				   , NULL)
66
 			);
72
 			);
67
 
73
 
68
 	prog->provider = provider_get("k");
74
 	prog->provider = provider_get("k");
70
 	return prog;
76
 	return prog;
71
 }
77
 }
72
 
78
 
73
-int symtab_resolve(node_t *n, void *_prog)
79
+int is_builtin(char *ident)
80
+{
81
+	if (!strcmp("@", ident) ||
82
+	    !strcmp("{", ident))
83
+		return 1;
84
+
85
+	return 0;
86
+}
87
+
88
+int symbol_resolve(node_t *n, void *_prog)
74
 {
89
 {
75
 	prog_t *prog = _prog;
90
 	prog_t *prog = _prog;
76
 	provider_t *global = provider_get(":");
91
 	provider_t *global = provider_get(":");
81
 		return 0;
96
 		return 0;
82
 
97
 
83
 	/* .IDENT/->IDENT is a struct/union member, skip */
98
 	/* .IDENT/->IDENT is a struct/union member, skip */
84
-	op = ncar(nup(nup(n)));
85
-	if (op && nop_is(op, '.'))
99
+	op = node_prev(node_prev(n));
100
+	if (op && (op->ntype == N_IDENT) && !strcmp(".", op->ident))
101
+		return 0;
102
+
103
+	if (is_builtin(n->ident))
86
 		return 0;
104
 		return 0;
87
 
105
 
88
 	err = prog->provider->resolve(prog, n);
106
 	err = prog->provider->resolve(prog, n);
98
 	return sym_add(prog->globals, n->ident, NULL);
116
 	return sym_add(prog->globals, n->ident, NULL);
99
 }
117
 }
100
 
118
 
119
+/* int symbol_infer(node_t *n, void *_prog) */
120
+/* { */
121
+/* 	return 0; */
122
+/* } */
123
+
101
 int pass_walk(pass_t *pass, prog_t *prog)
124
 int pass_walk(pass_t *pass, prog_t *prog)
102
 {
125
 {
103
-	return nwalk(prog->ast, pass->pre, pass->post, prog);
126
+	return node_walk(prog->ast, pass->pre, pass->post, prog);
104
 }
127
 }
105
 
128
 
106
 pass_t passes[] = {
129
 pass_t passes[] = {
107
-	{ .run = pass_walk, .pre = symtab_resolve },
130
+	{ .run = pass_walk, .pre = symbol_resolve },
131
+	/* { .run = pass_walk, .pre = symbol_infer }, */
108
 
132
 
109
 	{ NULL }
133
 	{ NULL }
110
 };
134
 };
111
 
135
 
112
 int main(void)
136
 int main(void)
113
 {
137
 {
114
-	ndump_info_t info = {
115
-		.indent = 2,
116
-		.fp = stdout,
117
-	};
118
-
119
 	prog_t *prog = prog_get();
138
 	prog_t *prog = prog_get();
120
 	pass_t *pass;
139
 	pass_t *pass;
121
 	int err;
140
 	int err;
127
 	}
146
 	}
128
 
147
 
129
 	printf("AST\n===\n");
148
 	printf("AST\n===\n");
130
-	ndump(prog->ast, &info);
149
+	node_dump(prog->ast, stdout);
131
 	printf("\nLOCALS\n======\n");
150
 	printf("\nLOCALS\n======\n");
132
 	symtab_dump(prog->locals, stdout);
151
 	symtab_dump(prog->locals, stdout);
133
 	printf("\nGLOBALS\n=======\n");
152
 	printf("\nGLOBALS\n=======\n");