From 66c118cfd3f96462b4fb2c462e203f4cd3e4d906 Mon Sep 17 00:00:00 2001
From: Sylvain Pogodalla <sylvain.pogodalla@inria.fr>
Date: Fri, 5 Dec 2008 14:58:23 +0000
Subject: [PATCH] Bug fix when both types and terms have the same name in a
 signature (abstract and object) and in lexicons

---
 src/acg-data/lexicon.ml |  4 +-
 src/grammars/parser.dyp | 95 +++++++++++++++++++++++------------------
 2 files changed, 56 insertions(+), 43 deletions(-)

diff --git a/src/acg-data/lexicon.ml b/src/acg-data/lexicon.ml
index f02af47..4930445 100644
--- a/src/acg-data/lexicon.ml
+++ b/src/acg-data/lexicon.ml
@@ -125,8 +125,8 @@ struct
 	(fun e acc ->
 	   match Sg.is_declared e abs with
 	     | Some s ->
-		 (try
-		    let _ = Utils.StringMap.find s d in
+		 (let () = Printf.printf "%s\n" s in try
+		    let _ = Dico.find s d in
 		      acc
 		  with
 		    | Not_found -> s::acc) 
diff --git a/src/grammars/parser.dyp b/src/grammars/parser.dyp
index bd812d0..b8c61a0 100644
--- a/src/grammars/parser.dyp
+++ b/src/grammars/parser.dyp
@@ -48,8 +48,10 @@
   exception No_sig
 
   type type_or_cst =
+    | Nothing
     | Type
     | Cst
+    | Both
 
   exception Is_type
   exception Is_cst
@@ -135,33 +137,33 @@
     let s = Entry.valuation_to_string v in
       raise (Error.Error (Error.Lexer_error (Error.Expect s,(p1,p2))))
 
-      
+	
 }
 
 
 %token
- EOI
-<Abstract_syntax.location> EQUAL
-<Abstract_syntax.location> SEMICOLON
-<Abstract_syntax.location> COLON
-<Abstract_syntax.location> COMMA
-<Abstract_syntax.location> LPAREN
-<Abstract_syntax.location> RPAREN
-<Abstract_syntax.location> DOT
-<Abstract_syntax.location> SIG_OPEN
-<Abstract_syntax.location> LEX_OPEN
-<Abstract_syntax.location> END_OF_DEC
-<Abstract_syntax.location> TYPE
-<Abstract_syntax.location> PREFIX
-<Abstract_syntax.location> INFIX
-<Abstract_syntax.location> BINDER
-<Abstract_syntax.location> LAMBDA
-<Abstract_syntax.location> LAMBDA0
-<Abstract_syntax.location> ARROW
-<Abstract_syntax.location> COLON_EQUAL
-<Abstract_syntax.location> LIN_ARROW
-<(string*Abstract_syntax.location)> IDENT
-<(string*Abstract_syntax.location)> SYMBOL
+EOI
+					 <Abstract_syntax.location> EQUAL
+					 <Abstract_syntax.location> SEMICOLON
+					 <Abstract_syntax.location> COLON
+					 <Abstract_syntax.location> COMMA
+					 <Abstract_syntax.location> LPAREN
+					 <Abstract_syntax.location> RPAREN
+					 <Abstract_syntax.location> DOT
+					 <Abstract_syntax.location> SIG_OPEN
+					 <Abstract_syntax.location> LEX_OPEN
+					 <Abstract_syntax.location> END_OF_DEC
+					 <Abstract_syntax.location> TYPE
+					 <Abstract_syntax.location> PREFIX
+					 <Abstract_syntax.location> INFIX
+					 <Abstract_syntax.location> BINDER
+					 <Abstract_syntax.location> LAMBDA
+					 <Abstract_syntax.location> LAMBDA0
+					 <Abstract_syntax.location> ARROW
+					 <Abstract_syntax.location> COLON_EQUAL
+					 <Abstract_syntax.location> LIN_ARROW
+					 <(string*Abstract_syntax.location)> IDENT
+					 <(string*Abstract_syntax.location)> SYMBOL
   
 %start <E.t> data  
 %start <E.Signature1.t -> E.Signature1.t> sig_entry  
@@ -417,31 +419,42 @@ sig_entries :
     let kind =
       List.fold_left
 	(fun k (id,loc) ->
-	   match k,fst (E.Signature1.is_constant id abs) with
-	     | (None|Some Cst),true -> Some Cst
-	     | None,false ->
-		 if (E.Signature1.is_type id abs)
-		 then
-		   raise Dyp.Giveup 
-		 else
-		   emit_parse_error (Error.Unknown_constant id) loc
-	     | Some Cst,false -> emit_parse_error (Error.Unknown_constant id) loc
-	     | Some Type,_ -> failwith "Bug: should not occur")
-	None
-	ids in ()}
+	   match k,fst (E.Signature1.is_constant id abs),E.Signature1.is_type id abs with
+	     | (Nothing|Cst|Both),true,false -> Cst
+	     | (Nothing|Both),true,true -> Both
+	     | Cst,true,_ -> Cst
+	     | (Nothing|Both),false,true -> raise Dyp.Giveup 
+	     | (Nothing|Both),false,false -> emit_parse_error (Error.Unknown_constant id) loc
+	     | Cst,false,_ -> emit_parse_error (Error.Unknown_constant id) loc
+	     | Type,_,_ -> failwith "Bug: should not occur")
+	Nothing
+	ids in
+      kind}<kind>
 	  term<t>  {
-	      fun lex ->
-		let term = fst (t Env.empty []) in
+	    try
+	      let term = fst (t Env.empty []) in
+		fun lex ->
 		  List.fold_left
 		    (fun acc (id,loc) -> E.Lexicon.insert (Abstract_syntax.Constant (id,loc,term)) acc)
 		    lex
-		    ids}
+		    ids
+	    with
+	      | Error.Error (Error.Parse_error (Error.Unknown_constant _,_)) when kind = Both -> raise Dyp.Giveup
+	      | exc -> raise exc}
 | comma_ids<ids> COLON_EQUAL ...{
     let abs,obj = get_abs_and_obj_sig_value dyp.last_local_data in    
     let kind =
       List.fold_left
 	(fun k (id,loc) ->
-	   match k,E.Signature1.is_type id abs with
+	   match k,fst (E.Signature1.is_constant id abs),E.Signature1.is_type id abs with
+	     | (Nothing|Type|Both),false,true -> Type
+	     | (Nothing|Both),true,true -> Both
+	     | Type,_,true -> Type
+	     | (Nothing|Both),true,false -> raise Dyp.Giveup 
+	     | (Nothing|Both),false,false -> emit_parse_error (Error.Unknown_type id) loc
+	     | Type,_,false -> emit_parse_error (Error.Unknown_type id) loc
+	     | Cst,_,_ -> failwith "Bug: should not occur"
+(*	   match k,E.Signature1.is_type id abs with
 	     | (None|Some Type),true -> Some Type
 	     | None,false ->
 		 if fst (E.Signature1.is_constant id abs)
@@ -450,8 +463,8 @@ sig_entries :
 		 else
 		   emit_parse_error (Error.Unknown_type id) loc
 	     | Some Type,false -> emit_parse_error (Error.Unknown_type id) loc
-	     | Some Cst,_ -> failwith "Bug: should not occur")
-	None
+	     | Some Cst,_ -> failwith "Bug: should not occur"*) )
+	Nothing
 	ids in ()}
 	      type_expression<ty>  {
 		  fun lex ->
-- 
2.24.1