Commit 66c118cf authored by POGODALLA Sylvain's avatar POGODALLA Sylvain

Bug fix when both types and terms have the same name in a signature (abstract...

Bug fix when both types and terms have the same name in a signature (abstract and object) and in lexicons
parent a33a9477
......@@ -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)
......
......@@ -48,8 +48,10 @@
exception No_sig
type type_or_cst =
| Nothing
| Type
| Cst
| Both
exception Is_type
exception Is_cst
......@@ -140,28 +142,28 @@
%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 ->
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 ->
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment