⍝ Subset of the Joy language:

    joy' 3 1 4 6 2 / - + * '        ⍝ postfix evaluation
6
    joy' 2 3 + 4+ '                 ⍝ error: words must be blank-separated
5 4+
    joy' 2 (* parenthesised *) 3 (* (* nested *) comments *) + '
5
    joy' 1 2 3 4                    (* stack grows to the right *)'
1 2 3 4

    joy' 1 dup  ;                   (* top stack item duplicated *)
       2 3 swap ;                   (* top two stack items swapped *)
       4 5 pop                      (* top item popped from stack *)'
1 1 ; 3 2 ; 4

    joy' [[[]]]                     (* nested list *)
         [a] [b c] concat   ;       (* joined lists *)
         a [b c] cons       ;       (* cons *)
         [a b c] uncons     ;       (* uncons *)
         3 4 [dup] dip + +          (* dip *)'
[[[]]] [a b c] ; [a b c] ; a [b c] ; 10

    joy' [1 2 3 4] 1 [*] fold     ; (* ×/⍳4         *)
         [1 2 3] [dup +] map      ; (* {⍵+⍵}¨⍳3     *)
         10 [1 2 3][+]map         ; (* 10+¨1 2 3    *)
         10 [[succ][pred]][i] map ; (* 10+¨1 ¯1     *)
         10 [5 +] [2 *] cleave    ; (* (10+5)(10×2) *)
         3 4 [+] [*] cleave       ; (* (3+4)(3×4)   *)
         [2 3] [+ 4 5 *] infra    ; (* (2+3)(4×5)   *)
         [1 2] [3 4] infra          (* (⌽1 2),3 4   *) '
24 ; [2 4 6] ; 10 [11 12 13] ; 10 [11 9] ; 15 20 ; 7 12 ; [5 20] ; [2 1 3 4]

    joy' 0 null                     (* null *)
         1 null
        [] null
       [1] null'
true false true false

    joy' 0 small                    (* small *)
         1 small
         2 small
        [] small
       [1] small
     [1 2] small'
true true false true true false

    joy' [0 1 2] [[dup null] [] [pred] ifte] map '
[0 0 1]

    joy' [0 1 2 0 1 2] [small] filter ;
         [0 1 2 0 1 2] [1 >=]  filter ;
       1 [0 1 2 0 1 2] [!=]    filter '
[0 1 0 1] ; [1 2 1 2] ; 1 [0 2 0 2]

    joy' [0 1 2 0 1 3] [small] split ;      (* (1 0=⊂⍺⍺ ⍵)/¨⊂⍵ *)
         [0 1 2 0 1 3] [2 <  ] split ; 
       2 [0 1 2 0 1 3] [  <= ] split '
[0 1 0 1] [2 3] ; [0 1 0 1] [2 3] ; 2 [2 3] [0 1 0 1]

    joy' DEFINE iftest == [null] [pop y] [pop n] ifte.
           <<  [] iftest >>
           << [1] iftest >>
           <<  0  iftest >>
           <<  1  iftest >> '
<< y >> << n >> << y >> << n >>

    joy'[1 2 3] [[]] [[]cons cons] primrec ;    (* primrec *)
        [1 2 3] [[]] [cons]        primrec ;
             5  [1]  [*]           primrec '
[1 [2 [3 []]]] ; [1 2 3] ; 120

    joy'10[null][succ][dup pred][*]linrec'      ⍝ linrec
3628800

    joy'5[small][][pred dup pred][+]binrec'     ⍝ binrec
5

    display scripts._joy
