diff options
| author | Marcos Magueta <maguetamarcos@gmail.com> | 2026-06-23 23:53:26 -0300 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2026-06-23 23:53:26 -0300 |
| commit | c284fcd570342c31bc21169960579a20a763e32e (patch) | |
| tree | ce7485055116d794c55090ad0978e0b3f5ff4c2a /lib/icl | |
| parent | b81586ee4a0543a5f9866586c78dccdd6328934a (diff) | |
| download | Sakura-c284fcd570342c31bc21169960579a20a763e32e.tar.gz Sakura-c284fcd570342c31bc21169960579a20a763e32e.zip | |
Format
Diffstat (limited to 'lib/icl')
| -rw-r--r-- | lib/icl/ast.ml | 18 | ||||
| -rw-r--r-- | lib/icl/executor.ml | 36 | ||||
| -rw-r--r-- | lib/icl/parser.ml | 1 | ||||
| -rw-r--r-- | lib/icl/sublanguage.ml | 1 |
4 files changed, 23 insertions, 33 deletions
diff --git a/lib/icl/ast.ml b/lib/icl/ast.ml index 30b0fa7..1a5b096 100644 --- a/lib/icl/ast.ml +++ b/lib/icl/ast.ml @@ -1,23 +1,17 @@ open Sexplib.Std -type binding_expr = - | Var of string - | Const of Drl.Ast.value (** reuse DRL value for literals *) +type binding_expr = Var of string | Const of Drl.Ast.value (** reuse DRL value for literals *) [@@deriving sexp] type constraint_body = - | MemberOf of { target : string; binding : (string * binding_expr) list } - | Not of { body : constraint_body; universe : string } + | MemberOf of {target: string; binding: (string * binding_expr) list} + | Not of {body: constraint_body; universe: string} | And of constraint_body list | Or of constraint_body list - | Exists of { variable : string; quantifier : string; body : constraint_body } - | Forall of { variable : string; quantifier : string; body : constraint_body } + | Exists of {variable: string; quantifier: string; body: constraint_body} + | Forall of {variable: string; quantifier: string; body: constraint_body} [@@deriving sexp] type statement = - | RegisterConstraint of { - constraint_name : string; - relation_name : string; - body : constraint_body; - } + | RegisterConstraint of {constraint_name: string; relation_name: string; body: constraint_body} [@@deriving sexp] diff --git a/lib/icl/executor.ml b/lib/icl/executor.ml index 084fb71..dd0a1d9 100644 --- a/lib/icl/executor.ml +++ b/lib/icl/executor.ml @@ -1,13 +1,13 @@ module Make (NT : Nt.S) = struct module Error = struct open Condition - let multigroup_not_found name = condition "multigroup-not-found" "Multigroup not found" ("name" |=| (of_string name)) + + let multigroup_not_found name = + condition "multigroup-not-found" "Multigroup not found" ("name" |=| of_string name) end let ( let* ) = Result.bind - - let parse_fqn (s : string) : (Qualified_name.t, Condition.t) result = - Qualified_name.try_parse s + let parse_fqn (s : string) : (Qualified_name.t, Condition.t) result = Qualified_name.try_parse s let lookup_mg (ctx : Sublanguage_context.t) (mg_name : string) : (Management.Multigroup.multigroup, Condition.t) result = @@ -15,43 +15,39 @@ module Make (NT : Nt.S) = struct | Some mg -> Ok mg | None -> Error (Error.multigroup_not_found mg_name) - let convert_binding_expr : Ast.binding_expr -> Constraint.binding_expr = - function + let convert_binding_expr : Ast.binding_expr -> Constraint.binding_expr = function | Ast.Var name -> Constraint.Var name | Ast.Const value -> Constraint.Const (Drl.Ast.value_to_abstract value) - let convert_binding (pairs : (string * Ast.binding_expr) list) : - Constraint.binding = + let convert_binding (pairs : (string * Ast.binding_expr) list) : Constraint.binding = List.fold_left - (fun acc (key, expr) -> - Constraint.BindingMap.add key (convert_binding_expr expr) acc) + (fun acc (key, expr) -> Constraint.BindingMap.add key (convert_binding_expr expr) acc) Constraint.BindingMap.empty pairs let rec convert_body : Ast.constraint_body -> Constraint.t = function - | Ast.MemberOf { target; binding } -> + | Ast.MemberOf {target; binding} -> Constraint.member_of ~target ~binding:(convert_binding binding) - | Ast.Not { body; universe } -> - Constraint.not_ ~universe (convert_body body) + | Ast.Not {body; universe} -> Constraint.not_ ~universe (convert_body body) | Ast.And bodies -> Constraint.and_ (List.map convert_body bodies) | Ast.Or bodies -> Constraint.or_ (List.map convert_body bodies) - | Ast.Exists { variable; quantifier; body } -> + | Ast.Exists {variable; quantifier; body} -> Constraint.exists ~variable ~quantifier (convert_body body) - | Ast.Forall { variable; quantifier; body } -> + | Ast.Forall {variable; quantifier; body} -> Constraint.forall ~variable ~quantifier (convert_body body) let execute (ctx : Sublanguage_context.t) (stmt : Ast.statement) : (Sublanguage_types.transition_delta * string, Condition.t) result = match stmt with - | Ast.RegisterConstraint { constraint_name; relation_name; body } -> + | Ast.RegisterConstraint {constraint_name; relation_name; body} -> let* fqn = parse_fqn relation_name in - let* mg = lookup_mg ctx fqn.mg in + let* mg = lookup_mg ctx fqn.mg in let runtime_body = convert_body body in let* _bh, new_mg = - NT.register_constraint ctx.write_handle mg - ~constraint_name ~relation_name:fqn.name ~body:runtime_body + NT.register_constraint ctx.write_handle mg ~constraint_name ~relation_name:fqn.name + ~body:runtime_body in ctx.branch#set_mg ~name:fqn.mg new_mg; - Ok ([ (fqn.mg, new_mg) ], "Constraint registered: " ^ constraint_name) + Ok ([fqn.mg, new_mg], "Constraint registered: " ^ constraint_name) end module Memory = Make (Nt.Memory) diff --git a/lib/icl/parser.ml b/lib/icl/parser.ml index a4df914..094b0fd 100644 --- a/lib/icl/parser.ml +++ b/lib/icl/parser.ml @@ -1,5 +1,6 @@ module Error = struct open Condition + let parse_error msg = condition "parse-error" msg empty end diff --git a/lib/icl/sublanguage.ml b/lib/icl/sublanguage.ml index 19f15ce..c68077d 100644 --- a/lib/icl/sublanguage.ml +++ b/lib/icl/sublanguage.ml @@ -6,7 +6,6 @@ module Make (NT : Nt.S) = struct let name = "icl" let parse _ = Ok () - let parse_sexp sexp = Parser.of_sexp sexp let execute ctx ast = |
