Permalink
Browse files

`(support ,.destructive splice)

  • Loading branch information...
1 parent 4f200e8 commit 1c91ceab6ee0f34c0bf2f82e53fffe6eee375907 @mishoo mishoo committed May 17, 2011
Showing with 28 additions and 8 deletions.
  1. +14 −4 jcls.js
  2. +14 −4 tmp/test.lisp
View
18 jcls.js
@@ -470,6 +470,10 @@ function read_comma(stream) {
stream.next();
sym = "UNQUOTE-SPLICE";
}
+ else if (stream.peek() == ".") {
+ stream.next();
+ sym = "UNQUOTE-NSPLICE";
+ }
return cons(JCLS.intern(sym), cons(read(stream), NIL));
};
@@ -623,11 +627,14 @@ var analyze = (function(){
return fapply(func, list);
});
- (function(UNQUOTE, SPLICE, QUASIQUOTE){
- function Splice(list) { this.list = list };
+ (function(UNQUOTE, SPLICE, NSPLICE, QUASIQUOTE){
+ function Splice(list, destructive) {
+ this.list = list;
+ this.destructive = destructive;
+ };
function cons_splice(a, b) {
if (a instanceof Splice) {
- a = copy_list(a.list);
+ a = a.destructive ? a.list : copy_list(a.list);
set_cdr(last(a), b);
return a;
}
@@ -643,6 +650,7 @@ var analyze = (function(){
switch (caar(node)) {
case UNQUOTE:
case SPLICE:
+ case NSPLICE:
if (nest == 0) {
set_car(cdr(car(node)), analyze(cadar(node)));
} else {
@@ -664,7 +672,8 @@ var analyze = (function(){
if (consp(node)) {
switch (car(node)) {
case UNQUOTE: return cadr(node)(env);
- case SPLICE: return new Splice(cadr(node)(env));
+ case SPLICE: return new Splice(cadr(node)(env), false);
+ case NSPLICE: return new Splice(cadr(node)(env), true);
}
return cons_splice(walk(car(node)), walk(cdr(node)));
} else {
@@ -675,6 +684,7 @@ var analyze = (function(){
});
}(JCLS.intern("UNQUOTE"),
JCLS.intern("UNQUOTE-SPLICE"),
+ JCLS.intern("UNQUOTE-NSPLICE"),
JCLS.intern("QUASIQUOTE")));
CL.special("QUOTE", function(ast){ return itself(car(ast)) });
View
@@ -1,9 +1,19 @@
-;; (jcls:print '(starting up))
-;; (jcls:print `(a b ,(+ 2 3)))
-;; (jcls:print `(,@(list 'foo 'bar) a b ,@(list 1 2 3)))
-
(jcls:print "Entering evaluator")
+(let* ((a '(1 2 3 4))
+ (b '(1 2 3 4))
+ (c `(,@a foo ,@a bar ,.b baz)))
+ (jcls:print c)
+ (jcls:print b)
+ (jcls:print a))
+
+(let ((a '(1 2)))
+ (jcls:print `(,.a ,@a))
+ (jcls:print a)
+ ;; but the following makes a cycle and our print function loops forever
+ ;; (jcls:print `(,.a ,.a))
+ )
+
(flet ((q ()
`(1 2 3)))
(jcls:print (eq (q) (q))))

0 comments on commit 1c91cea

Please sign in to comment.