From: Christophe R. <cr...@us...> - 2004-10-06 12:52:00
|
Update of /cvsroot/sbcl/sbcl/src/compiler In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13786/src/compiler Modified Files: Tag: character_branch srctran.lisp Log Message: 0.8.13.77.character.40: "Tuck your shirt in, boy!" Restore buildability (reported by Patrik Nordebo aka KingNato on #lisp IRC) ... be conservative when #+sb-xc-host about character types; try not to generate anything that's hard to unparse Index: srctran.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/srctran.lisp,v retrieving revision 1.111.2.2 retrieving revision 1.111.2.3 diff -u -d -r1.111.2.2 -r1.111.2.3 --- srctran.lisp 5 Oct 2004 11:03:35 -0000 1.111.2.2 +++ srctran.lisp 6 Oct 2004 12:51:38 -0000 1.111.2.3 @@ -2327,8 +2327,23 @@ ;; type. -- CSR, 2004-10-04 (when (numeric-type-p type) (let* ((lo (numeric-type-low type)) - (hi (numeric-type-high type))) - (specifier-type `(character-set ((,lo . ,hi)))))))) + (hi (numeric-type-high type)) + (type (specifier-type `(character-set ((,lo . ,hi)))))) + (cond + ;; KLUDGE: when running on the host, we lose a slight amount + ;; of precision so that we don't have to "unparse" types + ;; that formally we can't, such as (CHARACTER-SET ((0 + ;; . 0))). -- CSR, 2004-10-06 + #+sb-xc-host + ((csubtypep type (specifier-type 'standard-char)) type) + #+sb-xc-host + ((csubtypep type (specifier-type 'base-char)) + (specifier-type 'base-char)) + #+sb-xc-host + ((csubtypep type (specifier-type 'extended-char)) + (specifier-type 'extended-char)) + (t #+sb-xc-host (specifier-type 'character) + #-sb-xc-host type)))))) (defoptimizer (values derive-type) ((&rest values)) (make-values-type :required (mapcar #'lvar-type values))) |