aboutsummaryrefslogtreecommitdiffstats
path: root/lib/icl
diff options
context:
space:
mode:
authorMarcos Magueta <maguetamarcos@gmail.com>2026-06-23 23:53:26 -0300
committerGitHub <noreply@github.com>2026-06-23 23:53:26 -0300
commitc284fcd570342c31bc21169960579a20a763e32e (patch)
treece7485055116d794c55090ad0978e0b3f5ff4c2a /lib/icl
parentb81586ee4a0543a5f9866586c78dccdd6328934a (diff)
downloadSakura-c284fcd570342c31bc21169960579a20a763e32e.tar.gz
Sakura-c284fcd570342c31bc21169960579a20a763e32e.zip
Format
Diffstat (limited to '')
-rw-r--r--lib/icl/ast.ml18
-rw-r--r--lib/icl/executor.ml36
-rw-r--r--lib/icl/parser.ml1
-rw-r--r--lib/icl/sublanguage.ml1
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 =