Source

blub / blub_common.ml

open Format
open Blub_types


let typevar =
  let cur_index = ref 0 in
  fun () ->
    incr cur_index;
    Typevar(ref None, !cur_index)
;;

let mklocal = 
  let cur_index = ref 0 in
  fun name ->
    incr cur_index;
    { var_name=name; 
      var_uname="%" ^ name ^ "." ^ (string_of_int !cur_index) }
;;
  
let mkglobal name =
  { var_name=name;
    var_uname=name }
;;

let _pp_list ppe f = function
    [] -> ()
  | a1::an ->
      let pprest f = List.iter (fun e -> fprintf f "@ %a" ppe e) in
      fprintf f "%a%a" ppe a1 pprest an
;;

let pp_list ppe f l =
    fprintf f "@[<hv 0>@[<hv 1>(@,%a@]@,)@]" (_pp_list ppe) l
;;

let _pp_array ppe f arr =
  Array.iteri (fun idx e -> if idx = 0 then
		 fprintf f "%a" ppe e 
	       else
		 fprintf f ";@ %a" ppe e) arr
;;

let pp_array ppe f arr =
    fprintf f "@[<hv 0>@[<hv 1>[@,%a@]@,]@]" (_pp_array ppe) arr
;;

let rec pp_sval f = function
    Ssymbol s -> fprintf f "'%s" s
  | Sfalse -> fprintf f "#f"
  | Strue -> fprintf f "#t"
  | Sint x -> fprintf f "%d" x
  | Sfloat x -> fprintf f "%g" x
  | Sunbound -> fprintf f "<#unbound>"   
  | Sclosure _ -> fprintf f "<#closure>"
  | Spair p -> begin
      let rec pp_pair f pr =
	let hd = pr.car in
	match pr.cdr with
	    Snull -> fprintf f "%a" pp_sval hd
	  | Spair pr -> fprintf f "%a %a" pp_sval hd pp_pair pr
	  | x -> fprintf f "%a . %a" pp_sval hd pp_sval x
      in
      fprintf f "(%a)" pp_pair p
    end
  | Sjitclosure _ -> fprintf f "<#llvm>"
  | Snull -> fprintf f "<#null>"
  | Svector _ -> fprintf f "<#vector>"
  | Sstring s -> fprintf f "\"%s\"" s
  | Spfn _ -> fprintf f "<#primitive>"
  | Spfe _ -> fprintf f "<#primitive-2>"



let rec pp_type f = function
    Int -> fprintf f "int"
  | Bool -> fprintf f "bool"
  | Symbol -> fprintf f "symbol"
  | Float64 -> fprintf f "double"
  | VarArray t -> fprintf f "[%a]" pp_type t
  | Typevar (tv, id) -> begin
      match !tv with
	  None -> fprintf f "'tv%d" id
	| Some t -> pp_type f t
    end
  | Fun (params, ret) -> 
      let params = Array.to_list params in
      fprintf f "%a" (pp_list pp_type) (ret :: params)
;;

let pp_var f var =
  fprintf f "%s" var.var_uname 
;;

let rec pp_ast f = function
    A_lit l -> pp_sval f l
  | A_ref r -> pp_var f r
  | A_cnd (e1, e2, e3) -> 
      fprintf f "(if %a %a %a)" pp_ast e1 pp_ast e2 pp_ast e3;
  | A_seq exprs ->
      let exprs = Array.to_list exprs in
      fprintf f "(begin %a)" (_pp_list pp_ast) exprs
  | A_abs (vars, varargs, body) ->
      (* FIXME ; and what about varargs? *)
      let vars = Array.to_list vars in
      fprintf f "(lambda %a %a)" (pp_list pp_var) vars pp_ast body
  | A_app (fn, params) ->
      let params = Array.to_list params in
      fprintf f "%a" (pp_list pp_ast) (fn :: params)
  | A_let (bindings, body, lettype) ->
      let txt = match lettype with
	  LT_let -> "let"
	| LT_letstar -> "let*"
	| LT_letrec -> "letrec"
      in
      let pp_binding f (var, expr) =
	fprintf f "(%a %a)" pp_var var pp_ast expr
      in
      let bindings = Array.to_list bindings in
      fprintf f "(%s %a %a)" txt (pp_list pp_binding) bindings pp_ast body
  | A_callcc expr ->
      fprintf f "(call/cc %a)" pp_ast expr
  | A_set (var, expr) ->
      fprintf f "(set! %a %a)" pp_var var pp_ast expr
;;
      


let pp_env_frame f frame =
  let pairs = Array.mapi (fun idx var -> (var, frame.vals.(idx))) frame.vars in
  let pp_pair f (var, value) =
    fprintf f "(%a . %a)" pp_var var pp_sval value
  in

  fprintf f "envfrm%a" (pp_array pp_pair) pairs
;;

let pp_env f env =
  fprintf f "env%a" (pp_list pp_env_frame) env
;;
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.