Skip to content

Commit b6d16ec

Browse files
codybartfastcodybartfast
committed
Wip: amb 1.1
1 parent a865e25 commit b6d16ec

File tree

3 files changed

+120
-53
lines changed

3 files changed

+120
-53
lines changed

‎src/ambeval.c‎

Lines changed: 118 additions & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -42,6 +42,7 @@ static void init(obj execution_environment)
4242
ambenv);
4343

4444
evalstr("(define (analyze exp)"
45+
// " (newline)(display \"Exp:\")(display exp)(newline)"
4546
" (cond ((self-evaluating? exp) "
4647
" (analyze-self-evaluating exp))"
4748
" ((quoted? exp) (analyze-quoted exp))"
@@ -66,49 +67,45 @@ static void init(obj execution_environment)
6667
" (error \" Unknown expression type-- ANALYZE \" exp))))",
6768
ambenv);
6869
evalstr("(define (analyze-self-evaluating exp)"
69-
" (lambda (env) exp))",
70+
" (lambda (env succeed fail)"
71+
" (succeed exp fail)))",
7072
ambenv);
7173
evalstr("(define (analyze-quoted exp)"
7274
" (let ((qval (text-of-quotation exp)))"
73-
" (lambda (env) qval)))",
75+
" (lambda (env succeed fail)"
76+
" (succeed qval fail))))",
7477
ambenv);
7578
evalstr("(define (analyze-variable exp)"
76-
" (lambda (env) (lookup-variable-value exp env)))",
79+
" (lambda (env succeed fail)"
80+
" (succeed (lookup-variable-value exp env)"
81+
" fail)))",
7782
ambenv);
78-
79-
evalstr("(define (analyze-assignment exp)"
80-
" (let ((var (assignment-variable exp))"
81-
" (vproc (analyze (assignment-value exp))))"
82-
" (lambda (env)"
83-
" (set-variable-value! var (vproc env) env)"
84-
" 'ok)))",
85-
ambenv);
86-
87-
evalstr("(define (analyze-definition exp)"
88-
" (let ((var (definition-variable exp))"
89-
" (vproc (analyze (definition-value exp))))"
90-
" (lambda (env)"
91-
" (define-variable! var (vproc env) env)"
92-
" 'ok)))",
83+
evalstr("(define (analyze-lambda exp)"
84+
" (let ((vars (lambda-parameters exp))"
85+
" (bproc (analyze-sequence (lambda-body exp))))"
86+
" (lambda (env succeed fail)"
87+
" (succeed (make-procedure vars bproc env)"
88+
"fail))))",
9389
ambenv);
94-
9590
evalstr("(define (analyze-if exp)"
9691
" (let ((pproc (analyze (if-predicate exp)))"
9792
" (cproc (analyze (if-consequent exp)))"
9893
" (aproc (analyze (if-alternative exp))))"
99-
" (lambda (env)"
100-
" (if (true? (pproc env))"
101-
" (cproc env)"
102-
" (aproc env)))))",
103-
ambenv);
104-
evalstr("(define (analyze-lambda exp)"
105-
" (let ((vars (lambda-parameters exp))"
106-
" (bproc (analyze-sequence (lambda-body exp))))"
107-
" (lambda (env) (make-procedure vars bproc env))))",
94+
" (lambda (env succeed fail)"
95+
" (pproc env"
96+
" (lambda (pred-value fail2)"
97+
" (if (true? pred-value)"
98+
" (cproc env succeed fail2)"
99+
" (aproc env succeed fail2)))"
100+
" fail))))",
108101
ambenv);
109102
evalstr("(define (analyze-sequence exps)"
110-
" (define (sequentially proc1 proc2)"
111-
" (lambda (env) (proc1 env) (proc2 env)))"
103+
" (define (sequentially a b)"
104+
" (lambda (env succeed fail)"
105+
" (a env"
106+
" (lambda (a-value fail2)"
107+
" (b env succeed fail2))"
108+
" fail)))"
112109
" (define (loop first-proc rest-procs)"
113110
" (if (null? rest-procs)"
114111
" first-proc"
@@ -119,45 +116,114 @@ static void init(obj execution_environment)
119116
" (error \"Empty sequence -- ANALYZE\"))"
120117
" (loop (car procs) (cdr procs))))",
121118
ambenv);
122-
evalstr("(define (analyze-apply exp)"
123-
" (let ((fproc (analyze (apply-operator exp)))"
124-
" (argsproc (analyze (apply-operands exp))))"
125-
" (lambda (env)"
126-
" (execute-application (fproc env)"
127-
" (argsproc env)))))",
119+
evalstr("(define (analyze-definition exp)"
120+
" (let ((var (definition-variable exp))"
121+
" (vproc (analyze (definition-value exp))))"
122+
" (lambda (env succeed fail)"
123+
" (vproc env"
124+
" (lambda (val fail2)"
125+
" (define-variable! var val env)"
126+
" (succeed 'ok fail2))"
127+
" fail))))",
128128
ambenv);
129+
evalstr("(define (analyze-assignment exp)"
130+
" (let ((var (assignment-variable exp))"
131+
" (vproc (analyze (assignment-value exp))))"
132+
" (lambda (env succeed fail)"
133+
" (vproc env"
134+
" (lambda (val fail2)"
135+
" (let ((old-value"
136+
" (lookup-variable-value var env)))"
137+
" (set-variable-value! var val env)"
138+
" (succeed 'ok"
139+
" (lambda ()"
140+
" (set-variable-value! var"
141+
" old-value"
142+
" env)"
143+
" (fail2)))))"
144+
" fail))))",
145+
ambenv);
146+
// evalstr("(define (analyze-apply exp)"
147+
// " (let ((fproc (analyze (apply-operator exp)))"
148+
// " (argsproc (analyze (apply-operands exp))))"
149+
// " (lambda (env succeed fail) "
150+
// "(display \" ** HERE ** \")"
151+
// " (fproc env"
152+
// " (lambda (proc fail2)"
153+
// " (argsproc env"
154+
// " (lambda (args fail3)"
155+
// " (execute-application proc args succeed fail3)"
156+
// " )"
157+
// " fail2"
158+
// " )"
159+
// " )"
160+
// " fail))))",
161+
// ambenv);
129162
evalstr("(define (analyze-application exp)"
130163
" (let ((fproc (analyze (operator exp)))"
131164
" (aprocs (map analyze (operands exp))))"
132-
" (lambda (env)"
133-
" (execute-application (fproc env)"
134-
" (map (lambda (aproc) (aproc env))"
135-
" aprocs)))))",
165+
" (lambda (env succeed fail) "
166+
" (fproc env"
167+
" (lambda (proc fail2)"
168+
" (get-args aprocs"
169+
" env"
170+
" (lambda (args fail3)"
171+
" (execute-application"
172+
" proc args succeed fail3))"
173+
" fail2))"
174+
" fail))))",
136175
ambenv);
137-
evalstr("(define (execute-application proc args)"
176+
evalstr("(define (get-args aprocs env succeed fail)"
177+
" (if (null? aprocs)"
178+
" (succeed '() fail)"
179+
" ((car aprocs) env"
180+
" (lambda (arg fail2)"
181+
" (get-args (cdr aprocs)"
182+
" env"
183+
" (lambda (args fail3)"
184+
" (succeed (cons arg args)"
185+
" fail3))"
186+
" fail2))"
187+
" fail)))",
188+
ambenv);
189+
evalstr("(define (execute-application proc args succeed fail)"
138190
" (cond ((primitive-procedure? proc)"
139-
" (apply-primitive-procedure proc args))"
191+
" (succeed (apply-primitive-procedure proc args)"
192+
" fail))"
140193
" ((compound-procedure? proc)"
141194
" ((procedure-body proc)"
142195
" (extend-environment (procedure-parameters proc)"
143196
" args"
144197
" (procedure-environment proc)"
145-
" \"doh! analysis\")))"
198+
" \"doh! amb analysis\")"
199+
" succeed"
200+
" fail))"
146201
" (else"
147202
" (error"
148203
" \"Unknown procedure type -- EXECUTE-APPLICATION\""
149204
" proc))))",
150205
ambenv);
151-
evalstr("(define (analyze-time exp)"
152-
" (let ((proc (analyze (timed-expr exp))))"
153-
" (lambda (env)"
154-
" (time (proc env)))))",
155-
ambenv);
206+
207+
// evalstr("(define (analyze-apply exp)"
208+
// " (let ((fproc (analyze (apply-operator exp)))"
209+
// " (argsproc (analyze (apply-operands exp))))"
210+
// " (lambda (env)"
211+
// " (execute-application (fproc env)"
212+
// " (argsproc env)))))",
213+
// ambenv);
214+
// evalstr("(define (analyze-application exp)"
215+
// " (let ((fproc (analyze (operator exp)))"
216+
// " (aprocs (map analyze (operands exp))))"
217+
// " (lambda (env)"
218+
// " (execute-application (fproc env)"
219+
// " (map (lambda (aproc) (aproc env))"
220+
// " aprocs)))))",
221+
// ambenv);
156222
}
157223

158224
static obj ambeval(obj exp, obj exenv, obj succeed, obj fail)
159225
{
160-
(void)succeed, (void)fail;
226+
// (void)succeed, (void)fail;
161227

162228
static bool haveinit = false;
163229

@@ -176,7 +242,9 @@ static obj ambeval(obj exp, obj exenv, obj succeed, obj fail)
176242
disable_gc = orig_gc;
177243

178244
obj analyze_execute =
179-
cons(list2(quote, analyzed), list1(list2(quote, exenv)));
245+
cons(list2(quote, analyzed),
246+
list3(list2(quote, exenv), list2(quote, succeed),
247+
list2(quote, fail)));
180248

181249
return eceval(analyze_execute, exenv);
182250
}

‎src/custom.c‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -186,8 +186,7 @@ static obj add_extras(int ex, obj env)
186186
if (ex >= 221) {
187187
evalstr("(define (uapply proc args) (__%%apply proc args))",
188188
env);
189-
evalstr("(define (apply proc args) (uapply proc args))",
190-
env);
189+
evalstr("(define (apply proc args) (uapply proc args))", env);
191190
evalstr("(define (map proc . arglists)"
192191
" (define (smap proc items)"
193192
" (define (iter items mapped)"

‎src/parser.c‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -153,7 +153,7 @@ static obj parse_list(obj lst, struct inport *port)
153153
if (is_err(dat = check_eof()))
154154
return dat;
155155
else
156-
return error_parser(AREA, "Open list at and of file");
156+
return error_parser(AREA, "Open list at end of input");
157157
case TKN_LIST_CLOSE:
158158
return reverse(lst);
159159
case TKN_DOT:

0 commit comments

Comments
 (0)