2024-04-10 20:21:15 -04:00
|
|
|
<> (-- ?x) ()
|
|
|
|
-- ( little endian binary integers )
|
|
|
|
|
|
|
|
-- ( constants )
|
2024-04-12 12:53:40 -04:00
|
|
|
<> zero ((0 ()))
|
|
|
|
<> one ((1 ()))
|
|
|
|
<> ten ((0 (1 (0 (1 ())))))
|
2024-04-10 20:21:15 -04:00
|
|
|
|
|
|
|
-- ( decimal digit to binary )
|
2024-04-12 12:53:40 -04:00
|
|
|
<> (binary 0) ((0 ()))
|
|
|
|
<> (binary 1) ((1 ()))
|
|
|
|
<> (binary 2) ((0 (1 ())))
|
|
|
|
<> (binary 3) ((1 (1 ())))
|
|
|
|
<> (binary 4) ((0 (0 (1 ()))))
|
|
|
|
<> (binary 5) ((1 (0 (1 ()))))
|
|
|
|
<> (binary 6) ((0 (1 (1 ()))))
|
|
|
|
<> (binary 7) ((1 (1 (1 ()))))
|
|
|
|
<> (binary 8) ((0 (0 (0 (1 ())))))
|
|
|
|
<> (binary 9) ((1 (0 (0 (1 ())))))
|
2024-04-10 20:21:15 -04:00
|
|
|
|
|
|
|
-- ( binary to decimal digit )
|
2024-04-12 12:53:40 -04:00
|
|
|
<> ((decimal (0 ()))) (0)
|
|
|
|
<> ((decimal (1 ()))) (1)
|
|
|
|
<> ((decimal (0 (1 ())))) (2)
|
|
|
|
<> ((decimal (1 (1 ())))) (3)
|
|
|
|
<> ((decimal (0 (0 (1 ()))))) (4)
|
|
|
|
<> ((decimal (1 (0 (1 ()))))) (5)
|
|
|
|
<> ((decimal (0 (1 (1 ()))))) (6)
|
|
|
|
<> ((decimal (1 (1 (1 ()))))) (7)
|
|
|
|
<> ((decimal (0 (0 (0 (1 ())))))) (8)
|
|
|
|
<> ((decimal (1 (0 (0 (1 ())))))) (9)
|
|
|
|
|
|
|
|
-- reverse ()-terminated list
|
|
|
|
<> (reverse ?x) (reverse' () ?x)
|
|
|
|
<> (reverse' ?a ()) (?a)
|
2024-04-10 20:21:15 -04:00
|
|
|
<> (reverse' ?a (?h ?t)) (reverse' (?h ?a) ?t)
|
|
|
|
|
|
|
|
-- ( normalize, remove trailing zeros )
|
2024-04-12 12:53:40 -04:00
|
|
|
-- ( currently zero is (0 ()) though arguably it could be () )
|
2024-04-10 20:21:15 -04:00
|
|
|
-- ( that change would require auditing our rules )
|
2024-04-12 12:53:40 -04:00
|
|
|
<> (normalize (?h ?t)) ((?h normalize' () ?t))
|
|
|
|
<> (normalize' ?s ()) (())
|
2024-04-10 20:21:15 -04:00
|
|
|
<> (normalize' ?s (0 ?t)) (normalize' (0 ?s) ?t)
|
2024-04-12 12:53:40 -04:00
|
|
|
<> (normalize' () (1 ?t)) ((1 normalize' () ?t))
|
2024-04-10 20:21:15 -04:00
|
|
|
<> (normalize' (0 ?s) (1 ?t)) ((0 normalize' ?s (1 ?t)))
|
|
|
|
|
|
|
|
-- ( to integer )
|
2024-04-12 12:53:40 -04:00
|
|
|
<> ((int ?*)) ((sum f (one) g reverse (?*)))
|
|
|
|
<> (g ()) (())
|
2024-04-10 20:21:15 -04:00
|
|
|
<> (g (?h ?t)) ((binary ?h g ?t))
|
2024-04-12 12:53:40 -04:00
|
|
|
<> (f (?u) ()) (())
|
2024-04-10 22:14:47 -04:00
|
|
|
<> (f (?u) (?h ?t)) (((mul ?h ?u) f ((mul ?u ten)) ?t))
|
2024-04-10 20:21:15 -04:00
|
|
|
|
2024-04-11 19:03:25 -04:00
|
|
|
-- ( to binary str )
|
2024-04-12 12:53:40 -04:00
|
|
|
<> ((bstr ?x)) (emit force (0 (b ?x)))
|
2024-04-11 19:03:25 -04:00
|
|
|
|
2024-04-10 20:21:15 -04:00
|
|
|
-- ( to string: TODO, need division for this one )
|
2024-04-12 12:53:40 -04:00
|
|
|
<> ((str ?x)) ((str1 ?x ()))
|
|
|
|
<> ((str1 (0 ()) ?a)) (emit force ?a)
|
|
|
|
<> ((str1 (?h ?t) ?a)) ((str2 (divmod (?h ?t) ten) ?a))
|
|
|
|
<> ((str2 (?q ?r) ?a)) ((str1 ?q ((decimal ?r) ?a)))
|
|
|
|
|
|
|
|
-- ( force a list to evaluate to digits/letters )
|
|
|
|
<> ((?h force/r ?t)) (force/r (?h ?t))
|
|
|
|
<> (force ()) (force/r ())
|
|
|
|
<> (force (0 ?t)) ((0 force ?t))
|
|
|
|
<> (force (1 ?t)) ((1 force ?t))
|
|
|
|
<> (force (2 ?t)) ((2 force ?t))
|
|
|
|
<> (force (3 ?t)) ((3 force ?t))
|
|
|
|
<> (force (4 ?t)) ((4 force ?t))
|
|
|
|
<> (force (5 ?t)) ((5 force ?t))
|
|
|
|
<> (force (6 ?t)) ((6 force ?t))
|
|
|
|
<> (force (7 ?t)) ((7 force ?t))
|
|
|
|
<> (force (8 ?t)) ((8 force ?t))
|
|
|
|
<> (force (9 ?t)) ((9 force ?t))
|
|
|
|
<> (force (a ?t)) ((a force ?t))
|
|
|
|
<> (force (b ?t)) ((b force ?t))
|
|
|
|
<> (force (c ?t)) ((c force ?t))
|
|
|
|
<> (force (d ?t)) ((d force ?t))
|
|
|
|
<> (force (e ?t)) ((e force ?t))
|
|
|
|
<> (force (f ?t)) ((f force ?t))
|
|
|
|
<> (force (x ?t)) ((x force ?t))
|
|
|
|
|
|
|
|
-- ( emit )
|
|
|
|
<> (emit force/r ?*) (?*)
|
2024-04-11 18:38:49 -04:00
|
|
|
|
2024-04-10 20:21:15 -04:00
|
|
|
-- ( comparison operartions )
|
2024-04-10 22:14:47 -04:00
|
|
|
<> ((cmp ?x ?y)) ((cmpc #eq ?x ?y))
|
2024-04-12 12:53:40 -04:00
|
|
|
<> ((cmpc ?e () ())) (?e)
|
|
|
|
<> ((cmpc ?e (1 ?x) ())) (#gt)
|
|
|
|
<> ((cmpc ?e (0 ?x) ())) ((cmpc ?e ?x ()))
|
|
|
|
<> ((cmpc ?e () (1 ?y))) (#lt)
|
|
|
|
<> ((cmpc ?e () (0 ?y))) ((cmpc ?e () ?y))
|
2024-04-10 22:14:47 -04:00
|
|
|
<> ((cmpc ?e (0 ?x) (0 ?y))) ((cmpc ?e ?x ?y))
|
|
|
|
<> ((cmpc ?e (1 ?x) (0 ?y))) ((cmpc #gt ?x ?y))
|
|
|
|
<> ((cmpc ?e (0 ?x) (1 ?y))) ((cmpc #lt ?x ?y))
|
|
|
|
<> ((cmpc ?e (1 ?x) (1 ?y))) ((cmpc ?e ?x ?y))
|
2024-04-10 20:21:15 -04:00
|
|
|
|
|
|
|
-- ( addition )
|
2024-04-10 22:14:47 -04:00
|
|
|
<> ((add ?x ?y)) (addc 0 ?x ?y)
|
2024-04-12 12:53:40 -04:00
|
|
|
<> (addc 0 () ()) (())
|
|
|
|
<> (addc 1 () ()) ((1 ()))
|
|
|
|
<> (addc ?c ?x ()) (addc ?c ?x (0 ()))
|
|
|
|
<> (addc ?c () ?y) (addc ?c (0 ()) ?y)
|
2024-04-10 20:21:15 -04:00
|
|
|
<> (addc 0 (0 ?x) (0 ?y)) ((0 addc 0 ?x ?y))
|
|
|
|
<> (addc 0 (0 ?x) (1 ?y)) ((1 addc 0 ?x ?y))
|
|
|
|
<> (addc 0 (1 ?x) (0 ?y)) ((1 addc 0 ?x ?y))
|
|
|
|
<> (addc 0 (1 ?x) (1 ?y)) ((0 addc 1 ?x ?y))
|
|
|
|
<> (addc 1 (0 ?x) (0 ?y)) ((1 addc 0 ?x ?y))
|
|
|
|
<> (addc 1 (0 ?x) (1 ?y)) ((0 addc 1 ?x ?y))
|
|
|
|
<> (addc 1 (1 ?x) (0 ?y)) ((0 addc 1 ?x ?y))
|
|
|
|
<> (addc 1 (1 ?x) (1 ?y)) ((1 addc 1 ?x ?y))
|
|
|
|
|
|
|
|
-- ( summation )
|
2024-04-12 12:53:40 -04:00
|
|
|
<> ((sum ())) ((0 ()))
|
|
|
|
<> ((sum (?a ()))) (?a)
|
2024-04-10 22:14:47 -04:00
|
|
|
<> ((sum (?a (?b ?c)))) ((sum ((add ?a ?b) ?c)))
|
2024-04-10 20:21:15 -04:00
|
|
|
|
|
|
|
-- ( multiplication )
|
2024-04-12 12:53:40 -04:00
|
|
|
<> ((mul ?x ?y)) (mulc () ?x ?y)
|
|
|
|
<> (mulc ?t () ?y) ((sum ?t))
|
2024-04-10 20:21:15 -04:00
|
|
|
<> (mulc ?t (0 ?x) ?y) (mulc ?t ?x (0 ?y))
|
|
|
|
<> (mulc ?t (1 ?x) ?y) (mulc (?y ?t) ?x (0 ?y))
|
|
|
|
|
|
|
|
-- ( subtraction )
|
2024-04-10 22:14:47 -04:00
|
|
|
<> ((sub ?x ?y)) (normalize subc 0 ?x ?y)
|
2024-04-12 12:53:40 -04:00
|
|
|
<> (subc 0 () ()) (())
|
|
|
|
<> (subc 1 () ()) (#err)
|
|
|
|
<> (subc 0 ?x ()) (?x)
|
|
|
|
<> (subc 1 ?x ()) (subc 1 ?x (0 ()))
|
|
|
|
<> (subc ?c () ?y) (subc ?c (0 ()) ?y)
|
2024-04-10 20:21:15 -04:00
|
|
|
<> (subc 0 (0 ?x) (0 ?y)) ((0 subc 0 ?x ?y))
|
|
|
|
<> (subc 0 (0 ?x) (1 ?y)) ((1 subc 1 ?x ?y))
|
|
|
|
<> (subc 0 (1 ?x) (0 ?y)) ((1 subc 0 ?x ?y))
|
|
|
|
<> (subc 0 (1 ?x) (1 ?y)) ((0 subc 0 ?x ?y))
|
|
|
|
<> (subc 1 (0 ?x) (0 ?y)) ((1 subc 1 ?x ?y))
|
|
|
|
<> (subc 1 (0 ?x) (1 ?y)) ((0 subc 1 ?x ?y))
|
|
|
|
<> (subc 1 (1 ?x) (0 ?y)) ((0 subc 0 ?x ?y))
|
|
|
|
<> (subc 1 (1 ?x) (1 ?y)) ((1 subc 1 ?x ?y))
|
|
|
|
|
2024-04-12 12:53:40 -04:00
|
|
|
<> (dec (0 ())) (#err)
|
|
|
|
<> (dec (1 ())) ((0 ()))
|
|
|
|
<> (dec (1 ?t)) ((0 ?t))
|
|
|
|
<> (dec (0 ?t)) (dec' (0 ?t))
|
|
|
|
<> (dec' (1 ())) (())
|
2024-04-10 20:21:15 -04:00
|
|
|
<> (dec' (1 ?t)) ((0 ?t))
|
2024-04-12 12:53:40 -04:00
|
|
|
<> (dec' (0 ?t)) ((1 dec' ?t))
|
2024-04-10 20:21:15 -04:00
|
|
|
|
2024-04-10 22:14:47 -04:00
|
|
|
-- ( inc )
|
2024-04-12 12:53:40 -04:00
|
|
|
<> ((inc ())) ((1 ()))
|
2024-04-10 22:14:47 -04:00
|
|
|
<> ((inc (0 ?t))) ((1 ?t))
|
|
|
|
<> ((inc (1 ?t))) ((0 (inc ?t)))
|
2024-04-10 20:21:15 -04:00
|
|
|
|
2024-04-10 22:14:47 -04:00
|
|
|
-- ( left shift; lshift x b means x<<b )
|
2024-04-12 12:53:40 -04:00
|
|
|
<> ((lshift ?x (0 ()))) (?x)
|
|
|
|
<> ((lshift ?x (1 ()))) ((0 ?x))
|
|
|
|
<> ((lshift ?x (0 (?a ?b)))) ((lshift (0 ?x) dec (0 (?a ?b))))
|
|
|
|
<> ((lshift ?x (1 (?a ?b)))) ((lshift (0 ?x) (0 (?a ?b))))
|
|
|
|
|
|
|
|
<> ((rshift1 (?a ()))) ((0 ()))
|
|
|
|
<> ((rshift1 (?a (?b ?c)))) ((?b ?c))
|
2024-04-10 22:14:47 -04:00
|
|
|
|
|
|
|
-- ( divmod, i.e. quotient and remainder )
|
2024-04-12 12:53:40 -04:00
|
|
|
-- ( x is the dividend, or what's left of it )
|
|
|
|
-- ( y is the divisor )
|
|
|
|
-- ( s is the number of bits to shift, so far )
|
|
|
|
-- ( o is the next valuet o add to the quotient )
|
|
|
|
-- ( m is the next multiple of y to work with )
|
|
|
|
-- ( d is the quotient, so far )
|
2024-04-10 22:14:47 -04:00
|
|
|
<> ((divmod ?x ?y)) ((divmod1 ?x ?y (cmp ?x ?y)))
|
2024-04-11 18:38:49 -04:00
|
|
|
<> ((divmod1 ?x ?y #lt)) ((zero ?x))
|
|
|
|
<> ((divmod1 ?x ?y #eq)) ((one zero))
|
2024-04-12 12:53:40 -04:00
|
|
|
<> ((divmod1 ?x ?y #gt)) ((divmod2 ?x ?y zero ?y))
|
|
|
|
|
|
|
|
<> ((divmod2 ?x ?y ?s ?m)) ((divmod3 ?x ?y ?s ?m (cmp ?x (0 ?m))))
|
2024-04-10 22:14:47 -04:00
|
|
|
<> ((divmod3 ?x ?y ?s ?m #gt)) ((divmod2 ?x ?y (inc ?s) (0 ?m)))
|
2024-04-12 12:53:40 -04:00
|
|
|
<> ((divmod3 ?x ?y ?s ?m #eq)) ((divmod4 ?x ?y (inc ?s) (0 ?m) zero))
|
|
|
|
<> ((divmod3 ?x ?y ?s ?m #lt)) ((divmod4 ?x ?y ?s ?m zero))
|
|
|
|
|
|
|
|
<> ((divmod4 ?x ?y (0 ()) ?m ?d)) (((add ?d one) (sub ?x ?y)))
|
|
|
|
<> ((divmod4 ?x ?y ?s ?m ?d)) ((divmod5 (sub ?x ?m) ?y dec ?s (rshift1 ?m) (add ?d (lshift one ?s))))
|
|
|
|
|
|
|
|
<> ((divmod5 (0 ()) ?y ?s ?m ?d)) ((?d (0 ())))
|
|
|
|
<> ((divmod5 ?x ?y ?s ?m ?d)) ((divmod6 ?x ?y ?s ?m ?d (cmp ?x ?m)))
|
|
|
|
|
|
|
|
<> ((divmod6 ?x ?y (0 ()) ?m ?d #lt)) ((?d ?x))
|
|
|
|
<> ((divmod6 ?x ?y ?s ?m ?d #lt)) ((divmod5 ?x ?y dec ?s (rshift1 ?m) ?d))
|
|
|
|
<> ((divmod6 ?x ?y ?s ?m ?d #eq)) ((divmod4 ?x ?y ?s ?m ?d))
|
|
|
|
<> ((divmod6 ?x ?y ?s ?m ?d #gt)) ((divmod4 ?x ?y ?s ?m ?d))
|
2024-04-10 22:14:47 -04:00
|
|
|
|
|
|
|
-- ( floor divison )
|
|
|
|
<> ((div ?x ?y)) ((div' (divmod ?x ?y)))
|
|
|
|
<> ((div' (?q ?r))) (?q)
|
|
|
|
|
|
|
|
-- ( remainder )
|
|
|
|
<> ((mod ?x ?y)) ((mod' (divmod ?x ?y)))
|
|
|
|
<> ((mod' (?q ?r))) (?r)
|
|
|
|
|
2024-04-12 12:53:40 -04:00
|
|
|
-- (bstr (mul (int 2399) (int 3499)))
|
|
|
|
(str (int 1234567890))
|