Skip to content

Commit b6e72b4

Browse files
codybartfastcodybartfast
committed
Wip: amb skeleton
1 parent f0a885d commit b6e72b4

File tree

11 files changed

+230
-20
lines changed

11 files changed

+230
-20
lines changed

‎.vscode/tasks.json‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,7 @@
1111
"-lm", // load maths module
1212
//
1313
"src/aneval.c",
14+
"src/ambeval.c",
1415
"src/bitmap.c",
1516
"src/character.c",
1617
"src/convert.c",

‎CMakeLists.txt‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ project (sicp-scheme)
66
set(C_FLAGS "-lm -O3 -std=c17 -pedantic -pedantic-errors -Wall -Wextra -Wdouble-promotion -Wmissing-prototypes -Wstrict-prototypes -Wold-style-definition")
77

88
set (SRC_CORE
9+
src/ambeval.c
910
src/aneval.c
1011
src/bitmap.c
1112
src/character.c

‎src/ambeval.c‎

Lines changed: 178 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,178 @@
1+
#include "ambeval.h"
2+
3+
#define AREA "EVAL"
4+
5+
#include "aneval.h"
6+
#include "eceval.h"
7+
#include "environment.h"
8+
#include "list.h"
9+
#include "parser.h"
10+
#include "storage.h"
11+
12+
static obj evalstr(char *e, obj env)
13+
{
14+
return eceval(readp(openin_string(e)), env);
15+
}
16+
17+
static void init(obj execution_environment)
18+
{
19+
ambenv = extend_environment(emptylst, emptylst, execution_environment,
20+
of_identifier("init_analyzer"));
21+
22+
add_primprocs(ambenv);
23+
24+
evalstr("(define (map proc . arglists)"
25+
" (define (smap proc items)"
26+
" (define (iter items mapped)"
27+
" (if (null? items)"
28+
" mapped"
29+
" (iter (cdr items)"
30+
" (cons (proc (car items))"
31+
" mapped))))"
32+
" (reverse (iter items nil)))"
33+
" (define (iter arglists mapped)"
34+
" (if (null? (car arglists))"
35+
" mapped"
36+
" (iter (smap cdr arglists)"
37+
" (cons (__%%apply proc (smap car arglists))"
38+
" mapped))))"
39+
" (reverse (iter arglists nil)))",
40+
ambenv);
41+
42+
evalstr("(define (analyze exp)"
43+
" (cond ((self-evaluating? exp) "
44+
" (analyze-self-evaluating exp))"
45+
" ((quoted? exp) (analyze-quoted exp))"
46+
" ((variable? exp) (analyze-variable exp))"
47+
" ((assignment? exp) (analyze-assignment exp))"
48+
" ((definition? exp) (analyze-definition exp))"
49+
" ((if? exp) (analyze-if exp))"
50+
" ((lambda? exp) (analyze-lambda exp))"
51+
" ((begin? exp) (analyze-sequence (begin-actions exp)))"
52+
" ((cond? exp) (analyze (cond->if exp)))"
53+
" ((let? exp) (analyze (let->combination exp)))"
54+
" ((letrec? exp) (analyze (letrec->combination exp)))"
55+
" ((letstar? exp) (analyze (letstar->combination exp)))"
56+
" ((and? exp) (analyze (and->if exp)))"
57+
" ((or? exp) (analyze (or->if exp)))"
58+
" ((delay? exp) (analyze (delay->lambda exp)))"
59+
" ((cons-stream? exp) (analyze (cons-stream->cons exp)))"
60+
" ((time? exp) (analyze-time exp))"
61+
" ((apply? exp) (analyze-apply exp))"
62+
" ((application? exp) (analyze-application exp))"
63+
" (else"
64+
" (error \" Unknown expression type-- ANALYZE \" exp))))",
65+
ambenv);
66+
evalstr("(define (analyze-self-evaluating exp)"
67+
" (lambda (env) exp))",
68+
ambenv);
69+
evalstr("(define (analyze-quoted exp)"
70+
" (let ((qval (text-of-quotation exp)))"
71+
" (lambda (env) qval)))",
72+
ambenv);
73+
evalstr("(define (analyze-variable exp)"
74+
" (lambda (env) (lookup-variable-value exp env)))",
75+
ambenv);
76+
77+
evalstr("(define (analyze-assignment exp)"
78+
" (let ((var (assignment-variable exp))"
79+
" (vproc (analyze (assignment-value exp))))"
80+
" (lambda (env)"
81+
" (set-variable-value! var (vproc env) env)"
82+
" 'ok)))",
83+
ambenv);
84+
85+
evalstr("(define (analyze-definition exp)"
86+
" (let ((var (definition-variable exp))"
87+
" (vproc (analyze (definition-value exp))))"
88+
" (lambda (env)"
89+
" (define-variable! var (vproc env) env)"
90+
" 'ok)))",
91+
ambenv);
92+
93+
evalstr("(define (analyze-if exp)"
94+
" (let ((pproc (analyze (if-predicate exp)))"
95+
" (cproc (analyze (if-consequent exp)))"
96+
" (aproc (analyze (if-alternative exp))))"
97+
" (lambda (env)"
98+
" (if (true? (pproc env))"
99+
" (cproc env)"
100+
" (aproc env)))))",
101+
ambenv);
102+
evalstr("(define (analyze-lambda exp)"
103+
" (let ((vars (lambda-parameters exp))"
104+
" (bproc (analyze-sequence (lambda-body exp))))"
105+
" (lambda (env) (make-procedure vars bproc env))))",
106+
ambenv);
107+
evalstr("(define (analyze-sequence exps)"
108+
" (define (sequentially proc1 proc2)"
109+
" (lambda (env) (proc1 env) (proc2 env)))"
110+
" (define (loop first-proc rest-procs)"
111+
" (if (null? rest-procs)"
112+
" first-proc"
113+
" (loop (sequentially first-proc (car rest-procs))"
114+
" (cdr rest-procs))))"
115+
" (let ((procs (map analyze exps)))"
116+
" (if (null? procs)"
117+
" (error \"Empty sequence -- ANALYZE\"))"
118+
" (loop (car procs) (cdr procs))))",
119+
ambenv);
120+
evalstr("(define (analyze-apply exp)"
121+
" (let ((fproc (analyze (apply-operator exp)))"
122+
" (argsproc (analyze (apply-operands exp))))"
123+
" (lambda (env)"
124+
" (execute-application (fproc env)"
125+
" (argsproc env)))))",
126+
ambenv);
127+
evalstr("(define (analyze-application exp)"
128+
" (let ((fproc (analyze (operator exp)))"
129+
" (aprocs (map analyze (operands exp))))"
130+
" (lambda (env)"
131+
" (execute-application (fproc env)"
132+
" (map (lambda (aproc) (aproc env))"
133+
" aprocs)))))",
134+
ambenv);
135+
evalstr("(define (execute-application proc args)"
136+
" (cond ((primitive-procedure? proc)"
137+
" (apply-primitive-procedure proc args))"
138+
" ((compound-procedure? proc)"
139+
" ((procedure-body proc)"
140+
" (extend-environment (procedure-parameters proc)"
141+
" args"
142+
" (procedure-environment proc)"
143+
" \"doh! analysis\")))"
144+
" (else"
145+
" (error"
146+
" \"Unknown procedure type -- EXECUTE-APPLICATION\""
147+
" proc))))",
148+
ambenv);
149+
evalstr("(define (analyze-time exp)"
150+
" (let ((proc (analyze (timed-expr exp))))"
151+
" (lambda (env)"
152+
" (time (proc env)))))",
153+
ambenv);
154+
}
155+
156+
obj ambeval(obj exp, obj exenv)
157+
{
158+
static bool haveinit = false;
159+
160+
bool orig_gc = disable_gc;
161+
disable_gc = true;
162+
163+
if (!haveinit) {
164+
init(exenv);
165+
haveinit = true;
166+
}
167+
168+
obj analyzed =
169+
eceval(cons(of_identifier("analyze"), list1(list2(quote, exp))),
170+
ambenv);
171+
172+
disable_gc = orig_gc;
173+
174+
obj analyze_execute =
175+
cons(list2(quote, analyzed), list1(list2(quote, exenv)));
176+
177+
return eceval(analyze_execute, exenv);
178+
}

‎src/ambeval.h‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
#ifndef AMBEVAL_H
2+
#define AMBEVAL_H
3+
#include "sicpstd.h"
4+
5+
#include "obj.h"
6+
7+
obj ambeval(obj exp, obj env);
8+
9+
#endif

‎src/aneval.c‎

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -303,7 +303,7 @@ static obj is_variable_p(obj args)
303303
return is_variable(car(args)) ? true_o : false_o;
304304
}
305305

