some output directory messing

.gitignore

@@ -2,4 +2,5 @@ src/scsc/syntax-case.scm
 *.o[0-9]*
 build
 lib
+bin
 TODO

sakefile.scm

@@ -9,20 +9,21 @@
 (define-task init ()
   (sake#default-clean)
   (make-directory (current-build-directory))
-  (make-directory (current-lib-directory)))
+  (make-directory (current-lib-directory))
+  (make-directory (current-bin-directory)))
 
 (define-task compile-stage-1 (init)
   ;; Compile Sake program
   (info/color 'green "Compiling Sake...")
   (gambit-compile-file
    (string-append (current-source-directory) "sake/sake.scm")
-   output: (string-append (current-build-directory) "ssake")
+   output: (string-append (current-bin-directory) "ssake")
    options: "-exe")
   ;; Compile Spheres program
   (info/color 'green "Compiling Spheres...")
   (gambit-compile-file
    (string-append (current-source-directory) "spheres/spheres.scm")
-   output: (string-append (current-build-directory) "sspheres")
+   output: (string-append (current-bin-directory) "sspheres")
    options: "-exe"))
 
 (define-task post-compile-stage-1 ()
@@ -32,7 +33,7 @@
   (make-directory "~~spheres/core/src/sake")
   (if (not (file-exists? (sake-extensions-path)))
       (make-directory (sake-extensions-path)))
-  (copy-file (string-append (current-build-directory) "ssake") "~~/bin/ssake")
+  (copy-file (string-append (current-bin-directory) "ssake") "~~/bin/ssake")
   (copy-files (fileset dir: (string-append (current-source-directory) "sake")
                        test: (ends-with? ".scm")
                        recursive: #t)
@@ -45,14 +46,14 @@
   (copy-file (string-append (current-source-directory) "internal/tiny.scm")
              (string-append (sake-extensions-path) "tiny.scm"))
   (copy-file (string-append (current-source-directory) "sake/extensions/core-macros.scm")
-             (string-append (sake-extensions-path) "core-macros.scm"))
+             (string-append (sake-extensions-path) "aaaa_core-macros.scm"))
   (copy-file (string-append (current-source-directory) "sake/extensions/core.scm")
              (string-append (sake-extensions-path) "core.scm"))
 
   ;; Install Spheres program
   (info/color 'green "Installing Spheres...")
   (delete-file "~~/bin/sspheres")
-  (copy-file (string-append (current-build-directory) "sspheres") "~~/bin/sspheres")
+  (copy-file (string-append (current-bin-directory) "sspheres") "~~/bin/sspheres")
   ;; Create symbolic link in /usr/bin
   (delete-file "/usr/bin/sspheres")
   (create-symbolic-link "~~/bin/sspheres" "/usr/bin/sspheres"))

src/sake/extensions/core.scm

@@ -25,7 +25,7 @@
            (macros-module (%module-macros module))
            (version (if (null? version) (%module-version module) version))
            (input-file (string-append (%sphere-path (%module-sphere module))
-                                      (current-source-directory)
+                                      (default-source-directory)
                                       (%module-filename-scm module)))
            (intermediate-file (string-append (current-build-directory)
                                              "_%_"
@@ -558,7 +558,9 @@
                   (begin (make-directory (string-append (%sphere-system-path sphere) dir))
                          (copy-files (fileset dir: dir recursive: #f)
                                      (string-append (%sphere-system-path sphere) dir)))))
-            `(,(current-source-directory) ,(current-lib-directory) ,@extra-directories)))
+            `(,(path-relative (current-source-directory))
+              ,(path-relative (current-lib-directory))
+              ,@extra-directories)))
 
 ;;! Uninstall all the files from the system installation
 (##define (sake#uninstall-sphere-from-system #!optional (sphere (%current-sphere)))

src/sake/filesets#.scm

@@ -5,6 +5,8 @@
   ends-with?
   newer-than?
   newer-than/extension?
+  path-relative
+  path-add-trailing-directory-separator
   directory?
   regular?
   any?

src/sake/filesets.scm

@@ -78,6 +78,9 @@
 (define (path-add-trailing-directory-separator dir)
   (string-append (path-strip-trailing-directory-separator dir) "/"))
 
+(define (path-relative dir)
+  (path-normalize dir 'shortest (current-directory)))
+
 (define (directory? name)
   (eq? (file-type name) 'directory))
 

src/spheres.scm

@@ -103,27 +103,25 @@
 ;;------------------------------------------------------------------------------
 ;;!! Spheres
 
-(define^ default-src-directory
-  (make-parameter "src/"))
 
+;;!! Default paths and extensions.
+;; They should be used for refencing Spheres files in a general way, but not within
+;; Sake tasks. In those situations (current-*-directory) versions should be used instead
+
+(define^ default-source-directory
+  (make-parameter "src/"))
 (define^ default-build-directory
   (make-parameter "build/"))
-
 (define^ default-lib-directory
   (make-parameter "lib/"))
-
 (define^ default-bin-directory
   (make-parameter "bin/"))
-
 (define^ default-scm-extension
   (make-parameter ".scm"))
-
 (define^ default-o-extension
   (make-parameter ".o1"))
-
 (define^ default-c-extension
   (make-parameter ".o1.c"))
-
 (define^ config-file
   (make-parameter "config.scm"))
 
@@ -393,7 +391,7 @@ fig.scm file"))
 
 (define^ (%module-path-src module)
   (or (%module? module) (%module-error module))
-  (string-append (%module-path module) (default-src-directory)))
+  (string-append (%module-path module) (default-source-directory)))
 
 (define^ (%module-path-lib module)
   (or (%module? module) (%module-error module))
@@ -796,7 +794,7 @@ fig.scm file"))
                               (%module-shallow-dependencies-to-include module)))
                 (if sphere
                     (let ((file-o (string-append (%sphere-path sphere) (default-lib-directory) (%module-filename-o module)))
-                          (file-scm (string-append (%sphere-path sphere) (default-src-directory) (%module-filename-scm module))))
+                          (file-scm (string-append (%sphere-path sphere) (default-source-directory) (%module-filename-scm module))))
                       (cond ((file-exists? file-o)
                              (if verbose
                                  (display (string-append "-- object loaded -- " (object->string module) "\n")))