ce/ast.ml

(* 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"