306-
static void add_primprocs(obj env)
306+
void add_primprocs(obj env)
307307
{
308308
define_variable(of_identifier("and?"), of_function(is_and_p), env);
309309
define_variable(of_identifier("and->if"), of_function(and_to_if_p),
@@ -564,8 +564,6 @@ static void init(obj execution_environment)
564564
anenv);
565565
}
566566

567-
#include <stdio.h>
568-
569567
obj aneval(obj exp, obj exenv)
570568
{
571569
static bool haveinit = false;

‎src/aneval.h‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44

55
#include "obj.h"
66

7+
void add_primprocs(obj env);
78
obj aneval(obj exp, obj env);
89

910
#endif

‎src/eceval.c‎

Lines changed: 20 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,8 @@ static obj unev; // 7
2525
static obj val; // 8
2626
// Plus... the_global_environment // 9
2727
obj anenv; // 10
28-
const int rootlen = 10;
28+
obj ambenv; // 11
29+
const int rootlen = 11;
2930
static obj rootlst;
3031

3132
// ln 182
@@ -128,7 +129,7 @@ obj getroot(void)
128129

129130
// intentionally not using rootlen here, change number manually after
130131
// modifying body below.
131-
if ((actlen = length_u(rootlst)) != 10) {
132+
if ((actlen = length_u(rootlst)) != 11) {
132133
error_internal(
133134
AREA,
134135
"Bug! getroot() got list of unexpected length: %d ",
@@ -155,6 +156,8 @@ obj getroot(void)
155156
set_car(lst, the_global_environment());
156157
lst = cdr(lst);
157158
set_car(lst, anenv);
159+
lst = cdr(lst);
160+
set_car(lst, ambenv);
158161

159162
return rootlst;
160163
}
@@ -167,7 +170,7 @@ obj setroot(obj rlst)
167170

168171
// intentionally not using rootlen here, change number manually after
169172
// modifying body below.
170-
if ((actlen = length_u(rootlst)) != 10) {
173+
if ((actlen = length_u(rootlst)) != 11) {
171174
return error_internal(
172175
AREA,
173176
"Bug! setroot() got list of unexpected length: %d",
@@ -193,6 +196,8 @@ obj setroot(obj rlst)
193196
set_global_environment(car(lst));
194197
lst = cdr(lst);
195198
anenv = car(lst);
199+
lst = cdr(lst);
200+
ambenv = car(lst);
196201

197202
return unspecified;
198203
}
@@ -214,17 +219,18 @@ static obj init(void)
214219

215220
stack = emptylst;
216221
// preallocate storage for gc root
217-
rootlst = listn(10, // <----- actual length
218-
unspecified, // 1
219-
unspecified, // 2
220-
unspecified, // 3
221-
unspecified, // 4
222-
unspecified, // 5
223-
unspecified, // 6
224-
unspecified, // 7
225-
unspecified, // 8
226-
unspecified, // 9
227-
unspecified // 10
222+
rootlst = listn(11, // <----- actual length
223+
unspecified, // 1
224+
unspecified, // 2
225+
unspecified, // 3
226+
unspecified, // 4
227+
unspecified, // 5
228+
unspecified, // 6
229+
unspecified, // 7
230+
unspecified, // 8
231+
unspecified, // 9
232+
unspecified, // 10
233+
unspecified // 11
228234
);
229235
if ((actlen = length_u(rootlst)) != rootlen) {
230236
error_internal(

‎src/eceval.h‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@
55
#include "obj.h"
66

77
extern obj anenv;
8+
extern obj ambenv;
89
obj eceval(obj exp, obj env);
910
obj getroot(void);
1011
obj setroot(obj);

‎src/eval.c‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,15 @@
11
#include "eval.h"
22

33
#include "eceval.h"
4+
#include "ambeval.h"
45
#include "aneval.h"
56

67
obj (*eval)(obj, obj) = eceval;
78

9+
void use_ambeval(void){
10+
eval = ambeval;
11+
}
12+
813
void use_aneval(void){
914
eval = aneval;
1015
}

‎src/eval.h‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@
66

77
extern obj (*eval)(obj, obj) ;
88

9+
void use_ambeval(void);
910
void use_aneval(void);
1011

1112
#endif

0 commit comments

Comments
 (0)