From e6661bfa6a3d7dc477d0b7717c80bd536eca2d68 Mon Sep 17 00:00:00 2001 From: Marcos Magueta Date: Sat, 14 Mar 2026 11:39:04 -0300 Subject: =?UTF-8?q?Branching=20and=20na=C3=AFve=20merge=20strategies?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * AGPL license * branching and merging * Delete LICENSE in favor of separate PR Signed-off-by: Marcos Magueta * add unmonitored tests and docs --------- Signed-off-by: Marcos Magueta --- lib/icl/ast.ml | 23 +++++++++++++++++++++++ lib/icl/executor.ml | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++ lib/icl/parser.ml | 9 +++++++++ 3 files changed, 82 insertions(+) create mode 100644 lib/icl/ast.ml create mode 100644 lib/icl/executor.ml create mode 100644 lib/icl/parser.ml (limited to 'lib/icl') diff --git a/lib/icl/ast.ml b/lib/icl/ast.ml new file mode 100644 index 0000000..95e0271 --- /dev/null +++ b/lib/icl/ast.ml @@ -0,0 +1,23 @@ +open Sexplib.Std + +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 } + | 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 } +[@@deriving sexp] + +type statement = + | 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 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) diff --git a/lib/icl/parser.ml b/lib/icl/parser.ml new file mode 100644 index 0000000..a7981c0 --- /dev/null +++ b/lib/icl/parser.ml @@ -0,0 +1,9 @@ +type error = ParseError of string + +let of_string s = + match Sexplib.Sexp.of_string s |> Ast.statement_of_sexp with + | stmt -> Ok stmt + | exception exn -> Error (ParseError (Printexc.to_string exn)) + +let to_string stmt = + Ast.sexp_of_statement stmt |> Sexplib.Sexp.to_string_hum -- cgit v1.2.3