95 lines
2.2 KiB
OCaml
95 lines
2.2 KiB
OCaml
module Type = struct
|
|
type t =
|
|
| Int
|
|
| Float
|
|
| Function
|
|
| External
|
|
| String
|
|
|
|
let to_string = function
|
|
| Int -> "int"
|
|
| Float -> "float"
|
|
| String -> "string"
|
|
| Function -> "fun"
|
|
| External -> "external"
|
|
|
|
let supertype = function
|
|
| Int -> Some Float
|
|
| _ -> None
|
|
end
|
|
|
|
(* simple, untyped AST. *)
|
|
type t =
|
|
| Nint of int
|
|
| Nfloat of float
|
|
| Nstring 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
|
|
| 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"
|