blob: 51afcc3b44d543be8a8543650b77155e54ea6be7 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
(* Data structures for representing the state of a system *)
open Util
open Ast
exception Combinatorial_cycle of string
exception No_variable of string
exception Type_error of string
let type_error e = raise (Type_error e)
exception Not_implemented of string
let not_implemented e = raise (Not_implemented e)
type scope = string
type svalue =
| VInt of int
| VBool of bool
| VReal of float
| VState of id
| VPrevious of value
| VBusy (* intermediate value : calculating ! for detection of cycles *)
and value = svalue list
type state = svalue VarMap.t
(* functions for recursively getting variables *)
type calc_fun =
| F of (state -> calc_map -> state)
and calc_map = calc_fun VarMap.t
let get_var (st: state) (c: calc_map) (id: id) : (state * svalue) =
let st =
if VarMap.mem id st then st
else try match VarMap.find id c with
| F f ->
(* Format.printf "%s[ " id; *)
let r = f (VarMap.add id VBusy st) c in
(* Format.printf "]%s " id; *)
r
with Not_found -> raise (No_variable id)
in
match VarMap.find id st with
| VBusy -> raise (Combinatorial_cycle id)
| v -> st, v
(* pretty-printing *)
let rec str_of_value = function
| VInt i -> string_of_int i
| VReal r -> string_of_float r
| VBool b -> if b then "true" else "false"
| VState s -> "state " ^ s
| VPrevious p ->
"[" ^
List.fold_left (fun s v -> (if s = "" then "" else s ^ ", ") ^ str_of_value v) "" p
^ "]"
| VBusy -> "#"
let print_state st =
VarMap.iter (fun id v -> Format.printf "%s = %s@." id (str_of_value v)) st
|
