Commit | Line | Data |
---|---|---|
0067158f JM |
1 | unit reader; |
2 | ||
3 | {$H+} // Use AnsiString | |
4 | ||
5 | interface | |
6 | ||
7 | Uses sysutils, | |
8 | Classes, | |
9 | RegExpr in 'regexpr/Source/RegExpr.pas', | |
10 | mal_types; | |
11 | ||
12 | // | |
13 | // Reader class | |
14 | // | |
15 | ||
16 | type TReader = class(TObject) | |
17 | public | |
18 | Tokens : TStringList; | |
19 | Position : Integer; | |
20 | ||
21 | constructor Create(Toks: TStringList); | |
22 | ||
23 | function Peek() : string; | |
24 | function Next() : string; | |
25 | end; | |
26 | ||
27 | // | |
28 | // reader functions | |
29 | // | |
30 | ||
31 | function read_str(const Str: string): TMal; | |
32 | ||
33 | ||
34 | implementation | |
35 | ||
36 | // | |
37 | // Reader class | |
38 | // | |
39 | ||
40 | constructor TReader.Create(Toks: TStringList); | |
41 | begin | |
42 | inherited Create(); | |
43 | Self.Tokens := Toks; | |
44 | Self.Position := 0; | |
45 | end; | |
46 | ||
47 | function TReader.Peek() : string; | |
48 | begin | |
49 | if Position >= Tokens.Count then | |
50 | Peek := #0 | |
51 | else | |
52 | Peek := Tokens[Position]; | |
53 | end; | |
54 | ||
55 | function TReader.Next() : string; | |
56 | begin | |
57 | Next := Tokens[Position]; | |
58 | Position := Position + 1; | |
59 | end; | |
60 | ||
61 | ||
62 | // | |
63 | // reader functions | |
64 | // | |
65 | ||
66 | function tokenize(const Str: string) : TStringList; | |
67 | var | |
68 | RE : TRegExpr; | |
69 | Tokens : TStringList; | |
70 | begin | |
71 | RE := TRegExpr.Create; | |
72 | RE.Expression := '[\s,]*(~@|[\[\]{}()''`~^@]|"(([\\].|[^\\"])*)"?|;[^\r\n]*|[^\s\[\]{}()''"`@,;]+)'; | |
73 | Tokens := TStringList.Create; | |
74 | if RE.Exec(Str) then | |
75 | begin | |
76 | repeat | |
77 | if RE.Match[1][1] <> ';' then | |
78 | Tokens.Add(RE.Match[1]); | |
79 | until not RE.ExecNext; | |
80 | end; | |
81 | RE.Free; | |
82 | ||
83 | tokenize := Tokens; | |
84 | end; | |
85 | ||
86 | ||
87 | function read_atom(Reader : TReader) : TMal; | |
88 | var | |
89 | RE : TRegExpr; | |
90 | Token : string; | |
91 | Str : string; | |
92 | begin | |
93 | RE := TRegExpr.Create; | |
94 | RE.Expression := '(^-?[0-9]+$)|(^-?[0-9][0-9.]*$)|(^nil$)|(^true$)|(^false$)|^(\".*\")$|:(.*)|(^[^\"]*$)'; | |
95 | Token := Reader.Next(); | |
96 | //WriteLn('token: ' + Token); | |
97 | if RE.Exec(Token) then | |
98 | begin | |
99 | if RE.Match[1] <> '' then | |
100 | read_atom := TMalInt.Create(StrToInt(RE.Match[1])) | |
101 | else if RE.Match[2] <> '' then | |
102 | // TODO | |
103 | read_atom := TMalNil.Create | |
104 | else if RE.Match[3] <> '' then | |
105 | read_atom := TMalNil.Create | |
106 | else if RE.Match[4] <> '' then | |
107 | read_atom := TMalTrue.Create | |
108 | else if RE.Match[5] <> '' then | |
109 | read_atom := TMalFalse.Create | |
110 | else if RE.Match[6] <> '' then | |
111 | begin | |
112 | Str := copy(Token, 2, Length(Token)-2); | |
113 | Str := StringReplace(Str, '\"', '"', [rfReplaceAll]); | |
114 | Str := StringReplace(Str, '\n', #10, [rfReplaceAll]); | |
115 | Str := StringReplace(Str, '\\', '\', [rfReplaceAll]); | |
116 | read_atom := TMalString.Create(Str) | |
117 | end | |
118 | else if RE.Match[7] <> '' then | |
119 | read_atom := TMalString.Create(#127 + RE.Match[7]) | |
120 | else if RE.Match[8] <> '' then | |
121 | read_atom := TMalSymbol.Create(Token); | |
122 | end | |
123 | else | |
124 | begin | |
125 | RE.Free; | |
126 | raise Exception.Create('Invalid token in read_atom'); | |
127 | end; | |
128 | RE.Free; | |
129 | end; | |
130 | ||
131 | // Forward declaration since read_seq calls it | |
132 | function read_form(Reader : TReader) : TMal; forward; | |
133 | ||
134 | function read_seq(Reader : TReader; start: string; last: string) : TMalArray; | |
135 | var | |
136 | Token : string; | |
137 | Ast : TMalArray; | |
138 | begin | |
139 | SetLength(Ast, 0); | |
140 | ||
141 | Token := Reader.Next(); | |
142 | if Token <> start then | |
143 | raise Exception.Create('expected ''' + start + ''''); | |
144 | ||
145 | Token := Reader.Peek(); | |
146 | while Token <> last do | |
147 | begin | |
148 | if Token = #0 then | |
149 | raise Exception.Create('expected ''' + last + ''', got EOF'); | |
150 | SetLength(Ast, Length(Ast)+1); | |
151 | Ast[Length(Ast)-1] := read_form(Reader); | |
152 | Token := Reader.Peek(); | |
153 | end; | |
154 | ||
155 | Token := Reader.Next(); | |
156 | read_seq := Ast; | |
157 | end; | |
158 | ||
159 | function read_form(Reader : TReader) : TMal; | |
160 | var | |
161 | Token : string; | |
162 | Meta : TMal; | |
163 | begin | |
164 | Token := Reader.Peek(); | |
165 | case Token of | |
166 | // reader macros/transforms | |
167 | '''': | |
168 | begin | |
169 | Reader.Next(); | |
170 | read_form := _list(TMalSymbol.Create('quote'), | |
171 | read_form(Reader)); | |
172 | end; | |
173 | '`': | |
174 | begin | |
175 | Reader.Next(); | |
176 | read_form := _list(TMalSymbol.Create('quasiquote'), | |
177 | read_form(Reader)); | |
178 | end; | |
179 | '~': | |
180 | begin | |
181 | Reader.Next(); | |
182 | read_form := _list(TMalSymbol.Create('unquote'), | |
183 | read_form(Reader)); | |
184 | end; | |
185 | '~@': | |
186 | begin | |
187 | Reader.Next(); | |
188 | read_form := _list(TMalSymbol.Create('splice-unquote'), | |
189 | read_form(Reader)); | |
190 | end; | |
191 | '^': | |
192 | begin | |
193 | Reader.Next(); | |
194 | Meta := read_form(Reader); | |
195 | read_form := _list(TMalSymbol.Create('with-meta'), | |
196 | read_form(Reader), | |
197 | Meta); | |
198 | end; | |
199 | '@': | |
200 | begin | |
201 | Reader.Next(); | |
202 | read_form := _list(TMalSymbol.Create('deref'), read_form(Reader)); | |
203 | end; | |
204 | ||
205 | // list | |
206 | ')': raise Exception.Create('unexpected '')'''); | |
207 | '(': read_form := TMalList.Create(read_seq(Reader, '(', ')')); | |
208 | ||
209 | // vector | |
210 | ']': raise Exception.Create('unexpected '']'''); | |
211 | '[': read_form := TMalVector.Create(read_seq(Reader, '[', ']')); | |
212 | ||
213 | // hash-map | |
214 | '}': raise Exception.Create('unexpected ''}'''); | |
215 | '{': read_form := TMalHashMap.Create(read_seq(Reader, '{', '}')); | |
216 | else | |
217 | read_form := read_atom(Reader); | |
218 | end; | |
219 | end; | |
220 | ||
221 | ||
222 | function read_str(const Str: string): TMal; | |
223 | var | |
224 | Tokens : TStringList; | |
225 | //Dict : TObjectDictionary; | |
226 | begin | |
227 | Tokens := tokenize(Str); | |
228 | // TODO: check for empty list | |
229 | read_str := read_form(TReader.Create(Tokens)); | |
230 | end; | |
231 | ||
232 | end. |