┌→────────────────────────────────────────────────────────────┐
│DEFINE                                                       │
│                                                             │
│fac ==                  (* primitive-recursive factorial *)  │
│    [1] [*] primrec ;                                        │
│                                                             │
│fac-i ==                (* iterative factorial:         *)   │
│    [1 1]               (* →                   n [1 1]│ *)   │
│    dip                 (* →                     1 1 n│ *)   │
│    [dup [*]dip succ]   (* →   1 1 n [dup [*]dip succ]│ *)   │
│    times               (* →     ({(×/⍵),1↓⍵+1}⍣n⊢1 1)│ *)   │
│    pop ;               (* →       ({(×/⍵),1↓⍵+1}⍣n⊢1)│ *)   │
│                                                             │
│fac-r ==                (* recursive factorial: *)           │
│    [small]             (* test for 0 or 1      *)           │
│    []                  (* 0 → 0;  1 → 1        *)           │
│    [                   (*                   n│ *)           │
│        dup             (* →               n n│ *)           │
│        pred            (* →           n (n-1)│ *)           │
│        fac-r           (* →          n (!n-1)│ *)           │
│        *               (* →         (n×∇ n-1)│ *)           │
│    ]                                                        │
│    ifte ;              (* if-then-else         *)           │
│                                                             │
│Y ==  [dup cons] swoncat dup cons i ;   (* Y combinator *)   │
│                                                             │
│fac-y ==                (* Y-combinator factorial: *)        │
│    [                                                        │
│        [pop null]                                           │
│        [pop succ]                                           │
│        [[dup pred] dip i *]                                 │
│        ifte                                                 │
│     ] Y ;                                                   │
│                                                             │
│fib ==                  (* binary recursive fibonacci *)     │
│    [small] []          (* 0 → 0; 1 →1          *)           │
│    [pred dup pred]     (* →           (n-1 2)│ *)           │
│    [+]                 (* →         (+/n-1 2)│ *)           │
│    binrec ;                                                 │
│                                                             │
│fib-i ==                (* iterative fibonacci:         *)   │
│    [0 1]               (* →                   n [0 1]│ *)   │
│    dip                 (* →                     0 1 n│ *)   │
│    [dup [+]dip swap]   (* →   0 1 n [dup [+]dip swap]│ *)   │
│    times               (* →         ({1↓⍵,+/⍵}⍣n⊢0 1)│ *)   │
│    pop ;                                                    │
│                                                             │
│fib-r ==                (* recursive fibonacci: *)           │
│    [small]             (* test for 0 or 1      *)           │
│    []                  (* 0 → 0; 1 → 1         *)           │
│    [                   (*                   n│ *)           │
│        pred            (* →             (n-1)│ *)           │
│        dup             (* →        (n-1)(n-1)│ *)           │
│        [fib-r]dip      (* →      (∇ n-1)(n-1)│ *)           │
│        pred            (* →      (∇ n-1)(n-2)│ *)           │
│        fib-r           (* →    (∇ n-1)(∇ n-2)│ *)           │
│        +               (* →   ((∇ n-1)+∇ n-2)│ *)           │
│    ]                                                        │
│    ifte ;              (* if-then-else         *)           │
│                                                             │
│2∧ ==                   (* 2-to-the-power   *)               │
│    [1]dip              (* →           1 n│ *)               │
│    [dup +]             (* →   1 n [dup +]│ *)               │
│    times ;             (* →     {⍵+⍵}⍣n⊢1│ *)               │
│                                                             │
│seq ==                  (* [m .. n]         *)               │
│    [>] [pop2 []]       (* m>n:         []│ *)               │
│    [                                                        │
│        [dup succ]dip   (* →       m ++m n│ *)               │
│        seq             (* →  m [++m .. n]│ *)               │
│        cons            (* →      [m .. n]│ *)               │
│    ]                                                        │
│    ifte ;              (* if-then-else     *)               │
│                                                             │
│(* Ackermann's function:                                     │
│ *  ack 0 n → n+1                                            │
│ *  ack m 0 → ack (m-1) 1                                    │
│ *  ack m n → ack (m-1) (ack m (n-1))                        │
│ *)                                                          │
│                                                             │
│ack ==                  (* recursive Ackermann *)            │
│    [                                                        │
│        [[pop null] popd succ]                               │
│        [[    null] pop pred 1 ack]                          │
│        [           [dup pred swap] dip pred ack ack]        │
│    ]cond ;                                                  │
│                                                             │
│ack-y ==                (* Y-combinator Ackermann *)         │
│    [                   (* Kubica M.              *)         │
│        [                                                    │
│            [[pop pop null] pop popd succ]                   │
│            [[    pop null] [pop pred 1]dip i]               │
│            [                                                │
│                [[dup pred swap]dip pred]dip                 │
│                dup [i]dip i (* ack ack *)                   │
│            ]                                                │
│         ] cond                                              │
│     ] Y ;                                                   │
│                                                             │
│qsort ==                (* quicksort *)                      │
│    [small] []                                               │
│            [uncons [>] split]                               │
│    [enconcat]                                               │
│    binrec ;                                                 │
│                                                             │
│→ ==                    (*      rest│ *)    (* clear stack *)│
│    []                  (* → rest []│ *)                     │
│    unstack ;           (* →        │ *)                     │
│.                                                            │
└─────────────────────────────────────────────────────────────┘

:If 'v'∊Alpha
        joy scripts._joy,'
            DEFINE 0-5 == 0 5 seq.  (* sequence  *)
            0-5 [fac]   map         (* factorial *)
            0-5 [fac-y] map         (* factorial *)
            0-5 [fib]   map         (* fibonacci *)
            0-5 [2 rem] map         (* parity    *)
            [3 1 4 1 5] qsort       (* quicksort *)
            0 2 seq [dup ack] map   (* Ackermann *) '
    [1 1 2 6 24 120] [1 1 2 6 24 120] [0 1 1 2 3 5] [0 1 0 1 0 1] [1 1 3 4 5] [1 3 7]
:EndIf

    joy'  11 4 /; 11 4 rem; 11 4 div '          ⍝ division / remainder
2 ; 3 ; 2 3

    joy' -- X Y Z stack'            ⍝ push stack onto stack
-- X Y Z [Z Y X --]

    joy'poof [X Y Z --] unstack'    ⍝ replace stack with top item
-- Z Y X

    joy'[] [1 2 3]shunt [4 5]shunt' ⍝ shunt
[5 4 3 2 1]

    joy '3[stack]times'             ⍝ cf: disp {⍺ ⍵}\3⍴⊂⍬
[] [[]] [[[]] []]

    joy '(* null program *)'

    joy 'DEFINE 3 == 4.             (* redefinition of operator: 3  *)
         2 3 +                      (* 2 3 + → 6                    *)
        DEFINE 3 == 2 succ.         (* redefinition of operator: 3  *)
        2 3 +                       (* 2 3 + → 5                    *) '
6 5

⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝  Errors show the failing operator to the right of the │:

    joy '3 5 -'                     ⍝ error: subtrahend too big
3 5│-

    joy '1 2 3 4 5 + ? * /'         ⍝ error: ? not in domain of *
1 2 3 9 ?│* /

    joy '1 [2] concat'              ⍝ error: concat needs two lists
1 [2]│concat

    joy '[] uncons'                 ⍝ error: uncons of empty list
[]│uncons

    joy '1 2 cons'                  ⍝ error: cons to atom
1 2│cons

    joy '3 2 dup - /'               ⍝ error: divide by zero
3 0│/

    joy '0 [y] [t] branch'          ⍝ error: branch first arg must be bool
0 [y] [t]│branch

    joy 'true 0 <'                  ⍝ error: relational fn needs a number
true 0│<

    joy '0 pred'                    ⍝ error: 0 has no predecessor
0│pred

Back to: code

Back to: Workspaces