Changeset 26006 in project


Ignore:
Timestamp:
02/28/12 13:14:53 (9 years ago)
Author:
felix winkelmann
Message:

clueless hacking along

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/system/branches/rewrite/system.scm

    r25971 r26006  
    2020
    2121(define (dribble target . args)
    22   (when (verbose-actions target)
     22  (when (verbose target)
    2323    (apply print "; " (system-name (target-system target)) ": " args)))
    2424
     
    3636
    3737(define-class <target> ()
    38   ((system reader: target-system)))
     38  ((system reader: target-system)
     39   (verbose accessor: verbose initform: #t)))
    3940
    4041
     
    5556
    5657(define-class <scheme-file> (<file-componment>)
    57   ((modules accessor: scheme-file-modules)))
     58  ((modules accessor: scheme-file-modules)
     59   (load-time accessor: scheme-file-load-time initform: #f)
     60   (compiled-output-path accessor: scheme-file-compiled-output-path)
     61   (options accessor: scheme-file-options initform: '())))
    5862
    5963(define-class <compiled-scheme-file> (<scheme-file>)
    60   ((output-path accessor: compiled-scheme-file-output-path)
    61    (options accessor: compiled-scheme-file-options initform: '())))
     64  ())
    6265
    63 (define-generic (compiled-scheme-file-path (f <scheme-file>) (t <target>)))
    64  
    6566(define (make-component x #!optional sys)
    6667  (cond ((symbol? x) (make-component (symbol->string x)))
     
    8990   'path (or path (make-pathname #f (->string name) ext))
    9091   (append
    91     (if output-path (list 'output-path output-path) '())
    92     (if options (list 'options (listify options)) '())
    93     (if modules (list 'modules (listify options)) '()))))
     92    (optarg 'output-path output-path)
     93    (optarg 'options output-path)
     94    (optarg 'modules output-path))))
    9495
    95 (define file (file-maker <file>)) 
     96(define file (file-maker <file-component>)) 
    9697(define scheme-file (file-maker <scheme-file> "scm"))
    9798(define scheme-module (file-maker <scheme-file> "scm"))
    9899(define compiled-scheme-file (file-maker <compiled-scheme-file> "scm"))
    99100(define compiled-scheme-module (file-maker <compiled-scheme-file> "scm"))
     101
     102(define-record changed reason)
     103
     104(define (changed? reason . argfs)
     105  (and reason
     106       (make-changed
     107        (if (string? reason)
     108            (apply sprintf reason args)))))
     109
     110(define-generic (component-changed? component target))
     111(define-generic (component-needs-recompile? component target))
     112
     113(define-method (component-changed? (c <component>) (t <target>)) #f)
     114
     115(define-method (component-needs-recompile? (c <component>) (t <target>)) #f)
     116
     117(define-method (component-needs-recompile? (c <scheme-file>) (t <target>)) #f)
     118  ;;XXX
     119  )
     120
     121(define-method (component-needs-recompile? (c <compiled-scheme-file>) (t <target>))
     122  ;;XXX
     123  )
     124
     125(define-method (component-changed? (c <scheme-file>) (t <target>))
     126  ;;XXX determine whether we need to compile/load and use "component-needs-recompile?"
     127  (let ((in (file-component-path c))
     128        (out (schene-file-compiled-output-path c)))
     129    (cond ((not (file-exists? out))
     130           (changed "compiled file does not exist"))
     131          ((> (file-modification-time in)
     132              (file-modification-time out))
     133           (changed "source file is newer than compiled file"))
     134          (else #f))))
     135
     136(define-method (component-changed? (c <compiled-scheme-file>) (t <target>))
     137  (component-needs-recompile? c t))
     138
     139(define-generic (update-component! component target))
     140
     141(define-method (update-component! (c <component>) (t <target>)) (void))
     142
     143(define-method (update-component! (c <scheme-file>) (t <target>))
     144  ;;XXX determine whether to compile or load
     145  (let ((cf (compile-file
     146             (file-component-path c)
     147             options: (scheme-file-options c)
     148             verbose: (verbose t))))
     149    (unless cf (error "recompilation failed" sf))))
    100150
    101151
Note: See TracChangeset for help on using the changeset viewer.