CatalaLang/catala
1
1
Fork 0
mirror of https://github.com/CatalaLang/catala.git synced 2024-11-08 07:51:43 +03:00
Code Issues Projects Releases Wiki Activity

Finer control over input IO (distinction only_input/reentrant) [skip ci]

Browse Source
This commit is contained in:
Denis Merigoux 2022-02-07 10:30:36 +01:00
parent f4200bb638
commit e3b5d2d0b6
No known key found for this signature in database
GPG Key ID: EE99DCFA365C3EE3
13 changed files with 151 additions and 159 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/desugared/ast.ml
View File

@ -118,7 +118,7 @@ type scope_def = {
scope_def_rules : rule RuleMap.t; scope_def_rules : rule RuleMap.t;
scope_def_typ : Scopelang.Ast.typ Pos.marked; scope_def_typ : Scopelang.Ast.typ Pos.marked;
scope_def_is_condition : bool; scope_def_is_condition : bool;
scope_def_visibility : Scopelang.Ast.visibility; scope_def_io : Scopelang.Ast.io;
scope_def_label_groups : RuleSet.t LabelMap.t; scope_def_label_groups : RuleSet.t LabelMap.t;
} }

2
compiler/desugared/ast.mli
View File

@ -79,7 +79,7 @@ type scope_def = {
scope_def_rules : rule RuleMap.t; scope_def_rules : rule RuleMap.t;
scope_def_typ : Scopelang.Ast.typ Pos.marked; scope_def_typ : Scopelang.Ast.typ Pos.marked;
scope_def_is_condition : bool; scope_def_is_condition : bool;
scope_def_visibility : Scopelang.Ast.visibility; scope_def_io : Scopelang.Ast.io;
scope_def_label_groups : RuleSet.t LabelMap.t; scope_def_label_groups : RuleSet.t LabelMap.t;
} }

32
compiler/desugared/desugared_to_scope.ml
View File

