Version française
Home     About     Download     Resources     Contact us    
Browse thread
Two Different Exception Behaviors in camlp4 on the toplevel
[ Home ] [ Index: by date | by threads ]
[ Search: ]

[ Message by date: previous | next ] [ Message in thread: previous | next ] [ Thread: previous | next ]
Date: -- (:)
From: Joseph Young <ocaml@o...>
Subject: Re: [Caml-list] Two Different Exception Behaviors in camlp4 on the toplevel
 	The type checking using phantom types worked great.  Thanks.  In 
case it helps anyone else, I'm attaching complete working code below.

Joe

----------------------------
$ cat calc.ml
open Camlp4.PreCast;;
module CamlSyntax=
     Camlp4OCamlParser.Make(
         Camlp4OCamlRevisedParser.Make(
             Camlp4.PreCast.Syntax));;

(* The AST for the small calculator *)
type loc=CamlSyntax.Loc.t
type nonterminal=[`Add | `Sub | `Or | `And | `MixedFn];;
type terminal=[`Int of int | `Bool of bool | `Ocaml of (loc*string)];;
type calc=
| Nonterm of loc*nonterminal*(calc list)
| Term of loc*terminal;;

module TypeChecker : sig
     type 'a t
     val add : loc->int t->int t->int t
     val sub : loc->int t->int t->int t
     val or_: loc->bool t->bool t->bool t
     val and_: loc->bool t->bool t->bool t
     val mixed: loc->bool t->int t->int t
     val int_: loc->int -> int t
     val bool_: loc->bool -> bool t
     val expose : 'a t->calc
end = struct
     type 'a t=calc
     let add loc e1 e2 = Nonterm (loc,`Add,[e1;e2])
     let sub loc e1 e2 = Nonterm (loc,`Sub,[e1;e2])
     let or_ loc e1 e2 = Nonterm (loc,`Or,[e1;e2])
     let and_ loc e1 e2 = Nonterm (loc,`And,[e1;e2])
     let mixed loc e1 e2 = Nonterm (loc,`MixedFn,[e1;e2])
     let int_ loc i = Term (loc,`Int i)
     let bool_ loc b = Term (loc,`Bool b)
     let expose e=e
end;;

open TypeChecker;;

(* Grammar for a simple calculator *)
module CalcGram = Camlp4.PreCast.MakeGram(Camlp4.PreCast.Lexer);;
let (term:calc CalcGram.Entry.t)= CalcGram.Entry.mk "term";;
let term_eoi = CalcGram.Entry.mk "Simple calculator quotation";;
EXTEND CalcGram
     GLOBAL: term term_eoi;
     term:
     [ "alg"
         [ e1 = SELF; "+"; e2 = SELF -> Nonterm(_loc,`Add,[e1;e2])
         | e1 = SELF; "-"; e2 = SELF -> Nonterm(_loc,`Sub,[e1;e2])]
     | "bool"
         [ e1 = SELF; "or"; e2 = SELF -> Nonterm(_loc,`Or,[e1;e2])
         | e1 = SELF; "and"; e2 = SELF -> Nonterm(_loc,`And,[e1;e2])]
     | "other"
         [ e1 = SELF; "mix"; e2= SELF -> Nonterm(_loc,`MixedFn,[e1;e2])]
     | "simple"
         [ "$"; `STRING (e,_); "$" -> Term(_loc,`Ocaml (_loc,e))
         | `INT (i, _)  -> Term(_loc,`Int i)
         | "true" -> Term(_loc,`Bool true)
         | "false" -> Term(_loc,`Bool false)
         | "("; e = term; ")" -> e ]
     ];
     term_eoi:
     [[ t = term; `EOI -> t ]];
END;;

(* Generates an expression with the location information *)
let expr_of_loc _loc=
     let (a, b, c, d, e, f, g, h) = CamlSyntax.Loc.to_tuple _loc in
     <:expr< Loc.of_tuple ($`str:a$, $`int:b$, $`int:c$, $`int:d$,
         $`int:e$, $`int:f$, $`int:g$, $`bool:h$) >>
;;

(* Generates an expression with the nonterminal information *)
let expr_of_nonterm _loc name=
     match name with
     | `Add -> <:expr< add >>
     | `Sub -> <:expr< sub >>
     | `Or -> <:expr< or_ >>
     | `And -> <:expr< and_ >>
     | `MixedFn -> <:expr< mixed >>
;;

(* Generates an expression with the terminal information *)
let expr_of_term _loc e=
     let expr_loc=expr_of_loc _loc in
     match e with
     | `Int i -> <:expr< int_ $expr_loc$ $`int:i$ >>
     | `Bool b -> <:expr< bool_ $expr_loc$ $`bool:b$ >>
     | `Ocaml(l,e) -> CamlSyntax.Gram.parse_string CamlSyntax.expr_eoi l e
;;

(* Converts a calculator AST into an OCaml AST *)
let to_expr base_loc prog=
     let e=CalcGram.parse_string term_eoi base_loc prog in
     let rec to_expr e=
         match e with
         | Nonterm (_loc,name,[e1;e2]) ->
             let constr= expr_of_nonterm _loc name in
             let e1=to_expr e1 in
             let e2=to_expr e2 in
             <:expr< $constr$ $expr_of_loc _loc$ $e1$ $e2$>>
         | Term (_loc,data) ->
             let data= expr_of_term _loc data in
             <:expr< $data$ >>
         | _ -> failwith ("Wrong number of arguments.")
     in
     to_expr e
;;

let expand_calc_quot loc lopt e= to_expr loc e;;

Syntax.Quotation.add "calc" Syntax.Quotation.DynAst.expr_tag 
expand_calc_quot;;

----------------------------

$  cat Makefile
all:
         ocamlc -c -I +camlp4 -I +camlp4/Camlp4Parsers -pp camlp4of -o 
calc.cmo calc.ml

----------------------------