(* simple, untyped AST. *) type t = | Nothing | Nunit | Nint of int | Nfloat of float | Nbool of bool | Nstring of string | Nsymbol of string | Nfunction of string list * t | Nexternal of string | Var of string | Let of string * t | Letin of string * t * t | Unary of operator * t | Binop of t * operator * t | If of t * t * t (* cond then else *) | Apply of t * t list (* function application *) and operator = string let unary op t = Unary (op, t) let binop left op right = Binop (left, op, right) (* print ast LISP style. *) let print ast = let pr = Printf.printf in let rec aux = function | Nothing -> pr "" | Nunit -> pr "()" | Nint n -> pr "%d" n | Nfloat n -> pr "%f" n | Nbool b -> pr "%b" b | Nstring s -> pr "\"%s\"" s | Nsymbol s -> pr "#%s" s | Nfunction (arg::args, e) -> pr "(lambda (%s" arg; List.iter (pr " %s") args; pr ") "; aux e; pr ")" | Nexternal e -> pr "(extern %s)" e | Var v -> pr "%s" v | Let (v, Nfunction (args, e)) -> pr "(define (%s" v; List.iter (pr " %s") args; pr ") "; aux e; pr ")" | Let (v, e) -> pr "(define %s " v; aux e; pr ")" | Letin (v, e, f) -> pr "(let ((%s " v; aux e; pr ")) "; aux f; pr ")" | Unary (op, t) -> pr "(%s " op; aux t; pr ")" | Binop (left, op, right) -> pr "(%s " op; aux left; pr " "; aux right; pr ")" | If (co, th, el) -> let f e = pr " "; aux e in pr "(if"; f co; f th; f el; pr ")" | Apply (f, args) -> pr "("; aux f; List.iter (fun a -> pr " "; aux a) args; pr ")" | _ -> invalid_arg "Ast.print" in aux ast; pr "\n"