l4/pkg/ocaml/ocaml/contrib/camlp4/examples/syb_fold.ml

   1 type variable = string
   2  and term =
   3   | Var   of variable
   4   | Lam   of variable * term
   5   | App   of term * term
   6   | Const of constant
   7  and constant =
   8   | CInt    of int
   9   | CString of string
  10 ;;
  11
  12 class fold = Camlp4Filters.GenerateFold.generated;;
  13 (* class fold = Camlp4FoldGenerator.generated;; *)
  14
  15 module VarSet = Set.Make(String);;
  16
  17 (* Compute free variables with the fold class *)
  18 let free_variables_v1 =
  19   let o =
  20     object (self)
  21       inherit fold as super
  22       val fv = VarSet.empty
  23       method fv = fv
  24       method empty_fv = {< fv = VarSet.empty >}
  25       method term t =
  26         match t with
  27         | Var(v) -> {< fv = VarSet.add v fv >}
  28         | Lam(v, t) ->
  29             let fv1 = VarSet.remove v (self#empty_fv#term t)#fv in
  30             {< fv = VarSet.union fv fv1 >}
  31         | _ -> super#term t
  32     end
  33   in fun t -> VarSet.elements (o#term t)#fv
  34 ;;
  35
  36 (* Let's try to abstract that a little *)
  37
  38 let fold_term f t init =
  39   let o =
  40     object (self)
  41       inherit fold as super
  42       val acc = init
  43       method get = acc
  44       method reset = {< acc = init >}
  45       method term t =
  46         {< acc = f t acc (fun t -> (self#reset#term t)#get)
  47                          (fun t -> (super#term t)#get) >}
  48     end
  49   in
  50   (o#term t)#get
  51 ;;
  52
  53 (* A nicer version of free_variables *)
  54 let free_variables_v2 t =
  55   VarSet.elements begin
  56     fold_term begin fun t fv self next ->
  57       match t with
  58       | Var(v)    -> VarSet.add v fv
  59       | Lam(v, t) -> VarSet.union fv (VarSet.remove v (self t))
  60       | _         -> next t
  61     end t VarSet.empty
  62   end
  63 ;;
  64
  65 let term1 =
  66   App(
  67     App(Var"x1",
  68       Lam("x",
  69         App(Var"x", App(Var"y", (Lam("y", Lam("z", (App(Var"y", App(Var"x4",Var"z")))))))))),
  70     Var"x3")
  71
  72 ;;
  73
  74 let fv1 = free_variables_v1 term1;;
  75 let fv2 = free_variables_v2 term1;;
  76
  77 (* Low cost syntax *)
  78 let ( ^-> ) v t = Lam(v, t)
  79 let ( @ ) t1 t2 = App(t1, t2)
  80 let ( ! ) s = Var s
  81
  82 let term2 =
  83   !"x1" @
  84   ("x" ^-> !"x" @ !"y" @ ("y" ^-> ("z" ^-> !"y" @ !"x4" @ !"z"))) @
  85   !"x3"
  86
  87 ;;
  88
  89 let fv1' = free_variables_v1 term2;;
  90 let fv2' = free_variables_v2 term2;;