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 ;           (* →        │ *)
.

Back to: code

Back to: Workspaces