diff options
Diffstat (limited to 'lib/icl/executor.ml')
| -rw-r--r-- | lib/icl/executor.ml | 50 |
1 files changed, 50 insertions, 0 deletions
diff --git a/lib/icl/executor.ml b/lib/icl/executor.ml new file mode 100644 index 0000000..a895135 --- /dev/null +++ b/lib/icl/executor.ml @@ -0,0 +1,50 @@ +module Make (Storage : Management.Physical.S) = struct + module Ops = Manipulation.Make(Storage) + + type error = + | ManipulationError of Manipulation.error + | ConversionError of string + + let wrap_manip = Result.map_error (fun e -> ManipulationError e) + + 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 = + List.fold_left + (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 } -> + Constraint.MemberOf { 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) + | Ast.Exists { variable; quantifier; body } -> + Constraint.Exists { variable; quantifier; body = convert_body body } + | Ast.Forall { variable; quantifier; body } -> + Constraint.Forall { variable; quantifier; body = convert_body body } + + 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) +end + +module Memory = Make(Management.Physical.Memory) |
