diff options
| author | Estevan Castilho <tevo@riajuu.net> | 2026-05-21 01:55:21 +0000 |
|---|---|---|
| committer | Estevan Castilho <tevo@riajuu.net> | 2026-05-21 01:55:21 +0000 |
| commit | 98777208f3686de1d2496632f173204ae1795456 (patch) | |
| tree | f85b34c5b3871351c16ae07bb6996b62669cbd51 /lib/icl/executor.ml | |
| parent | 01e8817ebd580fef547699853a38c854eac670d1 (diff) | |
| download | Sakura-98777208f3686de1d2496632f173204ae1795456.tar.gz Sakura-98777208f3686de1d2496632f173204ae1795456.zip | |
Migrate the ICL over
Diffstat (limited to 'lib/icl/executor.ml')
| -rw-r--r-- | lib/icl/executor.ml | 31 |
1 files changed, 9 insertions, 22 deletions
diff --git a/lib/icl/executor.ml b/lib/icl/executor.ml index 0a77dff..7c23a28 100644 --- a/lib/icl/executor.ml +++ b/lib/icl/executor.ml @@ -1,31 +1,19 @@ module Make (NT : Nt.S) = struct - type error = - | ParseError of string - | NtError of Nt.error - | ConversionError of string - | MultigroupNotFound of string - | UnqualifiedName of string - - let sexp_of_error e = - let open Sexplib.Sexp in - match e with - | ParseError s -> List [ Atom "parse-error"; Atom s ] - | NtError e -> List [ Atom "nt-error"; Atom (Nt.string_of_error e) ] - | ConversionError s -> List [ Atom "conversion-error"; Atom s ] - | MultigroupNotFound s -> List [ Atom "multigroup-not-found"; Atom s ] - | UnqualifiedName s -> List [ Atom "unqualified-name"; Atom s ] + module Error = struct + open Condition + let multigroup_not_found name = condition "multigroup-not-found" ("name" |=| (of_string name)) + end let ( let* ) = Result.bind - let wrap_nt = Result.map_error (fun e -> NtError e) - let parse_fqn (s : string) : (Qualified_name.t, error) result = - Qualified_name.try_parse s |> Result.map_error (fun s -> UnqualifiedName 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, error) result = + (Management.Multigroup.multigroup, Condition.t) result = match ctx.branch#mg_of mg_name with | Some mg -> Ok mg - | None -> Error (MultigroupNotFound mg_name) + | None -> Error (Error.multigroup_not_found mg_name) let convert_binding_expr : Ast.binding_expr -> Constraint.binding_expr = function @@ -52,7 +40,7 @@ module Make (NT : Nt.S) = struct Constraint.forall ~variable ~quantifier (convert_body body) let execute (ctx : Sublanguage_context.t) (stmt : Ast.statement) : - (Sublanguage_types.transition_delta * string, error) result = + (Sublanguage_types.transition_delta * string, Condition.t) result = match stmt with | Ast.RegisterConstraint { constraint_name; relation_name; body } -> let* fqn = parse_fqn relation_name in @@ -61,7 +49,6 @@ module Make (NT : Nt.S) = struct let* _bh, new_mg = NT.register_constraint ctx.write_handle mg ~constraint_name ~relation_name:fqn.name ~body:runtime_body - |> wrap_nt in ctx.branch#set_mg ~name:fqn.mg new_mg; Ok ([ (fqn.mg, new_mg) ], "Constraint registered: " ^ constraint_name) |
