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