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 | ||
15 | var | |
16 | Repl_Env : TEnv; | |
bc6a1f15 | 17 | Line : string; |
0067158f JM |
18 | |
19 | // read | |
20 | function READ(const Str: string) : TMal; | |
21 | begin | |
22 | READ := read_str(Str); | |
23 | end; | |
24 | ||
25 | // eval | |
26 | // Forward declation since eval_ast call it | |
27 | function EVAL(Ast: TMal; Env: TEnv) : TMal; forward; | |
28 | ||
29 | function eval_ast(Ast: TMal; Env: TEnv) : TMal; | |
30 | var | |
31 | OldArr, NewArr : TMalArray; | |
32 | OldDict, NewDict : TMalDict; | |
33 | I : longint; | |
34 | begin | |
35 | if Ast is TMalSymbol then | |
36 | begin | |
37 | eval_ast := Env.Get((Ast as TMalSymbol)); | |
38 | end | |
39 | else if Ast is TMalList then | |
40 | begin | |
41 | OldArr := (Ast as TMalList).Val; | |
42 | SetLength(NewArr, Length(OldArr)); | |
43 | for I := 0 to Length(OldArr)-1 do | |
44 | begin | |
45 | NewArr[I] := EVAL(OldArr[I], Env); | |
46 | end; | |
47 | if Ast is TMalVector then | |
48 | eval_ast := TMalVector.Create(NewArr) | |
49 | else | |
50 | eval_ast := TMalList.Create(NewArr); | |
51 | end | |
52 | else if Ast is TMalHashMap then | |
53 | begin | |
54 | OldDict := (Ast as TMalHashMap).Val; | |
55 | NewDict := TMalDict.Create; | |
56 | I := 0; | |
57 | while I < OldDict.Count do | |
58 | begin | |
59 | NewDict[OldDict.Keys[I]] := EVAL(OldDict[OldDict.Keys[I]], Env); | |
60 | I := I + 1; | |
61 | end; | |
62 | eval_ast := TMalHashMap.Create(NewDict); | |
63 | end | |
64 | else | |
65 | eval_ast := Ast; | |
66 | end; | |
67 | ||
68 | function EVAL(Ast: TMal; Env: TEnv) : TMal; | |
69 | var | |
70 | Arr : TMalArray; | |
71 | Arr1 : TMalArray; | |
72 | A0Sym : string; | |
73 | LetEnv : TEnv; | |
74 | I : longint; | |
75 | Fn : TMalCallable; | |
76 | begin | |
77 | if Ast.ClassType <> TMalList then | |
78 | Exit(eval_ast(Ast, Env)); | |
79 | ||
80 | // Apply list | |
81 | Arr := (Ast as TMalList).Val; | |
82 | if Arr[0] is TMalSymbol then | |
83 | A0Sym := (Arr[0] as TMalSymbol).Val | |
84 | else | |
85 | A0Sym := '__<*fn*>__'; | |
86 | ||
87 | case A0Sym of | |
88 | 'def!': | |
89 | EVAL := Env.Add((Arr[1] as TMalSymbol), EVAL(Arr[2], ENV)); | |
90 | 'let*': | |
91 | begin | |
92 | LetEnv := TEnv.Create(Env); | |
93 | Arr1 := (Arr[1] as TMalList).Val; | |
94 | I := 0; | |
95 | while I < Length(Arr1) do | |
96 | begin | |
97 | LetEnv.Add((Arr1[I] as TMalSymbol), EVAL(Arr1[I+1], LetEnv)); | |
98 | Inc(I,2); | |
99 | end; | |
100 | EVAL := EVAL(Arr[2], LetEnv); | |
101 | end; | |
102 | else | |
103 | begin | |
104 | Arr := (eval_ast(Ast, Env) as TMalList).Val; | |
105 | if Arr[0] is TMalFunc then | |
106 | begin | |
107 | Fn := (Arr[0] as TMalFunc).Val; | |
108 | EVAL := Fn(copy(Arr, 1, Length(Arr)-1)); | |
109 | end | |
110 | else | |
111 | raise Exception.Create('invalid apply'); | |
112 | end; | |
113 | end; | |
114 | end; | |
115 | ||
116 | ||
117 | function PRINT(Exp: TMal) : string; | |
118 | begin | |
119 | PRINT := pr_str(Exp, True); | |
120 | end; | |
121 | ||
122 | // repl | |
123 | function REP(Str: string) : string; | |
124 | begin | |
125 | REP := PRINT(EVAL(READ(Str), Repl_Env)); | |
126 | end; | |
127 | ||
128 | function add(Args: TMalArray) : TMal; | |
129 | begin | |
130 | add := TMalInt.Create((Args[0] as TMalInt).Val + | |
131 | (Args[1] as TMalInt).Val); | |
132 | end; | |
133 | function subtract(Args: TMalArray) : TMal; | |
134 | begin | |
135 | subtract := TMalInt.Create((Args[0] as TMalInt).Val - | |
136 | (Args[1] as TMalInt).Val); | |
137 | end; | |
138 | function multiply(Args: TMalArray) : TMal; | |
139 | begin | |
140 | multiply := TMalInt.Create((Args[0] as TMalInt).Val * | |
141 | (Args[1] as TMalInt).Val); | |
142 | end; | |
143 | function divide(Args: TMalArray) : TMal; | |
144 | begin | |
145 | divide := TMalInt.Create((Args[0] as TMalInt).Val div | |
146 | (Args[1] as TMalInt).Val); | |
147 | end; | |
148 | ||
149 | begin | |
150 | Repl_Env := TEnv.Create; | |
151 | Repl_Env.Add(TMalSymbol.Create('+'), TMalFunc.Create(@add)); | |
152 | Repl_Env.Add(TMalSymbol.Create('-'), TMalFunc.Create(@subtract)); | |
153 | Repl_Env.Add(TMalSymbol.Create('*'), TMalFunc.Create(@multiply)); | |
154 | Repl_Env.Add(TMalSymbol.Create('/'), TMalFunc.Create(@divide)); | |
155 | while True do | |
156 | begin | |
0067158f | 157 | try |
bc6a1f15 JM |
158 | Line := _readline('user> '); |
159 | if Line = '' then continue; | |
0067158f JM |
160 | WriteLn(REP(Line)) |
161 | except | |
bc6a1f15 | 162 | On E : MalEOF do Halt(0); |
0067158f JM |
163 | On E : Exception do |
164 | begin | |
165 | WriteLn('Error: ' + E.message); | |
166 | WriteLn('Backtrace:'); | |
167 | WriteLn(GetBacktrace(E)); | |
168 | end; | |
169 | end; | |
170 | end; | |
171 | end. |