letrec

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 */

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))]
+  (apply punctuate " " as))
-    (reduce f 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"

visualisers/hmvis/src/main.cljs

@@ -38,7 +38,7 @@
            :else
              (js/console.warn "unrecognisable response from rlp"))))
 
-(def *socket (ws/create "ws://127.0.0.1:9002"
+(defonce *socket (ws/create "ws://127.0.0.1:9002"
                             {:on-message on-message
                              :on-open #(println "socket opened")
                              :on-close #(println "socket closed")
@@ -47,12 +47,6 @@
 (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"))