Version française
Home     About     Download     Resources     Contact us    
Browse thread
Something strange with CamlP4 quotations...
[ Home ] [ Index: by date | by threads ]
[ Search: ]

[ Message by date: previous | next ] [ Message in thread: previous | next ] [ Thread: previous | next ]
Date: -- (:)
From: Alessandro Baretta <a.baretta@b...>
Subject: Something strange with CamlP4 quotations...
This is a repost. Somehow, my original post did not seem to get through.

*****

I have a beautiful quotation expander which boils SQL code down to Ocaml code,
thereby allowing the type checker to verify queries at compile time. This
quotation has been working perfectly in the build system for a couple of years.
Just now I have made a findlib package which allows me to load the quotation
expander in a Camlp4-enabled toplevel, but I am unable to get it to work. Here's
what happens: the quotation expander is called, and it generates the correct
code, but the toplevel complains about a syntax error. If I cut-and-paste back
into the toplevel the dumped code generated by the quotation, the toplevel
accepts it without a wink. What's going on? Is it a problem with my findlib
package or is it a form of miscommunication between the camlp4 parser and the
toplevel?

Here's a transcript of a toplevel session showing the problem.

> alex@alex:~/dev/src$ ocaml
>         Objective Caml version 3.08.4
> 
> Findlib has been successfully loaded. Additional directives:
>   #require "package";;      to load a package
>   #list;;                   to list the available packages
>   #camlp4o;;                to load camlp4 (standard syntax)
>   #camlp4r;;                to load camlp4 (revised syntax)
>   #predicates "p,q,...";;   to set these predicates
>   Topfind.reset();;         to force that packages will be reloaded
>   #thread;;                 to enable threads
> 
> /opt/ocaml/3.08.4/lib/ocaml/camlp4: added to search path
> /opt/ocaml/3.08.4/lib/ocaml/camlp4/camlp4o.cma: loaded
> /opt/ocaml/3.08.4/lib/ocaml/str.cma: loaded
> /opt/ocaml/3.08.4/lib/ocaml/unix.cma: loaded
> /opt/ocaml/3.08.4/lib/ocaml/nums.cma: loaded
> /opt/ocaml/3.08.4/lib/site-lib/num-top: added to search path
> /opt/ocaml/3.08.4/lib/site-lib/num-top/num_top.cma: loaded
>         Camlp4 Parsing version 3.08.4
> 
> /opt/ocaml/3.08.4/lib/site-lib/num: added to search path
> /opt/ocaml/3.08.4/lib/site-lib/extlib: added to search path
> /opt/ocaml/3.08.4/lib/site-lib/extlib/extLib.cmo: loaded
> /opt/ocaml/3.08.4/lib/site-lib/ocamllib-addons: added to search path
> /opt/ocaml/3.08.4/lib/site-lib/ocamllib-addons/ocamllib-addons.cma: loaded
> # Pcaml.quotation_dump_file := Some "/dev/stderr";;
> - : unit = ()
> # #require "esql_qexp";;
> /opt/ocaml/3.08.4/lib/site-lib/rules-engine: added to search path
> /opt/ocaml/3.08.4/lib/site-lib/rules-engine/rules-engine.cma: loaded
> /opt/ocaml/3.08.4/lib/site-lib/pcre: added to search path
> /opt/ocaml/3.08.4/lib/site-lib/pcre/pcre.cma: loaded
> /opt/ocaml/3.08.4/lib/site-lib/netstring: added to search path
> /opt/ocaml/3.08.4/lib/site-lib/netstring/netstring.cma: loaded
> /opt/ocaml/3.08.4/lib/site-lib/netstring/netstring_top.cmo: loaded
> /opt/ocaml/3.08.4/lib/site-lib/netstring/netaccel.cma: loaded
> /opt/ocaml/3.08.4/lib/site-lib/netstring/netaccel_link.cmo: loaded
> /opt/ocaml/3.08.4/lib/site-lib/netstring/compatcgi.cma: loaded
> /opt/ocaml/3.08.4/lib/site-lib/pxp-engine: added to search path
> /opt/ocaml/3.08.4/lib/site-lib/pxp-engine/pxp_engine.cma: loaded
> /opt/ocaml/3.08.4/lib/site-lib/pxp-engine/pxp_top.cmo: loaded
> /opt/ocaml/3.08.4/lib/site-lib/pxp-addons: added to search path
> /opt/ocaml/3.08.4/lib/site-lib/pxp-addons/pxp-addons.cma: loaded
> /opt/ocaml/3.08.4/lib/site-lib/postgres: added to search path
> /opt/ocaml/3.08.4/lib/site-lib/postgres/postgres.cma: loaded
> /opt/ocaml/3.08.4/lib/site-lib/ocamlodbc_unixodbc: added to search path
> /opt/ocaml/3.08.4/lib/site-lib/ocamlodbc_unixodbc/ocamlodbc.cma: loaded
> /opt/ocaml/3.08.4/lib/site-lib/dbinterface: added to search path
> /opt/ocaml/3.08.4/lib/site-lib/dbinterface/dbinterface.cma: loaded
> /opt/ocaml/3.08.4/lib/site-lib/xdbs_base: added to search path
> /opt/ocaml/3.08.4/lib/site-lib/xdbs_base/xdbs_lib.cma: loaded
> /opt/ocaml/3.08.4/lib/site-lib/xdbschema: added to search path
> /opt/ocaml/3.08.4/lib/site-lib/xdbschema/xdbschema.cma: loaded
> /opt/ocaml/3.08.4/lib/site-lib/esql_lib: added to search path
> /opt/ocaml/3.08.4/lib/site-lib/esql_lib/esql_lib.cma: loaded
> /opt/ocaml/3.08.4/lib/site-lib/esql_qexp: added to search path
> /opt/ocaml/3.08.4/lib/site-lib/esql_qexp/esql_qexp.cma: loaded
> # #require "dmd_db";;
> /opt/ocaml/3.08.4/lib/site-lib/dmd_db: added to search path
> /opt/ocaml/3.08.4/lib/site-lib/dmd_db/db_dmd.cma: loaded
> # #require "xcaml_runtime_lib";;
> /opt/ocaml/3.08.4/lib/ocaml/dynlink.cma: loaded
> /opt/ocaml/3.08.4/lib/site-lib/cryptokit: added to search path
> /opt/ocaml/3.08.4/lib/site-lib/cryptokit/cryptokit.cma: loaded
> /opt/ocaml/3.08.4/lib/site-lib/xcaml_runtime_lib: added to search path
> /opt/ocaml/3.08.4/lib/site-lib/xcaml_runtime_lib/xcaml_runtime_lib.cma: loaded
> # <:sql< ACCESS Anagrafiche THROUGH Default_db.Pipeline DIRECT QUERY Example IS SELECT id_ente FROM ente >>;;
> Toplevel input:
> # <:sql< ACCESS Anagrafiche THROUGH Default_db.Pipeline DIRECT QUERY Example IS SELECT id_ente FROM ente >>;;
>   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
> While parsing result of quotation "sql": dumping result...
> module Example = struct
>   open Duality
>   module Pipe = Default_db.Pipeline
>   let query_name = "Example"
>   let int_of_string s = try int_of_string s with _ -> Printf.kprintf failwith "In query %s: Failure: cannot convert %S to an integer" query_name s
>   module Sql_query = Sql.Translate (Anagrafiche)
>   module DB = Dbinterface.Connection (Pipe) (Anagrafiche)
>   open Sql_query
>   type record = {
>     id_ente : string option;
>   }
>   let fieldnames = [|
>     "id_ente";
>   |]
>   let record_of_vector v = {
>     id_ente = ((Option.apply_opt Duality.identity)) v.(0);
>   }
>   let record_of_array a = {
>     id_ente =  (Option.optify +> (Option.apply_opt Duality.identity)) a.(0);
>   }
>   let record_of_list l = record_of_vector (Array.of_list l)
>   let records_of_table t = Array.map record_of_array t
>   let records_of_result res = Array.map record_of_array (Sql.get_table res)
>   let records_of_table_opt t = Array.map record_of_vector t
>   let make_table_opt t = Array.map (Array.map Option.optify) t
>   let records_of_res res = Array.map record_of_array (Sql.get_table res)
>   let vector_of_record r = [|
>    (Option.apply_default_opt None Duality.identity) r.id_ente;
>   |]
>   let list_of_record r = [
>    (Option.apply_default_opt None Duality.identity) r.id_ente;
>   ]
>   let table_of_records rv = Array.map vector_of_record rv
>   let field_list : Anagrafiche.field_tag list = [ `Id_ente;   ]
>   let from : Sql_query.table_expr list = [ `TABLE(`Ente `All);  ]
>   let where : Sql_query.query Anagrafiche.select_cond list = [  `TRUE;  ]
>   let groupby : Anagrafiche.field_tag list = [  ]
>   let having : Sql_query.query Anagrafiche.select_cond list = [  `TRUE;  ]
>   let orderby  : Anagrafiche.order_tag list = [  ]
>   let query : DB.query = `SELECT2(false, field_list, from, where, groupby, having, orderby)
>   let query_text = lazy(Sql_query.sql_query query)
>   let db_exec () = Sql.check_result (DB.exec query)
>   let table () = Sql.get_table (DB.exec query)
>   let table_opt () = make_table_opt (table ())
>   let records () = records_of_table  (table ())
>   let lazy_table = lazy (table ())
>   let table_once () = Lazy.force lazy_table
>   let table_opt_once () = make_table_opt (table_once ())
>   let records_once () = records_of_table  (table_once ())
>   let rec cont fl fr = (basic_continuation query) <-< fl >-> fr
> end
> 
> File "/dev/stderr", line 53, characters -2286--2280:
> Parse error: illegal begin of expression
> # module Example = struct
>   open Duality
>   module Pipe = Default_db.Pipeline
>   let query_name = "Example"
>   let int_of_string s = try int_of_string s with _ -> Printf.kprintf failwith "In query %s: Failure: cannot convert %S to an integer" query_name s
>   module Sql_query = Sql.Translate (Anagrafiche)
>   module DB = Dbinterface.Connection (Pipe) (Anagrafiche)
>   open Sql_query
>   type record = {
>     id_ente : string option;
>   }
>   let fieldnames = [|
>     "id_ente";
>   |]
>   let record_of_vector v = {
>     id_ente = ((Option.apply_opt Duality.identity)) v.(0);
>   }
>   let record_of_array a = {
>     id_ente =  (Option.optify +> (Option.apply_opt Duality.identity)) a.(0);
>   }
>   let record_of_list l = record_of_vector (Array.of_list l)
>   let records_of_table t = Array.map record_of_array t
>   let records_of_result res = Array.map record_of_array (Sql.get_table res)
>   let records_of_table_opt t = Array.map record_of_vector t
>   let make_table_opt t = Array.map (Array.map Option.optify) t
>   let records_of_res res = Array.map record_of_array (Sql.get_table res)
>   let vector_of_record r = [|
>    (Option.apply_default_opt None Duality.identity) r.id_ente;
>   |]
>   let list_of_record r = [
>    (Option.apply_default_opt None Duality.identity) r.id_ente;
>   ]
>   let table_of_records rv = Array.map vector_of_record rv
>   let field_list : Anagrafiche.field_tag list = [ `Id_ente;   ]
>   let from : Sql_query.table_expr list = [ `TABLE(`Ente `All);  ]
>   let where : Sql_query.query Anagrafiche.select_cond list = [  `TRUE;  ]
>   let groupby : Anagrafiche.field_tag list = [  ]
>   let having : Sql_query.query Anagrafiche.select_cond list = [  `TRUE;  ]
>   let orderby  : Anagrafiche.order_tag list = [  ]
>   let query : DB.query = `SELECT2(false, field_list, from, where, groupby, having, orderby)
>   let query_text = lazy(Sql_query.sql_query query)
>   let db_exec () = Sql.check_result (DB.exec query)
>   let table () = Sql.get_table (DB.exec query)
>   let table_opt () = make_table_opt (table ())
>   let records () = records_of_table  (table ())
>   let lazy_table = lazy (table ())
>   let table_once () = Lazy.force lazy_table
>   let table_opt_once () = make_table_opt (table_once ())
>   let records_once () = records_of_table  (table_once ())
>   let rec cont fl fr = (basic_continuation query) <-< fl >-> fr
> end
>                                                                                                       ;;
> Exception: Failure "Default_db: uninitialized".

Alex

-- 
*********************************************************************
http://www.barettadeit.com/
Baretta DE&IT
A division of Baretta SRL

tel. +39 02 370 111 55
fax. +39 02 370 111 54

Our technology:

The Application System/Xcaml (AS/Xcaml)
<http://www.asxcaml.org/>

The FreerP Project
<http://www.freerp.org/>