@ -231,7 +231,9 @@ let translate_scope (scope : Ast.scope) : Scopelang.Ast.scope_decl =
(* We exclude subscope variables that have 0 re-definitions and are not (* We exclude subscope variables that have 0 re-definitions and are not
visible in the input of the subscope *) visible in the input of the subscope *)
&& not && not
((not scope_def.Ast.scope_def_visibility.visibility_input) ((match Pos.unmark scope_def.Ast.scope_def_io.io_input with
| Scopelang.Ast.NoInput -> false
| _ -> true)
&& Ast.RuleMap.is_empty scope_def.scope_def_rules)) && Ast.RuleMap.is_empty scope_def.scope_def_rules))
scope.scope_defs scope.scope_defs
in in
@ -240,18 +242,20 @@ let translate_scope (scope : Ast.scope) : Scopelang.Ast.scope_decl =
(fun def_key scope_def -> (fun def_key scope_def ->
let def = scope_def.Ast.scope_def_rules in let def = scope_def.Ast.scope_def_rules in
(* This definition redefines a variable of the correct subscope. But we have to (* This definition redefines a variable of the correct subscope. But we have to
check that this redefinition is allowed with respect to the visibility check that this redefinition is allowed with respect to the io parameters of
parameters of that subscope variable. *) that subscope variable. *)
if not scope_def.Ast.scope_def_visibility.visibility_input then (match Pos.unmark scope_def.Ast.scope_def_io.io_input with
Errors.raise_multispanned_error | Scopelang.Ast.NoInput ->
"It is impossible to give a definition to a subscope variable not tagged \ Errors.raise_multispanned_error
as input or context." "It is impossible to give a definition to a subscope variable not \
((Some "Relevant subscope:", Ast.ScopeDef.get_position def_key) tagged as input or context."
:: List.map ((Some "Relevant subscope:", Ast.ScopeDef.get_position def_key)
(fun (rule, _) -> :: List.map
( Some "Suscope variable definition:", (fun (rule, _) ->
Pos.get_position (Ast.RuleName.get_info rule) )) ( Some "Suscope variable definition:",
(Ast.RuleMap.bindings def)); Pos.get_position (Ast.RuleName.get_info rule) ))
(Ast.RuleMap.bindings def))
| _ -> ());
(* Now that all is good, we can proceed with translating this redefinition to a (* Now that all is good, we can proceed with translating this redefinition to a
proper Scopelang term. *) proper Scopelang term. *)
let def_typ = scope_def.scope_def_typ in let def_typ = scope_def.scope_def_typ in
@ -294,7 +298,7 @@ let translate_scope (scope : Ast.scope) : Scopelang.Ast.scope_decl =
(fun var acc -> (fun var acc ->
let scope_def = Ast.ScopeDefMap.find (Ast.ScopeDef.Var var) scope.scope_defs in let scope_def = Ast.ScopeDefMap.find (Ast.ScopeDef.Var var) scope.scope_defs in
let typ = scope_def.scope_def_typ in let typ = scope_def.scope_def_typ in
Scopelang.Ast.ScopeVarMap.add var (typ, scope_def.scope_def_visibility) acc) Scopelang.Ast.ScopeVarMap.add var (typ, scope_def.scope_def_io) acc)
scope.scope_vars Scopelang.Ast.ScopeVarMap.empty scope.scope_vars Scopelang.Ast.ScopeVarMap.empty
in in
{ {

6
compiler/scopelang/ast.ml
View File

@ -118,7 +118,9 @@ let rec locations_used (e : expr Pos.marked) : LocationSet.t =
List.fold_left (fun acc e' -> LocationSet.union acc (locations_used e')) LocationSet.empty es List.fold_left (fun acc e' -> LocationSet.union acc (locations_used e')) LocationSet.empty es
| ErrorOnEmpty e' -> locations_used e' | ErrorOnEmpty e' -> locations_used e'
type visibility = { visibility_output : bool; visibility_input : bool } type io_input = NoInput | OnlyInput | Reentrant
type io = { io_output : bool Pos.marked; io_input : io_input Pos.marked }
type rule = type rule =
| Definition of location Pos.marked * typ Pos.marked * expr Pos.marked | Definition of location Pos.marked * typ Pos.marked * expr Pos.marked
@ -127,7 +129,7 @@ type rule =
type scope_decl = { type scope_decl = {
scope_decl_name : ScopeName.t; scope_decl_name : ScopeName.t;
scope_sig : (typ Pos.marked * visibility) ScopeVarMap.t; scope_sig : (typ Pos.marked * io) ScopeVarMap.t;
scope_decl_rules : rule list; scope_decl_rules : rule list;
} }

13
compiler/scopelang/ast.mli
View File

@ -84,9 +84,14 @@ type expr =
val locations_used : expr Pos.marked -> LocationSet.t val locations_used : expr Pos.marked -> LocationSet.t
type visibility = { type io_input =
visibility_output : bool; (** True if present in the scope's output *) | NoInput (** For an internal variable defined only in the scope *)
visibility_input : bool; (** True if present in the scope's input (reentrant) *) | OnlyInput (** For variables that should not be redefined in the scope *)
| Reentrant (** For variables defined in the scope that can also be redefined by the caller *)
type io = {
io_output : bool Pos.marked;
io_input : io_input Pos.marked; (** True if present in the scope's input (reentrant) *)
} }
type rule = type rule =
@ -96,7 +101,7 @@ type rule =
type scope_decl = { type scope_decl = {
scope_decl_name : ScopeName.t; scope_decl_name : ScopeName.t;
scope_sig : (typ Pos.marked * visibility) ScopeVarMap.t; scope_sig : (typ Pos.marked * io) ScopeVarMap.t;
scope_decl_rules : rule list; scope_decl_rules : rule list;
} }

17
compiler/scopelang/print.ml
View File

@ -149,8 +149,11 @@ let format_scope (fmt : Format.formatter) ((name, decl) : ScopeName.t * scope_de
~pp_sep:(fun fmt () -> Format.fprintf fmt "@ ") ~pp_sep:(fun fmt () -> Format.fprintf fmt "@ ")
(fun fmt (scope_var, (typ, vis)) -> (fun fmt (scope_var, (typ, vis)) ->
Format.fprintf fmt "(%a: %a%s%s)" ScopeVar.format_t scope_var format_typ typ Format.fprintf fmt "(%a: %a%s%s)" ScopeVar.format_t scope_var format_typ typ
(if vis.visibility_input then "|input" else "") (match Pos.unmark vis.io_input with
(if vis.visibility_output then "|output" else ""))) | NoInput -> "|internal"
| OnlyInput -> "|input"
| Reentrant -> "|context")
(if Pos.unmark vis.io_output then "|output" else "")))
(ScopeVarMap.bindings decl.scope_sig) (ScopeVarMap.bindings decl.scope_sig)
(Format.pp_print_list (Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt ";@\n") ~pp_sep:(fun fmt () -> Format.fprintf fmt ";@\n")
@ -162,10 +165,12 @@ let format_scope (fmt : Format.formatter) ((name, decl) : ScopeName.t * scope_de
(fun fmt e -> (fun fmt e ->
match Pos.unmark loc with match Pos.unmark loc with
| SubScopeVar _ -> format_expr fmt e | SubScopeVar _ -> format_expr fmt e
| ScopeVar v -> | ScopeVar v -> (
if (snd (ScopeVarMap.find (Pos.unmark v) decl.scope_sig)).visibility_input then match
Format.fprintf fmt "reentrant or by default@ %a" format_expr e Pos.unmark (snd (ScopeVarMap.find (Pos.unmark v) decl.scope_sig)).io_input
else Format.fprintf fmt "%a" format_expr e) with
| Reentrant -> Format.fprintf fmt "reentrant or by default@ %a" format_expr e
| _ -> Format.fprintf fmt "%a" format_expr e))
e e
| Assertion e -> Format.fprintf fmt "assert (%a)" format_expr e | Assertion e -> Format.fprintf fmt "assert (%a)" format_expr e
| Call (scope_name, subscope_name) -> | Call (scope_name, subscope_name) ->

53
compiler/scopelang/scope_to_dcalc.ml
View File

@ -17,7 +17,7 @@ open Utils
type scope_var_ctx = { type scope_var_ctx = {
scope_var_name : Ast.ScopeVar.t; scope_var_name : Ast.ScopeVar.t;
scope_var_typ : Dcalc.Ast.typ; scope_var_typ : Dcalc.Ast.typ;
scope_var_visibility : Ast.visibility; scope_var_io : Ast.io;
} }
type scope_sig_ctx = { type scope_sig_ctx = {
@ -36,9 +36,8 @@ type ctx = {
enums : Ast.enum_ctx; enums : Ast.enum_ctx;
scope_name : Ast.ScopeName.t; scope_name : Ast.ScopeName.t;
scopes_parameters : scope_sigs_ctx; scopes_parameters : scope_sigs_ctx;
scope_vars : (Dcalc.Ast.Var.t * Dcalc.Ast.typ * Ast.visibility) Ast.ScopeVarMap.t; scope_vars : (Dcalc.Ast.Var.t * Dcalc.Ast.typ * Ast.io) Ast.ScopeVarMap.t;
subscope_vars : subscope_vars : (Dcalc.Ast.Var.t * Dcalc.Ast.typ * Ast.io) Ast.ScopeVarMap.t Ast.SubScopeMap.t;
(Dcalc.Ast.Var.t * Dcalc.Ast.typ * Ast.visibility) Ast.ScopeVarMap.t Ast.SubScopeMap.t;
local_vars : Dcalc.Ast.Var.t Ast.VarMap.t; local_vars : Dcalc.Ast.Var.t Ast.VarMap.t;
} }
@ -301,12 +300,12 @@ let translate_rule (ctx : ctx) (rule : Ast.rule)
match rule with match rule with
| Definition ((ScopeVar a, var_def_pos), tau, e) -> | Definition ((ScopeVar a, var_def_pos), tau, e) ->
let a_name = Ast.ScopeVar.get_info (Pos.unmark a) in let a_name = Ast.ScopeVar.get_info (Pos.unmark a) in
(* TODO: put visibility in a friendlier place, maybe in the Definition constructor? *) (* TODO: put io in a friendlier place, maybe in the Definition constructor? *)
let a_visibility = let a_io =
(List.find (List.find
(fun local_var -> Ast.ScopeVar.compare local_var.scope_var_name (Pos.unmark a) = 0) (fun local_var -> Ast.ScopeVar.compare local_var.scope_var_name (Pos.unmark a) = 0)
(Ast.ScopeMap.find ctx.scope_name ctx.scopes_parameters).scope_sig_local_vars) (Ast.ScopeMap.find ctx.scope_name ctx.scopes_parameters).scope_sig_local_vars)
.scope_var_visibility .scope_var_io
in in
let a_var = Dcalc.Ast.Var.make a_name in let a_var = Dcalc.Ast.Var.make a_name in
let tau = translate_typ ctx tau in let tau = translate_typ ctx tau in
@ -315,7 +314,9 @@ let translate_rule (ctx : ctx) (rule : Ast.rule)
let merged_expr = let merged_expr =
Bindlib.box_apply Bindlib.box_apply
(fun merged_expr -> (Dcalc.Ast.ErrorOnEmpty merged_expr, Pos.get_position a_name)) (fun merged_expr -> (Dcalc.Ast.ErrorOnEmpty merged_expr, Pos.get_position a_name))
(if a_visibility.visibility_input then merge_defaults a_expr new_e else new_e) (match Pos.unmark a_io.io_input with
| OnlyInput | Reentrant -> merge_defaults a_expr new_e
| NoInput -> new_e)
in in
let merged_expr = let merged_expr =
tag_with_log_entry merged_expr tag_with_log_entry merged_expr
@ -333,7 +334,7 @@ let translate_rule (ctx : ctx) (rule : Ast.rule)
{ {
ctx with ctx with
scope_vars = scope_vars =
Ast.ScopeVarMap.add (Pos.unmark a) (a_var, Pos.unmark tau, a_visibility) ctx.scope_vars; Ast.ScopeVarMap.add (Pos.unmark a) (a_var, Pos.unmark tau, a_io) ctx.scope_vars;
} ) } )
| Definition ((SubScopeVar (subs_name, subs_index, subs_var), var_def_pos), tau, e) -> | Definition ((SubScopeVar (subs_name, subs_index, subs_var), var_def_pos), tau, e) ->
let a_name = let a_name =
@ -356,12 +357,12 @@ let translate_rule (ctx : ctx) (rule : Ast.rule)
[ (Dcalc.Ast.TLit TUnit, var_def_pos) ] [ (Dcalc.Ast.TLit TUnit, var_def_pos) ]
var_def_pos var_def_pos
in in
let a_visibility = let a_io =
(List.find (List.find
(fun local_var -> (fun local_var ->
Ast.ScopeVar.compare local_var.scope_var_name (Pos.unmark subs_var) = 0) Ast.ScopeVar.compare local_var.scope_var_name (Pos.unmark subs_var) = 0)
(Ast.ScopeMap.find subs_name ctx.scopes_parameters).scope_sig_local_vars) (Ast.ScopeMap.find subs_name ctx.scopes_parameters).scope_sig_local_vars)
.scope_var_visibility .scope_var_io
in in
( [ ( [
{ {
@ -380,13 +381,11 @@ let translate_rule (ctx : ctx) (rule : Ast.rule)
match map with match map with
| Some map -> | Some map ->
Some Some
(Ast.ScopeVarMap.add (Pos.unmark subs_var) (Ast.ScopeVarMap.add (Pos.unmark subs_var) (a_var, Pos.unmark tau, a_io) map)
(a_var, Pos.unmark tau, a_visibility)
map)
| None -> | None ->
Some Some
(Ast.ScopeVarMap.singleton (Pos.unmark subs_var) (Ast.ScopeVarMap.singleton (Pos.unmark subs_var)
(a_var, Pos.unmark tau, a_visibility))) (a_var, Pos.unmark tau, a_io)))
ctx.subscope_vars; ctx.subscope_vars;
} ) } )
| Call (subname, subindex) -> | Call (subname, subindex) ->
@ -394,13 +393,12 @@ let translate_rule (ctx : ctx) (rule : Ast.rule)
let all_subscope_vars = subscope_sig.scope_sig_local_vars in let all_subscope_vars = subscope_sig.scope_sig_local_vars in
let all_subscope_input_vars = let all_subscope_input_vars =
List.filter List.filter
(fun var_ctx -> var_ctx.scope_var_visibility.Ast.visibility_input) (fun var_ctx ->
match Pos.unmark var_ctx.scope_var_io.Ast.io_input with NoInput -> false | _ -> true)
all_subscope_vars all_subscope_vars
in in
let all_subscope_output_vars = let all_subscope_output_vars =
List.filter List.filter (fun var_ctx -> Pos.unmark var_ctx.scope_var_io.Ast.io_output) all_subscope_vars
(fun var_ctx -> var_ctx.scope_var_visibility.Ast.visibility_output)
all_subscope_vars
in in
let scope_dcalc_var = subscope_sig.scope_sig_scope_var in let scope_dcalc_var = subscope_sig.scope_sig_scope_var in
let called_scope_input_struct = subscope_sig.scope_sig_input_struct in let called_scope_input_struct = subscope_sig.scope_sig_input_struct in
@ -515,7 +513,7 @@ let translate_rule (ctx : ctx) (rule : Ast.rule)
(List.fold_left (List.fold_left
(fun acc (var_ctx, dvar) -> (fun acc (var_ctx, dvar) ->
Ast.ScopeVarMap.add var_ctx.scope_var_name Ast.ScopeVarMap.add var_ctx.scope_var_name
(dvar, var_ctx.scope_var_typ, var_ctx.scope_var_visibility) (dvar, var_ctx.scope_var_typ, var_ctx.scope_var_io)
acc) acc)
Ast.ScopeVarMap.empty all_subscope_output_vars_dcalc) Ast.ScopeVarMap.empty all_subscope_output_vars_dcalc)
ctx.subscope_vars; ctx.subscope_vars;
@ -547,7 +545,7 @@ let translate_rules (ctx : ctx) (rules : Ast.rule list)
in in
let scope_variables = Ast.ScopeVarMap.bindings new_ctx.scope_vars in let scope_variables = Ast.ScopeVarMap.bindings new_ctx.scope_vars in
let scope_output_variables = let scope_output_variables =
List.filter (fun (_, (_, _, visibility)) -> visibility.Ast.visibility_output) scope_variables List.filter (fun (_, (_, _, io)) -> Pos.unmark io.Ast.io_output) scope_variables
in in
let return_exp = let return_exp =
Bindlib.box_apply Bindlib.box_apply
@ -582,10 +580,13 @@ let translate_scope_decl (struct_ctx : Ast.struct_ctx) (enum_ctx : Ast.enum_ctx)
in in
(* first we create variables from the fields of the input struct *) (* first we create variables from the fields of the input struct *)
let scope_input_variables = let scope_input_variables =
List.filter (fun (var_ctx, _) -> var_ctx.scope_var_visibility.visibility_input) scope_variables List.filter
(fun (var_ctx, _) ->
match Pos.unmark var_ctx.scope_var_io.io_input with NoInput -> false | _ -> true)
scope_variables
in in
let scope_output_variables = let scope_output_variables =
List.filter (fun (var_ctx, _) -> var_ctx.scope_var_visibility.visibility_output) scope_variables List.filter (fun (var_ctx, _) -> Pos.unmark var_ctx.scope_var_io.io_output) scope_variables
in in
let input_destructurings = let input_destructurings =
List.mapi List.mapi
@ -692,11 +693,7 @@ let translate_program (prgm : Ast.program) : Dcalc.Ast.program * Dependency.TVer
List.map List.map
(fun (scope_var, (tau, vis)) -> (fun (scope_var, (tau, vis)) ->
let tau = translate_typ (ctx_for_typ_translation scope_name) tau in let tau = translate_typ (ctx_for_typ_translation scope_name) tau in
{ { scope_var_name = scope_var; scope_var_typ = Pos.unmark tau; scope_var_io = vis })
scope_var_name = scope_var;
scope_var_typ = Pos.unmark tau;
scope_var_visibility = vis;
})
(Ast.ScopeVarMap.bindings scope.scope_sig); (Ast.ScopeVarMap.bindings scope.scope_sig);
scope_sig_scope_var = scope_dvar; scope_sig_scope_var = scope_dvar;
scope_sig_input_var = scope_input_var; scope_sig_input_var = scope_input_var;

42
compiler/surface/ast.ml
View File

@ -433,43 +433,65 @@ type scope_use = {
name = "scope_use_iter"; name = "scope_use_iter";
}] }]
type scope_decl_context_item_attribute = Context | Input | Output | Internal type io_input = Input | Context | Internal
[@@deriving
visitors { variety = "map"; name = "io_input_map" },
visitors { variety = "iter"; name = "io_input_iter" }]
type scope_decl_context_scope = { type scope_decl_context_io = {
scope_decl_context_scope_name : ident Pos.marked; scope_decl_context_io_input : io_input Pos.marked;
scope_decl_context_scope_sub_scope : constructor Pos.marked; scope_decl_context_io_output : bool Pos.marked;
scope_decl_context_scope_attribute : (scope_decl_context_item_attribute[@opaque]) Pos.marked;
} }
[@@deriving [@@deriving
visitors visitors
{ {
variety = "map"; variety = "map";
ancestors = [ "ident_map"; "constructor_map"; "Pos.marked_map" ]; ancestors = [ "io_input_map"; "Pos.marked_map" ];
name = "scope_decl_context_io_map";
},
visitors
{
variety = "iter";
ancestors = [ "io_input_iter"; "Pos.marked_iter" ];
name = "scope_decl_context_io_iter";
}]
type scope_decl_context_scope = {
scope_decl_context_scope_name : ident Pos.marked;
scope_decl_context_scope_sub_scope : constructor Pos.marked;
scope_decl_context_scope_attribute : scope_decl_context_io;
}
[@@deriving
visitors
{
variety = "map";
ancestors = [ "ident_map"; "constructor_map"; "scope_decl_context_io_map"; "Pos.marked_map" ];
name = "scope_decl_context_scope_map"; name = "scope_decl_context_scope_map";
}, },
visitors visitors
{ {
variety = "iter"; variety = "iter";
ancestors = [ "ident_iter"; "constructor_iter"; "Pos.marked_iter" ]; ancestors =
[ "ident_iter"; "constructor_iter"; "scope_decl_context_io_iter"; "Pos.marked_iter" ];
name = "scope_decl_context_scope_iter"; name = "scope_decl_context_scope_iter";
}] }]
type scope_decl_context_data = { type scope_decl_context_data = {
scope_decl_context_item_name : ident Pos.marked; scope_decl_context_item_name : ident Pos.marked;
scope_decl_context_item_typ : typ Pos.marked; scope_decl_context_item_typ : typ Pos.marked;
scope_decl_context_item_attribute : (scope_decl_context_item_attribute[@opaque]) Pos.marked; scope_decl_context_item_attribute : scope_decl_context_io;
} }
[@@deriving [@@deriving
visitors visitors
{ {
variety = "map"; variety = "map";
ancestors = [ "typ_map"; "ident_map" ]; ancestors = [ "typ_map"; "scope_decl_context_io_map"; "ident_map" ];
name = "scope_decl_context_data_map"; name = "scope_decl_context_data_map";
}, },
visitors visitors
{ {
variety = "iter"; variety = "iter";
ancestors = [ "typ_iter"; "ident_iter" ]; ancestors = [ "typ_iter"; "scope_decl_context_io_iter"; "ident_iter" ];
name = "scope_decl_context_data_iter"; name = "scope_decl_context_data_iter";
}] }]

25
compiler/surface/desugaring.ml
View File

@ -1069,13 +1069,18 @@ let process_scope_use (ctxt : Name_resolution.context) (prgm : Desugared.Ast.pro
List.iter (check_unlabeled_exception scope_uid ctxt) use.scope_use_items; List.iter (check_unlabeled_exception scope_uid ctxt) use.scope_use_items;
List.fold_left (process_scope_use_item precond scope_uid ctxt) prgm use.scope_use_items List.fold_left (process_scope_use_item precond scope_uid ctxt) prgm use.scope_use_items
let attribute_to_visibility (attr : Ast.scope_decl_context_item_attribute Pos.marked) : let attribute_to_io (attr : Ast.scope_decl_context_io) : Scopelang.Ast.io =
Scopelang.Ast.visibility = {
match Pos.unmark attr with Scopelang.Ast.io_output = attr.scope_decl_context_io_output;
| Ast.Context -> { visibility_input = true; Scopelang.Ast.visibility_output = true } Scopelang.Ast.io_input =
| Ast.Input -> { visibility_input = true; Scopelang.Ast.visibility_output = false } Pos.map_under_mark
| Ast.Output -> { visibility_input = false; Scopelang.Ast.visibility_output = true } (fun io ->
| Ast.Internal -> { visibility_input = false; Scopelang.Ast.visibility_output = false } match io with
| Ast.Input -> Scopelang.Ast.OnlyInput
| Ast.Internal -> Scopelang.Ast.NoInput
| Ast.Context -> Scopelang.Ast.Reentrant)
attr.scope_decl_context_io_input;
}
(** Main function of this module *) (** Main function of this module *)
let desugar_program (ctxt : Name_resolution.context) (prgm : Ast.program) : Desugared.Ast.program = let desugar_program (ctxt : Name_resolution.context) (prgm : Ast.program) : Desugared.Ast.program =
@ -1111,8 +1116,7 @@ let desugar_program (ctxt : Name_resolution.context) (prgm : Ast.program) : Desu
Desugared.Ast.scope_def_label_groups = Desugared.Ast.scope_def_label_groups =
Name_resolution.label_groups ctxt s_uid def_key; Name_resolution.label_groups ctxt s_uid def_key;
Desugared.Ast.scope_def_is_condition = v_sig.var_sig_is_condition; Desugared.Ast.scope_def_is_condition = v_sig.var_sig_is_condition;
Desugared.Ast.scope_def_visibility = Desugared.Ast.scope_def_io = attribute_to_io v_sig.var_sig_io;
attribute_to_visibility v_sig.var_sig_visibility;
} }
acc) acc)
s_context.Name_resolution.var_idmap Desugared.Ast.ScopeDefMap.empty s_context.Name_resolution.var_idmap Desugared.Ast.ScopeDefMap.empty
@ -1133,8 +1137,7 @@ let desugar_program (ctxt : Name_resolution.context) (prgm : Ast.program) : Desu
Desugared.Ast.scope_def_label_groups = Desugared.Ast.scope_def_label_groups =
Name_resolution.label_groups ctxt subscope_uid def_key; Name_resolution.label_groups ctxt subscope_uid def_key;
Desugared.Ast.scope_def_is_condition = v_sig.var_sig_is_condition; Desugared.Ast.scope_def_is_condition = v_sig.var_sig_is_condition;
Desugared.Ast.scope_def_visibility = Desugared.Ast.scope_def_io = attribute_to_io v_sig.var_sig_io;
attribute_to_visibility v_sig.var_sig_visibility;
} }
acc) acc)
(Scopelang.Ast.ScopeMap.find subscope_uid ctxt.Name_resolution.scopes) (Scopelang.Ast.ScopeMap.find subscope_uid ctxt.Name_resolution.scopes)

