gst/step8_macros.st

   1 FileStream fileIn: 'readline.st'.
   2 FileStream fileIn: 'reader.st'.
   3 FileStream fileIn: 'printer.st'.
   4 FileStream fileIn: 'env.st'.
   5 FileStream fileIn: 'func.st'.
   6 FileStream fileIn: 'core.st'.
   7
   8 Object subclass: MAL [
   9     MAL class >> READ: input [
  10         ^Reader readStr: input
  11     ]
  12
  13     MAL class >> evalAst: sexp env: env [
  14         sexp type = #symbol ifTrue: [
  15             ^env get: sexp value
  16         ].
  17
  18         sexp type = #list ifTrue: [
  19             ^self evalList: sexp env: env class: MALList
  20         ].
  21         sexp type = #vector ifTrue: [
  22             ^self evalList: sexp env: env class: MALVector
  23         ].
  24         sexp type = #map ifTrue: [
  25             ^self evalList: sexp env: env class: MALMap
  26         ].
  27
  28         ^sexp
  29     ]
  30
  31     MAL class >> evalList: sexp env: env class: aClass [
  32         | items |
  33         items := sexp value collect:
  34             [ :item | self EVAL: item env: env ].
  35         ^aClass new: items
  36     ]
  37
  38     MAL class >> quasiquote: ast [
  39         | result a a0 a0_ a0_0 a0_1 rest |
  40         ast isPair ifFalse: [
  41             result := {MALSymbol new: #quote. ast}.
  42             ^MALList new: (OrderedCollection from: result)
  43         ].
  44
  45         a := ast value.
  46         a0 := a first.
  47
  48         (a0 type = #symbol and: [ a0 value = #unquote ]) ifTrue: [ ^a second ].
  49
  50         a0 isPair ifTrue: [
  51             a0_ := a0 value.
  52             a0_0 := a0_ first.
  53             a0_1 := a0_ second.
  54
  55             (a0_0 type = #symbol and:
  56              [ a0_0 value = #'splice-unquote' ]) ifTrue: [
  57                 rest := MALList new: a allButFirst.
  58                 result := {MALSymbol new: #concat. a0_1.
  59                            self quasiquote: rest}.
  60                 ^MALList new: (OrderedCollection from: result)
  61             ]
  62         ].
  63
  64         rest := MALList new: a allButFirst.
  65         result := {MALSymbol new: #cons. self quasiquote: a0.
  66                    self quasiquote: rest}.
  67         ^MALList new: (OrderedCollection from: result)
  68     ]
  69
  70     MAL class >> isMacroCall: ast env: env [
  71         | a0 a0_ f |
  72         ast type = #list ifTrue: [
  73             a0 := ast value first.
  74             a0_ := a0 value.
  75             a0 type = #symbol ifTrue: [
  76                 f := env find: a0_.
  77                 (f notNil and: [ f type = #func ]) ifTrue: [
  78                     ^f isMacro
  79                 ]
  80             ]
  81         ].
  82         ^false
  83     ]
  84
  85     MAL class >> macroexpand: aSexp env: env [
  86         | sexp |
  87
  88         "NOTE: redefinition of method arguments is not allowed"
  89         sexp := aSexp.
  90
  91         [ self isMacroCall: sexp env: env ] whileTrue: [
  92             | ast a0_ macro rest |
  93             ast := sexp value.
  94             a0_ := ast first value.
  95             macro := env find: a0_.
  96             rest := ast allButFirst.
  97             sexp := macro fn value: rest.
  98         ].
  99
 100         ^sexp
 101     ]
 102
 103     MAL class >> EVAL: aSexp env: anEnv [
 104         | sexp env ast a0 a0_ a1 a1_ a2 a3 forms function args |
 105
 106         "NOTE: redefinition of method arguments is not allowed"
 107         sexp := aSexp.
 108         env := anEnv.
 109
 110         [
 111             [ :continue |
 112                 sexp type ~= #list ifTrue: [
 113                     ^self evalAst: sexp env: env
 114                 ].
 115                 sexp value isEmpty ifTrue: [
 116                     ^sexp
 117                 ].
 118
 119                 sexp := self macroexpand: sexp env: env.
 120                 sexp type ~= #list ifTrue: [
 121                     ^self evalAst: sexp env: env
 122                 ].
 123
 124                 ast := sexp value.
 125                 a0 := ast first.
 126
 127                 a0_ := ast first value.
 128                 a0_ = #'def!' ifTrue: [
 129                     | result |
 130                     a1_ := ast second value.
 131                     a2 := ast third.
 132                     result := self EVAL: a2 env: env.
 133                     env set: a1_ value: result.
 134                     ^result
 135                 ].
 136
 137                 a0_ = #'defmacro!' ifTrue: [
 138                     | result |
 139                     a1_ := ast second value.
 140                     a2 := ast third.
 141                     result := self EVAL: a2 env: env.
 142                     result isMacro: true.
 143                     env set: a1_ value: result.
 144                     ^result
 145                 ].
 146
 147                 a0_ = #'macroexpand' ifTrue: [
 148                     a1 := ast second.
 149                     ^self macroexpand: a1 env: env
 150                 ].
 151
 152                 a0_ = #'let*' ifTrue: [
 153                     | env_ |
 154                         env_ := Env new: env.
 155                     a1_ := ast second value.
 156                     a2 := ast third.
 157                     1 to: a1_ size by: 2 do:
 158                         [ :i | env_ set: (a1_ at: i) value
 159                                     value: (self EVAL: (a1_ at: i + 1)
 160                                                  env: env_) ].
 161                     env := env_.
 162                     sexp := a2.
 163                     continue value "TCO"
 164                 ].
 165
 166                 a0_ = #do ifTrue: [
 167                     | forms last |
 168                     ast size < 2 ifTrue: [
 169                         forms := {}.
 170                         last := MALObject Nil.
 171                     ] ifFalse: [
 172                         forms := ast copyFrom: 2 to: ast size - 1.
 173                         last := ast last.
 174                     ].
 175
 176                     forms do: [ :form | self EVAL: form env: env ].
 177                     sexp := last.
 178                     continue value "TCO"
 179                 ].
 180
 181                 a0_ = #if ifTrue: [
 182                     | condition |
 183                     a1 := ast second.
 184                     a2 := ast third.
 185                     a3 := ast at: 4 ifAbsent: [ MALObject Nil ].
 186                     condition := self EVAL: a1 env: env.
 187
 188                     (condition type = #false or:
 189                          [ condition type = #nil ]) ifTrue: [
 190                              sexp := a3
 191                          ] ifFalse: [
 192                              sexp := a2
 193                          ].
 194                     continue value "TCO"
 195                 ].
 196
 197                 a0_ = #quote ifTrue: [
 198                     a1 := ast second.
 199                     ^a1
 200                 ].
 201
 202                 a0_ = #quasiquote ifTrue: [
 203                     | result |
 204                     a1 := ast second.
 205                     sexp := self quasiquote: a1.
 206                     continue value "TCO"
 207                 ].
 208
 209                 a0_ = #'fn*' ifTrue: [
 210                     | binds env_ fn |
 211                         a1_ := ast second value.
 212                     binds := a1_ collect: [ :item | item value ].
 213                     a2 := ast third.
 214                     fn := [ :args |
 215                         self EVAL: a2 env:
 216                             (Env new: env binds: binds exprs: args) ].
 217                     ^Func new: a2 params: binds env: env fn: fn
 218                 ].
 219
 220                 forms := (self evalAst: sexp env: env) value.
 221                 function := forms first.
 222                 args := forms allButFirst asArray.
 223
 224                 function type = #fn ifTrue: [ ^function fn value: args ].
 225                 function type = #func ifTrue: [
 226                     | env_ |
 227                     sexp := function ast.
 228                     env_ := Env new: function env binds: function params
 229                                 exprs: args.
 230                     env := env_.
 231                     continue value "TCO"
 232                 ]
 233             ] valueWithExit
 234         ] repeat.
 235     ]
 236
 237     MAL class >> PRINT: sexp [
 238         ^Printer prStr: sexp printReadably: true
 239     ]
 240
 241     MAL class >> rep: input env: env [
 242         ^self PRINT: (self EVAL: (self READ: input) env: env)
 243     ]
 244 ]
 245
 246 | input historyFile replEnv argv |
 247
 248 historyFile := '.mal_history'.
 249 ReadLine readHistory: historyFile.
 250 replEnv := Env new: nil.
 251
 252 argv := Smalltalk arguments.
 253 argv notEmpty ifTrue: [ argv := argv allButFirst ].
 254 argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]).
 255
 256 Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ].
 257 replEnv set: #eval value: (Fn new: [ :args | MAL EVAL: args first env: replEnv ]).
 258 replEnv set: #'*ARGV*' value: (MALList new: argv).
 259
 260 MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv.
 261 MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))' env: replEnv.
 262
 263 MAL rep: '(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))' env: replEnv.
 264 MAL rep: '(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))' env: replEnv.
 265
 266 Smalltalk arguments notEmpty ifTrue: [
 267     MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv
 268 ] ifFalse: [
 269     [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [
 270         input isEmpty ifFalse: [
 271             ReadLine addHistory: input.
 272             ReadLine writeHistory: historyFile.
 273             [ (MAL rep: input env: replEnv) displayNl ]
 274                 on: MALEmptyInput do: [ #return ]
 275                 on: MALError do:
 276                     [ :err | ('error: ', err messageText) displayNl. #return ].
 277         ]
 278     ].
 279
 280     '' displayNl.
 281 ]