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 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 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.
  56
  57                 a0_ := ast first value.
  58                 a0_ = #'def!' ifTrue: [
  59                     | result |
  60                     a1_ := ast second value.
  61                     a2 := ast third.
  62                     result := self EVAL: a2 env: env.
  63                     env set: a1_ value: result.
  64                     ^result
  65                 ].
  66
  67                 a0_ = #'let*' ifTrue: [
  68                     | env_ |
  69                         env_ := Env new: env.
  70                     a1_ := ast second value.
  71                     a2 := ast third.
  72                     1 to: a1_ size by: 2 do:
  73                         [ :i | env_ set: (a1_ at: i) value
  74                                     value: (self EVAL: (a1_ at: i + 1)
  75                                                  env: env_) ].
  76                     env := env_.
  77                     sexp := a2.
  78                     continue value "TCO"
  79                 ].
  80
  81                 a0_ = #do ifTrue: [
  82                     | forms last |
  83                     ast size < 2 ifTrue: [
  84                         forms := {}.
  85                         last := MALObject Nil.
  86                     ] ifFalse: [
  87                         forms := ast copyFrom: 2 to: ast size - 1.
  88                         last := ast last.
  89                     ].
  90
  91                     forms do: [ :form | self EVAL: form env: env ].
  92                     sexp := last.
  93                     continue value "TCO"
  94                 ].
  95
  96                 a0_ = #if ifTrue: [
  97                     | condition |
  98                     a1 := ast second.
  99                     a2 := ast third.
 100                     a3 := ast at: 4 ifAbsent: [ MALObject Nil ].
 101                     condition := self EVAL: a1 env: env.
 102
 103                     (condition type = #false or:
 104                          [ condition type = #nil ]) ifTrue: [
 105                              sexp := a3
 106                          ] ifFalse: [
 107                              sexp := a2
 108                          ].
 109                     continue value "TCO"
 110                 ].
 111
 112                 a0_ = #'fn*' ifTrue: [
 113                     | binds env_ fn |
 114                     a1_ := ast second value.
 115                     binds := a1_ collect: [ :item | item value ].
 116                     a2 := ast third.
 117                     fn := [ :args |
 118                         self EVAL: a2 env:
 119                             (Env new: env binds: binds exprs: args) ].
 120                     ^Func new: a2 params: binds env: env fn: fn
 121                 ].
 122
 123                 forms := (self evalAst: sexp env: env) value.
 124                 function := forms first.
 125                 args := forms allButFirst asArray.
 126
 127                 function type = #fn ifTrue: [ ^function fn value: args ].
 128                 function type = #func ifTrue: [
 129                     | env_ |
 130                     sexp := function ast.
 131                     env_ := Env new: function env binds: function params
 132                                 exprs: args.
 133                     env := env_.
 134                     continue value "TCO"
 135                 ]
 136             ] valueWithExit
 137         ] repeat.
 138     ]
 139
 140     MAL class >> PRINT: sexp [
 141         ^Printer prStr: sexp printReadably: true
 142     ]
 143
 144     MAL class >> rep: input env: env [
 145         ^self PRINT: (self EVAL: (self READ: input) env: env)
 146     ]
 147 ]
 148
 149 | input historyFile replEnv argv |
 150
 151 historyFile := '.mal_history'.
 152 ReadLine readHistory: historyFile.
 153 replEnv := Env new: nil.
 154
 155 argv := Smalltalk arguments.
 156 argv notEmpty ifTrue: [ argv := argv allButFirst ].
 157 argv := OrderedCollection from: (argv collect: [ :arg | MALString new: arg ]).
 158
 159 Core Ns keysAndValuesDo: [ :op :block | replEnv set: op value: block ].
 160 replEnv set: #eval value: (Fn new: [ :args | MAL EVAL: args first env: replEnv ]).
 161 replEnv set: #'*ARGV*' value: (MALList new: argv).
 162
 163 MAL rep: '(def! not (fn* (a) (if a false true)))' env: replEnv.
 164 MAL rep: '(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))' env: replEnv.
 165
 166 Smalltalk arguments notEmpty ifTrue: [
 167     MAL rep: '(load-file "', Smalltalk arguments first, '")' env: replEnv
 168 ] ifFalse: [
 169     [ input := ReadLine readLine: 'user> '. input isNil ] whileFalse: [
 170         input isEmpty ifFalse: [
 171             ReadLine addHistory: input.
 172             ReadLine writeHistory: historyFile.
 173             [ (MAL rep: input env: replEnv) displayNl ]
 174                 on: MALEmptyInput do: [ #return ]
 175                 on: MALError do:
 176                     [ :err | ('error: ', err messageText) displayNl. #return ].
 177         ]
 178     ].
 179
 180     '' displayNl.
 181 ]