diff options
Diffstat (limited to 'src/ast.ml')
| -rw-r--r-- | src/ast.ml | 215 |
1 files changed, 119 insertions, 96 deletions
@@ -20,19 +20,14 @@ base_kind_aux = (* base kind *) type -base_kind = - BK_aux of base_kind_aux * l - - -type id_aux = (* Identifier *) Id of x | DeIid of x (* remove infix status *) type -kind_aux = (* kinds *) - K_kind of (base_kind) list +base_kind = + BK_aux of base_kind_aux * l type @@ -41,8 +36,8 @@ id = type -kind = - K_aux of kind_aux * l +kind_aux = (* kinds *) + K_kind of (base_kind) list type @@ -58,9 +53,8 @@ and nexp = type -kinded_id_aux = (* optionally kind-annotated identifier *) - KOpt_none of id (* identifier *) - | KOpt_kind of kind * id (* kind-annotated variable *) +kind = + K_aux of kind_aux * l type @@ -72,6 +66,22 @@ nexp_constraint_aux = (* constraint over kind $_$ *) type +kinded_id_aux = (* optionally kind-annotated identifier *) + KOpt_none of id (* identifier *) + | KOpt_kind of kind * id (* kind-annotated variable *) + + +type +nexp_constraint = + NC_aux of nexp_constraint_aux * l + + +type +kinded_id = + KOpt_aux of kinded_id_aux * l + + +type efct_aux = (* effect *) Effect_rreg (* read register *) | Effect_wreg (* write register *) @@ -83,13 +93,9 @@ efct_aux = (* effect *) type -kinded_id = - KOpt_aux of kinded_id_aux * l - - -type -nexp_constraint = - NC_aux of nexp_constraint_aux * l +quant_item_aux = (* Either a kinded identifier or a nexp constraint for a typquant *) + QI_id of kinded_id (* An optionally kinded identifier *) + | QI_const of nexp_constraint (* A constraint for this type *) type @@ -98,9 +104,8 @@ efct = type -quant_item_aux = (* Either a kinded identifier or a nexp constraint for a typquant *) - QI_id of kinded_id (* An optionally kinded identifier *) - | QI_const of nexp_constraint (* A constraint for this type *) +quant_item = + QI_aux of quant_item_aux * l type @@ -117,8 +122,9 @@ order_aux = (* vector order specifications, of kind $_$ *) type -quant_item = - QI_aux of quant_item_aux * l +typquant_aux = (* type quantifiers and constraints *) + TypQ_tq of (quant_item) list + | TypQ_no_forall (* sugar, omitting quantifier and constraints *) type @@ -132,22 +138,8 @@ order = type -typquant_aux = (* type quantifiers and constraints *) - TypQ_tq of (quant_item) list - | TypQ_no_forall (* sugar, omitting quantifier and constraints *) - - -type -lit_aux = (* Literal constant *) - L_unit (* $() : _$ *) - | L_zero (* $_ : _$ *) - | L_one (* $_ : _$ *) - | L_true (* $_ : _$ *) - | L_false (* $_ : _$ *) - | L_num of int (* natural number constant *) - | L_hex of string (* bit vector constant, C-style *) - | L_bin of string (* bit vector constant, C-style *) - | L_string of string (* string constant *) +typquant = + TypQ_aux of typquant_aux * l type @@ -172,8 +164,21 @@ and typ_arg = type -typquant = - TypQ_aux of typquant_aux * l +lit_aux = (* Literal constant *) + L_unit (* $() : _$ *) + | L_zero (* $_ : _$ *) + | L_one (* $_ : _$ *) + | L_true (* $_ : _$ *) + | L_false (* $_ : _$ *) + | L_num of int (* natural number constant *) + | L_hex of string (* bit vector constant, C-style *) + | L_bin of string (* bit vector constant, C-style *) + | L_string of string (* string constant *) + + +type +typschm_aux = (* type scheme *) + TypSchm_ts of typquant * typ type @@ -182,8 +187,8 @@ lit = type -typschm_aux = (* type scheme *) - TypSchm_ts of typquant * typ +typschm = + TypSchm_aux of typschm_aux * l type @@ -212,11 +217,6 @@ and 'a fpat = type -typschm = - TypSchm_aux of typschm_aux * l - - -type 'a exp_aux = (* Expression *) E_block of ('a exp) list (* block (parsing conflict with structs?) *) | E_id of id (* identifier *) @@ -281,19 +281,19 @@ and 'a letbind = type -rec_opt_aux = (* Optional recursive annotation for functions *) - Rec_nonrec (* non-recursive *) - | Rec_rec (* recursive *) +naming_scheme_opt_aux = (* Optional variable-naming-scheme specification for variables of defined type *) + Name_sect_none + | Name_sect_some of string type -'a funcl_aux = (* Function clause *) - FCL_Funcl of id * 'a pat * 'a exp +'a tannot_opt_aux = (* Optional type annotation for functions *) + Typ_annot_opt_some of typquant * typ type -'a tannot_opt_aux = (* Optional type annotation for functions *) - Typ_annot_opt_some of typquant * typ +'a funcl_aux = (* Function clause *) + FCL_Funcl of id * 'a pat * 'a exp type @@ -303,19 +303,24 @@ type type -naming_scheme_opt_aux = (* Optional variable-naming-scheme specification for variables of defined type *) - Name_sect_none - | Name_sect_some of string +rec_opt_aux = (* Optional recursive annotation for functions *) + Rec_nonrec (* non-recursive *) + | Rec_rec (* recursive *) type -rec_opt = - Rec_aux of rec_opt_aux * l +naming_scheme_opt = + Name_sect_aux of naming_scheme_opt_aux * l type -'a funcl = - FCL_aux of 'a funcl_aux * 'a annot +index_range_aux = (* index specification, for bitfields in register types *) + BF_single of int (* single index *) + | BF_range of int * int (* index range *) + | BF_concat of index_range * index_range (* concatenation of index ranges *) + +and index_range = + BF_aux of index_range_aux * l type @@ -324,33 +329,48 @@ type type +'a funcl = + FCL_aux of 'a funcl_aux * 'a annot + + +type 'a effects_opt = Effects_opt_aux of 'a effects_opt_aux * 'a annot type -index_range_aux = (* index specification, for bitfields in register types *) - BF_single of int (* single index *) - | BF_range of int * int (* index range *) - | BF_concat of index_range * index_range (* concatenation of index ranges *) - -and index_range = - BF_aux of index_range_aux * l +rec_opt = + Rec_aux of rec_opt_aux * l type -naming_scheme_opt = - Name_sect_aux of naming_scheme_opt_aux * l +ne = (* internal numeric expressions *) + Ne_var of id + | Ne_const of int + | Ne_mult of ne * ne + | Ne_add of ne * ne + | Ne_exp of ne + | Ne_unary of ne type -'a fundef_aux = (* Function definition *) - FD_function of rec_opt * 'a tannot_opt * 'a effects_opt * ('a funcl) list +k = (* Internal kinds *) + Ki_typ + | Ki_nat + | Ki_ord + | Ki_efct + | Ki_val (* Representing values, for use in identifier checks *) + | Ki_ctor of (k) list * k + | Ki_infer (* Representing an unknown kind, inferred by context *) type -'a val_spec_aux = (* Value type specification *) - VS_val_spec of typschm * id +'a type_def_aux = (* Type definition body *) + TD_abbrev of id * naming_scheme_opt * typschm (* type abbreviation *) + | TD_record of id * naming_scheme_opt * typquant * ((typ * id)) list * bool (* struct type definition *) + | TD_variant of id * naming_scheme_opt * typquant * ((typ * id)) list * bool (* union type definition *) + | TD_enum of id * naming_scheme_opt * (id) list * bool (* enumeration type definition *) + | TD_register of id * nexp * nexp * ((index_range * id)) list (* register mutable bitfield type definition *) type @@ -360,22 +380,29 @@ type type -'a type_def_aux = (* Type definition body *) - TD_abbrev of id * naming_scheme_opt * typschm (* type abbreviation *) - | TD_record of id * naming_scheme_opt * typquant * ((typ * id)) list * bool (* struct type definition *) - | TD_variant of id * naming_scheme_opt * typquant * ((typ * id)) list * bool (* union type definition *) - | TD_enum of id * naming_scheme_opt * (id) list * bool (* enumeration type definition *) - | TD_register of id * nexp * nexp * ((index_range * id)) list (* register mutable bitfield type definition *) +'a fundef_aux = (* Function definition *) + FD_function of rec_opt * 'a tannot_opt * 'a effects_opt * ('a funcl) list type -'a fundef = - FD_aux of 'a fundef_aux * 'a annot +'a val_spec_aux = (* Value type specification *) + VS_val_spec of typschm * id type -'a val_spec = - VS_aux of 'a val_spec_aux * 'a annot +t_arg = (* Argument to type constructors *) + Typ of t + | Nexp of ne + | Effect of effects + | Order of order + +and t_args = (* Arguments to type constructors *) + T_args of (t_arg) list + + +type +'a type_def = + TD_aux of 'a type_def_aux * 'a annot type @@ -384,19 +411,13 @@ type type -'a type_def = - TD_aux of 'a type_def_aux * 'a annot +'a fundef = + FD_aux of 'a fundef_aux * 'a annot type -k = (* Internal kinds *) - Ki_typ - | Ki_nat - | Ki_ord - | Ki_efct - | Ki_val (* Representing values, for use in identifier checks *) - | Ki_ctor of (k) list * k - | Ki_infer (* Representing an unknown kind, inferred by context *) +'a val_spec = + VS_aux of 'a val_spec_aux * 'a annot type @@ -457,5 +478,7 @@ type Defs of ('a def) list (** definitions *) +(** definitions *) +(** definitions *) |