diff options
Diffstat (limited to 'src/boot')
| -rw-r--r-- | src/boot/ast.boot | 7 | ||||
| -rw-r--r-- | src/boot/parser.boot | 21 | ||||
| -rw-r--r-- | src/boot/strap/ast.clisp | 5 | ||||
| -rw-r--r-- | src/boot/strap/parser.clisp | 7 |
4 files changed, 26 insertions, 14 deletions
diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 05a1d94d..b7ae91b5 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -1362,10 +1362,15 @@ bfDs n == n = 0 => '"" strconc('"D",bfDs(n-1)) +ctorName x == + x is [.,:.] => ctorName first x + x + bfEnum(t,csts) == - ['DEFTYPE,t,nil,backquote(['MEMBER,:csts],nil)] + ['DEFTYPE,ctorName t,nil,backquote(['MEMBER,:csts],nil)] bfRecordDef(tu,s,fields,accessors) == + s := ctorName s -- forget parameters parms := [x for f in fields | f is ['%Signature,x,.]] fun := makeSymbol strconc('"mk",symbolName s) ctor := makeSymbol strconc('"MAKE-",symbolName s) diff --git a/src/boot/parser.boot b/src/boot/parser.boot index ce3f4954..43507640 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -1,4 +1,4 @@ --- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. +-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. -- Copyright (C) 2007-2012, Gabriel Dos Reis. -- All rights reserved. @@ -477,7 +477,7 @@ bpExportItem ps == bpRequire(ps,function bpSignature) bpExportItemTail ps or true bpRestore(ps,a) - bpTypeAliasDefition ps + bpTypeAliasDefinition ps false ++ ExportItemList: @@ -542,12 +542,15 @@ bpNamespace ps == bpPush(ps,bfNamespace bpPop1 ps) -- Parse a type alias defnition: --- type-alias-definition: --- identifier <=> logical-expression -bpTypeAliasDefition ps == - (bpTerm(ps,function bpIdList) or bpTrap ps) and +-- TypeAliasDefinition: +-- TypeName <=> logical-expression +bpTypeAliasDefinition ps == + bpTypeName ps and bpEqKey(ps,"TDEF") and bpLogical ps and - bpPush(ps,%TypeAlias(bpPop2 ps, bpPop1 ps)) + bpPush(ps,%TypeAlias(bpPop2 ps,bpPop1 ps)) + +bpTypeName ps == + bpTerm(ps,function bpIdList) or bpTrap ps ++ Parse a signature declaration ++ Signature: @@ -981,7 +984,7 @@ bpDefinition ps == bpDef ps bpEqPeek(ps,"TDEF") => bpRestore(ps,a) - bpTypeAliasDefition ps + bpTypeAliasDefinition ps true bpRestore(ps,a) false @@ -1220,7 +1223,7 @@ bpChecknull ps == bpStruct ps == bpEqKey(ps,"STRUCTURE") and - bpRequire(ps,function bpName) and + bpRequire(ps,function bpTypeName) and (bpEqKey(ps,"DEF") or bpTrap ps) and (bpRecord ps or bpTypeList ps) and bpPush(ps,%Structure(bpPop2 ps,bpPop1 ps)) diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 73afad30..9c271751 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -2518,8 +2518,10 @@ (DEFUN |bfDs| (|n|) (COND ((EQL |n| 0) "") (T (CONCAT "D" (|bfDs| (- |n| 1)))))) +(DEFUN |ctorName| (|x|) (COND ((CONSP |x|) (|ctorName| (CAR |x|))) (T |x|))) + (DEFUN |bfEnum| (|t| |csts|) - (LIST 'DEFTYPE |t| NIL (|backquote| (CONS 'MEMBER |csts|) NIL))) + (LIST 'DEFTYPE (|ctorName| |t|) NIL (|backquote| (CONS 'MEMBER |csts|) NIL))) (DEFUN |bfRecordDef| (|tu| |s| |fields| |accessors|) (LET* (|accDefs| @@ -2535,6 +2537,7 @@ |x| |ISTMP#1|) (PROGN + (SETQ |s| (|ctorName| |s|)) (SETQ |parms| (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index d0d000c8..1b05fd82 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -556,10 +556,11 @@ (|bpPush| |ps| (|bfNamespace| (|bpPop1| |ps|))))) (DEFUN |bpTypeAliasDefition| (|ps|) - (AND (OR (|bpTerm| |ps| #'|bpIdList|) (|bpTrap| |ps|)) (|bpEqKey| |ps| 'TDEF) - (|bpLogical| |ps|) + (AND (|bpTypeName| |ps|) (|bpEqKey| |ps| 'TDEF) (|bpLogical| |ps|) (|bpPush| |ps| (|%TypeAlias| (|bpPop2| |ps|) (|bpPop1| |ps|))))) +(DEFUN |bpTypeName| (|ps|) (OR (|bpTerm| |ps| #'|bpIdList|) (|bpTrap| |ps|))) + (DEFUN |bpSignature| (|ps|) (AND (|bpName| |ps|) (|bpSignatureTail| |ps|))) (DEFUN |bpSignatureTail| (|ps|) @@ -1282,7 +1283,7 @@ (COND ((NULL |a|) (|bpTrap| |ps|)) (T (|bpPush| |ps| |a|)))))) (DEFUN |bpStruct| (|ps|) - (AND (|bpEqKey| |ps| 'STRUCTURE) (|bpRequire| |ps| #'|bpName|) + (AND (|bpEqKey| |ps| 'STRUCTURE) (|bpRequire| |ps| #'|bpTypeName|) (OR (|bpEqKey| |ps| 'DEF) (|bpTrap| |ps|)) (OR (|bpRecord| |ps|) (|bpTypeList| |ps|)) (|bpPush| |ps| (|%Structure| (|bpPop2| |ps|) (|bpPop1| |ps|))))) |