Source

Opifex / src / Language / Common / Store.ml

The branch 'port-stringpainter' does not exist.
Full commit
(*
 * Opifex
 *
 * Copyrights(C) 2012 by Pawel Wieczorek <wieczyk at gmail>
 *)

open AST

(*************************************************************************************************
 * Store
 ************************************************************************************************)

type location = Location of int

type 'value t = int ref * (location, 'value) Hashtbl.t * (variable, location) Hashtbl.t

let create () = (ref 0, Hashtbl.create 127, Hashtbl.create 127)

let alloc_location (ref, _, _) = 
    let loc = !ref in
    ref := succ loc;
    Location loc

let release_location (_, hash_table, _) location =
    Hashtbl.remove hash_table location

let store_location (_, hash_table, _) location value =
    Hashtbl.replace hash_table location value

let fetch_location (_, hash_table, _) location =
    Hashtbl.find hash_table location

(*************************************************************************************************
 * Version for variable-driven store
 ************************************************************************************************)

let map_variable ((_, _, vmap) as store) variable =
    try
        Hashtbl.find vmap variable 
    with
        Not_found ->
            let fresh_location = alloc_location store in
            Hashtbl.replace vmap variable fresh_location;
            fresh_location

let store_variable store variable value =
    let loc = map_variable store variable in
    store_location store loc value

let fetch_variable store variable =
    let loc = map_variable store variable in
    fetch_location store loc

(*************************************************************************************************
 * PrettyPrinter
 ************************************************************************************************)

module PrettyPrinter = struct

open Formatter;;

let build_reverse_vmap vmap =
    let rvmap = Hashtbl.create 127 in
    Hashtbl.iter (fun k v -> Hashtbl.replace rvmap v k) vmap;
    rvmap

let show_location (Location loc) = 
    [ psp_special ("@L" ^ string_of_int loc) 
    ]

let show_hash_table show_value hash_table rvmap =
    let handle_entry l v aux =
        let variable = 
            try
                [ psp_syntax "("
                ; psp_keyword "variable"
                ; psp_variable (Hashtbl.find rvmap l)
                ; psp_syntax ")"
                ]
            with 
                Not_found ->
                []
            in
        [ psp_nested 0 (show_location l)
        ; psp_nested 0 variable
        ; psp_operator "="
        ; psp_nested 0 (show_value v)
        ; psp_break
        ] :: aux
        in
    List.concat (Hashtbl.fold handle_entry hash_table [])

let show_store show_value (refc, hash_table, vmap) =
    [ psp_keyword "fresh location"
    ; psp_operator "="
    ; psp_value_int (!refc)
    ; psp_break
    ; psp_keyword "memory"
    ; psp_syntax ":"
    ; psp_break
    ; psp_nested 0 (show_hash_table show_value hash_table (build_reverse_vmap vmap) )
    ]

end