summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/clj/clojure/core.clj65
-rw-r--r--src/jvm/clojure/lang/Compiler.java112
2 files changed, 177 insertions, 0 deletions
diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj
index cfe0cddc..8d554847 100644
--- a/src/clj/clojure/core.clj
+++ b/src/clj/clojure/core.clj
@@ -4381,6 +4381,70 @@
`(letfn* ~(vec (interleave (map first fnspecs)
(map #(cons `fn %) fnspecs)))
~@body))
+
+
+;;;;;;; case ;;;;;;;;;;;;;
+(defn- shift-mask [shift mask x]
+ (-> x (bit-shift-right shift) (bit-and mask)))
+
+(defn- min-hash
+ "takes a collection of keys and returns [shift mask]"
+ [keys]
+ (let [hashes (map hash keys)
+ cnt (count keys)]
+ (when-not (apply distinct? hashes)
+ (throw (IllegalArgumentException. "Hashes must be distinct")))
+ (or (first
+ (filter (fn [[s m]]
+ (apply distinct? (map #(shift-mask s m %) hashes)))
+ (for [mask (map #(dec (bit-shift-left 1 %)) (range 1 14))
+ shift (range 0 31)]
+ [shift mask])))
+ (throw (IllegalArgumentException. "No distinct mapping found")))))
+
+(defmacro case
+ "Takes an expression, and a set of clauses.
+
+ Each clause can take the form of either:
+
+ test-constant result-expr
+
+ (test-constant1 ... test-constantN) result-expr
+
+ The test-constants are not evaluated. They must be compile-time
+ literals, and need not be quoted. If the expression is equal to a
+ test-constant, the corresponding result-expr is returned. A single
+ default expression can follow the clauses, and its value will be
+ returned if no clause matches. If no default expression is provided
+ and no clause matches, an IllegalArgumentException is thrown.
+
+ Unlike cond and condp, case does a constant-time dispatch, the
+ clauses are not considered sequentially. All manner of constant
+ expressions are acceptable in case, including numbers, strings,
+ symbols, keywords, and (Clojure) composites thereof. Note that since
+ lists are used to group multiple constants that map to the same
+ expression, a vector can be used to match a list if needed. The
+ test-constants need not be all of the same type."
+
+ [e & clauses]
+ (let [ge (with-meta (gensym) {:tag Object})
+ default (if (odd? (count clauses))
+ (last clauses)
+ `(throw (IllegalArgumentException. (str "No matching clause: " ~ge))))
+ cases (partition 2 clauses)
+ case-map (reduce (fn [m [test expr]]
+ (if (seq? test)
+ (into m (zipmap test (repeat expr)))
+ (assoc m test expr)))
+ {} cases)
+ [shift mask] (min-hash (keys case-map))
+
+ hmap (reduce (fn [m [test expr :as te]]
+ (assoc m (shift-mask shift mask (hash test)) te))
+ (sorted-map) case-map)]
+ `(let [~ge ~e]
+ (case* ~ge ~shift ~mask ~(key (first hmap)) ~(key (last hmap)) ~default ~hmap))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; helper files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(alter-meta! (find-ns 'clojure.core) assoc :doc "Fundamental library of the Clojure language")
(load "core_deftype")
@@ -4587,3 +4651,4 @@
(recur (conj ret (first items)) (next items))
ret)))))
+ \ No newline at end of file
diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java
index 7a0c5527..4ef28512 100644
--- a/src/jvm/clojure/lang/Compiler.java
+++ b/src/jvm/clojure/lang/Compiler.java
@@ -56,6 +56,7 @@ static final Symbol MONITOR_EXIT = Symbol.create("monitor-exit");
static final Symbol IMPORT = Symbol.create("clojure.core", "import*");
//static final Symbol INSTANCE = Symbol.create("instance?");
static final Symbol DEFCLASS = Symbol.create("defclass*");
+static final Symbol CASE = Symbol.create("case*");
//static final Symbol THISFN = Symbol.create("thisfn");
static final Symbol CLASS = Symbol.create("Class");
@@ -92,6 +93,7 @@ static final public IPersistentMap specials = PersistentHashMap.create(
LOOP, new LetExpr.Parser(),
RECUR, new RecurExpr.Parser(),
IF, new IfExpr.Parser(),
+ CASE, new CaseExpr.Parser(),
LET, new LetExpr.Parser(),
LETFN, new LetFnExpr.Parser(),
DO, new BodyExpr.Parser(),
@@ -130,6 +132,7 @@ private static final Type IFN_TYPE = Type.getType(IFn.class);
private static final Type RT_TYPE = Type.getType(RT.class);
final static Type CLASS_TYPE = Type.getType(Class.class);
final static Type NS_TYPE = Type.getType(Namespace.class);
+final static Type UTIL_TYPE = Type.getType(Util.class);
final static Type REFLECTOR_TYPE = Type.getType(Reflector.class);
final static Type THROWABLE_TYPE = Type.getType(Throwable.class);
final static Type BOOLEAN_OBJECT_TYPE = Type.getType(Boolean.class);
@@ -5606,5 +5609,114 @@ static public class MethodParamExpr implements Expr, MaybePrimitiveExpr{
}
}
+public static class CaseExpr extends UntypedExpr{
+ public final Expr expr;
+ public final int shift, mask, low, high;
+ public final Expr defaultExpr;
+ public final HashMap<Integer,Expr> tests;
+ public final HashMap<Integer,Expr> thens;
+
+ public final int line;
+
+ final static Method hashMethod = Method.getMethod("int hash(Object)");
+ final static Method equalsMethod = Method.getMethod("boolean equals(Object, Object)");
+
+
+ public CaseExpr(int line, Expr expr, int shift, int mask, int low, int high, Expr defaultExpr,
+ HashMap<Integer,Expr> tests,HashMap<Integer,Expr> thens){
+ this.expr = expr;
+ this.shift = shift;
+ this.mask = mask;
+ this.low = low;
+ this.high = high;
+ this.defaultExpr = defaultExpr;
+ this.tests = tests;
+ this.thens = thens;
+ this.line = line;
+ }
+
+ public Object eval() throws Exception{
+ throw new UnsupportedOperationException("Can't eval case");
+ }
+
+ public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
+ Label defaultLabel = gen.newLabel();
+ Label endLabel = gen.newLabel();
+ HashMap<Integer,Label> labels = new HashMap();
+
+ for(Integer i : tests.keySet())
+ {
+ labels.put(i, gen.newLabel());
+ }
+
+ Label[] la = new Label[(high-low)+1];
+
+ for(int i=low;i<=high;i++)
+ {
+ la[i-low] = labels.containsKey(i) ? labels.get(i) : defaultLabel;
+ }
+
+ gen.visitLineNumber(line, gen.mark());
+ expr.emit(C.EXPRESSION, objx, gen);
+ gen.invokeStatic(UTIL_TYPE,hashMethod);
+ gen.push(shift);
+ gen.visitInsn(ISHR);
+ gen.push(mask);
+ gen.visitInsn(IAND);
+ gen.visitTableSwitchInsn(low, high, defaultLabel, la);
+
+ for(Integer i : labels.keySet())
+ {
+ gen.mark(labels.get(i));
+ expr.emit(C.EXPRESSION, objx, gen);
+ tests.get(i).emit(C.EXPRESSION, objx, gen);
+ gen.invokeStatic(UTIL_TYPE, equalsMethod);
+ gen.ifZCmp(GeneratorAdapter.EQ, defaultLabel);
+ thens.get(i).emit(C.EXPRESSION,objx,gen);
+ gen.goTo(endLabel);
+ }
+
+ gen.mark(defaultLabel);
+ defaultExpr.emit(C.EXPRESSION, objx, gen);
+ gen.mark(endLabel);
+ if(context == C.STATEMENT)
+ gen.pop();
+ }
+
+ static class Parser implements IParser{
+ //(case* expr shift mask low high default map<minhash, [test then]>)
+ //prepared by case macro and presumed correct
+ //case macro binds actual expr in let so expr is always a local,
+ //no need to worry about multiple evaluation
+ public Expr parse(C context, Object frm) throws Exception{
+ ISeq form = (ISeq) frm;
+ if(context == C.EVAL)
+ return analyze(context, RT.list(RT.list(FN, PersistentVector.EMPTY, form)));
+ PersistentVector args = PersistentVector.create(form.next());
+ HashMap<Integer,Expr> tests = new HashMap();
+ HashMap<Integer,Expr> thens = new HashMap();
+
+ for(Object o : ((Map)args.nth(6)).entrySet())
+ {
+ Map.Entry e = (Map.Entry) o;
+ Integer minhash = (Integer) e.getKey();
+ MapEntry me = (MapEntry) e.getValue();
+ Expr testExpr = new ConstantExpr(me.getKey());
+ tests.put(minhash, testExpr);
+ Expr thenExpr = analyze(C.EXPRESSION, me.getValue());
+ thens.put(minhash, thenExpr);
+ }
+ return new CaseExpr((Integer) LINE.deref(),
+ analyze(C.EXPRESSION, args.nth(0)),
+ (Integer)args.nth(1),
+ (Integer)args.nth(2),
+ (Integer)args.nth(3),
+ (Integer)args.nth(4),
+ analyze(C.EXPRESSION, args.nth(5)),
+ tests,thens);
+
+ }
+ }
+}
}
generated by cgit v1.2.3-18-g5258 (git 2.32.0) at 2025-07-16 13:01:06 +0000