How to Create Sensible Debugging Information when Dynamically Typechecking Code Generated with camlp5 Quotations

How to Create Sensible Debugging Information when Dynamically Typechecking Code Generated with camlp5 Quotations

[echinuz echinuz]

[-- Attachment #1: Type: text/plain, Size: 1333 bytes --]

I have a DSL that I embedded using quotations with camlp5.  Essentially, there are a number of features that are useful in ocaml, such as file io, that I don't want to add to the language.  Using quotations allows me to add these features.  The language, by itself, can be statically type checked, but since I allow antiquotations I must type check at runtime.  Unfortunately, I'm having trouble figuring out a sensible way to add debugging information during type checking.  A typical program looks like this:

let x=... in
let prog= <:prog<
     embedded commands...
     more embedded commands...
>> in
execute prog;;

The problem with location information generated in camlp5 is that it gives the location relative to the quote.  I'm more interested in location information relative to the entire program.  One thought is to run the file through camlp5 twice and generate location information using trick similar to __LOCATION__ from pa_macro.  However, since the first pass through expands the quotations, the subsequent location information tends to be deceptive.

Is there a good way to generate this location information?  Or, more generally, is there a better way to type check the resulting program?
 
       
---------------------------------
Be a better friend, newshound, and know-it-all with Yahoo! Mobile.  Try it now.

[-- Attachment #2: Type: text/html, Size: 1559 bytes --]

Re: [Caml-list] How to Create Sensible Debugging Information when Dynamically Typechecking Code Generated with camlp5 Quotations

[Nicolas Pouillard]

Note: Camlp4 give you locations relative to the entire program ;)

Regards,

Excerpts from echinuz echinuz's message of Fri Dec 14 22:22:23 +0100 2007:
> I have a DSL that I embedded using quotations with camlp5.  Essentially, there
> are a number of features that are useful in ocaml, such as file io, that I
> don't want to add to the language.  Using quotations allows me to add these
> features.  The language, by itself, can be statically type checked, but since I
> allow antiquotations I must type check at runtime.  Unfortunately, I'm having
> trouble figuring out a sensible way to add debugging information during type
> checking.  A typical program looks like this:
> 
> let x=... in
> let prog= <:prog<
>      embedded commands...
>      more embedded commands...
> >> in
> execute prog;;
> 
> The problem with location information generated in camlp5 is that it gives the
> location relative to the quote.  I'm more interested in location information
> relative to the entire program.  One thought is to run the file through camlp5
> twice and generate location information using trick similar to __LOCATION__
> from pa_macro.  However, since the first pass through expands the quotations,
> the subsequent location information tends to be deceptive.
> 
> Is there a good way to generate this location information?  Or, more generally,
> is there a better way to type check the resulting program?
>  

-- 
Nicolas Pouillard aka Ertai

Re: [Caml-list] How to Create Sensible Debugging Information when Dynamically Typechecking Code Generated with camlp5 Quotations

[Daniel de Rauglaudre]

Hi,

On Fri, Dec 14, 2007 at 01:22:23PM -0800, echinuz echinuz wrote:

> The language, by itself, can be statically type checked, but since I
> allow antiquotations I must type check at runtime.

I don't understand that. Antiquotations do not imply runtime type
checking: they are just syntax.

> let x=... in
> let prog= <:prog<
>      embedded commands...
>      more embedded commands...
> >> in
> execute prog;;
> 
> The problem with location information generated in camlp5 is that it
> gives the location relative to the quote.

If the above program is OCaml+Camlp5 (I mean, not your language with
your syntax and semantics), I don't understand what you say : the
location information is absolutely not relative to the quotation !

But, perhaps, you mean : in error messages, the entire quotation is
underlined even if the message concerns a sub-part of the quotation ?

By defaut, typing errors show the entire quotation, because the
system cannot know where is the precise location of the error,
a quotation being any text. There is no knowledge of the
correspondence between the quotation text and the syntax tree,
and even no guarantee that such a correspondence exists !

For example if the code is :
   <:prog< this is a variable foo >>
and the typing error message is :
   Unbound variable : foo

there is no reason why the variable "foo" would match the text "foo" of
the quotation text. It could be a quotation expander returning
<:expr< foo >> whatever the quotation text. Therefore the OCaml typing
has no reason to underline the text "foo" of the quotation.

This is why the default behaviour of the Camlp5 quotation system
set the entire quotation in the whole syntax tree of the quotation.

If you want to specify a specific location to a part of your quotation,
you have to create specific nodes <:expr< $anti:x$ >> or <:patt< $anti:x$ >>
around these nodes. See the chapter about quotations and the one about
locations in Camlp5 documentation.

If you use Camlp5 extensible grammars to parse your quotation, or parts
of your quotation, you may have your quotation or these parts of your
quotation correctly located, relative to the quotation, and a good usage
of the antiquotation nodes above should give you correct typing error
messages, relative to the entire program.

Location is indeed a difficult part in programming quotations. Bad
programmed, errors can be shown in unexpected parts of the program.
You have to read the documentation and understand exactly what things
mean.

Hope this helps.

-- 
Daniel de Rauglaudre
http://pauillac.inria.fr/~ddr/

Re: [Caml-list] How to Create Sensible Debugging Information when Dynamically Typechecking Code Generated with camlp5 Quotations

[echinuz echinuz]

[-- Attachment #1: Type: text/plain, Size: 3609 bytes --]

Allow me to clarify what I meant by type errors and antiquotations.  Here is a very simple program that contains the parser, type checker, and quotation generator:

---------------------------------------
#load "pa_extend.cmo";;
#load "q_MLast.cmo";;

(* Parser *)
type palg=
| PApp of string*palg list
| PInt of string
| PFlo of string;;


let g=Grammar.gcreate (Plexer.gmake ());;
let exp_eoi = Grammar.Entry.create g "exp_eoi";;

EXTEND
    GLOBAL: exp_eoi;
    exp_eoi:
        [[ x = exp; EOI -> x ]] ;
    exp:
        [[x=INT -> PInt x
        | x=FLOAT -> PFlo x
        | f = LIDENT; "("; xs=LIST1 SELF SEP ","; ")"-> PApp (f,xs)]];
END;;

let parse s = Grammar.Entry.parse exp_eoi (Stream.of_string s);;

(* Type Checker *)
exception TypeError;;
type integer=[`Int];;
type real=[integer | `Real];;
let rec type_expr=function
    | PApp (f,args) ->
        (match f with
        | "add" ->
            if List.length args != 2 then
                raise TypeError
            else
                let args=List.map type_expr args in
                (match (List.nth args 0,List.nth args 1) with
                | #integer,#integer -> `Int
                | #real,#real -> `Real)
        | _ -> raise TypeError)
    | PInt _ -> `Int
    | PFlo _ -> `Real
;;


(* Quotations *)
type alg=
| App of string*alg list
| Int of int
| Flo of float;;

let loc=Ploc.dummy;;
let rec to_expr=function
    | PInt x-> <:expr< Int $int:x$ >>
    | PFlo x-> <:expr< Flo $flo:x$ >>
    | PApp (f,el)->
        let rec make_el=function
            | x::xs -> <:expr< [$x$::$make_el xs$] >>
            | [] -> <:expr< [] >>
        in
        let el=List.map to_expr el in
        let el=make_el el in
        <:expr< App ($str:f$,$el$) >>
;;
let rec to_patt=function
    | PInt x-> <:patt< Int $int:x$ >>
    | PFlo x-> <:patt< Flo $flo:x$ >>
    | PApp (f,el)->
        let rec make_el=function
            | x::xs -> <:patt< [$x$::$make_el xs$] >>
            | [] -> <:patt< [] >>
        in
        let el=List.map to_patt el in
        let el=make_el el in
        <:patt< App ($str:f$,$el$) >>
;;

let expand_expr s=
    let p=parse s in
    let t=type_expr p in
    to_expr p
;;
let expand_patt s=
    let p=parse s in
    let t=type_expr p in
    to_patt p
;;
Quotation.add "exp" (Quotation.ExAst (expand_expr,expand_patt));;
 ---------------------------------------

Thus, by type check, I mean actually verifying the typing rules of the DSL.  In this case, it means that the only function allowed is "add" and that this function requires two arguments.  Now, imagine the above language where antiquotations are allowed.  The parsed AST would have datatype

type palg=
| PApp of string*palg list
| PInt of string
| PFlo of string
| PQuote of Ploc.t*string

and it becomes impossible to type check in the above sense since we can not ascertain the type of PQuote.  Now, we can still type check the resulting AST of type alg (not palg).  But, this must occur at runtime rather than during the preprocessing step at compile time.  Therein lies the problem.

If we discover a type error during runtime, it would be nice to give the user some indication of where the error occurs short of saying, "Add expects two arguments."  Since the location information provided is relative to the quote, it can still be challenging to determine exactly where the type error occurs.  Thus, I'm either trying to obtain better location information or perhaps learn that there's a better place or method to type check than what I'm using.

       
---------------------------------
Never miss a thing.   Make Yahoo your homepage.

[-- Attachment #2: Type: text/html, Size: 5789 bytes --]

Re: [Caml-list] How to Create Sensible Debugging Information when Dynamically Typechecking Code Generated with camlp5 Quotations

[Daniel de Rauglaudre]

Hi,

On Sat, Dec 15, 2007 at 11:32:55AM -0800, echinuz echinuz wrote:

> Allow me to clarify what I meant by type errors and antiquotations.
> Here is a very simple program that contains the parser, type
> checker, and quotation generator:

After having tested your program, I indeed see:

    $ ocamlc -pp camlp5o -I +camlp5 -c toto.ml
    $ ledit ocaml -I +camlp5 camlp5o.cma ./toto.cmo
             Objective Caml version ...

             Camlp5 Parsing version ...

    # <:exp< add(3) >>;;
    Toplevel input:
    # <:exp< add(3) >>;;
      ^^^^^^^^^^^^^^^^
    While expanding quotation "exp":
    Uncaught exception: Toto.TypeError

Would you like that only "add" be underlined ? It is possible.

You miss information of the location in your syntax tree. I suggest to
change your type "palg", on the constructor "PApp" like this:

    | PApp of string*Ploc.t*palg list

where the 2nd argument is the location of the function represented by
the string (1st argument).

The grammar rule for reading a function with arguments could be
changed into:

      | (f,floc) = lident; "("; xs=LIST1 SELF SEP ","; ")"->
          PApp (f,floc,xs)]];

needing an extra rule, "lident", where the location of the identifier is
recorded:
     lident:
       [[x = LIDENT -> (x, loc)]];

Change the rest of your program to fix the fact that PApp has now three
arguments instead of two.

In the function "type_expr", the case:
    | PApp (f,args) ->
becomes:
    | PApp (f,loc,args) ->

And the following typing error:
            if List.length args != 2 then
                raise TypeError
becomes:
            if List.length args != 2 then
                Ploc.raise loc TypeError

Recompile and test:

    $ ocamlc -pp camlp5o -I +camlp5 -c toto.ml
    $ ledit ocaml -I +camlp5 camlp5o.cma ./toto.cmo
            Objective Caml version ...

            Camlp5 Parsing version ...

    # <:exp< add(3) >>;;
    Toplevel input:
    # <:exp< add(3) >>;;
             ^^^
    While expanding quotation "exp":
    Uncaught exception: Toto.TypeError

Does it answer your problem ?

-- 
Daniel de Rauglaudre
http://pauillac.inria.fr/~ddr/

Re: [Caml-list] How to Create Sensible Debugging Information when Dynamically Typechecking Code Generated with camlp5 Quotations

[echinuz echinuz]

[-- Attachment #1: Type: text/plain, Size: 4514 bytes --]

That's very close to what I'd like, but quotations cause a problem.  With quotations, it's impossible to type check during preprocessing.  It must occur after the AST has been formed.  In this case, Ploc.raise doesn't generate nice error messages like it does during preprocessing.  Here's the offending code:

------------------------------
#load "pa_extend.cmo";;
#load "q_MLast.cmo";;

(* Parser *)
type palg=
| PApp of Ploc.t*string*palg list
| PInt of Ploc.t*string
| PFlo of Ploc.t*string
| PQuote of Ploc.t*string;;

let g=Grammar.gcreate (Plexer.gmake ());;
let exp_eoi = Grammar.Entry.create g "exp_eoi";;

EXTEND
    GLOBAL: exp_eoi;
    exp_eoi:
        [[ x = exp; EOI -> x ]] ;
    exp:
        [[x=INT -> PInt (loc,x)
        | x=FLOAT -> PFlo (loc,x)
        | (f,loc)=lident; "("; xs=LIST1 SELF SEP ","; ")"-> PApp (loc,f,xs)
        | x=ANTIQUOT-> PQuote(loc,x)]];
    lident:
        [[x = LIDENT -> (x, loc)]];
END;;

let parse s = Grammar.Entry.parse exp_eoi (Stream.of_string s);;

(* Quotations *)
type alg=
| App of Ploc.t*string*alg list
| Int of Ploc.t*int
| Flo of Ploc.t*float;;

let get_loc l=
    string_of_int (Ploc.line_nb l),
    string_of_int (Ploc.bol_pos l),
    string_of_int (Ploc.first_pos l),
    string_of_int (Ploc.last_pos l)
;;
let rec to_expr=function
    | PInt (loc,x)->
        let line_nb,bol_pos,bp,ep=get_loc loc in
        <:expr< Int (Ploc.make $int:line_nb$ $int:bol_pos$ ($int:bp$,$int:ep$),
            $int:x$) >>
    | PFlo (loc,x)->
        let line_nb,bol_pos,bp,ep=get_loc loc in
        <:expr< Flo (Ploc.make $int:line_nb$ $int:bol_pos$ ($int:bp$,$int:ep$),
            $flo:x$) >>
    | PApp (loc,f,el)->
        let line_nb,bol_pos,bp,ep=get_loc loc in
        let rec make_el=function
            | x::xs -> <:expr< [$x$::$make_el xs$] >>
            | [] -> <:expr< [] >>
        in
        let el=List.map to_expr el in
        let el=make_el el in
        <:expr< App(Ploc.make $int:line_nb$ $int:bol_pos$ ($int:bp$,$int:ep$),
            $str:f$,$el$) >>
    | PQuote (loc,x)->
        let loc=Ploc.make (Ploc.line_nb loc) (Ploc.bol_pos loc)
            (Ploc.first_pos loc + 1,Ploc.last_pos loc + 1)
        in
        let x=Grammar.Entry.parse Pcaml.expr_eoi (Stream.of_string x) in
        <:expr< $anti:x$ >>
;;
let rec to_patt=function
    | PInt (loc,x)->
        let line_nb,bol_pos,bp,ep=get_loc loc in
        <:patt< Int (Ploc.make $int:line_nb$ $int:bol_pos$ ($int:bp$,$int:ep$),
            $int:x$) >>
    | PFlo (loc,x)->
        let line_nb,bol_pos,bp,ep=get_loc loc in
        <:patt< Flo (Ploc.make $int:line_nb$ $int:bol_pos$ ($int:bp$,$int:ep$),
            $flo:x$) >>
    | PApp (loc,f,el)->
        let line_nb,bol_pos,bp,ep=get_loc loc in
        let rec make_el=function
            | x::xs -> <:patt< [$x$::$make_el xs$] >>
            | [] -> <:patt< [] >>
        in
        let el=List.map to_patt el in
        let el=make_el el in
        <:patt< App (Ploc.make $int:line_nb$ $int:bol_pos$ ($int:bp$,$int:ep$),
            $str:f$,$el$) >>
    | PQuote (loc,x)->
        let loc=Ploc.make (Ploc.line_nb loc) (Ploc.bol_pos loc)
            (Ploc.first_pos loc + 1,Ploc.last_pos loc + 1)
        in
        let x=Grammar.Entry.parse Pcaml.patt_eoi (Stream.of_string x) in
        <:patt< $anti:x$ >>
;;

let expand_expr s=to_expr (parse s);;
let expand_patt s=to_patt (parse s);;

Quotation.add "exp" (Quotation.ExAst (expand_expr,expand_patt));;

(* Type Checker *)
exception TypeError;;
type integer=[`Int];;
type real=[integer | `Real];;
let rec type_expr=function
    | App (loc,f,args) ->
        (match f with
        | "add" ->
            if List.length args != 2 then
                Ploc.raise loc TypeError
            else
                let args=List.map type_expr args in
                (match (List.nth args 0,List.nth args 1) with
                | #integer,#integer -> `Int
                | #real,#real -> `Real)
        | _ -> Ploc.raise loc TypeError)
    | Int _ -> `Int
    | Flo _ -> `Real
;;
------------------------------

How do you generate nice error messages with location information as they occur during preprocessing?  As a corollary, is there an easier way to extract location information into the final AST other than removing each of the four integers, converting them to strings, and inserting them with antiquotations manually (Ploc.make $int:line_nb$ $int:bol_pos$ ($int:bp$,$int:ep$))?

       
---------------------------------
Never miss a thing.   Make Yahoo your homepage.

[-- Attachment #2: Type: text/html, Size: 7922 bytes --]

Re: [Caml-list] How to Create Sensible Debugging Information when Dynamically Typechecking Code Generated with camlp5 Quotations

[Daniel de Rauglaudre]

Hi,

On Sun, Dec 16, 2007 at 07:29:24PM -0800, echinuz echinuz wrote:

> That's very close to what I'd like, but quotations cause a problem.
> With quotations, it's impossible to type check during preprocessing.
> It must occur after the AST has been formed. In this case,
> Ploc.raise doesn't generate nice error messages like it does during
> preprocessing.  Here's the offending code:

Please give also an example showing the problem. I understand with
examples.

-- 
Daniel de Rauglaudre
http://pauillac.inria.fr/~ddr/

Re: [Caml-list] How to Create Sensible Debugging Information when Dynamically Typechecking Code Generated with camlp5 Quotations

[echinuz echinuz]

[-- Attachment #1: Type: text/plain, Size: 7979 bytes --]

Without quotations, the code looks like:

---------------------------------------
$ cat alg.ml
#load "pa_extend.cmo";;
#load "q_MLast.cmo";;

(* Parser *)
type palg=
| PApp of Ploc.t*string*palg list 
| PInt of Ploc.t*string 
| PFlo of Ploc.t*string;;


let g=Grammar.gcreate (Plexer.gmake ());;
let exp_eoi = Grammar.Entry.create g "exp_eoi";;

EXTEND
    GLOBAL: exp_eoi;
    exp_eoi:
        [[ x = exp; EOI -> x ]] ;
    exp:
        [[x=INT -> PInt (loc,x)
        | x=FLOAT -> PFlo (loc,x)
        | (f,floc)=lident; "("; xs=LIST1 SELF SEP ","; ")"->PApp (floc,f,xs)]];
    lident:
        [[x = LIDENT -> (x, loc)]]; 
END;;

let parse s = Grammar.Entry.parse exp_eoi (Stream.of_string s);;

(* Type Checker *)
exception TypeError;;
type integer=[`Int];;
type real=[integer | `Real];;
let rec type_expr=function
    | PApp (loc,f,args) ->
        (match f with
        | "add" ->
            if List.length args != 2 then
                Ploc.raise loc TypeError
            else
                let args=List.map type_expr args in 
                (match (List.nth args 0,List.nth args 1) with
                | #integer,#integer -> `Int
                | #real,#real -> `Real)
        | _ -> Ploc.raise loc TypeError)
    | PInt _ -> `Int
    | PFlo _ -> `Real
;;


(* Quotations *)
type alg=
| App of string*alg list
| Int of int
| Flo of float;;

let loc=Ploc.dummy;;
let rec to_expr=function
    | PInt (loc,x)-> <:expr< Alg.Int $int:x$ >>
    | PFlo (loc,x)-> <:expr< Alg.Flo $flo:x$ >>
    | PApp (loc,f,el)->
        let rec make_el=function
            | x::xs -> <:expr< [$x$::$make_el xs$] >>
            | [] -> <:expr< [] >>
        in
        let el=List.map to_expr el in
        let el=make_el el in
        <:expr< Alg.App ($str:f$,$el$) >>
;;
let rec to_patt=function
    | PInt (loc,x)-> <:patt< Alg.Int $int:x$ >>
    | PFlo (loc,x)-> <:patt< Alg.Flo $flo:x$ >>
    | PApp (loc,f,el)->
        let rec make_el=function
            | x::xs -> <:patt< [$x$::$make_el xs$] >>
            | [] -> <:patt< [] >>
        in
        let el=List.map to_patt el in
        let el=make_el el in
        <:patt< Alg.App ($str:f$,$el$) >>
;;

let expand_expr s=
    let p=parse s in
    let t=type_expr p in
    to_expr p
;;
let expand_patt s=
    let p=parse s in
    let t=type_expr p in
    to_patt p
;;
Quotation.add "exp" (Quotation.ExAst (expand_expr,expand_patt));;
---------------------------------------

When run on the test file:

---------------------------------------
 $ cat test.ml
let x=2;; 
let x=3;;
let x=4;;
let y= <:exp< add(1,2,3) >>;;
---------------------------------------

We receive the error:

---------------------------------------
ocamlc -I +camlp5 -pp "camlp5o ./alg.cmo" test.ml -o test
File "test.ml", line 4, characters 14-17:
While expanding quotation "exp":
Uncaught exception: Alg.TypeError
Preprocessor error
make: *** [all] Error 2
---------------------------------------

This is a good error message and exactly what I want.  Now, we modify the above code to add quotations:

---------------------------------------
$ cat alg.ml
#load "pa_extend.cmo";;
#load "q_MLast.cmo";;

(* Parser *)
type palg=
| PApp of Ploc.t*string*palg list 
| PInt of Ploc.t*string 
| PFlo of Ploc.t*string
| PQuote of Ploc.t*string;;

let g=Grammar.gcreate (Plexer.gmake ());;
let exp_eoi = Grammar.Entry.create g "exp_eoi";;

EXTEND
    GLOBAL: exp_eoi;
    exp_eoi:
        [[ x = exp; EOI -> x ]] ;
    exp:
        [[x=INT -> PInt (loc,x)
        | x=FLOAT -> PFlo (loc,x)
        | (f,floc)=lident; "("; xs=LIST1 SELF SEP ","; ")"-> PApp (floc,f,xs)
        | x=ANTIQUOT-> PQuote(loc,x)]];
    lident:
        [[x = LIDENT -> (x, loc)]]; 
END;;

let parse s = Grammar.Entry.parse exp_eoi (Stream.of_string s);;

(* Quotations *)
type alg=
| App of Ploc.t*string*alg list
| Int of Ploc.t*int
| Flo of Ploc.t*float;;

let get_loc l=
    string_of_int (Ploc.line_nb l),
    string_of_int (Ploc.bol_pos l),
    string_of_int (Ploc.first_pos l),
    string_of_int (Ploc.last_pos l)
;;
let rec to_expr=function
    | PInt (loc,x)->
        let line_nb,bol_pos,bp,ep=get_loc loc in
        <:expr< Alg.Int (
            Ploc.make$int:line_nb$ $int:bol_pos$ ($int:bp$,$int:ep$),
            $int:x$) >>
    | PFlo (loc,x)-> 
        let line_nb,bol_pos,bp,ep=get_loc loc in
        <:expr< Alg.Flo (
            Ploc.make $int:line_nb$ $int:bol_pos$ ($int:bp$,$int:ep$),
            $flo:x$) >>
    | PApp (loc,f,el)->
        let line_nb,bol_pos,bp,ep=get_loc loc in
        let rec make_el=function
            | x::xs -> <:expr< [$x$::$make_el xs$] >>
            | [] -> <:expr< [] >>
        in
        let el=List.map to_expr el in
        let el=make_el el in
        <:expr< Alg.App(
            Ploc.make $int:line_nb$ $int:bol_pos$ ($int:bp$,$int:ep$),
            $str:f$,$el$) >>
    | PQuote (loc,x)->
        let loc=Ploc.make (Ploc.line_nb loc) (Ploc.bol_pos loc)
            (Ploc.first_pos loc + 1,Ploc.last_pos loc + 1)
        in
        let x=Grammar.Entry.parse Pcaml.expr_eoi (Stream.of_string x) in
        <:expr< $anti:x$ >>
;;
let rec to_patt=function
    | PInt (loc,x)-> 
        let line_nb,bol_pos,bp,ep=get_loc loc in
        <:patt< Alg.Int (
            Ploc.make $int:line_nb$ $int:bol_pos$ ($int:bp$,$int:ep$),
            $int:x$) >>
    | PFlo (loc,x)-> 
        let line_nb,bol_pos,bp,ep=get_loc loc in
        <:patt< Alg.Flo (
            Ploc.make $int:line_nb$ $int:bol_pos$ ($int:bp$,$int:ep$),
            $flo:x$) >>
    | PApp (loc,f,el)->
        let line_nb,bol_pos,bp,ep=get_loc loc in
        let rec make_el=function
            | x::xs -> <:patt< [$x$::$make_el xs$] >>
            | [] -> <:patt< [] >>
        in
        let el=List.map to_patt el in
        let el=make_el el in
        <:patt< Alg.App (
            Ploc.make $int:line_nb$ $int:bol_pos$ ($int:bp$,$int:ep$),
            $str:f$,$el$) >>
    | PQuote (loc,x)->
        let loc=Ploc.make (Ploc.line_nb loc) (Ploc.bol_pos loc)
            (Ploc.first_pos loc + 1,Ploc.last_pos loc + 1)
        in
        let x=Grammar.Entry.parse Pcaml.patt_eoi (Stream.of_string x) in
        <:patt< $anti:x$ >>
;;

let expand_expr s=to_expr (parse s);;
let expand_patt s=to_patt (parse s);;

Quotation.add "exp" (Quotation.ExAst (expand_expr,expand_patt));;

(* Type Checker *)
exception TypeError;;
type integer=[`Int];;
type real=[integer | `Real];;
let rec type_expr=function
    | App (loc,f,args) ->
        (match f with
        | "add" ->
            if List.length args != 2 then
                Ploc.raise loc TypeError
            else
                let args=List.map type_expr args in 
                (match (List.nth args 0,List.nth args 1) with
                | #integer,#integer -> `Int
                | #real,#real -> `Real)
        | _ -> Ploc.raise loc TypeError)
    | Int _ -> `Int
    | Flo _ -> `Real
;;
---------------------------------------

Then, we use this program with the test file:

---------------------------------------
$ cat test.ml
let x=2;; 
let x=3;;
let x=4;;
let y= <:exp< add(1,2,3) >>;;
let z= Alg.type_expr y;;
---------------------------------------

Everything compiles fine since we no longer type check during compilation:

---------------------------------------
ocamlc -I +camlp5 -pp "camlp5o ./alg.cmo" camlp5.cma alg.cmo test.ml -o test
---------------------------------------

However, when we run the following executable, we receive the error:

---------------------------------------
$ ./test
Fatal error: exception Ploc.Exc(_, _)
---------------------------------------

This contains no location information since Plot.Exc is not caught and handled in the same manner as it is during preprocessing.  I would like an error similar to the first case, when there were no quotations, to be shown in the second case, when there are quotations.

Thanks for your help.

       
---------------------------------
Looking for last minute shopping deals?  Find them fast with Yahoo! Search.

[-- Attachment #2: Type: text/html, Size: 14037 bytes --]

Re: [Caml-list] How to Create Sensible Debugging Information when Dynamically Typechecking Code Generated with camlp5 Quotations

[Nicolas Pouillard]

[-- Attachment #1: Type: text/plain, Size: 6678 bytes --]

Excerpts from echinuz echinuz's message of Sat Dec 15 20:32:55 +0100 2007:
> Allow me to clarify what I meant by type errors and antiquotations.  Here is a
> very simple program that contains the parser, type checker, and quotation
> generator:

Ok,  I  understand your problem and will try to help you using Camlp4 examples
based on your original code.

In  first  I  attach  alg1.ml that is some minimum translation of your code in
order to use Camlp4 and to have locations.

I also attach a _tags file that helps ocamlbuild to build them.

Let's try this first example using alg1_test.ml.

$ mkdir algtest
$ cd algtest
$ cp <attachments> .
$ ocamlbuild alg1.cmo
$ cat alg1_test.ml
open Alg1;;
let x = <:exp< add(21, 21) >>;;
let y = <:exp< add(31, 11.0) >>;;
$ camlp4of ./_build/alg1.cmo alg1_test.ml
open Alg1
let x = App ("add", [ Int 21; Int 21 ])
let y = App ("add", [ Int 31; Flo 11.0 ])

Then  let's add antiquotations (alg1_ant.ml), basically one adds a Ant case to
the  alg type that will hold the antiquoted expression/pattern plus it's type.
We  embed  the  type  to  simplify the dynamic typing and don't involving some
type  inference.  One also embed the type of an expression at runtime in order
to check it against the type of the hole.

In  order to show some useful examples of typing errors one add strings values
to the language (alg1_ant_str.ml).

Here is the kind of program that we want accept:

$ cat alg1_ant_test.ml
open Alg1_ant;;
let x = <:exp< add(21, 21) >> in
let y = <:exp< add(31, 11.0) >> in
<:exp< add(add($Int: x$, $Real: y$), 42) >>

And the kind of programs that we want to dynamically reject:

$ cat alg1_ant_test_bad.ml
open Alg1_ant_str;;
let x = <:exp< "FOO" >> in
<:exp< add(42, $Int:x$) >>

Let's try the two new extensions:

# Compilation
$ ocamlbuild alg1_ant.cmo alg1_ant_str.cmo

# Let's look at the result
$ camlp4of ./_build/alg1_ant.cmo alg1_ant_test.ml
open Alg1_ant
let x = ((App ("add", [ Int 21; Int 21 ])), `Int) in
let y = ((App ("add", [ Int 31; Flo 11.0 ])), `Real)
in
  ((App ("add",
      [ App ("add",
          [ type_check
              (Loc.of_tuple
                 ("alg1_ant_test.ml", 4, 84, 100, 4, 84, 107, false))
              x `Int;
            type_check
              (Loc.of_tuple
                 ("alg1_ant_test.ml", 4, 84, 110, 4, 84, 118, false))
              y `Real ]);
        Int 42 ])),
   `Real)

# Let's compile and run the example
$ ocamlbuild alg1_ant_test.byte --

# Let's try the bad example to see that there is no static error.
$ camlp4of ./_build/alg1_ant_str.cmo alg1_ant_test_bad.ml
open Alg1_ant_str
let x = ((Str "FOO"), `Str)
in
  ((App ("add",
      [ Int 42;
        type_check
          (Loc.of_tuple
             ("alg1_ant_test_bad.ml", 3, 47, 63, 3, 47, 69, false))
          x `Int ])),
   `Int)

# Finally let's run it to show the runtime check failure.
$ ocamlbuild alg1_ant_test_bad.byte --
Dynamic Typing Error at File "alg1_ant_test_bad.ml", line 3, characters 16-22
Fatal error: exception Alg1_ant_str.TypeError

Hope that helps

Best regards,

> ---------------------------------------
> #load "pa_extend.cmo";;
> #load "q_MLast.cmo";;
> 
> (* Parser *)
> type palg=
> | PApp of string*palg list
> | PInt of string
> | PFlo of string;;
> 
> 
> let g=Grammar.gcreate (Plexer.gmake ());;
> let exp_eoi = Grammar.Entry.create g "exp_eoi";;
> 
> EXTEND
>     GLOBAL: exp_eoi;
>     exp_eoi:
>         [[ x = exp; EOI -> x ]] ;
>     exp:
>         [[x=INT -> PInt x
>         | x=FLOAT -> PFlo x
>         | f = LIDENT; "("; xs=LIST1 SELF SEP ","; ")"-> PApp (f,xs)]];
> END;;
> 
> let parse s = Grammar.Entry.parse exp_eoi (Stream.of_string s);;
> 
> (* Type Checker *)
> exception TypeError;;
> type integer=[`Int];;
> type real=[integer | `Real];;
> let rec type_expr=function
>     | PApp (f,args) ->
>         (match f with
>         | "add" ->
>             if List.length args != 2 then
>                 raise TypeError
>             else
>                 let args=List.map type_expr args in
>                 (match (List.nth args 0,List.nth args 1) with
>                 | #integer,#integer -> `Int
>                 | #real,#real -> `Real)
>         | _ -> raise TypeError)
>     | PInt _ -> `Int
>     | PFlo _ -> `Real
> ;;
> 
> 
> (* Quotations *)
> type alg=
> | App of string*alg list
> | Int of int
> | Flo of float;;
> 
> let loc=Ploc.dummy;;
> let rec to_expr=function
>     | PInt x-> <:expr< Int $int:x$ >>
>     | PFlo x-> <:expr< Flo $flo:x$ >>
>     | PApp (f,el)->
>         let rec make_el=function
>             | x::xs -> <:expr< [$x$::$make_el xs$] >>
>             | [] -> <:expr< [] >>
>         in
>         let el=List.map to_expr el in
>         let el=make_el el in
>         <:expr< App ($str:f$,$el$) >>
> ;;
> let rec to_patt=function
>     | PInt x-> <:patt< Int $int:x$ >>
>     | PFlo x-> <:patt< Flo $flo:x$ >>
>     | PApp (f,el)->
>         let rec make_el=function
>             | x::xs -> <:patt< [$x$::$make_el xs$] >>
>             | [] -> <:patt< [] >>
>         in
>         let el=List.map to_patt el in
>         let el=make_el el in
>         <:patt< App ($str:f$,$el$) >>
> ;;
> 
> let expand_expr s=
>     let p=parse s in
>     let t=type_expr p in
>     to_expr p
> ;;
> let expand_patt s=
>     let p=parse s in
>     let t=type_expr p in
>     to_patt p
> ;;
> Quotation.add "exp" (Quotation.ExAst (expand_expr,expand_patt));;
>  ---------------------------------------
> 
> Thus, by type check, I mean actually verifying the typing rules of the DSL.  In
> this case, it means that the only function allowed is "add" and that this
> function requires two arguments.  Now, imagine the above language where
> antiquotations are allowed.  The parsed AST would have datatype
> 
> type palg=
> | PApp of string*palg list
> | PInt of string
> | PFlo of string
> | PQuote of Ploc.t*string
> 
> and it becomes impossible to type check in the above sense since we can not
> ascertain the type of PQuote.  Now, we can still type check the resulting AST
> of type alg (not palg).  But, this must occur at runtime rather than during the
> preprocessing step at compile time.  Therein lies the problem.
> 
> If we discover a type error during runtime, it would be nice to give the user
> some indication of where the error occurs short of saying, "Add expects two
> arguments."  Since the location information provided is relative to the quote,
> it can still be challenging to determine exactly where the type error occurs. 
> Thus, I'm either trying to obtain better location information or perhaps learn
> that there's a better place or method to type check than what I'm using.
> 

-- 
Nicolas Pouillard aka Ertai

[-- Attachment #2: alg1.ml --]
[-- Type: application/octet-stream, Size: 2795 bytes --]

(* Parser *)
open Camlp4.PreCast;;

type palg=
| PApp of Loc.t * string * palg list (* if you want locations, you have to keep them *)
| PInt of Loc.t * string
| PFlo of Loc.t * string;;

module G = MakeGram(Lexer);; (* instead of let g=Grammar.gcreate (Plexer.gmake ());; *)
let exp_eoi = G.Entry.mk "exp_eoi";; (* instead of Grammar.Entry.create g "exp_eoi";; *)

EXTEND G (* specify which grammar you extend *)
  GLOBAL: exp_eoi;
  exp_eoi:
    [[ x = exp; `EOI (* `EOI instead of EOI *) -> x ]];
  exp:
    [[ x = INT -> PInt(_loc, x)
     | x = FLOAT -> PFlo(_loc, x)
     | f = LIDENT; "("; xs = LIST1 SELF SEP ","; ")" -> PApp(_loc, f, xs) ]];
END;;

let parse = G.parse_string exp_eoi;; (* instead of let parse s = Grammar.Entry.parse exp_eoi (Stream.of_string s);; *)

(* Type Checker *)
exception TypeError;;
type integer=[`Int];;
type real=[integer | `Real];;
let rec type_expr=function
  | PApp(_loc, f,args) ->
      begin match f, args with (* pattern matching is your friend *)
      | "add", [arg1; arg2] ->
          (match type_expr arg1, type_expr arg2 with
           | #integer,#integer -> `Int
           | #real,#real -> `Real)
      | _ -> Loc.raise _loc TypeError (* note the location wrapping to have a correct location *)
      end
  | PInt _ -> `Int
  | PFlo _ -> `Real
;;


(* Quotations *)
type alg=
| App of string*alg list
| Int of int
| Flo of float;;

(* One cannot expect good locations with this declaration: let loc=Ploc.dummy;; *)
let rec to_expr=function
    | PInt(_loc, x) -> <:expr< Int $int:x$ >>
    | PFlo(_loc, x) -> <:expr< Flo $flo:x$ >>
    | PApp(_loc, f, el)->
        let rec make_el=function
            | x::xs -> <:expr< $x$::$make_el xs$ >>
              (* instead of <:expr< [$x$::$make_el xs$] >> since I've used camlp4of *)
            | [] -> <:expr< [] >>
        in
        let el=List.map to_expr el in
        let el=make_el el in
        <:expr< App ($str:f$,$el$) >>
;;
let rec to_patt=function
    | PInt(_loc, x) -> <:patt< Int $int:x$ >>
    | PFlo(_loc, x) -> <:patt< Flo $flo:x$ >>
    | PApp(_loc, f, el) ->
        let rec make_el=function
            | x::xs -> <:patt< $x$::$make_el xs$ >>
            | [] -> <:patt< [] >>
        in
        let el=List.map to_patt el in
        let el=make_el el in
        <:patt< App ($str:f$,$el$) >>
;;

let expand_expr loc _loc_name s =
    let p = parse loc s in
    let _t = type_expr p in
    to_expr p
;;
let expand_patt loc _loc_name s =
    let p = parse loc s in
    let _t = type_expr p in
    to_patt p
;;

let expand_str_item loc loc_name s =
  <:str_item@loc< $exp:expand_expr loc loc_name s$ >>

module Q = Syntax.Quotation;;
Q.add "exp" Q.DynAst.expr_tag expand_expr;;
Q.add "exp" Q.DynAst.patt_tag expand_patt;;
Q.add "exp" Q.DynAst.str_item_tag expand_str_item;;

[-- Attachment #3: _tags --]
[-- Type: application/octet-stream, Size: 198 bytes --]

true: use_camlp4_full, camlp4of
<alg1_test.ml>: pp(camlp4of ./alg1.cmo)
<alg1_ant_test.ml>: pp(camlp4of ./alg1_ant.cmo)
<alg1_ant_test_bad.ml>: pp(camlp4of ./alg1_ant_str.cmo)
<*.byte>: use_dynlink

[-- Attachment #4: alg1_test.ml --]
[-- Type: application/octet-stream, Size: 78 bytes --]

open Alg1;;
let x = <:exp< add(21, 21) >>;;
let y = <:exp< add(31, 11.0) >>;;

[-- Attachment #5: alg1_ant.ml --]
[-- Type: application/octet-stream, Size: 4159 bytes --]

(* Parser *)
open Camlp4.PreCast;;
module Loc = Camlp4.PreCast.Loc;;

type palg=
| PApp of Loc.t * string * palg list (* if you want locations, you have to keep them *)
| PInt of Loc.t * string
| PFlo of Loc.t * string
| PAnt of Loc.t * string (* the type *) * string (* the expr/patt *)
;;

module G = MakeGram(Lexer);; (* instead of let g=Grammar.gcreate (Plexer.gmake ());; *)
let exp_eoi = G.Entry.mk "exp_eoi";; (* instead of Grammar.Entry.create g "exp_eoi";; *)

EXTEND G (* specify which grammar you extend *)
  GLOBAL: exp_eoi;
  exp_eoi:
    [[ x = exp; `EOI (* `EOI instead of EOI *) -> x ]];
  exp:
    [[ x = INT -> PInt(_loc, x)
     | x = FLOAT -> PFlo(_loc, x)
     | f = LIDENT; "("; xs = LIST1 SELF SEP ","; ")" -> PApp(_loc, f, xs)
     | `ANTIQUOT(ty, str) -> PAnt(_loc, ty, str) ]];
END;;

let parse = G.parse_string exp_eoi;; (* instead of let parse s = Grammar.Entry.parse exp_eoi (Stream.of_string s);; *)

exception NoSuchType of string;;
let ty_of_string _loc = function
  | "Int"  -> `Int
  | "Real" -> `Real
  | ty     -> Loc.raise _loc (NoSuchType ty)
;;
let string_of_ty = function
  | `Int -> "Int"
  | `Real -> "Real"
;;

(* Type Checker *)
exception TypeError;;
type integer=[`Int];;
type real=[integer | `Real];;
let rec type_expr=function
  | PApp(_loc, f,args) ->
      begin match f, args with (* pattern matching is your friend *)
      | "add", [arg1; arg2] ->
          (match type_expr arg1, type_expr arg2 with
           | #integer,#integer -> `Int
           | #real,#real -> `Real)
      | _ -> Loc.raise _loc TypeError (* note the location wrapping to have a correct location *)
      end
  | PInt _ -> `Int
  | PFlo _ -> `Real
  | PAnt(_loc, ty, _) -> ty_of_string _loc ty
;;

(* Quotations *)
(* note that this type definition will be useful only in programs that will use
 * <:exp< ... >> but not here. *)
type alg =
| App of string*alg list
| Int of int
| Flo of float
and typed_alg = (alg * real)
;;

let type_check _loc (expr, ty_expr) ty =
  if ty_expr = ty then expr
  else begin
    Format.eprintf "@[<2>Dynamic Typing Error at@ %a@]@." Loc.print _loc;
    raise TypeError
  end

let expr_of_loc loc = Camlp4.PreCast.Ast.Meta.MetaLoc.meta_loc_expr loc loc;;

module CamlSyntax =
  Camlp4OCamlParser.Make(
    Camlp4OCamlRevisedParser.Make(
      Camlp4.PreCast.Syntax
    )
  );;
let expr_of_string = CamlSyntax.Gram.parse_string CamlSyntax.expr_eoi;;

Camlp4_config.antiquotations := true;; (* Tell camlp4 that you want use antiquotations *)

(* One cannot expect good locations with this declaration: let loc=Ploc.dummy;; *)
let rec to_expr=function
    | PInt(_loc, x) -> <:expr< Int $int:x$ >>
    | PFlo(_loc, x) -> <:expr< Flo $flo:x$ >>
    | PApp(_loc, f, el)->
        let rec make_el=function
            | x::xs -> <:expr< $x$::$make_el xs$ >>
              (* instead of <:expr< [$x$::$make_el xs$] >> since I've used camlp4of *)
            | [] -> <:expr< [] >>
        in
        let el=List.map to_expr el in
        let el=make_el el in
        <:expr< App ($str:f$,$el$) >>
    | PAnt(_loc, ty, str) ->
        <:expr< type_check $expr_of_loc _loc$ $expr_of_string _loc str$ `$ty$ >>
;;
let rec to_patt=function
    | PInt(_loc, x) -> <:patt< Int $int:x$ >>
    | PFlo(_loc, x) -> <:patt< Flo $flo:x$ >>
    | PApp(_loc, f, el) ->
        let rec make_el=function
            | x::xs -> <:patt< $x$::$make_el xs$ >>
            | [] -> <:patt< [] >>
        in
        let el=List.map to_patt el in
        let el=make_el el in
        <:patt< App ($str:f$,$el$) >>
    | PAnt _ -> invalid_arg "antiquotations not supported in patterns"
;;

let expand_expr _loc _loc_name s =
    let p = parse _loc s in
    let t = type_expr p in
    <:expr< ($to_expr p$, `$string_of_ty t$) >>
;;
let expand_patt _loc _loc_name s =
    let p = parse _loc s in
    let t = type_expr p in
    <:patt< ($to_patt p$, `$string_of_ty t$) >>
;;

let expand_str_item loc loc_name s =
  <:str_item@loc< $exp:expand_expr loc loc_name s$ >>

module Q = Syntax.Quotation;;
Q.add "exp" Q.DynAst.expr_tag expand_expr;;
Q.add "exp" Q.DynAst.patt_tag expand_patt;;
Q.add "exp" Q.DynAst.str_item_tag expand_str_item;;

[-- Attachment #6: alg1_ant_test.ml --]
[-- Type: application/octet-stream, Size: 128 bytes --]

open Alg1_ant;;
let x = <:exp< add(21, 21) >> in
let y = <:exp< add(31, 11.0) >> in
<:exp< add(add($Int: x$, $Real: y$), 42) >>

[-- Attachment #7: alg1_ant_str.ml --]
[-- Type: application/octet-stream, Size: 4485 bytes --]

open Camlp4.PreCast;;
module Loc = Camlp4.PreCast.Loc;;

type palg=
| PApp of Loc.t * string * palg list (* if you want locations, you have to keep them *)
| PInt of Loc.t * string
| PFlo of Loc.t * string
| PStr of Loc.t * string
| PAnt of Loc.t * string (* the type *) * string (* the expr/patt *)
;;

(* Parser *)
module G = MakeGram(Lexer);; (* instead of let g=Grammar.gcreate (Plexer.gmake ());; *)
let exp_eoi = G.Entry.mk "exp_eoi";; (* instead of Grammar.Entry.create g "exp_eoi";; *)

EXTEND G (* specify which grammar you extend *)
  GLOBAL: exp_eoi;
  exp_eoi:
    [[ x = exp; `EOI (* `EOI instead of EOI *) -> x ]];
  exp:
    [[ x = INT -> PInt(_loc, x)
     | x = FLOAT -> PFlo(_loc, x)
     | x = STRING -> PStr(_loc, x)
     | f = LIDENT; "("; xs = LIST1 SELF SEP ","; ")" -> PApp(_loc, f, xs)
     | `ANTIQUOT(ty, str) -> PAnt(_loc, ty, str) ]];
END;;

let parse = G.parse_string exp_eoi;; (* instead of let parse s = Grammar.Entry.parse exp_eoi (Stream.of_string s);; *)

exception NoSuchType of string;;
let ty_of_string _loc = function
  | "Int"  -> `Int
  | "Real" -> `Real
  | "Str"  -> `Str
  | ty     -> Loc.raise _loc (NoSuchType ty)
;;
let string_of_ty = function
  | `Int -> "Int"
  | `Real -> "Real"
  | `Str -> "Str"
;;

(* Type Checker *)
exception TypeError;;
type integer=[`Int];;
type real=[integer | `Real];;
type any=[real | `Str];;
let rec type_expr=function
  | PApp(_loc, f,args) ->
      begin match f, args with (* pattern matching is your friend *)
      | "add", [arg1; arg2] ->
          (match type_expr arg1, type_expr arg2 with
           | #integer,#integer -> `Int
           | #real,#real -> `Real
           | #any,#any -> Loc.raise _loc TypeError)
      | _ -> Loc.raise _loc TypeError (* note the location wrapping to have a correct location *)
      end
  | PInt _ -> `Int
  | PFlo _ -> `Real
  | PStr _ -> `Str
  | PAnt(_loc, ty, _) -> ty_of_string _loc ty
;;

(* Quotations *)
(* note that this type definition will be useful only in programs that will use
 * <:exp< ... >> but not here. *)
type alg =
| App of string*alg list
| Int of int
| Flo of float
| Str of string
and typed_alg = (alg * any)
;;

(* Dynamic Type Checker *)
let type_check _loc (expr, ty_expr) ty =
  if ty_expr = ty then expr
  else begin
    Format.eprintf "@[<2>Dynamic Typing Error at@ %a@]@." Loc.print _loc;
    raise TypeError
  end

let expr_of_loc loc = Camlp4.PreCast.Ast.Meta.MetaLoc.meta_loc_expr loc loc;;

module CamlSyntax =
  Camlp4OCamlParser.Make(
    Camlp4OCamlRevisedParser.Make(
      Camlp4.PreCast.Syntax
    )
  );;
let expr_of_string = CamlSyntax.Gram.parse_string CamlSyntax.expr_eoi;;

Camlp4_config.antiquotations := true;; (* Tell camlp4 that you want use antiquotations *)

(* One cannot expect good locations with this declaration: let loc=Ploc.dummy;; *)
let rec to_expr=function
    | PInt(_loc, x) -> <:expr< Int $int:x$ >>
    | PFlo(_loc, x) -> <:expr< Flo $flo:x$ >>
    | PStr(_loc, x) -> <:expr< Str $str:x$ >>
    | PApp(_loc, f, el)->
        let rec make_el=function
            | x::xs -> <:expr< $x$::$make_el xs$ >>
              (* instead of <:expr< [$x$::$make_el xs$] >> since I've used camlp4of *)
            | [] -> <:expr< [] >>
        in
        let el=List.map to_expr el in
        let el=make_el el in
        <:expr< App ($str:f$,$el$) >>
    | PAnt(_loc, ty, str) ->
        <:expr< type_check $expr_of_loc _loc$ $expr_of_string _loc str$ `$ty$ >>
;;
let rec to_patt=function
    | PInt(_loc, x) -> <:patt< Int $int:x$ >>
    | PFlo(_loc, x) -> <:patt< Flo $flo:x$ >>
    | PStr(_loc, x) -> <:patt< Str $str:x$ >>
    | PApp(_loc, f, el) ->
        let rec make_el=function
            | x::xs -> <:patt< $x$::$make_el xs$ >>
            | [] -> <:patt< [] >>
        in
        let el=List.map to_patt el in
        let el=make_el el in
        <:patt< App ($str:f$,$el$) >>
    | PAnt _ -> invalid_arg "antiquotations not supported in patterns"
;;

let expand_expr _loc _loc_name s =
    let p = parse _loc s in
    let t = type_expr p in
    <:expr< ($to_expr p$, `$string_of_ty t$) >>
;;
let expand_patt _loc _loc_name s =
    let p = parse _loc s in
    let t = type_expr p in
    <:patt< ($to_patt p$, `$string_of_ty t$) >>
;;

let expand_str_item loc loc_name s =
  <:str_item@loc< $exp:expand_expr loc loc_name s$ >>

module Q = Syntax.Quotation;;
Q.add "exp" Q.DynAst.expr_tag expand_expr;;
Q.add "exp" Q.DynAst.patt_tag expand_patt;;
Q.add "exp" Q.DynAst.str_item_tag expand_str_item;;

[-- Attachment #8: alg1_ant_test_bad.ml --]
[-- Type: application/octet-stream, Size: 74 bytes --]

open Alg1_ant_str;;
let x = <:exp< "FOO" >> in
<:exp< add(42, $Int:x$) >>

Re: [Caml-list] How to Create Sensible Debugging Information when Dynamically Typechecking Code Generated with camlp5 Quotations

[Daniel de Rauglaudre]

Hi,

On Mon, Dec 17, 2007 at 01:11:09AM -0800, echinuz echinuz wrote:

> This contains no location information since Plot.Exc is not caught
> and handled in the same manner as it is during preprocessing.  I
> would like an error similar to the first case, when there were no
> quotations, to be shown in the second case, when there are
> quotations.

Ok, I understand your problem. It is indeed something missing in Camlp5.
I just added what is necessary and made a release. Download the latest
version (5.05) of Camlp5 at:
   http://pauillac.inria.fr/~ddr/camlp5/

I added a function "Pcaml.quotation_location" which returns the location
of the quotation text, relative to the source file, and usable in quotations
expanders.

Your code:

  let get_loc l=
    string_of_int (Ploc.line_nb l),
    string_of_int (Ploc.bol_pos l),
    string_of_int (Ploc.first_pos l),
    string_of_int (Ploc.last_pos l)

could be changed into:

  let get_loc l=
    let l =
      let qloc = Pcaml.quotation_location () in
      Ploc.shift (Ploc.first_pos qloc) l
    in
    string_of_int (Ploc.line_nb l),
    string_of_int (Ploc.bol_pos l),
    string_of_int (Ploc.first_pos l),
    string_of_int (Ploc.last_pos l)

Hope this helps.

-- 
Daniel de Rauglaudre
http://pauillac.inria.fr/~ddr/

Re: [Caml-list] How to Create Sensible Debugging Information when Dynamically Typechecking Code Generated with camlp5 Quotations

[echinuz echinuz]

[-- Attachment #1: Type: text/plain, Size: 5423 bytes --]

That seems to have done the trick.  Thanks for adding that function.  The overall solution is a little awkward, so if you take requests, it would be nice if this process is streamlined in future versions.  In other words, it would be nice if there was an easier way to pass through location information into the final AST and an easier way to throw errors with this information.  In case anyone else wants to see the final solution, I'm attaching it below:

----------------------------------
$ cat alg.ml
#load "pa_extend.cmo";;
#load "q_MLast.cmo";;

(* Parser *)
type palg=
| PApp of Ploc.t*string*palg list 
| PInt of Ploc.t*string 
| PFlo of Ploc.t*string
| PQuote of Ploc.t*string;;

let g=Grammar.gcreate (Plexer.gmake ());;
let exp_eoi = Grammar.Entry.create g "exp_eoi";;

EXTEND
    GLOBAL: exp_eoi;
    exp_eoi:
        [[ x = exp; EOI -> x ]] ;
    exp:
        [[x=INT -> PInt (loc,x)
        | x=FLOAT -> PFlo (loc,x)
        | (f,floc)=lident; "("; xs=LIST1 SELF SEP ","; ")"-> PApp (floc,f,xs)
        | x=ANTIQUOT-> PQuote(loc,x)]];
    lident:
        [[x = LIDENT -> (x, loc)]]; 
END;;

let parse s = Grammar.Entry.parse exp_eoi (Stream.of_string s);;

(* Quotations *)
type alg=
| App of (Ploc.t*string)*string*alg list
| Int of (Ploc.t*string)*int
| Flo of (Ploc.t*string)*float;;

let get_loc l=
    let l=
        let qloc=Pcaml.quotation_location () in
        Ploc.shift (Ploc.first_pos qloc) l
    in
    string_of_int (Ploc.line_nb l),
    string_of_int (Ploc.bol_pos l),
    string_of_int (Ploc.first_pos l),
    string_of_int (Ploc.last_pos l)
;;
let rec to_expr=function
    | PInt (loc,x)->
        let line_nb,bol_pos,bp,ep=get_loc loc in
        <:expr< Alg.Int (
            (Ploc.make$int:line_nb$ $int:bol_pos$ ($int:bp$,$int:ep$),
            $str:!Pcaml.input_file$),
            $int:x$) >>
    | PFlo (loc,x)-> 
        let line_nb,bol_pos,bp,ep=get_loc loc in
        <:expr< Alg.Flo (
            (Ploc.make$int:line_nb$ $int:bol_pos$ ($int:bp$,$int:ep$),
            $str:!Pcaml.input_file$),
            $flo:x$) >>
    | PApp (loc,f,el)->
        let line_nb,bol_pos,bp,ep=get_loc loc in
        let rec make_el=function
            | x::xs -> <:expr< [$x$::$make_el xs$] >>
            | [] -> <:expr< [] >>
        in
        let el=List.map to_expr el in
        let el=make_el el in
        <:expr< Alg.App(
            (Ploc.make$int:line_nb$ $int:bol_pos$ ($int:bp$,$int:ep$),
            $str:!Pcaml.input_file$),
            $str:f$,$el$) >>
    | PQuote (loc,x)->
        let loc=Ploc.make (Ploc.line_nb loc) (Ploc.bol_pos loc)
            (Ploc.first_pos loc + 1,Ploc.last_pos loc + 1)
        in
        let x=Grammar.Entry.parse Pcaml.expr_eoi (Stream.of_string x) in
        <:expr< $anti:x$ >>
;;
let rec to_patt=function
    | PInt (loc,x)-> 
        let line_nb,bol_pos,bp,ep=get_loc loc in
        <:patt< Alg.Int (
            (Ploc.make$int:line_nb$ $int:bol_pos$ ($int:bp$,$int:ep$),
            $str:!Pcaml.input_file$),
            $int:x$) >>
    | PFlo (loc,x)-> 
        let line_nb,bol_pos,bp,ep=get_loc loc in
        <:patt< Alg.Flo (
            (Ploc.make$int:line_nb$ $int:bol_pos$ ($int:bp$,$int:ep$),
            $str:!Pcaml.input_file$),
            $flo:x$) >>
    | PApp (loc,f,el)->
        let line_nb,bol_pos,bp,ep=get_loc loc in
        let rec make_el=function
            | x::xs -> <:patt< [$x$::$make_el xs$] >>
            | [] -> <:patt< [] >>
        in
        let el=List.map to_patt el in
        let el=make_el el in
        <:patt< Alg.App (
            (Ploc.make$int:line_nb$ $int:bol_pos$ ($int:bp$,$int:ep$),
            $str:!Pcaml.input_file$),
            $str:f$,$el$) >>
    | PQuote (loc,x)->
        let loc=Ploc.make (Ploc.line_nb loc) (Ploc.bol_pos loc)
            (Ploc.first_pos loc + 1,Ploc.last_pos loc + 1)
        in
        let x=Grammar.Entry.parse Pcaml.patt_eoi (Stream.of_string x) in
        <:patt< $anti:x$ >>
;;

let expand_expr s=
    let loc=Ploc.dummy in
    <:expr< Alg.check_and_ret $to_expr (parse s)$ >>
;;
let expand_patt s=
    let loc=Ploc.dummy in
    <:patt< Alg.check_and_ret $to_patt (parse s)$ >>
;;

Quotation.add "exp" (Quotation.ExAst (expand_expr,expand_patt));;

(* Type Checker *)
exception TypeError;;
type integer=[`Int];;
type real=[integer | `Real];;
let report_err loc fname exc=
    let loc_fmt =
        match Sys.os_type with
        | "MacOS" ->
            ("File \"%s\"; line %d; characters %d to %d\n### " 
                : ('a, 'b, 'c) format)
        | _ -> ("File \"%s\", line %d, characters %d-%d:\n" 
                : ('a, 'b, 'c) format)
    in
    let (file, line, c1, c2)=Ploc.from_file fname loc in
    Printf.eprintf loc_fmt file line c1 c2; flush stderr;
    raise exc
;;
let rec type_expr=function
    | App ((loc,fname),f,args) ->
        (match f with
        | "add" ->
            if List.length args != 2 then
                report_err loc fname TypeError
            else
                let args=List.map type_expr args in 
                (match (List.nth args 0,List.nth args 1) with
                | #integer,#integer -> `Int
                | #real,#real -> `Real)
        | _ -> report_err loc fname TypeError)
    | Int _ -> `Int
    | Flo _ -> `Real
;;
let rec check_and_ret e=
    let _=type_expr e in e 
;;
----------------------------------

       
---------------------------------
Never miss a thing.   Make Yahoo your homepage.

[-- Attachment #2: Type: text/html, Size: 10189 bytes --]

Re: [Caml-list] How to Create Sensible Debugging Information when Dynamically Typechecking Code Generated with camlp5 Quotations

[Daniel de Rauglaudre]

Hi,

On Tue, Dec 18, 2007 at 03:05:05PM -0800, echinuz echinuz wrote:

> That seems to have done the trick.  Thanks for adding that function.
> The overall solution is a little awkward, so if you take requests,
> it would be nice if this process is streamlined in future versions.
> In other words, it would be nice if there was an easier way to pass
> through location information into the final AST and an easier way to
> throw errors with this information.

Ok, but I don't see, for the moment, what kind of function I can offer.

In the meantime, you can improve your code by building the functions:

  let make_expr_loc loc =
    let line_nb,bol_pos,bp,ep = get_loc loc in
    <:expr<
      (Ploc.make $int:line_nb$ $int:bol_pos$ ($int:bp$, $int:ep$),
       $str:!Pcaml.input_file$)
    >>
  ;;
  let make_patt_loc loc =
    let line_nb,bol_pos,bp,ep = get_loc loc in
    <:patt<
      (Ploc.make $int:line_nb$ $int:bol_pos$ ($int:bp$, $int:ep$),
       $str:!Pcaml.input_file$)
    >>
  ;;

and, therefore, your:

     | PInt (loc,x)->
         let line_nb,bol_pos,bp,ep=get_loc loc in
         <:expr< Alg.Int (
             (Ploc.make$int:line_nb$ $int:bol_pos$ ($int:bp$,$int:ep$),
             $str:!Pcaml.input_file$),
             $int:x$) >>

can be written:

    | PInt (loc,x)->
        <:expr< Alg.Int ($make_expr_loc loc$, $int:x$) >>

For antiquotations, notice that you can use named antiquotations. For
example, adding a case, in your grammar:

        | x=ANTIQUOT "int"-> ...

allowing you to use $int:expr$ in your quotations, for an expression
of type int, and you can generate the good code with Alg.Int and a
correctly shifted location (without forgetting the "$int:" before the
expression). You can add a case for floats, and so on.

-- 
Daniel de Rauglaudre
http://pauillac.inria.fr/~ddr/