github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-12 00:42:56 +00:00
Code Issues Projects Releases Wiki Activity

MAKEFILE NEW of CMLSEQ files (#1911)

Browse Source 
so pf and tf can find DEFUNs
This commit is contained in:
rmkaplan 2024-12-23 23:00:47 -08:00 committed by GitHub
parent e1c594b28c
commit 1d15f37fdc
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
4 changed files with 129 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
sources/CMLSEQCOMMON
View File

@ -1,24 +1,20 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "16-May-90 14:28:05" {DSK}<usr>local>lde>lispcore>sources>CMLSEQCOMMON.;2 5238
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (VARS CMLSEQCOMMONCOMS)
(FILECREATED "14-Dec-2024 19:23:34" {WMEDLEY}<sources>CMLSEQCOMMON.;2 4967
previous date%: "12-Nov-86 14:57:08" {DSK}<usr>local>lde>lispcore>sources>CMLSEQCOMMON.;1)
:EDIT-BY rmk
:PREVIOUS-DATE "16-May-90 14:28:05" {WMEDLEY}<sources>CMLSEQCOMMON.;1)
(* ; "
Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT CMLSEQCOMMONCOMS)
(RPAQQ CMLSEQCOMMONCOMS ((FUNCTIONS CHECK-SUBSEQ COLLECT-ITEM COPY-VECTOR-SUBSEQ
FILL-VECTOR-SUBSEQ MAKE-SEQUENCE-LIKE SEQ-DISPATCH TYPE-SPECIFIER
)
(FUNCTIONS BACKWARD-LIST-LOOP BACKWARD-VECTOR-LOOP FORWARD-LIST-LOOP
FORWARD-VECTOR-LOOP)
(PROP FILETYPE CMLSEQCOMMON)
(DECLARE%: EVAL@COMPILE DONTCOPY DONTEVAL@LOAD (LOCALVARS . T))))
(RPAQQ CMLSEQCOMMONCOMS ((FUNCTIONS CHECK-SUBSEQ COLLECT-ITEM COPY-VECTOR-SUBSEQ FILL-VECTOR-SUBSEQ
MAKE-SEQUENCE-LIKE SEQ-DISPATCH TYPE-SPECIFIER)
(FUNCTIONS BACKWARD-LIST-LOOP BACKWARD-VECTOR-LOOP FORWARD-LIST-LOOP
FORWARD-VECTOR-LOOP)
(PROP FILETYPE CMLSEQCOMMON)
(DECLARE%: EVAL@COMPILE DONTCOPY DONTEVAL@LOAD (LOCALVARS . T))))
(DEFMACRO CHECK-SUBSEQ (SEQ START END LENGTH)
`(CL:IF (NOT (<= 0 ,START ,END ,LENGTH))
@ -128,7 +124,10 @@ Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
(LOCALVARS . T)
)
)
(PUTPROPS CMLSEQCOMMON COPYRIGHT ("Venue & Xerox Corporation" 1986 1990))
(DECLARE%: DONTCOPY
(FILEMAP (NIL)))
(FILEMAP (NIL (771 957 (CHECK-SUBSEQ 771 . 957)) (959 1113 (COLLECT-ITEM 959 . 1113)) (1115 1597 (
COPY-VECTOR-SUBSEQ 1115 . 1597)) (1599 1820 (FILL-VECTOR-SUBSEQ 1599 . 1820)) (1822 2183 (
MAKE-SEQUENCE-LIKE 1822 . 2183)) (2185 2333 (SEQ-DISPATCH 2185 . 2333)) (2335 2500 (TYPE-SPECIFIER
2335 . 2500)) (2502 3109 (BACKWARD-LIST-LOOP 2502 . 3109)) (3111 3648 (BACKWARD-VECTOR-LOOP 3111 .
3648)) (3650 4234 (FORWARD-LIST-LOOP 3650 . 4234)) (4236 4782 (FORWARD-VECTOR-LOOP 4236 . 4782)))))
STOP

BIN
sources/CMLSEQCOMMON.LCOM
View File

Binary file not shown.

217
sources/CMLSEQFINDER
View File

@ -1,14 +1,11 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "16-May-90 14:29:23" {DSK}<usr>local>lde>lispcore>sources>CMLSEQFINDER.;2 33743
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (VARS CMLSEQFINDERCOMS)
(FILECREATED "14-Dec-2024 19:21:30" {WMEDLEY}<sources>CMLSEQFINDER.;2 33444
previous date%: "12-Nov-86 18:41:14" {DSK}<usr>local>lde>lispcore>sources>CMLSEQFINDER.;1)
:EDIT-BY rmk
:PREVIOUS-DATE "16-May-90 14:29:23" {WMEDLEY}<sources>CMLSEQFINDER.;1)
(* ; "
Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT CMLSEQFINDERCOMS)
@ -39,13 +36,13 @@ Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
(CL:IF ,TEST-FORM (RETURN CURRENT])
(CL:DEFUN SIMPLE-FIND (ITEM SEQUENCE START END)
(SIMPLE-FIND-MACRO ITEM SEQUENCE START END (EQL ITEM CURRENT)))
(SIMPLE-FIND-MACRO ITEM SEQUENCE START END (EQL ITEM CURRENT)))
(CL:DEFUN SIMPLE-FIND-IF (TEST SEQUENCE START END)
(SIMPLE-FIND-MACRO ITEM SEQUENCE START END (CL:FUNCALL TEST CURRENT)))
(SIMPLE-FIND-MACRO ITEM SEQUENCE START END (CL:FUNCALL TEST CURRENT)))
(CL:DEFUN SIMPLE-FIND-IF-NOT (TEST SEQUENCE START END)
(SIMPLE-FIND-MACRO ITEM SEQUENCE START END (NOT (CL:FUNCALL TEST CURRENT))))
(SIMPLE-FIND-MACRO ITEM SEQUENCE START END (NOT (CL:FUNCALL TEST CURRENT))))
(DEFMACRO COMPLEX-FIND-MACRO (ITEM SEQUENCE START END FROM-END KEY TEST-FORM)
`(CL:IF (NULL ,FROM-END)
@ -63,7 +60,7 @@ Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
(CL:IF ,TEST-FORM (RETURN CURRENT]))
(CL:DEFUN COMPLEX-FIND (ITEM SEQUENCE START END FROM-END KEY TEST TEST-NOT-P)
[COMPLEX-FIND-MACRO ITEM SEQUENCE START END FROM-END KEY (CL:IF TEST-NOT-P
[COMPLEX-FIND-MACRO ITEM SEQUENCE START END FROM-END KEY (CL:IF TEST-NOT-P
(NOT (CL:FUNCALL TEST ITEM
(CL:FUNCALL KEY CURRENT))
)
@ -71,19 +68,19 @@ Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
(CL:FUNCALL KEY CURRENT)))])
(CL:DEFUN COMPLEX-FIND-IF (TEST SEQUENCE START END FROM-END KEY)
(COMPLEX-FIND-MACRO ITEM SEQUENCE START END FROM-END KEY (CL:FUNCALL TEST (CL:FUNCALL KEY CURRENT)
(COMPLEX-FIND-MACRO ITEM SEQUENCE START END FROM-END KEY (CL:FUNCALL TEST (CL:FUNCALL KEY CURRENT)
)))
(CL:DEFUN COMPLEX-FIND-IF-NOT (TEST SEQUENCE START END FROM-END KEY)
[COMPLEX-FIND-MACRO ITEM SEQUENCE START END FROM-END KEY (NOT (CL:FUNCALL TEST (CL:FUNCALL KEY
[COMPLEX-FIND-MACRO ITEM SEQUENCE START END FROM-END KEY (NOT (CL:FUNCALL TEST (CL:FUNCALL KEY
CURRENT])
(CL:DEFUN CL:FIND (ITEM SEQUENCE &KEY (START 0)
END
(FROM-END NIL FROM-END-P)
(KEY 'CL:IDENTITY KEY-P)
(TEST 'EQL TEST-P)
(TEST-NOT NIL TEST-NOT-P))
END
(FROM-END NIL FROM-END-P)
(KEY 'CL:IDENTITY KEY-P)
(TEST 'EQL TEST-P)
(TEST-NOT NIL TEST-NOT-P))
"Returns the first element in SEQUENCE satisfying the test (default is EQL) with the given ITEM"
(LET ((LENGTH (CL:LENGTH SEQUENCE)))
(CL:IF (NULL END)
@ -92,37 +89,37 @@ Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
(CL:IF (AND TEST-P TEST-NOT-P)
(CL:ERROR "Both Test and Test-not specified"))
(CL:IF (OR FROM-END-P KEY-P TEST-P TEST-NOT-P)
(COMPLEX-FIND ITEM SEQUENCE START END FROM-END KEY (CL:IF TEST-NOT-P
(COMPLEX-FIND ITEM SEQUENCE START END FROM-END KEY (CL:IF TEST-NOT-P
TEST-NOT
TEST)
TEST-NOT-P)
(SIMPLE-FIND ITEM SEQUENCE START END))))
(SIMPLE-FIND ITEM SEQUENCE START END))))
(CL:DEFUN CL:FIND-IF (TEST SEQUENCE &KEY (START 0)
END
(FROM-END NIL FROM-END-P)
(KEY 'CL:IDENTITY KEY-P))
END
(FROM-END NIL FROM-END-P)
(KEY 'CL:IDENTITY KEY-P))
"Returns the zero-origin index of the first element satisfying the test."
(LET ((LENGTH (CL:LENGTH SEQUENCE)))
(CL:IF (NULL END)
(SETQ END LENGTH))
(CHECK-SUBSEQ SEQUENCE START END LENGTH)
(CL:IF (OR FROM-END-P KEY-P)
(COMPLEX-FIND-IF TEST SEQUENCE START END FROM-END KEY)
(SIMPLE-FIND-IF TEST SEQUENCE START END))))
(COMPLEX-FIND-IF TEST SEQUENCE START END FROM-END KEY)
(SIMPLE-FIND-IF TEST SEQUENCE START END))))
(CL:DEFUN CL:FIND-IF-NOT (TEST SEQUENCE &KEY (START 0)
END
(FROM-END NIL FROM-END-P)
(KEY 'CL:IDENTITY KEY-P))
END
(FROM-END NIL FROM-END-P)
(KEY 'CL:IDENTITY KEY-P))
"Returns the zero-origin index of the first element not satisfying the test."
(LET ((LENGTH (CL:LENGTH SEQUENCE)))
(CL:IF (NULL END)
(SETQ END LENGTH))
(CHECK-SUBSEQ SEQUENCE START END LENGTH)
(CL:IF (OR FROM-END-P KEY-P)
(COMPLEX-FIND-IF-NOT TEST SEQUENCE START END FROM-END KEY)
(SIMPLE-FIND-IF-NOT TEST SEQUENCE START END))))
(COMPLEX-FIND-IF-NOT TEST SEQUENCE START END FROM-END KEY)
(SIMPLE-FIND-IF-NOT TEST SEQUENCE START END))))
(DEFMACRO SIMPLE-POSITION-MACRO (ITEM SEQUENCE START END TEST-FORM)
`[SEQ-DISPATCH ,SEQUENCE (FORWARD-LIST-LOOP ,SEQUENCE ,START ,END (INDEX CURRENT)
@ -133,13 +130,13 @@ Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
(CL:IF ,TEST-FORM (RETURN INDEX])
(CL:DEFUN SIMPLE-POSITION (ITEM SEQUENCE START END)
(SIMPLE-POSITION-MACRO ITEM SEQUENCE START END (EQL ITEM CURRENT)))
(SIMPLE-POSITION-MACRO ITEM SEQUENCE START END (EQL ITEM CURRENT)))
(CL:DEFUN SIMPLE-POSITION-IF (TEST SEQUENCE START END)
(SIMPLE-POSITION-MACRO ITEM SEQUENCE START END (CL:FUNCALL TEST CURRENT)))
(SIMPLE-POSITION-MACRO ITEM SEQUENCE START END (CL:FUNCALL TEST CURRENT)))
(CL:DEFUN SIMPLE-POSITION-IF-NOT (TEST SEQUENCE START END)
(SIMPLE-POSITION-MACRO ITEM SEQUENCE START END (NOT (CL:FUNCALL TEST CURRENT))))
(SIMPLE-POSITION-MACRO ITEM SEQUENCE START END (NOT (CL:FUNCALL TEST CURRENT))))
(DEFMACRO COMPLEX-POSITION-MACRO (ITEM SEQUENCE START END FROM-END KEY TEST-FORM)
`(CL:IF (NULL ,FROM-END)
@ -157,7 +154,7 @@ Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
(CL:IF ,TEST-FORM (RETURN INDEX]))
(CL:DEFUN COMPLEX-POSITION (ITEM SEQUENCE START END FROM-END KEY TEST TEST-NOT-P)
[COMPLEX-POSITION-MACRO ITEM SEQUENCE START END FROM-END KEY (CL:IF TEST-NOT-P
[COMPLEX-POSITION-MACRO ITEM SEQUENCE START END FROM-END KEY (CL:IF TEST-NOT-P
(NOT (CL:FUNCALL TEST ITEM
(CL:FUNCALL KEY
CURRENT)))
@ -166,19 +163,19 @@ Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
])
(CL:DEFUN COMPLEX-POSITION-IF (TEST SEQUENCE START END FROM-END KEY)
(COMPLEX-POSITION-MACRO ITEM SEQUENCE START END FROM-END KEY (CL:FUNCALL TEST (CL:FUNCALL KEY
(COMPLEX-POSITION-MACRO ITEM SEQUENCE START END FROM-END KEY (CL:FUNCALL TEST (CL:FUNCALL KEY
CURRENT))))
(CL:DEFUN COMPLEX-POSITION-IF-NOT (TEST SEQUENCE START END FROM-END KEY)
[COMPLEX-POSITION-MACRO ITEM SEQUENCE START END FROM-END KEY (NOT (CL:FUNCALL TEST
[COMPLEX-POSITION-MACRO ITEM SEQUENCE START END FROM-END KEY (NOT (CL:FUNCALL TEST
(CL:FUNCALL KEY CURRENT])
(CL:DEFUN CL:POSITION (ITEM SEQUENCE &KEY (START 0)
END
(FROM-END NIL FROM-END-P)
(KEY 'CL:IDENTITY KEY-P)
(TEST 'EQL TEST-P)
(TEST-NOT NIL TEST-NOT-P))
END
(FROM-END NIL FROM-END-P)
(KEY 'CL:IDENTITY KEY-P)
(TEST 'EQL TEST-P)
(TEST-NOT NIL TEST-NOT-P))
"Returns the zero-origin index of the first element in SEQUENCE satisfying the test (default is EQL) with the given ITEM"
(LET ((LENGTH (CL:LENGTH SEQUENCE)))
(CL:IF (NULL END)
@ -187,37 +184,37 @@ Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
(CL:IF (AND TEST-P TEST-NOT-P)
(CL:ERROR "Both Test and Test-not specified"))
(CL:IF (OR FROM-END-P KEY-P TEST-P TEST-NOT-P)
(COMPLEX-POSITION ITEM SEQUENCE START END FROM-END KEY (CL:IF TEST-NOT-P
(COMPLEX-POSITION ITEM SEQUENCE START END FROM-END KEY (CL:IF TEST-NOT-P
TEST-NOT
TEST)
TEST-NOT-P)
(SIMPLE-POSITION ITEM SEQUENCE START END))))
(SIMPLE-POSITION ITEM SEQUENCE START END))))
(CL:DEFUN CL:POSITION-IF (TEST SEQUENCE &KEY (START 0)
END
(FROM-END NIL FROM-END-P)
(KEY 'CL:IDENTITY KEY-P))
END
(FROM-END NIL FROM-END-P)
(KEY 'CL:IDENTITY KEY-P))
"Returns the zero-origin index of the first element satisfying test(el)"
(LET ((LENGTH (CL:LENGTH SEQUENCE)))
(CL:IF (NULL END)
(SETQ END LENGTH))
(CHECK-SUBSEQ SEQUENCE START END LENGTH)
(CL:IF (OR FROM-END-P KEY-P)
(COMPLEX-POSITION-IF TEST SEQUENCE START END FROM-END KEY)
(SIMPLE-POSITION-IF TEST SEQUENCE START END))))
(COMPLEX-POSITION-IF TEST SEQUENCE START END FROM-END KEY)
(SIMPLE-POSITION-IF TEST SEQUENCE START END))))
(CL:DEFUN CL:POSITION-IF-NOT (TEST SEQUENCE &KEY (START 0)
END
(FROM-END NIL FROM-END-P)
(KEY 'CL:IDENTITY KEY-P))
END
(FROM-END NIL FROM-END-P)
(KEY 'CL:IDENTITY KEY-P))
"Returns the zero-origin index of the first element not satisfying test(el)"
(LET ((LENGTH (CL:LENGTH SEQUENCE)))
(CL:IF (NULL END)
(SETQ END LENGTH))
(CHECK-SUBSEQ SEQUENCE START END LENGTH)
(CL:IF (OR FROM-END-P KEY-P)
(COMPLEX-POSITION-IF-NOT TEST SEQUENCE START END FROM-END KEY)
(SIMPLE-POSITION-IF-NOT TEST SEQUENCE START END))))
(COMPLEX-POSITION-IF-NOT TEST SEQUENCE START END FROM-END KEY)
(SIMPLE-POSITION-IF-NOT TEST SEQUENCE START END))))
(DEFMACRO SIMPLE-COUNT-MACRO (ITEM SEQUENCE START END TEST-FORM)
`[SEQ-DISPATCH ,SEQUENCE [FORWARD-LIST-LOOP ,SEQUENCE ,START ,END (INDEX CURRENT (CNT 0))
@ -230,30 +227,30 @@ Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
(SETQ CNT (CL:1+ CNT)))])
(CL:DEFUN SIMPLE-COUNT (ITEM SEQUENCE START END)
(SIMPLE-COUNT-MACRO ITEM SEQUENCE START END (EQL ITEM CURRENT)))
(SIMPLE-COUNT-MACRO ITEM SEQUENCE START END (EQL ITEM CURRENT)))
(CL:DEFUN SIMPLE-COUNT-IF (TEST SEQUENCE START END)
(SIMPLE-COUNT-MACRO ITEM SEQUENCE START END (CL:FUNCALL TEST CURRENT)))
(SIMPLE-COUNT-MACRO ITEM SEQUENCE START END (CL:FUNCALL TEST CURRENT)))
(CL:DEFUN SIMPLE-COUNT-IF-NOT (TEST SEQUENCE START END)
(SIMPLE-COUNT-MACRO ITEM SEQUENCE START END (NOT (CL:FUNCALL TEST CURRENT))))
(SIMPLE-COUNT-MACRO ITEM SEQUENCE START END (NOT (CL:FUNCALL TEST CURRENT))))
(CL:DEFUN COMPLEX-COUNT (ITEM SEQUENCE START END KEY TEST TEST-NOT-P)
[SIMPLE-COUNT-MACRO ITEM SEQUENCE START END (CL:IF TEST-NOT-P
[SIMPLE-COUNT-MACRO ITEM SEQUENCE START END (CL:IF TEST-NOT-P
(NOT (CL:FUNCALL TEST ITEM (CL:FUNCALL KEY CURRENT
)))
(CL:FUNCALL TEST ITEM (CL:FUNCALL KEY CURRENT)))])
(CL:DEFUN COMPLEX-COUNT-IF (TEST SEQUENCE START END KEY)
(SIMPLE-COUNT-MACRO ITEM SEQUENCE START END (CL:FUNCALL TEST (CL:FUNCALL KEY CURRENT))))
(SIMPLE-COUNT-MACRO ITEM SEQUENCE START END (CL:FUNCALL TEST (CL:FUNCALL KEY CURRENT))))
(CL:DEFUN COMPLEX-COUNT-IF-NOT (TEST SEQUENCE START END KEY)
[SIMPLE-COUNT-MACRO ITEM SEQUENCE START END (NOT (CL:FUNCALL TEST (CL:FUNCALL KEY CURRENT])
[SIMPLE-COUNT-MACRO ITEM SEQUENCE START END (NOT (CL:FUNCALL TEST (CL:FUNCALL KEY CURRENT])
(CL:DEFUN CL:COUNT (ITEM SEQUENCE &KEY (START 0)
END FROM-END (KEY 'CL:IDENTITY KEY-P)
(TEST 'EQL TEST-P)
(TEST-NOT NIL TEST-NOT-P))
END FROM-END (KEY 'CL:IDENTITY KEY-P)
(TEST 'EQL TEST-P)
(TEST-NOT NIL TEST-NOT-P))
(LET ((LENGTH (CL:LENGTH SEQUENCE)))
(CL:IF (NULL END)
(SETQ END LENGTH))
@ -261,34 +258,33 @@ Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
(CL:IF (AND TEST-P TEST-NOT-P)
(CL:ERROR "Both Test and Test-not specified"))
(CL:IF (OR KEY-P TEST-P TEST-NOT-P)
(COMPLEX-COUNT ITEM SEQUENCE START END KEY (CL:IF TEST-NOT-P
(COMPLEX-COUNT ITEM SEQUENCE START END KEY (CL:IF TEST-NOT-P
TEST-NOT
TEST)
TEST-NOT-P)
(SIMPLE-COUNT ITEM SEQUENCE START END))))
(SIMPLE-COUNT ITEM SEQUENCE START END))))
(CL:DEFUN CL:COUNT-IF (TEST SEQUENCE &KEY (START 0)
END FROM-END (KEY 'CL:IDENTITY KEY-P))
(LET ((LENGTH (CL:LENGTH SEQUENCE)))
(CL:IF (NULL END)
(SETQ END LENGTH))
(CHECK-SUBSEQ SEQUENCE START END LENGTH)
(CL:IF KEY-P
(COMPLEX-COUNT-IF TEST SEQUENCE START END KEY)
(SIMPLE-COUNT-IF TEST SEQUENCE START END))))
(CL:DEFUN CL:COUNT-IF-NOT (TEST SEQUENCE &KEY (START 0)
END FROM-END (KEY 'CL:IDENTITY KEY-P))
(LET ((LENGTH (CL:LENGTH SEQUENCE)))
(CL:IF (NULL END)
(SETQ END LENGTH))
(CHECK-SUBSEQ SEQUENCE START END LENGTH)
(CL:IF KEY-P
(COMPLEX-COUNT-IF TEST SEQUENCE START END KEY)
(SIMPLE-COUNT-IF TEST SEQUENCE START END))))
(COMPLEX-COUNT-IF-NOT TEST SEQUENCE START END KEY)
(SIMPLE-COUNT-IF-NOT TEST SEQUENCE START END))))
(CL:DEFUN CL:COUNT-IF-NOT (TEST SEQUENCE &KEY (START 0)
END FROM-END (KEY 'CL:IDENTITY KEY-P))
(LET ((LENGTH (CL:LENGTH SEQUENCE)))
(CL:IF (NULL END)
(SETQ END LENGTH))
(CHECK-SUBSEQ SEQUENCE START END LENGTH)
(CL:IF KEY-P
(COMPLEX-COUNT-IF-NOT TEST SEQUENCE START END KEY)
(SIMPLE-COUNT-IF-NOT TEST SEQUENCE START END))))
(CL:DEFUN COMPLEX-COMPARE-BACKWARD (SEQUENCE1 SEQUENCE2 START1 END1 START2 END2 KEY TEST
TEST-NOT-P)
(CL:DEFUN COMPLEX-COMPARE-BACKWARD (SEQUENCE1 SEQUENCE2 START1 END1 START2 END2 KEY TEST TEST-NOT-P)
[LET ((LEN1 (- END1 START1))
(LEN2 (- END2 START2)))
(CL:IF (> LEN1 LEN2)
@ -363,8 +359,7 @@ Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
(NOT TEST-RESULT))]
(CL:1+ INDEX1)))])
(CL:DEFUN COMPLEX-COMPARE-FORWARD (SEQUENCE1 SEQUENCE2 START1 END1 START2 END2 KEY TEST
TEST-NOT-P)
(CL:DEFUN COMPLEX-COMPARE-FORWARD (SEQUENCE1 SEQUENCE2 START1 END1 START2 END2 KEY TEST TEST-NOT-P)
[LET ((LEN1 (- END1 START1))
(LEN2 (- END2 START2)))
(CL:IF (> LEN1 LEN2)
@ -467,13 +462,13 @@ Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
INDEX1))])
(CL:DEFUN CL:MISMATCH (SEQUENCE1 SEQUENCE2 &KEY (START1 0)
END1
(START2 0)
END2
(FROM-END NIL FROM-END-P)
(TEST 'EQL TEST-P)
(TEST-NOT NIL TEST-NOT-P)
(KEY 'CL:IDENTITY KEY-P))
END1
(START2 0)
END2
(FROM-END NIL FROM-END-P)
(TEST 'EQL TEST-P)
(TEST-NOT NIL TEST-NOT-P)
(KEY 'CL:IDENTITY KEY-P))
[LET ((LENGTH1 (CL:LENGTH SEQUENCE1))
(LENGTH2 (CL:LENGTH SEQUENCE2)))
(CL:IF (NULL END1)
@ -487,7 +482,7 @@ Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
(LET ((SUBLEN1 (- END1 START1))
(SUBLEN2 (- END2 START2)))
(CL:IF FROM-END
(LET ((INDEX (COMPLEX-COMPARE-BACKWARD SEQUENCE1 SEQUENCE2 START1 END1 START2 END2
(LET ((INDEX (COMPLEX-COMPARE-BACKWARD SEQUENCE1 SEQUENCE2 START1 END1 START2 END2
KEY (CL:IF TEST-NOT-P
TEST-NOT
TEST)
@ -497,25 +492,25 @@ Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
NIL
INDEX))
(LET [(INDEX (CL:IF (OR KEY-P TEST-P TEST-NOT-P KEY-P)
(COMPLEX-COMPARE-FORWARD SEQUENCE1 SEQUENCE2 START1 END1 START2
(COMPLEX-COMPARE-FORWARD SEQUENCE1 SEQUENCE2 START1 END1 START2
END2 KEY (CL:IF TEST-NOT-P
TEST-NOT
TEST)
TEST-NOT-P)
(SIMPLE-COMPARE SEQUENCE1 SEQUENCE2 START1 END1 START2 END2))]
(SIMPLE-COMPARE SEQUENCE1 SEQUENCE2 START1 END1 START2 END2))]
(CL:IF (AND (EQL INDEX END1)
(EQL SUBLEN1 SUBLEN2))
NIL
INDEX)))])
(CL:DEFUN CL:SEARCH (SEQUENCE1 SEQUENCE2 &KEY (START1 0)
END1
(START2 0)
END2
(FROM-END NIL FROM-END-P)
(TEST 'EQL TEST-P)
(TEST-NOT NIL TEST-NOT-P)
(KEY 'CL:IDENTITY KEY-P))
END1
(START2 0)
END2
(FROM-END NIL FROM-END-P)
(TEST 'EQL TEST-P)
(TEST-NOT NIL TEST-NOT-P)
(KEY 'CL:IDENTITY KEY-P))
"A search is conducted for the first subsequence of sequence2 which element-wise matches sequence1. If there is such a subsequence in sequence2, the index of the its leftmost element is returned otherwise () is returned."
[LET ((LENGTH1 (CL:LENGTH SEQUENCE1))
(LENGTH2 (CL:LENGTH SEQUENCE2)))
@ -534,7 +529,7 @@ Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
(CL:DO ((SUBSTART2 START2 (CL:1+ SUBSTART2))
(END-SEARCH (- END2 SUBLEN1)))
((> SUBSTART2 END-SEARCH))
(CL:IF (EQL (SIMPLE-COMPARE SEQUENCE1 SEQUENCE2 START1 END1 SUBSTART2 END2)
(CL:IF (EQL (SIMPLE-COMPARE SEQUENCE1 SEQUENCE2 START1 END1 SUBSTART2 END2)
END1)
(RETURN SUBSTART2)))
(CL:DO ((SUBSTART2 START2 (CL:1+ SUBSTART2))
@ -544,7 +539,7 @@ Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
TEST))
INDEX)
((> SUBSTART2 END-SEARCH))
(SETQ INDEX (COMPLEX-COMPARE-FORWARD SEQUENCE1 SEQUENCE2 START1 END1
(SETQ INDEX (COMPLEX-COMPARE-FORWARD SEQUENCE1 SEQUENCE2 START1 END1
SUBSTART2 END2 KEY PREDICATE TEST-NOT-P))
(CL:IF (EQL INDEX END1)
(RETURN SUBSTART2))))
@ -552,7 +547,7 @@ Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
(CL:DO ((SUBSTART2 (- END2 SUBLEN1)
(CL:1- SUBSTART2)))
((< SUBSTART2 START2))
(CL:IF (EQL (SIMPLE-COMPARE SEQUENCE1 SEQUENCE2 START1 END1 SUBSTART2 END2)
(CL:IF (EQL (SIMPLE-COMPARE SEQUENCE1 SEQUENCE2 START1 END1 SUBSTART2 END2)
END1)
(RETURN SUBSTART2)))
(CL:DO ((SUBSTART2 (- END2 SUBLEN1)
@ -561,7 +556,7 @@ Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
TEST-NOT
TEST)))
((< SUBSTART2 START2))
(CL:IF (EQL (COMPLEX-COMPARE-FORWARD SEQUENCE1 SEQUENCE2 START1 END1
(CL:IF (EQL (COMPLEX-COMPARE-FORWARD SEQUENCE1 SEQUENCE2 START1 END1
SUBSTART2 END2 KEY PREDICATE TEST-NOT-P)
END1)
(RETURN SUBSTART2)))))])
@ -573,7 +568,23 @@ Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
(LOCALVARS . T)
)
)
(PUTPROPS CMLSEQFINDER COPYRIGHT ("Venue & Xerox Corporation" 1986 1990))
(DECLARE%: DONTCOPY
(FILEMAP (NIL)))
(FILEMAP (NIL (1336 1745 (SIMPLE-FIND-MACRO 1336 . 1745)) (1747 1869 (SIMPLE-FIND 1747 . 1869)) (1871
2003 (SIMPLE-FIND-IF 1871 . 2003)) (2005 2147 (SIMPLE-FIND-IF-NOT 2005 . 2147)) (2149 3024 (
COMPLEX-FIND-MACRO 2149 . 3024)) (3026 3639 (COMPLEX-FIND 3026 . 3639)) (3641 3886 (COMPLEX-FIND-IF
3641 . 3886)) (3888 4162 (COMPLEX-FIND-IF-NOT 3888 . 4162)) (4164 5163 (CL:FIND 4164 . 5163)) (5165
5750 (CL:FIND-IF 5165 . 5750)) (5752 6365 (CL:FIND-IF-NOT 5752 . 6365)) (6367 6776 (
SIMPLE-POSITION-MACRO 6367 . 6776)) (6778 6908 (SIMPLE-POSITION 6778 . 6908)) (6910 7050 (
SIMPLE-POSITION-IF 6910 . 7050)) (7052 7202 (SIMPLE-POSITION-IF-NOT 7052 . 7202)) (7204 8069 (
COMPLEX-POSITION-MACRO 7204 . 8069)) (8071 8737 (COMPLEX-POSITION 8071 . 8737)) (8739 9013 (
COMPLEX-POSITION-IF 8739 . 9013)) (9015 9283 (COMPLEX-POSITION-IF-NOT 9015 . 9283)) (9285 10349 (
CL:POSITION 9285 . 10349)) (10351 10959 (CL:POSITION-IF 10351 . 10959)) (10961 11597 (CL:POSITION-IF-NOT
10961 . 11597)) (11599 12100 (SIMPLE-COUNT-MACRO 11599 . 12100)) (12102 12226 (SIMPLE-COUNT 12102 .
12226)) (12228 12362 (SIMPLE-COUNT-IF 12228 . 12362)) (12364 12508 (SIMPLE-COUNT-IF-NOT 12364 . 12508)
) (12510 12945 (COMPLEX-COUNT 12510 . 12945)) (12947 13103 (COMPLEX-COUNT-IF 12947 . 13103)) (13105
13268 (COMPLEX-COUNT-IF-NOT 13105 . 13268)) (13270 14074 (CL:COUNT 13270 . 14074)) (14076 14492 (
CL:COUNT-IF 14076 . 14492)) (14494 14926 (CL:COUNT-IF-NOT 14494 . 14926)) (14928 20608 (
COMPLEX-COMPARE-BACKWARD 14928 . 20608)) (20610 25345 (COMPLEX-COMPARE-FORWARD 20610 . 25345)) (25347
27890 (SIMPLE-COMPARE 25347 . 27890)) (27892 29989 (CL:MISMATCH 27892 . 29989)) (29991 33257 (CL:SEARCH
29991 . 33257)))))
STOP

BIN
sources/CMLSEQFINDER.LCOM
View File

Binary file not shown.