diff options
author | dos-reis <gdr@axiomatics.org> | 2011-10-21 10:16:58 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2011-10-21 10:16:58 +0000 |
commit | 002256394cd0b9b4cffb7dd0a309e993ade36d60 (patch) | |
tree | eb3604e21bf483d8d51aa0ff3998fa193adf1378 | |
parent | ce9a3f7062228b84610f0effa0dec5a4e87095f4 (diff) | |
download | open-axiom-002256394cd0b9b4cffb7dd0a309e993ade36d60.tar.gz |
Workaround proclamation bug in GCL
* boot/utility.boot (firstNonblankPosition): Do not declare.
-rw-r--r-- | src/ChangeLog | 5 | ||||
-rw-r--r-- | src/boot/strap/parser.clisp | 22 | ||||
-rw-r--r-- | src/boot/strap/tokens.clisp | 10 | ||||
-rw-r--r-- | src/boot/strap/utility.clisp | 4 | ||||
-rw-r--r-- | src/boot/utility.boot | 3 |
5 files changed, 33 insertions, 11 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 7e6701ed..30e7ef28 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,10 @@ 2011-10-21 Gabriel Dos Reis <gdr@cs.tamu.edu> + Workaround proclamation bug in GCL + * boot/utility.boot (firstNonblankPosition): Do not declare. + +2011-10-21 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/define.boot (compDefineCapsuleFunction): Reimplement signature inference. (hasSigInTargetCategory): Implement what the documentation says: diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index 3d8d15f8..a91db6cc 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -396,6 +396,25 @@ (AND (OR (|bpSexp|) (|bpTrap|)) (|bpPush| (|bfSymbol| (|bpPop1|))))) (T (|bpString|)))) +(DEFUN |bpChar| () + (PROG (|ISTMP#1| |s| |a|) + (DECLARE (SPECIAL |$stok| |$ttok|)) + (RETURN + (COND + ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'ID) (EQ |$ttok| '|char|)) + (SETQ |a| (|bpState|)) + (COND + ((|bpApplication|) (SETQ |s| (|bpPop1|)) + (COND + ((AND (CONSP |s|) (EQ (CAR |s|) '|char|) + (PROGN + (SETQ |ISTMP#1| (CDR |s|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))))) + (|bpPush| |s|)) + (T (|bpRestore| |a|) NIL))) + (T NIL))) + (T NIL))))) + (DEFUN |bpExportItemTail| () (OR (AND (|bpEqKey| 'BEC) (OR (|bpAssign|) (|bpTrap|)) @@ -976,7 +995,8 @@ (|bpPush| (|bfDTuple| (|bpPop1|)))))) (DEFUN |bpPattern| () - (OR (|bpBracketConstruct| #'|bpPatternL|) (|bpName|) (|bpConstTok|))) + (OR (|bpBracketConstruct| #'|bpPatternL|) (|bpChar|) (|bpName|) + (|bpConstTok|))) (DEFUN |bpEqual| () (AND (|bpEqKey| 'SHOEEQ) (OR (|bpApplication|) (|bpConstTok|) (|bpTrap|)) diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index fac4526d..d645f51f 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -99,7 +99,7 @@ (PROGN (SETQ |a| (MAKE-ARRAY 256)) (SETQ |b| (MAKE-ARRAY 1)) - (SETF (ELT |b| 0) (MAKE-STRING 0)) + (SETF (ELT |b| 0) (|makeString| 0)) (LET ((|i| 0)) (LOOP (COND ((> |i| 255) (RETURN NIL)) @@ -194,10 +194,10 @@ (LIST '|list| 'LIST) (LIST '|listEq?| 'EQUAL) (LIST '|lowerCase?| 'LOWER-CASE-P) (LIST '|makeSymbol| 'INTERN) (LIST '|maxIndex| 'MAXINDEX) (LIST '|mkpf| 'MKPF) - (LIST '|newString| 'MAKE-STRING) (LIST '|newVector| 'MAKE-ARRAY) - (LIST '|nil| NIL) (LIST '|not| 'NOT) (LIST '|null| 'NULL) - (LIST '|odd?| 'ODDP) (LIST '|or| 'OR) (LIST '|otherwise| 'T) - (LIST '|property| 'GET) (LIST '|readInteger| 'PARSE-INTEGER) + (LIST '|newVector| 'MAKE-ARRAY) (LIST '|nil| NIL) + (LIST '|not| 'NOT) (LIST '|null| 'NULL) (LIST '|odd?| 'ODDP) + (LIST '|or| 'OR) (LIST '|otherwise| 'T) (LIST '|property| 'GET) + (LIST '|readInteger| 'PARSE-INTEGER) (LIST '|readLispFromString| 'READ-FROM-STRING) (LIST '|readOnly?| 'CONSTANTP) (LIST '|removeDuplicates| 'REMDUP) (LIST '|rest| 'CDR) (LIST '|sameObject?| 'EQ) diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp index d522b8c8..db11171f 100644 --- a/src/boot/strap/utility.clisp +++ b/src/boot/strap/utility.clisp @@ -78,10 +78,6 @@ (DECLAIM (FTYPE (FUNCTION (|%String| |%Short|) (|%Maybe| |%Short|)) - |firstNonblankPosition|)) - -(DECLAIM - (FTYPE (FUNCTION (|%String| |%Short|) (|%Maybe| |%Short|)) |firstBlankPosition|)) (|%defaultReadAndLoadSettings|) diff --git a/src/boot/utility.boot b/src/boot/utility.boot index 79d84700..70802e5a 100644 --- a/src/boot/utility.boot +++ b/src/boot/utility.boot @@ -64,7 +64,8 @@ module utility (objectMember?, symbolMember?, stringMember?, setIntersection: (%List %Thing,%List %Thing) -> %List %Thing atomic?: %Thing -> %Boolean finishLine: %Thing -> %Void - firstNonblankPosition: (%String,%Short) -> %Maybe %Short + --FIXME: Next signature commented out because of GCL bugs + -- firstNonblankPosition: (%String,%Short) -> %Maybe %Short firstBlankPosition: (%String,%Short) -> %Maybe %Short %defaultReadAndLoadSettings() |