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