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     'pr-str': fn (...params) ->
 101         params |> map (p) -> pr_str p, print_readably=true
 102                |> join ' '
 103                |> const-str
 104
 105     'str': fn (...params) ->
 106         params |> map (p) -> pr_str p, print_readably=false
 107                |> join ''
 108                |> const-str
 109
 110     'prn': fn (...params) ->
 111         params |> map (p) -> pr_str p, print_readably=true
 112                |> join ' '
 113                |> console.log
 114                |> const-nil
 115
 116     'println': fn (...params) ->
 117         params |> map (p) -> pr_str p, print_readbly=false
 118                |> join ' '
 119                |> console.log
 120                |> const-nil
 121
 122     'read-string': fn ({type, value}) ->
 123         check-type 'read-string', 0, \string, type
 124         read_str value
 125
 126     'slurp': fn (filename) ->
 127         if filename.type != \string
 128             runtime-error "'slurp' expected the first parameter
 129                            to be a string, got a #{filename.type}"
 130
 131         const-str <| fs.readFileSync filename.value, 'utf8'
 132
 133     'atom': fn (value) -> {type: \atom, value: value}
 134     'atom?': fn (atom) -> const-bool atom.type == \atom
 135     'deref': fn (atom) ->
 136         check-type 'deref', 0, \atom, atom.type
 137         atom.value
 138
 139     'reset!': fn (atom, value) ->
 140         check-type 'reset!', 0, \atom, atom.type
 141         atom.value = value
 142
 143     'swap!': fn (atom, fn, ...args) ->
 144         check-type 'swap!', 0, \atom, atom.type
 145         if fn.type != \function
 146             runtime-error "'swap!' expected the second parameter
 147                            to be a function, got a #{fn.type}"
 148
 149         atom.value = unpack-tco (fn.value.apply @, [atom.value] ++ args)
 150
 151     'cons': fn (value, list) ->
 152         check-param 'cons', 1, (list-or-vector list),
 153             'list or vector', list.type
 154
 155         {type: \list, value: [value] ++ list.value}
 156
 157     'concat': fn (...params) ->
 158         if not all list-or-vector, params
 159             runtime-error "'concat' expected all parameters to be a list or vector"
 160
 161         {type: \list, value: params |> map (.value) |> concat}
 162
 163     'nth': fn (list, index) ->
 164         check-param 'nth', 0, (list-or-vector list),
 165             'list or vector', list.type
 166         check-param 'nth', 1, index.type == \int,
 167             'int', index.type
 168
 169         if index.value < 0 or index.value >= list.value.length
 170             runtime-error 'list index out of bounds'
 171
 172         list.value[index.value]
 173
 174     'first': fn (list) ->
 175         if list.type == \const and list.value == \nil
 176             return const-nil!
 177
 178         check-param 'first', 0, (list-or-vector list),
 179             'list or vector', list.type
 180
 181         if list.value.length == 0
 182         then const-nil!
 183         else list.value[0]
 184
 185     'rest': fn (list) ->
 186         if list.type == \const and list.value == \nil
 187             return {type: \list, value: []}
 188
 189         check-param 'rest', 0, (list-or-vector list),
 190             'list or vector', list.type
 191
 192         {type: \list, value: list.value.slice 1}
 193
 194     'throw': fn (value) -> throw value
 195
 196     'apply': fn (fn, ...params, list) ->
 197         check-type 'apply', 0, \function, fn.type
 198         if not list then runtime-error "apply expected at least two parameters"
 199         check-param 'apply', params.length+1, (list-or-vector list),
 200             'list or vector', list.type
 201
 202         unpack-tco fn.value.apply @, params ++ list.value
 203
 204     'map': fn (fn, list) ->
 205         check-type 'map', 0, \function, fn.type
 206         check-param 'map', 1, (list-or-vector list),
 207             'list or vector', list.type
 208
 209         mapped-list = list.value |> map (value) ->
 210             unpack-tco fn.value.apply @, [value]
 211
 212         {type: \list, value: mapped-list}
 213
 214     'nil?': fn (ast) -> const-bool (ast.type == \const and ast.value == \nil)
 215     'true?': fn (ast) -> const-bool (ast.type == \const and ast.value == \true)
 216     'false?': fn (ast) -> const-bool (ast.type == \const and ast.value == \false)
 217     'symbol?': fn (ast) -> const-bool ast.type == \symbol
 218
 219     'symbol': fn (str) ->
 220         check-type 'symbol', 0, \string, str.type
 221         {type: \symbol, value: str.value}
 222
 223     'keyword': fn (str) ->
 224         check-type 'keyword', 0, \string, str.type
 225         {type: \keyword, value: ':' + str.value}
 226
 227     'keyword?': fn (ast) -> const-bool ast.type == \keyword
 228
 229     'number?': fn (ast) -> const-bool ast.type == \int
 230     'fn?': fn (ast) -> const-bool (ast.type == \function and not ast.is_macro)
 231     'macro?': fn (ast) -> const-bool (ast.type == \function and ast.is_macro)
 232
 233     'vector': fn (...params) -> {type: \vector, value: params}
 234     'vector?': fn (ast) -> const-bool ast.type == \vector
 235
 236     'hash-map': fn (...params) -> list-to-map params
 237
 238     'map?': fn (ast) -> const-bool ast.type == \map
 239
 240     'assoc': fn (m, ...params) ->
 241         check-type 'assoc', 0, \map, m.type
 242
 243         # Turn the params into a map, this is kind of hacky.
 244         params-map = list-to-map params
 245
 246         # Copy the map by cloning (prototyping).
 247         new-map = ^^m.value
 248
 249         for k, v of params-map.value
 250             new-map[k] = v
 251
 252         {type: \map, value: new-map}
 253
 254     'dissoc': fn (m, ...keys) ->
 255         check-type 'dissoc', 0, \map, m.type
 256
 257         # Convert keyword to map key strings.
 258         str-keys = keys |> map map-keyword
 259
 260         new-map = m.value
 261             |> obj-to-pairs
 262             |> reject ([key, value]) -> key in str-keys
 263             |> pairs-to-obj
 264
 265         {type: \map, value: new-map}
 266
 267     'get': fn (m, key) ->
 268         if m.type == \const and m.value == \nil
 269         then return const-nil!
 270
 271         check-type 'get', 0, \map, m.type
 272         str-key = map-keyword key
 273         value = m.value[str-key]
 274         if value then value else const-nil!
 275
 276     'contains?': fn (m, key) ->
 277         check-type 'contains?', 0, \map, m.type
 278         str-key = map-keyword key
 279         const-bool (str-key of m.value)
 280
 281     'keys': fn (m) ->
 282         check-type 'keys', 0, \map, m.type
 283         result = keys m.value |> map (key) ->
 284             if key.startsWith keyword-prefix
 285             then {type: \keyword, value: key.substring 1}
 286             else {type: \string, value: key}
 287         {type: \list, value: result}
 288
 289     'vals': fn (m) ->
 290         check-type 'vals', 0, \map, m.type
 291         {type: \list, value: values m.value}
 292
 293     'sequential?': fn (ast) -> const-bool list-or-vector ast
 294
 295     'with-meta': fn (ast, m) ->
 296         ast with {meta: m}
 297
 298     'meta': fn (ast) ->
 299         if ast.meta
 300         then ast.meta
 301         else const-nil!
 302
 303     'readline': fn (prompt) ->
 304         check-type 'readline', 0, \string, prompt.type
 305         result = readline prompt.value
 306         if result?
 307         then const-str result
 308         else const-nil!
 309
 310     'time-ms': fn ->
 311         const-int (new Date).getTime!
 312
 313     'conj': fn (list, ...params) ->
 314         check-param 'conj', 0, (list-or-vector list),
 315             'list or vector', list.type
 316
 317         if list.type == \list
 318             type: \list
 319             value: (reverse params) ++ list.value
 320         else
 321             type: \vector
 322             value: list.value ++ params
 323
 324     'string?': fn (ast) -> const-bool ast.type == \string
 325
 326     'seq': fn (seq) ->
 327         switch seq.type
 328         | \list =>
 329             if seq.value.length
 330             then seq
 331             else const-nil!
 332         | \vector =>
 333             if seq.value.length
 334             then {type: \list, value: seq.value}
 335             else const-nil!
 336         | \string =>
 337             if seq.value.length
 338             then {type: \list, value: chars seq.value |> map const-str}
 339             else const-nil!
 340         | otherwise =>
 341             if seq.type == \const and seq.value == \nil
 342             then const-nil!
 343             else runtime-error "unsupported type for 'seq': #{seq.type}"