From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: X-Spam-Checker-Version: SpamAssassin 3.1.3 (2006-06-01) on yquem.inria.fr X-Spam-Level: * X-Spam-Status: No, score=1.1 required=5.0 tests=AWL,DNS_FROM_RFC_ABUSE, DNS_FROM_RFC_WHOIS,HTML_MESSAGE autolearn=disabled version=3.1.3 Received: from mail3-relais-sop.national.inria.fr (mail3-relais-sop.national.inria.fr [192.134.164.104]) by yquem.inria.fr (Postfix) with ESMTP id 90014BC6D for ; Wed, 19 Dec 2007 00:05:08 +0100 (CET) X-IronPort-Anti-Spam-Filtered: true X-IronPort-Anti-Spam-Result: AgAAACfhZ0fAXQInh2dsb2JhbACCb40SAQEBCAopmgU X-IronPort-AV: E=Sophos;i="4.24,182,1196636400"; d="scan'208";a="6992491" Received: from concorde.inria.fr ([192.93.2.39]) by mail3-smtp-sop.national.inria.fr with ESMTP; 19 Dec 2007 00:05:08 +0100 Received: from mail4-relais-sop.national.inria.fr (mail4-relais-sop.national.inria.fr [192.134.164.105]) by concorde.inria.fr (8.13.6/8.13.6) with ESMTP id lBIN579k016148 (version=TLSv1/SSLv3 cipher=RC4-SHA bits=128 verify=OK) for ; Wed, 19 Dec 2007 00:05:07 +0100 X-IronPort-Anti-Spam-Filtered: true X-IronPort-Anti-Spam-Result: AgAAAK/gZ0fRSbJbn2dsb2JhbACCb40SAQEBAQcEBgkIGJoD X-IronPort-AV: E=Sophos;i="4.24,182,1196636400"; d="scan'208";a="20483789" Received: from web60123.mail.yahoo.com ([209.73.178.91]) by mail4-smtp-sop.national.inria.fr with SMTP; 19 Dec 2007 00:05:06 +0100 Received: (qmail 89222 invoked by uid 60001); 18 Dec 2007 23:05:05 -0000 DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=s1024; d=yahoo.com; h=X-YMail-OSG:Received:Date:From:Subject:To:In-Reply-To:MIME-Version:Content-Type:Content-Transfer-Encoding:Message-ID; b=GbyO6/WTMG/92rQuTHs4H+g3yvGFtTs/7OAZ/M7+7mwFUqpUuThbpQWnHSH/mslH7WxiUkIKM5NCqhvgdweoF1Zv4+Z7gP/UsPgMwoYe9IzqM/W6AoL2gLq2MKxDNpNdoTT/jjHf3ckfmJ2ZGywQZ5y7S6mFFpKxcrxTuLDp8Ww=; X-YMail-OSG: m_LhIjwVM1nNaGVm37xA7FFVO0KMtzduBNalVsC.qN6R_eNFKAibnAt7Ca_CUtHMNjkExypU_V8_5mHDD7d3XxhqDXg.Z8wq1GUO6gP_ve5EXP6cmWrw Received: from [66.100.224.174] by web60123.mail.yahoo.com via HTTP; Tue, 18 Dec 2007 15:05:05 PST Date: Tue, 18 Dec 2007 15:05:05 -0800 (PST) From: echinuz echinuz Subject: Re: [Caml-list] How to Create Sensible Debugging Information when Dynamically Typechecking Code Generated with camlp5 Quotations To: caml-list@inria.fr In-Reply-To: <1197733590-sup-3933@ausone.local> MIME-Version: 1.0 Content-Type: multipart/alternative; boundary="0-226392745-1198019105=:88461" Content-Transfer-Encoding: 8bit Message-ID: <86496.88461.qm@web60123.mail.yahoo.com> X-Miltered: at concorde with ID 47685223.000 by Joe's j-chkmail (http://j-chkmail . ensmp . fr)! X-Spam: no; 0.00; camlp:01 cmo:01 mlast:01 cmo:01 parser:01 plexer:01 gmake:01 lident:01 lident:01 pcaml:01 expr:01 expr:01 pcaml:01 checker:01 macos:01 --0-226392745-1198019105=:88461 Content-Type: text/plain; charset=iso-8859-1 Content-Transfer-Encoding: 8bit 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. --0-226392745-1198019105=:88461 Content-Type: text/html; charset=iso-8859-1 Content-Transfer-Encoding: 8bit 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. --0-226392745-1198019105=:88461--