diff --git a/src/catala/catala_surface/ast.ml b/src/catala/catala_surface/ast.ml index 425d7e39..74d2e97d 100644 --- a/src/catala/catala_surface/ast.ml +++ b/src/catala/catala_surface/ast.ml @@ -17,8 +17,10 @@ module Pos = Utils.Pos type constructor = string +(** Constructors are CamlCase *) type ident = string +(** Idents are snake_case *) type qident = ident Pos.marked list @@ -65,7 +67,12 @@ type enum_decl = { type match_case_pattern = constructor Pos.marked list * ident Pos.marked option -type op_kind = KInt | KDec | KMoney | KDate | KDuration +type op_kind = + | KInt (** No suffix *) + | KDec (** Suffix: [.] *) + | KMoney (** Suffix: [$] *) + | KDate (** Suffix: [@] *) + | KDuration (** Suffix: [^] *) type binop = | And @@ -131,8 +138,7 @@ and expression = | StructLit of constructor Pos.marked * (ident Pos.marked * expression Pos.marked) list | Ident of ident | Dotted of expression Pos.marked * ident Pos.marked - -(* Dotted is for both struct field projection and sub-scope variables *) + (** Dotted is for both struct field projection and sub-scope variables *) type rule = { rule_parameter : ident Pos.marked option; diff --git a/src/catala/catala_surface/surface.mld b/src/catala/catala_surface/surface.mld index fca041ae..394f656e 100644 --- a/src/catala/catala_surface/surface.mld +++ b/src/catala/catala_surface/surface.mld @@ -65,7 +65,8 @@ Relevant modules: {!modules: Surface.Name_resolution Surface.Desugaring} The desugaring consists of translating {!module: Surface.Ast} to -{!module: Desugared.Ast}. The translation is implemented in +{!module: Desugared.Ast} of the {{: desugared.html} desugared representation}. +The translation is implemented in {!module: Surface.Desugaring}, but it relies on a helper module to perform the name resolution: {!module: Surface.Name_resolution}. Indeed, in {!module: Surface.Ast}, the variables identifiers are just [string], whereas in diff --git a/src/catala/desugared/ast.ml b/src/catala/desugared/ast.ml index ba50e072..2941b0dc 100644 --- a/src/catala/desugared/ast.ml +++ b/src/catala/desugared/ast.ml @@ -12,13 +12,18 @@ or implied. See the License for the specific language governing permissions and limitations under the License. *) +(** Abstract syntax tree of the desugared representation *) + module Pos = Utils.Pos module Uid = Utils.Uid -module IdentMap = Map.Make (String) -module RuleName = Uid.Make (Uid.MarkedString) () +(** {1 Names, Maps and Keys} *) -module RuleMap = Map.Make (RuleName) +module IdentMap : Map.S with type key = String.t = Map.Make (String) + +module RuleName : Uid.Id with type info = Uid.MarkedString.info = Uid.Make (Uid.MarkedString) () + +module RuleMap : Map.S with type key = RuleName.t = Map.Make (RuleName) (** Inside a scope, a definition can refer either to a scope def, or a subscope def *) module ScopeDef = struct @@ -47,10 +52,11 @@ module ScopeDef = struct | SubScopeVar (_, v) -> Scopelang.Ast.ScopeVar.hash v end -module ScopeDefMap = Map.Make (ScopeDef) -module ScopeDefSet = Set.Make (ScopeDef) +module ScopeDefMap : Map.S with type key = ScopeDef.t = Map.Make (ScopeDef) -(* Scopes *) +module ScopeDefSet : Set.S with type elt = ScopeDef.t = Set.Make (ScopeDef) + +(** {1 AST} *) type rule = { just : Scopelang.Ast.expr Pos.marked Bindlib.box; @@ -95,6 +101,8 @@ type program = { program_structs : Scopelang.Ast.struct_ctx; } +(** {1 Helpers} *) + let free_variables (def : rule RuleMap.t) : Pos.t ScopeDefMap.t = let add_locs (acc : Pos.t ScopeDefMap.t) (locs : Scopelang.Ast.LocationSet.t) : Pos.t ScopeDefMap.t = diff --git a/src/catala/desugared/dependency.ml b/src/catala/desugared/dependency.ml index 7c5eea1b..b1295594 100644 --- a/src/catala/desugared/dependency.ml +++ b/src/catala/desugared/dependency.ml @@ -12,18 +12,21 @@ or implied. See the License for the specific language governing permissions and limitations under the License. *) +(** Scope dependencies computations using {{:http://ocamlgraph.lri.fr/} OCamlgraph} *) + module Pos = Utils.Pos module Errors = Utils.Errors -(** The vertices of the scope dependency graph are either : +(** {1 Graph declaration} *) + +(** Vertices: scope variables or subscopes. + + The vertices of the scope dependency graph are either : - the variables of the scope ; - the subscopes of the scope. - Indeed, during interpretation, subscopes are executed atomically. - - In the graph, x -> y if x is used in the definition of y. *) - + Indeed, during interpretation, subscopes are executed atomically. *) module Vertex = struct type t = Var of Scopelang.Ast.ScopeVar.t | SubScope of Scopelang.Ast.SubScopeName.t @@ -46,7 +49,8 @@ module Vertex = struct | SubScope v -> Scopelang.Ast.SubScopeName.format_t fmt v end -(** On the edges, the label is the expression responsible for the use of the variable *) +(** On the edges, the label is the position of the expression responsible for the use of the + variable. In the graph, [x -> y] if [x] is used in the definition of [y].*) module Edge = struct type t = Pos.t @@ -56,11 +60,18 @@ module Edge = struct end module ScopeDependencies = Graph.Persistent.Digraph.ConcreteBidirectionalLabeled (Vertex) (Edge) +(** Module of the graph, provided by OCamlGraph *) + module TopologicalTraversal = Graph.Topological.Make (ScopeDependencies) +(** Module of the topological traversal of the graph, provided by OCamlGraph *) module SCC = Graph.Components.Make (ScopeDependencies) (** Tarjan's stongly connected components algorithm, provided by OCamlGraph *) +(** {1 Graph computations} *) + +(** Returns an ordering of the scope variables and subscope compatible with the dependencies of the + computation *) let correct_computation_ordering (g : ScopeDependencies.t) : Vertex.t list = List.rev (TopologicalTraversal.fold (fun sd acc -> sd :: acc) g []) @@ -99,6 +110,7 @@ let check_for_cycle (scope : Ast.scope) (g : ScopeDependencies.t) : unit = ]) scc)) +(** Builds the dependency graph of a particular scope *) let build_scope_dependencies (scope : Ast.scope) : ScopeDependencies.t = let g = ScopeDependencies.empty in (* Add all the vertices to the graph *) diff --git a/src/catala/desugared/desugared.mld b/src/catala/desugared/desugared.mld index e18187a2..c5d617b7 100644 --- a/src/catala/desugared/desugared.mld +++ b/src/catala/desugared/desugared.mld @@ -1 +1,30 @@ -{0 Desugared representation } \ No newline at end of file +{0 Desugared representation } + +This representation is the second in the compilation chain +(see {{: index.html#architecture} Architecture}). Its main difference +with {{: surface.html} the surface representation} is that the legislative +text has been discarded and all the definitions of each variables have been +collected in the same place rather than being scattered across the code base. + +The module describing the abstract syntax tree is: + +{!modules: Desugared.Ast} + +{1 Translation to the scope language} + +Related modules: + +{!modules: Desugared.Dependency Desugared.Desugared_to_scope} + +Before the translation to the {{: scopelang.html} scope language}, +{!module: Desugared.Dependency} checks that within +a scope, there is no computational circular dependency between the variables +of the scope. When the dependency graph is a DAG, +{!module: Desugared.Desugared_to_scope} performs a topological ordering to +produce an ordered list of the scope definitions compatible with the +computation order. All the graph computations are done using the +{{:http://ocamlgraph.lri.fr/} Ocamlgraph} library. + +The other important piece of work performed by +{!module: Desugared.Desugared_to_scope} is the construction of the default trees +(see {!constructor: Dcalc.Ast.EDefault}) from the list of prioritized rules. \ No newline at end of file diff --git a/src/catala/desugared/desugared_to_scope.ml b/src/catala/desugared/desugared_to_scope.ml index 970ac996..60e16ebb 100644 --- a/src/catala/desugared/desugared_to_scope.ml +++ b/src/catala/desugared/desugared_to_scope.ml @@ -12,14 +12,22 @@ or implied. See the License for the specific language governing permissions and limitations under the License. *) +(** Translation from {!module: Desugared.Ast} to {!module: Scopelang.Ast} *) + module Pos = Utils.Pos module Errors = Utils.Errors module Cli = Utils.Cli +(** {1 Rule tree construction} *) + type rule_tree = Leaf of Ast.rule | Node of Ast.rule * rule_tree list -(* invariant: one rule in def does not have any parent rule *) -(* invariant: there are no dandling pointer parents in the rules *) +(** Transforms a flat list of rules into a tree, taking into account the priorities declared between + rules + + {e Invariant:} only one rule does not have any parent rule + + {e Invariant:} there are no dandling pointer parents in the rules *) let rec def_map_to_tree (def : Ast.rule Ast.RuleMap.t) : rule_tree = (* first we look to the only rule that does not have any parent *) let has_no_parent _ (r : Ast.rule) = Option.is_none r.Ast.parent_rule in @@ -47,6 +55,9 @@ let rec def_map_to_tree (def : Ast.rule Ast.RuleMap.t) : rule_tree = in Node (no_parent, tree_children) +(** From the {!type: rule_tree}, builds an {!constructor: Dcalc.Ast.EDefault} expression in the + scope language. The [~toplevel] parameter is used to know when to place the toplevel binding in + the case of functions. *) let rec rule_tree_to_expr ~(toplevel : bool) (is_func : Scopelang.Ast.Var.t option) (tree : rule_tree) : Scopelang.Ast.expr Pos.marked Bindlib.box = let rule, children = match tree with Leaf r -> (r, []) | Node (r, child) -> (r, child) in @@ -79,10 +90,12 @@ let rec rule_tree_to_expr ~(toplevel : bool) (is_func : Scopelang.Ast.Var.t opti if toplevel then Scopelang.Ast.make_abs (Array.of_list [ new_param ]) default Pos.no_pos [ typ ] Pos.no_pos else default - | _ -> assert false + | _ -> (* should not happen *) assert false -(* should not happen *) +(** {1 AST translation} *) +(** Translates a definition inside a scope, the resulting expression should be an {!constructor: + Dcalc.Ast.EDefault} *) let translate_def (def_info : Ast.ScopeDef.t) (def : Ast.rule Ast.RuleMap.t) (typ : Scopelang.Ast.typ Pos.marked) : Scopelang.Ast.expr Pos.marked = (* Here, we have to transform this list of rules into a default tree. *) @@ -132,6 +145,7 @@ let translate_def (def_info : Ast.ScopeDef.t) (def : Ast.rule Ast.RuleMap.t) (Option.map (fun _ -> Scopelang.Ast.Var.make ("ρ", Pos.no_pos)) is_def_func) def_tree) +(** Translates a scope *) let translate_scope (scope : Ast.scope) : Scopelang.Ast.scope_decl = let scope_dependencies = Dependency.build_scope_dependencies scope in Dependency.check_for_cycle scope scope_dependencies; @@ -213,6 +227,8 @@ let translate_scope (scope : Ast.scope) : Scopelang.Ast.scope_decl = Scopelang.Ast.scope_sig; } +(** {1 API} *) + let translate_program (pgrm : Ast.program) : Scopelang.Ast.program = { Scopelang.Ast.program_scopes = Scopelang.Ast.ScopeMap.map translate_scope pgrm.program_scopes; diff --git a/src/catala/scope_language/ast.ml b/src/catala/scope_language/ast.ml index 90ffafc9..b219f074 100644 --- a/src/catala/scope_language/ast.ml +++ b/src/catala/scope_language/ast.ml @@ -12,45 +12,54 @@ or implied. See the License for the specific language governing permissions and limitations under the License. *) +(** Abstract syntax tree of the scope language *) + module Pos = Utils.Pos module Uid = Utils.Uid -module ScopeName = Uid.Make (Uid.MarkedString) () +(** {1 Identifiers} *) -module ScopeNameSet = Set.Make (ScopeName) -module ScopeMap = Map.Make (ScopeName) +module ScopeName : Uid.Id with type info = Uid.MarkedString.info = Uid.Make (Uid.MarkedString) () -module SubScopeName = Uid.Make (Uid.MarkedString) () +module ScopeNameSet : Set.S with type elt = ScopeName.t = Set.Make (ScopeName) -module SubScopeNameSet = Set.Make (SubScopeName) -module SubScopeMap = Map.Make (SubScopeName) +module ScopeMap : Map.S with type key = ScopeName.t = Map.Make (ScopeName) -module ScopeVar = Uid.Make (Uid.MarkedString) () +module SubScopeName : Uid.Id with type info = Uid.MarkedString.info = Uid.Make (Uid.MarkedString) () -module ScopeVarSet = Set.Make (ScopeVar) -module ScopeVarMap = Map.Make (ScopeVar) +module SubScopeNameSet : Set.S with type elt = SubScopeName.t = Set.Make (SubScopeName) -module StructName = Uid.Make (Uid.MarkedString) () +module SubScopeMap : Map.S with type key = SubScopeName.t = Map.Make (SubScopeName) -module StructMap = Map.Make (StructName) +module ScopeVar : Uid.Id with type info = Uid.MarkedString.info = Uid.Make (Uid.MarkedString) () -module StructFieldName = Uid.Make (Uid.MarkedString) () +module ScopeVarSet : Set.S with type elt = ScopeVar.t = Set.Make (ScopeVar) -module StructFieldMap = Map.Make (StructFieldName) +module ScopeVarMap : Map.S with type key = ScopeVar.t = Map.Make (ScopeVar) -module EnumName = Uid.Make (Uid.MarkedString) () +module StructName : Uid.Id with type info = Uid.MarkedString.info = Uid.Make (Uid.MarkedString) () -module EnumMap = Map.Make (EnumName) +module StructMap : Map.S with type key = StructName.t = Map.Make (StructName) -module EnumConstructor = Uid.Make (Uid.MarkedString) () +module StructFieldName : Uid.Id with type info = Uid.MarkedString.info = + Uid.Make (Uid.MarkedString) () -module EnumConstructorMap = Map.Make (EnumConstructor) +module StructFieldMap : Map.S with type key = StructFieldName.t = Map.Make (StructFieldName) + +module EnumName : Uid.Id with type info = Uid.MarkedString.info = Uid.Make (Uid.MarkedString) () + +module EnumMap : Map.S with type key = EnumName.t = Map.Make (EnumName) + +module EnumConstructor : Uid.Id with type info = Uid.MarkedString.info = + Uid.Make (Uid.MarkedString) () + +module EnumConstructorMap : Map.S with type key = EnumConstructor.t = Map.Make (EnumConstructor) type location = | ScopeVar of ScopeVar.t Pos.marked | SubScopeVar of ScopeName.t * SubScopeName.t Pos.marked * ScopeVar.t Pos.marked -module LocationSet = Set.Make (struct +module LocationSet : Set.S with type elt = location Pos.marked = Set.Make (struct type t = location Pos.marked let compare x y = @@ -64,6 +73,8 @@ module LocationSet = Set.Make (struct | SubScopeVar _, ScopeVar _ -> 1 end) +(** {1 Abstract syntax tree} *) + type typ = | TLit of Dcalc.Ast.typ_lit | TStruct of StructName.t @@ -114,6 +125,29 @@ let rec locations_used (e : expr Pos.marked) : LocationSet.t = (LocationSet.union (locations_used just) (locations_used cons)) subs +type rule = + | Definition of location Pos.marked * typ Pos.marked * expr Pos.marked + | Assertion of expr Pos.marked + | Call of ScopeName.t * SubScopeName.t + +type scope_decl = { + scope_decl_name : ScopeName.t; + scope_sig : typ Pos.marked ScopeVarMap.t; + scope_decl_rules : rule list; +} + +type struct_ctx = (StructFieldName.t * typ Pos.marked) list StructMap.t + +type enum_ctx = (EnumConstructor.t * typ Pos.marked) list EnumMap.t + +type program = { + program_scopes : scope_decl ScopeMap.t; + program_enums : enum_ctx; + program_structs : struct_ctx; +} + +(** {1 Variable helpers} *) + module Var = struct type t = expr Bindlib.var @@ -139,24 +173,3 @@ let make_app (e : expr Pos.marked Bindlib.box) (u : expr Pos.marked Bindlib.box Bindlib.box_apply2 (fun e u -> (EApp (e, u), pos)) e (Bindlib.box_list u) module VarMap = Map.Make (Var) - -type rule = - | Definition of location Pos.marked * typ Pos.marked * expr Pos.marked - | Assertion of expr Pos.marked - | Call of ScopeName.t * SubScopeName.t - -type scope_decl = { - scope_decl_name : ScopeName.t; - scope_sig : typ Pos.marked ScopeVarMap.t; - scope_decl_rules : rule list; -} - -type struct_ctx = (StructFieldName.t * typ Pos.marked) list StructMap.t - -type enum_ctx = (EnumConstructor.t * typ Pos.marked) list EnumMap.t - -type program = { - program_scopes : scope_decl ScopeMap.t; - program_enums : enum_ctx; - program_structs : struct_ctx; -} diff --git a/src/catala/scope_language/scopelang.mld b/src/catala/scope_language/scopelang.mld index 71f5c721..addaf813 100644 --- a/src/catala/scope_language/scopelang.mld +++ b/src/catala/scope_language/scopelang.mld @@ -1 +1,34 @@ -{0 The scope language } \ No newline at end of file +{0 The scope language } + +This representation is the second in the compilation chain +(see {{: index.html#architecture} Architecture}). Its main difference +with the previous {{: desugared.html} desugared representation} is that inside +a scope, the definitions are ordered according to their computational +dependency order, and each definition is a {!constructor: Dcalc.Ast.EDefault} tree +instead of a flat list of rules. + +The module describing the abstract syntax tree is: + +{!modules: Scopelang.Ast} + +Printing helpers can be found in {!module: Scopelang.Print}. + +{1 Translation to the default calculus} + +Related modules: + +{!modules: Scopelang.Dependency Scopelang.Scope_to_dcalc} + +The translation from the scope language to the +{{: dcalc.html} default calculus} involves three big features: + +{ol +{li Translating structures and enums into simpler sum and product types} +{li Build thunked signatures for the scopes as functions } +{li Transform the list of scopes into a program} +} + +1 and 3 involve computing dependency graphs for respectively the structs and +enums on one hand, and the inter-scope dependencies on the other hand. Both +can be found in {!module: Scopelang.Dependency}, while +{!module: Scopelang.Scope_to_dcalc} is mostly responsible for 2. \ No newline at end of file