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 'pr-str': fn (...params) ->
101 params |
> map
(p
) -> pr_str p
, print_readably
=true
105 'str': fn (...params) ->
106 params |
> map
(p
) -> pr_str p
, print_readably
=false
110 'prn': fn (...params) ->
111 params |
> map
(p
) -> pr_str p
, print_readably
=true
116 'println': fn (...params) ->
117 params |
> map
(p
) -> pr_str p
, print_readbly
=false
122 'read-string': fn ({type, value}) ->
123 check
-type
'read-string', 0, \string, type
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
}"
131 const
-str
<| fs.readFileSync filename.value
, 'utf8'
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
139 'reset!': fn (atom, value) ->
140 check
-type
'reset!', 0, \atom, atom.type
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
}"
149 atom.value
= unpack
-tco
(fn.value.apply @
, [atom.value
] ++ args
)
151 'cons': fn (value, list) ->
152 check
-param
'cons', 1, (list-or-vector list),
153 'list or vector', list.type
155 {type
: \list
, value
: [value
] ++ list.value
}
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"
161 {type
: \list
, value
: params |
> map
(.value
) |
> concat
}
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,
169 if index.value
< 0 or index.value
>= list.value.length
170 runtime
-error
'list index out of bounds'
172 list.value
[index.value
]
174 'first': fn (list) ->
175 if list.type
== \const and list.value
== \nil
178 check
-param
'first', 0, (list-or-vector list),
179 'list or vector', list.type
181 if list.value.length
== 0
186 if list.type
== \const and list.value
== \nil
187 return
{type
: \list
, value
: []}
189 check
-param
'rest', 0, (list-or-vector list),
190 'list or vector', list.type
192 {type
: \list
, value
: list.value.slice
1}
194 'throw': fn (value) -> throw value
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
202 unpack
-tco fn.value.apply @
, params ++ list.value
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
209 mapped
-list
= list.value |
> map
(value
) ->
210 unpack
-tco fn.value.apply @
, [value
]
212 {type
: \list
, value
: mapped
-list
}
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
219 'symbol': fn (str) ->
220 check
-type
'symbol', 0, \string, str.type
221 {type
: \symbol
, value
: str.value
}
223 'keyword': fn (str) ->
224 check
-type
'keyword', 0, \string, str.type
225 {type
: \keyword
, value
: ':' + str.value}
227 'keyword?': fn (ast) -> const-bool ast.type == \keyword
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)
233 'vector': fn (...params) -> {type: \vector, value: params}
234 'vector?': fn (ast) -> const-bool ast.type == \vector
236 'hash-map': fn (...params) -> list-to-map params
238 'map?': fn (ast) -> const-bool ast.type == \map
240 'assoc': fn (m, ...params) ->
241 check
-type
'assoc', 0, \map, m.type
243 # Turn the params into a map
, this is kind of hacky.
244 params
-map
= list
-to
-map params
246 # Copy the map by cloning
(prototyping
).
249 for k
, v of params
-map.value
252 {type
: \map
, value
: new
-map
}
254 'dissoc': fn (m, ...keys) ->
255 check
-type
'dissoc', 0, \map, m.type
257 # Convert keyword to map key strings.
258 str
-keys
= keys |
> map map
-keyword
262 |
> reject
([key
, value
]) -> key in str
-keys
265 {type
: \map
, value
: new
-map
}
267 'get': fn (m, key) ->
268 if m.type
== \const and m.value
== \nil
269 then return const
-nil
!
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
!
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
)
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
}
290 check
-type
'vals', 0, \map, m.type
291 {type
: \list
, value
: values m.value
}
293 'sequential?': fn (ast) -> const-bool list-or-vector ast
295 'with-meta': fn (ast, m) ->
303 'readline': fn (prompt) ->
304 check
-type
'readline', 0, \string, prompt.type
305 result
= readline prompt.value
307 then const
-str result
311 const
-int
(new
Date).getTime
!
313 'conj': fn (list, ...params) ->
314 check
-param
'conj', 0, (list-or-vector list),
315 'list or vector', list.type
317 if list.type
== \list
319 value
: (reverse params
) ++ list.value
322 value
: list.value ++ params
324 'string?': fn (ast) -> const-bool ast.type == \string
334 then
{type
: \list
, value
: seq.value
}
338 then
{type
: \list
, value
: chars seq.value |
> map const
-str
}
341 if seq.type
== \const and seq.value
== \nil
343 else runtime
-error "unsupported type for
'seq': #{seq.type}"