aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog10
-rw-r--r--src/boot/ast.boot5
-rw-r--r--src/boot/strap/ast.clisp59
-rw-r--r--src/interp/lexing.boot25
4 files changed, 53 insertions, 46 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index ea883533..3f7b04b3 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,15 @@
2012-05-22 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/lexing.boot (%Token): Now an actual type defined as a
+ record structure.
+ (copyToken): Adjust.
+ (tokenSymbol): Remove as now automatically generated.
+ (tokenType): Likewise.
+ (tokenNonblank?): Likewise.
+ * boot/ast.boot (bfRecordDef): Specify a name for a copier function.
+
+2012-05-22 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* boot/translator.boot (translateToplevel): Handle record structures.
* boot/tokens.boot: "with" is now a keyword in Boot.
* boot/parser.boot (bpSignature): The typing is required afte the
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index b3c568b4..54d9b7ed 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -1342,7 +1342,10 @@ bfRecordDef(s,fields,accessors) ==
parms := [x for f in fields | f is ['%Signature,x,.]]
fun := makeSymbol strconc('"mk",symbolName s)
ctor := makeSymbol strconc('"MAKE-",symbolName s)
- recDef := ["DEFSTRUCT",s,:[x for ['%Signature,x,.] in fields]]
+ recDef := ["DEFSTRUCT",
+ [s,[bfColonColon("KEYWORD","COPIER"),
+ makeSymbol strconc('"copy",symbolName s)]],
+ :[x for ['%Signature,x,.] in fields]]
ctorDef :=
args := [:[bfColonColon("KEYWORD",p),p] for p in parms]
["DEFMACRO",fun,parms,["LIST",quote ctor,:args]]
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 59f68b8c..89380ea0 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -2515,34 +2515,37 @@
(SETQ |ctor| (INTERN (CONCAT "MAKE-" (SYMBOL-NAME |s|))))
(SETQ |recDef|
(CONS 'DEFSTRUCT
- (CONS |s|
- (LET ((|bfVar#6| NIL)
- (|bfVar#7| NIL)
- (|bfVar#5| |fields|)
- (|bfVar#4| NIL))
- (LOOP
- (COND
- ((OR (NOT (CONSP |bfVar#5|))
- (PROGN (SETQ |bfVar#4| (CAR |bfVar#5|)) NIL))
- (RETURN |bfVar#6|))
- (T
- (AND (CONSP |bfVar#4|)
- (EQ (CAR |bfVar#4|) '|%Signature|)
- (PROGN
- (SETQ |ISTMP#1| (CDR |bfVar#4|))
- (AND (CONSP |ISTMP#1|)
- (PROGN
- (SETQ |x| (CAR |ISTMP#1|))
- (SETQ |ISTMP#2| (CDR |ISTMP#1|))
- (AND (CONSP |ISTMP#2|)
- (NULL (CDR |ISTMP#2|))))))
- (COND
- ((NULL |bfVar#6|)
- (SETQ |bfVar#6| #2=(CONS |x| NIL))
- (SETQ |bfVar#7| |bfVar#6|))
- (T (RPLACD |bfVar#7| #2#)
- (SETQ |bfVar#7| (CDR |bfVar#7|)))))))
- (SETQ |bfVar#5| (CDR |bfVar#5|)))))))
+ (CONS
+ (LIST |s|
+ (LIST (|bfColonColon| 'KEYWORD 'COPIER)
+ (INTERN (CONCAT "copy" (SYMBOL-NAME |s|)))))
+ (LET ((|bfVar#6| NIL)
+ (|bfVar#7| NIL)
+ (|bfVar#5| |fields|)
+ (|bfVar#4| NIL))
+ (LOOP
+ (COND
+ ((OR (NOT (CONSP |bfVar#5|))
+ (PROGN (SETQ |bfVar#4| (CAR |bfVar#5|)) NIL))
+ (RETURN |bfVar#6|))
+ (T
+ (AND (CONSP |bfVar#4|)
+ (EQ (CAR |bfVar#4|) '|%Signature|)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |bfVar#4|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |x| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (NULL (CDR |ISTMP#2|))))))
+ (COND
+ ((NULL |bfVar#6|)
+ (SETQ |bfVar#6| #2=(CONS |x| NIL))
+ (SETQ |bfVar#7| |bfVar#6|))
+ (T (RPLACD |bfVar#7| #2#)
+ (SETQ |bfVar#7| (CDR |bfVar#7|)))))))
+ (SETQ |bfVar#5| (CDR |bfVar#5|)))))))
(SETQ |ctorDef|
(PROGN
(SETQ |args|
diff --git a/src/interp/lexing.boot b/src/interp/lexing.boot
index aeaccf9d..5adc0678 100644
--- a/src/interp/lexing.boot
+++ b/src/interp/lexing.boot
@@ -152,27 +152,18 @@ nextChar() ==
--%
--% Token abstract datatype.
---% Operational semantics:
---% structure Token ==
---% Record(symbol: Identifier, type: TokenType, nonBlank?: Boolean)
---%
---% type in '(NUMBER IDENTIFIER SPECIAL_-CHAR)
---% nonBlank? if token is not preceded by a blank.
--%
+structure %Token ==
+ Record(sym: %Symbol, typ: %Thing, nb?: %Boolean) with
+ tokenSymbol == (.sym)
+ tokenType == (.typ) -- typ in '(NUMBER IDENTIFIER SPECIAL_-CHAR)
+ tokenNonblank? == (.nb?) -- true if token is not preceded by a blank.
+
makeToken(sym == nil, typ == nil, blnk? == true) ==
- [sym,typ,blnk?]
+ mk%Token(sym,typ,blnk?)
macro copyToken t ==
- copyList t
-
-macro tokenSymbol t ==
- first t
-
-macro tokenType t ==
- second t
-
-macro tokenNonblank? t ==
- third t
+ copy%Token t
++ Last seen token
$priorToken := makeToken()