Front Page All Articles Recent Changes Random Article

Contents

Concatenative language

  • ACL
  • Ait
  • Aocla
  • Breeze
  • Callisto
  • Cat
  • Cognate
  • colorForth
  • Concata
  • CoSy
  • Deque
  • DSSP
  • dt
  • Elymas
  • Enchilada
  • ETAC
  • F
  • Factor
  • Fiveth
  • Forth
  • Fourth
  • Freelang
  • Gershwin
  • hex
  • iNet
  • Joy
  • Joy of Postfix App
  • kcats
  • Kitten
  • lang5
  • Listack
  • LSE64
  • Lviv
  • Meow5
  • min
  • Mirth
  • mjoy
  • Mlatu
  • Ode
  • OForth
  • Om
  • Onyx
  • Plorth
  • Popr
  • Porth
  • PostScript
  • Prowl
  • Quest32
  • Quackery
  • r3
  • Raven
  • Retro
  • RPL
  • SPL
  • Staapl
  • Stabel
  • Tal
  • Titan
  • Trith
  • Uiua
  • Worst
  • xs
  • XY
  • 5th
  • 8th

Concatenative topics

  • Compilers
  • Interpreters
  • Type systems
  • Object systems
  • Quotations
  • Variables
  • Garbage collection
  • Example programs

Concatenative meta

  • People
  • Communities

Other languages

  • APL
  • C++
  • Erlang
  • FP trivia
  • Haskell
  • Io
  • Java
  • JavaScript
  • Lisp
  • ML
  • Oberon
  • RPL
  • Self
  • Slate
  • Smalltalk

Meta

  • Search
  • Farkup wiki format
  • Etiquette
  • Sandbox

Sierpinski triangle

The Sierpinski triangle of order 4 should look like this:

                       *
                      * *
                     *   *
                    * * * *
                   *       *
                  * *     * *
                 *   *   *   *
                * * * * * * * *
               *               *
              * *             * *
             *   *           *   *
            * * * *         * * * *
           *       *       *       *
          * *     * *     * *     * *
         *   *   *   *   *   *   *   *
        * * * * * * * * * * * * * * * *

Uxntal

@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

fy

: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

Factor

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

Kitten

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

Gforth

: 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

Uiua

# can be made better by someone with more uiua experience
S ← ↻1=0⊞(/+⬚0×)∩⋯:⟜:⊙-.⇡.ⁿ:2
P ← ∵(□↯:@ )⇌:≡(□♭⊏:["  " " □"]↙)+1⇡⧻.

Callisto

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

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

Latest Revisions Edit

All content is © 2008-2024 by its respective authors. By adding content to this wiki, you agree to release it under the BSD license.