2 Copyright (C) 2017-2018 Keziah Wesley
4 You can redistribute and/or modify this file under the terms of the
5 GNU Affero General Public License as published by the Free Software
6 Foundation, either version 3 of the License, or (at your option) any
9 This file is distributed in the hope that it will be useful, but
10 WITHOUT ANY WARRANTY; without even the implied warranty of
11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 Affero General Public License for more details.
14 You should have received a copy of the GNU Affero General Public
15 License along with this file. If not, see
16 <http://www.gnu.org/licenses/>.
29 push_frame (void (*fn) (), tuple_object args, void (*cont) ())
31 // update current frame's continuation
32 cf->cont = new_subr (cont);
34 // allocate new frame, make current
37 cst += sizeof (frame) / sizeof (object);
39 // set new frame's frametop
40 cf->cont = new_subr (fn);
43 new_tuple ((object *) prev, sizeof (frame) / sizeof (object));
49 cf = (frame *) cf->prevframe.body;
53 #define RETURN(x) do { ret = (x); pop_frame(); return; } while (0)
54 // invoke before pushing args onto stack for child call
55 // TODO: replace with PUSH_ARG interface?
56 #define END_LOCALS() do { cf->prevcst = cst; } while (0)
57 #define CALL_THEN(fn, args, cont) do { push_frame(fn, args, cont); return; } while (0)
58 #define TAILCALL(fn) do { cf->cont = fn; return; } while (0)
62 pool_object *x = POOL_OBJECT(o->head);
65 x = POOL_OBJECT(o->rest);
68 return mcall(evaluator, len);
72 2 ways to call an applicable:
73 - generically: `<foo bar>`
74 - applicably: `<APPLY foo bar>`
76 generic calls must perform wrapping
79 // * applicable (SUBR / simple FUNCTION): eval whole form, call impl
81 // * complex FUNCTION: call impl
83 // Upon initial entry, `cf->args.body[0]` is the FORM, and
84 // `ret` is the result of evaluating the FORM's first position.
85 // Typically, the first position will be an ATOM, which is
86 // self-evaluating; its value is to be looked up according to the
87 // first-position resolution rules:
103 assert (0 && "I don't know how to call that");
107 // locals: { list_object list, list_object tail }
111 // store result of previous call
112 pool_object *prev_res = as_pool (&ret);
113 list_object *tail = as_list (&cf->locals[1]);
114 *POOL_OBJECT (tail->val.head) = (pool_object)
116 .type = prev_res->type,.rest = tail->val.head + 1,.val = prev_res->val};
118 // advance input and output
119 assert (cf->args.len == 1);
120 list_object *args = as_list (&cf->args.body[0]);
121 assert (args->val.head);
122 args->val.head = POOL_OBJECT (args->val.head)->rest;
125 POOL_OBJECT (tail->val.head)->rest = 0;
126 RETURN (cf->locals[0]);
132 CALL_THEN (eval, new_tuple ((object *) POOL_OBJECT (args->val.head), 1),
139 assert (cf->args.len == 1);
140 switch (cf->args.body[0].type)
144 RETURN (cf->args.body[0]);
146 // Handle `head` now; then iterate on `.rest`.
148 if (!cf->args.body[0].list.val.head)
149 RETURN (cf->args.body[0]);
150 // locals: { list_object list, list_object tail }
152 // Allocate the new list contiguously and keep track of the
153 // current tail so we can build it in forward order.
155 new_list (pool_alloc (list_length (&cf->args.body[0].list)));
156 cf->locals[1] = cf->locals[0];
159 new_tuple ((object *)
160 POOL_OBJECT (cf->args.body[0].list.val.head), 1),
163 // `<>` is a special case.
164 if (!cf->args.body[0].list.val.head)
166 cf->args.body[0].type = EVALTYPE_FALSE;
167 RETURN (cf->args.body[0]);
169 // Eval first position, then apply to args
172 new_tuple ((object *)
173 POOL_OBJECT (cf->args.body[0].list.val.head), 1),
176 case EVALTYPE_VECTOR: TAILCALL(eval_vector);
179 assert (0 && "I don't know how to eval that");