Concatenative topics
Concatenative meta
Other languages
Meta
The Sierpinski triangle of order 4 should look like this:
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
@sierpinski ( -> ) ( mask ) [ LIT2r 0a18 ] [ LIT2r 2018 ] ( size ) [ LIT2 &size 1001 ] SUB &>ver ( -- ) DUP INCk &>pad ( length -- ) DEOkr #01 SUB DUP ?&>pad &>fill ( length i -- ) ANDk DUP2r ?{ POP2r ORA2kr } DEOr DEOkr INC ADDk ,&size LDR LTH ?&>fill POP2 OVR2r DEOr #01 SUB INCk ?&>ver POP POP2r POP2r BRK
:N 16; N [ dup (y) [' .c] dotimes (print padding) N [ dup (x) over2 drop 1- (y' = y - 1) swap N !- (x' = N - x) & (x' & y') \' \'* ifte .c ' .c ] (print * or space) dotimes .nl] dotimes
: plot ( i j -- ) bitand zero? "* " " " ? write ; : pad ( n -- ) 1 - [ bl ] times ; : plot-row ( n -- ) dup 1 + [ tuck - plot ] with each-integer ; : sierpinski ( n -- ) dup '[ _ over - pad plot-row nl ] each-integer ;
vocab each_int: define helper<+P> (Int32, Int32, (Int32 -> +P) -> +P): -> n, i, f ; if (i < n): i f call n (i + 1) f helper define each_int<+P> (Int32, (Int32 -> +P) -> +P): zero swap each_int::helper define with_arg<R1..., R2..., T, A, B, S..., +P2, +P1>(R1..., T, B, (R2..., T, A -> S... +P2) -> R1..., B, (R2..., A -> S... +P1) +P1): {swap} dip {{swap} dip call} apply apply define plot (Int32, Int32 -> +IO): (&) zero (=) if {"* "} else {" "} print define over<A, B> (A, B -> A, B, A): -> a, b; a b a define tuck<A, B> (A, B -> B, A, B): swap over define times<+P> (Int32, (-> +P) -> +P): {drop} swap compose each_int define pad (Int32 -> +IO): 1 (-) {" " print} times define plot_row (Int32 -> +IO): dup 1 (+) {tuck (-) plot} with_arg each_int define sierpinski (Int32 -> +IO): dup {over (-) pad plot_row "\n" print} apply each_int 16 sierpinski
: star ( -- ) [char] * emit space ; : plot ( i j -- ) and 0= if star else 2 spaces then ; : padd ( n -- ) 0 +do space loop ; : 2^ ( n -- 2^n ) dup 0= if 1 else 1- 2 swap lshift then ; : sierpinski ( o -- ) 2^ dup 1- -1 swap -do i padd dup 0 +do i j plot loop cr 1 -loop ; 4 sierpinski
# can be made better by someone with more uiua experience S ← ↻1=0⊞(/+⬚0×)∩⋯:⟜:⊙-.⇡.ⁿ:2 P ← ∵(□↯:@ )⇌:≡(□♭⊏:[" " " □"]↙)+1⇡⧻.
include "cores/rm86.cal" include "std/io.cal" func sierpinski begin let cell n let cell x let cell y let cell pad n ! 0 y ! n @ pad ! while y @ n @ < do 0 x ! while x @ pad @ < do ' ' printch x @ 1 + x ! end 0 x ! while x @ n @ < do if x @ n @ y @ 1 + - and then ' ' printch else '*' printch end ' ' printch x @ 1 + x ! end y @ 1 + y ! pad @ 1 - pad ! 13 printch 10 printch end end 16 sierpinski
Modal is a string re-writing language. The rules have been written to emulate other post-fix concatenative languages.
<> (?: 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
This revision created on Sat, 13 Apr 2024 15:05:10 by neauoire