diff --git a/compiler/catala_utils/uid.ml b/compiler/catala_utils/uid.ml index 7b7bc7d9..23beedae 100644 --- a/compiler/catala_utils/uid.ml +++ b/compiler/catala_utils/uid.ml @@ -53,6 +53,7 @@ module Make (X : Info) (S : Style) () : Id with type info = X.info = struct let format ppf t = Format.pp_open_stag ppf (Ocolor_format.Ocolor_style_tag S.style); X.format ppf t.info; + (* Format.pp_print_int ppf t.id; (* uncomment for precise uid debug *) *) Format.pp_close_stag ppf () end diff --git a/compiler/dcalc/from_scopelang.ml b/compiler/dcalc/from_scopelang.ml index 50119ca7..a720c69d 100644 --- a/compiler/dcalc/from_scopelang.ml +++ b/compiler/dcalc/from_scopelang.ml @@ -16,6 +16,7 @@ open Catala_utils open Shared_ast +module S = Scopelang.Ast type scope_var_ctx = { scope_var_name : ScopeVar.t; @@ -54,9 +55,6 @@ type 'm ctx = { toplevel_vars : ('m Ast.expr Var.t * naked_typ) TopdefName.Map.t; scope_vars : ('m Ast.expr Var.t * naked_typ * Desugared.Ast.io) ScopeVar.Map.t; - subscope_vars : - ('m Ast.expr Var.t * naked_typ * Desugared.Ast.io) ScopeVar.Map.t - SubScopeName.Map.t; date_rounding : date_rounding; } @@ -151,10 +149,10 @@ let tag_with_log_entry NOTE: the choice of the exception that will be triggered and show in the trace is arbitrary (but deterministic). *) -let collapse_similar_outcomes (type m) (excepts : m Scopelang.Ast.expr list) : - m Scopelang.Ast.expr list = +let collapse_similar_outcomes (type m) (excepts : m S.expr list) : m S.expr list + = let module ExprMap = Map.Make (struct - type t = m Scopelang.Ast.expr + type t = m S.expr let compare = Expr.compare let format = Expr.format @@ -214,8 +212,7 @@ let thunk_scope_arg var_ctx e = Expr.make_abs [| Var.make "_" |] e [TLit TUnit, pos] pos | _ -> assert false -let rec translate_expr (ctx : 'm ctx) (e : 'm Scopelang.Ast.expr) : - 'm Ast.expr boxed = +let rec translate_expr (ctx : 'm ctx) (e : 'm S.expr) : 'm Ast.expr boxed = let m = Mark.get e in match Mark.remove e with | EMatch { e = e1; name; cases = e_cases } -> @@ -483,8 +480,6 @@ let rec translate_expr (ctx : 'm ctx) (e : 'm Scopelang.Ast.expr) : match loc with | ScopelangScopeVar { name = v, _; _ } -> [ScopeName.get_info sname; ScopeVar.get_info v] - | SubScopeVar { scope; var = v, _; _ } -> - [ScopeName.get_info scope; ScopeVar.get_info v] | ToplevelVar _ -> []) | _ -> [] in @@ -509,10 +504,6 @@ let rec translate_expr (ctx : 'm ctx) (e : 'm Scopelang.Ast.expr) : match Mark.remove f with | ELocation (ScopelangScopeVar { name = var }) -> retrieve_out_typ_or_any var ctx.scope_vars - | ELocation (SubScopeVar { alias; var; _ }) -> - ctx.subscope_vars - |> SubScopeName.Map.find (Mark.remove alias) - |> retrieve_out_typ_or_any var | ELocation (ToplevelVar { name }) -> ( let typ = TopdefName.Map.find (Mark.remove name) ctx.decl_ctx.ctx_topdefs @@ -568,26 +559,6 @@ let rec translate_expr (ctx : 'm ctx) (e : 'm Scopelang.Ast.expr) : | ELocation (ScopelangScopeVar { name = a }) -> let v, _, _ = ScopeVar.Map.find (Mark.remove a) ctx.scope_vars in Expr.evar v m - | ELocation (SubScopeVar { alias = s; var = a; _ }) -> ( - try - let v, _, _ = - ScopeVar.Map.find (Mark.remove a) - (SubScopeName.Map.find (Mark.remove s) ctx.subscope_vars) - in - Expr.evar v m - with ScopeVar.Map.Not_found _ | SubScopeName.Map.Not_found _ -> - Message.raise_multispanned_error - [ - Some "Incriminated variable usage:", Expr.pos e; - ( Some "Incriminated subscope variable declaration:", - Mark.get (ScopeVar.get_info (Mark.remove a)) ); - ( Some "Incriminated subscope declaration:", - Mark.get (SubScopeName.get_info (Mark.remove s)) ); - ] - "The variable %a.%a cannot be used here, as it is not part of subscope \ - %a's results. Maybe you forgot to qualify it as an output?" - SubScopeName.format (Mark.remove s) ScopeVar.format (Mark.remove a) - SubScopeName.format (Mark.remove s)) | ELocation (ToplevelVar { name }) -> let path = TopdefName.path (Mark.remove name) in if path = [] then @@ -602,29 +573,39 @@ let rec translate_expr (ctx : 'm ctx) (e : 'm Scopelang.Ast.expr) : | EIfThenElse _ | EAppOp _ ) as e -> Expr.map ~f:(translate_expr ctx) ~op:Operator.translate (e, m) -(** The result of a rule translation is a list of assignment, with variables and - expressions. We also return the new translation context available after the - assignment to use in later rule translations. The list is actually a +(** The result of a rule translation is a list of assignments, with variables + and expressions. We also return the new translation context available after + the assignment to use in later rule translations. The list is actually a continuation yielding a [Dcalc.scope_body_expr] by giving it what should come later in the chain of let-bindings. *) let translate_rule (ctx : 'm ctx) - (rule : 'm Scopelang.Ast.rule) + (rule : 'm S.rule) ((sigma_name, pos_sigma) : Uid.MarkedString.info) : ('m Ast.expr scope_body_expr Bindlib.box -> 'm Ast.expr scope_body_expr Bindlib.box) * 'm ctx = match rule with - | Definition ((ScopelangScopeVar { name = a }, var_def_pos), tau, a_io, e) -> + | S.ScopeVarDefinition { var; typ; e; _ } + | S.SubScopeVarDefinition { var; typ; e; _ } -> let pos_mark, _ = pos_mark_mk e in - let a_name = ScopeVar.get_info (Mark.remove a) in + let scope_let_kind, io = + match rule with + | S.ScopeVarDefinition { io; _ } -> ScopeVarDefinition, io + | S.SubScopeVarDefinition _ -> + let pos = Mark.get var in + ( SubScopeVarDefinition, + { io_input = NoInput, pos; io_output = false, pos } ) + | S.Assertion _ -> assert false + in + let a_name = ScopeVar.get_info (Mark.remove var) in let a_var = Var.make (Mark.remove a_name) in let new_e = translate_expr ctx e in - let a_expr = Expr.make_var a_var (pos_mark var_def_pos) in - let is_func = match Mark.remove tau with TArrow _ -> true | _ -> false in + let a_expr = Expr.make_var a_var (pos_mark (Mark.get var)) in + let is_func = match Mark.remove typ with TArrow _ -> true | _ -> false in let merged_expr = - match Mark.remove a_io.io_input with - | OnlyInput -> failwith "should not happen" + match Mark.remove io.io_input with + | OnlyInput -> assert false (* scopelang should not contain any definitions of input only variables *) | Reentrant -> merge_defaults ~is_func a_expr new_e | NoInput -> new_e @@ -633,9 +614,9 @@ let translate_rule tag_with_log_entry merged_expr (VarDef { - log_typ = Mark.remove tau; - log_io_output = Mark.remove a_io.io_output; - log_io_input = Mark.remove a_io.io_input; + log_typ = Mark.remove typ; + log_io_output = Mark.remove io.io_output; + log_io_input = Mark.remove io.io_input; }) [sigma_name, pos_sigma; a_name] in @@ -644,10 +625,10 @@ let translate_rule (fun next merged_expr -> Cons ( { - scope_let_typ = tau; + scope_let_typ = typ; scope_let_expr = merged_expr; - scope_let_kind = ScopeVarDefinition; - scope_let_pos = Mark.get a; + scope_let_kind; + scope_let_pos = Mark.get var; }, next )) (Bindlib.bind_var a_var next) @@ -655,236 +636,10 @@ let translate_rule { ctx with scope_vars = - ScopeVar.Map.add (Mark.remove a) - (a_var, Mark.remove tau, a_io) + ScopeVar.Map.add (Mark.remove var) + (a_var, Mark.remove typ, io) ctx.scope_vars; } ) - | Definition - ((SubScopeVar { alias = subs_index; var = subs_var; _ }, _), tau, a_io, e) - -> - let a_name = - Mark.map - (fun str -> - str ^ "." ^ Mark.remove (ScopeVar.get_info (Mark.remove subs_var))) - (SubScopeName.get_info (Mark.remove subs_index)) - in - let a_var = Var.make (Mark.remove a_name) in - let new_e = - tag_with_log_entry (translate_expr ctx e) - (VarDef - { - log_typ = Mark.remove tau; - log_io_output = false; - log_io_input = Mark.remove a_io.Desugared.Ast.io_input; - }) - [sigma_name, pos_sigma; a_name] - in - let thunked_or_nonempty_new_e = - match a_io.Desugared.Ast.io_input with - | Runtime.NoInput, _ -> assert false - | Runtime.OnlyInput, _ -> new_e - | Runtime.Reentrant, pos -> ( - match Mark.remove tau with - | TArrow _ -> new_e - | _ -> Mark.map_mark (Expr.with_pos pos) (Expr.thunk_term new_e)) - in - ( (fun next -> - Bindlib.box_apply2 - (fun next thunked_or_nonempty_new_e -> - Cons - ( { - scope_let_pos = Mark.get a_name; - scope_let_typ = input_var_typ (Mark.remove tau) a_io; - scope_let_expr = thunked_or_nonempty_new_e; - scope_let_kind = SubScopeVarDefinition; - }, - next )) - (Bindlib.bind_var a_var next) - (Expr.Box.lift thunked_or_nonempty_new_e)), - { - ctx with - subscope_vars = - SubScopeName.Map.update (Mark.remove subs_index) - (fun map -> - match map with - | Some map -> - Some - (ScopeVar.Map.add (Mark.remove subs_var) - (a_var, Mark.remove tau, a_io) - map) - | None -> - Some - (ScopeVar.Map.singleton (Mark.remove subs_var) - (a_var, Mark.remove tau, a_io))) - ctx.subscope_vars; - } ) - | Definition ((ToplevelVar _, _), _, _, _) -> - assert false - (* A global variable can't be defined locally. The [Definition] constructor - could be made more specific to avoid this case, but the added complexity - didn't seem worth it *) - | Call (subname, subindex, m) -> - let subscope_sig = ScopeName.Map.find subname ctx.scopes_parameters in - let scope_sig_decl = ScopeName.Map.find subname ctx.decl_ctx.ctx_scopes in - let all_subscope_vars = subscope_sig.scope_sig_local_vars in - let all_subscope_input_vars = - List.filter - (fun var_ctx -> - match Mark.remove var_ctx.scope_var_io.Desugared.Ast.io_input with - | NoInput -> false - | _ -> true) - all_subscope_vars - in - let called_scope_input_struct = subscope_sig.scope_sig_input_struct in - let called_scope_return_struct = subscope_sig.scope_sig_output_struct in - let all_subscope_output_vars = - List.filter_map - (fun var_ctx -> - if Mark.remove var_ctx.scope_var_io.Desugared.Ast.io_output then - (* Retrieve the actual expected output type through the scope output - struct definition *) - let str = - StructName.Map.find called_scope_return_struct - ctx.decl_ctx.ctx_structs - in - let fld = - ScopeVar.Map.find var_ctx.scope_var_name - scope_sig_decl.out_struct_fields - in - let ty = StructField.Map.find fld str in - Some { var_ctx with scope_var_typ = Mark.remove ty } - else None) - all_subscope_vars - in - let pos_call = Mark.get (SubScopeName.get_info subindex) in - let scope_dcalc_ref = - let m = mark_tany m pos_call in - match subscope_sig.scope_sig_scope_ref with - | Local_scope_ref var -> Expr.make_var var m - | External_scope_ref name -> - Expr.eexternal ~name:(Mark.map (fun n -> External_scope n) name) m - in - let subscope_vars_defined = - try SubScopeName.Map.find subindex ctx.subscope_vars - with SubScopeName.Map.Not_found _ -> ScopeVar.Map.empty - in - let subscope_var_not_yet_defined subvar = - not (ScopeVar.Map.mem subvar subscope_vars_defined) - in - let subscope_args = - List.fold_left - (fun acc (subvar : scope_var_ctx) -> - let e = - if subscope_var_not_yet_defined subvar.scope_var_name then - (* This is a redundant check. Normally, all subscope variables - should have been defined (even an empty definition, if they're - not defined by any rule in the source code) by the translation - from desugared to the scope language. *) - Expr.empty_thunked_term m - else - let a_var, _, _ = - ScopeVar.Map.find subvar.scope_var_name subscope_vars_defined - in - Expr.make_var a_var (mark_tany m pos_call) - in - let field = - (ScopeVar.Map.find subvar.scope_var_name - subscope_sig.scope_sig_in_fields) - .scope_input_name - in - StructField.Map.add field e acc) - StructField.Map.empty all_subscope_input_vars - in - let subscope_struct_arg = - Expr.estruct ~name:called_scope_input_struct ~fields:subscope_args - (mark_tany m pos_call) - in - let all_subscope_output_vars_dcalc = - List.map - (fun (subvar : scope_var_ctx) -> - let sub_dcalc_var = - Var.make - (Mark.remove (SubScopeName.get_info subindex) - ^ "." - ^ Mark.remove (ScopeVar.get_info subvar.scope_var_name)) - in - subvar, sub_dcalc_var) - all_subscope_output_vars - in - let subscope_func = - tag_with_log_entry scope_dcalc_ref BeginCall - [ - sigma_name, pos_sigma; - SubScopeName.get_info subindex; - ScopeName.get_info subname; - ] - in - let call_expr = - tag_with_log_entry - (Expr.eapp ~f:subscope_func ~args:[subscope_struct_arg] - ~tys:[TStruct called_scope_input_struct, Expr.mark_pos m] - (mark_tany m pos_call)) - EndCall - [ - sigma_name, pos_sigma; - SubScopeName.get_info subindex; - ScopeName.get_info subname; - ] - in - let result_tuple_var = Var.make "result" in - let result_tuple_typ = TStruct called_scope_return_struct, pos_sigma in - let call_scope_let next = - Bindlib.box_apply2 - (fun next call_expr -> - Cons - ( { - scope_let_pos = pos_sigma; - scope_let_kind = CallingSubScope; - scope_let_typ = result_tuple_typ; - scope_let_expr = call_expr; - }, - next )) - (Bindlib.bind_var result_tuple_var next) - (Expr.Box.lift call_expr) - in - let result_bindings_lets next = - List.fold_right - (fun (var_ctx, v) next -> - let field = - ScopeVar.Map.find var_ctx.scope_var_name - scope_sig_decl.out_struct_fields - in - Bindlib.box_apply2 - (fun next r -> - Cons - ( { - scope_let_pos = pos_sigma; - scope_let_typ = var_ctx.scope_var_typ, pos_sigma; - scope_let_kind = DestructuringSubScopeResults; - scope_let_expr = - ( EStructAccess - { name = called_scope_return_struct; e = r; field }, - mark_tany m pos_sigma ); - }, - next )) - (Bindlib.bind_var v next) - (Expr.Box.lift - (Expr.make_var result_tuple_var (mark_tany m pos_sigma)))) - all_subscope_output_vars_dcalc next - in - ( (fun next -> call_scope_let (result_bindings_lets next)), - { - ctx with - subscope_vars = - SubScopeName.Map.add subindex - (List.fold_left - (fun acc (var_ctx, dvar) -> - ScopeVar.Map.add var_ctx.scope_var_name - (dvar, var_ctx.scope_var_typ, var_ctx.scope_var_io) - acc) - ScopeVar.Map.empty all_subscope_output_vars_dcalc) - ctx.subscope_vars; - } ) | Assertion e -> let new_e = translate_expr ctx e in let scope_let_pos = Expr.pos e in @@ -910,7 +665,7 @@ let translate_rule let translate_rules (ctx : 'm ctx) (scope_name : ScopeName.t) - (rules : 'm Scopelang.Ast.rule list) + (rules : 'm S.rule list) ((sigma_name, pos_sigma) : Uid.MarkedString.info) (mark : 'm mark) (scope_sig : 'm scope_sig_ctx) : @@ -953,7 +708,7 @@ let translate_rules let translate_scope_decl (ctx : 'm ctx) (scope_name : ScopeName.t) - (sigma : 'm Scopelang.Ast.scope_decl) = + (sigma : 'm S.scope_decl) = let sigma_info = ScopeName.get_info sigma.scope_decl_name in let scope_sig = ScopeName.Map.find sigma.scope_decl_name ctx.scopes_parameters @@ -1007,8 +762,11 @@ let translate_scope_decl or not ? *) Message.raise_spanned_error pos_sigma "Scope %a has no content" ScopeName.format scope_name - | (Definition (_, _, _, (_, m)) | Assertion (_, m) | Call (_, _, m)) :: _ -> - m + | ( S.ScopeVarDefinition { e; _ } + | S.SubScopeVarDefinition { e; _ } + | S.Assertion e ) + :: _ -> + Mark.get e in let rules_with_return_expr, ctx = translate_rules ctx scope_name sigma.scope_decl_rules sigma_info scope_mark @@ -1069,7 +827,7 @@ let translate_scope_decl (Bindlib.bind_var scope_input_var (input_destructurings rules_with_return_expr)) -let translate_program (prgm : 'm Scopelang.Ast.program) : 'm Ast.program = +let translate_program (prgm : 'm S.program) : 'm Ast.program = let defs_dependencies = Scopelang.Dependency.build_program_dep_graph prgm in Scopelang.Dependency.check_for_cycle_in_defs defs_dependencies; let defs_ordering = @@ -1094,7 +852,7 @@ let translate_program (prgm : 'm Scopelang.Ast.program) : 'm Ast.program = as the return type of ScopeCalls) ; but input fields are used purely internally and need to be created here to implement the call convention for scopes. *) - let module S = Scopelang.Ast in + let module S = S in ScopeVar.Map.filter_map (fun dvar svar -> match Mark.remove svar.S.svar_io.Desugared.Ast.io_input with @@ -1124,8 +882,8 @@ let translate_program (prgm : 'm Scopelang.Ast.program) : 'm Ast.program = (fun (scope_var, svar) -> { scope_var_name = scope_var; - scope_var_typ = Mark.remove svar.Scopelang.Ast.svar_in_ty; - scope_var_io = svar.Scopelang.Ast.svar_io; + scope_var_typ = Mark.remove svar.S.svar_in_ty; + scope_var_io = svar.S.svar_io; }) (ScopeVar.Map.bindings scope.scope_sig); scope_sig_scope_ref = scope_ref; @@ -1142,8 +900,8 @@ let translate_program (prgm : 'm Scopelang.Ast.program) : 'm Ast.program = in ModuleName.Map.fold (fun _ s -> ScopeName.Map.disjoint_union (process_scopes s)) - prgm.Scopelang.Ast.program_modules - (process_scopes prgm.Scopelang.Ast.program_scopes) + prgm.S.program_modules + (process_scopes prgm.S.program_scopes) in let ctx_structs = ScopeName.Map.fold @@ -1165,7 +923,7 @@ let translate_program (prgm : 'm Scopelang.Ast.program) : 'm Ast.program = TopdefName.Map.mapi (fun name (_, ty) -> Var.make (Mark.remove (TopdefName.get_info name)), Mark.remove ty) - prgm.Scopelang.Ast.program_topdefs + prgm.S.program_topdefs in let ctx = { @@ -1173,7 +931,7 @@ let translate_program (prgm : 'm Scopelang.Ast.program) : 'm Ast.program = scope_name = None; scopes_parameters; scope_vars = ScopeVar.Map.empty; - subscope_vars = SubScopeName.Map.empty; + (* subscope_vars = ScopeVar.Map.empty; *) toplevel_vars; date_rounding = AbortOnRound; } @@ -1222,6 +980,6 @@ let translate_program (prgm : 'm Scopelang.Ast.program) : 'm Ast.program = { code_items = Bindlib.unbox items; decl_ctx; - module_name = prgm.Scopelang.Ast.program_module_name; + module_name = prgm.S.program_module_name; lang = prgm.program_lang; } diff --git a/compiler/desugared/ast.ml b/compiler/desugared/ast.ml index 8005948a..d89fdc75 100644 --- a/compiler/desugared/ast.ml +++ b/compiler/desugared/ast.ml @@ -25,45 +25,58 @@ open Shared_ast def *) module ScopeDef = struct module Base = struct - type t = - | Var of ScopeVar.t * StateName.t option - | SubScopeVar of SubScopeName.t * ScopeVar.t * Pos.t - (** In this case, the [ScopeVar.t] lives inside the context of the - subscope's original declaration *) + type kind = + | Var of StateName.t option + | SubScopeInput of { + name : ScopeName.t; + var_within_origin_scope : ScopeVar.t; + } - let compare x y = - match x, y with - | Var (x, stx), Var (y, sty) -> ( - match ScopeVar.compare x y with - | 0 -> Option.compare StateName.compare stx sty - | n -> n) - | SubScopeVar (x', x, _), SubScopeVar (y', y, _) -> ( - match SubScopeName.compare x' y' with - | 0 -> ScopeVar.compare x y - | n -> n) - | Var _, _ -> -1 - | _, Var _ -> 1 + type t = ScopeVar.t Mark.pos * kind - let get_position x = - match x with - | Var (x, None) -> Mark.get (ScopeVar.get_info x) - | Var (_, Some sx) -> Mark.get (StateName.get_info sx) - | SubScopeVar (_, _, pos) -> pos + let equal_kind k1 k2 = + match k1, k2 with + | Var s1, Var s2 -> Option.equal StateName.equal s1 s2 + | ( SubScopeInput { var_within_origin_scope = v1; _ }, + SubScopeInput { var_within_origin_scope = v2; _ } ) -> + ScopeVar.equal v1 v2 + | (Var _ | SubScopeInput _), _ -> false - let format fmt x = - match x with - | Var (v, None) -> ScopeVar.format fmt v - | Var (v, Some sv) -> - Format.fprintf fmt "%a.%a" ScopeVar.format v StateName.format sv - | SubScopeVar (s, v, _) -> - Format.fprintf fmt "%a.%a" SubScopeName.format s ScopeVar.format v + let equal (v1, k1) (v2, k2) = + ScopeVar.equal (Mark.remove v1) (Mark.remove v2) && equal_kind k1 k2 - let hash x = - match x with - | Var (v, None) -> ScopeVar.hash v - | Var (v, Some sv) -> Int.logxor (ScopeVar.hash v) (StateName.hash sv) - | SubScopeVar (w, v, _) -> - Int.logxor (SubScopeName.hash w) (ScopeVar.hash v) + let compare_kind k1 k2 = + match k1, k2 with + | Var st1, Var st2 -> Option.compare StateName.compare st1 st2 + | ( SubScopeInput { var_within_origin_scope = v1; _ }, + SubScopeInput { var_within_origin_scope = v2; _ } ) -> + ScopeVar.compare v1 v2 + | Var _, SubScopeInput _ -> -1 + | SubScopeInput _, Var _ -> 1 + + let compare (v1, k1) (v2, k2) = + match Mark.compare ScopeVar.compare v1 v2 with + | 0 -> compare_kind k1 k2 + | n -> n + + let get_position (v, _) = Mark.get v + + let format_kind ppf = function + | Var None -> () + | Var (Some st) -> Format.fprintf ppf "@%a" StateName.format st + | SubScopeInput { var_within_origin_scope = v; _ } -> + Format.fprintf ppf ".%a" ScopeVar.format v + + let format ppf (v, k) = + ScopeVar.format ppf (Mark.remove v); + format_kind ppf k + + let hash_kind = function + | Var None -> 0 + | Var (Some st) -> StateName.hash st + | SubScopeInput { var_within_origin_scope = v; _ } -> ScopeVar.hash v + + let hash (v, k) = Int.logxor (ScopeVar.hash (Mark.remove v)) (hash_kind k) end include Base @@ -220,7 +233,7 @@ type var_or_states = WholeVar | States of StateName.t list type scope = { scope_vars : var_or_states ScopeVar.Map.t; - scope_sub_scopes : ScopeName.t SubScopeName.Map.t; + scope_sub_scopes : ScopeName.t ScopeVar.Map.t; scope_uid : ScopeName.t; scope_defs : scope_def ScopeDef.Map.t; scope_assertions : assertion AssertionName.Map.t; @@ -244,9 +257,6 @@ type program = { let rec locations_used e : LocationSet.t = match e with | ELocation l, m -> LocationSet.singleton (l, Expr.mark_pos m) - | EAbs { binder; _ }, _ -> - let _, body = Bindlib.unmbind binder in - locations_used body | e -> Expr.shallow_fold (fun e -> LocationSet.union (locations_used e)) @@ -259,12 +269,7 @@ let free_variables (def : rule RuleName.Map.t) : Pos.t ScopeDef.Map.t = (fun (loc, loc_pos) acc -> let usage = match loc with - | DesugaredScopeVar { name; state } -> - Some (ScopeDef.Var (Mark.remove name, state)) - | SubScopeVar { alias; var; _ } -> - Some - (ScopeDef.SubScopeVar - (Mark.remove alias, Mark.remove var, Mark.get alias)) + | DesugaredScopeVar { name; state } -> Some (name, ScopeDef.Var state) | ToplevelVar _ -> None in match usage with diff --git a/compiler/desugared/ast.mli b/compiler/desugared/ast.mli index 48849052..b8f787bf 100644 --- a/compiler/desugared/ast.mli +++ b/compiler/desugared/ast.mli @@ -19,13 +19,24 @@ open Catala_utils open Shared_ast -(** Inside a scope, a definition can refer either to a scope def, or a subscope - def *) +(** Inside a scope, a definition can refer to a variable (possibly an + intermediate state thereof) or an input of a subscope. *) module ScopeDef : sig - type t = - | Var of ScopeVar.t * StateName.t option - | SubScopeVar of SubScopeName.t * ScopeVar.t * Pos.t + type kind = + | Var of StateName.t option + | SubScopeInput of { + name : ScopeName.t; + var_within_origin_scope : ScopeVar.t; + } + val equal_kind : kind -> kind -> bool + val compare_kind : kind -> kind -> int + val format_kind : Format.formatter -> kind -> unit + val hash_kind : kind -> int + + type t = ScopeVar.t Mark.pos * kind + + val equal : t -> t -> bool val compare : t -> t -> int val get_position : t -> Pos.t val format : Format.formatter -> t -> unit @@ -105,7 +116,7 @@ type var_or_states = WholeVar | States of StateName.t list type scope = { scope_vars : var_or_states ScopeVar.Map.t; - scope_sub_scopes : ScopeName.t SubScopeName.Map.t; + scope_sub_scopes : ScopeName.t ScopeVar.Map.t; scope_uid : ScopeName.t; scope_defs : scope_def ScopeDef.Map.t; scope_assertions : assertion AssertionName.Map.t; diff --git a/compiler/desugared/dependency.ml b/compiler/desugared/dependency.ml index 79b664ef..d22ddc1a 100644 --- a/compiler/desugared/dependency.ml +++ b/compiler/desugared/dependency.ml @@ -35,14 +35,12 @@ open Shared_ast module Vertex = struct type t = | Var of ScopeVar.t * StateName.t option - | SubScope of SubScopeName.t | Assertion of Ast.AssertionName.t let hash x = match x with | Var (x, None) -> ScopeVar.hash x | Var (x, Some sx) -> Int.logxor (ScopeVar.hash x) (StateName.hash sx) - | SubScope x -> SubScopeName.hash x | Assertion a -> Ast.AssertionName.hash a let compare x y = @@ -51,35 +49,27 @@ module Vertex = struct match ScopeVar.compare x y with | 0 -> Option.compare StateName.compare xst yst | n -> n) - | SubScope x, SubScope y -> SubScopeName.compare x y | Assertion a, Assertion b -> Ast.AssertionName.compare a b | Var _, _ -> -1 | _, Var _ -> 1 - | SubScope _, Assertion _ -> -1 - | Assertion _, SubScope _ -> 1 - | SubScope _, _ -> . - | _, SubScope _ -> . let equal x y = match x, y with | Var (x, sx), Var (y, sy) -> ScopeVar.equal x y && Option.equal StateName.equal sx sy - | SubScope x, SubScope y -> SubScopeName.equal x y | Assertion a, Assertion b -> Ast.AssertionName.equal a b - | (Var _ | SubScope _ | Assertion _), _ -> false + | (Var _ | Assertion _), _ -> false let format (fmt : Format.formatter) (x : t) : unit = match x with | Var (v, None) -> ScopeVar.format fmt v | Var (v, Some sv) -> Format.fprintf fmt "%a@%a" ScopeVar.format v StateName.format sv - | SubScope v -> SubScopeName.format fmt v | Assertion a -> Ast.AssertionName.format fmt a let info = function | Var (v, None) -> ScopeVar.get_info v | Var (_, Some sv) -> StateName.get_info sv - | SubScope v -> SubScopeName.get_info v | Assertion a -> Ast.AssertionName.get_info a end @@ -177,9 +167,9 @@ let build_scope_dependencies (scope : Ast.scope) : ScopeDependencies.t = scope.scope_vars g in let g = - SubScopeName.Map.fold - (fun (v : SubScopeName.t) _ g -> - ScopeDependencies.add_vertex g (Vertex.SubScope v)) + ScopeVar.Map.fold + (fun (v : ScopeVar.t) _ g -> + ScopeDependencies.add_vertex g (Vertex.Var (v, None))) scope.scope_sub_scopes g in let g = @@ -189,67 +179,35 @@ let build_scope_dependencies (scope : Ast.scope) : ScopeDependencies.t = in (* then add the edges *) let g = + let to_vertex (var, kind) = + match kind with + | Ast.ScopeDef.Var st -> Vertex.Var (Mark.remove var, st) + | Ast.ScopeDef.SubScopeInput _ -> Vertex.Var (Mark.remove var, None) + in Ast.ScopeDef.Map.fold (fun def_key scope_def g -> let def = scope_def.Ast.scope_def_rules in + let v_defined = to_vertex def_key in let fv = Ast.free_variables def in Ast.ScopeDef.Map.fold (fun fv_def fv_def_pos g -> - match def_key, fv_def with - | ( Ast.ScopeDef.Var (v_defined, s_defined), - Ast.ScopeDef.Var (v_used, s_used) ) -> - (* simple case *) - if - ScopeVar.equal v_used v_defined - && Option.equal StateName.equal s_used s_defined - then - (* variable definitions cannot be recursive *) - Message.raise_spanned_error fv_def_pos - "The variable %a is used in one of its definitions, but \ - recursion is forbidden in Catala" - Ast.ScopeDef.format def_key - else - let edge = - ScopeDependencies.E.create - (Vertex.Var (v_used, s_used)) - fv_def_pos - (Vertex.Var (v_defined, s_defined)) - in - ScopeDependencies.add_edge_e g edge - | ( Ast.ScopeDef.SubScopeVar (defined, _, _), - Ast.ScopeDef.Var (v_used, s_used) ) -> - (* here we are defining the input of a subscope using a var of the - scope *) - let edge = - ScopeDependencies.E.create - (Vertex.Var (v_used, s_used)) - fv_def_pos (Vertex.SubScope defined) - in - ScopeDependencies.add_edge_e g edge - | ( Ast.ScopeDef.SubScopeVar (defined, _, _), - Ast.ScopeDef.SubScopeVar (used, _, _) ) -> - (* here we are defining the input of a scope with the output of - another subscope *) - if SubScopeName.equal used defined then - (* subscopes are not recursive functions *) - Message.raise_spanned_error fv_def_pos - "The subscope %a is used when defining one of its inputs, \ - but recursion is forbidden in Catala" - SubScopeName.format defined - else - let edge = - ScopeDependencies.E.create (Vertex.SubScope used) fv_def_pos - (Vertex.SubScope defined) - in - ScopeDependencies.add_edge_e g edge - | ( Ast.ScopeDef.Var (v_defined, s_defined), - Ast.ScopeDef.SubScopeVar (used, _, _) ) -> - (* finally we define a scope var with the output of a subscope *) - let edge = - ScopeDependencies.E.create (Vertex.SubScope used) fv_def_pos - (Vertex.Var (v_defined, s_defined)) - in - ScopeDependencies.add_edge_e g edge) + let v_used = to_vertex fv_def in + let () = + if Vertex.equal v_used v_defined then + match def_key with + | _, Ast.ScopeDef.Var _ -> + Message.raise_spanned_error fv_def_pos + "The variable %a is used in one of its definitions, but \ + recursion is forbidden in Catala" + Ast.ScopeDef.format def_key + | v, Ast.ScopeDef.SubScopeInput _ -> + Message.raise_spanned_error fv_def_pos + "The subscope %a is used in the definition of its own \ + input %a, but recursion is forbidden in Catala" + ScopeVar.format (Mark.remove v) Ast.ScopeDef.format def_key + in + ScopeDependencies.add_edge_e g + (ScopeDependencies.E.create v_used fv_def_pos v_defined)) fv g) scope.scope_defs g in @@ -263,8 +221,6 @@ let build_scope_dependencies (scope : Ast.scope) : ScopeDependencies.t = match Mark.remove used_var with | DesugaredScopeVar { name; state } -> Some (Vertex.Var (Mark.remove name, state)) - | SubScopeVar { alias; _ } -> - Some (Vertex.SubScope (Mark.remove alias)) | ToplevelVar _ -> None (* we don't add this dependency because toplevel definitions are outside the scope *) diff --git a/compiler/desugared/dependency.mli b/compiler/desugared/dependency.mli index d475b629..7e190a1d 100644 --- a/compiler/desugared/dependency.mli +++ b/compiler/desugared/dependency.mli @@ -36,7 +36,6 @@ open Shared_ast module Vertex : sig type t = | Var of Shared_ast.ScopeVar.t * Shared_ast.StateName.t option - | SubScope of Shared_ast.SubScopeName.t | Assertion of Ast.AssertionName.t val format : Format.formatter -> t -> unit diff --git a/compiler/desugared/disambiguate.ml b/compiler/desugared/disambiguate.ml index d87dc4ac..024645f6 100644 --- a/compiler/desugared/disambiguate.ml +++ b/compiler/desugared/disambiguate.ml @@ -14,6 +14,7 @@ License for the specific language governing permissions and limitations under the License. *) +open Catala_utils open Shared_ast open Ast @@ -82,10 +83,11 @@ let program prg = let scope = ScopeName.Map.find scope_name modul.module_scopes in let vars = ScopeDef.Map.fold - (fun var def vars -> - match var with - | Var (v, _states) -> ScopeVar.Map.add v def.scope_def_typ vars - | SubScopeVar _ -> vars) + (fun (v, kind) def vars -> + match kind with + | ScopeDef.Var _ -> + ScopeVar.Map.add (Mark.remove v) def.scope_def_typ vars + | ScopeDef.SubScopeInput _ -> vars) scope.scope_defs ScopeVar.Map.empty in (* at this stage, rule resolution and the corresponding encapsulation diff --git a/compiler/desugared/from_surface.ml b/compiler/desugared/from_surface.ml index a8de7be1..b7d58c0e 100644 --- a/compiler/desugared/from_surface.ml +++ b/compiler/desugared/from_surface.ml @@ -395,7 +395,7 @@ let rec translate_expr | Some st, [], _ -> Message.raise_spanned_error (Mark.get st) "Variable %a does not define states" ScopeVar.format uid - | st, states, Some (Var (x'_uid, sx'), _) + | st, states, Some (((x'_uid, _), Ast.ScopeDef.Var sx'), _) when ScopeVar.equal uid x'_uid -> ( if st <> None then (* TODO *) @@ -443,9 +443,10 @@ let rec translate_expr Expr.elocation (DesugaredScopeVar { name = uid, pos; state = x_state }) emark - | Some (SubScope _) - (* Note: allowing access to a global variable with the same name as a - subscope is disputable, but I see no good reason to forbid it either *) + | Some (SubScope (uid, _, _)) -> + Expr.elocation + (DesugaredScopeVar { name = uid, pos; state = None }) + emark | None -> ( match Ident.Map.find_opt x ctxt.local.topdefs with | Some v -> @@ -472,39 +473,17 @@ let rec translate_expr emark | None -> Name_resolution.raise_unknown_identifier "for an external variable" name) - | Dotted (e, ((path, x), _ppos)) -> ( - match path, Mark.remove e with - | [], Ident ([], (y, _), None) - when Option.fold scope ~none:false ~some:(fun s -> - Name_resolution.is_subscope_uid s ctxt y) -> - (* In this case, y.x is a subscope variable *) - let subscope_uid, subscope_real_uid = - match Ident.Map.find y scope_vars with - | SubScope (sub, sc) -> sub, sc - | ScopeVar _ -> assert false - in - let subscope_var_uid = - Name_resolution.get_var_uid subscope_real_uid ctxt x - in - Expr.elocation - (SubScopeVar - { - scope = subscope_real_uid; - alias = subscope_uid, pos; - var = subscope_var_uid, pos; - }) - emark - | _ -> - (* In this case e.x is the struct field x access of expression e *) - let e = rec_helper e in - let rec get_str ctxt = function - | [] -> None - | [c] -> Some (Name_resolution.get_struct ctxt c) - | mod_id :: path -> - get_str (Name_resolution.get_module_ctx ctxt mod_id) path - in - Expr.edstructaccess ~e ~field:(Mark.remove x) - ~name_opt:(get_str ctxt path) emark) + | Dotted (e, ((path, x), _ppos)) -> + (* e.x is the struct field x access of expression e *) + let e = rec_helper e in + let rec get_str ctxt = function + | [] -> None + | [c] -> Some (Name_resolution.get_struct ctxt c) + | mod_id :: path -> + get_str (Name_resolution.get_module_ctx ctxt mod_id) path + in + Expr.edstructaccess ~e ~field:(Mark.remove x) ~name_opt:(get_str ctxt path) + emark | FunCall ((Builtin b, _), [arg]) -> let op, ty = match b with @@ -1526,59 +1505,58 @@ let attribute_to_io (attr : S.scope_decl_context_io) : Ast.io = let init_scope_defs (ctxt : Name_resolution.context) - (scope_idmap : scope_var_or_subscope Ident.Map.t) : + (scope_context : Name_resolution.scope_context) : Ast.scope_def Ast.ScopeDef.Map.t = (* Initializing the definitions of all scopes and subscope vars, with no rules yet inside *) let add_def _ v scope_def_map = + let pos = + match v with + | ScopeVar v | SubScope (v, _, _) -> Mark.get (ScopeVar.get_info v) + in + let new_def v_sig io = + { + Ast.scope_def_rules = RuleName.Map.empty; + Ast.scope_def_typ = v_sig.Name_resolution.var_sig_typ; + Ast.scope_def_is_condition = v_sig.var_sig_is_condition; + Ast.scope_def_parameters = v_sig.var_sig_parameters; + Ast.scope_def_io = io; + } + in match v with | ScopeVar v -> ( let v_sig = ScopeVar.Map.find v ctxt.Name_resolution.var_typs in match v_sig.var_sig_states_list with | [] -> - let def_key = Ast.ScopeDef.Var (v, None) in + let def_key = (v, pos), Ast.ScopeDef.Var None in Ast.ScopeDef.Map.add def_key - { - Ast.scope_def_rules = RuleName.Map.empty; - Ast.scope_def_typ = v_sig.var_sig_typ; - Ast.scope_def_is_condition = v_sig.var_sig_is_condition; - Ast.scope_def_parameters = v_sig.var_sig_parameters; - Ast.scope_def_io = attribute_to_io v_sig.var_sig_io; - } + (new_def v_sig (attribute_to_io v_sig.var_sig_io)) scope_def_map | states -> + let last_state = List.length states - 1 in let scope_def, _ = List.fold_left (fun (acc, i) state -> - let def_key = Ast.ScopeDef.Var (v, Some state) in - let def = - { - Ast.scope_def_rules = RuleName.Map.empty; - Ast.scope_def_typ = v_sig.var_sig_typ; - Ast.scope_def_is_condition = v_sig.var_sig_is_condition; - Ast.scope_def_parameters = v_sig.var_sig_parameters; - Ast.scope_def_io = - (* The first state should have the input I/O of the original - variable, and the last state should have the output I/O - of the original variable. All intermediate states shall - have "internal" I/O.*) - (let original_io = attribute_to_io v_sig.var_sig_io in - let io_input = - if i = 0 then original_io.io_input - else NoInput, Mark.get (StateName.get_info state) - in - let io_output = - if i = List.length states - 1 then original_io.io_output - else false, Mark.get (StateName.get_info state) - in - { io_input; io_output }); - } + let def_key = (v, pos), Ast.ScopeDef.Var (Some state) in + let original_io = attribute_to_io v_sig.var_sig_io in + (* The first state should have the input I/O of the original + variable, and the last state should have the output I/O of the + original variable. All intermediate states shall have + "internal" I/O.*) + let io_input = + if i = 0 then original_io.io_input + else NoInput, Mark.get (StateName.get_info state) in + let io_output = + if i = last_state then original_io.io_output + else false, Mark.get (StateName.get_info state) + in + let def = new_def v_sig { io_input; io_output } in Ast.ScopeDef.Map.add def_key def acc, i + 1) (scope_def_map, 0) states in scope_def) - | SubScope (v0, subscope_uid) -> + | SubScope (v0, subscope_uid, forward_out) -> let sub_scope_def = Name_resolution.get_scope_context ctxt subscope_uid in let ctxt = List.fold_left @@ -1590,16 +1568,41 @@ let init_scope_defs ctxt (ScopeName.path subscope_uid) in + let var_def = + { + Ast.scope_def_rules = RuleName.Map.empty; + Ast.scope_def_typ = + ( TStruct sub_scope_def.scope_out_struct, + Mark.get (ScopeVar.get_info v0) ); + Ast.scope_def_is_condition = false; + Ast.scope_def_parameters = None; + Ast.scope_def_io = + { + io_input = NoInput, Mark.get forward_out; + io_output = forward_out; + }; + } + in + let scope_def_map = + Ast.ScopeDef.Map.add + ((v0, pos), Ast.ScopeDef.Var None) + var_def scope_def_map + in Ident.Map.fold (fun _ v scope_def_map -> match v with - | SubScope _ -> scope_def_map + | SubScope _ -> + (* TODO: if we consider "input subscopes" at some point their inputs + will need to be forwarded here *) + scope_def_map | ScopeVar v -> (* TODO: shouldn't we ignore internal variables too at this point ? *) let v_sig = ScopeVar.Map.find v ctxt.Name_resolution.var_typs in let def_key = - Ast.ScopeDef.SubScopeVar (v0, v, Mark.get (ScopeVar.get_info v)) + ( (v0, Mark.get (ScopeVar.get_info v)), + Ast.ScopeDef.SubScopeInput + { name = subscope_uid; var_within_origin_scope = v } ) in Ast.ScopeDef.Map.add def_key { @@ -1612,7 +1615,7 @@ let init_scope_defs scope_def_map) sub_scope_def.Name_resolution.var_idmap scope_def_map in - Ident.Map.fold add_def scope_idmap Ast.ScopeDef.Map.empty + Ident.Map.fold add_def scope_context.var_idmap Ast.ScopeDef.Map.empty (** Main function of this module *) let translate_program (ctxt : Name_resolution.context) (surface : S.program) : @@ -1636,14 +1639,14 @@ let translate_program (ctxt : Name_resolution.context) (surface : S.program) : (fun _ v acc -> match v with | ScopeVar _ -> acc - | SubScope (sub_var, sub_scope) -> - SubScopeName.Map.add sub_var sub_scope acc) - s_context.Name_resolution.var_idmap SubScopeName.Map.empty + | SubScope (sub_var, sub_scope, _) -> + ScopeVar.Map.add sub_var sub_scope acc) + s_context.Name_resolution.var_idmap ScopeVar.Map.empty in { Ast.scope_vars; scope_sub_scopes; - scope_defs = init_scope_defs ctxt s_context.var_idmap; + scope_defs = init_scope_defs ctxt s_context; scope_assertions = Ast.AssertionName.Map.empty; scope_meta_assertions = []; scope_options = []; diff --git a/compiler/desugared/linting.ml b/compiler/desugared/linting.ml index 264fe784..fd589eb5 100644 --- a/compiler/desugared/linting.ml +++ b/compiler/desugared/linting.ml @@ -25,9 +25,13 @@ let detect_empty_definitions (p : program) : unit = ScopeDef.Map.iter (fun scope_def_key scope_def -> if - (match scope_def_key with ScopeDef.Var _ -> true | _ -> false) + (match scope_def_key with _, ScopeDef.Var _ -> true | _ -> false) && RuleName.Map.is_empty scope_def.scope_def_rules && (not scope_def.scope_def_is_condition) + && (not + (ScopeVar.Map.mem + (Mark.remove (fst scope_def_key)) + scope.scope_sub_scopes)) && match Mark.remove scope_def.scope_def_io.io_input with | NoInput -> true @@ -251,34 +255,30 @@ let detect_dead_code (p : program) : unit = let is_alive (v : Dependency.ScopeDependencies.vertex) = match v with | Assertion _ -> true - | SubScope _ -> true | Var (var, state) -> let scope_def = - ScopeDef.Map.find (Var (var, state)) scope.scope_defs + ScopeDef.Map.find + ((var, Pos.no_pos), ScopeDef.Var state) + scope.scope_defs in Mark.remove scope_def.scope_def_io.io_output (* A variable is initially alive if it is an output*) in let is_alive = Reachability.analyze is_alive scope_dependencies in - ScopeVar.Map.iter - (fun var states -> - let emit_unused_warning () = - Message.emit_spanned_warning - (Mark.get (ScopeVar.get_info var)) - "This variable is dead code; it does not contribute to computing \ - any of scope \"%a\" outputs. Did you forget something?" - ScopeName.format scope_name - in - match states with - | WholeVar -> - if not (is_alive (Var (var, None))) then emit_unused_warning () - | States states -> - List.iter - (fun state -> - if not (is_alive (Var (var, Some state))) then - emit_unused_warning ()) - states) - scope.scope_vars) + let emit_unused_warning vx = + Message.emit_spanned_warning + (Mark.get (Dependency.Vertex.info vx)) + "Unused varible: %a does not contribute to computing any of scope %a \ + outputs. Did you forget something?" + Dependency.Vertex.format vx ScopeName.format scope_name + in + Dependency.ScopeDependencies.iter_vertex + (fun vx -> + if + (not (is_alive vx)) + && Dependency.ScopeDependencies.succ scope_dependencies vx = [] + then emit_unused_warning vx) + scope_dependencies) p.program_root.module_scopes let lint_program (p : program) : unit = diff --git a/compiler/desugared/name_resolution.ml b/compiler/desugared/name_resolution.ml index 5d7293f6..f6a5900d 100644 --- a/compiler/desugared/name_resolution.ml +++ b/compiler/desugared/name_resolution.ml @@ -35,6 +35,8 @@ type scope_context = { (** All variables, including scope variables and subscopes *) scope_defs_contexts : scope_def_context Ast.ScopeDef.Map.t; (** What is the default rule to refer to for unnamed exceptions, if any *) + scope_in_struct : StructName.t; + scope_out_struct : StructName.t; sub_scopes : ScopeName.Set.t; (** Other scopes referred to by this scope. Used for dependency analysis *) } @@ -136,10 +138,10 @@ let get_var_uid let get_subscope_uid (scope_uid : ScopeName.t) (ctxt : context) - ((y, pos) : Ident.t Mark.pos) : SubScopeName.t = + ((y, pos) : Ident.t Mark.pos) : ScopeVar.t = let scope = get_scope_context ctxt scope_uid in match Ident.Map.find_opt y scope.var_idmap with - | Some (SubScope (sub_uid, _sub_id)) -> sub_uid + | Some (SubScope (sub_uid, _sub_id, _)) -> sub_uid | _ -> raise_unknown_identifier "for a subscope of this scope" (y, pos) (** [is_subscope_uid scope_uid ctxt y] returns true if [y] belongs to the @@ -161,32 +163,19 @@ let belongs_to (ctxt : context) (uid : ScopeVar.t) (scope_uid : ScopeName.t) : | _ -> false) scope.var_idmap -(** Retrieves the type of a scope definition from the context *) -let get_def_typ (ctxt : context) (def : Ast.ScopeDef.t) : typ = +let get_var_def (def : Ast.ScopeDef.t) : ScopeVar.t = match def with - | Ast.ScopeDef.SubScopeVar (_, x, _) - (* we don't need to look at the subscope prefix because [x] is already the uid - referring back to the original subscope *) - | Ast.ScopeDef.Var (x, _) -> - get_var_typ ctxt x + | (v, _), Ast.ScopeDef.Var _ + | _, Ast.ScopeDef.SubScopeInput { var_within_origin_scope = v; _ } -> + v (** Retrieves the type of a scope definition from the context *) let get_params (ctxt : context) (def : Ast.ScopeDef.t) : (Uid.MarkedString.info * typ) list Mark.pos option = - match def with - | Ast.ScopeDef.SubScopeVar (_, x, _) - (* we don't need to look at the subscope prefix because [x] is already the uid - referring back to the original subscope *) - | Ast.ScopeDef.Var (x, _) -> - (ScopeVar.Map.find x ctxt.var_typs).var_sig_parameters + (ScopeVar.Map.find (get_var_def def) ctxt.var_typs).var_sig_parameters let is_def_cond (ctxt : context) (def : Ast.ScopeDef.t) : bool = - match def with - | Ast.ScopeDef.SubScopeVar (_, x, _) - (* we don't need to look at the subscope prefix because [x] is already the uid - referring back to the original subscope *) - | Ast.ScopeDef.Var (x, _) -> - is_var_cond ctxt x + is_var_cond ctxt (get_var_def def) let get_enum ctxt id = match Ident.Map.find (Mark.remove id) ctxt.local.typedefs with @@ -267,6 +256,10 @@ let process_subscope_decl (ctxt : context) (decl : Surface.Ast.scope_decl_context_scope) : context = let name, name_pos = decl.scope_decl_context_scope_name in + let forward_output = + decl.Surface.Ast.scope_decl_context_scope_attribute + .scope_decl_context_io_output + in let (path, subscope), s_pos = decl.scope_decl_context_scope_sub_scope in let scope_ctxt = get_scope_context ctxt scope in match Ident.Map.find_opt (Mark.remove subscope) scope_ctxt.var_idmap with @@ -274,13 +267,13 @@ let process_subscope_decl let info = match use with | ScopeVar v -> ScopeVar.get_info v - | SubScope (ssc, _) -> SubScopeName.get_info ssc + | SubScope (ssc, _, _) -> ScopeVar.get_info ssc in Message.raise_multispanned_error [Some "first use", Mark.get info; Some "second use", s_pos] "Subscope name @{\"%s\"@} already used" (Mark.remove subscope) | None -> - let sub_scope_uid = SubScopeName.fresh (name, name_pos) in + let sub_scope_uid = ScopeVar.fresh (name, name_pos) in let original_subscope_uid = let ctxt = module_ctx ctxt path in get_scope ctxt subscope @@ -290,7 +283,7 @@ let process_subscope_decl scope_ctxt with var_idmap = Ident.Map.add name - (SubScope (sub_scope_uid, original_subscope_uid)) + (SubScope (sub_scope_uid, original_subscope_uid, forward_output)) scope_ctxt.var_idmap; sub_scopes = ScopeName.Set.add original_subscope_uid scope_ctxt.sub_scopes; @@ -377,7 +370,7 @@ let process_data_decl let info = match use with | ScopeVar v -> ScopeVar.get_info v - | SubScope (ssc, _) -> SubScopeName.get_info ssc + | SubScope (ssc, _, _) -> ScopeVar.get_info ssc in Message.raise_multispanned_error [Some "First use:", Mark.get info; Some "Second use:", pos] @@ -578,6 +571,20 @@ let process_scope_decl (ctxt : context) (decl : Surface.Ast.scope_decl) : data.scope_decl_context_item_typ; } :: acc + | Surface.Ast.ContextScope + { + scope_decl_context_scope_name = var; + scope_decl_context_scope_sub_scope = (path, scope), pos; + scope_decl_context_scope_attribute = + { scope_decl_context_io_output = true, _; _ }; + } -> + Mark.add (Mark.get item) + { + Surface.Ast.struct_decl_field_name = var; + Surface.Ast.struct_decl_field_typ = + Base (Data (Primitive (Named (path, scope)))), pos; + } + :: acc | _ -> acc) decl.scope_decl_context [] in @@ -605,8 +612,8 @@ let process_scope_decl (ctxt : context) (decl : Surface.Ast.scope_decl) : Ident.Map.fold (fun id var svmap -> match var with - | SubScope _ -> svmap - | ScopeVar v -> ( + | SubScope (_, _, (false, _)) -> svmap + | ScopeVar v | SubScope (v, _, (true, _)) -> ( try let field = StructName.Map.find str @@ -673,6 +680,8 @@ let process_name_item (ctxt : context) (item : Surface.Ast.code_item Mark.pos) : { var_idmap = Ident.Map.empty; scope_defs_contexts = Ast.ScopeDef.Map.empty; + scope_in_struct = in_struct_name; + scope_out_struct = out_struct_name; sub_scopes = ScopeName.Set.empty; } ctxt.scopes @@ -762,9 +771,9 @@ let get_def_key | [x] -> let x_uid = get_var_uid scope_uid ctxt x in let var_sig = ScopeVar.Map.find x_uid ctxt.var_typs in - Ast.ScopeDef.Var - ( x_uid, - match state with + ( (x_uid, pos), + Ast.ScopeDef.Var + (match state with | Some state -> ( try Some @@ -787,21 +796,22 @@ let get_def_key "This definition does not indicate which state has to be \ considered for variable %a." ScopeVar.format x_uid - else None ) + else None) ) | [y; x] -> - let (subscope_uid, subscope_real_uid) : SubScopeName.t * ScopeName.t = + let (subscope_var, name) : ScopeVar.t * ScopeName.t = match Ident.Map.find_opt (Mark.remove y) scope_ctxt.var_idmap with - | Some (SubScope (v, u)) -> v, u + | Some (SubScope (v, u, _)) -> v, u | Some _ -> Message.raise_spanned_error pos - "Invalid access to input variable, %a is not a subscope" - Print.lit_style (Mark.remove y) + "Invalid definition, %a is not a subscope" Print.lit_style + (Mark.remove y) | None -> Message.raise_spanned_error pos "No definition found for subscope %a" Print.lit_style (Mark.remove y) in - let x_uid = get_var_uid subscope_real_uid ctxt x in - Ast.ScopeDef.SubScopeVar (subscope_uid, x_uid, pos) + let var_within_origin_scope = get_var_uid name ctxt x in + ( (subscope_var, pos), + Ast.ScopeDef.SubScopeInput { name; var_within_origin_scope } ) | _ -> Message.raise_spanned_error pos "This line is defining a quantity that is neither a scope variable nor a \ diff --git a/compiler/desugared/name_resolution.mli b/compiler/desugared/name_resolution.mli index 7ca4768c..ce54061d 100644 --- a/compiler/desugared/name_resolution.mli +++ b/compiler/desugared/name_resolution.mli @@ -35,6 +35,8 @@ type scope_context = { (** All variables, including scope variables and subscopes *) scope_defs_contexts : scope_def_context Ast.ScopeDef.Map.t; (** What is the default rule to refer to for unnamed exceptions, if any *) + scope_in_struct : StructName.t; + scope_out_struct : StructName.t; sub_scopes : ScopeName.Set.t; (** Other scopes referred to by this scope. Used for dependency analysis *) } @@ -130,8 +132,7 @@ val get_scope_context : context -> ScopeName.t -> scope_context val get_var_uid : ScopeName.t -> context -> Ident.t Mark.pos -> ScopeVar.t (** Get the variable uid inside the scope given in argument *) -val get_subscope_uid : - ScopeName.t -> context -> Ident.t Mark.pos -> SubScopeName.t +val get_subscope_uid : ScopeName.t -> context -> Ident.t Mark.pos -> ScopeVar.t (** Get the subscope uid inside the scope given in argument *) val is_subscope_uid : ScopeName.t -> context -> Ident.t -> bool @@ -141,9 +142,6 @@ val is_subscope_uid : ScopeName.t -> context -> Ident.t -> bool val belongs_to : context -> ScopeVar.t -> ScopeName.t -> bool (** Checks if the var_uid belongs to the scope scope_uid *) -val get_def_typ : context -> Ast.ScopeDef.t -> typ -(** Retrieves the type of a scope definition from the context *) - val get_params : context -> Ast.ScopeDef.t -> diff --git a/compiler/driver.ml b/compiler/driver.ml index 15f38268..afb519fb 100644 --- a/compiler/driver.ml +++ b/compiler/driver.ml @@ -339,7 +339,7 @@ module Commands = struct let get_variable_uid (ctxt : Desugared.Name_resolution.context) (scope_uid : ScopeName.t) - (variable : string) = + (variable : string) : Desugared.Ast.ScopeDef.t = (* Sometimes the variable selected is of the form [a.b] *) let first_part, second_part = match String.index_opt variable '.' with @@ -356,50 +356,21 @@ module Commands = struct Message.raise_error "Variable @{\"%s\"@} not found inside scope @{\"%a\"@}" variable ScopeName.format scope_uid - | Some (SubScope (subscope_var_name, subscope_name)) -> ( - match second_part with - | None -> - Message.raise_error - "Subscope @{\"%a\"@} of scope @{\"%a\"@} cannot be \ - selected by itself, please add \".\" where is a subscope \ - variable." - SubScopeName.format subscope_var_name ScopeName.format scope_uid - | Some second_part -> ( - match - let ctxt = - Desugared.Name_resolution.module_ctx ctxt - (List.map - (fun m -> ModuleName.to_string m, Pos.no_pos) - (ScopeName.path subscope_name)) - in - Ident.Map.find_opt second_part - (ScopeName.Map.find subscope_name ctxt.scopes).var_idmap - with - | Some (ScopeVar v) -> - Desugared.Ast.ScopeDef.SubScopeVar (subscope_var_name, v, Pos.no_pos) - | _ -> - Message.raise_error - "Var @{\"%s\"@} of subscope @{\"%a\"@} in scope \ - @{\"%a\"@} does not exist, please check your command line \ - arguments." - second_part SubScopeName.format subscope_var_name ScopeName.format - scope_uid)) - | Some (ScopeVar v) -> - Desugared.Ast.ScopeDef.Var - ( v, - Option.map - (fun second_part -> - let var_sig = ScopeVar.Map.find v ctxt.var_typs in - match - Ident.Map.find_opt second_part var_sig.var_sig_states_idmap - with - | Some state -> state - | None -> - Message.raise_error - "State @{\"%s\"@} is not found for variable \ - @{\"%s\"@} of scope @{\"%a\"@}" - second_part first_part ScopeName.format scope_uid) - second_part ) + | Some (ScopeVar v | SubScope (v, _, _)) -> + let state = + second_part + |> Option.map + @@ fun id -> + let var_sig = ScopeVar.Map.find v ctxt.var_typs in + match Ident.Map.find_opt id var_sig.var_sig_states_idmap with + | Some state -> state + | None -> + Message.raise_error + "State @{\"%s\"@} is not found for variable \ + @{\"%s\"@} of scope @{\"%a\"@}" + id first_part ScopeName.format scope_uid + in + (v, Pos.no_pos), Desugared.Ast.ScopeDef.Var state let get_output ?ext options output_file = let output_file = Option.map options.Global.path_rewrite output_file in diff --git a/compiler/lcalc/to_ocaml.ml b/compiler/lcalc/to_ocaml.ml index ab64204a..7f4fae77 100644 --- a/compiler/lcalc/to_ocaml.ml +++ b/compiler/lcalc/to_ocaml.ml @@ -691,7 +691,7 @@ let format_scope_exec_args Message.raise_error "No scopes that don't require input were found, executable can't be \ generated"; - Format.eprintf "@[Generating entry points for scopes:@ %a@]@." + Message.emit_debug "@[Generating entry points for scopes:@ %a@]@." (Format.pp_print_list ~pp_sep:Format.pp_print_space (fun ppf (_, s, _) -> ScopeName.format ppf s)) scopes_with_no_input; diff --git a/compiler/scalc/to_python.ml b/compiler/scalc/to_python.ml index 8e963d3d..0e9f4c97 100644 --- a/compiler/scalc/to_python.ml +++ b/compiler/scalc/to_python.ml @@ -134,12 +134,14 @@ module IntMap = Map.Make (struct let format ppf i = Format.pp_print_int ppf i end) -let format_name_cleaned (fmt : Format.formatter) (s : string) : unit = +let clean_name (s : string) : string = s |> String.to_snake_case |> Re.Pcre.substitute ~rex:(Re.Pcre.regexp "\\.") ~subst:(fun _ -> "_dot_") |> avoid_keywords - |> Format.pp_print_string fmt + +let format_name_cleaned (fmt : Format.formatter) (s : string) : unit = + Format.pp_print_string fmt (clean_name s) (** For each `VarName.t` defined by its string and then by its hash, we keep track of which local integer id we've given it. This is used to keep @@ -149,25 +151,17 @@ let format_name_cleaned (fmt : Format.formatter) (s : string) : unit = let string_counter_map : int IntMap.t StringMap.t ref = ref StringMap.empty let format_var (fmt : Format.formatter) (v : VarName.t) : unit = - let v_str = Mark.remove (VarName.get_info v) in + let v_str = clean_name (Mark.remove (VarName.get_info v)) in let hash = VarName.hash v in let local_id = match StringMap.find_opt v_str !string_counter_map with | Some ids -> ( match IntMap.find_opt hash ids with | None -> - let max_id = - snd - (List.hd - (List.fast_sort - (fun (_, x) (_, y) -> Int.compare y x) - (IntMap.bindings ids))) - in + let id = 1 + IntMap.fold (fun _ -> Int.max) ids 0 in string_counter_map := - StringMap.add v_str - (IntMap.add hash (max_id + 1) ids) - !string_counter_map; - max_id + 1 + StringMap.add v_str (IntMap.add hash id ids) !string_counter_map; + id | Some local_id -> local_id) | None -> string_counter_map := @@ -176,8 +170,8 @@ let format_var (fmt : Format.formatter) (v : VarName.t) : unit = in if v_str = "_" then Format.fprintf fmt "_" (* special case for the unit pattern *) - else if local_id = 0 then format_name_cleaned fmt v_str - else Format.fprintf fmt "%a_%d" format_name_cleaned v_str local_id + else if local_id = 0 then Format.pp_print_string fmt v_str + else Format.fprintf fmt "%s_%d" v_str local_id let format_path ctx fmt p = match List.rev p with @@ -632,6 +626,16 @@ let format_ctx (e, EnumName.Map.find e ctx.decl_ctx.ctx_enums)) (type_ordering @ scope_structs) +(* FIXME: this is an ugly (and partial) workaround, Python basically has one + namespace and we reserve the name to avoid clashes between func ids and + variable ids. *) +let reserve_func_name = function + | SVar _ -> () + | SFunc { var = v; _ } | SScope { scope_body_var = v; _ } -> + let v_str = clean_name (Mark.remove (FuncName.get_info v)) in + string_counter_map := + StringMap.add v_str (IntMap.singleton (-1) 0) !string_counter_map + let format_code_item ctx fmt = function | SVar { var; expr; typ = _ } -> Format.fprintf fmt "@[%a = (@,%a@,@])@," format_var var @@ -651,6 +655,7 @@ let format_program (fmt : Format.formatter) (p : Ast.program) (type_ordering : Scopelang.Dependency.TVertex.t list) : unit = + List.iter reserve_func_name p.code_items; Format.pp_open_vbox fmt 0; let header = [ diff --git a/compiler/scopelang/ast.ml b/compiler/scopelang/ast.ml index 1c01de7a..100cfc10 100644 --- a/compiler/scopelang/ast.ml +++ b/compiler/scopelang/ast.ml @@ -39,9 +39,19 @@ let rec locations_used (e : 'm expr) : LocationSet.t = e LocationSet.empty type 'm rule = - | Definition of location Mark.pos * typ * Desugared.Ast.io * 'm expr + | ScopeVarDefinition of { + var : ScopeVar.t Mark.pos; + typ : typ; + io : Desugared.Ast.io; + e : 'm expr; + } + | SubScopeVarDefinition of { + var : ScopeVar.t Mark.pos; + var_within_origin_scope : ScopeVar.t; + typ : typ; + e : 'm expr; + } | Assertion of 'm expr - | Call of ScopeName.t * SubScopeName.t * 'm mark type scope_var_ty = { svar_in_ty : typ; @@ -66,16 +76,16 @@ type 'm program = { } let type_rule decl_ctx env = function - | Definition (loc, typ, io, expr) -> - let expr' = Typing.expr decl_ctx ~env ~typ expr in - Definition (loc, typ, io, Expr.unbox expr') - | Assertion expr -> - let typ = Mark.add (Expr.pos expr) (TLit TBool) in - let expr' = Typing.expr decl_ctx ~env ~typ expr in - Assertion (Expr.unbox expr') - | Call (sc_name, ssc_name, m) -> - let pos = Expr.mark_pos m in - Call (sc_name, ssc_name, Typed { pos; ty = Mark.add pos TAny }) + | ScopeVarDefinition ({ typ; e; _ } as def) -> + let e = Typing.expr decl_ctx ~env ~typ e in + ScopeVarDefinition { def with e = Expr.unbox e } + | SubScopeVarDefinition ({ typ; e; _ } as def) -> + let e = Typing.expr decl_ctx ~env ~typ e in + SubScopeVarDefinition { def with e = Expr.unbox e } + | Assertion e -> + let typ = Mark.add (Expr.pos e) (TLit TBool) in + let e = Typing.expr decl_ctx ~env ~typ e in + Assertion (Expr.unbox e) let type_program (type m) (prg : m program) : typed program = (* Caution: this environment building code is very similar to that in diff --git a/compiler/scopelang/ast.mli b/compiler/scopelang/ast.mli index 0908f9cd..c47d1336 100644 --- a/compiler/scopelang/ast.mli +++ b/compiler/scopelang/ast.mli @@ -32,9 +32,22 @@ type 'm expr = (scopelang, 'm) gexpr val locations_used : 'm expr -> LocationSet.t type 'm rule = - | Definition of location Mark.pos * typ * Desugared.Ast.io * 'm expr + | ScopeVarDefinition of { + var : ScopeVar.t Mark.pos; + typ : typ; + io : Desugared.Ast.io; + e : 'm expr; + } + | SubScopeVarDefinition of { + var : ScopeVar.t Mark.pos; (** Variable within the current scope *) + (* scope: ScopeVar.t Mark.pos; (\** Variable pointing to the *\) *) + (* origin_var: ScopeVar.t Mark.pos; + * reentrant: bool; *) + var_within_origin_scope : ScopeVar.t; + typ : typ; (* non-thunked at this point for reentrant vars *) + e : 'm expr; + } | Assertion of 'm expr - | Call of ScopeName.t * SubScopeName.t * 'm mark type scope_var_ty = { svar_in_ty : typ; diff --git a/compiler/scopelang/dependency.ml b/compiler/scopelang/dependency.ml index fa086ce8..8644ae0d 100644 --- a/compiler/scopelang/dependency.ml +++ b/compiler/scopelang/dependency.ml @@ -94,15 +94,12 @@ let rec expr_used_defs e = | e -> recurse_subterms e let rule_used_defs = function - | Ast.Assertion e | Ast.Definition (_, _, _, e) -> + | Ast.Assertion e + | Ast.ScopeVarDefinition { e; _ } + | Ast.SubScopeVarDefinition { e; _ } -> (* TODO: maybe this info could be passed on from previous passes without walking through all exprs again *) expr_used_defs e - | Ast.Call (subscope, subindex, _) -> - if ScopeName.path subscope = [] then - VMap.singleton (Scope subscope) - (Mark.get (SubScopeName.get_info subindex)) - else VMap.empty let build_program_dep_graph (prgm : 'm Ast.program) : SDependencies.t = let g = SDependencies.empty in diff --git a/compiler/scopelang/from_desugared.ml b/compiler/scopelang/from_desugared.ml index 8a76babc..a27cf337 100644 --- a/compiler/scopelang/from_desugared.ml +++ b/compiler/scopelang/from_desugared.ml @@ -58,15 +58,6 @@ let rec translate_expr (ctx : ctx) (e : D.expr) : untyped Ast.expr boxed = ctx (Array.to_list vars) (Array.to_list new_vars) in Expr.eabs (Expr.bind new_vars (translate_expr ctx body)) tys m - | ELocation (SubScopeVar { scope; alias; var }) -> - (* When referring to a subscope variable in an expression, we are referring - to the output, hence we take the last state. *) - let var = - match ScopeVar.Map.find (Mark.remove var) ctx.scope_var_mapping with - | WholeVar new_s_var -> Mark.copy var new_s_var - | States states -> Mark.copy var (snd (List.hd (List.rev states))) - in - Expr.elocation (SubScopeVar { scope; alias; var }) m | ELocation (DesugaredScopeVar { name; state = None }) -> Expr.elocation (ScopelangScopeVar @@ -199,9 +190,62 @@ let def_to_exception_graph exc_graph let rule_to_exception_graph (scope : D.scope) = function + | Desugared.Dependency.Vertex.Var (var, None) + when ScopeVar.Map.mem var scope.scope_sub_scopes -> + (* Before calling the sub_scope, we need to include all the re-definitions + of subscope parameters*) + D.ScopeDef.Map.fold + (fun ((sscope, kind) as def_key) scope_def exc_graphs -> + match kind with + | D.ScopeDef.Var _ -> exc_graphs + | D.ScopeDef.SubScopeInput _ + when (not (ScopeVar.equal var (Mark.remove sscope))) + || Mark.remove scope_def.D.scope_def_io.io_input = NoInput + && RuleName.Map.is_empty scope_def.scope_def_rules -> + (* We exclude subscope variables that have 0 re-definitions and are + not visible in the input of the subscope *) + exc_graphs + | D.ScopeDef.SubScopeInput { var_within_origin_scope; _ } -> + (* This definition redefines a variable of the correct subscope. But + we have to check that this redefinition is allowed with respect to + the io parameters of that subscope variable. *) + let def = scope_def.D.scope_def_rules in + let is_cond = scope_def.scope_def_is_condition in + let () = + match Mark.remove scope_def.D.scope_def_io.io_input with + | NoInput -> + Message.raise_multispanned_error + (( Some "Incriminated subscope:", + Mark.get (ScopeVar.get_info (Mark.remove sscope)) ) + :: ( Some "Incriminated variable:", + Mark.get (ScopeVar.get_info var_within_origin_scope) ) + :: List.map + (fun rule -> + ( Some "Incriminated subscope variable definition:", + Mark.get (RuleName.get_info rule) )) + (RuleName.Map.keys def)) + "Invalid assignment to a subscope variable that is not tagged \ + as input or context." + | OnlyInput when RuleName.Map.is_empty def && not is_cond -> + (* If the subscope variable is tagged as input, then it shall be + defined. *) + Message.raise_multispanned_error + [ + ( Some "Incriminated subscope:", + Mark.get (ScopeVar.get_info (Mark.remove sscope)) ); + Some "Incriminated variable:", Mark.get sscope; + ] + "This subscope variable is a mandatory input but no definition \ + was provided." + | _ -> () + in + let new_exc_graph = def_to_exception_graph def_key def in + D.ScopeDef.Map.add def_key new_exc_graph exc_graphs) + scope.scope_defs D.ScopeDef.Map.empty | Desugared.Dependency.Vertex.Var (var, state) -> ( + let pos = Mark.get (ScopeVar.get_info var) in let scope_def = - D.ScopeDef.Map.find (D.ScopeDef.Var (var, state)) scope.scope_defs + D.ScopeDef.Map.find ((var, pos), D.ScopeDef.Var state) scope.scope_defs in let var_def = scope_def.D.scope_def_rules in match Mark.remove scope_def.D.scope_def_io.io_input with @@ -220,76 +264,8 @@ let rule_to_exception_graph (scope : D.scope) = function (* we do not provide any definition for an input-only variable *) | _ -> D.ScopeDef.Map.singleton - (D.ScopeDef.Var (var, state)) - (def_to_exception_graph (D.ScopeDef.Var (var, state)) var_def)) - | Desugared.Dependency.Vertex.SubScope sub_scope_index -> - (* Before calling the sub_scope, we need to include all the re-definitions - of subscope parameters*) - let sub_scope_vars_redefs_candidates = - D.ScopeDef.Map.filter - (fun def_key scope_def -> - match def_key with - | D.ScopeDef.Var _ -> false - | D.ScopeDef.SubScopeVar (sub_scope_index', _, _) -> - sub_scope_index = sub_scope_index' - (* We exclude subscope variables that have 0 re-definitions and are - not visible in the input of the subscope *) - && not - ((match Mark.remove scope_def.D.scope_def_io.io_input with - | NoInput -> true - | _ -> false) - && RuleName.Map.is_empty scope_def.scope_def_rules)) - scope.scope_defs - in - let sub_scope_vars_redefs = - D.ScopeDef.Map.mapi - (fun def_key scope_def -> - let def = scope_def.D.scope_def_rules in - let is_cond = scope_def.scope_def_is_condition in - match def_key with - | D.ScopeDef.Var _ -> assert false (* should not happen *) - | D.ScopeDef.SubScopeVar (sscope, sub_scope_var, pos) -> - (* This definition redefines a variable of the correct subscope. But - we have to check that this redefinition is allowed with respect - to the io parameters of that subscope variable. *) - (match Mark.remove scope_def.D.scope_def_io.io_input with - | NoInput -> - Message.raise_multispanned_error - (( Some "Incriminated subscope:", - Mark.get (SubScopeName.get_info sscope) ) - :: ( Some "Incriminated variable:", - Mark.get (ScopeVar.get_info sub_scope_var) ) - :: List.map - (fun rule -> - ( Some "Incriminated subscope variable definition:", - Mark.get (RuleName.get_info rule) )) - (RuleName.Map.keys def)) - "It is impossible to give a definition to a subscope variable \ - not tagged as input or context." - | OnlyInput when RuleName.Map.is_empty def && not is_cond -> - (* If the subscope variable is tagged as input, then it shall be - defined. *) - Message.raise_multispanned_error - [ - ( Some "Incriminated subscope:", - Mark.get (SubScopeName.get_info sscope) ); - Some "Incriminated variable:", pos; - ] - "This subscope variable is a mandatory input but no definition \ - was provided." - | _ -> ()); - let exc_graph = def_to_exception_graph def_key def in - let var_pos = D.ScopeDef.get_position def_key in - exc_graph, sub_scope_var, var_pos) - sub_scope_vars_redefs_candidates - in - List.fold_left - (fun exc_graphs (new_exc_graph, subscope_var, var_pos) -> - D.ScopeDef.Map.add - (D.ScopeDef.SubScopeVar (sub_scope_index, subscope_var, var_pos)) - new_exc_graph exc_graphs) - D.ScopeDef.Map.empty - (D.ScopeDef.Map.values sub_scope_vars_redefs) + ((var, pos), D.ScopeDef.Var state) + (def_to_exception_graph ((var, pos), D.ScopeDef.Var state) var_def)) | Assertion _ -> D.ScopeDef.Map.empty (* no exceptions for assertions *) let scope_to_exception_graphs (scope : D.scope) : @@ -576,157 +552,166 @@ let translate_rule (exc_graphs : Desugared.Dependency.ExceptionsDependencies.t D.ScopeDef.Map.t) = function | Desugared.Dependency.Vertex.Var (var, state) -> ( + let pos = Mark.get (ScopeVar.get_info var) in + (* TODO: this may point to the place where the variable was declared instead + of the binding in the definition being explored. Needs double-checking + and maybe adding more position information *) let scope_def = - D.ScopeDef.Map.find (D.ScopeDef.Var (var, state)) scope.scope_defs + D.ScopeDef.Map.find ((var, pos), D.ScopeDef.Var state) scope.scope_defs in - let var_def = scope_def.D.scope_def_rules in - let var_params = scope_def.D.scope_def_parameters in - let var_typ = scope_def.D.scope_def_typ in - let is_cond = scope_def.D.scope_def_is_condition in - match Mark.remove scope_def.D.scope_def_io.io_input with - | OnlyInput when not (RuleName.Map.is_empty var_def) -> - assert false (* error already raised *) - | OnlyInput -> [] - (* we do not provide any definition for an input-only variable *) - | _ -> - let scope_def_key = D.ScopeDef.Var (var, state) in - let expr_def = - translate_def ctx scope_def_key var_def var_params var_typ - scope_def.D.scope_def_io - (D.ScopeDef.Map.find scope_def_key exc_graphs) - ~is_cond ~is_subscope_var:false + match ScopeVar.Map.find_opt var scope.scope_sub_scopes with + | None -> ( + let var_def = scope_def.D.scope_def_rules in + let var_params = scope_def.D.scope_def_parameters in + let var_typ = scope_def.D.scope_def_typ in + let is_cond = scope_def.D.scope_def_is_condition in + match Mark.remove scope_def.D.scope_def_io.io_input with + | OnlyInput when not (RuleName.Map.is_empty var_def) -> + assert false (* error already raised *) + | OnlyInput -> [] + (* we do not provide any definition for an input-only variable *) + | _ -> + let scope_def_key = (var, pos), D.ScopeDef.Var state in + let expr_def = + translate_def ctx scope_def_key var_def var_params var_typ + scope_def.D.scope_def_io + (D.ScopeDef.Map.find scope_def_key exc_graphs) + ~is_cond ~is_subscope_var:false + in + let scope_var = + match ScopeVar.Map.find var ctx.scope_var_mapping, state with + | WholeVar v, None -> v + | States states, Some state -> List.assoc state states + | _ -> assert false + in + [ + Ast.ScopeVarDefinition + { + var = scope_var, pos; + typ = var_typ; + io = scope_def.D.scope_def_io; + e = Expr.unbox expr_def; + }; + ]) + | Some subscope -> + (* Before calling the subscope, we need to include all the re-definitions + of subscope parameters *) + let subscope_params = + D.ScopeDef.Map.fold + (fun def_key scope_def acc -> + match def_key with + | _, D.ScopeDef.Var _ -> acc + | (v, _), D.ScopeDef.SubScopeInput _ + when (not (ScopeVar.equal var v)) + || Mark.remove scope_def.D.scope_def_io.io_input = NoInput + && RuleName.Map.is_empty scope_def.scope_def_rules -> + acc + | v, D.ScopeDef.SubScopeInput { var_within_origin_scope; _ } -> + let pos = Mark.get v in + let def = scope_def.D.scope_def_rules in + let def_typ = scope_def.scope_def_typ in + let is_cond = scope_def.scope_def_is_condition in + assert ( + (* an error should have been already raised *) + match scope_def.D.scope_def_io.io_input with + | NoInput, _ -> false + | OnlyInput, _ -> is_cond || not (RuleName.Map.is_empty def) + | _ -> true); + let var_within_origin_scope = + match + ScopeVar.Map.find var_within_origin_scope + ctx.scope_var_mapping + with + | WholeVar v -> v + | States ((_, v) :: _) -> v + | States [] -> assert false + in + let def_var = + Var.make + (String.concat "." + [ + Mark.remove (ScopeVar.get_info (Mark.remove v)); + Mark.remove (ScopeVar.get_info var_within_origin_scope); + ]) + in + let typ = + Scope.input_type def_typ scope_def.D.scope_def_io.D.io_input + in + let expr_def = + translate_def ctx def_key def scope_def.D.scope_def_parameters + def_typ scope_def.D.scope_def_io + (D.ScopeDef.Map.find def_key exc_graphs) + ~is_cond ~is_subscope_var:true + in + ScopeVar.Map.add var_within_origin_scope + (def_var, pos, typ, expr_def) + acc) + scope.scope_defs ScopeVar.Map.empty in - let scope_var = - match ScopeVar.Map.find var ctx.scope_var_mapping, state with - | WholeVar v, None -> v - | States states, Some state -> List.assoc state states - | _ -> failwith "should not happen" + let subscope_param_map = + ScopeVar.Map.map (fun (_, _, _, expr) -> expr) subscope_params in - [ - Ast.Definition - ( ( ScopelangScopeVar - { name = scope_var, Mark.get (ScopeVar.get_info scope_var) }, - Mark.get (ScopeVar.get_info scope_var) ), - var_typ, - scope_def.D.scope_def_io, - Expr.unbox expr_def ); - ]) - | Desugared.Dependency.Vertex.SubScope sub_scope_index -> - (* Before calling the sub_scope, we need to include all the re-definitions - of subscope parameters*) - let sub_scope = - SubScopeName.Map.find sub_scope_index scope.scope_sub_scopes - in - let sub_scope_vars_redefs_candidates = - D.ScopeDef.Map.filter - (fun def_key scope_def -> - match def_key with - | D.ScopeDef.Var _ -> false - | D.ScopeDef.SubScopeVar (sub_scope_index', _, _) -> - sub_scope_index = sub_scope_index' - (* We exclude subscope variables that have 0 re-definitions and are - not visible in the input of the subscope *) - && not - ((match Mark.remove scope_def.D.scope_def_io.io_input with - | NoInput -> true - | _ -> false) - && RuleName.Map.is_empty scope_def.scope_def_rules)) - scope.scope_defs - in - let sub_scope_vars_redefs = - D.ScopeDef.Map.mapi - (fun def_key scope_def -> - let def = scope_def.D.scope_def_rules in - let def_typ = scope_def.scope_def_typ in - let is_cond = scope_def.scope_def_is_condition in - match def_key with - | D.ScopeDef.Var _ -> assert false (* should not happen *) - | D.ScopeDef.SubScopeVar (_, sub_scope_var, var_pos) -> - (* This definition redefines a variable of the correct subscope. But - we have to check that this redefinition is allowed with respect - to the io parameters of that subscope variable. *) - (match Mark.remove scope_def.D.scope_def_io.io_input with - | NoInput -> assert false (* error already raised *) - | OnlyInput when RuleName.Map.is_empty def && not is_cond -> - assert false (* error already raised *) - | _ -> ()); - (* Now that all is good, we can proceed with translating this - redefinition to a proper Scopelang term. *) - let expr_def = - translate_def ctx def_key def scope_def.D.scope_def_parameters - def_typ scope_def.D.scope_def_io - (D.ScopeDef.Map.find def_key exc_graphs) - ~is_cond ~is_subscope_var:true - in - let def_typ = - Scope.input_type def_typ scope_def.D.scope_def_io.D.io_input - in - let subscop_real_name = - SubScopeName.Map.find sub_scope_index scope.scope_sub_scopes - in - Ast.Definition - ( ( SubScopeVar - { - scope = subscop_real_name; - alias = sub_scope_index, var_pos; - var = - (match - ScopeVar.Map.find sub_scope_var ctx.scope_var_mapping - with - | WholeVar v -> v, var_pos - | States states -> - (* When defining a sub-scope variable, we always - define its first state in the sub-scope. *) - snd (List.hd states), var_pos); - }, - var_pos ), - def_typ, - scope_def.D.scope_def_io, - Expr.unbox expr_def )) - sub_scope_vars_redefs_candidates - in - let sub_scope_vars_redefs = D.ScopeDef.Map.values sub_scope_vars_redefs in - sub_scope_vars_redefs - @ [ - Ast.Call - ( sub_scope, - sub_scope_index, - Untyped { pos = Mark.get (SubScopeName.get_info sub_scope_index) } - ); - ] + let subscope_expr = + Expr.escopecall ~scope:subscope ~args:subscope_param_map + (Untyped { pos }) + in + assert (RuleName.Map.is_empty scope_def.D.scope_def_rules); + (* The subscope will be defined by its inputs, it's not supposed to have + direct rules yet *) + let scope_info = ScopeName.Map.find subscope ctx.decl_ctx.ctx_scopes in + let subscope_var_dcalc = + match ScopeVar.Map.find var ctx.scope_var_mapping with + | WholeVar v -> v + | _ -> assert false + in + let subscope_def = + Ast.ScopeVarDefinition + { + var = subscope_var_dcalc, pos; + typ = + ( TStruct scope_info.out_struct_name, + Mark.get (ScopeVar.get_info var) ); + io = scope_def.D.scope_def_io; + e = Expr.unbox_closed subscope_expr; + } + in + [subscope_def]) | Assertion a_name -> let assertion_expr = D.AssertionName.Map.find a_name scope.scope_assertions in (* we unbox here because assertions do not have free variables (at this - point Bindlib variables are only for fuhnction parameters)*) + point Bindlib variables are only for function parameters)*) let assertion_expr = translate_expr ctx (Expr.unbox assertion_expr) in [Ast.Assertion (Expr.unbox assertion_expr)] let translate_scope_interface ctx scope = + let get_svar scope_def = + let svar_in_ty = + Scope.input_type scope_def.D.scope_def_typ + scope_def.D.scope_def_io.io_input + in + { + Ast.svar_in_ty; + svar_out_ty = scope_def.D.scope_def_typ; + svar_io = scope_def.scope_def_io; + } + in let scope_sig = + (* Add the definitions of standard scope vars *) ScopeVar.Map.fold (fun var (states : D.var_or_states) acc -> - let get_svar scope_def = - let svar_in_ty = - Scope.input_type scope_def.D.scope_def_typ - scope_def.D.scope_def_io.io_input - in - { - Ast.svar_in_ty; - svar_out_ty = scope_def.D.scope_def_typ; - svar_io = scope_def.scope_def_io; - } - in match states with | WholeVar -> let scope_def = - D.ScopeDef.Map.find (D.ScopeDef.Var (var, None)) scope.D.scope_defs + D.ScopeDef.Map.find + ((var, Pos.no_pos), D.ScopeDef.Var None) + scope.D.scope_defs in ScopeVar.Map.add (match ScopeVar.Map.find var ctx.scope_var_mapping with | WholeVar v -> v - | States _ -> failwith "should not happen") + | States _ -> assert false) (get_svar scope_def) acc | States states -> (* What happens in the case of variables with multiple states is @@ -736,17 +721,34 @@ let translate_scope_interface ctx scope = (fun acc (state : StateName.t) -> let scope_def = D.ScopeDef.Map.find - (D.ScopeDef.Var (var, Some state)) + ((var, Pos.no_pos), D.ScopeDef.Var (Some state)) scope.D.scope_defs in ScopeVar.Map.add (match ScopeVar.Map.find var ctx.scope_var_mapping with - | WholeVar _ -> failwith "should not happen" + | WholeVar _ -> assert false | States states' -> List.assoc state states') (get_svar scope_def) acc) acc states) scope.scope_vars ScopeVar.Map.empty in + let scope_sig = + (* Add the definition of vars corresponding to subscope calls, and their + parameters (subscope vars) *) + ScopeVar.Map.fold + (fun var _scope_name acc -> + let scope_def = + D.ScopeDef.Map.find + ((var, Pos.no_pos), D.ScopeDef.Var None) + scope.D.scope_defs + in + ScopeVar.Map.add + (match ScopeVar.Map.find var ctx.scope_var_mapping with + | WholeVar v -> v + | States _ -> assert false) + (get_svar scope_def) acc) + scope.D.scope_sub_scopes scope_sig + in let pos = Mark.get (ScopeName.get_info scope.scope_uid) in Mark.add pos { @@ -801,52 +803,71 @@ let translate_program let add_scope_mappings modul ctx = ScopeName.Map.fold (fun _ scdef ctx -> - ScopeVar.Map.fold - (fun scope_var (states : D.var_or_states) ctx -> - let var_name, var_pos = ScopeVar.get_info scope_var in - let new_var = - match states with - | D.WholeVar -> WholeVar (ScopeVar.fresh (var_name, var_pos)) - | States states -> - let var_prefix = var_name ^ "_" in - let state_var state = - ScopeVar.fresh - (Mark.map (( ^ ) var_prefix) (StateName.get_info state)) - in - States (List.map (fun state -> state, state_var state) states) - in - let reentrant = - let state = + let ctx = + (* Add normal scope vars to the env *) + ScopeVar.Map.fold + (fun scope_var (states : D.var_or_states) ctx -> + let var_name, var_pos = ScopeVar.get_info scope_var in + let new_var = match states with - | D.WholeVar -> None - | States (s :: _) -> Some s - | States [] -> assert false + | D.WholeVar -> WholeVar (ScopeVar.fresh (var_name, var_pos)) + | States states -> + let var_prefix = var_name ^ "_" in + let state_var state = + ScopeVar.fresh + (Mark.map (( ^ ) var_prefix) (StateName.get_info state)) + in + States + (List.map (fun state -> state, state_var state) states) in - match - D.ScopeDef.Map.find_opt - (Var (scope_var, state)) - scdef.D.scope_defs - with - | Some - { - scope_def_io = { io_input = Runtime.Reentrant, _; _ }; - scope_def_typ; - _; - } -> - Some scope_def_typ - | _ -> None - in - { - ctx with - scope_var_mapping = - ScopeVar.Map.add scope_var new_var ctx.scope_var_mapping; - reentrant_vars = - Option.fold reentrant - ~some:(fun ty -> - ScopeVar.Map.add scope_var ty ctx.reentrant_vars) - ~none:ctx.reentrant_vars; - }) - scdef.D.scope_vars ctx) + let reentrant = + let state = + match states with + | D.WholeVar -> None + | States (s :: _) -> Some s + | States [] -> assert false + in + match + D.ScopeDef.Map.find_opt + ((scope_var, Pos.no_pos), Var state) + scdef.D.scope_defs + with + | Some + { + scope_def_io = { io_input = Runtime.Reentrant, _; _ }; + scope_def_typ; + _; + } -> + Some scope_def_typ + | _ -> None + in + { + ctx with + scope_var_mapping = + ScopeVar.Map.add scope_var new_var ctx.scope_var_mapping; + reentrant_vars = + Option.fold reentrant + ~some:(fun ty -> + ScopeVar.Map.add scope_var ty ctx.reentrant_vars) + ~none:ctx.reentrant_vars; + }) + scdef.D.scope_vars ctx + in + let ctx = + (* Add scope vars pointing to subscope executions to the env (their + definitions are introduced during the processing of the rules + above) *) + ScopeVar.Map.fold + (fun var _ ctx -> + let var_name, var_pos = ScopeVar.get_info var in + let scope_var_mapping = + let new_var = WholeVar (ScopeVar.fresh (var_name, var_pos)) in + ScopeVar.Map.add var new_var ctx.scope_var_mapping + in + { ctx with scope_var_mapping }) + scdef.D.scope_sub_scopes ctx + in + ctx) modul.D.module_scopes ctx in (* Todo: since we rename all scope vars at this point, it would be better to diff --git a/compiler/scopelang/print.ml b/compiler/scopelang/print.ml index de7c4c86..713d2ac8 100644 --- a/compiler/scopelang/print.ml +++ b/compiler/scopelang/print.ml @@ -72,31 +72,24 @@ let scope ?debug ctx fmt (name, (decl, _pos)) = ~pp_sep:(fun fmt () -> Format.fprintf fmt "%a@ " Print.punctuation ";") (fun fmt rule -> match rule with - | Definition (loc, typ, _, e) -> - Format.fprintf fmt "@[%a %a %a %a %a@ %a@]" Print.keyword - "let" Print.location (Mark.remove loc) Print.punctuation ":" + | ScopeVarDefinition { var; typ; io; e } -> + Format.fprintf fmt "@[%a %a %a %a %a@ %t%a@]" Print.keyword + "let" ScopeVar.format (Mark.remove var) Print.punctuation ":" (Print.typ ctx) typ Print.punctuation "=" - (fun fmt e -> - match Mark.remove loc with - | SubScopeVar _ | ToplevelVar _ -> Print.expr () fmt e - | ScopelangScopeVar { name = v } -> ( - match - Mark.remove - (ScopeVar.Map.find (Mark.remove v) decl.scope_sig).svar_io - .io_input - with - | Reentrant -> - Format.fprintf fmt "%a@ %a" Print.op_style - "reentrant or by default" (Print.expr ?debug ()) e - | _ -> Format.fprintf fmt "%a" (Print.expr ?debug ()) e)) - e + (fun fmt -> + match Mark.remove io.io_input with + | Reentrant -> + Print.op_style fmt "reentrant or by default"; + Format.pp_print_space fmt () + | _ -> ()) + (Print.expr ?debug ()) e + | SubScopeVarDefinition { var; typ; e; _ } -> + Format.fprintf fmt "@[%a %a %a %a %a@ %a@]" Print.keyword + "let" ScopeVar.format (Mark.remove var) Print.punctuation ":" + (Print.typ ctx) typ Print.punctuation "=" (Print.expr ?debug ()) e | Assertion e -> Format.fprintf fmt "%a %a" Print.keyword "assert" - (Print.expr ?debug ()) e - | Call (scope_name, subscope_name, _) -> - Format.fprintf fmt "%a %a%a%a%a" Print.keyword "call" - ScopeName.format scope_name Print.punctuation "[" - SubScopeName.format subscope_name Print.punctuation "]")) + (Print.expr ?debug ()) e)) decl.scope_decl_rules let print_topdef ctx ppf name (e, ty) = diff --git a/compiler/shared_ast/definitions.ml b/compiler/shared_ast/definitions.ml index eb910cda..0c75a84b 100644 --- a/compiler/shared_ast/definitions.ml +++ b/compiler/shared_ast/definitions.ml @@ -95,16 +95,10 @@ module ScopeVar = end) () -module SubScopeName = - Uid.Gen - (struct - let style = Ocolor_types.(Fg (C4 hi_magenta)) - end) - () - type scope_var_or_subscope = | ScopeVar of ScopeVar.t - | SubScope of SubScopeName.t * ScopeName.t + | SubScope of ScopeVar.t * ScopeName.t * bool Mark.pos +(* The bool is true if the output of the subscope is to be forwarded *) module StateName = Uid.Gen @@ -444,12 +438,6 @@ type 'a glocation = name : ScopeVar.t Mark.pos; } -> < scopeVarSimpl : yes ; .. > glocation - | SubScopeVar : { - scope : ScopeName.t; - alias : SubScopeName.t Mark.pos; - var : ScopeVar.t Mark.pos; - } - -> < explicitScopes : yes ; .. > glocation | ToplevelVar : { name : TopdefName.t Mark.pos; } diff --git a/compiler/shared_ast/expr.ml b/compiler/shared_ast/expr.ml index 2e75d4be..d59f2108 100644 --- a/compiler/shared_ast/expr.ml +++ b/compiler/shared_ast/expr.ml @@ -537,31 +537,19 @@ let compare_location (x : a glocation Mark.pos) (y : a glocation Mark.pos) = match Mark.remove x, Mark.remove y with - | ( DesugaredScopeVar { name = vx; state = None }, - DesugaredScopeVar { name = vy; state = None } ) - | ( DesugaredScopeVar { name = vx; state = Some _ }, - DesugaredScopeVar { name = vy; state = None } ) - | ( DesugaredScopeVar { name = vx; state = None }, - DesugaredScopeVar { name = vy; state = Some _ } ) -> - ScopeVar.compare (Mark.remove vx) (Mark.remove vy) - | ( DesugaredScopeVar { name = x, _; state = Some sx }, - DesugaredScopeVar { name = y, _; state = Some sy } ) -> - let cmp = ScopeVar.compare x y in - if cmp = 0 then StateName.compare sx sy else cmp + | ( DesugaredScopeVar { name = vx; state = sx }, + DesugaredScopeVar { name = vy; state = sy } ) -> ( + match Mark.compare ScopeVar.compare vx vy with + | 0 -> Option.compare StateName.compare sx sy + | n -> n) | ScopelangScopeVar { name = vx, _ }, ScopelangScopeVar { name = vy, _ } -> ScopeVar.compare vx vy - | ( SubScopeVar { alias = xsubindex, _; var = xsubvar, _; _ }, - SubScopeVar { alias = ysubindex, _; var = ysubvar, _; _ } ) -> - let c = SubScopeName.compare xsubindex ysubindex in - if c = 0 then ScopeVar.compare xsubvar ysubvar else c | ToplevelVar { name = vx, _ }, ToplevelVar { name = vy, _ } -> TopdefName.compare vx vy | DesugaredScopeVar _, _ -> -1 | _, DesugaredScopeVar _ -> 1 | ScopelangScopeVar _, _ -> -1 | _, ScopelangScopeVar _ -> 1 - | SubScopeVar _, _ -> -1 - | _, SubScopeVar _ -> 1 | ToplevelVar _, _ -> . | _, ToplevelVar _ -> . diff --git a/compiler/shared_ast/print.ml b/compiler/shared_ast/print.ml index c41f4a16..6f3cf877 100644 --- a/compiler/shared_ast/print.ml +++ b/compiler/shared_ast/print.ml @@ -74,9 +74,6 @@ let location (type a) (fmt : Format.formatter) (l : a glocation) : unit = match l with | DesugaredScopeVar { name; _ } -> ScopeVar.format fmt (Mark.remove name) | ScopelangScopeVar { name; _ } -> ScopeVar.format fmt (Mark.remove name) - | SubScopeVar { alias = subindex; var = subvar; _ } -> - Format.fprintf fmt "%a.%a" SubScopeName.format (Mark.remove subindex) - ScopeVar.format (Mark.remove subvar) | ToplevelVar { name } -> TopdefName.format fmt (Mark.remove name) let external_ref fmt er = diff --git a/compiler/shared_ast/typing.ml b/compiler/shared_ast/typing.ml index ccb18269..9b88cf51 100644 --- a/compiler/shared_ast/typing.ml +++ b/compiler/shared_ast/typing.ml @@ -27,10 +27,10 @@ module Any = (struct type info = unit - let to_string _ = "any" + let to_string () = "any" let format fmt () = Format.fprintf fmt "any" - let equal _ _ = true - let compare _ _ = 0 + let equal () () = true + let compare () () = 0 end) (struct let style = Ocolor_types.(Fg (C4 hi_magenta)) @@ -405,11 +405,6 @@ module Env = struct let get t v = Var.Map.find_opt v t.vars let get_scope_var t sv = A.ScopeVar.Map.find_opt sv t.scope_vars let get_toplevel_var t v = A.TopdefName.Map.find_opt v t.toplevel_vars - - let get_subscope_out_var t scope var = - Option.bind (A.ScopeName.Map.find_opt scope t.scopes) (fun vmap -> - A.ScopeVar.Map.find_opt var vmap) - let add v tau t = { t with vars = Var.Map.add v tau t.vars } let add_var v typ t = add v (ast_to_typ typ) t @@ -503,8 +498,6 @@ and typecheck_expr_top_down : match loc with | DesugaredScopeVar { name; _ } | ScopelangScopeVar { name } -> Env.get_scope_var env (Mark.remove name) - | SubScopeVar { scope; var; _ } -> - Env.get_subscope_out_var env scope (Mark.remove var) | ToplevelVar { name } -> Env.get_toplevel_var env (Mark.remove name) in let ty = @@ -561,12 +554,10 @@ and typecheck_expr_top_down : | A.EDStructAccess { e = e_struct; name_opt; field } -> let t_struct = match name_opt with - | Some name -> TStruct name - | None -> TAny (Any.fresh ()) - in - let e_struct' = - typecheck_expr_top_down ctx env (unionfind t_struct) e_struct + | Some name -> unionfind (TStruct name) + | None -> unionfind (TAny (Any.fresh ())) in + let e_struct' = typecheck_expr_top_down ctx env t_struct e_struct in let name = match UnionFind.get (ty e_struct') with | TStruct name, _ -> name @@ -575,8 +566,8 @@ and typecheck_expr_top_down : "Disambiguation failed before reaching field %s" field | _ -> Message.raise_spanned_error (Expr.pos e) - "This is not a structure, cannot access field %s (%a)" field - (format_typ ctx) (ty e_struct') + "This is not a structure, cannot access field %s (found type: %a)" + field (format_typ ctx) (ty e_struct') in let str = try A.StructName.Map.find name env.structs @@ -587,19 +578,50 @@ and typecheck_expr_top_down : let field = let candidate_structs = try A.Ident.Map.find field ctx.ctx_struct_fields - with A.Ident.Map.Not_found _ -> - Message.raise_spanned_error - (Expr.mark_pos context_mark) - "Field @{\"%s\"@} does not belong to structure \ - @{\"%a\"@} (no structure defines it)" - field A.StructName.format name + with A.Ident.Map.Not_found _ -> ( + match + A.ScopeName.Map.choose_opt + @@ A.ScopeName.Map.filter + (fun _ { A.out_struct_name; _ } -> + A.StructName.equal out_struct_name name) + ctx.ctx_scopes + with + | Some (scope_out, _) -> + Message.raise_multispanned_error_full + [ + ( Some + (fun ppf -> + Format.fprintf ppf + "@{%s@} is used here as an output" field), + Expr.mark_pos context_mark ); + ( Some + (fun ppf -> + Format.fprintf ppf "Scope %a is declared here" + A.ScopeName.format scope_out), + Mark.get (A.StructName.get_info name) ); + ] + "Variable @{%s@} is not a declared output of scope %a." + field A.ScopeName.format scope_out + ~suggestion: + (List.map A.StructField.to_string (A.StructField.Map.keys str)) + | None -> + Message.raise_multispanned_error + [ + None, Expr.mark_pos context_mark; + ( Some "Structure definition", + Mark.get (A.StructName.get_info name) ); + ] + "Field @{\"%s\"@} does not belong to structure \ + @{\"%a\"@}." + field A.StructName.format name + ~suggestion:(A.Ident.Map.keys ctx.ctx_struct_fields)) in try A.StructName.Map.find name candidate_structs with A.StructName.Map.Not_found _ -> Message.raise_spanned_error (Expr.mark_pos context_mark) "@[Field @{\"%s\"@}@ does not belong to@ structure \ - @{\"%a\"@},@ but to %a@]" + @{\"%a\"@}@ (however, structure %a defines it)@]" field A.StructName.format name (Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf "@ or@ ") diff --git a/compiler/surface/parser.messages b/compiler/surface/parser.messages index 92095361..73ad1b6c 100644 --- a/compiler/surface/parser.messages +++ b/compiler/surface/parser.messages @@ -1,6 +1,6 @@ source_file: BEGIN_CODE DECLARATION ENUM UIDENT COLON ALT UIDENT CONTENT TEXT YEAR ## -## Ends in an error in state: 438. +## Ends in an error in state: 590. ## ## list(addpos(enum_decl_line)) -> enum_decl_line . list(addpos(enum_decl_line)) [ SCOPE END_CODE DECLARATION ] ## @@ -12,7 +12,7 @@ expected another enum case, or a new declaration or scope use source_file: BEGIN_CODE DECLARATION ENUM UIDENT COLON ALT UIDENT CONTENT YEAR ## -## Ends in an error in state: 434. +## Ends in an error in state: 586. ## ## option(preceded(CONTENT,addpos(typ))) -> CONTENT . typ_data [ SCOPE END_CODE DECLARATION ALT ] ## @@ -24,7 +24,7 @@ expected a content type source_file: BEGIN_CODE DECLARATION ENUM UIDENT COLON ALT UIDENT YEAR ## -## Ends in an error in state: 433. +## Ends in an error in state: 585. ## ## enum_decl_line -> ALT UIDENT . option(preceded(CONTENT,addpos(typ))) [ SCOPE END_CODE DECLARATION ALT ] ## @@ -36,7 +36,7 @@ expected a payload for your enum case, or another case or declaration source_file: BEGIN_CODE DECLARATION ENUM UIDENT COLON ALT YEAR ## -## Ends in an error in state: 432. +## Ends in an error in state: 584. ## ## enum_decl_line -> ALT . UIDENT option(preceded(CONTENT,addpos(typ))) [ SCOPE END_CODE DECLARATION ALT ] ## @@ -48,7 +48,7 @@ expected the name of an enum case source_file: BEGIN_CODE DECLARATION ENUM UIDENT COLON YEAR ## -## Ends in an error in state: 431. +## Ends in an error in state: 583. ## ## code_item -> DECLARATION ENUM UIDENT COLON . list(addpos(enum_decl_line)) [ SCOPE END_CODE DECLARATION ] ## @@ -60,7 +60,7 @@ expected an enum case source_file: BEGIN_CODE DECLARATION ENUM UIDENT YEAR ## -## Ends in an error in state: 430. +## Ends in an error in state: 582. ## ## code_item -> DECLARATION ENUM UIDENT . COLON list(addpos(enum_decl_line)) [ SCOPE END_CODE DECLARATION ] ## @@ -72,7 +72,7 @@ expected a colon source_file: BEGIN_CODE DECLARATION ENUM YEAR ## -## Ends in an error in state: 429. +## Ends in an error in state: 581. ## ## code_item -> DECLARATION ENUM . UIDENT COLON list(addpos(enum_decl_line)) [ SCOPE END_CODE DECLARATION ] ## @@ -960,7 +960,7 @@ expected the name of the scope being used source_file: BEGIN_CODE YEAR ## -## Ends in an error in state: 479. +## Ends in an error in state: 631. ## ## source_file_item -> BEGIN_CODE . code END_CODE [ LAW_TEXT LAW_HEADING EOF BEGIN_METADATA BEGIN_DIRECTIVE BEGIN_CODE ] ## @@ -1021,8 +1021,8 @@ source_file: BEGIN_METADATA LAW_TEXT LAW_HEADING ## accurate view of the past (what has been recognized so far), they ## may provide an INCOMPLETE view of the future (what was expected next). ## In state 1, spurious reduction of production nonempty_list(LAW_TEXT) -> LAW_TEXT -## In state 458, spurious reduction of production law_text -> nonempty_list(LAW_TEXT) -## In state 459, spurious reduction of production option(law_text) -> law_text +## In state 610, spurious reduction of production law_text -> nonempty_list(LAW_TEXT) +## In state 611, spurious reduction of production option(law_text) -> law_text ## expected some law text or code block @@ -3450,74 +3450,96 @@ expected a binary operator continuing the expression, or a keyword ending the ex source_file: BEGIN_CODE DECLARATION SCOPE UIDENT COLON CONTEXT YEAR ## -## Ends in an error in state: 397. +## Ends in an error in state: 510. ## -## scope_decl_item_attribute -> scope_decl_item_attribute_input . scope_decl_item_attribute_output [ LIDENT ] +## scope_decl_item -> CONTEXT . OUTPUT lident CONTENT typ_data DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT . OUTPUT lident CONTENT typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT . OUTPUT lident CONTENT typ_data list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT . lident CONTENT typ_data DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT . lident CONTENT typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT . lident CONTENT typ_data list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT . OUTPUT lident SCOPE quident [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT . lident SCOPE quident [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT . OUTPUT lident CONDITION DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT . OUTPUT lident CONDITION DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT . OUTPUT lident CONDITION list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT . lident CONDITION DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT . lident CONDITION DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT . lident CONDITION list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] ## ## The known suffix of the stack is as follows: -## scope_decl_item_attribute_input +## CONTEXT ## expected a variable name, optionally preceded by 'output' source_file: BEGIN_CODE DECLARATION SCOPE UIDENT COLON INTERNAL YEAR ## -## Ends in an error in state: 400. +## Ends in an error in state: 418. ## -## scope_decl_item -> scope_decl_item_attribute . lident CONTENT typ_data DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] -## scope_decl_item -> scope_decl_item_attribute . lident CONTENT typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] -## scope_decl_item -> scope_decl_item_attribute . lident CONTENT typ_data list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] -## scope_decl_item -> scope_decl_item_attribute . lident CONDITION DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] -## scope_decl_item -> scope_decl_item_attribute . lident CONDITION DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] -## scope_decl_item -> scope_decl_item_attribute . lident CONDITION list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> INTERNAL . OUTPUT lident CONTENT typ_data DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> INTERNAL . OUTPUT lident CONTENT typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> INTERNAL . OUTPUT lident CONTENT typ_data list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> INTERNAL . lident CONTENT typ_data DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> INTERNAL . lident CONTENT typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> INTERNAL . lident CONTENT typ_data list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> INTERNAL . OUTPUT lident SCOPE quident [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> INTERNAL . lident SCOPE quident [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> INTERNAL . OUTPUT lident CONDITION DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> INTERNAL . OUTPUT lident CONDITION DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> INTERNAL . OUTPUT lident CONDITION list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> INTERNAL . lident CONDITION DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> INTERNAL . lident CONDITION DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> INTERNAL . lident CONDITION list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] ## ## The known suffix of the stack is as follows: -## scope_decl_item_attribute +## INTERNAL ## expected a variable name source_file: BEGIN_CODE DECLARATION SCOPE UIDENT COLON CONTEXT LIDENT YEAR ## -## Ends in an error in state: 401. +## Ends in an error in state: 534. ## -## scope_decl_item -> scope_decl_item_attribute lident . CONTENT typ_data DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] -## scope_decl_item -> scope_decl_item_attribute lident . CONTENT typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] -## scope_decl_item -> scope_decl_item_attribute lident . CONTENT typ_data list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] -## scope_decl_item -> scope_decl_item_attribute lident . CONDITION DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] -## scope_decl_item -> scope_decl_item_attribute lident . CONDITION DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] -## scope_decl_item -> scope_decl_item_attribute lident . CONDITION list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident . CONTENT typ_data DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident . CONTENT typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident . CONTENT typ_data list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident . SCOPE quident [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident . CONDITION DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident . CONDITION DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident . CONDITION list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] ## ## The known suffix of the stack is as follows: -## scope_decl_item_attribute lident +## CONTEXT lident ## expected either 'condition', or 'content' followed by the expected variable type source_file: BEGIN_CODE DECLARATION SCOPE UIDENT COLON CONTEXT LIDENT CONTENT YEAR ## -## Ends in an error in state: 402. +## Ends in an error in state: 537. ## -## scope_decl_item -> scope_decl_item_attribute lident CONTENT . typ_data DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] -## scope_decl_item -> scope_decl_item_attribute lident CONTENT . typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] -## scope_decl_item -> scope_decl_item_attribute lident CONTENT . typ_data list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident CONTENT . typ_data DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident CONTENT . typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident CONTENT . typ_data list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] ## ## The known suffix of the stack is as follows: -## scope_decl_item_attribute lident CONTENT +## CONTEXT lident CONTENT ## expected a type source_file: BEGIN_CODE DECLARATION SCOPE UIDENT COLON CONTEXT LIDENT CONTENT BOOLEAN YEAR ## -## Ends in an error in state: 403. +## Ends in an error in state: 538. ## -## scope_decl_item -> scope_decl_item_attribute lident CONTENT typ_data . DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] -## scope_decl_item -> scope_decl_item_attribute lident CONTENT typ_data . DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] -## scope_decl_item -> scope_decl_item_attribute lident CONTENT typ_data . list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident CONTENT typ_data . DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident CONTENT typ_data . DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident CONTENT typ_data . list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] ## ## The known suffix of the stack is as follows: -## scope_decl_item_attribute lident CONTENT typ_data +## CONTEXT lident CONTENT typ_data ## expected either 'state' definitions for the variable, or the next declaration @@ -3525,37 +3547,37 @@ for the scope source_file: BEGIN_CODE DECLARATION SCOPE UIDENT COLON CONTEXT LIDENT CONTENT UIDENT DEPENDS YEAR ## -## Ends in an error in state: 404. +## Ends in an error in state: 539. ## -## scope_decl_item -> scope_decl_item_attribute lident CONTENT typ_data DEPENDS . separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] -## scope_decl_item -> scope_decl_item_attribute lident CONTENT typ_data DEPENDS . LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident CONTENT typ_data DEPENDS . separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident CONTENT typ_data DEPENDS . LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] ## ## The known suffix of the stack is as follows: -## scope_decl_item_attribute lident CONTENT typ_data DEPENDS +## CONTEXT lident CONTENT typ_data DEPENDS ## expected a name and type for the dependency of this definition (' content ') source_file: BEGIN_CODE DECLARATION SCOPE UIDENT COLON CONTEXT LIDENT CONTENT UIDENT DEPENDS LPAREN YEAR ## -## Ends in an error in state: 405. +## Ends in an error in state: 540. ## -## scope_decl_item -> scope_decl_item_attribute lident CONTENT typ_data DEPENDS LPAREN . separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident CONTENT typ_data DEPENDS LPAREN . separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] ## ## The known suffix of the stack is as follows: -## scope_decl_item_attribute lident CONTENT typ_data DEPENDS LPAREN +## CONTEXT lident CONTENT typ_data DEPENDS LPAREN ## expected a name and type for the dependency of this definition (' content ') source_file: BEGIN_CODE DECLARATION SCOPE UIDENT COLON CONTEXT LIDENT CONTENT UIDENT DEPENDS LPAREN LIDENT CONTENT UIDENT STATE ## -## Ends in an error in state: 406. +## Ends in an error in state: 541. ## -## scope_decl_item -> scope_decl_item_attribute lident CONTENT typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) . RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident CONTENT typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) . RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] ## ## The known suffix of the stack is as follows: -## scope_decl_item_attribute lident CONTENT typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) +## CONTEXT lident CONTENT typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) ## ## WARNING: This example involves spurious reductions. ## This implies that, although the LR(1) items shown above provide an @@ -3571,19 +3593,19 @@ expected a closing paren, or a comma followed by another argument specification source_file: BEGIN_CODE DECLARATION SCOPE UIDENT COLON CONTEXT LIDENT CONTENT UIDENT DEPENDS LPAREN LIDENT CONTENT UIDENT RPAREN YEAR ## -## Ends in an error in state: 407. +## Ends in an error in state: 542. ## -## scope_decl_item -> scope_decl_item_attribute lident CONTENT typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN . list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident CONTENT typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN . list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] ## ## The known suffix of the stack is as follows: -## scope_decl_item_attribute lident CONTENT typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN +## CONTEXT lident CONTENT typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN ## expected a 'state' declaration for the preceding declaration, or the next declaration for the scope source_file: BEGIN_CODE DECLARATION SCOPE UIDENT COLON CONTEXT LIDENT CONDITION STATE LIDENT YEAR ## -## Ends in an error in state: 408. +## Ends in an error in state: 403. ## ## list(state) -> state . list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] ## @@ -3596,12 +3618,12 @@ declaration for the scope source_file: BEGIN_CODE DECLARATION SCOPE UIDENT COLON CONTEXT LIDENT CONTENT UIDENT DEPENDS LIDENT CONTENT UIDENT DEFINED_AS ## -## Ends in an error in state: 411. +## Ends in an error in state: 544. ## -## scope_decl_item -> scope_decl_item_attribute lident CONTENT typ_data DEPENDS separated_nonempty_list(COMMA,var_content) . list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident CONTENT typ_data DEPENDS separated_nonempty_list(COMMA,var_content) . list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] ## ## The known suffix of the stack is as follows: -## scope_decl_item_attribute lident CONTENT typ_data DEPENDS separated_nonempty_list(COMMA,var_content) +## CONTEXT lident CONTENT typ_data DEPENDS separated_nonempty_list(COMMA,var_content) ## ## WARNING: This example involves spurious reductions. ## This implies that, although the LR(1) items shown above provide an @@ -3617,51 +3639,51 @@ expected the next declaration for the scope source_file: BEGIN_CODE DECLARATION SCOPE UIDENT COLON CONTEXT LIDENT CONDITION YEAR ## -## Ends in an error in state: 414. +## Ends in an error in state: 547. ## -## scope_decl_item -> scope_decl_item_attribute lident CONDITION . DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] -## scope_decl_item -> scope_decl_item_attribute lident CONDITION . DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] -## scope_decl_item -> scope_decl_item_attribute lident CONDITION . list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident CONDITION . DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident CONDITION . DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident CONDITION . list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] ## ## The known suffix of the stack is as follows: -## scope_decl_item_attribute lident CONDITION +## CONTEXT lident CONDITION ## expected the next declaration for the scope source_file: BEGIN_CODE DECLARATION SCOPE UIDENT COLON CONTEXT LIDENT CONDITION DEPENDS YEAR ## -## Ends in an error in state: 415. +## Ends in an error in state: 548. ## -## scope_decl_item -> scope_decl_item_attribute lident CONDITION DEPENDS . separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] -## scope_decl_item -> scope_decl_item_attribute lident CONDITION DEPENDS . LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident CONDITION DEPENDS . separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident CONDITION DEPENDS . LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] ## ## The known suffix of the stack is as follows: -## scope_decl_item_attribute lident CONDITION DEPENDS +## CONTEXT lident CONDITION DEPENDS ## expected the form 'depends on content ' source_file: BEGIN_CODE DECLARATION SCOPE UIDENT COLON CONTEXT LIDENT CONDITION DEPENDS LPAREN YEAR ## -## Ends in an error in state: 416. +## Ends in an error in state: 549. ## -## scope_decl_item -> scope_decl_item_attribute lident CONDITION DEPENDS LPAREN . separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident CONDITION DEPENDS LPAREN . separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] ## ## The known suffix of the stack is as follows: -## scope_decl_item_attribute lident CONDITION DEPENDS LPAREN +## CONTEXT lident CONDITION DEPENDS LPAREN ## expected the form 'depends on ( content [, content ...])' source_file: BEGIN_CODE DECLARATION SCOPE UIDENT COLON CONTEXT LIDENT CONDITION DEPENDS LPAREN LIDENT CONTENT UIDENT STATE ## -## Ends in an error in state: 417. +## Ends in an error in state: 550. ## -## scope_decl_item -> scope_decl_item_attribute lident CONDITION DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) . RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident CONDITION DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) . RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] ## ## The known suffix of the stack is as follows: -## scope_decl_item_attribute lident CONDITION DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) +## CONTEXT lident CONDITION DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) ## ## WARNING: This example involves spurious reductions. ## This implies that, although the LR(1) items shown above provide an @@ -3677,21 +3699,27 @@ expected a closing paren, or a comma followed by another argument declaration (' source_file: BEGIN_CODE DECLARATION SCOPE UIDENT COLON CONTEXT LIDENT CONDITION DEPENDS LPAREN LIDENT CONTENT UIDENT RPAREN YEAR ## -## Ends in an error in state: 418. +## Ends in an error in state: 551. ## -## scope_decl_item -> scope_decl_item_attribute lident CONDITION DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN . list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> CONTEXT lident CONDITION DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN . list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] ## ## The known suffix of the stack is as follows: -## scope_decl_item_attribute lident CONDITION DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN +## CONTEXT lident CONDITION DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN ## expected the next definition in scope source_file: BEGIN_CODE DECLARATION SCOPE UIDENT COLON LIDENT YEAR ## -## Ends in an error in state: 425. +## Ends in an error in state: 558. ## +## scope_decl_item -> lident . CONTENT typ_data DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> lident . CONTENT typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> lident . CONTENT typ_data list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] ## scope_decl_item -> lident . SCOPE quident [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> lident . CONDITION DEPENDS separated_nonempty_list(COMMA,var_content) list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> lident . CONDITION DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] +## scope_decl_item -> lident . CONDITION list(state) [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] ## ## The known suffix of the stack is as follows: ## lident @@ -3701,7 +3729,7 @@ expected the form ' scope ', or a scope variable declaration source_file: BEGIN_CODE DECLARATION SCOPE UIDENT COLON LIDENT SCOPE YEAR ## -## Ends in an error in state: 426. +## Ends in an error in state: 559. ## ## scope_decl_item -> lident SCOPE . quident [ SCOPE OUTPUT LIDENT INTERNAL INPUT END_CODE DECLARATION CONTEXT ] ## @@ -3713,7 +3741,7 @@ expected a scope name source_file: BEGIN_CODE DECLARATION LIDENT YEAR ## -## Ends in an error in state: 440. +## Ends in an error in state: 592. ## ## code_item -> DECLARATION lident . CONTENT typ_data DEPENDS separated_nonempty_list(COMMA,var_content) option(opt_def) [ SCOPE END_CODE DECLARATION ] ## code_item -> DECLARATION lident . CONTENT typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN option(opt_def) [ SCOPE END_CODE DECLARATION ] @@ -3727,7 +3755,7 @@ expected 'content ' source_file: BEGIN_CODE DECLARATION LIDENT CONTENT YEAR ## -## Ends in an error in state: 441. +## Ends in an error in state: 593. ## ## code_item -> DECLARATION lident CONTENT . typ_data DEPENDS separated_nonempty_list(COMMA,var_content) option(opt_def) [ SCOPE END_CODE DECLARATION ] ## code_item -> DECLARATION lident CONTENT . typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN option(opt_def) [ SCOPE END_CODE DECLARATION ] @@ -3741,7 +3769,7 @@ expected a type source_file: BEGIN_CODE DECLARATION LIDENT CONTENT BOOLEAN YEAR ## -## Ends in an error in state: 442. +## Ends in an error in state: 594. ## ## code_item -> DECLARATION lident CONTENT typ_data . DEPENDS separated_nonempty_list(COMMA,var_content) option(opt_def) [ SCOPE END_CODE DECLARATION ] ## code_item -> DECLARATION lident CONTENT typ_data . DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN option(opt_def) [ SCOPE END_CODE DECLARATION ] @@ -3756,7 +3784,7 @@ expected 'equals ', optionally preceded by 'depends on content source_file: BEGIN_CODE DECLARATION LIDENT CONTENT UIDENT DEPENDS YEAR ## -## Ends in an error in state: 443. +## Ends in an error in state: 595. ## ## code_item -> DECLARATION lident CONTENT typ_data DEPENDS . separated_nonempty_list(COMMA,var_content) option(opt_def) [ SCOPE END_CODE DECLARATION ] ## code_item -> DECLARATION lident CONTENT typ_data DEPENDS . LPAREN separated_nonempty_list(COMMA,var_content) RPAREN option(opt_def) [ SCOPE END_CODE DECLARATION ] @@ -3769,7 +3797,7 @@ expected a variable name, following the form 'depends on content ' source_file: BEGIN_CODE DECLARATION LIDENT CONTENT UIDENT DEPENDS LPAREN YEAR ## -## Ends in an error in state: 444. +## Ends in an error in state: 596. ## ## code_item -> DECLARATION lident CONTENT typ_data DEPENDS LPAREN . separated_nonempty_list(COMMA,var_content) RPAREN option(opt_def) [ SCOPE END_CODE DECLARATION ] ## @@ -3781,7 +3809,7 @@ expected a variable name, following the form 'depends on ( content , source_file: BEGIN_CODE DECLARATION LIDENT CONTENT UIDENT DEPENDS LPAREN LIDENT CONTENT UIDENT DEFINED_AS ## -## Ends in an error in state: 445. +## Ends in an error in state: 597. ## ## code_item -> DECLARATION lident CONTENT typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) . RPAREN option(opt_def) [ SCOPE END_CODE DECLARATION ] ## @@ -3803,7 +3831,7 @@ content ' source_file: BEGIN_CODE DECLARATION LIDENT CONTENT UIDENT DEPENDS LPAREN LIDENT CONTENT UIDENT RPAREN YEAR ## -## Ends in an error in state: 446. +## Ends in an error in state: 598. ## ## code_item -> DECLARATION lident CONTENT typ_data DEPENDS LPAREN separated_nonempty_list(COMMA,var_content) RPAREN . option(opt_def) [ SCOPE END_CODE DECLARATION ] ## @@ -3815,7 +3843,7 @@ expected 'equals ' source_file: BEGIN_CODE DECLARATION LIDENT CONTENT UIDENT DEPENDS LPAREN LIDENT CONTENT UIDENT RPAREN DEFINED_AS YEAR ## -## Ends in an error in state: 447. +## Ends in an error in state: 599. ## ## option(opt_def) -> DEFINED_AS . expression [ SCOPE END_CODE DECLARATION ] ## @@ -3878,7 +3906,7 @@ expected the definition of another argument in the form ' content ' source_file: BEGIN_CODE DECLARATION LIDENT CONTENT UIDENT DEPENDS LIDENT CONTENT UIDENT DEFINED_AS FALSE YEAR ## -## Ends in an error in state: 448. +## Ends in an error in state: 600. ## ## expression -> expression . DOT qlident [ XOR WITH SCOPE PLUSPLUS PLUS OR OF NOT_EQUAL MULT MINUS LESSER_EQUAL LESSER GREATER_EQUAL GREATER FOR EQUAL END_CODE DOT DIV DECLARATION CONTAINS AND ] ## expression -> expression . OF funcall_args [ XOR WITH SCOPE PLUSPLUS PLUS OR OF NOT_EQUAL MULT MINUS LESSER_EQUAL LESSER GREATER_EQUAL GREATER FOR EQUAL END_CODE DOT DIV DECLARATION CONTAINS AND ] @@ -3912,7 +3940,7 @@ expected a binary operator continuing the expression, or a keyword ending the ex source_file: BEGIN_DIRECTIVE YEAR ## -## Ends in an error in state: 460. +## Ends in an error in state: 612. ## ## source_file_item -> BEGIN_DIRECTIVE . directive END_DIRECTIVE [ LAW_TEXT LAW_HEADING EOF BEGIN_METADATA BEGIN_DIRECTIVE BEGIN_CODE ] ## @@ -3924,7 +3952,7 @@ expected a directive, e.g. 'Include: ' source_file: BEGIN_DIRECTIVE LAW_INCLUDE YEAR ## -## Ends in an error in state: 470. +## Ends in an error in state: 622. ## ## directive -> LAW_INCLUDE . COLON nonempty_list(DIRECTIVE_ARG) option(AT_PAGE) [ END_DIRECTIVE ] ## @@ -3936,7 +3964,7 @@ expected ':', then a file name or 'JORFTEXTNNNNNNNNNNNN' source_file: BEGIN_DIRECTIVE LAW_INCLUDE COLON YEAR ## -## Ends in an error in state: 471. +## Ends in an error in state: 623. ## ## directive -> LAW_INCLUDE COLON . nonempty_list(DIRECTIVE_ARG) option(AT_PAGE) [ END_DIRECTIVE ] ## @@ -3948,7 +3976,7 @@ expected a file name or 'JORFTEXTNNNNNNNNNNNN' source_file: BEGIN_DIRECTIVE LAW_INCLUDE COLON DIRECTIVE_ARG YEAR ## -## Ends in an error in state: 472. +## Ends in an error in state: 624. ## ## nonempty_list(DIRECTIVE_ARG) -> DIRECTIVE_ARG . [ END_DIRECTIVE AT_PAGE ] ## nonempty_list(DIRECTIVE_ARG) -> DIRECTIVE_ARG . nonempty_list(DIRECTIVE_ARG) [ END_DIRECTIVE AT_PAGE ] @@ -3961,7 +3989,7 @@ expected a page specification in the form '@p.', or a newline source_file: BEGIN_DIRECTIVE LAW_INCLUDE COLON DIRECTIVE_ARG AT_PAGE YEAR ## -## Ends in an error in state: 477. +## Ends in an error in state: 629. ## ## source_file_item -> BEGIN_DIRECTIVE directive . END_DIRECTIVE [ LAW_TEXT LAW_HEADING EOF BEGIN_METADATA BEGIN_DIRECTIVE BEGIN_CODE ] ## @@ -3973,7 +4001,7 @@ expected a newline source_file: LAW_HEADING YEAR ## -## Ends in an error in state: 482. +## Ends in an error in state: 634. ## ## source_file -> source_file_item . source_file [ # ] ## diff --git a/compiler/surface/parser.mly b/compiler/surface/parser.mly index 4278b788..cdbc585b 100644 --- a/compiler/surface/parser.mly +++ b/compiler/surface/parser.mly @@ -84,9 +84,10 @@ end> %type scope_item %type struct_scope_base %type struct_scope -%type scope_decl_item_attribute_input +%type scope_decl_item_attribute_input %type scope_decl_item_attribute_output -%type scope_decl_item_attribute +%type scope_decl_item_attribute +%type scope_decl_item_attribute_mandatory %type scope_decl_item %type enum_decl_line %type code_item @@ -546,42 +547,50 @@ let struct_scope := } } -let scope_decl_item_attribute_input := -| CONTEXT ; { Context } -| INPUT ; { Input } +let scope_decl_item_attribute_input == +| CONTEXT ; { Some Context } +| INPUT ; { Some Input } +| INTERNAL ; { Some Internal } +| { None } -let scope_decl_item_attribute_output := +let scope_decl_item_attribute_output == | OUTPUT ; { true } | { false } -let scope_decl_item_attribute := +let scope_decl_item_attribute == | input = addpos(scope_decl_item_attribute_input) ; - output = addpos(scope_decl_item_attribute_output) ; { - { - scope_decl_context_io_input = input; - scope_decl_context_io_output = output - } - } -| INTERNAL ; { - { - scope_decl_context_io_input = (Internal, Pos.from_lpos $sloc); - scope_decl_context_io_output = (false, Pos.from_lpos $sloc) - } - } -| OUTPUT ; { - { - scope_decl_context_io_input = (Internal, Pos.from_lpos $sloc); - scope_decl_context_io_output = (true, Pos.from_lpos $sloc) - } - } + output = addpos(scope_decl_item_attribute_output) ; + i = lident ; { + match input, output with + | (Some Internal, _), (true, pos) -> + Message.raise_spanned_error pos + "A variable cannot be declared both 'internal' and 'output'." + | input, output -> input, output, i +} +let scope_decl_item_attribute_mandatory == +| attr = scope_decl_item_attribute ; { + let in_attr_opt, out_attr, i = attr in + let in_attr = match in_attr_opt, out_attr with + | (None, _), (false, _) -> + Message.raise_spanned_error (Pos.from_lpos $loc(attr)) + "Variable declaration requires input qualification ('internal', \ + 'input' or 'context')" + | (None, pos), (true, _) -> Internal, pos + | (Some i, pos), _ -> i, pos + in + { + scope_decl_context_io_input = in_attr; + scope_decl_context_io_output = out_attr; + }, i +} let scope_decl_item := -| attr = scope_decl_item_attribute ; - i = lident ; +| attr_i = scope_decl_item_attribute_mandatory ; CONTENT ; t = addpos(typ) ; args_typ = depends_stance ; states = list(state) ; { + let attr, i = attr_i in ContextData { scope_decl_context_item_name = i; scope_decl_context_item_attribute = attr; @@ -594,21 +603,30 @@ let scope_decl_item := scope_decl_context_item_states = states; } } -| i = lident ; SCOPE ; c = addpos(quident) ; { +| attr = scope_decl_item_attribute ; + SCOPE ; c = addpos(quident) ; { + let in_attr_opt, out_attr, i = attr in + let attr = match in_attr_opt, out_attr with + | (None, pos), out -> { + scope_decl_context_io_input = (Internal, pos); + scope_decl_context_io_output = out; + }; + | (Some _, pos), _ -> + Message.raise_spanned_error pos + "Scope declaration does not support input qualifiers ('internal', \ + 'input' or 'context')" + in ContextScope{ scope_decl_context_scope_name = i; scope_decl_context_scope_sub_scope = c; - scope_decl_context_scope_attribute = { - scope_decl_context_io_input = (Internal, Pos.from_lpos $sloc); - scope_decl_context_io_output = (false, Pos.from_lpos $sloc); - }; + scope_decl_context_scope_attribute = attr; } } -| attr = scope_decl_item_attribute ; - i = lident ; +| attr_i = scope_decl_item_attribute_mandatory ; pos_condition = pos(CONDITION) ; args = depends_stance ; states = list(state) ; { + let attr, i = attr_i in ContextData { scope_decl_context_item_name = i; scope_decl_context_item_attribute = attr; diff --git a/tests/backends/python_name_clash.catala_en b/tests/backends/python_name_clash.catala_en new file mode 100644 index 00000000..644f9fb3 --- /dev/null +++ b/tests/backends/python_name_clash.catala_en @@ -0,0 +1,158 @@ +This test exposes a name clash between the scope function (`ScopeName,` +rewritten to `scope_name`) and the scope variable `scope_name`. + +```catala +declaration scope SomeNâme: + input i content integer + output o content integer + +scope SomeNâme: + definition o equals i + 1 + +declaration scope B: + output some_nâme scope SomeNâme + +scope B: + definition some_nâme.i equals 1 +``` + +```catala-test-inline +$ catala python +# This file has been generated by the Catala compiler, do not edit! + +from catala.runtime import * +from typing import Any, List, Callable, Tuple +from enum import Enum + +class SomeName: + def __init__(self, o: Integer) -> None: + self.o = o + + def __eq__(self, other: object) -> bool: + if isinstance(other, SomeName): + return (self.o == other.o) + else: + return False + + def __ne__(self, other: object) -> bool: + return not (self == other) + + def __str__(self) -> str: + return "SomeName(o={})".format(self.o) + +class B: + def __init__(self, some_name: SomeName) -> None: + self.some_name = some_name + + def __eq__(self, other: object) -> bool: + if isinstance(other, B): + return (self.some_name == other.some_name) + else: + return False + + def __ne__(self, other: object) -> bool: + return not (self == other) + + def __str__(self) -> str: + return "B(some_name={})".format(self.some_name) + +class SomeNameIn: + def __init__(self, i_in: Integer) -> None: + self.i_in = i_in + + def __eq__(self, other: object) -> bool: + if isinstance(other, SomeNameIn): + return (self.i_in == other.i_in) + else: + return False + + def __ne__(self, other: object) -> bool: + return not (self == other) + + def __str__(self) -> str: + return "SomeNameIn(i_in={})".format(self.i_in) + +class BIn: + def __init__(self, ) -> None: + pass + + def __eq__(self, other: object) -> bool: + if isinstance(other, BIn): + return (True) + else: + return False + + def __ne__(self, other: object) -> bool: + return not (self == other) + + def __str__(self) -> str: + return "BIn()".format() + + +def some_name(some_name_in:SomeNameIn): + i = some_name_in.i_in + try: + def temp_o(_:Unit): + raise EmptyError + def temp_o_1(_:Unit): + return False + def temp_o_2(_:Unit): + def temp_o_3(_:Unit): + return (i + integer_of_string("1")) + def temp_o_4(_:Unit): + return True + return handle_default(SourcePosition(filename="tests/backends/python_name_clash.catala_en", + start_line=7, start_column=10, + end_line=7, end_column=11, + law_headings=[]), [], temp_o_4, temp_o_3) + temp_o_5 = handle_default(SourcePosition(filename="tests/backends/python_name_clash.catala_en", + start_line=7, start_column=10, + end_line=7, end_column=11, + law_headings=[]), [temp_o_2], temp_o_1, + temp_o) + except EmptyError: + temp_o_5 = dead_value + raise NoValueProvided(SourcePosition(filename="tests/backends/python_name_clash.catala_en", + start_line=7, start_column=10, + end_line=7, end_column=11, + law_headings=[])) + o = temp_o_5 + return SomeName(o = o) + +def b(b_in:BIn): + try: + def temp_result(_:Unit): + raise EmptyError + def temp_result_1(_:Unit): + return False + def temp_result_2(_:Unit): + def temp_result_3(_:Unit): + return integer_of_string("1") + def temp_result_4(_:Unit): + return True + return handle_default(SourcePosition(filename="tests/backends/python_name_clash.catala_en", + start_line=16, start_column=14, + end_line=16, end_column=25, + law_headings=[]), [], temp_result_4, + temp_result_3) + temp_result_5 = handle_default(SourcePosition(filename="tests/backends/python_name_clash.catala_en", + start_line=16, start_column=14, + end_line=16, end_column=25, + law_headings=[]), [temp_result_2], + temp_result_1, temp_result) + except EmptyError: + temp_result_5 = dead_value + raise NoValueProvided(SourcePosition(filename="tests/backends/python_name_clash.catala_en", + start_line=16, start_column=14, + end_line=16, end_column=25, + law_headings=[])) + result = some_name(SomeNameIn(i_in = temp_result_5)) + result_1 = SomeName(o = result.o) + if True: + temp_some_name = result_1 + else: + temp_some_name = result_1 + some_name_1 = temp_some_name + return B(some_name = some_name_1) +``` +The above should *not* show `some_name = temp_some_name`, but instead `some_name_1 = ...` diff --git a/tests/exception/good/groups_of_exceptions.catala_en b/tests/exception/good/groups_of_exceptions.catala_en index c7cdcdc5..7617d479 100644 --- a/tests/exception/good/groups_of_exceptions.catala_en +++ b/tests/exception/good/groups_of_exceptions.catala_en @@ -72,9 +72,9 @@ let scope Foo (y: integer|input) (x: integer|internal|output) = | true ⊢ ⟨ ⟨y = 2 ⊢ ⟨2⟩⟩, ⟨y = 3 ⊢ ⟨3⟩⟩ | false ⊢ ∅ ⟩ ⟩ | true ⊢ ⟨ ⟨y = 0 ⊢ ⟨0⟩⟩, ⟨y = 1 ⊢ ⟨1⟩⟩ | false ⊢ ∅ ⟩ ⟩ -let scope Test (x: integer|internal|output) = - let f.y : integer = error_empty ⟨ ⟨true ⊢ ⟨2⟩⟩ | false ⊢ ∅ ⟩; - call Foo[f]; +let scope Test (x: integer|internal|output) (f: Foo {x: integer}|internal) = + let f : Foo {x: integer} = + Foo of {"y"= error_empty ⟨ ⟨true ⊢ ⟨2⟩⟩ | false ⊢ ∅ ⟩}; let x : integer = error_empty ⟨ ⟨true ⊢ ⟨f.x⟩⟩ | false ⊢ ∅ ⟩ ``` diff --git a/tests/func/good/closure_through_scope.catala_en b/tests/func/good/closure_through_scope.catala_en index d62dc9ef..170a6ffa 100644 --- a/tests/func/good/closure_through_scope.catala_en +++ b/tests/func/good/closure_through_scope.catala_en @@ -28,15 +28,15 @@ $ catala Typecheck --check-invariants ```catala-test-inline $ catala Lcalc -s T --avoid-exceptions -O --closure-conversion let scope T (T_in: T_in): T {y: integer} = - let sub_set s.x : bool = false in - let call result : S {f: ((closure_env, integer) → integer * closure_env)} - = - S { S_in x_in = s.x; } + let set s : S {f: ((closure_env, integer) → integer * closure_env)} = + { S f = (closure_s, to_closure_env ()); } in - let sub_get s.f : ((closure_env, integer) → integer * closure_env) = - result.f + let set y : integer = + let code_and_env : ((closure_env, integer) → integer * closure_env) = + s.f + in + code_and_env.0 code_and_env.1 2 in - let set y : integer = s.f.0 s.f.1 2 in return { T y = y; } ``` diff --git a/tests/func/good/context_func.catala_en b/tests/func/good/context_func.catala_en index e43132f1..ee7f4e1c 100644 --- a/tests/func/good/context_func.catala_en +++ b/tests/func/good/context_func.catala_en @@ -19,20 +19,40 @@ scope B: ```catala-test-inline $ catala Typecheck --check-invariants +[WARNING] Unused varible: a does not contribute to computing any of scope B outputs. Did you forget something? + +┌─⯈ tests/func/good/context_func.catala_en:9.3-9.4: +└─┐ +9 │ a scope A + │ ‾ + └─ Test [RESULT] All invariant checks passed [RESULT] Typechecking successful! ``` ```catala-test-inline $ catala Scopelang -s B -let scope B (b: bool|input) = - let a.f : integer → ⟨integer⟩ = λ (x: integer) → - ⟨ ⟨b && x > 0 ⊢ ⟨x - 1⟩⟩ | false ⊢ ∅ ⟩; - call A[a] +[WARNING] Unused varible: a does not contribute to computing any of scope B outputs. Did you forget something? + +┌─⯈ tests/func/good/context_func.catala_en:9.3-9.4: +└─┐ +9 │ a scope A + │ ‾ + └─ Test +let scope B (b: bool|input) (a: A {f: integer → integer}|internal) = + let a : A {f: integer → integer} = + A of {"f"= (λ (x: integer) → ⟨ ⟨b && x > 0 ⊢ ⟨x - 1⟩⟩ | false ⊢ ∅ ⟩)} ``` ```catala-test-inline $ catala Dcalc -s A +[WARNING] Unused varible: a does not contribute to computing any of scope B outputs. Did you forget something? + +┌─⯈ tests/func/good/context_func.catala_en:9.3-9.4: +└─┐ +9 │ a scope A + │ ‾ + └─ Test let scope A (A_in: A_in {f_in: integer → ⟨integer⟩}) : A {f: integer → integer} @@ -48,13 +68,24 @@ let scope A ```catala-test-inline $ catala Dcalc -s B +[WARNING] Unused varible: a does not contribute to computing any of scope B outputs. Did you forget something? + +┌─⯈ tests/func/good/context_func.catala_en:9.3-9.4: +└─┐ +9 │ a scope A + │ ‾ + └─ Test let scope B (B_in: B_in {b_in: bool}): B = let get b : bool = B_in.b_in in - let sub_set a.f : integer → ⟨integer⟩ = - λ (x: integer) → - ⟨ ⟨b && x > 0 ⊢ ⟨x - 1⟩⟩ | false ⊢ ∅ ⟩ + let set a : A {f: integer → integer} = + let result : A = + A + { A_in + f_in = λ (x: integer) → ⟨ ⟨b && x > 0 ⊢ ⟨x - 1⟩⟩ | false ⊢ ∅ ⟩; + } + in + let result1 : A = { A f = λ (param0: integer) → result.f param0; } in + if true then result1 else result1 in - let call result : A {f: integer → integer} = A { A_in f_in = a.f; } in - let sub_get a.f : integer → integer = result.f in return {B} ``` diff --git a/tests/io/bad/inputing_to_not_input.catala_en b/tests/io/bad/inputing_to_not_input.catala_en index 1fc58859..ae99fa6a 100644 --- a/tests/io/bad/inputing_to_not_input.catala_en +++ b/tests/io/bad/inputing_to_not_input.catala_en @@ -17,7 +17,7 @@ scope B: ```catala-test-inline $ catala Typecheck [ERROR] -It is impossible to give a definition to a subscope variable not tagged as input or context. +Invalid assignment to a subscope variable that is not tagged as input or context. Incriminated subscope: ┌─⯈ tests/io/bad/inputing_to_not_input.catala_en:8.3-8.4: diff --git a/tests/io/bad/using_non_output.catala_en b/tests/io/bad/using_non_output.catala_en index 893002ab..8f658513 100644 --- a/tests/io/bad/using_non_output.catala_en +++ b/tests/io/bad/using_non_output.catala_en @@ -15,35 +15,21 @@ scope B: ``` ```catala-test-inline $ catala Typecheck -[WARNING] This variable is dead code; it does not contribute to computing any of scope "A" outputs. Did you forget something? - -┌─⯈ tests/io/bad/using_non_output.catala_en:5.12-5.13: -└─┐ -5 │ internal a content integer - │ ‾ - └─ Test [ERROR] -The variable a.a cannot be used here, as it is not part of subscope a's results. Maybe you forgot to qualify it as an output? +Variable a is not a declared output of scope A. -Incriminated variable usage: +a is used here as an output ┌─⯈ tests/io/bad/using_non_output.catala_en:14.13-14.16: └──┐ 14 │ assertion a.a = 0 │ ‾‾‾ └─ Test -Incriminated subscope variable declaration: -┌─⯈ tests/io/bad/using_non_output.catala_en:5.12-5.13: +Scope A is declared here +┌─⯈ tests/io/bad/using_non_output.catala_en:4.19-4.20: └─┐ -5 │ internal a content integer - │ ‾ - └─ Test - -Incriminated subscope declaration: -┌─⯈ tests/io/bad/using_non_output.catala_en:8.3-8.4: -└─┐ -8 │ a scope A - │ ‾ +4 │ declaration scope A: + │ ‾ └─ Test #return code 123# ``` diff --git a/tests/io/good/condition_only_input.catala_en b/tests/io/good/condition_only_input.catala_en index d13b9007..14772db1 100644 --- a/tests/io/good/condition_only_input.catala_en +++ b/tests/io/good/condition_only_input.catala_en @@ -25,9 +25,13 @@ $ catala Typecheck --check-invariants ```catala-test-inline $ catala Dcalc -s B let scope B (B_in: B_in): B = - let sub_set a.x : bool = error_empty ⟨ ⟨true ⊢ ⟨false⟩⟩ | false ⊢ ∅ ⟩ in - let call result : A {y: integer} = A { A_in x_in = a.x; } in - let sub_get a.y : integer = result.y in + let set a : A {y: integer} = + let result : A = + A { A_in x_in = error_empty ⟨ ⟨true ⊢ ⟨false⟩⟩ | false ⊢ ∅ ⟩; } + in + let result1 : A = { A y = result.y; } in + if true then result1 else result1 + in let assert _ : unit = assert ((a.y = 1)) in return {B} ``` diff --git a/tests/io/good/subscope.catala_en b/tests/io/good/subscope.catala_en index f4d81deb..5aca91a1 100644 --- a/tests/io/good/subscope.catala_en +++ b/tests/io/good/subscope.catala_en @@ -31,10 +31,17 @@ $ catala Typecheck --check-invariants ```catala-test-inline $ catala Dcalc -s B let scope B (B_in: B_in): B = - let sub_set a.a : unit → ⟨integer⟩ = λ () → ∅ in - let sub_set a.b : integer = error_empty ⟨ ⟨true ⊢ ⟨2⟩⟩ | false ⊢ ∅ ⟩ in - let call result : A {c: integer} = A { A_in a_in = a.a; b_in = a.b; } in - let sub_get a.c : integer = result.c in + let set a : A {c: integer} = + let result : A = + A + { A_in + a_in = λ () → ∅; + b_in = error_empty ⟨ ⟨true ⊢ ⟨2⟩⟩ | false ⊢ ∅ ⟩; + } + in + let result1 : A = { A c = result.c; } in + if true then result1 else result1 + in let assert _ : unit = assert ((a.c = 1)) in return {B} ``` diff --git a/tests/name_resolution/good/let_in.catala_en b/tests/name_resolution/good/let_in.catala_en index dca21542..b1a9bb8f 100644 --- a/tests/name_resolution/good/let_in.catala_en +++ b/tests/name_resolution/good/let_in.catala_en @@ -55,6 +55,13 @@ scope S2: ```catala-test-inline $ catala test-scope S2 +[WARNING] Unused varible: x does not contribute to computing any of scope S2 outputs. Did you forget something? + +┌─⯈ tests/name_resolution/good/let_in.catala_en:47.4-47.5: +└──┐ +47 │ x scope S + │ ‾ + └─ Check scope of let-in vs scope variable [RESULT] Computation successful! Results: [RESULT] y = 1 ``` diff --git a/tests/proof/bad/prolala_motivating_example.catala_en b/tests/proof/bad/prolala_motivating_example.catala_en index d3b87552..bfb14387 100644 --- a/tests/proof/bad/prolala_motivating_example.catala_en +++ b/tests/proof/bad/prolala_motivating_example.catala_en @@ -124,7 +124,7 @@ scope Amount: ```catala-test-inline $ catala Proof --disable-counterexamples [ERROR] -It is impossible to give a definition to a subscope variable not tagged as input or context. +Invalid assignment to a subscope variable that is not tagged as input or context. Incriminated subscope: ┌─⯈ tests/proof/bad/prolala_motivating_example.catala_en:56.3-56.14: diff --git a/tests/scope/bad/sub_vars_in_sub_var.catala_en b/tests/scope/bad/sub_vars_in_sub_var.catala_en index 98e170ce..8d59ef92 100644 --- a/tests/scope/bad/sub_vars_in_sub_var.catala_en +++ b/tests/scope/bad/sub_vars_in_sub_var.catala_en @@ -16,12 +16,12 @@ scope B: ```catala-test-inline $ catala test-scope A [ERROR] -The subscope a is used when defining one of its inputs, but recursion is forbidden in Catala +The subscope a is used in the definition of its own input a.y, but recursion is forbidden in Catala -┌─⯈ tests/scope/bad/sub_vars_in_sub_var.catala_en:13.28-13.31: +┌─⯈ tests/scope/bad/sub_vars_in_sub_var.catala_en:13.28-13.29: └──┐ 13 │ definition a.y equals if a.x then 0 else 1 - │ ‾‾‾ + │ ‾ └─ Article #return code 123# ``` diff --git a/tests/scope/good/191_fix_record_name_confusion.catala_en b/tests/scope/good/191_fix_record_name_confusion.catala_en index 556b4270..ad7070ba 100644 --- a/tests/scope/good/191_fix_record_name_confusion.catala_en +++ b/tests/scope/good/191_fix_record_name_confusion.catala_en @@ -25,7 +25,6 @@ $ catala Typecheck --check-invariants ```catala-test-inline $ catala OCaml -O -Generating entry points for scopes: ScopeA ScopeB (** This file has been generated by the Catala compiler, do not edit! *) @@ -56,9 +55,8 @@ let scope_a (scope_a_in: ScopeA_in.t) : ScopeA.t = {ScopeA.a = a_} let scope_b (scope_b_in: ScopeB_in.t) : ScopeB.t = - let result_: ScopeA.t = scope_a (()) in - let scope_a_dot_a_: bool = result_.ScopeA.a in - let a_: bool = scope_a_dot_a_ in + let scope_a_: ScopeA.t = {ScopeA.a = ((scope_a (())).ScopeA.a)} in + let a_: bool = scope_a_.ScopeA.a in {ScopeB.a = a_} diff --git a/tests/scope/good/local-capture-subscope.catala_en b/tests/scope/good/local-capture-subscope.catala_en new file mode 100644 index 00000000..a0e27007 --- /dev/null +++ b/tests/scope/good/local-capture-subscope.catala_en @@ -0,0 +1,53 @@ + +```catala +declaration scope A: + output ao content integer + +declaration scope S: + a scope A + output so content integer + +scope A: + definition ao equals 99 + +scope S: + definition so equals + let a equals A { -- ao: 42 } in + a.ao + +``` + + +```catala-test-inline +$ catala test-scope S +[WARNING] Unused varible: a does not contribute to computing any of scope S outputs. Did you forget something? + +┌─⯈ tests/scope/good/local-capture-subscope.catala_en:7.3-7.4: +└─┐ +7 │ a scope A + │ ‾ +[RESULT] Computation successful! Results: +[RESULT] so = 42 +``` + + +```catala +declaration scope A2: + input output io content integer + output x content integer + +declaration scope S2: + a scope A2 + b scope A2 + output c1 content integer + output c2 content integer + +scope A2: + definition x equals 0 + +scope S2: + definition a.io equals 1 + definition b.io equals 2 + definition c1 equals a.io + definition c2 equals b.io +``` diff --git a/tests/scope/good/out_sub_scope.catala_en b/tests/scope/good/out_sub_scope.catala_en new file mode 100644 index 00000000..bfb534c7 --- /dev/null +++ b/tests/scope/good/out_sub_scope.catala_en @@ -0,0 +1,27 @@ + +```catala +declaration scope A: + input i content integer + output o content integer + input output io content integer + +declaration scope B: + output a scope A + output b content integer + +scope A: + definition o equals i + +scope B: + definition a.i equals 99 + definition a.io equals 100 + definition b equals a.o +``` + + +```catala-test-inline +$ catala test-scope B +[RESULT] Computation successful! Results: +[RESULT] a = A { -- o: 99 -- io: 100 } +[RESULT] b = 99 +``` diff --git a/tests/scope/good/scope_call2.catala_en b/tests/scope/good/scope_call2.catala_en index 291c94ba..a8e43338 100644 --- a/tests/scope/good/scope_call2.catala_en +++ b/tests/scope/good/scope_call2.catala_en @@ -22,12 +22,24 @@ scope Titi: ```catala-test-inline $ catala Typecheck --check-invariants +[WARNING] Unused varible: toto does not contribute to computing any of scope Titi outputs. Did you forget something? + +┌─⯈ tests/scope/good/scope_call2.catala_en:13.3-13.7: +└──┐ +13 │ toto scope Toto + │ ‾‾‾‾ [RESULT] All invariant checks passed [RESULT] Typechecking successful! ``` ```catala-test-inline $ catala test-scope Titi +[WARNING] Unused varible: toto does not contribute to computing any of scope Titi outputs. Did you forget something? + +┌─⯈ tests/scope/good/scope_call2.catala_en:13.3-13.7: +└──┐ +13 │ toto scope Toto + │ ‾‾‾‾ [RESULT] Computation successful! Results: [RESULT] fizz = Toto { -- foo: 1,213 } [RESULT] fuzz = Toto { -- foo: 1,323 } diff --git a/tests/scope/good/sub_sub_scope.catala_en b/tests/scope/good/sub_sub_scope.catala_en index 94f6beca..66b8df99 100644 --- a/tests/scope/good/sub_sub_scope.catala_en +++ b/tests/scope/good/sub_sub_scope.catala_en @@ -34,12 +34,40 @@ scope C: ```catala-test-inline $ catala Typecheck --check-invariants +[WARNING] Unused varible: a does not contribute to computing any of scope C outputs. Did you forget something? + +┌─⯈ tests/scope/good/sub_sub_scope.catala_en:14.3-14.4: +└──┐ +14 │ a scope A + │ ‾ + └─ Article +[WARNING] Unused varible: b does not contribute to computing any of scope C outputs. Did you forget something? + +┌─⯈ tests/scope/good/sub_sub_scope.catala_en:15.3-15.4: +└──┐ +15 │ b scope B + │ ‾ + └─ Article [RESULT] All invariant checks passed [RESULT] Typechecking successful! ``` ```catala-test-inline $ catala test-scope A +[WARNING] Unused varible: a does not contribute to computing any of scope C outputs. Did you forget something? + +┌─⯈ tests/scope/good/sub_sub_scope.catala_en:14.3-14.4: +└──┐ +14 │ a scope A + │ ‾ + └─ Article +[WARNING] Unused varible: b does not contribute to computing any of scope C outputs. Did you forget something? + +┌─⯈ tests/scope/good/sub_sub_scope.catala_en:15.3-15.4: +└──┐ +15 │ b scope B + │ ‾ + └─ Article [RESULT] Computation successful! Results: [RESULT] u = true [RESULT] x = 0 @@ -47,12 +75,40 @@ $ catala test-scope A ```catala-test-inline $ catala test-scope B +[WARNING] Unused varible: a does not contribute to computing any of scope C outputs. Did you forget something? + +┌─⯈ tests/scope/good/sub_sub_scope.catala_en:14.3-14.4: +└──┐ +14 │ a scope A + │ ‾ + └─ Article +[WARNING] Unused varible: b does not contribute to computing any of scope C outputs. Did you forget something? + +┌─⯈ tests/scope/good/sub_sub_scope.catala_en:15.3-15.4: +└──┐ +15 │ b scope B + │ ‾ + └─ Article [RESULT] Computation successful! Results: [RESULT] y = 1 ``` ```catala-test-inline $ catala test-scope C +[WARNING] Unused varible: a does not contribute to computing any of scope C outputs. Did you forget something? + +┌─⯈ tests/scope/good/sub_sub_scope.catala_en:14.3-14.4: +└──┐ +14 │ a scope A + │ ‾ + └─ Article +[WARNING] Unused varible: b does not contribute to computing any of scope C outputs. Did you forget something? + +┌─⯈ tests/scope/good/sub_sub_scope.catala_en:15.3-15.4: +└──┐ +15 │ b scope B + │ ‾ + └─ Article [RESULT] Computation successful! Results: [RESULT] z = 2 ``` diff --git a/tests/struct/bad/wrong_qualified_field.catala_en b/tests/struct/bad/wrong_qualified_field.catala_en index d39df7b9..e79fdd4b 100644 --- a/tests/struct/bad/wrong_qualified_field.catala_en +++ b/tests/struct/bad/wrong_qualified_field.catala_en @@ -20,7 +20,8 @@ scope A: ```catala-test-inline $ catala test-scope A [ERROR] -Field "g" does not belong to structure "Foo", but to "Bar" +Field "g" does not belong to structure "Foo" +(however, structure "Bar" defines it) ┌─⯈ tests/struct/bad/wrong_qualified_field.catala_en:17.23-17.30: └──┐ diff --git a/tests/typing/good/common.catala_en b/tests/typing/good/common.catala_en index 267c9654..004d46ce 100644 --- a/tests/typing/good/common.catala_en +++ b/tests/typing/good/common.catala_en @@ -31,7 +31,7 @@ $ catala Typecheck --check-invariants └──┐ 15 │ output a content decimal │ ‾ -[WARNING] This variable is dead code; it does not contribute to computing any of scope "S" outputs. Did you forget something? +[WARNING] Unused varible: x does not contribute to computing any of scope S outputs. Did you forget something? ┌─⯈ tests/typing/good/common.catala_en:12.9-12.10: └──┐ diff --git a/tests/variable_state/bad/no_cross_exceptions.catala_en b/tests/variable_state/bad/no_cross_exceptions.catala_en index abe40793..6b426d0a 100644 --- a/tests/variable_state/bad/no_cross_exceptions.catala_en +++ b/tests/variable_state/bad/no_cross_exceptions.catala_en @@ -17,7 +17,7 @@ scope A: ```catala-test-inline $ catala Typecheck [ERROR] -Unknown label for the scope variable foo.baz: "thing" +Unknown label for the scope variable foo@baz: "thing" ┌─⯈ tests/variable_state/bad/no_cross_exceptions.catala_en:14.13-14.18: └──┐