Implemented the -denv CLI option

2 files changed, 46 insertions, 1 deletions

diff --git a/src/Environment.ml b/src/Environment.ml
index dab9bce..b7c26df 100644
--- a/src/Environment.ml
+++ b/src/Environment.ml
@@ -35,6 +35,48 @@ let bind_lexical env id v =
 let bind_lexical_all env l =
   List.fold_left (fun env (id, v) -> bind_lexical env id v) env l
 
+let dump env channel =
+  let open Printf in
+
+  let rec print_value indent_level id v =
+    let id =
+      match id with
+      | Some id -> Ident.unique_name id
+      | None    -> "(no name)"
+    in
+    let indent = String.make indent_level ' ' in
+
+    if Obj.is_int v then
+      fprintf channel "%s%s\t=\t%i\n" indent id @$ Obj.obj v
+    else
+      let tag = Obj.tag v in
+
+      if tag = Obj.string_tag then
+        fprintf channel "%s%s\t=\t%s\n" indent id @$ Obj.obj v
+      else if tag = Obj.double_tag then
+        fprintf channel "%s%s\t=\t%f\n" indent id @$ Obj.obj v
+      else if tag = 0 then
+        let sz = Obj.size v in
+
+        fprintf channel "%s%s\t=\t[%i] {\n" indent id sz;
+
+        for i = 0 to sz - 1 do
+          print_value (indent_level + 4) None @$ Obj.field v i
+        done;
+
+        fprintf channel "%s}\n" indent
+      else
+        fprintf channel "%s%s\t=\t<abstr:%i>\n" indent id tag
+  in
+
+  Hashtbl.iter (fun id v -> print_value 0 (Some id) v) env.global;
+
+  if List.length env.lexical > 0 then
+    begin
+      fprintf channel "%%\n";
+      List.iter (fun (id, v) -> print_value 0 (Some id) !v) env.lexical
+    end
+
 let fresh () =
   { global = Hashtbl.create 10; lexical = []; }
 
diff --git a/src/Tamasheq.ml b/src/Tamasheq.ml
index ebd8d7c..d5e17b0 100644
--- a/src/Tamasheq.ml
+++ b/src/Tamasheq.ml
@@ -144,5 +144,8 @@ let () =
         List.iter (Printlambda.lambda pp >> Format.print_newline) lambda
       ;
 
-      List.iter (fun l -> ignore @$ eval env [] l) lambda
+      List.iter (fun l -> ignore @$ eval env [] l) lambda;
+
+      if !denv then
+        Environment.dump env stderr
     end