gcl.git - GNU Common Lisp

diff --git a/gcl/cmpnew/gcl_cmpenv.lsp b/gcl/cmpnew/gcl_cmpenv.lsp
index 2051ab891..46fbae488 100755
--- a/gcl/cmpnew/gcl_cmpenv.lsp
+++ b/gcl/cmpnew/gcl_cmpenv.lsp

@@ -337,7 +337,7 @@

readtable sequence short-float simple-array simple-bit-vector

simple-string simple-vector single-float standard-char stream string

dynamic-extent :dynamic-extent

- string-char symbol t vector signed-byte unsigned-byte)

+ symbol t vector signed-byte unsigned-byte)

(proclaim-var (car decl) (cdr decl)))

(otherwise

(unless (member (car decl) *alien-declarations*)

@@ -449,7 +449,7 @@

integer keyword list long-float nil null number package pathname

random-state ratio rational readtable sequence simple-array

simple-bit-vector simple-string simple-base-string simple-vector single-float

- standard-char stream string string-char symbol t vector

+ standard-char stream string symbol t vector

signed-byte unsigned-byte)

(let ((type (type-filter stype)))

(when type

@@ -667,7 +667,7 @@

readtable sequence short-float simple-array simple-bit-vector

simple-string simple-vector single-float standard-char stream string

dynamic-extent :dynamic-extent

- string-char symbol t vector signed-byte unsigned-byte)

+ symbol t vector signed-byte unsigned-byte)

(let ((type (type-filter (car decl))))

(dolist** (var (cdr decl) t)

(if (symbolp var)

diff --git a/gcl/cmpnew/gcl_cmpfun.lsp b/gcl/cmpnew/gcl_cmpfun.lsp
index 5c02c60ac..bb923fbd9 100755
--- a/gcl/cmpnew/gcl_cmpfun.lsp
+++ b/gcl/cmpnew/gcl_cmpfun.lsp

@@ -565,7 +565,7 @@

(equal (third type) '(*)))))

(setq tem (si::best-array-element-type

(second type)))

- (cond ((eq tem 'string-char) `(stringp ,x))

+ (cond ((eq tem 'character) `(stringp ,x))

((eq tem 'bit) `(bit-vector-p ,x))

((setq tem (position tem *aet-types*))

`(the boolean (vector-type ,x ,tem)))))

@@ -811,7 +811,7 @@

(defun aet-c-type (type)

(ecase type

((t) "object")

- ((string-char signed-char) "char")

+ ((character signed-char) "char")

(fixnum "fixnum")

(unsigned-char "unsigned char")

(unsigned-short "unsigned short")

diff --git a/gcl/cmpnew/gcl_cmpopt.lsp b/gcl/cmpnew/gcl_cmpopt.lsp
index b6d064953..4400313a3 100755
--- a/gcl/cmpnew/gcl_cmpopt.lsp
+++ b/gcl/cmpnew/gcl_cmpopt.lsp

@@ -1,4 +1,4 @@

-(in-package 'compiler)

+(in-package :compiler)

;; The optimizers have been redone to allow more flags

;; The old style optimizations correspond to the first 2

@@ -136,7 +136,7 @@

(get 'system:aset 'inline-unsafe))

(push '(((array t) fixnum t) t #.(flags set)"(#0)->v.v_self[#1]= (#2)")

(get 'system:aset 'inline-unsafe))

-(push '(((array string-char) fixnum character) character #.(flags rfa set)"(#0)->ust.ust_self[#1]= (#2)")

+(push '(((array character) fixnum character) character #.(flags rfa set)"(#0)->ust.ust_self[#1]= (#2)")

(get 'system:aset 'inline-unsafe))

(push '(((array fixnum) fixnum fixnum) fixnum #.(flags set rfa)"(#0)->fixa.fixa_self[#1]= (#2)")

(get 'system:aset 'inline-unsafe))

@@ -159,7 +159,7 @@

(push '(((array t) fixnum fixnum t) t #.(flags set)

"@0;(#0)->a.a_self[(#1)*(#0)->a.a_dims[1]+#2]= (#3)")

(get 'system:aset 'inline-unsafe))

-(push '(((array string-char) fixnum fixnum character) character

+(push '(((array character) fixnum fixnum character) character

#.(flags rfa set)

"@0;(#0)->ust.ust_self[(#1)*(#0)->a.a_dims[1]+#2]= (#3)")

(get 'system:aset 'inline-unsafe))

@@ -433,7 +433,7 @@

(get 'aref 'inline-unsafe))

(push '(((array t) fixnum) t #.(flags)"(#0)->v.v_self[#1]")

(get 'aref 'inline-unsafe))

-(push '(((array string-char) fixnum) character #.(flags rfa)"(#0)->ust.ust_self[#1]")

+(push '(((array character) fixnum) character #.(flags rfa)"(#0)->ust.ust_self[#1]")

(get 'aref 'inline-unsafe))

(push '(((array fixnum) fixnum) fixnum #.(flags rfa)"(#0)->fixa.fixa_self[#1]")

(get 'aref 'inline-unsafe))

@@ -456,7 +456,7 @@

(push '(((array t) fixnum fixnum) t #.(flags )

"@0;(#0)->a.a_self[(#1)*(#0)->a.a_dims[1]+#2]")

(get 'aref 'inline-unsafe))

-(push '(((array string-char) fixnum fixnum) character #.(flags rfa)

+(push '(((array character) fixnum fixnum) character #.(flags rfa)

"@0;(#0)->ust.ust_self[(#1)*(#0)->a.a_dims[1]+#2]")

(get 'aref 'inline-unsafe))

(push '(((array fixnum) fixnum fixnum) fixnum #.(flags rfa)

diff --git a/gcl/cmpnew/gcl_cmptop.lsp b/gcl/cmpnew/gcl_cmptop.lsp
index 3d7adad9b..6d4d65c99 100755
--- a/gcl/cmpnew/gcl_cmptop.lsp
+++ b/gcl/cmpnew/gcl_cmptop.lsp

@@ -572,7 +572,7 @@

(defun make-inline-string (cfun args fname)

(if (null args)

(format nil "~d()" (c-function-name "LI" cfun fname))

- (let ((o (make-array 100 :element-type 'string-char :fill-pointer 0

+ (let ((o (make-array 100 :element-type 'character :fill-pointer 0

:adjustable t )))

(format o "~d(" (c-function-name "LI" cfun fname))

(do ((l args (cdr l))

diff --git a/gcl/cmpnew/gcl_cmptype.lsp b/gcl/cmpnew/gcl_cmptype.lsp
index 0d23611b3..4313854ac 100755
--- a/gcl/cmpnew/gcl_cmptype.lsp
+++ b/gcl/cmpnew/gcl_cmptype.lsp

@@ -51,7 +51,7 @@

(let ((type (type-of thing)))

(case type

((fixnum short-float long-float) type)

- ((string-char standard-char character) 'character)

+ ((standard-char character) 'character)

((string bit-vector) type)

(vector (list 'vector (array-element-type thing)))

(array (list 'array (array-element-type thing)))

@@ -82,7 +82,7 @@

(and (consp (caddr type))

(= (length (caddr type)) 1))))

(case element-type

- (string-char 'string)

+ (character 'string)

(bit 'bit-vector)

(t (list 'vector element-type))))

(t (list 'array element-type))))

@@ -109,8 +109,8 @@

((subtypep type '(vector long-float))

'(vector long-float))

((subtypep type '(array t)) '(array t))

- ((subtypep type '(array string-char))

- '(array string-char))

+ ((subtypep type '(array character))

+ '(array character))

((subtypep type '(array bit)) '(array bit))

((subtypep type '(array fixnum)) '(array fixnum))

((subtypep type '(array short-float))

@@ -146,7 +146,7 @@

(case (car type1)

(array

(case (cadr type1)

- (string-char (if (eq type2 'string) type2 nil))

+ (character (if (eq type2 'string) type2 nil))

(bit (if (eq type2 'bit-vector) type2 nil))

(t (if (and (consp type2)

(eq (car type2) 'vector)

@@ -160,7 +160,7 @@

(t (case type1

(string

(if (and (consp type2) (eq (car type2) 'array)

- (eq (cadr type2) 'string-char))

+ (eq (cadr type2) 'character))

type1 nil))

(bit-vector

(if (and (consp type2) (eq (car type2) 'array)

diff --git a/gcl/cmpnew/gcl_make_ufun.lsp b/gcl/cmpnew/gcl_make_ufun.lsp
index 26bf132d5..93865f827 100755
--- a/gcl/cmpnew/gcl_make_ufun.lsp
+++ b/gcl/cmpnew/gcl_make_ufun.lsp

@@ -20,13 +20,13 @@

-(in-package 'compiler)

+(in-package :compiler)

(defvar gazonk (make-package 'symbol-table :use nil))

(defvar eof (cons nil nil))

(defvar *Ufun-out*)

-(defvar *str* (make-array 128 :element-type 'string-char :fill-pointer 0))

+(defvar *str* (make-array 128 :element-type 'character :fill-pointer 0))

(defun make-Ufun (in-files &key (out-file "Ufun_list.lsp"))

(with-open-file (*Ufun-out* out-file :direction :output)

diff --git a/gcl/lsp/gcl_arraylib.lsp b/gcl/lsp/gcl_arraylib.lsp
index 7a21363a9..ff0416e9e 100755
--- a/gcl/lsp/gcl_arraylib.lsp
+++ b/gcl/lsp/gcl_arraylib.lsp

@@ -31,7 +31,7 @@

(or (gethash type *baet-hash*)

(setf (gethash type *baet-hash*)

(if type

- (car (member type '(string-char bit signed-char unsigned-char signed-short unsigned-short

+ (car (member type '(character bit signed-char unsigned-char signed-short unsigned-short

fixnum short-float long-float t)

:test 'subtypep)) t)))))

diff --git a/gcl/lsp/gcl_debug.lsp b/gcl/lsp/gcl_debug.lsp
index 57ec43f8b..7d736cb0f 100755
--- a/gcl/lsp/gcl_debug.lsp
+++ b/gcl/lsp/gcl_debug.lsp

@@ -583,7 +583,7 @@

;; in other common lisps this should be a string output stream.

(defvar *display-string*

- (make-array 100 :element-type 'string-char :fill-pointer 0 :adjustable t))

+ (make-array 100 :element-type 'character :fill-pointer 0 :adjustable t))

(defun display-env (n env)

(do ((v (reverse env) (cdr v)))

diff --git a/gcl/lsp/gcl_defstruct.lsp b/gcl/lsp/gcl_defstruct.lsp
index b6eb00631..2301753cf 100755
--- a/gcl/lsp/gcl_defstruct.lsp
+++ b/gcl/lsp/gcl_defstruct.lsp

@@ -496,7 +496,7 @@

;bootstrapping code!

(setq def (make-s-data-structure

(make-array (* leng (size-of t))

- :element-type 'string-char :static t)

+ :element-type 'character :static t)

(make-t-type leng nil slot-descriptions)

*standard-slot-positions*

slot-descriptions

diff --git a/gcl/lsp/gcl_describe.lsp b/gcl/lsp/gcl_describe.lsp
index 86e0d5e77..569d5a2d3 100755
--- a/gcl/lsp/gcl_describe.lsp
+++ b/gcl/lsp/gcl_describe.lsp

@@ -186,7 +186,6 @@

(defun inspect-character (character)

(format t

(cond ((standard-char-p character) "~S - standard character")

- ((string-char-p character) "~S - string character")

(t "~S - character"))

character)

(inspect-print "code: #x~X" (char-code character))

diff --git a/gcl/lsp/gcl_info.lsp b/gcl/lsp/gcl_info.lsp
index 7c146d969..4204b8b8a 100755
--- a/gcl/lsp/gcl_info.lsp
+++ b/gcl/lsp/gcl_info.lsp

@@ -1,4 +1,4 @@

-(in-package "SI" )

+(in-package :si)

(eval-when (compile eval)

(defmacro while (test &body body)

@@ -11,7 +11,7 @@

(eval-when (compile eval load)

(defun sharp-u-reader (stream subchar arg)

subchar arg

- (let ((tem (make-array 10 :element-type 'string-char :fill-pointer 0)))

+ (let ((tem (make-array 10 :element-type 'character :fill-pointer 0)))

(or (eql (read-char stream) #\")

(error "sharp-u-reader reader needs a \" right after it"))

(loop

@@ -44,7 +44,7 @@

(or (and (<= 0 start ) (<= start len))

(error "illegal file start ~a" start))

(let ((tem (make-array (- len start)

- :element-type 'string-char)))

+ :element-type 'character)))

(if (> start 0) (file-position st start))

(si::fread tem 0 (length tem) st) tem)))

@@ -105,7 +105,7 @@

((> extra 0)

(setq tem

(make-array (f + (length x) extra)

- :element-type 'string-char :fill-pointer 0))

+ :element-type 'character :fill-pointer 0))

(setq i 0)

(go AGAIN))

(t (setq tem x)))

diff --git a/gcl/lsp/gcl_predlib.lsp b/gcl/lsp/gcl_predlib.lsp
index c86c3b72e..106089030 100755
--- a/gcl/lsp/gcl_predlib.lsp
+++ b/gcl/lsp/gcl_predlib.lsp

@@ -85,7 +85,7 @@

(deftype vector (&optional element-type size)

`(array ,element-type (,size)))

(deftype string (&optional size)

- `(vector string-char ,size))

+ `(vector character ,size))

(deftype base-string (&optional size)

`(vector base-char ,size))

(deftype bit-vector (&optional size)

@@ -94,7 +94,7 @@

(deftype simple-vector (&optional size)

`(simple-array t (,size)))

(deftype simple-string (&optional size)

- `(simple-array string-char (,size)))

+ `(simple-array character (,size)))

(deftype simple-base-string (&optional size)

`(simple-array base-char (,size)))

(deftype simple-bit-vector (&optional size)

@@ -204,8 +204,8 @@

(ratio (eq (type-of object) 'ratio))

(standard-char

(and (characterp object) (standard-char-p object)))

- ((base-char string-char)

- (and (characterp object) (string-char-p object)))

+ ((base-char character)

+ (characterp object))

(integer

(and (integerp object) (in-interval-p object i)))

(rational

@@ -307,7 +307,7 @@

signed-char unsigned-char signed-short unsigned-short

number integer bignum rational ratio float method-combination

short-float single-float double-float long-float complex

- character standard-char string-char real

+ character standard-char character real

package stream pathname readtable hash-table random-state

structure array simple-array function compiled-function

arithmetic-error base-char base-string broadcast-stream

@@ -581,23 +581,23 @@

(if (sub-interval-p '(* *) i2) (values t t) (values nil t)))

(t (values nil ntp2))))

(standard-char

- (if (member t2 '(base-char string-char character))

+ (if (member t2 '(base-char character character))

(values t t)

(values nil ntp2)))

(base-char

- (if (member t2 '(character string-char))

+ (if (member t2 '(character character))

(values t t)

(values nil ntp2)))

(extended-char

- (if (member t2 '(character string-char))

+ (if (member t2 '(character character))

(values t t)

(values nil ntp2)))

- (string-char

+ (character

(if (eq t2 'character)

(values t t)

(values nil ntp2)))

(character

- (if (eq t2 'string-char)

+ (if (eq t2 'character)

(values t t)

(values nil ntp2)))

(integer

@@ -633,7 +633,7 @@

(unless (or (equal (car i1) (car i2))

; FIXME

(and (eq (car i1) 'base-char)

- (eq (car i2) 'string-char)))

+ (eq (car i2) 'character)))

;; Unless the element type matches,

;; return NIL T.

;; Is this too strict?

@@ -656,7 +656,7 @@

(unless (or (equal (car i1) (car i2))

; FIXME

(and (eq (car i1) 'base-char)

- (eq (car i2) 'string-char)))

+ (eq (car i2) 'character)))

(return-from subtypep

(values nil t)))))

(when (or (endp (cdr i1)) (eq (cadr i1) '*))

diff --git a/gcl/lsp/gcl_seq.lsp b/gcl/lsp/gcl_seq.lsp
index 5c1ffa3e7..6ce5aa2eb 100755
--- a/gcl/lsp/gcl_seq.lsp
+++ b/gcl/lsp/gcl_seq.lsp

@@ -36,7 +36,7 @@

(if iesp

(make-list size :initial-element initial-element)

(make-list size))))

- ((or (eq type 'simple-string) (eq type 'string)) 'string-char)

+ ((or (eq type 'simple-string) (eq type 'string)) 'character)

((or (eq type 'simple-bit-vector) (eq type 'bit-vector)) 'bit)

((or (eq type 'simple-vector) (eq type 'vector)) t)

(t

diff --git a/gcl/o/typespec.c b/gcl/o/typespec.c
index 9a8b124aa..5689cc1e7 100755
--- a/gcl/o/typespec.c
+++ b/gcl/o/typespec.c

@@ -197,7 +197,6 @@ DEF_ORDINARY("CHARACTER",sLcharacter,LISP,"");

DEF_ORDINARY("NUMBER",sLnumber,LISP,"");

DEF_ORDINARY("RATIONAL",sLrational,LISP,"");

DEF_ORDINARY("FLOAT",sLfloat,LISP,"");

-DEF_ORDINARY("STRING-CHAR",sLstring_char,LISP,"");

DEF_ORDINARY("REAL",sLreal,LISP,"");

DEF_ORDINARY("INTEGER",sLinteger,LISP,"");

DEF_ORDINARY("RATIO",sLratio,LISP,"");