Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

[enhance] compiler, database: Just change type of database options

  • Loading branch information...
commit 121d0462191c3c8c5744df15273e9758c5fad899 1 parent ec2c2f5
@BourgerieQuentin BourgerieQuentin authored
View
6 libqmlcompil/dbGen/dbGen_private.ml
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -28,6 +28,7 @@ module List = BaseList
(* shorthands *)
module Q = QmlAst
+module DbAst = QmlAst.Db
module C = DbGen_common
module H = DbGenHelpers
@@ -1341,7 +1342,8 @@ module CodeGenerator ( Arg : DbGenByPass.S ) = struct
(* if Schema_private.package_name_of_def db_def <> ObjectFiles.get_current_package_name() *)
(* then (dbinfo_map, gamma, defs) *)
(* else *)
- let engine = C.engine_opt db_def.Schema_private.options in
+ assert (db_def.Schema_private.options.DbAst.backend = `db3);
+ let engine = `meta in
let engine_id =
H.new_ident (Printf.sprintf "engine_%s"
(ExprIdent.original_name db_def.Schema_private.ident))
View
6 libqmlcompil/dbGen/schema_private.ml
@@ -83,7 +83,7 @@ type database_def = {
context: QmlError.context;
path_aliases: (Q.path * Q.path) list;
(* eg. [(/a,/b); (/alias,/deep/data)] *)
- options: Db.options list;
+ options: Db.options;
schema: t;
package : ObjectFiles.package_name;
virtual_path : (Q.ident * Q.ty * Q.ty) PathMap.t;
@@ -702,7 +702,9 @@ let register_new_db_value ~name_default_values t gamma (label, value) =
ty = C.Db.t ();
context;
path_aliases = [];
- options = [];
+ options = {
+ Q.Db.backend = C.Args.get_engine ();
+ };
schema = SchemaGraphLib.initial_schema ~context;
package = ObjectFiles.get_current_package_name ();
virtual_path = PathMap.empty } t
View
34 libqmlcompil/qmlAst.ml
@@ -206,18 +206,14 @@ struct
directive). For now, only used to specify the data storage location (any
path, absolute or relative, ending with the filename prefix). DbGen sets
this to [~/.mlstate/<progname>/default] by default (based on argv.(0)) *)
- type engine =
- [
- |`db3 of string option (* path *)
- |`db3light of string option (* path *)
- |`meta
- |`client of string option * int option (* server:port *)
- ]
- type options =
- [
- |`engine of engine
- |`mountpoint of string list
- ]
+ type engine = [
+ |`db3
+ |`mongo
+ ]
+
+ type options = {
+ backend : engine
+ }
type 'expr db_constraint = (** The type of DB constraints as specified by the user. To be extended *)
(* /!\ this is WIP, and most of it is dummy for now *)
@@ -299,12 +295,10 @@ struct
let h = Option.default "" h in
let p = match p with None -> "" | Some p -> ":" ^ string_of_int p in
"@shared(" ^ h ^ p ^ ")"
- let options_to_string opts =
- String.concat_map " "
- (function
- | `engine s -> engine_to_string s
- | `mountpoint _sl -> ""
- ) opts
+ let options_to_string opt = match opt.backend with
+ | `db3 -> "@db3"
+ | `mongo -> "@mongo"
+
let path_decl_key_to_string = function
| Decl_fld s -> "/"^s
| Decl_int -> "[_]" (* "[]" in qml. This is only valid for default defs. Should be "[int]" once available in OPA *)
@@ -1142,7 +1136,7 @@ let comb l x = List.fold_left (fun b f -> f x || b) false l
type code_elt =
| Database of Annot.label * Ident.t * (** The name of the database*)
- Db.path_decl * Db.options list
+ Db.path_decl * Db.options
| NewDbValue of Annot.label * (expr,ty) Db.db_def
| NewType of Annot.label * typedef list
| NewVal of Annot.label * (Ident.t * expr) list
@@ -1314,7 +1308,7 @@ let map_code = List.map
*)
type ('a, 'b) maped_code_elt =
| M_Failure of code_elt * (exn * exn list) (** exn list : for NewVal for example *)
- | M_Database of Ident.t * Db.path_decl * (Db.options list)
+ | M_Database of Ident.t * Db.path_decl * Db.options
| M_NewDbValue of Db.path_decl * 'a
| M_DbAlias of Db.path_decl * Db.path_decl
| M_DbDefault of Db.path_decl
View
4 libqmlcompil/qmlDbGen.ml
@@ -42,7 +42,7 @@ module Schema = struct
name : string;
ident : Ident.t;
dbty : QmlAst.ty;
- options : QmlAst.Db.options list;
+ options : QmlAst.Db.options;
package : ObjectFiles.package_name;
}
@@ -118,7 +118,7 @@ module Schema = struct
Sch.ty = C.Db.t ();
Sch.context = QmlError.Context.pos (FilePos.nopos "built from gml");
Sch.path_aliases = [];
- Sch.options = [];
+ Sch.options = {DbAst.backend = `db3};
Sch.schema = Schema_io.from_gml_string s;
Sch.package = "dummy_from_gml";
Sch.virtual_path = Sch.PathMap.empty;
View
6 libqmlcompil/qmlDbGen.mli
@@ -51,7 +51,7 @@ module Schema: sig
name : string;
ident : Ident.t;
dbty : QmlAst.ty;
- options : QmlAst.Db.options list;
+ options : QmlAst.Db.options;
package : ObjectFiles.package_name;
}
@@ -78,7 +78,7 @@ module Schema: sig
(** Maps the idents of the different database schemas and their respective
options in a multi-schema *)
val mapi:
- (string list -> QmlAst.ident * QmlAst.Db.options list -> QmlAst.ident * QmlAst.Db.options list)
+ (string list -> QmlAst.ident * QmlAst.Db.options -> QmlAst.ident * QmlAst.Db.options)
-> t -> t
(** Initial empty schema *)
@@ -117,7 +117,7 @@ module Schema: sig
(** Registers database declarations *)
val register_db_declaration:
- t -> Annot.label * Ident.t * QmlAst.Db.path_decl * QmlAst.Db.options list
+ t -> Annot.label * Ident.t * QmlAst.Db.path_decl * QmlAst.Db.options
-> t
(** Registers db-related declarations (paths & default & constraints)
View
10 opa/pass_MongoAccessGeneration.ml
@@ -656,13 +656,9 @@ let init_database gamma annotmap schema =
(fun (annotmap, newvals) database ->
let ident = database.DbSchema.ident in
let name = database.DbSchema.name in
- match database.DbSchema.options with
- | [`engine (`client (host, port))] ->
- let (annotmap, open_) = Generator.open_database gamma annotmap name host port in
- (annotmap, (Q.NewVal (label, [ident, open_]))::newvals)
- | _ ->
- let (annotmap, open_) = Generator.open_database gamma annotmap name None None in
- (annotmap, (Q.NewVal (label, [ident, open_]))::newvals)
+ assert(database.DbSchema.options.DbAst.backend == `mongo);
+ let (annotmap, open_) = Generator.open_database gamma annotmap name None None in
+ (annotmap, (Q.NewVal (label, [ident, open_]))::newvals)
)
(annotmap, []) (DbSchema.get_db_declaration schema)
View
11 opalang/classic_syntax/opa_parser.trx
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -199,7 +199,6 @@ network_port <- Opa_lexer.colon_nosp Opa_lexer.int:p {{ p }}
*)/** database declaration **/
database <-
(* single database, short form and full form *)
- / Opa_lexer.DATABASE spacing file_path:s {{ [Database ("database", [], [`engine (`db3 (Some s))])] }}
/ Opa_lexer.DATABASE spacing db_options:dbo {{ [Database ("database", [], dbo)] }}
(* many-db or one, but named, db *)
/ Opa_lexer.DATABASE ml_identifier:i assign spacing db_options:dbo {{ [Database (i, [i], dbo)] }}
@@ -245,13 +244,7 @@ db_virtual <-
/** database options **/
db_options <-
- / "@" "local" Opa_lexer.lpar_nosp spacing '"' file_path:s '"' rpar {{ [`engine (`db3 (Some s))] }}
- / "@" "local" {{ [`engine (`db3 None)] }}
- / "@" "light" Opa_lexer.lpar_nosp spacing '"' file_path:s '"' rpar {{ [`engine (`db3light (Some s))] }}
- / "@" "light" {{ [`engine (`db3light None)] }}
- / "@" "meta" {{ [`engine (`meta)] }}
- / "@" "shared" Opa_lexer.lpar_nosp spacing '"' network_hostname?:h network_port?:p '"' rpar {{ [`engine (`client (h, p))] }}
- / "@" "shared" {{ [`engine (`client (None, None))] }}
+ / "@" "meta" {{ {QmlAst.Db.backend = `db3} }}
(**
{6 Bindings}
View
11 opalang/js_syntax/opa_parser.trx
@@ -429,7 +429,7 @@ declaration_database <-
{{
let decl_ =
let opt = match opt with
- | None -> []
+ | None -> {QmlAst.Db.backend = `db3}
| Some opt -> opt in
[Database (id, [id], opt)]
in
@@ -481,13 +481,8 @@ db_virtual <-
/** database options **/
db_options <-
- / "@" "local" Opa_lexer.lpar_nosp spacing '"' database_file_path:s '"' rpar {{ [`engine (`db3 (Some s))] }}
- / "@" "local" {{ [`engine (`db3 None)] }}
- / "@" "light" Opa_lexer.lpar_nosp spacing '"' database_file_path:s '"' rpar {{ [`engine (`db3light (Some s))] }}
- / "@" "light" {{ [`engine (`db3light None)] }}
- / "@" "meta" {{ [`engine (`meta)] }}
- / "@" "shared" Opa_lexer.lpar_nosp spacing '"' database_network_hostname?:h database_network_port?:p '"' rpar {{ [`engine (`client (h, p))] }}
- / "@" "shared" {{ [`engine (`client (None, None))] }}
+ / "@" "db3" {{ {QmlAst.Db.backend = `db3} }}
+ / "@" "mongo" {{ {QmlAst.Db.backend = `mongo} }}
View
11 opalang/opaPrint.ml
@@ -921,10 +921,7 @@ module Classic = struct
method code_elt : 'dir. ('ident, [< all_directives ] as 'dir) code_elt pprinter = fun f c ->
self#label self#code_elt_node f c
method code_elt_node : 'dir. ('ident, [< all_directives ] as 'dir) code_elt_node pprinter = fun f -> function
- | Database (ident,[name],[`engine (`db3 (Some s))]) -> pp f "database /* %a */ %s %s" self#ident ident name s
- | Database (ident,[],[`engine (`db3 (Some s))]) -> pp f "database /* %a */ %s" self#ident ident s
- | Database (ident,[name],[`engine (`db3light (Some s))]) -> pp f "database /* %a */ %s %s" self#ident ident name s
- | Database (ident,[],[`engine (`db3light (Some s))]) -> pp f "database /* %a */ %s" self#ident ident s
+ | Database (ident,[],options) -> pp f "database /* %a */ %s" self#ident ident (QmlAst.Db.options_to_string options)
| Database _ -> pp f "@@fixme<database>"
| NewDbDef db_def -> pp f "@[<2>db %a@]" self#db_def db_def
| NewType typedefs -> (
@@ -1533,10 +1530,8 @@ module Js = struct
method code_elt : 'dir. ('ident, [< all_directives ] as 'dir) code_elt pprinter = fun f c ->
self#label self#code_elt_node f c
method code_elt_node : 'dir. ('ident, [< all_directives ] as 'dir) code_elt_node pprinter = fun f -> function
- | Database (ident,[name],[`engine (`db3 (Some s))]) -> pp f "database /* %a */ %s %s" self#ident ident name s
- | Database (ident,[],[`engine (`db3 (Some s))]) -> pp f "database /* %a */ %s" self#ident ident s
- | Database (ident,[name],[`engine (`db3light (Some s))]) -> pp f "database /* %a */ %s %s" self#ident ident name s
- | Database (ident,[],[`engine (`db3light (Some s))]) -> pp f "database /* %a */ %s" self#ident ident s
+ | Database (ident,[name],options) -> pp f "database /* %a */ %s %s" self#ident ident name (QmlAst.Db.options_to_string options)
+ | Database (ident,[],options) -> pp f "database /* %a */ %s" self#ident ident (QmlAst.Db.options_to_string options)
| Database _ -> pp f "@@fixme<database>"
| NewDbDef db_def -> pp f "@[<2>database %a@]" self#db_def db_def
| NewType typedefs -> (
View
2  opalang/surfaceAst.ml
@@ -211,7 +211,7 @@ and 'ident colvar = Colvar of 'ident
and ('ident, 'dir) code_elt = ('ident, 'dir) code_elt_node label
and ('ident, 'dir) code_elt_node =
- | Database of 'ident * string list * QmlAst.Db.options list
+ | Database of 'ident * string list * QmlAst.Db.options
| NewDbDef of (('ident, 'dir) expr, 'ident ty) QmlAst.Db.db_def
| NewType of 'ident typedef list
| NewVal of ('ident pat * ('ident, 'dir) expr) list * bool (* rec *)
View
4 passes/surfaceAstRenaming.ml
@@ -1480,7 +1480,7 @@ type 'b common_code_elt_node =
(* the toplevel declaration after toplevel renaming and before renaming in the rhs *)
type 'b tmp_code_elt_node =
[ 'b common_code_elt_node
- | `Database of Ident.t * string list * QmlAst.Db.options list
+ | `Database of Ident.t * string list * QmlAst.Db.options
| `NewVal of (Ident.t StringMap.t * Ident.t pat * (string, 'b) expr) list * bool ]
type 'b tmp_code_elt = 'b tmp_code_elt_node QmlLoc.label
type 'b tmp_code = 'b tmp_code_elt list
@@ -1488,7 +1488,7 @@ type 'b tmp_code = 'b tmp_code_elt list
(* the toplevel declaration after toplevel renaming of types only *)
type 'b tmp_code_elt_node_only_types =
[ 'b common_code_elt_node
- | `Database of string * string list * QmlAst.Db.options list
+ | `Database of string * string list * QmlAst.Db.options
| `NewVal of (string pat * (string, 'b) expr) list * bool ]
type 'b tmp_code_elt_only_types = 'b tmp_code_elt_node_only_types QmlLoc.label
type 'b tmp_code_only_types = 'b tmp_code_elt_only_types list
View
2  qmlpasses/pass_DbSchemaGeneration.ml
@@ -27,7 +27,7 @@ struct
(* overriding db options *)
let commandline_override =
- ref (StringListMap.empty : QmlAst.Db.options list StringListMap.t)
+ ref (StringListMap.empty : QmlAst.Db.options StringListMap.t)
let parse_opts s =
try
Please sign in to comment.
Something went wrong with that request. Please try again.