diff options
author | dos-reis <gdr@axiomatics.org> | 2012-05-23 02:49:30 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2012-05-23 02:49:30 +0000 |
commit | a8faa740f1e13fce63ac23326a227655bca7a0b2 (patch) | |
tree | a4d6165c93449b677aaaa45e609131546198fb1b /src/boot/strap/scanner.clisp | |
parent | eae4d54c648d019b9db583b4e8d2c432f8d7bb16 (diff) | |
download | open-axiom-a8faa740f1e13fce63ac23326a227655bca7a0b2.tar.gz |
* boot/tokens.boot (%Token): New datatype.
(makeToken): New.
* boot/includer.boot: Use %token accessors.
* boot/parser.boot: Likewise.
* boot/pile.boot: Likewise.
* boot/scanner.boot: Likewise.
* boot/utility.boot: Export subString.
Diffstat (limited to 'src/boot/strap/scanner.clisp')
-rw-r--r-- | src/boot/strap/scanner.clisp | 23 |
1 files changed, 3 insertions, 20 deletions
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp index 958f768b..3c056e11 100644 --- a/src/boot/strap/scanner.clisp +++ b/src/boot/strap/scanner.clisp @@ -23,19 +23,6 @@ (DEFUN |dqToList| (|s|) (COND ((NULL |s|) NIL) (T (CAR |s|)))) -(DEFUN |shoeTokConstruct| (|x| |y| |z|) (CONS |x| (CONS |y| |z|))) - -(DEFUN |shoeConstructToken| (|lp| |b| |n|) - (|shoeTokConstruct| (ELT |b| 0) (ELT |b| 1) (CONS |lp| |n|))) - -(DEFUN |shoeTokType| (|x|) (CAR |x|)) - -(DEFUN |shoeTokPart| (|x|) (CADR |x|)) - -(DEFUN |shoeTokPosn| (|x|) - (LET* (|p|) - (PROGN (SETQ |p| (CDDR |x|)) |p|))) - (DEFUN |shoeNextLine| (|s|) (LET* (|s1| |a|) (DECLARE (SPECIAL |$sz| |$n| |$ln| |$r| |$f| |$linepos|)) @@ -72,8 +59,7 @@ ((SETQ |command| (|shoeLine?| |$ln|)) (SETQ |dq| (|dqUnit| - (|shoeConstructToken| |$linepos| - (|shoeLeafLine| |command|) 0))) + (|makeToken| |$linepos| (|shoeLeafLine| |command|) 0))) (CONS (LIST |dq|) |$r|)) ((SETQ |command| (|shoeLisp?| |$ln|)) (|shoeLispToken| |$r| |command|)) @@ -97,9 +83,7 @@ (SETQ |LETTMP#1| (|shoeAccumulateLines| |s| |string|)) (SETQ |r| (CAR |LETTMP#1|)) (SETQ |st| (CDR |LETTMP#1|)) - (SETQ |dq| - (|dqUnit| - (|shoeConstructToken| |linepos| (|shoeLeafLisp| |st|) 0))) + (SETQ |dq| (|dqUnit| (|makeToken| |linepos| (|shoeLeafLisp| |st|) 0))) (CONS (LIST |dq|) |r|)))) (DEFUN |shoeAccumulateLines| (|s| |string|) @@ -146,8 +130,7 @@ ((CHAR= |ch| (|char| '_)) (|shoeEscape|)) ((EQUAL |ch| |shoeTAB|) (SETQ |$n| (+ |$n| 1)) NIL) (T (|shoeError|)))) - (COND ((NULL |b|) NIL) - (T (|dqUnit| (|shoeConstructToken| |linepos| |b| |n|))))))) + (COND ((NULL |b|) NIL) (T (|dqUnit| (|makeToken| |linepos| |b| |n|))))))) (DEFUN |shoeLeafId| (|x|) (LIST 'ID (INTERN |x|))) |