Commit 44135941 authored by Andrei Paskevich's avatar Andrei Paskevich

parsing epsilon expressions

parent a466c154
...@@ -49,6 +49,7 @@ ...@@ -49,6 +49,7 @@
"clone", CLONE; "clone", CLONE;
"else", ELSE; "else", ELSE;
"end", END; "end", END;
"epsilon", EPSILON;
"exists", EXISTS; "exists", EXISTS;
"export", EXPORT; "export", EXPORT;
"false", FALSE; "false", FALSE;
...@@ -161,8 +162,6 @@ rule token = parse ...@@ -161,8 +162,6 @@ rule token = parse
{ LEFTPAR } { LEFTPAR }
| ")" | ")"
{ RIGHTPAR } { RIGHTPAR }
| "!"
{ BANG }
| ":" | ":"
{ COLON } { COLON }
| "->" | "->"
...@@ -177,18 +176,12 @@ rule token = parse ...@@ -177,18 +176,12 @@ rule token = parse
{ OP2 (String.make 1 c) } { OP2 (String.make 1 c) }
| "*" | "/" | "%" as c | "*" | "/" | "%" as c
{ OP3 (String.make 1 c) } { OP3 (String.make 1 c) }
| "@"
{ AT }
| "." | "."
{ DOT } { DOT }
| "[" | "["
{ LEFTSQ } { LEFTSQ }
| "]" | "]"
{ RIGHTSQ } { RIGHTSQ }
| "{"
{ LEFTB }
| "}"
{ RIGHTB }
| "|" | "|"
{ BAR } { BAR }
| "\"" | "\""
......
...@@ -54,25 +54,21 @@ ...@@ -54,25 +54,21 @@
/* keywords */ /* keywords */
%token AND AS AXIOM %token AND AS AXIOM CLONE
%token CLONE %token ELSE END EPSILON EXISTS EXPORT FALSE FORALL
%token ELSE END EXISTS EXPORT FALSE FORALL %token GOAL IF IMPORT IN INDUCTIVE LEMMA
%token GOAL %token LET LOGIC MATCH NAMESPACE NOT OR
%token IF IMPORT IN INDUCTIVE LEMMA %token THEN THEORY TRUE TYPE USE WITH
%token LET LOGIC MATCH
%token NAMESPACE NOT OR
%token THEN THEORY TRUE TYPE
%token USE WITH
/* symbols */ /* symbols */
%token ARROW AT %token ARROW
%token BANG BAR %token BAR
%token COLON COMMA %token COLON COMMA
%token DOT EQUAL %token DOT EQUAL
%token LEFTB LEFTPAR LEFTSQ %token LEFTPAR LEFTSQ
%token LRARROW %token LRARROW
%token QUOTE RIGHTB %token QUOTE
%token RIGHTPAR RIGHTSQ %token RIGHTPAR RIGHTSQ
%token UNDERSCORE %token UNDERSCORE
...@@ -81,30 +77,25 @@ ...@@ -81,30 +77,25 @@
/* Precedences */ /* Precedences */
%left LEFTB %nonassoc prec_decls
%nonassoc LOGIC TYPE INDUCTIVE
%left COLON
%left IN
%left ELSE %nonassoc COLON
%nonassoc ELSE
%nonassoc IN
%nonassoc DOT
%right prec_named %nonassoc prec_named
%right prec_quant
%right ARROW LRARROW %right ARROW LRARROW
%right OR %right OR
%right AND %right AND
%right NOT %nonassoc NOT
%right prec_if
%left EQUAL OP0 %left EQUAL OP0
%left OP1 %left OP1
%left OP2 %left OP2
%left OP3 %left OP3
%right unary_op %nonassoc prefix_op
%left LEFTSQ %nonassoc postfix_op
%nonassoc prec_decls
%nonassoc LOGIC TYPE INDUCTIVE
/* Entry points */ /* Entry points */
...@@ -385,11 +376,11 @@ lexpr: ...@@ -385,11 +376,11 @@ lexpr:
| lexpr OP3 lexpr | lexpr OP3 lexpr
{ let id = { id = infix $2; id_loc = loc_i 2 } in { let id = { id = infix $2; id_loc = loc_i 2 } in
mk_pp (PPapp (Qident id, [$1; $3])) } mk_pp (PPapp (Qident id, [$1; $3])) }
| any_op lexpr %prec unary_op | any_op lexpr %prec prefix_op
{ let id = { id = prefix $1; id_loc = loc_i 2 } in { let id = { id = prefix $1; id_loc = loc_i 2 } in
mk_pp (PPapp (Qident id, [$2])) } mk_pp (PPapp (Qident id, [$2])) }
/* /*
| lexpr any_op %prec unary_op | lexpr any_op %prec postfix_op
{ let id = { id = postfix $2; id_loc = loc_i 2 } in { let id = { id = postfix $2; id_loc = loc_i 2 } in
mk_pp (PPapp (Qident id, [$1])) } mk_pp (PPapp (Qident id, [$1])) }
*/ */
...@@ -397,11 +388,11 @@ lexpr: ...@@ -397,11 +388,11 @@ lexpr:
{ mk_pp (PPvar $1) } { mk_pp (PPvar $1) }
| qualid LEFTPAR list1_lexpr_sep_comma RIGHTPAR | qualid LEFTPAR list1_lexpr_sep_comma RIGHTPAR
{ mk_pp (PPapp ($1, $3)) } { mk_pp (PPapp ($1, $3)) }
| IF lexpr THEN lexpr ELSE lexpr %prec prec_if | IF lexpr THEN lexpr ELSE lexpr
{ mk_pp (PPif ($2, $4, $6)) } { mk_pp (PPif ($2, $4, $6)) }
| FORALL list1_uquant_sep_comma triggers DOT lexpr %prec prec_quant | FORALL list1_uquant_sep_comma triggers DOT lexpr
{ mk_pp (PPquant (PPforall, $2, $3, $5)) } { mk_pp (PPquant (PPforall, $2, $3, $5)) }
| EXISTS list1_uquant_sep_comma triggers DOT lexpr %prec prec_quant | EXISTS list1_uquant_sep_comma triggers DOT lexpr
{ mk_pp (PPquant (PPexists, $2, $3, $5)) } { mk_pp (PPquant (PPexists, $2, $3, $5)) }
| INTEGER | INTEGER
{ mk_pp (PPconst (Term.ConstInt $1)) } { mk_pp (PPconst (Term.ConstInt $1)) }
...@@ -419,6 +410,8 @@ lexpr: ...@@ -419,6 +410,8 @@ lexpr:
{ mk_pp (PPlet ($2, $4, $6)) } { mk_pp (PPlet ($2, $4, $6)) }
| MATCH list1_lexpr_sep_comma WITH bar_ match_cases END | MATCH list1_lexpr_sep_comma WITH bar_ match_cases END
{ mk_pp (PPmatch ($2, $5)) } { mk_pp (PPmatch ($2, $5)) }
| EPSILON lident COLON primitive_type DOT lexpr
{ mk_pp (PPeps ($2, $4, $6)) }
| lexpr COLON primitive_type | lexpr COLON primitive_type
{ mk_pp (PPcast ($1, $3)) } { mk_pp (PPcast ($1, $3)) }
; ;
...@@ -449,6 +442,7 @@ pattern: ...@@ -449,6 +442,7 @@ pattern:
| uqualid { mk_pat (PPpapp ($1, [])) } | uqualid { mk_pat (PPpapp ($1, [])) }
| uqualid LEFTPAR list1_pat_sep_comma RIGHTPAR { mk_pat (PPpapp ($1, $3)) } | uqualid LEFTPAR list1_pat_sep_comma RIGHTPAR { mk_pat (PPpapp ($1, $3)) }
| pattern AS lident { mk_pat (PPpas ($1,$3)) } | pattern AS lident { mk_pat (PPpas ($1,$3)) }
| LEFTPAR pattern RIGHTPAR { $2 }
; ;
triggers: triggers:
......
...@@ -72,7 +72,7 @@ and pp_desc = ...@@ -72,7 +72,7 @@ and pp_desc =
| PPquant of pp_quant * uquant list * lexpr list list * lexpr | PPquant of pp_quant * uquant list * lexpr list list * lexpr
| PPnamed of string * lexpr | PPnamed of string * lexpr
| PPlet of ident * lexpr * lexpr | PPlet of ident * lexpr * lexpr
(* | PPeps of ident * lexpr *) | PPeps of ident * pty * lexpr
| PPmatch of lexpr list * (pattern list * lexpr) list | PPmatch of lexpr list * (pattern list * lexpr) list
| PPcast of lexpr * pty | PPcast of lexpr * pty
......
...@@ -266,7 +266,7 @@ and dterm_node = ...@@ -266,7 +266,7 @@ and dterm_node =
| Tlet of dterm * string * dterm | Tlet of dterm * string * dterm
| Tmatch of dterm list * (dpattern list * dterm) list | Tmatch of dterm list * (dpattern list * dterm) list
| Tnamed of string * dterm | Tnamed of string * dterm
| Teps of string * dfmla | Teps of string * dty * dfmla
and dfmla = and dfmla =
| Fapp of lsymbol * dterm list | Fapp of lsymbol * dterm list
...@@ -413,6 +413,11 @@ and dterm_node loc env = function ...@@ -413,6 +413,11 @@ and dterm_node loc env = function
let ty = dty env ty in let ty = dty env ty in
if not (unify e1.dt_ty ty) then term_expected_type ~loc e1.dt_ty ty; if not (unify e1.dt_ty ty) then term_expected_type ~loc e1.dt_ty ty;
e1.dt_node, ty e1.dt_node, ty
| PPeps ({id=x}, ty, e1) ->
let ty = dty env ty in
let env = { env with dvars = Mstr.add x ty env.dvars } in
let e1 = dfmla env e1 in
Teps (x, ty, e1), ty
| PPquant _ | PPif _ | PPquant _ | PPif _
| PPprefix _ | PPinfix _ | PPfalse | PPtrue -> | PPprefix _ | PPinfix _ | PPfalse | PPtrue ->
error ~loc TermExpected error ~loc TermExpected
...@@ -474,7 +479,7 @@ and dfmla env e = match e.pp_desc with ...@@ -474,7 +479,7 @@ and dfmla env e = match e.pp_desc with
Fnamed (x, f1) Fnamed (x, f1)
| PPvar x -> | PPvar x ->
Fvar (snd (find_prop x env.uc)) Fvar (snd (find_prop x env.uc))
| PPconst _ | PPcast _ -> | PPeps _ | PPconst _ | PPcast _ ->
error ~loc:e.pp_loc PredicateExpected error ~loc:e.pp_loc PredicateExpected
and dpat_list env tl pl = and dpat_list env tl pl =
...@@ -551,8 +556,12 @@ let rec term env t = match t.dt_node with ...@@ -551,8 +556,12 @@ let rec term env t = match t.dt_node with
| Tnamed (x, e1) -> | Tnamed (x, e1) ->
let e1 = term env e1 in let e1 = term env e1 in
t_label_add x e1 t_label_add x e1
| Teps _ -> | Teps (x, ty, e1) ->
assert false (*TODO*) let ty = ty_of_dty ty in
let v = create_vsymbol (id_fresh x) ty in
let env = Mstr.add x v env in
let e1 = fmla env e1 in
t_eps v e1
and fmla env = function and fmla env = function
| Ftrue -> | Ftrue ->
......
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