[r2004-01-23 13:55:11 by afrisch] Bug fix

Original author: afrisch
Date: 2004-01-23 13:55:11+00:00

TODO

@@ -205,3 +205,26 @@ Alain 2003-05-29
 
 Alain 2003-06-17  
   Fait, il y a qq temps déjà
+
+======================================================================
+
+Alain 2004-01-22
+
+
+Bug signalé par Cedric:
+        CDuce version 0.2.0-pre3
+
+# let fun toto ( String -> String)
+ |Int -> x
+ |_ -> raise "";;
+Warning at chars 35-43:
+This branch is not used
+Fatal error: exception Failure("Compile: cannot find x")
+
+
+La branche inutilisée n'est pas du tout type-checkée.
+Solutions possibles:
+ - type-checker quand même les branches inutilisées
+ - eventuellement, vérifier seulement la definition des variables utilisées
+ - calculer les variables libres d'une fonction après la detection
+   des branches inutilisées, pour ne pas en tenir compte
\ No newline at end of file

compile/compile.ml

@@ -97,8 +97,11 @@ and compile_abstr env a =
   Abstraction (slots, a.Typed.fun_iface, body)
 
 and compile_branches env tail (brs : Typed.branches) =
+  (* Don't compile unused branches, because they have not been
+     type checked. *)
+  let used = List.filter (fun br -> br.Typed.br_used) brs.Typed.br_branches in
   { 
-    brs = List.map (compile_branch env tail) brs.Typed.br_branches;
+    brs = List.map (compile_branch env tail) used;
     brs_tail = tail;
     brs_accept_chars = not (Types.Char.is_empty brs.Typed.br_accept);
     brs_input = brs.Typed.br_typ;

typing/typer.ml

@@ -1011,7 +1011,7 @@ let flatten loc arg constr precise =
     if precise then Sequence.flatten t else constr
   else
     let t = arg sconstr' true in
-    Sequence.flatten t
+    verify loc (Sequence.flatten t) constr
 
 let rec type_check env e constr precise = 
   let d = type_check' e.exp_loc env e.exp_descr constr precise in
@@ -1255,7 +1255,7 @@ and type_map loc env def e b constr precise =
 	 let res = 
 	   type_check_branches loc env t b constr' (precise || (not exact)) in
 	 if def && not (Types.subtype t b.br_accept) 
-	 then Types.cup res Sequence.nil_type
+	 then (require loc Sequence.nil_type constr'; Types.cup res Sequence.nil_type)
 	 else res)
       t in
   if exact then res else verify loc res constr