aboutsummaryrefslogtreecommitdiffstats
path: root/lib/icl
diff options
context:
space:
mode:
authorMarcos Magueta <maguetamarcos@gmail.com>2026-03-14 11:39:04 -0300
committerGitHub <noreply@github.com>2026-03-14 11:39:04 -0300
commite6661bfa6a3d7dc477d0b7717c80bd536eca2d68 (patch)
tree12510963feeed03221defa690e73edd4135b65e1 /lib/icl
parent0ad04e638baa8f283150d3c2809cdb9bf21e2995 (diff)
downloadSakura-e6661bfa6a3d7dc477d0b7717c80bd536eca2d68.tar.gz
Sakura-e6661bfa6a3d7dc477d0b7717c80bd536eca2d68.zip
Branching and naïve merge strategies
* AGPL license * branching and merging * Delete LICENSE in favor of separate PR Signed-off-by: Marcos Magueta <maguetamarcos@gmail.com> * add unmonitored tests and docs --------- Signed-off-by: Marcos Magueta <maguetamarcos@gmail.com>
Diffstat (limited to '')
-rw-r--r--lib/icl/ast.ml23
-rw-r--r--lib/icl/executor.ml50
-rw-r--r--lib/icl/parser.ml9
3 files changed, 82 insertions, 0 deletions
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