Add a prebuild.ss file to give us finer-grained control over what we …

…prebuild. We should expand this as Vicare gets more stable.

Makefile

@@ -98,7 +98,8 @@ etags:
 # Build Vicare FASL files so everything goes faster
 .phony: prebuild
 prebuild:
-	vicare -L . -L external/nanopass-framework --more-file-extensions --compile-dependencies harlanc.scm
+	vicare -O2 -L . -L external/nanopass-framework --more-file-extensions --compile-dependencies prebuild.ss
+#	vicare -L . -L external/nanopass-framework --more-file-extensions --compile-dependencies harlanc.scm
 
 #============================================================
 # For JIT support we embed Chez Scheme in a static library:

harlan/middle/generate-kernel-calls.scm

@@ -10,63 +10,6 @@
    (harlan middle languages)
    (harlan helpers))
 
-;; TODO: This is a failed attempt at removing complex kernel
-;; arguments. Basically, we were doing it too late in the compiler to
-;; be feasible. I'm moving it to before lower-vectors. This code is
-;; kept commented out here, but it should be removed once the earlier
-;; version is in place.
-
-;;(define-pass remove-complex-kernel-args^
-;;  : M8 (m) -> M8 ()
-;;
-;;  (definitions
-;;    (define (complex? t)
-;;      (nanopass-case
-;;       (M8 Rho-Type) t
-;;       ((adt ,x) #t)
-;;       (else #f)))
-;;    
-;;    ;; returns (x*^ t*^ replace-x* replace-x*^ replace-t* region)
-;;    (define (replace-args x* t*)
-;;      (if (null? t*)
-;;          (values '() '() '() '()' ())
-;;          (let-values (((x*^ t*^ replace-x* replace-x*^ replace-t*)
-;;                        (replace-args (cdr x*) (cdr t*))))
-;;             (let ((x (car x*))
-;;                   (t (car t*)))
-;;               (if (complex? t)
-;;                   (let ((x^ (gensym x)))
-;;                     (values (cons x^ x*^)
-;;                             (cons 'region_ptr t*^)
-;;                             (cons x replace-x*)
-;;                             (cons x^ replace-x*^)
-;;                             (cons t replace-t*)))
-;;                   (values (cons x x*^)
-;;                           (cons t t*^)
-;;                           replace-x*
-;;                           replace-x*^
-;;                           replace-t*)))))))
-  ;; Oh yeah... We need to pick a random region to put these things
-  ;; in.  Also, we don't have box and unbox anymore... This might be
-  ;; worth adding in.
-
-;;  (Kernel
-;;   : Kernel (kernel) -> Kernel
-;;
-;;   ((kernel ,x ((,x* ,t*) ...) ,stmt)
-;;    (let-values (((x*^ t*^ replace-x* replace-x*^ replace-t*)
-;;                  (replace-args x* t*)))
-;;      `(kernel
-;;           ,x ((,x*^ ,x*^) ...)
-;;           (begin
-;;             (let ,replace-x* ,replace-t*
-;;)
-
-;;(define (remove-complex-kernel-args m)
-;;  (if (allow-complex-kernel-args)
-;;      m
-;;      (remove-complex-kernel-args^ m)))
-
 (define-pass generate-kernel-calls
   : M8 (m) -> M9 ()
 

harlan/middle/remove-recursion.scm

@@ -30,24 +30,26 @@
         (set! current-node (list name)))
 
       (define (add-call! name)
+        (assert (not (null? current-node)))
         (set-cdr! current-node (set-add (cdr current-node) name))))
 
     (Stmt : Stmt (b) -> Stmt ())
 
     (Decl
      : Decl (decl) -> Decl ()
 
-     ((gpu-module ,[k*] ...)
-      (new-node! '_)
-      (let ((sccs (strongly-connected-components cgraph)))
-        (if (dump-call-graph)
-            (begin
-              (if (file-exists? "call-graph.dot")
-                  (delete-file "call-graph.dot"))
-              (write-dot cgraph
-                         sccs
-                         (open-output-file "call-graph.dot"))))
-        `(gpu-module (call-graph ,cgraph ,sccs) ,k* ...)))
+     ((gpu-module ,k* ...)
+      (let ((k* (map Kernel k*)))
+        (new-node! '_)
+        (let ((sccs (strongly-connected-components cgraph)))
+          (if (dump-call-graph)
+              (begin
+                (if (file-exists? "call-graph.dot")
+                    (delete-file "call-graph.dot"))
+                (write-dot cgraph
+                           sccs
+                           (open-output-file "call-graph.dot"))))
+          `(gpu-module (call-graph ,cgraph ,sccs) ,k* ...))))
      ((fn ,name (,x ...) ,[t] ,stmt)
       (new-node! name)
       `(fn ,name (,x ...) ,t ,(Stmt stmt))))
@@ -56,7 +58,7 @@
      : Kernel (k) -> Kernel ()
 
      ((kernel ,x ((,x* ,[t*]) ...) ,stmt)
-      (new-node! '_kernel)
+      (new-node! x)
       `(kernel ,x ((,x* ,t*) ...) ,(Stmt stmt))))
 
     (Expr
@@ -96,10 +98,14 @@
                   (loop (cdr sccs))))))
 
       (define (recursive? name)
-        (or (memq name (cdr (assq name (call-graph))))
-            (let ((scc (find-scc name)))
-              ;;(display (length scc))
-              (> (length scc) 1)))))
+        (let ((node (assq name (call-graph))))
+          (if (not node)
+              (error 'recursive "could not find function in call graph"
+                     name (call-graph)))
+          (or (memq name (cdr node))
+              (let ((scc (find-scc name)))
+                ;;(display (length scc))
+                (> (length scc) 1))))))
 
     (Expr
      : Expr (e) -> Expr ()

harlanc

@@ -5,4 +5,4 @@ SCHEME=vicare
 schemeScript="$0".scm
 HARLAN_DIR=`dirname $schemeScript`
 
-$SCHEME -L $HARLAN_DIR -L $HARLAN_DIR/external/nanopass-framework --more-file-extensions --r6rs-script "$schemeScript" -- -L $HARLAN_DIR/lib/harlan -R $HARLAN_DIR/rt $@
+$SCHEME -O2 -L $HARLAN_DIR -L $HARLAN_DIR/external/nanopass-framework --more-file-extensions --r6rs-script "$schemeScript" -- -L $HARLAN_DIR/lib/harlan -R $HARLAN_DIR/rt $@

prebuild.ss

@@ -0,0 +1,10 @@
+(import (elegant-weapons compat)
+        (elegant-weapons graphs)
+        (elegant-weapons graphviz)
+        (elegant-weapons helpers)
+        (elegant-weapons insert-prototypes)
+        (elegant-weapons match)
+        (elegant-weapons print-c)
+        (elegant-weapons record-case)
+        (elegant-weapons sets)
+        (nanopass))