Merge remote-tracking branch 'upstream/master' into d6/binary

This commit is contained in:
~d6 2024-04-16 17:25:53 -04:00
commit cf4db4ae76
27 changed files with 211 additions and 871 deletions

View File

@ -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.

View File

@ -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

View File

@ -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))))))

View File

@ -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))

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -1,3 +0,0 @@
<> ((send ?:)) ()
(send (hello world))

View File

@ -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))

View File

@ -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

11
examples/io_read.modal Normal file
View File

@ -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

11
examples/io_repl.modal Normal file
View File

@ -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

5
examples/io_write.modal Normal file
View File

@ -0,0 +1,5 @@
?(?-) (This example prints hello world to the console.)
<> (send ?:) (?:)
send (hello world)

View File

@ -1 +0,0 @@
?((?x ?y) (?y ?x)) foo bar

View File

@ -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)

View File

@ -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))))))

View File

@ -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)))

View File

@ -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;

View File

@ -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
}

View File

@ -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

View File

@ -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)

View File

@ -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))

View File

@ -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.)

73
examples/tests.modal Normal file
View File

@ -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

View File

@ -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)

View File

@ -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:

View File

@ -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,37 +37,35 @@ 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;
while(fread(&c, 1, 1, stdin) && c >= ' ') return;
*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 */ ss = walk(s);
else { if(r == '*') {
if(*s == '(') { /* special implode */
while(s < ss && (c = *s++))
if(!spacer(c)) *dst_++ = c;
} else { /* special explode */
int i, depth = 0; int i, depth = 0;
while((c = *s++) && !spacer(c)) while((c = *s++) && !spacer(c))
*outp_++ = c, *outp_++ = ' ', *outp_++ = '(', depth++; *dst_++ = c, *dst_++ = ' ', *dst_++ = '(', depth++;
for(i = 0; i < depth; i++) for(i = 0; i < depth; i++)
*outp_++ = ')'; *dst_++ = ')';
} }
} else if(r == ':') { } else if(r == ':') { /* special stdout */
/* special stdout */
if(*s == '(') s++, --ss; if(*s == '(') s++, --ss;
while(s < ss) { while(s < ss) {
c = *s++; c = *s++;
@ -80,10 +78,11 @@ put_reg(char r)
} else } else
putc(c, stdout); putc(c, stdout);
} }
} else if(r == '~') { /* special stdin */
while(fread(&c, 1, 1, stdin) && c >= ' ')
*dst_++ = c;
} else } else
while(s < ss) *outp_++ = *s++; while(s < ss) *dst_++ = *s++;
} else
*outp_++ = '?', *outp_++ = r;
} }
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) {
for(i = 0; i <= rmax; i++)
regs[i] = 0; 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;
} }