1 /* JitterLisp: ASTs.
2
3 Copyright (C) 2017, 2018 Luca Saiu
4 Written by Luca Saiu
5
6 This file is part of the JitterLisp language implementation, distributed as
7 an example along with Jitter under the same license.
8
9 Jitter is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
13
14 Jitter is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
18
19 You should have received a copy of the GNU General Public License
20 along with Jitter. If not, see <http://www.gnu.org/licenses/>. */
21
22
23 #include "jitterlisp-ast.h"
24
25 #include "jitterlisp-sexpression.h"
26 #include "jitterlisp-allocator.h"
27
28 #include "jitterlisp.h"
29
30
31
32
33 /* Utility.
34 * ************************************************************************** */
35
36
37
38
39
40 /* AST allocation utility.
41 * ************************************************************************** */
42
43 /* Expand to an unprotected sequence of C declarations and statements declaring
44 an automatic variable of type struct jitterlisp_ast * named unencoded_res,
45 its encoded counterpart res, and a subs pointer pointer to the subs field
46 of unencoded res; heap-allocating unencoded_res, initializing its case_ and
47 sub_no fields to the given values. The flexible array member content is not
48 initialized. */
49 #define JITTERLISP_MAKE_LOCALS_(_jitterlisp_case, _jitterlisp_sub_no) \
50 const size_t sub_no = (_jitterlisp_sub_no); \
51 struct jitterlisp_ast *unencoded_res \
52 = JITTERLISP_AST_MAKE_UNINITIALIZED_UNENCODED(sub_no); \
53 jitterlisp_object res = JITTERLISP_AST_ENCODE(unencoded_res); \
54 unencoded_res->case_ = (_jitterlisp_case); \
55 unencoded_res->sub_no = (sub_no); \
56 jitterlisp_object * const subs __attribute__ ((unused)) \
57 = unencoded_res->subs
58
59
60
61
62 /* AST high-level allocation.
63 * ************************************************************************** */
64
65 jitterlisp_object
jitterlisp_ast_make_literal(jitterlisp_object value)66 jitterlisp_ast_make_literal (jitterlisp_object value)
67 {
68 JITTERLISP_MAKE_LOCALS_(jitterlisp_ast_case_literal, 1);
69 subs [0] = value;
70 return res;
71 }
72
73 jitterlisp_object
jitterlisp_ast_make_variable(jitterlisp_object symbol)74 jitterlisp_ast_make_variable (jitterlisp_object symbol)
75 {
76 jitterlisp_validate_symbol (symbol);
77 JITTERLISP_MAKE_LOCALS_(jitterlisp_ast_case_variable, 1);
78 subs [0] = symbol;
79 return res;
80 }
81
82 jitterlisp_object
jitterlisp_ast_make_define(jitterlisp_object symbol,jitterlisp_object ast)83 jitterlisp_ast_make_define (jitterlisp_object symbol, jitterlisp_object ast)
84 {
85 jitterlisp_validate_symbol (symbol);
86 jitterlisp_validate_ast (ast);
87 JITTERLISP_MAKE_LOCALS_(jitterlisp_ast_case_define, 2);
88 subs [0] = symbol;
89 subs [1] = ast;
90 return res;
91 }
92
93 jitterlisp_object
jitterlisp_ast_make_if(jitterlisp_object condition_ast,jitterlisp_object then_ast,jitterlisp_object else_ast)94 jitterlisp_ast_make_if (jitterlisp_object condition_ast,
95 jitterlisp_object then_ast,
96 jitterlisp_object else_ast)
97 {
98 jitterlisp_validate_ast (condition_ast);
99 jitterlisp_validate_ast (then_ast);
100 jitterlisp_validate_ast (else_ast);
101 JITTERLISP_MAKE_LOCALS_(jitterlisp_ast_case_if, 3);
102 subs [0] = condition_ast;
103 subs [1] = then_ast;
104 subs [2] = else_ast;
105 return res;
106 }
107
108 jitterlisp_object
jitterlisp_ast_make_setb(jitterlisp_object symbol,jitterlisp_object ast)109 jitterlisp_ast_make_setb (jitterlisp_object symbol, jitterlisp_object ast)
110 {
111 jitterlisp_validate_symbol (symbol);
112 jitterlisp_validate_ast (ast);
113 JITTERLISP_MAKE_LOCALS_(jitterlisp_ast_case_setb, 2);
114 subs [0] = symbol;
115 subs [1] = ast;
116 return res;
117 }
118
119 jitterlisp_object
jitterlisp_ast_make_while(jitterlisp_object condition_ast,jitterlisp_object body_ast)120 jitterlisp_ast_make_while (jitterlisp_object condition_ast,
121 jitterlisp_object body_ast)
122 {
123 jitterlisp_validate_ast (condition_ast);
124 jitterlisp_validate_ast (body_ast);
125 JITTERLISP_MAKE_LOCALS_(jitterlisp_ast_case_while, 2);
126 subs [0] = condition_ast;
127 subs [1] = body_ast;
128 return res;
129 }
130
131 jitterlisp_object
jitterlisp_ast_make_primitive(jitterlisp_object primitive_object,jitterlisp_object actual_asts)132 jitterlisp_ast_make_primitive (jitterlisp_object primitive_object,
133 jitterlisp_object actual_asts)
134 {
135 jitterlisp_validate_primitive (primitive_object);
136 jitterlisp_validate_asts (actual_asts);
137 size_t actual_no = jitterlisp_length (actual_asts);
138 struct jitterlisp_primitive *p
139 = JITTERLISP_PRIMITIVE_DECODE(primitive_object);
140 if (p->in_arity != actual_no)
141 jitterlisp_error_cloned ("jitterlisp_ast_make_primitive: invalid in-arity");
142 JITTERLISP_MAKE_LOCALS_(jitterlisp_ast_case_primitive, actual_no + 1);
143 subs [0] = primitive_object;
144 int i;
145 for (i = 0; i < actual_no; i ++)
146 {
147 subs [1 + i] = JITTERLISP_EXP_C_A_CAR(actual_asts);
148 actual_asts = JITTERLISP_EXP_C_A_CDR(actual_asts);
149 }
150 return res;
151 }
152
153 jitterlisp_object
jitterlisp_ast_make_call(jitterlisp_object operator_ast,jitterlisp_object actual_asts)154 jitterlisp_ast_make_call (jitterlisp_object operator_ast,
155 jitterlisp_object actual_asts)
156 {
157 jitterlisp_validate_ast (operator_ast);
158 jitterlisp_validate_asts (actual_asts);
159 size_t actual_no = jitterlisp_length (actual_asts);
160 JITTERLISP_MAKE_LOCALS_(jitterlisp_ast_case_call, actual_no + 1);
161 subs [0] = operator_ast;
162 int i;
163 for (i = 0; i < actual_no; i ++)
164 {
165 subs [1 + i] = JITTERLISP_EXP_C_A_CAR(actual_asts);
166 actual_asts = JITTERLISP_EXP_C_A_CDR(actual_asts);
167 }
168 return res;
169 }
170
171 jitterlisp_object
jitterlisp_ast_make_lambda(jitterlisp_object formal_symbols,jitterlisp_object body_ast)172 jitterlisp_ast_make_lambda (jitterlisp_object formal_symbols,
173 jitterlisp_object body_ast)
174 {
175 jitterlisp_validate_distinct_symbols (formal_symbols);
176 jitterlisp_validate_ast (body_ast);
177 JITTERLISP_MAKE_LOCALS_(jitterlisp_ast_case_lambda, 2);
178 subs [0] = formal_symbols;
179 subs [1] = body_ast;
180 return res;
181 }
182
183 jitterlisp_object
jitterlisp_ast_make_let(jitterlisp_object bound_symbol,jitterlisp_object bound_ast,jitterlisp_object body_ast)184 jitterlisp_ast_make_let (jitterlisp_object bound_symbol,
185 jitterlisp_object bound_ast,
186 jitterlisp_object body_ast)
187 {
188 jitterlisp_validate_symbol (bound_symbol);
189 jitterlisp_validate_ast (bound_ast);
190 jitterlisp_validate_ast (body_ast);
191 JITTERLISP_MAKE_LOCALS_(jitterlisp_ast_case_let, 3);
192 subs [0] = bound_symbol;
193 subs [1] = bound_ast;
194 subs [2] = body_ast;
195 return res;
196 }
197
198 jitterlisp_object
jitterlisp_ast_make_sequence(jitterlisp_object ast_0,jitterlisp_object ast_1)199 jitterlisp_ast_make_sequence (jitterlisp_object ast_0,
200 jitterlisp_object ast_1)
201 {
202 jitterlisp_validate_ast (ast_0);
203 jitterlisp_validate_ast (ast_1);
204 JITTERLISP_MAKE_LOCALS_(jitterlisp_ast_case_sequence, 2);
205 subs [0] = ast_0;
206 subs [1] = ast_1;
207 return res;
208 }
209
210
211
212
213 /* AST accessors.
214 * ************************************************************************** */
215
216 jitterlisp_object
jitterlisp_ast_operands(jitterlisp_object ast)217 jitterlisp_ast_operands (jitterlisp_object ast)
218 {
219 jitterlisp_validate_ast (ast);
220 struct jitterlisp_ast *unencoded_ast = JITTERLISP_AST_DECODE(ast);
221 if (unencoded_ast->case_ != jitterlisp_ast_case_call
222 && unencoded_ast->case_ != jitterlisp_ast_case_primitive)
223 jitterlisp_error_cloned ("jitterlisp_ast_operands: non-primitive non-call "
224 "case");
225
226 /* Build the result list, starting the last element. */
227 jitterlisp_object res = JITTERLISP_EMPTY_LIST;
228 int i;
229 for (i = unencoded_ast->sub_no - 2; i >= 0; i --)
230 res = jitterlisp_cons (unencoded_ast->subs [1 + i], res);
231
232 return res;
233 }
234