<commit_before>;;;  --------------------------------------------------------------  ;;;
;;;                                                                  ;;;
;;;               Utilities for compiling and loading                ;;;
;;;                                                                  ;;;
;;;  --------------------------------------------------------------  ;;;

;;;; ---------- File utilities ----------

(define (object-files path)
  (let* ((dir (path-directory path))
         (begin-str (string-append (path-strip-directory
                                    (path-strip-extension path))
                                   ".o")))
    (map (lambda (fn)
           (path-expand fn dir))
         (filter (lambda (fn)
                   (and (string-begins-with fn begin-str)
                        (string->number
                         (substring fn
                                    (string-length begin-str)
                                    (string-length fn)))))
                 (directory-files dir)))))

(define (object-file-extract-number fn)
  (or (string->number
       (substring fn
                  (let loop ((i (string-length fn)))
                    (if (zero? i)
                        0
                        (let ((chr
                               (char->integer
                                (string-ref fn (- i 1)))))
                          (if (and (>= chr (char->integer #\0))
                                   (<= chr (char->integer #\9)))
                              (loop (- i 1))
                              i))))
                  (string-length fn)))
      0))

(define (last-object-file path)
  (let ((lst (object-files path))
        (max-num -1)
        (res #f))
    (let loop ((lst lst))
      (if (not (null? lst))
          (let ((num (object-file-extract-number (car lst))))
            (if (> num max-num)
                (begin
                  (set! max-num num)
                  (set! res (car lst))))
            (loop (cdr lst)))))
    res))

(define (clean-file path)
  (for-each (lambda (fn)
              (let ((dep-fn (deps-file-name fn)))
                (if (file-exists? dep-fn)
                    (delete-file dep-fn)))
              (delete-file fn))
            (object-files path)))

;;;; ---------- Loading ----------

;; TODO This doesn't work atm [I have forgotten why I wrote this]
(define (module-needs-compile? mod)
  (let ((mod (resolve-one-module mod)))
    (let* ((path (module-reference-path mod))
           (of (last-object-file path)))
      (if of
          (and (file-exists? path)
               (file-newer? path of))
          'not-compiled))))

(define (load-module-scm-file module-ref file)
  (let ((runtime-code
         compiletime-code
         visit-code
         info-code
         (module-macroexpand module-ref
                             (file-read-as-expr file))))
    (values (lambda ()
              (eval-no-hook runtime-code))
            (eval-no-hook compiletime-code)
            (eval-no-hook visit-code)
            (u8vector->module-reference
             (eval-no-hook info-code)))))

;; Takes the return value of ##load-object-file and returns a table
;; mapping "[module namespace]-[rt, ct or mi]" to the instantiation
;; procedure.
(define (load-object-file-result->table result)
  (list->table
   (map (lambda (x)
          (cons (vector-ref x 0)
                (vector-ref x 1)))
     (vector->list
      (vector-ref result 0)))))

;; file should be an absolute path to an object file
(define load-module-object-table
  (let ((registry (make-table)))
    (lambda (file)
      (or (table-ref registry file #f)
          (let ((result (##load-object-file file #t)))
            (if (not (and (vector? result)
                          (= 3 (vector-length result))))
                (error "Failed to load file:" file result))
            
            (let ((missing-constants
                   (vector-ref result 1)))
              (for-each
                  (lambda (pair)
                    (let ((var (car pair))
                          (mod (cdr pair)))
                      (print "*** WARNING -- Variable \""
                             var
                             "\" used in module \""
                             mod
                             "\" is undefined\n")))
                missing-constants))

            (let ((table (load-object-file-result->table result)))
              (table-set! registry file table)
              table))))))

(define (deps-file-name fn)
  (string-append fn ".deps"))

(define (load-deps-file fn)
  (with-input-from-file fn
    (lambda ()
      (let* ((fs (file-size fn))
             (u8v (make-u8vector fs)))
        (read-subu8vector u8v 0 fs)
        (u8vector->module-reference u8v)))))

(define (load-deps-from-deps-file fn)
  (for-each module-reference-ref
    (load-deps-file fn)))

(define (load-module-from-file module-ref file-with-extension)
  (let* ((file
          (path-strip-trailing-directory-separator
           (path-strip-extension
            (path-normalize file-with-extension))))
         
         (object-fn
          (let* ((ol (string-append file ".ol"))
                 (object-fn (if (file-exists? ol)
                                (with-input-from-file ol
                                  read-line)
                                (last-object-file file))))
            (and object-fn
                 (path-normalize object-fn #f file))))

         (force-compile
          (lambda ()
            (module-compile! module-ref)
            (load-module-from-file module-ref file-with-extension))))
    
    (cond
     ((eq? #t (module-needs-compile? module-ref))
      (force-compile))
     
     ((not object-fn)
      (let ((rt
             ct
             vt
             mi
             (load-module-scm-file module-ref
                                   (string-append file ".scm"))))
        (let ((ret (assq 'force-compile mi)))
          (if (and ret (cdr ret))
              (force-compile)
              (values rt ct vt mi)))))
     
     (else
      (let* ((module-object-table
              (let ((deps-fn (deps-file-name object-fn)))
                (if (file-exists? deps-fn)
                    (load-deps-from-deps-file deps-fn))
                (load-module-object-table object-fn)))
             (ns
              (let ((str (module-reference-namespace module-ref)))
                (substring str 0 (- (string-length str) 1))))
             (rt (table-ref module-object-table
                            (string-append ns "-rt")
                            #f))
             (ct (table-ref module-object-table
                            (string-append ns "-ct")
                            #f))
             (vt (table-ref module-object-table
                            (string-append ns "-vt")
                            #f))
             (mi (table-ref module-object-table
                            (string-append ns "-mi")
                            #f)))
        (if (not (and rt ct vt mi))
            (error "Module initializers not found for:" ns))
        
        (values rt
                (ct)<commit_msg>Module bunch dependencies are now properly invoked (not just loaded)<commit_after>;;;  --------------------------------------------------------------  ;;;
;;;                                                                  ;;;
;;;               Utilities for compiling and loading                ;;;
;;;                                                                  ;;;
;;;  --------------------------------------------------------------  ;;;

;;;; ---------- File utilities ----------

(define (object-files path)
  (let* ((dir (path-directory path))
         (begin-str (string-append (path-strip-directory
                                    (path-strip-extension path))
                                   ".o")))
    (map (lambda (fn)
           (path-expand fn dir))
         (filter (lambda (fn)
                   (and (string-begins-with fn begin-str)
                        (string->number
                         (substring fn
                                    (string-length begin-str)
                                    (string-length fn)))))
                 (directory-files dir)))))

(define (object-file-extract-number fn)
  (or (string->number
       (substring fn
                  (let loop ((i (string-length fn)))
                    (if (zero? i)
                        0
                        (let ((chr
                               (char->integer
                                (string-ref fn (- i 1)))))
                          (if (and (>= chr (char->integer #\0))
                                   (<= chr (char->integer #\9)))
                              (loop (- i 1))
                              i))))
                  (string-length fn)))
      0))

(define (last-object-file path)
  (let ((lst (object-files path))
        (max-num -1)
        (res #f))
    (let loop ((lst lst))
      (if (not (null? lst))
          (let ((num (object-file-extract-number (car lst))))
            (if (> num max-num)
                (begin
                  (set! max-num num)
                  (set! res (car lst))))
            (loop (cdr lst)))))
    res))

(define (clean-file path)
  (for-each (lambda (fn)
              (let ((dep-fn (deps-file-name fn)))
                (if (file-exists? dep-fn)
                    (delete-file dep-fn)))
              (delete-file fn))
            (object-files path)))

;;;; ---------- Loading ----------

;; TODO This doesn't work atm [I have forgotten why I wrote this]
(define (module-needs-compile? mod)
  (let ((mod (resolve-one-module mod)))
    (let* ((path (module-reference-path mod))
           (of (last-object-file path)))
      (if of
          (and (file-exists? path)
               (file-newer? path of))
          'not-compiled))))

(define (load-module-scm-file module-ref file)
  (let ((runtime-code
         compiletime-code
         visit-code
         info-code
         (module-macroexpand module-ref
                             (file-read-as-expr file))))
    (values (lambda ()
              (eval-no-hook runtime-code))
            (eval-no-hook compiletime-code)
            (eval-no-hook visit-code)
            (u8vector->module-reference
             (eval-no-hook info-code)))))

;; Takes the return value of ##load-object-file and returns a table
;; mapping "[module namespace]-[rt, ct or mi]" to the instantiation
;; procedure.
(define (load-object-file-result->table result)
  (list->table
   (map (lambda (x)
          (cons (vector-ref x 0)
                (vector-ref x 1)))
     (vector->list
      (vector-ref result 0)))))

;; file should be an absolute path to an object file
(define load-module-object-table
  (let ((registry (make-table)))
    (lambda (file)
      (or (table-ref registry file #f)
          (let ((result (##load-object-file file #t)))
            (if (not (and (vector? result)
                          (= 3 (vector-length result))))
                (error "Failed to load file:" file result))
            
            (let ((missing-constants
                   (vector-ref result 1)))
              (for-each
                  (lambda (pair)
                    (let ((var (car pair))
                          (mod (cdr pair)))
                      (print "*** WARNING -- Variable \""
                             var
                             "\" used in module \""
                             mod
                             "\" is undefined\n")))
                missing-constants))

            (let ((table (load-object-file-result->table result)))
              (table-set! registry file table)
              table))))))

(define (deps-file-name fn)
  (string-append fn ".deps"))

(define (load-deps-file fn)
  (with-input-from-file fn
    (lambda ()
      (let* ((fs (file-size fn))
             (u8v (make-u8vector fs)))
        (read-subu8vector u8v 0 fs)
        (u8vector->module-reference u8v)))))

(define (invoke-deps-from-deps-file fn)
  (loaded-modules-invoke/deps
   (map module-reference-ref
     (load-deps-file fn))
   (syntactic-tower-first-phase *repl-syntactic-tower*)))

(define (load-module-from-file module-ref file-with-extension)
  (let* ((file
          (path-strip-trailing-directory-separator
           (path-strip-extension
            (path-normalize file-with-extension))))
         
         (object-fn
          (let* ((ol (string-append file ".ol"))
                 (object-fn (if (file-exists? ol)
                                (with-input-from-file ol
                                  read-line)
                                (last-object-file file))))
            (and object-fn
                 (path-normalize object-fn #f file))))

         (force-compile
          (lambda ()
            (module-compile! module-ref)
            (load-module-from-file module-ref file-with-extension))))
    
    (cond
     ((eq? #t (module-needs-compile? module-ref))
      (force-compile))
     
     ((not object-fn)
      (let ((rt
             ct
             vt
             mi
             (load-module-scm-file module-ref
                                   (string-append file ".scm"))))
        (let ((ret (assq 'force-compile mi)))
          (if (and ret (cdr ret))
              (force-compile)
              (values rt ct vt mi)))))
     
     (else
      (let* ((module-object-table
              (let ((deps-fn (deps-file-name object-fn)))
                (if (file-exists? deps-fn)
                    (invoke-deps-from-deps-file deps-fn))
                (load-module-object-table object-fn)))
             (ns
              (let ((str (module-reference-namespace module-ref)))
                (substring str 0 (- (string-length str) 1))))
             (rt (table-ref module-object-table
                            (string-append ns "-rt")
                            #f))
             (ct (table-ref module-object-table
                            (string-append ns "-ct")
                            #f))
             (vt (table-ref module-object-table
                            (string-append ns "-vt")
                            #f))
             (mi (table-ref module-object-table
                            (string-append ns "-mi")
                            #f)))
        (if (not (and rt ct vt mi))
            (error "Module initializers not found for:" ns))
        
        (values rt
                (ct)
{'fraction_non_alphanumeric': 0.15331082477778543, 'fraction_numerical': 0.0030317646248191276, 'mean_word_length': 1.1105133052202996, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 29, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 26, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1638625', 'n_tokens_mistral': 3940, 'n_tokens_neox': 3807, 'n_words': 987}