gst/step5_tco.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 >> EVAL: aSexp env: anEnv [
  39         | sexp env ast a0_ a1 a1_ a2 a3 forms function args |
  40
  41         "NOTE: redefinition of method arguments is not allowed"
  42         sexp := aSexp.
  43         env := anEnv.
  44
  45         [
  46             [ :continue |
  47                 sexp type ~= #list ifTrue: [
  48                     ^self evalAst: sexp env: env
  49                 ].
  50                 sexp value isEmpty ifTrue: [
  51                     ^sexp
  52                 ].
  53
  54                 ast := sexp value.
  55                 a0_ := ast first value.
  56
  57                 a0_ = #'def!' ifTrue: [
  58                     | result |
  59                     a1_ := ast second value.
  60                     a2 := ast third.
  61                     result := self EVAL: a2 env: env.
  62                     env set: a1_ value: result.
  63                     ^result
  64                 ].
  65
  66                 a0_ = #'let*' ifTrue: [
  67                     | env_ |
  68                     env_ := Env new: env.
  69                     a1_ := ast second value.
  70                     a2 := ast third.
  71                     1 to: a1_ size by: 2 do:
  72                         [ :i | env_ set: (a1_ at: i) value
  73                                     value: (self EVAL: (a1_ at: i + 1)
  74                                                  env: env_) ].
  75                     env := env_.
  76                     sexp := a2.
  77                     continue value "TCO"
  78                 ].
  79
  80                 a0_ = #do ifTrue: [
  81                     | forms last |
  82                     ast size < 2 ifTrue: [
  83                         forms := {}.
  84                         last := MALObject Nil.
  85                     ] ifFalse: [
  86                         forms := ast copyFrom: 2 to: ast size - 1.
  87                         last := ast last.
  88                     ].
  89
  90                     forms do: [ :form | self EVAL: form env: env ].
  91                     sexp := last.
  92                     continue value "TCO"
  93                 ].
  94
  95                 a0_ = #if ifTrue: [
  96                     | condition |
  97                     a1 := ast second.
  98                     a2 := ast third.
  99                     a3 := ast at: 4 ifAbsent: [ MALObject Nil ].
 100                     condition := self EVAL: a1 env: env.
 101
 102                     (condition type = #false or:
 103                      [ condition type = #nil ]) ifTrue: [
 104                         sexp := a3
 105                     ] ifFalse: [
 106                         sexp := a2
 107                     ].
 108                     continue value "TCO"
 109                 ].
 110
 111                 a0_ = #'fn*' ifTrue: [
 112                     | binds env_ fn |
 113                     a1_ := ast second value.
 114                     binds := a1_ collect: [ :item | item value ].
 115                     a2 := ast third.
 116                     fn := [ :args |
 117                         self EVAL: a2 env:
 118                             (Env new: env binds: binds exprs: args) ].
 119                     ^Func new: a2 params: binds env: env fn: fn
 120                 ].
 121
 122                 forms := (self evalAst: sexp env: env) value.
 123                 function := forms first.
 124                 args := forms allButFirst asArray.
 125
 126                 function class = BlockClosure ifTrue: [ ^function value: args ].
 127                 function class = Func ifTrue: [
 128                     | env_ |
 129                     sexp := function ast.
 130                     env_ := Env new: function env binds: function params
 131                                 exprs: args.
 132                     env := env_.
 133                     continue value "TCO"
 134                 ]
 135             ] valueWithExit
 136         ] repeat.
 137     ]
 138
 139     MAL class >> PRINT: sexp [
 140         ^Printer prStr: sexp printReadably: true
 141     ]
 142
 143     MAL class >> rep: input env: env [
 144         ^self PRINT: (self EVAL: (self READ: input) env: env)
 145     ]
 146 ]
 147
 148 | input historyFile replEnv |
 149
 150 historyFile := '.mal_history'.
 151 ReadLine readHistory: historyFile.
 152 replEnv := Env new: nil.
 153
 154 Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ].
 155
 156 MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv.
 157
 158 [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [
 159     input isEmpty ifFalse: [
 160         ReadLine addHistory: input.
 161         ReadLine writeHistory: historyFile.
 162         [ (MAL rep: input env: replEnv) displayNl ]
 163             on: MALEmptyInput do: [ #return ]
 164             on: MALError do:
 165                 [ :err | ('error: ', err messageText) displayNl. #return ].
 166     ]
 167 ]
 168
 169 '' displayNl.