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'
10 {readline
} = require
'./node_readline'
13 export runtime
-error
= (msg
) -> throw new
Error msg
15 export unpack
-tco
= (ast
) ->
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
}
26 list
-or
-vector
= ({type
}) -> type in
[\list \vector
]
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
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
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
)
45 else if a.type
!= b.type then false
46 else a.value
== b.value
49 check
-param
= (name
, idx
, test
, expected
, actual
) ->
51 runtime
-error "
'#{name}' expected parameter #{idx}
52 to be #
{expected
}, got #
{actual
}"
55 check
-type
= (name
, idx
, expected
, actual
) ->
56 check
-param name
, idx
, expected
== actual
, expected
, actual
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)
65 'list': fn (...list) -> {type: \list, value: list}
66 'list?': fn (param) -> const-bool param.type == \list
68 'empty?': fn ({type, value}) ->
73 else runtime
-error "
'empty?' is not supported on #{value}"
75 const
-bool value.length
== 0
77 const
-bool Obj.empty value
79 runtime
-error "
'empty?' is not supported on type #{type}"
81 'count': fn ({type, value}) ->
86 else runtime
-error "
'count' is not supported on #{value}"
88 const
-int value.length
90 value |
> Obj.keys |
> (.length
) |
> const
-int
92 runtime
-error "
'count' is not supported on type #{type}"
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
100 'not': fn ({type, value}) ->
101 const
-bool
(type
== \const and value in
[\false \nil
])
103 'pr-str': fn (...params) ->
104 params |
> map
(p
) -> pr_str p
, print_readably
=true
108 'str': fn (...params) ->
109 params |
> map
(p
) -> pr_str p
, print_readably
=false
113 'prn': fn (...params) ->
114 params |
> map
(p
) -> pr_str p
, print_readably
=true
119 'println': fn (...params) ->
120 params |
> map
(p
) -> pr_str p
, print_readbly
=false
125 'read-string': fn ({type, value}) ->
126 check
-type
'read-string', 0, \string, type
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
}"
134 const
-str
<| fs.readFileSync filename.value
, 'utf8'
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
142 'reset!': fn (atom, value) ->
143 check
-type
'reset!', 0, \atom, atom.type
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
}"
152 atom.value
= unpack
-tco
(fn.value.apply @
, [atom.value
] ++ args
)
154 'cons': fn (value, list) ->
155 check
-param
'cons', 1, (list-or-vector list),
156 'list or vector', list.type
158 {type
: \list
, value
: [value
] ++ list.value
}
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"
164 {type
: \list
, value
: params |
> map
(.value
) |
> concat
}
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,
172 if index.value
< 0 or index.value
>= list.value.length
173 runtime
-error
'list index out of bounds'
175 list.value
[index.value
]
177 'first': fn (list) ->
178 if list.type
== \const and list.value
== \nil
181 check
-param
'first', 0, (list-or-vector list),
182 'list or vector', list.type
184 if list.value.length
== 0
189 if list.type
== \const and list.value
== \nil
190 return
{type
: \list
, value
: []}
192 check
-param
'rest', 0, (list-or-vector list),
193 'list or vector', list.type
195 {type
: \list
, value
: list.value.slice
1}
197 'throw': fn (value) -> throw value
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
205 unpack
-tco fn.value.apply @
, params ++ list.value
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
212 mapped
-list
= list.value |
> map
(value
) ->
213 unpack
-tco fn.value.apply @
, [value
]
215 {type
: \list
, value
: mapped
-list
}
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
222 'symbol': fn (str) ->
223 check
-type
'symbol', 0, \string, str.type
224 {type
: \symbol
, value
: str.value
}
226 'keyword': fn (str) ->
227 check
-type
'keyword', 0, \string, str.type
228 {type
: \keyword
, value
: ':' + str.value}
230 'keyword?': fn (ast) -> const-bool ast.type == \keyword
232 'number?': fn (ast) -> const-bool ast.type == \int
233 'fn?': fn (ast) -> const-bool (ast.type == \function and not ast.is_macro)
234 'macro?': fn (ast) -> const-bool (ast.type == \function and ast.is_macro)
236 'vector': fn (...params) -> {type: \vector, value: params}
237 'vector?': fn (ast) -> const-bool ast.type == \vector
239 'hash-map': fn (...params) -> list-to-map params
241 'map?': fn (ast) -> const-bool ast.type == \map
243 'assoc': fn (m, ...params) ->
244 check
-type
'assoc', 0, \map, m.type
246 # Turn the params into a map
, this is kind of hacky.
247 params
-map
= list
-to
-map params
249 # Copy the map by cloning
(prototyping
).
252 for k
, v of params
-map.value
255 {type
: \map
, value
: new
-map
}
257 'dissoc': fn (m, ...keys) ->
258 check
-type
'dissoc', 0, \map, m.type
260 # Convert keyword to map key strings.
261 str
-keys
= keys |
> map map
-keyword
265 |
> reject
([key
, value
]) -> key in str
-keys
268 {type
: \map
, value
: new
-map
}
270 'get': fn (m, key) ->
271 if m.type
== \const and m.value
== \nil
272 then return const
-nil
!
274 check
-type
'get', 0, \map, m.type
275 str
-key
= map
-keyword key
276 value
= m.value
[str
-key
]
277 if value then value else const
-nil
!
279 'contains?': fn (m, key) ->
280 check
-type
'contains?', 0, \map, m.type
281 str
-key
= map
-keyword key
282 const
-bool
(str
-key of m.value
)
285 check
-type
'keys', 0, \map, m.type
286 result
= keys m.value |
> map
(key
) ->
287 if key.startsWith keyword
-prefix
288 then
{type
: \keyword
, value
: key.substring
1}
289 else
{type
: \string
, value
: key
}
290 {type
: \list
, value
: result
}
293 check
-type
'vals', 0, \map, m.type
294 {type
: \list
, value
: values m.value
}
296 'sequential?': fn (ast) -> const-bool list-or-vector ast
298 'with-meta': fn (ast, m) ->
306 'readline': fn (prompt) ->
307 check
-type
'readline', 0, \string, prompt.type
308 result
= readline prompt.value
310 then const
-str result
314 const
-int
(new
Date).getTime
!
316 'conj': fn (list, ...params) ->
317 check
-param
'conj', 0, (list-or-vector list),
318 'list or vector', list.type
320 if list.type
== \list
322 value
: (reverse params
) ++ list.value
325 value
: list.value ++ params
327 'string?': fn (ast) -> const-bool ast.type == \string
337 then
{type
: \list
, value
: seq.value
}
341 then
{type
: \list
, value
: chars seq.value |
> map const
-str
}
344 if seq.type
== \const and seq.value
== \nil
346 else runtime
-error "unsupported type for
'seq': #{seq.type}"