fork(1) download
copy 
  1. (* box 1 *)
  2. module List_stack :
  3.   (* public *)
  4.   sig
  5.     exception Empty_stack
  6.     type 'a t
  7.     val make : unit -> 'a t
  8.     val push : 'a -> 'a t -> unit
  9.     val pop  : 'a t -> 'a
  10.   end = struct
  11.  
  12.     exception Empty_stack
  13.  
  14.     type 'a t = 'a list ref
  15.  
  16.     let make () = ref []
  17.  
  18.     let push x st =
  19.       st := x :: !st
  20.  
  21.     let pop st =
  22.       match !st with
  23.       | [] -> raise Empty_stack
  24.       | head :: rest ->
  25.         begin
  26.           st := rest ;
  27.           head
  28.         end
  29.  
  30.   end
  31.  
  32.  
  33.  
  34. (* box 2 *)
  35. module Array_stack :
  36.   (* public *)
  37.   sig
  38.     exception Empty_stack
  39.     type 'a t
  40.     val make : unit -> 'a t
  41.     val push : 'a -> 'a t -> unit
  42.     val pop  : 'a t -> 'a
  43.   end = struct
  44.  
  45.     (* public impl *)
  46.  
  47.     exception Empty_stack
  48.  
  49.     type 'a t =
  50.       { mutable items : 'a option array
  51.       ; mutable count : int
  52.       }
  53.  
  54.     (* private *)
  55.  
  56.     let grow_factor = 1.6
  57.     let init_capacity = 10
  58.  
  59.     let grow src =
  60.       let old_cap = Array.length src in
  61.       let new_cap = int_of_float (grow_factor *. float_of_int old_cap) in
  62.       let dst = Array.make new_cap None in
  63.       Array.blit src 0 dst 0 old_cap ;
  64.       dst
  65.  
  66.     let ensure_cap s =
  67.       if s.count < Array.length s.items
  68.       then ()
  69.       else s.items <- grow s.items
  70.  
  71.     (* public impl *)
  72.  
  73.     let make () =
  74.       { items = Array.make init_capacity None
  75.       ; count = 0
  76.       }
  77.  
  78.     let push x s =
  79.       ensure_cap s ;
  80.       Array.set s.items s.count (Some x) ;
  81.       s.count <- s.count + 1
  82.  
  83.     let pop s =
  84.       if s.count = 0
  85.       then raise Empty_stack
  86.       else
  87.         s.count <- s.count - 1 ;
  88.         match Array.get s.items s.count with
  89.         | None   -> raise (Failure "unreachable")
  90.         | Some x ->
  91.           begin
  92.             Array.set s.items s.count None ;
  93.             x
  94.           end
  95.  
  96.   end
  97.  
  98.  
  99.  
  100. (* interface *)
  101. module type Stack =
  102.   sig
  103.     exception Empty_stack
  104.     type 'a t
  105.     val make : unit -> 'a t
  106.     val push : 'a -> 'a t -> unit
  107.     val pop  : 'a t -> 'a
  108.   end
  109.  
  110.  
  111.  
  112. (* box 3 *)
  113. module Main (Stack : Stack) =
  114.   struct
  115.  
  116.     let main () =
  117.       let s = Stack.make () in
  118.       for i = 1 to 3 do
  119.         Stack.push i s
  120.       done ;
  121.       for i = 1 to 3 do
  122.         Stack.pop s |> Printf.printf "%d "
  123.       done ;
  124.       Printf.printf "\n"
  125.  
  126.   end
  127.  
  128. let _ =
  129.   let module M1 = Main (List_stack) in
  130.   let module M2 = Main (Array_stack) in
  131.   M1.main () ;
  132.   M2.main ()
  133.  
Success #stdin #stdout 0s 5552KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
3 2 1 
3 2 1
https://ideone.com/ow8kd2
language:
OCaml (ocamlopt 4.05.0)
created:
2 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!