diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/ddl/ast.ml | 4 | ||||
| -rw-r--r-- | lib/ddl/executor.ml | 82 | ||||
| -rw-r--r-- | lib/ddl/parser.ml | 7 | ||||
| -rw-r--r-- | lib/ddl/sublanguage.ml | 8 |
4 files changed, 48 insertions, 53 deletions
diff --git a/lib/ddl/ast.ml b/lib/ddl/ast.ml index 7faee40..ee39edb 100644 --- a/lib/ddl/ast.ml +++ b/lib/ddl/ast.ml @@ -9,8 +9,8 @@ type cardinality_spec = type statement = | CreateDatabase of string - | CreateRelation of { name: string; schema: (string * string) list } + | CreateRelation of { name : string; schema : (string * string) list } | RetractRelation of string | ClearRelation of string - | RegisterDomain of { name: string; cardinality: cardinality_spec } + | RegisterDomain of { name : string; cardinality : cardinality_spec } [@@deriving sexp] diff --git a/lib/ddl/executor.ml b/lib/ddl/executor.ml index fbb2f62..d374ffe 100644 --- a/lib/ddl/executor.ml +++ b/lib/ddl/executor.ml @@ -1,68 +1,64 @@ module Make (Storage : Management.Physical.S) = struct - module Ops = Manipulation.Make(Storage) + module Ops = Manipulation.Make (Storage) type error = - | ParseError of string + | ParseError of string | ManipulationError of Manipulation.error - | RelationNotFound of string + | RelationNotFound of string let sexp_of_error e = let open Sexplib.Sexp in match e with - | ParseError s -> List [Atom "parse-error"; Atom s] + | ParseError s -> List [ Atom "parse-error"; Atom s ] | ManipulationError e -> Manipulation.sexp_of_error e - | RelationNotFound s -> List [Atom "relation-not-found"; Atom s] + | RelationNotFound s -> List [ Atom "relation-not-found"; Atom s ] let ( let* ) = Result.bind - let wrap_manip r = Result.map_error (fun e -> ManipulationError e) r let get_rel db name = - Ops.get_relation db ~name - |> Option.to_result ~none:(RelationNotFound name) + Ops.get_relation db ~name |> Option.to_result ~none:(RelationNotFound name) - let convert_cardinality : Ast.cardinality_spec -> Conventions.Cardinality.t = function - | Ast.Finite n -> Conventions.Cardinality.Finite n - | Ast.AlephZero -> Conventions.Cardinality.AlephZero - | Ast.Continuum -> Conventions.Cardinality.Continuum + let convert_cardinality : Ast.cardinality_spec -> Conventions.Cardinality.t = + function + | Ast.Finite n -> Conventions.Cardinality.Finite n + | Ast.AlephZero -> Conventions.Cardinality.AlephZero + | Ast.Continuum -> Conventions.Cardinality.Continuum | Ast.ConstrainedFinite -> Conventions.Cardinality.ConstrainedFinite - let execute - (storage : Storage.t) - (db : Management.Database.t) - (stmt : Ast.statement) - : (Management.Database.t * string, error) result = + let execute (storage : Storage.t) (db : Management.Database.t) + (stmt : Ast.statement) : (Management.Database.t * string, error) result = match stmt with | Ast.CreateDatabase name -> - let* db = Ops.create_database storage ~name |> wrap_manip in - Ok (db, "Database created: " ^ name) - + let* db = Ops.create_database storage ~name |> wrap_manip in + Ok (db, "Database created: " ^ name) | Ast.CreateRelation { name; schema = schema_pairs } -> - let schema = - List.fold_left (fun s (attr, dom) -> Schema.add attr dom s) Schema.empty schema_pairs - in - let* (db, _) = Ops.create_relation storage db ~name ~schema |> wrap_manip in - Ok (db, "Relation created: " ^ name) - + let schema = + List.fold_left + (fun s (attr, dom) -> Schema.add attr dom s) + Schema.empty schema_pairs + in + let* db, _ = + Ops.create_relation storage db ~name ~schema |> wrap_manip + in + Ok (db, "Relation created: " ^ name) | Ast.RetractRelation name -> - let* db = Ops.retract_relation storage db ~name |> wrap_manip in - Ok (db, "Relation retracted: " ^ name) - + let* db = Ops.retract_relation storage db ~name |> wrap_manip in + Ok (db, "Relation retracted: " ^ name) | Ast.ClearRelation name -> - let* rel = get_rel db name in - let* (db, _) = Ops.clear_relation storage db rel |> wrap_manip in - Ok (db, "Relation cleared: " ^ name) - + let* rel = get_rel db name in + let* db, _ = Ops.clear_relation storage db rel |> wrap_manip in + Ok (db, "Relation cleared: " ^ name) | Ast.RegisterDomain { name; cardinality } -> - let domain = Domain.make - ~name - ~generator:(fun _ -> Generator.Error "not enumerable via DDL") - ~membership_criteria:(fun _ -> true) - ~cardinality:(convert_cardinality cardinality) - ~compare:Stdlib.compare - in - let* db = Ops.register_domain storage db domain |> wrap_manip in - Ok (db, "Domain registered: " ^ name) + let domain = + Domain.make ~name + ~generator:(fun _ -> Generator.Error "not enumerable via DDL") + ~membership_criteria:(fun _ -> true) + ~cardinality:(convert_cardinality cardinality) + ~compare:Stdlib.compare + in + let* db = Ops.register_domain storage db domain |> wrap_manip in + Ok (db, "Domain registered: " ^ name) end -module Memory = Make(Management.Physical.Memory) +module Memory = Make (Management.Physical.Memory) diff --git a/lib/ddl/parser.ml b/lib/ddl/parser.ml index 28f8b6c..5678b47 100644 --- a/lib/ddl/parser.ml +++ b/lib/ddl/parser.ml @@ -2,13 +2,12 @@ type error = ParseError of string let of_sexp sexp = match Ast.statement_of_sexp sexp with - | stmt -> Ok stmt + | stmt -> Ok stmt | exception exn -> Error (ParseError (Printexc.to_string exn)) let of_string s = match Sexplib.Sexp.of_string s |> Ast.statement_of_sexp with - | stmt -> Ok stmt + | 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 +let to_string stmt = Ast.sexp_of_statement stmt |> Sexplib.Sexp.to_string_hum diff --git a/lib/ddl/sublanguage.ml b/lib/ddl/sublanguage.ml index 26a012f..bf40a05 100644 --- a/lib/ddl/sublanguage.ml +++ b/lib/ddl/sublanguage.ml @@ -1,9 +1,9 @@ module Make (Storage : Management.Physical.S) = struct - module Exec = Executor.Make(Storage) + module Exec = Executor.Make (Storage) type storage = Storage.t - type ast = Ast.statement - type error = Exec.error + type ast = Ast.statement + type error = Exec.error let name = "ddl" @@ -20,4 +20,4 @@ module Make (Storage : Management.Physical.S) = struct let sexp_of_error = Exec.sexp_of_error end -module Memory = Make(Management.Physical.Memory) +module Memory = Make (Management.Physical.Memory) |