msyds/rlp
1
0
Fork 0
Code Issues 4 Pull Requests Actions Packages Projects Releases 2 Wiki Activity

letrec

Browse Source
This commit is contained in:
crumbtoo
2024-03-27 13:57:10 -06:00
parent b6a4f71706
commit 92305b2031
4 changed files with 51 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/Rlp/AltParse.y
View File

@@ -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 : β) :: [β]

7
visualisers/hmvis/public/css/main.css
View File

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

41
visualisers/hmvis/src/hmvis/annotated.cljs
View File

@@ -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"

20
visualisers/hmvis/src/main.cljs
View File

@@ -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"))