7 new_value_index: procedure expose values
. /* new_value_index() */
8 values
.0 = values
.0 + 1
11 obj_type: procedure /* obj_type(obj) */
15 obj_val: procedure expose values
. /* obj_val(obj) */
20 when type
== "numb" | type
== "nill" | type
== "true" | type
== "fals" then return val
25 obj_meta: procedure expose values
. /* obj_meta(obj) */
28 if type
== "numb" | type
== "nill" | type
== "true" | type
== "fals" then return ""
30 return values
.meta
.ind
32 obj_clone_and_set_meta: procedure expose values
. /* obj_clone_and_set_meta(obj, new_meta) */
36 if type
== "numb" | type
== "nill" | type
== "true" | type
== "fals" then return ""
37 orig_ind
= substr(obj
, 6)
38 new_idx
= new_value_index
()
39 values
.new_idx
= values
.orig_ind
40 values
.meta
.new_idx
= new_meta
41 return type
|| "_" || new_idx
43 new_number: procedure /* new_number(n) */
47 number?
: procedure /* number?(obj) */
48 return obj_type
(arg(1)) == "numb"
50 new_nil: procedure /* new_nil() */
53 nil?
: procedure /* nil?(obj) */
54 return obj_type
(arg(1)) == "nill"
56 new_true: procedure /* new_true() */
59 true?
: procedure /* true?(obj) */
60 return obj_type
(arg(1)) == "true"
62 new_false: procedure /* new_false() */
65 false?
: procedure /* false?(obj) */
66 return obj_type
(arg(1)) == "fals"
68 new_boolean: procedure /* new_boolean(cond) */
74 new_symbol: procedure expose values
. /* new_symbol(str) */
76 idx
= new_value_index
()
80 symbol?
: procedure /* symbol?(obj) */
81 return obj_type
(arg(1)) == "symb"
83 new_string: procedure expose values
. /* new_string(str) */
85 idx
= new_value_index
()
89 string?
: procedure /* string?(obj) */
90 return obj_type
(arg(1)) == "stri"
92 new_keyword: procedure expose values
. /* new_keyword(str) */
94 idx
= new_value_index
()
98 keyword?
: procedure /* keyword?(obj) */
99 return obj_type
(arg(1)) == "keyw"
101 new_seq: procedure expose values
. /* new_seq(type, seq) */
104 idx
= new_value_index
()
106 return type
|| "_" || idx
108 new_list: procedure expose values
. /* new_list(seq) */
110 return new_seq
("list", seq
)
112 list?
: procedure /* list?(obj) */
113 return obj_type
(arg(1)) == "list"
115 new_vector: procedure expose values
. /* new_vector(seq) */
117 return new_seq
("vect", seq
)
119 vector?
: procedure /* vector?(obj) */
120 return obj_type
(arg(1)) == "vect"
122 sequential?
: procedure /* sequential?(obj) */
123 return (list?
(arg(1)) | vector?
(arg(1)))
125 count_elements: procedure expose values
. /* count_elements(lst) */
126 return words(obj_val
(arg(1)))
128 new_hashmap: procedure expose values
. /* new_hashmap(seq) */
130 return new_seq
("hash", seq
)
132 hashmap?
: procedure /* hashmap?(obj) */
133 return obj_type
(arg(1)) == "hash"
135 contains?
: procedure expose values
. /* contains?(hm_val, key) */
138 do i
=1 to words(hm_val
) by 2
139 if equal?
(key
, word(hm_val
, i
)) then return 1
143 hashmap_get: procedure expose values
. /* hashmap_get(hm_val, key) */
146 do i
=1 to words(hm_val
) by 2
147 if equal?
(key
, word(hm_val
, i
)) then return word(hm_val
, i
+ 1)
151 new_nativefn: procedure expose values
. /* new_hashmap(native_func_name) */
152 native_func_name
= arg(1)
153 idx
= new_value_index
()
154 values
.idx
= native_func_name
155 return "nafn_" || idx
157 nativefn?
: procedure /* nativefn?(obj) */
158 return obj_type
(arg(1)) == "nafn"
160 new_func: procedure expose values
. /* new_func(body_ast, env_idx, binds) */
165 idx
= new_value_index
()
166 values
.idx
= body_ast env_idx binds is_macro
167 return "func_" || idx
169 func?
: procedure /* func?(obj) */
170 return obj_type
(arg(1)) == "func"
172 func_macro?
: procedure expose values
. /* func_macro?(obj) */
173 return func?
(arg(1)) & (func_is_macro
(arg(1)) == 1)
175 func_body_ast: procedure expose values
. /* func_body_ast(func_obj) */
176 return word(obj_val
(arg(1)), 1)
178 func_env_idx: procedure expose values
. /* func_env_idx(func_obj) */
179 return word(obj_val
(arg(1)), 2)
181 func_binds: procedure expose values
. /* func_binds(func_obj) */
182 return word(obj_val
(arg(1)), 3)
184 func_is_macro: procedure expose values
. /* func_is_macro(func_obj) */
185 return word(obj_val
(arg(1)), 4)
187 func_mark_as_macro: procedure expose values
. /* func_mark_as_macro(func_obj) */
188 idx
= substr(arg(1), 6)
189 values
.idx
= subword(values
.idx
, 1, 3) 1
192 new_atom: procedure expose values
. /* new_atom(obj) */
194 idx
= new_value_index
()
196 return "atom_" || idx
198 atom?
: procedure /* atom?(obj) */
199 return obj_type
(arg(1)) == "atom"
201 atom_set: procedure expose values
. /* atom_set(atom, new_value) */
204 idx
= substr(atom
, 6)
205 values
.idx
= new_value
208 equal_hashmap?
: procedure expose values
. /* equal_hashmap?(a, b) */
209 hma_val
= obj_val
(arg(1))
210 hmb_val
= obj_val
(arg(2))
211 if words(hma_val
) \
= words(hmb_val
) then return 0
212 do i
=1 to words(hma_val
) by 2
213 a_key
= word(hma_val
, i
)
214 a_val
= word(hma_val
, i
+ 1)
215 b_val
= hashmap_get
(hmb_val
, a_key
)
216 if b_val
== "" then return 0
217 if \equal?
(a_val
, b_val
) then return 0
221 equal_sequential?
: procedure expose values
. /* equal_sequential?(a, b) */
222 a_val
= obj_val
(arg(1))
223 b_val
= obj_val
(arg(2))
224 if words(a_val
) \
= words(b_val
) then return 0
225 do i
=1 to words(a_val
)
226 if \equal?
(word(a_val
, i
), word(b_val
, i
)) then return 0
230 equal?
: procedure expose values
. /* equal?(a, b) */
238 when nil?
(a
) then return nil?
(b
)
239 when true?
(a
) then return true?
(b
)
240 when false?
(a
) then return false?
(b
)
241 when (a_type
== "numb" & b_type
= "numb") | ,
242 (a_type
== "symb" & b_type
= "symb") | ,
243 (a_type
== "stri" & b_type
= "stri") | ,
244 (a_type
== "keyw" & b_type
= "keyw") then return (obj_val
(a
) == obj_val
(b
))
245 when (sequential?
(a
) & sequential?
(b
)) then return equal_sequential?
(a
, b
)
246 when (hashmap?
(a
) & hashmap?
(b
)) then return equal_hashmap?
(a
, b
)