gdritter repos picoml / master samples / fact.picoml
master

Tree @master (Download .tar.gz)

fact.picoml @masterraw · history · blame

(* basic recursive factorial *)
let fact (n : Nat) : Nat = match n with
  | 0 => 1
  | _ => n * fact(n-1)
end;

(* tail-recursive factorial *)
let tail_fact (n : Nat) : Nat = do
  let go (k : Nat) (r : Nat) : Nat = match k with
    | 0 => r
    | _ => go (k - 1) (r * k)
  end;
  go n 1
end;

(* unnecessarily elaborate monoidal approach *)
type Monoid m = {
  mappend : m -> m -> m,
  mempty : m,
};

let mconcat (m : Monoid t) (lst: List t) -> t = match lst with
  | Cons x xs -> m.mappend x (mconcat m xs)
  | Nil       -> m.mempty
end;

let prod_monoid : Monoid Nat = {
  mappend = (*),
  mempty  = 1,
};

let range x y = cond
  | x == y = Nil
  | x <  y = Cons x (range (x+1) y)
  | else   = panic "Bad range!"
end

let product = mconcat prod_monoid;
let monoidal_fact n = product (range 1 n);