diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 0b4397fd..cd984b92 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -1,8 +1,15 @@ name: CI on: - - push - - pull_request + push: + branches: + - 'master' + + pull_request: + branches: + - 'master' +env: + ACTIONS_CACHE_VERISON: 0 # TODO: Add the deploy if needed jobs: @@ -29,6 +36,47 @@ jobs: - name: Run JVM tests run: bb test:jvm + test-clojureclr: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + + - name: Setup .NET + uses: actions/setup-dotnet@v5 + with: + dotnet-version: '8.0.x' + + - name: Install ClojureCLR and cljr + run: | + dotnet tool install --global Clojure.Main --version 1.12.3-alpha3 + dotnet tool install --global Clojure.Cljr --version 0.1.0-alpha8 + echo "$HOME/.dotnet/tools" >> $GITHUB_PATH + + - name: Restore dependency cache + id: cache-deps + uses: actions/cache/restore@v4 + with: + path: | + ~/.gitlibs + key: ${{ env.ACTIONS_CACHE_VERSION }}-clr-deps-${{ hashFiles('**/deps-clr.edn') }} + restore-keys: | + ${{ env.ACTIONS_CACHE_VERSION }}-clr-deps- + + - name: Download dependencies + if: steps.cache-deps.outputs.cache-hit != 'true' + run: cljr -A:test -Stree + + - name: Save dependency cache + if: steps.cache-deps.outputs.cache-hit != 'true' + uses: actions/cache/save@v4 + with: + path: | + ~/.gitlibs + key: ${{ env.ACTIONS_CACHE_VERSION }}-clr-deps-${{ hashFiles('**/deps-clr.edn') }} + + - name: Run CLR tests + run: ./script/test/clr + test-node: runs-on: ubuntu-latest steps: diff --git a/.gitignore b/.gitignore index d0089753..606ba589 100644 --- a/.gitignore +++ b/.gitignore @@ -44,3 +44,6 @@ src/scratch.clj src/scratch.cljs .lein-failures scratch.clj +linux-install.sh +install.sh +install diff --git a/bb.edn b/bb.edn index 022d28c6..2883f1df 100644 --- a/bb.edn +++ b/bb.edn @@ -7,6 +7,8 @@ :tasks {test:jvm {:doc "Run CLJ tests with leiningen" :task (shell "script/test/jvm")} + test:clr {:doc "Run CLR tests with cljr" + :task (shell "script/test/clr")} test:native {:doc "Run CLJ tests with leiningen" :task (do (shell "script/compile") diff --git a/deps-clr.edn b/deps-clr.edn new file mode 100644 index 00000000..48e3a213 --- /dev/null +++ b/deps-clr.edn @@ -0,0 +1,7 @@ +{:paths ["src" "resources"] + :deps {borkdude/edamame {:git/url "https://github.com/borkdude/edamame" + :git/tag "v1.5.33" + :git/sha "f429cf7f44aa83d92f12fd5d52e06387c517a19d"}} + :aliases {:test {:extra-paths ["test"] + :extra-deps {io.github.dmiller/test-runner {:git/tag "v0.5.3clr" :git/sha "ae91dd2727bbf70eb3a6d869a19953de3819dfbc"}} + :main-opts ["-m" "cognitect.test-runner"]}}} diff --git a/deps.edn b/deps.edn index 3466776f..62a378a2 100644 --- a/deps.edn +++ b/deps.edn @@ -1,14 +1,12 @@ {:paths ["resources" "src"] :deps {borkdude/edamame {:mvn/version "1.4.32"} - borkdude/sci.impl.reflector {:mvn/version "0.0.5"} org.babashka/sci.impl.types {:mvn/version "0.0.2"} borkdude/graal.locking {:mvn/version "0.0.2"}} :aliases {:examples {:extra-paths ["examples"]} - :dev {:extra-deps {org.clojure/clojure {:mvn/version "1.12.0"}} - :extra-paths ["reflector/src-java11"]} + :dev {:extra-deps {org.clojure/clojure {:mvn/version "1.12.0"}}} :test {:extra-paths ["test" "test-resources"] - :extra-deps {org.clojure/clojure {:mvn/version "1.9.0"} + :extra-deps {org.clojure/clojure {:mvn/version "1.10.3"} org.clojure/clojurescript {:mvn/version "1.11.132"} clj-commons/conch {:mvn/version "0.9.2"} funcool/promesa {:mvn/version "8.0.450"}}} diff --git a/project.clj b/project.clj index f3563bf9..859c6b00 100644 --- a/project.clj +++ b/project.clj @@ -9,14 +9,12 @@ :license {:name "Eclipse Public License 1.0" :url "http://opensource.org/licenses/eclipse-1.0.php"} :source-paths ["src"] - :dependencies [[org.clojure/clojure "1.9.0"] - [borkdude/sci.impl.reflector "0.0.5"] + :dependencies [[org.clojure/clojure "1.10.3"] [borkdude/edamame "1.4.32"] [org.babashka/sci.impl.types "0.0.2"] [borkdude/graal.locking "0.0.2"]] :plugins [[lein-codox "0.10.7"]] - :profiles {:clojure-1.9.0 {:dependencies [[org.clojure/clojure "1.9.0"]]} - :clojure-1.10.3 {:depdencies [[org.clojure/clojure "1.10.3"]]} + :profiles {:clojure-1.10.3 {:depdencies [[org.clojure/clojure "1.10.3"]]} :clojure-1.11.1 {:dependencies [[org.clojure/clojure "1.11.1"]]} :native-image {:dependencies [[org.clojure/clojure "1.10.3"]]} :dev {:dependencies [[thheller/shadow-cljs "2.8.64"]]} diff --git a/reflector/.gitignore b/reflector/.gitignore deleted file mode 100644 index 8b137891..00000000 --- a/reflector/.gitignore +++ /dev/null @@ -1 +0,0 @@ - diff --git a/reflector/project.clj b/reflector/project.clj deleted file mode 100644 index 278c80d1..00000000 --- a/reflector/project.clj +++ /dev/null @@ -1,10 +0,0 @@ -(defproject borkdude/sci.impl.reflector "0.0.5" - :dependencies [[org.clojure/clojure "1.9.0"]] - :description "JVM reflection support for SCI" - :licence "MIT" - :java-source-paths ["src"] - :javac-options ["-target" "1.8" "-source" "1.8" "-Xlint:-options"] - :deploy-repositories [["clojars" {:url "https://clojars.org/repo" - :username :env/clojars_user - :password :env/clojars_pass - :sign-releases false}]]) diff --git a/reflector/script/deploy b/reflector/script/deploy deleted file mode 100755 index 0bc22f8a..00000000 --- a/reflector/script/deploy +++ /dev/null @@ -1,3 +0,0 @@ -#!/usr/bin/env bash - -lein deploy clojars diff --git a/reflector/src/sci/impl/FISupport.java b/reflector/src/sci/impl/FISupport.java deleted file mode 100644 index 3fa8d052..00000000 --- a/reflector/src/sci/impl/FISupport.java +++ /dev/null @@ -1,32 +0,0 @@ -package sci.impl; - -import clojure.lang.RT; -import clojure.lang.IPersistentSet; -import java.util.concurrent.Callable; -import java.lang.reflect.Modifier; -import java.util.Comparator; - -class FISupport { - private static final IPersistentSet AFN_FIS = RT.set(Callable.class, Runnable.class, Comparator.class); - private static final IPersistentSet OBJECT_METHODS = RT.set("equals", "toString", "hashCode"); - - // Return FI method if: - // 1) Target is a functional interface and not already implemented by AFn - // 2) Target method matches one of our fn invoker methods (0 <= arity <= 10) - protected static java.lang.reflect.Method maybeFIMethod(Class target) { - if (target != null && target.isAnnotationPresent(FunctionalInterface.class) - && !AFN_FIS.contains(target)) { - - java.lang.reflect.Method[] methods = target.getMethods(); - for (java.lang.reflect.Method method : methods) { - if (method.getParameterCount() >= 0 && method.getParameterCount() <= 10 - && Modifier.isAbstract(method.getModifiers()) - && !OBJECT_METHODS.contains(method.getName())) - return method; - } - } - return null; - } -} - - diff --git a/reflector/src/sci/impl/Reflector.java b/reflector/src/sci/impl/Reflector.java deleted file mode 100644 index e18e039c..00000000 --- a/reflector/src/sci/impl/Reflector.java +++ /dev/null @@ -1,749 +0,0 @@ -/** clojure.lang.Reflector adapted for sci **/ -/** https://github.com/clojure/clojure/commits/master/src/jvm/clojure/lang/Reflector.java **/ -/** Patches made: - - Extra imports after package decl. - - Made invokeMatchingMethod public (around line 169) - - Compiler.FISupport was extracted into sci.impl.FISupport -**/ - -/** - * 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. - **/ - -/* rich Apr 19, 2006 */ - -package sci.impl; - -/** PATCH **/ -import clojure.lang.Util; -import clojure.lang.RT; -import clojure.lang.Compiler; -import clojure.lang.IFn; -import java.lang.reflect.Proxy; -/** END PATCH **/ - -import java.lang.invoke.MethodHandle; -import java.lang.invoke.MethodHandles; -import java.lang.invoke.MethodType; -import java.lang.reflect.Constructor; -import java.lang.reflect.Field; -import java.lang.reflect.Method; -import java.lang.reflect.Modifier; -import java.util.*; -import java.util.stream.Collectors; - -public class Reflector{ - -private static final MethodHandle CAN_ACCESS_PRED; - -// Java 8 is oldest JDK supported -private static boolean isJava8() { - return System.getProperty("java.vm.specification.version").equals("1.8"); -} - -static { - MethodHandle pred = null; - try { - if (! isJava8()) - pred = MethodHandles.lookup().findVirtual(Method.class, "canAccess", MethodType.methodType(boolean.class, Object.class)); - } catch (Throwable t) { - Util.sneakyThrow(t); - } - CAN_ACCESS_PRED = pred; -} - -private static boolean canAccess(Method m, Object target) { - if (CAN_ACCESS_PRED != null) { - // JDK9+ use j.l.r.AccessibleObject::canAccess, which respects module rules - try { - return (boolean) CAN_ACCESS_PRED.invoke(m, target); - } catch (Throwable t) { - throw Util.sneakyThrow(t); - } - } else { - // JDK 8 - return true; - } -} - -private static Collection interfaces(Class c) { - Set interfaces = new HashSet(); - Deque toWalk = new ArrayDeque(); - toWalk.addAll(Arrays.asList(c.getInterfaces())); - Class iface = toWalk.poll(); - while (iface != null) { - interfaces.add(iface); - toWalk.addAll(Arrays.asList(iface.getInterfaces())); - iface = toWalk.poll(); - } - return interfaces; -} - -private static Method tryFindMethod(Class c, Method m) { - if(c == null) return null; - try { - return c.getMethod(m.getName(), m.getParameterTypes()); - } catch(NoSuchMethodException e) { - return null; - } -} - -private static Method toAccessibleSuperMethod(Method m, Object target) { - Method selected = m; - while(selected != null) { - if(canAccess(selected, target)) return selected; - selected = tryFindMethod(selected.getDeclaringClass().getSuperclass(), m); - } - - Collection interfaces = interfaces(m.getDeclaringClass()); - for(Class c : interfaces) { - selected = tryFindMethod(c, m); - if(selected != null) return selected; - } - return null; -} - -public static Object invokeInstanceMethod(Object target, String methodName, Object[] args) { - return invokeInstanceMethodOfClass(target, target.getClass(), methodName, args); -} - -public static Object invokeInstanceMethodOfClass(Object target, Class c, String methodName, Object[] args) { - List methods = getMethods(c, args.length, methodName, false).stream() - .map(method -> toAccessibleSuperMethod(method, target)) - .filter(Objects::nonNull) - .collect(Collectors.toList()); - return invokeMatchingMethod(methodName, methods, c, target, args); -} - -public static Object invokeInstanceMethodOfClass(Object target, String className, String methodName, Object[] args) { - return invokeInstanceMethodOfClass(target, RT.classForName(className), methodName, args); -} - -private static Throwable getCauseOrElse(Exception e) { - if (e.getCause() != null) - return e.getCause(); - return e; -} - -private static RuntimeException throwCauseOrElseException(Exception e) { - if (e.getCause() != null) - throw Util.sneakyThrow(e.getCause()); - throw Util.sneakyThrow(e); -} - -private static String noMethodReport(String methodName, Class contextClass, Object[] args){ - return "No matching method " + methodName + " found taking " + args.length + " args" - + (contextClass != null ? " for " + contextClass : ""); -} - - private static Method matchMethod(List methods, Object[] args) { - return matchMethod(methods, args, null); - } - - private static Method matchMethod(List methods, Object[] args, Class[] argTypes) { - Method foundm = null; - for(Iterator i = methods.iterator(); i.hasNext();) { - Method m = (Method) i.next(); - Class[] params = m.getParameterTypes(); - if(isCongruent(params, args, argTypes) && (foundm == null || Compiler.subsumes(params, foundm.getParameterTypes()))) { - foundm = m; - } - } - return foundm; -} - -private static Object[] widenBoxedArgs(Object[] args) { - Object[] widenedArgs = new Object[args.length]; - for(int i=0; i 0) - return invokeMatchingMethod(name, meths, target, RT.EMPTY_ARRAY); - else - return getInstanceField(target, name); - } -} - -public static Object invokeInstanceMember(Object target, String name) { - //check for field first - Class c = target.getClass(); - Field f = getField(c, name, false); - if(f != null) //field get - { - try - { - return prepRet(f.getType(), f.get(target)); - } - catch(IllegalAccessException e) - { - throw Util.sneakyThrow(e); - } - } - return invokeInstanceMethod(target, name, RT.EMPTY_ARRAY); -} - -public static Object invokeInstanceMember(String name, Object target, Object arg1) { - //check for field first - Class c = target.getClass(); - Field f = getField(c, name, false); - if(f != null) //field set - { - try - { - f.set(target, boxArg(f.getType(), arg1)); - } - catch(IllegalAccessException e) - { - throw Util.sneakyThrow(e); - } - return arg1; - } - return invokeInstanceMethod(target, name, new Object[]{arg1}); -} - -public static Object invokeInstanceMember(String name, Object target, Object... args) { - return invokeInstanceMethod(target, name, args); -} - - -static public Field getField(Class c, String name, boolean getStatics){ - Field[] allfields = c.getFields(); - for(int i = 0; i < allfields.length; i++) - { - if(name.equals(allfields[i].getName()) - && Modifier.isStatic(allfields[i].getModifiers()) == getStatics) - return allfields[i]; - } - return null; -} - -static public List getMethods(Class c, int arity, String name, boolean getStatics){ - Method[] allmethods = c.getMethods(); - ArrayList methods = new ArrayList(); - ArrayList bridgeMethods = new ArrayList(); - for(int i = 0; i < allmethods.length; i++) - { - Method method = allmethods[i]; - if(name.equals(method.getName()) - && Modifier.isStatic(method.getModifiers()) == getStatics - && method.getParameterTypes().length == arity) - { - try - { - if(method.isBridge() - && c.getMethod(method.getName(), method.getParameterTypes()) - .equals(method)) - bridgeMethods.add(method); - else - methods.add(method); - } - catch(NoSuchMethodException e) - { - } - } -// && (!method.isBridge() -// || (c == StringBuilder.class && -// c.getMethod(method.getName(), method.getParameterTypes()) -// .equals(method)))) -// { -// methods.add(allmethods[i]); -// } - } - - if(methods.isEmpty()) - methods.addAll(bridgeMethods); - - if(!getStatics && c.isInterface()) - { - allmethods = Object.class.getMethods(); - for(int i = 0; i < allmethods.length; i++) - { - if(name.equals(allmethods[i].getName()) - && Modifier.isStatic(allmethods[i].getModifiers()) == getStatics - && allmethods[i].getParameterTypes().length == arity) - { - methods.add(allmethods[i]); - } - } - } - return methods; -} - -// Return type coercions match coercions in FnInvokers for compiled invokers -private static Object coerceAdapterReturn(Object ret, Class targetType) { - if(targetType.isPrimitive()) { - switch (targetType.getName()) { - case "boolean": return RT.booleanCast(ret); - case "long": return RT.longCast(ret); - case "double": return RT.doubleCast(ret); - case "int": return RT.intCast(ret); - case "short": return RT.shortCast(ret); - case "byte": return RT.byteCast(ret); - case "float": return RT.floatCast(ret); - } - } - return ret; -} - -static Object boxArg(Class paramType, Object arg){ - if(arg instanceof IFn && FISupport.maybeFIMethod(paramType) != null && !(paramType.isInstance(arg))) - // Adapt IFn obj to targetType using dynamic proxy - return Proxy.newProxyInstance(RT.baseLoader(), - new Class[]{paramType}, - (proxy, method, methodArgs) -> { - Object ret = ((IFn) arg).applyTo(RT.seq(methodArgs)); - return coerceAdapterReturn(ret, method.getReturnType()); - }); - else if(!paramType.isPrimitive()) - return paramType.cast(arg); - else if(paramType == boolean.class) - return Boolean.class.cast(arg); - else if(paramType == char.class) - return Character.class.cast(arg); - else if(arg instanceof Number) - { - Number n = (Number) arg; - if(paramType == int.class) - return n.intValue(); - else if(paramType == float.class) - return n.floatValue(); - else if(paramType == double.class) - return n.doubleValue(); - else if(paramType == long.class) - return n.longValue(); - else if(paramType == short.class) - return n.shortValue(); - else if(paramType == byte.class) - return n.byteValue(); - } - throw new IllegalArgumentException("Unexpected param type, expected: " + paramType + - ", given: " + arg.getClass().getName()); -} - -static Object[] boxArgs(Class[] params, Object[] args){ - if(params.length == 0) - return null; - Object[] ret = new Object[params.length]; - for(int i = 0; i < params.length; i++) - { - Object arg = args[i]; - Class paramType = params[i]; - ret[i] = boxArg(paramType, arg); - } - return ret; -} - -static public boolean paramArgTypeMatch(Class paramType, Class argType){ - if(argType == null) - return !paramType.isPrimitive(); - if(paramType == argType || paramType.isAssignableFrom(argType)) - return true; - if(FISupport.maybeFIMethod(paramType) != null && IFn.class.isAssignableFrom(argType)) - return true; - if(paramType == int.class) - return argType == Integer.class - || argType == long.class - || argType == Long.class - || argType == short.class - || argType == byte.class;// || argType == FixNum.class; - else if(paramType == float.class) - return argType == Float.class - || argType == double.class; - else if(paramType == double.class) - return argType == Double.class - || argType == float.class;// || argType == DoubleNum.class; - else if(paramType == long.class) - return argType == Long.class - || argType == int.class - || argType == short.class - || argType == byte.class;// || argType == BigNum.class; - else if(paramType == char.class) - return argType == Character.class; - else if(paramType == short.class) - return argType == Short.class; - else if(paramType == byte.class) - return argType == Byte.class; - else if(paramType == boolean.class) - return argType == Boolean.class; - return false; -} - - static boolean isCongruent(Class[] params, Object[] args) { - return isCongruent(params, args, null); - } - - static boolean isCongruent(Class[] params, Object[] args, Class[] argTypes){ - boolean ret = false; - if(args == null) - return params.length == 0; - if(params.length == args.length) - { - ret = true; - for(int i = 0; ret && i < params.length; i++) - { - Class argType = null; - Object arg = args[i]; - if (argTypes != null) { - Object t = argTypes[i]; - if (t == null && arg != null) { - argType = arg.getClass(); - } else { - argType = argTypes[i]; - } - } else { - argType = (arg == null) ? null : arg.getClass(); - } - Class paramType = params[i]; - ret = paramArgTypeMatch(paramType, argType); - } - } - return ret; -} - -public static Object prepRet(Class c, Object x){ - if (!(c.isPrimitive() || c == Boolean.class)) - return x; - if(x instanceof Boolean) - return ((Boolean) x)?Boolean.TRUE:Boolean.FALSE; -// else if(x instanceof Integer) -// { -// return ((Integer)x).longValue(); -// } -// else if(x instanceof Float) -// return Double.valueOf(((Float) x).doubleValue()); - return x; -} - -} diff --git a/script/test/all b/script/test/all index f6a98839..b6ccb0c8 100755 --- a/script/test/all +++ b/script/test/all @@ -3,7 +3,7 @@ set -eo pipefail script/test/jvm - +script/test/clr script/test/node echo "Compiling binary for native test" diff --git a/script/test/clr b/script/test/clr new file mode 100755 index 00000000..cfa50fb2 --- /dev/null +++ b/script/test/clr @@ -0,0 +1,51 @@ +#!/bin/bash +# Run tests for sci under ClojureCLR +# +# This script uses the cljr CLI tool with deps-clr.edn to run the test suite. +# Only test namespaces that currently pass on ClojureCLR are enabled. +# +# Prerequisites: +# - cljr (ClojureCLR CLI tool) must be installed as a dotnet tool +# - .NET 8.0 or later must be installed + +set -e + +# Get the directory where this script is located +SCRIPT_DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" +PROJECT_ROOT="$( cd "$SCRIPT_DIR/../.." && pwd )" + +echo "Running sci tests under ClojureCLR..." + +cd "$PROJECT_ROOT" + +# Define test namespaces to run +# Only namespaces that currently pass on ClojureCLR are uncommented +# Namespaces are sorted alphabetically for easier maintenance +TEST_NAMESPACES=( + # --namespace sci.array-test # requires interop + # --namespace sci.async-test # requires JS/browser + # --namespace sci.core-protocols-test # requires interop + # --namespace sci.core-test # requires interop/defn + # --namespace sci.error-test # requires interop + --namespace sci.hello-world-test # passes ✓ + --namespace sci.hierarchies-test # requires interop + # --namespace sci.impl.analyzer-test # requires interop + # --namespace sci.impl.binding-array-refactor-test # requires interop + # --namespace sci.impl.vars-test # requires interop + # --namespace sci.interop-test # requires interop + # --namespace sci.io-test # requires interop + # --namespace sci.multimethods-test # requires interop + # --namespace sci.namespaces-test # requires interop + # --namespace sci.parse-test # has errors + # --namespace sci.pprint-test # requires interop + # --namespace sci.protocols-test # requires interop + # --namespace sci.proxy-test # requires interop + # --namespace sci.read-test # requires interop + # --namespace sci.records-test # requires interop + # --namespace sci.reify-test # requires interop + # --namespace sci.repl-test # requires interop + # --namespace sci.vars-test # requires interop +) + +# Run tests with the specified namespaces +cljr -M:test "${TEST_NAMESPACES[@]}" "$@" diff --git a/script/test/jvm b/script/test/jvm index 7d51eedf..c2a5dc57 100755 --- a/script/test/jvm +++ b/script/test/jvm @@ -2,9 +2,6 @@ set -eo pipefail -echo "Testing with Clojure 1.9.0" -lein with-profiles +clojure-1.9.0 test "$@" - echo "Testing with Clojure 1.10.3" lein with-profiles +clojure-1.10.3 test "$@" diff --git a/src/sci/addons.cljc b/src/sci/addons.cljc index d72c4944..b014d648 100644 --- a/src/sci/addons.cljc +++ b/src/sci/addons.cljc @@ -1,9 +1,9 @@ (ns sci.addons {:no-doc true} (:refer-clojure :exclude [future pmap]) - #?(:clj (:require [sci.addons.future :as f]))) + #?@(:cljs [] :default [(:require [sci.addons.future :as f])])) ;; For backward compatibility -#?(:clj +#?(:cljs nil :default (defn future [opts] (f/install opts))) diff --git a/src/sci/addons/future.clj b/src/sci/addons/future.cljc similarity index 90% rename from src/sci/addons/future.clj rename to src/sci/addons/future.cljc index d5dc3a4e..684cadbf 100644 --- a/src/sci/addons/future.clj +++ b/src/sci/addons/future.cljc @@ -1,8 +1,8 @@ (ns sci.addons.future {:no-doc true} (:refer-clojure :exclude [future pmap]) - (:require [sci.impl.copy-vars :refer [copy-core-var new-var macrofy]]) - (:require [sci.impl.vars :as vars])) + (:require [sci.impl.copy-vars :refer [copy-core-var new-var macrofy]] + [sci.impl.vars :as vars])) (def future* (macrofy 'future (fn [_ _ & body] @@ -19,7 +19,8 @@ (defn pmap "Like clojure.core/pmap but also conveys sci bindings to the threads." ([f coll] - (let [n (+ 2 (.. Runtime getRuntime availableProcessors)) + (let [n (+ 2 #?(:clj (.. Runtime getRuntime availableProcessors) + :cljr Environment/ProcessorCount)) rets (map #(future** (f %)) coll) step (fn step [[x & xs :as vs] fs] (lazy-seq diff --git a/src/sci/core.cljc b/src/sci/core.cljc index 800f3051..64854619 100644 --- a/src/sci/core.cljc +++ b/src/sci/core.cljc @@ -29,7 +29,7 @@ copy-ns]] [sci.impl.cljs]))) -#?(:clj (set! *warn-on-reflection* true)) +#?(:cljs nil :default (set! *warn-on-reflection* true)) (defn new-var "Returns a new sci var." @@ -165,7 +165,8 @@ calls." [& body] (macros/? :clj - `(let [out# (java.io.StringWriter.)] + `(let [out# (#?(:clj java.io.StringWriter. + :cljs System.IO.StringWriter.))] (with-bindings {out out#} (do ~@body) (str out#))) @@ -185,24 +186,26 @@ (vars/binding-conveyor-fn))] (future-call f#)))) -#?(:clj (defn pmap - "Like clojure.core/pmap but also conveys sci bindings to the threads." - ([f coll] - (let [n (+ 2 (.. Runtime getRuntime availableProcessors)) - rets (map #(future (f %)) coll) - step (fn step [[x & xs :as vs] fs] - (lazy-seq - (if-let [s (seq fs)] - (cons (deref x) (step xs (rest s))) - (map deref vs))))] - (step rets (drop n rets)))) - ([f coll & colls] - (let [step (fn step [cs] - (lazy-seq - (let [ss (map seq cs)] - (when (every? identity ss) - (cons (map first ss) (step (map rest ss)))))))] - (pmap #(apply f %) (step (cons coll colls))))))) +#?(:cljs nil :default + (defn pmap + "Like clojure.core/pmap but also conveys sci bindings to the threads." + ([f coll] + (let [n (+ 2 #?(:clj (.. Runtime getRuntime availableProcessors) + :cljr Environment/ProcessorCount)) + rets (map #(future (f %)) coll) + step (fn step [[x & xs :as vs] fs] + (lazy-seq + (if-let [s (seq fs)] + (cons (deref x) (step xs (rest s))) + (map deref vs))))] + (step rets (drop n rets)))) + ([f coll & colls] + (let [step (fn step [cs] + (lazy-seq + (let [ss (map seq cs)] + (when (every? identity ss) + (cons (map first ss) (step (map rest ss)))))))] + (pmap #(apply f %) (step (cons coll colls))))))) (defn alter-var-root "Atomically alters the root binding of sci var v by applying f to its @@ -504,7 +507,8 @@ m))}) (or (:exclude-when-meta opts) [:no-doc :skip-wiki]))] - `(-copy-ns ~publics-map ~sci-ns))))))) + `(-copy-ns ~publics-map ~sci-ns)) + :default nil))))) (defn add-import! "Adds import of class named by `class-name` (a symbol) to namespace named by `ns-name` (a symbol) under alias `alias` (a symbol). Returns mutated context." @@ -556,7 +560,7 @@ In the future, more unrestricted access may be added, so only use this when you're not using SCI as a sandbox." [] #?(:cljs (set! unrestrict/*unrestricted* true) - :clj (c/alter-var-root #'unrestrict/*unrestricted* (constantly true)))) + :default (c/alter-var-root #'unrestrict/*unrestricted* (constantly true)))) (defn var->symbol "Returns a fully qualified symbol from a `sci.lang.Var`" diff --git a/src/sci/ctx_store.cljc b/src/sci/ctx_store.cljc index b0f27b0b..48556316 100644 --- a/src/sci/ctx_store.cljc +++ b/src/sci/ctx_store.cljc @@ -30,7 +30,8 @@ (or *ctx* (let [msg "No context found in: sci.ctx-store/*ctx*. Please set it using sci.ctx-store/reset-ctx!"] (throw #?(:clj (java.lang.IllegalStateException. msg) - :cljs (js/Error. msg)))))) + :cljs (js/Error. msg) + :cljr (InvalidOperationException. msg)))))) (defmacro with-ctx "Bind `ctx` during execution of body." diff --git a/src/sci/impl/analyzer.cljc b/src/sci/impl/analyzer.cljc index d1ed3d50..2b756b3b 100644 --- a/src/sci/impl/analyzer.cljc +++ b/src/sci/impl/analyzer.cljc @@ -3,10 +3,9 @@ :clj-kondo/config '{:linters {:unresolved-symbol {:exclude [ctx this bindings]}}}} (:refer-clojure :exclude [destructure macroexpand macroexpand-all macroexpand-1]) (:require - #?(:clj [sci.impl.types :as t :refer [#?(:cljs ->Node) ->constant]]) #?(:cljs [cljs.tagged-literals :refer [JSValue]]) #?(:cljs [goog.object :as gobj]) - #?(:cljs [sci.impl.types :as t :refer [->constant]]) + [sci.impl.types :as t :refer [->constant]] #?(:cljs [sci.impl.unrestrict :as unrestrict]) [clojure.string :as str] [sci.impl.evaluator :as eval] @@ -21,9 +20,8 @@ [ana-macros constant? macro? rethrow-with-location-of-node set-namespace! recur special-syms]] [sci.impl.vars :as vars] - [sci.lang]) - #?(:clj (:import - [sci.impl Reflector])) + [sci.lang] + #?(:clj [sci.impl.reflector :as reflector])) #?(:cljs (:require-macros [sci.impl.analyzer :refer [gen-return-recur @@ -31,6 +29,8 @@ gen-return-call with-top-level-loc]]))) +#?(:cljs nil :default (set! *warn-on-reflection* true)) + (defn recur-target [ctx] (:recur-target ctx)) @@ -46,8 +46,6 @@ (defn recur-target? [ctx] (:recur-target ctx)) -#?(:clj (set! *warn-on-reflection* true)) - (defn- throw-error-with-location [msg node] (utils/throw-error-with-location msg node {:phase "analysis"})) @@ -485,8 +483,8 @@ (let [f (f enclosed-array) f (t/eval f ctx bindings)] (apply f args)) - (throw (new #?(:clj Exception - :cljs js/Error) + (throw (new #?(:cljs js/Error + :default Exception) (let [actual-count (if macro? (- arg-count 2) arg-count)] (str "Cannot call " fn-name " with " actual-count " arguments"))))))) @@ -653,14 +651,16 @@ ;; namespace could be absent in config {}) refers (:refers the-current-ns) - the-current-ns (if-let [x (and refers (.get ^java.util.Map refers name))] + the-current-ns (if-let [x (and refers #?(:clj (.get ^java.util.Map refers name) + :cljs (.get refers name) + :default (get refers name)))] (throw-error-with-location (str name " already refers to " x " in namespace " cnn) expr) (if-let [the-var #?(:clj (.get ^java.util.Map the-current-ns name) - :cljs (get the-current-ns name))] + :default (get the-current-ns name))] (let [cur-file @utils/current-file] (when-not (= cur-file (:file (meta the-var))) (alter-meta! the-var assoc :file cur-file)) @@ -699,7 +699,8 @@ expected-arg-count (if docstring 4 3)] (when-not (<= arg-count expected-arg-count) (throw (new #?(:clj IllegalArgumentException - :cljs js/Error) + :cljs js/Error + :cljr InvalidOperationException) "Too many arguments to def"))) (let [init (if docstring ?init ?docstring) init (if (= 2 arg-count) @@ -881,12 +882,12 @@ body (analyze ctx (cons 'do body-exprs)) catches (mapv (fn [c] (let [[_ ex binding & body] c] - (if-let [clazz #?(:clj (interop/resolve-class ctx ex) - :cljs (case ex + (if-let [clazz #?(:cljs (case ex js/Error js/Error js/Object js/Object :default :default - (analyze ctx ex)))] + (analyze ctx ex)) + :default (interop/resolve-class ctx ex))] (let [ex-iden (gensym) closure-bindings (:closure-bindings ctx) ex-idx (update-parents ctx closure-bindings ex-iden) @@ -907,8 +908,8 @@ sci-error (let [fst (when (= 1 (count catches)) (nth catches 0)) ex (:ex fst)] - (and (= #?(:clj 'Exception - :cljs 'js/Error) ex) + (and (= #?(:cljs 'js/Error + :default 'Exception) ex) (some-> ex meta :sci/error))) finally (when finally (analyze ctx (cons 'do (rest finally))))] @@ -920,7 +921,8 @@ (when-not (= 2 (count expr)) (throw-error-with-location #?(:clj "Too many arguments to throw, throw expects a single Throwable instance" - :cljs "Too many arguments to throw") + :cljs "Too many arguments to throw" + :cljr "Too many arguments to throw, throw expects a single Exception") expr)) (let [ctx (without-recur-target ctx) ana (analyze ctx ex) @@ -939,16 +941,17 @@ [method-expr & args] (if (seq? method-expr) method-expr (cons method-expr args)) instance-expr (analyze ctx instance-expr) - #?@(:clj [instance-expr (utils/vary-meta* - instance-expr - (fn [m] - (if-let [t (:tag m)] - (let [clazz (or (interop/resolve-class ctx t) - (records/resolve-record-class ctx t) - (throw-error-with-location - (str "Unable to resolve classname: " t) t))] - (assoc m :tag-class clazz)) - m)))]) + #?@(:cljs [] + :default [instance-expr (utils/vary-meta* + instance-expr + (fn [m] + (if-let [t (:tag m)] + (let [clazz (or (interop/resolve-class ctx t) + (records/resolve-record-class ctx t) + (throw-error-with-location + (str "Unable to resolve classname: " t) t))] + (assoc m :tag-class clazz)) + m)))]) method-name (name method-expr) args (when args (analyze-children ctx args)) res @@ -957,7 +960,7 @@ (subs method-name 1) method-name) meth-name* meth-name - meth-name (#?(:clj munge :cljs utils/munge-str) meth-name) + meth-name (#?(:cljs utils/munge-str :default munge) meth-name) stack (assoc (meta expr) :ns @utils/current-ns :file @utils/current-file)] @@ -991,7 +994,7 @@ ;; of the same name, in which case it resolves to a ;; call to the method. (if-let [_ - (try (Reflector/getStaticField ^Class instance-expr ^String method-name) + (try (reflector/get-static-field instance-expr method-name) (catch IllegalArgumentException _ nil))] (sci.impl.types/->Node (interop/get-static-field instance-expr method-name) @@ -1003,6 +1006,7 @@ #?@(:clj [^"[Ljava.lang.Class;" arg-types (when (pos? arg-count) (make-array Class arg-count)) has-types? (volatile! nil)])] + #?(:cljr (throw (ex-info (str "TODO CLR " `analyze-dot) {}))) #?(:clj (when arg-types (areduce args idx _ret nil (let [arg (aget args idx) @@ -1041,14 +1045,15 @@ ctx bindings instance-expr meth-name meth-name* field-access args allowed? nil nil) stack)) {::instance-expr instance-expr - ::method-name method-name}))))] + ::method-name method-name})) + :cljr (throw (ex-info (str "TODO " `analyze-dot)))))] res)) (defn expand-dot** "Expands (. x method)" [ctx expr] (when (< (count expr) 3) - (throw (new #?(:clj IllegalArgumentException :cljs js/Error) + (throw (new #?(:clj IllegalArgumentException :cljs js/Error :cljr InvalidOperationException) "Malformed member expression, expecting (.member target ...)"))) (analyze-dot ctx expr)) @@ -1056,11 +1061,11 @@ "Expands (.foo x)" [ctx [method-name obj & args :as expr]] (when (< (count expr) 2) - (throw (new #?(:clj IllegalArgumentException :cljs js/Error) + (throw (new #?(:clj IllegalArgumentException :cljs js/Error :cljr InvalidOperationException) "Malformed member expression, expecting (.member target ...)"))) (analyze-dot ctx (with-meta (list '. obj (cons (symbol (subs (name method-name) 1)) args)) (meta expr)))) -#?(:clj +#?(:cljs nil :default (defn- invoke-constructor-node [ctx class args] (let [ctx (without-recur-target ctx) args (analyze-children ctx args)] @@ -1156,7 +1161,8 @@ (interop/invoke-js-constructor* ctx bindings (t/eval class ctx bindings) args) - nil)))))) + nil))) + :cljr (throw (ex-info (str "TODO " `analyze-new)))))) (defn expand-constructor [ctx [constructor-sym & args]] (let [constructor-name (name constructor-sym) @@ -1178,14 +1184,15 @@ (sci.impl.types/->Node (try (apply f ctx analyzed-args) - (catch #?(:clj Throwable :cljs js/Error) e + (catch #?(:clj Throwable :cljs js/Error :cljr Exception) e (rethrow-with-location-of-node ctx bindings e this))) stack))) (defn analyze-ns-form [ctx [_ns ns-name & exprs :as expr]] (when-not (symbol? ns-name) (throw (new #?(:clj IllegalArgumentException - :cljs js/Error) + :cljs js/Error + :cljr InvalidOperationException) (str "Namespace name must be symbol, got: " (pr-str ns-name))))) (let [[docstring exprs] (let [fexpr (first exprs)] @@ -1308,7 +1315,7 @@ ~@(map (fn [j] `(t/eval ~(symbol (str "arg" j)) ~'ctx ~'bindings)) (range i))) - (catch ~(macros/? :clj 'Throwable :cljs 'js/Error) e# + (catch ~(macros/? :clj #?(:cljr 'Exception :default 'Throwable) :cljs 'js/Error) e# (rethrow-with-location-of-node ~'ctx ~'bindings e# ~'this))) ~'stack))]) let-bindings) @@ -1346,7 +1353,7 @@ ~@(map (fn [j] `(t/eval ~(symbol (str "arg" j)) ~'ctx ~'bindings)) (range i))) - (catch ~(macros/? :clj 'Throwable :cljs 'js/Error) e# + (catch ~(macros/? :clj #?(:cljr `Exception :default `Throwable) :cljs 'js/Error) e# (rethrow-with-location-of-node ~'ctx ~'bindings e# ~'this))) ~'stack) (sci.impl.types/->Node @@ -1355,7 +1362,7 @@ ~@(map (fn [j] `(t/eval ~(symbol (str "arg" j)) ~'ctx ~'bindings)) (range i))) - (catch ~(macros/? :clj 'Throwable :cljs 'js/Error) e# + (catch ~(macros/? :clj #?(:cljr `Exception :default `Throwable) :cljs 'js/Error) e# (rethrow-with-location-of-node ~'ctx ~'bindings e# ~'this))) ~'stack)))]) let-bindings) @@ -1386,7 +1393,7 @@ :file @utils/current-file)] (sci.impl.types/->Node (try (apply eval/eval-import ctx args) - (catch #?(:clj Throwable :cljs js/Error) e + (catch #?(:clj Throwable :cljs js/Error :default Exception) e (rethrow-with-location-of-node ctx bindings e this))) stack))) @@ -1456,12 +1463,12 @@ f (fn [obj & args] (let [args (object-array args) arg-count (alength args) - ^java.util.List methods (interop/meth-cache ctx clazz meth arg-count #(Reflector/getMethods clazz arg-count meth false) :instance-methods)] - (Reflector/invokeMatchingMethod meth methods clazz obj args arg-types)))] + ^java.util.List methods (interop/meth-cache ctx clazz meth arg-count #(reflector/get-methods clazz arg-count meth false) :instance-methods)] + (reflector/invoke-matching-method meth methods clazz obj args arg-types)))] (sci.impl.types/->Node f stack)) - (try (Reflector/getStaticField ^Class clazz ^String meth) + (try (reflector/get-static-field ^Class clazz ^String meth) (catch IllegalArgumentException _ nil)) (sci.impl.types/->Node @@ -1469,10 +1476,13 @@ stack) :else (sci.impl.types/->Node (fn [& args] - (Reflector/invokeStaticMethod + (reflector/invoke-static-method clazz meth ^objects (into-array Object args))) - stack))))) + stack)))) + :cljr + (defn analyze-interop [ctx expr [clazz meth]] + (throw (ex-info "TODO CLR " `analyze-interop)))) (defn analyze-call [ctx expr m top-level?] (with-top-level-loc top-level? m @@ -1493,11 +1503,7 @@ fast-path (-> f-meta :sci.impl/fast-path) f (or fast-path f)] (cond (and f-meta (::static-access f-meta)) - #?(:clj - (let [[clazz meth class-expr] f] - (analyze-dot ctx (with-meta (list* '. clazz meth (rest expr)) - (assoc m :class-expr class-expr)))) - :cljs + #?(:cljs (let [[class method-path] f last-path (last method-path) ctor? (= "" last-path) @@ -1553,46 +1559,54 @@ method-name (aget arr 1) method (unchecked-get class method-name)] (interop/invoke-static-method ctx bindings class method children)) - nil))))) - #?@(:clj [(and f-meta (:sci.impl.analyzer/interop f-meta)) - (let [[obj & args] (analyze-children ctx (rest expr)) - meth (-> (second f) - str - (subs 1)) - clazz (first f) - args (object-array args) - arg-count (count args) - stack (assoc m - :ns @utils/current-ns - :file @utils/current-file - :sci.impl/f-meta f-meta) - ^"[Ljava.lang.Class;" arg-types (when (pos? arg-count) - (make-array Class arg-count)) - has-types? (volatile! nil) - ] - (when arg-types - (or (when-let [param-tags (-> f* (some-> meta :param-tags))] - (vreset! has-types? true) - (areduce arg-types idx _ret nil - (when-let [t (nth param-tags idx)] - (when-not (= '_ t) - (when-let [t (interop/resolve-type-hint ctx t)] - (aset arg-types idx t)))))) - (areduce args idx _ret nil - (let [arg (aget args idx) - arg-meta (meta arg)] - (when-let [t (:tag arg-meta)] - (when-let [t (interop/resolve-type-hint ctx t)] - (do (vreset! has-types? true) - (aset arg-types idx t)))))))) - (sci.impl.types/->Node - (let [obj (sci.impl.types/eval obj ctx bindings)] - (interop/invoke-instance-method ctx bindings obj clazz - meth - args arg-count arg-types)) - stack))]) - #?@(:clj [(and f-meta (:sci.impl.analyzer/invoke-constructor f-meta)) - (invoke-constructor-node ctx (first f) (rest expr))]) + nil)))) + :default + (let [[clazz meth class-expr] f] + (analyze-dot ctx (with-meta (list* '. clazz meth (rest expr)) + (assoc m :class-expr class-expr))))) + #?@(:cljs [] + :default [(and f-meta (:sci.impl.analyzer/interop f-meta)) + (let [[obj & args] (analyze-children ctx (rest expr)) + meth (-> (second f) + str + (subs 1)) + clazz (first f) + args (object-array args) + arg-count (count args) + stack (assoc m + :ns @utils/current-ns + :file @utils/current-file + :sci.impl/f-meta f-meta) + #?(:clj ^"[Ljava.lang.Class;" arg-types + :cljr ^"System.Type[]" arg-types + :default arg-types) + (when (pos? arg-count) + (make-array #?(:clj Class :cljr Type) arg-count)) + has-types? (volatile! nil)] + (when arg-types + (or (when-let [param-tags (-> f* (some-> meta :param-tags))] + (vreset! has-types? true) + (areduce arg-types idx _ret nil + (when-let [t (nth param-tags idx)] + (when-not (= '_ t) + (when-let [t (interop/resolve-type-hint ctx t)] + (aset arg-types idx t)))))) + (areduce args idx _ret nil + (let [arg (aget args idx) + arg-meta (meta arg)] + (when-let [t (:tag arg-meta)] + (when-let [t (interop/resolve-type-hint ctx t)] + (do (vreset! has-types? true) + (aset arg-types idx t)))))))) + (sci.impl.types/->Node + (let [obj (sci.impl.types/eval obj ctx bindings)] + (interop/invoke-instance-method ctx bindings obj clazz + meth + args arg-count arg-types)) + stack))]) + #?@(:cljs [] + :default [(and f-meta (:sci.impl.analyzer/invoke-constructor f-meta)) + (invoke-constructor-node ctx (first f) (rest expr))]) (and (not eval?) ;; the symbol is not a binding (symbol? f) (or @@ -1665,9 +1679,11 @@ :ns @utils/current-ns :file @utils/current-file :sci.impl/f-meta f-meta) - #?(:cljs (when (utils/var? f) (fn [_ _ v] - (deref v))) :clj nil)))))))) - (catch #?(:clj Exception :cljs js/Error) e + #?(:cljs (when (utils/var? f) + (fn [_ _ v] + (deref v))) + :default nil)))))))) + (catch #?(:cljs js/Error :default Exception) e ;; we pass a ctx-fn because the rethrow function calls ;; stack on it, the only interesting bit it the map ;; with :ns and :file @@ -1706,10 +1722,10 @@ (t/eval @f ctx bindings)) (fn [ctx bindings f] (t/eval f ctx bindings))) - :clj (fn [ctx bindings f] - (t/eval f ctx bindings))))))) - (catch #?(:clj Exception - :cljs :default) e + :default (fn [ctx bindings f] + (t/eval f ctx bindings))))))) + (catch #?(:cljs :default + :default Exception) e (utils/rethrow-with-location-of-node ctx e (sci.impl.types/->Node nil (utils/make-stack m))))))) (defn map-fn [children-count] @@ -1729,15 +1745,16 @@ (return-call ctx the-map mf analyzed-children nil nil))) (defn constant-node? [x] - #?(:clj (instance? sci.impl.types.ConstantNode x) - :cljs (not (instance? sci.impl.types.NodeR x)))) + #?(:cljs (not (instance? sci.impl.types.NodeR x)) + :default (instance? sci.impl.types.ConstantNode x))) -#?(:clj (defn unwrap-children [children] - (-> (reduce (fn [acc x] - (conj! acc (t/eval x nil nil))) - (transient []) - children) - persistent!))) +#?(:cljs nil + :default (defn unwrap-children [children] + (-> (reduce (fn [acc x] + (conj! acc (t/eval x nil nil))) + (transient []) + children) + persistent!))) (defn analyze-map [ctx expr m] @@ -1745,9 +1762,10 @@ children (into [] cat expr) analyzed-children (analyze-children ctx children) const? (every? constant-node? analyzed-children) - #?@(:clj [analyzed-children (if const? - (unwrap-children analyzed-children) - analyzed-children)]) + #?@(:cljs [] + :default [analyzed-children (if const? + (unwrap-children analyzed-children) + analyzed-children)]) same? (when const? (= children analyzed-children)) const-val (when const? (if same? @@ -1774,9 +1792,10 @@ analyzed-meta (when m (analyze ctx m)) analyzed-children (analyze-children ctx expr) const? (every? constant-node? analyzed-children) - #?@(:clj [analyzed-children (if const? - (unwrap-children analyzed-children) - analyzed-children)]) + #?@(:cljs [] + :default [analyzed-children (if const? + (unwrap-children analyzed-children) + analyzed-children)]) set-expr? (set? expr) same? (and const? (= (if set-expr? (or (seq expr) []) @@ -1833,12 +1852,13 @@ (if (:const mv) @v (if (vars/isMacro v) - (throw (new #?(:clj IllegalStateException :cljs js/Error) + (throw (new #?(:clj IllegalStateException :cljs js/Error :cljr InvalidOperationException) (str "Can't take value of a macro: " v ""))) (sci.impl.types/->Node (faster/deref-1 v) nil))) - #?@(:clj + #?@(:cljs [] + :default [(:sci.impl.analyzer/interop mv) (analyze-interop ctx expr v)]) :else v)) diff --git a/src/sci/impl/callstack.cljc b/src/sci/impl/callstack.cljc index 073839aa..0306b792 100644 --- a/src/sci/impl/callstack.cljc +++ b/src/sci/impl/callstack.cljc @@ -4,7 +4,7 @@ [sci.impl.types :as types] [sci.lang])) -#?(:clj (set! *warn-on-reflection* true)) +#?(:cljs nil :default (set! *warn-on-reflection* true)) (defn sci-ns-name [^sci.lang.Namespace ns] (types/getName ns)) diff --git a/src/sci/impl/copy_vars.cljc b/src/sci/impl/copy_vars.cljc index 8ae93555..ad2ad8db 100644 --- a/src/sci/impl/copy_vars.cljc +++ b/src/sci/impl/copy_vars.cljc @@ -1,13 +1,13 @@ (ns sci.impl.copy-vars {:no-doc true} (:require - [sci.impl.cljs] + #?@(:cljr [] :default [sci.impl.cljs]) [sci.impl.macros :as macros] [sci.impl.utils :as utils :refer [clojure-core-ns]] [sci.lang]) #?(:cljs (:require-macros [sci.impl.copy-vars :refer [copy-var copy-core-var macrofy]]))) -#?(:clj (set! *warn-on-reflection* true)) +#?(:cljs nil :default (set! *warn-on-reflection* true)) ;; The following is produced with: ;; (def inlined (filter (comp :inline meta) (vals (ns-publics 'clojure.core)))) @@ -15,11 +15,12 @@ (def inlined-vars '#{+' unchecked-remainder-int unchecked-subtract-int dec' short-array bit-shift-right aget = boolean bit-shift-left aclone dec < char unchecked-long unchecked-negate unchecked-inc-int floats pos? boolean-array alength bit-xor unsigned-bit-shift-right neg? unchecked-float num reduced? booleans int-array inc' <= -' * min get long double bit-and-not unchecked-add-int short quot unchecked-double longs unchecked-multiply-int int > unchecked-int unchecked-multiply unchecked-dec double-array float - byte-array zero? unchecked-dec-int rem nth nil? bit-and *' unchecked-add identical? unchecked-divide-int unchecked-subtract / bit-or >= long-array object-array doubles unchecked-byte unchecked-short float-array inc + chars ints bit-not byte max == count char-array compare shorts unchecked-negate-int unchecked-inc unchecked-char bytes}) -(def cljs-resolve (resolve 'cljs.analyzer.api/resolve)) +#?(:cljr nil :default (def cljs-resolve (resolve 'cljs.analyzer.api/resolve))) -#?(:clj (def elide-vars (= "true" (System/getenv "SCI_ELIDE_VARS"))) - ;; for self-hosted - :cljs (def elide-vars false)) +#?(;; for self-hosted + :cljs (def elide-vars false) + :default (def elide-vars (= "true" (#?(:clj System/getenv :cljr System.Environment/GetEnvironmentVariable) + "SCI_ELIDE_VARS")))) (macros/deftime @@ -41,8 +42,8 @@ macro (when opts (:macro opts)) nm (when opts (:name opts)) [fqsym sym] (if (qualified-symbol? sym) - [sym (symbol (name sym))] - [(symbol "clojure.core" (str sym)) sym]) + [sym (symbol (name sym))] + [(symbol "clojure.core" (str sym)) sym]) inline (contains? inlined-vars sym) fast-path (or (= 'or sym) (= 'and sym) @@ -50,30 +51,29 @@ (= 'ns sym) (= 'lazy-seq sym)) varm (merge (cond-> {:name (or nm (list 'quote (symbol (name sym))))} - macro (assoc :macro true) - inline (assoc :sci.impl/inlined (:inlined opts fqsym))) - (let [#?@(:clj [the-var (macros/? :clj (resolve fqsym) - :cljs (atom nil))])] - (macros/? :clj #?(:clj (let [m (meta the-var) - dyn (:dynamic m) - arglists (:arglists m)] - (cond-> (if elide-vars {} {:doc (:doc m)}) - dyn (assoc :dynamic dyn) - (if elide-vars false arglists) - (assoc :arglists (list 'quote (:arglists m))) - fast-path (assoc :sci.impl/fast-path (list 'quote sym)))) - :cljs nil) - :cljs (let [r (cljs-resolve &env fqsym) - m (:meta r) - dyn (:dynamic m) - arglists (or (:arglists m) (:arglists r))] - (cond-> {:arglists (ensure-quote arglists) - :doc (or (:doc m) (:doc r))} - dyn (assoc :dynamic dyn) - arglists (assoc :arglists (ensure-quote arglists)) - fast-path (assoc :sci.impl/fast-path (list 'quote sym)))))))] - #_(when (= 'inc sym) - (prn varm)) + macro (assoc :macro true) + inline (assoc :sci.impl/inlined (:inlined opts fqsym))) + (let [#?@(:cljs [] + :default [the-var (macros/? :clj (resolve fqsym) + :cljs (atom nil))])] + (macros/? :clj #?(:cljs nil + :default (let [m (meta the-var) + dyn (:dynamic m) + arglists (:arglists m)] + (cond-> (if elide-vars {} {:doc (:doc m)}) + dyn (assoc :dynamic dyn) + (if elide-vars false arglists) + (assoc :arglists (list 'quote (:arglists m))) + fast-path (assoc :sci.impl/fast-path (list 'quote sym))))) + :cljs (let [r (cljs-resolve &env fqsym) + m (:meta r) + dyn (:dynamic m) + arglists (or (:arglists m) (:arglists r))] + (cond-> {:arglists (ensure-quote arglists) + :doc (or (:doc m) (:doc r))} + dyn (assoc :dynamic dyn) + arglists (assoc :arglists (ensure-quote arglists)) + fast-path (assoc :sci.impl/fast-path (list 'quote sym)))))))] varm)) (defmacro macrofy [& args] @@ -82,16 +82,18 @@ ;; Note: self hosted CLJS can't deal with multi-arity macros so this macro is split in 2 - #?(:clj - (if elide-vars + #?@(:cljs [] + :default + [(if elide-vars (binding [*out* *err*] (println "SCI: eliding vars.")) - nil)) + nil)]) (defmacro copy-var [sym ns & [opts]] (let [macro (:macro opts) - #?@(:clj [the-var (macros/? :clj (resolve sym) - :cljs (atom nil))]) + #?@(:cljs [] + :default [the-var (macros/? :clj (resolve sym) + :cljs (atom nil))]) dyn (:dynamic opts) varm (cond-> (assoc (var-meta &env (or (:name opts) (:copy-meta-from opts) @@ -106,8 +108,8 @@ ;; NOTE: emit as little code as possible, so our JS bundle is as small as possible (if macro (macros/? :clj - #?(:clj `(sci.lang.Var. ~(deref the-var) ~nm ~varm false ~ctx nil) - :cljs `(sci.lang.Var. ~init ~nm ~varm false ~ctx nil)) + #?(:cljs `(sci.lang.Var. ~init ~nm ~varm false ~ctx nil) + :default `(sci.lang.Var. ~(deref the-var) ~nm ~varm false ~ctx nil)) :cljs `(sci.lang.Var. ~init ~nm ~varm false ~ctx nil)) (if elide-vars (if (or dyn ctx) diff --git a/src/sci/impl/core_protocols.cljc b/src/sci/impl/core_protocols.cljc index 2bcb61ac..ba6765d9 100644 --- a/src/sci/impl/core_protocols.cljc +++ b/src/sci/impl/core_protocols.cljc @@ -8,49 +8,48 @@ ;;;; IDeref -(defmulti #?(:clj deref :cljs -deref) types/type-impl) +(defmulti #?(:cljs -deref :default deref) types/type-impl) -(defmethod #?(:clj deref :cljs -deref) :sci.impl.protocols/reified [ref] +(defmethod #?(:cljs -deref :default deref) :sci.impl.protocols/reified [ref] (let [methods (types/getMethods ref)] - ((get methods #?(:clj 'deref :cljs '-deref)) ref))) + ((get methods #?(:cljs '-deref :default 'deref)) ref))) (def ideref-default - (defmethod #?(:clj deref :cljs -deref) :default [ref] + (defmethod #?(:cljs -deref :default deref) :default [ref] (clojure.core/deref ref))) (defn deref* ([x] - #?(:clj (if (instance? clojure.lang.IDeref x) - (clojure.core/deref x) - (deref x)) - :cljs (if (or (instance? Atom x) + #?(:cljs (if (or (instance? Atom x) (implements? IDeref x)) (clojure.core/deref x) - (-deref x)))) - #?(:clj - ([x & args] - (apply clojure.core/deref x args)))) - -#?(:clj + (-deref x)) + :default (if (instance? clojure.lang.IDeref x) + (clojure.core/deref x) + (deref x)))) + #?@(:cljs [] + :default [([x & args] (apply clojure.core/deref x args))])) + +#?(:cljs nil :default (def clj-lang-ns (lang/->Namespace 'clojure.lang nil))) #?(:cljs (def cljs-core-ns (lang/->Namespace 'cljs.core nil))) (def deref-protocol - #?(:clj - (utils/new-var - 'clojure.lang.IDeref - {:class clojure.lang.IDeref - :methods #{deref} - :ns clj-lang-ns} - {:ns clj-lang-ns}) - :cljs + #?(:cljs (utils/new-var 'cljs.core.IDeref {:protocol IDeref :methods #{-deref} :ns cljs-core-ns} - {:ns cljs-core-ns}))) + {:ns cljs-core-ns}) + :default + (utils/new-var + 'clojure.lang.IDeref + {:class clojure.lang.IDeref + :methods #{deref} + :ns clj-lang-ns} + {:ns clj-lang-ns}))) ;;;; end IDeref @@ -68,38 +67,38 @@ ;; ([_ _ _ _] "THREE ARGUMENTs") ;; ([_ _ _ _ & more] (cl-format nil "~d ARGUMENTS" (+ 3 (count more))))) -(defmulti #?(:clj swap :cljs -swap!) types/type-impl) -(defmulti #?(:clj reset :cljs -reset!) types/type-impl) -#?(:clj (defmulti compareAndSet types/type-impl)) -#?(:clj (defmulti swapVals types/type-impl)) -#?(:clj (defmulti resetVals types/type-impl)) +(defmulti #?(:cljs -swap! :default swap) types/type-impl) +(defmulti #?(:cljs -reset! :default reset) types/type-impl) +#?(:cljs nil :default (defmulti compareAndSet types/type-impl)) +#?(:cljs nil :default (defmulti swapVals types/type-impl)) +#?(:cljs nil :default (defmulti resetVals types/type-impl)) ;;;; Protocol methods -(defmethod #?(:clj swap :cljs -swap!) :sci.impl.protocols/reified +(defmethod #?(:cljs -swap! :default swap) :sci.impl.protocols/reified ([ref f] (let [methods (types/getMethods ref)] - ((get methods #?(:clj 'swap :cljs '-swap!)) ref f))) + ((get methods #?(:cljs '-swap! :default 'swap)) ref f))) ([ref f a1] (let [methods (types/getMethods ref)] - ((get methods #?(:clj 'swap :cljs '-swap!)) ref f a1))) + ((get methods #?(:cljs '-swap! :default 'swap)) ref f a1))) ([ref f a1 a2] (let [methods (types/getMethods ref)] - ((get methods #?(:clj 'swap :cljs '-swap!)) ref f a1 a2))) + ((get methods #?(:cljs '-swap! :default 'swap)) ref f a1 a2))) ([ref f a1 a2 & args] (let [methods (types/getMethods ref)] - (apply (get methods #?(:clj 'swap :cljs '-swap!)) ref f a1 a2 args)))) + (apply (get methods #?(:cljs '-swap! :default 'swap)) ref f a1 a2 args)))) -(defmethod #?(:clj reset :cljs -reset!) :sci.impl.protocols/reified [ref v] +(defmethod #?(:cljs -reset! :default reset) :sci.impl.protocols/reified [ref v] (let [methods (types/getMethods ref)] - ((get methods #?(:clj 'reset :cljs '-reset!)) ref v))) + ((get methods #?(:cljs '-reset! :default 'reset)) ref v))) -#?(:clj +#?(:cljs nil :default (defmethod compareAndSet :sci.impl.protocols/reified [ref old new] (let [methods (types/getMethods ref)] ((get methods 'compareAndSet) ref old new)))) -#?(:clj +#?(:cljs nil :default (defmethod swapVals :sci.impl.protocols/reified ([ref f] (let [methods (types/getMethods ref)] @@ -114,7 +113,7 @@ (let [methods (types/getMethods ref)] (apply (get methods 'swapVals) ref f a1 a2 args))))) -#?(:clj +#?(:cljs nil :default (defmethod resetVals :sci.impl.protocols/reified [ref v] (let [methods (types/getMethods ref)] ((get methods 'resetVals) ref v)))) @@ -122,24 +121,21 @@ ;;;; Defaults (def iatom-defaults - [(defmethod #?(:clj swap :cljs -swap!) :default [ref f & args] + [(defmethod #?(:cljs -swap! :default swap) :default [ref f & args] ;; TODO: optimize arities (apply clojure.core/swap! ref f args)) - (defmethod #?(:clj reset :cljs -reset!) :default [ref v] + (defmethod #?(:cljs -reset! :default reset) :default [ref v] (reset! ref v)) - #?(:clj - (defmethod compareAndSet :default [ref old new] - (compare-and-set! ref old new))) - - #?(:clj - (defmethod swapVals :default [ref & args] - (apply swap-vals! ref args))) - - #?(:clj - (defmethod resetVals :default [ref v] - (reset-vals! ref v)))]) + #?@(:cljs [] + :default + [(defmethod compareAndSet :default [ref old new] + (compare-and-set! ref old new)) + (defmethod swapVals :default [ref & args] + (apply swap-vals! ref args)) + (defmethod resetVals :default [ref v] + (reset-vals! ref v))])]) ;;;; Re-routing @@ -148,37 +144,37 @@ ;; fast-path for host IAtom #?(:cljs (or (instance? Atom ref) (implements? ISwap ref)) - :clj (instance? clojure.lang.IAtom ref)) + :default (instance? clojure.lang.IAtom ref)) (if args (apply clojure.core/swap! ref f args) (clojure.core/swap! ref f)) (if args - (apply #?(:clj swap :cljs -swap!) ref f args) - (#?(:clj swap :cljs -swap!) ref f)))) + (apply #?(:cljs -swap! :default swap) ref f args) + (#?(:cljs -swap! :default swap) ref f)))) (defn reset!* [ref v] (if ;; fast-path for host IAtoms #?(:cljs (or (instance? Atom ref) (implements? IReset ref)) - :clj (instance? clojure.lang.IAtom ref)) + :default (instance? clojure.lang.IAtom ref)) (clojure.core/reset! ref v) - (#?(:clj reset :cljs -reset!) ref v))) + (#?(:cljs -reset! :default reset) ref v))) -#?(:clj +#?(:cljs nil :default (defn compare-and-set!* [ref old new] (if (instance? clojure.lang.IAtom ref) ;; fast-path for host IAtoms (clojure.core/compare-and-set! ref old new) (compareAndSet ref old new)))) -#?(:clj +#?(:cljs nil :default (defn swap-vals!* [ref f & args] (if (instance? clojure.lang.IAtom ref) (apply clojure.core/swap-vals! ref f args) (apply swapVals ref f args)))) -#?(:clj +#?(:cljs nil :default (defn reset-vals!* [ref v] (if (instance? clojure.lang.IAtom ref) (clojure.core/reset-vals! ref v) @@ -187,20 +183,20 @@ ;;;; Protocol vars (def swap-protocol - #?(:clj - (utils/new-var - 'clojure.lang.IAtom - {:class clojure.lang.IAtom - :methods #{swap, reset, compareAndSet} - :ns clj-lang-ns} - {:ns clj-lang-ns}) - :cljs + #?(:cljs (utils/new-var 'cljs.core.ISwap {:protocol ISwap :methods #{-swap!} :ns cljs-core-ns} - {:ns cljs-core-ns}))) + {:ns cljs-core-ns}) + :default + (utils/new-var + 'clojure.lang.IAtom + {:class clojure.lang.IAtom + :methods #{swap, reset, compareAndSet} + :ns clj-lang-ns} + {:ns clj-lang-ns}))) #?(:cljs (def reset-protocol @@ -211,7 +207,7 @@ :ns cljs-core-ns} {:ns cljs-core-ns}))) -#?(:clj +#?(:cljs nil :default (def iatom2-protocol (utils/new-var 'clojure.lang.IAtom2 diff --git a/src/sci/impl/deftype.cljc b/src/sci/impl/deftype.cljc index 4ce965f1..3a448ce2 100644 --- a/src/sci/impl/deftype.cljc +++ b/src/sci/impl/deftype.cljc @@ -8,9 +8,9 @@ [sci.impl.vars :as vars] [sci.lang])) -#?(:clj (set! *warn-on-reflection* true)) +#?(:cljs nil :default (set! *warn-on-reflection* true)) -#?(:clj +#?(:cljs nil :default (defn assert-no-jvm-interface [protocol protocol-name expr] (when (and (class? protocol) (not (= Object protocol))) @@ -20,7 +20,8 @@ (defn hex-hash [this] #?(:clj (Integer/toHexString (hash this)) - :cljs (.toString (hash this) 16))) + :cljs (.toString (hash this) 16) + :cljr (System.Convert/ToString (long (hash this)) (int 16)))) (defmulti to-string types/type-impl) (defmethod to-string :default [this] @@ -28,14 +29,15 @@ (str (namespace t) "." (name t) "@" (hex-hash this)))) -#?(:clj +#?(:cljs nil + :default (do (defmulti equals (fn [this _other] (types/type-impl this))) (defmethod equals :default [this other] (identical? this other)))) -(defn clojure-str [v] +(defn clojure-str ^String [v] ;; #object[user.Foo 0x743e63ce "user.Foo@743e63ce"] (let [n (types/type-impl v)] (str "#object[" n " 0x" (hex-hash v) " \"" (to-string v) "\"]"))) @@ -46,13 +48,12 @@ (clojure.core/deftype SciType [rec-name type - var #?(:clj ^:volatile-mutable ext-map - :cljs ^:mutable ext-map)] + var #?(:cljs ^:mutable ext-map + :default ^:volatile-mutable ext-map)] Object - (toString [this] + (#?(:cljr ToString :default toString) [this] (to-string this)) - #?(:clj (equals [this other] - (sci.impl.deftype/equals this other))) + #?(:clj (equals [this other] (sci.impl.deftype/equals this other))) sci.impl.types/SciTypeInstance (-get-type [_] @@ -61,22 +62,26 @@ (set! ext-map (assoc ext-map k v)) v) - #?@(:clj [SciPrintMethod - (-sci-print-method [this w] - (if-let [rv var] - (let [m (meta rv)] - (if-let [pm (:sci.impl/print-method m)] - (pm this w) - (.write ^java.io.Writer w ^String (clojure-str this)))) - (.write ^java.io.Writer w ^String (clojure-str this))))] - :cljs [IPrintWithWriter + #?@(:cljs [IPrintWithWriter (-pr-writer [this w opts] (if-let [rv var] (let [m (meta rv)] (if-let [pm (:sci.impl/print-method m)] (pm this w opts) (write-all w (clojure-str this)))) - (write-all w (clojure-str this))))]) + (write-all w (clojure-str this))))] + :default [SciPrintMethod + (-sci-print-method [this w] + (if-let [rv var] + (let [m (meta rv)] + (if-let [pm (:sci.impl/print-method m)] + (pm this w) + (#?(:clj .write :cljr .Write) + #?(:clj ^java.io.Writer w :cljr ^System.IO.TextWriter w) + (clojure-str this)))) + (#?(:clj .write :cljr .Write) + #?(:clj ^java.io.Writer w :cljr ^System.IO.TextWriter w) + (clojure-str this))))]) types/IBox (getVal [_] ext-map)) @@ -84,7 +89,8 @@ (defn ->type-impl [rec-name type var m] (SciType. rec-name type var m)) -#?(:clj +#?(:cljs nil + :default (defmethod print-method SciType [v w] (-sci-print-method v w))) @@ -99,7 +105,7 @@ field-set (set fields) protocol-impls (mapcat - (fn [[protocol-name & impls] #?(:clj expr :cljs expr)] + (fn [[protocol-name & impls] expr] (let [impls (group-by first impls) protocol (@utils/eval-resolve-state ctx (:bindings ctx) protocol-name) ;; _ (prn :protocol protocol) @@ -112,7 +118,7 @@ (utils/throw-error-with-location (str "Protocol not found: " protocol-name) expr)) - #?@(:clj [_ (assert-no-jvm-interface protocol protocol-name expr)]) + #?@(:cljs [] :default [_ (assert-no-jvm-interface protocol protocol-name expr)]) protocol (if (utils/var? protocol) @protocol protocol) protocol-var (:var protocol) _ (when protocol-var @@ -121,18 +127,18 @@ (fnil conj #{}) (symbol (str rec-type)))) protocol-ns (:ns protocol) pns (cond protocol-ns (str (types/getName protocol-ns)) - (= #?(:clj Object :cljs ::object) protocol) "sci.impl.deftype") + (= #?(:cljs ::object :default Object) protocol) "sci.impl.deftype") fq-meth-name #(if (simple-symbol? %) (symbol pns (str %)) %)] (map (fn [[method-name bodies]] (if #?(:cljs (and (keyword-identical? ::IPrintWithWriter protocol) (= '-pr-writer method-name)) - :clj false) + :default false) #?(:cljs `(alter-meta! (var ~record-name) assoc :sci.impl/print-method (fn ~(rest (first bodies)))) - :clj nil) + :default nil) (let [bodies (map rest bodies) bodies (mapv (fn [impl] (let [args (first impl) diff --git a/src/sci/impl/doseq_macro.cljc b/src/sci/impl/doseq_macro.cljc index b603af6d..af3031a4 100644 --- a/src/sci/impl/doseq_macro.cljc +++ b/src/sci/impl/doseq_macro.cljc @@ -6,10 +6,10 @@ (defn assert-args [seq-exprs _body-exprs] (when-not (vector? seq-exprs) - (throw (new #?(:clj IllegalArgumentException :cljs js/Error) + (throw (new #?(:clj IllegalArgumentException :cljs js/Error :cljr InvalidOperationException) "doseq requires a vector for its binding"))) (when-not (even? (count seq-exprs)) - (throw (new #?(:clj IllegalArgumentException :cljs js/Error) + (throw (new #?(:clj IllegalArgumentException :cljs js/Error :cljr InvalidOperationException) "doseq requires an even number of forms in binding vector")))) (defn expand-doseq diff --git a/src/sci/impl/evaluator.cljc b/src/sci/impl/evaluator.cljc index 60d3b3c4..417bcf8e 100644 --- a/src/sci/impl/evaluator.cljc +++ b/src/sci/impl/evaluator.cljc @@ -18,9 +18,9 @@ (declare fn-call) -#?(:clj (set! *warn-on-reflection* true)) +#?(:cljs nil :default (set! *warn-on-reflection* true)) -(def #?(:clj ^:const macros :cljs macros) +(def macros '#{do fn def defn syntax-quote}) @@ -53,8 +53,8 @@ (get (get (get env :namespaces) cnn) var-name))) (defmacro resolve-symbol [bindings sym] - `(.get ~(with-meta bindings - {:tag 'java.util.Map}) ~sym)) + #?(:clj `(.get ~(with-meta bindings {:tag 'java.util.Map}) ~sym) + :default `(get ~bindings ~sym))) (declare eval-string*) @@ -63,7 +63,7 @@ (let [v (types/eval case-val ctx bindings) found (get case-map v ::not-found)] (if (utils/kw-identical? ::not-found found) - (throw (new #?(:clj IllegalArgumentException :cljs js/Error) + (throw (new #?(:clj IllegalArgumentException :cljs js/Error :cljr InvalidOperationException) (str "No matching clause: " v))) (types/eval found ctx bindings)))) ([ctx bindings case-map case-val case-default] @@ -82,7 +82,7 @@ (seq catches) utils/*in-try*)] (types/eval body ctx bindings)) - (catch #?(:clj Throwable :cljs :default) e + (catch #?(:clj Throwable :cljs :default :cljr Exception) e (if-let [[_ r] (reduce (fn [_ c] @@ -92,7 +92,7 @@ (if (instance? sci.impl.types/NodeR clazz) (instance? (types/eval clazz ctx bindings) e) (instance? clazz e))) - :clj (instance? clazz e)) + :default (instance? clazz e)) (reduced [::try-result (do (aset ^objects bindings (:ex-idx c) e) @@ -116,10 +116,10 @@ (let [instance-expr* (types/eval instance-expr ctx bindings)] (interop/invoke-instance-field instance-expr* nil method-str)))) -(def none-sentinel #?(:clj (Object.) :cljs (js/Object.))) +(def none-sentinel #?(:cljs (js/Object.) :default (Object.))) -(defn get-from-type [instance _method-str method-str-unmunged #?(:clj arg-count :cljs args)] - (if (zero? #?(:clj arg-count :cljs (alength args))) +(defn get-from-type [instance _method-str method-str-unmunged #?(:cljs args :default arg-count)] + (if (zero? #?(:cljs (alength args) :default arg-count)) (if (instance? sci.impl.records.SciRecord instance) (get instance (keyword method-str-unmunged) none-sentinel) (if (instance? sci.impl.deftype.SciType instance) @@ -132,26 +132,30 @@ (let [instance-meta (meta instance-expr) tag-class (:tag-class instance-meta) instance-expr* (types/eval instance-expr ctx bindings) - v (get-from-type instance-expr* method-str method-str-unmunged #?(:clj arg-count :cljs args))] + v (get-from-type instance-expr* method-str method-str-unmunged #?(:cljs args :default arg-count))] (if-not (identical? none-sentinel v) v - (let [instance-class (or tag-class (#?(:clj class :cljs type) instance-expr*)) + (let [instance-class (or tag-class (#?(:cljs type :default class) instance-expr*)) env @(:env ctx) class->opts (:class->opts env) allowed? (or #?(:cljs allowed) (get class->opts :allow) (let [instance-class-name #?(:clj (.getName ^Class instance-class) - :cljs (.-name instance-class)) + :cljs (.-name instance-class) + :cljr (.FullName ^Type instance-class)) instance-class-symbol (symbol instance-class-name)] (get class->opts instance-class-symbol))) - ^Class target-class (if allowed? instance-class - (when-let [f (:public-class env)] - (f instance-expr*)))] + #?(:clj ^Class target-class + :cljr ^Type target-class + :default target-class) + (if allowed? instance-class + (when-let [f (:public-class env)] + (f instance-expr*)))] ;; we have to check options at run time, since we don't know what the class ;; of instance-expr is at analysis time - (when-not #?(:clj target-class - :cljs allowed?) + (when-not #?(:cljs allowed? + :default target-class) (throw-error-with-location (str "Method " method-str " on " instance-class " not allowed!") instance-expr)) (if field-access (interop/invoke-instance-field instance-expr* target-class method-str) @@ -173,7 +177,7 @@ res (second (resolve/lookup ctx sym false nil (qualified-symbol? sym)))] (when-not #?(:cljs (instance? sci.impl.types/NodeR res) - :clj (instance? sci.impl.types.Eval res)) + :default (instance? sci.impl.types.Eval res)) res))))) (vreset! utils/eval-resolve-state eval-resolve) @@ -215,7 +219,7 @@ (let [cnn (utils/current-ns-name)] (swap! env assoc-in [:namespaces cnn :refers class] rec-var) @rec-var) - (throw (new #?(:clj Exception :cljs js/Error) + (throw (new #?(:cljs js/Error :default Exception) (str "Unable to resolve classname: " fq-class-name))))))) nil classes))) @@ -265,31 +269,32 @@ (def-fn-call) ;; The following types cannot be treated as constants in the analyzer -#?(:clj (extend-protocol types/Eval - java.lang.Class - (eval [expr _ _] - expr) - clojure.lang.PersistentArrayMap - (eval [expr _ _] - expr) - clojure.lang.PersistentVector - (eval [expr _ _] - expr) - clojure.lang.Symbol - (eval [expr _ _] - expr) - sci.lang.Namespace - (eval [expr _ _] - expr) - sci.lang.Var - (eval [expr _ _] - expr) - clojure.lang.MultiFn - (eval [expr _ _] - expr) - Object - (eval [expr _ _] - expr) - ;; literal nils are treated like constants, but nil might also happen - ;; as a result of analysis - nil (eval [_ _ _] nil))) +#?(:cljs nil :default + (extend-protocol types/Eval + #?(:clj java.lang.Class :cljr Type) + (eval [expr _ _] + expr) + clojure.lang.PersistentArrayMap + (eval [expr _ _] + expr) + clojure.lang.PersistentVector + (eval [expr _ _] + expr) + clojure.lang.Symbol + (eval [expr _ _] + expr) + sci.lang.Namespace + (eval [expr _ _] + expr) + sci.lang.Var + (eval [expr _ _] + expr) + clojure.lang.MultiFn + (eval [expr _ _] + expr) + Object + (eval [expr _ _] + expr) + ;; literal nils are treated like constants, but nil might also happen + ;; as a result of analysis + nil (eval [_ _ _] nil))) diff --git a/src/sci/impl/faster.cljc b/src/sci/impl/faster.cljc index d528e253..0137f143 100644 --- a/src/sci/impl/faster.cljc +++ b/src/sci/impl/faster.cljc @@ -6,24 +6,27 @@ (defmacro nth-2 [c i] (? - :clj `(.nth ~(with-meta c {:tag 'clojure.lang.Indexed}) ~i) + :clj #?(:clj `(.nth ~(with-meta c {:tag 'clojure.lang.Indexed}) ~i) + :default `(nth ~c ~i)) :cljs `(~'-nth ~c ~i))) (defmacro assoc-3 [m k v] (? - :clj `(.assoc ~(with-meta m {:tag 'clojure.lang.Associative}) ~k ~v) + :clj #?(:clj `(.assoc ~(with-meta m {:tag 'clojure.lang.Associative}) ~k ~v) + :default `(assoc ~m ~k ~v)) :cljs `(~'-assoc ~m ~k ~v))) (defmacro get-2 [m k] (? - :clj `(.get ~(with-meta m {:tag 'java.util.Map}) ~k) + :clj #?(:clj `(.get ~(with-meta m {:tag 'java.util.Map}) ~k) + :default `(get ~m ~k)) :cljs `(.get ~m ~k))) (defmacro deref-1 [ref] (? - :clj `(.deref ~(with-meta ref - {:tag 'clojure.lang.IDeref})) + :clj #?(:clj `(.deref ~(with-meta ref {:tag 'clojure.lang.IDeref})) + :default `(deref ~ref)) :cljs `(~'-deref ~ref))) diff --git a/src/sci/impl/fns.cljc b/src/sci/impl/fns.cljc index 40cb6ac0..2e4d9e7b 100644 --- a/src/sci/impl/fns.cljc +++ b/src/sci/impl/fns.cljc @@ -5,7 +5,7 @@ [sci.impl.utils :as utils :refer [recur]]) #?(:cljs (:require-macros [sci.impl.fns :refer [gen-fn]]))) -#?(:clj (set! *warn-on-reflection* true)) +#?(:cljs nil :default (set! *warn-on-reflection* true)) (defmacro gen-fn ([n] @@ -57,7 +57,7 @@ #_{:clj-kondo/ignore [:unused-binding]} (defn fun - ([#?(:clj ^clojure.lang.Associative ctx :cljs ctx) + ([#?(:cljs ctx :default ^clojure.lang.Associative ctx) enclosed-array fn-body fn-name @@ -69,7 +69,7 @@ (:invoc-size fn-body) (utils/current-ns-name) (:vararg-idx fn-body))) - ([#?(:clj ^clojure.lang.Associative ctx :cljs ctx) + ([#?(:cljs ctx :default ^clojure.lang.Associative ctx) enclosed-array fn-body fn-name @@ -80,8 +80,8 @@ invoc-size nsm vararg-idx] (let [f (if vararg-idx - (case #?(:clj (int fixed-arity) - :cljs fixed-arity) + (case #?(:cljs fixed-arity + :default (int fixed-arity)) 0 (gen-fn 0 true true) 1 (gen-fn 1 true true) 2 (gen-fn 2 true true) @@ -103,8 +103,8 @@ 18 (gen-fn 18 true true) 19 (gen-fn 19 true true) 20 (gen-fn 20 true true)) - (case #?(:clj (int fixed-arity) - :cljs fixed-arity) + (case #?(:cljs fixed-arity + :default (int fixed-arity)) 0 (gen-fn 0) 1 (gen-fn 1) 2 (gen-fn 2) diff --git a/src/sci/impl/for_macro.cljc b/src/sci/impl/for_macro.cljc index 351fd1af..e8e92d5d 100644 --- a/src/sci/impl/for_macro.cljc +++ b/src/sci/impl/for_macro.cljc @@ -29,7 +29,8 @@ (conj groups [k v]))) [] (partition 2 seq-exprs))) err (fn [& msg] (throw (new #?(:clj IllegalArgumentException - :cljs js/Error) ^String (apply str msg)))) + :cljs js/Error + :cljr InvalidOperationException) ^String (apply str msg)))) emit-bind (fn emit-bind [[[bind expr & mod-pairs] & [[_ next-expr] :as next-groups]]] (let [giter (gensym "iter__") diff --git a/src/sci/impl/hierarchies.cljc b/src/sci/impl/hierarchies.cljc index 6b9fbe35..16960c45 100644 --- a/src/sci/impl/hierarchies.cljc +++ b/src/sci/impl/hierarchies.cljc @@ -10,7 +10,7 @@ (get-in @(:env (store/get-ctx)) [:namespaces 'clojure.core 'global-hierarchy])) (defn ->tag [x] - (if (instance? sci.lang.Type x) + (if (instance? #?(:cljr sci.lang.SciCustomType :default sci.lang.Type) x) (symbol (namespace x) (name x)) x)) diff --git a/src/sci/impl/interop.cljc b/src/sci/impl/interop.cljc index 45ed7362..3eb90489 100644 --- a/src/sci/impl/interop.cljc +++ b/src/sci/impl/interop.cljc @@ -1,15 +1,16 @@ (ns sci.impl.interop {:no-doc true} + (:require [sci.impl.types :as types] + [sci.impl.utils :as utils] + #?@(:cljs [] + :default [[sci.impl.reflector :as reflector]])) #?(:clj (:import - [java.lang.reflect Field Modifier] - [sci.impl Reflector])) - (:require [sci.impl.types] - [sci.impl.utils :as utils])) + [java.lang.reflect Modifier]))) ;; see https://github.com/clojure/clojure/blob/master/src/jvm/clojure/lang/Reflector.java ;; see invokeStaticMethod, getStaticField, etc. -#?(:clj (set! *warn-on-reflection* true)) +#?(:cljs nil :default (set! *warn-on-reflection* true)) (defn invoke-instance-field #?@(:cljs [[obj _target-class field-name] @@ -17,16 +18,20 @@ (aget obj field-name)] :clj [[obj ^Class target-class method] - (let [^Field field (.getField target-class method) + (let [field (.getField target-class method) mod (.getModifiers field)] (if (and (not (Modifier/isStatic mod)) (Modifier/isPublic mod)) (.get field obj) - (throw (ex-info (str "Not found or accessible instance field: " method) {}))))])) - -#?(:clj - (defn meth-cache [ctx ^Class class meth-name len fetch-fn k] - (let [cname (.getName class) + (throw (ex-info (str "Not found or accessible instance field: " method) {}))))] + :cljr + [[obj ^Type target-class method] + (throw (ex-info (str "TODO CLR support: " `invoke-instance-field) {}))])) + +#?(:cljs nil :default + (defn meth-cache [ctx class meth-name len fetch-fn k] + (let [cname #?(:clj (.getName ^Class class) + :cljr (.FullName ^Type class)) env (:env ctx) meths (-> (deref env) k (get cname) (get meth-name) (get len))] (or meths @@ -42,23 +47,24 @@ (let [args (.map args #(sci.impl.types/eval % ctx bindings))] (js/Reflect.apply method obj args)) (throw (js/Error. (str "Could not find instance method: " method-name))))] - :clj - [[ctx bindings obj ^Class target-class method ^objects args arg-count arg-types] - (let [^java.util.List methods - (meth-cache ctx target-class method arg-count #(Reflector/getMethods target-class arg-count method false) :instance-methods) + :default + [[ctx bindings obj target-class method ^objects args arg-count arg-types] + (let [methods (meth-cache ctx target-class method arg-count #(reflector/get-methods target-class arg-count method false) :instance-methods) zero-args? (zero? arg-count)] - (if (and zero-args? (.isEmpty ^java.util.List methods)) + (if (and zero-args? + #?(:clj (.isEmpty ^java.util.List methods) + :default (empty? methods))) (invoke-instance-field obj target-class method) - (do (let [args-array (object-array arg-count)] - (areduce args idx _ret nil - (aset args-array idx (sci.impl.types/eval (aget args idx) ctx bindings))) - ;; Note: I also tried caching the method that invokeMatchingMethod looks up, but retrieving it from the cache was actually more expensive than just doing the invocation! - ;; See getMatchingMethod in Reflector - (Reflector/invokeMatchingMethod method methods target-class obj args-array arg-types)))))])) + (let [args-array (object-array arg-count)] + (areduce args idx _ret nil + (aset args-array idx (types/eval (aget args idx) ctx bindings))) + ;; Note: I also tried caching the method that invokeMatchingMethod looks up, but retrieving it from the cache was actually more expensive than just doing the invocation! + ;; See getMatchingMethod in Reflector + (reflector/invoke-matching-method method methods target-class obj args-array arg-types))))])) -(defn get-static-field [^Class class field-name-sym] - #?(:clj (Reflector/getStaticField class (str field-name-sym)) - :cljs (unchecked-get class field-name-sym))) +(defn get-static-field [class field-name-sym] + #?(:cljs (unchecked-get class field-name-sym) + :default (reflector/get-static-field class (str field-name-sym)))) #?(:cljs (def fn-eval-allowed? @@ -85,36 +91,35 @@ (defn invoke-js-constructor* [ctx bindings constructor args] (js/Reflect.construct constructor (.map args #(sci.impl.types/eval % ctx bindings))))) -#?(:clj - (defn invoke-constructor #?(:clj [^Class class args] - :cljs [constructor args]) - (Reflector/invokeConstructor class (object-array args)))) +#?(:cljs nil :default + (defn invoke-constructor [class args] + (reflector/invoke-constructor class (object-array args)))) -(defn invoke-static-method #?(:clj [ctx bindings ^Class class ^String method-name ^objects args len] - :cljs [ctx bindings class method args]) - #?(:clj +(defn invoke-static-method #?(:cljs [ctx bindings class method args] + :default [ctx bindings class method-name ^objects args len]) + #?(:cljs (js/Reflect.apply method class (.map args #(sci.impl.types/eval % ctx bindings))) + :default (let [args-array (object-array len)] ;; [a idx ret init expr] (areduce args idx _ret nil (aset args-array idx (sci.impl.types/eval (aget args idx) ctx bindings))) ;; List methods = getMethods(c, args.length, methodName, true); ;; invokeMatchingMethod(methodName, methods, null, args) - (let [meths (meth-cache ctx class method-name len #(sci.impl.Reflector/getMethods class len method-name true) :static-methods)] + (let [meths (meth-cache ctx class method-name len #(reflector/get-methods class len method-name true) :static-methods)] ;; Note: I also tried caching the method that invokeMatchingMethod looks up, but retrieving it from the cache was actually more expensive than just doing the invocation! ;; See getMatchingMethod in Reflector - (sci.impl.Reflector/invokeMatchingMethod method-name meths nil args-array))) - :cljs (js/Reflect.apply method class (.map args #(sci.impl.types/eval % ctx bindings))))) + (reflector/invoke-matching-method method-name meths nil args-array))))) (defn fully-qualify-class [ctx sym] (let [env @(:env ctx) class->opts (:class->opts env)] - (or #?(:clj (when (contains? class->opts sym) sym) - :cljs (if-let [ns* (namespace sym)] + (or #?(:cljs (if-let [ns* (namespace sym)] (when (identical? "js" ns*) (when (contains? class->opts (symbol (name sym))) sym)) (when (contains? class->opts sym) - sym))) + sym)) + :default (when (contains? class->opts sym) sym)) (let [cnn (utils/current-ns-name) imports (get-in env [:namespaces cnn :imports])] (if-let [[_ v] (find imports sym)] @@ -127,11 +132,11 @@ ;; almost the same, since `js/Foo` stays fully qualified (let [env @(:env ctx) class->opts (:class->opts env) - class-opts (or #?(:clj (get class->opts sym) - :cljs (if-let [ns* (namespace sym)] + class-opts (or #?(:cljs (if-let [ns* (namespace sym)] (when (identical? "js" ns*) (get class->opts (symbol (name sym)))) - (get class->opts sym))) + (get class->opts sym)) + :default (get class->opts sym)) (let [cnn (utils/current-ns-name) imports (get-in env [:namespaces cnn :imports])] (if-let [[_ v] (find imports sym)] @@ -162,22 +167,51 @@ 'byte Byte/TYPE 'bytes (Class/forName "[B") 'char Character/TYPE - 'chars (Class/forName "[C")})) - -#?(:clj + 'chars (Class/forName "[C")}) + :cljr + (def prim->class + {'int Int32 + 'ints (Type/GetType "System.Int32[]") + 'long Int64 + 'longs (Type/GetType "System.Int64[]") + 'float Single + 'floats (Type/GetType "System.Single[]") + 'double Double + 'doubles (Type/GetType "System.Double[]") + 'void System.Void + 'short Int16 + 'shorts (Type/GetType "System.Int16[]") + 'boolean Boolean + 'booleans (Type/GetType "System.Boolean[]") + 'byte Byte + 'bytes (Type/GetType "System.Byte[]") + 'sbyte SByte + 'sbytes (Type/GetType "System.SByte[]") + 'ushort UInt16 + 'ushorts (Type/GetType "System.UInt16[]") + 'uint UInt32 + 'uints (Type/GetType "System.UInt32[]") + 'ulong UInt64 + 'ulongs (Type/GetType "System.UInt64[]") + 'char Char + 'chars (Type/GetType "System.Char[]")})) + +#?(:cljs nil :default (defn resolve-type-hint [ctx sym] - (if (string? sym) (Class/forName sym) + (if (string? sym) (#?(:clj Class/forName :cljr Type/GetType) sym) (or (get prim->class sym) (:class (resolve-class-opts ctx sym)))))) -#?(:clj +#?(:cljs nil :default (def ->array-class (memoize (fn [clazz dim] (class (apply make-array clazz (vec (repeat dim 0)))))))) -#?(:clj - (defn resolve-array-class [ctx sym-ns ^String sym-name-str] +#?(:cljs nil :default + (defn resolve-array-class + #?(:clj ^Class [ctx sym-ns ^String sym-name-str] + :cljr ^Type [ctx sym-ns ^String sym-name-str]) (when-let [clazz (or (resolve-class ctx sym-ns) (get prim->class sym-ns))] - (let [dim (- (int (.charAt sym-name-str 0)) 48)] + (let [dim (- (int (#?(:clj .charAt :cljr .get_Chars) sym-name-str 0)) 48)] (->array-class clazz dim))))) diff --git a/src/sci/impl/interpreter.cljc b/src/sci/impl/interpreter.cljc index 2d8a022b..15c4cd31 100644 --- a/src/sci/impl/interpreter.cljc +++ b/src/sci/impl/interpreter.cljc @@ -12,7 +12,7 @@ [sci.impl.vars :as vars] [sci.impl.parser :as parser])) -#?(:clj (set! *warn-on-reflection* true)) +#?(:cljs nil :default (set! *warn-on-reflection* true)) (defn eval-form* [ctx form] (let [eval-file (:clojure.core/eval-file (meta form))] @@ -39,11 +39,12 @@ analyzed (ana/analyze ctx form true) binding-array-size (count (get-in @cb [upper-sym 0 :syms])) bindings (object-array binding-array-size)] - (if (instance? #?(:clj sci.impl.types.EvalForm - :cljs sci.impl.types/EvalForm) analyzed) + (if (instance? #?(:cljs sci.impl.types/EvalForm + :default sci.impl.types.EvalForm) + analyzed) (eval-form* ctx (types/getVal analyzed)) (try (types/eval analyzed ctx bindings) - (catch #?(:clj Throwable :cljs js/Error) e + (catch #?(:clj Throwable :cljs js/Error :cljr Exception) e (utils/rethrow-with-location-of-node ctx bindings e analyzed)))))) (let [upper-sym (gensym) cb (volatile! {upper-sym {0 {:syms {}}}}) @@ -54,7 +55,7 @@ binding-array-size (count (get-in @cb [upper-sym 0 :syms])) bindings (object-array binding-array-size)] (try (types/eval analyzed ctx bindings) - (catch #?(:clj Throwable :cljs js/Error) e + (catch #?(:clj Throwable :cljs js/Error :cljr Exception) e (utils/rethrow-with-location-of-node ctx bindings e analyzed))))) (finally (when eval-file @@ -75,8 +76,9 @@ (vars/with-bindings {utils/current-ns (or (when opts (:ns opts)) @utils/current-ns) parser/data-readers @parser/data-readers - #?@(:clj [utils/warn-on-reflection-var @utils/warn-on-reflection-var - utils/unchecked-math-var @utils/unchecked-math-var])} + #?@(:cljs [] + :default [utils/warn-on-reflection-var @utils/warn-on-reflection-var + utils/unchecked-math-var @utils/unchecked-math-var])} (let [reader (r/indexing-push-back-reader (r/string-push-back-reader s)) eval-string+? (when opts (:sci.impl/eval-string+ opts))] (loop [ret nil] diff --git a/src/sci/impl/io.cljc b/src/sci/impl/io.cljc index 20f3a79f..3ba01211 100644 --- a/src/sci/impl/io.cljc +++ b/src/sci/impl/io.cljc @@ -3,7 +3,7 @@ (:refer-clojure :exclude [pr prn pr-str prn-str print print-str println println-str newline flush with-out-str with-in-str read-line printf #?@(:cljs [string-print]) - #?@(:clj [print-simple])]) + #?@(:cljs [] :default [print-simple])]) (:require #?(:cljs [goog.string]) [sci.impl.copy-vars :refer [copy-var]] @@ -12,7 +12,7 @@ [sci.impl.utils :as utils] [sci.impl.vars :as vars])) -#?(:clj (set! *warn-on-reflection* true)) +#?(:cljs nil :default (set! *warn-on-reflection* true)) (defn core-dynamic-var "create a dynamic var with clojure.core :ns meta" @@ -27,17 +27,21 @@ (doto (core-dynamic-var '*in*) (vars/unbind) #?(:clj (alter-meta! assoc - :doc "A java.io.Reader object representing standard input for read operations."))))) + :doc "A java.io.Reader object representing standard input for read operations.") + :cljr (alter-meta! assoc + :doc "A System.IO.TextReader object representing standard input for read operations."))))) (def out (binding [*unrestricted* true] (doto (core-dynamic-var '*out*) (vars/unbind) - #?(:clj (alter-meta! assoc :doc "A java.io.Writer object representing standard output for print operations."))))) + #?(:clj (alter-meta! assoc :doc "A java.io.Writer object representing standard output for print operations.") + :cljr (alter-meta! assoc :doc "A System.IO.TextWriter object representing standard output for print operations."))))) (def err (binding [*unrestricted* true] (doto (core-dynamic-var '*err*) (vars/unbind) - #?(:clj (alter-meta! assoc :doc " A java.io.Writer object representing standard error for print operations."))))) + #?(:clj (alter-meta! assoc :doc " A java.io.Writer object representing standard error for print operations.") + :cljr (alter-meta! assoc :doc " A System.IO.TextWriter object representing standard error for print operations."))))) #?(:cljs (def print-fn @@ -66,32 +70,17 @@ (binding [*print-fn* @print-fn] (cljs.core/string-print x))) ) -#?(:clj (defn pr-on - {:private true - :static true} - [x w] - (if *print-dup* - (print-dup x w) - (print-method x w)) - nil)) +#?(:cljs nil :default + (defn pr-on + {:private true + :static true} + [x w] + (if *print-dup* + (print-dup x w) + (print-method x w)) + nil)) -#?(:clj (defn pr - ([] nil) - ([x] - (binding [*print-length* @print-length - *print-level* @print-level - *print-meta* @print-meta - *print-namespace-maps* @print-namespace-maps - *print-readably* @print-readably - *print-dup* @print-dup-var] - (pr-on x @out))) - ([x & more] - (pr x) - (. ^java.io.Writer @out (append \space)) - (if-let [nmore (next more)] - (recur (first more) nmore) - (apply pr more)))) - :cljs (defn pr +#?(:cljs (defn pr [& objs] (binding [*print-fn* @print-fn *print-length* @print-length @@ -101,36 +90,50 @@ *print-readably* @print-readably *print-newline* @print-newline *print-dup* @print-dup-var] - (apply cljs.core/pr objs)))) + (apply cljs.core/pr objs))) + :default (defn pr + ([] nil) + ([x] + (binding [*print-length* @print-length + *print-level* @print-level + *print-meta* @print-meta + *print-namespace-maps* @print-namespace-maps + *print-readably* @print-readably + *print-dup* @print-dup-var] + (pr-on x @out))) + ([x & more] + (pr x) + (. #?(:clj ^java.io.Writer @out + :cljr ^System.IO.TextWriter @out) + (append \space)) + (if-let [nmore (next more)] + (recur (first more) nmore) + (apply pr more))))) -#?(:clj +#?(:cljs (defn flush [] ;stub + nil) + :default (defn flush [] - (. ^java.io.Writer @out (flush)) - nil) - :cljs (defn flush [] ;stub - nil)) + (. #?(:clj ^java.io.Writer @out + :cljr ^System.IO.TextWriter @out) + (flush)) + nil)) #?(:cljs (declare println)) -#?(:clj (defn newline - [] - (. ^java.io.Writer @out (append ^String @#'clojure.core/system-newline)) - nil) - :cljs (defn newline +#?(:cljs (defn newline [] (binding [*print-fn* @print-fn] - (cljs.core/newline)))) + (cljs.core/newline))) + :default (defn newline + [] + (. #?(:clj ^java.io.Writer @out + :cljr ^System.IO.TextWriter @out) + (append ^String @#'clojure.core/system-newline)) + nil)) -#?(:clj - (defn pr-str - "pr to a string, returning it" - [& xs] - (let [sw (java.io.StringWriter.)] - (vars/with-bindings {out sw} - (apply pr xs)) - (str sw))) - :cljs +#?(:cljs (defn pr-str "pr to a string, returning it" [& objs] @@ -141,16 +144,17 @@ *print-readably* @print-readably *print-newline* @print-newline *print-dup* @print-dup-var] - (apply cljs.core/pr-str objs)))) + (apply cljs.core/pr-str objs))) + :default + (defn pr-str + "pr to a string, returning it" + [& xs] + (let [sw (#?(:clj java.io.StringWriter. :cljr System.IO.StringWriter.))] + (vars/with-bindings {out sw} + (apply pr xs)) + (str sw)))) -#?(:clj - (defn prn - [& more] - (apply pr more) - (newline) - (when @flush-on-newline - (flush))) - :cljs +#?(:cljs (defn prn [& objs] (binding [*print-fn* @print-fn @@ -161,17 +165,16 @@ *print-readably* @print-readably *print-newline* @print-newline *print-dup* @print-dup-var] - (apply cljs.core/prn objs)))) + (apply cljs.core/prn objs))) + :default + (defn prn + [& more] + (apply pr more) + (newline) + (when @flush-on-newline + (flush)))) -#?(:clj - (defn prn-str - "prn to a string, returning it" - [& xs] - (let [sw (java.io.StringWriter.)] - (vars/with-bindings {out sw} - (apply prn xs)) - (str sw))) - :cljs +#?(:cljs (defn prn-str "prn to a string, returning it" [& objs] @@ -182,14 +185,17 @@ *print-readably* @print-readably *print-newline* @print-newline *print-dup* @print-dup-var] - (apply cljs.core/prn-str objs)))) + (apply cljs.core/prn-str objs))) + :default + (defn prn-str + "prn to a string, returning it" + [& xs] + (let [sw (#?(:clj java.io.StringWriter. :cljr System.IO.StringWriter.))] + (vars/with-bindings {out sw} + (apply prn xs)) + (str sw)))) -#?(:clj - (defn print - [& more] - (vars/with-bindings {print-readably nil} - (apply pr more))) - :cljs +#?(:cljs (defn print [& objs] (binding [*print-fn* @print-fn @@ -199,17 +205,14 @@ *print-readably* nil *print-newline* @print-newline *print-dup* @print-dup-var] - (apply cljs.core/print objs)))) + (apply cljs.core/print objs))) + :default + (defn print + [& more] + (vars/with-bindings {print-readably nil} + (apply pr more)))) -#?(:clj - (defn print-str - "print to a string, returning it" - [& xs] - (let [sw (java.io.StringWriter.)] - (vars/with-bindings {out sw} - (apply print xs)) - (str sw))) - :cljs +#?(:cljs (defn print-str "print to a string, returning it" [& objs] @@ -220,14 +223,17 @@ *print-readably* @print-readably *print-newline* @print-newline *print-dup* @print-dup-var] - (apply cljs.core/print-str objs)))) + (apply cljs.core/print-str objs))) + :clj + (defn print-str + "print to a string, returning it" + [& xs] + (let [sw (#?(:clj java.io.StringWriter. :cljr System.IO.StringWriter.))] + (vars/with-bindings {out sw} + (apply print xs)) + (str sw)))) -#?(:clj - (defn println - [& more] - (vars/with-bindings {print-readably nil} - (apply prn more))) - :cljs +#?(:cljs (defn println [& objs] (binding [*print-fn* @print-fn @@ -238,17 +244,14 @@ *print-readably* @print-readably *print-newline* @print-newline *print-dup* @print-dup-var] - (apply cljs.core/println objs)))) + (apply cljs.core/println objs))) + :default + (defn println + [& more] + (vars/with-bindings {print-readably nil} + (apply prn more)))) -#?(:clj - (defn println-str - "println to a string, returning it" - [& xs] - (let [sw (java.io.StringWriter.)] - (vars/with-bindings {out sw} - (apply println xs)) - (str sw))) - :cljs +#?(:cljs (defn println-str "println to a string, returning it" [& objs] @@ -259,9 +262,17 @@ *print-readably* @print-readably *print-newline* @print-newline *print-dup* @print-dup-var] - (apply cljs.core/println-str objs)))) + (apply cljs.core/println-str objs))) + :default + (defn println-str + "println to a string, returning it" + [& xs] + (let [sw (#?(:clj java.io.StringWriter. :cljr System.IO.StringWriter.))] + (vars/with-bindings {out sw} + (apply println xs)) + (str sw)))) -#?(:clj +#?(:cljs nil :default (defn printf [fmt & args] (print (apply format fmt args)))) @@ -269,22 +280,24 @@ (defn with-out-str [_ _ & body] `(let [s# (new #?(:clj java.io.StringWriter - :cljs goog.string.StringBuffer))] - #?(:clj - (binding [*out* s#] - ~@body - (str s#)) - :cljs + :cljs goog.string.StringBuffer + :cljr System.IO.StringWriter))] + #?(:cljs (binding [*print-newline* true *print-fn* (fn [x#] (. s# ~utils/allowed-append x#))] ~@body + (str s#)) + :default + (binding [*out* s#] + ~@body (str s#))))) -#?(:clj +#?(:cljs nil :default (defn with-in-str [_ _ s & body] - `(with-open [s# (-> (java.io.StringReader. ~s) clojure.lang.LineNumberingPushbackReader.)] + `(with-open [s# #?(:clj (-> (java.io.StringReader. ~s) clojure.lang.LineNumberingPushbackReader.) + :cljr (System.IO.StringReader. ~s))] (binding [*in* s#] ~@body)))) @@ -293,9 +306,12 @@ [] (if (instance? clojure.lang.LineNumberingPushbackReader @in) (.readLine ^clojure.lang.LineNumberingPushbackReader @in) - (.readLine ^java.io.BufferedReader @in)))) + (.readLine ^java.io.BufferedReader @in))) + :cljr + (defn read-line [] + (System.IO.TextReader/.ReadLine @in))) -#?(:clj +#?(:cljs nil :default (defn print-simple [o w] (binding [*print-dup* @print-dup-var *print-meta* @print-meta diff --git a/src/sci/impl/load.cljc b/src/sci/impl/load.cljc index 815eac75..664e3a6c 100644 --- a/src/sci/impl/load.cljc +++ b/src/sci/impl/load.cljc @@ -15,8 +15,8 @@ [ctx reader] (let [reader ;; TODO: move this check to edamame - (if #?(:clj (instance? clojure.tools.reader.reader_types.IndexingReader reader) - :cljs (implements? r/IndexingReader reader)) + (if #?(:cljs (implements? r/IndexingReader reader) + :default (instance? clojure.tools.reader.reader_types.IndexingReader reader)) reader (r/indexing-push-back-reader reader))] (loop [ret nil] @@ -92,7 +92,7 @@ (defn handle-require-libspec-env [_ctx env current-ns the-loaded-ns lib-name - {:keys [:as :refer #?(:cljs :refer-macros) :rename :exclude :only :use] :as #?(:clj _opts :cljs opts)}] + {:keys [:as :refer #?(:cljs :refer-macros) :rename :exclude :only :use] :as #?(:cljs opts :default _opts)}] (or #?(:cljs (when (string? lib-name) @@ -129,13 +129,13 @@ (assoc ns (rename-sym sym) (if-let [[_k v] (find the-loaded-ns sym)] v - (throw (new #?(:clj Exception :cljs js/Error) + (throw (new #?(:cljs js/Error :default Exception) (str sym " does not exist"))))) ns)) referred refer)] (assoc the-current-ns :refers referred)) - :else (throw (new #?(:clj Exception :cljs js/Error) + :else (throw (new #?(:cljs js/Error :default Exception) ":refer value must be a sequential collection of symbols"))) use (handle-refer-all the-current-ns the-loaded-ns include-sym? rename-sym only) :else the-current-ns) @@ -148,10 +148,10 @@ @(get-in env '[:namespaces clojure.core *loaded-libs*])) (defn add-loaded-lib [env lib] - #?(:clj - (dosync (alter (loaded-libs env) conj lib)) - :cljs - (swap! (loaded-libs env) conj lib)) + #?(:cljs + (swap! (loaded-libs env) conj lib) + :default + (dosync (alter (loaded-libs env) conj lib))) nil) (defn handle-require-libspec @@ -178,7 +178,8 @@ (if (and loading (not (contains? @(loaded-libs env) lib)) (nat-int? #?(:clj (.indexOf ^clojure.lang.PersistentVector loading lib) - :cljs (.indexOf loading lib)))) + :cljs (.indexOf loading lib) + :cljr (.IndexOf ^clojure.lang.PersistentVector loading lib)))) (throw-error-with-location (let [lib-emphasized (str "[ " lib " ]") loading (conj loading lib) @@ -211,10 +212,11 @@ {utils/current-ns curr-ns utils/current-file file parser/data-readers @parser/data-readers - #?@(:clj [utils/warn-on-reflection-var @utils/warn-on-reflection-var - utils/unchecked-math-var @utils/unchecked-math-var])} + #?@(:cljs [] + :default [utils/warn-on-reflection-var @utils/warn-on-reflection-var + utils/unchecked-math-var @utils/unchecked-math-var])} (load-string* ctx source)) - (catch #?(:clj Exception :cljs js/Error) e + (catch #?(:cljs js/Error :default Exception) e (swap! env* update :namespaces dissoc lib) (throw e))))) (when-not handled @@ -227,19 +229,21 @@ (or (when reload* (when-let [the-loaded-ns (get namespaces lib)] (reset! env* (handle-require-libspec-env ctx env cnn the-loaded-ns lib opts)))) - (throw (new #?(:clj Exception :cljs js/Error) + (throw (new #?(:cljs js/Error :default Exception) (str "Could not find namespace: " lib ".")))))) - (throw (new #?(:clj Exception :cljs js/Error) - + (throw (new #?(:cljs js/Error :default Exception) (str "Could not find namespace " lib "."))))) - #?(:clj (add-loaded-lib env lib) - :cljs (when-not js-lib? - (add-loaded-lib env lib))) + #?(:cljs (when-not js-lib? + (add-loaded-lib env lib)) + :default (add-loaded-lib env lib)) nil))))) (defn load-lib* [ctx prefix lib options] - (when (and prefix (pos? (.indexOf (name lib) #?(:clj (int \.) - :cljs \.)))) + (when (and prefix + (pos? (#?(:cljr .IndexOf :default .indexOf) + (name lib) + #?(:cljs \. + :default (int \.))))) (throw-error-with-location (str "Found lib name '" (name lib) "' containing period with prefix '" prefix "'. lib names inside prefix lists must not contain periods") lib)) @@ -247,14 +251,14 @@ opts (apply hash-map options)] (handle-require-libspec ctx lib opts))) -#?(:clj +#?(:cljs + (defn load-lib [ctx prefix lib & options] + (load-lib* ctx prefix lib options)) + :default (let [load-lock (Object.)] (defn load-lib [ctx prefix lib & options] (locking load-lock - (load-lib* ctx prefix lib options)))) - :cljs - (defn load-lib [ctx prefix lib & options] - (load-lib* ctx prefix lib options))) + (load-lib* ctx prefix lib options))))) (defn- prependss "Prepends a symbol or a seq to coll" @@ -356,7 +360,7 @@ (let [cnn (utils/current-ns-name) namespaces (:namespaces env) ns (or (get namespaces ns-sym) - (throw (new #?(:clj Exception :cljs js/Error) + (throw (new #?(:cljs js/Error :default Exception) (str "No namespace: " ns-sym)))) fs (apply hash-map filters) public-keys (filter symbol? (keys ns)) @@ -366,7 +370,7 @@ public-keys (or (:refer fs) (:only fs) public-keys)) _ (when (and to-do (not (sequential? to-do))) - (throw (new #?(:clj Exception :cljs js/Error) + (throw (new #?(:cljs js/Error :default Exception) ":only/:refer value must be a sequential collection of symbols"))) the-current-ns (get namespaces cnn) referred (:refers the-current-ns) @@ -375,7 +379,8 @@ (let [v (get ns sym)] (when-not v (throw (new #?(:clj java.lang.IllegalAccessError - :cljs js/Error) + :cljs js/Error + :cljr InvalidOperationException) ;; TODO: handle private vars (if false ;; (get (ns-interns ns) sym) (str sym " is not public") diff --git a/src/sci/impl/macroexpand.cljc b/src/sci/impl/macroexpand.cljc index c4cd78a2..6952e61f 100644 --- a/src/sci/impl/macroexpand.cljc +++ b/src/sci/impl/macroexpand.cljc @@ -19,8 +19,7 @@ (= 'clojure.core/defrecord op) expr :else (let [f (try (resolve/resolve-symbol ctx op true) - (catch #?(:clj Exception :cljs :default) - _ ::unresolved))] + (catch #?(:cljs :default :default Exception) _ ::unresolved))] (if (kw-identical? ::unresolved f) expr (let [var? (var? f) diff --git a/src/sci/impl/macros.cljc b/src/sci/impl/macros.cljc index 255b0bb7..be22bd24 100644 --- a/src/sci/impl/macros.cljc +++ b/src/sci/impl/macros.cljc @@ -8,21 +8,24 @@ [& body] (when #?(:clj (not (:ns &env)) :cljs (when-let [n (and *ns* (ns-name *ns*))] - (re-matches #".*\$macros" (name n)))) + (re-matches #".*\$macros" (name n))) + :default true) `(do ~@body))) (defmacro usetime "Private. usetime macro from https://github.com/cgrand/macrovich" [& body] - (when #?(:clj true :cljs (not (re-matches #".*\$macros" (name (ns-name *ns*))))) + (when #?(:clj true :cljs (not (re-matches #".*\$macros" (name (ns-name *ns*)))) :default true) `(do ~@body))) (deftime (defmacro ? "Private. case macro from https://github.com/cgrand/macrovich" [& {:keys [cljs clj]}] + #?(:cljr clj + :default (if (contains? &env '&env) `(if (:ns ~'&env) ~cljs ~clj) (if #?(:clj (:ns &env) :cljs true) cljs - clj)))) + clj))))) diff --git a/src/sci/impl/main.cljc b/src/sci/impl/main.cljc index cd437b57..6e61a48b 100644 --- a/src/sci/impl/main.cljc +++ b/src/sci/impl/main.cljc @@ -24,6 +24,7 @@ #?@(:clj [ctx (assoc-in ctx [:namespaces 'clojure.core 'time] (with-meta time* {:sci/macro true}))]) #?@(:clj [ctx (assoc-in ctx [:classes 'java.lang.System] System)]) #?@(:clj [ctx (assoc-in ctx [:classes 'java.lang.IllegalArgumentException] IllegalArgumentException)]) + #?@(:cljr [ctx (assoc-in ctx [:classes `InvalidOperationException] InvalidOperationException)]) #?@(:clj [ctx (assoc-in ctx [:classes 'java.lang.Thread] Thread)]) #?@(:clj [ctx (assoc-in ctx [:classes 'java.lang.Math] Math)]) #?@(:clj [ctx (assoc-in ctx [:imports] {'System 'java.lang.System diff --git a/src/sci/impl/multimethods.cljc b/src/sci/impl/multimethods.cljc index b4784977..8fe7815d 100644 --- a/src/sci/impl/multimethods.cljc +++ b/src/sci/impl/multimethods.cljc @@ -2,11 +2,11 @@ {:no-doc true} (:refer-clojure :exclude [defmulti defmethod]) (:require - #?(:clj [clojure.string :as str]) + #?@(:cljs [] :default [[clojure.string :as str]]) [sci.ctx-store :as store] [sci.impl.hierarchies :refer [global-hierarchy]])) -#?(:clj (set! *warn-on-reflection* true)) +#?(:cljs nil :default (set! *warn-on-reflection* true)) (defn ^:private check-valid-options "Throws an exception if the given option map contains keys not listed @@ -18,7 +18,8 @@ (map #(str ", " %) (rest valid-keys)))] (throw #?(:clj (IllegalArgumentException. ^String message) - :cljs (js/Error. ^string message)))))) + :cljs (js/Error. ^string message) + :cljr (InvalidOperationException. ^String message)))))) (defn defmulti "Creates a new multimethod with the associated dispatch function. @@ -67,45 +68,47 @@ m) mm-name (with-meta mm-name m)] (when (= (count options) 1) - (throw (new #?(:clj Exception :cljs js/Error) + (throw (new #?(:cljs js/Error :default Exception) "The syntax for defmulti has changed. Example: (defmulti name dispatch-fn :default dispatch-value)"))) (let [options (apply hash-map options) default (get options :default :default) hierarchy (get options :hierarchy (global-hierarchy))] (check-valid-options options :default :hierarchy) - #?(:clj `(let [v# (def ~mm-name)] - (when-not (and (clojure.core/has-root-impl v#) (clojure.core/multi-fn?-impl (deref v#))) - (def ~mm-name - (clojure.core/multi-fn-impl ~(name mm-name) ~dispatch-fn ~default ~hierarchy)))) - :cljs `(defonce ~(with-meta mm-name m) + #?(:cljs `(defonce ~(with-meta mm-name m) (let [method-table# (atom {}) prefer-table# (atom {}) method-cache# (atom {}) cached-hierarchy# (atom {})] (clojure.core/multi-fn-impl ~(symbol (name mm-name)) ~dispatch-fn ~default ~hierarchy - method-table# prefer-table# method-cache# cached-hierarchy#))))))) + method-table# prefer-table# method-cache# cached-hierarchy#))) + :default `(let [v# (def ~mm-name)] + (when-not (and (clojure.core/has-root-impl v#) (clojure.core/multi-fn?-impl (deref v#))) + (def ~mm-name + (clojure.core/multi-fn-impl ~(name mm-name) ~dispatch-fn ~default ~hierarchy)))))))) (defn multi-fn?-impl [x] - (instance? #?(:clj clojure.lang.MultiFn - :cljs cljs.core/MultiFn) x)) + (instance? #?(:cljs cljs.core/MultiFn + :default clojure.lang.MultiFn) x)) -(defn multi-fn-impl #?(:clj [name dispatch-fn default hierarchy] - :cljs [name dispatch-fn default hierarchy - method-table prefer-table method-cache cached-hierarchy]) - (new #?(:clj clojure.lang.MultiFn - :cljs cljs.core/MultiFn) name dispatch-fn default hierarchy +(defn multi-fn-impl #?(:cljs [name dispatch-fn default hierarchy + method-table prefer-table method-cache cached-hierarchy] + :default [name dispatch-fn default hierarchy]) + (new #?(:cljs cljs.core/MultiFn + :default clojure.lang.MultiFn) name dispatch-fn default hierarchy #?@(:cljs [method-table prefer-table method-cache cached-hierarchy]))) (defn multi-fn-add-method-impl [multifn dispatch-val f] - #?(:clj (.addMethod ^clojure.lang.MultiFn multifn dispatch-val f) - :cljs (-add-method multifn dispatch-val f))) + #?(:cljs (-add-method multifn dispatch-val f) + :default (.addMethod ^clojure.lang.MultiFn multifn dispatch-val f))) (defn defmethod "Creates and installs a new method of multimethod associated with dispatch-value. " [_x _y multifn dispatch-val & fn-tail] - #?(:clj + #?(:cljs + (list 'clojure.core/multi-fn-add-method-impl multifn dispatch-val (list* 'fn fn-tail)) + :default (let [multifn-str (str multifn)] (if (or (str/ends-with? multifn-str "print-method") (str/ends-with? multifn-str "simple-dispatch")) @@ -126,6 +129,4 @@ (alter-meta! (:sci.impl/var m#) assoc :sci.impl/print-method (fn ~@fn-tail)) :else (clojure.core/multi-fn-add-method-impl ~multifn ~dispatch-val (fn ~@fn-tail)))) (clojure.core/multi-fn-add-method-impl ~multifn ~dispatch-val (fn ~@fn-tail)))) - `(clojure.core/multi-fn-add-method-impl ~multifn ~dispatch-val (fn ~@fn-tail)))) - :cljs - (list 'clojure.core/multi-fn-add-method-impl multifn dispatch-val (list* 'fn fn-tail)))) + `(clojure.core/multi-fn-add-method-impl ~multifn ~dispatch-val (fn ~@fn-tail)))))) diff --git a/src/sci/impl/namespaces.cljc b/src/sci/impl/namespaces.cljc index ad633bb8..bfff0458 100644 --- a/src/sci/impl/namespaces.cljc +++ b/src/sci/impl/namespaces.cljc @@ -16,18 +16,18 @@ exists?]) (:require #?(:clj [borkdude.graal.locking]) - #?(:clj [clojure.edn :as edn] - :cljs [cljs.reader :as edn]) + #?(:cljs [cljs.reader :as edn] + :default [clojure.edn :as edn]) #?(:clj [clojure.java.io :as jio]) - #?(:clj [sci.impl.proxy :as proxy]) - #?(:clj [sci.impl.copy-vars :refer [copy-core-var copy-var macrofy new-var avoid-method-too-large]] - :cljs [sci.impl.copy-vars :refer [new-var]]) + #?@(:cljs [] :default [[sci.impl.proxy :as proxy]]) + #?(:cljs [sci.impl.copy-vars :refer [new-var]] + :default [sci.impl.copy-vars :refer [copy-core-var copy-var macrofy new-var avoid-method-too-large]]) #?(:cljs [sci.impl.resolve]) [clojure.set :as set] [clojure.string :as str] [clojure.walk :as walk] [sci.ctx-store :as store] - [sci.impl.cljs] + #?@(:cljr [] :default [sci.impl.cljs]) [sci.impl.core-protocols :as core-protocols] [sci.impl.deftype :as deftype] [sci.impl.destructure :as destructure] @@ -52,18 +52,20 @@ #?(:cljs (:require-macros [sci.impl.copy-vars :refer [copy-var copy-core-var macrofy avoid-method-too-large]]))) -#?(:clj (set! *warn-on-reflection* true)) +#?(:cljs nil :default (set! *warn-on-reflection* true)) (def clojure-core-ns sci.impl.utils/clojure-core-ns) -#?(:clj (defn -locking-impl [lockee lock-fn] - (borkdude.graal.LockFix/lock lockee lock-fn))) +#?(:cljs nil :default + (defn -locking-impl [lockee lock-fn] + #?(:clj (borkdude.graal.LockFix/lock lockee lock-fn) + :default (throw (ex-info (str "TODO " `-locking-impl) {}))))) (defn locking* [_form _bindings - #?(:clj x :cljs _x) & body] - #?(:clj `(let [lockee# ~x] - (clojure.core/-locking-impl lockee# (^{:once true} fn* [] ~@body))) - :cljs `(do ~@body))) + #?(:cljs _x :default x) & body] + #?(:cljs `(do ~@body) + :default `(let [lockee# ~x] + (clojure.core/-locking-impl lockee# (^{:once true} fn* [] ~@body))))) (defn ->* [_ _ x & forms] @@ -146,7 +148,8 @@ (if (next clauses) (second clauses) (throw (new #?(:clj IllegalArgumentException - :cljs js/Error) + :cljs js/Error + :cljr InvalidOperationException) "cond requires an even number of forms"))) (cons 'clojure.core/cond (next (next clauses)))))) @@ -256,20 +259,22 @@ [_ _ & names] `(do ~@(map #(list 'def (vary-meta % assoc :declared true)) names))) (def ex-message - (if-let [v (resolve 'clojure.core/ex-message)] - @v - (fn ex-message [ex] - (when (instance? #?(:clj Throwable :cljs js/Error) ex) - #?(:clj (.getMessage ^Throwable ex) - :cljs (.-message ex)))))) + #?(:cljr clojure.core/ex-message + :default (if-let [v (resolve 'clojure.core/ex-message)] + @v + (fn ex-message [ex] + (when (instance? #?(:clj Throwable :cljs js/Error) ex) + #?(:clj (.getMessage ^Throwable ex) + :cljs (.-message ex))))))) (def ex-cause - (if-let [v (resolve 'clojure.core/ex-cause)] - @v - (fn ex-message [ex] - (when (instance? #?(:clj Throwable :cljs ExceptionInfo) ex) - #?(:clj (.getCause ^Throwable ex) - :cljs (.-cause ex)))))) + #?(:cljr clojure.core/ex-cause + :default (if-let [v (resolve 'clojure.core/ex-cause)] + @v + (fn ex-message [ex] + (when (instance? #?(:clj Throwable :cljs ExceptionInfo) ex) + #?(:clj (.getCause ^Throwable ex) + :cljs (.-cause ex))))))) (def assert-var (sci.impl.utils/dynamic-var '*assert* true {:ns clojure-core-ns})) @@ -277,11 +282,11 @@ ([_&form _ x] (when @assert-var `(when-not ~x - (throw (#?(:clj AssertionError. :cljs js/Error.) (str "Assert failed: " (pr-str '~x))))))) + (throw (#?(:cljs js/Error. :default AssertionError.) (str "Assert failed: " (pr-str '~x))))))) ([_&form _ x message] (when @assert-var `(when-not ~x - (throw (#?(:clj AssertionError. :cljs js/Error.) (str "Assert failed: " ~message "\n" (pr-str '~x)))))))) + (throw (#?(:cljs js/Error. :default AssertionError.) (str "Assert failed: " ~message "\n" (pr-str '~x)))))))) (defn areduce* [_ _ a idx ret init expr] `(let [a# ~a l# (alength a#)] @@ -309,9 +314,10 @@ (with-open ~(subvec bindings 2) ~@body) (finally (.close ~(bindings 0))))) - :else #?(:clj (throw (IllegalArgumentException. - "with-open only allows Symbols in bindings")) - :cljs ::TODO))) + :else (throw (new #?(:clj IllegalArgumentException + :cljs js/Error + :cljr InvalidOperationException) + "with-open only allows Symbols in bindings")))) (defn letfn* [_ _ fnspecs & body] (let [syms (map first fnspecs)] @@ -359,8 +365,8 @@ (defn delay* [_ _ & body] - #?(:clj `(new clojure.lang.Delay (fn [] ~@body)) - :cljs `(new cljs.core/Delay (fn [] ~@body)))) + #?(:cljs `(new cljs.core/Delay (fn [] ~@body)) + :default `(new clojure.lang.Delay (fn [] ~@body)))) (defn defn-* [_ _ name & decls] @@ -376,7 +382,8 @@ n (count clause)] (cond (= 0 n) `(throw (new #?(:clj IllegalArgumentException - :cljs js/Error) + :cljs js/Error + :cljr InvalidOperationException) (str "No matching clause: " ~expr))) (= 1 n) a (= 2 n) `(if (~pred ~a ~expr) @@ -438,10 +445,10 @@ (sci.impl.utils/set-namespace! (store/get-ctx) ns-sym {})) (defn sci-the-ns* [ctx x] - (if (instance? #?(:clj sci.lang.Namespace - :cljs sci.lang/Namespace) x) x + (if (instance? #?(:cljs sci.lang/Namespace + :default sci.lang.Namespace) x) x (or (sci-find-ns* ctx x) - (throw (new #?(:clj Exception :cljs js/Error) + (throw (new #?(:clj Exception :cljs js/Error :cljr InvalidOperationException) (str "No namespace: " x " found")))))) (defn sci-the-ns [x] @@ -650,7 +657,8 @@ (require* sci-ctx namespace) (sci-resolve* sci-ctx sym))) (throw (new #?(:clj IllegalArgumentException - :cljs js/Error) + :cljs js/Error + :cljr InvalidOperationException) (str "Not a qualified symbol: " sym)))))) (defn sci-find-var [sym] @@ -660,10 +668,12 @@ (if-let [namespace (-> (store/get-ctx) :env deref :namespaces (get nsname))] (get namespace sym') (throw (new #?(:clj IllegalArgumentException - :cljs js/Error) + :cljs js/Error + :cljr InvalidOperationException) (str "No such namespace: " nsname))))) (throw (new #?(:clj IllegalArgumentException - :cljs js/Error) + :cljs js/Error + :cljr InvalidOperationException) (str "Not a qualified symbol: " sym))))) ;;;; End require + resolve @@ -779,7 +789,7 @@ ;;;; -#?(:clj +#?(:cljs nil :default (def clojure-lang {:private true :obj (sci.lang/->Namespace 'clojure.lang nil) @@ -798,7 +808,7 @@ ;;;; Record impl (defn -create-type [data] - (new sci.lang.Type data nil nil)) + (new #?(:cljr sci.lang.SciCustomType :default sci.lang.Type) data nil nil)) #_(defn -reg-key! [rec-type k v] (when (instance? sci.lang.Type rec-type) @@ -818,7 +828,7 @@ {:obj (sci.lang/->Namespace 'sci.impl.deftype nil) :private true 'toString sci.impl.deftype/to-string - #?@(:clj ['equals sci.impl.deftype/equals]) + #?@(:cljs [] :default ['equals sci.impl.deftype/equals]) '-create-type -create-type '->type-impl sci.impl.deftype/->type-impl '-inner-impl sci.impl.types/getVal @@ -877,43 +887,47 @@ (.createAsIfByAssoc PersistentArrayMap (to-array s)) (if (seq s) (first s) (.-EMPTY PersistentArrayMap)))))) -#?(:clj (def clojure-version-var - (sci.impl.utils/dynamic-var - '*clojure-version* (update clojure.core/*clojure-version* - :qualifier (fn [qualifier] - (if qualifier - (str qualifier "-SCI") - "SCI"))) - {:ns clojure-core-ns - :doc "The version info for Clojure core, as a map containing :major :minor \n :incremental and :qualifier keys. Feature releases may increment \n :minor and/or :major, bugfix releases will increment :incremental. \n Possible values of :qualifier include \"GA\", \"SNAPSHOT\", \"RC-x\" \"BETA-x\""}))) - -#?(:clj (defn - clojure-version - "Returns clojure version as a printable string." - [] - (let [*clojure-version* @clojure-version-var] - (str (:major *clojure-version*) - "." - (:minor *clojure-version*) - (when-let [i (:incremental *clojure-version*)] - (str "." i)) - (when-let [q (:qualifier *clojure-version*)] - (when (pos? (count q)) (str "-" q))) - (when (:interim *clojure-version*) - "-SNAPSHOT"))))) - -#?(:clj +#?(:cljs nil :default + (def clojure-version-var + (sci.impl.utils/dynamic-var + '*clojure-version* (update clojure.core/*clojure-version* + :qualifier (fn [qualifier] + (if qualifier + (str qualifier "-SCI") + "SCI"))) + {:ns clojure-core-ns + :doc "The version info for Clojure core, as a map containing :major :minor \n :incremental and :qualifier keys. Feature releases may increment \n :minor and/or :major, bugfix releases will increment :incremental. \n Possible values of :qualifier include \"GA\", \"SNAPSHOT\", \"RC-x\" \"BETA-x\""}))) + +#?(:cljs nil :default + (defn + clojure-version + "Returns clojure version as a printable string." + [] + (let [*clojure-version* @clojure-version-var] + (str (:major *clojure-version*) + "." + (:minor *clojure-version*) + (when-let [i (:incremental *clojure-version*)] + (str "." i)) + (when-let [q (:qualifier *clojure-version*)] + (when (pos? (count q)) (str "-" q))) + (when (:interim *clojure-version*) + "-SNAPSHOT"))))) + +#?(:cljs nil :default (defmulti print-method (fn [x _w] (type x)) :hierarchy (reify clojure.lang.IRef - (deref [_] (throw (java.lang.SecurityException. + (deref [_] (throw (#?(:clj java.lang.SecurityException. + :cljr System.Security.SecurityException.) "Print-method is not allowed by default since it mutates the global runtime. Add it to SCI ctx via {:namespaces {'clojure.core print-method}}")))))) -#?(:clj +#?(:cljs nil :default (defmulti print-dup (fn [x _w] (class x)) :hierarchy (reify clojure.lang.IRef - (deref [_] (throw (java.lang.SecurityException. + (deref [_] (throw (#?(:clj java.lang.SecurityException. + :cljr System.Security.SecurityException.) "Print-dup is not allowed by default since it mutates the global runtime. Add it to SCI ctx via {:namespaces {'clojure.core print-dup}}")))))) #?(:cljs @@ -984,7 +998,7 @@ (defn loaded-libs** [syms] (utils/dynamic-var - '*loaded-libs* (#?(:clj ref :cljs atom) + '*loaded-libs* (#?(:cljs atom :default ref) (into (sorted-set) syms)) {:doc "A ref to a sorted set of symbols representing loaded libs" @@ -1042,8 +1056,8 @@ (defn lazy-seq* [_ _ & body] - #?(:clj (list 'new 'clojure.lang.LazySeq (list* '^{:once true} fn* [] body)) - :cljs `(new cljs.core/LazySeq nil (fn [] ~@body) nil nil))) + #?(:cljs `(new cljs.core/LazySeq nil (fn [] ~@body) nil nil) + :default (list 'new 'clojure.lang.LazySeq (list* '^{:once true} fn* [] body)))) (defn time "Evaluates expr and prints the time it took. Returns the value of expr." @@ -1051,8 +1065,8 @@ `(let [start# (clojure.core/system-time) ret# ~expr] (prn (str "Elapsed time: " - #?(:clj (/ (double (- (clojure.core/system-time) start#)) 1000000.0) - :cljs (.toFixed (- (clojure.core/system-time) start#) 6)) + #?(:cljs (.toFixed (- (clojure.core/system-time) start#) 6) + :default (/ (double (- (clojure.core/system-time) start#)) 1000000.0)) " msecs")) ret#)) @@ -1082,26 +1096,31 @@ `(some? ~x))))) #?(:clj (defn system-time [] - (System/nanoTime))) - -#?(:clj + (System/nanoTime)) + :cljr (defn system-time [] + (let [ticks (System.Diagnostics.Stopwatch/GetTimestamp) + freq (double (.Frequency System.Diagnostics.Stopwatch))] + (long (* 1e9 (/ ticks freq)))))) + +#?(:cljs nil + :default (do (set! *warn-on-reflection* false) (defn reflective-aset [arr idx val] (clojure.lang.RT/aset arr idx val)) (set! *warn-on-reflection* true))) -#?(:clj (defn aset* - "Sets the value at the index/indices. Works on Java arrays of - reference types. Returns val." - ([arr idx val] - (let [ctype (.getComponentType (class arr)) - prim? (.isPrimitive ctype)] - (if prim? - (reflective-aset arr idx val) - (aset ^objects arr idx val)))) - ([arr idx idx2 & idxv] - (apply aset* (aget ^objects arr idx) idx2 idxv)))) +#?(:cljs nil + :default (defn aset* + "Sets the value at the index/indices. Works on Java arrays of + reference types. Returns val." + ([arr idx val] + (let [ctype (#?(:clj .getComponentType :cljr .GetElementType) (class arr))] + (if (#?(:clj .isPrimitive :cljr .IsPrimitive) ctype) + (reflective-aset arr idx val) + (aset ^objects arr idx val)))) + ([arr idx idx2 & idxv] + (apply aset* (aget ^objects arr idx) idx2 idxv)))) (defn eval* [form] (let [ctx (store/get-ctx)] @@ -1137,14 +1156,14 @@ 'println-str (copy-core-var sci.impl.io/println-str) 'pr-str (copy-core-var sci.impl.io/pr-str) 'prn-str (copy-core-var sci.impl.io/prn-str) - 'print-str (copy-core-var #?(:cljs sci.impl.io/print-str :clj print-str)) - #?@(:clj ['print-method (copy-core-var print-method)]) - #?@(:clj ['print-dup (copy-core-var print-dup)]) - #?@(:clj ['printf (copy-core-var sci.impl.io/printf)]) - #?@(:clj ['print-simple (copy-core-var sci.impl.io/print-simple)]) + 'print-str (copy-core-var #?(:cljs sci.impl.io/print-str :default print-str)) + #?@(:cljs [] :default ['print-method (copy-core-var print-method)]) + #?@(:cljs [] :default ['print-dup (copy-core-var print-dup)]) + #?@(:cljs [] :default ['printf (copy-core-var sci.impl.io/printf)]) + #?@(:cljs [] :default ['print-simple (copy-core-var sci.impl.io/print-simple)]) 'with-out-str (macrofy 'with-out-str sci.impl.io/with-out-str) - #?@(:clj ['with-in-str (macrofy 'with-in-str sci.impl.io/with-in-str) - 'read-line (copy-core-var sci.impl.io/read-line)]) + #?@(:cljs [] :default ['with-in-str (macrofy 'with-in-str sci.impl.io/with-in-str) + 'read-line (copy-core-var sci.impl.io/read-line)]) ;; end io ;; read '*data-readers* parser/data-readers @@ -1154,8 +1173,8 @@ '*suppress-read* parser/suppress-read 'read (copy-var read clojure-core-ns {:copy-meta-from 'clojure.core/read}) 'read-string (copy-var read-string clojure-core-ns {:copy-meta-from 'clojure.core/read-string}) - #?@(:clj ['reader-conditional (copy-core-var reader-conditional)]) - #?@(:clj ['reader-conditional? (copy-core-var reader-conditional?)]) + #?@(:cljs [] :default ['reader-conditional (copy-core-var reader-conditional)]) + #?@(:cljs [] :default ['reader-conditional? (copy-core-var reader-conditional?)]) ;; end read ;; REPL variables '*1 *1 @@ -1164,10 +1183,10 @@ '*e *e ;; end REPL variables ;; clojure dynamic vars - #?@(:clj ['*clojure-version* clojure-version-var - 'clojure-version (copy-core-var clojure-version) - '*warn-on-reflection* utils/warn-on-reflection-var - '*unchecked-math* utils/unchecked-math-var]) + #?@(:cljs [] :default ['*clojure-version* clojure-version-var + 'clojure-version (copy-core-var clojure-version) + '*warn-on-reflection* utils/warn-on-reflection-var + '*unchecked-math* utils/unchecked-math-var]) ;; end clojure dynamic vars ;; multimethods 'defmulti (macrofy 'defmulti sci.impl.multimethods/defmulti clojure-core-ns) @@ -1193,8 +1212,8 @@ 'reify* (new-var 'reify* reify/reify* clojure-core-ns) 'reify (macrofy 'reify reify/reify clojure-core-ns) 'protocol-type-impl (new-var 'protocol-type-impl types/type-impl) - #?@(:clj ['proxy* (new-var 'proxy* proxy/proxy*) - 'proxy (macrofy 'proxy proxy/proxy clojure-core-ns)]) + #?@(:cljs [] :default ['proxy* (new-var 'proxy* proxy/proxy*) + 'proxy (macrofy 'proxy proxy/proxy clojure-core-ns)]) 'satisfies? (copy-var sci.impl.protocols/satisfies? clojure-core-ns {:name 'satisfies?}) ;; end protocols ;; IDeref as protocol @@ -1204,15 +1223,15 @@ ;; end IDeref as protocol ;; IAtom / ISwap as protocol 'swap! (copy-var core-protocols/swap!* clojure-core-ns {:name 'swap!}) - 'compare-and-set! #?(:clj (copy-var core-protocols/compare-and-set!* clojure-core-ns {:name 'compare-and-set!}) - :cljs (copy-core-var compare-and-set!)) + 'compare-and-set! #?(:cljs (copy-core-var compare-and-set!) + :default (copy-var core-protocols/compare-and-set!* clojure-core-ns {:name 'compare-and-set!})) #?@(:cljs ['IReset core-protocols/reset-protocol 'ISwap core-protocols/swap-protocol '-swap! (new-var '-swap! core-protocols/-swap!) '-reset! (new-var '-reset! core-protocols/-reset!)]) ;; in CLJS swap-vals! and reset-vals! are going through the other protocols - #?@(:clj ['swap-vals! (copy-var core-protocols/swap-vals!* clojure-core-ns {:name 'swap-vals!}) - 'reset-vals! (copy-var core-protocols/reset-vals!* clojure-core-ns {:name 'reset-vals!})]) + #?@(:cljs [] :default ['swap-vals! (copy-var core-protocols/swap-vals!* clojure-core-ns {:name 'swap-vals!}) + 'reset-vals! (copy-var core-protocols/reset-vals!* clojure-core-ns {:name 'reset-vals!})]) #?@(:cljs ['IRecord (utils/new-var 'IRecord {:protocol IRecord :ns clojure-core-ns} {:ns clojure-core-ns})]) @@ -1255,20 +1274,21 @@ 'amap (macrofy 'amap amap*) 'ancestors (copy-var hierarchies/ancestors* clojure-core-ns {:name 'ancestors}) 'and (macrofy 'and and*) - #?@(:clj ['aset (copy-var aset* clojure-core-ns {:name 'aset})] - :default ['aset (copy-core-var aset)]) - #?@(:clj ['aset-boolean (copy-core-var aset-boolean) - 'aset-byte (copy-core-var aset-byte) - 'aset-char (copy-core-var aset-char) - 'aset-double (copy-core-var aset-double) - 'aset-float (copy-core-var aset-float) - 'aset-int (copy-core-var aset-int) - 'aset-long (copy-core-var aset-long) - 'aset-short (copy-core-var aset-short)]) - 'alength #?(:clj (copy-var alength clojure-core-ns {:inlined - (fn [arr] - (java.lang.reflect.Array/getLength arr))}) - :cljs (copy-core-var alength)) + #?@(:cljs ['aset (copy-core-var aset)] + :default ['aset (copy-var aset* clojure-core-ns {:name 'aset})]) + #?@(:cljs [] :default ['aset-boolean (copy-core-var aset-boolean) + 'aset-byte (copy-core-var aset-byte) + 'aset-char (copy-core-var aset-char) + 'aset-double (copy-core-var aset-double) + 'aset-float (copy-core-var aset-float) + 'aset-int (copy-core-var aset-int) + 'aset-long (copy-core-var aset-long) + 'aset-short (copy-core-var aset-short)]) + 'alength #?(:cljs (copy-core-var alength) + :default (copy-var alength clojure-core-ns {:inlined + (fn [arr] + #?(:clj (java.lang.reflect.Array/getLength arr) + :default (. clojure.lang.RT (alength arr))))})) 'any? (copy-core-var any?) 'apply (copy-core-var apply) 'areduce (macrofy 'areduce areduce*) @@ -1286,7 +1306,7 @@ 'binding (macrofy 'binding sci-binding) 'binding-conveyor-fn (copy-core-var sci.impl.vars/binding-conveyor-fn) 'bit-and-not (copy-core-var bit-and-not) - #?@(:clj ['bit-clear (copy-core-var bit-clear)]) + #?@(:cljs [] :default ['bit-clear (copy-core-var bit-clear)]) 'bit-set (copy-core-var bit-set) 'bit-shift-left (copy-core-var bit-shift-left) 'bit-shift-right (copy-core-var bit-shift-right) @@ -1310,7 +1330,7 @@ 'case (macrofy 'case case**) 'char (copy-core-var char) 'char? (copy-core-var char?) - #?@(:clj ['class? (copy-core-var class?)]) + #?@(:cljs [] :default ['class? (copy-core-var class?)]) #?@(:cljs ['clj->js (copy-core-var clj->js)]) 'cond (macrofy 'cond cond*) 'cond-> (macrofy 'cond-> cond->*) @@ -1352,7 +1372,7 @@ clojure-core-ns) 'delay (macrofy 'delay delay*) 'delay? (copy-core-var delay?) - #?@(:clj ['deliver (copy-core-var deliver)]) + #?@(:cljs [] :default ['deliver (copy-core-var deliver)]) #?@(:cljs ['demunge (copy-core-var cljs.core/demunge)]) 'derive (copy-var hierarchies/derive* clojure-core-ns {:name 'derive}) 'descendants (copy-var hierarchies/descendants* clojure-core-ns {:name 'descendants}) @@ -1379,7 +1399,7 @@ '->Eduction (copy-core-var ->Eduction) 'empty (copy-core-var empty) 'empty? (copy-core-var empty?) - #?@(:clj ['enumeration-seq (copy-core-var enumeration-seq)]) + #?@(:cljs [] :default ['enumeration-seq (copy-core-var enumeration-seq)]) 'eval (copy-var eval* clojure-core-ns {:copy-meta-from 'clojure.core/eval}) 'even? (copy-core-var even?) 'every? (copy-core-var every?) @@ -1414,7 +1434,7 @@ 'force (copy-core-var force) 'get (copy-core-var get) 'get-thread-binding-frame-impl (new-var 'get-thread-binding-frame-impl sci.impl.vars/get-thread-binding-frame) - #?@(:clj ['get-thread-bindings (copy-var sci.impl.vars/get-thread-bindings clojure-core-ns {:name 'get-thread-bindings})]) + #?@(:cljs [] :default ['get-thread-bindings (copy-var sci.impl.vars/get-thread-bindings clojure-core-ns {:name 'get-thread-bindings})]) 'get-in (copy-core-var get-in) 'group-by (copy-core-var group-by) 'gensym (copy-core-var gensym) @@ -1441,7 +1461,7 @@ 'intern (copy-var sci-intern clojure-core-ns {:name 'intern}) 'into (copy-core-var into) 'iterate (copy-core-var iterate) - #?@(:clj ['iterator-seq (copy-core-var iterator-seq)]) + #?@(:cljs [] :default ['iterator-seq (copy-core-var iterator-seq)]) 'int (copy-core-var int) 'int? (copy-core-var int?) 'interpose (copy-core-var interpose) @@ -1543,7 +1563,7 @@ 'partition-all (copy-core-var partition-all) 'partition-by (copy-core-var partition-by) 'persistent! (copy-core-var persistent!) - #?@(:clj ['promise (copy-core-var promise)]) + #?@(:cljs [] :default ['promise (copy-core-var promise)]) 'push-thread-bindings (copy-var sci.impl.vars/push-thread-bindings clojure-core-ns {:name 'push-thread-bindings}) 'qualified-ident? (copy-core-var qualified-ident?) 'qualified-symbol? (copy-core-var qualified-symbol?) @@ -1554,9 +1574,9 @@ 'refer (copy-var sci-refer clojure-core-ns {:name 'refer}) 'refer-clojure (macrofy 'refer-clojure sci-refer-clojure) 're-find (copy-core-var re-find) - #?@(:clj ['re-groups (copy-core-var re-groups)]) + #?@(:cljs [] :default ['re-groups (copy-core-var re-groups)]) 're-pattern (copy-core-var re-pattern) - #?@(:clj ['re-matcher (copy-core-var re-matcher)]) + #?@(:cljs [] :default ['re-matcher (copy-core-var re-matcher)]) 're-matches (copy-core-var re-matches) 'realized? (copy-core-var realized?) 'rem (copy-core-var rem) @@ -1591,7 +1611,7 @@ 'set? (copy-core-var set?) 'sequential? (copy-core-var sequential?) 'select-keys (copy-core-var select-keys) - #?@(:clj ['short-array (copy-core-var short-array)]) + #?@(:cljs [] :default ['short-array (copy-core-var short-array)]) 'simple-keyword? (copy-core-var simple-keyword?) 'simple-symbol? (copy-core-var simple-symbol?) 'some? (copy-core-var some?) @@ -1614,11 +1634,10 @@ 'thread-bound? (copy-var sci-thread-bound? clojure-core-ns {:name 'thread-bound?}) 'time (copy-var time clojure-core-ns {:macro true}) 'subs (copy-core-var subs) - #?@(:clj ['supers (copy-core-var supers)]) + #?@(:cljs [] :default ['supers (copy-core-var supers)]) 'symbol (copy-var symbol* clojure-core-ns {:name 'symbol}) 'symbol? (copy-core-var symbol?) - 'system-time (copy-var #?(:clj system-time - :cljs system-time) clojure-core-ns) + 'system-time (copy-var system-time clojure-core-ns) 'special-symbol? (copy-core-var special-symbol?) 'subvec (copy-core-var subvec) 'some-fn (copy-core-var some-fn) @@ -1715,36 +1734,36 @@ #?@(:cljs ['-write (copy-var -write clojure-core-ns)]) 'locking (macrofy 'locking locking*) - #?@(:clj ['-locking-impl (copy-var -locking-impl clojure-core-ns)]) - #?@(:clj ['+' (copy-core-var +') - '-' (copy-core-var -') - '*' (copy-core-var *') - 'boolean-array (copy-core-var boolean-array) - 'byte-array (copy-core-var byte-array) - 'bigint (copy-core-var bigint) - 'bytes? (copy-core-var bytes?) - 'biginteger (copy-core-var biginteger) - 'bigdec (copy-core-var bigdec) - 'char-array (copy-core-var char-array) - 'char-escape-string (copy-core-var char-escape-string) - 'char-name-string (copy-core-var char-name-string) - 'class (copy-core-var class) - 'dec' (copy-core-var dec') - 'decimal? (copy-core-var decimal?) - 'denominator (copy-core-var denominator) - 'format (copy-core-var format) - 'float-array (copy-core-var float-array) - 'inc' (copy-core-var inc') - 'line-seq (copy-core-var line-seq) - 'num (copy-core-var num) - 'namespace-munge (copy-core-var namespace-munge) - 'numerator (copy-core-var numerator) - 'replicate (copy-core-var replicate) - 'rational? (copy-core-var rational?) - 'ratio? (copy-core-var ratio?) - 'rationalize (copy-core-var rationalize) - 'seque (copy-core-var seque) - 'xml-seq (copy-core-var xml-seq)])})) + #?@(:cljs [] :default ['-locking-impl (copy-var -locking-impl clojure-core-ns)]) + #?@(:cljs [] :default ['+' (copy-core-var +') + '-' (copy-core-var -') + '*' (copy-core-var *') + 'boolean-array (copy-core-var boolean-array) + 'byte-array (copy-core-var byte-array) + 'bigint (copy-core-var bigint) + 'bytes? (copy-core-var bytes?) + 'biginteger (copy-core-var biginteger) + 'bigdec (copy-core-var bigdec) + 'char-array (copy-core-var char-array) + 'char-escape-string (copy-core-var char-escape-string) + 'char-name-string (copy-core-var char-name-string) + 'class (copy-core-var class) + 'dec' (copy-core-var dec') + 'decimal? (copy-core-var decimal?) + 'denominator (copy-core-var denominator) + 'format (copy-core-var format) + 'float-array (copy-core-var float-array) + 'inc' (copy-core-var inc') + 'line-seq (copy-core-var line-seq) + 'num (copy-core-var num) + 'namespace-munge (copy-core-var namespace-munge) + 'numerator (copy-core-var numerator) + 'replicate (copy-core-var replicate) + 'rational? (copy-core-var rational?) + 'ratio? (copy-core-var ratio?) + 'rationalize (copy-core-var rationalize) + #?@(:cljr [] :default ['seque (copy-core-var seque)]) + 'xml-seq (copy-core-var xml-seq)])})) (defn dir-fn [ns] @@ -1805,9 +1824,10 @@ str-or-pattern." [str-or-pattern] (let [ctx (store/get-ctx) - matches? (if (instance? #?(:clj java.util.regex.Pattern :cljs js/RegExp) str-or-pattern) + matches? (if (instance? #?(:clj java.util.regex.Pattern :cljs js/RegExp :cljr System.Text.RegularExpressions.Regex) + str-or-pattern) #(re-find str-or-pattern (str %)) - #(clojure.string/includes? (str %) (str str-or-pattern)))] + #(str/includes? (str %) (str str-or-pattern)))] (sort (mapcat (fn [ns] (let [ns-name (str ns)] (map #(symbol ns-name (str %)) @@ -1849,18 +1869,20 @@ Example: (source-fn 'filter)" [x] (let [ctx (store/get-ctx)] - (when-let [ - v (sci-resolve* ctx x)] - (let [{:keys [#?(:clj :file) :line :ns]} (meta v)] + (when-let [v (sci-resolve* ctx x)] + (let [{:keys [#?@(:cljs [] :default [file]) line ns]} (meta v)] (when (and line ns) - (when-let [source (or #?(:clj (when file - (let [f (jio/file file)] - (when (.exists f) (slurp f))))) + (when-let [source (or #?@(:cljs [] + :clj [(when-some [f (some-> file jio/file)] + (when (.exists f) + (slurp f)))] + :cljr [(when (some-> file System.IO.File/Exists) + (slurp file))]) (when-let [load-fn (:load-fn @(:env ctx))] (:source (load-fn {:namespace (types/getName ns)}))))] - (let [lines (clojure.string/split source #"\n") + (let [lines (str/split source #"\n") line (dec line) - start (clojure.string/join "\n" (drop line lines)) + start (str/join "\n" (drop line lines)) reader (read/source-logging-reader start) res (parser/parse-next ctx reader {:source true})] (:source (meta res))))))))) @@ -1874,21 +1896,25 @@ [_ _ n] `(println (or (~'clojure.repl/source-fn '~n) (str "Source not found")))) - #?(:clj + #?(:cljs nil :default (defn root-cause "Returns the initial cause of an exception or error by peeling off all of its wrappers" {:added "1.3"} - [^Throwable t] + [t] (loop [cause t] - (if (and (instance? clojure.lang.Compiler$CompilerException cause) - (not= (.source ^clojure.lang.Compiler$CompilerException cause) "NO_SOURCE_FILE")) + (if (and (instance? #?(:clj clojure.lang.Compiler$CompilerException + :cljr clojure.lang.Compiler+CompilerException) cause) + (not= (.source #?(:clj ^clojure.lang.Compiler$CompilerException cause + :cljr ^clojure.lang.Compiler+CompilerException cause)) + "NO_SOURCE_FILE")) cause - (if-let [cause (.getCause cause)] + (if-let [cause #?(:clj (.getCause ^Throwable cause) + :cljr (.InnerException ^Exception cause))] (recur cause) cause))))) - #?(:clj + #?(:cljs nil :default (defn demunge "Given a string representation of a fn class, as in a stack trace element, returns a readable version." @@ -1896,40 +1922,50 @@ [fn-name] (clojure.lang.Compiler/demunge fn-name))) - #?(:clj + #?(:cljs nil :default (defn stack-element-str "Returns a (possibly unmunged) string representation of a StackTraceElement" {:added "1.3"} - [^StackTraceElement el] - (let [file (.getFileName el) - clojure-fn? (and file (or (.endsWith file ".clj") - (.endsWith file ".cljc") - (= "NO_SOURCE_FILE" file)))] + [#?(:clj ^StackTraceElement el :cljr ^System.Diagnostics.StackFrame el :default el)] + (let [file (#?(:clj .getFileName :cljr .GetFileName) el) + clojure-fn? (and file (or (str/ends-with? file ".clj") + (str/ends-with? file ".cljc") + (= "NO_SOURCE_FILE" file))) + cname #?(:clj (.getClassName el) + :cljr (-> el .GetMethod .DeclaringType .FullName)) + fname #?(:clj (.getFileName el) + :cljr (.GetFileName el)) + line #?(:clj (.getLineNumber el) + :cljr (.GetFileLineNumber el))] (str (if clojure-fn? - (demunge (.getClassName el)) - (str (.getClassName el) "." (.getMethodName el))) - " (" (.getFileName el) ":" (.getLineNumber el) ")")))) + (demunge cname) + (str cname "." #?(:clj (.getMethodName el) + :cljr (-> el .GetMethod .Name)))) + " (" fname ":" line ")")))) - #?(:clj + #?(:cljs nil :default (defn pst "Prints a stack trace of the exception, to the depth requested. If none supplied, uses the root cause of the most recent repl exception (*e), and a depth of 12." {:added "1.3"} ([] (pst 12)) ([e-or-depth] - (if (instance? Throwable e-or-depth) + (if (instance? #?(:clj Throwable :cljr Exception) e-or-depth) (pst e-or-depth 12) (pst (root-cause @*e) e-or-depth))) - ([^Throwable e depth] + ([#?(:clj ^Throwable e :cljr ^Exception e :default e) depth] (sci.impl.vars/with-bindings {sci.impl.io/out @sci.impl.io/err} - (sci.impl.io/println (str (-> e class .getSimpleName) " " - (.getMessage e) + (sci.impl.io/println (str (-> e class #?(:clj .getSimpleName :cljr .Name)) " " + (#?(:clj .getMessage :cljr .Message) e) (when-let [info (ex-data e)] (str " " (pr-str info))))) - (let [st (.getStackTrace e) - cause (.getCause e)] + (let [st #?(:clj (.getStackTrace e) + :cljr (-> e System.Diagnostics.StackTrace. .GetFrames)) + cause (#?(:clj .getCause :cljr .InnerException) e)] (doseq [el (take depth (remove #(#{"clojure.lang.RestFn" "clojure.lang.AFn"} - (.getClassName ^StackTraceElement %)) + #?(:clj (.getClassName ^StackTraceElement %) + :cljr (-> ^System.Diagnostics.StackFrame % + .GetMethod .DeclaringType .FullName))) st))] (sci.impl.io/println (str \tab (stack-element-str el)))) (when cause @@ -1950,9 +1986,10 @@ 'apropos (new-var 'apropos apropos clojure-repl-namespace) 'source (macrofy 'source source clojure-repl-namespace) 'source-fn (new-var 'source-fn source-fn clojure-repl-namespace) - #?@(:clj ['pst (new-var 'pst pst clojure-repl-namespace) - 'stack-element-str (new-var 'stack-element-str stack-element-str clojure-repl-namespace) - 'demunge (new-var 'demunge demunge clojure-repl-namespace)])}) + #?@(:cljs [] + :default ['pst (new-var 'pst pst clojure-repl-namespace) + 'stack-element-str (new-var 'stack-element-str stack-element-str clojure-repl-namespace) + 'demunge (new-var 'demunge demunge clojure-repl-namespace)])}) (defn apply-template [argv expr values] @@ -1999,8 +2036,9 @@ 'walk (copy-var clojure.walk/walk clojure-walk-namespace) 'postwalk (copy-var clojure.walk/postwalk clojure-walk-namespace) 'prewalk (copy-var clojure.walk/prewalk clojure-walk-namespace) - #?@(:clj ['postwalk-demo (copy-var clojure.walk/postwalk-demo clojure-walk-namespace) - 'prewalk-demo (copy-var clojure.walk/prewalk-demo clojure-walk-namespace)]) + #?@(:cljs [] + :default ['postwalk-demo (copy-var clojure.walk/postwalk-demo clojure-walk-namespace) + 'prewalk-demo (copy-var clojure.walk/prewalk-demo clojure-walk-namespace)]) 'keywordize-keys (copy-var clojure.walk/keywordize-keys clojure-walk-namespace) 'stringify-keys (copy-var clojure.walk/stringify-keys clojure-walk-namespace) 'prewalk-replace (copy-var clojure.walk/prewalk-replace clojure-walk-namespace) @@ -2012,6 +2050,7 @@ ) (macros/usetime + ;; TODO :cljr ;; #_#?(:clj (alter-var-root #'clojure-core assoc ;; 'locking (macrofy 'locking locking*) ;; '-locking-impl (copy-var -locking-impl clojure-core-ns)) @@ -2019,7 +2058,7 @@ ;; 'locking (macrofy 'locking locking*)))) (def namespaces - {#?@(:clj ['clojure.lang clojure-lang]) + {#?@(:cljs [] :default ['clojure.lang clojure-lang]) 'clojure.core clojure-core 'clojure.string {:obj clojure-string-namespace 'blank? (copy-var clojure.string/blank? clojure-string-namespace) @@ -2042,7 +2081,7 @@ 'triml (copy-var clojure.string/triml clojure-string-namespace) 'trimr (copy-var clojure.string/trimr clojure-string-namespace) 'upper-case (copy-var clojure.string/upper-case clojure-string-namespace) - #?@(:clj ['re-quote-replacement (copy-var clojure.string/re-quote-replacement clojure-string-namespace)])} + #?@(:cljs [] :default ['re-quote-replacement (copy-var clojure.string/re-quote-replacement clojure-string-namespace)])} 'clojure.set {:obj clojure-set-namespace 'difference (copy-var clojure.set/difference clojure-set-namespace) 'index (copy-var clojure.set/index clojure-set-namespace) @@ -2060,11 +2099,11 @@ 'clojure.template clojure-template 'clojure.repl clojure-repl 'clojure.edn {:obj clojure-edn-namespace - 'read (copy-var #?(:clj clojure.edn/read - :cljs cljs.reader/read) clojure-edn-namespace) + 'read (copy-var #?(:cljs cljs.reader/read + :default clojure.edn/read) clojure-edn-namespace) 'read-string (copy-var - #?(:clj clojure.edn/read-string - :cljs cljs.reader/read-string) clojure-edn-namespace)} + #?(:cljs cljs.reader/read-string + :default clojure.edn/read-string) clojure-edn-namespace)} 'sci.impl.records sci-impl-records 'sci.impl.deftype sci-impl-deftype 'sci.impl.protocols sci-impl-protocols})) diff --git a/src/sci/impl/opts.cljc b/src/sci/impl/opts.cljc index e5cf0199..1c5e7a5b 100644 --- a/src/sci/impl/opts.cljc +++ b/src/sci/impl/opts.cljc @@ -6,10 +6,9 @@ [sci.impl.types] [sci.impl.utils :as utils :refer [strip-core-ns]] [sci.lang]) - #?(:clj (:import - [sci.impl.types IReified]))) + #?@(:cljs [] :default [(:import [sci.impl.types IReified])])) -#?(:clj +#?(:cljs nil :default (defrecord Env [namespaces imports load-fn])) (def namespace-syms (keys namespaces/namespaces)) @@ -43,11 +42,11 @@ #?@(:cljs [js-libs (merge (:js-libs env) js-libs)])] ;; TODO: is the first case ever hit? (if-not env - #?(:clj (->Env namespaces imports load-fn) - :cljs {:namespaces namespaces + #?(:cljs {:namespaces namespaces :imports imports :load-fn load-fn - :async-load-fn async-load-fn}) + :async-load-fn async-load-fn} + :default (->Env namespaces imports load-fn)) (assoc env :namespaces namespaces :imports imports @@ -63,33 +62,50 @@ (not-empty (into prev-perms (comp cat (map strip-core-ns)) permissions))) (def default-classes - #?(:clj {'java.lang.AssertionError AssertionError - 'java.lang.Exception {:class Exception} - 'java.lang.IllegalArgumentException java.lang.IllegalArgumentException - 'clojure.lang.Delay clojure.lang.Delay - 'clojure.lang.ExceptionInfo clojure.lang.ExceptionInfo - 'clojure.lang.LineNumberingPushbackReader clojure.lang.LineNumberingPushbackReader - 'clojure.lang.LazySeq clojure.lang.LazySeq - 'java.lang.String {:class String} - 'java.io.StringWriter java.io.StringWriter - 'java.io.StringReader java.io.StringReader - 'java.lang.Integer Integer - 'java.lang.Number Number - 'java.lang.Double Double - 'java.lang.ArithmeticException ArithmeticException - 'java.lang.Object Object - 'sci.lang.IVar sci.lang.IVar ;; deprecated - 'sci.lang.Type sci.lang.Type - 'sci.lang.Var sci.lang.Var} - :cljs {'Error {:class js/Error :constructor (fn - ([msg] (js/Error. msg)) - ([msg filename] (js/Error. msg filename)) - ([msg filename line] (js/Error. msg filename line)))} - ;; this is here to satisfy the queue reader literal + advanced compilation - 'cljs.core.PersistentQueue.EMPTY cljs.core/PersistentQueue.EMPTY - 'goog.string.StringBuffer {:class goog.string/StringBuffer - :constructor #(goog.string/StringBuffer. %)} - 'sci.lang.Type sci.lang.Type})) + #?(:cljs + {'Error {:class js/Error + :constructor (fn + ([msg] (js/Error. msg)) + ([msg filename] (js/Error. msg filename)) + ([msg filename line] (js/Error. msg filename line)))} + 'cljs.core.PersistentQueue.EMPTY cljs.core/PersistentQueue.EMPTY + 'goog.string.StringBuffer {:class goog.string/StringBuffer + :constructor #(goog.string/StringBuffer. %)} + 'sci.lang.Type sci.lang.Type} + :default + (merge + ;; Common between clj/cljr + {'clojure.lang.Delay clojure.lang.Delay + 'clojure.lang.ExceptionInfo clojure.lang.ExceptionInfo + 'clojure.lang.LazySeq clojure.lang.LazySeq + 'sci.lang.IVar sci.lang.IVar ;; deprecated + 'sci.lang.Var sci.lang.Var} + #?(:clj + {'clojure.lang.LineNumberingPushbackReader clojure.lang.LineNumberingPushbackReader + 'java.io.StringReader java.io.StringReader + 'java.io.StringWriter java.io.StringWriter + 'java.lang.ArithmeticException ArithmeticException + 'java.lang.AssertionError AssertionError + 'java.lang.Double Double + 'java.lang.Exception {:class Exception} + 'java.lang.IllegalArgumentException java.lang.IllegalArgumentException + 'java.lang.Integer Integer + 'java.lang.Number Number + 'java.lang.Object Object + 'java.lang.String {:class String} + 'sci.lang.Type sci.lang.Type} + :cljr + {'System.ArgumentException System.ArgumentException + 'System.ArithmeticException System.ArithmeticException + 'System.Double System.Double + 'System.Exception {:class System.Exception} + 'System.IO.StringReader System.IO.StringReader + 'System.IO.StringWriter System.IO.StringWriter + 'System.Int32 System.Int32 + 'System.Int64 System.Int64 + 'System.Object System.Object + 'System.String {:class System.String} + 'sci.lang.SciCustomType sci.lang.SciCustomType})))) (def default-imports #?(:clj '{AssertionError java.lang.AssertionError @@ -100,6 +116,13 @@ Number java.lang.Number Double java.lang.Double Object java.lang.Object} + :cljr '{Exception System.Exception + String System.String + ArithmeticException System.ArithmeticException + Integer System.Int32 + Number System.Int64 + Double System.Double + Object System.Object} :cljs {})) (defn stringify-keys [m] @@ -128,24 +151,26 @@ :class->opts (persistent! class->opts)}))) (def default-reify-fn - #?(:clj (fn [{:keys [interfaces methods protocols]}] - (reify - Object - (toString [this] - ((get methods 'toString) this)) - IReified - (getInterfaces [_this] - interfaces) - (getMethods [_this] - methods) - (getProtocols [_this] - protocols))) - :cljs (fn [_ _ _]))) + #?(:cljs (fn [_ _ _]) + :default (fn [{:keys [interfaces methods protocols]}] + (reify + Object + (#?(:clj toString :cljr ToString) [this] + ((get methods '#?(:clj toString :cljr ToString)) + this)) + IReified + (getInterfaces [_this] + interfaces) + (getMethods [_this] + methods) + (getProtocols [_this] + protocols))))) -#?(:clj (defrecord Ctx [bindings env - features readers - reload-all - check-permissions])) +#?(:cljs nil :default + (defrecord Ctx [bindings env + features readers + reload-all + check-permissions])) (defn ->ctx [bindings env features readers check-permissions?] #?(:cljs {:bindings bindings @@ -153,12 +178,12 @@ :features features :readers readers :check-permissions check-permissions?} - :clj (->Ctx bindings env features readers false check-permissions?))) + :default (->Ctx bindings env features readers false check-permissions?))) (def default-ns-aliases - #?(:clj {} - :cljs {;; in SCI the core namespace is always called clojure.core - 'cljs.core 'clojure.core})) + #?(:cljs {;; in SCI the core namespace is always called clojure.core + 'cljs.core 'clojure.core} + :default {})) (defn init "Initializes options" @@ -190,7 +215,8 @@ :deny (when deny (process-permissions #{} deny)) :reify-fn (or reify-fn default-reify-fn) :proxy-fn proxy-fn - #?@(:clj [:main-thread-id (.getId (Thread/currentThread))]))] + #?@(:clj [:main-thread-id (.getId (Thread/currentThread))] + :cljr [:main-thread-id (.ManagedThreadId (System.Threading.Thread/CurrentThread))]))] ctx)) (defn merge-opts [ctx opts] diff --git a/src/sci/impl/parser.cljc b/src/sci/impl/parser.cljc index 89c65e9f..e1971a93 100644 --- a/src/sci/impl/parser.cljc +++ b/src/sci/impl/parser.cljc @@ -9,7 +9,7 @@ [sci.impl.types :as types] [sci.impl.utils :as utils])) -#?(:clj (set! *warn-on-reflection* true)) +#?(:cljs nil :default (set! *warn-on-reflection* true)) (def ^:const eof :sci.impl.parser.edamame/eof) @@ -100,10 +100,13 @@ (res-without-sym sym) (let [sym-name (name sym)] (or - #?(:clj (when (and (= 1 (.length sym-name)) - (Character/isDigit (.charAt sym-name 0))) - (when-let [clazz ^Class (interop/resolve-array-class ctx sym-ns sym-name)] - (symbol (pr-str clazz))))) + #?@(:cljs [] + :default [(when (and (= 1 (#?(:clj .length :cljr .Length) sym-name)) + (-> sym-name + (#?(:clj .charAt :cljr .get_Chars) 0) + #?(:clj Character/isDigit :cljr Char/IsDigit))) + (when-let [clazz (interop/resolve-array-class ctx sym-ns sym-name)] + (symbol (pr-str clazz))))]) (let [nss (get env :namespaces)] (if (get nss sym-ns) sym @@ -114,7 +117,7 @@ (if-let [import (-> nss (get current-ns) :imports (get sym-ns))] (symbol (str import) (name sym)) sym) - :clj sym)))))))] + :default sym)))))))] ret)) (defn throw-eval-read [_] @@ -171,13 +174,17 @@ (vary-meta v assoc :line (get-line-number r) :column (- (get-column-number r) - #?(:clj (.length (str v)) - :cljs (.-length (str v))))) + (#?(:clj .length + :cljs .-length + :cljr .Length) + (str v)))) v))) - (catch #?(:clj clojure.lang.ExceptionInfo - :cljs cljs.core/ExceptionInfo) e - (throw (ex-info #?(:clj (.getMessage e) - :cljs (.-message e)) + (catch #?(:cljs cljs.core/ExceptionInfo + :default clojure.lang.ExceptionInfo) e + (throw (ex-info (#?(:clj .getMessage + :cljs .-message + :cljr .Message) + e) (assoc (ex-data e) :type :sci.error/parse :phase "parse" diff --git a/src/sci/impl/protocols.cljc b/src/sci/impl/protocols.cljc index a1c81c14..c99a36c8 100644 --- a/src/sci/impl/protocols.cljc +++ b/src/sci/impl/protocols.cljc @@ -5,7 +5,7 @@ extends? implements? type->str]) (:require [sci.ctx-store :as store] - #?(:clj [sci.impl.interop :as interop]) + #?@(:cljs [] :default [[sci.impl.interop :as interop]]) [sci.impl.deftype] [sci.impl.multimethods :as mms] [sci.impl.types :as types] @@ -15,12 +15,12 @@ #?(:cljs (def extend-default-val (str `default))) -(defn default? [#?(:clj ctx - :cljs _ctx) sym] - #?(:clj (and (or (= 'Object sym) - (= 'java.lang.Object type)) - (= Object (interop/resolve-class ctx 'Object))) - :cljs (= extend-default-val sym))) +(defn default? [#?(:cljs _ctx + :default ctx) sym] + #?(:cljs (= extend-default-val sym) + :default (and (or (= 'Object sym) + (= `Object type)) + (= Object (interop/resolve-class ctx 'Object))))) (defn ->sigs [signatures] (into {} @@ -75,12 +75,13 @@ method# (get meta# '~fq-name)] (if method# (apply method# x# args#) - (let [method# (get-method ~method-name (#?(:clj class :cljs type) x#)) + (let [method# (get-method ~method-name (#?(:cljs type :default class) x#)) default# (get-method ~method-name :default)] (if (not= method# default#) (apply method# x# args#) (throw (new #?(:clj IllegalArgumentException - :cljs js/Error) + :cljs js/Error + :cljr InvalidOperationException) (str "No implementation of method: " ~(keyword method-name) " of protocol: " (var ~protocol-name) " found for: " @@ -88,22 +89,24 @@ (conj impls ;; fallback method for extension on IRecord `(defmethod ~method-name :default [x# & args#] - (let [method# (get-method ~method-name (#?(:clj class :cljs type) x#)) + (let [method# (get-method ~method-name (#?(:cljs type :default class) x#)) default# (get-method ~method-name :default)] (if (not= method# default#) (apply method# x# args#) (throw (new #?(:clj IllegalArgumentException - :cljs js/Error) + :cljs js/Error + :cljr InvalidOperationException) (str "No implementation of method: " ~(keyword method-name) " of protocol: " ~(list 'var fq-protocol-name) " found for: " (clojure.core/protocol-type-impl x#)))))))))] `(do ~@impls - #?(:clj (alter-var-root (var ~protocol-name) - update :methods conj ~method-name) - :cljs (def ~protocol-name - (update ~protocol-name :methods conj ~method-name)))))) + #?(:cljs (def ~protocol-name + (update ~protocol-name :methods conj ~method-name)) + :default (alter-var-root (var ~protocol-name) + update :methods conj ~method-name) + )))) signatures ) ~(list 'quote protocol-name))] @@ -143,12 +146,12 @@ (if-let [meth# (get m# '~fq)] (apply meth# ~args) ;; look for type specific method - (let [meth# (get-method ~fq (#?(:clj class :cljs type) farg#)) + (let [meth# (get-method ~fq (#?(:cljs type :default class) farg#)) default# (get-method ~fq :default)] (if (not= default# meth#) (apply meth# ~args) (do ~@body)))) - (let [meth# (get-method ~fq (#?(:clj class :cljs type) farg#)) + (let [meth# (get-method ~fq (#?(:cljs type :default class) farg#)) default# (get-method ~fq :default)] (if (not= default# meth#) (apply meth# ~args) @@ -163,7 +166,7 @@ (defn process-single [fq [args & body]] (list args `(let [farg# ~(first args)] - (let [meth# (get-method ~fq (#?(:clj class :cljs type) farg#)) + (let [meth# (get-method ~fq (#?(:cljs type :default class) farg#)) default# (get-method ~fq :default)] (if (not= default# meth#) (apply meth# ~args) @@ -228,14 +231,14 @@ expansion `(do ~@(map (fn [[type & meths]] - (let [type #?(:clj type - :cljs (get cljs-type-symbols type type))] + (let [type #?(:cljs (get cljs-type-symbols type type) + :default type)] (if #?(:cljs print-writer? - :clj false) + :default false) #?(:cljs `(clojure.core/alter-meta! (var ~type) assoc :sci.impl/print-method (fn ~@(rest (first meths)))) - :clj nil) + :default nil) `(do (clojure.core/alter-var-root (var ~protocol-name) update :satisfies (fnil conj #{}) @@ -268,7 +271,8 @@ (or (when-let [sats (:satisfies protocol)] (or #?(:clj (contains? sats "class java.lang.Object") - :cljs (contains? sats extend-default-val)) + :cljs (contains? sats extend-default-val) + :cljr (throw (ex-info "TODO CLR: " `find-matching-non-default-method))) (when (nil? obj) (contains? sats "nil")) (when-let [t (types/type-impl obj)] @@ -280,11 +284,11 @@ (:methods protocol))))) (defn satisfies? [protocol obj] - (if #?(:clj (instance? sci.impl.types.IReified obj) - ;; in CLJS we currently don't support mixing "classes" and protocols, + (if #?(;; in CLJS we currently don't support mixing "classes" and protocols, ;; hence, the instance is always a Reified, thus we can avoid calling ;; the slower satisfies? - :cljs (instance? sci.impl.types/Reified obj)) + :cljs (instance? sci.impl.types/Reified obj) + :default (instance? sci.impl.types.IReified obj)) (contains? (types/getProtocols obj) protocol) ;; can be record that is implementing this protocol ;; or a type like String, etc. that implements a protocol via extend-type, etc. @@ -299,30 +303,30 @@ (find-matching-non-default-method protocol obj))) ;; NOTE: what if the protocol doesn't have any methods? ;; This probably needs fixing - :clj (or - (when-let [p (:protocol protocol)] - (clojure.core/satisfies? p obj)) - (find-matching-non-default-method protocol obj))))) + :default (or + (when-let [p (:protocol protocol)] + (clojure.core/satisfies? p obj)) + (find-matching-non-default-method protocol obj))))) (defn instance-impl [clazz x] (cond ;; fast path for Clojure when using normal clazz - #?@(:clj [(class? clazz) - (instance? clazz x)]) - (instance? sci.lang.Type clazz) - (if (#?(:clj instance? - :cljs cljs.core/implements?) sci.impl.types.SciTypeInstance x) + #?@(:cljs [] :default [(class? clazz) + (instance? clazz x)]) + (instance? #?(:cljr sci.lang.SciCustomType :default sci.lang.Type) clazz) + (if (#?(:cljs cljs.core/implements? + :default instance?) sci.impl.types.SciTypeInstance x) (= clazz (sci.impl.types/-get-type x)) (= clazz (-> x meta :type))) ;; only in Clojure, we could be referring to clojure.lang.IDeref as a sci protocol (map? clazz) - #?(:clj (if-let [c (:class clazz)] - ;; this is a protocol which is an interface on the JVM - (or (satisfies? clazz x) - ;; this is the fallback because we excluded defaults for the core protocols - (instance? c x)) - (satisfies? clazz x)) - :cljs (satisfies? clazz x)) + #?(:cljs (satisfies? clazz x) + :default (if-let [c (:class clazz)] + ;; this is a protocol which is an interface on the JVM + (or (satisfies? clazz x) + ;; this is the fallback because we excluded defaults for the core protocols + (instance? c x)) + (satisfies? clazz x))) ;; could we have a fast path for CLJS too? please let me know! :else (instance? clazz x))) diff --git a/src/sci/impl/records.cljc b/src/sci/impl/records.cljc index fd09be2c..ae1e6b5f 100644 --- a/src/sci/impl/records.cljc +++ b/src/sci/impl/records.cljc @@ -9,9 +9,9 @@ [sci.impl.vars :as vars] [sci.lang])) -#?(:clj (set! *warn-on-reflection* true)) +#?(:cljs nil :default (set! *warn-on-reflection* true)) -#?(:clj +#?(:cljs nil :default (defn assert-no-jvm-interface [protocol protocol-name expr] (when (and (class? protocol) (not (= Object protocol))) @@ -24,7 +24,8 @@ (let [t (types/type-impl this)] (str (namespace t) "." (name t) "@" #?(:clj (Integer/toHexString (hash this)) - :cljs (.toString (hash this) 16))))) + :cljs (.toString (hash this) 16) + :cljr (System.Convert/ToString ^long (hash this) (int 16)))))) (defn clojure-str [v] (let [t (types/type-impl v)] @@ -33,7 +34,104 @@ (defprotocol SciPrintMethod (-sci-print-method [x w])) -#?(:clj +#?(:cljs nil + :cljr + (deftype SciRecord [rec-name + type + var ext-map + ^:unsynchronized-mutable my_hash + ^:unsynchronized-mutable my_hasheq] + clojure.lang.IRecord ;; marker interface + + clojure.lang.IHashEq + (hasheq [_] + (let [hq my_hasheq] + (if (zero? hq) + (let [type-hash (hash rec-name) + h (int (bit-xor type-hash (clojure.lang.APersistentMap/mapHasheq ext-map)))] + (set! my_hasheq h) + h) + hq))) + + clojure.lang.IObj + (meta [_] + (meta ext-map)) + (withMeta [_ m] + (SciRecord. + rec-name type var (with-meta ext-map m) 0 0)) + + clojure.lang.ILookup + (valAt [_this k] + (.valAt ^clojure.lang.ILookup ext-map k)) + (valAt [_ k else] + (.valAt ^clojure.lang.ILookup ext-map k else)) + + clojure.lang.IPersistentMap + (count [_] + (count ext-map)) + (empty [_] + (throw (NotSupportedException. (str "Can't create empty: " (str rec-name))))) + (^clojure.lang.IPersistentMap cons [this e] + (cond + (map? e) (into this e) + (vector? e) (assoc this (nth e 0) (nth e 1)) + :else (reduce conj this e))) + (equiv [this gs] + (boolean + (or (identical? this gs) + (when (instance? SciRecord gs) + (and (identical? rec-name (.-rec-name ^SciRecord gs)) + (= ext-map (.-ext-map ^SciRecord gs))))))) + (containsKey [_this k] + (.containsKey ^clojure.lang.IPersistentMap ext-map k)) + (entryAt [_this k] + (.entryAt ^clojure.lang.IPersistentMap ext-map k)) + (seq [_this] (.seq ^clojure.lang.IPersistentMap ext-map)) + (^clojure.lang.IPersistentMap assoc [_this k v] + (SciRecord. rec-name type var (assoc ext-map k v) 0 0)) + (without [_this k] + (SciRecord. rec-name type var (dissoc ext-map k) 0 0)) + + System.Collections.IDictionary + (get_Count [_this] + (count ext-map)) + (get_IsReadOnly [_this] + true) + (get_Keys [_this] + (keys ext-map)) + (get_Values [_this] + (vals ext-map)) + (get_Item [_this k] + (get ext-map k)) + (set_Item [_this _k _v] + (throw (NotSupportedException.))) + (Add [_this _k _v] + (throw (NotSupportedException.))) + (Clear [_this] + (throw (NotSupportedException.))) + (Contains [_this k] + (contains? ext-map k)) + (Remove [_this _k] + (throw (NotSupportedException.))) + + Object + (#?(:cljr ToString :default toString) [this] + (to-string this)) + + SciPrintMethod + (-sci-print-method [this w] + (if-let [rv var] + (let [m (meta rv)] + (if-let [pm (:sci.impl/print-method m)] + (pm this w) + (.Write ^System.IO.TextWriter w ^String (clojure-str this)))) + (.Write ^System.IO.TextWriter w ^String (clojure-str this)))) + + sci.impl.types/SciTypeInstance + (-get-type [_] + type)) + + :default (deftype SciRecord [rec-name type var ext-map @@ -242,10 +340,12 @@ (defmethod print-method SciRecord [v w] (-sci-print-method v w))) -#?(:clj (defn ->record-impl [rec-name type var m] - (SciRecord. rec-name type var m 0 0)) - :cljs (defn ->record-impl [rec-name type var m] - (SciRecord. rec-name type var m nil))) +#?(:cljs (defn ->record-impl [rec-name type var m] + (SciRecord. rec-name type var m nil)) + :cljr (defn ->record-impl [rec-name type var m] + (SciRecord. rec-name type var m 0 0)) + :default (defn ->record-impl [rec-name type var m] + (SciRecord. rec-name type var m 0 0))) (defn defrecord [[_fname & _ :as form] _ record-name fields & raw-protocol-impls] (let [ctx (store/get-ctx)] @@ -261,7 +361,7 @@ field-set (set fields) protocol-impls (mapcat - (fn [[protocol-name & impls] #?(:clj expr :cljs expr)] + (fn [[protocol-name & impls] expr] (let [impls (group-by first impls) protocol (@utils/eval-resolve-state ctx (:bindings ctx) protocol-name) ;; _ (prn :protocol protocol) @@ -272,7 +372,7 @@ (utils/throw-error-with-location (str "Protocol not found: " protocol-name) expr)) - #?@(:clj [_ (assert-no-jvm-interface protocol protocol-name expr)]) + #?@(:cljs [] :default [_ (assert-no-jvm-interface protocol protocol-name expr)]) protocol (if (utils/var? protocol) @protocol protocol) protocol-var (:var protocol) _ (when protocol-var @@ -281,7 +381,7 @@ (fnil conj #{}) (protocols/type->str rec-type))) protocol-ns (:ns protocol) pns (cond protocol-ns (str (types/getName protocol-ns)) - (= #?(:clj Object :cljs ::object) protocol) "sci.impl.records") + (= #?(:cljs ::object :default Object) protocol) "sci.impl.records") fq-meth-name #(if (simple-symbol? %) (symbol pns (str %)) %)] @@ -370,4 +470,4 @@ (defn resolve-record-class [ctx class-sym] (when-let [x (resolve-record-or-protocol-class ctx class-sym)] - (when (instance? sci.lang.Type x) x))) + (when (instance? #?(:cljr sci.lang.SciCustomType :default sci.lang.Type) x) x))) diff --git a/src/sci/impl/reflector.cljc b/src/sci/impl/reflector.cljc new file mode 100644 index 00000000..a62bea1f --- /dev/null +++ b/src/sci/impl/reflector.cljc @@ -0,0 +1,330 @@ +(ns sci.impl.reflector + "Minimal reflection support for SCI. + + JVM notes: + - mostly based on clojure.java.Reflector + - made invokeMatchingMethod public via invoke-matching-method + - added arg-types to allow type hints to steer reflection resolution + - FISupport - extracted from Compiler to support functional interface adaptation" + {:no-doc true} + #?(:clj + (:import [java.lang.reflect Method Modifier Proxy] + [clojure.lang Reflector Compiler IFn RT]))) + +#?(:cljs nil :default (set! *warn-on-reflection* :warn-on-boxed)) + +;; FISupport + +#?(:clj + (do + ;; AFn already implements these functional interfaces, so we don't need to adapt them + (def ^:private afn-fis + #{java.util.concurrent.Callable + java.lang.Runnable + java.util.Comparator}) + + (def ^:private object-methods + #{"equals" "toString" "hashCode"}) + + (defn- maybe-fi-method + "Return FI method if: + 1) Target is a functional interface and not already implemented by AFn + 2) Target method matches one of our fn invoker methods (0 <= arity <= 10)" + [^Class target] + (when (and target + (.isAnnotationPresent target java.lang.FunctionalInterface) + (not (contains? afn-fis target))) + (let [methods (.getMethods target)] + (some (fn [^Method method] + (when (and (>= (.getParameterCount method) 0) + (<= (.getParameterCount method) 10) + (Modifier/isAbstract (.getModifiers method)) + (not (contains? object-methods (.getName method)))) + method)) + methods)))))) + +;; Reflector functions + +#?(:clj + (defn get-methods + "Get methods matching the given class, arity, method name and static flag. + Delegates directly to clojure.lang.Reflector." + [^Class c arity ^String method-name static?] + (Reflector/getMethods c arity method-name static?)) + :cljr + (defn get-methods + [& args] + (throw (ex-info (str "TODO " `get-methods) {})))) + +#?(:clj + (defn get-static-field + "Get a static field value from a class. + Delegates directly to clojure.lang.Reflector." + [^Class c ^String field-name] + (Reflector/getStaticField c field-name)) + :cljr + (defn get-static-field + [& args] + (throw (ex-info (str "TODO " `get-static-field) {})))) + +#?(:clj + (defn invoke-constructor + "Invoke a constructor on a class with the given arguments. + Delegates directly to clojure.lang.Reflector." + [^Class c args] + (Reflector/invokeConstructor c args)) + :cljr + (defn invoke-constructor + [& args] + (throw (ex-info (str "TODO " `invoke-constructor) {})))) + +#?(:clj + (defn invoke-static-method + "Invoke a static method on a class with the given arguments. + Delegates directly to clojure.lang.Reflector." + [^Class c ^String method-name ^objects args] + (Reflector/invokeStaticMethod c method-name args)) + :cljr + (defn invoke-static-method + [& args] + (throw (ex-info (str "TODO " `invoke-static-method) {})))) + +#?(:clj + (defn- coerce-adapter-return + "Return type coercions match coercions in FnInvokers for compiled invokers" + [ret ^Class target-type] + (if (.isPrimitive target-type) + (case (.getName target-type) + "boolean" (RT/booleanCast ret) + "long" (RT/longCast ret) + "double" (RT/doubleCast ret) + "int" (RT/intCast ret) + "short" (RT/shortCast ret) + "byte" (RT/byteCast ret) + "float" (RT/floatCast ret) + ret) + ret))) + +#?(:clj + (defn- box-arg + "Box an argument to match the parameter type. + Handles IFn -> Functional Interface adaptation." + [^Class param-type ^Object arg] + (if (and (instance? IFn arg) + (when-let [_fi-method (maybe-fi-method param-type)] + (not (.isInstance param-type arg)))) + ;; Adapt IFn obj to targetType using dynamic proxy + (Proxy/newProxyInstance + (RT/baseLoader) + (into-array Class [param-type]) + (reify java.lang.reflect.InvocationHandler + (invoke [_ _proxy method method-args] + (let [ret (.applyTo ^IFn arg (RT/seq method-args))] + (coerce-adapter-return ret (.getReturnType ^Method method)))))) + ;; Standard boxing + (cond + (not (.isPrimitive param-type)) + (.cast param-type arg) + + (identical? param-type Boolean/TYPE) + (.cast Boolean arg) + + (identical? param-type Character/TYPE) + (.cast Character arg) + + (instance? Number arg) + (let [^Number n arg] + (cond + (identical? param-type Integer/TYPE) (.intValue n) + (identical? param-type Float/TYPE) (.floatValue n) + (identical? param-type Double/TYPE) (.doubleValue n) + (identical? param-type Long/TYPE) (.longValue n) + (identical? param-type Short/TYPE) (.shortValue n) + (identical? param-type Byte/TYPE) (.byteValue n) + :else (throw (IllegalArgumentException. + (str "Unexpected param type, expected: " param-type + ", given: " (.getName (.getClass arg))))))) + + :else + (throw (IllegalArgumentException. + (str "Unexpected param type, expected: " param-type + ", given: " (.getName (.getClass arg))))))))) + +#?(:clj + (defn- box-args + "Box all arguments to match parameter types." + [^objects params ^objects args] + (if (zero? (alength params)) + nil + (let [ret (object-array (alength params))] + (dotimes [i (alength params)] + (aset ret i (box-arg (aget params i) (aget args i)))) + ret)))) + +#?(:clj + (defn- param-arg-type-match? + "Check if a parameter type matches an argument type. + Includes support for functional interface adaptation." + [^Class param-type ^Class arg-type] + (cond + (nil? arg-type) + (not (.isPrimitive param-type)) + + (or (identical? param-type arg-type) (.isAssignableFrom param-type arg-type)) + true + + (and (maybe-fi-method param-type) (.isAssignableFrom IFn arg-type)) + true + + (identical? param-type Integer/TYPE) + (or (identical? arg-type Integer) + (identical? arg-type Long/TYPE) + (identical? arg-type Long) + (identical? arg-type Short/TYPE) + (identical? arg-type Byte/TYPE)) + + (identical? param-type Float/TYPE) + (or (identical? arg-type Float) + (identical? arg-type Double/TYPE)) + + (identical? param-type Double/TYPE) + (or (identical? arg-type Double) + (identical? arg-type Float/TYPE)) + + (identical? param-type Long/TYPE) + (or (identical? arg-type Long) + (identical? arg-type Integer/TYPE) + (identical? arg-type Short/TYPE) + (identical? arg-type Byte/TYPE)) + + (identical? param-type Character/TYPE) + (identical? arg-type Character) + + (identical? param-type Short/TYPE) + (identical? arg-type Short) + + (identical? param-type Byte/TYPE) + (identical? arg-type Byte) + + (identical? param-type Boolean/TYPE) + (identical? arg-type Boolean) + + :else + false))) + +#?(:clj + (defn- is-congruent? + "Check if parameters are congruent with arguments and arg-types." + [^objects params ^objects args ^objects arg-types] + (if (nil? args) + (zero? (alength params)) + (and (== (alength params) (alength args)) + (loop [i 0] + (if (< i (alength params)) + (let [arg (aget args i) + arg-type (if arg-types + (let [t (aget arg-types i)] + (if (and (nil? t) (some? arg)) + (.getClass ^Object arg) + t)) + (when arg (.getClass ^Object arg))) + param-type (aget params i)] + (if (param-arg-type-match? param-type arg-type) + (recur (inc i)) + false)) + true)))))) + +#?(:clj + (defn- match-method + "Find the best matching method from a list of methods given args and optional arg-types." + [methods args arg-types] + (loop [methods methods + found-m nil] + (if-let [^Method m (first methods)] + (let [params (.getParameterTypes m)] + (if (and (is-congruent? params args arg-types) + (or (nil? found-m) + (Compiler/subsumes params (.getParameterTypes ^Method found-m)))) + (recur (rest methods) m) + (recur (rest methods) found-m))) + found-m)))) + +#?(:clj + (defn- widen-boxed-args + "Widen boxed numeric arguments (e.g., Integer -> Long, Float -> Double)." + [^objects args] + (let [widened (object-array (alength args))] + (dotimes [i (alength args)] + (let [arg (aget args i)] + (if (some? arg) + (let [val-class (.getClass ^Object arg)] + (aset widened i + (cond + (or (identical? val-class Integer) (identical? val-class Short) (identical? val-class Byte)) + (.longValue ^Number arg) + + (identical? val-class Float) + (.doubleValue ^Number arg) + + :else + arg))) + (aset widened i nil)))) + widened))) + +#?(:clj + (defn invoke-matching-method + "Invoke a method matching the given name from a list of methods. + This is the core SCI-specific method that supports type hints via arg-types. + Parameters: + - method-name: String name of the method + - methods: java.util.List of Method objects + - context-class: Class for error messages (can be nil for static methods) + - target: Object to invoke on (nil for static methods) + - args: Object array of arguments + - arg-types: Optional array of Class objects for type hints" + ([method-name methods ^Object target args] + (invoke-matching-method method-name methods + (when target (.getClass target)) + target args nil)) + ([method-name methods context-class target args] + (invoke-matching-method method-name methods context-class target args nil)) + ([method-name methods context-class target args arg-types] + (let [methods (seq methods)] + (if (empty? methods) + (throw (IllegalArgumentException. + (str "No matching method " method-name " found taking " + (alength ^objects args) " args" + (when context-class (str " for " context-class))))) + (let [^Method m (if (== 1 (count methods)) + (first methods) + (or (match-method methods args arg-types) + ;; widen boxed args and re-try + (match-method methods (widen-boxed-args args) arg-types)))] + (if (nil? m) + (throw (IllegalArgumentException. + (str "No matching method " method-name " found taking " + (alength ^objects args) " args" + (when context-class (str " for " context-class))))) + ;; Use Reflector's helper to find accessible version of method + (let [^Method + accessible-m (if (or (not (Modifier/isPublic + (.getModifiers (.getDeclaringClass m)))) + (and target + (not (.canAccess m target)))) + (clojure.lang.Reflector/getAsMethodOfAccessibleBase (or context-class (.getDeclaringClass m)) + m + target) + m)] + (when (nil? accessible-m) + (throw (IllegalArgumentException. + (str "Can't call public method of non-public class: " m)))) + (try + (let [ret (.invoke accessible-m target (box-args (.getParameterTypes accessible-m) args))] + (Reflector/prepRet (.getReturnType accessible-m) ret)) + (catch Exception e + (throw (clojure.lang.Util/sneakyThrow + (or (.getCause e) e)))))))))))) + :cljr + (defn invoke-matching-method + [& args] + (throw (ex-info (str "TODO " `invoke-matching-method) {})))) diff --git a/src/sci/impl/reify.cljc b/src/sci/impl/reify.cljc index 0282ea8d..270cfbdb 100644 --- a/src/sci/impl/reify.cljc +++ b/src/sci/impl/reify.cljc @@ -1,7 +1,7 @@ (ns sci.impl.reify {:no-doc true} (:refer-clojure :exclude [reify]) - #?(:clj (:require [sci.ctx-store :as store])) + #?@(:cljs [] :default [(:require [sci.ctx-store :as store])]) #?(:cljs (:require [sci.impl.types :as t]))) (defn reify [form _ & args] @@ -15,18 +15,16 @@ (into {}))] `(clojure.core/reify* '~form ~(vec classes) ~methods))) -(defn reify* - #?(:clj [form classes methods] - :cljs [_form classes methods]) - #?(:clj (let [{interfaces true protocols false} (group-by class? classes)] - (if-let [factory (:reify-fn (store/get-ctx))] - (with-meta (factory {:interfaces (set interfaces) - :methods methods - :protocols (set protocols)}) - (meta form)) - (throw (ex-info (str "No reify factory for: " interfaces) - {:class class})))) - ;; NOTE: in CLJS everything is a protocol in reify, except Object +(defn reify* [#?(:cljs _form :default form) classes methods] + #?(;; NOTE: in CLJS everything is a protocol in reify, except Object ;; So it's probably better if we dissoc-ed that from the set of classes ;; However, we only use that set to test in satisfies? - :cljs (t/->Reified classes methods (set classes)))) + :cljs (t/->Reified classes methods (set classes)) + :default (let [{interfaces true protocols false} (group-by class? classes)] + (if-let [factory (:reify-fn (store/get-ctx))] + (with-meta (factory {:interfaces (set interfaces) + :methods methods + :protocols (set protocols)}) + (meta form)) + (throw (ex-info (str "No reify factory for: " interfaces) + {:class class})))))) diff --git a/src/sci/impl/resolve.cljc b/src/sci/impl/resolve.cljc index fb12f775..afeaf602 100644 --- a/src/sci/impl/resolve.cljc +++ b/src/sci/impl/resolve.cljc @@ -52,38 +52,38 @@ sym-ns (get (:ns-aliases env) sym-ns sym-ns)] (if sym-ns (or - #?(:clj + #?(:cljs nil + :default (when-not only-var? (when (and (= 1 (.length sym-name-str)) - (Character/isDigit (.charAt sym-name-str 0))) + #?(:clj (Character/isDigit (.charAt sym-name-str 0)) + :cljr (Char/IsDigit (.get_Chars sym-name-str 0)))) (when-let [clazz (interop/resolve-array-class ctx sym-ns sym-name-str)] [sym clazz])))) (when - #?(:clj (= 'clojure.core sym-ns) - :cljs (or (= 'clojure.core sym-ns) - (= 'cljs.core sym-ns))) + #?(:cljs (or (= 'clojure.core sym-ns) + (= 'cljs.core sym-ns)) + :default (= 'clojure.core sym-ns)) (or (some-> env :namespaces (get 'clojure.core) (find sym-name)) (when-let [v (when call? (get ana-macros sym-name))] [sym v]))) (some-> env :namespaces (get sym-ns) (find sym-name)) (when-not only-var? (when-let [clazz (interop/resolve-class ctx sym-ns)] - [sym (if (and call? #?(:clj (not (str/starts-with? sym-name-str ".")))) + [sym (if (and call? + #?@(:cljs [] + :default [(not (str/starts-with? sym-name-str "."))])) (with-meta - [clazz #?(:clj sym-name - :cljs (.split (utils/munge-str (str sym-name)) ".")) + [clazz #?(:cljs (.split (utils/munge-str (str sym-name)) ".") + :default sym-name) sym-ns] - #?(:clj + #?(:cljs + {:sci.impl.analyzer/static-access true} + :default (if (= "new" sym-name-str) {:sci.impl.analyzer/invoke-constructor true} - {:sci.impl.analyzer/static-access true}) - :cljs - {:sci.impl.analyzer/static-access true})) - #?(:clj - (with-meta - [clazz sym-name] - {:sci.impl.analyzer/interop true}) - :cljs + {:sci.impl.analyzer/static-access true}))) + #?(:cljs (let [stack (assoc (meta sym) :file @utils/current-file :ns @utils/current-ns) @@ -97,7 +97,11 @@ (->Node (interop/get-static-fields clazz path) stack)) - )))]))) + ) + :default + (with-meta + [clazz sym-name] + {:sci.impl.analyzer/interop true})))]))) ;; no sym-ns (or ;; prioritize refers over vars in the current namespace, see 527 @@ -120,13 +124,13 @@ [sym c]) ;; resolves record or protocol referenced as class ;; e.g. clojure.lang.IDeref which is really a var in clojure.lang/IDeref - #?(:clj - (when-let [x (records/resolve-record-or-protocol-class ctx sym)] - [sym x]) - :cljs + #?(:cljs (when-not (:dotted-access ctx) (when-let [x (records/resolve-record-or-protocol-class ctx sym)] - [sym x])))))))))) + [sym x])) + :default + (when-let [x (records/resolve-record-or-protocol-class ctx sym)] + [sym x]))))))))) (defn update-parents ":syms = closed over -> idx" @@ -163,7 +167,7 @@ (defn lookup ([ctx sym call?] (lookup ctx sym call? nil)) ([ctx sym call? m] (lookup ctx sym call? m nil)) - ([ctx sym call? #?(:clj m :cljs _) only-var?] + ([ctx sym call? #?(:cljs _ :default m) only-var?] (let [bindings (faster/get-2 ctx :bindings) track-mutable? (faster/get-2 ctx :deftype-fields)] (or @@ -175,14 +179,14 @@ (let [oi (:outer-idens ctx) ob (oi v)] (update-parents ctx (:closure-bindings ctx) ob))) - #?@(:clj [tag (or (:tag m) - (some-> k meta :tag))]) + #?@(:cljs [] :default [tag (or (:tag m) + (some-> k meta :tag))]) mutable? (when track-mutable? (when-let [m (some-> k meta)] - #?(:clj (or (:volatile-mutable m) - (:unsynchronized-mutable m)) - :cljs (or (:mutable m) - (:volatile-mutable m))))) + #?(:cljs (or (:mutable m) + (:volatile-mutable m)) + :default (or (:volatile-mutable m) + (:unsynchronized-mutable m))))) v (if call? ;; resolve-symbol is already handled in the call case (mark-resolve-sym k idx) (let [v (cond-> (if mutable? @@ -195,8 +199,8 @@ (->Node (aget ^objects bindings idx) nil)) - #?@(:clj [tag (with-meta - {:tag tag})]) + #?@(:cljs [] + :default [tag (with-meta {:tag tag})]) mutable? (vary-meta assoc :mutable true))] v))] [k v]))) @@ -248,30 +252,29 @@ (recur (str new-sym) nxt-segments))))))))) #?(:cljs (defn resolve-dotted-access [ctx sym call? m] - #?(:cljs - (when-let [[v segments] (resolve-prefix+path ctx sym m)] - (let [v (if (utils/var? v) (deref v) v) - segments (mapv utils/munge-str segments) - segments (into-array segments)] - ;; NOTE: there is a reloading implication here... - (if call? - [sym (with-meta - [v segments] - {:sci.impl.analyzer/static-access true})] - (if (instance? sci.impl.types/NodeR v) - [sym - (sci.impl.types/->Node - (interop/get-static-fields - (sci.impl.types/eval v ctx bindings) - segments) - sym)] - ;; This is x.a.b.c - [sym (interop/get-static-fields v segments) - ;; This would be the correct implementation if v would be mutated, but can be implemented as: - ;; (.. x -a -b c) - #_(sci.impl.types/->Node - (interop/get-static-fields v segments) - nil)]))))))) + (when-let [[v segments] (resolve-prefix+path ctx sym m)] + (let [v (if (utils/var? v) (deref v) v) + segments (mapv utils/munge-str segments) + segments (into-array segments)] + ;; NOTE: there is a reloading implication here... + (if call? + [sym (with-meta + [v segments] + {:sci.impl.analyzer/static-access true})] + (if (instance? sci.impl.types/NodeR v) + [sym + (sci.impl.types/->Node + (interop/get-static-fields + (sci.impl.types/eval v ctx bindings) + segments) + sym)] + ;; This is x.a.b.c + [sym (interop/get-static-fields v segments) + ;; This would be the correct implementation if v would be mutated, but can be implemented as: + ;; (.. x -a -b c) + #_(sci.impl.types/->Node + (interop/get-static-fields v segments) + nil)])))))) (defn resolve-symbol ([ctx sym] (resolve-symbol ctx sym false nil)) @@ -279,8 +282,7 @@ ([ctx sym call? m] (second (or (resolve-symbol* ctx sym call? m) - #?(:cljs (let [resolved (resolve-dotted-access ctx sym call? m)] - resolved)) + #?(:cljs (resolve-dotted-access ctx sym call? m)) (throw-error-with-location (str "Unable to resolve symbol: " sym) sym))))) diff --git a/src/sci/impl/test.cljc b/src/sci/impl/test.cljc index 8ddbb0cc..d4abfc37 100644 --- a/src/sci/impl/test.cljc +++ b/src/sci/impl/test.cljc @@ -20,7 +20,6 @@ maybe-destructured rethrow-with-location-of-node set-namespace!]] [sci.impl.vars :as vars] #?(:cljs [cljs.tagged-literals :refer [JSValue]])) - #?(:clj (:import [sci.impl Reflector])) #?(:cljs (:require-macros [sci.impl.test :refer [Foo]] diff --git a/src/sci/impl/types.cljc b/src/sci/impl/types.cljc index c36351fe..97f5e905 100644 --- a/src/sci/impl/types.cljc +++ b/src/sci/impl/types.cljc @@ -1,30 +1,29 @@ (ns sci.impl.types {:no-doc true} (:refer-clojure :exclude [eval]) - #?(:clj (:require [sci.impl.macros :as macros])) + #?@(:cljs [] :default [(:require [sci.impl.macros :as macros])]) #?(:cljs (:require-macros [sci.impl.macros :as macros] [sci.impl.types :refer [->Node]])) #?(:clj (:import [sci.impl.types IReified]))) -#?(:clj (set! *warn-on-reflection* true)) +#?(:cljs nil :default (set! *warn-on-reflection* true)) (defprotocol IBox (setVal [_this _v]) (getVal [_this])) -#?(:cljs - (defprotocol IReified - (getInterfaces [_]) - (getMethods [_]) - (getProtocols [_]))) - #?(:clj (do (defn getMethods [obj] (.getMethods ^IReified obj)) (defn getInterfaces [obj] (.getInterfaces ^IReified obj)) (defn getProtocols [obj] - (.getProtocols ^IReified obj)))) + (.getProtocols ^IReified obj))) + :default + (defprotocol IReified + (getInterfaces [_]) + (getMethods [_]) + (getProtocols [_]))) (deftype Reified [interfaces meths protocols] IReified @@ -54,11 +53,11 @@ "Externally available type implementation." [x] (or (some-> x meta :type) - (when (#?(:clj instance? - :cljs cljs.core/implements?) sci.impl.types.SciTypeInstance x) + (when (#?(:cljs cljs.core/implements? + :default instance?) sci.impl.types.SciTypeInstance x) (-get-type x)) #?(:clj (class x) ;; no need to check for metadata anymore - :cljs (type x)))) + :default (type x)))) ;; returned from analyzer when macroexpansion needs interleaved eval (deftype EvalForm [form] @@ -69,10 +68,11 @@ (stack [this])) (extend-protocol Stack - #?(:clj Object :cljs default) (stack [_this] nil)) + #?(:cljs default :default Object) (stack [_this] nil)) -#?(:clj (defprotocol Eval - (eval [expr ctx ^objects bindings]))) +#?(:cljs nil + :default (defprotocol Eval + (eval [expr ctx ^objects bindings]))) #?(:cljs (defrecord NodeR [f stack] @@ -101,15 +101,16 @@ ~body) ~stack)))) -#?(:clj +#?(:cljs nil + :default (deftype ConstantNode [x] Eval (eval [_expr _bindings _ctx] x) Stack (stack [_] nil))) (defn ->constant [x] - #?(:clj (->ConstantNode x) - :cljs x)) + #?(:cljs x + :default (->ConstantNode x))) (defprotocol HasName ;; INamed was already taken by CLJS (getName [_])) diff --git a/src/sci/impl/utils.cljc b/src/sci/impl/utils.cljc index 8f8726e2..835529f6 100644 --- a/src/sci/impl/utils.cljc +++ b/src/sci/impl/utils.cljc @@ -8,7 +8,8 @@ [sci.impl.vars :as vars] [sci.lang :as lang]) #?(:cljs (:import [goog.string StringBuffer])) - #?(:cljs (:require-macros [sci.impl.utils :refer [kw-identical? dotimes+]]))) + #?(:cljs (:require-macros [sci.impl.utils :refer [kw-identical? dotimes+]])) + #?(:cljr (:import [System.Threading Thread]))) #?(:clj (set! *warn-on-reflection* true)) @@ -23,7 +24,9 @@ #?(:clj (instance? java.util.regex.Pattern x) :cljs - (instance? js/RegExp x)))) + (instance? js/RegExp x) + :cljr + (instance? System.Text.RegularExpressions.Regex x)))) (defmacro kw-identical? [k v] (macros/? @@ -32,8 +35,8 @@ ;; NOTE: we could add a unique object to the context instead of using this ;; global one, which would be an even safer solution -(def recur #?(:clj (Object.) - :cljs (js/Object.))) +(def recur #?(:cljs (js/Object.) + :default (Object.))) (declare current-file current-ns) @@ -61,10 +64,10 @@ (symbol "append"))) (defn demunge [s] - #?(:clj (clojure.lang.Compiler/demunge s) - :cljs (cljs.core/demunge s))) + #?(:cljs (cljs.core/demunge s) + :default (clojure.lang.Compiler/demunge s))) -#?(:clj +#?(:cljs nil :default (defn rewrite-ex-msg [ex-msg env fm] (when ex-msg (if-let [[_ printed-fn] (re-matches #"Wrong number of args \(\d+\) passed to: (.*)" ex-msg)] @@ -97,12 +100,13 @@ ex-msg)))) (defn rethrow-with-location-of-node - ([ctx ^Throwable e raw-node] (rethrow-with-location-of-node ctx (:bindings ctx) e raw-node)) - ([ctx _bindings ^Throwable e raw-node] - (if (let [in-try #?(:clj (or *in-try* - (not= (:main-thread-id ctx) - (.getId (Thread/currentThread)))) - :cljs *in-try*)] + ([ctx e raw-node] (rethrow-with-location-of-node ctx (:bindings ctx) e raw-node)) + ([ctx _bindings ^Exception e raw-node] + (if (let [in-try #?(:cljs *in-try* + :default (or *in-try* + (not= (:main-thread-id ctx) + #?(:clj (.getId (Thread/currentThread)) + :cljr (.ManagedThreadId (System.Threading.Thread/CurrentThread))))))] (if (kw-identical? in-try :sci/error) ;; preserve location information false @@ -111,7 +115,7 @@ (throw e) (let [stack (t/stack raw-node) ;; _ (prn :stack stack) - #?@(:clj [fm (:sci.impl/f-meta stack)]) + #?@(:cljs [] :default [fm (:sci.impl/f-meta stack)]) env (:env ctx) id (:id ctx) d (ex-data e) @@ -127,7 +131,8 @@ (if wrapping-sci-error? (throw e) (let [ex-msg #?(:clj (.getMessage e) - :cljs (.-message e)) + :cljs (.-message e) + :default (ex-message e)) {:keys [:line :column :file]} (or stack (some-> env deref @@ -135,8 +140,8 @@ deref last meta) #_(meta node))] (if (and line column) - (let [ex-msg #?(:clj (rewrite-ex-msg ex-msg env fm) - :cljs ex-msg) + (let [ex-msg #?(:cljs ex-msg + :default (rewrite-ex-msg ex-msg env fm)) phase (:phase d) new-exception (let [new-d (cond-> {:type :sci/error @@ -151,8 +156,8 @@ (throw e))))))))) (defn- iobj? [obj] - (and #?(:clj (instance? clojure.lang.IObj obj) - :cljs (implements? IWithMeta obj)) + (and #?(:cljs (implements? IWithMeta obj) + :default (instance? clojure.lang.IObj obj)) (meta obj))) (defn vary-meta* @@ -169,8 +174,8 @@ (def allowed-loop (symbol "clojure.core/loop")) (def allowed-recur (symbol "recur")) -(def var-unbound #?(:clj (Object.) - :cljs (js/Object.))) +(def var-unbound #?(:cljs (js/Object.) + :default (Object.))) (defn namespace-object "Fetches namespaces from env if it exists. Else, if `create?`, @@ -245,7 +250,8 @@ (defn log [& xs] #?(:clj (.println System/err (str/join " " xs)) - :cljs (.log js/console (str/join " " xs)))) + :cljs (.log js/console (str/join " " xs)) + :cljr (.WriteLn System.Console/Error (str/join " " xs)))) (defn dynamic-var ([name] @@ -286,8 +292,8 @@ (instance? sci.lang.Var x)) (defn namespace? [x] - (instance? #?(:clj sci.lang.Namespace - :cljs sci.lang/Namespace) x)) + (instance? #?(:cljs sci.lang/Namespace + :default sci.lang.Namespace) x)) (defmacro dotimes+ [n body] `(do (dotimes [i# ~(dec n)] @@ -298,17 +304,21 @@ ;; (& monitor-exit case* try reify* finally loop* do letfn* if clojure.core/import* new deftype* let* fn* recur set! . var quote catch throw monitor-enter def) (def special-syms '#{try finally do if new recur quote throw def . var set! let* loop* case*}) -#?(:clj (def warn-on-reflection-var - (dynamic-var - '*warn-on-reflection* false - {:ns clojure-core-ns - :doc "When set to true, the compiler will emit warnings when reflection is\n needed to resolve Java method calls or field accesses.\n\n Defaults to false."}))) - -#?(:clj (def unchecked-math-var - (dynamic-var - '*unchecked-math* clojure.core/*unchecked-math* - {:ns clojure-core-ns - :doc "While bound to true, compilations of +, -, *, inc, dec and the\n coercions will be done without overflow checks. While bound\n to :warn-on-boxed, same behavior as true, and a warning is emitted\n when compilation uses boxed math. Default: false."}))) +#?(:cljs nil + :default + (def warn-on-reflection-var + (dynamic-var + '*warn-on-reflection* false + {:ns clojure-core-ns + :doc "When set to true, the compiler will emit warnings when reflection is\n needed to resolve Java method calls or field accesses.\n\n Defaults to false."}))) + +#?(:cljs nil + :default + (def unchecked-math-var + (dynamic-var + '*unchecked-math* clojure.core/*unchecked-math* + {:ns clojure-core-ns + :doc "While bound to true, compilations of +, -, *, inc, dec and the\n coercions will be done without overflow checks. While bound\n to :warn-on-boxed, same behavior as true, and a warning is emitted\n when compilation uses boxed math. Default: false."}))) #?(:cljs (defn ^string munge-str [name] diff --git a/src/sci/impl/vars.cljc b/src/sci/impl/vars.cljc index f0eca496..3d1a7a1c 100644 --- a/src/sci/impl/vars.cljc +++ b/src/sci/impl/vars.cljc @@ -16,9 +16,10 @@ [sci.impl.unrestrict :refer [*unrestricted*]]) #?(:cljs (:require-macros [sci.impl.vars :refer [with-bindings with-writeable-namespace - with-writeable-var]]))) + with-writeable-var]])) + #?(:cljr (:import [System.Threading Thread]))) -#?(:clj (set! *warn-on-reflection* true)) +#?(:cljs nil :default (set! *warn-on-reflection* true)) (macros/deftime (defmacro with-writeable-namespace @@ -39,27 +40,32 @@ (def ^ThreadLocal dvals (proxy [ThreadLocal] [] (initialValue [] top-frame))) :cljs - (def dvals (volatile! top-frame))) + (def dvals (volatile! top-frame)) + :cljr + ;; Atom> + ;; push/pop discipline keeps contained threads alive while in atom + (def dvals (atom {}))) (defn get-thread-binding-frame ^Frame [] #?(:clj (.get dvals) - :cljs @dvals)) + :cljs @dvals + :cljr (@dvals (Thread/CurrentThread) top-frame))) -(deftype TBox #?(:clj [thread ^:volatile-mutable val] - :cljs [thread ^:mutable val]) +(deftype TBox #?(:cljs [thread ^:mutable val] + :default [thread ^:volatile-mutable val]) t/IBox (setVal [_this v] (set! val v)) (getVal [_this] val)) (defn clone-thread-binding-frame ^Frame [] - (let [^Frame f #?(:clj (.get dvals) - :cljs @dvals)] + (let [^Frame f (get-thread-binding-frame)] (Frame. (.-bindings f) nil))) (defn reset-thread-binding-frame [frame] #?(:clj (.set dvals frame) - :cljs (vreset! dvals frame))) + :cljs (vreset! dvals frame) + :cljr (swap! dvals assoc (Thread/CurrentThread) frame))) (defprotocol IVar (bindRoot [this v]) @@ -73,7 +79,7 @@ (defprotocol DynVar (dynamic? [this])) -(extend-type #?(:clj Object :cljs default) +(extend-type #?(:cljs default :default Object) DynVar (dynamic? [_] false)) @@ -83,11 +89,13 @@ bmap (reduce (fn [acc [var* val*]] (when (not (dynamic? var*)) (throw (new #?(:clj IllegalStateException - :cljs js/Error) + :cljs js/Error + :cljr InvalidOperationException) (str "Can't dynamically bind non-dynamic var " var*)))) (setThreadBound var* true) (assoc acc var* (TBox. #?(:clj (Thread/currentThread) - :cljs nil) val*))) + :cljs nil + :cljr (Thread/CurrentThread)) val*))) bmap bindings)] (reset-thread-binding-frame (Frame. bmap frame)))) @@ -97,9 +105,10 @@ (if-let [f (.-prev ^Frame (get-thread-binding-frame))] (if (identical? top-frame f) #?(:clj (.remove dvals) - :cljs (vreset! dvals top-frame)) + :cljs (vreset! dvals top-frame) + :cljr (swap! dvals dissoc (Thread/CurrentThread))) (reset-thread-binding-frame f)) - (throw (new #?(:clj Exception :cljs js/Error) "No frame to pop.")))) + (throw (new #?(:cljs js/Error :default Exception) "No frame to pop.")))) (defn get-thread-bindings [] (let [;; type hint added to prevent shadow-cljs warning, although fn has return tag @@ -115,10 +124,10 @@ (defn get-thread-binding ^TBox [sci-var] (when-let [;; type hint added to prevent shadow-cljs warning, although fn has return tag - ^Frame f #?(:clj (.get dvals) - :cljs @dvals)] + ^Frame f (get-thread-binding-frame)] #?(:clj (.get ^java.util.Map (.-bindings f) sci-var) - :cljs (.get (.-bindings f) sci-var)))) + :cljs (.get (.-bindings f) sci-var) + :cljr (get (.-bindings f) sci-var)))) (defn binding-conveyor-fn [f] @@ -142,60 +151,62 @@ (defn throw-unbound-call-exception [the-var] (throw (new #?(:clj IllegalStateException - :cljs js/Error) (str "Attempting to call unbound fn: " the-var)))) + :cljs js/Error + :cljr InvalidOperationException) + (str "Attempting to call unbound fn: " the-var)))) (deftype SciUnbound [the-var] Object - (toString [_] + (#?(:cljr ToString :default toString) [_] (str "Unbound: " the-var)) - #?@(:clj [clojure.lang.IFn] :cljs [IFn]) - (#?(:clj invoke :cljs -invoke) [_] + #?@(:cljs [IFn] :default [clojure.lang.IFn]) + (#?(:cljs -invoke :default invoke) [_] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a] + (#?(:cljs -invoke :default invoke ) [_ a] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a b] + (#?(:cljs -invoke :default invoke ) [_ a b] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a b c] + (#?(:cljs -invoke :default invoke ) [_ a b c] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a b c d] + (#?(:cljs -invoke :default invoke ) [_ a b c d] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a b c d e] + (#?(:cljs -invoke :default invoke ) [_ a b c d e] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a b c d e f] + (#?(:cljs -invoke :default invoke ) [_ a b c d e f] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a b c d e f g] + (#?(:cljs -invoke :default invoke ) [_ a b c d e f g] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a b c d e f g h] + (#?(:cljs -invoke :default invoke ) [_ a b c d e f g h] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a b c d e f g h i] + (#?(:cljs -invoke :default invoke ) [_ a b c d e f g h i] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a b c d e f g h i j] + (#?(:cljs -invoke :default invoke ) [_ a b c d e f g h i j] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a b c d e f g h i j k] + (#?(:cljs -invoke :default invoke ) [_ a b c d e f g h i j k] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a b c d e f g h i j k l] + (#?(:cljs -invoke :default invoke ) [_ a b c d e f g h i j k l] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a b c d e f g h i j k l m] + (#?(:cljs -invoke :default invoke ) [_ a b c d e f g h i j k l m] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a b c d e f g h i j k l m n] + (#?(:cljs -invoke :default invoke ) [_ a b c d e f g h i j k l m n] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a b c d e f g h i j k l m n o] + (#?(:cljs -invoke :default invoke ) [_ a b c d e f g h i j k l m n o] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a b c d e f g h i j k l m n o p] + (#?(:cljs -invoke :default invoke ) [_ a b c d e f g h i j k l m n o p] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a b c d e f g h i j k l m n o p q] + (#?(:cljs -invoke :default invoke ) [_ a b c d e f g h i j k l m n o p q] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a b c d e f g h i j k l m n o p q r] + (#?(:cljs -invoke :default invoke ) [_ a b c d e f g h i j k l m n o p q r] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a b c d e f g h i j k l m n o p q r s] + (#?(:cljs -invoke :default invoke ) [_ a b c d e f g h i j k l m n o p q r s] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a b c d e f g h i j k l m n o p q r s t] + (#?(:cljs -invoke :default invoke ) [_ a b c d e f g h i j k l m n o p q r s t] (throw-unbound-call-exception the-var)) - (#?(:clj invoke :cljs -invoke) [_ a b c d e f g h i j k l m n o p q r s t rest] + (#?(:cljs -invoke :default invoke ) [_ a b c d e f g h i j k l m n o p q r s t rest] (throw-unbound-call-exception the-var)) - #?(:clj - (applyTo [_ args] - (throw-unbound-call-exception the-var)))) + #?@(:cljs [] + :default [(applyTo [_ args] + (throw-unbound-call-exception the-var))])) ;; adapted from https://github.com/clojure/clojurescript/blob/df1837048d01b157a04bb3dc7fedc58ee349a24a/src/main/cljs/cljs/core.cljs#L1118 @@ -242,13 +253,11 @@ (defn alter-var-root ([v f] - #?(:clj - (locking v (bindRoot v (f (getRawRoot v)))) - :cljs (bindRoot v (f (getRawRoot v))))) + #?(:cljs (bindRoot v (f (getRawRoot v))) + :default (locking v (bindRoot v (f (getRawRoot v)))))) ([v f & args] - #?(:clj - (locking v (bindRoot v (apply f (getRawRoot v) args))) - :cljs (bindRoot v (apply f (getRawRoot v) args))))) + #?(:cljs (bindRoot v (apply f (getRawRoot v) args)) + :default (locking v (bindRoot v (apply f (getRawRoot v) args)))))) (comment (def v1 (SciVar. (fn [] 0) 'foo nil)) diff --git a/src/sci/lang.cljc b/src/sci/lang.cljc index 142e2b13..32bd6312 100644 --- a/src/sci/lang.cljc +++ b/src/sci/lang.cljc @@ -3,12 +3,13 @@ [sci.impl.types :as types] [sci.impl.vars :as vars] #?(:cljs [sci.impl.unrestrict :refer [*unrestricted*]])) - (:refer-clojure :exclude [Var ->Var var? Namespace ->Namespace])) + (:refer-clojure :exclude [Var ->Var var? Namespace ->Namespace]) + #?(:cljr (:import [System.Threading Thread]))) -#?(:clj (set! *warn-on-reflection* true)) +#?(:cljs nil :default (set! *warn-on-reflection* true)) -;; marker interface for vars, clj only for now -#?(:clj (definterface ^{:doc "Marker interface for SCI vars."} IVar)) +;; marker interface for vars, clj{r} only for now +#?(:cljs nil :default (definterface ^{:doc "Marker interface for SCI vars."} IVar)) (defn- class-name [s] (if-let [i (str/last-index-of s ".")] @@ -21,40 +22,28 @@ s)) (deftype ^{:doc "Representation of a SCI custom type, created e.g. with `(defrecord Foo [])`. The fields of this type are implementation detail and should not be accessed directly."} - Type [^:volatile-mutable data - ^:volatile-mutable namespace - ^:volatile-mutable name] + #?(:cljr SciCustomType ;;Type is System.Type in ClojureCLR + :default Type) + [^:volatile-mutable data + ^:volatile-mutable namespace + ^:volatile-mutable name] sci.impl.types/IBox (getVal [_] data) (setVal [_ v] (set! data v)) Object - (toString [_] + (#?(:cljr ToString :default toString) [_] (str (:sci.impl/type-name data))) ;; meta is only supported to get our implementation! keys out - #?@(:clj - [clojure.lang.IMeta - (meta [_] data)] - :cljs + #?@(:cljs [IMeta - (-meta [_] data)]) + (-meta [_] data)] + :default + [clojure.lang.IMeta + (meta [_] data)]) ;; we need to support Named for `derive` - #?@(:clj - [clojure.lang.Named - (getNamespace [this] - (if (nil? namespace) - (let [ns (package-name (str this))] - (set! namespace ns) - ns) - namespace)) - (getName [this] - (if (nil? name) - (let [nom (class-name (str this))] - (set! name nom) - nom) - name))] - :cljs + #?@(:cljs [INamed (-namespace [this] (if (nil? namespace) @@ -67,13 +56,28 @@ (let [nom (class-name (str this))] (set! name nom) nom) - name))])) + name))] + :default + [clojure.lang.Named + (getNamespace [this] + (if (nil? namespace) + (let [ns (package-name (str this))] + (set! namespace ns) + ns) + namespace)) + (getName [this] + (if (nil? name) + (let [nom (class-name (str this))] + (set! name nom) + nom) + name))])) -#?(:clj (defmethod print-method Type [this w] - (.write ^java.io.Writer w (str this)))) +#?(:cljs nil + :clj (defmethod print-method Type [this w] (.write ^java.io.Writer w (str this))) + :cljr (defmethod print-method SciCustomType [this w] (.Write ^System.IO.TextWriter w (str this)))) (defn- throw-root-binding [this] - (throw (#?(:clj IllegalStateException. :cljs js/Error.) + (throw (#?(:clj IllegalStateException. :cljs js/Error. :cljr InvalidOperationException.) (str "Can't change/establish root binding of " this " with set")))) (defn notify-watches [ref watches old-val new-val] @@ -89,20 +93,20 @@ (deftype ^{:doc "Representation of a SCI var, created e.g. with `(defn foo [])` The fields of this type are implementation detail and should not be accessed directly."} - Var [#?(:clj ^:volatile-mutable root - :cljs ^:mutable root) + Var [#?(:cljs ^:mutable root + :default ^:volatile-mutable root) sym - #?(:clj ^:volatile-mutable meta - :cljs ^:mutable meta) - #?(:clj ^:volatile-mutable thread-bound - :cljs ^:mutable thread-bound) - #?(:clj ^:volatile-mutable needs-ctx - :cljs ^:mutable needs-ctx) - #?(:clj ^:volatile-mutable watches - :cljs ^:mutable watches)] - #?(:clj - ;; marker interface, clj only for now - sci.lang.IVar) + #?(:cljs ^:mutable meta + :default ^:volatile-mutable meta) + #?(:cljs ^:mutable thread-bound + :default ^:volatile-mutable thread-bound) + #?(:cljs ^:mutable needs-ctx + :default ^:volatile-mutable needs-ctx) + #?(:cljs ^:mutable watches + :default ^:volatile-mutable watches)] + #?@(:cljs [] :default + ;; marker interface, clj only for now + [sci.lang.IVar]) types/HasName (getName [_this] (or (:name meta) sym)) @@ -139,35 +143,38 @@ types/IBox (setVal [this v] (if-let [b (vars/get-thread-binding this)] - #?(:clj + #?(:cljs (types/setVal b v) + :default (let [t (.-thread b)] - (if (not (identical? t (Thread/currentThread))) - (throw (IllegalStateException. + (if (not (identical? t #?(:clj (Thread/currentThread) + :cljr (Thread/CurrentThread)))) + (throw (#?(:clj IllegalStateException. :cljr InvalidOperationException.) (format "Can't set!: %s from non-binding thread" (vars/toSymbol this)))) - (types/setVal b v))) - :cljs (types/setVal b v)) - #?(:clj (throw-root-binding this) - :cljs (if *unrestricted* + (types/setVal b v)))) + #?(:cljs (if *unrestricted* (set! (.-root this) v) - (throw-root-binding this))))) + (throw-root-binding this)) + :default (throw-root-binding this)))) (getVal [_this] root) - #?(:clj clojure.lang.IDeref :cljs IDeref) - (#?(:clj deref - :cljs -deref) [this] + #?(:cljs IDeref :default clojure.lang.IDeref) + (#?(:cljs -deref + :default deref) [this] (if thread-bound (if-let [tbox (vars/get-thread-binding this)] (types/getVal tbox) root) root)) Object - (toString [this] + (#?(:cljr ToString :default toString) [this] (str "#'" (vars/toSymbol this))) #?(:cljs IPrintWithWriter) #?(:cljs (-pr-writer [a writer opts] (-write writer "#'") (-pr-writer (vars/toSymbol a) writer opts))) - #?(:clj clojure.lang.IMeta :cljs IMeta) - #?(:clj (clojure.core/meta [_] meta) :cljs (-meta [_] meta)) + #?@(:cljs [IMeta + (-meta [_] meta)] + :default [clojure.lang.IMeta + (meta [_] meta)]) ;; #?(:clj Comparable :cljs IEquiv) ;; (-equiv [this other] ;; (if (instance? Var other) @@ -176,23 +183,16 @@ ;; #?(:clj clojure.lang.IHashEq :cljs IHash) ;; (-hash [_] ;; (hash-symbol sym)) - #?(:clj clojure.lang.IReference) - #?(:clj (alterMeta [this f args] - (vars/with-writeable-var this meta - (locking this (set! meta (apply f meta args)))))) - #?(:clj (resetMeta [this m] - (vars/with-writeable-var this meta - (locking this (set! meta m))))) - #?@(:clj [clojure.lang.IRef - (addWatch [this key fn] - (vars/with-writeable-var this meta - (set! watches (assoc watches key fn))) - this) - (removeWatch [this key] - (vars/with-writeable-var this meta - (set! watches (dissoc watches key))) - this)] - :cljs [IWatchable + #?@(:cljs [] + :default + [clojure.lang.IReference + (alterMeta [this f args] + (vars/with-writeable-var this meta + (locking this (set! meta (apply f meta args))))) + (resetMeta [this m] + (vars/with-writeable-var this meta + (locking this (set! meta m))))]) + #?@(:cljs [IWatchable (-add-watch [this key fn] (vars/with-writeable-var this meta (set! watches (assoc watches key fn))) @@ -200,61 +200,69 @@ (-remove-watch [this key] (vars/with-writeable-var this meta (set! watches (dissoc watches key))) - this)]) + this)] + :default [clojure.lang.IRef + (addWatch [this key fn] + (vars/with-writeable-var this meta + (set! watches (assoc watches key fn))) + this) + (removeWatch [this key] + (vars/with-writeable-var this meta + (set! watches (dissoc watches key))) + this)]) ;; #?(:cljs Fn) ;; In the real CLJS this is there... why? - #?(:clj clojure.lang.IFn :cljs IFn) - (#?(:clj invoke :cljs -invoke) [this] + #?(:cljs IFn :default clojure.lang.IFn) + (#?(:cljs -invoke :default invoke) [this] (@this)) - (#?(:clj invoke :cljs -invoke) [this a] + (#?(:cljs -invoke :default invoke) [this a] (@this a)) - (#?(:clj invoke :cljs -invoke) [this a b] + (#?(:cljs -invoke :default invoke) [this a b] (@this a b)) - (#?(:clj invoke :cljs -invoke) [this a b c] + (#?(:cljs -invoke :default invoke) [this a b c] (@this a b c)) - (#?(:clj invoke :cljs -invoke) [this a b c d] + (#?(:cljs -invoke :default invoke) [this a b c d] (@this a b c d)) - (#?(:clj invoke :cljs -invoke) [this a b c d e] + (#?(:cljs -invoke :default invoke) [this a b c d e] (@this a b c d e)) - (#?(:clj invoke :cljs -invoke) [this a b c d e f] + (#?(:cljs -invoke :default invoke) [this a b c d e f] (@this a b c d e f)) - (#?(:clj invoke :cljs -invoke) [this a b c d e f g] + (#?(:cljs -invoke :default invoke) [this a b c d e f g] (@this a b c d e f g)) - (#?(:clj invoke :cljs -invoke) [this a b c d e f g h] + (#?(:cljs -invoke :default invoke) [this a b c d e f g h] (@this a b c d e f g h)) - (#?(:clj invoke :cljs -invoke) [this a b c d e f g h i] + (#?(:cljs -invoke :default invoke) [this a b c d e f g h i] (@this a b c d e f g h i)) - (#?(:clj invoke :cljs -invoke) [this a b c d e f g h i j] + (#?(:cljs -invoke :default invoke) [this a b c d e f g h i j] (@this a b c d e f g h i j)) - (#?(:clj invoke :cljs -invoke) [this a b c d e f g h i j k] + (#?(:cljs -invoke :default invoke) [this a b c d e f g h i j k] (@this a b c d e f g h i j k)) - (#?(:clj invoke :cljs -invoke) [this a b c d e f g h i j k l] + (#?(:cljs -invoke :default invoke) [this a b c d e f g h i j k l] (@this a b c d e f g h i j k l)) - (#?(:clj invoke :cljs -invoke) [this a b c d e f g h i j k l m] + (#?(:cljs -invoke :default invoke) [this a b c d e f g h i j k l m] (@this a b c d e f g h i j k l m)) - (#?(:clj invoke :cljs -invoke) [this a b c d e f g h i j k l m n] + (#?(:cljs -invoke :default invoke) [this a b c d e f g h i j k l m n] (@this a b c d e f g h i j k l m n)) - (#?(:clj invoke :cljs -invoke) [this a b c d e f g h i j k l m n o] + (#?(:cljs -invoke :default invoke) [this a b c d e f g h i j k l m n o] (@this a b c d e f g h i j k l m n o)) - (#?(:clj invoke :cljs -invoke) [this a b c d e f g h i j k l m n o p] + (#?(:cljs -invoke :default invoke) [this a b c d e f g h i j k l m n o p] (@this a b c d e f g h i j k l m n o p)) - (#?(:clj invoke :cljs -invoke) [this a b c d e f g h i j k l m n o p q] + (#?(:cljs -invoke :default invoke) [this a b c d e f g h i j k l m n o p q] (@this a b c d e f g h i j k l m n o p q)) - (#?(:clj invoke :cljs -invoke) [this a b c d e f g h i j k l m n o p q r] + (#?(:cljs -invoke :default invoke) [this a b c d e f g h i j k l m n o p q r] (@this a b c d e f g h i j k l m n o p q r)) - (#?(:clj invoke :cljs -invoke) [this a b c d e f g h i j k l m n o p q r s] + (#?(:cljs -invoke :default invoke) [this a b c d e f g h i j k l m n o p q r s] (@this a b c d e f g h i j k l m n o p q r s)) - (#?(:clj invoke :cljs -invoke) [this a b c d e f g h i j k l m n o p q r s t] + (#?(:cljs -invoke :default invoke) [this a b c d e f g h i j k l m n o p q r s t] (@this a b c d e f g h i j k l m n o p q r s t)) - (#?(:clj invoke :cljs -invoke) [this a b c d e f g h i j k l m n o p q r s t rest] + (#?(:cljs -invoke :default invoke) [this a b c d e f g h i j k l m n o p q r s t rest] (apply @this a b c d e f g h i j k l m n o p q r s t rest)) - #?(:clj - (applyTo [this args] - (apply @this args)))) + #?@(:cljs [] + :default [(applyTo [this args] (apply @this args))])) -#?(:clj +#?(:cljs nil :default ;; Use public interface for print-method so it can be overriden in bb itself - (do (defmethod print-method sci.lang.IVar [o ^java.io.Writer w] - (.write w (str "#'" (vars/toSymbol ^sci.impl.vars.IVar o)))) + (do (defmethod print-method sci.lang.IVar [o #?(:clj ^java.io.Writer w :cljr ^System.IO.TextWriter w :default w)] + (#?(:clj .write :cljr :Write) w (str "#'" (vars/toSymbol ^sci.impl.vars.IVar o)))) (prefer-method print-method sci.lang.IVar clojure.lang.IDeref))) (deftype @@ -262,19 +270,22 @@ "Representation of a SCI namespace, created e.g. with `(create-ns 'foo)`. The fields of this type are implementation detail and should not be accessed directly."} - Namespace [name #?(:clj ^:volatile-mutable meta - :cljs ^:mutable meta)] + Namespace [name #?(:cljs ^:mutable meta + :default ^:volatile-mutable meta)] Object - (toString [_] + (#?(:cljr ToString :default toString) [_] (str name)) types/HasName (getName [_] name) - #?(:clj clojure.lang.IMeta :cljs IMeta) - #?(:clj (clojure.core/meta [_] meta) :cljs (-meta [_] meta)) - #?(:clj clojure.lang.IReference) - #?(:clj (alterMeta [this f args] - (vars/with-writeable-namespace this meta - (locking this (set! meta (apply f meta args)))))) - #?(:clj (resetMeta [this m] - (vars/with-writeable-namespace this meta - (locking this (set! meta m)))))) + #?@(:cljs [IMeta + (-meta [_] meta)] + :default [clojure.lang.IMeta + (clojure.core/meta [_] meta) + + clojure.lang.IReference + (alterMeta [this f args] + (vars/with-writeable-namespace this meta + (locking this (set! meta (apply f meta args))))) + (resetMeta [this m] + (vars/with-writeable-namespace this meta + (locking this (set! meta m))))])) diff --git a/test/sci/core_test.cljc b/test/sci/core_test.cljc index 2018028a..45f513d4 100644 --- a/test/sci/core_test.cljc +++ b/test/sci/core_test.cljc @@ -3,11 +3,15 @@ [clojure.edn :as edn] [clojure.string :as str] [clojure.test :as test :refer [deftest is testing]] - #?(:clj [sci.ctx-store :as store]) + #?@(:cljs [] :default [[sci.ctx-store :as store]]) [sci.copy-ns-test-ns] [sci.core :as sci :refer [eval-string]] [sci.impl.unrestrict :as unrestrict] - [sci.test-utils :as tu])) + [sci.test-utils :as tu]) + #?@(:cljs [] + :default [(:import + #?(:cljr [System.Threading Thread]) + [clojure.lang ExceptionInfo])])) #?(:cljs (def Exception js/Error)) @@ -22,28 +26,29 @@ (reverse (map #(:name (meta %)) (:testing-vars (test/get-current-env)))) " (" file ":" line (when column (str ":" column)) ")")))) -#?(:clj +#?(:cljs (defmethod cljs.test/report [:cljs.test/default :begin-test-var] [m] + (println "===" (-> m testing-vars-str)) + (println)) + :default (defmethod clojure.test/report :begin-test-var [m] (println "===" (-> m :var meta :name)) - (println)) - :cljs (defmethod cljs.test/report [:cljs.test/default :begin-test-var] [m] - (println "===" (-> m testing-vars-str)) - (println))) + (println))) -#?(:clj +#?(:cljs nil :default (defmethod clojure.test/report :end-test-var [_m] (let [{:keys [:fail :error]} @test/*report-counters*] - (when (and (= "true" (System/getenv "SCI_FAIL_FAST")) + (when (and (= "true" (#?(:clj System/getenv :cljr System.Environment/GetEnvironmentVariable) "SCI_FAIL_FAST")) (or (pos? fail) (pos? error))) (println "=== Failing fast") - (System/exit 1))))) + (#?(:clj System/exit :cljr System.Environment/Exit) 1))))) (defn eval* ([form] (eval* nil form)) ([binding form] (tu/eval* form {:bindings {'*in* binding} :classes #?(:clj {'java.lang.IllegalArgumentException java.lang.IllegalArgumentException} - :cljs {})}))) + :cljs {} + :cljr {'System.InvalidOperationException System.InvalidOperationException})}))) (deftest core-test (testing "do can have multiple expressions" @@ -60,13 +65,13 @@ (is (= 2 (eval* 1 '(if (zero? *in*) 1 2)))) (is (= 10 (eval* "(if true 10 20)"))) (is (= 20 (eval* "(if false 10 20)"))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"Too few arguments to if" + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"Too few arguments to if" (eval* '(if)))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"Too few arguments to if" + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"Too few arguments to if" (eval* '(if 1)))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"Too many arguments to if" + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"Too many arguments to if" (eval* '(if 1 2 3 4)))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"Too many arguments to if" + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"Too many arguments to if" (eval* '(if 1 2 3 4 5)))) (is (= 1 (eval* 0 '(when (zero? *in*) 1)))) (is (nil? (eval* 1 '(when (zero? *in*) 1)))) @@ -198,7 +203,7 @@ (deftest fn-test #_(is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) #"arg" + #?(:cljs js/Error :default Exception) #"arg" (eval* '((fn foo [x] (if (< x 3) (foo 1 (inc x)) x)) 0)))) (is (= 3 (eval* '((fn foo [x] (if (< x 3) (foo (inc x)) x)) 0)))) (is (= [2 3] (eval* '((fn foo [[x & xs]] xs) [1 2 3])))) @@ -210,18 +215,18 @@ (is (= "otherwise" (eval* '((fn ([x] "otherwise") ([x & xs] "variadic")) 1)))) (is (= "variadic" (eval* '((fn ([x] "otherwise") ([x & xs] "variadic")) 1 2)))) (is (= '(2 3 4) (eval* '(apply (fn [x & xs] xs) 1 2 [3 4])))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"Can't have fixed arity function with more params than variadic function" (eval* " (fn ([& args]) ([v ]))"))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"Can't have more than 1 variadic overload" (eval* " (fn ([& args]) ([v & args]))")))) (deftest pre-post-conditions-test - (is (thrown-with-msg? #?(:clj Throwable :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"Assert failed: \(pos\? x\)" (eval* "(def f (fn ([x] {:pre [(pos? x)]} x) ([x y] (+ x y)))) (f -1)"))) - (is (thrown-with-msg? #?(:clj Throwable :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"Assert failed: \(< % 10\)" (eval* "(def f (fn ([x] {:pre [(pos? x)]} x) ([x y] {:post [(< % 10)]} (+ x y)))) (f 5 10)")))) @@ -302,14 +307,14 @@ (deftest resolve-test (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) #"x" + #?(:cljs js/Error :default Exception) #"x" (eval* "#(inc x)"))) (testing "as->" (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) #"y" + #?(:cljs js/Error :default Exception) #"y" (eval* "(defn foo [] (as-> y x (inc y)))"))) (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) #"y" + #?(:cljs js/Error :default Exception) #"y" (eval* "(defn foo [] (as-> 10 x (inc y)))")))) (is (= 1 (eval* "((symbol \"do\") {'do 1})"))) (is (= 1 (eval* "(let [x 'do] (x {'do 1}))"))) @@ -319,115 +324,178 @@ (is (= 1 (eval* "((symbol \"recur\") {'recur 1})"))) (is (= [true false] (eval* "(mapv (comp some? resolve) '[inc x])"))) (is (= [1 nil] (eval* "(def a 1) [@(resolve 'a) (resolve '{a 1} 'a)]"))) - #?(:clj + #?(:cljs nil :default (testing "type hints" (sci/eval-string (binding [*print-meta* true] - (pr-str '(let [http-url "https://www.clojure.org" - conn ^java.net.HttpURLConnection (.openConnection (java.net.URL. http-url))] - (.connect conn)))) + (pr-str #?(:clj '(let [http-url "https://www.clojure.org" + conn ^java.net.HttpURLConnection (.openConnection (java.net.URL. http-url))] + (.connect conn)) + :cljr '(let [http-url "https://www.clojure.org" + conn ^System.Net.WebRequest (System.Net.WebRequest/Create http-url)] + (.GetResponse conn))))) {:namespaces {'clojure.core {'slurp slurp}} - :classes {'java.net.HttpURLConnection java.net.HttpURLConnection - 'java.net.URL java.net.URL}}) + :classes #?(:clj {'java.net.HttpURLConnection java.net.HttpURLConnection + 'java.net.URL java.net.URL} + :cljr {'System.Net.WebRequest System.Net.WebRequest})}) (sci/eval-string (binding [*print-meta* true] - (pr-str '(let [http-url "https://www.clojure.org"] - (let [conn (.openConnection (java.net.URL. http-url))] - (.getHeaderFieldKey ^java.net.HttpURLConnection conn 0))))) + (pr-str #?(:clj '(let [http-url "https://www.clojure.org"] + (let [conn (.openConnection (java.net.URL. http-url))] + (.getHeaderFieldKey ^java.net.HttpURLConnection conn 0))) + :cljr '(let [http-url "https://www.clojure.org"] + (let [conn (System.Net.WebRequest/Create http-url)] + (.Headers conn)))))) {:namespaces {'clojure.core {'slurp slurp}} - :classes {'java.net.HttpURLConnection java.net.HttpURLConnection - 'java.net.URL java.net.URL}}))) + :classes #?(:clj {'java.net.HttpURLConnection java.net.HttpURLConnection + 'java.net.URL java.net.URL} + :cljr {'System.Net.WebRequest System.Net.WebRequest})}))) #?(:clj (is (nil? (sci/eval-string "(resolve 'java.lang.Exception/foo)" {:classes {'java.lang.Exception java.lang.Exception}}))) - :cljs (is (nil? (sci/eval-string "(resolve 'js/Error)" {:classes {'js #js {:Error js/Error}}})))) + :cljs (is (nil? (sci/eval-string "(resolve 'js/Error)" {:classes {'js #js {:Error js/Error}}}))) + :cljr (is (nil? (sci/eval-string "(resolve 'System.Exception/foo)" + {:classes {'System.Exception System.Exception}})))) (is (= 1 (eval* "((binding [*ns* 'user] (resolve 'inc)) 0)"))) (is (= 2 (eval* "(def x 2) (let [x 1 x #'x] @x)"))) (is (thrown-with-msg? Exception #"dude" (eval* "(defn foo [] #'dude)"))) (is (thrown-with-msg? Exception #"inc" (sci/eval-string "(defn foo [] #'inc)" {:deny '[inc]})))) -#?(:clj +#?(:cljs nil :default (deftest type-hint-let-test - (is (= (BigDecimal. 42) - (sci/eval-string " -(defn- nested-hint [^Number n] - ;; .longValue is available on Number, should work - (let [^BigDecimal n (.add (BigDecimal. (.longValue n)) (BigDecimal. 2))] - ;; .abs is available on BigDecimal but not non Number, should work - (.abs n))) - -(nested-hint (BigDecimal. -44))" - {:classes {'BigDecimal BigDecimal :allow :all}}))))) - -#?(:clj + (is (= (#?(:clj BigDecimal. :cljr Decimal.) + 42) + (sci/eval-string + #?(:clj "(defn- nested-hint [^Number n] + ;; .longValue is available on Number, should work + (let [^BigDecimal n (.add (BigDecimal. (.longValue n)) (BigDecimal. 2))] + ;; .abs is available on BigDecimal but not non Number, should work + (.abs n))) + + (nested-hint (BigDecimal. -44))" + :cljr "(defn nested-hint [^System.Numerics.Complex n] + ;; .Magnitude is available as an instance property on Complex, should work + (let [^System.Numerics.Complex n (.Add n (System.Numerics.Complex. 2 0))] + ;; .Magnitude is available on Complex but not on non-hinted types, should work + (System.Decimal. (* (.Magnitude n) 42)))) + + (nested-hint (System.Numerics.Complex. 1 0))") + {:classes (assoc #?(:clj {'BigDecimal BigDecimal} + :cljr {'System.Numerics.Complex System.Numerics.Complex}) + :allow :all)}))))) + +#?(:cljs nil :default (deftest type-hint-let-pops-after-nest-test (try - (sci/eval-string " -(defn- nested-hint [^Number n] - (let [^BigDecimal n (BigDecimal. -123)] - ;; .abs is available on BigDecimal but not non Number, should work - (.abs n)) - ;; longValue is available on Number, should work - (.longValue n) - ;; precision is not available on BigDecimal but not on Number, should throw - (.precision n)) - -(nested-hint (BigDecimal. -42))" - {:classes {'BigDecimal BigDecimal :allow :all}}) + (sci/eval-string + #?(:clj "(defn nested-hint [^Number n] + (let [^BigDecimal n (BigDecimal. -123)] + ;; .abs is available on BigDecimal but not non Number, should work + (.abs n)) + ;; longValue is available on Number, should work + (.longValue n) + ;; precision is not available on BigDecimal but not on Number, should throw + (.precision n)) + (nested-hint (BigDecimal. -42))" + :cljr "(defn nested-hint [^System.IConvertible n] + (let [^System.Decimal n (System.Decimal. -123)] + ;; .ToString is available on Decimal but not non IConvertible, should work + (.ToString n)) + ;; ToInt64 is available on IConvertible, should work + (.ToInt64 n nil) + ;; Scale is not available on Decimal but not on IConvertible, should throw + (.Scale n)) + (nested-hint (System.Decimal. -42))") + {:classes (assoc #?(:clj {'BigDecimal BigDecimal} + :cljr {'System.Decimal System.Decimal}) + :allow :all)}) (is false "expected a throw") (catch Exception e - (is (= "precision" (-> e ex-data :message))))))) + (is (= #?(:clj "precision" :cljr "Scale" :default ::new-platform) + (-> e ex-data :message))))))) -#?(:clj +#?(:cljs nil :default (deftest type-hint-shadowed-def-test - (is (= (BigDecimal. 42) - (sci/eval-string " -(def ^Number n (BigDecimal. 17)) - -(defn- foo [^BigDecimal n] - ;; .abs is available on BigDecimal but not non Number, should work - (.abs n)) - -(foo (BigDecimal. 42))" - {:classes {'BigDecimal BigDecimal :allow :all}}))))) - -#?(:clj + (is (= #?(:clj (BigDecimal. 42) + :cljr (Decimal. 42) + :default ::new-platform) + (sci/eval-string + #?(:clj "(def ^Number n (BigDecimal. 17)) + (defn foo [^BigDecimal n] + ;; .abs is available on BigDecimal but not non Number, should work + (.abs n)) + (foo (BigDecimal. 42))" + :cljr "(def ^System.IConvertible n (System.Decimal. 17)) + (defn foo [^System.Decimal n] + ;; .ToString is available on Decimal but not non IConvertible, should work + (.ToString n)) + (foo (System.Decimal. 42))") + {:classes (assoc #?(:clj {'BigDecimal BigDecimal} + :cljr {'System.Decimal System.Decimal}) + :allow :all) }))))) + +#?(:cljs nil :default (deftest type-hint-catch-test (is (= "message" - (sci/eval-string " -(defn foo [^Number x] - (try - (throw (ex-info \"message\" {})) - (catch Exception x - ;; .getMessage is available on Exception, should work - (.getMessage x)))) - -(foo (BigDecimal. 42))" - {:classes {'BigDecimal BigDecimal :allow :all}}))))) - -#?(:clj + (sci/eval-string + #?(:clj "(defn foo [^Number x] + (try + (throw (ex-info \"message\" {})) + (catch Exception x + ;; .getMessage is available on Exception, should work + (.getMessage x)))) + (foo (BigDecimal. 42))" + :cljr "(defn foo [^System.IConvertible x] + (try + (throw (System.Exception. \"message\")) + (catch System.Exception x + ;; .Message is available on System.Exception, should work + (.Message x)))) + (foo (System.Decimal. 42))") + {:classes (assoc #?(:clj {'BigDecimal BigDecimal} + :cljr {'System.Decimal System.Decimal}) + :allow :all)}))))) + +#?(:cljs nil :default (deftest type-hint-letfn-test - (is (= (BigDecimal. 33) - (sci/eval-string " -(defn foo [^Number bar] - (letfn [(myfn [^BigDecimal bar] - ;; .abs is available on BigDecimal but not non Number, should work - (.abs bar))] - (myfn (BigDecimal. 33)))) - -(foo (BigDecimal. 42))" - {:classes {'BigDecimal BigDecimal :allow :all}}))))) - -#?(:clj + (is (= #?(:clj (BigDecimal. 33) + :cljr (Decimal. 33) + :default ::new-platform) + (sci/eval-string + #?(:clj "(defn foo [^Number bar] + (letfn [(myfn [^BigDecimal bar] + ;; .abs is available on BigDecimal but not non Number, should work + (.abs bar))] + (myfn (BigDecimal. 33)))) + (foo (BigDecimal. 42))" + :cljr "(defn foo [^System.IConvertible bar] + (letfn [(myfn [^System.Decimal bar] + ;; .ToString is available on Decimal but not non IConvertible, should work + (.ToString bar))] + (myfn (System.Decimal. 33)))) + (foo (System.Decimal. 42))") + {:classes (assoc #?(:clj {'BigDecimal BigDecimal} + :cljr {'System.Decimal System.Decimal}) + :allow :all)}))))) + +#?(:cljs nil :default (deftest type-hint-fn-test - (is (= (BigDecimal. 99) - (sci/eval-string " -(defn foo [^Number x] - (fn [^BigDecimal x] - ;; .abs is available on BigDecimal but not non Number, should work - (.abs x))) - -((foo (BigDecimal. -72)) (BigDecimal. -99))" - {:classes {'BigDecimal BigDecimal :allow :all}}))))) + (is (= #?(:clj (BigDecimal. 99) + :cljr (Decimal. 99) + :default ::new-platform) + (sci/eval-string + #?(:clj "(defn foo [^Number x] + (fn [^BigDecimal x] + ;; .abs is available on BigDecimal but not non Number, should work + (.abs x))) + ((foo (BigDecimal. -72)) (BigDecimal. -99))" + :cljr "(defn foo [^System.IConvertible x] + (fn [^System.Decimal x] + ;; .ToString is available on Decimal but not non IConvertible, should work + (.ToString x))) + ((foo (System.Decimal. -72)) (System.Decimal. -99))") + {:classes (assoc #?(:clj {'BigDecimal BigDecimal} + :cljr {'System.Decimal System.Decimal}) + :allow :all)}))))) (deftest ns-resolve-test (is (= 'join (eval* "(ns foo (:require [clojure.string :refer [join]])) (ns bar) (-> (ns-resolve 'foo 'join) meta :name)")))) @@ -440,7 +508,7 @@ (str/includes? (with-out-str (try (tu/eval* "(defn foo []) (foo) (println \"hello\") (defn bar [] x)" {:bindings {'println println}}) - (catch #?(:clj Exception :cljs js/Error) _ nil))) + (catch #?(:cljs js/Error :default Exception) _ nil))) "hello")))) (testing "nil as last expression returns nil as a whole" (is (nil? (eval* "1 2 nil"))))) @@ -454,11 +522,11 @@ (deftest permission-test (is (tu/eval* "(int? 1)" {:allow '[int?]})) (is (tu/eval* "(int? 1)" {:deny '[double?]})) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"allowed" (tu/eval* "(int? 1)" {:allow '[boolean?]}))) (is (= 3 (tu/eval* "(do (defn foo []) 3)" {:allow nil :deny []}))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"allowed" (tu/eval* "(defn foo [])" {:allow '[fn*]}))) (if tu/native? @@ -477,16 +545,16 @@ (is (tu/eval* (str (list `#(let [x %] x) 10)) {:allow '[fn* let let*]})) (is (= [2 3 4] (sci/eval-string "(impl/mapv inc [1 2 3])" {:allow '[impl/mapv inc] :namespaces {'impl {'mapv mapv}}}))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"allowed" (tu/eval* "(loop [] (recur))" {:deny '[loop*]}))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"allowed" (tu/eval* "(clojure.core/loop [] (recur))" {:deny '[loop*]}))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"allowed" (tu/eval* "(clojure.core/loop [] (recur))" {:deny '[recur]}))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"allowed" (tu/eval* "(clojure.core/inc 1)" {:deny '[clojure.core/inc]}))) @@ -499,17 +567,17 @@ (is (nil? (tu/eval* "(doseq [i [1 2 3]] i)" {:deny '[loop recur]}))) (is (nil? (tu/eval* "(dotimes [i 3] i)" {:deny '[loop recur]}))) (testing "users should not be able to hack around this by messing with metadata" - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"allowed" (tu/eval* "(def allowed-loop (with-meta (symbol \"loop\") {:line :allow})) (defmacro foo [] `(~allowed-loop [])) (foo)" {:deny '[loop* recur]}))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"allowed" (tu/eval* "(let [allowed-loop (with-meta (symbol \"loop\") {:line :allow})] (defmacro foo [] `(~allowed-loop []))) (foo)" {:deny '[loop* recur]})))) (testing "but it should be forbidden in macros that are defined by a user" - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"allowed" (tu/eval* "(defmacro foo [] `(loop [])) (foo)" {:deny '[loop* recur]}))))) (testing "users cannot hack around sci.impl/needs-ctx" @@ -536,13 +604,13 @@ (tu/assert-submap {:type :sci/error, :line 1, :column 15, :message #"Wrong number of args \(1\) passed to: user/foo"} (try (eval* "(defn foo []) (foo 1)") - (catch #?(:clj clojure.lang.ExceptionInfo :cljs ExceptionInfo) ex + (catch ExceptionInfo ex (let [d (ex-data ex)] d)))) (tu/assert-submap {:type :sci/error, :line 1, :column 21, :message #"Wrong number of args \(0\) passed to: user/foo"} (try (eval* "(defn foo [x & xs]) (foo)") - (catch #?(:clj clojure.lang.ExceptionInfo :cljs ExceptionInfo) ex + (catch ExceptionInfo ex (let [d (ex-data ex)] d)))) (tu/assert-submap {:type :sci/error, :line 3, :column 12, @@ -550,19 +618,19 @@ (try (eval* " (defmacro bindings [a] (zipmap (mapv #(list 'quote %) (keys &env)) (keys &env))) (let [x 1] (bindings))") - (catch #?(:clj clojure.lang.ExceptionInfo :cljs ExceptionInfo) ex + (catch ExceptionInfo ex (let [d (ex-data ex)] d)))) #_(tu/assert-submap {:type :sci/error, :line 1, :column 25, :message #"Wrong number of args \(0\) passed to: user/foo"} (try (eval* (str "(defmacro foo [x & xs]) " "(foo)")) - (catch #?(:clj clojure.lang.ExceptionInfo :cljs ExceptionInfo) ex + (catch ExceptionInfo ex (let [d (ex-data ex)] d)))))) (deftest disable-arity-checks-test - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"Cannot call foo with 1 arguments" (sci/eval-string "(defn foo ([]) ([x y])) (foo 1)" {:disable-arity-checks true})))) @@ -640,16 +708,16 @@ (defn throws-tail-ex [expr] (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) + #?(:cljs js/Error :default Exception) #"Can only recur from tail position" (sci/eval-string (pr-str expr))) (str "FAIL: does not throw recur exception: " expr))) (defn it-works [expr] (is (any? (sci/eval-string (pr-str expr) - #?(:clj {:classes {'String String}} - :cljs {:classes {:allow :all - 'js js/global}}))) + #?(:cljs {:classes {:allow :all + 'js js/global}} + :default {:classes {'String String}}))) (str "FAIL: " expr))) (deftest recur-test @@ -689,8 +757,8 @@ (throws-tail-ex '(letfn [(f ([x] (f x 1)) ([x y] (+ x y)))] (f 1) (recur))) (throws-tail-ex '(letfn [(f [x] (recur 1) (f x 1))])) (it-works '(letfn [(f [x] (recur 1))])) - (throws-tail-ex '(fn [] (new #?(:clj String :cljs js/Error) (recur)))) - (it-works '(fn [] (new #?(:clj String :cljs js/Error) (fn [] (recur))))) + (throws-tail-ex '(fn [] (new #?(:cljs js/Error :default String) (recur)))) + (it-works '(fn [] (new #?(:cljs js/Error :default String) (fn [] (recur))))) (throws-tail-ex '(fn [] (throw (recur)))) #?(:cljs (it-works '(fn [] (throw (fn [] (recur)))))) (throws-tail-ex '(fn [] (.length (recur)))) @@ -722,8 +790,9 @@ (is (thrown-with-msg? Exception #"Cannot recur across try" (sci/eval-string "(defn foo [] (try (recur)))"))) - #?(:clj (do (throws-tail-ex '(String/new (recur))) - (throws-tail-ex '(String/.length (recur))))))) + #?(:cljs nil :default + (do (throws-tail-ex '(String/new (recur))) + (throws-tail-ex '(#?(:clj String/.length :cljr String/.Length) (recur))))))) (deftest loop-test (is (= 2 (tu/eval* "(loop [[x y] [1 2]] (if (= x 3) y (recur [(inc x) y])))" {}))) @@ -766,16 +835,16 @@ (eval* " (defn when []) (defn nth []) (for [[_ counts] [[1 [1 2 3]] [3 [1 2 3]]] c counts] c)"))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"vector" (eval* "(for 1 [i j])"))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"even" (eval* "(for [:dude] [i j])"))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"keyword" (eval* "(for [x [1 2 3] :dude []] [i j])"))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"args" (eval* "(for 1 2 3)")))) @@ -794,7 +863,7 @@ (cond (string? x) 1 (int? x) 2))"))) (is (= 2 (eval* "(let [x 2] (cond (string? x) 1 :else 2))"))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"even" (eval* "(let [x 2] (cond (string? x) 1 :else))")))) @@ -817,18 +886,20 @@ (is (= 7 (eval* "(case (inc 2), 1 true, 2 (+ 1 2 3), 7)"))) (is (= 6 (eval* "(case (inc 2), 1 true, (2 3) (+ 1 2 3), 7)"))) (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) + #?(:cljs js/Error :default Exception) #"(?i)duplicate case test constant" (eval* "(case (inc 2), 1 true, 1 false)"))) (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) + #?(:cljs js/Error :default Exception) #"matching clause" - #?(:clj (eval* " -(try (case (inc 2), 1 true, 2 (+ 1 2 3)) - (catch java.lang.IllegalArgumentException e - (throw (Exception. (ex-message e)))))") - :cljs (eval* "(case (inc 2), 1 true, 2 (+ 1 2 3))")))) - #?(:clj + #?(:clj (eval* "(try (case (inc 2), 1 true, 2 (+ 1 2 3)) + (catch java.lang.IllegalArgumentException e + (throw (Exception. (ex-message e)))))") + :cljs (eval* "(case (inc 2), 1 true, 2 (+ 1 2 3))") + :cljr (eval* "(try (case (inc 2), 1 true, 2 (+ 1 2 3)) + (catch System.InvalidOperationException e + (throw (Exception. (ex-message e)))))")))) + #?(:cljs nil :default (testing "case generated by macro" (is (= :yolo (eval* @@ -855,34 +926,34 @@ (is (= 2 (eval* "(defn foo [fn] (fn 1)) (foo inc)")))) (deftest throw-test - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"foo" - #?(:clj (eval* "(throw (Exception. \"foo\"))") - :cljs (eval* "(throw (js/Error. \"foo\"))"))))) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"foo" + #?(:cljs (eval* "(throw (js/Error. \"foo\"))") + :default (eval* "(throw (Exception. \"foo\"))"))))) (deftest try-catch-finally-throw-test (when-not tu/native? (let [state (atom nil)] - (is (zero? (tu/eval* #?(:clj "(try (mapv 1 [1 2 3]) - (catch Exception _e 0) - (finally (reset! state :finally)))" - :cljs "(try (mapv 1 [1 2 3]) + (is (zero? (tu/eval* #?(:cljs "(try (mapv 1 [1 2 3]) (catch js/Error _e 0) - (finally (reset! state :finally)))") + (finally (reset! state :finally)))" + :default "(try (mapv 1 [1 2 3]) + (catch Exception _e 0) + (finally (reset! state :finally)))") {:bindings {'state state 'reset! reset!}}))) (is (= :finally @state)))) - #?@(:clj + #?@(:cljs + [(is (= :foo (eval* "(try (mapv 1 [1 2 3]) (catch js/Error e :foo))"))) + (when-not tu/native? + (tu/assert-submap {:type :sci/error, :line 1, :column 6, :a 1} + (eval* "(try (throw (ex-info \"\" {:a 1})) (catch js/Error e (ex-data e)))")))] + :default [(is (nil? (eval* "(try (mapv 1 [1 2 3]) (catch Exception e nil))"))) (when-not tu/native? (tu/assert-submap {:type :sci/error, :line 1, :column 4} (try (eval* " (/ 1 0)") - (catch Exception e (ex-data e)))))] - :cljs - [(is (= :foo (eval* "(try (mapv 1 [1 2 3]) (catch js/Error e :foo))"))) - (when-not tu/native? - (tu/assert-submap {:type :sci/error, :line 1, :column 6, :a 1} - (eval* "(try (throw (ex-info \"\" {:a 1})) (catch js/Error e (ex-data e)))")))]) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"Foo" + (catch Exception e (ex-data e)))))]) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"Foo" (eval* "(try 1 (catch Foo e e))"))) (testing "try block can have multiple expressions" (is (= 3 (eval* "(try 1 2 3)")))) @@ -937,12 +1008,23 @@ (hash-test) "))) (is (= 2 (count (re-seq #"__auto__" (tu/eval* "(str `(let [x# 1] `~x#))" nil))))) - #?(:clj (when-not tu/native? - (is (= "foo" (tu/eval* " -(defmacro pat [s] `(java.util.regex.Pattern/compile ~s)) -(def p (pat \"foo\")) (re-find p \"foo\")" - {:classes {'java.util.regex.Pattern java.util.regex.Pattern}}))))) - #?(:clj (is (= 'java.lang.Exception (eval* "`Exception")))) + #?(:cljs nil :default + (when-not tu/native? + (is (= "foo" + #?(:clj (tu/eval* + "(defmacro pat [s] `(java.util.regex.Pattern/compile ~s)) + (def p (pat \"foo\")) + (re-find p \"foo\")" + {:classes {'java.util.regex.Pattern java.util.regex.Pattern}}) + :cljr (tu/eval* + "(defmacro pat [s] `(System.Text.RegularExpressions.Regex. ~s)) + (def p (pat \"foo\")) + (let [m (.Match p \"foo\")] + (.Value m))" + {:classes {'System.Text.RegularExpressions.Regex System.Text.RegularExpressions.Regex}})))))) + #?(:cljs nil :default + (is (= #?(:clj 'java.lang.Exception :cljr 'System.Exception) + (eval* "`Exception")))) (is (= 'foo/x (eval* "(ns foo) (def x) (ns bar (:require [foo :refer [x]])) `x"))) (is (= 'foo/inc (eval* "(ns foo (:refer-clojure :exclude [inc])) `inc"))) (is (= 'foo/inc (eval* "(ns foo) (defn inc []) `inc"))) @@ -989,10 +1071,11 @@ (deftest try-catch-test (is (zero? (tu/eval* "(try #?(:clj (/ 1 0) :cljs (1 1)) - (catch #?(:clj ArithmeticException :cljs js/Error) _ 0))" + (catch #?(:clj ArithmeticException :cljs js/Error :cljr ArithmeticException) _ 0))" {:read-cond :allow - :features #?(:clj #{:clj} - :cljs #{:cljs})}))) + :features #{#?(:clj :clj + :cljs :cljs + :cljr :cljr)}}))) (is (= 4 (eval* "(def x 1) (try (pos? x) (def y (+ 1 2 x)) @@ -1005,43 +1088,44 @@ (eval* "((fn foo [x] (if (= 72 x) x (foo (inc x)))) 0)"))))) (deftest syntax-errors - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"simple symbol" + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"simple symbol" (eval* "(def f/b 1)"))) (when-not tu/native? (is (thrown-with-data? {:line 1} (eval* "(def f/b 1)")))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"Too many arguments to def" + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"Too many arguments to def" (eval* "(def -main [] 1)"))) (is (= 1 (eval* "(def x \"foo\" 1) x"))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"simple symbol" + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"simple symbol" (eval* "(defn f/b [])"))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"missing" + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"missing" (eval* "(defn foo)"))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"vector" + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"vector" (eval* "(defn foo ())"))) (is (eval* "(def *clause* \"During formatting, *clause* is bound to :select, :from, :where, etc.\" nil)"))) (deftest ex-message-test - (is (= "foo" #?(:clj (eval* "(ex-message (Exception. \"foo\"))") - :cljs (eval* "(ex-message (js/Error. \"foo\"))"))))) + (is (= "foo" #?(:cljs (eval* "(ex-message (js/Error. \"foo\"))") + :default (eval* "(ex-message (Exception. \"foo\"))"))))) (deftest assert-test (when-not tu/native? (is (thrown-with-msg? - #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) + ExceptionInfo #"should-be-true" (eval* "(def should-be-true false) (assert should-be-true)"))) (let [d (try (eval* "(def should-be-true false) (assert should-be-true)") - (catch #?(:clj clojure.lang.ExceptionInfo :cljs js/Error) e (ex-data e)))] + (catch #?(:cljs js/Error :default ExceptionInfo) e (ex-data e)))] (is (= 1 (:line d))))) (sci/binding [sci/assert true] (sci/eval-string "(set! *assert* false) (assert false)")) (sci/binding [sci/assert true] (sci/eval-string "(set! *assert* true) (try (assert false) - (catch #?(:clj java.lang.AssertionError :cljs js/Error) e :dude))" - {:features #?(:clj #{:clj} - :cljs #{:cljs})}))) + (catch #?(:clj AssertionError :cljs js/Error :cljr Exception) e :dude))" + {:features #{#?(:clj :clj + :cljs :cljs + :cljr :cljr)}}))) (deftest dotimes-test (when-not tu/native? @@ -1099,8 +1183,8 @@ (deftest macroexpand-1-test (is (= [1 1] (eval* "(defmacro foo [x] `[~x ~x]) (macroexpand-1 '(foo 1))"))) (is (= '(if 1 1 (clojure.core/cond)) (eval* "(macroexpand-1 '(cond 1 1))"))) - (is (= #?(:clj 'clojure.core/let - :cljs 'cljs.core/let) + (is (= #?(:cljs 'cljs.core/let + :default 'clojure.core/let) (first (eval* "(macroexpand-1 '(for [x [1 2 3]] x))")))) (is (= '(user/bar 1) (eval* "(defmacro foo [x] `(bar ~x)) (defmacro bar [x] x) (macroexpand-1 '(foo 1))"))) (is (= '(foobar) (eval* "(defmacro foo [] '(foobar)) (macroexpand '(foo))"))) @@ -1197,20 +1281,20 @@ (deftest readers-test (when-not tu/native? - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"No reader function" (tu/eval* "#x/str 5" {}))) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"No reader function" (tu/eval* "#x/str 5" {}))) (is (string? (tu/eval* "#x/str 5" {:readers {'x/str str}}))) (let [res (tu/eval* "#example.Record{:foo 1}" {:readers {'example.Record map->ReaderTestRecord}})] (is (record? res))))) (deftest built-in-vars-are-read-only-test (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) #"read-only" + #?(:cljs js/Error :default Exception) #"read-only" (tu/eval* "(alter-var-root #'clojure.core/inc (constantly dec)) (inc 2)" {}))) (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) #"read-only" + #?(:cljs js/Error :default Exception) #"read-only" (tu/eval* "(alter-meta! #'clojure.core/inc assoc :foo)" {}))) (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) #"read-only" + #?(:cljs js/Error :default Exception) #"read-only" (tu/eval* "(alter-meta! #'-> dissoc :macro)" {})))) (deftest tagged-literal-test @@ -1232,11 +1316,11 @@ (deftest read-string-eval-test (is (= 3 (eval* "(load-string \"1 2 3\")"))) (is (= 'user (eval* "(load-string \"(ns bar)\") (ns-name *ns*)"))) - #?(:clj (is (= :foo (eval* "(with-in-str \":foo\" (read))")))) + #?(:cljs nil :default (is (= :foo (eval* "(with-in-str \":foo\" (read))")))) (is (= :foo (eval* "(def f (load-string \"(with-meta (fn [ctx] :foo) {:sci.impl/op 'needs-ctx})\")) (f 1)"))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"loop.*allowed" + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"loop.*allowed" (tu/eval* "(eval (read-string \"(loop [] (recur))\"))" {:deny '[loop]}))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"loop.*allowed" + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"loop.*allowed" (tu/eval* "(load-string \"(loop [] (recur))\")" {:deny '[loop]}))) (is (nil? (meta (tu/eval* "(read-string \"(+ 1 2 3)\")" nil))))) @@ -1261,7 +1345,7 @@ (is (= 3 (do (sci/eval-string* forked "(def y 3)") (sci/eval-string* forked "y")))) (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) + #?(:cljs js/Error :default Exception) #"Unable to resolve symbol: y" (sci/eval-string* ctx "y")))))) (defmacro do-twice [x] `(do ~x ~x)) @@ -1298,8 +1382,8 @@ (with-meta (persistent! (reduce-kv (fn [acc k v] (assoc! acc k (f v))) - (if #?(:clj (instance? clojure.lang.IEditableCollection m) - :cljs (implements? IEditableCollection m)) + (if #?(:cljs (implements? IEditableCollection m) + :default (instance? clojure.lang.IEditableCollection m)) (transient m) (transient {})) m)) @@ -1323,7 +1407,7 @@ (is (thrown-with-data? {:line 1 :column 2} (sci/eval-string " (clojure.string/includes? nil :foo)"))) - #?(:clj + #?(:cljs nil :default (is (thrown-with-data? {:line 1 :column 2} (sci/eval-string " (throw (Exception.))"))))) @@ -1355,8 +1439,9 @@ (deftest instance?-test (is (false? (eval* "(defrecord Foo []) (instance? Foo 1)"))) (is (true? (eval* "(defrecord Foo []) (instance? Foo (->Foo))"))) - #?(:clj (is (true? (eval* "(instance? Number 1)")))) - (is (thrown? #?(:clj Exception :cljs js/Error) (eval* "(instance? 'Foo 1)")))) + #?(:clj (is (true? (eval* "(instance? Number 1)"))) + :cljr (is (true? (eval* "(instance? System.Int64 1)")))) + (is (thrown? #?(:cljs js/Error :default Exception) (eval* "(instance? 'Foo 1)")))) (deftest threading-macro-test (testing "->" @@ -1417,14 +1502,14 @@ (deftest macro-val-error-test (is (thrown-with-msg? - #?(:clj Exception :cljs :default) #"value of a macro" + #?(:cljs :default :default Exception) #"value of a macro" (eval* "(defmacro foo []) foo"))) (is (thrown-with-msg? - #?(:clj Exception :cljs :default) #"value of a macro" + #?(:cljs :default :default Exception) #"value of a macro" (eval* "->"))) (testing "throw at analysis time" (is (thrown-with-msg? - #?(:clj Exception :cljs :default) #"value of a macro" + #?(:cljs :default :default Exception) #"value of a macro" (eval* "(defmacro foo []) (defn bar [] foo)"))))) (deftest var-isnt-fn @@ -1436,16 +1521,16 @@ (testing "This is an implementation detail of Clojure, but we use it to check if we really create hash-maps here" (is (false? (eval* "(= (range 100) (keys (zipmap (range 100) (range 100))))"))))) -#?(:clj - (deftest merge-opts-test - (let [ctx (sci/init {:classes {'System System}}) - ctx2 (sci/merge-opts ctx {:classes {'Thread Thread}})] - (is (sci/eval-string* ctx2 "System Thread")))) - :cljs +#?(:cljs (deftest merge-opts-test (let [ctx (sci/init {:classes {'js goog/global :allow :all}}) ctx2 (sci/merge-opts ctx {:namespaces {}})] - (is (sci/eval-string* ctx2 "(try (assoc 1 1 1) (catch js/Error e 12))"))))) + (is (sci/eval-string* ctx2 "(try (assoc 1 1 1) (catch js/Error e 12))")))) + :default + (deftest merge-opts-test + (let [ctx (sci/init {:classes {'String String}}) + ctx2 (sci/merge-opts ctx {:classes {'Thread Thread}})] + (is (sci/eval-string* ctx2 "String Thread"))))) (deftest merge-opts-with-new-vars-test (let [C (atom (sci/init {:namespaces {'n {'foo 1}}}))] @@ -1454,7 +1539,7 @@ (is (= 2 (sci/eval-form @C 'n/foo))))) (deftest merge-opts-preserves-features-test - (let [ctx(sci/init {:features #{:cljs}})] + (let [ctx (sci/init {:features #{:cljs}})] (is (= 2 (sci/eval-string* ctx "#?(:clj 1 :cljs 2)"))) (is (= 2 (sci/eval-string* (sci/merge-opts ctx {}) "#?(:clj 1 :cljs 2)"))))) @@ -1498,13 +1583,13 @@ (deftest eval-file-meta-test (testing "error during analysis" (let [data (try (sci/eval-string "^{:clojure.core/eval-file \"dude.clj\"} (identity (hi))") - (catch #?(:clj Exception :cljs :default) e + (catch #?(:cljs :default :default Exception) e (ex-data e)))] (is (= "analysis" (:phase data))) (is (= "dude.clj" (:file data))))) (testing "error at runtime" (let [data (try (sci/eval-string "^{:clojure.core/eval-file \"dude.clj\"} (let [x :foo] (assoc x :hello 1))") - (catch #?(:clj Exception :cljs :default) e + (catch #?(:cljs :default :default Exception) e (ex-data e)))] (is (= "dude.clj" (:file data))))) (testing "eval at runtime" @@ -1595,7 +1680,7 @@ (aget an-array idx))))")] (is (= [1 2 3 4 5] mapped-array)))) -#?(:clj +#?(:cljs nil :default (deftest clojure-version-test (is (str/ends-with? (sci/eval-string "(clojure-version)") "SCI")) (is (str/ends-with? (:qualifier (sci/eval-string "*clojure-version*")) @@ -1637,11 +1722,13 @@ (is (= 1 (sci/eval-string "(clojure.dude/inc 0)" {:ns-aliases '{clojure.dude clojure.core}})))) -#?(:clj +#?(:cljs nil :default (deftest sandbox-print-method-test (is (thrown-with-msg? - Exception #"allowed" - (sci/eval-string "(defmethod print-method Integer [x w])"))))) + Exception #"allowed" + (sci/eval-string + #?(:clj "(defmethod print-method Integer [x w])" + :cljr "(defmethod print-method System.Int64 [x w])")))))) (deftest memfn-test (is (true? (sci/eval-string "((memfn startsWith prefix) \"abc\" \"a\")" {:classes {:allow :all}})))) @@ -1707,15 +1794,15 @@ (is (= #queue [1 2 3] (sci/eval-string "#queue [1 2 3]"))))) (deftest time-test - #?(:clj - (let [output (java.io.StringWriter.)] - (is (= 1 (sci/binding [sci/out output] (sci/eval-string "(time 1)")))) - (is (re-matches #"\"Elapsed time: \d\.\d+ msecs\"\s*" (str output)))) - :cljs + #?(:cljs (let [output (atom "") print-fn #(swap! output str %)] (is (= 1 (sci/binding [sci/print-fn print-fn] (sci/eval-string "(time 1)" {:classes {'js js/globalThis :allow :all}})))) - (is (re-matches #"\"Elapsed time: \d\.\d+ msecs\"\s*" @output))))) + (is (re-matches #"\"Elapsed time: \d\.\d+ msecs\"\s*" @output))) + :default + (let [output (#?(:clj java.io.StringWriter. :cljr System.IO.StringWriter.))] + (is (= 1 (sci/binding [sci/out output] (sci/eval-string "(time 1)")))) + (is (re-matches #"\"Elapsed time: \d\.\d+ msecs\"\s*" (str output)))))) #?(:cljs (deftest exists?-test @@ -1732,7 +1819,7 @@ (is (false? (sci/eval-string "(exists? console.log)" {:classes {'js js/globalThis :allow :all}}))))) -#?(:clj +#?(:cljs nil :default (deftest macros-can-be-used-with-apply-test (let [ctx (sci/init {})] (store/with-ctx ctx diff --git a/test/sci/error_test.cljc b/test/sci/error_test.cljc index 0542316c..ad96e9de 100644 --- a/test/sci/error_test.cljc +++ b/test/sci/error_test.cljc @@ -1,5 +1,5 @@ (ns sci.error-test - (:require #?(:clj [sci.addons.future :as fut]) + (:require #?@(:cljs [] :default [[sci.addons.future :as fut]]) #?(:cljs [clojure.string :as str]) [clojure.test :as t :refer [deftest testing is]] [sci.core :as sci :refer [eval-string]])) @@ -12,8 +12,8 @@ (defn bar [] (subs nil 0)) (defn foo [] (bar)) (foo)") - (catch #?(:clj Exception - :cljs js/Error) e + (catch #?(:cljs js/Error + :default Exception) e (map #(-> % (select-keys [:ns :name :line :column])) (sci/stacktrace e)))) @@ -29,24 +29,24 @@ (is (= expected stacktrace))) (let [stacktrace (try (eval-string "(1 2 3)") - (catch #?(:clj Exception - :cljs js/Error) e + (catch #?(:cljs js/Error + :default Exception) e (map #(-> % (select-keys [:ns :name :line :column])) (sci/stacktrace e))))] (is (= '({:ns user, :name nil, :line 1, :column 1}) stacktrace))) (testing "unresolved class in import" (let [stacktrace (try (eval-string "(ns foo (:import [java.io FooBar]))") - (catch #?(:clj Exception - :cljs js/Error) e + (catch #?(:cljs js/Error + :default Exception) e (map #(-> % (select-keys [:ns :name :line :column])) (sci/stacktrace e))))] (is (= '({:ns foo, :name nil, :line 1, :column 9}) stacktrace)))) (testing "local" (let [stacktrace (try (eval-string "(defn foo []) (defn g [x] (x 1)) (g (foo))") - (catch #?(:clj Exception - :cljs :default) e + (catch #?(:cljs :default + :default Exception) e (sci/stacktrace e)))] (is (= '({:ns user, :name g, :file nil} {:ns user, :file nil, :line 1, :column 27, :name g} @@ -63,17 +63,18 @@ (testing "defn does not introduce fn-named local binding" (let [locals (try (eval-string "(defn foo [x] (subs nil 0)) (foo :x)") - (catch #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) e + (catch #?(:cljs cljs.core/ExceptionInfo :default clojure.lang.ExceptionInfo) e (:locals (ex-data e)))) ks (keys locals)] (is (= '[x] ks))))) -#?(:clj (deftest arity-error-test - (testing "The name of the correct function is reported" - (is (thrown-with-msg? - #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) - #"Wrong number of args \(0\) passed to: foo/echo-msg" - (eval-string " +#?(:cljs nil :default + (deftest arity-error-test + (testing "The name of the correct function is reported" + (is (thrown-with-msg? + #?(:cljs cljs.core/ExceptionInfo :default clojure.lang.ExceptionInfo) + #"Wrong number of args \(0\) passed to: foo/echo-msg" + (eval-string " (ns foo) (defn echo-msg [msg] @@ -86,20 +87,20 @@ (main)")))))) -#?(:clj +#?(:cljs nil :default (deftest arity-error-hof-test (testing "apply is not reported when higher order argument causes arity error" (is (thrown-with-msg? - #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) + clojure.lang.ExceptionInfo #"Wrong number of args \(1\) passed to: function of arity 0" (eval-string "(apply (fn []) [1])"))) (is (thrown-with-msg? - #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) + clojure.lang.ExceptionInfo #"Wrong number of args \(3\) passed to: function of arity 1" (eval-string "(apply (fn [_]) [1 2 3])"))) (testing "varargs" (is (thrown-with-msg? - #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) + clojure.lang.ExceptionInfo #"Wrong number of args \(0\) passed to: function of arity 1" (eval-string "(apply (fn [_ & xs]) [])"))))))) @@ -116,10 +117,10 @@ (defn throwing-fn [] (throw (ex-info \"ex-message\" {:column 3}))) (throwing-fn)") - (catch #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) e + (catch #?(:cljs cljs.core/ExceptionInfo :default clojure.lang.ExceptionInfo) e [(dissoc (ex-data e) :sci.impl/callstack :locals) (ex-data #?(:clj (.getCause e) - :cljs (ex-cause e)))])))))) + :default (ex-cause e)))])))))) (deftest implicit-do-error-test (let [expected {:type :sci/error @@ -128,7 +129,7 @@ :message "Assert failed: false"} try-string #(try (eval-string %) - (catch #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core/ExceptionInfo) e + (catch #?(:cljs cljs.core/ExceptionInfo :default clojure.lang.ExceptionInfo) e (dissoc (ex-data e) :sci.impl/callstack :file)))] (testing "top level try with implicit do wraps exception" (is (= expected @@ -144,13 +145,13 @@ (is (= ["user - NO_SOURCE_PATH:1:1"] (sci/format-stacktrace - (sci/stacktrace (try (sci/eval-string "(def n x)") (catch #?(:clj Exception :cljs js/Error) e e))))))) + (sci/stacktrace (try (sci/eval-string "(def n x)") (catch #?(:cljs js/Error :default Exception) e e))))))) (deftest try-finally-test (is (= ["clojure.core/assoc - " "user/foo - NO_SOURCE_PATH:1:14" "user/foo - NO_SOURCE_PATH:1:1" "user - NO_SOURCE_PATH:1:84" "user - NO_SOURCE_PATH:1:65"] (sci/format-stacktrace - (sci/stacktrace (try (sci/eval-string "(defn foo [] (assoc :foo :bar :baz)) (def ^:dynamic *foo* nil ) (binding [*foo* 3] (foo))") (catch #?(:clj Exception :cljs js/Error) e e))))))) + (sci/stacktrace (try (sci/eval-string "(defn foo [] (assoc :foo :bar :baz)) (def ^:dynamic *foo* nil ) (binding [*foo* 3] (foo))") (catch #?(:cljs js/Error :default Exception) e e))))))) (deftest macroexpansion-with-unresolved-symbol-has-location-test (let [data (try (sci/eval-string "(defmacro dude [& body] `(do ~@body)) (dude x)") (catch Exception e (ex-data e)))] @@ -160,26 +161,26 @@ #?(:clj (deftest preserve-exception-type-in-threads-test (is (= java.lang.IllegalArgumentException - (sci/eval-string " -(def f (future (throw (IllegalArgumentException. \"meh\")))) -(try @f - (catch Throwable e - (type (ex-cause e))))" - (-> {:classes {'IllegalArgumentException IllegalArgumentException - 'Throwable Throwable}} - (fut/install))))))) + (sci/eval-string + "(def f (future (throw (IllegalArgumentException. \"meh\")))) + (try @f + (catch Throwable e + (type (ex-cause e))))" + (-> {:classes {'IllegalArgumentException IllegalArgumentException + 'Throwable Throwable}} + (fut/install)))))) + :cljr + (deftest preserve-exception-type-in-threads-test + (is (= System.ArgumentException + (sci/eval-string + "(def f (future (throw (System.ArgumentException. \"meh\")))) + (try @f + (catch System.Exception e + (type (ex-cause e))))" + (-> {:classes {'System.ArgumentException System.ArgumentException + 'System.Exception System.Exception}} + (fut/install))))))) -#?(:clj - (deftest thread-test - (let [invoke-ex-fn - (fn [f] - (try - (f) - (catch Throwable e - (ex-data e))))] - (let [f (sci.core/eval-string "(fn [] (try (/ 1 0) (catch ^:sci/error Exception e (throw e))))")] - (is (let [res @(future (invoke-ex-fn f))] - (is (= {:line 1 :column 13} (select-keys res [:line :column]))))))))) (deftest destructure-test (doseq [[snippet [line col]] diff --git a/test/sci/hello_world_test.cljc b/test/sci/hello_world_test.cljc new file mode 100644 index 00000000..5bd81e74 --- /dev/null +++ b/test/sci/hello_world_test.cljc @@ -0,0 +1,132 @@ +(ns sci.hello-world-test + "Basic non-interop tests for SCI evaluation on ClojureCLR. + + These tests verify that SCI works correctly on ClojureCLR + without relying on Java/CLR interop features. + + Note: Tests involving defn, loop/recur, destructuring, and complex + features that require CLR reflection have been excluded, as the + custom reflector has not yet been ported to C#." + (:require + [clojure.test :as test :refer [deftest is testing]] + [sci.core :as sci])) + +(deftest hello-world-test + (testing "Simple string evaluation" + (is (= "Hello, World!" (sci/eval-string "\"Hello, World!\"")))) + + (testing "Simple arithmetic" + (is (= 3 (sci/eval-string "(+ 1 2)"))) + (is (= 10 (sci/eval-string "(* 2 5)"))) + (is (= 4 (sci/eval-string "(- 7 3)"))) + (is (= 2 (sci/eval-string "(/ 8 4)"))))) + +(deftest literal-test + (testing "Number literals" + (is (= 42 (sci/eval-string "42"))) + (is (= 3.14 (sci/eval-string "3.14")))) + + (testing "Boolean literals" + (is (= true (sci/eval-string "true"))) + (is (= false (sci/eval-string "false")))) + + (testing "Nil literal" + (is (= nil (sci/eval-string "nil")))) + + (testing "String literals" + (is (= "foo" (sci/eval-string "\"foo\"")))) + + (testing "Keyword literals" + (is (= :foo (sci/eval-string ":foo"))) + (is (= :foo/bar (sci/eval-string ":foo/bar")))) + + (testing "Symbol literals" + (is (= 'foo (sci/eval-string "'foo"))))) + +(deftest collection-test + (testing "Vector literals" + (is (= [1 2 3] (sci/eval-string "[1 2 3]"))) + (is (= [] (sci/eval-string "[]")))) + + (testing "List literals" + (is (= '(1 2 3) (sci/eval-string "'(1 2 3)"))) + (is (= '() (sci/eval-string "'()")))) + + (testing "Map literals" + (is (= {:a 1 :b 2} (sci/eval-string "{:a 1 :b 2}"))) + (is (= {} (sci/eval-string "{}")))) + + (testing "Set literals" + (is (= #{1 2 3} (sci/eval-string "#{1 2 3}"))) + (is (= #{} (sci/eval-string "#{}"))))) + +(deftest function-test + (testing "Anonymous functions" + (is (= 10 (sci/eval-string "((fn [x] (* x 2)) 5)"))) + (is (= 7 (sci/eval-string "((fn [a b] (+ a b)) 3 4)")))) + + (testing "Function literals" + (is (= 8 (sci/eval-string "(#(* % 2) 4)"))) + (is (= 15 (sci/eval-string "(#(+ %1 %2) 7 8)"))))) + +(deftest conditional-test + (testing "if expressions" + (is (= :yes (sci/eval-string "(if true :yes :no)"))) + (is (= :no (sci/eval-string "(if false :yes :no)"))) + (is (= nil (sci/eval-string "(if false :yes)")))) + + (testing "when expressions" + (is (= 5 (sci/eval-string "(when true 5)"))) + (is (= nil (sci/eval-string "(when false 5)"))))) + +(deftest sequence-operations-test + (testing "map function" + (is (= [2 4 6] (sci/eval-string "(map #(* % 2) [1 2 3])"))) + (is (= [2 3 4] (sci/eval-string "(map inc [1 2 3])")))) + + (testing "filter function" + (is (= [2 4] (sci/eval-string "(filter even? [1 2 3 4])"))) + (is (= [1 3] (sci/eval-string "(filter odd? [1 2 3 4])")))) + + (testing "reduce function" + (is (= 10 (sci/eval-string "(reduce + [1 2 3 4])"))) + (is (= 24 (sci/eval-string "(reduce * [1 2 3 4])"))))) + +(deftest do-test + (testing "do expressions" + (is (= 3 (sci/eval-string "(do 1 2 3)"))) + (is (= 5 (sci/eval-string "(do (def x 5) x)"))))) + +(deftest def-test + (testing "def creates var" + (is (= 42 (sci/eval-string "(def answer 42) answer"))) + (is (= "hello" (sci/eval-string "(def greeting \"hello\") greeting"))))) + +(deftest macro-test + (testing "Built-in macros work" + (is (= 4 (sci/eval-string "(-> 1 inc inc inc)"))) + (is (= 6 (sci/eval-string "(->> [1 2 3] (reduce +))")))) + + (testing "and/or macros" + (is (= true (sci/eval-string "(and true true)"))) + (is (= false (sci/eval-string "(and true false)"))) + (is (= true (sci/eval-string "(or false true)"))) + (is (= false (sci/eval-string "(or false false)"))))) + +(deftest namespace-test + (testing "Namespace operations" + (is (some? (sci/eval-string "(ns foo.bar) *ns*"))) + (is (= 'foo.bar (sci/eval-string "(ns foo.bar) (ns-name *ns*)"))))) + +(deftest apply-test + (testing "apply function" + (is (= 10 (sci/eval-string "(apply + [1 2 3 4])"))) + (is (= 120 (sci/eval-string "(apply * [2 3 4 5])"))))) + +(deftest comp-test + (testing "comp function" + (is (= [2 3 4] (sci/eval-string "((comp vec (partial map inc)) [1 2 3])"))))) + +(deftest partial-test + (testing "partial function" + (is (= [2 3 4] (sci/eval-string "(map (partial + 1) [1 2 3])"))))) diff --git a/test/sci/interop_test.cljc b/test/sci/interop_test.cljc index cd1d7fea..172d3ca9 100644 --- a/test/sci/interop_test.cljc +++ b/test/sci/interop_test.cljc @@ -6,12 +6,13 @@ [sci.core :as sci] [sci.test-utils :as tu] #?(:cljs [goog.object :as gobj])) + ;;TODO cljr PublicFields + tests #?(:clj (:import PublicFields))) (defn eval* [expr] (tu/eval* expr {})) -#?(:clj +#?(:cljs nil :default (deftest instance-methods (is (= 3 (eval* "(.length \"foo\")"))) (testing "calling instance methods on unconfigured classes is not allowed" @@ -25,8 +26,12 @@ (eval* "(let [^Foo x ^Foo {}] (.foo x))")))) (testing "can get the name of arbitrary class by type hinting it as Object" (when-not tu/native? - (is (= "clojure.core$int_QMARK_" (tu/eval* "(defn foo [^Object x] (.getClass x)) (.getName (foo int?))" - {:classes {'java.lang.Class Class}}))))) + (is (= "clojure.core$int_QMARK_" + #?(:clj (tu/eval* "(defn foo [^Object x] (.getClass x)) (.getName (foo int?))" + {:classes {'java.lang.Class Class}}) + :cljr (tu/eval* "(defn foo [^Object x] (.GetType x)) (.Name (foo int?))" + {:classes {'System.Type Type}}) + :default ::new-platform))))) (testing "resolve target class at analysis time" (is (= "message" (eval* " (ns foo (:import [clojure.lang ExceptionInfo])) @@ -35,10 +40,17 @@ (foo/foo (ex-info \"message\" {}))")))) (testing "map interop" (when-not tu/native? - (is (= #{:a} (tu/eval* "(.keySet {:a 1})" - {:classes {'java.util.Map 'java.util.Map - :public-class (fn [o] - (when (instance? java.util.Map o) java.util.Map))}}))))))) + (is (= #{:a} + #?(:clj (tu/eval* "(.keySet {:a 1})" + {:classes {'java.util.Map 'java.util.Map + :public-class (fn [o] + (when (instance? java.util.Map o) java.util.Map))}}) + :cljr (tu/eval* "(.get_Keys {:a 1})" + {} ;;TODO ? + #_{:classes {'java.util.Map 'java.util.Map + :public-class (fn [o] + (when (instance? java.util.Map o) java.util.Map))}}) + :default ::new-platform))))))) #?(:clj (deftest instance-fields @@ -67,7 +79,7 @@ (testing (pr-str expr) (is (= (eval expr) (tu/eval* (pr-str expr) classes))))))))) -#?(:clj +#?(:cljs nil :default (deftest static-fields (is (= 32 (eval* "Integer/SIZE"))) (is (= 32 (eval* "(Integer/SIZE)"))) @@ -77,12 +89,12 @@ (is (thrown-with-msg? Exception #"Unable to resolve" (eval* "clojure.lang.Var/rev")))))) -#?(:clj +#?(:cljs nil :default (deftest constructor-test (is (= "dude" (eval* "(String. (str \"dude\"))"))) (is (= "dude" (eval* "(new String (str \"dude\"))"))))) -#?(:clj +#?(:cljs nil :default (deftest import-test (is (true? (eval* "(class? (import clojure.lang.ExceptionInfo))"))) (is (some? (eval* "(import clojure.lang.ExceptionInfo) ExceptionInfo"))) @@ -120,12 +132,32 @@ {:imports {'Class 'java.lang.Class} :classes {'java.lang.Class {:class Class :static-methods {'forName (fn [_Class _forName] :dude)}}}}))) + (is (= :dude (sci/eval-string + "(sci.lang.Var/cloneThreadBindings)" + {:classes {'sci.lang.Var {:class sci.lang.Var + :static-methods {'cloneThreadBindings (fn [_Class] :dude)}}}})))) + :cljr + (deftest static-methods + (is (= 123 (eval* "(Int32/Parse \"123\")"))) + (is (= 123 (eval* "(. Int32 (Parse \"123\"))"))) + (is (= 123 (eval* "(. Int32 Parse \"123\")"))) + (is (= 123 (eval* "(Int32/Parse (str \"12\" \"3\") (inc 9))"))) + (is (= 123 (eval* "(defmacro parse-int [x] `(. Int32 (Parse ~x))) + (parse-int \"123\")"))) + (testing "calling static methods on unconfigured classes is not allowed" + (is (thrown-with-msg? Exception #"Unable to resolve" + (eval* "(clojure.lang.Var/find 'clojure.core/int)")))) + (is (= :dude (sci/eval-string + "(Class/forName \"java.lang.String\")" + {:imports {'Class 'java.lang.Class} + :classes {'java.lang.Class {:class Type + :static-methods {'forName (fn [_Class _forName] :dude)}}}}))) (is (= :dude (sci/eval-string "(sci.lang.Var/cloneThreadBindings)" {:classes {'sci.lang.Var {:class sci.lang.Var :static-methods {'cloneThreadBindings (fn [_Class] :dude)}}}}))))) -#?(:clj +#?(:cljs nil :default (deftest clojure-1_12-interop-test (is (= [1 2 3] (eval* "(map Integer/parseInt [\"1\" \"2\" \"3\"])"))) (is (= [1 2 3] (eval* "(map String/.length [\"1\" \"22\" \"333\"])"))) @@ -133,27 +165,29 @@ (is (= 3 (eval* "(String/.length \"123\")"))) (is (= "123" (eval* "(String/new \"123\")"))))) -#?(:clj +#?(:cljs nil :default (when-not tu/native? (deftest clojure-1_12-array-test - (let [byte-1 (class (make-array Byte/TYPE 0)) - byte-3 (class (make-array Byte/TYPE 0 0 0)) + (let [byte-1 (class (make-array #?(:clj Byte/TYPE :cljr Byte) 0)) + byte-3 (class (make-array #?(:clj Byte/TYPE :cljr Byte) 0 0 0)) String-1 (class (make-array String 0))] - (is (= (class (make-array Long/TYPE 0)) (eval* "long/1"))) - (is (= (class (make-array Long/TYPE 0 0)) (eval* "long/2") )) - (is (= (class (make-array Integer/TYPE 0)) (eval* "int/1"))) - (is (= (class (make-array Double/TYPE 0)) (eval* "double/1") )) - (is (= (class (make-array Short/TYPE 0)) (eval* "short/1") )) - (is (= (class (make-array Boolean/TYPE 0)) (eval* "boolean/1"))) + (is (= (class (make-array #?(:clj Long/TYPE :cljr Int64) 0)) (eval* "long/1"))) + (is (= (class (make-array #?(:clj Long/TYPE :cljr Int64) 0 0)) (eval* "long/2") )) + (is (= (class (make-array #?(:clj Integer/TYPE :cljr Int32) 0)) (eval* "int/1"))) + (is (= (class (make-array #?(:clj Double/TYPE :cljr Double) 0)) (eval* "double/1") )) + (is (= (class (make-array #?(:clj Short/TYPE :cljr Int16) 0)) (eval* "short/1") )) + (is (= (class (make-array #?(:clj Boolean/TYPE :cljr Boolean) 0)) (eval* "boolean/1"))) (is (= byte-1 (eval* "byte/1"))) - (is (= (class (make-array Float/TYPE 0)) (eval* "float/1"))) + (is (= (class (make-array #?(:clj Float/TYPE :cljr Single) 0)) (eval* "float/1"))) (is (= (class (make-array String 0)) (eval* "String/1"))) - (is (= String-1 (eval* "java.lang.String/1"))) + (is (= String-1 (eval* #?(:clj "java.lang.String/1" :cljr "System.String/1")))) (is (= (symbol (pr-str byte-1)) (eval* "`byte/1"))) (is (= (symbol (pr-str byte-3)) (eval* "`byte/3"))) - (is (= (symbol "java.util.UUID/1") (eval* "`java.util.UUID/1"))) + #?(:clj (is (= (symbol "java.util.UUID/1") (eval* "`java.util.UUID/1"))) + :cljr (is (= (symbol "System.Guid/1") (eval* "`System.Guid/1")))) (is (= (symbol (pr-str String-1)) (eval* "`String/1"))) - (is (= (symbol (pr-str String-1)) (eval* "`java.lang.String/1"))) + #?(:clj (is (= (symbol (pr-str String-1)) (eval* "`java.lang.String/1"))) + :cljr (is (= (symbol (pr-str String-1)) (eval* "`System.String/1")))) (is (= [(symbol "long/2")] (eval* "['long/2]") (eval* "`[~'long/2]"))))))) (when-not tu/native? @@ -163,9 +197,10 @@ (fn [form] (try (tu/eval* (str form) {:classes {:allow :all - #?@(:clj ['Long Long])}}) + #?@(:clj ['Long Long] + :cljr ['Int64 Int64])}}) (is (= nil "shouldn't reach here") (str form)) - (catch #?(:clj Exception :cljs :default) e + (catch #?(:cljs :default :default Exception) e (ex-data e))))] (testing "instance members" (are [form] @@ -178,7 +213,8 @@ '(. 3 missingMem) '(. 3 missingMem 1 2) '(.missingMem 3) '(.missingMem 3 1 2) ; these return nil in cljs - #?@(:clj ['(.-missingMem 3) '(. 3 -missingMem)]))) + #?@(:cljs [] + :default ['(.-missingMem 3) '(. 3 -missingMem)]))) #?(:clj (testing "static members" (are [form] @@ -192,17 +228,32 @@ '(.missingMem Long) '(.missingMem Long 1 2) '(Long/missingMem) '(Long/missingMem 1 2) '(. Long -missingMem) '(.-missingMem Long) - #_#_'Long/missingMem '(Long/-missingMem)))))))) + #_#_'Long/missingMem '(Long/-missingMem))) + :cljr + (testing "static members" + (are [form] + (let [actual (form-ex-data form)] + (and (tu/submap? {:type :sci/error + :line 1 + :column 1} + actual) + (str/includes? (:message actual) "missingMem"))) + '(. Int64 missingMem) '(. Int64 missingMem 1 2) + '(.missingMem Int64) '(.missingMem Int64 1 2) + '(Int64/missingMem) '(Int64/missingMem 1 2) + '(. Int64 -missingMem) '(.-missingMem Int64) + #_#_'Int64/missingMem '(Int64/-missingMem)))))))) (deftest syntax-test (when-not tu/native? (doseq [expr ["(.)" "(. {})" "(.foo)"]] - (is (thrown-with-msg? #?(:clj IllegalArgumentException :cljs js/Error) + (is (thrown-with-msg? #?(:clj IllegalArgumentException :cljs js/Error :cljr Exception) #"Malformed" (try (eval* expr) - (catch #?(:clj Exception :cljs :default) e - (throw #?(:clj (.getCause e)) - #?(:cljs (.-cause e)))))))))) + (catch #?(:cljs :default :default Exception) e + (throw #?(:clj (.getCause e) + :cljs (.-cause e) + :cljr (ex-cause e)))))))))) ;;;; CLJS @@ -261,14 +312,12 @@ #?(:cljs (when-not (tu/planck-env?) - #?(:cljs - (def fs (let [m (js->clj (js/require "fs"))] - (zipmap (map symbol (keys m)) (vals m))))) - #?(:cljs - (deftest object-as-namespace-test - (is (str/includes? - (tu/eval* "(str (fs/readFileSync \"README.md\"))" {:namespaces {'fs fs}}) - "EPL")))))) + (def fs (let [m (js->clj (js/require "fs"))] + (zipmap (map symbol (keys m)) (vals m)))) + (deftest object-as-namespace-test + (is (str/includes? + (tu/eval* "(str (fs/readFileSync \"README.md\"))" {:namespaces {'fs fs}}) + "EPL"))))) #?(:cljs (deftest js-reader-test @@ -345,7 +394,8 @@ 'java.lang.Runnable java.lang.Runnable 'java.util.concurrent.ExecutorService java.util.concurrent.ExecutorService} :imports {'Runnable 'java.lang.Runnable - 'Callable 'java.util.concurrent.Callable}})) + 'Callable 'java.util.concurrent.Callable}}) + :cljr (println "TODO CLR" `type-hint-config)) #?(:clj (deftest type-hint-test @@ -391,7 +441,8 @@ {:bindings {'resource (io/resource "clojure/core.clj")} :classes {'java.net.URL java.net.URL 'java.net.JarURLConnection java.net.JarURLConnection}})) -)) +) + :cljr (println "TODO CLR" `type-hint-test)) #?(:cljs (deftest issue-987-munged-method-or-property-name-test @@ -408,7 +459,7 @@ (is (= 2 (sci/eval-string "(def x #js {:a 1 :foo_bar #js {:catch 2}}) x.foo-bar.catch" {:classes {'js goog/global}}))) (is (= 3 (sci/eval-string "(let [a #js {:foo_bar #js {:catch 3}}] a.foo-bar.catch)")))))) -#?(:clj +#?(:cljs nil :default (deftest issue-987-deftype-munged-fields-test ;; these cases don't work in CLJS yet because {:classes {:allow :all}} takes the fast path ;; perhaps we can fix this by exposing the deftype as an Object in CLJS with mutated fields diff --git a/test/sci/namespaces_test.cljc b/test/sci/namespaces_test.cljc index 82120578..2a78f1e5 100644 --- a/test/sci/namespaces_test.cljc +++ b/test/sci/namespaces_test.cljc @@ -18,15 +18,15 @@ (is (= "1-2-3" (eval* "(require '[clojure.string :as string]) (string/join \"-\" [1 2 3])"))) (is (= "1-2-3" (eval* "(require '[clojure.string :refer [join]]) (join \"-\" [1 2 3])"))) (is (= "1-2-3" (eval* "(require '[clojure.string :refer :all]) (join \"-\" [1 2 3])"))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"must be a sequential" (eval* "(require '[clojure.string :refer 1]) (join \"-\" [1 2 3])"))) (is (= #{1 4 6 3 2 5} (eval* "(set/union #{1 2 3} #{4 5 6})"))) (is (= #{1 4 6 3 2 5} (eval* "(require '[clojure.set :as s]) (s/union #{1 2 3} #{4 5 6})"))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"clojure.foo" (eval* "(require '[clojure.foo :as s])"))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"quux does not exist" (eval* "(require '[clojure.set :refer [quux]])"))) (is (= [1 2 3] (eval* "(ns foo) (def x 1) (ns bar) (def x 2) (in-ns 'baz) (def x 3) (require 'foo 'bar) [foo/x bar/x x]"))) @@ -49,7 +49,7 @@ (is (= #{1 2} (eval* "(require '[clojure.set :refer [union] :rename {union union2}]) (union2 #{1} #{2})"))) (is (= 16 (eval* "(ns foo (:refer-clojure :rename {bit-shift-left <<})) (<< 8 1)"))) (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) + #?(:cljs js/Error :default Exception) #"Unable to resolve.*bit-shift-left" (eval* "(ns foo (:refer-clojure :rename {bit-shift-left <<})) (bit-shift-left 8 1)")))) (when-not tu/native? @@ -61,7 +61,7 @@ {:source "(ns foo.bar) (def x :success)" :file "foo/bar.clj"}))}))))) (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) + #?(:cljs js/Error :default Exception) #"already refers to" (eval* " (ns foo (:require [clojure.string :refer [split]])) @@ -72,15 +72,15 @@ (is (= #{1 2} (eval* "(use 'clojure.set) (union #{1} #{2})"))) (is (= #{1 2} (eval* "(use '[clojure.set :only [union]]) (union #{1} #{2})"))) (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) + #?(:cljs js/Error :default Exception) #"Unable to resolve.*union" (eval* "(use '[clojure.set :exclude [union]]) (union #{1} #{2})"))) (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) + #?(:cljs js/Error :default Exception) #"Unable to resolve.*union" (eval* "(use '[clojure.set :only [difference]]) (union #{1} #{2})"))) (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) + #?(:cljs js/Error :default Exception) #"already refers to" (eval* " (ns foo (:use clojure.string)) @@ -152,14 +152,14 @@ (import clojure.lang.ExceptionInfo) (some? (get (ns-imports *ns*) 'ExceptionInfo))"))])) (deftest refer-clojure-exclude - (is (thrown? #?(:clj Exception :cljs js/Error) + (is (thrown? #?(:cljs js/Error :default Exception) (eval* "(ns foo (:refer-clojure :exclude [get])) (some? get)"))) (is (true? (eval* "(ns foo (:refer-clojure :exclude [get])) (defn get []) (some? get)")))) (deftest refer-test - (is (thrown? #?(:clj Exception :cljs js/Error) + (is (thrown? #?(:cljs js/Error :default Exception) (eval* "(refer 'clojure.string :only [join]) includes?"))) - (is (thrown? #?(:clj Exception :cljs js/Error) + (is (thrown? #?(:cljs js/Error :default Exception) (eval* "(refer 'clojure.string :exclude [join]) join"))) (is (eval* "(refer 'clojure.string :only '[join]) (some? join)")) (is (eval* "(refer 'clojure.string) (some? join)")) @@ -212,10 +212,10 @@ (deftest find-var-test (is (eval* "(= #'clojure.core/map (find-var 'clojure.core/map))")) (is (eval* "(nil? (find-var 'clojure.core/no-such-symbol))")) - (is (thrown-with-msg? #?(:clj clojure.lang.ExceptionInfo :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default clojure.lang.ExceptionInfo) #"No such namespace: no.such.namespace" (eval* "(find-var 'no.such.namespace/var)"))) - (is (thrown-with-msg? #?(:clj clojure.lang.ExceptionInfo :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default clojure.lang.ExceptionInfo) #"Not a qualified symbol: no-namespace" (eval* "(find-var 'no-namespace)")))) @@ -228,7 +228,7 @@ (deftest ns-unalias-test (testing "Removing an alias in an unknown namespace throws" - (is (thrown? #?(:clj Exception :cljs js/Error) (eval* "(ns-unalias (find-ns 'unknown) 'core)")))) + (is (thrown? #?(:cljs js/Error :default Exception) (eval* "(ns-unalias (find-ns 'unknown) 'core)")))) (testing "Removing an undefined alias is a no-op" (is (nil? (eval* "(ns-unalias *ns* 'core)")))) @@ -241,18 +241,18 @@ (deftest ns-syntax-test (is (thrown-with-msg? - #?(:clj Exception :cljs :default) + #?(:cljs :default :default Exception) #"symbol" (eval* "(ns 1)")))) (deftest nested-libspecs-test (is (= #{1 2 3 4} (eval* "(require '[clojure [set :refer [union]]]) (union #{1 2 3} #{2 3 4})"))) (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) + #?(:cljs js/Error :default Exception) #"lib names inside prefix lists must not contain periods" (eval* "(ns clojure.core.protocols) (ns foo) (require '[clojure [core.protocols]])"))) (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) + #?(:cljs js/Error :default Exception) #"Unsupported option\(s\) supplied: :foo" (eval* "(ns foo (:require [clojure.core] [dude] :foo))"))) (testing "error message contains location" @@ -262,14 +262,14 @@ (deftest cyclic-load-test (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) #"Cyclic load dependency: \[ foo \]->bar->\[ foo \]" + #?(:cljs js/Error :default Exception) #"Cyclic load dependency: \[ foo \]->bar->\[ foo \]" (sci/eval-string "(require 'foo)" {:load-fn (fn [{:keys [:namespace]}] (case namespace foo {:source "(ns foo (:require bar)) bar/x"} bar {:source "(ns bar (:require foo)) (def x)"}))}))) (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) #"Cyclic load dependency: \[ bar \]->foo->\[ bar \]" + #?(:cljs js/Error :default Exception) #"Cyclic load dependency: \[ bar \]->foo->\[ bar \]" (sci/eval-string "(require 'bar)" {:load-fn (fn [{:keys [:namespace]}] (case namespace @@ -304,7 +304,7 @@ bar/bar"} (sci/eval-string* the-ctx "(ns foo) (require '[bar :as b])") (is @success?))) -#?(:clj +#?(:cljs nil :default (defn clojure-meta [name] (-> (resolve (symbol "clojure.core" (str name))) meta))) @@ -315,17 +315,17 @@ bar/bar"} (testing "core function that needs ctx" (doseq [v '[macroexpand find-ns - #?(:clj get-thread-bindings) + #?@(:cljs [] :default [get-thread-bindings]) satisfies? ns-unmap - #?(:clj remove-ns) + #?@(:cljs [] :default [remove-ns]) find-ns - #?(:clj find-var) + #?@(:cljs [] :default [find-var]) ns-publics - #?(:clj ns-unalias) + #?@(:cljs [] :default [ns-unalias]) isa? eval - #?(:clj refer)]] + #?@(:cljs [] :default [refer])]] (is (true? (eval* (str/replace "(string? (:doc (meta #'{{v}})))" "{{v}}" (str v)))) v))) (testing "dynvars" (doseq [v '[*print-namespace-maps* @@ -338,19 +338,19 @@ bar/bar"} (doseq [v `[inc newline pr - #?(:clj push-thread-bindings) + #?@(:cljs [] :default [push-thread-bindings]) ~(when (:doc (meta (resolve 'ex-message))) `ex-message) - #?(:clj swap-vals!) - #?(:clj reset-vals!) + #?@(:cljs [] :default [swap-vals!]) + #?@(:cljs [] :default [reset-vals!]) alength - #?(:clj var-get) - #?(:clj var-set) + #?@(:cljs [] :default [var-get]) + #?@(:cljs [] :default [var-set]) compare-and-set!] :when v] (is (true? (eval* (str/replace "(string? (:doc (meta #'{{v}})))" "{{v}}" (str v)))) v))) (testing "All documented public vars in Clojure should also have a docstring if present in SCI") - #?(:clj + #?(:cljs nil :default (is (empty? (for [[name var] (-> (sci/init {}) :env deref diff --git a/test/sci/protocols_test.cljc b/test/sci/protocols_test.cljc index 05d46ab5..03bc4e41 100644 --- a/test/sci/protocols_test.cljc +++ b/test/sci/protocols_test.cljc @@ -4,8 +4,7 @@ [clojure.string :as str] [clojure.test :refer [deftest is testing]] [sci.core :as sci] - [sci.test-utils :as tu]) - #?(:clj (:import [java.lang Long]))) + [sci.test-utils :as tu])) (deftest protocol-test (let [prog " @@ -56,6 +55,10 @@ :cljs (-> prog (str/replace "String" "js/String") (str/replace "Number" "js/Number") + (str/replace "Object" ":default")) + :cljr (-> prog + (str/replace "String" "System.String") + (str/replace "Number" "Int64") (str/replace "Object" ":default")))] (is (= ["foo-A!" "bar-A!" @@ -67,25 +70,25 @@ :bar/object :fooB/object true] - (tu/eval* prog #?(:clj {} - :cljs {:classes {:allow :all + (tu/eval* prog #?(:cljs {:classes {:allow :all 'js #js {:String js/String - :Number js/Number}}})))))) + :Number js/Number}}} + :default {})))))) (defn eval* [prog] - (tu/eval* #?(:clj prog - :cljs (-> prog + (tu/eval* #?(:cljs (-> prog (str/replace "Object" ":default") - (str/replace "js/:default" "js/Object"))) ;lol - #?(:clj {} - :cljs {:classes {:allow :all + (str/replace "js/:default" "js/Object")) ;lol + :default prog) + #?(:cljs {:classes {:allow :all 'js #js {:Object js/Object :String js/String :Number js/Number :Array js/Array :Function js/Function - :Boolean js/Boolean}}}))) + :Boolean js/Boolean}}} + :default {}))) (deftest docstring-test (is (= "-------------------------\nuser/Foo\n cool protocol\n" (tu/eval* " @@ -139,9 +142,9 @@ (defprotocol Area (get-area [this])) (extend-type String Area (get-area [_] 0)) (extends? Area String)" - prog #?(:clj prog - :cljs (-> prog - (str/replace "String" "js/String")))] + prog #?(:cljs (-> prog + (str/replace "String" "js/String")) + :default prog)] (is (true? (eval* prog)))) (testing "Aliases are allowed and ignored" (testing "extent-type" @@ -155,9 +158,9 @@ (= \"f\" (f/foo \"foo\")) " - prog #?(:clj prog - :cljs (-> prog - (str/replace "String" "js/String")))] + prog #?(:cljs (-> prog + (str/replace "String" "js/String")) + :default prog)] (is (true? (eval* prog))))) (testing "extend-protocol" (let [prog " @@ -170,9 +173,9 @@ (= \"f\" (f/foo \"foo\")) " - prog #?(:clj prog - :cljs (-> prog - (str/replace "String" "js/String")))] + prog #?(:cljs (-> prog + (str/replace "String" "js/String")) + :default prog)] (is (true? (eval* prog))))))) (deftest extend-via-metadata-test @@ -190,8 +193,8 @@ (def x (with-meta {} {`foox (fn [_] 1)})) (foo x)"] - (is (thrown-with-msg? #?(:clj Exception - :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error + :default Exception) #"No implementation of method: :foo of protocol: #'user/Foo found for" (tu/eval* prog {}))))) @@ -209,12 +212,12 @@ "(extend String IFruit {:subtotal (fn ([s] (count s)) ([s discount] (- (count s) discount)))})" "(extend-protocol IFruit String (subtotal ([s] (count s)) ([s discount] (- (count s) discount))))"] :let [prog (prog expr) - prog #?(:clj prog - :cljs (-> prog - (str/replace "String" "js/String")))]] + prog #?(:cljs (-> prog + (str/replace "String" "js/String")) + :default prog)]] (is (= [100 95 3 1] (eval* prog)))))) -#?(:clj +#?(:cljs nil :default (deftest import-test (testing "namespace with hyphen" (let [prog " @@ -242,7 +245,7 @@ [true :object] [true :object]) (eval* (str "(defprotocol IFoo (foo [_])) -(extend-type " #?(:clj "Object" :cljs "default") " IFoo (foo [_] :object)) +(extend-type " #?(:cljs "default" :default "Object") " IFoo (foo [_] :object)) (map #(vector (satisfies? IFoo %) (foo %)) [\"\" 1 inc true [] {}])"))))) @@ -291,7 +294,7 @@ (defrecord Foo [] IFoo (foo [_] :record)) (foo (->Foo))"))))) -#?(:clj +#?(:cljs nil :default (deftest satisfies-host-protocol (let [ns (sci/create-ns 'clojure.core.protocols)] (is (true? (sci/eval-string "(satisfies? clojure.core.protocols/IKVReduce {})" @@ -313,7 +316,7 @@ (is (= [:object :meta] (eval* "(defprotocol Dude :extend-via-metadata true (foo [_])) (extend-type Object Dude (foo [_] :object)) (defrecord Rec []) [(foo (->Rec)) (foo (with-meta {} {'user/foo (fn [_] :meta)}))]")))) -#?(:clj +#?(:cljs nil :default (deftest IRecord-extension-test (testing "without default override" (is (= :record (sci/eval-string "(defprotocol Dude (dude [_])) (extend-protocol Dude clojure.lang.IRecord (dude [_] :record)) (defrecord Foo []) (dude (->Foo))" @@ -366,19 +369,23 @@ (-> "(defprotocol Marker) (extend-type java.lang.Long Marker) (satisfies? Marker 1)" - #?(:cljs (str/replace "java.lang.Long" "number")) + #?(:cljs (str/replace "java.lang.Long" "number") + :cljr (str/replace "java.lang.Long" "System.Int64")) (sci/eval-string #?(:clj {:classes {'java.lang.Long java.lang.Long}} - :cljs {:classes {'js #js {:Number js/Number}}})))))) + :cljs {:classes {'js #js {:Number js/Number}}} + :cljr {:classes {'System.Int64 System.Int64}})))))) (is (true? (sci/binding [sci/out *out*] (-> "(defprotocol Marker) (extend-protocol Marker java.lang.Long) (satisfies? Marker 1)" - #?(:cljs (str/replace "java.lang.Long" "number")) + #?(:cljs (str/replace "java.lang.Long" "number") + :cljr (str/replace "java.lang.Long" "System.Int64")) (sci/eval-string #?(:clj {:classes {'java.lang.Long java.lang.Long}} - :cljs {:classes {'js #js {:Number js/Number}}}))))))) + :cljs {:classes {'js #js {:Number js/Number}}} + :cljr {:classes {'System.Int64 System.Int64}}))))))) (deftest return-value-test @@ -444,5 +451,7 @@ (deftest protocol-satisfies-nil-and-boolean-test (is (true? (eval* "(defprotocol IFoo) (extend-type nil IFoo) (satisfies? IFoo nil)"))) (is (true? (sci/eval-string "(defprotocol IFoo) (extend-type #?(:clj (class true) :cljs boolean) IFoo) (satisfies? IFoo false)" - {:classes #?(:clj nil :cljs {'js #js {:Boolean js/Boolean}}) - :features #?(:clj #{:clj} :cljs #{:cljs})})))) + {:classes #?(:cljs {'js #js {:Boolean js/Boolean}} + :default nil) + :features #?(:cljs #{:cljs} + :default #{:clj})})))) diff --git a/test/sci/proxy_test.clj b/test/sci/proxy_test.cljc similarity index 80% rename from test/sci/proxy_test.clj rename to test/sci/proxy_test.cljc index 4b7faf54..fb578308 100644 --- a/test/sci/proxy_test.clj +++ b/test/sci/proxy_test.cljc @@ -2,6 +2,7 @@ (:require [clojure.test :refer [deftest is testing]] [sci.core :as sci])) +#?(:cljs nil :default (deftest APersistentMap-proxy-test (let [obj (sci/eval-string " @@ -11,8 +12,9 @@ ([k default] (and (instance? clojure.lang.APersistentMap this) [:k k :default default])))) " {:classes {'clojure.lang.APersistentMap clojure.lang.APersistentMap} - :proxy-fn (fn [{:keys [:class :methods]}] - (case (.getName ^Class class) + :proxy-fn (fn [{:keys [class methods]}] + (case #?(:clj (.getName ^Class class) + :cljr (.FullName ^Type class)) "clojure.lang.APersistentMap" (proxy [clojure.lang.APersistentMap] [] (valAt @@ -30,8 +32,9 @@ ([k default] (and (instance? clojure.lang.APersistentMap this) [:k k :default default])))) " {:classes {'clojure.lang.APersistentMap clojure.lang.APersistentMap} - :proxy-fn (fn [{:keys [:class :methods]}] - (case (.getName ^Class class) + :proxy-fn (fn [{:keys [class methods]}] + (case #?(:clj (.getName ^Class class) + :cljr (.FullName ^Type class)) "clojure.lang.APersistentMap" (proxy [clojure.lang.APersistentMap] [] (valAt @@ -40,6 +43,4 @@ (is (= [:k :f] (obj :f))) (is (= [:k :f :default :def] (obj :f :def)))))) - - - +) diff --git a/test/sci/reify_test.cljc b/test/sci/reify_test.cljc index 131f88d7..806df7c2 100644 --- a/test/sci/reify_test.cljc +++ b/test/sci/reify_test.cljc @@ -1,12 +1,11 @@ (ns sci.reify-test - (:require [clojure.test :refer #?(:clj [deftest is testing] - :cljs [deftest is testing])] - #?(:clj [sci.impl.types :as t]) + (:require [clojure.test :refer [deftest is testing]] + #?@(:cljs [] :default [[sci.impl.types :as t]]) [sci.test-utils :as tu]) - #?(:clj (:import [sci.impl.types IReified]))) + #?@(:cljs [] :default [(:import [sci.impl.types IReified])])) (deftest reify-test - #?(:clj + #?(:cljs nil :default [] (do (testing "reifying Object" (is (= "this!" (tu/eval* "(str (reify Object (toString [this] \"this!\")))" nil)))) (testing "metadata" @@ -14,7 +13,7 @@ (tu/eval* "(meta ^{:k :v} (reify Object (toString [this] \"this!\")))" nil))))))) (deftest reify-mixed-protocol-class-test - #?(:clj + #?(:cljs nil :default [] (when-not tu/native? (testing "reifying Object and IDeref" (is (= ["obj-str" "ideref-deref" "protocol-custom"] @@ -58,12 +57,12 @@ [(method r 1 2) (method r 1 2 3)])" nil))))) -#?(:clj +#?(:cljs nil :default [] (do (definterface Interface1 (method [])) (definterface Interface2 (method [first])))) (deftest reify-with-matching-method-names - #?(:clj + #?(:cljs nil :default [] (when-not tu/native? (let [mixed-opts {:classes {'Interface1 Interface1 @@ -153,8 +152,7 @@ (getMethods [this] methods) (getProtocols [this] - protocols))) - }] + protocols)))}] (testing "reify form from macro has (incorrectly) fully qualifed method name" (is (= 2 (tu/eval* @@ -164,4 +162,5 @@ (apply [_# x#] (~f x#)))) (.apply (clj-fn->function inc) 1))) - opts)))))))) + opts)))))) + :cljr (is (= ::TODO nil)))) diff --git a/test/sci/repl_test.cljc b/test/sci/repl_test.cljc index 17a468b7..c7272b2a 100644 --- a/test/sci/repl_test.cljc +++ b/test/sci/repl_test.cljc @@ -18,17 +18,17 @@ user/f Macro foodoc") (str/trim (sci/with-out-str (eval* "(defmacro f \"foodoc\" ([x]) ([x y])) (clojure.repl/doc f)"))))) - (is (= (str/trim #?(:clj " + (is (= (str/trim #?(:cljs " ------------------------- clojure.core/inc ([x]) - Returns a number one greater than num. Does not auto-promote - longs, will throw on overflow. See also: inc'" - :cljs " + Returns a number one greater than num." + :default " ------------------------- clojure.core/inc ([x]) - Returns a number one greater than num.")) + Returns a number one greater than num. Does not auto-promote + longs, will throw on overflow. See also: inc'")) (str/trim (sci/with-out-str (eval* "(clojure.repl/doc inc)"))))) (is (= (str/trim "-------------------------\nfoo\n foodoc\n") @@ -62,7 +62,7 @@ foo-ns (when-not tu/native? (let [output (sci/with-out-str (eval* "(require '[clojure.repl :refer [dir]]) (dir clojure.string)"))] (is (str/includes? output "includes?")))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"No namespace.*found" (eval* "(require '[clojure.repl :refer [dir]]) (dir clojure.typo)")))) @@ -72,13 +72,13 @@ foo-ns (is (contains? symbols 'clojure.string/includes?)))) (deftest repl-pst-test - #?(:clj + #?(:cljs nil :default (when-not tu/native? - (let [sw (java.io.StringWriter.)] + (let [sw (#?(:clj java.io.StringWriter. :cljr System.IO.StringWriter.))] (sci/binding [sci/err sw] (eval* "(try (/ 1 0) (catch Exception e (clojure.repl/pst e 2)))")) (is (str/includes? (str sw) "Divide by zero"))) - (let [sw (java.io.StringWriter.)] + (let [sw (#?(:clj java.io.StringWriter. :cljr System.IO.StringWriter.))] (sci/binding [sci/err sw] (eval* "(try (/ 1 0) (catch Exception e (clojure.repl/pst e 2)))")) (is (str/includes? (str/trim (str sw)) (str/trim " diff --git a/test/sci/test_utils.cljc b/test/sci/test_utils.cljc index b47ea1c8..1f8b5621 100644 --- a/test/sci/test_utils.cljc +++ b/test/sci/test_utils.cljc @@ -1,30 +1,30 @@ (ns sci.test-utils - (:require #?(:clj [edamame.core :as edamame]) + (:require #?@(:cljs [] :default [[edamame.core :as edamame]]) #?(:clj [me.raynes.conch :refer [let-programs] :as sh]) [clojure.test :as test :refer [is]] [sci.core :refer [eval-string]] - #?(:clj [sci.test-utils.macros]) ;; defines thrown-with-data? + #?@(:cljs [] :default [sci.test-utils.macros]) ;; defines thrown-with-data? [sci.test-utils.utils :as u]) #?(:cljs (:require-macros [sci.test-utils.macros]))) (def native? #?(:clj (= "native" (System/getenv "SCI_TEST_ENV")) - :cljs false)) + :default false)) (when native? (println "Testing native version.")) (defn eval* [form ctx] (if #?(:clj (not native?) - :cljs true) + :default true) (eval-string (str form) ctx) #?(:clj (let [v (let-programs [sci "./sci"] (try (sci (str form) (str ctx)) - (catch #?(:clj Exception :cljs :default) e + (catch Exception e (throw (ex-info (:stderr (ex-data e)) (or (ex-data e) {}))))))] (edamame/parse-string v {:all true :location? (constantly false)})) - :cljs nil))) + :default nil))) (def submap? u/submap?) diff --git a/test/sci/test_utils/macros.cljc b/test/sci/test_utils/macros.cljc index 542c90e5..4631f541 100644 --- a/test/sci/test_utils/macros.cljc +++ b/test/sci/test_utils/macros.cljc @@ -1,12 +1,12 @@ (ns sci.test-utils.macros (:require [sci.test-utils.utils] - #?(:clj [clojure.test :as test]) - [cljs.test :as cljs-test])) + #?@(:cljs [] :default [[clojure.test :as test]]) + #?@(:cljr [] :default [[cljs.test :as cljs-test]]))) -#?(:clj (set! *warn-on-reflection* true)) +#?(:cljs nil :default (set! *warn-on-reflection* true)) -#?(:clj +#?(:cljs nil :default (defmethod test/assert-expr 'thrown-with-data? [msg [_ msg-re data expr]] (let [[msg-re expected expr] @@ -24,7 +24,7 @@ :actual nil}) (catch Exception ex# (let [data# (ex-data ex#) - ex-msg# (.getMessage ex#)] + ex-msg# (#?(:clj .getMessage :default ex-message) ex#)] (test/do-report (if msg-re# (if (re-find msg-re# ex-msg#) @@ -42,9 +42,12 @@ (defmacro deftime "From macrovich" [& body] - (when #?(:clj (not (:ns &env)) :cljs (re-matches #".*\$macros" (name (ns-name *ns*)))) + (when #?(:clj (not (:ns &env)) + :cljs (re-matches #".*\$macros" (name (ns-name *ns*))) + :default true) `(do ~@body))) +#?(:cljr nil :default (deftime (defmethod #?(:clj cljs.test/assert-expr :cljs cljs.test$macros/assert-expr) @@ -78,3 +81,4 @@ :message msg# :expected msg-re# :actual ex-msg#})))))))))) +) diff --git a/test/sci/test_utils/utils.cljc b/test/sci/test_utils/utils.cljc index fd6e2ae8..813383ed 100644 --- a/test/sci/test_utils/utils.cljc +++ b/test/sci/test_utils/utils.cljc @@ -9,7 +9,7 @@ (every? (fn [[k v]] (and (contains? m2 k) (submap? v (get m2 k)))) m1) - #?(:clj (instance? java.util.regex.Pattern m1) - :cljs (regexp? m1)) + #?(:cljs (regexp? m1) + :default (instance? #?(:clj java.util.regex.Pattern :cljr System.Text.RegularExpressions.Regex) m1)) (re-find m1 m2) :else (= m1 m2))) diff --git a/test/sci/vars_test.cljc b/test/sci/vars_test.cljc index bd02220f..39cee13f 100644 --- a/test/sci/vars_test.cljc +++ b/test/sci/vars_test.cljc @@ -1,11 +1,12 @@ (ns sci.vars-test (:require - #?(:clj [sci.addons :as addons]) + #?@(:cljs [] :default [[sci.addons :as addons]]) [clojure.string :as str] [clojure.test :as test :refer [deftest is testing]] [sci.core :as sci] [sci.impl.unrestrict :refer [*unrestricted*]] - [sci.test-utils :as tu])) + [sci.test-utils :as tu]) + #?(:cljr (:import [System.Threading Thread]))) (defn eval* ([form] (eval* nil form)) @@ -14,7 +15,7 @@ (deftest dynamic-var-test (testing "set var root binding" - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"root binding" + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"root binding" (eval* "(def ^:dynamic x 1) (set! x 2) x")))) (testing "set var thread-local binding" (is (= [0 1 2 0] (eval* @@ -49,10 +50,10 @@ (deftest binding-syntax-test (testing "no vector binding" - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"vector" + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"vector" (eval* "(def ^:dynamic x 1) (binding #{x 1})")))) (testing "not even bindings" - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"even" + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"even" (eval* "(def ^:dynamic x 1) (binding [x])"))))) (deftest redefine-var-test @@ -94,17 +95,17 @@ (is (= 10 (eval* "(defn foo [& xs] (apply + xs)) (apply #'foo 1 2 3 [4])")))) (deftest macro-val-test - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"value of a macro" (eval* "(defmacro foo []) foo"))) (is (some? (eval* "(defmacro foo []) #'foo")))) (deftest unbound-call-test - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"unbound fn: #'user/x" (eval* "(def x) (x 1)")))) -#?(:clj +#?(:cljs nil :default (when-not tu/native? (deftest binding-conveyor-test (is (= 1 (tu/eval* "(def ^:dynamic x 0) (binding [x 1] @(future x))" @@ -114,43 +115,42 @@ @(future (binding [x (inc x)] @(future (binding [x (inc x)] x)))))" (addons/future {}))))))) -#?(:clj +#?(:cljs nil :default (when-not tu/native? (deftest bound-fn-test (is (= :hello (tu/eval* " (def ^:dynamic *some-var* nil) (def state (promise)) (defn f [] (deliver state *some-var*)) - -(binding [*some-var* :hello] - (.start (java.lang.Thread. (bound-fn* f)))) +(def bfn (binding [*some-var* :hello] (bound-fn* f))) +@(future (bfn)) @state" - {:classes {'java.lang.Thread java.lang.Thread}}))) + (addons/future {})))) (is (= :hello (tu/eval* " (def ^:dynamic *some-var* nil) (def state (promise)) (defn f [] (deliver state *some-var*)) - -(binding [*some-var* :hello] - (.start (java.lang.Thread. (bound-fn [] (f))))) +(def bfn (binding [*some-var* :hello] (bound-fn [] (f)))) +@(future (bfn)) @state" - {:classes {'java.lang.Thread java.lang.Thread}})))))) + (addons/future {}))))))) -#?(:clj +#?(:cljs nil :default (deftest with-bindings-test - (is (= 6 (eval* " + (is (= 6 (eval* (-> " (let [sw (java.io.StringWriter.)] (with-bindings {#'*out* sw} (println \"hello\")) (let [res (str sw)] - (count res)))"))))) + (count res)))" + #?(:cljr (str/replace "java.io.StringWriter" "System.IO.StringWriter")))))))) (deftest with-bindings-api-test (when-not tu/native? (let [x (sci/new-dynamic-var 'x)] (is (= 1 (sci/with-bindings {x 1} (sci/eval-string "*x*" {:bindings {'*x* x}}))))) - (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"bind non-dynamic" + (is (thrown-with-msg? #?(:cljs js/Error :default Exception) #"bind non-dynamic" (sci/with-bindings {1 1} (sci/eval-string "*x*" {:bindings {'*x* 1}})))))) @@ -166,10 +166,10 @@ (is (= 1 (sci/with-redefs [x 1] (sci/eval-string "x" {:bindings {'x x}})))) (is (str/includes? (str/lower-case (str @x)) "unbound"))) - (is (thrown-with-msg? #?(:clj Throwable :cljs js/Error) #"1 is not a var" + (is (thrown-with-msg? #?(:cljs js/Error :clj Throwable) #"1 is not a var" (sci/with-redefs [1 1]))))) -#?(:clj +#?(:cljs nil :default (deftest pmap-test (when-not tu/native? (is (= '(11 11 11) @@ -178,7 +178,7 @@ (def ^:dynamic *x* 10) -#?(:clj +#?(:cljs nil :default (deftest pmap-api-test (when-not tu/native? (let [x (sci/new-dynamic-var 'x 10)] @@ -186,14 +186,14 @@ (is (= '(11 11 11) @(binding [*x* 11] (sci/future (sci/binding [x *x*] (sci/pmap identity [@x @x @x]))))))))))) -#?(:clj +#?(:cljs nil :default (deftest promise-test (when-not tu/native? (is (= :delivered (tu/eval* "(let [x (promise)] (future (deliver x :delivered)) (deref x))" (-> (addons/future {}) - (assoc-in [:classes 'java.lang.Thread] Thread))))) + (assoc-in [:classes 'Thread] Thread))))) (is (= :failed (tu/eval* "(let [x (promise)] (deref x 1 :failed))" (addons/future {}))))))) @@ -208,9 +208,10 @@ (deftest alter-var-root-test (is (= 2 (eval* "(def x 1) (alter-var-root #'x (fn foo [v] (inc x))) x"))) - #?(:clj (testing "it is atomic" - (is (= 1000 (sci/eval-string "(def x 0) (do (doall (pmap #(alter-var-root #'x (fn foo [v] (+ v %))) (take 1000 (repeat 1)))) x)" - {:namespaces {'clojure.core {'pmap clojure.core/pmap}}}))))) + #?(:cljs nil :default + (testing "it is atomic" + (is (= 1000 (sci/eval-string "(def x 0) (do (doall (pmap #(alter-var-root #'x (fn foo [v] (+ v %))) (take 1000 (repeat 1)))) x)" + {:namespaces {'clojure.core {'pmap clojure.core/pmap}}}))))) (testing "alter-var-root uses root binding to update" (is (= 2 (eval* "(def ^:dynamic *x* 1) (binding [*x* 2] (alter-var-root #'*x* inc)) *x*")))) (testing "alter-var-root returns new value" @@ -221,7 +222,7 @@ (let [x (sci/new-dynamic-var '*x* (fn [] 10) {:ns (sci/create-ns 'user) :sci/built-in true})] (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) + #?(:cljs js/Error :default Exception) #"Built-in var" (sci/eval-string "[(with-redefs [*x* (fn [] 11)] (*x*)) (*x*)]" {:bindings {'*x* x}})))) @@ -241,12 +242,12 @@ (deftest with-local-vars-test (is (= 2 (eval* "(with-local-vars [x 1] (+ 1 (var-get x)))"))) (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) + #?(:cljs js/Error :default Exception) #"even" (sci/eval-string "(with-local-vars [x] (+ 1 (var-get x)))"))) (is (thrown-with-msg? - #?(:clj Exception :cljs js/Error) + #?(:cljs js/Error :default Exception) #"vector" (sci/eval-string "(with-local-vars #{x 1} (+ 1 (var-get x)))")))) @@ -261,7 +262,7 @@ (sci/with-out-str (sci/eval-string "(def x 1) (add-watch #'x :foo (fn [k r o n] (prn :o o :n n))) (alter-var-root #'x (constantly 5))")) ":o 1 :n 5"))) -#?(:clj +#?(:cljs nil :default (deftest thread-binds (is (true? (sci/eval-string*