Version française
Home     About     Download     Resources     Contact us    
Browse thread
How to Create Sensible Debugging Information when Dynamically Typechecking Code Generated with camlp5 Quotations
[ Home ] [ Index: by date | by threads ]
[ Search: ]

[ Message by date: previous | next ] [ Message in thread: previous | next ] [ Thread: previous | next ]
Date: -- (:)
From: echinuz echinuz <echinuz@y...>
Subject: Re: [Caml-list] How to Create Sensible Debugging Information when Dynamically Typechecking Code Generated with camlp5 Quotations
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.