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
|
||||
|
||||
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)
|
||||
define (KI ?x ?y) (?y)
|
||||
define (T ?x ?y) (?y ?y)
|
||||
define (W ?x ?y) (?x ?y ?y)
|
||||
define (K ?x ?y) (?x)
|
||||
define (C ?x ?y ?z) (?x ?z ?y)
|
||||
define (B ?x ?y ?z) (?x (?y ?z))
|
||||
define (I ?x) (?x)
|
||||
define (S ?x ?y ?z) (?x ?z (?y ?z))
|
||||
<> (M ?x) (?x ?x)
|
||||
<> (KI ?x ?y) (?y)
|
||||
<> (T ?x ?y) (?y ?y)
|
||||
<> (W ?x ?y) (?x ?y ?y)
|
||||
<> (K ?x ?y) (?x)
|
||||
<> (C ?x ?y ?z) (?x ?z ?y)
|
||||
<> (B ?x ?y ?z) (?x (?y ?z))
|
||||
<> (I ?x) (?x)
|
||||
<> (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)
|
||||
<> (?: print $) (?:)
|
||||
<> ($ ?x) (?x $)
|
||||
?(?-) (This example prints to the console and demonstrates how to delay the execution of a rule.)
|
||||
|
||||
$ (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) ()
|
||||
<> (READ) (?~)
|
||||
<> (READ ?~) (?~)
|
||||
|
||||
-- (Print)
|
||||
|
||||
|
|
@ -34,8 +34,8 @@
|
|||
|
||||
-- (Play)
|
||||
|
||||
<> (ready) (display READ play)
|
||||
<> (?x run wait) (READ play)
|
||||
<> (ready) (display READ stdin play)
|
||||
<> (?x run wait) (READ stdin play)
|
||||
<> (?x victory) ((?x wins!\n) put-str)
|
||||
|
||||
-- (Interface)
|
||||
|
|
|
|||
5
makefile
5
makefile
|
|
@ -8,11 +8,10 @@ all: dest
|
|||
dest:
|
||||
@ mkdir -p bin
|
||||
run: all bin/modal
|
||||
@ bin/modal examples/hello.modal
|
||||
@ bin/modal examples/hello.modal 2> /dev/null
|
||||
test: bin/modal-debug bin/modal
|
||||
@ bin/modal -v
|
||||
@ bin/modal-debug examples/test.modal "(arg1) (arg2 (arg3))"
|
||||
@ bin/modal examples/test.modal 2> /dev/null
|
||||
@ bin/modal-debug examples/tests.modal
|
||||
install: bin/modal
|
||||
cp bin/modal ~/bin/
|
||||
uninstall:
|
||||
|
|
|
|||
132
src/modal.c
132
src/modal.c
|
|
@ -5,11 +5,11 @@ typedef struct {
|
|||
char *a, *b;
|
||||
} Rule;
|
||||
|
||||
static int dst;
|
||||
static int flip, rmin = 0xff, rmax = 0x00, cycles = 0x10000;
|
||||
static Rule rules[0x1000], lambda, *rules_ = rules;
|
||||
static char dict[0x8000], *dict_ = dict;
|
||||
static char bank_a[0x4000], *prog_ = bank_a;
|
||||
static char bank_b[0x4000], *outp_ = bank_b;
|
||||
static char bank_a[0x4000], *src_ = bank_a;
|
||||
static char bank_b[0x4000], *dst_ = bank_b;
|
||||
static char *regs[0x100];
|
||||
|
||||
#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);
|
||||
while(a < aa && b < bb)
|
||||
if(*a++ != *b++) return 0;
|
||||
} else
|
||||
} else {
|
||||
regs[r] = b;
|
||||
if(r < rmin) rmin = r;
|
||||
if(r > rmax) rmax = r;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
static void
|
||||
put_reg(char r)
|
||||
{
|
||||
char c, *s = regs[(int)r];
|
||||
if(r == '~') {
|
||||
/* special stdin */
|
||||
char c, *s = regs[(int)r], *ss;
|
||||
if(!s) {
|
||||
*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 >= ' ')
|
||||
*outp_++ = 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++;
|
||||
*dst_++ = c;
|
||||
} else
|
||||
*outp_++ = '?', *outp_++ = r;
|
||||
while(s < ss) *dst_++ = *s++;
|
||||
}
|
||||
|
||||
static char *
|
||||
|
|
@ -91,15 +90,18 @@ match_rule(Rule *r, char *p)
|
|||
{
|
||||
int i;
|
||||
char c, last = 0, *a = r->a, *b = p;
|
||||
for(i = 0x21; i < 0x7f; i++)
|
||||
regs[i] = 0;
|
||||
if(rmax) {
|
||||
for(i = 0; i <= rmax; i++)
|
||||
regs[i] = 0;
|
||||
rmin = 0xff, rmax = 0x00;
|
||||
}
|
||||
while((c = *a)) {
|
||||
if(spacer(last) && c == '?') {
|
||||
if(!set_reg(*(++a), b)) return NULL;
|
||||
a++, b = walk(b);
|
||||
continue;
|
||||
}
|
||||
if(*a != *b) return NULL;
|
||||
if(c != *b) return NULL;
|
||||
a++, b++, last = c;
|
||||
}
|
||||
c = *b;
|
||||
|
|
@ -109,30 +111,31 @@ match_rule(Rule *r, char *p)
|
|||
static int
|
||||
commit_rule(Rule *r, char *s, int create)
|
||||
{
|
||||
while((*outp_++ = *s++))
|
||||
while((*dst_++ = *s++))
|
||||
;
|
||||
*outp_++ = 0;
|
||||
if((dst = !dst))
|
||||
prog_ = bank_b, outp_ = bank_a;
|
||||
*dst_++ = 0;
|
||||
if((flip = !flip))
|
||||
src_ = bank_b, dst_ = bank_a;
|
||||
else
|
||||
prog_ = bank_a, outp_ = bank_b;
|
||||
src_ = bank_a, dst_ = bank_b;
|
||||
if(create)
|
||||
fprintf(stderr, "<> (%s) (%s)\n", r->a, r->b);
|
||||
else
|
||||
fprintf(stderr, "%02d %s\n", r->id, prog_);
|
||||
fprintf(stderr, "%02d %s\n", r->id, src_);
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int
|
||||
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++))
|
||||
if(spacer(last) && c == '?')
|
||||
put_reg(*b++);
|
||||
else
|
||||
*outp_++ = c, last = c;
|
||||
if(last == ' ' && outp_ - origin == 0) outp_--;
|
||||
*dst_++ = c, last = c;
|
||||
if(dst_ == origin)
|
||||
while(*res == ' ') res++;
|
||||
return commit_rule(r, res, 0);
|
||||
}
|
||||
|
||||
|
|
@ -141,11 +144,14 @@ parse_frag(char *s)
|
|||
{
|
||||
char c, *ss;
|
||||
while((c = *s) && c <= ' ') s++;
|
||||
if(*s != ')' && *s != '<' && s[1] != '>') {
|
||||
if(*s != ')' && !(*s == '<' && s[1] == '>')) {
|
||||
ss = walk(s);
|
||||
if(*s == '(') s++, ss--;
|
||||
while(s < ss) *dict_++ = *s++;
|
||||
s++;
|
||||
if(*s == '(') {
|
||||
s++;
|
||||
while(s < ss - 1) *dict_++ = *s++;
|
||||
s++;
|
||||
} else
|
||||
while(s < ss) *dict_++ = *s++;
|
||||
}
|
||||
*dict_++ = 0;
|
||||
return s;
|
||||
|
|
@ -163,7 +169,7 @@ create_rule(Rule *r, int id, char *s)
|
|||
static int
|
||||
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)) {
|
||||
if(spacer(last)) {
|
||||
|
|
@ -185,10 +191,10 @@ rewrite(void)
|
|||
if((res = match_rule(r, s)) != NULL)
|
||||
return write_rule(r, last, res);
|
||||
}
|
||||
*outp_++ = last = c;
|
||||
*dst_++ = last = c;
|
||||
s++;
|
||||
}
|
||||
*outp_++ = 0;
|
||||
*dst_++ = 0;
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
|
@ -200,9 +206,9 @@ main(int argc, char **argv)
|
|||
if(argc < 2)
|
||||
return !printf("usage: modal [-v] source.modal\n");
|
||||
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")))
|
||||
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)) {
|
||||
c = c <= 0x20 ? 0x20 : c;
|
||||
if(w > bank_a) {
|
||||
|
|
@ -215,6 +221,6 @@ main(int argc, char **argv)
|
|||
while(*(--w) <= ' ') *w = 0;
|
||||
fclose(f);
|
||||
while(rewrite())
|
||||
;
|
||||
if(!cycles--) return !fprintf(stderr, "Cycle limit exceeded.\n");
|
||||
return 0;
|
||||
}
|
||||
Loading…
Reference in New Issue