@@ -0,0 +1,119 @@
|
||||
(ns net.deertopia.doerg.elisp
|
||||
(:require [clojure.core.match :refer [match]]
|
||||
[clojure.java.io :as io]
|
||||
[clojure.spec.alpha :as s]
|
||||
[instaparse.core :as ip])
|
||||
(:refer-clojure :exclude [print read read-string]))
|
||||
|
||||
(ip/defparser read*
|
||||
(io/resource "net/deertopia/doerg/elisp/grammar"))
|
||||
|
||||
(defn- transform-string [s]
|
||||
(let [s* (loop [s (seq s)
|
||||
acc ""]
|
||||
(match s
|
||||
([\\ c & cs] :seq)
|
||||
(recur
|
||||
cs
|
||||
(str acc
|
||||
(condp = c
|
||||
\n \newline
|
||||
\f \formfeed
|
||||
\\ \\
|
||||
\" \"
|
||||
\newline nil
|
||||
(throw (ex-info "IDK!" {:char c})))))
|
||||
([c & cs] :seq) (recur cs (str acc c))
|
||||
([] :seq) acc))]
|
||||
[:string (apply str s*)]))
|
||||
|
||||
(defn- transform-integer [s]
|
||||
[:integer (parse-long s)])
|
||||
|
||||
(defn- transform-property-string
|
||||
([[_ text]]
|
||||
[:string text])
|
||||
([[_ text] & props]
|
||||
[:string text (->> (for [[_ [_ beg] [_ end] prop] props]
|
||||
{[beg end] prop})
|
||||
(apply merge))]))
|
||||
|
||||
(defn- transform-list [& xs]
|
||||
(match (last xs)
|
||||
[:dot-cdr x] [:cons* (butlast xs) x]
|
||||
_ [:cons* xs]))
|
||||
|
||||
(def transforms {:string transform-string
|
||||
:list transform-list
|
||||
:integer transform-integer
|
||||
:property-string transform-property-string})
|
||||
|
||||
(defn read [s & args]
|
||||
(->> (apply read* s args)
|
||||
(ip/transform transforms)))
|
||||
|
||||
(defn read-string [s]
|
||||
(read s :start :text))
|
||||
|
||||
(defn cons? [x]
|
||||
(= (first x) :cons*))
|
||||
|
||||
(s/def ::alist
|
||||
(s/tuple #{:list}
|
||||
(s/and ::list
|
||||
cons?)))
|
||||
|
||||
(defn car [x]
|
||||
(match x
|
||||
[:cons* xs y] (first xs)
|
||||
[:cons* xs] (first xs)
|
||||
[:symbol "nil"] nil
|
||||
_ nil))
|
||||
|
||||
(defn cdr [x]
|
||||
(match x
|
||||
[:cons* xs y] (if (<= (count xs) 1)
|
||||
y
|
||||
[:cons* (rest xs) y])
|
||||
[:cons* xs] [:cons* (rest xs)]
|
||||
[:symbol "nil"] nil
|
||||
_ nil))
|
||||
|
||||
(defn emacs-list? [x]
|
||||
(match x
|
||||
[:cons* xs] true
|
||||
_ false))
|
||||
|
||||
(defn read-alist [s]
|
||||
(let [r (->> s read*
|
||||
(ip/transform
|
||||
(merge transforms
|
||||
{:symbol (fn [s] (symbol s))
|
||||
:string (fn [s] s)}))
|
||||
first)]
|
||||
(match r
|
||||
[:cons* pairs] (->> (for [pair pairs]
|
||||
(let [x (car pair)
|
||||
y (cdr pair)]
|
||||
{x y}))
|
||||
(apply merge))
|
||||
_ nil)))
|
||||
|
||||
(defn read-string [s]
|
||||
(match (-> s read first)
|
||||
[:string x & props] x
|
||||
:else nil))
|
||||
|
||||
(defn print [x]
|
||||
;; TODO: this is really not how it should be done lol. at the
|
||||
;; moment, `print` is only used in `net.deertopia.doerg.roam`
|
||||
;; and only to serialise uuids, so it's not a /massive/ priority.
|
||||
(cond (or (string? x) (uuid? x)) (str \" x \")
|
||||
:else (throw (ex-info "`print` is unimplemented lol"
|
||||
{:x x}))))
|
||||
|
||||
(comment
|
||||
(do (ip/defparser parse* (io/resource "elisp-grammar"))
|
||||
(read "#(\"blah\" 0 1 (doge))")
|
||||
(read "\"bla\\nh\"")
|
||||
(read-alist "((x . y))")))
|
||||
Reference in New Issue
Block a user