livescript/core.ls

   1
   2 {
   3     zip, map, apply, and-list, join, Obj, concat, all,
   4     pairs-to-obj, obj-to-pairs, reject, keys, values,
   5     difference, empty, reverse, chars
   6 } = require 'prelude-ls'
   7 {pr_str} = require './printer'
   8 {read_str, list-to-map, map-keyword, keyword-prefix} = require './reader'
   9 fs = require 'fs'
  10 {readline} = require './node_readline'
  11
  12
  13 export runtime-error = (msg) -> throw new Error msg
  14
  15 export unpack-tco = (ast) ->
  16     if ast.type == \tco
  17     then ast.eval!
  18     else ast
  19
  20 fn = (body) -> {type: \function, value: body}
  21 const-nil = -> {type: \const, value: \nil}
  22 const-int = (int) -> {type: \int, value: int}
  23 const-bool = (bool) -> {type: \const, value: if bool then \true else \false}
  24 const-str = (str) -> {type: \string, value: str}
  25
  26 list-or-vector = ({type}) -> type in [\list \vector]
  27
  28 are-lists-equal = (equals-fn, a, b) ->
  29     if a.length != b.length then false
  30     else zip a, b |> map (apply equals-fn) |> and-list
  31
  32 deep-equals = (a, b) ->
  33     if (list-or-vector a) and (list-or-vector b) then
  34         are-lists-equal deep-equals, a.value, b.value
  35     else if a.type == \map and b.type == \map then
  36         a-keys = keys a.value
  37         b-keys = keys b.value
  38         if a-keys.length == b-keys.length and \
  39             empty (difference a-keys, b-keys)
  40             #if are-lists-equal (==), a-keys, b-keys
  41             a-keys |> map (key) -> [a.value[key], b.value[key]]
  42                    |> map (apply deep-equals)
  43                    |> and-list
  44         else false
  45     else if a.type != b.type then false
  46     else a.value == b.value
  47
  48
  49 check-param = (name, idx, test, expected, actual) ->
  50     if not test
  51         runtime-error "'#{name}' expected parameter #{idx}
  52                        to be #{expected}, got #{actual}"
  53
  54
  55 check-type = (name, idx, expected, actual) ->
  56     check-param name, idx, expected == actual, expected, actual
  57
  58
  59 export ns = do
  60     '+': fn (a, b) -> const-int a.value + b.value
  61     '-': fn (a, b) -> const-int a.value - b.value
  62     '*': fn (a, b) -> const-int a.value * b.value
  63     '/': fn (a, b) -> const-int parseInt (a.value / b.value)
  64
  65     'list': fn (...list) -> {type: \list, value: list}
  66     'list?': fn (param) -> const-bool param.type == \list
  67
  68     'empty?': fn ({type, value}) ->
  69         switch type
  70         | \const =>
  71             if value == \nil
  72             then const-bool true
  73             else runtime-error "'empty?' is not supported on #{value}"
  74         | \list, \vector =>
  75             const-bool value.length == 0
  76         | \map =>
  77             const-bool Obj.empty value
  78         | otherwise =>
  79             runtime-error "'empty?' is not supported on type #{type}"
  80
  81     'count': fn ({type, value}) ->
  82         switch type
  83         | \const =>
  84             if value == \nil
  85             then const-int 0
  86             else runtime-error "'count' is not supported on #{value}"
  87         | \list, \vector =>
  88             const-int value.length
  89         | \map =>
  90             value |> Obj.keys |> (.length) |> const-int
  91         | otherwise =>
  92             runtime-error "'count' is not supported on type #{type}"
  93
  94     '=': fn (a, b) -> const-bool (deep-equals a, b)
  95     '<': fn (a, b) -> const-bool a.value < b.value
  96     '>': fn (a, b) -> const-bool a.value > b.value
  97     '<=': fn (a, b) -> const-bool a.value <= b.value
  98     '>=': fn (a, b) -> const-bool a.value >= b.value
  99
 100     'not': fn ({type, value}) ->
 101         const-bool (type == \const and value in [\false \nil])
 102
 103     'pr-str': fn (...params) ->
 104         params |> map (p) -> pr_str p, print_readably=true
 105                |> join ' '
 106                |> const-str
 107
 108     'str': fn (...params) ->
 109         params |> map (p) -> pr_str p, print_readably=false
 110                |> join ''
 111                |> const-str
 112
 113     'prn': fn (...params) ->
 114         params |> map (p) -> pr_str p, print_readably=true
 115                |> join ' '
 116                |> console.log
 117                |> const-nil
 118
 119     'println': fn (...params) ->
 120         params |> map (p) -> pr_str p, print_readbly=false
 121                |> join ' '
 122                |> console.log
 123                |> const-nil
 124
 125     'read-string': fn ({type, value}) ->
 126         check-type 'read-string', 0, \string, type
 127         read_str value
 128
 129     'slurp': fn (filename) ->
 130         if filename.type != \string
 131             runtime-error "'slurp' expected the first parameter
 132                            to be a string, got a #{filename.type}"
 133
 134         const-str <| fs.readFileSync filename.value, 'utf8'
 135
 136     'atom': fn (value) -> {type: \atom, value: value}
 137     'atom?': fn (atom) -> const-bool atom.type == \atom
 138     'deref': fn (atom) ->
 139         check-type 'deref', 0, \atom, atom.type
 140         atom.value
 141
 142     'reset!': fn (atom, value) ->
 143         check-type 'reset!', 0, \atom, atom.type
 144         atom.value = value
 145
 146     'swap!': fn (atom, fn, ...args) ->
 147         check-type 'swap!', 0, \atom, atom.type
 148         if fn.type != \function
 149             runtime-error "'swap!' expected the second parameter
 150                            to be a function, got a #{fn.type}"
 151
 152         atom.value = unpack-tco (fn.value.apply @, [atom.value] ++ args)
 153
 154     'cons': fn (value, list) ->
 155         check-param 'cons', 1, (list-or-vector list),
 156             'list or vector', list.type
 157
 158         {type: \list, value: [value] ++ list.value}
 159
 160     'concat': fn (...params) ->
 161         if not all list-or-vector, params
 162             runtime-error "'concat' expected all parameters to be a list or vector"
 163
 164         {type: \list, value: params |> map (.value) |> concat}
 165
 166     'nth': fn (list, index) ->
 167         check-param 'nth', 0, (list-or-vector list),
 168             'list or vector', list.type
 169         check-param 'nth', 1, index.type == \int,
 170             'int', index.type
 171
 172         if index.value < 0 or index.value >= list.value.length
 173             runtime-error 'list index out of bounds'
 174
 175         list.value[index.value]
 176
 177     'first': fn (list) ->
 178         if list.type == \const and list.value == \nil
 179             return const-nil!
 180
 181         check-param 'first', 0, (list-or-vector list),
 182             'list or vector', list.type
 183
 184         if list.value.length == 0
 185         then const-nil!
 186         else list.value[0]
 187
 188     'rest': fn (list) ->
 189         if list.type == \const and list.value == \nil
 190             return {type: \list, value: []}
 191
 192         check-param 'rest', 0, (list-or-vector list),
 193             'list or vector', list.type
 194
 195         {type: \list, value: list.value.slice 1}
 196
 197     'throw': fn (value) -> throw value
 198
 199     'apply': fn (fn, ...params, list) ->
 200         check-type 'apply', 0, \function, fn.type
 201         if not list then runtime-error "apply expected at least two parameters"
 202         check-param 'apply', params.length+1, (list-or-vector list),
 203             'list or vector', list.type
 204
 205         unpack-tco fn.value.apply @, params ++ list.value
 206
 207     'map': fn (fn, list) ->
 208         check-type 'map', 0, \function, fn.type
 209         check-param 'map', 1, (list-or-vector list),
 210             'list or vector', list.type
 211
 212         mapped-list = list.value |> map (value) ->
 213             unpack-tco fn.value.apply @, [value]
 214
 215         {type: \list, value: mapped-list}
 216
 217     'nil?': fn (ast) -> const-bool (ast.type == \const and ast.value == \nil)
 218     'true?': fn (ast) -> const-bool (ast.type == \const and ast.value == \true)
 219     'false?': fn (ast) -> const-bool (ast.type == \const and ast.value == \false)
 220     'symbol?': fn (ast) -> const-bool ast.type == \symbol
 221
 222     'symbol': fn (str) ->
 223         check-type 'symbol', 0, \string, str.type
 224         {type: \symbol, value: str.value}
 225
 226     'keyword': fn (str) ->
 227         check-type 'keyword', 0, \string, str.type
 228         {type: \keyword, value: ':' + str.value}
 229
 230     'keyword?': fn (ast) -> const-bool ast.type == \keyword
 231
 232     'vector': fn (...params) -> {type: \vector, value: params}
 233     'vector?': fn (ast) -> const-bool ast.type == \vector
 234
 235     'hash-map': fn (...params) -> list-to-map params
 236
 237     'map?': fn (ast) -> const-bool ast.type == \map
 238
 239     'assoc': fn (m, ...params) ->
 240         check-type 'assoc', 0, \map, m.type
 241
 242         # Turn the params into a map, this is kind of hacky.
 243         params-map = list-to-map params
 244
 245         # Copy the map by cloning (prototyping).
 246         new-map = ^^m.value
 247
 248         for k, v of params-map.value
 249             new-map[k] = v
 250
 251         {type: \map, value: new-map}
 252
 253     'dissoc': fn (m, ...keys) ->
 254         check-type 'dissoc', 0, \map, m.type
 255
 256         # Convert keyword to map key strings.
 257         str-keys = keys |> map map-keyword
 258
 259         new-map = m.value
 260             |> obj-to-pairs
 261             |> reject ([key, value]) -> key in str-keys
 262             |> pairs-to-obj
 263
 264         {type: \map, value: new-map}
 265
 266     'get': fn (m, key) ->
 267         if m.type == \const and m.value == \nil
 268         then return const-nil!
 269
 270         check-type 'get', 0, \map, m.type
 271         str-key = map-keyword key
 272         value = m.value[str-key]
 273         if value then value else const-nil!
 274
 275     'contains?': fn (m, key) ->
 276         check-type 'contains?', 0, \map, m.type
 277         str-key = map-keyword key
 278         const-bool (str-key of m.value)
 279
 280     'keys': fn (m) ->
 281         check-type 'keys', 0, \map, m.type
 282         result = keys m.value |> map (key) ->
 283             if key.startsWith keyword-prefix
 284             then {type: \keyword, value: key.substring 1}
 285             else {type: \string, value: key}
 286         {type: \list, value: result}
 287
 288     'vals': fn (m) ->
 289         check-type 'vals', 0, \map, m.type
 290         {type: \list, value: values m.value}
 291
 292     'sequential?': fn (ast) -> const-bool list-or-vector ast
 293
 294     'with-meta': fn (ast, m) ->
 295         ast with {meta: m}
 296
 297     'meta': fn (ast) ->
 298         if ast.meta
 299         then ast.meta
 300         else const-nil!
 301
 302     'readline': fn (prompt) ->
 303         check-type 'readline', 0, \string, prompt.type
 304         result = readline prompt.value
 305         if result?
 306         then const-str result
 307         else const-nil!
 308
 309     'time-ms': fn ->
 310         const-int (new Date).getTime!
 311
 312     'conj': fn (list, ...params) ->
 313         check-param 'conj', 0, (list-or-vector list),
 314             'list or vector', list.type
 315
 316         if list.type == \list
 317             type: \list
 318             value: (reverse params) ++ list.value
 319         else
 320             type: \vector
 321             value: list.value ++ params
 322
 323     'string?': fn (ast) -> const-bool ast.type == \string
 324
 325     'seq': fn (seq) ->
 326         switch seq.type
 327         | \list =>
 328             if seq.value.length
 329             then seq
 330             else const-nil!
 331         | \vector =>
 332             if seq.value.length
 333             then {type: \list, value: seq.value}
 334             else const-nil!
 335         | \string =>
 336             if seq.value.length
 337             then {type: \list, value: chars seq.value |> map const-str}
 338             else const-nil!
 339         | otherwise =>
 340             if seq.type == \const and seq.value == \nil
 341             then const-nil!
 342             else runtime-error "unsupported type for 'seq': #{seq.type}"