Merge remote-tracking branch 'upstream/master' into d6/binary
This commit is contained in:
commit
cf4db4ae76
|
@ -18,4 +18,4 @@ bin/modal examples/hello.modal
|
||||||
|
|
||||||
## Credits
|
## Credits
|
||||||
|
|
||||||
Created by [wryl](https://wryl.tech/), Immediate Mode Technologies.
|
Created by [wryl](https://wryl.tech/), Paradigital.
|
||||||
|
|
|
@ -1,9 +0,0 @@
|
||||||
<> ((You said: quit\n) send) ((You quit.) print ')
|
|
||||||
<> (?: print ') (?:)
|
|
||||||
<> (?: send) (?: wait)
|
|
||||||
<> (wait) ((You said: ?~\n) send)
|
|
||||||
<> (' ?x) (?x ')
|
|
||||||
|
|
||||||
(Say something, or type "quit": \n) print '
|
|
||||||
|
|
||||||
wait
|
|
|
@ -1,20 +0,0 @@
|
||||||
<> (add (s ?x) (s ?y)) (s (add ?x (s ?y)))
|
|
||||||
<> (add (s ?x) (0)) (s ?x)
|
|
||||||
<> (add (0) (s ?y)) (s ?y)
|
|
||||||
<> (add (0) (0)) (0)
|
|
||||||
<> (sub (s ?x) (s ?y)) (sub ?x ?y)
|
|
||||||
<> (sub (s ?x) (0)) (s ?x)
|
|
||||||
<> (sub (0) (s ?y)) (s ?y)
|
|
||||||
<> (sub (0) (0)) (0)
|
|
||||||
<> (mul (s ?x) (s ?y)) (add (s ?x) (mul (s ?x) (sub (s ?y) (s (0)))))
|
|
||||||
<> (mul (s ?x) (s (0))) (s ?x)
|
|
||||||
<> (mul (s (0)) (s ?y)) (s ?y)
|
|
||||||
<> (mul (s ?x) (0)) (0)
|
|
||||||
<> (mul (0) (s ?x)) (0)
|
|
||||||
<> (?x + ?y) (add ?x ?y)
|
|
||||||
<> (?x - ?y) (sub ?x ?y)
|
|
||||||
<> (?x * ?y) (mul ?x ?y)
|
|
||||||
<> (factorial (s (0))) ((s (0)))
|
|
||||||
<> (factorial (s ?x)) (((s ?x) * factorial ((s ?x) - (s (0)))))
|
|
||||||
|
|
||||||
factorial (s (s (s (s (s (0))))))
|
|
|
@ -1,158 +0,0 @@
|
||||||
<> (-- ?x) ()
|
|
||||||
-- ( little endian binary integers )
|
|
||||||
|
|
||||||
-- ( constants )
|
|
||||||
<> zero ((0 nil))
|
|
||||||
<> one ((1 nil))
|
|
||||||
<> two ((0 (1 nil)))
|
|
||||||
<> three ((1 (1 nil)))
|
|
||||||
<> ten ((0 (1 (0 (1 nil)))))
|
|
||||||
|
|
||||||
-- ( decimal digit to binary )
|
|
||||||
<> (binary 0) ((0 nil))
|
|
||||||
<> (binary 1) ((1 nil))
|
|
||||||
<> (binary 2) ((0 (1 nil)))
|
|
||||||
<> (binary 3) ((1 (1 nil)))
|
|
||||||
<> (binary 4) ((0 (0 (1 nil))))
|
|
||||||
<> (binary 5) ((1 (0 (1 nil))))
|
|
||||||
<> (binary 6) ((0 (1 (1 nil))))
|
|
||||||
<> (binary 7) ((1 (1 (1 nil))))
|
|
||||||
<> (binary 8) ((0 (0 (0 (1 nil)))))
|
|
||||||
<> (binary 9) ((1 (0 (0 (1 nil)))))
|
|
||||||
|
|
||||||
-- ( binary to decimal digit )
|
|
||||||
<> (decimal (0 nil)) (0)
|
|
||||||
<> (decimal (1 nil)) (1)
|
|
||||||
<> (decimal (0 (1 nil))) (2)
|
|
||||||
<> (decimal (1 (1 nil))) (3)
|
|
||||||
<> (decimal (0 (0 (1 nil)))) (4)
|
|
||||||
<> (decimal (1 (0 (1 nil)))) (5)
|
|
||||||
<> (decimal (0 (1 (1 nil)))) (6)
|
|
||||||
<> (decimal (1 (1 (1 nil)))) (7)
|
|
||||||
<> (decimal (0 (0 (0 (1 nil))))) (8)
|
|
||||||
<> (decimal (1 (0 (0 (1 nil))))) (9)
|
|
||||||
|
|
||||||
-- create nil-terminated list
|
|
||||||
<> (nilify (?h)) ((?h nil))
|
|
||||||
<> (nilify (?h ?t)) ((?h nilify ?t))
|
|
||||||
|
|
||||||
-- reverse nil-terminated list
|
|
||||||
<> (reverse ?x) (reverse' nil ?x)
|
|
||||||
<> (reverse' ?a nil) (?a)
|
|
||||||
<> (reverse' ?a (?h ?t)) (reverse' (?h ?a) ?t)
|
|
||||||
|
|
||||||
-- ( normalize, remove trailing zeros )
|
|
||||||
-- ( currently zero is (0 nil) though arguably it could be nil )
|
|
||||||
-- ( that change would require auditing our rules )
|
|
||||||
<> (normalize (?h ?t)) ((?h normalize' nil ?t))
|
|
||||||
<> (normalize' ?s nil) (nil)
|
|
||||||
<> (normalize' ?s (0 ?t)) (normalize' (0 ?s) ?t)
|
|
||||||
<> (normalize' nil (1 ?t)) ((1 normalize' nil ?t))
|
|
||||||
<> (normalize' (0 ?s) (1 ?t)) ((0 normalize' ?s (1 ?t)))
|
|
||||||
|
|
||||||
-- ( to integer )
|
|
||||||
<> ((int ?*)) ((sum f (one) g reverse nilify (?*)))
|
|
||||||
<> (g nil) (nil)
|
|
||||||
<> (g (?h ?t)) ((binary ?h g ?t))
|
|
||||||
<> (f (?u) nil) (nil)
|
|
||||||
<> (f (?u) (?h ?t)) (((mul ?h ?u) f ((mul ?u ten)) ?t))
|
|
||||||
|
|
||||||
-- ( to string: TODO, need division for this one )
|
|
||||||
|
|
||||||
-- ( comparison operartions )
|
|
||||||
<> ((cmp ?x ?y)) ((cmpc #eq ?x ?y))
|
|
||||||
<> ((cmpc ?e nil nil)) (?e)
|
|
||||||
<> ((cmpc ?e (1 ?x) nil)) (#gt)
|
|
||||||
<> ((cmpc ?e (0 ?x) nil)) ((cmpc ?e ?x nil))
|
|
||||||
<> ((cmpc ?e nil (1 ?y))) (#lt)
|
|
||||||
<> ((cmpc ?e nil (0 ?y))) ((cmpc ?e nil ?y))
|
|
||||||
<> ((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))
|
|
||||||
|
|
||||||
-- ( addition )
|
|
||||||
<> ((add ?x ?y)) (addc 0 ?x ?y)
|
|
||||||
<> (addc 0 nil nil) (nil)
|
|
||||||
<> (addc 1 nil nil) ((1 nil))
|
|
||||||
<> (addc ?c ?x nil) (addc ?c ?x (0 nil))
|
|
||||||
<> (addc ?c nil ?y) (addc ?c (0 nil) ?y)
|
|
||||||
<> (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 )
|
|
||||||
<> ((sum nil)) ((0 nil))
|
|
||||||
<> ((sum (?a nil))) (?a)
|
|
||||||
<> ((sum (?a (?b ?c)))) ((sum ((add ?a ?b) ?c)))
|
|
||||||
|
|
||||||
-- ( multiplication )
|
|
||||||
<> ((mul ?x ?y)) (mulc nil ?x ?y)
|
|
||||||
<> (mulc ?t nil ?y) ((sum ?t))
|
|
||||||
<> (mulc ?t (0 ?x) ?y) (mulc ?t ?x (0 ?y))
|
|
||||||
<> (mulc ?t (1 ?x) ?y) (mulc (?y ?t) ?x (0 ?y))
|
|
||||||
|
|
||||||
-- ( subtraction )
|
|
||||||
<> ((sub ?x ?y)) (normalize subc 0 ?x ?y)
|
|
||||||
<> (subc 0 nil nil) (nil)
|
|
||||||
<> (subc 1 nil nil) (#err)
|
|
||||||
<> (subc 0 ?x nil) (?x)
|
|
||||||
<> (subc 1 ?x nil) (subc 1 ?x (0 nil))
|
|
||||||
<> (subc ?c nil ?y) (subc ?c (0 nil) ?y)
|
|
||||||
<> (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))
|
|
||||||
|
|
||||||
-- ( dec )
|
|
||||||
<> (dec (0 nil)) (#err)
|
|
||||||
<> (dec ?x) (normalize dec' ?x)
|
|
||||||
<> (dec' (0 ?t)) ((1 dec' ?t))
|
|
||||||
<> (dec' (1 ?t)) ((0 ?t))
|
|
||||||
|
|
||||||
-- ( inc )
|
|
||||||
<> ((inc nil)) ((1 nil))
|
|
||||||
<> ((inc (0 ?t))) ((1 ?t))
|
|
||||||
<> ((inc (1 ?t))) ((0 (inc ?t)))
|
|
||||||
|
|
||||||
-- ( left shift; lshift x b means x<<b )
|
|
||||||
<> ((lshift ?x (0 nil))) (?x)
|
|
||||||
<> ((lshift ?x (1 nil))) ((0 ?x))
|
|
||||||
<> ((lshift ?x (?h (?a ?b)))) ((lshift (0 ?x) dec (?h (?a ?b))))
|
|
||||||
|
|
||||||
-- ( divmod, i.e. quotient and remainder )
|
|
||||||
<> ((divmod ?x ?y)) ((divmod1 ?x ?y (cmp ?x ?y)))
|
|
||||||
<> ((divmod1 ?x ?y #lt)) (zero)
|
|
||||||
<> ((divmod1 ?x ?y #eq)) (one)
|
|
||||||
<> ((divmod1 ?x ?y #gt)) ((divmod2 ?x ?y zero (0 ?y)))
|
|
||||||
<> ((divmod2 ?x ?y ?s ?m)) ((divmod3 ?x ?y ?s ?m (cmp ?x ?m)))
|
|
||||||
<> ((divmod3 ?x ?y ?s ?m #lt)) ((divmod4 ?x ?y ?s zero))
|
|
||||||
<> ((divmod3 ?x ?y ?s ?m #eq)) ((divmod4 ?x ?y (inc ?s) zero))
|
|
||||||
<> ((divmod3 ?x ?y ?s ?m #gt)) ((divmod2 ?x ?y (inc ?s) (0 ?m)))
|
|
||||||
<> ((divmod4 ?x ?y (0 nil) ?d)) (((add ?d one) (sub ?x ?y)))
|
|
||||||
<> ((divmod4 ?x ?y ?s ?d)) ((divmod5 (sub ?x (lshift ?y ?s)) ?y dec ?s (add ?d (lshift one ?s))))
|
|
||||||
<> ((divmod5 (0 nil) ?y ?s ?d)) ((?d (0 nil)))
|
|
||||||
<> ((divmod5 ?x ?y ?s ?d)) ((divmod6 ?x ?y ?s ?d (cmp ?x (lshift ?y ?s))))
|
|
||||||
<> ((divmod6 ?x ?y (0 nil) ?d #lt)) ((?d ?x))
|
|
||||||
<> ((divmod6 ?x ?y ?s ?d #lt)) ((divmod5 ?x ?y dec ?s ?d))
|
|
||||||
<> ((divmod6 ?x ?y ?s ?d #eq)) ((divmod4 ?x ?y ?s ?d))
|
|
||||||
<> ((divmod6 ?x ?y ?s ?d #gt)) ((divmod4 ?x ?y ?s ?d))
|
|
||||||
|
|
||||||
-- ( 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)
|
|
||||||
|
|
||||||
(divmod (int 1234567) (int 1357))
|
|
|
@ -1,11 +1,13 @@
|
||||||
|
?(?-) (This example demonstrates how to implement combinatory calculus.)
|
||||||
|
|
||||||
define (M ?x) (?x ?x)
|
<> (M ?x) (?x ?x)
|
||||||
define (KI ?x ?y) (?y)
|
<> (KI ?x ?y) (?y)
|
||||||
define (T ?x ?y) (?y ?y)
|
<> (T ?x ?y) (?y ?y)
|
||||||
define (W ?x ?y) (?x ?y ?y)
|
<> (W ?x ?y) (?x ?y ?y)
|
||||||
define (K ?x ?y) (?x)
|
<> (K ?x ?y) (?x)
|
||||||
define (C ?x ?y ?z) (?x ?z ?y)
|
<> (C ?x ?y ?z) (?x ?z ?y)
|
||||||
define (B ?x ?y ?z) (?x (?y ?z))
|
<> (B ?x ?y ?z) (?x (?y ?z))
|
||||||
define (I ?x) (?x)
|
<> (I ?x) (?x)
|
||||||
define (S ?x ?y ?z) (?x ?z (?y ?z))
|
<> (S ?x ?y ?z) (?x ?z (?y ?z))
|
||||||
|
|
||||||
|
C KI x y z
|
||||||
|
|
|
@ -1,8 +0,0 @@
|
||||||
define (: ?x ?y ;) (define ?x ?y)
|
|
||||||
: (?x dup) (?x ?x) ;
|
|
||||||
: (?x ?y swap) (?y ?x) ;
|
|
||||||
: (?x drop) () ;
|
|
||||||
: (?x ?y p*) (?x * ?y) ;
|
|
||||||
: square (dup p*) ;
|
|
||||||
|
|
||||||
10 square
|
|
|
@ -1,9 +0,0 @@
|
||||||
<> (read) (?~)
|
|
||||||
<> (?: print ') (?:)
|
|
||||||
<> (' ?x) (?x ')
|
|
||||||
|
|
||||||
(Tell me three things: \n) print '
|
|
||||||
|
|
||||||
' (You said: read
|
|
||||||
then, you continued: read
|
|
||||||
finaly, you concluded: read) print
|
|
|
@ -1,3 +0,0 @@
|
||||||
<> ((send ?:)) ()
|
|
||||||
|
|
||||||
(send (hello world))
|
|
|
@ -1,8 +0,0 @@
|
||||||
<> (explode ?*) (str (?*))
|
|
||||||
<> (reverse (str (?h ?t))) (reverse/l ?t (?h))
|
|
||||||
<> (reverse (str (?h))) (?h)
|
|
||||||
<> (reverse/l (?h ?t) ?l) (reverse/l ?t (?h ?l))
|
|
||||||
<> (reverse/l (?h) ?l) (str (?h ?l))
|
|
||||||
<> (implode str ?*) (?*)
|
|
||||||
|
|
||||||
(implode reverse (explode hello))
|
|
|
@ -1,5 +1,7 @@
|
||||||
<> (NAME) (Modal)
|
?(?-) (This example prints to the console and demonstrates how to delay the execution of a rule.)
|
||||||
<> (?: print $) (?:)
|
|
||||||
<> ($ ?x) (?x $)
|
|
||||||
|
|
||||||
$ (Welcome to NAME \nHave fun!\n\n) print
|
<> (NAME) (Modal)
|
||||||
|
<> (?: print String) (?:)
|
||||||
|
<> (String ?x) (?x String)
|
||||||
|
|
||||||
|
String (Welcome to NAME \nHave fun!\n\n) print
|
||||||
|
|
|
@ -0,0 +1,11 @@
|
||||||
|
?(?-) (This example requests 3 line delimited strings from the console.)
|
||||||
|
|
||||||
|
<> (read ?~) (?~)
|
||||||
|
<> (?: print ') (?:)
|
||||||
|
<> (' ?x) (?x ')
|
||||||
|
|
||||||
|
(Tell me three things: \n) print '
|
||||||
|
|
||||||
|
' (You said: read stdin
|
||||||
|
\nthen, you continued: read stdin
|
||||||
|
\nfinaly, you concluded: read stdin \n) print
|
|
@ -0,0 +1,11 @@
|
||||||
|
?(?-) (This example demonstrates how to keep the runtime active between prompts.)
|
||||||
|
|
||||||
|
<> ((You said: quit\n) send) ((You quit.) print ')
|
||||||
|
<> (?: print ') (?:)
|
||||||
|
<> (?: send) (?: wait stdin)
|
||||||
|
<> (wait ?~) ((You said: ?~\n) send)
|
||||||
|
<> (' ?x) (?x ')
|
||||||
|
|
||||||
|
(Say something, or type "quit": \n) print '
|
||||||
|
|
||||||
|
wait stdin
|
|
@ -0,0 +1,5 @@
|
||||||
|
?(?-) (This example prints hello world to the console.)
|
||||||
|
|
||||||
|
<> (send ?:) (?:)
|
||||||
|
|
||||||
|
send (hello world)
|
|
@ -1 +0,0 @@
|
||||||
?((?x ?y) (?y ?x)) foo bar
|
|
|
@ -1,13 +0,0 @@
|
||||||
define nil ()
|
|
||||||
define (pair (?x) (?y)) ((?x ?y))
|
|
||||||
define (first (?x ?y)) (?x)
|
|
||||||
define (second (?x ?y)) (?y)
|
|
||||||
|
|
||||||
define (quote ?x) (quote ?x)
|
|
||||||
define (if ?c ?t else ?f) (if/else ?c quote ?t quote ?f)
|
|
||||||
define (if/else (true) quote (?t) quote (?f)) (?t)
|
|
||||||
define (if/else (false) quote (?t) quote (?f)) (?f)
|
|
||||||
|
|
||||||
define (hello) (bye)
|
|
||||||
|
|
||||||
pair (pair (foo) (nil)) (baz)
|
|
|
@ -1,8 +0,0 @@
|
||||||
<> (foo ?x) (?x)
|
|
||||||
<> (map ?x (list ?l)) (map/l map/x ?x ?l)
|
|
||||||
<> (map/x ?x (?h ?t)) (?x ?h (map/x ?x ?t))
|
|
||||||
<> (map/x ?x (?h)) (map/r (?x ?h))
|
|
||||||
<> (?h (map/r ?t)) (?map/r (?h ?t))
|
|
||||||
<> (map/l map/r ?l) (list ?l)
|
|
||||||
|
|
||||||
map foo (list (1 (2 (3 (4 (5))))))
|
|
|
@ -1,199 +0,0 @@
|
||||||
<> (-- ?x) ()
|
|
||||||
-- ( little endian binary integers )
|
|
||||||
|
|
||||||
-- ( constants )
|
|
||||||
<> zero ((0 ()))
|
|
||||||
<> one ((1 ()))
|
|
||||||
<> ten ((0 (1 (0 (1 ())))))
|
|
||||||
|
|
||||||
-- ( decimal digit to binary )
|
|
||||||
<> ((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 ())))))
|
|
||||||
|
|
||||||
-- ( binary to decimal digit )
|
|
||||||
<> ((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) (reverse1 () ?x)
|
|
||||||
<> (reverse1 ?a ()) (?a)
|
|
||||||
<> (reverse1 ?a (?h ?t)) (reverse1 (?h ?a) ?t)
|
|
||||||
|
|
||||||
-- ( to integer )
|
|
||||||
<> ((int ?*)) ((sum f (one) g reverse (?*)))
|
|
||||||
<> (g ()) (())
|
|
||||||
<> (g (?h ?t)) (((binary ?h) g ?t))
|
|
||||||
<> (f (?u) ()) (())
|
|
||||||
<> (f (?u) (?h ?t)) (((mul ?h ?u) f ((mul ?u ten)) ?t))
|
|
||||||
|
|
||||||
-- ( to binary str )
|
|
||||||
-- ( <> ((bstr ?x)) (emit force (0 (b ?x))) )
|
|
||||||
-- ( <> ((bstr ?x)) ((bstr1 () ?x)) )
|
|
||||||
<> ((bstr ?x)) ((bstr1 force ?x ()))
|
|
||||||
<> ((bstr1 force/r () ?a)) (emit force/r (0 (b ?a)))
|
|
||||||
<> ((bstr1 force/r (?h ?t) ?a)) ((bstr1 force/r ?t (?h ?a)))
|
|
||||||
|
|
||||||
-- ( to string: TODO, need division for this one )
|
|
||||||
<> ((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 ?*) (?*)
|
|
||||||
|
|
||||||
-- ( comparison operartions )
|
|
||||||
<> ((cmp ?x ?y)) ((cmpc #eq ?x ?y))
|
|
||||||
<> ((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))
|
|
||||||
<> ((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))
|
|
||||||
|
|
||||||
-- ( addition )
|
|
||||||
<> ((add ?x ?y)) ((addc 0 ?x ?y))
|
|
||||||
<> ((addc 0 () ())) (())
|
|
||||||
<> ((addc 1 () ())) ((1 ()))
|
|
||||||
-- ( <> ((addc ?c ?x ())) ((addc ?c ?x (0 ()))) )
|
|
||||||
-- ( <> ((addc ?c () ?y)) ((addc ?c (0 ()) ?y)) )
|
|
||||||
<> ((addc 0 ?x ())) (?x)
|
|
||||||
<> ((addc 0 () ?y)) (?y)
|
|
||||||
<> ((addc 1 ?x ())) ((addc 1 ?x (0 ())))
|
|
||||||
<> ((addc 1 () ?y)) ((addc 1 (0 ()) ?y))
|
|
||||||
<> ((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 )
|
|
||||||
<> ((sum ())) ((0 ()))
|
|
||||||
<> ((sum (?a ()))) (?a)
|
|
||||||
<> ((sum (?a (?b ?c)))) ((sum ((add ?a ?b) ?c)))
|
|
||||||
|
|
||||||
-- ( multiplication )
|
|
||||||
<> ((mul ?x ?y)) ((mulc () ?x ?y))
|
|
||||||
<> ((mulc ?t () ?y)) ((sum ?t))
|
|
||||||
<> ((mulc ?t (0 ?x) ?y)) ((mulc ?t ?x (0 ?y)))
|
|
||||||
<> ((mulc ?t (1 ?x) ?y)) ((mulc (?y ?t) ?x (0 ?y)))
|
|
||||||
|
|
||||||
-- ( subtraction )
|
|
||||||
<> ((sub ?x ?y)) (sub1 0 ?x ?y ())
|
|
||||||
<> (sub1 0 () () ?s) (())
|
|
||||||
<> (sub1 1 () () ?s) (#err)
|
|
||||||
<> (sub1 ?c ?x () ?s) (sub1 ?c ?x (0 ()) ?s)
|
|
||||||
<> (sub1 ?c () ?y ?s) (sub1 ?c (0 ()) ?y ?s)
|
|
||||||
<> (sub1 0 (0 ?x) (0 ?y) ?s) (sub1 0 ?x ?y (0 ?s))
|
|
||||||
<> (sub1 0 (0 ?x) (1 ?y) ?s) (sub2 1 ?x ?y ?s)
|
|
||||||
<> (sub1 0 (1 ?x) (0 ?y) ?s) (sub2 0 ?x ?y ?s)
|
|
||||||
<> (sub1 0 (1 ?x) (1 ?y) ?s) (sub1 0 ?x ?y (0 ?s))
|
|
||||||
<> (sub1 1 (0 ?x) (0 ?y) ?s) (sub2 1 ?x ?y ?s)
|
|
||||||
<> (sub1 1 (0 ?x) (1 ?y) ?s) (sub1 1 ?x ?y (0 ?s))
|
|
||||||
<> (sub1 1 (1 ?x) (0 ?y) ?s) (sub1 0 ?x ?y (0 ?s))
|
|
||||||
<> (sub1 1 (1 ?x) (1 ?y) ?s) (sub2 1 ?x ?y ?s)
|
|
||||||
<> (sub2 ?c ?x ?y ()) ((1 sub1 ?c ?x ?y ()))
|
|
||||||
<> (sub2 ?c ?x ?y (?h ?t)) ((0 sub2 ?c ?x ?y ?t))
|
|
||||||
|
|
||||||
<> (dec (0 ())) (#err)
|
|
||||||
<> (dec (1 ())) ((0 ()))
|
|
||||||
<> (dec (1 ?t)) ((0 ?t))
|
|
||||||
<> (dec (0 ?t)) (dec1 (0 ?t))
|
|
||||||
<> (dec1 (1 ())) (())
|
|
||||||
<> (dec1 (1 ?t)) ((0 ?t))
|
|
||||||
<> (dec1 (0 ?t)) ((1 dec1 ?t))
|
|
||||||
|
|
||||||
-- ( inc )
|
|
||||||
<> ((inc ())) ((1 ()))
|
|
||||||
<> ((inc (0 ?t))) ((1 ?t))
|
|
||||||
<> ((inc (1 ?t))) ((0 (inc ?t)))
|
|
||||||
|
|
||||||
-- ( left shift; lshift x b means x<<b )
|
|
||||||
<> ((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))
|
|
||||||
|
|
||||||
-- ( divmod, i.e. quotient and remainder )
|
|
||||||
-- ( 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 )
|
|
||||||
<> ((divmod ?x ?y)) ((divmod1 ?x ?y (cmp ?x ?y)))
|
|
||||||
<> ((divmod1 ?x ?y #lt)) ((zero ?x))
|
|
||||||
<> ((divmod1 ?x ?y #eq)) ((one zero))
|
|
||||||
<> ((divmod1 ?x ?y #gt)) ((divmod2 ?x ?y zero ?y))
|
|
||||||
|
|
||||||
<> ((divmod2 ?x ?y ?s ?m)) ((divmod3 ?x ?y ?s ?m (cmp ?x (0 ?m))))
|
|
||||||
<> ((divmod3 ?x ?y ?s ?m #gt)) ((divmod2 ?x ?y (inc ?s) (0 ?m)))
|
|
||||||
<> ((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))
|
|
||||||
|
|
||||||
-- ( floor divison )
|
|
||||||
<> ((div ?x ?y)) ((div1 (divmod ?x ?y)))
|
|
||||||
<> ((div1 (?q ?r))) (?q)
|
|
||||||
|
|
||||||
-- ( remainder )
|
|
||||||
<> ((mod ?x ?y)) ((mod1 (divmod ?x ?y)))
|
|
||||||
<> ((mod1 (?q ?r))) (?r)
|
|
||||||
|
|
||||||
(bstr (mul (int 123456789) (int 987654321)))
|
|
|
@ -1,144 +0,0 @@
|
||||||
1 -> (s (0));
|
|
||||||
|
|
||||||
|
|
||||||
neg (neg ?x) -> ?x;
|
|
||||||
neg (0) -> 0;
|
|
||||||
|
|
||||||
|
|
||||||
add (s ?x) (s ?y) -> s (add ?x (s ?y));
|
|
||||||
add (0) (s ?x) -> s ?x;
|
|
||||||
add (s ?x) (0) -> s ?x;
|
|
||||||
add (0) (0) -> 0;
|
|
||||||
|
|
||||||
|
|
||||||
?x + ?y + ?z -> (?x + ?y) + ?z;
|
|
||||||
|
|
||||||
|
|
||||||
?x + ?y -> add ?x ?y;
|
|
||||||
|
|
||||||
|
|
||||||
sub (s ?x) (s ?y) -> sub ?x ?y;
|
|
||||||
sub (s ?x) (0) -> s ?x;
|
|
||||||
sub (0) (s ?x) -> neg (s ?x);
|
|
||||||
sub (0) (0) -> 0;
|
|
||||||
|
|
||||||
|
|
||||||
?x - ?y -> sub ?x ?y;
|
|
||||||
|
|
||||||
|
|
||||||
mul (s ?x) (s ?y) -> (s ?x) + (mul (s ?x) ((s ?y) - 1));
|
|
||||||
mul (s ?x) (s (0)) -> s ?x;
|
|
||||||
mul (s ?x) (0) -> 0;
|
|
||||||
mul (0) (s ?x) -> 0;
|
|
||||||
|
|
||||||
|
|
||||||
?x * ?y -> mul ?x ?y;
|
|
||||||
|
|
||||||
|
|
||||||
Ensures that a list or a number has been reduced to its normal form. ;
|
|
||||||
|
|
||||||
reduced (0) -> true;
|
|
||||||
reduced (nil) -> true;
|
|
||||||
reduced (s ?x) -> reduced ?x;
|
|
||||||
reduced (?h : ?t) -> reduced ?t;
|
|
||||||
reduced ?x -> false;
|
|
||||||
|
|
||||||
|
|
||||||
Because there may be conflicts with expressions that
|
|
||||||
are currently being reduced, we need to fold over reduced
|
|
||||||
lists, i.e ones that have already been fully generated. ;
|
|
||||||
|
|
||||||
fold (?f) ?i ?l -> fold reduced ?l (?f) ?i ?l;
|
|
||||||
fold true (?f) ?i (nil) -> ?i;
|
|
||||||
fold true (?f) ?i (?h : (nil)) -> ?f ?i ?h;
|
|
||||||
fold true (?f) ?i (?h : ?t) -> ?f ?i (fold (?f) ?h ?t);
|
|
||||||
fold false (?f) ?i ?l -> fold (?f) ?i ?l;
|
|
||||||
|
|
||||||
|
|
||||||
factorial (s (0)) -> s (0);
|
|
||||||
factorial (s ?x) -> (s ?x) * (factorial ((s ?x) - 1));
|
|
||||||
|
|
||||||
|
|
||||||
sum (?h : ?t) -> fold (add) (0) (?h : ?t);
|
|
||||||
|
|
||||||
|
|
||||||
range ?x (s (0)) -> ?x : (nil);
|
|
||||||
range ?x (s ?y) -> ?x : (range (?x + 1) ((s ?y) - 1));
|
|
||||||
|
|
||||||
|
|
||||||
Disgusting (yet valid) hack for currying.
|
|
||||||
We need lambdas. ;
|
|
||||||
|
|
||||||
unpack (?h : nil) -> ?h;
|
|
||||||
unpack (?h : ?t) -> ?h unpack ?t;
|
|
||||||
unpack (?x) -> ?x;
|
|
||||||
unpack (?x . -> ?x unpack (;
|
|
||||||
|
|
||||||
|
|
||||||
:: (?f) ?a -> ?f unpack ?a;
|
|
||||||
|
|
||||||
|
|
||||||
mapp (?f) ?a (nil) -> nil;
|
|
||||||
mapp (?f) ?a (?h : (nil)) -> (?f unpack ?a ?h) : (nil);
|
|
||||||
mapp (?f) ?a (?h : ?t) -> (?f unpack ?a ?h) : (mapp (?f) ?a ?t);
|
|
||||||
|
|
||||||
|
|
||||||
map (?f) (nil) -> nil;
|
|
||||||
map (?f) (?h : nil) -> (?f ?h) : (nil);
|
|
||||||
map (?f) (?h : ?t) -> (?f ?h) : (map (?f) ?t);
|
|
||||||
|
|
||||||
|
|
||||||
product ?x -> fold (mul) 1 ?x;
|
|
||||||
|
|
||||||
|
|
||||||
factorial2 ?x -> product (range 1 ?x);
|
|
||||||
|
|
||||||
|
|
||||||
contains ?x (nil) -> false;
|
|
||||||
contains ?x (?x : ?t) -> true;
|
|
||||||
contains ?x (?h : ?t) -> contains ?x ?t;
|
|
||||||
|
|
||||||
|
|
||||||
unique (nil) -> nil;
|
|
||||||
unique false (?h : ?t) -> ?h : (unique ?t);
|
|
||||||
unique true (?h : ?t) -> unique ?t;
|
|
||||||
unique (?h : ?t) -> unique contains ?h ?t (?h : ?t);
|
|
||||||
|
|
||||||
|
|
||||||
length (nil) -> 0;
|
|
||||||
length (?h : ?t) -> s (length ?t);
|
|
||||||
|
|
||||||
|
|
||||||
zipWith (?f) (nil) (nil) -> nil;
|
|
||||||
zipWith (?f) (?h : ?t) (nil) -> nil;
|
|
||||||
zipWith (?f) (nil) (?h : ?t) -> nil;
|
|
||||||
zipWith (?f) (?h1 : ?t1) (?h2 : ?t2) -> (?f ?h1 ?h2) : (zipWith (?f) ?t1 ?t2);
|
|
||||||
|
|
||||||
|
|
||||||
evens ?x -> zipWith (add) (range (0) ?x) (range (0) ?x);
|
|
||||||
|
|
||||||
|
|
||||||
not (not ?x) -> ?x;
|
|
||||||
not true -> false;
|
|
||||||
not false -> true;
|
|
||||||
|
|
||||||
|
|
||||||
any ?x -> contains true ?x;
|
|
||||||
|
|
||||||
|
|
||||||
all ?x -> not contains false ?x;
|
|
||||||
|
|
||||||
|
|
||||||
none ?x -> not any ?x;
|
|
||||||
|
|
||||||
|
|
||||||
add1 ?x -> add ?x 1;
|
|
||||||
|
|
||||||
|
|
||||||
square ?x -> ?x * ?x;
|
|
||||||
|
|
||||||
|
|
||||||
reduce (s ?x) -> s (reduce ?x);
|
|
||||||
reduce (0) -> (0);
|
|
||||||
reduce (?h : ?t) -> ?h : (reduce ?t);
|
|
||||||
reduce (nil) -> nil;
|
|
|
@ -1,141 +0,0 @@
|
||||||
define [-- ?x] {}
|
|
||||||
|
|
||||||
define [form ?x ?y] {
|
|
||||||
define ?x ?y
|
|
||||||
}
|
|
||||||
|
|
||||||
define [rule ?x ?y] {
|
|
||||||
define ?x ?y
|
|
||||||
}
|
|
||||||
|
|
||||||
define [?x -> ?y] {
|
|
||||||
define ?x ?y
|
|
||||||
}
|
|
||||||
|
|
||||||
[(?x) = (?x)] -> {
|
|
||||||
true
|
|
||||||
}
|
|
||||||
|
|
||||||
[(?x) = (?y)] -> {
|
|
||||||
false
|
|
||||||
}
|
|
||||||
|
|
||||||
[false or false] -> {
|
|
||||||
false
|
|
||||||
}
|
|
||||||
|
|
||||||
[true or false] -> {
|
|
||||||
true
|
|
||||||
}
|
|
||||||
|
|
||||||
[false or true] -> {
|
|
||||||
true
|
|
||||||
}
|
|
||||||
|
|
||||||
[true or true] -> {
|
|
||||||
true
|
|
||||||
}
|
|
||||||
|
|
||||||
[quote ?x] -> {
|
|
||||||
quote ?x
|
|
||||||
}
|
|
||||||
|
|
||||||
[unquote (quote ?x)] -> {
|
|
||||||
?x
|
|
||||||
}
|
|
||||||
|
|
||||||
form [
|
|
||||||
if ?condition
|
|
||||||
?true
|
|
||||||
else
|
|
||||||
?false
|
|
||||||
]
|
|
||||||
{
|
|
||||||
if/else ?condition {
|
|
||||||
quote ?true
|
|
||||||
} {
|
|
||||||
quote ?false
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
form [
|
|
||||||
if ?condition
|
|
||||||
?branch
|
|
||||||
]
|
|
||||||
{
|
|
||||||
if/q ?condition {
|
|
||||||
quote ?branch
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
rule [
|
|
||||||
if/q (true)
|
|
||||||
?branch
|
|
||||||
]
|
|
||||||
{
|
|
||||||
unquote ?branch
|
|
||||||
}
|
|
||||||
|
|
||||||
rule [
|
|
||||||
if/q (false)
|
|
||||||
?branch
|
|
||||||
]
|
|
||||||
{}
|
|
||||||
|
|
||||||
rule [
|
|
||||||
if/else (true)
|
|
||||||
?true
|
|
||||||
?false
|
|
||||||
]
|
|
||||||
{
|
|
||||||
unquote ?true
|
|
||||||
}
|
|
||||||
|
|
||||||
rule [
|
|
||||||
if/else (false)
|
|
||||||
?true
|
|
||||||
?false
|
|
||||||
]
|
|
||||||
{
|
|
||||||
unquote ?false
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
[factorial (?x)] -> {
|
|
||||||
if ((?x) = (1)) {
|
|
||||||
1
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
?x * factorial (?x - 1)
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
[fibonacci (?number)] -> {
|
|
||||||
if((?number) = (0) or (?number) = (1)) {
|
|
||||||
?number
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
fibonacci (?number - 1) + fibonacci (?number - 2)
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
[range (?low) (?high)] -> {
|
|
||||||
if((?low) = (?high + 1)) {
|
|
||||||
nil
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
?low : range (?low + 1) (?high)
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
[fold (?operation) (?initial) (nil)] -> {
|
|
||||||
?initial
|
|
||||||
}
|
|
||||||
|
|
||||||
[fold (?operation) (?initial) (?head : ?tail)] -> {
|
|
||||||
?operation ?head (fold (?operation) (?initial) ?tail)
|
|
||||||
}
|
|
||||||
|
|
||||||
[sum ?list] -> {
|
|
||||||
fold (add) (0) ?list
|
|
||||||
}
|
|
|
@ -1,50 +0,0 @@
|
||||||
<> (written by) (capital)
|
|
||||||
<> (?: print) (?:)
|
|
||||||
|
|
||||||
<> (?* explode) ((List (?*)))
|
|
||||||
<> ((List ?*) implode) (?*)
|
|
||||||
|
|
||||||
<> (MkEmpty) (_________________________________ explode)
|
|
||||||
|
|
||||||
<> ((List (?1 (?2 ?l))) MkWindow) ((Window (?1 ?2) ?l))
|
|
||||||
|
|
||||||
<> ((Window (?1 ?2) ( )) roll) ((WindowExhausted))
|
|
||||||
<> ((Window (?1 ?2) (?3 )) roll) ((Window (?1 ?2 ?3) ()))
|
|
||||||
<> ((Window (?1 ?2) (?3 ?l)) roll) ((Window (?1 ?2 ?3) ?l))
|
|
||||||
|
|
||||||
<> ((Window (?1 ?2 ?3) ( )) roll) ((Window (?2 ?3 ) ()))
|
|
||||||
<> ((Window (?1 ?2 ?3) (?4 )) roll) ((Window (?2 ?3 ?4) ()))
|
|
||||||
<> ((Window (?1 ?2 ?3) (?4 ?l)) roll) ((Window (?2 ?3 ?4) ?l))
|
|
||||||
|
|
||||||
|
|
||||||
<> (?p apply-rule) ((Rule (?p explode MkWindow MkEmpty apply-rule)) implode)
|
|
||||||
<> ((Window (?1 ?2 ?3) ()) (List (?h ?t)) apply-rule) ((?1 ?2 ?3) cell-state ((?2 ?3) cell-state (Rule')))
|
|
||||||
<> ((Window ?v ?l) (List (?h ?t)) apply-rule) ( ?v cell-state ((Window ?v ?l) roll (List ?t) apply-rule))
|
|
||||||
|
|
||||||
<> (Rule (Rule' ?l)) (List ?l)
|
|
||||||
<> (?y (Rule' )) (Rule' (?y))
|
|
||||||
<> (?x (Rule' ?y)) (Rule' (?x ?y))
|
|
||||||
|
|
||||||
<> ((* * *) cell-state) (_)
|
|
||||||
<> ((* * _) cell-state) (*)
|
|
||||||
<> ((* _ *) cell-state) (_)
|
|
||||||
<> ((* _ _) cell-state) (*)
|
|
||||||
<> ((_ * *) cell-state) (*)
|
|
||||||
<> ((_ * _) cell-state) (_)
|
|
||||||
<> ((_ _ *) cell-state) (*)
|
|
||||||
<> ((_ _ _) cell-state) (_)
|
|
||||||
|
|
||||||
<> ((* _) cell-state) (*)
|
|
||||||
<> ((_ *) cell-state) (*)
|
|
||||||
<> ((_ _) cell-state) (_)
|
|
||||||
|
|
||||||
<> ((Gas ?f) ?p (?r) MkTriangle) ((Triangle ((Gas ?f) ?p (?r) build)))
|
|
||||||
<> ((Gas (?g ?f)) ?p (?r) build) (?p ((Gas ?f) ?p ?r (?r) build))
|
|
||||||
<> ((Gas (Empty)) ?p ?r build) (?p (Triangle'))
|
|
||||||
|
|
||||||
<> (Triangle (Triangle' ?l)) (List (\n ?l))
|
|
||||||
<> (?y (Triangle' )) (Triangle' (?y (\n (\n))))
|
|
||||||
<> (?x (Triangle' ?y)) (Triangle' (?x (\n ?y)))
|
|
||||||
|
|
||||||
|
|
||||||
(Gas (* (* (* (* (* (* (* (* (* (* (* (* (* (* (* (Empty))))))))))))))))) ________________*________________ (apply-rule) MkTriangle implode print
|
|
|
@ -0,0 +1,11 @@
|
||||||
|
?(?-) (This example joins two tokens.)
|
||||||
|
|
||||||
|
<> (join (?a) (?*)) (join reverse (?a) List (?*))
|
||||||
|
<> (join List () List ?*) (?*)
|
||||||
|
<> (join List (?x ?y) List ?z) (join List ?y List (?x ?z))
|
||||||
|
|
||||||
|
<> (reverse List ()) (List)
|
||||||
|
<> (reverse (?*)) (reverse List (?*) ())
|
||||||
|
<> (reverse List (?x ?y) ?z) (reverse List ?y (?x ?z))
|
||||||
|
|
||||||
|
join (foo) (bar)
|
|
@ -0,0 +1,7 @@
|
||||||
|
?(?-) (This example reverses the string modal, into ladom.)
|
||||||
|
|
||||||
|
<> (reverse List () ?*) (?*)
|
||||||
|
<> (reverse (?*)) (reverse List (?*) ())
|
||||||
|
<> (reverse List (?x ?y) ?z) (reverse List ?y (?x ?z))
|
||||||
|
|
||||||
|
(reverse (modal))
|
|
@ -1,16 +0,0 @@
|
||||||
<> (explode ?*) (str (?*))
|
|
||||||
<> (reverse (str (?h ?t))) (reverse/l ?t (?h))
|
|
||||||
<> (reverse (str (?h))) (?h)
|
|
||||||
<> (reverse/l (?h ?t) ?l) (reverse/l ?t (?h ?l))
|
|
||||||
<> (reverse/l (?h) ?l) (str (?h ?l))
|
|
||||||
<> (implode str ?*) (?*)
|
|
||||||
<> (empty-register) (?x)
|
|
||||||
<> (explode ?*) (str (?*))
|
|
||||||
<> (eq ?x ?x) (#t)
|
|
||||||
<> (eq ?x ?y) (#f)
|
|
||||||
<> (?x dup) (?x ?x)
|
|
||||||
<> (?x ?y swap) (?y ?x)
|
|
||||||
<> (?x pop) ()
|
|
||||||
<> (print ?:) (?:)
|
|
||||||
|
|
||||||
(implode reverse (explode hello)) (explode hello) empty-register (eq abc abc) (eq abc def) (1 2 3) (4 5 6) swap pop dup (hey 1234 pop) (print Done.)
|
|
|
@ -0,0 +1,73 @@
|
||||||
|
?(?-) (This example tests various aspects of the implementation.)
|
||||||
|
|
||||||
|
<> (?: print) (?:)
|
||||||
|
<> (?x = ?x test) (#ok)
|
||||||
|
<> (?x = ?y test) (#fail)
|
||||||
|
|
||||||
|
?(?-) (Inline rules)
|
||||||
|
|
||||||
|
<> ((?x -> ?y)) (<> ?x ?y)
|
||||||
|
(nap -> (tap =))
|
||||||
|
|
||||||
|
nap tap test
|
||||||
|
|
||||||
|
?(?-) (Empty replacements)
|
||||||
|
|
||||||
|
<> (?x pop-plain)
|
||||||
|
<> (?x pop) ()
|
||||||
|
|
||||||
|
abc def pop-plain = abc test
|
||||||
|
abc def pop = abc test
|
||||||
|
|
||||||
|
?(?-) (Basic replacements)
|
||||||
|
|
||||||
|
<> (replace-name (foo)) ((bar) =)
|
||||||
|
|
||||||
|
replace-name (foo) (bar) test
|
||||||
|
|
||||||
|
?(?-) (Basic register setups)
|
||||||
|
|
||||||
|
<> (dup (?x)) ((?x ?x) =)
|
||||||
|
<> (swap (?x ?y)) ((?y ?x) =)
|
||||||
|
<> (compare (?x ?x ?x)) ((#t) =)
|
||||||
|
|
||||||
|
dup (abc) (abc abc) test
|
||||||
|
swap (abc def) (def abc) test
|
||||||
|
compare (abc abc abc) (#t) test
|
||||||
|
|
||||||
|
?(?-) (Empty register replacement)
|
||||||
|
|
||||||
|
<> (replace-empty ?x) (?y)
|
||||||
|
|
||||||
|
replace-empty abc = ?y test
|
||||||
|
|
||||||
|
?(?-) (Guards setups)
|
||||||
|
|
||||||
|
<> (join (String ?x) (String ?y)) ((?x ?y) =)
|
||||||
|
|
||||||
|
join (String abc) (String def) (abc def) test
|
||||||
|
|
||||||
|
?(?-) (Lambdas)
|
||||||
|
|
||||||
|
?((?x) ((?x ?x) =)) abc (abc abc) test
|
||||||
|
abc ?(?x) def = abc test
|
||||||
|
|
||||||
|
?(?-) (Explode)
|
||||||
|
|
||||||
|
<> (explode ?*) ((?*) =)
|
||||||
|
|
||||||
|
explode cow (c (o (w ()))) test
|
||||||
|
|
||||||
|
?(?-) (Implode)
|
||||||
|
|
||||||
|
<> (implode ?*) (?* =)
|
||||||
|
|
||||||
|
implode (b (a (t ()))) bat test
|
||||||
|
|
||||||
|
?(?-) (List reversal)
|
||||||
|
|
||||||
|
<> (reverse List () ?*) (?*)
|
||||||
|
<> (reverse (?*)) (reverse List (?*) ())
|
||||||
|
<> (reverse List (?x ?y) ?z) (reverse List ?y (?x ?z))
|
||||||
|
|
||||||
|
reverse (modal) = ladom test
|
|
@ -1,7 +1,7 @@
|
||||||
-- (Tic Tac Toe)
|
?(?-) (This example demonstrates how to implement a 2-players game of Tic Tac Toe)
|
||||||
|
|
||||||
<> (-- ?x) ()
|
<> (-- ?x) ()
|
||||||
<> (READ) (?~)
|
<> (READ ?~) (?~)
|
||||||
|
|
||||||
-- (Print)
|
-- (Print)
|
||||||
|
|
||||||
|
@ -34,8 +34,8 @@
|
||||||
|
|
||||||
-- (Play)
|
-- (Play)
|
||||||
|
|
||||||
<> (ready) (display READ play)
|
<> (ready) (display READ stdin play)
|
||||||
<> (?x run wait) (READ play)
|
<> (?x run wait) (READ stdin play)
|
||||||
<> (?x victory) ((?x wins!\n) put-str)
|
<> (?x victory) ((?x wins!\n) put-str)
|
||||||
|
|
||||||
-- (Interface)
|
-- (Interface)
|
||||||
|
|
5
makefile
5
makefile
|
@ -8,11 +8,10 @@ all: dest
|
||||||
dest:
|
dest:
|
||||||
@ mkdir -p bin
|
@ mkdir -p bin
|
||||||
run: all bin/modal
|
run: all bin/modal
|
||||||
@ bin/modal examples/hello.modal
|
@ bin/modal examples/hello.modal 2> /dev/null
|
||||||
test: bin/modal-debug bin/modal
|
test: bin/modal-debug bin/modal
|
||||||
@ bin/modal -v
|
@ bin/modal -v
|
||||||
@ bin/modal-debug examples/test.modal "(arg1) (arg2 (arg3))"
|
@ bin/modal-debug examples/tests.modal
|
||||||
@ bin/modal examples/test.modal 2> /dev/null
|
|
||||||
install: bin/modal
|
install: bin/modal
|
||||||
cp bin/modal ~/bin/
|
cp bin/modal ~/bin/
|
||||||
uninstall:
|
uninstall:
|
||||||
|
|
132
src/modal.c
132
src/modal.c
|
@ -5,11 +5,11 @@ typedef struct {
|
||||||
char *a, *b;
|
char *a, *b;
|
||||||
} Rule;
|
} Rule;
|
||||||
|
|
||||||
static int dst;
|
static int flip, rmin = 0xff, rmax = 0x00, cycles = 0x10000;
|
||||||
static Rule rules[0x1000], lambda, *rules_ = rules;
|
static Rule rules[0x1000], lambda, *rules_ = rules;
|
||||||
static char dict[0x8000], *dict_ = dict;
|
static char dict[0x8000], *dict_ = dict;
|
||||||
static char bank_a[0x4000], *prog_ = bank_a;
|
static char bank_a[0x4000], *src_ = bank_a;
|
||||||
static char bank_b[0x4000], *outp_ = bank_b;
|
static char bank_b[0x4000], *dst_ = bank_b;
|
||||||
static char *regs[0x100];
|
static char *regs[0x100];
|
||||||
|
|
||||||
#define spacer(c) (c <= ' ' || c == '(' || c == ')')
|
#define spacer(c) (c <= ' ' || c == '(' || c == ')')
|
||||||
|
@ -37,53 +37,52 @@ set_reg(int r, char *b)
|
||||||
char *a = regs[r], *aa = walk(a), *bb = walk(b);
|
char *a = regs[r], *aa = walk(a), *bb = walk(b);
|
||||||
while(a < aa && b < bb)
|
while(a < aa && b < bb)
|
||||||
if(*a++ != *b++) return 0;
|
if(*a++ != *b++) return 0;
|
||||||
} else
|
} else {
|
||||||
regs[r] = b;
|
regs[r] = b;
|
||||||
|
if(r < rmin) rmin = r;
|
||||||
|
if(r > rmax) rmax = r;
|
||||||
|
}
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
static void
|
static void
|
||||||
put_reg(char r)
|
put_reg(char r)
|
||||||
{
|
{
|
||||||
char c, *s = regs[(int)r];
|
char c, *s = regs[(int)r], *ss;
|
||||||
if(r == '~') {
|
if(!s) {
|
||||||
/* special stdin */
|
*dst_++ = '?', *dst_++ = r;
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
ss = walk(s);
|
||||||
|
if(r == '*') {
|
||||||
|
if(*s == '(') { /* special implode */
|
||||||
|
while(s < ss && (c = *s++))
|
||||||
|
if(!spacer(c)) *dst_++ = c;
|
||||||
|
} else { /* special explode */
|
||||||
|
int i, depth = 0;
|
||||||
|
while((c = *s++) && !spacer(c))
|
||||||
|
*dst_++ = c, *dst_++ = ' ', *dst_++ = '(', depth++;
|
||||||
|
for(i = 0; i < depth; i++)
|
||||||
|
*dst_++ = ')';
|
||||||
|
}
|
||||||
|
} else if(r == ':') { /* special stdout */
|
||||||
|
if(*s == '(') s++, --ss;
|
||||||
|
while(s < ss) {
|
||||||
|
c = *s++;
|
||||||
|
if(c == '\\') {
|
||||||
|
switch(*s++) {
|
||||||
|
case 't': putc(0x09, stdout); break;
|
||||||
|
case 'n': putc(0x0a, stdout); break;
|
||||||
|
case 's': putc(0x20, stdout); break;
|
||||||
|
}
|
||||||
|
} else
|
||||||
|
putc(c, stdout);
|
||||||
|
}
|
||||||
|
} else if(r == '~') { /* special stdin */
|
||||||
while(fread(&c, 1, 1, stdin) && c >= ' ')
|
while(fread(&c, 1, 1, stdin) && c >= ' ')
|
||||||
*outp_++ = c;
|
*dst_++ = c;
|
||||||
} else if(s) {
|
|
||||||
char *ss = walk(s);
|
|
||||||
if(r == '*') {
|
|
||||||
/* special implode */
|
|
||||||
if(*s == '(') {
|
|
||||||
while(s < ss && (c = *s++))
|
|
||||||
if(!spacer(c)) *outp_++ = c;
|
|
||||||
}
|
|
||||||
/* special explode */
|
|
||||||
else {
|
|
||||||
int i, depth = 0;
|
|
||||||
while((c = *s++) && !spacer(c))
|
|
||||||
*outp_++ = c, *outp_++ = ' ', *outp_++ = '(', depth++;
|
|
||||||
for(i = 0; i < depth; i++)
|
|
||||||
*outp_++ = ')';
|
|
||||||
}
|
|
||||||
} else if(r == ':') {
|
|
||||||
/* special stdout */
|
|
||||||
if(*s == '(') s++, --ss;
|
|
||||||
while(s < ss) {
|
|
||||||
c = *s++;
|
|
||||||
if(c == '\\') {
|
|
||||||
switch(*s++) {
|
|
||||||
case 't': putc(0x09, stdout); break;
|
|
||||||
case 'n': putc(0x0a, stdout); break;
|
|
||||||
case 's': putc(0x20, stdout); break;
|
|
||||||
}
|
|
||||||
} else
|
|
||||||
putc(c, stdout);
|
|
||||||
}
|
|
||||||
} else
|
|
||||||
while(s < ss) *outp_++ = *s++;
|
|
||||||
} else
|
} else
|
||||||
*outp_++ = '?', *outp_++ = r;
|
while(s < ss) *dst_++ = *s++;
|
||||||
}
|
}
|
||||||
|
|
||||||
static char *
|
static char *
|
||||||
|
@ -91,15 +90,18 @@ match_rule(Rule *r, char *p)
|
||||||
{
|
{
|
||||||
int i;
|
int i;
|
||||||
char c, last = 0, *a = r->a, *b = p;
|
char c, last = 0, *a = r->a, *b = p;
|
||||||
for(i = 0x21; i < 0x7f; i++)
|
if(rmax) {
|
||||||
regs[i] = 0;
|
for(i = 0; i <= rmax; i++)
|
||||||
|
regs[i] = 0;
|
||||||
|
rmin = 0xff, rmax = 0x00;
|
||||||
|
}
|
||||||
while((c = *a)) {
|
while((c = *a)) {
|
||||||
if(spacer(last) && c == '?') {
|
if(spacer(last) && c == '?') {
|
||||||
if(!set_reg(*(++a), b)) return NULL;
|
if(!set_reg(*(++a), b)) return NULL;
|
||||||
a++, b = walk(b);
|
a++, b = walk(b);
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
if(*a != *b) return NULL;
|
if(c != *b) return NULL;
|
||||||
a++, b++, last = c;
|
a++, b++, last = c;
|
||||||
}
|
}
|
||||||
c = *b;
|
c = *b;
|
||||||
|
@ -109,30 +111,31 @@ match_rule(Rule *r, char *p)
|
||||||
static int
|
static int
|
||||||
commit_rule(Rule *r, char *s, int create)
|
commit_rule(Rule *r, char *s, int create)
|
||||||
{
|
{
|
||||||
while((*outp_++ = *s++))
|
while((*dst_++ = *s++))
|
||||||
;
|
;
|
||||||
*outp_++ = 0;
|
*dst_++ = 0;
|
||||||
if((dst = !dst))
|
if((flip = !flip))
|
||||||
prog_ = bank_b, outp_ = bank_a;
|
src_ = bank_b, dst_ = bank_a;
|
||||||
else
|
else
|
||||||
prog_ = bank_a, outp_ = bank_b;
|
src_ = bank_a, dst_ = bank_b;
|
||||||
if(create)
|
if(create)
|
||||||
fprintf(stderr, "<> (%s) (%s)\n", r->a, r->b);
|
fprintf(stderr, "<> (%s) (%s)\n", r->a, r->b);
|
||||||
else
|
else
|
||||||
fprintf(stderr, "%02d %s\n", r->id, prog_);
|
fprintf(stderr, "%02d %s\n", r->id, src_);
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
static int
|
static int
|
||||||
write_rule(Rule *r, char last, char *res)
|
write_rule(Rule *r, char last, char *res)
|
||||||
{
|
{
|
||||||
char c, *b = r->b, *origin = outp_;
|
char c, *b = r->b, *origin = dst_;
|
||||||
while((c = *b++))
|
while((c = *b++))
|
||||||
if(spacer(last) && c == '?')
|
if(spacer(last) && c == '?')
|
||||||
put_reg(*b++);
|
put_reg(*b++);
|
||||||
else
|
else
|
||||||
*outp_++ = c, last = c;
|
*dst_++ = c, last = c;
|
||||||
if(last == ' ' && outp_ - origin == 0) outp_--;
|
if(dst_ == origin)
|
||||||
|
while(*res == ' ') res++;
|
||||||
return commit_rule(r, res, 0);
|
return commit_rule(r, res, 0);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -141,11 +144,14 @@ parse_frag(char *s)
|
||||||
{
|
{
|
||||||
char c, *ss;
|
char c, *ss;
|
||||||
while((c = *s) && c <= ' ') s++;
|
while((c = *s) && c <= ' ') s++;
|
||||||
if(*s != ')' && *s != '<' && s[1] != '>') {
|
if(*s != ')' && !(*s == '<' && s[1] == '>')) {
|
||||||
ss = walk(s);
|
ss = walk(s);
|
||||||
if(*s == '(') s++, ss--;
|
if(*s == '(') {
|
||||||
while(s < ss) *dict_++ = *s++;
|
s++;
|
||||||
s++;
|
while(s < ss - 1) *dict_++ = *s++;
|
||||||
|
s++;
|
||||||
|
} else
|
||||||
|
while(s < ss) *dict_++ = *s++;
|
||||||
}
|
}
|
||||||
*dict_++ = 0;
|
*dict_++ = 0;
|
||||||
return s;
|
return s;
|
||||||
|
@ -163,7 +169,7 @@ create_rule(Rule *r, int id, char *s)
|
||||||
static int
|
static int
|
||||||
rewrite(void)
|
rewrite(void)
|
||||||
{
|
{
|
||||||
char c, last = 0, *cap, *s = dst ? bank_b : bank_a, *res;
|
char c, last = 0, *cap, *s = src_, *res;
|
||||||
while((c = *s) && c <= ' ') s++;
|
while((c = *s) && c <= ' ') s++;
|
||||||
while((c = *s)) {
|
while((c = *s)) {
|
||||||
if(spacer(last)) {
|
if(spacer(last)) {
|
||||||
|
@ -185,10 +191,10 @@ rewrite(void)
|
||||||
if((res = match_rule(r, s)) != NULL)
|
if((res = match_rule(r, s)) != NULL)
|
||||||
return write_rule(r, last, res);
|
return write_rule(r, last, res);
|
||||||
}
|
}
|
||||||
*outp_++ = last = c;
|
*dst_++ = last = c;
|
||||||
s++;
|
s++;
|
||||||
}
|
}
|
||||||
*outp_++ = 0;
|
*dst_++ = 0;
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -200,9 +206,9 @@ main(int argc, char **argv)
|
||||||
if(argc < 2)
|
if(argc < 2)
|
||||||
return !printf("usage: modal [-v] source.modal\n");
|
return !printf("usage: modal [-v] source.modal\n");
|
||||||
if(argc < 3 && argv[1][0] == '-' && argv[1][1] == 'v')
|
if(argc < 3 && argv[1][0] == '-' && argv[1][1] == 'v')
|
||||||
return !printf("Modal Interpreter, 13 Apr 2024.\n");
|
return !printf("Modal Interpreter, 16 Apr 2024.\n");
|
||||||
if(!(f = fopen(argv[1], "r")))
|
if(!(f = fopen(argv[1], "r")))
|
||||||
return !printf("Invalid Modal file: %s.\n", argv[1]);
|
return !fprintf(stderr, "Invalid Modal file: %s.\n", argv[1]);
|
||||||
while(fread(&c, 1, 1, f)) {
|
while(fread(&c, 1, 1, f)) {
|
||||||
c = c <= 0x20 ? 0x20 : c;
|
c = c <= 0x20 ? 0x20 : c;
|
||||||
if(w > bank_a) {
|
if(w > bank_a) {
|
||||||
|
@ -215,6 +221,6 @@ main(int argc, char **argv)
|
||||||
while(*(--w) <= ' ') *w = 0;
|
while(*(--w) <= ' ') *w = 0;
|
||||||
fclose(f);
|
fclose(f);
|
||||||
while(rewrite())
|
while(rewrite())
|
||||||
;
|
if(!cycles--) return !fprintf(stderr, "Cycle limit exceeded.\n");
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
Loading…
Reference in New Issue