Skip to content

Instantly share code, notes, and snippets.

@swannodette
Last active December 29, 2015 10:09
Show Gist options
  • Star 8 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save swannodette/7654717 to your computer and use it in GitHub Desktop.
Save swannodette/7654717 to your computer and use it in GitHub Desktop.
(ns logic-ast.core
(:refer-clojure :exclude [==])
(:require [clojure.java.io :as io]
[clojure.pprint :as pp]
[cljs.env :as env]
[cljs.analyzer.utils :as u]
[cljs.analyzer :as ana]
[clojure.core.logic
:refer [run run* conde == fresh lcons partial-map defne] :as l]
[clojure.core.logic.pldb :as pldb]))
(def ana-env (atom {}))
#_(env/with-compiler-env ana-env
(ana/analyze-file "cljs/core.cljs"))
(declare invokes)
(defne invokes-in-ops [ops op-tag out]
([[op . rest] _ _]
(conde
[(invokes {:op op-tag op-tag op} out)]
[(invokes-in-ops rest op-tag out)])))
(defn invokes [ast out]
(conde
[(fresh [methods]
(== (partial-map {:op :def :init {:methods methods}}) ast)
(invokes-in-ops methods :method out))]
[(fresh [expr]
(== (partial-map {:op :method :method {:expr expr}}) ast)
(invokes expr out))]
[(fresh [ret]
(== (partial-map {:op :do :ret ret}) ast)
(invokes ret out))]
[(fresh [args]
(== (partial-map {:op :invoke :args args}) ast)
(conde
[(== (partial-map {:f {:info {:name out}}}) ast)]
[(invokes-in-ops args :arg out)]))]
[(fresh [arg]
(== (partial-map {:op :arg :arg arg}) ast)
(invokes arg out))]))
(comment
;; ideal syntax once defne uses partial maps for map unification
(defne invokes [ast out]
([{:op :def :init {:methods methods}} _]
(invokes-in-ops methods :method out))
([{:op :method :method {:expr expr}} _]
(invokes expr out))
([{:op :do :ret ret} _]
(invokes ret out))
([{:op :invoke :args args} _]
(conde
[(== (partial-map {:f {:info {:name out}}}) ast)]
[(invokes-in-ops args :arg out)]))
([{:op :arg :arg arg} _]
(invokes arg out)))
(->> '(defn foo [a b] (bar c (baz c)))
u/to-ast
pp/pprint)
(run* [q]
(== (->> '(defn foo [a b] (bar c (baz c)))
u/to-ast)
(partial-map {:op q})))
(let [ast (u/to-ast '(defn foo [a b] (bar c (baz d))))]
(run* [q]
(invokes ast q))) ;; (cljs.user/bar cljs.user/baz)
)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment