From e897e59f7afb7f0434680b7bf7a0717d6f003dab Mon Sep 17 00:00:00 2001 From: Devine Lu Linvega Date: Sat, 13 Apr 2024 16:12:55 -0700 Subject: [PATCH] Fixed issue with empty plode register --- examples/multiply.modal | 199 ++++++++++++++++++++++++++++++++++++++ examples/sierpinski.modal | 50 ++++++++++ makefile | 4 +- src/modal.c | 46 ++++----- 4 files changed, 270 insertions(+), 29 deletions(-) create mode 100644 examples/multiply.modal create mode 100644 examples/sierpinski.modal diff --git a/examples/multiply.modal b/examples/multiply.modal new file mode 100644 index 0000000..790dd09 --- /dev/null +++ b/examples/multiply.modal @@ -0,0 +1,199 @@ +<> (-- ?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< ((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))) \ No newline at end of file diff --git a/examples/sierpinski.modal b/examples/sierpinski.modal new file mode 100644 index 0000000..15cc210 --- /dev/null +++ b/examples/sierpinski.modal @@ -0,0 +1,50 @@ +<> (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 \ No newline at end of file diff --git a/makefile b/makefile index 85aa564..748271f 100644 --- a/makefile +++ b/makefile @@ -8,11 +8,11 @@ all: dest dest: @ mkdir -p bin run: all bin/modal - @ bin/modal examples/hello.modal 2> /dev/null + @ bin/modal examples/hello.modal test: bin/modal-debug bin/modal @ bin/modal -v @ bin/modal-debug examples/test.modal "(arg1) (arg2 (arg3))" - @ bin/modal examples/test.modal + @ bin/modal examples/test.modal 2> /dev/null install: bin/modal cp bin/modal ~/bin/ uninstall: diff --git a/src/modal.c b/src/modal.c index 5277c35..7688d6e 100644 --- a/src/modal.c +++ b/src/modal.c @@ -30,27 +30,6 @@ walk(char *s) return s; } -static char * -plode(char *s) -{ - int i, depth = 0; - char c, *ss; - /* implode */ - if(*s == '(') { - ss = walk(s); - while(s < ss && (c = *s++)) - if(!spacer(c)) *outp_++ = c; - } - /* explode */ - else { - while((c = *s++) && !spacer(c)) - *outp_++ = c, *outp_++ = ' ', *outp_++ = '(', depth++; - for(i = 0; i < depth; i++) - *outp_++ = ')'; - } - return s; -} - static int set_reg(int r, char *b) { @@ -66,19 +45,32 @@ set_reg(int r, char *b) static void put_reg(char r) { - char *s = regs[(int)r]; - if(r == '*') - s = plode(s); - else if(r == '~') { + char c, *s = regs[(int)r]; + if(r == '~') { char buf; while(fread(&buf, 1, 1, stdin) && buf >= ' ') *outp_++ = buf; } else if(s) { char *ss = walk(s); - if(r == ':') { + if(r == '*') { + /* implode */ + if(*s == '(') { + ss = walk(s); + while(s < ss && (c = *s++)) + if(!spacer(c)) *outp_++ = c; + } + /* 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 == ':') { if(*s == '(') s++, --ss; while(s < ss) { - char c = *s++; + c = *s++; if(c == '\\') { switch(*s++) { case 't': putc(0x09, stdout); break;