Also remade filemap for CMLCHARACTER (and changed from LCOM to DFASL)
CLEANUP is confused about how to compile. This had FILETYPE = CL-COMPILE-TYPE, with an existing LCOM. It produced a new DFASL, but the LCOM was still hanging around. I'm deleting the LCOM here, pushing the new DFASL.
This commit is contained in:
rmkaplan
parent
1bed018db8
commit
df8c5a52f1
@ -1,50 +1,46 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "28-Jun-99 21:54:32" {DSK}<project>medley3.5>sources>CMLCHARACTER.;2 32559
|
||||
|
||||
changes to%: (OPTIMIZERS CL:CODE-CHAR)
|
||||
(FUNCTIONS CL:CODE-CHAR)
|
||||
(FILECREATED "17-Oct-2023 13:16:14" {WMEDLEY}<sources>CMLCHARACTER.;3 31224
|
||||
|
||||
previous date%: "18-Aug-95 14:45:44" {DSK}<project>medley3.5>sources>CMLCHARACTER.;1)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "28-Jun-99 21:54:32" {WMEDLEY}<sources>CMLCHARACTER.;1)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1985, 1986, 1987, 1990, 1995, 1999 by Venue & Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT CMLCHARACTERCOMS)
|
||||
|
||||
(RPAQQ CMLCHARACTERCOMS
|
||||
[(COMS (* ;
|
||||
"Interlisp CHARCODE; Some is here, the rest is in LLREAD.")
|
||||
[(COMS (* ;
|
||||
"Interlisp CHARCODE; Some is here, the rest is in LLREAD.")
|
||||
(FNS CHARCODE CHARCODE.UNDECODE)
|
||||
(PROP MACRO SELCHARQ ALPHACHARP DIGITCHARP UCASECODE)
|
||||
(OPTIMIZERS CHARCODE)
|
||||
(ALISTS (DWIMEQUIVLST SELCHARQ)
|
||||
(PRETTYEQUIVLST SELCHARQ)))
|
||||
(COMS (* ; "Common Lisp CHARACTER type")
|
||||
(COMS (* ; "Common Lisp CHARACTER type")
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS CHARACTER))
|
||||
(VARIABLES \CHARHI)
|
||||
(VARIABLES CL:CHAR-BITS-LIMIT CL:CHAR-CODE-LIMIT CL:CHAR-CONTROL-BIT CL:CHAR-FONT-LIMIT
|
||||
CL:CHAR-HYPER-BIT CL:CHAR-META-BIT CL:CHAR-SUPER-BIT))
|
||||
(COMS (* ; "Basic character fns")
|
||||
(COMS (* ; "Basic character fns")
|
||||
(FNS CL:CHAR-CODE CL:CHAR-INT CL:INT-CHAR)
|
||||
(FUNCTIONS CL:CODE-CHAR)
|
||||
(OPTIMIZERS CL:CHAR-CODE CL:CHAR-INT CL:CODE-CHAR CL:INT-CHAR))
|
||||
[COMS (* ;
|
||||
"I/O; Some is here, the rest is in LLREAD.")
|
||||
[COMS (* ;
|
||||
"I/O; Some is here, the rest is in LLREAD.")
|
||||
(FNS CHARACTER.PRINT)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (SETTOPVAL (\TYPEGLOBALVARIABLE 'CHARACTER T)
|
||||
(NTYPX (CL:CODE-CHAR 0 0 0)))
|
||||
(DEFPRINT 'CHARACTER 'CHARACTER.PRINT]
|
||||
(COMS
|
||||
(* ;; "Common lisp character functions")
|
||||
(* ;; "Common lisp character functions")
|
||||
|
||||
(FNS CL:CHAR-BIT CL:CHAR-BITS CL:CHAR-DOWNCASE CL:CHAR-FONT CL:CHAR-NAME CL:CHAR-UPCASE
|
||||
CL:CHARACTER CL:NAME-CHAR CL:SET-CHAR-BIT)
|
||||
(FUNCTIONS CL:DIGIT-CHAR CL:MAKE-CHAR)
|
||||
(OPTIMIZERS CL:CHAR-UPCASE CL:CHAR-DOWNCASE CL:MAKE-CHAR))
|
||||
(COMS
|
||||
(* ;; "Predicates")
|
||||
(* ;; "Predicates")
|
||||
|
||||
(FNS CL:ALPHA-CHAR-P CL:ALPHANUMERICP CL:BOTH-CASE-P CL:CHARACTERP CL:GRAPHIC-CHAR-P
|
||||
CL:LOWER-CASE-P CL:STANDARD-CHAR-P CL:STRING-CHAR-P CL:UPPER-CASE-P)
|
||||
@ -57,11 +53,11 @@ Copyright (c) 1985, 1986, 1987, 1990, 1995, 1999 by Venue & Xerox Corporation.
|
||||
CL:CHAR> CL:CHAR>= CL:CHARACTERP CL:LOWER-CASE-P CL:STRING-CHAR-P
|
||||
CL:UPPER-CASE-P))
|
||||
(COMS
|
||||
(* ;; "Internals")
|
||||
(* ;; "Internals")
|
||||
|
||||
(FUNCTIONS %%CHAR-DOWNCASE-CODE %%CHAR-UPCASE-CODE %%CODE-CHAR))
|
||||
(COMS
|
||||
(* ;; "Compiler options")
|
||||
(* ;; "Compiler options")
|
||||
|
||||
(PROP FILETYPE CMLCHARACTER)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (LOCALVARS . T)))
|
||||
@ -89,36 +85,35 @@ Copyright (c) 1985, 1986, 1987, 1990, 1995, 1999 by Venue & Xerox Corporation.
|
||||
)
|
||||
|
||||
(PUTPROPS SELCHARQ MACRO [F (CONS 'SELECTQ (CONS (CAR F)
|
||||
(MAPLIST (CDR F)
|
||||
(FUNCTION (LAMBDA (I)
|
||||
(COND
|
||||
((CDR I)
|
||||
(CONS
|
||||
(CHARCODE.DECODE
|
||||
(CAAR I))
|
||||
(CDAR I)))
|
||||
(T (CAR I])
|
||||
(MAPLIST (CDR F)
|
||||
(FUNCTION (LAMBDA (I)
|
||||
(COND
|
||||
((CDR I)
|
||||
(CONS (CHARCODE.DECODE
|
||||
(CAAR I))
|
||||
(CDAR I)))
|
||||
(T (CAR I])
|
||||
|
||||
(PUTPROPS ALPHACHARP MACRO ((CHAR)
|
||||
([LAMBDA (UCHAR)
|
||||
(DECLARE (LOCALVARS UCHAR))
|
||||
(AND (IGEQ UCHAR (CHARCODE A))
|
||||
(ILEQ UCHAR (CHARCODE Z]
|
||||
(LOGAND CHAR 95))))
|
||||
([LAMBDA (UCHAR)
|
||||
(DECLARE (LOCALVARS UCHAR))
|
||||
(AND (IGEQ UCHAR (CHARCODE A))
|
||||
(ILEQ UCHAR (CHARCODE Z]
|
||||
(LOGAND CHAR 95))))
|
||||
|
||||
(PUTPROPS DIGITCHARP MACRO [LAMBDA (CHAR)
|
||||
(AND (IGEQ CHAR (CHARCODE 0))
|
||||
(ILEQ CHAR (CHARCODE 9])
|
||||
(AND (IGEQ CHAR (CHARCODE 0))
|
||||
(ILEQ CHAR (CHARCODE 9])
|
||||
|
||||
(PUTPROPS UCASECODE MACRO (OPENLAMBDA (CHAR)
|
||||
(COND
|
||||
((AND (IGEQ CHAR (CHARCODE a))
|
||||
(ILEQ CHAR (CHARCODE z)))
|
||||
(LOGAND CHAR 95))
|
||||
(T CHAR))))
|
||||
(COND
|
||||
((AND (IGEQ CHAR (CHARCODE a))
|
||||
(ILEQ CHAR (CHARCODE z)))
|
||||
(LOGAND CHAR 95))
|
||||
(T CHAR))))
|
||||
|
||||
(DEFOPTIMIZER CHARCODE (C)
|
||||
(KWOTE (CHARCODE.DECODE C T)))
|
||||
(KWOTE (CHARCODE.DECODE C T)))
|
||||
|
||||
(ADDTOVAR DWIMEQUIVLST (SELCHARQ . SELECTQ))
|
||||
|
||||
@ -132,7 +127,7 @@ Copyright (c) 1985, 1986, 1987, 1990, 1995, 1999 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS CHARACTER [(CODE (\LOLOC (\DTEST DATUM 'CHARACTER]
|
||||
(CREATE (\VAG2 \CHARHI CODE)))
|
||||
(CREATE (\VAG2 \CHARHI CODE)))
|
||||
)
|
||||
)
|
||||
|
||||
@ -172,43 +167,43 @@ Copyright (c) 1985, 1986, 1987, 1990, 1995, 1999 by Venue & Xerox Corporation.
|
||||
)
|
||||
|
||||
(CL:DEFUN CL:CODE-CHAR (CODE &OPTIONAL (BITS 0)
|
||||
(FONT 0))
|
||||
(FONT 0))
|
||||
(CL:IF (AND (EQ BITS 0)
|
||||
(EQ FONT 0)
|
||||
|
||||
(* ;; "This checks for smallposp")
|
||||
(* ;; "This checks for smallposp")
|
||||
|
||||
(EQ (\HILOC CODE)
|
||||
\SmallPosHi))
|
||||
(%%CODE-CHAR CODE)))
|
||||
|
||||
(DEFOPTIMIZER CL:CHAR-CODE (CHAR)
|
||||
[LET [(CONSTANT-CHAR (AND (CL:CONSTANTP CHAR)
|
||||
(CL:EVAL CHAR]
|
||||
(CL:IF (CL:CHARACTERP CONSTANT-CHAR)
|
||||
(\LOLOC CONSTANT-CHAR)
|
||||
`(\LOLOC (\DTEST ,CHAR 'CHARACTER)))])
|
||||
[LET [(CONSTANT-CHAR (AND (CL:CONSTANTP CHAR)
|
||||
(CL:EVAL CHAR]
|
||||
(CL:IF (CL:CHARACTERP CONSTANT-CHAR)
|
||||
(\LOLOC CONSTANT-CHAR)
|
||||
`(\LOLOC (\DTEST ,CHAR 'CHARACTER)))])
|
||||
|
||||
(DEFOPTIMIZER CL:CHAR-INT (CHAR)
|
||||
`(CL:CHAR-CODE ,CHAR))
|
||||
`(CL:CHAR-CODE ,CHAR))
|
||||
|
||||
(DEFOPTIMIZER CL:CODE-CHAR (CODE &OPTIONAL (BITS 0)
|
||||
(FONT 0))
|
||||
(CL:IF (AND (EQ BITS 0)
|
||||
(EQ FONT 0))
|
||||
[LET [(CONSTANT-CODE (AND (CL:CONSTANTP CODE)
|
||||
(CL:EVAL CODE]
|
||||
(CL:IF (EQ (\HILOC CONSTANT-CODE)
|
||||
\SmallPosHi)
|
||||
(%%CODE-CHAR CONSTANT-CODE)
|
||||
`(LET ((%%CODE ,CODE))
|
||||
(AND (EQ (\HILOC %%CODE)
|
||||
,\SmallPosHi)
|
||||
(%%CODE-CHAR %%CODE))))]
|
||||
'COMPILER:PASS))
|
||||
(FONT 0))
|
||||
(CL:IF (AND (EQ BITS 0)
|
||||
(EQ FONT 0))
|
||||
[LET [(CONSTANT-CODE (AND (CL:CONSTANTP CODE)
|
||||
(CL:EVAL CODE]
|
||||
(CL:IF (EQ (\HILOC CONSTANT-CODE)
|
||||
\SmallPosHi)
|
||||
(%%CODE-CHAR CONSTANT-CODE)
|
||||
`(LET ((%%CODE ,CODE))
|
||||
(AND (EQ (\HILOC %%CODE)
|
||||
,\SmallPosHi)
|
||||
(%%CODE-CHAR %%CODE))))]
|
||||
'COMPILER:PASS))
|
||||
|
||||
(DEFOPTIMIZER CL:INT-CHAR (INTEGER)
|
||||
`(CL:CODE-CHAR ,INTEGER))
|
||||
`(CL:CODE-CHAR ,INTEGER))
|
||||
|
||||
|
||||
|
||||
@ -326,36 +321,34 @@ Copyright (c) 1985, 1986, 1987, 1990, 1995, 1999 by Venue & Xerox Corporation.
|
||||
)
|
||||
|
||||
(CL:DEFUN CL:DIGIT-CHAR (WEIGHT &OPTIONAL (RADIX 10)
|
||||
(FONT 0))
|
||||
(FONT 0))
|
||||
[AND (EQ FONT 0)
|
||||
(< -1 WEIGHT RADIX 37)
|
||||
(CL:IF (< WEIGHT 10)
|
||||
(%%CODE-CHAR (+ (CONSTANT (CL:CHAR-CODE #\0))
|
||||
WEIGHT))
|
||||
WEIGHT))
|
||||
(%%CODE-CHAR (+ (CONSTANT (CL:CHAR-CODE #\A))
|
||||
(- WEIGHT 10))))])
|
||||
(- WEIGHT 10))))])
|
||||
|
||||
(CL:DEFUN CL:MAKE-CHAR (CHAR &OPTIONAL (BITS 0)
|
||||
(FONT 0))
|
||||
(FONT 0))
|
||||
(CL:IF (AND (EQL BITS 0)
|
||||
(EQL FONT 0))
|
||||
CHAR))
|
||||
|
||||
(DEFOPTIMIZER CL:CHAR-UPCASE (CHAR)
|
||||
`[%%CODE-CHAR (%%CHAR-UPCASE-CODE (CL:CHAR-CODE
|
||||
,CHAR])
|
||||
`[%%CODE-CHAR (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR])
|
||||
|
||||
(DEFOPTIMIZER CL:CHAR-DOWNCASE (CHAR)
|
||||
`[%%CODE-CHAR (%%CHAR-DOWNCASE-CODE (CL:CHAR-CODE
|
||||
,CHAR])
|
||||
`[%%CODE-CHAR (%%CHAR-DOWNCASE-CODE (CL:CHAR-CODE ,CHAR])
|
||||
|
||||
(DEFOPTIMIZER CL:MAKE-CHAR (CHAR &OPTIONAL BITS FONT)
|
||||
(CL:IF (AND (OR (NULL BITS)
|
||||
(EQL BITS 0))
|
||||
(OR (NULL FONT)
|
||||
(EQL FONT 0)))
|
||||
CHAR
|
||||
'COMPILER:PASS))
|
||||
(CL:IF (AND (OR (NULL BITS)
|
||||
(EQL BITS 0))
|
||||
(OR (NULL FONT)
|
||||
(EQL FONT 0)))
|
||||
CHAR
|
||||
'COMPILER:PASS))
|
||||
|
||||
|
||||
|
||||
@ -627,105 +620,100 @@ Copyright (c) 1985, 1986, 1987, 1990, 1995, 1999 by Venue & Xerox Corporation.
|
||||
VAL)))
|
||||
|
||||
(DEFOPTIMIZER CL:CHAR-EQUAL (CHAR &REST MORE-CHARS)
|
||||
(CL:IF (EQL 1 (CL:LENGTH MORE-CHARS))
|
||||
`[EQ (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR))
|
||||
(%%CHAR-UPCASE-CODE (CL:CHAR-CODE
|
||||
,(CAR MORE-CHARS]
|
||||
'COMPILER:PASS))
|
||||
(CL:IF (EQL 1 (CL:LENGTH MORE-CHARS))
|
||||
`[EQ (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR))
|
||||
(%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,(CAR MORE-CHARS]
|
||||
'COMPILER:PASS))
|
||||
|
||||
(DEFOPTIMIZER CL:CHAR-GREATERP (CHAR &REST MORE-CHARS)
|
||||
`(> (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR))
|
||||
,@(CL:MAPCAR [FUNCTION (CL:LAMBDA
|
||||
(FORM)
|
||||
`(%%CHAR-UPCASE-CODE
|
||||
(CL:CHAR-CODE ,FORM]
|
||||
MORE-CHARS)))
|
||||
`(> (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR))
|
||||
,@(CL:MAPCAR [FUNCTION (CL:LAMBDA
|
||||
(FORM)
|
||||
`(%%CHAR-UPCASE-CODE (CL:CHAR-CODE
|
||||
,FORM]
|
||||
MORE-CHARS)))
|
||||
|
||||
(DEFOPTIMIZER CL:CHAR-LESSP (CHAR &REST MORE-CHARS)
|
||||
`(< (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR))
|
||||
,@(CL:MAPCAR [FUNCTION (CL:LAMBDA
|
||||
(FORM)
|
||||
`(%%CHAR-UPCASE-CODE
|
||||
(CL:CHAR-CODE ,FORM]
|
||||
MORE-CHARS)))
|
||||
`(< (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR))
|
||||
,@(CL:MAPCAR [FUNCTION (CL:LAMBDA (FORM)
|
||||
`(%%CHAR-UPCASE-CODE
|
||||
(CL:CHAR-CODE ,FORM]
|
||||
MORE-CHARS)))
|
||||
|
||||
(DEFOPTIMIZER CL:CHAR-NOT-EQUAL (CHAR &REST MORE-CHARS)
|
||||
(CL:IF (EQL 1 (CL:LENGTH MORE-CHARS))
|
||||
`[NOT (EQ (%%CHAR-UPCASE-CODE (CL:CHAR-CODE
|
||||
,CHAR))
|
||||
(%%CHAR-UPCASE-CODE (CL:CHAR-CODE
|
||||
,(CAR MORE-CHARS]
|
||||
'COMPILER:PASS))
|
||||
(CL:IF (EQL 1 (CL:LENGTH MORE-CHARS))
|
||||
`[NOT (EQ (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR))
|
||||
(%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,(CAR MORE-CHARS]
|
||||
'COMPILER:PASS))
|
||||
|
||||
(DEFOPTIMIZER CL:CHAR-NOT-GREATERP (CHAR &REST MORE-CHARS)
|
||||
`(<= (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR))
|
||||
,@(CL:MAPCAR [FUNCTION (CL:LAMBDA
|
||||
(FORM)
|
||||
`(%%CHAR-UPCASE-CODE
|
||||
(CL:CHAR-CODE ,FORM]
|
||||
MORE-CHARS)))
|
||||
`(<= (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR))
|
||||
,@(CL:MAPCAR [FUNCTION (CL:LAMBDA
|
||||
(FORM)
|
||||
`(%%CHAR-UPCASE-CODE
|
||||
(CL:CHAR-CODE ,FORM]
|
||||
MORE-CHARS)))
|
||||
|
||||
(DEFOPTIMIZER CL:CHAR-NOT-LESSP (CHAR &REST MORE-CHARS)
|
||||
`(>= (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR))
|
||||
,@(CL:MAPCAR [FUNCTION (CL:LAMBDA
|
||||
(FORM)
|
||||
`(%%CHAR-UPCASE-CODE
|
||||
(CL:CHAR-CODE ,FORM]
|
||||
MORE-CHARS)))
|
||||
`(>= (%%CHAR-UPCASE-CODE (CL:CHAR-CODE ,CHAR))
|
||||
,@(CL:MAPCAR [FUNCTION (CL:LAMBDA
|
||||
(FORM)
|
||||
`(%%CHAR-UPCASE-CODE (CL:CHAR-CODE
|
||||
,FORM]
|
||||
MORE-CHARS)))
|
||||
|
||||
(DEFOPTIMIZER CL:CHAR/= (CHAR &REST MORE-CHARS)
|
||||
(CL:IF (CDR MORE-CHARS)
|
||||
'COMPILER:PASS
|
||||
`(NEQ ,CHAR ,(CAR MORE-CHARS))))
|
||||
(CL:IF (CDR MORE-CHARS)
|
||||
'COMPILER:PASS
|
||||
`(NEQ ,CHAR ,(CAR MORE-CHARS))))
|
||||
|
||||
(DEFOPTIMIZER CL:CHAR< (CHAR &REST MORE-CHARS)
|
||||
`(< (CL:CHAR-CODE ,CHAR)
|
||||
,@(CL:MAPCAR [FUNCTION (CL:LAMBDA (FORM)
|
||||
`(CL:CHAR-CODE ,FORM]
|
||||
MORE-CHARS)))
|
||||
`(< (CL:CHAR-CODE ,CHAR)
|
||||
,@(CL:MAPCAR [FUNCTION (CL:LAMBDA (FORM)
|
||||
`(CL:CHAR-CODE ,FORM]
|
||||
MORE-CHARS)))
|
||||
|
||||
(DEFOPTIMIZER CL:CHAR<= (CHAR &REST MORE-CHARS)
|
||||
`(<= (CL:CHAR-CODE ,CHAR)
|
||||
,@(CL:MAPCAR [FUNCTION (CL:LAMBDA (FORM)
|
||||
`(CL:CHAR-CODE ,FORM]
|
||||
MORE-CHARS)))
|
||||
`(<= (CL:CHAR-CODE ,CHAR)
|
||||
,@(CL:MAPCAR [FUNCTION (CL:LAMBDA (FORM)
|
||||
`(CL:CHAR-CODE ,FORM]
|
||||
MORE-CHARS)))
|
||||
|
||||
(DEFOPTIMIZER CL:CHAR= (CHAR &REST MORE-CHARS)
|
||||
(CL:IF (CDR MORE-CHARS)
|
||||
[LET
|
||||
((CH (GENSYM)))
|
||||
(CL:IF (CDR MORE-CHARS)
|
||||
[LET ((CH (GENSYM)))
|
||||
`(LET ((,CH ,CHAR))
|
||||
(AND ,@(for X in MORE-CHARS
|
||||
collect `(EQ ,CH ,X]
|
||||
`(EQ ,CHAR ,(CAR MORE-CHARS))))
|
||||
`(EQ ,CHAR ,(CAR MORE-CHARS))))
|
||||
|
||||
(DEFOPTIMIZER CL:CHAR> (CHAR &REST MORE-CHARS)
|
||||
`(> (CL:CHAR-CODE ,CHAR)
|
||||
,@(CL:MAPCAR [FUNCTION (CL:LAMBDA (FORM)
|
||||
`(CL:CHAR-CODE ,FORM]
|
||||
MORE-CHARS)))
|
||||
`(> (CL:CHAR-CODE ,CHAR)
|
||||
,@(CL:MAPCAR [FUNCTION (CL:LAMBDA (FORM)
|
||||
`(CL:CHAR-CODE ,FORM]
|
||||
MORE-CHARS)))
|
||||
|
||||
(DEFOPTIMIZER CL:CHAR>= (CHAR &REST MORE-CHARS)
|
||||
`(>= (CL:CHAR-CODE ,CHAR)
|
||||
,@(CL:MAPCAR [FUNCTION (CL:LAMBDA (FORM)
|
||||
`(CL:CHAR-CODE ,FORM]
|
||||
MORE-CHARS)))
|
||||
`(>= (CL:CHAR-CODE ,CHAR)
|
||||
,@(CL:MAPCAR [FUNCTION (CL:LAMBDA (FORM)
|
||||
`(CL:CHAR-CODE ,FORM]
|
||||
MORE-CHARS)))
|
||||
|
||||
(DEFOPTIMIZER CL:CHARACTERP (OBJECT)
|
||||
`(TYPENAMEP ,OBJECT 'CHARACTER))
|
||||
`(TYPENAMEP ,OBJECT 'CHARACTER))
|
||||
|
||||
(DEFOPTIMIZER CL:LOWER-CASE-P (CHAR)
|
||||
`(<= (CONSTANT (CL:CHAR-CODE #\a))
|
||||
(CL:CHAR-CODE ,CHAR)
|
||||
(CONSTANT (CL:CHAR-CODE #\z))))
|
||||
`(<= (CONSTANT (CL:CHAR-CODE #\a))
|
||||
(CL:CHAR-CODE ,CHAR)
|
||||
(CONSTANT (CL:CHAR-CODE #\z))))
|
||||
|
||||
(DEFOPTIMIZER CL:STRING-CHAR-P (CHAR)
|
||||
`(\DTEST ,CHAR 'CHARACTER))
|
||||
`(\DTEST ,CHAR 'CHARACTER))
|
||||
|
||||
(DEFOPTIMIZER CL:UPPER-CASE-P (CHAR)
|
||||
`(<= (CONSTANT (CL:CHAR-CODE #\A))
|
||||
(CL:CHAR-CODE ,CHAR)
|
||||
(CONSTANT (CL:CHAR-CODE #\Z))))
|
||||
`(<= (CONSTANT (CL:CHAR-CODE #\A))
|
||||
(CL:CHAR-CODE ,CHAR)
|
||||
(CONSTANT (CL:CHAR-CODE #\Z))))
|
||||
|
||||
|
||||
|
||||
@ -772,21 +760,23 @@ Copyright (c) 1985, 1986, 1987, 1990, 1995, 1999 by Venue & Xerox Corporation.
|
||||
(ADDTOVAR NLAML CHARCODE)
|
||||
|
||||
(ADDTOVAR LAMA CL:CHAR>= CL:CHAR> CL:CHAR= CL:CHAR<= CL:CHAR< CL:CHAR/= CL:CHAR-NOT-LESSP
|
||||
CL:CHAR-NOT-GREATERP CL:CHAR-NOT-EQUAL CL:CHAR-LESSP CL:CHAR-GREATERP
|
||||
CL:CHAR-EQUAL)
|
||||
CL:CHAR-NOT-GREATERP CL:CHAR-NOT-EQUAL CL:CHAR-LESSP CL:CHAR-GREATERP
|
||||
CL:CHAR-EQUAL)
|
||||
)
|
||||
(PUTPROPS CMLCHARACTER COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1990 1995 1999))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4041 4323 (CHARCODE 4051 . 4110) (CHARCODE.UNDECODE 4112 . 4321)) (6868 7233 (
|
||||
CL:CHAR-CODE 6878 . 7026) (CL:CHAR-INT 7028 . 7090) (CL:INT-CHAR 7092 . 7231)) (9139 10193 (
|
||||
CHARACTER.PRINT 9149 . 10191)) (10406 13937 (CL:CHAR-BIT 10416 . 10569) (CL:CHAR-BITS 10571 . 10728) (
|
||||
CL:CHAR-DOWNCASE 10730 . 10916) (CL:CHAR-FONT 10918 . 11075) (CL:CHAR-NAME 11077 . 12860) (
|
||||
CL:CHAR-UPCASE 12862 . 13044) (CL:CHARACTER 13046 . 13534) (CL:NAME-CHAR 13536 . 13776) (CL:SET-CHAR-BIT
|
||||
13778 . 13935)) (15381 18563 (CL:ALPHA-CHAR-P 15391 . 15927) (CL:ALPHANUMERICP 15929 . 16123) (
|
||||
CL:BOTH-CASE-P 16125 . 16232) (CL:CHARACTERP 16234 . 16378) (CL:GRAPHIC-CHAR-P 16380 . 17513) (
|
||||
CL:LOWER-CASE-P 17515 . 17668) (CL:STANDARD-CHAR-P 17670 . 18336) (CL:STRING-CHAR-P 18338 . 18406) (
|
||||
CL:UPPER-CASE-P 18408 . 18561)) (18564 24388 (CL:CHAR-EQUAL 18574 . 18968) (CL:CHAR-GREATERP 18970 .
|
||||
19477) (CL:CHAR-LESSP 19479 . 19983) (CL:CHAR-NOT-EQUAL 19985 . 20585) (CL:CHAR-NOT-GREATERP 20587 .
|
||||
21099) (CL:CHAR-NOT-LESSP 21101 . 21610) (CL:CHAR/= 21612 . 22192) (CL:CHAR< 22194 . 22644) (CL:CHAR<=
|
||||
22646 . 23098) (CL:CHAR= 23100 . 23480) (CL:CHAR> 23482 . 23932) (CL:CHAR>= 23934 . 24386)))))
|
||||
(FILEMAP (NIL (3835 4117 (CHARCODE 3845 . 3904) (CHARCODE.UNDECODE 3906 . 4115)) (6423 6788 (
|
||||
CL:CHAR-CODE 6433 . 6581) (CL:CHAR-INT 6583 . 6645) (CL:INT-CHAR 6647 . 6786)) (6790 7091 (CL:CODE-CHAR
|
||||
6790 . 7091)) (8610 9664 (CHARACTER.PRINT 8620 . 9662)) (9877 13408 (CL:CHAR-BIT 9887 . 10040) (
|
||||
CL:CHAR-BITS 10042 . 10199) (CL:CHAR-DOWNCASE 10201 . 10387) (CL:CHAR-FONT 10389 . 10546) (CL:CHAR-NAME
|
||||
10548 . 12331) (CL:CHAR-UPCASE 12333 . 12515) (CL:CHARACTER 12517 . 13005) (CL:NAME-CHAR 13007 .
|
||||
13247) (CL:SET-CHAR-BIT 13249 . 13406)) (13410 13803 (CL:DIGIT-CHAR 13410 . 13803)) (13805 13969 (
|
||||
CL:MAKE-CHAR 13805 . 13969)) (14648 17830 (CL:ALPHA-CHAR-P 14658 . 15194) (CL:ALPHANUMERICP 15196 .
|
||||
15390) (CL:BOTH-CASE-P 15392 . 15499) (CL:CHARACTERP 15501 . 15645) (CL:GRAPHIC-CHAR-P 15647 . 16780)
|
||||
(CL:LOWER-CASE-P 16782 . 16935) (CL:STANDARD-CHAR-P 16937 . 17603) (CL:STRING-CHAR-P 17605 . 17673) (
|
||||
CL:UPPER-CASE-P 17675 . 17828)) (17831 23655 (CL:CHAR-EQUAL 17841 . 18235) (CL:CHAR-GREATERP 18237 .
|
||||
18744) (CL:CHAR-LESSP 18746 . 19250) (CL:CHAR-NOT-EQUAL 19252 . 19852) (CL:CHAR-NOT-GREATERP 19854 .
|
||||
20366) (CL:CHAR-NOT-LESSP 20368 . 20877) (CL:CHAR/= 20879 . 21459) (CL:CHAR< 21461 . 21911) (CL:CHAR<=
|
||||
21913 . 22365) (CL:CHAR= 22367 . 22747) (CL:CHAR> 22749 . 23199) (CL:CHAR>= 23201 . 23653)) (23657
|
||||
24547 (CL:DIGIT-CHAR-P 23657 . 24547)) (29909 30254 (%%CHAR-DOWNCASE-CODE 29909 . 30254)) (30256 30599
|
||||
(%%CHAR-UPCASE-CODE 30256 . 30599)) (30601 30660 (%%CODE-CHAR 30601 . 30660)))))
|
||||
STOP
|
||||
|
||||
BIN
sources/CMLCHARACTER.DFASL
Normal file
BIN
sources/CMLCHARACTER.DFASL
Normal file
Binary file not shown.
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user