Commit | Line | Data |
---|---|---|
0067158f JM |
1 | program Mal; |
2 | ||
bc6a1f15 JM |
3 | {$H+} // Use AnsiString |
4 | ||
0067158f JM |
5 | Uses sysutils, |
6 | CMem, | |
7 | fgl, | |
bc6a1f15 | 8 | mal_readline, |
0067158f JM |
9 | mal_types, |
10 | mal_func, | |
11 | reader, | |
12 | printer, | |
13 | mal_env, | |
14 | core; | |
15 | ||
16 | var | |
17 | Repl_Env : TEnv; | |
bc6a1f15 | 18 | Line : string; |
0067158f JM |
19 | I : longint; |
20 | Key : string; | |
21 | ||
22 | // read | |
23 | function READ(const Str: string) : TMal; | |
24 | begin | |
25 | READ := read_str(Str); | |
26 | end; | |
27 | ||
28 | // eval | |
29 | // Forward declation since eval_ast call it | |
30 | function EVAL(Ast: TMal; Env: TEnv) : TMal; forward; | |
31 | ||
32 | function eval_ast(Ast: TMal; Env: TEnv) : TMal; | |
33 | var | |
34 | OldArr, NewArr : TMalArray; | |
35 | OldDict, NewDict : TMalDict; | |
36 | I : longint; | |
37 | begin | |
38 | if Ast is TMalSymbol then | |
39 | begin | |
40 | eval_ast := Env.Get((Ast as TMalSymbol)); | |
41 | end | |
42 | else if Ast is TMalList then | |
43 | begin | |
44 | OldArr := (Ast as TMalList).Val; | |
45 | SetLength(NewArr, Length(OldArr)); | |
46 | for I := 0 to Length(OldArr)-1 do | |
47 | begin | |
48 | NewArr[I] := EVAL(OldArr[I], Env); | |
49 | end; | |
50 | if Ast is TMalVector then | |
51 | eval_ast := TMalVector.Create(NewArr) | |
52 | else | |
53 | eval_ast := TMalList.Create(NewArr); | |
54 | end | |
55 | else if Ast is TMalHashMap then | |
56 | begin | |
57 | OldDict := (Ast as TMalHashMap).Val; | |
58 | NewDict := TMalDict.Create; | |
59 | I := 0; | |
60 | while I < OldDict.Count do | |
61 | begin | |
62 | NewDict[OldDict.Keys[I]] := EVAL(OldDict[OldDict.Keys[I]], Env); | |
63 | I := I + 1; | |
64 | end; | |
65 | eval_ast := TMalHashMap.Create(NewDict); | |
66 | end | |
67 | else | |
68 | eval_ast := Ast; | |
69 | end; | |
70 | ||
71 | function EVAL(Ast: TMal; Env: TEnv) : TMal; | |
72 | var | |
73 | Lst : TMalList; | |
74 | Arr : TMalArray; | |
75 | Arr1 : TMalArray; | |
76 | A0Sym : string; | |
77 | LetEnv : TEnv; | |
78 | FnEnv : TEnv; | |
79 | Cond : TMal; | |
80 | I : longint; | |
81 | Fn : TMalFunc; | |
82 | Args : TMalArray; | |
83 | begin | |
84 | if Ast.ClassType <> TMalList then | |
85 | Exit(eval_ast(Ast, Env)); | |
86 | ||
87 | // Apply list | |
88 | Lst := (Ast as TMalList); | |
89 | Arr := Lst.Val; | |
75b9209a JM |
90 | if Length(Arr) = 0 then |
91 | Exit(Ast); | |
0067158f JM |
92 | if Arr[0] is TMalSymbol then |
93 | A0Sym := (Arr[0] as TMalSymbol).Val | |
94 | else | |
95 | A0Sym := '__<*fn*>__'; | |
96 | ||
97 | case A0Sym of | |
98 | 'def!': | |
99 | EVAL := Env.Add((Arr[1] as TMalSymbol), EVAL(Arr[2], ENV)); | |
100 | 'let*': | |
101 | begin | |
102 | LetEnv := TEnv.Create(Env); | |
103 | Arr1 := (Arr[1] as TMalList).Val; | |
104 | I := 0; | |
105 | while I < Length(Arr1) do | |
106 | begin | |
107 | LetEnv.Add((Arr1[I] as TMalSymbol), EVAL(Arr1[I+1], LetEnv)); | |
108 | Inc(I,2); | |
109 | end; | |
110 | EVAL := EVAL(Arr[2], LetEnv); | |
111 | end; | |
112 | 'do': | |
113 | begin | |
114 | Arr := (eval_ast(Lst.Rest, Env) as TMalList).Val; | |
115 | EVAL := Arr[Length(Arr)-1]; | |
116 | end; | |
117 | 'if': | |
118 | begin | |
119 | Cond := EVAL(Arr[1], Env); | |
120 | if (Cond is TMalNil) or (Cond is TMalFalse) then | |
121 | if Length(Arr) > 3 then | |
122 | EVAL := EVAL(Arr[3], Env) | |
123 | else | |
124 | EVAL := TMalNil.Create | |
125 | else | |
126 | EVAL := EVAL(Arr[2], Env); | |
127 | end; | |
128 | 'fn*': | |
129 | begin | |
130 | EVAL := TMalFunc.Create(Arr[2], Env, (Arr[1] as TMalList)) | |
131 | end; | |
132 | else | |
133 | begin | |
134 | Arr := (eval_ast(Ast, Env) as TMalList).Val; | |
135 | if Arr[0] is TMalFunc then | |
136 | begin | |
137 | Fn := Arr[0] as TMalFunc; | |
138 | if Length(Arr) < 2 then | |
139 | SetLength(Args, 0) | |
140 | else | |
141 | Args := copy(Arr, 1, Length(Arr)-1); | |
142 | if Fn.Ast = nil then | |
143 | EVAL := Fn.Val(Args) | |
144 | else | |
145 | begin | |
146 | FnEnv := TEnv.Create(Fn.Env, Fn.Params, Args); | |
147 | EVAL := EVAL(Fn.Ast, FnEnv); | |
148 | end | |
149 | ||
150 | end | |
151 | else | |
152 | raise Exception.Create('invalid apply'); | |
153 | end; | |
154 | end; | |
155 | end; | |
156 | ||
157 | ||
158 | function PRINT(Exp: TMal) : string; | |
159 | begin | |
160 | PRINT := pr_str(Exp, True); | |
161 | end; | |
162 | ||
163 | // repl | |
164 | function REP(Str: string) : string; | |
165 | begin | |
166 | REP := PRINT(EVAL(READ(Str), Repl_Env)); | |
167 | end; | |
168 | ||
169 | begin | |
170 | Repl_Env := TEnv.Create; | |
171 | ||
172 | // core.pas: defined using Pascal | |
173 | for I := 0 to core.NS.Count-1 do | |
174 | begin | |
175 | Key := core.NS.Keys[I]; | |
176 | Repl_Env.Add(TMalSymbol.Create(Key), | |
177 | TMalFunc.Create(core.NS[Key])); | |
178 | end; | |
179 | ||
180 | // core.mal: defined using language itself | |
181 | REP('(def! not (fn* (a) (if a false true)))'); | |
182 | ||
183 | while True do | |
184 | begin | |
0067158f | 185 | try |
bc6a1f15 JM |
186 | Line := _readline('user> '); |
187 | if Line = '' then continue; | |
0067158f JM |
188 | WriteLn(REP(Line)) |
189 | except | |
bc6a1f15 | 190 | On E : MalEOF do Halt(0); |
0067158f JM |
191 | On E : Exception do |
192 | begin | |
193 | WriteLn('Error: ' + E.message); | |
194 | WriteLn('Backtrace:'); | |
195 | WriteLn(GetBacktrace(E)); | |
196 | end; | |
197 | end; | |
198 | end; | |
199 | end. |