9
compiler/surface/name_resolution.ml
View File

@ -51,7 +51,7 @@ type enum_context = typ Pos.marked Scopelang.Ast.EnumConstructorMap.t
type var_sig = { type var_sig = {
var_sig_typ : typ Pos.marked; var_sig_typ : typ Pos.marked;
var_sig_is_condition : bool; var_sig_is_condition : bool;
var_sig_visibility : Ast.scope_decl_context_item_attribute Pos.marked; var_sig_io : Ast.scope_decl_context_io;
} }
type context = { type context = {
@ -98,9 +98,8 @@ let get_var_typ (ctxt : context) (uid : Scopelang.Ast.ScopeVar.t) : typ Pos.mark
let is_var_cond (ctxt : context) (uid : Scopelang.Ast.ScopeVar.t) : bool = let is_var_cond (ctxt : context) (uid : Scopelang.Ast.ScopeVar.t) : bool =
(Scopelang.Ast.ScopeVarMap.find uid ctxt.var_typs).var_sig_is_condition (Scopelang.Ast.ScopeVarMap.find uid ctxt.var_typs).var_sig_is_condition
let get_var_visibility (ctxt : context) (uid : Scopelang.Ast.ScopeVar.t) : let get_var_io (ctxt : context) (uid : Scopelang.Ast.ScopeVar.t) : Ast.scope_decl_context_io =
Ast.scope_decl_context_item_attribute Pos.marked = (Scopelang.Ast.ScopeVarMap.find uid ctxt.var_typs).var_sig_io
(Scopelang.Ast.ScopeVarMap.find uid ctxt.var_typs).var_sig_visibility
(** Get the variable uid inside the scope given in argument *) (** Get the variable uid inside the scope given in argument *)
let get_var_uid (scope_uid : Scopelang.Ast.ScopeName.t) (ctxt : context) let get_var_uid (scope_uid : Scopelang.Ast.ScopeName.t) (ctxt : context)
@ -271,7 +270,7 @@ let process_data_decl (scope : Scopelang.Ast.ScopeName.t) (ctxt : context)
{ {
var_sig_typ = data_typ; var_sig_typ = data_typ;
var_sig_is_condition = is_cond; var_sig_is_condition = is_cond;
var_sig_visibility = decl.scope_decl_context_item_attribute; var_sig_io = decl.scope_decl_context_item_attribute;
} }
ctxt.var_typs; ctxt.var_typs;
} }

