88 lines
		
	
	
	
		
			2 KiB
		
	
	
	
		
			OCaml
		
	
	
	
	
	
			
		
		
	
	
			88 lines
		
	
	
	
		
			2 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 *)
 | 
						|
 | 
						|
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 ")"
 | 
						|
  in
 | 
						|
  aux ast; pr "\n"
 |