CatalaLang/catala
1
1
Fork 0
mirror of https://github.com/CatalaLang/catala.git synced 2024-09-19 00:15:39 +03:00
Code Issues Projects Releases Wiki Activity

Allow "output subscopes" ; unify the internal representation of subscopes (#597)

Browse Source
This commit is contained in:
Louis Gesbert 2024-04-10 19:25:34 +02:00 committed by GitHub
commit f3164051cc
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
44 changed files with 1292 additions and 1158 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
compiler/catala_utils/uid.ml
View File

@ -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

340
compiler/dcalc/from_scopelang.ml
View File

@ -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;
}

95
compiler/desugared/ast.ml
View File

@ -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

23
compiler/desugared/ast.mli
View File

@ -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;

98
compiler/desugared/dependency.ml
View File

@ -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 *)

1
compiler/desugared/dependency.mli
View File

@ -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

10
compiler/desugared/disambiguate.ml
View File

@ -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

157
compiler/desugared/from_surface.ml
View File

@ -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 = [];

44
compiler/desugared/linting.ml
View File

@ -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 =

84
compiler/desugared/name_resolution.ml
View File

@ -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 @{<yellow>\"%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 \

8
compiler/desugared/name_resolution.mli
View File

@ -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 ->

61
compiler/driver.ml
View File

@ -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 @{<yellow>\"%s\"@} not found inside scope @{<yellow>\"%a\"@}"
variable ScopeName.format scope_uid
| Some (SubScope (subscope_var_name, subscope_name)) -> (
match second_part with
| None ->
Message.raise_error
"Subscope @{<yellow>\"%a\"@} of scope @{<yellow>\"%a\"@} cannot be \
selected by itself, please add \".<var>\" where <var> 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 @{<yellow>\"%s\"@} of subscope @{<yellow>\"%a\"@} in scope \
@{<yellow>\"%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 @{<yellow>\"%s\"@} is not found for variable \
@{<yellow>\"%s\"@} of scope @{<yellow>\"%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 @{<yellow>\"%s\"@} is not found for variable \
@{<yellow>\"%s\"@} of scope @{<yellow>\"%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

2
compiler/lcalc/to_ocaml.ml
View File

@ -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 "@[<hov 2>Generating entry points for scopes:@ %a@]@."
Message.emit_debug "@[<hov 2>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;

37
compiler/scalc/to_python.ml
View File

@ -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 "@[<hv 4>%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 =
[

34
compiler/scopelang/ast.ml
View File

@ -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

17
compiler/scopelang/ast.mli
View File

@ -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;

9
compiler/scopelang/dependency.ml
View File

@ -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

529
compiler/scopelang/from_desugared.ml
View File

@ -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

37
compiler/scopelang/print.ml
View File

@ -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 "@[<hov 2>%a %a %a %a %a@ %a@]" Print.keyword
"let" Print.location (Mark.remove loc) Print.punctuation ":"
| ScopeVarDefinition { var; typ; io; e } ->
Format.fprintf fmt "@[<hov 2>%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 "@[<hov 2>%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) =

16
compiler/shared_ast/definitions.ml
View File

@ -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;
}

22
compiler/shared_ast/expr.ml
View File

@ -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 _ -> .

3
compiler/shared_ast/print.ml
View File

@ -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 =

70
compiler/shared_ast/typing.ml
View File

@ -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 @{<yellow>\"%s\"@} does not belong to structure \
@{<yellow>\"%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
"@{<yellow>%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 @{<yellow>%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 @{<yellow>\"%s\"@} does not belong to structure \
@{<yellow>\"%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)
"@[<hov>Field @{<yellow>\"%s\"@}@ does not belong to@ structure \
@{<yellow>\"%a\"@},@ but to %a@]"
@{<yellow>\"%a\"@}@ (however, structure %a defines it)@]"
field A.StructName.format name
(Format.pp_print_list
~pp_sep:(fun ppf () -> Format.fprintf ppf "@ or@ ")

210
compiler/surface/parser.messages
View File

@ -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 ('<ident> content <type>')
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 ('<ident> content <type>')
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 <ident> content <type>'
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 (<ident> content <type> [, <ident> content <type> ...])'
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 '<ident> scope <Scope_name>', 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 <type>'
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 <expression>', optionally preceded by 'depends on <var> 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 <var> content <type>'
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 (<var> content <type>,
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 <type>'
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 <expression>'
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 '<var> content <type>'
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: <filename>'
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.<number>', 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 [ # ]
##

86
compiler/surface/parser.mly
View File

@ -84,9 +84,10 @@ end>
%type<Ast.scope_use_item Mark.pos> scope_item
%type<Ast.lident Mark.pos * Ast.base_typ Mark.pos> struct_scope_base
%type<Ast.struct_decl_field> struct_scope
%type<Ast.io_input> scope_decl_item_attribute_input
%type<Ast.io_input option> scope_decl_item_attribute_input
%type<bool> scope_decl_item_attribute_output
%type<Ast.scope_decl_context_io> scope_decl_item_attribute
%type<Ast.io_input option Mark.pos * bool Mark.pos * Ast.lident Mark.pos> scope_decl_item_attribute
%type<Ast.scope_decl_context_io * Ast.lident Mark.pos> scope_decl_item_attribute_mandatory
%type<Ast.scope_decl_context_item> scope_decl_item
%type<Ast.enum_decl_case> enum_decl_line
%type<Ast.code_item> 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;

158
tests/backends/python_name_clash.catala_en Normal file
View File

@ -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 = ...`

6
tests/exception/good/groups_of_exceptions.catala_en
View File

@ -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 ⊢ ∅ ⟩
```

14
tests/func/good/closure_through_scope.catala_en
View File

@ -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; }
```

49
tests/func/good/context_func.catala_en
View File

@ -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}
```

2
tests/io/bad/inputing_to_not_input.catala_en
View File

@ -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:

26
tests/io/bad/using_non_output.catala_en
View File

@ -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#
```

10
tests/io/good/condition_only_input.catala_en
View File

@ -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}
```

15
tests/io/good/subscope.catala_en
View File

@ -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}
```

7
tests/name_resolution/good/let_in.catala_en
View File

@ -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
```

2
tests/proof/bad/prolala_motivating_example.catala_en
View File

@ -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:

6
tests/scope/bad/sub_vars_in_sub_var.catala_en
View File

@ -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#
```

6
tests/scope/good/191_fix_record_name_confusion.catala_en
View File

@ -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_}

53
tests/scope/good/local-capture-subscope.catala_en Normal file
View File

@ -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
```

27
tests/scope/good/out_sub_scope.catala_en Normal file
View File

@ -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
```

12
tests/scope/good/scope_call2.catala_en
View File

@ -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 }

56
tests/scope/good/sub_sub_scope.catala_en
View File

@ -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
```

3
tests/struct/bad/wrong_qualified_field.catala_en
View File

@ -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:
└──┐

2
tests/typing/good/common.catala_en
View File

@ -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:
└──┐

2
tests/variable_state/bad/no_cross_exceptions.catala_en
View File

@ -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:
└──┐