gst/core.st

   1 FileStream fileIn: 'types.st'.
   2 FileStream fileIn: 'printer.st'.
   3 FileStream fileIn: 'reader.st'.
   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
  13     Core class >> nilable: args else: block [
  14         args first type = #nil ifTrue: [
  15             ^MALObject Nil
  16         ] ifFalse: [
  17             ^block value
  18         ]
  19     ]
  20
  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 ] ].
  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 ].
  74 Core Ns at: #throw put:
  75     [ :args | MALCustomError new signal: args first ].
  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     ].
  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 ])) ].
 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:
 111     [ :args | Core nilable: args else: [
 112         args first value at: 1 ifAbsent: [ MALObject Nil ] ] ].
 113 Core Ns at: #rest put:
 114     [ :args |
 115         | items rest |
 116         items := args first value.
 117         (args first type = #nil or: [ items isEmpty  ]) ifTrue: [
 118             rest := {}
 119         ] ifFalse: [
 120             rest := items allButFirst
 121         ].
 122         MALList new: (OrderedCollection from: rest)
 123     ].
 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) ].