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