Files
hak/t/cons-01.hak
hyung-hwan 46dd217591 added the catchsig callback to vm for system-catch-sig and implementation of process handling
various bug fixes in dealing with multiple instances - still more to fix
more methods to dictionary access
files to access cons cell to the core module
2026-08-29 14:40:35 +09:00

80 lines
2.5 KiB
Plaintext

## core.car / core.cdr / core.cons
##
## A data list #(1 2 3) is a chain of Cons cells whose head and tail live in
## named instance variables, so basicAt and primAt cannot reach them. These
## three are what let the class library walk and build a list.
fun chk(ok msg) {
if ok { printf "OK: %s\n" msg } \
else { printf "ERROR: %s\n" msg }
}
l := #(1 2 3)
chk (eqv? (core.classOf l) Cons) "a data list is a chain of Cons cells"
chk (= (core.car l) 1) "car answers the head"
chk (eqv? (core.classOf (core.cdr l)) Cons) "cdr answers the tail"
chk (= (core.car (core.cdr l)) 2) "cadr reaches the second element"
chk (nil? (core.cdr (core.cdr (core.cdr l)))) "the tail of the last cell is nil"
## walking
n := 0
sum := 0
p := l
while (not (nil? p)) {
n := (+ n 1)
sum := (+ sum (core.car p))
p := (core.cdr p)
}
chk (= n 3) "a list can be walked to its end"
chk (= sum 6) "and every element visited"
## building
b := (core.cons 1 (core.cons 2 (core.cons 3 nil)))
chk (eqv? (core.classOf b) Cons) "cons builds a cell"
chk (= (core.car b) 1) "the built list starts where it should"
chk (= (core.car (core.cdr (core.cdr b))) 3) "and ends where it should"
chk (nil? (core.cdr (core.cdr (core.cdr b)))) "and is properly terminated"
## an improper list is allowed - the tail need not be a list
i := (core.cons 1 2)
chk (= (core.cdr i) 2) "cons accepts a non-list tail"
## select over a list, species preserved, built with cons alone
fun l-reverse(l) {
| p out |
out := nil
p := l
while (not (nil? p)) {
out := (core.cons (core.car p) out)
p := (core.cdr p)
}
return out
}
fun l-select(l blk) {
| p out x |
out := nil
p := l
while (not (nil? p)) {
x := (core.car p)
if (blk x) { out := (core.cons x out) }
p := (core.cdr p)
}
return (l-reverse out)
}
v := #(1 2 3 4 5 6)
r := (l-select v (fun(x) { return (= 0 (rem x 2)) }))
chk (eqv? (core.classOf r) Cons) "select over a list answers a list"
chk (= (core.car r) 2) "with the right first element"
chk (= (core.car (core.cdr r)) 4) "and the right second"
chk (= (core.car (core.cdr (core.cdr r))) 6) "and the right third"
chk (nil? (core.cdr (core.cdr (core.cdr r)))) "and nothing more"
chk (= (core.car v) 1) "the original list is untouched"
## the type gate
bad := 0
try { core.car nil } catch (e) { bad := (+ bad 1) }
try { core.cdr nil } catch (e) { bad := (+ bad 1) }
try { core.car #[1 2] } catch (e) { bad := (+ bad 1) }
try { core.cdr "s" } catch (e) { bad := (+ bad 1) }
chk (= bad 4) "car and cdr refuse anything that is not a cons"