update camlp4o

diff --git a/camlp4/pa_oo.ml b/camlp4/pa_oo.ml
index f1e632b..99e90be 100644 (file)
--- a/camlp4/pa_oo.ml
+++ b/camlp4/pa_oo.ml
@@ -47,11 +47,13 @@ let expand_access _loc mut id e kind =
   let reader = <:class_str_item< method $id$ = $lid:id$ >>
   and writer =
     <:class_str_item< method $"set_"^id$ $lid:id'$ = $lid:id$ := $lid:id'$ >>
+  and updater =
+    <:class_str_item< method $"set_"^id$ $lid:id'$ = {< $lid:id$ = $lid:id'$ >} >>
   in
   let accessors =
     match kind with None -> <:class_str_item<>>
     | Some k -> match k with
-      | `R -> reader
+      | `R -> <:class_str_item< $reader$; $updater$ >>
       | `W -> writer
       | `RW -> <:class_str_item< $reader$; $writer$ >>
   in

diff --git a/scm/src/OMakefile b/scm/src/OMakefile
index 4df12e7..fc5393c 100644 (file)
--- a/scm/src/OMakefile
+++ b/scm/src/OMakefile
@@ -1,4 +1,4 @@
-.PHONY: clean doc
+.PHONY: clean
 
 ################################################
 #
@@ -71,8 +71,6 @@ PROGRAM = habc-scm
 OCamlProgram($(PROGRAM), main $(FILES))
 OCamlLibrary($(PROGRAM), $(FILES))
 
-doc :
-       ocamldoc -html $(OCAMLPPFLAGS) -v -d ../html/ *.mli
 ################################################
 #
 # additonal rules

diff --git a/scm/src/ast.ml b/scm/src/ast.ml
index 42bf20f..75e9812 100644 (file)
--- a/scm/src/ast.ml
+++ b/scm/src/ast.ml
@@ -72,42 +72,6 @@ let lift_stmt f =
 
 let lift_program f = List.map (lift_stmt f)
 
-let rec fold_up =
-  fun branch leaf expr ->
-    let g e =
-      fold_up branch leaf e in
-      match expr with
-         `Int _ | `String _ | `Bool _ | `Float _ | `Var _ ->
-           leaf expr
-       | `Lambda (name,expr') ->
-           branch @@ `Lambda (name,(g expr'))
-       | `Call exprs ->
-           branch @@ `Call (List.map g exprs)
-       | `If (a,b,c) ->
-           branch @@ `If ((g a),(g b),(g c))
-       | `Let (decl,body) ->
-           let decl' =
-             List.map (fun (a,b)->(a,g b)) decl in
-           let body' =
-             g body in
-             branch @@ `Let (decl',body')
-       | `LetRec (decl,body) ->
-           let decl' =
-             List.map (fun (a,b)->(a,g b)) decl in
-           let body' =
-             g body in
-             branch @@ `LetRec (decl',body')
-       | `Block exprs' ->
-           branch @@ `Block (List.map g exprs')
-       | `New (name,args) ->
-           branch @@ `New (name,List.map g args)
-       | `Invoke (obj,name,args) ->
-           branch @@ `Invoke (g obj,name,List.map g args)
-       | `SlotRef (obj,name) ->
-           branch @@ `SlotRef (g obj,name)
-       | `SlotSet (obj,name,value) ->
-           branch @@ `SlotSet (g obj,name,g value)
-
 let rec fold f g fold_rec env =
   function
     | `Bool _ | `Float _ | `Int _ |  `String _ | `Var _ as e ->
@@ -125,10 +89,10 @@ let rec fold f g fold_rec env =
          f env e in
          g env' @@ `If (fold_rec env' a, fold_rec env' b, fold_rec env' c)
     | `Let (decl,body) as e ->
-       let env' =
-         f env e in
        let decl' =
          List.map (Tuple.T2.map2 (fold_rec env)) decl in
+       let env' =
+         f env e in
        let body' =
          fold_rec env' body in
          g env' @@ `Let (decl',body')

diff --git a/scm/src/ast.mli b/scm/src/ast.mli
index 9167c19..411c0fa 100644 (file)
--- a/scm/src/ast.mli
+++ b/scm/src/ast.mli
@@ -75,10 +75,10 @@ type program =
 
 (** [map f e] applys f to all-sub expression of [e]. *)
 val map : (expr -> expr) -> expr -> expr
-val fold_up : ('a expr_type -> 'a) -> (expr -> 'a ) -> expr -> 'a
+val fold : ('a -> ([> 'b expr_type]) -> 'a) ->  ('a -> [> 'd expr_type] -> 'e) -> ('a -> 'b -> 'd) -> 'a -> 'b expr_type -> 'e
 
 (**{6 Lift}*)
 val lift_stmt : (expr->expr) -> stmt -> stmt
 val lift_program : (expr->expr) -> program -> program
 
-val fold : ('a -> ([> 'b expr_type]) -> 'a) ->  ('a -> [> 'd expr_type] -> 'e) -> ('a -> 'b -> 'd) -> 'a -> 'b expr_type -> 'e
+