livescript/step5_tco.ls

   1 readline = require './node_readline'
   2 {id, map, each, last, all, unique, zip, Obj, elem-index} = require 'prelude-ls'
   3 {read_str} = require './reader'
   4 {pr_str} = require './printer'
   5 {Env} = require './env'
   6 {runtime-error, ns} = require './core'
   7 {list-to-pairs} = require './utils'
   8
   9
  10 defer-tco = (env, ast) ->
  11     type: \tco
  12     env: env
  13     ast: ast
  14
  15
  16 is-thruthy = ({type, value}) ->
  17     type != \const or value not in [\nil \false]
  18
  19
  20 fmap-ast = (fn, {type, value}: ast) -->
  21     {type: type, value: fn value}
  22
  23
  24 eval_simple = (env, {type, value}: ast) ->
  25     switch type
  26     | \symbol => env.get value
  27     | \list, \vector => ast |> fmap-ast map eval_ast env
  28     | \map => ast |> fmap-ast Obj.map eval_ast env
  29     | otherwise => ast
  30
  31
  32 eval_ast = (env, {type, value}: ast) -->
  33     loop
  34         if type != \list
  35             return eval_simple env, ast
  36         else if value.length == 0
  37             return ast
  38
  39         result = if value[0].type == \symbol
  40             params = value[1 to]
  41             switch value[0].value
  42             | 'def!' => eval_def env, params
  43             | 'let*' => eval_let env, params
  44             | 'do'   => eval_do env, params
  45             | 'if'   => eval_if env, params
  46             | 'fn*'  => eval_fn env, params
  47             | otherwise => eval_apply env, value
  48         else
  49             eval_apply env, value
  50
  51         if result.type == \tco
  52             env = result.env
  53             {type, value}: ast = result.ast
  54         else
  55             return result
  56
  57
  58 check_params = (name, params, expected) ->
  59     if params.length != expected
  60         runtime-error "'#{name}' expected #{expected} parameters,
  61                        got #{params.length}"
  62
  63
  64 eval_def = (env, params) ->
  65     check_params 'def!', params, 2
  66
  67     # Name is in the first parameter, and is not evaluated.
  68     name = params[0]
  69     if name.type != \symbol
  70         runtime-error "expected a symbol for the first parameter
  71                        of def!, got a #{name.type}"
  72
  73     # Evaluate the second parameter and store
  74     # it under name in the env.
  75     env.set name.value, (eval_ast env, params[1])
  76
  77
  78 eval_let = (env, params) ->
  79     check_params 'let*', params, 2
  80
  81     binding_list = params[0]
  82     if binding_list.type not in [\list \vector]
  83         runtime-error "expected 1st parameter of 'let*' to
  84                        be a binding list (or vector),
  85                        got a #{binding_list.type}"
  86     else if binding_list.value.length % 2 != 0
  87         runtime-error "binding list of 'let*' must have an even
  88                        number of parameters"
  89
  90     # Make a new environment with the
  91     # current environment as outer.
  92     let_env = new Env env
  93
  94     # Evaluate all binding values in the
  95     # new environment.
  96     binding_list.value
  97     |> list-to-pairs
  98     |> each ([binding_name, binding_value]) ->
  99         if binding_name.type != \symbol
 100             runtime-error "expected a symbol as binding name,
 101                            got a #{binding_name.type}"
 102
 103         let_env.set binding_name.value, (eval_ast let_env, binding_value)
 104
 105     # Defer evaluation of let* body with TCO.
 106     defer-tco let_env, params[1]
 107
 108
 109 eval_do = (env, params) ->
 110     if params.length == 0
 111         runtime-error "'do' expected at least one parameter"
 112
 113     [...rest, last-param] = params
 114     rest |> each eval_ast env
 115     tco env, last-param
 116
 117
 118 eval_if = (env, params) ->
 119     if params.length < 2
 120         runtime-error "'if' expected at least 2 parameters"
 121     else if params.length > 3
 122         runtime-error "'if' expected at most 3 parameters"
 123
 124     cond = eval_ast env, params[0]
 125     if is-thruthy cond
 126         defer-tco env, params[1]
 127     else if params.length > 2
 128         defer-tco env, params[2]
 129     else
 130         {type: \const, value: \nil}
 131
 132
 133 eval_fn = (env, params) ->
 134     check_params 'fn*', params, 2
 135
 136     if params[0].type not in [\list \vector]
 137         runtime-error "'fn*' expected first parameter to be a list or vector."
 138
 139     if not all (.type == \symbol), params[0].value
 140         runtime-error "'fn*' expected only symbols in the parameters list."
 141
 142     binds = params[0].value |> map (.value)
 143     vargs = null
 144
 145     # Parse variadic bind.
 146     if binds.length >= 2
 147         [...rest, amper, name] = binds
 148         if amper == '&' and name != '&'
 149             binds = rest
 150             vargs = name
 151
 152     if elem-index '&', binds
 153         runtime-error "'fn*' invalid usage of variadic parameters."
 154
 155     if (unique binds).length != binds.length
 156         runtime-error "'fn*' duplicate symbols in parameters list."
 157
 158     body = params[1]
 159
 160     fn_instance = (...values) ->
 161         if not vargs and values.length != binds.length
 162             runtime-error "function expected #{binds.length} parameters,
 163                            got #{values.length}"
 164         else if vargs and values.length < binds.length
 165             runtime-error "function expected at least
 166                            #{binds.length} parameters,
 167                            got #{values.length}"
 168
 169         # Set binds to values in the new env.
 170         fn_env = new Env env
 171
 172         for [name, value] in (zip binds, values)
 173             fn_env.set name, value
 174
 175         if vargs
 176             fn_env.set vargs, do
 177                 type: \list
 178                 value: values.slice binds.length
 179
 180         # Defer evaluation of the function body to TCO.
 181         defer-tco fn_env, body
 182
 183     {type: \function, value: fn_instance}
 184
 185
 186 eval_apply = (env, list) ->
 187     [fn, ...args] = list |> map eval_ast env
 188     if fn.type != \function
 189         runtime-error "#{fn.value} is not a function, got a #{fn.type}"
 190
 191     fn.value.apply env, args
 192
 193
 194 repl_env = new Env
 195 for symbol, value of ns
 196     repl_env.set symbol, value
 197
 198
 199 rep = (line) ->
 200     line
 201     |> read_str
 202     |> eval_ast repl_env
 203     |> (ast) -> pr_str ast, print_readably=true
 204
 205
 206 # Define not.
 207 rep '(def! not (fn* (x) (if x false true)))'
 208
 209 loop
 210     line = readline.readline 'user> '
 211     break if not line? or line == ''
 212     try
 213         console.log rep line
 214     catch error
 215         if error.message
 216         then console.error error.message
 217         else console.error "Error:", pr_str error, print_readably=true