Source

Opifex / src / Language / CWCPS / CWCPS_Util.ml

Full commit
(*
 * Opifex
 *
 * Copyrights(C) 2012 by Pawel Wieczorek <wieczyk at gmail>
 *)

open CWCPS_AST
open Batteries

module ValuePrinter = struct

open CWCPS_PrettyPrinter
open CWCPS_Eval

let update_mem (ht,mpath) var = (ht, string_of_variable var :: mpath)

let is_closure = function
    | VAL_Closure _ -> true
    | _ -> false


let rec _show_closure mem args body env =
        [ Formatter.psp_value_keyword "closure"
        ; Formatter.psp_nested 0 (List.map (fun x -> Formatter.psp_variable x) args)
        ; Formatter.psp_operator "->"
        ; Formatter.psp_break
        ; Formatter.psp_indent 0 (CWCPS_PrettyPrinter.show_expression body)
        ; Formatter.psp_indent 0 
            [ Formatter.psp_nested 0 (_show_environment mem env)
            ]
        ]

and _show_real_value mem = function
    | VAL_Integer i     -> [ Formatter.psp_value_int i ]
    | VAL_Unit          -> [ Formatter.psp_value "()" ]
    | VAL_Closure (args,body,env) ->  _show_closure mem args body env


and _show_value (ht, mpath) v =
    try

        (* drity hack :-) *)
        if not (is_closure v) then raise Not_found
        else ();
        let path = Hashtbl.find ht v in
        [ Formatter.psp_identifier (Identifier (Util.concat_intersperse "." (List.rev path)))
        ]
    with
        Not_found ->
            Hashtbl.replace ht v mpath;
            _show_real_value (ht, mpath) v

and _show_environment mem environment =
    Environment.PrettyPrinter.show_environment _show_value update_mem mem environment


let show_value v = _show_value (Hashtbl.create 127, ["@"]) v
let show_environment e = _show_environment (Hashtbl.create 127, ["@"]) e

end

(*
module TypePrinter = struct

let _show_type _ v = CWCPS_TypeChecker.show_type_expression v

let show_environment = 
    Environment.PrettyPrinter.show_environment _show_type (fun _ _ -> ()) () 

end
*)

module IODriver = struct

open CWCPS_Eval

let standard_io_driver = 
    let _read () = VAL_Integer (print_string "> "; read_int ()) in
    let _write = print_endline -| Formatter.render_painter -| Formatter.psp_nested 0 -| ValuePrinter.show_value in
    (_read, _write)

end