diff options
Diffstat (limited to 'src/boot/strap')
| -rw-r--r-- | src/boot/strap/ast.clisp | 3 | ||||
| -rw-r--r-- | src/boot/strap/translator.clisp | 41 |
2 files changed, 28 insertions, 16 deletions
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index b0c40086..e90f8223 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -2329,6 +2329,9 @@ (DEFUN |bfDs| (|n|) (COND ((EQL |n| 0) "") (T (CONCAT "D" (|bfDs| (- |n| 1)))))) +(DEFUN |bfEnum| (|t| |csts|) + (LIST 'DEFTYPE |t| NIL (|backquote| (CONS 'MEMBER |csts|) NIL))) + (DEFUN |bfHandlers| (|n| |e| |hs|) (|bfHandlers,main| |n| |e| |hs| NIL)) (DEFUN |bfHandlers,main| (|n| |e| |hs| |xs|) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index 4294b1ba..eec8f45e 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -609,7 +609,7 @@ (T |x|))))) (DEFUN |translateToplevel| (|b| |export?|) - (PROG (|lhs| |t| |ISTMP#2| |sig| |ns| |n| |ISTMP#1| |xs|) + (PROG (|csts| |lhs| |t| |ISTMP#2| |sig| |ns| |n| |ISTMP#1| |xs|) (DECLARE (SPECIAL |$currentModuleName| |$foreignsDefsForCLisp| |$constantIdentifiers| |$InteractiveMode| |$activeNamespace|)) @@ -725,21 +725,30 @@ (|bfMDef| |op| |args| |body|))) (|%Structure| (LET ((|t| (CADR |b|)) (|alts| (CADDR |b|))) - (LET ((|bfVar#5| NIL) - (|bfVar#6| NIL) - (|bfVar#4| |alts|) - (|alt| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#4|)) - (PROGN (SETQ |alt| (CAR |bfVar#4|)) NIL)) - (RETURN |bfVar#5|)) - ((NULL |bfVar#5|) - (SETQ |bfVar#5| #2=(CONS (|bfCreateDef| |alt|) NIL)) - (SETQ |bfVar#6| |bfVar#5|)) - (T (RPLACD |bfVar#6| #2#) - (SETQ |bfVar#6| (CDR |bfVar#6|)))) - (SETQ |bfVar#4| (CDR |bfVar#4|)))))) + (COND + ((AND (CONSP |alts|) (NULL (CDR |alts|)) + (PROGN + (SETQ |ISTMP#1| (CAR |alts|)) + (AND (CONSP |ISTMP#1|) + (EQ (CAR |ISTMP#1|) '|Enumeration|) + (PROGN (SETQ |csts| (CDR |ISTMP#1|)) T)))) + (LIST (|bfEnum| |t| |csts|))) + (T + (LET ((|bfVar#5| NIL) + (|bfVar#6| NIL) + (|bfVar#4| |alts|) + (|alt| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#4|)) + (PROGN (SETQ |alt| (CAR |bfVar#4|)) NIL)) + (RETURN |bfVar#5|)) + ((NULL |bfVar#5|) + (SETQ |bfVar#5| #2=(CONS (|bfCreateDef| |alt|) NIL)) + (SETQ |bfVar#6| |bfVar#5|)) + (T (RPLACD |bfVar#6| #2#) + (SETQ |bfVar#6| (CDR |bfVar#6|)))) + (SETQ |bfVar#4| (CDR |bfVar#4|)))))))) (|%Namespace| (LET ((|n| (CADR |b|))) (PROGN |