(* Lecture 15: Include and Open, Mutable References *)
(* Author: Frank Pfenning *)

(* Bug workaround for MLWorks restricted beta *)
open General;

signature ORDER =
sig
  type t  (* parameter *)
  val compare : t * t -> order
end;

signature ORDER' =
sig
  include ORDER
  val == : t * t -> bool
  val >  : t * t -> bool
  val >= : t * t -> bool
  val <  : t * t -> bool
  val <= : t * t -> bool
  val min : t * t -> t
  val max : t * t -> t
end;

functor ExtendOrder (structure O : ORDER)
                    :> ORDER' where type t = O.t =
struct
  open O
  (* expands to:
     type t = O.t
     val compare = O.compare
  *)
  infix ==
  fun (x == y) = case O.compare(x,y) of EQUAL => true | _ => false
  fun (x > y) = case O.compare(x,y) of GREATER => true | _ => false
  fun (x >= y) = case O.compare(x,y) of LESS => false | _ => true
  fun (x < y) = case O.compare(x,y) of LESS => true | _ => false
  fun (x <= y) = case O.compare(x,y) of GREATER => false | _ => true
  fun max(x,y) = case O.compare(x,y) of LESS => y | _ => x
  fun min(x,y) = case O.compare(x,y) of GREATER => y | _ => x
end;

signature NAT =
sig

  eqtype nat  (* or: type nat *)

  exception Negative

  val fromInt : int -> nat  (* raises Negative *)
  val toInt : nat -> int  (* raises Overflow *)

  val + : nat * nat -> nat
  val * : nat * nat -> nat
  val - : nat * nat -> nat  (* raises Negative *)
  val div : nat * nat -> nat
  val mod : nat * nat -> nat

  include ORDER where type t = nat

  val toString : nat -> string
  val fromString : string -> nat option

end;

(*
functor BigNat (structure Int : INTEGER) :> NAT =
struct

local
  open Int
in

  type nat = int list
  (* ... *)
  local 
    structure Order :> ORDER where type t = nat =
    struct
      type t = nat
      fun compare (xs,ys) = (* ... *)
    end

    structure Order' :> ORDER' where type t = nat =
      ExtendOrder (structure O = Order)
  in
    open Order'
  end
  (* ... *)

end  (* local open Int *)
end; (* functor Nat *)

functor BigInt (structure Nat : NAT) :> INTEGER =
struct

  datatype int = Pos of Nat.nat | Neg of Nat.nat

  (* ... *)
end; (* functor BigInt *)
*)

signature RATIONAL =
sig

  eqtype rat

  structure BigInt : INTEGER
  val fromBigInts : BigInt.int * BigInt.int -> rat	 (* raises Div *)
  val toBigInts : rat -> BigInt.int * BigInt.int    (* cancelled *)

  val // : int * int -> rat		(* raises Div *)
  (* infix // *)
  val toInts : rat -> int * int		(* cancelled, raises Overflow *)

  val zero : rat
  val one : rat

  val + : rat * rat -> rat
  val * : rat * rat -> rat
  val - : rat * rat -> rat
  val / : rat * rat -> rat
  val ~ : rat -> rat

  include ORDER where type t = rat

  val toString : rat -> string
  val fromString : string -> rat option

end;  (* signature RATIONAL *)

(**************************)
(*** Mutable References ***)
(**************************)

val cell = ref 5;
val x1 = !cell;
val _ = (cell := 4);
val x2 = !cell;

(* Example: generator for new names *)

signature NAME_GEN =
sig
  type nameGen
  val init : string -> nameGen  (* initializes counter *)
  val next : nameGen -> string  (* effect: increments counter *)
end;

structure NameGen :> NAME_GEN =
struct

  type nameGen = string * int ref

  fun init (s) = let val cell = ref 0 in (s,cell) end
  fun next (s,cell) = ( cell := !cell+1 ; s ^ Int.toString(!cell) )

end;

val xgen : NameGen.nameGen = NameGen.init "x";
val x1 = NameGen.next xgen;
val x2 = NameGen.next xgen;
val x3 = NameGen.next xgen;

(* Arrays *)

signature ARRAY' =
sig
  type 'a array
  val array : int * 'a -> 'a array  (* raises Size *)
  val fromList : 'a list -> 'a array
  val tabulate : int * (int -> 'a) -> 'a array

  val length : 'a array -> int

  val sub : 'a array * int -> 'a  (* raises Subscript *)
  val update : 'a array * int * 'a -> unit  (* raises Subscript *)

  val modify : ('a -> 'a) -> 'a array -> unit
end;

val a : real array = Array.tabulate (5, (fn x => 1.0/real(x+1)));
val b : int array = Array.fromList [0,1,2,3,4];
val c : string array = Array.array (5,"");
val a0 = Array.sub (a,0);
val _ = Array.update(a,0,2.0);
a; (* has changed *)

structure Array' :> ARRAY' =
struct
  type 'a array = ('a ref) list

  (* array (i,x), i >= 0 *)
  (* raises Size if i < 0 *)
  fun array (i,x) =
      let fun ar (0,l) = l
	    | ar (i,l) = ar(i-1, ref(x)::l)
      in
	if i < 0 then raise Size
	else ar (i,nil)
      end;

  fun fromList (nil) = nil
    | fromList (x::l) = ref(x)::fromList(l)

  fun tabulate (n,f) =
      let fun tab (0,l) = l
	    | tab (i,l) = tab(i-1, ref(f(i-1))::l)
      in
	if n < 0 then raise Size
	else tab (n,nil)
      end

  fun length (l) = List.length (l)

  fun sub (l,n) = ! (List.nth (l,n))  (* raises Subscript *)

  fun update (l,n,x) = ( List.nth(l,n) := x ) (* raises Subscript *)

  fun modify f l =
      let fun md nil = ()
	    | md (r::l) = (r := f(!r) ; md l)
      in
	md l
      end
end; (* structure Array' *)