From d7eceebe0eb9cd7840f183dcaf294c85794b0db5 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sun, 3 Jun 2012 13:02:47 +0000
Subject: 	* interp/lexing.boot (%Line): Now a record structure. 	*
 boot/parser.boot (bpTypeName): Split out of bpTypeAliasDefinition. 
 (bpStruct): Use it.  Support parameterized structures. 	*
 boot/ast.boot (ctorName): New. 	(bfEnum): Use it for parameterized
 enums. 	(bfRecord): Use it for parameterized records.

---
 src/boot/strap/ast.clisp    | 5 ++++-
 src/boot/strap/parser.clisp | 7 ++++---
 2 files changed, 8 insertions(+), 4 deletions(-)

(limited to 'src/boot/strap')

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|)))))
-- 
cgit v1.2.3