diff options
| author | dos-reis <gdr@axiomatics.org> | 2013-06-01 07:35:18 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2013-06-01 07:35:18 +0000 |
| commit | 64aeafac79d72f440b6546bae91583e6efd6b674 (patch) | |
| tree | de419861e4625d20bc0e1c68f5db1590a50708b9 /src/boot/strap/ast.clisp | |
| parent | de3a19c35df30298d323c5882e39931f329ea29e (diff) | |
| download | open-axiom-64aeafac79d72f440b6546bae91583e6efd6b674.tar.gz | |
Support --output in compiler, for bootstrapping stage.
Diffstat (limited to 'src/boot/strap/ast.clisp')
| -rw-r--r-- | src/boot/strap/ast.clisp | 23 |
1 files changed, 16 insertions, 7 deletions
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index a51ee1c2..6cb05e57 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -1223,6 +1223,8 @@ (DEFUN |bfKeyArg| (|k| |x|) (LIST '|%Key| |k| |x|)) +(DEFUN |lispKey| (|k|) (INTERN (STRING-UPCASE (SYMBOL-NAME |k|)) "KEYWORD")) + (DEFUN |bfExpandKeys| (|l|) (LET* (|x| |ISTMP#2| |k| |ISTMP#1| |a| |args|) (PROGN @@ -1241,17 +1243,24 @@ (SETQ |ISTMP#2| (CDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) (PROGN (SETQ |x| (CAR |ISTMP#2|)) T)))))) - (SETQ |args| - (CONS |x| - (CONS - (INTERN (STRING-UPCASE (SYMBOL-NAME |k|)) "KEYWORD") - |args|)))) + (SETQ |args| (CONS |x| (CONS (|lispKey| |k|) |args|)))) (T (SETQ |args| (CONS |a| |args|))))) (|reverse!| |args|)))) (DEFUN |bfApplication| (|bfop| |bfarg|) - (COND ((|bfTupleP| |bfarg|) (CONS |bfop| (|bfExpandKeys| (CDR |bfarg|)))) - (T (LIST |bfop| |bfarg|)))) + (LET* (|v| |ISTMP#2| |k| |ISTMP#1|) + (COND ((|bfTupleP| |bfarg|) (CONS |bfop| (|bfExpandKeys| (CDR |bfarg|)))) + ((AND (CONSP |bfarg|) (EQ (CAR |bfarg|) '|%Key|) + (PROGN + (SETQ |ISTMP#1| (CDR |bfarg|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SETQ |k| (CAR |ISTMP#1|)) + (SETQ |ISTMP#2| (CDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) + (PROGN (SETQ |v| (CAR |ISTMP#2|)) T)))))) + (LIST |bfop| (|lispKey| |k|) |v|)) + (T (LIST |bfop| |bfarg|))))) (DEFUN |bfReName| (|x|) (LET* (|a|) |