Fix :std/source (#930)

Add a test for good measure

src/std/source-test.ss

@@ -0,0 +1,17 @@
+(export #t)
+(import :std/source
+        :std/test)
+
+(def source-test
+  (test-suite "test :std/source"
+    (test-case "simple tests"
+      (check-equal? (this-source-position) ;; <-- marks the position of this-source-position itself
+                    #x00150007) ;; Line 8 (7 counting from from 0), column 21, in Gambit encoding.
+      (check-equal? (path-strip-directory (this-source-file))
+                    "source-test.ss")
+      (check-equal? (path-directory (this-source-path "blah"))
+                    (path-directory (this-source-file)))
+      (check-equal? (this-source-directory)
+                    (path-directory (this-source-file)))
+      (check-equal? (bytes->string (subu8vector (this-source-content "source-test.ss") 0 11))
+                    "(export #t)"))))

src/std/source.ss

@@ -1,4 +1,4 @@
-(export #t)
+(export #t (for-syntax #t))
 
 (import (for-syntax :std/stxutil
                     :std/misc/path
@@ -10,6 +10,27 @@
 ;;; The second value is a fixnum, either non-negative (+ (* 65536 column) line),
 ;;; or if the previous formula had overflows, negative file position.
 
+(begin-syntax
+  (def (stx-source-file stx)
+    (alet (loc (stx-source stx))
+      (vector-ref loc 0)))
+
+  (def (stx-source-position stx)
+    (alet (loc (stx-source stx))
+      (vector-ref loc 1)))
+
+  (def (stx-source-directory stx)
+    (alet (file (stx-source-file stx))
+      (path-directory file)))
+
+  (def (stx-source-path stx . relpath)
+    (alet (dir (stx-source-directory stx))
+      (apply subpath dir relpath)))
+
+  (def (stx-source-content stx . relpath)
+    (alet (path (apply stx-source-path stx relpath))
+      (read-file-u8vector path))))
+
 (defsyntax-call (this-source-location ctx)
   (stx-source ctx))
 
@@ -23,9 +44,7 @@
   (stx-source-directory ctx))
 
 (defsyntax-call (this-source-path ctx relpath)
-  (alet (dir (stx-source-directory ctx)) (apply subpath dir relpath)))
+  (stx-source-path ctx relpath))
 
 (defsyntax-call (this-source-content ctx relpath)
-  (alet (dir (stx-source-directory ctx))
-    (alet (path (apply subpath dir ctx relpath))
-      (read-file-u8vector path))))
+  (stx-source-content ctx relpath))

src/std/stxutil.ss

@@ -45,12 +45,3 @@
                              (x (maybe-intern-symbol (stringify x)))))
 (def maybe-keywordify (case-lambda ((x) (if (keyword? x) x (maybe-intern-keyword (stringify x))))
                               (x (maybe-intern-keyword (stringify x)))))
-
-(def (stx-source-file stx)
-  (alet (loc (stx-source stx)) (vector-ref loc 0)))
-
-(def (stx-source-position stx)
-  (alet (loc (stx-source stx)) (vector-ref loc 1)))
-
-(def (stx-source-directory stx)
-  (alet (file (stx-source-file stx)) (path-directory file)))