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

[echinuz echinuz <echinuz@yahoo.com>]

[-- 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 --]