[r2004-12-26 23:43:53 by afrisch] Oops

Original author: afrisch
Date: 2004-12-26 23:43:54+00:00

driver/cduce.ml

@@ -194,8 +194,8 @@ let debug ppf tenv cenv = function
       Format.fprintf ppf "[DEBUG:compile]@.";
       let t = Typer.typ tenv t
       and pl = List.map (Typer.pat tenv) pl in
-(*      Patterns.Compile.debug_compile ppf t pl *)
-      Patterns.demo_compile ppf (Types.descr t) (List.map Patterns.descr pl) 
+      Patterns.Compile.debug_compile ppf t pl
+(*       Patterns.demo_compile ppf (Types.descr t) (List.map Patterns.descr pl)  *)
   | `Explain (t,e) ->
       Format.fprintf ppf "[DEBUG:explain]@.";
       let t = Typer.typ tenv t in

misc/custom.ml

@@ -36,6 +36,8 @@ let dump_list ?(sep="; ") f ppf l =
   );
   Format.pp_print_string ppf " ]"
 
+let dump_array ?(sep="; ") f ppf a = dump_list ~sep f ppf (Array.to_list a)
+
 module String : T with type t = string = struct
   type t = string
   let dump = Format.pp_print_string
@@ -82,6 +84,34 @@ module Bool : T with type t = bool = struct
   let deserialize = Serialize.Get.bool
 end
 
+module Array(X : T) = struct
+  module Elem = X
+  type t = X.t array
+  let dump = dump_array X.dump
+  let check a = Array.iter X.check a
+
+  let rec compare_elems a1 a2 i l =
+    if (i = l) then 0
+    else
+      let c = X.compare a1.(i) a2.(i) in
+      if c <> 0 then c else compare_elems a1 a2 (succ i) l
+
+  let compare a1 a2 =
+    let l1 = Array.length a1 and l2 = Array.length a2 in
+    let c = Pervasives.compare l1 l2 in if c <> 0 then c
+    else compare_elems a1 a2 0 l1
+
+  let equal a1 a2 = compare a1 a2 == 0
+
+  let hash a =
+    let h = ref (Array.length a) in
+    Array.iter (fun x -> h := 17 * !h + X.hash x) a;
+    !h
+    
+  let serialize t x = Serialize.Put.array X.serialize t x
+  let deserialize t = Serialize.Get.array X.deserialize t
+end
+
 module List(X : T) = struct
   module Elem = X
   type t = X.t list

typing/typer.ml

@@ -608,7 +608,7 @@ and derecurs_regexp vars b rvars env = function
    - rvars: seq variables that appear on the right of the regexp
 
   returns the set of seq variable of the regexp minus rvars
-  (they have already been terminated)
+  (they have already been terminated if not below a star)
 *)
   | Epsilon -> 
       PEpsilon, IdSet.empty
@@ -627,11 +627,9 @@ and derecurs_regexp vars b rvars env = function
       IdSet.cup v1 v2
   | Star p -> 
       let (p,v) = derecurs_regexp vars true rvars env p in
-      assert (IdSet.is_empty v);
       termin b v (PStar p), v
   | WeakStar p -> 
       let (p,v) = derecurs_regexp vars true rvars env p in
-      assert (IdSet.is_empty v);
       termin b v (PWeakStar p), v
   | SeqCapture (x,p) -> 
       let vars = IdSet.add x vars in

web/site.cd

@@ -278,7 +278,8 @@ match page with
  let text (t : [InlineText*]) : H:Inlines =
   transform t with
    | <code>x -> [ <b>[ <tt>(highlight x) ] ]
-   | <local href=l>txt -> [ (local_link (sitemap,l,txt)) ]
+   | <local href=l>txt -> 
+	[ (local_link (sitemap,l,txt)) ]
    | <(tag & (`b|`i|`tt|`em)) (attr)>x -> [ <(tag) (attr)>(text x) ]
    | <footnote nocount=_>_ -> 
       let n = string_of !footnote_counter in
@@ -497,5 +498,3 @@ match load_include input with
  | [ <site>[ <title>(site & String) (p & Page) ] ] -> 
    let _ = gen_page (site,[],p,[], [], compute_sitemap p) in []
  | _ -> raise ("Invalid input document " @ input)
-
-