From c5bc3a4992b4968780c286a084ad7c02b2b58f1e Mon Sep 17 00:00:00 2001 From: Marcos Magueta Date: Fri, 3 Apr 2026 16:04:05 -0300 Subject: Polarity walker, constraint and manipulation refactor with batteries --- lib/icl/executor.ml | 58 ++++++++++++++++++++++++++--------------------------- 1 file changed, 28 insertions(+), 30 deletions(-) (limited to 'lib/icl') diff --git a/lib/icl/executor.ml b/lib/icl/executor.ml index 591f839..07d0978 100644 --- a/lib/icl/executor.ml +++ b/lib/icl/executor.ml @@ -1,58 +1,56 @@ module Make (Storage : Management.Physical.S) = struct - module Ops = Manipulation.Make(Storage) + module Ops = Manipulation.Make (Storage) type error = - | ParseError of string + | ParseError of string | ManipulationError of Manipulation.error - | ConversionError of string + | ConversionError of string let sexp_of_error e = let open Sexplib.Sexp in match e with - | ParseError s -> List [Atom "parse-error"; Atom s] + | ParseError s -> List [ Atom "parse-error"; Atom s ] | ManipulationError e -> Manipulation.sexp_of_error e - | ConversionError s -> List [Atom "conversion-error"; Atom s] + | ConversionError s -> List [ Atom "conversion-error"; Atom s ] let wrap_manip = Result.map_error (fun e -> ManipulationError e) - 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) - Constraint.BindingMap.empty - pairs + Constraint.BindingMap.empty pairs let rec convert_body : Ast.constraint_body -> Constraint.t = function | Ast.MemberOf { target; binding } -> - Constraint.MemberOf { target; binding = convert_binding binding } + Constraint.member_of ~target ~binding:(convert_binding binding) | Ast.Not { body; universe } -> - Constraint.Not { body = convert_body body; universe } - | Ast.And bodies -> - Constraint.And (List.map convert_body bodies) - | Ast.Or bodies -> - Constraint.Or (List.map convert_body bodies) + 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 } -> - Constraint.Exists { variable; quantifier; body = convert_body body } + Constraint.exists ~variable ~quantifier (convert_body body) | Ast.Forall { variable; quantifier; body } -> - Constraint.Forall { variable; quantifier; body = convert_body body } + Constraint.forall ~variable ~quantifier (convert_body body) - let execute - (storage : Storage.t) - (db : Management.Database.t) - (stmt : Ast.statement) - : (Management.Database.t * string, error) result = + let execute (storage : Storage.t) (db : Management.Database.t) + (stmt : Ast.statement) : (Management.Database.t * string, error) result = match stmt with - | Ast.RegisterConstraint { constraint_name; relation_name; body } -> - let runtime_body = convert_body body in - (match Ops.register_constraint storage db - ~constraint_name ~relation_name ~body:runtime_body - |> wrap_manip with - | Ok new_db -> Ok (new_db, "Constraint registered: " ^ constraint_name) - | Error e -> Error e) + | Ast.RegisterConstraint { constraint_name; relation_name; body } -> ( + let runtime_body = convert_body body in + match + Ops.register_constraint storage db ~constraint_name ~relation_name + ~body:runtime_body + |> wrap_manip + with + | Ok new_db -> Ok (new_db, "Constraint registered: " ^ constraint_name) + | Error e -> Error e) end -module Memory = Make(Management.Physical.Memory) +module Memory = Make (Management.Physical.Memory) -- cgit v1.2.3