diff options
author | dos-reis <gdr@axiomatics.org> | 2012-05-22 16:46:25 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2012-05-22 16:46:25 +0000 |
commit | eae4d54c648d019b9db583b4e8d2c432f8d7bb16 (patch) | |
tree | 2be3450270bde5e728ba1f2571b3a00c95aaf910 | |
parent | d5c006517a885094c5752f7f143c9a0e8cda4504 (diff) | |
download | open-axiom-eae4d54c648d019b9db583b4e8d2c432f8d7bb16.tar.gz |
* 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.
-rw-r--r-- | src/ChangeLog | 10 | ||||
-rw-r--r-- | src/boot/ast.boot | 5 | ||||
-rw-r--r-- | src/boot/strap/ast.clisp | 59 | ||||
-rw-r--r-- | src/interp/lexing.boot | 25 |
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() |