From ef68cc4d9fcbd01398ca291ef7cba45ff8cab70d Mon Sep 17 00:00:00 2001
From: crumbtoo <crumb@disroot.org>
Date: Wed, 27 Mar 2024 13:57:10 -0600
Subject: [PATCH] letrec

---
 src/Rlp/AltParse.y                         |  2 +-
 visualisers/hmvis/public/css/main.css      |  7 +++-
 visualisers/hmvis/src/hmvis/annotated.cljs | 41 +++++++++++++++++++---
 visualisers/hmvis/src/main.cljs            | 20 ++++-------
 4 files changed, 51 insertions(+), 19 deletions(-)

diff --git a/src/Rlp/AltParse.y b/src/Rlp/AltParse.y
index 6352b9c..610e435 100644
--- a/src/Rlp/AltParse.y
+++ b/src/Rlp/AltParse.y
@@ -209,7 +209,7 @@ layout_list0(sep,p) : p                          { [$1] }
 
 -- layout1(p : β) :: [β]
 layout1(p)  : '{' layout_list1(';',p) '}'   { $2 }
-            | VL  layout_list1(VS,p) VS VR     { $2 }
+            | VL  layout_list1(VS,p) VS VR  { $2 }
             | VL  layout_list1(VS,p) VR     { $2 }
 
 -- layout_list1(sep : α, p : β) :: [β]
diff --git a/visualisers/hmvis/public/css/main.css b/visualisers/hmvis/public/css/main.css
index d6ce1c6..3e6580a 100644
--- a/visualisers/hmvis/public/css/main.css
+++ b/visualisers/hmvis/public/css/main.css
@@ -72,7 +72,7 @@ body {
 .annotation-wrapper .annotation
 { position: relative
 ; bottom: 0
-; min-height: 0.50em
+; min-height: 0.60em
 }
 
 .annotation-text
@@ -87,6 +87,11 @@ body {
 { display: inline-block
 }
 
+code
+{ font-family: monospace
+; font-size: 1em
+}
+
 /* .typed-wrapper.hovering > .code-wrapper */
 /* { border-width: 0.2em */
 /* ; border-style: solid */
diff --git a/visualisers/hmvis/src/hmvis/annotated.cljs b/visualisers/hmvis/src/hmvis/annotated.cljs
index 9611ac0..40d417f 100644
--- a/visualisers/hmvis/src/hmvis/annotated.cljs
+++ b/visualisers/hmvis/src/hmvis/annotated.cljs
@@ -6,15 +6,24 @@
             [reagent.core :as r]
             [reagent.dom :as rdom]
             [clojure.pprint :refer [cl-format]]
-            [hmvis.ppr :as ppr]))
+            [hmvis.ppr :as ppr]
+            [clojure.pprint :refer [pprint]]
+            [clojure.string :as str]))
 
 (defonce tc-input (r/atom nil))
 
 (defonce current-annotation-text (r/atom nil))
 
+(defn unicodify [s]
+  (str/replace s #"->" "→"))
+
+(defn punctuate [p & as]
+  (match as
+         [] ""
+         _  (reduce #(str %1 p %2) as)))
+
 (defn hsep [& as]
-  (let [f (fn [a b] (str a " " b))]
-    (reduce f as)))
+  (apply punctuate " " as))
 
 (defn maybe-parens [c s]
   (if c
@@ -52,7 +61,7 @@
                            "typed-wrapper")
                 }
           [:div {:class "code-wrapper"} child]]
-         [Annotation colour t hovering?]])))
+         [Annotation colour (unicodify t) hovering?]])))
 
 (declare Expr)
 
@@ -70,6 +79,27 @@
        " "
        [Expr colours ppr/app-prec1 x]])
 
+(defn let-or-letrec [rec]
+  (match rec
+         "Rec"    "letrec"
+         "NonRec" "let"))
+
+(defn Pat [colours p {:keys [tag contents]}]
+  (match tag
+         "VarP" contents))
+
+(defn Binding [colours {:keys [tag contents]}]
+  (match tag
+         "VarB" (let [[p v] contents]
+                  [:<> [Pat colours 0 p] " = " [Expr colours 0 v]])))
+
+(defn LetExpr [colours rec bs e]
+  [:<> (let-or-letrec rec)
+       " "
+       (apply punctuate "; " (map (partial Binding colours) bs))
+       " in "
+       (Expr colours 0 e)])
+
 (defn Expr [[c & colours] p {e :e t :type}]
   (match e
     {:InL {:tag "LamF" :contents [bs body & _]}}
@@ -80,6 +110,9 @@
     {:InL {:tag "AppF" :contents [f x]}}
       (maybe-parens (< ppr/app-prec p)
                     [Typed c t [AppExpr colours f x]])
+    {:InR {:tag "LetEF" :contents [r bs body]}}
+      (maybe-parens (< ppr/app-prec1 p)
+                    [Typed c t [LetExpr colours r bs body]])
     :else [:code "<expr>"]))
 
 (def rainbow-cycle (cycle ["red"
diff --git a/visualisers/hmvis/src/main.cljs b/visualisers/hmvis/src/main.cljs
index 647003e..56168c4 100644
--- a/visualisers/hmvis/src/main.cljs
+++ b/visualisers/hmvis/src/main.cljs
@@ -38,21 +38,15 @@
            :else
              (js/console.warn "unrecognisable response from rlp"))))
 
-(def *socket (ws/create "ws://127.0.0.1:9002"
-                        {:on-message on-message
-                         :on-open #(println "socket opened")
-                         :on-close #(println "socket closed")
-                         :on-error #(println "error: " %)}))
+(defonce *socket (ws/create "ws://127.0.0.1:9002"
+                            {:on-message on-message
+                             :on-open #(println "socket opened")
+                             :on-close #(println "socket closed")
+                             :on-error #(println "error: " %)}))
 
 (defn send [msg]
   (ws/send *socket msg fmt/json))
 
-; (defn init-type-check-button []
-;   (let [b (.querySelector js/document "#type-check")]
-;     (.addEventListener b "click"
-;                        #(send {:command "annotate"
-;                                :source (.getValue *editor)}))))
-
 (defonce *editor nil)
 
 (defn TypeCheckButton []
@@ -68,7 +62,8 @@
       :theme "solarized_light"
       :keyboardHandler "vim"
       :defaultValue (str "id = \\x -> x\n"
-                         "flip f x y = f y x\n")
+                         "flip f x y = f y x\n"
+                         "fix f = letrec x = f x in x")
       :style {:width "100%"
               :height "100%"}
       :on-load (fn [editor]
@@ -104,6 +99,5 @@
 
 ;; this is called before any code is reloaded
 (defn ^:dev/before-load stop []
-  (ws/close *socket)
   (js/console.log "stop"))