2011-07-27 07:17:02 -07:00
|
|
|
(****************************************************************************)
|
|
|
|
|
(* *)
|
|
|
|
|
(* OCaml *)
|
|
|
|
|
(* *)
|
|
|
|
|
(* INRIA Rocquencourt *)
|
|
|
|
|
(* *)
|
|
|
|
|
(* Copyright 2007 Institut National de Recherche en Informatique et *)
|
|
|
|
|
(* en Automatique. All rights reserved. This file is distributed under *)
|
|
|
|
|
(* the terms of the GNU Library General Public License, with the special *)
|
|
|
|
|
(* exception on linking described in LICENSE at the top of the OCaml *)
|
|
|
|
|
(* source tree. *)
|
|
|
|
|
(* *)
|
|
|
|
|
(****************************************************************************)
|
|
|
|
|
|
2007-11-21 09:50:26 -08:00
|
|
|
(* Please keep me in sync with brion.inria.fr/gallium/index.php/Arithmetic_Example *)
|
|
|
|
|
|
|
|
|
|
open Camlp4.PreCast;;
|
|
|
|
|
module ArithGram = MakeGram(Lexer);;
|
|
|
|
|
|
|
|
|
|
type t = Local of string * t * t
|
|
|
|
|
| Binop of t * (int -> int -> int) * t
|
|
|
|
|
| Int of int
|
|
|
|
|
| Var of string;;
|
|
|
|
|
|
|
|
|
|
let expression = ArithGram.Entry.mk "expression";;
|
|
|
|
|
|
|
|
|
|
EXTEND ArithGram
|
|
|
|
|
GLOBAL: expression;
|
|
|
|
|
|
|
|
|
|
expression: (* A grammar entry for expressions *)
|
|
|
|
|
[ "top"
|
|
|
|
|
[ "let"; `LIDENT s; "="; e1 = SELF; "in"; e2 = SELF -> Local(s,e1,e2) ]
|
|
|
|
|
| "plus"
|
|
|
|
|
[ e1 = SELF; "+"; e2 = SELF -> Binop(e1, ( + ), e2)
|
|
|
|
|
| e1 = SELF; "-"; e2 = SELF -> Binop(e1, ( - ), e2) ]
|
|
|
|
|
| "times"
|
|
|
|
|
[ e1 = SELF; "*"; e2 = SELF -> Binop(e1, ( * ), e2)
|
|
|
|
|
| e1 = SELF; "/"; e2 = SELF -> Binop(e1, ( / ), e2) ]
|
|
|
|
|
| "simple"
|
|
|
|
|
[ `INT(i, _) -> Int(i)
|
|
|
|
|
| `LIDENT s -> Var(s)
|
|
|
|
|
| "("; e = expression; ")" -> e ]
|
|
|
|
|
];
|
|
|
|
|
|
|
|
|
|
END;;
|
|
|
|
|
|
|
|
|
|
let parse_arith s =
|
|
|
|
|
ArithGram.parse_string expression (Loc.mk "<string>") s;;
|
|
|
|
|
|
|
|
|
|
let rec eval env =
|
|
|
|
|
function
|
|
|
|
|
| Local(x, e1, e2) ->
|
|
|
|
|
let v1 = eval env e1 in
|
|
|
|
|
eval ((x, v1) :: env) e2
|
|
|
|
|
| Binop(e1, op, e2) ->
|
|
|
|
|
op (eval env e1) (eval env e2)
|
|
|
|
|
| Int(i) -> i
|
|
|
|
|
| Var(x) -> List.assoc x env;;
|
|
|
|
|
|
|
|
|
|
let calc s =
|
|
|
|
|
Format.printf "%s ==> %d@." s (eval [] (parse_arith s));;
|
|
|
|
|
|
|
|
|
|
calc "42 * let x = 21 in x + x";;
|
