Skip to content
Snippets Groups Projects
Commit 0a3ec09c authored by ram's avatar ram
Browse files

Changed to use :EVAL-NAME and closures instead of macros for the string

transforms (reducing code bloat.)
Removed some commented-out stuff.
parent 09fb062f
No related branches found
No related tags found
No related merge requests found
...@@ -7,12 +7,10 @@ ...@@ -7,12 +7,10 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/seqtran.lisp,v 1.11 1991/02/20 14:59:36 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/seqtran.lisp,v 1.12 1991/11/05 19:26:21 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/seqtran.lisp,v 1.11 1991/02/20 14:59:36 ram Exp $
;;;
;;; This file contains optimizers for list and sequence functions. ;;; This file contains optimizers for list and sequence functions.
;;; ;;;
;;; Written by Rob MacLachlan. Some code adapted from the old seqtran file, ;;; Written by Rob MacLachlan. Some code adapted from the old seqtran file,
...@@ -105,27 +103,6 @@ ...@@ -105,27 +103,6 @@
'nil))) 'nil)))
(frob val)))) (frob val))))
#|Inline expansion is available...
;;; For Adjoin, just turn into a member and let the member transform
;;; worry about it.
;;;
(deftransform adjoin ((item list &key (key #'identity) test test-not))
`(if (member (funcall key item) list
,@(when test '(:test test))
,@(when test-not '(:test-not test-not))
:key key)
list
(cons item list)))
|#
#|
member map concatenate position find
|#
;;; Names of predicates that compute the same value as CHAR= when applied to ;;; Names of predicates that compute the same value as CHAR= when applied to
;;; characters. ;;; characters.
;;; ;;;
...@@ -426,61 +403,58 @@ member map concatenate position find ...@@ -426,61 +403,58 @@ member map concatenate position find
;;; version. This is an IR1 transform so that we don't have to worry about ;;; version. This is an IR1 transform so that we don't have to worry about
;;; changing the order of evaluation. ;;; changing the order of evaluation.
;;; ;;;
(macrolet ((frob (pred pred*) (loop for (fun pred*) in
`(deftransform ,pred ((string1 string2 &key (start1 0) end1 '((string< string<*)
(start2 0) end2)) (string> string>*)
'(,pred* string1 string2 start1 end1 start2 end2)))) (string<= string<=*)
(string>= string>=*)
(frob string< string<*) (string= string=*)
(frob string> string>*) (string/= string/=*)) do
(frob string<= string<=*) (deftransform fun ((string1 string2 &key (start1 0) end1
(frob string>= string>=*) (start2 0) end2)
(frob string= string=*) * * :eval-name t)
(frob string/= string/=*)) `(,pred* string1 string2 start1 end1 start2 end2)))
;;; STRING<>=-BODY -- Internal ;;; STRING-xxx* transform -- Internal
;;; ;;;
;;; Return a form that tests the free variables STRING1 and STRING2 for the ;;; Return a form that tests the free variables STRING1 and STRING2 for the
;;; ordering relationship specified by Lessp and Equalp. The start and end are ;;; ordering relationship specified by Lessp and Equalp. The start and end are
;;; also gotten from the environment. Both strings must be simple strings. ;;; also gotten from the environment. Both strings must be simple strings.
;;; ;;;
(defun string<>=-body (lessp equalp) (loop for (name lessp equalp) in
`(let* ((end1 (if (not end1) (length string1) end1)) '((string<* t nil)
(end2 (if (not end2) (length string2) end2)) (string<=* t t)
(index (lisp::%sp-string-compare (string>* nil nil)
string1 start1 end1 string2 start2 end2))) (string>=* nil t)) do
(if index (deftransform name ((string1 string2 start1 end1 start2 end2)
(cond ((= index ,(if lessp 'end1 'end2)) index) (simple-string simple-string t t t t) *
((= index ,(if lessp 'end2 'end1)) nil) :eval-name t)
((,(if lessp 'char< 'char>) `(let* ((end1 (if (not end1) (length string1) end1))
(schar string1 index) (end2 (if (not end2) (length string2) end2))
(schar string2 (index (lisp::%sp-string-compare
(truly-the index string1 start1 end1 string2 start2 end2)))
(+ index (truly-the fixnum (if index
(- start2 start1)))))) (cond ((= index ,(if lessp 'end1 'end2)) index)
index) ((= index ,(if lessp 'end2 'end1)) nil)
(t nil)) ((,(if lessp 'char< 'char>)
,(if equalp 'end1 'nil)))) (schar string1 index)
(schar string2
(truly-the index
(macrolet ((frob (name lessp equalp) (+ index (truly-the fixnum
`(deftransform ,name ((string1 string2 start1 end1 start2 end2) (- start2 start1))))))
(simple-string simple-string t t t t)) index)
(string<>=-body ,lessp ,equalp)))) (t nil))
(frob string<* t nil) ,(if equalp 'end1 'nil)))))
(frob string<=* t t)
(frob string>* nil nil)
(frob string>=* nil t)) (loop for (name result-fun) in
'((string=* not)
(string/=* identity)) do
(macrolet ((frob (name result-fun) (deftransform name ((string1 string2 start1 end1 start2 end2)
`(deftransform ,name (simple-string simple-string t t t t) *
((string1 string2 start1 end1 start2 end2) :eval-name t)
(simple-string simple-string t t t t)) `(,result-fun
'(,result-fun (lisp::%sp-string-compare
(lisp::%sp-string-compare string1 start1 (or end1 (length string1))
string1 start1 (or end1 (length string1)) string2 start2 (or end2 (length string2))))))
string2 start2 (or end2 (length string2)))))))
(frob string=* not)
(frob string/=* identity))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment