From d0732d97a93d8924ded0c915160955d1492fc588 Mon Sep 17 00:00:00 2001 From: ygrek Date: Sun, 21 Jun 2009 10:51:18 +0300 Subject: [PATCH] wip --- demo/demo.sql.pp | 2 ++ demo/demo_csharp.cs | 23 ++++++++++++++++++++++- gen.ml | 28 +++++++++++++--------------- gen_cxx.ml | 28 ++++++++++++++++------------ main.ml | 2 +- parser.ml | 2 +- rA.ml | 6 +++--- sql_parser.mly | 10 +++++----- stmt.ml | 2 ++ syntax.ml | 15 ++++++++------- tables.ml | 4 ++-- test.ml | 4 ++-- 12 files changed, 77 insertions(+), 49 deletions(-) diff --git a/demo/demo.sql.pp b/demo/demo.sql.pp index bf814c1..6938275 100644 --- a/demo/demo.sql.pp +++ b/demo/demo.sql.pp @@ -13,3 +13,5 @@ SELECT %CONCAT(name,' ',surname)%name || ' ' || surname% AS fullname, SUM(amount -- @list_donors SELECT DISTINCT surname FROM person JOIN money ON src = id AND dst = (SELECT id FROM person WHERE surname LIKE ?) LIMIT ?; +DROP TABLE IF EXISTS person; +DROP TABLE IF EXISTS money; diff --git a/demo/demo_csharp.cs b/demo/demo_csharp.cs index 4f757dc..4d18290 100644 --- a/demo/demo_csharp.cs +++ b/demo/demo_csharp.cs @@ -10,9 +10,30 @@ public class Test IDbConnection conn = new MySqlConnection(connectionString); conn.Open(); + gen.create_person(); + gen.create_money(); + + gen.add_person("John","Black"); + ResultSet rs = st.executeQuery("SELECT LAST_INSERT_ID()"); rs.next(); + int john = rs.getInt(1); + + gen.add_person("Ivan","Petrov"); + rs = st.executeQuery("SELECT LAST_INSERT_ID()"); rs.next(); + int ivan = rs.getInt(1); + + gen.add_person("Sancho","Alvares"); + rs = st.executeQuery("SELECT LAST_INSERT_ID()"); rs.next(); + int sancho = rs.getInt(1); + + // add money relations + gen.add_money(john,ivan,200); + gen.add_money(john,sancho,100); + gen.add_money(john,sancho,250); + gen.add_money(sancho,ivan,300); + Console.WriteLine("Total transfers:"); sqlgg.calc_total calc = new sqlgg.calc_total(conn); - calc.execute(delegate (String name, decimal total) { Console.WriteLine(name + ": " + total); }); + calc.execute(delegate (String name, long total) { Console.WriteLine(name + ": " + total); }); Console.WriteLine("Donors:"); sqlgg.list_donors donors = new sqlgg.list_donors(conn); diff --git a/gen.ml b/gen.ml index bb7c9f3..798ca9b 100644 --- a/gen.ml +++ b/gen.ml @@ -54,45 +54,43 @@ let get_sql props kind params = module type Lang = sig type t - val generate_code : t -> int -> RA.Scheme.t -> Stmt.params -> Stmt.kind -> Props.t -> unit + val generate : t -> string -> Stmt.t Enum.t -> unit val start : unit -> t - val start_output : t -> string -> unit - val finish_output : t -> string -> unit val comment : t -> ('a,unit,string,unit) format4 -> 'a val empty_line : t -> unit end module Make(S : Lang) = struct -let generate_code out index stmt = +(* +let generate_code stmt f = let ((schema,params,kind),props) = stmt in let sql = Props.get props "sql" >> Option.default "" in - S.comment out "%s" sql; +(* S.comment out "%s" sql; *) if not (RA.Scheme.is_unique schema) then Error.log "Error: this SQL statement will produce rowset with duplicate column names:\n%s\n" sql else begin - S.generate_code out index schema params kind props + f schema params kind props end +*) let time_string () = let module U = Unix in let t = U.time () >> U.gmtime in sprintf "%04u-%02u-%02uT%02u:%02uZ" (1900 + t.U.tm_year) t.U.tm_mon t.U.tm_mday t.U.tm_hour t.U.tm_min -let generate_header code = - S.comment code "DO NOT EDIT MANUALLY"; - S.comment code ""; - S.comment code "generated by sqlgg %s on %s" Config.version (time_string ()); - S.comment code "visit http://ygrek.org.ua/p/sqlgg/"; - S.empty_line code +let generate_header out = + S.comment out "DO NOT EDIT MANUALLY"; + S.comment out ""; + S.comment out "generated by sqlgg %s on %s" Config.version (time_string ()); + S.comment out "visit http://ygrek.org.ua/p/sqlgg/"; + S.empty_line out let process name stmts = let out = S.start () in generate_header out; - S.start_output out name; - Enum.iteri (generate_code out) stmts; - S.finish_output out name + S.generate out name stmts end diff --git a/gen_cxx.ml b/gen_cxx.ml index d785fb4..fafba03 100644 --- a/gen_cxx.ml +++ b/gen_cxx.ml @@ -165,11 +165,8 @@ type t = unit let start () = () -let names = ref [] - -let generate_code () index schema params kind props = +let make_stmt index schema params kind props = let name = choose_name props kind index in - names := name :: !names; let sql = quote (get_sql props kind params) in struct_params name ["stmt","typename Traits::statement"] (fun () -> func "" name ["db","typename Traits::connection"] ~tail:(sprintf ": stmt(db,SQLGG_STR(%s))" sql) Apply.id; @@ -188,7 +185,21 @@ let generate_code () index schema params kind props = | Some schema_name -> output "return stmt.select(result,%s(),%s(%s));" (schema_name ^ "") params_binder_name inline_params end); - ) + ); + name + +let generate () name stmts = + let stmts = List.of_enum stmts in + let names = + List.mapi (fun i ((schema,params,kind),props) -> make_stmt i schema params kind props) stmts + in + List.iter (fun name -> output "%s %s;" name name) names; + empty_line (); + let tail = match names with + | [] -> "" + | _ -> ": " ^ (String.concat ", " (List.map (fun name -> sprintf "%s(db)" name) names)) + in + func "" name ["db","typename Traits::connection"] ~tail Apply.id let start_output () name = output "#pragma once"; @@ -197,12 +208,5 @@ let start_output () name = start_struct name let finish_output () name = - List.iter (fun name -> output "%s %s;" name name) !names; - empty_line (); - let tail = match !names with - | [] -> "" - | _ -> ": " ^ (String.concat ", " (List.map (fun name -> sprintf "%s(db)" name) !names)) - in - func "" name ["db","typename Traits::connection"] ~tail Apply.id; end_struct name diff --git a/main.ml b/main.ml index 80655f3..efc9c86 100644 --- a/main.ml +++ b/main.ml @@ -31,7 +31,7 @@ let parse_one (stmt,props) = end let show_one ((s,p),props) = - RA.Scheme.print s; + RA.Schema.print s; print_endline (Stmt.params_to_string p) let get_statements ch = diff --git a/parser.ml b/parser.ml index 609aa97..d6dc353 100644 --- a/parser.ml +++ b/parser.ml @@ -2,7 +2,7 @@ module T_SQL_parser = struct type token = Sql_parser.token - type result = RA.Scheme.t * Stmt.params * Stmt.kind + type result = RA.Schema.t * Stmt.params * Stmt.kind let rule = Sql_lexer.parse_rule let input = Sql_parser.input end diff --git a/rA.ml b/rA.ml index 1095e7d..7d36e54 100644 --- a/rA.ml +++ b/rA.ml @@ -13,7 +13,7 @@ type attr = {name : string; domain : Type.t;} let attr n d = {name=n;domain=d} -module Scheme = +module Schema = struct type t = attr list deriving (Show) @@ -107,12 +107,12 @@ struct end -type table = string * Scheme.t deriving (Show) +type table = string * Schema.t deriving (Show) let print_table t = print_endline (Show.show(t)) (* -open Scheme +open Schema let test = [{name="a";domain=Type.Int}; {name="b";domain=Type.Int}; {name="c";domain=Type.Text};];; diff --git a/sql_parser.mly b/sql_parser.mly index bde5d13..a2c59a5 100644 --- a/sql_parser.mly +++ b/sql_parser.mly @@ -25,7 +25,7 @@ let select_value select = let (s,p) = select in if (List.length s <> 1) then - raise (RA.Scheme.Error (s,"only one column allowed for SELECT operator in this expression")); + raise (RA.Schema.Error (s,"only one column allowed for SELECT operator in this expression")); params_of select %} @@ -63,7 +63,7 @@ %type expr -%start input +%start input %% @@ -106,7 +106,7 @@ statement: CREATE ioption(temporary) TABLE ioption(if_not_exists) name=IDENT { let s = Tables.get_schema table in let s = match cols with - | Some cols -> RA.Scheme.project cols s + | Some cols -> RA.Schema.project cols s | None -> s in let p = Syntax.schema_as_params s in @@ -144,9 +144,9 @@ select_stmt: select_core list(preceded(compound_op,select_core)) o=loption(order let (s1,p1,tbls) = $1 in let (s2l,p2l) = List.split (List.map (fun (s,p,_) -> s,p) $2) in (* ignoring tables in compound statements - they cannot be used in ORDER BY *) - let schema = List.fold_left RA.Scheme.compound s1 s2l in + let schema = List.fold_left RA.Schema.compound s1 s2l in let p3 = Syntax.get_params_l tbls schema o in -(* RA.Scheme.check_unique schema; *) +(* RA.Schema.check_unique schema; *) schema,(p1@(List.flatten p2l)@p3@p4) } diff --git a/stmt.ml b/stmt.ml index bb2e5e3..e197e50 100644 --- a/stmt.ml +++ b/stmt.ml @@ -20,3 +20,5 @@ type kind = | Select | Drop of string deriving (Show) +type t = { schema : RA.Schema.t; params : params; kind : kind; props : Props.t; } + diff --git a/syntax.ml b/syntax.ml index 83a1629..6c6e2ae 100644 --- a/syntax.ml +++ b/syntax.ml @@ -39,7 +39,7 @@ let resolve_columns tables joined_schema expr = match e with | `Value x -> `Value x | `Column (name,x) -> - let attr = RA.Scheme.find (Option.map_default schema joined_schema x) name in + let attr = RA.Schema.find (Option.map_default schema joined_schema x) name in `Value attr.RA.domain | `Param x -> `Param x | `Func (r,l) -> `Func (r,(List.map each l)) @@ -90,8 +90,8 @@ let infer_schema columns tables joined_schema = | Expr (e,name) -> let col = begin match e with - | `Column (name,Some t) -> RA.Scheme.find (schema t) name - | `Column (name,None) -> RA.Scheme.find joined_schema name + | `Column (name,Some t) -> RA.Schema.find (schema t) name + | `Column (name,None) -> RA.Schema.find joined_schema name | _ -> RA.attr "" (Option.default Sql.Type.Text (resolve_types tables joined_schema e >> snd)) end in let col = Option.map_default (fun n -> {col with RA.name = n}) col name in @@ -135,9 +135,9 @@ let do_join (tables,params,schema) ((table1,params1),kind) = let schema = match kind with | `Cross | `Search _ - | `Default -> RA.Scheme.cross schema schema1 - | `Natural -> RA.Scheme.natural schema schema1 - | `Using l -> RA.Scheme.join_using l schema schema1 + | `Default -> RA.Schema.cross schema schema1 + | `Natural -> RA.Schema.natural schema schema1 + | `Using l -> RA.Schema.join_using l schema schema1 in let p = match kind with | `Cross | `Default | `Natural | `Using _ -> [] @@ -156,6 +156,7 @@ let split_column_assignments schema l = List.iter (fun (col,expr) -> cols := col :: !cols; (* hint expression to unify with the column type *) - let typ = (RA.Scheme.find schema col).RA.domain in + let typ = (RA.Schema.find schema col).RA.domain in exprs := (`Func (None, [`Value typ;expr])) :: !exprs) l; (List.rev !cols,List.rev !exprs) + diff --git a/tables.ml b/tables.ml index fe166c8..08ba338 100644 --- a/tables.ml +++ b/tables.ml @@ -37,8 +37,8 @@ let alter name f = in all := List.map alter_scheme !all -let alter_add name col pos = alter name (fun s -> RA.Scheme.add s col pos) -let alter_drop name col = alter name (fun s -> RA.Scheme.drop s col) +let alter_add name col pos = alter name (fun s -> RA.Schema.add s col pos) +let alter_drop name col = alter name (fun s -> RA.Schema.drop s col) let print () = List.iter RA.print_table !all diff --git a/test.ml b/test.ml index f4e0133..bc49c89 100644 --- a/test.ml +++ b/test.ml @@ -5,7 +5,7 @@ open Sql.Type open Stmt let tt ?msg stmt schema params = - let print_schema = RA.Scheme.to_string in + let print_schema = RA.Schema.to_string in let print_params = Stmt.params_to_string in let (s1,p1,_) = try @@ -61,7 +61,7 @@ let test_join_result_cols () = let test_misc () = let test = let printer = Show.show in - fun x y z -> assert_equal ~printer (RA.Scheme.natural_ x y) z + fun x y z -> assert_equal ~printer (RA.Schema.natural_ x y) z in test [1;2;3;4] [1;2;5;6] [1;2;3;4;5;6]; test [1;2;3;4] [4;3;2;1] [1;2;3;4]; -- 2.11.4.GIT