Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

UNIFY-11: ClojureScript support (Draft) #5

Closed
wants to merge 1 commit into from
Closed

UNIFY-11: ClojureScript support (Draft) #5

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
46 changes: 46 additions & 0 deletions .github/workflows/cljs_test.yml
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,46 @@
name: ClojureScript Test
on: [push]

jobs:
cljs-test:
name: ClojureScript Test
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v2

- uses: actions/setup-java@v4
with:
distribution: 'temurin'
java-version: '17'

- uses: DeLaGuardo/[email protected]
with:
tools-deps: '1.10.1.763'

- name: Cache maven
uses: actions/cache@v2
env:
cache-name: cache-maven
with:
path: ~/.m2
key: ${{ runner.os }}-${{ env.cache-name }}-${{ hashFiles('**/deps.edn') }}
restore-keys: |
${{ runner.os }}-${{ env.cache-name }}-

- name: Cache gitlibs
uses: actions/cache@v2
env:
cache-name: cache-gitlibs
with:
path: ~/.gitlibs
key: ${{ runner.os }}-${{ env.cache-name }}-${{ hashFiles('**/deps.edn') }}
restore-keys: |
${{ runner.os }}-${{ env.cache-name }}-

- name: Build tests
run: clojure -M:test:cljs-build

- name: Run tests
run: |
node target/test.js | tee test-out.txt
grep -qxF '0 failures, 0 errors.' test-out.txt
1 change: 1 addition & 0 deletions .gitignore
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,3 +3,4 @@ target
lib
multi-lib
.cpcache/
target
2 changes: 1 addition & 1 deletion README.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
clojure.core.unify
========================================

core.unify is a Clojure contrib library providing the following features:
core.unify is a Clojure & ClojureScript contrib library providing the following features:

* Factory functions for constructing unification binding, subst, and unification functions, with or without occurs checking

Expand Down
10 changes: 9 additions & 1 deletion deps.edn
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,4 +13,12 @@
{:git/url "https://github.com/cognitect-labs/test-runner"
:sha "f7ef16dc3b8332b0d77bc0274578ad5270fbfedd"}}
:main-opts ["-m" "cognitect.test-runner"
"-d" "src/test/clojure"]}}}
"-d" "src/test/clojure"]}
:cljs
{:extra-deps {org.clojure/clojurescript {:mvn/version "1.11.132"}}
:main-opts ["-m" "cljs.main" "-re" "node" "-r"]}
:cljs-build
{:extra-paths ["src/test/cljs"]
:extra-deps {org.clojure/clojurescript {:mvn/version "1.11.132"}}
:main-opts ["-m" "cljs.main" "-v" "-O" "advanced" "-d" "target"
"-o" "target/test.js" "-c" "clojure.core.unify-test-runner"]}}}
75 changes: 37 additions & 38 deletions src/main/clojure/clojure/core/unify.clj → src/main/clojure/clojure/core/unify.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@
(ns ^{:doc "A unification library for Clojure."
:author "Michael Fogus"}
clojure.core.unify
#?(:cljs (:require-macros [clojure.core.unify :refer [create-var-unification-fn]]))
(:require [clojure.zip :as zip]
[clojure.walk :as walk]))

Expand Down Expand Up @@ -36,12 +37,13 @@
predicate. At the moment, the only meaning of `composite?` is:
Returns true if `(seq x)` will succeed, false otherwise."
[x]
(or (coll? x)
(nil? x)
(instance? Iterable x)
(-> x class .isArray)
(string? x)
(instance? java.util.Map x)))
#?(:clj (or (coll? x)
(nil? x)
(instance? Iterable x)
(-> x class .isArray)
(string? x)
(instance? java.util.Map x))
:cljs (seqable? x)))

(declare garner-unifiers)

Expand All @@ -58,7 +60,6 @@
(recur (zip/next (zip/insert-right z (binds current))))
:else (recur (zip/next z))))))


