Changeset 8816


Ignore:
Timestamp:
Mar 18, 2008, 1:20:33 AM (12 years ago)
Author:
gz
Message:

Propagate 'recompile' load restart (r8813) from working-0711 branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-files.lisp

    r8286 r8816  
    11391139        (*load-truename* file-name)
    11401140        (source-file file-name)
    1141         constructed-source-file
    11421141        ;; Don't bind these: let OPTIMIZE proclamations/declamations
    11431142        ;; persist, unless debugging.
     
    11711170           (*loading-file-source-file* (namestring source-file))) ;reset by fasload to logical name stored in the file?
    11721171      (declare (special *loading-files* *loading-file-source-file*))
    1173       (unwind-protect
    1174         (progn
    1175           (when verbose
    1176             (format t "~&;Loading ~S..." *load-pathname*)
    1177             (force-output))
    1178           (cond ((fasl-file-p file-name)
    1179                  (flet ((attempt-load (file-name)
    1180                           (multiple-value-bind (winp err)
    1181                               (%fasload (native-translated-namestring file-name))
    1182                             (if (not winp)
    1183                               (%err-disp err)))))
    1184                    (let ((*fasload-print* print))
    1185                      (declare (special *fasload-print*))
    1186                      (setq constructed-source-file (make-pathname :defaults file-name :type (pathname-type *.lisp-pathname*)))
    1187                      (when (equalp source-file *load-truename*)
    1188                        (when (probe-file constructed-source-file)
    1189                          (setq source-file constructed-source-file)))
    1190                      (if (and source-file
    1191                               (not (equalp source-file file-name))
    1192                               (probe-file source-file))
    1193                        ;;really need restart-case-if instead of duplicating code below
    1194                        (restart-case
    1195                          (attempt-load file-name)
    1196                          #+ignore
    1197                          (load-other () :report (lambda (x) (format s "load other file"))
    1198                                      (return-from
    1199                                        %load
    1200                                        (%load (choose-file-dialog) verbose print if-does-not-exist)))
    1201                          (load-source
    1202                           ()
    1203                           :report (lambda (s)
    1204                                     (format s "Attempt to load ~s instead of ~s"
    1205                                             source-file *load-pathname*))
    1206                           (return-from
    1207                             %load
    1208                             (%load source-file verbose print if-does-not-exist  external-format))))
    1209                        ;;duplicated code
    1210                        (attempt-load file-name)))))
    1211                 (t
    1212                  (with-open-file (stream file-name
    1213                                          :element-type 'base-char
    1214                                          :external-format external-format)
    1215                    (load-from-stream stream print))))))))
     1172      (when verbose
     1173        (format t "~&;Loading ~S..." *load-pathname*)
     1174        (force-output))
     1175      (cond ((fasl-file-p file-name)
     1176             (let ((*fasload-print* print)
     1177                   (restart-setup nil)
     1178                   (restart-source nil)
     1179                   (restart-fasl nil))
     1180               (declare (special *fasload-print*))
     1181               (flet ((restart-test (c)
     1182                        (unless restart-setup
     1183                          (setq restart-setup t)
     1184                          (let ((source *loading-file-source-file*)
     1185                                (fasl *load-pathname*))
     1186                            (when (and (not (typep c 'file-error))
     1187                                       source
     1188                                       fasl
     1189                                       (setq source (probe-file source))
     1190                                       (setq fasl (probe-file fasl))
     1191                                       (not (equalp source fasl)))
     1192                              (setq restart-fasl (namestring *load-pathname*)
     1193                                    restart-source *loading-file-source-file*))))
     1194                        (not (null restart-fasl)))
     1195                      (fname (p)
     1196                        #-versioned-file-system
     1197                        (namestring (make-pathname :version :unspecific :defaults p))
     1198                        #+versioned-file-system
     1199                        (namestring p)))
     1200                 (restart-case (multiple-value-bind (winp err)
     1201                                   (%fasload (native-translated-namestring file-name))
     1202                                 (if (not winp)
     1203                                   (%err-disp err)))
     1204                   (load-source
     1205                    ()
     1206                    :test restart-test
     1207                    :report (lambda (s)
     1208                              (format s "Load ~s instead of ~s"
     1209                                      (fname restart-source) (fname restart-fasl)))
     1210                    (%load source-file verbose print if-does-not-exist external-format))
     1211                   (recompile
     1212                    ()
     1213                    :test restart-test
     1214                    :report (lambda (s)
     1215                              (let ((*print-circle* NIL))
     1216                                (format s
     1217                                        (if (equalp
     1218                                             restart-source
     1219                                             (make-pathname :type (pathname-type *.lisp-pathname*)
     1220                                                            :defaults restart-fasl))
     1221                                          "Compile ~s and then load ~s again"
     1222                                          "Compile ~s into ~s then load ~:*~s again")
     1223                                        (fname restart-source) (fname restart-fasl))))
     1224                    (compile-file restart-source :output-file restart-fasl)
     1225                    (%load restart-fasl verbose print if-does-not-exist external-format))))))
     1226            (t
     1227             (with-open-file (stream file-name
     1228                                     :element-type 'base-char
     1229                                     :external-format external-format)
     1230               (load-from-stream stream print))))))
    12161231  file-name)
    12171232
Note: See TracChangeset for help on using the changeset viewer.