Add parsing for guards in function clauses

Breaks parsing ambiguities by removing = as an identifier in the old parser
and requiring parentheses for some expressions in the new parser

5 files changed, 25 insertions, 17 deletions

diff --git a/src/initial_check.ml b/src/initial_check.ml
index 6e8af1be..689df577 100644
--- a/src/initial_check.ml
+++ b/src/initial_check.ml
@@ -741,8 +741,8 @@ let to_ast_effects_opt (k_env : kind Envmap.t) (Parse_ast.Effect_opt_aux(e,l)) :
 let to_ast_funcl (names,k_env,def_ord) (Parse_ast.FCL_aux(fcl,l) : Parse_ast.funcl) : (unit funcl) =
   (*let _ = Printf.eprintf "to_ast_funcl\n" in*)
   match fcl with
-  | Parse_ast.FCL_Funcl(id,pat,exp) -> 
-    FCL_aux(FCL_Funcl(to_ast_id id, Pat_aux (Pat_exp (to_ast_pat k_env def_ord pat, to_ast_exp k_env def_ord exp),(l,()))),(l,()))
+  | Parse_ast.FCL_Funcl(id,pexp) ->
+    FCL_aux(FCL_Funcl(to_ast_id id, to_ast_case k_env def_ord pexp),(l,()))
 
 let to_ast_fundef  (names,k_env,def_ord) (Parse_ast.FD_aux(fd,l):Parse_ast.fundef) : (unit fundef) envs_out = 
   match fd with
@@ -839,7 +839,7 @@ let to_ast_def (names, k_env, def_ord) partial_defs def : def_progress envs_out
       | Some(d,k) -> typ_error l "Scattered function definition header name already in use by scattered definition" (Some id) None None)
     | Parse_ast.SD_scattered_funcl(funcl) -> 
       (match funcl with
-      | Parse_ast.FCL_aux(Parse_ast.FCL_Funcl(id,_,_),_) -> 
+      | Parse_ast.FCL_aux(Parse_ast.FCL_Funcl(id,_),_) ->
         let id = to_ast_id id in
         (match (def_in_progress id partial_defs) with
 	| None -> typ_error l "Scattered function definition clause does not match any exisiting function definition headers" (Some id) None None
diff --git a/src/parse_ast.ml b/src/parse_ast.ml
index 705c7ff4..b684725f 100644
--- a/src/parse_ast.ml
+++ b/src/parse_ast.ml
@@ -354,7 +354,7 @@ rec_opt_aux =  (* Optional recursive annotation for functions *)
 
 type 
 funcl_aux =  (* Function clause *)
-   FCL_Funcl of id * pat * exp
+   FCL_Funcl of id * pexp
 
 
 type 
diff --git a/src/parser.mly b/src/parser.mly
index 58f5f1e1..755c2cc7 100644
--- a/src/parser.mly
+++ b/src/parser.mly
@@ -869,8 +869,6 @@ eq_exp:
   | at_exp
     { $1 }
   /* XXX check for consistency */
-  | eq_exp Eq at_exp
-    { eloc (E_app_infix($1,Id_aux(Id($2), locn 2 2), $3)) }
   | eq_exp EqEq at_exp
     { eloc (E_app_infix($1,Id_aux(Id($2), locn 2 2), $3)) }
   | eq_exp ExclEq at_exp
@@ -907,8 +905,6 @@ eq_exp:
 eq_right_atomic_exp:
   | at_right_atomic_exp
     { $1 }
-  | eq_exp Eq at_right_atomic_exp
-    { eloc (E_app_infix($1,Id_aux(Id($2), locn 2 2), $3)) }
   | eq_exp EqEq at_right_atomic_exp
     { eloc (E_app_infix($1,Id_aux(Id($2), locn 2 2), $3)) }
   | eq_exp ExclEq at_right_atomic_exp
@@ -1018,9 +1014,15 @@ letbind:
   | Let_ atomic_pat Eq exp
     { lbloc (LB_val($2,$4)) }
 
+patsexp_funcl:
+  | atomic_pat Eq exp
+    { peloc (Pat_exp($1,$3)) }
+  | atomic_pat When exp Eq exp
+    { peloc (Pat_when ($1, $3, $5)) }
+
 funcl:
-  | id atomic_pat Eq exp
-    { funclloc (FCL_Funcl($1,$2,$4)) }
+  | id patsexp_funcl
+    { funclloc (FCL_Funcl($1,$2)) }
 
 funcl_ands:
   | funcl
diff --git a/src/parser2.mly b/src/parser2.mly
index 21959cf5..500344ad 100644
--- a/src/parser2.mly
+++ b/src/parser2.mly
@@ -998,15 +998,21 @@ exp_list:
   | exp Comma exp_list
     { $1 :: $3 }
 
+funcl_patexp:
+  | pat Eq exp
+    { mk_pexp (Pat_exp ($1, $3)) $startpos $endpos }
+  | pat If_ exp0 Eq exp
+    { mk_pexp (Pat_when ($1, $3, $5)) $startpos $endpos }
+
 funcl:
-  | id pat Eq exp
-    { mk_funcl (FCL_Funcl ($1, $2, $4)) $startpos $endpos }
+  | id funcl_patexp
+    { mk_funcl (FCL_Funcl ($1, $2)) $startpos $endpos }
 
 funcls:
-  | id pat Eq exp
-    { [mk_funcl (FCL_Funcl ($1, $2, $4)) $startpos $endpos] }
-  | id pat Eq exp And funcls
-    { mk_funcl (FCL_Funcl ($1, $2, $4)) $startpos $endpos :: $6 }
+  | id funcl_patexp
+    { [mk_funcl (FCL_Funcl ($1, $2)) $startpos $endpos] }
+  | id funcl_patexp And funcls
+    { mk_funcl (FCL_Funcl ($1, $2)) $startpos $endpos :: $4 }
 
 type_def:
   | Typedef id typquant Eq typ
diff --git a/src/pretty_print_sail.ml b/src/pretty_print_sail.ml
index 05dbb9ee..68f414b3 100644
--- a/src/pretty_print_sail.ml
+++ b/src/pretty_print_sail.ml
@@ -490,7 +490,7 @@ let doc_funcl (FCL_aux(FCL_Funcl(id,pexp),_)) =
   | Pat_aux (Pat_exp (pat,exp),_) ->
      group (doc_op equals (separate space [doc_id id; doc_atomic_pat pat]) (doc_exp exp))
   | Pat_aux (Pat_when (pat,wh,exp),_) ->
-     group (doc_op equals (separate space [doc_id id; doc_atomic_pat pat; string "if"; doc_exp wh])
+     group (doc_op equals (separate space [doc_id id; doc_atomic_pat pat; string "when"; doc_exp wh])
               (doc_exp exp))
 
 let doc_fundef (FD_aux(FD_function(r, typa, efa, fcls),_)) =