Commit | Line | Data |
---|---|---|
adb2ac78 VS |
1 | FileStream fileIn: 'types.st'. |
2 | FileStream fileIn: 'printer.st'. | |
e3ce370c | 3 | FileStream fileIn: 'reader.st'. |
adb2ac78 VS |
4 | |
5 | Object subclass: Core [ | |
6 | Ns := Dictionary new. | |
7 | Core class >> Ns [ ^Ns ] | |
8 | ||
9 | Core class >> coerce: block [ | |
10 | block value ifTrue: [ ^MALObject True ] ifFalse: [ ^MALObject False ] | |
11 | ] | |
12 | ||
d38ab263 VS |
13 | Core class >> nilable: args else: block [ |
14 | args first type = #nil ifTrue: [ | |
15 | ^MALObject Nil | |
16 | ] ifFalse: [ | |
17 | ^block value | |
18 | ] | |
19 | ] | |
20 | ||
adb2ac78 VS |
21 | Core class >> printedArgs: args readable: readable sep: sep [ |
22 | | items | | |
23 | items := args collect: | |
24 | [ :arg | Printer prStr: arg printReadably: readable ]. | |
25 | "NOTE: {} join returns the unchanged array" | |
26 | items isEmpty ifTrue: [ ^'' ] ifFalse: [ ^items join: sep ] | |
27 | ] | |
28 | ] | |
29 | ||
30 | Core Ns at: #+ put: | |
31 | [ :args | MALNumber new: args first value + args second value ]. | |
32 | Core Ns at: #- put: | |
33 | [ :args | MALNumber new: args first value - args second value ]. | |
34 | Core Ns at: #* put: | |
35 | [ :args | MALNumber new: args first value * args second value ]. | |
36 | Core Ns at: #/ put: | |
37 | [ :args | MALNumber new: args first value // args second value ]. | |
38 | ||
39 | Core Ns at: #'pr-str' put: | |
40 | [ :args | MALString new: (Core printedArgs: args readable: true sep: ' ') ]. | |
41 | Core Ns at: #str put: | |
42 | [ :args | MALString new: (Core printedArgs: args readable: false sep: '') ]. | |
43 | Core Ns at: #prn put: | |
44 | [ :args | (Core printedArgs: args readable: true sep: ' ') displayNl. | |
45 | MALObject Nil ]. | |
46 | Core Ns at: #println put: | |
47 | [ :args | (Core printedArgs: args readable: false sep: ' ') displayNl. | |
48 | MALObject Nil ]. | |
49 | ||
50 | Core Ns at: #list put: [ :args | MALList new: (OrderedCollection from: args) ]. | |
51 | Core Ns at: #'list?' put: | |
52 | [ :args | Core coerce: [ args first type = #list ] ]. | |
53 | Core Ns at: #'empty?' put: | |
54 | [ :args | Core coerce: [ args first value isEmpty ] ]. | |
55 | Core Ns at: #count put: | |
56 | [ :args | MALNumber new: args first value size ]. | |
57 | ||
58 | Core Ns at: #= put: | |
59 | [ :args | Core coerce: [ args first = args second ] ]. | |
60 | ||
61 | Core Ns at: #< put: | |
62 | [ :args | Core coerce: [ args first value < args second value ] ]. | |
63 | Core Ns at: #<= put: | |
64 | [ :args | Core coerce: [ args first value <= args second value ] ]. | |
65 | Core Ns at: #> put: | |
66 | [ :args | Core coerce: [ args first value > args second value ] ]. | |
67 | Core Ns at: #>= put: | |
68 | [ :args | Core coerce: [ args first value >= args second value ] ]. | |
e3ce370c VS |
69 | |
70 | Core Ns at: #'read-string' put: | |
71 | [ :args | Reader readStr: args first value ]. | |
72 | Core Ns at: #slurp put: | |
73 | [ :args | MALString new: (File path: args first value) contents ]. | |
d38ab263 VS |
74 | Core Ns at: #throw put: |
75 | [ :args | MALCustomError new signal: args first ]. | |
e3ce370c VS |
76 | |
77 | Core Ns at: #atom put: | |
78 | [ :args | MALAtom new: args first ]. | |
79 | Core Ns at: #'atom?' put: | |
80 | [ :args | Core coerce: [ args first type = #atom ] ]. | |
81 | Core Ns at: #deref put: | |
82 | [ :args | args first value ]. | |
83 | Core Ns at: #'reset!' put: | |
84 | [ :args | args first value: args second. args second ]. | |
85 | Core Ns at: #'swap!' put: | |
86 | [ :args | | |
87 | | a f x xs result | | |
88 | a := args first. | |
89 | f := args second. | |
90 | f class = Func ifTrue: [ f := f fn ]. | |
91 | x := a value. | |
92 | xs := args allButFirst: 2. | |
93 | result := f value: (xs copyWithFirst: x). | |
94 | a value: result. | |
95 | result | |
96 | ]. | |
d586e014 VS |
97 | |
98 | Core Ns at: #cons put: | |
99 | [ :args | MALList new: (args second value copyWithFirst: args first) ]. | |
100 | Core Ns at: #concat put: | |
101 | [ :args | MALList new: (OrderedCollection join: | |
102 | (args collect: [ :arg | arg value ])) ]. | |
ae4600c7 VS |
103 | Core Ns at: #nth put: |
104 | [ :args | | |
105 | | items index | | |
106 | items := args first value. | |
107 | index := args second value + 1. | |
108 | items at: index ifAbsent: [ MALOutOfBounds new signal ] | |
109 | ]. | |
110 | Core Ns at: #first put: | |
d38ab263 VS |
111 | [ :args | Core nilable: args else: [ |
112 | args first value at: 1 ifAbsent: [ MALObject Nil ] ] ]. | |
ae4600c7 VS |
113 | Core Ns at: #rest put: |
114 | [ :args | | |
115 | | items rest | | |
116 | items := args first value. | |
d38ab263 | 117 | (args first type = #nil or: [ items isEmpty ]) ifTrue: [ |
ae4600c7 VS |
118 | rest := {} |
119 | ] ifFalse: [ | |
120 | rest := items allButFirst | |
121 | ]. | |
122 | MALList new: (OrderedCollection from: rest) | |
123 | ]. | |
d38ab263 VS |
124 | |
125 | Core Ns at: #apply put: | |
126 | [ :args | | |
127 | | f rest result | | |
128 | f := args first. | |
129 | f class = Func ifTrue: [ f := f fn ]. | |
130 | args size < 3 ifTrue: [ | |
131 | rest := {} | |
132 | ] ifFalse: [ | |
133 | rest := args copyFrom: 2 to: args size - 1 | |
134 | ]. | |
135 | rest := rest, args last value. | |
136 | f value: rest | |
137 | ]. | |
138 | Core Ns at: #map put: | |
139 | [ :args | | |
140 | | items f result | | |
141 | f := args first. | |
142 | f class = Func ifTrue: [ f := f fn ]. | |
143 | items := args second value. | |
144 | result := items collect: [ :item | f value: {item} ]. | |
145 | MALList new: (OrderedCollection from: result) | |
146 | ]. | |
147 | ||
148 | Core Ns at: #'nil?' put: | |
149 | [ :args | Core coerce: [ args first type = #nil ] ]. | |
150 | Core Ns at: #'true?' put: | |
151 | [ :args | Core coerce: [ args first type = #true ] ]. | |
152 | Core Ns at: #'false?' put: | |
153 | [ :args | Core coerce: [ args first type = #false ] ]. | |
154 | Core Ns at: #'symbol?' put: | |
155 | [ :args | Core coerce: [ args first type = #symbol ] ]. | |
156 | Core Ns at: #'keyword?' put: | |
157 | [ :args | Core coerce: [ args first type = #keyword ] ]. | |
158 | Core Ns at: #'vector?' put: | |
159 | [ :args | Core coerce: [ args first type = #vector ] ]. | |
160 | Core Ns at: #'map?' put: | |
161 | [ :args | Core coerce: [ args first type = #map ] ]. | |
162 | Core Ns at: #'sequential?' put: | |
163 | [ :args | Core coerce: [ args first type = #list or: | |
164 | [ args first type = #vector ] ] ]. | |
165 | ||
166 | Core Ns at: #symbol put: | |
167 | [ :args | MALSymbol new: args first value asSymbol ]. | |
168 | Core Ns at: #keyword put: | |
169 | [ :args | MALKeyword new: args first value asSymbol ]. | |
170 | Core Ns at: #vector put: | |
171 | [ :args | MALVector new: (OrderedCollection from: args) ]. | |
172 | Core Ns at: #'hash-map' put: | |
173 | [ :args | MALMap new: args asDictionary ]. | |
174 | ||
175 | Core Ns at: #assoc put: | |
176 | [ :args | | |
177 | | result keyVals | | |
178 | result := Dictionary from: args first value associations. | |
179 | keyVals := args allButFirst. | |
180 | 1 to: keyVals size by: 2 do: | |
181 | [ :i | result add: (keyVals at: i) -> (keyVals at: i + 1) ]. | |
182 | MALMap new: result | |
183 | ]. | |
184 | Core Ns at: #dissoc put: | |
185 | [ :args | | |
186 | | result keys | | |
187 | result := Dictionary from: args first value associations. | |
188 | keys := args allButFirst. | |
189 | keys do: [ :key | result removeKey: key ifAbsent: [ nil ] ]. | |
190 | MALMap new: result | |
191 | ]. | |
192 | Core Ns at: #get put: | |
193 | [ :args | Core nilable: args else: | |
194 | [ args first value at: args second ifAbsent: [ MALObject Nil ] ] ]. | |
195 | Core Ns at: #'contains?' put: | |
196 | [ :args | Core coerce: [ args first value includesKey: args second ] ]. | |
197 | Core Ns at: #keys put: | |
198 | [ :args | MALList new: (OrderedCollection from: args first value keys) ]. | |
199 | Core Ns at: #vals put: | |
200 | [ :args | MALList new: (OrderedCollection from: args first value values) ]. |