diff options
Diffstat (limited to 'src/boot/strap')
| -rw-r--r-- | src/boot/strap/ast.clisp | 25 | ||||
| -rw-r--r-- | src/boot/strap/includer.clisp | 2 | ||||
| -rw-r--r-- | src/boot/strap/scanner.clisp | 2 | ||||
| -rw-r--r-- | src/boot/strap/tokens.clisp | 3 | ||||
| -rw-r--r-- | src/boot/strap/translator.clisp | 14 |
5 files changed, 31 insertions, 15 deletions
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index e491f548..6053c6b8 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -228,7 +228,7 @@ (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Boolean|) |bfBeginsDollar|)) -(DEFUN |bfBeginsDollar| (|x|) (EQL (ELT (PNAME |x|) 0) (|char| '$))) +(DEFUN |bfBeginsDollar| (|x|) (CHAR= (ELT (PNAME |x|) 0) (|char| '$))) (DEFUN |compFluid| (|id|) (LIST 'FLUID |id|)) @@ -959,9 +959,12 @@ (RETURN (COND ((NULL |rhs|) (LIST 'NULL |lhs|)) - ((STRINGP |rhs|) + ((|bfString?| |rhs|) (|bfAND| (LIST (LIST 'STRINGP |lhs|) (LIST 'STRING= |lhs| |rhs|)))) + ((|bfChar?| |rhs|) + (|bfAND| (LIST (LIST 'CHARACTERP |lhs|) + (LIST 'CHAR= |lhs| |rhs|)))) ((INTEGERP |rhs|) (LIST 'EQL |lhs| |rhs|)) ((ATOM |rhs|) (LIST 'PROGN (|bfLetForm| |rhs| |lhs|) 'T)) ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'QUOTE) @@ -1201,24 +1204,35 @@ (DEFUN |defQuoteId| (|x|) (AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE) (SYMBOLP (CADR |x|)))) +(DEFUN |bfChar?| (|x|) + (OR (CHARACTERP |x|) + (AND (CONSP |x|) (MEMQ (CAR |x|) '(|char| |abstractChar|))))) + (DEFUN |bfSmintable| (|x|) (OR (INTEGERP |x|) - (AND (CONSP |x|) (MEMQ (CAR |x|) '(SIZE LENGTH |char| QENUM))))) + (AND (CONSP |x|) (MEMQ (CAR |x|) '(SIZE LENGTH QENUM))))) + +(DEFUN |bfString?| (|x|) + (OR (STRINGP |x|) + (AND (CONSP |x|) + (MEMQ (CAR |x|) '(|charString| |symbolName| |toString|))))) (DEFUN |bfQ| (|l| |r|) (COND + ((OR (|bfChar?| |l|) (|bfChar?| |r|)) (LIST 'CHAR= |l| |r|)) ((OR (|bfSmintable| |l|) (|bfSmintable| |r|)) (LIST 'EQL |l| |r|)) ((OR (|defQuoteId| |l|) (|defQuoteId| |r|)) (LIST 'EQ |l| |r|)) ((NULL |l|) (LIST 'NULL |r|)) ((NULL |r|) (LIST 'NULL |l|)) ((OR (EQ |l| T) (EQ |r| T)) (LIST 'EQ |l| |r|)) - ((OR (STRINGP |l|) (STRINGP |r|)) (LIST 'STRING= |l| |r|)) + ((OR (|bfString?| |l|) (|bfString?| |r|)) (LIST 'STRING= |l| |r|)) (T (LIST 'EQUAL |l| |r|)))) (DEFUN |bfLessp| (|l| |r|) (COND ((EQL |l| 0) (LIST 'PLUSP |r|)) ((EQL |r| 0) (LIST 'MINUSP |l|)) + ((OR (|bfChar?| |l|) (|bfChar?| |r|)) (LIST 'CHAR< |l| |r|)) (T (LIST '< |l| |r|)))) (DEFUN |bfLambda| (|vars| |body|) @@ -1570,7 +1584,8 @@ ((MEMQ |x| |$constantIdentifiers|) NIL) ((CONSTANTP |x|) NIL) ((OR (BOUNDP |x|) (NULL |$activeNamespace|)) T) - ((SETQ |y| (FIND-SYMBOL (STRING |x|) |$activeNamespace|)) + ((SETQ |y| + (FIND-SYMBOL (SYMBOL-NAME |x|) |$activeNamespace|)) (NOT (CONSTANTP |y|))) (T T))) (T NIL))))) diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp index 99c6a5fb..06904a5b 100644 --- a/src/boot/strap/includer.clisp +++ b/src/boot/strap/includer.clisp @@ -252,7 +252,7 @@ (DEFUN |shoePlainLine?| (|s|) (COND ((EQL (LENGTH |s|) 0) T) - (T (NOT (EQL (ELT |s| 0) (|char| '|)|)))))) + (T (NOT (CHAR= (ELT |s| 0) (|char| '|)|)))))) (DEFUN |shoeSay?| (|s|) (|shoePrefix?| ")say" |s|)) diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp index 0fe763ad..1319d3c9 100644 --- a/src/boot/strap/scanner.clisp +++ b/src/boot/strap/scanner.clisp @@ -51,7 +51,7 @@ ((NULL |$n|) T) ((EQL (QENUM |$ln| |$n|) |shoeTAB|) (SETQ |a| (MAKE-FULL-CVEC (- 7 (REM |$n| 8)) " ")) - (SETF (ELT |$ln| |$n|) (ELT " " 0)) + (SETF (ELT |$ln| |$n|) (|char| '| |)) (SETQ |$ln| (CONCAT |a| |$ln|)) (SETQ |s1| (CONS (CONS |$ln| (CDR |$f|)) |$r|)) (|shoeNextLine| |s1|)) diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index 58a9b3d7..45c988f4 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -213,12 +213,13 @@ (EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL) (LET ((|bfVar#9| - (LIST (LIST '|abs| 'ABS) + (LIST (LIST '|abs| 'ABS) (LIST '|abstractChar| 'CODE-CHAR) (LIST '|alphabetic?| 'ALPHA-CHAR-P) (LIST '|alphanumeric?| 'ALPHANUMERICP) (LIST '|and| 'AND) (LIST '|append| 'APPEND) (LIST '|apply| 'APPLY) (LIST '|atom| 'ATOM) (LIST '|canonicalFilename| 'PROBE-FILE) + (LIST '|charString| 'STRING) (LIST '|char?| 'CHARACTERP) (LIST '|codePoint| 'CHAR-CODE) (LIST '|cons?| 'CONSP) (LIST '|copy| 'COPY) (LIST '|croak| 'CROAK) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index c941265d..51bfd7d4 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -604,7 +604,7 @@ (PROGN (SETQ |$currentModuleName| |m|) (SETQ |$foreignsDefsForCLisp| NIL) - (CONS (LIST 'PROVIDE (STRING |m|)) + (CONS (LIST 'PROVIDE (SYMBOL-NAME |m|)) (LET ((|bfVar#11| NIL) (|bfVar#10| |ds|) (|d| NIL)) (LOOP @@ -625,8 +625,8 @@ (COND ((NOT (STRING= (|getOptionValue| '|import|) "skip")) - (|bootImport| (STRING |m|)))) - (LIST (LIST 'IMPORT-MODULE (STRING |m|)))))) + (|bootImport| (SYMBOL-NAME |m|)))) + (LIST (LIST 'IMPORT-MODULE (SYMBOL-NAME |m|)))))) (|%ImportSignature| (LET ((|x| (CADR |b|)) (|sig| (CADDR |b|))) (|genImportDeclaration| |x| |sig|))) @@ -702,8 +702,8 @@ (|%Namespace| (LET ((|n| (CADR |b|))) (PROGN - (SETQ |$activeNamespace| (STRING |n|)) - (LIST (LIST 'IN-PACKAGE (STRING |n|)))))) + (SETQ |$activeNamespace| (SYMBOL-NAME |n|)) + (LIST (LIST 'IN-PACKAGE (SYMBOL-NAME |n|)))))) (|%Lisp| (LET ((|s| (CADR |b|))) (|shoeReadLispString| |s| 0))) (T (LIST (|translateToplevelExpression| |b|))))))))) @@ -1230,7 +1230,7 @@ (COND (|b| (SETQ |stream| *TERMINAL-IO*) (PSTTOMC (|bRgen| |stream|)) (BOOTLOOP)) - ((EQUAL (ELT |a| 0) (ELT "]" 0)) NIL) + ((CHAR= (ELT |a| 0) (|char| '])) NIL) (T (PSTTOMC (LIST |a|)) (BOOTLOOP))))))))) (DEFUN BOOTPO () @@ -1245,7 +1245,7 @@ (COND (|b| (SETQ |stream| *TERMINAL-IO*) (PSTOUT (|bRgen| |stream|)) (BOOTPO)) - ((EQUAL (ELT |a| 0) (ELT "]" 0)) NIL) + ((CHAR= (ELT |a| 0) (|char| '])) NIL) (T (PSTOUT (LIST |a|)) (BOOTPO))))))))) (DEFUN PSTOUT (|string|) |