Changeset 8813


Ignore:
Timestamp:
Mar 17, 2008, 10:35:38 PM (12 years ago)
Author:
gz
Message:

Add a RECOMPILE restart to loading a fasl, also generalize LOAD-SOURCE while in there

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-1/l1-files.lisp

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