feat: refactor parser (#144)

src/stencil/cleanup.clj

@@ -56,7 +56,7 @@
 (defn- nested-tokens-fmap-postwalk
  "Depth-first traversal of the tree."
  [f-cmd-block-before f-cmd-block-after f-child node]
- (assert (map? node)) 
+ (assert (map? node))
  (letfn [(children-mapper [children]
  (mapv update-blocks children))
  (update-children [node]
@@ -164,23 +164,25 @@
  ;; amikor van benne blocks
  ;; mapping: {Sym -> Str}
  (letfn [(resolve-sym [mapping s]
- (assert (map? mapping))
- (assert (symbol? s))
- ;; megprobal egy adott szimbolumot a mapping alapjan rezolvalni.
- ;; visszaad egy stringet
- (if (.contains (name s) ".")
- (let [[p1 p2] (vec (.split (name s) "\\." 2))]
- (if-let [pt (mapping (symbol p1))]
- (str pt "." p2)
- (name s)))
- (mapping s (name s))))
- (expr [mapping rpn]
- (assert (sequential? rpn)) ;; RPN kifejezes kell legyen
- (keep (partial resolve-sym mapping) (filter symbol? rpn)))
- ;; iff rpn expr consists of 1 variable only -> resolves that one variable.
- (maybe-variable [mapping rpn]
- (when (and (= 1 (count rpn)) (symbol? (first rpn)))
- (resolve-sym mapping (first rpn))))
+ (assert (map? mapping))
+ (assert (symbol? s))
+ (mapping s (name s)))
+ (expr [mapping e]
+ (cond (symbol? e) [(resolve-sym mapping e)]
+ (not (sequential? e)) nil
+ (= :fncall (first e)) (mapcat (partial expr mapping) (nnext e))
+ (= :get (first e)) (let [[ss rest] (split-with string? (nnext e))]
+ (cons
+ (reduce (fn [root item] (str root "." item))
+ (resolve-sym mapping (second e))
+ ss)
+ (mapcat (partial expr mapping) rest)))
+ :else (mapcat (partial expr mapping) (next e))))
+ (maybe-variable [mapping e]
+ (cond (symbol? e)
+ (resolve-sym mapping e) 
+ (and (sequential? e) (= :get (first e)) (symbol? (second e)) (every? string? (nnext e)))
+ (reduce (fn [a b] (str a "." b)) (resolve-sym mapping (second e)) (nnext e))))
  (collect [m xs] (mapcat (partial collect-1 m) xs))
  (collect-1 [mapping x]
  (case (:cmd x)

src/stencil/grammar.clj

@@ -0,0 +1,89 @@
+(ns stencil.grammar)
+
+(defn- guarded [pred]
+ (fn [t]
+ (when (pred (first t))
+ [(first t) (next t)])))
+
+;; left-associative chained infix expression
+(defn- chained [reader reader* reducer]
+ (fn [tokens] chained
+ (when-let [[result tokens] (reader tokens)]
+ (loop [tokens tokens
+ result result]
+ (if (empty? tokens)
+ [result nil]
+ (if-let [[fs tokens] (reader* tokens)]
+ (recur tokens (reducer result fs))
+ [result tokens]))))))
+
+(defn- read-or-throw [reader tokens]
+ (or (reader tokens)
+ (throw (ex-info (str "Invalid stencil expression!") {:reader reader :prefix tokens}))))
+
+(defn- all [condition & readers]
+ (fn [tokens]
+ (when-let [[result tokens] (condition tokens)]
+ (reduce (fn [[result tokens] reader]
+ (let [[r tokens] (read-or-throw reader tokens)]
+ [(conj result r) tokens]))
+ [[result] tokens] readers))))
+
+(defmacro ^:private grammar [bindings body]
+ `(letfn* [~@(for [[k v] (partition 2 bindings), x [k (list 'fn '[%] (list v '%))]] x)] ~body))
+
+(defn- mapping [reader mapper]
+ (fn [tokens]
+ (when-let [[result tokens] (reader tokens)]
+ [(mapper result) tokens])))
+
+(defn- parenthesed [reader]
+ (mapping (all (guarded #{:open}) reader (guarded #{:close})) second))
+
+(defn- op-chain [operand operator]
+ (chained operand (all operator operand) (fn [a [op b]] (list op a b))))
+
+(defn- op-chain-r [operand operator]
+ (mapping (chained (all operand) (all operator operand) (fn [a [op b]] (list* b op a)))
+ (fn [a] (reduce (fn [a [op c]] [op c a]) (first a) (partition 2 (next a))))))
+
+(defn- at-least-one [reader]
+ (fn [tokens]
+ (when-let [[result tokens] (reader tokens)]
+ (loop [tokens tokens, result [result]]
+ (if-let [[res tokens] (reader tokens)]
+ (recur tokens (conj result res))
+ [result tokens])))))
+
+(defn- optional [reader] ;; always matches
+ (fn [t] (or (reader t) [nil t])))
+
+(def testlang
+ (grammar [val (some-fn iden-or-fncall
+ (parenthesed expression)
+ (guarded number?)
+ (guarded string?))
+ iden (guarded symbol?)
+ dotted (mapping (all (guarded #{:dot}) iden) (comp name second))
+ bracketed (mapping (all (guarded #{:open-bracket}) expression (guarded #{:close-bracket})) second)
+ args (mapping (optional (chained (all expression) (all (guarded #{:comma}) expression) into))
+ (fn [x] (take-nth 2 x)))
+ args-suffix (parenthesed args)
+ iden-or-fncall (mapping (all iden (optional args-suffix))
+ (fn [[id xs]] (if xs (list* :fncall id xs) id)))
+ accesses (mapping (all val (optional (at-least-one (some-fn bracketed dotted))))
+ (fn [[id chain]] (if chain (list* :get id chain) id)))
+ neg (some-fn (all (guarded #{:minus}) neg) accesses)
+ not (some-fn (all (guarded #{:not}) not) neg)
+ pow (op-chain-r not (guarded #{:power}))
+ mul (op-chain pow (guarded #{:times :divide :mod}))
+ add (op-chain mul (guarded #{:plus :minus}))
+ cmp (op-chain add (guarded #{:lt :gt :lte :gte}))
+ cmpe (op-chain cmp (guarded #{:eq :neq}))
+ and (op-chain cmpe (guarded #{:and}))
+ or (op-chain and (guarded #{:or}))
+ expression or]
+ expression))
+
+(defn runlang [grammar input]
+ (ffirst (read-or-throw (all grammar {nil []}) input)))