Source

OCamlRuby / expression.ml

open Util


type literal = LString of string | LInt of int | LBool of bool | LVar of string

type expr =
  | Call of obj * string * expr list
  | Field of field
  | Assign of string * expr
  | If of expr * expr * expr
  | Literal of literal
  | BinOp of op * expr * expr
  | Ignore of expr * expr
  | External of (context -> inst)
and field =
  | FunDef of string * string list * expr
  | ClassDef of string * field list
and obj = Obj of expr | Local
and op = Mult | Div | Plus | Minus | Eq | Le | Lt | Ge | Gt | And | Or

(* CONTEXT *)
and context = (string * f) list
and f = Var of inst | Fun of string list * expr
and inst = { class_name:string; ctx:context }

exception UnboundValue

(* for debug ============*)
let sliteral = function
  | LString s -> s
  | LInt i -> string_of_int i
  | LBool b -> string_of_bool b
  | LVar v -> v
let rec sexpr = function
  | Call (Local, fname, _) -> "Call Local#" ^ fname
  | Call (Obj o, fname, _) -> "Call ?#" ^ fname
  | Field (FunDef (fname, argnames, e)) -> "FunDef:" ^ fname ^ "(" ^ sexpr e ^ ")"
  | Field (ClassDef (cname, fs)) -> "ClassDef"
  | Assign (vname, _) -> "Assign:" ^ vname
  | If (_, e1, e2) -> "If(" ^ sexpr e1 ^ ", " ^ sexpr e2 ^ ")"
  | Literal lit -> sliteral lit
  | BinOp (op, e1, e2) -> "BinOp"
  | Ignore (e1, e2) -> "Ig(" ^ sexpr e1 ^ ");\n" ^ sexpr e2
  | External func -> "External"
(* ======================*)


let rec get_var ctx vname =
  match ctx with
  | [] -> p "E.get_var: unboundvar: %s\n" vname;
	raise UnboundValue
  | (name, Var v) :: tl when name=vname -> v
  | _ :: tl -> get_var tl vname
let set_var ctx vname value =
  (vname, Var value) :: ctx
let rec get_fun ctx fname =
  match ctx with
  | [] -> p "E.get_fun: unboundfun: %s\n" fname;
      raise UnboundValue
  | (name, Fun (args, body)) :: tl when name=fname -> (args, body)
  | _ :: tl -> get_fun tl fname
let set_fun ctx fname (argnames, body) = (fname, Fun (argnames, body)) :: ctx

let null_obj = { class_name="Null"; ctx = []}