diff --git a/compiler/dcalc/typing.ml b/compiler/dcalc/typing.ml index 1b3bec0f..6d764771 100644 --- a/compiler/dcalc/typing.ml +++ b/compiler/dcalc/typing.ml @@ -107,7 +107,7 @@ let rec format_typ | TArray t1 -> Format.fprintf fmt "@[%a@ array@]" format_typ t1 | TAny d -> Format.fprintf fmt "any[%d]" (Any.hash d) -exception Type_error of A.any_marked_expr * unionfind_typ * unionfind_typ +exception Type_error of A.any_expr * unionfind_typ * unionfind_typ type mark = { pos : Pos.t; uf : unionfind_typ } diff --git a/compiler/shared_ast/definitions.ml b/compiler/shared_ast/definitions.ml index fecff430..df91a91d 100644 --- a/compiler/shared_ast/definitions.ml +++ b/compiler/shared_ast/definitions.ml @@ -148,8 +148,6 @@ type scopelang = [ `Scopelang ] type dcalc = [ `Dcalc ] type lcalc = [ `Lcalc ] -(* type scalc = [ `Scalc ] *) - type 'a any = [< desugared | scopelang | dcalc | lcalc ] as 'a (** Literals are the same throughout compilation except for the [LEmptyError] @@ -194,16 +192,15 @@ and ('a, 't) naked_gexpr = | EApp : ('a, 't) gexpr * ('a, 't) gexpr list -> ('a any, 't) naked_gexpr | EOp : operator -> ('a any, 't) naked_gexpr | EArray : ('a, 't) gexpr list -> ('a any, 't) naked_gexpr - (* All but statement calculus *) | EVar : ('a, 't) naked_gexpr Bindlib.var - -> (([< desugared | scopelang | dcalc | lcalc ] as 'a), 't) naked_gexpr + -> ('a any, 't) naked_gexpr | EAbs : (('a, 't) naked_gexpr, ('a, 't) gexpr) Bindlib.mbinder * typ list - -> (([< desugared | scopelang | dcalc | lcalc ] as 'a), 't) naked_gexpr + -> ('a any, 't) naked_gexpr | EIfThenElse : ('a, 't) gexpr * ('a, 't) gexpr * ('a, 't) gexpr - -> (([< desugared | scopelang | dcalc | lcalc ] as 'a), 't) naked_gexpr + -> ('a any, 't) naked_gexpr (* Early stages *) | ELocation : 'a glocation @@ -254,16 +251,6 @@ type ('e, 'b) binder = (('a, 't) naked_gexpr, 'b) Bindlib.binder (** The expressions use the {{:https://lepigre.fr/ocaml-bindlib/} Bindlib} library, based on higher-order abstract syntax *) -(* (\* Statement calculus *\) - * | ESVar: LocalName.t -> (scalc as 'a, 't) naked_gexpr - * | ESStruct: ('a, 't) gexpr list * StructName.t -> (scalc as 'a, 't) naked_gexpr - * | ESStructFieldAccess: ('a, 't) gexpr * StructFieldName.t * StructName.t -> (scalc as 'a, 't) naked_gexpr - * | ESInj: ('a, 't) gexpr * EnumConstructor.t * EnumName.t -> (scalc as 'a, 't) naked_gexpr - * | ESFunc: TopLevelName.t -> (scalc as 'a, 't) naked_gexpr *) - -type 'e anyexpr = 'e constraint 'e = (_ any, _) gexpr -(** Shorter alias for functions taking any kind of expression *) - (** {2 Markings} *) type untyped = { pos : Pos.t } [@@ocaml.unboxed] @@ -277,7 +264,7 @@ type typed = { pos : Pos.t; ty : typ } type _ mark = Untyped : untyped -> untyped mark | Typed : typed -> typed mark (** Useful for errors and printing, for example *) -type any_marked_expr = AnyExpr : (_ any, _ mark) gexpr -> any_marked_expr +type any_expr = AnyExpr : (_ any, _ mark) gexpr -> any_expr (** {2 Higher-level program structure} *) @@ -308,7 +295,7 @@ type 'e scope_let = { scope_let_next : ('e, 'e scope_body_expr) binder; scope_let_pos : Pos.t; } - constraint 'e = ('a, 'm mark) gexpr + constraint 'e = (_ any, _ mark) gexpr (** This type is parametrized by the expression type so it can be reused in later intermediate representations. *) @@ -318,14 +305,14 @@ type 'e scope_let = { and 'e scope_body_expr = | Result of 'e | ScopeLet of 'e scope_let - constraint 'e = (_, _ mark) gexpr + constraint 'e = (_ any, _ mark) gexpr type 'e scope_body = { scope_body_input_struct : StructName.t; scope_body_output_struct : StructName.t; scope_body_expr : ('e, 'e scope_body_expr) binder; } - constraint 'e = (_, _ mark) gexpr + constraint 'e = (_ any, _ mark) gexpr (** Instead of being a single expression, we give a little more ad-hoc structure to the scope body by decomposing it in an ordered list of let-bindings, and a result expression that uses the let-binded variables. The first binder is @@ -336,14 +323,14 @@ type 'e scope_def = { scope_body : 'e scope_body; scope_next : ('e, 'e scopes) binder; } - constraint 'e = (_, _ mark) gexpr + constraint 'e = (_ any, _ mark) gexpr (** Finally, we do the same transformation for the whole program for the kinded lets. This permit us to use bindlib variables for scopes names. *) and 'e scopes = | Nil | ScopeDef of 'e scope_def - constraint 'e = (_, _ mark) gexpr + constraint 'e = (_ any, _ mark) gexpr type struct_ctx = (StructFieldName.t * typ) list StructMap.t type enum_ctx = (EnumConstructor.t * typ) list EnumMap.t diff --git a/compiler/shared_ast/scope.mli b/compiler/shared_ast/scope.mli index bdc22a43..54e3e10f 100644 --- a/compiler/shared_ast/scope.mli +++ b/compiler/shared_ast/scope.mli @@ -85,7 +85,7 @@ val format : ?debug:bool (** [true] for debug printing *) -> decl_ctx -> Format.formatter -> - ScopeName.t * 'e anyexpr scope_body -> + ScopeName.t * 'e scope_body -> unit val to_expr : @@ -112,6 +112,6 @@ val build_typ_from_sig : (** {2 Analysis and tests} *) -val free_vars_body_expr : 'e anyexpr scope_body_expr -> 'e Var.Set.t -val free_vars_body : 'e anyexpr scope_body -> 'e Var.Set.t -val free_vars : 'e anyexpr scopes -> 'e Var.Set.t +val free_vars_body_expr : 'e scope_body_expr -> 'e Var.Set.t +val free_vars_body : 'e scope_body -> 'e Var.Set.t +val free_vars : 'e scopes -> 'e Var.Set.t