120 lines
3.2 KiB
Clojure
120 lines
3.2 KiB
Clojure
(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))")))
|