5
compiler/surface/name_resolution.mli
View File

@ -51,7 +51,7 @@ type enum_context = typ Pos.marked Scopelang.Ast.EnumConstructorMap.t
type var_sig = { type var_sig = {
var_sig_typ : typ Pos.marked; var_sig_typ : typ Pos.marked;
var_sig_is_condition : bool; var_sig_is_condition : bool;
var_sig_visibility : Ast.scope_decl_context_item_attribute Pos.marked; var_sig_io : Ast.scope_decl_context_io;
} }
type context = { type context = {
@ -90,8 +90,7 @@ val get_var_typ : context -> Scopelang.Ast.ScopeVar.t -> typ Pos.marked
val is_var_cond : context -> Scopelang.Ast.ScopeVar.t -> bool val is_var_cond : context -> Scopelang.Ast.ScopeVar.t -> bool
val get_var_visibility : val get_var_io : context -> Scopelang.Ast.ScopeVar.t -> Ast.scope_decl_context_io
context -> Scopelang.Ast.ScopeVar.t -> Ast.scope_decl_context_item_attribute Pos.marked
val get_var_uid : val get_var_uid :
Scopelang.Ast.ScopeName.t -> context -> ident Pos.marked -> Scopelang.Ast.ScopeVar.t Scopelang.Ast.ScopeName.t -> context -> ident Pos.marked -> Scopelang.Ast.ScopeVar.t

79
compiler/surface/parser.messages
View File

@ -1,6 +1,6 @@
source_file: BEGIN_CODE DECLARATION ENUM CONSTRUCTOR COLON ALT CONSTRUCTOR CONTENT TEXT YEAR source_file: BEGIN_CODE DECLARATION ENUM CONSTRUCTOR COLON ALT CONSTRUCTOR CONTENT TEXT YEAR
## ##
## Ends in an error in state: 345. ## Ends in an error in state: 348.
## ##
## nonempty_list(enum_decl_line) -> enum_decl_line . [ SCOPE END_CODE DECLARATION ] ## nonempty_list(enum_decl_line) -> enum_decl_line . [ SCOPE END_CODE DECLARATION ]
## nonempty_list(enum_decl_line) -> enum_decl_line . nonempty_list(enum_decl_line) [ SCOPE END_CODE DECLARATION ] ## nonempty_list(enum_decl_line) -> enum_decl_line . nonempty_list(enum_decl_line) [ SCOPE END_CODE DECLARATION ]
@ -13,7 +13,7 @@ expected another enum case, or a new declaration or scope use
source_file: BEGIN_CODE DECLARATION ENUM CONSTRUCTOR COLON ALT CONSTRUCTOR CONTENT YEAR source_file: BEGIN_CODE DECLARATION ENUM CONSTRUCTOR COLON ALT CONSTRUCTOR CONTENT YEAR
## ##
## Ends in an error in state: 340. ## Ends in an error in state: 343.
## ##
## enum_decl_line_payload -> CONTENT . typ [ SCOPE END_CODE DECLARATION ALT ] ## enum_decl_line_payload -> CONTENT . typ [ SCOPE END_CODE DECLARATION ALT ]
## ##
@ -25,7 +25,7 @@ expected a content type
source_file: BEGIN_CODE DECLARATION ENUM CONSTRUCTOR COLON ALT CONSTRUCTOR YEAR source_file: BEGIN_CODE DECLARATION ENUM CONSTRUCTOR COLON ALT CONSTRUCTOR YEAR
## ##
## Ends in an error in state: 339. ## Ends in an error in state: 342.
## ##
## enum_decl_line -> ALT constructor . option(enum_decl_line_payload) [ SCOPE END_CODE DECLARATION ALT ] ## enum_decl_line -> ALT constructor . option(enum_decl_line_payload) [ SCOPE END_CODE DECLARATION ALT ]
## ##
@ -37,7 +37,7 @@ expected a payload for your enum case, or another case or declaration
source_file: BEGIN_CODE DECLARATION ENUM CONSTRUCTOR COLON ALT YEAR source_file: BEGIN_CODE DECLARATION ENUM CONSTRUCTOR COLON ALT YEAR
## ##
## Ends in an error in state: 338. ## Ends in an error in state: 341.
## ##
## enum_decl_line -> ALT . constructor option(enum_decl_line_payload) [ SCOPE END_CODE DECLARATION ALT ] ## enum_decl_line -> ALT . constructor option(enum_decl_line_payload) [ SCOPE END_CODE DECLARATION ALT ]
## ##
@ -49,7 +49,7 @@ expected the name of an enum case
source_file: BEGIN_CODE DECLARATION ENUM CONSTRUCTOR COLON YEAR source_file: BEGIN_CODE DECLARATION ENUM CONSTRUCTOR COLON YEAR
## ##
## Ends in an error in state: 337. ## Ends in an error in state: 340.
## ##
## code_item -> DECLARATION ENUM constructor COLON . nonempty_list(enum_decl_line) [ SCOPE END_CODE DECLARATION ] ## code_item -> DECLARATION ENUM constructor COLON . nonempty_list(enum_decl_line) [ SCOPE END_CODE DECLARATION ]
## ##
@ -61,7 +61,7 @@ expected an enum case
source_file: BEGIN_CODE DECLARATION ENUM CONSTRUCTOR YEAR source_file: BEGIN_CODE DECLARATION ENUM CONSTRUCTOR YEAR
## ##
## Ends in an error in state: 336. ## Ends in an error in state: 339.
## ##
## code_item -> DECLARATION ENUM constructor . COLON nonempty_list(enum_decl_line) [ SCOPE END_CODE DECLARATION ] ## code_item -> DECLARATION ENUM constructor . COLON nonempty_list(enum_decl_line) [ SCOPE END_CODE DECLARATION ]
## ##
@ -73,7 +73,7 @@ expected a colon
source_file: BEGIN_CODE DECLARATION ENUM YEAR source_file: BEGIN_CODE DECLARATION ENUM YEAR
## ##
## Ends in an error in state: 335. ## Ends in an error in state: 338.
## ##
## code_item -> DECLARATION ENUM . constructor COLON nonempty_list(enum_decl_line) [ SCOPE END_CODE DECLARATION ] ## code_item -> DECLARATION ENUM . constructor COLON nonempty_list(enum_decl_line) [ SCOPE END_CODE DECLARATION ]
## ##
@ -83,71 +83,12 @@ source_file: BEGIN_CODE DECLARATION ENUM YEAR
expected the name of your enum expected the name of your enum
source_file: BEGIN_CODE DECLARATION SCOPE CONSTRUCTOR COLON CONTEXT IDENT CONDITION YEAR
##
## Ends in an error in state: 330.
##
## scope_decl_item -> scope_decl_item_attribute ident CONDITION . option(struct_scope_func) [ SCOPE OUTPUT INTERNAL INPUT END_CODE DECLARATION CONTEXT ]
##
## The known suffix of the stack is as follows:
## scope_decl_item_attribute ident CONDITION
##
expected the next context item or a dependency declaration for this item
source_file: BEGIN_CODE DECLARATION SCOPE CONSTRUCTOR COLON CONTEXT IDENT CONTENT TEXT YEAR
##
## Ends in an error in state: 328.
##
## scope_decl_item -> scope_decl_item_attribute ident CONTENT typ . option(struct_scope_func) [ SCOPE OUTPUT INTERNAL INPUT END_CODE DECLARATION CONTEXT ]
##
## The known suffix of the stack is as follows:
## scope_decl_item_attribute ident CONTENT typ
##
expected the next context item or a dependency declaration for this item
source_file: BEGIN_CODE DECLARATION SCOPE CONSTRUCTOR COLON CONTEXT IDENT CONTENT YEAR
##
## Ends in an error in state: 327.
##
## scope_decl_item -> scope_decl_item_attribute ident CONTENT . typ option(struct_scope_func) [ SCOPE OUTPUT INTERNAL INPUT END_CODE DECLARATION CONTEXT ]
##
## The known suffix of the stack is as follows:
## scope_decl_item_attribute ident CONTENT
##
expected the type of this context item
source_file: BEGIN_CODE DECLARATION SCOPE CONSTRUCTOR COLON CONTEXT IDENT YEAR
##
## Ends in an error in state: 324.
##
## scope_decl_item -> scope_decl_item_attribute ident . CONTENT typ option(struct_scope_func) [ SCOPE OUTPUT INTERNAL INPUT END_CODE DECLARATION CONTEXT ]
## scope_decl_item -> scope_decl_item_attribute ident . SCOPE constructor [ SCOPE OUTPUT INTERNAL INPUT END_CODE DECLARATION CONTEXT ]
## scope_decl_item -> scope_decl_item_attribute ident . CONDITION option(struct_scope_func) [ SCOPE OUTPUT INTERNAL INPUT END_CODE DECLARATION CONTEXT ]
##
## The known suffix of the stack is as follows:
## scope_decl_item_attribute ident
##
expected the kind of this context item: is it a condition, a sub-scope or a data?
source_file: BEGIN_CODE DECLARATION SCOPE CONSTRUCTOR COLON CONTEXT YEAR
##
## Ends in an error in state: 323.
##
## scope_decl_item -> scope_decl_item_attribute . ident CONTENT typ option(struct_scope_func) [ SCOPE OUTPUT INTERNAL INPUT END_CODE DECLARATION CONTEXT ]
## scope_decl_item -> scope_decl_item_attribute . ident SCOPE constructor [ SCOPE OUTPUT INTERNAL INPUT END_CODE DECLARATION CONTEXT ]
## scope_decl_item -> scope_decl_item_attribute . ident CONDITION option(struct_scope_func) [ SCOPE OUTPUT INTERNAL INPUT END_CODE DECLARATION CONTEXT ]
##
## The known suffix of the stack is as follows:
## scope_decl_item_attribute
##
expected the name of this new context item
source_file: BEGIN_CODE DECLARATION SCOPE CONSTRUCTOR COLON YEAR source_file: BEGIN_CODE DECLARATION SCOPE CONSTRUCTOR COLON YEAR
## ##
@ -189,7 +130,7 @@ source_file: BEGIN_CODE DECLARATION STRUCT CONSTRUCTOR COLON CONDITION IDENT DEP
## ##
## Ends in an error in state: 303. ## Ends in an error in state: 303.
## ##
## typ -> collection_marked . typ [ SCOPE OUTPUT INTERNAL INPUT END_CODE DEPENDS DECLARATION DATA CONTEXT CONDITION ALT ] ## typ -> collection_marked . typ [ SCOPE INTERNAL INPUT END_CODE DEPENDS DECLARATION DATA CONTEXT CONDITION ALT ]
## ##
## The known suffix of the stack is as follows: ## The known suffix of the stack is as follows:
## collection_marked ## collection_marked
@ -213,7 +154,7 @@ source_file: BEGIN_CODE DECLARATION STRUCT CONSTRUCTOR COLON CONDITION IDENT DEP
## ##
## Ends in an error in state: 307. ## Ends in an error in state: 307.
## ##
## struct_scope_func -> DEPENDS . typ [ SCOPE OUTPUT INTERNAL INPUT END_CODE DECLARATION DATA CONTEXT CONDITION ] ## struct_scope_func -> DEPENDS . typ [ SCOPE INTERNAL INPUT END_CODE DECLARATION DATA CONTEXT CONDITION ]
## ##
## The known suffix of the stack is as follows: ## The known suffix of the stack is as follows:
## DEPENDS ## DEPENDS
@ -1926,7 +1867,7 @@ expected the name of the scope being used
source_file: BEGIN_CODE YEAR source_file: BEGIN_CODE YEAR
## ##
## Ends in an error in state: 363. ## Ends in an error in state: 366.
## ##
## source_file_item -> BEGIN_CODE . code END_CODE [ LAW_TEXT LAW_HEADING EOF BEGIN_METADATA BEGIN_DIRECTIVE BEGIN_CODE ] ## source_file_item -> BEGIN_CODE . code END_CODE [ LAW_TEXT LAW_HEADING EOF BEGIN_METADATA BEGIN_DIRECTIVE BEGIN_CODE ]
## ##

25
compiler/surface/parser.mly
View File

@ -495,12 +495,24 @@ struct_scope:
}, Pos.from_lpos $sloc) }, Pos.from_lpos $sloc)
} }
scope_decl_item_attribute: scope_decl_item_attribute_input:
| CONTEXT { Context, Pos.from_lpos $sloc } | CONTEXT { Context, Pos.from_lpos $sloc }
| INPUT { Input, Pos.from_lpos $sloc } | INPUT { Input, Pos.from_lpos $sloc }
| OUTPUT { Output, Pos.from_lpos $sloc }
| INTERNAL { Internal, Pos.from_lpos $sloc } | INTERNAL { Internal, Pos.from_lpos $sloc }
scope_decl_item_attribute_output:
| OUTPUT { true, Pos.from_lpos $sloc }
| { false, Pos.from_lpos $sloc }
scope_decl_item_attribute:
| input = scope_decl_item_attribute_input
output = scope_decl_item_attribute_output {
{
scope_decl_context_io_input = input;
scope_decl_context_io_output = output
}
}
scope_decl_item: scope_decl_item:
| attr = scope_decl_item_attribute i = ident CONTENT t = typ func_typ = option(struct_scope_func) { (ContextData ({ | attr = scope_decl_item_attribute i = ident CONTENT t = typ func_typ = option(struct_scope_func) { (ContextData ({
scope_decl_context_item_name = i; scope_decl_context_item_name = i;
@ -515,14 +527,17 @@ scope_decl_item:
}, Pos.from_lpos $sloc); }, Pos.from_lpos $sloc);
}), Pos.from_lpos $sloc) }), Pos.from_lpos $sloc)
} }
| attr = scope_decl_item_attribute i = ident SCOPE c = constructor { | INTERNAL i = ident SCOPE c = constructor {
(ContextScope({ (ContextScope({
scope_decl_context_scope_name = i; scope_decl_context_scope_name = i;
scope_decl_context_scope_sub_scope = c; scope_decl_context_scope_sub_scope = c;
scope_decl_context_scope_attribute = attr; 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);
};
}), Pos.from_lpos $sloc) }), Pos.from_lpos $sloc)
} }
| attr = scope_decl_item_attribute i = ident _condition = CONDITION func_typ = option(struct_scope_func) { | attr = scope_decl_item_attribute i = ident _condition = CONDITION func_typ = option(struct_scope_func) {
(ContextData ({ (ContextData ({
scope_decl_context_item_name = i; scope_decl_context_item_name = i;
scope_decl_context_item_attribute = attr; scope_decl_context_item_attribute = attr;