aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog5
-rw-r--r--src/boot/strap/parser.clisp22
-rw-r--r--src/boot/strap/tokens.clisp10
-rw-r--r--src/boot/strap/utility.clisp4
-rw-r--r--src/boot/utility.boot3
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()