From 5416de8ee5e3d8a2d1b90925accf67972d8bb430 Mon Sep 17 00:00:00 2001
From: crumbtoo <crumb@disroot.org>
Date: Tue, 30 Apr 2024 14:48:05 -0600
Subject: [PATCH] heap

---
 visualisers/gmvis/public/css/main.css | 30 +++++++++++
 visualisers/gmvis/src/ui.cljs         | 72 ++++++++++++++++++++++-----
 2 files changed, 90 insertions(+), 12 deletions(-)

diff --git a/visualisers/gmvis/public/css/main.css b/visualisers/gmvis/public/css/main.css
index 134a342..fa746ec 100644
--- a/visualisers/gmvis/public/css/main.css
+++ b/visualisers/gmvis/public/css/main.css
@@ -124,3 +124,33 @@ body
 ; flex-shrink: 0
 }
 
+.heap-view
+{
+}
+
+.heap-entry-container
+{ display: flex
+; flex-direction: column
+}
+
+.heap-entry-container > .heap-entry:nth-of-type(even)
+{ background: #0000007f
+; color: white
+}
+
+.heap-entry
+{ display: flex
+; flex-direction: row
+; justify-content: space-between
+; font-family: monospace;
+}
+
+.heap-entry-addr
+{ white-space: nowrap
+}
+
+/* .heap-entry-container.odd > .heap-entry:nth-of-type(odd) */
+/* { background: #0000007f */
+/* ; color: white */
+/* } */
+
diff --git a/visualisers/gmvis/src/ui.cljs b/visualisers/gmvis/src/ui.cljs
index 0eeaa26..e80fa52 100644
--- a/visualisers/gmvis/src/ui.cljs
+++ b/visualisers/gmvis/src/ui.cljs
@@ -1,5 +1,6 @@
 (ns ui
     (:require
+      [clojure.pprint :refer (cl-format)]
       [wscljs.client :as ws]
       [wscljs.format :as fmt]
       [clojure.string :as str]
@@ -22,6 +23,21 @@
 
 ;------------------------------------------------------------------------------;
 
+(defn gen-key []
+  (js/self.crypto.randomUUID))
+
+(defn add-key [e]
+  (let [uuid (js/self.crypto.randomUUID)]
+    (match e
+      [tag props & children] (concat [tag (assoc props :key uuid)] children))))
+
+;------------------------------------------------------------------------------;
+
+(declare ppr-node)
+(declare ppr-node*)
+
+;------------------------------------------------------------------------------;
+
 (defn Root [props & children]
   [:> Resplit.Root (assoc props :class "split-root")
    [:<> children]])
@@ -44,17 +60,22 @@
   [:div {:class "pane-content dump-view"}
    [Header "Dump"]])
 
-(defn Heap []
+;------------------------------------------------------------------------------;
+
+(defn HeapEntry [heap addr-key]
+  (let [addr (js/Number (name addr-key))]
+    [:div {:class "heap-entry"
+           :key (gen-key)}
+     [:div {:class "heap-entry-addr"}
+      (cl-format nil "&~3D" addr)]
+     [:div {:class "heap-entry-node"}
+      (ppr-node heap addr)]]))
+
+(defn Heap [heap]
   [:div {:class "pane-content heap-view"}
-   [Header "Heap"]])
-
-(defn gen-key []
-  (js/self.crypto.randomUUID))
-
-(defn add-key [e]
-  (let [uuid (js/self.crypto.randomUUID)]
-    (match e
-      [tag props & children] (concat [tag (assoc props :key uuid)] children))))
+   [Header "Heap"]
+   [:div {:class "heap-entry-container"}
+    [:<> (map (partial HeapEntry heap) (keys heap))]]])
 
 ;------------------------------------------------------------------------------;
 
@@ -77,6 +98,14 @@
 (def app-prec+1 11)
 (def app-prec-1 9)
 
+(defn ppr-list [heap addrs]
+  (match addrs
+         [] "[]"
+         _ (str "[" (->> addrs
+                         (map (partial ppr-node* 0 heap))
+                         (interpose ", ")
+                         (concat)) "]")))
+
 (defn ppr-node* [p heap addr]
   (match (deref-addr heap addr)
     {:tag "NGlobal" :contents [arity code]}
@@ -85,7 +114,7 @@
 
     {:tag "NNum" :contents k}
     (maybe-parens (> p 0)
-                  (words "Num" k))
+                  (words "Number" k))
 
     {:tag "NAp" :contents [f x]}
     (maybe-parens (> p app-prec)
@@ -93,6 +122,25 @@
                          "@"
                          (ppr-node* app-prec+1 heap x)))
 
+    {:tag "NConstr" :contents [tag as]}
+    (maybe-parens (> p 0)
+                  (words "Constructor"
+                         tag
+                         (ppr-list heap as)))
+
+    {:tag "NInd" :contents addr*}
+    (maybe-parens (> p 0)
+                  (words "Indirection"
+                         (ppr-node* app-prec+1 heap addr*)))
+
+    {:tag "NUninitialised"}
+    "<Uninitialised>"
+
+    {:tag "NMarked" :contents node*}
+    (maybe-parens (> p 0)
+                  (words "Marked"
+                         "<node>"))
+    
     nil (str "<broken pointer: &" addr ">")
 
     a (str "other" a)))
@@ -158,7 +206,7 @@
            heap :_gmHeap}]
   [Root {:direction "horizontal"}
    [Pane {:order 0 :initialSize "0.333fr"}
-    [Heap]]
+    [Heap heap]]
    [Splitter {:order 1 :size +split-width+}]
    [Pane {:order 2 :initialSize "0.333fr"}
     [Root {:direction "vertical"}