From 6561df64a7274750332da3bb2c96968b0f4aba26 Mon Sep 17 00:00:00 2001 From: mikera Date: Tue, 27 Feb 2024 10:22:02 +0000 Subject: [PATCH] Successful Convex Lisp quasiquote implementation V1 --- convex-core/src/main/cvx/convex/core.cvx | 249 +++++++++++------- .../main/java/convex/core/lang/Compiler.java | 1 + .../src/main/java/convex/core/lang/Core.java | 3 + .../test/java/convex/actors/RegistryTest.java | 8 +- .../test/java/convex/core/init/BaseTest.java | 123 +++++++++ .../test/java/convex/core/init/InitTest.java | 38 +-- .../test/java/convex/core/lang/ACVMTest.java | 9 +- .../java/convex/core/lang/CompilerTest.java | 98 +++++-- .../java/convex/core/lang/ContextTest.java | 10 +- .../test/java/convex/core/lang/CoreTest.java | 13 +- .../test/java/convex/core/lang/OpsTest.java | 6 +- .../src/test/java/convex/lib/TrustTest.java | 4 +- 12 files changed, 380 insertions(+), 182 deletions(-) create mode 100644 convex-core/src/test/java/convex/core/init/BaseTest.java diff --git a/convex-core/src/main/cvx/convex/core.cvx b/convex-core/src/main/cvx/convex/core.cvx index cb5461c00..8c6cff3c9 100644 --- a/convex-core/src/main/cvx/convex/core.cvx +++ b/convex-core/src/main/cvx/convex/core.cvx @@ -22,6 +22,124 @@ :examples [{:code "(call *registry* (register {:name \"My name\"}))"}]}} (address 9)) +;;;;;;;;;; Convex Lisp quasiquote impl + +(def quasiquote*) +(def qq*) + +(def quasiquote + ^{:doc {:description "Returns the quoted value of a form, without evaluating it. Like `quote`, but elements within the form may be unquoted via `unquote`." + :examples [{:code "(quasiquote foo)" :return "foo"} + {:code "(quasiquote (:a :b (unquote (+ 2 3))))" :return "(:a :b 5)"}] + :signature [{:params [form]}]} + :expander? true} + (fn [[_ form] e] + (e (qq* form 1) e))) + +;; private helper, always produces a generator for a form +(def ^:private? qq* (fn [form depth] + (let [qf (quasiquote* form depth)] + (cond + qf qf + (list 'quote + form))))) + +;; quasiquote elements of sequence, produce a sequence of generators or nil if "pure" quotation +;; nil production is an important optimisation to avoid regenerating static subtrees +(def ^:private? qq-seq (fn + [ss depth] + (let [n (count ss)] ;; size of sequence] + (loop [i 0 + found false + ss ss] + (cond (< i n) + (let [v (nth ss i) + e (quasiquote* v depth)] + (cond (nil? e) + (set! ss (assoc ss i (list 'quote + v))) ;; we need these if a generator is required + (do + (set! found true) + (set! ss (assoc ss i e)))) + (recur (inc i) found ss)) + (cond found ss nil) ;; end of loop + ))))) + +;; Quasiquote expand function, returns nil if no change (i.e. a pure quotable form), otherwise a generator for the form +(def quasiquote* (fn [form depth] + (cond + ;; first catch [] () {} #{} and nil, which dont expand + (empty? form) (return nil) + + ;; handle each type of data structure + (list? form) + (let [fst (first form)] + (cond + ;; Nested quasiquote, needs to increase depth + (= 'quasiquote fst + ) + (cond + (!= 2 (count form)) (fail :EXPAND "nested quasiquote requires 1 argument") + (let [snd (second form) + ev (quasiquote* snd (inc depth))] + (cond + (nil? ev) (return nil) + (list 'list + (quote 'quasiquote + ) + ev)))) + + ;; unquote unwraps one level of quasiquote + (= 'unquote + fst) + (cond + (!= 2 (count form)) (fail :EXPAND "unquote requires 1 argument") + (let [snd (second form)] + (cond + (> depth 1) + (let [ev (quasiquote* snd (dec depth))] + (cond (nil? ev) (return nil)) + (list 'list + (quote 'unquote + ) + ev)) + (nil? snd) (compile nil) ;; special case, generator for nil + snd + ))) + + + (let [es (qq-seq form depth)] + (cond (nil? es) (return nil)) + (cons 'list + es)))) + + (vector? form) + (let [es (qq-seq (vec form) depth)] + (cond (nil? es) (return nil)) + (vec es)) + + (set? form) + (let [es (qq-seq (vec form) depth)] + (cond + (nil? es) (return nil) + (cons 'list + (quote 'hash-set + ) es))) + + (map? form) + (let [es (qq-seq (apply concat (vec form)) depth)] + (cond + (nil? es) (return nil) + (cons 'list + (quote 'hash-map + ) es))) + + ;; Nothing special possible, so just return nil to signal no change + nil))) + +;; Test expansion +`[1 ~(inc 2)] + ;;;;;;;;;; Expanders, creating macros and defining functions ;; TODO. Review expanders and `macro`, API is not clear. + macros cannot be used within the transaction where they are created @@ -33,7 +151,8 @@ :expander? true} (fn [x e] (let [[_ name & decl] x - exp (cons 'fn decl) + exp (cons 'fn + decl) form `(def ~(syntax name {:expander? true}) ~exp)] (e form e)))) @@ -45,7 +164,8 @@ :expander? true} (fn [x e] (let [[_ name & decl] x - mac (cons 'fn decl) + mac (cons 'fn + decl) form `(def ~(syntax name (assoc (meta (first decl)) :expander? true)) ;; merge in metadata on parameter plus :expander? tag @@ -62,9 +182,11 @@ :signature [{:params [name params & body]} {:params [name & fn-decls]}]}} [name & decl] - (cond (empty? decl) (fail :ARITY "`defn` requires at lest one function definition")) - (let [fnform (cons 'fn decl) - name (syntax name (meta (first decl)))] ;; Note: merges in metadata on parameter list + (cond + (empty? decl) (fail :ARITY "`defn` requires at lest one function definition")) + (let [fnform (cons 'fn + decl) + name (syntax name (meta (first decl)))] ;; Note: merges in metadata on parameter list `(def ~name ~fnform))) (defmacro macro @@ -72,13 +194,30 @@ :examples [{:code "(macro [x] (if x :foo :bar))"}] :signature [{:params [params & body]}]}} [& decl] - (let [mfunc (cons 'fn decl)] + (let [mfunc (cons 'fn + decl)] `(let [m# ~mfunc] ;; set up a closure containing the macro function (fn [x e] (e (apply m# (next (unsyntax x))) e))))) - + +(defn identity + ^{:doc {:description "An identity function which returns its first argument unchanged." + :examples [{:code "(identity :foo)"} + {:code "(map identity [1 2 3])"}] + :signature [{:params [x]}]}} + [x & _] + x) + +(defn expand-1 + ^{:doc {:description "Expands a form once." + :examples [{:code "(expand-1 '(or 1 2 3))"}] + :signature [{:params [x]}]}} + ([x] + (expand x *initial-expander* identity)) + ([x e] + (expand x e identity))) ;;;;;;;;;; Environment setup @@ -96,95 +235,7 @@ syms) nil) -;;;;;;;;;; Experimental Convex Lisp quasiquote impl - -(declare quasiquote* qq*) - -(defmacro quasiquote2 - ^{:doc {:description "Returns the quoted value of a form, without evaluating it. Like `quote`, but elements within the form may be unquoted via `unquote`." - :examples [{:code "(quasiquote foo)" :return "foo"} - {:code "(quasiquote (:a :b (unquote (+ 2 3))))" :return "(:a :b 5)"}] - :signature [{:params [form]}]}} - [form] - (qq* form 1)) - -;; private helper, always produces a generator for a form -(defn ^:private? qq* [form depth] - (let [qf (quasiquote* form depth)] - (cond qf qf (list 'quote - form)))) - -;; quasiquote elements of sequence/ Produce a generator, or nil if "pure" quotation -;; nil production is an important optimisation to avoid regenerating static subtrees -(defn ^:private? qq-seq [ss depth] - (let [n (count ss)] ;; size of sequence] - (loop [i 0 - found false - ss ss] - (cond (< i n) - (let [v (nth ss i) - e (quasiquote* v depth)] - (cond (nil? e) - (set! ss (assoc ss i (list 'quote - v))) - (do - (set! found true) - (set! ss (assoc ss i e)))) - (recur (inc i) found ss)) - (cond found ss nil) ;; end of loop - )))) -; (map (fn [a] (qq* a depth)) ss)) -;; Quasiquote expand function, returns nil if no change (i.e. pure qouting), otherwise a generator for the form -(defn quasiquote* [form depth] - (cond - ;; first catch [] () {} #{} and nil, which dont expand - (empty? form) (return nil) - - ;; handle each type of data structure - (list? form) - (let [fst (first form)] - (cond - ;; Nested quasiquote, no futher expansion - (= 'quasiquote fst - ) - (cond - (!= 2 (count form)) (fail :EXPAND "nested quasiquote requires 1 argument") - (quasiquote* (second form) (inc depth))) - - ;; unquote unwraps one level of quasiquote - (= fst 'unquote - ) - (cond - (!= 2 (count form)) (fail :EXPAND "unquote requires 1 argument") - (let [snd (second form)] - (cond - (> depth 1) (quasiquote* snd (dec depth)) - (nil? snd) (compile nil) - snd))) - - - (let [es (qq-seq form depth)] - (cond (nil? es) (return nil)) - (cons 'list - es)))) - (vector? form) - (qq-seq form depth) - - (set? form) - (let [es (qq-seq form depth)] - (cond (nil? es) (return nil)) - (cons 'hash-set - es)) - - (map? form) - (let [es (qq-seq (apply concat (vec form)) depth)] - (cond (nil? es) (return nil)) - (cons 'hash-map - es)) - - ;; Nothing special, so just return nil to signal no change - nil)) ;;;;;;;;;; Logic Operations @@ -512,13 +563,7 @@ body) (vec ~sequence))) -(defn identity - ^{:doc {:description "An identity function which returns a single argument unchanged." - :examples [{:code "(identity :foo)"} - {:code "(map identity [1 2 3])"}] - :signature [{:params [x]}]}} - [x] - x) + (defmacro set-in! ^{:doc {:description "Sets a value within a nested associative structure, combining behaviour of set! and assoc-in." diff --git a/convex-core/src/main/java/convex/core/lang/Compiler.java b/convex-core/src/main/java/convex/core/lang/Compiler.java index de9e682c7..c450808d6 100644 --- a/convex-core/src/main/java/convex/core/lang/Compiler.java +++ b/convex-core/src/main/java/convex/core/lang/Compiler.java @@ -856,6 +856,7 @@ public Context invoke(Context context,ACell[] args ) { // check for macro / expander in initial position. // Note that 'quote' is handled by this, via QUOTE_EXPANDER AFn expander = context.lookupExpander(first); + if (expander!=null) { return context.expand(expander,x, cont); // (exp x cont) } diff --git a/convex-core/src/main/java/convex/core/lang/Core.java b/convex-core/src/main/java/convex/core/lang/Core.java index 05195014d..765d67047 100644 --- a/convex-core/src/main/java/convex/core/lang/Core.java +++ b/convex-core/src/main/java/convex/core/lang/Core.java @@ -2746,6 +2746,9 @@ private static Context registerCoreCode(AHashMap env) throws IOEx ctx = ctx.execute(op); // System.out.println("Core compilation juice: "+ctx.getJuice()); assert (!ctx.isExceptional()) : "Error executing op: "+ op+ "\n\nException : "+ ctx.getExceptional().toString(); + + // Testing for core output + // System.out.println("Core: "+ctx.getResult()); } return ctx; diff --git a/convex-core/src/test/java/convex/actors/RegistryTest.java b/convex-core/src/test/java/convex/actors/RegistryTest.java index 56e1ed9d9..8e79c040b 100644 --- a/convex-core/src/test/java/convex/actors/RegistryTest.java +++ b/convex-core/src/test/java/convex/actors/RegistryTest.java @@ -1,6 +1,8 @@ package convex.actors; -import static convex.test.Assertions.*; +import static convex.test.Assertions.assertArgumentError; +import static convex.test.Assertions.assertNobodyError; +import static convex.test.Assertions.assertTrustError; import static org.junit.jupiter.api.Assertions.assertEquals; import static org.junit.jupiter.api.Assertions.assertNull; @@ -14,8 +16,8 @@ import convex.core.data.Keyword; import convex.core.data.Maps; import convex.core.data.Symbol; +import convex.core.init.BaseTest; import convex.core.init.Init; -import convex.core.init.InitTest; import convex.core.lang.ACVMTest; import convex.core.lang.Context; import convex.test.Samples; @@ -23,7 +25,7 @@ public class RegistryTest extends ACVMTest { protected RegistryTest() throws IOException { - super(InitTest.BASE); + super(BaseTest.STATE); } static final Address REG = Init.REGISTRY_ADDRESS; diff --git a/convex-core/src/test/java/convex/core/init/BaseTest.java b/convex-core/src/test/java/convex/core/init/BaseTest.java new file mode 100644 index 000000000..ad802181e --- /dev/null +++ b/convex-core/src/test/java/convex/core/init/BaseTest.java @@ -0,0 +1,123 @@ +package convex.core.init; + +import static org.junit.jupiter.api.Assertions.assertEquals; +import static org.junit.jupiter.api.Assertions.assertNotEquals; +import static org.junit.jupiter.api.Assertions.assertNotNull; +import static org.junit.jupiter.api.Assertions.assertSame; +import static org.junit.jupiter.api.Assertions.assertTrue; + +import java.util.ArrayList; +import java.util.Arrays; +import java.util.HashSet; +import java.util.stream.Collectors; + +import org.junit.jupiter.api.Test; + +import convex.core.Constants; +import convex.core.State; +import convex.core.crypto.AKeyPair; +import convex.core.data.AccountKey; +import convex.core.data.AccountStatus; +import convex.core.data.Address; +import convex.core.data.Hash; +import convex.core.data.Ref; +import convex.core.data.Refs; +import convex.core.data.prim.CVMLong; +import convex.core.lang.ACVMTest; + +/** + * Tests for Init functionality + * + * Also includes static State instances for Testing + */ +public class BaseTest extends ACVMTest { + + public static final AKeyPair[] KEYPAIRS = new AKeyPair[] { + AKeyPair.createSeeded(2), + AKeyPair.createSeeded(3), + AKeyPair.createSeeded(5), + AKeyPair.createSeeded(7), + AKeyPair.createSeeded(11), + AKeyPair.createSeeded(13), + AKeyPair.createSeeded(17), + AKeyPair.createSeeded(19), + }; + + public static ArrayList PEER_KEYPAIRS=(ArrayList) Arrays.asList(KEYPAIRS).stream().collect(Collectors.toList()); + public static ArrayList PEER_KEYS=(ArrayList) Arrays.asList(KEYPAIRS).stream().map(kp->kp.getAccountKey()).collect(Collectors.toList()); + + public static final AKeyPair FIRST_PEER_KEYPAIR = KEYPAIRS[0]; + public static final AccountKey FIRST_PEER_KEY = FIRST_PEER_KEYPAIR.getAccountKey(); + + public static final AKeyPair HERO_KEYPAIR = KEYPAIRS[0]; + public static final AKeyPair VILLAIN_KEYPAIR = KEYPAIRS[1]; + + public static final AccountKey HERO_KEY = HERO_KEYPAIR.getAccountKey(); + + + /** + * Standard base state used for testing + */ + public static final State STATE= Init.createBaseState(PEER_KEYS); + + public static Address HERO=Init.getGenesisAddress(); + public static Address VILLAIN=Init.getGenesisPeerAddress(1); + + public static final Address FIRST_PEER_ADDRESS = Init.getGenesisPeerAddress(0); + + + protected BaseTest() { + super(STATE); + } + + @Test + public void testMemoryExchange() { + CVMLong mem=STATE.getGlobalMemoryPool(); + CVMLong cvx=STATE.getGlobalMemoryValue(); + assertEquals(Constants.INITIAL_MEMORY_POOL,mem.longValue()); + assertEquals(Constants.INITIAL_MEMORY_POOL*Constants.INITIAL_MEMORY_PRICE,cvx.longValue()); + } + + @Test + public void testHero() { + AccountStatus as=STATE.getAccount(HERO); + assertNotNull(as); + assertEquals(Constants.INITIAL_ACCOUNT_ALLOWANCE,as.getMemory()); + } + + @Test + public void testVILLAIN() { + AccountStatus as=STATE.getAccount(VILLAIN); + assertNotNull(as); + assertEquals(Constants.INITIAL_ACCOUNT_ALLOWANCE,as.getMemory()); + assertNotEquals(HERO,VILLAIN); + } + + @Test + public void testInitRef() { + State s=STATE; + Ref sr=s.getRef(); + + Refs.RefTreeStats s1s=Refs.getRefTreeStats(sr); + + // TODO: need to work out why something already persisted, + // Seems to be in Core shared instance? "%2, 1, 1" + //ACell[] c=new ACell[2]; + //Refs.visitAllRefs(sr, r->{ + // ACell v=r.getValue(); + // if (r.isPersisted()) { + // throw new Error("Persisted: "+v.getType()+" = "+v+" after "+c[0]+","+c[1]); + // } + // c[0]=c[1]; + // c[1]=v; + //}); + //assertEquals(0L,s1s.persisted); + + assertSame(s1s.root,sr); + + HashSet hs=new HashSet<>(); + sr.findMissing(hs, 100); + assertTrue(hs.isEmpty()); + } + +} diff --git a/convex-core/src/test/java/convex/core/init/InitTest.java b/convex-core/src/test/java/convex/core/init/InitTest.java index c60325cb3..c3fc037ae 100644 --- a/convex-core/src/test/java/convex/core/init/InitTest.java +++ b/convex-core/src/test/java/convex/core/init/InitTest.java @@ -1,16 +1,13 @@ package convex.core.init; import static org.junit.jupiter.api.Assertions.assertEquals; -import static org.junit.jupiter.api.Assertions.assertNotEquals; import static org.junit.jupiter.api.Assertions.assertNotNull; import static org.junit.jupiter.api.Assertions.assertNull; import static org.junit.jupiter.api.Assertions.assertSame; import static org.junit.jupiter.api.Assertions.assertTrue; import java.util.ArrayList; -import java.util.Arrays; import java.util.HashSet; -import java.util.stream.Collectors; import org.junit.jupiter.api.Test; @@ -18,7 +15,6 @@ import convex.core.State; import convex.core.crypto.AKeyPair; import convex.core.data.AccountKey; -import convex.core.data.AccountStatus; import convex.core.data.Address; import convex.core.data.Hash; import convex.core.data.Ref; @@ -34,19 +30,10 @@ */ public class InitTest extends ACVMTest { - public static final AKeyPair[] KEYPAIRS = new AKeyPair[] { - AKeyPair.createSeeded(2), - AKeyPair.createSeeded(3), - AKeyPair.createSeeded(5), - AKeyPair.createSeeded(7), - AKeyPair.createSeeded(11), - AKeyPair.createSeeded(13), - AKeyPair.createSeeded(17), - AKeyPair.createSeeded(19), - }; + public static final AKeyPair[] KEYPAIRS = BaseTest.KEYPAIRS; - public static ArrayList PEER_KEYPAIRS=(ArrayList) Arrays.asList(KEYPAIRS).stream().collect(Collectors.toList()); - public static ArrayList PEER_KEYS=(ArrayList) Arrays.asList(KEYPAIRS).stream().map(kp->kp.getAccountKey()).collect(Collectors.toList()); + public static ArrayList PEER_KEYPAIRS=BaseTest.PEER_KEYPAIRS; + public static ArrayList PEER_KEYS=BaseTest.PEER_KEYS; public static final AKeyPair FIRST_PEER_KEYPAIR = KEYPAIRS[0]; public static final AccountKey FIRST_PEER_KEY = FIRST_PEER_KEYPAIR.getAccountKey(); @@ -62,10 +49,6 @@ public class InitTest extends ACVMTest { */ public static final State STATE= createState(); - /** - * Base state (without libraries) - */ - public static final State BASE = Init.createBaseState(PEER_KEYS); public static State createState() { @@ -122,21 +105,6 @@ public void testMemoryExchange() { assertEquals(Constants.INITIAL_MEMORY_POOL,mem.longValue()); assertEquals(Constants.INITIAL_MEMORY_POOL*Constants.INITIAL_MEMORY_PRICE,cvx.longValue()); } - - @Test - public void testHero() { - AccountStatus as=STATE.getAccount(HERO); - assertNotNull(as); - assertEquals(Constants.INITIAL_ACCOUNT_ALLOWANCE,as.getMemory()); - } - - @Test - public void testVILLAIN() { - AccountStatus as=STATE.getAccount(VILLAIN); - assertNotNull(as); - assertEquals(Constants.INITIAL_ACCOUNT_ALLOWANCE,as.getMemory()); - assertNotEquals(HERO,VILLAIN); - } @Test public void testInitRef() { diff --git a/convex-core/src/test/java/convex/core/lang/ACVMTest.java b/convex-core/src/test/java/convex/core/lang/ACVMTest.java index 34db67da4..ab6259c1c 100644 --- a/convex-core/src/test/java/convex/core/lang/ACVMTest.java +++ b/convex-core/src/test/java/convex/core/lang/ACVMTest.java @@ -6,6 +6,7 @@ import convex.core.data.prim.CVMBool; import convex.core.data.prim.CVMDouble; import convex.core.data.prim.CVMLong; +import convex.core.init.BaseTest; import convex.core.init.Init; import convex.core.init.InitTest; import convex.core.util.Utils; @@ -54,12 +55,12 @@ protected ACVMTest(State genesis) { c=buildContext(c); this.INITIAL=c.getState(); this.CONTEXT=c; - HERO = InitTest.HERO; - VILLAIN = InitTest.VILLAIN; + HERO = BaseTest.HERO; + VILLAIN = BaseTest.VILLAIN; c=c.withJuice(0); // reset juice used INITIAL_JUICE = c.getJuiceAvailable(); - HERO_BALANCE = c.getAccountStatus(InitTest.HERO).getBalance(); - VILLAIN_BALANCE = c.getAccountStatus(InitTest.VILLAIN).getBalance(); + HERO_BALANCE = c.getAccountStatus(HERO).getBalance(); + VILLAIN_BALANCE = c.getAccountStatus(VILLAIN).getBalance(); } /** diff --git a/convex-core/src/test/java/convex/core/lang/CompilerTest.java b/convex-core/src/test/java/convex/core/lang/CompilerTest.java index aaff7cd9f..bc1471528 100644 --- a/convex-core/src/test/java/convex/core/lang/CompilerTest.java +++ b/convex-core/src/test/java/convex/core/lang/CompilerTest.java @@ -40,6 +40,7 @@ import convex.core.data.prim.CVMBool; import convex.core.data.prim.CVMLong; import convex.core.exceptions.ParseException; +import convex.core.init.BaseTest; import convex.core.lang.ops.Constant; import convex.core.lang.ops.Def; import convex.core.lang.ops.Do; @@ -57,6 +58,9 @@ */ public class CompilerTest extends ACVMTest { + protected CompilerTest() { + super(BaseTest.STATE); + } @Test public void testConstants() { @@ -93,7 +97,6 @@ public void testConstants() { assertEquals(Constant.of(null),comp("nil")); assertEquals(Constant.of(true),comp("true")); assertEquals(Constant.of(false),comp("false")); - } @Test public void testComments() { @@ -364,10 +367,15 @@ public void testQuote() { assertEquals(Symbol.create("undefined-1"),eval("'undefined-1")); - assertEquals(expand("(quote (1 2))"),expand("'(1 2)")); + assertEquals(read("(quote (1 2))"),expand("'(1 2)")); + assertEquals(read("(quote (if))"),expand("'(if)")); // unquote doesn't do anything in regular quote assertEquals(eval("(quote (unquote 17))"),eval("'~17")); + + // Macros don't expand within in regular quote + assertEquals(read("(if)"),eval("(quote (if))")); + } @Test @@ -387,32 +395,32 @@ public void testDataLiterals() { @Test public void testQuoteDataStructures() { - assertEquals(Maps.of(1,2,3,4), eval("`{~(inc 0) 2 3 ~(dec 5)}")); - assertEquals(Sets.of(1,2,3),eval("`#{1 2 ~(dec 4)}")); + assertEquals(Maps.of(1,2,3,4), eval("{~(inc 0) 2 3 ~(dec 5)}")); + assertEquals(Sets.of(1,2,3),eval("#{1 2 ~(dec 4)}")); // TODO: unquote-splicing in data structures. } @Test public void testQuoteCases() { - // Tests from Racket / Scheme Context ctx=step("(def x 1)"); - assertEquals(read("(a b c)"),eval(ctx,"`(a b c)")); - assertEquals(read("(a b 1)"),eval(ctx,"`(a b ~x)")); - assertEquals(read("(a b 3)"),eval(ctx,"`(a b ~(+ x 2))")); - assertEquals(read("(a `(b ~x))"),eval(ctx,"`(a `(b ~x))")); - assertEquals(read("(a `(b ~1))"),eval(ctx,"`(a `(b ~~x))")); - assertEquals(read("(a `(b ~1))"),eval(ctx,"`(a `(b ~~`~x))")); - assertEquals(read("(a `(b ~x))"),eval(ctx,"`(a `(b ~~'x))")); - + // Unquote does nothing inside a regular quote assertEquals(read("(a b (unquote x))"),eval(ctx,"'(a b ~x)")); assertEquals(read("(unquote x)"),eval(ctx,"'~x")); // Unquote escapes surrounding quasiquote assertEquals(read("(a b (quote 1))"),eval(ctx,"`(a b '~x)")); + - + // Tests from Racket / Scheme + assertEquals(read("(a b c)"),eval(ctx,"`(a b c)")); + assertEquals(read("(a b 1)"),eval(ctx,"`(a b ~x)")); + assertEquals(read("(a b 3)"),eval(ctx,"`(a b ~(+ x 2))")); + assertEquals(read("(a `(b ~x))"),eval(ctx,"`(a `(b ~x))")); + assertEquals(read("(a `(b ~1))"),eval(ctx,"`(a `(b ~~x))")); + assertEquals(read("(a `(b ~1))"),eval(ctx,"`(a `(b ~~`~x))")); + assertEquals(read("(a `(b ~x))"),eval(ctx,"`(a `(b ~~'x))")); } @@ -451,28 +459,45 @@ public void testQuasiquote() { assertEquals(read("(quote 3)"),eval("(quasiquote (quote ~(inc 2)))")); assertEquals(Vectors.of(1,Vectors.of(2),3),eval("(let [a 2] (quasiquote [1 [~a] ~(let [a 3] a)]))")); - assertEquals(Maps.of(2,3,Maps.empty(),5),eval("(quasiquote {~(inc 1) 3 {} ~(dec 6)})")); + assertEquals(Maps.of(2,3,Maps.empty(),5),eval("(eval (quasiquote {~(inc 1) 3 {} ~(dec 6)}))")); // Compilation checks assertEquals(Constant.of(10),comp("(quasiquote (unquote (quasiquote (unquote 10))))")); - + } + + @Test + public void testQuasiquoteExpansions() { + assertEquals(read("(quote foo)"),expand("(quasiquote foo)")); + assertEquals(read("(quote false)"),expand("(quasiquote false)")); + assertEquals(read("(quote nil)"),expand("(quasiquote nil)")); + assertEquals(read("(quote 17)"),expand("(quasiquote 17)")); + assertEquals(read("(quote [1 2])"),expand("(quasiquote [1 2])")); + assertEquals(read("[(quote foo) (inc 2)]"),expand("(quasiquote [foo (unquote (inc 2))])")); + + assertEquals(read("(cond 1 2 3)"),expand("(quasiquote ~(if 1 2 3))")); + + assertEquals(read("[foo 3]"),eval("(expand-1 `[foo (unquote (inc 2))])")); } @Test - public void testQuasiquote2() { + public void testQuasiquoteHelpers() { + // returns null, because forms don't require generator (already self-generating) assertNull(eval("(quasiquote* [1 2] 1)")); + assertNull(eval("(quasiquote* 7 1)")); + assertNull(eval("(quasiquote* nil 2)")); assertNull(eval("(qq-seq [] 1)")); + assertEquals(Vectors.of(2),eval("(qq-seq '[~2] 1)")); assertEquals(Vectors.of(1,2,3),eval("(eval (qq-seq '[1 ~2 ~(dec 4)] 1))")); - assertEquals(Vectors.of(1,2,3),eval("(quasiquote2 [1 ~2 ~(dec 4)])")); + assertEquals(read("(quote (quasiquote foo))"),eval("(qq* '(quasiquote foo) 1)")); - assertEquals(Vectors.of(1,Vectors.of(2),3),eval("(let [a 2] (quasiquote2 [1 [~a] ~(let [a 3] a)]))")); - // expansions - assertEquals(read("(quote foo)"),expand("(quasiquote2 foo)")); - assertEquals(read("(quote false)"),expand("(quasiquote2 false)")); - assertEquals(read("(quote nil)"),expand("(quasiquote2 nil)")); + assertEquals(read("(quote 7)"),eval("(qq* 7 1)")); + assertEquals(read("(quote foo)"),eval("(qq* 'foo 1)")); + assertEquals(read("(quote (quote foo))"),eval("(qq* ''foo 1)")); + + assertEquals(read("(inc 1)"),eval("(qq* '(unquote (inc 1)) 1)")); } @Test @@ -683,6 +708,9 @@ public void testDefExpander() { assertEquals(Syntax.create(Keywords.FOO,Maps.of(Keywords.BAR,CVMBool.TRUE)),Reader.read("^:bar :foo")); assertEquals(Syntax.create(Keywords.FOO,Maps.of(Keywords.BAR,CVMBool.TRUE)),expand("^:bar :foo")); + + assertEquals(read("(cond 1 2 3)"),expand("(if 1 2 3)")); + } @Test public void testExpandDataStructures() { @@ -716,9 +744,17 @@ public void testQuoteCompile() { @Test public void testMacrosInMaps() { + System.out.println(expand("`{(if true 1 2) ~(if false 1 2)}")); + // System.out.println(eval("(list (quote hash-map) (quote (if true 1 2)) (if false 1 2))")); assertEquals(Maps.of(1L,2L),eval("(eval '{(if true 1 2) (if false 1 2)})")); assertEquals(Maps.of(1L,2L),eval("(eval `{(if true 1 2) ~(if false 1 2)})")); } + + @Test + public void testMacrosInSets() { + assertEquals(Sets.of(1L,2L),eval("(eval '#{(if true 1 2) (if false 1 2)})")); + assertEquals(Sets.of(1L,2L),eval("(eval `#{(if true 1 2) ~(if false 1 2)})")); + } @Test public void testMacrosNested() { @@ -772,12 +808,18 @@ public void testMacrosInActor() { ctx=step(ctx,"(def bar ("+addr+"/foo 2))"); assertEquals(Keywords.FOO,ctx.getResult()); } - - @Test - public void testMacrosInSets() { - assertEquals(Sets.of(1L,2L),eval("(eval '#{(if true 1 2) (if false 1 2)})")); - assertEquals(Sets.of(1L,2L),eval("(eval `#{(if true 1 2) ~(if false 1 2)})")); + + @Test public void testMacroDefinition() { + Context ctx=context(); + ctx=exec(ctx,"(defmacro fot [a b c] a)"); + + assertCVMEquals(2,eval(ctx,"(fot (+ 1 1) 3 4)")); + assertCVMEquals(2,eval(ctx,"("+ctx.getAddress()+"/fot (+ 1 1) 3 4)")); + + // TODO: check if this should really fail? Probably yes, because expander shouldn't eval *address* in lookup? + //assertCVMEquals(2,eval(ctx,"(*address*/fot (+ 1 1) 3 4)")); } + @Test public void testStaticCompilation() { diff --git a/convex-core/src/test/java/convex/core/lang/ContextTest.java b/convex-core/src/test/java/convex/core/lang/ContextTest.java index 113408b1e..3a9db1486 100644 --- a/convex-core/src/test/java/convex/core/lang/ContextTest.java +++ b/convex-core/src/test/java/convex/core/lang/ContextTest.java @@ -1,6 +1,10 @@ package convex.core.lang; -import static convex.test.Assertions.*; +import static convex.test.Assertions.assertCVMEquals; +import static convex.test.Assertions.assertDepthError; +import static convex.test.Assertions.assertJuiceError; +import static convex.test.Assertions.assertNotError; +import static convex.test.Assertions.assertUndeclaredError; import static org.junit.jupiter.api.Assertions.assertEquals; import static org.junit.jupiter.api.Assertions.assertFalse; import static org.junit.jupiter.api.Assertions.assertNotSame; @@ -21,7 +25,7 @@ import convex.core.data.Strings; import convex.core.data.Symbol; import convex.core.data.Vectors; -import convex.core.init.InitTest; +import convex.core.init.BaseTest; import convex.core.lang.ops.Special; /** @@ -30,7 +34,7 @@ public class ContextTest extends ACVMTest { protected ContextTest() { - super(InitTest.BASE); + super(BaseTest.STATE); } private final Address ADDR=context().getAddress(); diff --git a/convex-core/src/test/java/convex/core/lang/CoreTest.java b/convex-core/src/test/java/convex/core/lang/CoreTest.java index 23fea0095..fe298ca67 100644 --- a/convex-core/src/test/java/convex/core/lang/CoreTest.java +++ b/convex-core/src/test/java/convex/core/lang/CoreTest.java @@ -68,6 +68,7 @@ import convex.core.exceptions.BadFormatException; import convex.core.exceptions.BadSignatureException; import convex.core.exceptions.InvalidDataException; +import convex.core.init.BaseTest; import convex.core.init.Init; import convex.core.init.InitTest; import convex.core.lang.impl.CorePred; @@ -93,7 +94,7 @@ public class CoreTest extends ACVMTest { protected CoreTest() throws IOException { - super(InitTest.BASE); + super(BaseTest.STATE); } @Test @@ -694,9 +695,12 @@ public void testVectorTypes() { public void testIdentity() { assertNull(eval("(identity nil)")); assertEquals(Vectors.of(1L, 2L), eval("(identity [1 2])")); + + // Identity takes first arg and discards others + assertCVMEquals(7, eval("(identity 7 8 9)")); assertArityError(step("(identity)")); - assertArityError(step("(identity 1 2)")); + // assertArityError(step("(identity 1 2)")); // old behaviour } @Test @@ -4320,6 +4324,11 @@ public void testExpand() { // arity error in expansion execution assertArityError(step("(expand 1 (fn [x e] (count)))")); } + + @Test + public void testExpand_1() { + assertEquals(read("(let [v# 1] (cond v# v# (or 2 3)))"), eval("(expand-1 '(or 1 2 3))")); + } @Test public void testExpandEdgeCases() { diff --git a/convex-core/src/test/java/convex/core/lang/OpsTest.java b/convex-core/src/test/java/convex/core/lang/OpsTest.java index 49778faf9..439e43f9a 100644 --- a/convex-core/src/test/java/convex/core/lang/OpsTest.java +++ b/convex-core/src/test/java/convex/core/lang/OpsTest.java @@ -25,8 +25,8 @@ import convex.core.data.prim.CVMLong; import convex.core.exceptions.BadFormatException; import convex.core.exceptions.InvalidDataException; +import convex.core.init.BaseTest; import convex.core.init.Init; -import convex.core.init.InitTest; import convex.core.lang.impl.AClosure; import convex.core.lang.impl.Fn; import convex.core.lang.ops.Cond; @@ -51,7 +51,7 @@ public class OpsTest extends ACVMTest { protected OpsTest() { - super(InitTest.BASE); + super(BaseTest.STATE); } private final long INITIAL_JUICE = context().getJuiceAvailable(); @@ -82,7 +82,7 @@ public void testConstant() { @Test public void testOutOfJuice() { long JUICE = Juice.CONSTANT - 1; // insufficient juice to run operation - Context c = Context.createInitial(INITIAL, InitTest.HERO, JUICE); + Context c = Context.createInitial(INITIAL, HERO, JUICE); AOp op = Constant.of(10L); assertJuiceError(c.execute(op)); diff --git a/convex-core/src/test/java/convex/lib/TrustTest.java b/convex-core/src/test/java/convex/lib/TrustTest.java index d230bdce8..303a2f687 100644 --- a/convex-core/src/test/java/convex/lib/TrustTest.java +++ b/convex-core/src/test/java/convex/lib/TrustTest.java @@ -15,7 +15,7 @@ import convex.core.data.ACell; import convex.core.data.Address; -import convex.core.init.InitTest; +import convex.core.init.BaseTest; import convex.core.lang.ACVMTest; import convex.core.lang.Context; @@ -23,7 +23,7 @@ public class TrustTest extends ACVMTest { private Address trusted; protected TrustTest() throws IOException { - super(InitTest.BASE); + super(BaseTest.STATE); } @Override protected Context buildContext(Context ctx) {