104 lines
2.5 KiB
OCaml
104 lines
2.5 KiB
OCaml
(* simple, untyped AST. *)
|
|
type t =
|
|
| Nothing
|
|
| Nint of int
|
|
| Nfloat of float
|
|
| Nbool of bool
|
|
| Nstring of string
|
|
| Nsymbol of string
|
|
| Nfunction of string * 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 *)
|
|
(* these will be seperated into external functions. *)
|
|
| 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 *)
|
|
| Eq | Neq | GE | LE | GT | LT
|
|
| Negate
|
|
|
|
let op_to_string = function
|
|
| Add -> "+"
|
|
| Sub -> "-"
|
|
| Mul -> "*"
|
|
| Div -> "/"
|
|
| Mod -> "%"
|
|
| Exp -> "^"
|
|
| Eq -> "="
|
|
| Neq -> "<>"
|
|
| GE -> ">="
|
|
| LE -> "<="
|
|
| GT -> ">"
|
|
| LT -> "<"
|
|
| 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 rec cascade = function
|
|
| Nfunction (arg, e) ->
|
|
let args, e = cascade e in
|
|
arg :: args, e
|
|
| e -> [], e
|
|
in
|
|
|
|
let pr = Printf.printf in
|
|
let rec aux = function
|
|
| Nothing -> 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, e) ->
|
|
let args, e = cascade e in
|
|
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, 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) ->
|
|
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 ")"
|
|
| 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 ")"
|
|
|
|
| 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"
|