⍝ 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
⍝∇ joy nats display scripts._joy
Back to: code
Back to: Workspaces