ce/ast.ml

(* simple, untyped AST. *)
type t =
  | Nint of int
  | Nfloat of float
  | Nstring of string
  | Nsymbol of string
  | Nfunction of string list * t
  | Nexternal of string
  | Var of string
  | Let of string * t
  | Unary of operator * t
  | Binop of t * operator * t
  | Apply of t * t list (* function application *)
  (* these will be seperated into (toplevel) directives. *)
  | Set_binop_pre of operator * t
  | Get_binop_pre of operator
  | Set_binop_aso of operator * string
  | Get_binop_aso of operator

and operator =
  | Add | Sub | Mul | Div (* arithmetics *)
  | Mod (* modular operation *)
  | Exp (* exponentation *)
  | Negate

let op_to_string = function
  | Add -> "+"
  | Sub -> "-"
  | Mul -> "*"
  | Div -> "/"
  | Mod -> "%"
  | Exp -> "^"
  | Negate -> "-"

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
    | Nint n -> pr "%d" n
    | Nfloat n -> pr "%f" n
    | Nstring s -> pr "\"%s\"" s
    | Nsymbol s -> pr "#%s" s
    | Nfunction (args, e) ->
      pr "lambda (%s" @@ List.hd args;
      List.iter (pr " %s") @@ List.tl args;
      pr ") ("; aux e; pr")"
    | Nexternal e -> pr "(extern %s)" e
    | Var v -> pr "%s" v
    | Let (v, e) ->
      pr "(let %s " v; aux e; pr ")"
    | Unary (op, t) ->
      let op = op_to_string op in
      pr "(%s " op; aux t; pr ")"
    | Binop (left, op, right) ->
      let op = op_to_string op in
      pr "(%s " op; aux left; pr " "; aux right; pr ")"
    | Apply (f, args) ->
      pr "("; List.iter aux @@ f::args; pr ")"

    | Set_binop_pre (op, pre) ->
      pr "(set_pre %s " (op_to_string op);
      aux pre;
      pr ")"
    | Get_binop_pre op ->
      pr "(get_pre %s)" (op_to_string op)
    | Set_binop_aso (op, aso) ->
      pr "(set_assoc %s %s)" (op_to_string op) aso
    | Get_binop_aso op ->
      pr "(get_pre %s)" (op_to_string op)
  in
  aux ast; pr "\n"