Changeset 11647


Ignore:
Timestamp:
Jan 29, 2009, 3:04:44 PM (11 years ago)
Author:
gz
Message:

remove ~<newline> in format strings at compile time (r11539 and r11645 from trunk)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/compiler/optimizers.lisp

    r11504 r11647  
    19621962                         (format-to-string stream ,string)
    19631963                         (progn (write-string ,string (and (neq stream t) stream)) nil))))))
     1964          ((let ((new (format-string-sans~newlines string)))
     1965             (and (neq new string) (setq string new)))
     1966           `(format ,stream ,string ,@args))
    19641967          ((optimize-format-call stream string args env))
    19651968          (t call))
    19661969    call))
     1970
     1971(defun format-string-sans~newlines (string)
     1972  (loop as pos = 0 then (position #\Newline string :start pos) while pos
     1973        as ch = (and (> pos 0) (schar string (1- pos)))
     1974        do (cond ((not (or (eq ch #\~)
     1975                           (and (or (eq ch #\:) (eq ch #\@))
     1976                                (> pos 1) (eq (schar string (- pos 2)) #\~))))
     1977                  (incf pos))
     1978                 ((eq ch #\:)
     1979                  (decf pos 2)
     1980                  (setq string (%str-cat (subseq string 0 pos) (subseq string (+ pos 3)))))
     1981                 ((eq ch #\@)
     1982                  (setq string (%str-cat (subseq string 0 (- pos 2))
     1983                                         "~%"
     1984                                         (subseq string (or
     1985                                                         (position-if-not #'whitespacep string
     1986                                                                          :start (1+ pos))
     1987                                                         (1+ pos))))))
     1988                  ((eq ch #\~)
     1989                  (decf pos)
     1990                  (setq string (%str-cat (subseq string 0 pos)
     1991                                         (subseq string (or (position-if-not #'whitespacep string
     1992                                                                         :start (1+ pos))
     1993                                                            (1+ pos))))))))
     1994  string)
    19671995
    19681996(defun count-known-format-args (string start end)
Note: See TracChangeset for help on using the changeset viewer.