| 1 | {zip, map, apply, and-list, join} = require 'prelude-ls' |
| 2 | {pr_str} = require './printer' |
| 3 | |
| 4 | |
| 5 | export runtime-error = (msg) -> throw new Error msg |
| 6 | |
| 7 | |
| 8 | fn = (body) -> {type: \function, value: body} |
| 9 | const-nil = {type: \const, value: \nil} |
| 10 | const-int = (int) -> {type: \int, value: int} |
| 11 | const-bool = (bool) -> {type: \const, value: if bool then \true else \false} |
| 12 | const-str = (str) -> {type: \string, value: str} |
| 13 | |
| 14 | list-or-vector = ({type}) -> type in [\list \vector] |
| 15 | |
| 16 | deep-equals = (a, b) -> |
| 17 | if not list-or-vector a then |
| 18 | if a.type != b.type then false |
| 19 | else a.value == b.value |
| 20 | else if list-or-vector b then |
| 21 | if a.value.length != b.value.length then false |
| 22 | else |
| 23 | # Compare all elements of a and b with deep-equals. |
| 24 | zip a.value, b.value |
| 25 | |> map (apply deep-equals) |
| 26 | |> and-list # all must be true (equals) |
| 27 | else false |
| 28 | |
| 29 | |
| 30 | export ns = do |
| 31 | '+': fn (a, b) -> const-int a.value + b.value |
| 32 | '-': fn (a, b) -> const-int a.value - b.value |
| 33 | '*': fn (a, b) -> const-int a.value * b.value |
| 34 | '/': fn (a, b) -> const-int parseInt (a.value / b.value) |
| 35 | |
| 36 | 'list': fn (...list) -> {type: \list, value: list} |
| 37 | 'list?': fn (param) -> const-bool param.type == \list |
| 38 | |
| 39 | 'empty?': fn (param) -> |
| 40 | if not list-or-vector param |
| 41 | runtime-error "'empty?' expected first parameter |
| 42 | to be of type list or vector, |
| 43 | got a #{param.type}." |
| 44 | |
| 45 | const-bool param.value.length == 0 |
| 46 | |
| 47 | 'count': fn (param) -> |
| 48 | if not list-or-vector param |
| 49 | runtime-error "'count' expected first parameter |
| 50 | to be of type list or vector, |
| 51 | got a #{param.type}." |
| 52 | |
| 53 | const-int param.value.length |
| 54 | |
| 55 | 'prn': fn (param) -> |
| 56 | if param |
| 57 | console.log pr_str param |
| 58 | |
| 59 | const-nil |
| 60 | |
| 61 | '=': fn (a, b) -> const-bool (deep-equals a, b) |
| 62 | '<': fn (a, b) -> const-bool a.value < b.value |
| 63 | '>': fn (a, b) -> const-bool a.value > b.value |
| 64 | '<=': fn (a, b) -> const-bool a.value <= b.value |
| 65 | '>=': fn (a, b) -> const-bool a.value >= b.value |
| 66 | |
| 67 | 'not': fn (a) -> const-bool (a.type == \const and a.value == \false) |
| 68 | |
| 69 | 'str': fn (...params) -> const-str (params |> map pr_str |> join '') |