gst/step6_file.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 class = BlockClosure ifTrue: [^sexp ].
  15
  16         sexp type = #symbol ifTrue: [
  17             ^env get: sexp value
  18         ].
  19
  20         sexp type = #list ifTrue: [
  21             ^self evalList: sexp env: env class: MALList
  22         ].
  23         sexp type = #vector ifTrue: [
  24             ^self evalList: sexp env: env class: MALVector
  25         ].
  26         sexp type = #map ifTrue: [
  27             ^self evalList: sexp env: env class: MALMap
  28         ].
  29
  30         ^sexp
  31     ]
  32
  33     MAL class >> evalList: sexp env: env class: aClass [
  34         | items |
  35         items := sexp value collect:
  36             [ :item | self EVAL: item env: env ].
  37         ^aClass new: items
  38     ]
  39
  40     MAL class >> EVAL: aSexp env: anEnv [
  41         | sexp env ast a0 a0_ a1 a1_ a2 a3 forms function args |
  42
  43         "NOTE: redefinition of method arguments is not allowed"
  44         sexp := aSexp.
  45         env := anEnv.
  46
  47         [
  48             [ :continue |
  49                 (sexp class = BlockClosure or: [ sexp type ~= #list ]) ifTrue: [
  50                     ^self evalAst: sexp env: env
  51                 ].
  52                 sexp value isEmpty ifTrue: [
  53                     ^sexp
  54                 ].
  55
  56                 ast := sexp value.
  57                 a0 := ast first.
  58
  59                 a0 class ~= BlockClosure ifTrue: [
  60                     a0_ := ast first value.
  61                     a0_ = #'def!' ifTrue: [
  62                         | result |
  63                         a1_ := ast second value.
  64                         a2 := ast third.
  65                         result := self EVAL: a2 env: env.
  66                         env set: a1_ value: result.
  67                         ^result
  68                     ].
  69
  70                     a0_ = #'let*' ifTrue: [
  71                         | env_ |
  72                             env_ := Env new: env.
  73                         a1_ := ast second value.
  74                         a2 := ast third.
  75                         1 to: a1_ size by: 2 do:
  76                             [ :i | env_ set: (a1_ at: i) value
  77                                         value: (self EVAL: (a1_ at: i + 1)
  78                                                      env: env_) ].
  79                         env := env_.
  80                         sexp := a2.
  81                         continue value "TCO"
  82                     ].
  83
  84                     a0_ = #do ifTrue: [
  85                         | forms last |
  86                         ast size < 2 ifTrue: [
  87                             forms := {}.
  88                             last := MALObject Nil.
  89                         ] ifFalse: [
  90                             forms := ast copyFrom: 2 to: ast size - 1.
  91                             last := ast last.
  92                         ].
  93
  94                         forms do: [ :form | self EVAL: form env: env ].
  95                         sexp := last.
  96                         continue value "TCO"
  97                     ].
  98
  99                     a0_ = #if ifTrue: [
 100                         | condition |
 101                         a1 := ast second.
 102                         a2 := ast third.
 103                         a3 := ast at: 4 ifAbsent: [ MALObject Nil ].
 104                         condition := self EVAL: a1 env: env.
 105
 106                         (condition type = #false or:
 107                              [ condition type = #nil ]) ifTrue: [
 108                                  sexp := a3
 109                              ] ifFalse: [
 110                                  sexp := a2
 111                              ].
 112                         continue value "TCO"
 113                     ].
 114
 115                     a0_ = #'fn*' ifTrue: [
 116                         | binds env_ fn |
 117                             a1_ := ast second value.
 118                         binds := a1_ collect: [ :item | item value ].
 119                         a2 := ast third.
 120                         fn := [ :args |
 121                             self EVAL: a2 env:
 122                                 (Env new: env binds: binds exprs: args) ].
 123                         ^Func new: a2 params: binds env: env fn: fn
 124                     ]
 125                 ].
 126
 127                 forms := (self evalAst: sexp env: env) value.
 128                 function := forms first.
 129                 args := forms allButFirst asArray.
 130
 131                 function class = BlockClosure ifTrue: [ ^function value: args ].
 132                 function class = Func ifTrue: [
 133                     | env_ |
 134                     sexp := function ast.
 135                     env_ := Env new: function env binds: function params
 136                                 exprs: args.
 137                     env := env_.
 138                     continue value "TCO"
 139                 ]
 140             ] valueWithExit
 141         ] repeat.
 142     ]
 143
 144     MAL class >> PRINT: sexp [
 145         ^Printer prStr: sexp printReadably: true
 146     ]
 147
 148     MAL class >> rep: input env: env [
 149         ^self PRINT: (self EVAL: (self READ: input) env: env)
 150     ]
 151 ]
 152
 153 | input historyFile replEnv argv |
 154
 155 historyFile := '.mal_history'.
 156 ReadLine readHistory: historyFile.
 157 replEnv := Env new: nil.
 158
 159 argv := Smalltalk arguments.
 160 argv notEmpty ifTrue: [ argv := argv allButFirst ].
 161 argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]).
 162
 163 Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ].
 164 replEnv set: #eval value: [ :args | MAL EVAL: args first env: replEnv ].
 165 replEnv set: #'*ARGV*' value: (MALList new: argv).
 166
 167 MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv.
 168 MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))' env: replEnv.
 169
 170 Smalltalk arguments notEmpty ifTrue: [
 171     MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv
 172 ] ifFalse: [
 173     [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [
 174         input isEmpty ifFalse: [
 175             ReadLine addHistory: input.
 176             ReadLine writeHistory: historyFile.
 177             [ (MAL rep: input env: replEnv) displayNl ]
 178                 on: MALEmptyInput do: [ #return ]
 179                 on: MALError do:
 180                     [ :err | ('error: ', err messageText) displayNl. #return ].
 181         ]
 182     ].
 183
 184     '' displayNl.
 185 ]