UNIFY-11: ClojureScript Support

* .clj -> .cljc * remove dynamic docstrings * add CLJS affordances to deps.edn * add CLJS test runner * add CLJS CI test * gitignore target dir * Update README
clojure · Sep 28, 2024 · 095d352 · 095d352
1 parent 8de557b
commit 095d352
Show file tree

Hide file tree

Showing 7 changed files with 126 additions and 47 deletions.
diff --git a/.github/workflows/cljs_test.yml b/.github/workflows/cljs_test.yml
@@ -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
diff --git a/.gitignore b/.gitignore
@@ -3,3 +3,4 @@ target
 lib
 multi-lib
 .cpcache/
+target
diff --git a/README.md b/README.md
@@ -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
 

diff --git a/deps.edn b/deps.edn
@@ -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"]}}}
diff --git a/src/main/clojure/clojure/core/unify.clj → src/main/clojure/clojure/core/unify.cljc b/src/main/clojure/clojure/core/unify.clj → src/main/clojure/clojure/core/unify.cljc
@@ -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]))
 
@@ -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)
 
@@ -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)
@@ -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}
@@ -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))
@@ -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] 
@@ -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)))
@@ -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?))
 
@@ -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?))
 

diff --git a/src/test/cljs/clojure/core/unify_test_runner.cljs b/src/test/cljs/clojure/core/unify_test_runner.cljs
@@ -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)
diff --git a/src/test/clojure/clojure/core/unify_test.clj → ...test/clojure/clojure/core/unify_test.cljc b/src/test/clojure/clojure/core/unify_test.clj → ...test/clojure/clojure/core/unify_test.cljc
@@ -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))))
@@ -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)))
@@ -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))))))