gst/step7_quote.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 >> EVAL: aSexp env: anEnv [
  71         | sexp env ast a0 a0_ a1 a1_ a2 a3 forms function args |
  72
  73         "NOTE: redefinition of method arguments is not allowed"
  74         sexp := aSexp.
  75         env := anEnv.
  76
  77         [
  78             [ :continue |
  79                 sexp type ~= #list ifTrue: [
  80                     ^self evalAst: sexp env: env
  81                 ].
  82                 sexp value isEmpty ifTrue: [
  83                     ^sexp
  84                 ].
  85
  86                 ast := sexp value.
  87                 a0 := ast first.
  88
  89                 a0_ := ast first value.
  90                 a0_ = #'def!' ifTrue: [
  91                     | result |
  92                     a1_ := ast second value.
  93                     a2 := ast third.
  94                     result := self EVAL: a2 env: env.
  95                     env set: a1_ value: result.
  96                     ^result
  97                 ].
  98
  99                 a0_ = #'let*' ifTrue: [
 100                     | env_ |
 101                         env_ := Env new: env.
 102                     a1_ := ast second value.
 103                     a2 := ast third.
 104                     1 to: a1_ size by: 2 do:
 105                         [ :i | env_ set: (a1_ at: i) value
 106                                     value: (self EVAL: (a1_ at: i + 1)
 107                                                  env: env_) ].
 108                     env := env_.
 109                     sexp := a2.
 110                     continue value "TCO"
 111                 ].
 112
 113                 a0_ = #do ifTrue: [
 114                     | forms last |
 115                     ast size < 2 ifTrue: [
 116                         forms := {}.
 117                         last := MALObject Nil.
 118                     ] ifFalse: [
 119                         forms := ast copyFrom: 2 to: ast size - 1.
 120                         last := ast last.
 121                     ].
 122
 123                     forms do: [ :form | self EVAL: form env: env ].
 124                     sexp := last.
 125                     continue value "TCO"
 126                 ].
 127
 128                 a0_ = #if ifTrue: [
 129                     | condition |
 130                     a1 := ast second.
 131                     a2 := ast third.
 132                     a3 := ast at: 4 ifAbsent: [ MALObject Nil ].
 133                     condition := self EVAL: a1 env: env.
 134
 135                     (condition type = #false or:
 136                          [ condition type = #nil ]) ifTrue: [
 137                              sexp := a3
 138                          ] ifFalse: [
 139                              sexp := a2
 140                          ].
 141                     continue value "TCO"
 142                 ].
 143
 144                 a0_ = #quote ifTrue: [
 145                     a1 := ast second.
 146                     ^a1
 147                 ].
 148
 149                 a0_ = #quasiquote ifTrue: [
 150                     | result |
 151                     a1 := ast second.
 152                     sexp := self quasiquote: a1.
 153                     continue value "TCO"
 154                 ].
 155
 156                 a0_ = #'fn*' ifTrue: [
 157                     | binds env_ fn |
 158                         a1_ := ast second value.
 159                     binds := a1_ collect: [ :item | item value ].
 160                     a2 := ast third.
 161                     fn := [ :args |
 162                         self EVAL: a2 env:
 163                             (Env new: env binds: binds exprs: args) ].
 164                     ^Func new: a2 params: binds env: env fn: fn
 165                 ].
 166
 167                 forms := (self evalAst: sexp env: env) value.
 168                 function := forms first.
 169                 args := forms allButFirst asArray.
 170
 171                 function class = BlockClosure ifTrue: [ ^function value: args ].
 172                 function class = Func ifTrue: [
 173                     | env_ |
 174                     sexp := function ast.
 175                     env_ := Env new: function env binds: function params
 176                                 exprs: args.
 177                     env := env_.
 178                     continue value "TCO"
 179                 ]
 180             ] valueWithExit
 181         ] repeat.
 182     ]
 183
 184     MAL class >> PRINT: sexp [
 185         ^Printer prStr: sexp printReadably: true
 186     ]
 187
 188     MAL class >> rep: input env: env [
 189         ^self PRINT: (self EVAL: (self READ: input) env: env)
 190     ]
 191 ]
 192
 193 | input historyFile replEnv argv |
 194
 195 historyFile := '.mal_history'.
 196 ReadLine readHistory: historyFile.
 197 replEnv := Env new: nil.
 198
 199 argv := Smalltalk arguments.
 200 argv notEmpty ifTrue: [ argv := argv allButFirst ].
 201 argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]).
 202
 203 Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ].
 204 replEnv set: #eval value: [ :args | MAL EVAL: args first env: replEnv ].
 205 replEnv set: #'*ARGV*' value: (MALList new: argv).
 206
 207 MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv.
 208 MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))' env: replEnv.
 209
 210 Smalltalk arguments notEmpty ifTrue: [
 211     MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv
 212 ] ifFalse: [
 213     [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [
 214         input isEmpty ifFalse: [
 215             ReadLine addHistory: input.
 216             ReadLine writeHistory: historyFile.
 217             [ (MAL rep: input env: replEnv) displayNl ]
 218                 on: MALEmptyInput do: [ #return ]
 219                 on: MALError do:
 220                     [ :err | ('error: ', err messageText) displayNl. #return ].
 221         ]
 222     ].
 223
 224     '' displayNl.
 225 ]