diff options
| -rw-r--r-- | src/ChangeLog | 5 | ||||
| -rw-r--r-- | src/boot/ast.boot | 8 | ||||
| -rw-r--r-- | src/boot/strap/ast.clisp | 22 |
3 files changed, 18 insertions, 17 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 94ea56f9..8435dbcb 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2011-05-25 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * boot/ast.boot (shoeCompTran1): Translate arguments to vector + constructor too. + 2011-05-20 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/modemap.boot (augModemapsFromDomain): Don't add modemaps diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 76616c22..d8eedae2 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -1015,8 +1015,12 @@ shoeCompTran1 x == $locVars := [y for y in $locVars | not symbolMember?(y,newbindings)] x -- literal vectors. - x is ['vector,['LIST,:args]] => (x.op := 'VECTOR; x.args := args; x) - x is ['vector,'NIL] => (x.op := 'VECTOR; x.args := nil; x) + x is ['vector,elts] => + x.op := 'VECTOR + do + elts is 'NIL => x.args := nil + x.args := shoeCompTran1 elts.args -- elts.op is LIST + x x is ['%Namespace,n] => n is "DOT" => "*PACKAGE*" ["FIND-PACKAGE",symbolName n] diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 61a5f103..90ce113f 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -1820,7 +1820,7 @@ (T NIL))))) (DEFUN |shoeCompTran1| (|x|) - (PROG (|n| |args| |newbindings| |r| |ISTMP#2| |l| |zs| |y| |ISTMP#1| + (PROG (|n| |elts| |newbindings| |r| |ISTMP#2| |l| |zs| |y| |ISTMP#1| U) (DECLARE (SPECIAL |$fluidVars| |$locVars| |$dollarVars|)) (RETURN @@ -1918,20 +1918,12 @@ (PROGN (SETQ |ISTMP#1| (CDR |x|)) (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (PROGN - (SETQ |ISTMP#2| (CAR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (EQ (CAR |ISTMP#2|) 'LIST) - (PROGN - (SETQ |args| (CDR |ISTMP#2|)) - T)))))) - (RPLACA |x| 'VECTOR) (RPLACD |x| |args|) |x|) - ((AND (CONSP |x|) (EQ (CAR |x|) '|vector|) - (PROGN - (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (EQ (CAR |ISTMP#1|) 'NIL)))) - (RPLACA |x| 'VECTOR) (RPLACD |x| NIL) |x|) + (PROGN (SETQ |elts| (CAR |ISTMP#1|)) T)))) + (RPLACA |x| 'VECTOR) + (COND + ((EQ |elts| 'NIL) (RPLACD |x| NIL)) + (T (RPLACD |x| (|shoeCompTran1| (CDR |elts|))))) + |x|) ((AND (CONSP |x|) (EQ (CAR |x|) '|%Namespace|) (PROGN (SETQ |ISTMP#1| (CDR |x|)) |