diff options
Diffstat (limited to 'src/parser.mly')
| -rw-r--r-- | src/parser.mly | 170 |
1 files changed, 98 insertions, 72 deletions
diff --git a/src/parser.mly b/src/parser.mly index bd68cfdc..8e5023c8 100644 --- a/src/parser.mly +++ b/src/parser.mly @@ -129,9 +129,9 @@ let make_vector_sugar order_set is_inc typ typ1 = /*Terminals with no content*/ %token And Alias As Assert Bitzero Bitone Bits By Case Clause Const Dec Def Default Deinfix Effect EFFECT End -%token Enumerate Else Exit Extern False Forall Foreach Function_ If_ In IN Inc Let_ Member Nat Order +%token Enumerate Else Exit Extern False Forall Foreach Overload Function_ If_ In IN Inc Let_ Member Nat NatNum Order Cast %token Pure Rec Register Return Scattered Sizeof Struct Switch Then True TwoStarStar Type TYPE Typedef -%token Undefined Union With Val +%token Undefined Union With When Val Constraint %token Barr Depend Rreg Wreg Rmem Rmemt Wmem Wmv Wmvt Eamem Exmem Undef Unspec Nondet Escape @@ -150,7 +150,7 @@ let make_vector_sugar order_set is_inc typ typ1 = %token <string> Id TyVar TyId %token <int> Num -%token <string> String Bin Hex +%token <string> String Bin Hex Real %token <string> Amp At Carrot Div Eq Excl Gt Lt Plus Star Tilde %token <string> AmpAmp CarrotCarrot Colon ColonColon EqEq ExclEq ExclExcl @@ -209,6 +209,10 @@ id: { idl (DeIid($3)) } | Lparen Deinfix Lt Rparen { idl (DeIid($3)) } + | Lparen Deinfix GtUnderS Rparen + { idl (DeIid($3)) } + | Lparen Deinfix LtUnderS Rparen + { idl (DeIid($3)) } | Lparen Deinfix Minus Rparen { idl (DeIid("-")) } | Lparen Deinfix MinusUnderS Rparen @@ -226,7 +230,7 @@ id: | Lparen Deinfix AmpAmp Rparen { idl (DeIid($3)) } | Lparen Deinfix Bar Rparen - { idl (DeIid("||")) } + { idl (DeIid("|")) } | Lparen Deinfix BarBar Rparen { idl (DeIid("||")) } | Lparen Deinfix CarrotCarrot Rparen @@ -243,6 +247,8 @@ id: { idl (DeIid($3)) } | Lparen Deinfix GtEq Rparen { idl (DeIid($3)) } + | Lparen Deinfix GtEqUnderS Rparen + { idl (DeIid($3)) } | Lparen Deinfix GtEqPlus Rparen { idl (DeIid($3)) } | Lparen Deinfix GtGt Rparen @@ -257,6 +263,8 @@ id: { idl (DeIid($3)) } | Lparen Deinfix LtEq Rparen { idl (DeIid($3)) } + | Lparen Deinfix LtEqUnderS Rparen + { idl (DeIid($3)) } | Lparen Deinfix LtLt Rparen { idl (DeIid($3)) } | Lparen Deinfix LtLtLt Rparen @@ -283,6 +291,8 @@ atomic_kind: { bkloc BK_type } | Nat { bkloc BK_nat } + | NatNum + { bkloc BK_nat } | Order { bkloc BK_order } | EFFECT @@ -342,29 +352,7 @@ effect_typ: | Pure { tloc (ATyp_set([])) } -atomic_typ: - | tid - { tloc (ATyp_id $1) } - | tyvar - { tloc (ATyp_var $1) } - | effect_typ - { $1 } - | Inc - { tloc (ATyp_inc) } - | Dec - { tloc (ATyp_dec) } - | SquareBar nexp_typ BarSquare - { tloc (make_range_sugar $2) } - | SquareBar nexp_typ Colon nexp_typ BarSquare - { tloc (make_range_sugar_bounded $2 $4) } - | SquareColon nexp_typ ColonSquare - { tloc (make_atom_sugar $2) } - | Lparen typ Rparen - { $2 } - vec_typ: - | atomic_typ - { $1 } | tid Lsquare nexp_typ Rsquare { tloc (make_vector_sugar false false (ATyp_aux ((ATyp_id $1), locn 1 1)) $3) } | tid Lsquare nexp_typ Colon nexp_typ Rsquare @@ -383,68 +371,75 @@ vec_typ: { tloc (make_vector_sugar_bounded true false "vector" (ATyp_aux ((ATyp_var $1), locn 1 1)) $3 $5) } app_typs: - | nexp_typ + | atomic_typ { [$1] } - | nexp_typ Comma app_typs + | atomic_typ Comma app_typs { $1::$3 } -app_typ: +atomic_typ: | vec_typ { $1 } + | range_typ + { $1 } + | nexp_typ + { $1 } + | Inc + { tloc (ATyp_inc) } + | Dec + { tloc (ATyp_dec) } | tid Lt app_typs Gt { tloc (ATyp_app($1,$3)) } | Register Lt app_typs Gt { tloc (ATyp_app(Id_aux(Id "register", locn 1 1),$3)) } -app_num_typ: - | app_typ - { $1 } - | Num - { tloc (ATyp_constant $1) } +range_typ: + | SquareBar nexp_typ BarSquare + { tloc (make_range_sugar $2) } + | SquareBar nexp_typ Colon nexp_typ BarSquare + { tloc (make_range_sugar_bounded $2 $4) } + | SquareColon nexp_typ ColonSquare + { tloc (make_atom_sugar $2) } -star_typ: - | app_num_typ +nexp_typ: + | nexp_typ Plus nexp_typ2 + { tloc (ATyp_sum ($1, $3)) } + | nexp_typ Minus nexp_typ2 + { tloc (ATyp_minus ($1, $3)) } + | Minus nexp_typ2 + { tloc (ATyp_neg $2) } + | nexp_typ2 { $1 } - | app_num_typ Star nexp_typ - { tloc (ATyp_times ($1, $3)) } -exp_typ: - | star_typ - { $1 } - | TwoStarStar atomic_typ - { tloc (ATyp_exp($2)) } - | TwoStarStar Num - { tloc (ATyp_exp (tloc (ATyp_constant $2))) } +nexp_typ2: + | nexp_typ2 Star nexp_typ3 + { tloc (ATyp_times ($1, $3)) } + | nexp_typ3 + { $1 } -nexp_typ: - | exp_typ +nexp_typ3: + | TwoStarStar nexp_typ4 + { tloc (ATyp_exp $2) } + | nexp_typ4 { $1 } - | atomic_typ Plus nexp_typ - { tloc (ATyp_sum($1,$3)) } - | Lparen atomic_typ Plus nexp_typ Rparen - { tloc (ATyp_sum($2,$4)) } - | Num Plus nexp_typ - { tloc (ATyp_sum((tlocl (ATyp_constant $1) 1 1),$3)) } - | Lparen Num Plus nexp_typ Rparen - { tloc (ATyp_sum((tlocl (ATyp_constant $2) 2 2),$4)) } - | atomic_typ Minus nexp_typ - { tloc (ATyp_minus($1,$3)) } - | Lparen atomic_typ Minus nexp_typ Rparen - { tloc (ATyp_minus($2,$4)) } - | Num Minus nexp_typ - { tloc (ATyp_minus((tlocl (ATyp_constant $1) 1 1),$3)) } - | Lparen Num Minus nexp_typ Rparen - { tloc (ATyp_minus((tlocl (ATyp_constant $2) 2 2),$4)) } +nexp_typ4: + | Num + { tlocl (ATyp_constant $1) 1 1 } + | tid + { tloc (ATyp_id $1) } + | tyvar + { tloc (ATyp_var $1) } + | Lparen tup_typ Rparen + { $2 } tup_typ_list: - | app_typ Comma app_typ + | atomic_typ Comma atomic_typ { [$1;$3] } - | app_typ Comma tup_typ_list + | atomic_typ Comma tup_typ_list { $1::$3 } tup_typ: - | app_typ + | atomic_typ { $1 } | Lparen tup_typ_list Rparen { tloc (ATyp_tup $2) } @@ -452,7 +447,7 @@ tup_typ: typ: | tup_typ { $1 } - | tup_typ MinusGt typ Effect effect_typ + | tup_typ MinusGt tup_typ Effect effect_typ { tloc (ATyp_fn($1,$3,$5)) } lit: @@ -470,6 +465,8 @@ lit: { lloc (L_bin $1) } | Hex { lloc (L_hex $1) } + | Real + { lloc (L_real $1) } | Undefined { lloc L_undef } | Bitzero @@ -477,7 +474,6 @@ lit: | Bitone { lloc L_one } - atomic_pat: | lit { ploc (P_lit $1) } @@ -485,8 +481,8 @@ atomic_pat: { ploc P_wild } | Lparen pat As id Rparen { ploc (P_as($2,$4)) } - | Lparen typ Rparen atomic_pat - { ploc (P_typ($2,$4)) } + | Lparen tup_typ Rparen atomic_pat + { ploc (P_typ($2,$4)) } | id { ploc (P_app($1,[])) } | Lcurly fpats Rcurly @@ -507,6 +503,8 @@ atomic_pat: { ploc (P_list([$2])) } | SquareBarBar comma_pats BarBarSquare { ploc (P_list($2)) } + | atomic_pat ColonColon pat + { ploc (P_cons ($1, $3)) } | Lparen pat Rparen { $2 } @@ -569,7 +567,7 @@ atomic_exp: { eloc (E_lit($1)) } | Lparen exp Rparen { $2 } - | Lparen typ Rparen atomic_exp + | Lparen tup_typ Rparen atomic_exp { eloc (E_cast($2,$4)) } | Lparen comma_exps Rparen { eloc (E_tuple($2)) } @@ -597,6 +595,8 @@ atomic_exp: { eloc (E_case($2,$4)) } | Sizeof atomic_typ { eloc (E_sizeof($2)) } + | Constraint Lparen nexp_constraint Rparen + { eloc (E_constraint $3) } | Exit atomic_exp { eloc (E_exit $2) } | Return atomic_exp @@ -656,7 +656,7 @@ right_atomic_exp: if $6 <> "to" && $6 <> "downto" then raise (Parse_error_locn ((loc ()),"Missing \"to\" or \"downto\" in foreach loop")); let step = eloc (E_lit(lloc (L_num 1))) in - let ord = + let ord = if $6 = "to" then ATyp_aux(ATyp_inc,(locn 6 6)) else ATyp_aux(ATyp_dec,(locn 6 6)) in @@ -970,6 +970,8 @@ case_exps: patsexp: | atomic_pat MinusGt exp { peloc (Pat_exp($1,$3)) } + | atomic_pat When exp MinusGt exp + { peloc (Pat_when ($1, $3, $5)) } letbind: | Let_ atomic_pat Eq exp @@ -1023,6 +1025,10 @@ val_spec: { vloc (VS_val_spec(mk_typschm $2 $3 2 3,$4)) } | Val typ id { vloc (VS_val_spec(mk_typschm (mk_typqn ()) $2 2 2,$3)) } + | Val Cast typquant typ id + { vloc (VS_cast_spec (mk_typschm $3 $4 3 4,$5)) } + | Val Cast typ id + { vloc (VS_cast_spec (mk_typschm (mk_typqn ()) $3 3 3, $4)) } | Val Extern typquant typ id { vloc (VS_extern_no_rename (mk_typschm $3 $4 3 4,$5)) } | Val Extern typ id @@ -1051,14 +1057,32 @@ nums: { $1::$3 } nexp_constraint: + | nexp_constraint1 + { $1 } + | nexp_constraint1 Bar nexp_constraint + { NC_aux (NC_or ($1, $3), loc ()) } + +nexp_constraint1: + | nexp_constraint2 + { $1 } + | nexp_constraint2 Amp nexp_constraint1 + { NC_aux (NC_and ($1, $3), loc ()) } + +nexp_constraint2: | nexp_typ Eq nexp_typ { NC_aux(NC_fixed($1,$3), loc () ) } + | nexp_typ ExclEq nexp_typ + { NC_aux (NC_not_equal ($1, $3), loc ()) } | nexp_typ GtEq nexp_typ { NC_aux(NC_bounded_ge($1,$3), loc () ) } | nexp_typ LtEq nexp_typ { NC_aux(NC_bounded_le($1,$3), loc () ) } + | tyvar In Lcurly nums Rcurly + { NC_aux(NC_nat_set_bounded($1,$4), loc ()) } | tyvar IN Lcurly nums Rcurly { NC_aux(NC_nat_set_bounded($1,$4), loc ()) } + | Lparen nexp_constraint Rparen + { $2 } id_constraint: | nexp_constraint @@ -1266,6 +1290,8 @@ def: { dloc (DEF_spec($1)) } | default_typ { dloc (DEF_default($1)) } + | Overload id Lsquare enum_body Rsquare + { dloc (DEF_overload($2,$4)) } | Register typ id { dloc (DEF_reg_dec(DEC_aux(DEC_reg($2,$3),loc ()))) } | Register Alias id Eq exp |