(defn- bind-phase
[binds variable expr]
(if (or (nil? expr)
Expand All @@ -70,24 +71,25 @@
[want-occurs? variable? v expr binds]
(if want-occurs?
`(if (occurs? ~variable? ~v ~expr ~binds)
(throw (IllegalStateException. (str "Cycle found in the path " ~expr)))
#?(:clj (throw (IllegalStateException. (str "Cycle found in the path " ~expr)))
:cljs (throw (js/Error. (str "Cycle found in the path " ~expr))))
(bind-phase ~binds ~v ~expr))
`(bind-phase ~binds ~v ~expr)))

(defmacro create-var-unification-fn
[want-occurs?]
(let [varp (gensym)
v (gensym)
expr (gensym)
binds (gensym)]
`(fn ~'var-unify
[~varp ~v ~expr ~binds]
(if-let [vb# (~binds ~v)]
(garner-unifiers ~varp vb# ~expr ~binds)
(if-let [vexpr# (and (~varp ~expr) (~binds ~expr))]
(garner-unifiers ~varp ~v vexpr# ~binds)
~(determine-occursness want-occurs? varp v expr binds))))))

#?(:clj
(defmacro create-var-unification-fn
[want-occurs?]
(let [varp (gensym)
v (gensym)
expr (gensym)
binds (gensym)]
`(fn ~'var-unify
[~varp ~v ~expr ~binds]
(if-let [vb# (~binds ~v)]
(garner-unifiers ~varp vb# ~expr ~binds)
(if-let [vexpr# (and (~varp ~expr) (~binds ~expr))]
(garner-unifiers ~varp ~v vexpr# ~binds)
~(determine-occursness want-occurs? varp v expr binds)))))))

(def ^{:doc "Unify the variable v with expr. Uses the bindings supplied and possibly returns an extended bindings map."
:private true}
Expand All @@ -102,10 +104,6 @@
(#{'&} (first form))))

(defn- garner-unifiers
"Attempt to unify x and y with the given bindings (if any). Potentially returns a map of the
unifiers (bindings) found. Will throw an `IllegalStateException` if the expressions
contain a cycle relationship. Will also throw an `IllegalArgumentException` if the
sub-expressions clash."
([x y] (garner-unifiers unify-variable lvar? x y {}))
([variable? x y] (garner-unifiers unify-variable variable? x y {}))
([variable? x y binds] (garner-unifiers unify-variable variable? x y binds))
Expand Down Expand Up @@ -141,7 +139,6 @@
binds)))))

(defn- try-subst
"Attempts to substitute the bindings in the appropriate locations in the given expression."
[variable? x binds]
{:pre [(map? binds) (fn? variable?)]}
(walk/prewalk (fn [expr]
Expand All @@ -153,8 +150,6 @@
x))

(defn- unifier*
"Attempts the entire unification process from garnering the bindings to substituting
the appropriate bindings."
([x y] (unifier* lvar? x y))
([variable? x y]
(unifier* variable? x y (garner-unifiers variable? x y)))
Expand Down Expand Up @@ -191,17 +186,19 @@
(partial unifier* variable-fn))


(def ^{:doc (str (:doc (meta #'garner-unifiers))
" Note: This function is implemented with an occurs-check.")
(def ^{:doc "Attempt to unify x and y with the given bindings (if any). Potentially returns a map of the
unifiers (bindings) found. Will throw an `IllegalStateException` if the expressions
contain a cycle relationship. Will also throw an `IllegalArgumentException` if the
sub-expressions clash. Note: This function is implemented with an occurs-check."
:arglists '([expression1 expression2])}
unify (make-occurs-unify-fn lvar?))

(def ^{:doc (:doc (meta #'try-subst))
(def ^{:doc "Attempts to substitute the bindings in the appropriate locations in the given expression."
:arglists '([expression bindings])}
subst (make-occurs-subst-fn lvar?))

(def ^{:doc (str (:doc (meta #'unifier*))
" Note: This function is implemented with an occurs-check.")
(def ^{:doc "Attempts the entire unification process from garnering the bindings to substituting
the appropriate bindings. Note: This function is implemented with an occurs-check."
:arglists '([expression1 expression2])}
unifier (make-occurs-unifier-fn lvar?))

Expand Down Expand Up @@ -232,14 +229,16 @@
(garner-unifiers unify-variable- variable-fn x y {}))))


(def ^{:doc (str (:doc (meta #'garner-unifiers))
" Note: This function is implemented **without** an occurs-check.")
(def ^{:doc "Attempt to unify x and y with the given bindings (if any). Potentially returns a map of the
unifiers (bindings) found. Will throw an `IllegalStateException` if the expressions
contain a cycle relationship. Will also throw an `IllegalArgumentException` if the
sub-expressions clash. Note: This function is implemented **without** an occurs-check."
:arglists '([expression1 expression2])}
unify- (make-unify-fn lvar?))


(def ^{:doc (str (:doc (meta #'unifier*))
" Note: This function is implemented **without** an occurs-check.")
(def ^{:doc "Attempts the entire unification process from garnering the bindings to substituting
the appropriate bindings. Note: This function is implemented **without** an occurs-check."
:arglists '([expression1 expression2])}
unifier- (make-unifier-fn lvar?))

Expand Down
16 changes: 16 additions & 0 deletions src/test/cljs/clojure/core/unify_test_runner.cljs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,16 @@
; Copyright (c) Rich Hickey. All rights reserved.
; The use and distribution terms for this software are covered by the
; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
; which can be found in the file epl-v10.html at the root of this distribution.
; By using this software in any fashion, you are agreeing to be bound by
; the terms of this license.
; You must not remove this notice, or any other, from this software.

(ns ^{:doc "A unification library for Clojure."
:author "Michael Fogus"}
clojure.core.unify-test-runner
(:require [clojure.core.unify-test]
[clojure.test :refer [run-tests]]))

(run-tests
'clojure.core.unify-test)
23 changes: 16 additions & 7 deletions src/test/clojure/clojure/core/unify_test.clj → ...test/clojure/clojure/core/unify_test.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,12 +9,19 @@
(ns ^{:doc "A unification library for Clojure."
:author "Michael Fogus"}
clojure.core.unify-test
(:use [clojure.core.unify] :reload-all)
(:use [clojure.test]))
(:require [clojure.core.unify :refer [unify]]
[clojure.test :refer [deftest is testing]]))

(println "\nTesting with Clojure" (clojure-version))
#?(:clj (println "\nTesting with Clojure" (clojure-version))
:cljs (println "\nTesting with ClojureScript" *clojurescript-version*))

(def CAPS #(and (symbol? %) (Character/isUpperCase (first (name %)))))
#?(:cljs
(defn uppercase? [s]
(let [c (.charCodeAt s 0)]
(and (>= c 65)
(<= c 90)))))

(def CAPS #(and (symbol? %) (#?(:clj Character/isUpperCase :cljs uppercase?) (first (name %)))))

(deftest test-garner-unifiers
(is (= {} (#'clojure.core.unify/garner-unifiers '(a b) '(a b))))
Expand All @@ -32,8 +39,10 @@
(is (nil? (#'clojure.core.unify/garner-unifiers '(f ?a) '(g 42)))) ; clash
(is (nil? (#'clojure.core.unify/garner-unifiers '(?a ?a) 'a))) ; clash
(is (= '{?y (h), ?x (h)} (#'clojure.core.unify/garner-unifiers '(f ?x (h)) '(f (h) ?y))))
(is (thrown? IllegalStateException (#'clojure.core.unify/garner-unifiers '(f (g ?x) ?y) '(f ?y ?x)))) ; cycle
(is (thrown? IllegalStateException (#'clojure.core.unify/garner-unifiers '?x '(f ?x)))) ; cycle
(is (thrown? #?(:clj IllegalStateException :cljs js/Error)
(#'clojure.core.unify/garner-unifiers '(f (g ?x) ?y) '(f ?y ?x)))) ; cycle
(is (thrown? #?(:clj IllegalStateException :cljs js/Error)
(#'clojure.core.unify/garner-unifiers '?x '(f ?x)))) ; cycle
(is (= '{?y (g ?x)} (#'clojure.core.unify/garner-unifiers '(f (g ?x) ?y) '(f ?y (g ?x)))))
(is (= '{?z (g ?x), ?y (g ?x)} (#'clojure.core.unify/garner-unifiers '(f (g ?x) ?y) '(f ?y ?z))))
(is (= '{?a a} (#'clojure.core.unify/garner-unifiers '?a 'a)))
Expand Down Expand Up @@ -75,7 +84,7 @@
(is (= #{2 3 4} (#'clojure.core.unify/unifier- #{'?a '?b '?c} #{2 3 4}))))

(deftest test-mk-unifier
(let [u (#'clojure.core.unify/make-occurs-unifier-fn #(and (symbol? %)
(let [u (#'clojure.core.unify/make-occurs-unifier-fn #(and (symbol? %)
(re-matches #"^\?.*" (name %))))]
(is (= '((?a * 5 ** 2) + (4 * 5) + 3) (u '((?a * ?x ** 2) + (?b * ?x) + ?c) '(?z + (4 * 5) + 3))))))

Expand Down
Loading