using membero

This commit is contained in:
Jonas Enlund 2012-03-16 19:01:38 +02:00
parent 2dbbfee70e
commit fa2539b524

View file

@ -18,7 +18,7 @@
;; directory. ;; directory.
;; ;;
;; For more information, see: [rule](#jonase.kibit.rules) namespace ;; For more information, see: [rule](#jonase.kibit.rules) namespace
(def all-rules core-rules/all-rules) (def all-rules (map logic/prep core-rules/all-rules))
;; Building an alternative form ;; Building an alternative form
;; ---------------------------- ;; ----------------------------
@ -43,43 +43,20 @@
(defn unify (defn unify
"Unify expr with a rule pair. On success, return a map keyed with "Unify expr with a rule pair. On success, return a map keyed with
`:rule, :expr, :line and :alt`, otherwise return `nil`" `:rule, :expr, :line and :alt`, otherwise return `nil`"
[expr rule] [expr rules]
(let [[r s] (#'logic/prep rule) (let [alt (first (logic/run* [q]
alt (first (logic/run* [alt] (logic/fresh [pat alt]
(logic/== expr r) (logic/membero [pat alt] rules)
(logic/== s alt)))] (logic/== expr pat)
(logic/== q alt))))]
(when alt (when alt
{:expr expr {:expr expr
:rule rule ;:rule rule
:alt (if (seq? alt) :alt (if (seq? alt)
(seq alt) (seq alt)
alt) alt)
:line (-> expr meta :line)}))) :line (-> expr meta :line)})))
;; ### Applying unification
;; The `check-form` function does a linear search over the rules and
;; returns the map created by the first successful unification with
;; expr.
(defn check-form
"Returns the first successful unification for expr against the
rules. Returns nil if no rule unifies with expr"
([expr]
(check-form expr all-rules))
([expr rules]
(when (sequential? expr)
(some #(unify expr %) rules))))
;; This walks across all the forms within an expr-sequence,
;; checking each inner form. We have to restore `:expr` because it
;; gets munged in the tree/expr walk
(defn check-expr
"Given a full expression/form-of-forms/form, return a map containing the
alternative suggestion info, or `nil` (see: `check-form`)"
[expr]
(when-let [new-expr (walk/walk #(or (-> % check-form :alt) %) check-form expr)]
(assoc new-expr :expr expr)))
;; Reading source files ;; Reading source files
;; -------------------- ;; --------------------
@ -126,5 +103,5 @@
([reader] ([reader]
(check-file reader all-rules)) (check-file reader all-rules))
([reader rules] ([reader rules]
(keep check-form (keep #(unify % rules)
(mapcat expr-seq (read-ns (LineNumberingPushbackReader. reader)))))) (mapcat expr-seq (read-ns (LineNumberingPushbackReader. reader))))))