Browse thread
Two Different Exception Behaviors in camlp4 on the toplevel
-
Joseph Young
-
blue storm
- Joseph Young
-
blue storm
[
Home
]
[ Index:
by date
|
by threads
]
[ Message by date: previous | next ] [ Message in thread: previous | next ] [ Thread: previous | next ]
[ 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
----------------------------