1817 - one more attempt; retreat to 1801

akkartik · Jun 13, 2012 · f3e2b3c · f3e2b3c
1 parent c4fdbbc
commit f3e2b3c
Show file tree

Hide file tree

Showing 9 changed files with 170 additions and 25 deletions.
diff --git a/004cell.cc b/004cell.cc
@@ -238,3 +238,19 @@ Cell* dropPtr(Cell* p) {
 void addCons(Cell* p, Cell* x) {
   setCdr(p, newCons(x));
 }
+
+bool contains(Cell* tree, Cell* a, unordered_set<Cell*>& done) {
+  // guard against cycles
+  if (done.find(tree) != done.end()) return false;
+  done.insert(tree);
+
+  if (tree == a) return true;
+  if (!isCons(tree)) return false;
+  return contains(car(tree), a, done)
+         || contains(cdr(tree), a, done);
+}
+
+bool contains(Cell* tree, Cell* a) {
+  unordered_set<Cell*> done;
+  return contains(tree, a, done);
+}
diff --git a/004cell.test.cc b/004cell.test.cc
@@ -50,3 +50,12 @@ void test_Cell_layout_constraints() {
   check(sizeof(float) <= sizeof(Cell*));
   check(sizeof(size_t) <= sizeof(Cell*));
 }
+
+void test_contains_handles_circular_lists() {
+  unordered_set<Cell*> done;
+  Cell* x = newCons(newNum(1));
+  setCdr(x, x);
+  check(!contains(x, newSym("a"), done));
+  x->cdr = nil; // break cycle for gc
+  rmref(x);
+}
diff --git a/007scope.cc b/007scope.cc
@@ -114,11 +114,23 @@ Cell* scopeContainingBinding(Cell* sym, Cell* scope) {
   return NULL;
 }
 
-Cell* lookup(Cell* sym, Cell* scope) {
+                                  bool isAlreadyEvald(Cell*);
+                                  bool skippedAlreadyEvald = false;
+                                  Cell* maybeStripAlreadyEvald(bool dontReallyStrip, Cell* x) {
+                                    if (dontReallyStrip) {
+                                      skippedAlreadyEvald = contains(x, newSym("''"));
+                                      return x;
+                                    }
+                                    if (isAlreadyEvald(x))
+                                      return cdr(x);
+                                    return x;
+                                  }
+
+Cell* lookup(Cell* sym, Cell* scope, bool keepAlreadyEval) {
   Cell* result = lookupLexicalBinding(sym, scope);
-  if (result) return result;
+  if (result) return maybeStripAlreadyEvald(keepAlreadyEval, result);
   result = lookupDynamicBinding(sym);
-  if (result) return result;
+  if (result) return maybeStripAlreadyEvald(keepAlreadyEval, result);
   RAISE << "No binding for " << toString(sym) << endl;
 
   if (pretendRaise) return nil; // don't die
@@ -127,6 +139,10 @@ Cell* lookup(Cell* sym, Cell* scope) {
   return nil;
 }
 
+Cell* lookup(Cell* sym, Cell* scope) {
+  return lookup(sym, scope, false);
+}
+
 Cell* lookup(Cell* sym) {
   return lookup(sym, currLexicalScopes.top());
 }

diff --git a/008eval.cc b/008eval.cc
@@ -8,6 +8,12 @@
                                     return isCons(cell) && car(cell) == newSym("''");
                                   }
 
+                                  Cell* stripAlreadyEvald(Cell* cell) {
+                                    while (isAlreadyEvald(cell))
+                                      cell = cdr(cell);
+                                    return cell;
+                                  }
+
                                   bool isBackQuoted(Cell* cell) {
                                     return isCons(cell) && car(cell) == newSym("`");
                                   }
@@ -48,8 +54,8 @@
 
 
 
-                                  Cell* unsplice(Cell* arg, Cell* scope) {
-                                    return eval(cdr(arg), scope);
+                                  Cell* unsplice(Cell* arg, Cell* scope, bool dontStripAlreadyEval) {
+                                    return eval(cdr(arg), scope, dontStripAlreadyEval);
                                   }
 
                                   // keep sync'd with mac
@@ -65,14 +71,19 @@
                                     return true;
                                   }
 
+                                  bool isMacroWithoutBackquotes(Cell* fn) {
+                                    if (!isMacro(fn)) return false;
+                                    return !contains(body(fn), newSym("`"));
+                                  }
+
 // eval @exprs and inline them into args, tagging them with '' (already eval'd)
-Cell* spliceArgs(Cell* args, Cell* scope, Cell* fn) {
+Cell* spliceArgs(Cell* args, Cell* scope, Cell* fn, bool dontStripAlreadyEval) {
   Cell *pResult = newCell(), *tip = pResult;
   for (Cell* curr = args; curr != nil; curr=cdr(curr)) {
     if (isSplice(car(curr))) {
-      if (isMacro(fn))
+      if (isMacroWithoutBackquotes(fn))
         RAISE << "calling macros with splice can have subtle effects (http://arclanguage.org/item?id=15659)" << endl;
-      Cell* x = unsplice(car(curr), scope);
+      Cell* x = unsplice(car(curr), scope, dontStripAlreadyEval);
       for (Cell* curr2 = x; curr2 != nil; curr2=cdr(curr2), tip=cdr(tip))
         if (isColonSym(car(curr2)))
           addCons(tip, car(curr2));
@@ -88,6 +99,10 @@ Cell* spliceArgs(Cell* args, Cell* scope, Cell* fn) {
   return dropPtr(pResult);
 }
 
+Cell* spliceArgs(Cell* args, Cell* scope, Cell* fn) {
+  return spliceArgs(args, scope, fn, false);
+}
+
                                   Cell* stripQuote(Cell* cell) {
                                     return isQuoted(cell) ? cdr(cell) : cell;
                                   }
@@ -185,22 +200,22 @@ Cell* reorderKeywordArgs(Cell* params, Cell* args) {
 
 
 
-Cell* evalArgs(Cell* params, Cell* args, Cell* scope) {
+Cell* evalArgs(Cell* params, Cell* args, Cell* scope, bool dontStripAlreadyEval) {
   if (args == nil) return nil;
 
   if (isQuoted(params))
     return mkref(args);
 
   Cell* result = newCell();
-  setCdr(result, evalArgs(cdr(params), cdr(args), scope));
+  setCdr(result, evalArgs(cdr(params), cdr(args), scope, dontStripAlreadyEval));
   rmref(cdr(result));
 
   if (isAlreadyEvald(car(args)))
-    setCar(result, cdr(car(args)));
+    setCar(result, stripAlreadyEvald(car(args)));
   else if (isCons(params) && isQuoted(car(params)))
     setCar(result, car(args));
   else {
-    setCar(result, eval(car(args), scope));
+    setCar(result, eval(car(args), scope, dontStripAlreadyEval));
     rmref(car(result));
   }
   return mkref(result);
@@ -258,8 +273,14 @@ void bindParams(Cell* params, Cell* args) {
 Cell* processUnquotes(Cell* x, long depth, Cell* scope) {
   if (!isCons(x)) return mkref(x);
 
-  if (unquoteDepth(x) == depth)
-    return eval(stripUnquote(x), scope);
+  if (unquoteDepth(x) == depth) {
+    skippedAlreadyEvald = false;
+    Cell* result = eval(stripUnquote(x), scope, true);
+    if (!skippedAlreadyEvald) return result;
+    result = newCons(newSym("''"), result);
+    rmref(cdr(result));
+    return mkref(result);
+  }
   else if (car(x) == newSym(","))
     return mkref(x);
 
@@ -270,7 +291,7 @@ Cell* processUnquotes(Cell* x, long depth, Cell* scope) {
   }
 
   if (depth == 1 && isUnquoteSplice(car(x))) {
-    Cell* result = eval(cdr(car(x)), scope);
+    Cell* result = eval(cdr(car(x)), scope, true);
     Cell* splice = processUnquotes(cdr(x), depth, scope);
     if (result == nil) return splice;
     // always splice in a copy
@@ -311,7 +332,7 @@ Cell* processUnquotes(Cell* x, long depth) {
 
 // HACK: explicitly reads from passed-in scope, but implicitly creates bindings
 // to currLexicalScope. Carefully make sure it's popped off.
-Cell* eval(Cell* expr, Cell* scope) {
+Cell* eval(Cell* expr, Cell* scope, bool dontStripAlreadyEval) {
   if (!expr)
     RAISE << "eval: cell should never be NUL" << endl << DIE;
 
@@ -322,7 +343,7 @@ Cell* eval(Cell* expr, Cell* scope) {
     return mkref(expr);
 
   if (isSym(expr))
-    return mkref(lookup(expr, scope));
+    return mkref(lookup(expr, scope, dontStripAlreadyEval));
 
   if (isAtom(expr))
     return mkref(expr);
@@ -344,7 +365,7 @@ Cell* eval(Cell* expr, Cell* scope) {
 
   newDynamicScope(CURR_LEXICAL_SCOPE, scope);
   // expr is a function call
-  Cell* fn0 = eval(car(expr), scope);
+  Cell* fn0 = eval(car(expr), scope, dontStripAlreadyEval);
   Cell* fn = fn0;
   if (fn0 != nil && !isFn(fn0))
     fn = coerceQuoted(fn0, newSym("function"), lookup("coercions*"));
@@ -356,10 +377,10 @@ Cell* eval(Cell* expr, Cell* scope) {
         << "  Or you need to split it in two." << endl << DIE;
 
   // eval all its args in the current lexical scope
-  Cell* splicedArgs = spliceArgs(callArgs(expr), scope, fn);
+  Cell* splicedArgs = spliceArgs(callArgs(expr), scope, fn, dontStripAlreadyEval);
   // keyword args can change what we eval
   Cell* orderedArgs = reorderKeywordArgs(sig(fn), splicedArgs);
-  Cell* evaldArgs = evalArgs(sig(fn), orderedArgs, scope);
+  Cell* evaldArgs = evalArgs(sig(fn), orderedArgs, scope, dontStripAlreadyEval);
 
   // swap in the function's lexical environment
   if (!isCompiledFn(body(fn)))
@@ -377,7 +398,7 @@ Cell* eval(Cell* expr, Cell* scope) {
   else
     for (Cell* form = impl(fn); form != nil; form = cdr(form)) {
       rmref(result);
-      result = eval(car(form), currLexicalScopes.top());
+      result = eval(car(form), currLexicalScopes.top(), dontStripAlreadyEval);
     }
 
   endLexicalScope();
@@ -393,6 +414,10 @@ Cell* eval(Cell* expr, Cell* scope) {
   return result; // already mkref'd
 }
 
+Cell* eval(Cell* expr, Cell* scope) {
+  return eval(expr, scope, false);
+}
+
 Cell* eval(Cell* expr) {
   return eval(expr, currLexicalScopes.top());
 }
diff --git a/008eval.test.cc b/008eval.test.cc
@@ -80,7 +80,7 @@ void test_reorderKeywordArgs_handles_improper_lists() {
 
 
                                   Cell* evalArgs(Cell* params, Cell* args) {
-                                    return evalArgs(params, args, currLexicalScopes.top());
+                                    return evalArgs(params, args, currLexicalScopes.top(), false);
                                   }
 
 void test_evalArgs_handles_unquoted_param() {
@@ -122,6 +122,20 @@ void test_evalArgs_handles_alreadyEvald_arg() {
   endDynamicScope("a");
 }
 
+void test_evalArgs_handles_multiply_alreadyEvald_arg() {
+  newDynamicScope("a", newNum(3));
+  Cell* params = read(stream("(x)"));
+  Cell* args = newCons(newCons(newSym("''"),
+                  newCons(newSym("''"), newSym("a"))));
+  Cell* evaldArgs = evalArgs(params, args);
+  checkEq(car(evaldArgs), newSym("a"));
+  checkEq(cdr(evaldArgs), nil);
+  rmref(evaldArgs);
+  rmref(args);
+  rmref(params);
+  endDynamicScope("a");
+}
+
 void test_evalArgs_handles_varargs_param() {
   newDynamicScope("a", newNum(3));
   newDynamicScope("b", newNum(4));
@@ -589,7 +603,7 @@ void test_eval_handles_splice6() {
 }
 
 void test_eval_splice_on_macros_warns() {
-  Cell* expr = read(stream("(fn '(x y) (eval `(cons ,x ,y) caller-scope))"));
+  Cell* expr = read(stream("(fn '(x y) (eval (cons 'cons (cons x (cons y nil))) caller-scope))"));
   Cell* fn = eval(expr);
   newDynamicScope("f", fn);
   newDynamicScope("a", newNum(3));
@@ -610,6 +624,28 @@ void test_eval_splice_on_macros_warns() {
   rmref(expr);
 }
 
+void test_eval_splice_on_macros_with_backquote() {
+  Cell* expr = read(stream("(fn '(x y) (eval `(cons ,x ,y) caller-scope))"));
+  Cell* fn = eval(expr);
+  newDynamicScope("f", fn);
+  newDynamicScope("a", newNum(3));
+  newDynamicScope("b", newNum(4));
+  Cell* argval = read(stream("(a b)"));
+  newDynamicScope("args", argval);
+  Cell* call = read(stream("(f @args)"));
+  Cell* result = eval(call);
+  checkEq(raiseCount, 0);
+  rmref(result);
+  rmref(call);
+  endDynamicScope("args");
+  rmref(argval);
+  endDynamicScope("b");
+  endDynamicScope("a");
+  endDynamicScope("f");
+  rmref(fn);
+  rmref(expr);
+}
+
 void test_eval_doesnt_modify_fn() {
   Cell* fn = read(stream("(fn(x) (eval x))"));
   Cell* f = eval(fn);

diff --git a/030.test b/030.test
@@ -5,6 +5,42 @@ prn.
  :valueof (let x 3 (foo x))
  :should be 4)
 
+(mac! foo(a b) `(cons ,a ,b))
+(test "macros work with splice when eventually eval'd"
+ :valueof (foo @'(1 (2 3)))
+ :should be '(1 2 3))
+
+(test "macros work with splice when not eventually eval'd"
+ :valueof ((fn() (= @'(foo 3)) foo))
+ :should be 3)
+
+(mac! foo(a b) `(cons ,a ,b))
+(mac! bar(a b) `(foo ,a ,b))
+(test "nested macros work with splice"
+ :valueof (bar @'(1 (2 3)))
+ :should be '(1 2 3))
+
+(mac! bar args `(foo ,@args))
+(test "nested macros work with nested splice"
+ :valueof (bar @'(1 (2 3)))
+ :should be '(1 2 3))
+
+(def! bar args (foo @args))
+(mac! qux args `(bar ,@args))
+(test "nested functions and macros work with nested splice"
+ :valueof (qux @'(1 (2 3)))
+ :should be '(1 2 3))
+
+(mac! foo(a b) `(if 34 ,(if 34 `(cons ,a ,b))))
+(test "nested backquotes work with splice"
+ :valueof (foo @'(1 (2 3)))
+ :should be '(1 2 3))
+
+(mac! foo(a b) `(cons ,a ,cdr.b))
+(test "compound comma-exprs work with splice"
+ :valueof (foo @'(1 (2 3)))
+ :should be '(1 3))
+
 
 
 (test "do returns last expr"

diff --git a/031test.wart b/031test.wart
@@ -7,8 +7,6 @@ def pending-test'(msg expr/valueof pred/should expected)
   (err "
 pending: ")
   (err msg)
-  (err "
-")
 
 alias be iso
 alias equal iso

diff --git a/032check.test b/032check.test
@@ -82,6 +82,10 @@
                 (or nil x)))
  :should be 3)
 
+(test "or works with splice"
+ :valueof (or @'(nil 1))
+ :should be 1)
+
 
 
 (test "and handles 0 args"
@@ -121,6 +125,10 @@
               (and x 36))
  :should be 36)
 
+(test "and works with splice"
+ :valueof (and @'(1 2))
+ :should be 2)
+
 
 
 (test "iso handles nils"

diff --git a/boot.cc b/boot.cc
@@ -80,6 +80,7 @@ Cell* read(CodeStream& c);
 bool interactive = false; // eval on multiple newlines
 Cell* eval(Cell*);
 Cell* eval(Cell*, Cell*);
+Cell* eval(Cell*, Cell*, bool);