[r2004-12-26 19:49:35 by afrisch] Empty log message

Original author: afrisch
Date: 2004-12-26 19:49:35+00:00

runtime/explain.ml

@@ -58,7 +58,6 @@ and run_disp_kind pt fail actions = function
         actions.basic
   | Absent ->
       run_disp_basic pt fail (fun t -> Types.Record.has_absent t) actions.basic
-  | Delayed _ -> assert false
   | v ->
       run_disp_kind pt fail actions (normalize v)
 

runtime/run_dispatch.ml

@@ -149,12 +149,13 @@ let make_result_string_utf8 i j s q r1 r2 (code,r) =
 let rec run_disp_basic v f =  function
   | [(_,r)] -> make_result_basic v r
   | (t,r)::rem -> if f t then make_result_basic v r else run_disp_basic v f rem
-  | _ -> assert false
+  | _ ->  
+      Format.fprintf Format.std_formatter "ERR: %a@." Value.print v;
+      assert false
 
 let rec run_dispatcher d v = 
-(*
-  Format.fprintf Format.std_formatter "Matching (%a) with:@\n" Value.print v;
-  Patterns.Compile.print_dispatcher Format.std_formatter d;
+(*  Format.fprintf Format.std_formatter "Matching (%a) with:@." Value.print v; *)
+(*  Patterns.Compile.print_dispatcher Format.std_formatter d;
 *)
   match actions d with
     | AIgnore r -> make_result_basic v r
@@ -166,11 +167,11 @@ and run_disp_kind actions v =
   | Xml (v1,v2,v3) -> run_disp_prod v v1 (Pair (v2,v3)) actions.xml
   | Record r -> run_disp_record false v (LabelMap.get r) actions.record
   | String_latin1 (i,j,s,q) -> 
-(*      run_disp_kind actions (Value.normalize v) *)
-      run_disp_string_latin1 i j s q actions
+(*      run_disp_kind actions (Value.normalize v)  *)
+       run_disp_string_latin1 i j s q actions 
   | String_utf8 (i,j,s,q) -> 
-(*      run_disp_kind actions (Value.normalize v) *)
-	run_disp_string_utf8 i j s q actions 
+(*      run_disp_kind actions (Value.normalize v)  *)
+ 	run_disp_string_utf8 i j s q actions  
   | Atom a -> make_result_basic v (Atoms.get_map a actions.atoms) 
   | Char c -> make_result_basic v (Chars.get_map c actions.chars) 
   | Integer i ->
@@ -185,8 +186,6 @@ and run_disp_kind actions v =
   | Absent ->
       run_disp_basic v (fun t -> Types.Record.has_absent t) actions.basic
   | Concat (_,_) as v -> run_disp_kind actions (Value.normalize v)
-  | Delayed _ -> assert false
-
 
 and run_disp_prod v v1 v2 = function
   | Impossible -> assert false
@@ -272,13 +271,16 @@ and run_disp_string_latin1_2 r1 i j s q = function
       let code2 = run_disp_string_latin1_loop i j s q d2 in
       make_result_string_latin1 i j s q r1 r2 b2.(code2)
 and run_disp_string_latin1_loop i j s q d =
+  let i = succ i in
+  if i == j then run_dispatcher d q else
   match actions d with
-    | AIgnore r -> make_result_basic Absent r
-    | AKind k -> run_disp_string_latin1 (succ i) j s q k
+    | AIgnore r -> make_result_basic (Value.String_latin1 (i,j,s,q)) r
+    | AKind k -> run_disp_string_latin1 i j s q k
 
 and run_disp_string_utf8 i j s q actions = 
-  if Utf8.equal_index i j then run_disp_kind actions q 
-  else match actions.prod with
+  if Utf8.equal_index i j then run_disp_kind actions q
+  else
+  match actions.prod with
     | Impossible -> assert false
     | TailCall d1 -> run_disp_string_utf8_char d1 (Chars.V.mk_int (Utf8.get s i))
     | Ignore d2 -> run_disp_string_utf8_2 !cursor i j s q d2
@@ -300,9 +302,11 @@ and run_disp_string_utf8_2 r1 i j s q = function
       let code2 = run_disp_string_utf8_loop i j s q d2 in
       make_result_string_utf8 i j s q r1 r2 b2.(code2)
 and run_disp_string_utf8_loop i j s q d =
+  let i = Utf8.advance s i in
+  if Utf8.equal_index i j then run_dispatcher d q else
   match actions d with
-    | AIgnore r -> make_result_basic Absent r
-    | AKind k -> run_disp_string_utf8 (Utf8.advance s i) j s q k
+    | AIgnore r -> make_result_basic (Value.String_utf8 (i,j,s,q)) r
+    | AKind k -> run_disp_string_utf8 i j s q k
 
 let run_dispatcher d v =
   let code = run_dispatcher d v in
@@ -446,7 +450,6 @@ and run_disp_kind actions v =
   | Absent ->
       run_disp_basic v (fun t -> Types.Record.has_absent t) actions.basic
   | Concat (_,_) as v -> run_disp_kind actions (Value.normalize v)
-  | Delayed _ -> assert false
 
 
 and run_disp_prod v v1 v2 = function

runtime/value.ml

@@ -16,8 +16,6 @@ type t =
   | Concat of t * t
   | Absent
 
-  | Delayed of t ref
-
 (* 
   The only representation of the empty sequence is nil.
   In particular, in String_latin1 and String_utf8, the string cannot be empty.
@@ -268,8 +266,6 @@ let rec print ppf v =
 	Format.fprintf ppf "<abstract=%s>" s
     | Absent -> 	
 	Format.fprintf ppf "<[absent]>"
-    | Delayed x ->
-	Format.fprintf ppf "<[delayed]>"
 and print_quoted_str ppf = function
   | Pair (Char c, q) -> 
       Chars.V.print_in_string ppf c; 
@@ -378,9 +374,6 @@ let dump_xml ppf v =
     | Absent ->
         Format.fprintf ppf "@[<hv1>";
         Format.fprintf ppf "<absent />@]"
-    | Delayed _ ->
-        Format.fprintf ppf "@[<hv1>";
-        Format.fprintf ppf "<delayed />@]"
   in
   Format.fprintf ppf "@[<hv1>";
   Format.fprintf ppf "<value>@,%a@,</value>@]" aux v
@@ -408,8 +401,10 @@ let rec compare x y =
       | Abstract (s1,v1), Abstract (s2,v2) ->
 	  let c = Types.Abstract.T.compare s1 s2 in if c <> 0 then c 
 	  else raise (CDuceExn (string_latin1 "comparing abstract values"))
-      | Absent,_ | _,Absent 
-      | Delayed _, _ | _, Delayed _ -> assert false
+      | Absent,_ | _,Absent ->
+	  Format.fprintf Format.std_formatter
+	    "ERR: Compare %a %a@." print x print y;
+	  assert false
       | Concat (_,_) as x, y -> eval_lazy_concat x; compare x y
       | x, (Concat (_,_) as y) -> eval_lazy_concat y; compare x y
       | String_latin1 (ix,jx,sx,qx), String_latin1 (iy,jy,sy,qy) ->

runtime/value.mli

@@ -21,9 +21,6 @@ type t =
 (* Special value for absent record fields, and failed pattern matching *)
   | Absent
 
-(* Only in evaluation environment *)
-  | Delayed of t ref
-
 module ValueSet: Set.S with type elt = t
 
 exception CDuceExn of t