diff --git a/collects/tests/unstable/srcloc.ss b/collects/tests/unstable/srcloc.ss
new file mode 100644
index 0000000000..299cbf07b8
--- /dev/null
+++ b/collects/tests/unstable/srcloc.ss
@@ -0,0 +1,305 @@
+
+(load-relative "../mzscheme/loadtest.ss")
+
+(Section 'srcloc)
+(require unstable/srcloc)
+(require scheme/shared)
+
+(test #t source-location? #f)
+(test #f source-location? #t)
+(test #t source-location? (list #f #f #f #f #f))
+(test #t source-location? (list 'here 1 0 1 0))
+(test #t source-location? (list #f 1 0 1 0))
+(test #f source-location? (list 'here #f 0 1 0))
+(test #f source-location? (list 'here 1 #f 1 0))
+(test #t source-location? (list 'here 1 0 #f 0))
+(test #t source-location? (list 'here 1 0 1 #f))
+(test #f source-location? (list 'here 1 -1 1 0))
+(test #f source-location? (list 'here 1 0 0 0))
+(test #f source-location? (list 'here 1 0 1 -1))
+(test #f source-location? (shared ([x (list* 'here 1 0 1 0 x)]) x))
+(test #t source-location? (vector #f #f #f #f #f))
+(test #t source-location? (vector 'here 1 0 1 0))
+(test #t source-location? (vector #f 1 0 1 0))
+(test #f source-location? (vector 'here #f 0 1 0))
+(test #f source-location? (vector 'here 1 #f 1 0))
+(test #t source-location? (vector 'here 1 0 #f 0))
+(test #t source-location? (vector 'here 1 0 1 #f))
+(test #f source-location? (vector 'here 0 0 1 0))
+(test #f source-location? (vector 'here 1 -1 1 0))
+(test #f source-location? (vector 'here 1 0 0 0))
+(test #f source-location? (vector 'here 1 0 1 -1))
+(test #t source-location? (make-srcloc #f #f #f #f #f))
+(test #t source-location? (make-srcloc 'here 1 0 1 0))
+(test #t source-location? (make-srcloc #f 1 0 1 0))
+(test #f source-location? (make-srcloc 'here #f 0 1 0))
+(test #f source-location? (make-srcloc 'here 1 #f 1 0))
+(test #t source-location? (make-srcloc 'here 1 0 #f 0))
+(test #t source-location? (make-srcloc 'here 1 0 1 #f))
+(test #t source-location? (datum->syntax #f null #f))
+(test #t source-location? (datum->syntax #f null (list 'here 1 0 1 0)))
+(test #t source-location? (datum->syntax #f null (list #f 1 0 1 0)))
+;;(test #f source-location? (datum->syntax #f null (list 'here #f 0 1 0))) ;; won't run
+;;(test #f source-location? (datum->syntax #f null (list 'here 1 #f 1 0))) ;; won't run
+(test #t source-location? (datum->syntax #f null (list 'here 1 0 #f 0)))
+(test #t source-location? (datum->syntax #f null (list 'here 1 0 1 #f)))
+
+(test #f source-location-list? #f)
+(test #t source-location-list? (list #f #f #f #f #f))
+(test #t source-location-list? (list 'here 1 0 1 0))
+(test #t source-location-list? (list #f 1 0 1 0))
+(test #f source-location-list? (list 'here #f 0 1 0))
+(test #f source-location-list? (list 'here 1 #f 1 0))
+(test #t source-location-list? (list 'here 1 0 #f 0))
+(test #t source-location-list? (list 'here 1 0 1 #f))
+(test #f source-location-list? (list 'here 0 0 1 0))
+(test #f source-location-list? (list 'here 1 -1 1 0))
+(test #f source-location-list? (list 'here 1 0 0 0))
+(test #f source-location-list? (list 'here 1 0 1 -1))
+(test #f source-location-list? (shared ([x (list* 'here 1 0 1 0 x)]) x))
+(test #f source-location-list? (vector 'here 1 0 1 0))
+(test #f source-location-list? (make-srcloc 'here 1 0 1 0))
+(test #f source-location-list? (datum->syntax #f null #f))
+(test #f source-location-list? (datum->syntax #f null (list 'here 1 0 1 0)))
+
+(test #f source-location-vector? #f)
+(test #f source-location-vector? (list 'here 1 0 1 0))
+(test #t source-location-vector? (vector #f 1 0 1 0))
+(test #f source-location-vector? (vector 'here #f 0 1 0))
+(test #f source-location-vector? (vector 'here 1 #f 1 0))
+(test #t source-location-vector? (vector 'here 1 0 #f 0))
+(test #t source-location-vector? (vector 'here 1 0 1 #f))
+(test #t source-location-vector? (vector #f #f #f #f #f))
+(test #t source-location-vector? (vector 'here 1 0 1 0))
+(test #f source-location-vector? (vector 'here 0 0 1 0))
+(test #f source-location-vector? (vector 'here 1 -1 1 0))
+(test #f source-location-vector? (vector 'here 1 0 0 0))
+(test #f source-location-vector? (vector 'here 1 0 1 -1))
+(test #f source-location-vector? (make-srcloc 'here 1 0 1 0))
+(test #f source-location-vector? (datum->syntax #f null #f))
+(test #f source-location-vector? (datum->syntax #f null (list 'here 1 0 1 0)))
+
+(test (void) check-source-location! 'test-srcloc #f)
+(err/rt-test (check-source-location! 'test-srcloc #t) exn:fail:contract?)
+(test (void) check-source-location! 'test-srcloc (list #f #f #f #f #f))
+(test (void) check-source-location! 'test-srcloc (list 'here 1 0 1 0))
+(test (void) check-source-location! 'test-srcloc (list #f 1 0 1 0))
+(err/rt-test (check-source-location! 'test-srcloc (list 'here #f 0 1 0)) exn:fail:contract?)
+(err/rt-test (check-source-location! 'test-srcloc (list 'here 1 #f 1 0)) exn:fail:contract?)
+(test (void) check-source-location! 'test-srcloc (list 'here 1 0 #f 0))
+(test (void) check-source-location! 'test-srcloc (list 'here 1 0 1 #f))
+(err/rt-test (check-source-location! 'test-srcloc (list 'here 0 0 1 0)) exn:fail:contract?)
+(err/rt-test (check-source-location! 'test-srcloc (list 'here 1 -1 1 0)) exn:fail:contract?)
+(err/rt-test (check-source-location! 'test-srcloc (list 'here 1 0 0 0)) exn:fail:contract?)
+(err/rt-test (check-source-location! 'test-srcloc (list 'here 1 0 1 -1)) exn:fail:contract?)
+(err/rt-test (check-source-location! 'test-srcloc (shared ([x (list* 'here 1 0 1 0 x)]) x)) exn:fail:contract?)
+(test (void) check-source-location! 'test-srcloc (vector #f #f #f #f #f))
+(test (void) check-source-location! 'test-srcloc (vector 'here 1 0 1 0))
+(test (void) check-source-location! 'test-srcloc (vector #f 1 0 1 0))
+(err/rt-test (check-source-location! 'test-srcloc (vector 'here #f 0 1 0)) exn:fail:contract?)
+(err/rt-test (check-source-location! 'test-srcloc (vector 'here 1 #f 1 0)) exn:fail:contract?)
+(test (void) check-source-location! 'test-srcloc (vector 'here 1 0 #f 0))
+(test (void) check-source-location! 'test-srcloc (vector 'here 1 0 1 #f))
+(err/rt-test (check-source-location! 'test-srcloc (vector 'here 0 0 1 0)) exn:fail:contract?)
+(err/rt-test (check-source-location! 'test-srcloc (vector 'here 1 -1 1 0)) exn:fail:contract?)
+(err/rt-test (check-source-location! 'test-srcloc (vector 'here 1 0 0 0)) exn:fail:contract?)
+(err/rt-test (check-source-location! 'test-srcloc (vector 'here 1 0 1 -1)) exn:fail:contract?)
+(test (void) check-source-location! 'test-srcloc (make-srcloc #f #f #f #f #f))
+(test (void) check-source-location! 'test-srcloc (make-srcloc 'here 1 0 1 0))
+(test (void) check-source-location! 'test-srcloc (make-srcloc #f 1 0 1 0))
+(err/rt-test (check-source-location! 'test-srcloc (make-srcloc 'here #f 0 1 0)) exn:fail:contract?)
+(err/rt-test (check-source-location! 'test-srcloc (make-srcloc 'here 1 #f 1 0)) exn:fail:contract?)
+(test (void) check-source-location! 'test-srcloc (make-srcloc 'here 1 0 #f 0))
+(test (void) check-source-location! 'test-srcloc (make-srcloc 'here 1 0 1 #f))
+(test (void) check-source-location! 'test-srcloc (datum->syntax #f null #f))
+(test (void) check-source-location! 'test-srcloc (datum->syntax #f null (list 'here 1 0 1 0)))
+(test (void) check-source-location! 'test-srcloc (datum->syntax #f null (list #f 1 0 1 0)))
+;;(err/rt-test (check-source-location! 'test-srcloc (datum->syntax #f null (list 'here #f 0 1 0))) exn:fail:contract?) ;; won't run
+;;(err/rt-test (check-source-location! 'test-srcloc (datum->syntax #f null (list 'here 1 #f 1 0))) exn:fail:contract?) ;; won't run
+(test (void) check-source-location! 'test-srcloc (datum->syntax #f null (list 'here 1 0 #f 0)))
+(test (void) check-source-location! 'test-srcloc (datum->syntax #f null (list 'here 1 0 1 #f)))
+
+(test (make-srcloc #f #f #f #f #f) build-source-location)
+(test (make-srcloc #f #f #f #f #f) build-source-location #f)
+(test (make-srcloc 'here 1 0 1 0) build-source-location (make-srcloc 'here 1 0 1 0))
+(test (make-srcloc 'here 1 0 1 0) build-source-location (vector 'here 1 0 1 0))
+(test (make-srcloc 'here 1 0 1 0) build-source-location (list 'here 1 0 1 0))
+(test (make-srcloc 'here 1 0 1 0) build-source-location (datum->syntax #f null (list 'here 1 0 1 0)))
+(test (make-srcloc 'here 1 0 1 3) build-source-location (list 'here 1 0 1 0) (vector 'here 2 1 3 1))
+(test (make-srcloc 'here 1 0 1 3) build-source-location (vector 'here 2 1 3 1) (list 'here 1 0 1 0))
+(test (make-srcloc #f #f #f #f #f) build-source-location (vector 'here 2 1 3 1) (list 'there 1 0 1 0))
+(err/rt-test (build-source-location (list 'bad 0 0 0 0)) exn:fail:contract?)
+
+(test (list #f #f #f #f #f) build-source-location-list)
+(test (list #f #f #f #f #f) build-source-location-list #f)
+(test (list 'here 1 0 1 0) build-source-location-list (make-srcloc 'here 1 0 1 0))
+(test (list 'here 1 0 1 0) build-source-location-list (vector 'here 1 0 1 0))
+(test (list 'here 1 0 1 0) build-source-location-list (list 'here 1 0 1 0))
+(test (list 'here 1 0 1 0) build-source-location-list (datum->syntax #f null (list 'here 1 0 1 0)))
+(test (list 'here 1 0 1 3) build-source-location-list (list 'here 1 0 1 0) (vector 'here 2 1 3 1))
+(test (list 'here 1 0 1 3) build-source-location-list (vector 'here 2 1 3 1) (list 'here 1 0 1 0))
+(test (list #f #f #f #f #f) build-source-location-list (vector 'here 2 1 3 1) (list 'there 1 0 1 0))
+(err/rt-test (build-source-location-list (list 'bad 0 0 0 0)) exn:fail:contract?)
+
+(test (vector #f #f #f #f #f) build-source-location-vector)
+(test (vector #f #f #f #f #f) build-source-location-vector #f)
+(test (vector 'here 1 0 1 0) build-source-location-vector (make-srcloc 'here 1 0 1 0))
+(test (vector 'here 1 0 1 0) build-source-location-vector (vector 'here 1 0 1 0))
+(test (vector 'here 1 0 1 0) build-source-location-vector (list 'here 1 0 1 0))
+(test (vector 'here 1 0 1 0) build-source-location-vector (datum->syntax #f null (list 'here 1 0 1 0)))
+(test (vector 'here 1 0 1 3) build-source-location-vector (list 'here 1 0 1 0) (vector 'here 2 1 3 1))
+(test (vector 'here 1 0 1 3) build-source-location-vector (vector 'here 2 1 3 1) (list 'here 1 0 1 0))
+(test (vector #f #f #f #f #f) build-source-location-vector (vector 'here 2 1 3 1) (list 'there 1 0 1 0))
+(err/rt-test (build-source-location-vector (list 'bad 0 0 0 0)) exn:fail:contract?)
+
+(define-syntax-rule (test-stx-srcloc (list src line col pos span) fn arg ...)
+  (begin
+    (test #t syntax? (fn arg ...))
+    (test src syntax-source (fn arg ...))
+    (test line syntax-line (fn arg ...))
+    (test col syntax-column (fn arg ...))
+    (test pos syntax-position (fn arg ...))
+    (test span syntax-span (fn arg ...))))
+
+(test-stx-srcloc (list #f #f #f #f #f) build-source-location-syntax)
+(test-stx-srcloc (list #f #f #f #f #f) build-source-location-syntax #f)
+(test-stx-srcloc (list 'here 1 0 1 0) build-source-location-syntax (make-srcloc 'here 1 0 1 0))
+(test-stx-srcloc (list 'here 1 0 1 0) build-source-location-syntax (vector 'here 1 0 1 0))
+(test-stx-srcloc (list 'here 1 0 1 0) build-source-location-syntax (list 'here 1 0 1 0))
+(test-stx-srcloc (list 'here 1 0 1 0) build-source-location-syntax (datum->syntax #f null (list 'here 1 0 1 0)))
+(test-stx-srcloc (list 'here 1 0 1 3) build-source-location-syntax (list 'here 1 0 1 0) (vector 'here 2 1 3 1))
+(test-stx-srcloc (list 'here 1 0 1 3) build-source-location-syntax (vector 'here 2 1 3 1) (list 'here 1 0 1 0))
+(test-stx-srcloc (list #f #f #f #f #f) build-source-location-syntax (vector 'here 2 1 3 1) (list 'there 1 0 1 0))
+(err/rt-test (build-source-location-syntax (list 'bad 0 0 0 0)) exn:fail:contract?)
+
+(test #f source-location-known? #f)
+(test #t source-location-known? (list 'here 1 0 1 0))
+(test #f source-location-known? (list #f #f #f #f #f))
+(test #t source-location-known? (vector 'here 1 0 1 0))
+(test #f source-location-known? (vector #f #f #f #f #f))
+(test #t source-location-known? (make-srcloc 'here 1 0 1 0))
+(test #f source-location-known? (make-srcloc #f #f #f #f #f))
+(test #t source-location-known? (datum->syntax #f null (list 'here 1 0 1 0)))
+(test #f source-location-known? (datum->syntax #f null (list #f #f #f #f #f)))
+
+(test #f source-location-source #f)
+(test 'here source-location-source (list 'here 1 2 3 4))
+(test 'here source-location-source (vector 'here 1 2 3 4))
+(test 'here source-location-source (make-srcloc 'here 1 2 3 4))
+(test 'here source-location-source (datum->syntax #f null (list 'here 1 2 3 4)))
+
+(test #f source-location-line #f)
+(test 1 source-location-line (list 'here 1 2 3 4))
+(test 1 source-location-line (vector 'here 1 2 3 4))
+(test 1 source-location-line (make-srcloc 'here 1 2 3 4))
+(test 1 source-location-line (datum->syntax #f null (list 'here 1 2 3 4)))
+
+(test #f source-location-column #f)
+(test 2 source-location-column (list 'here 1 2 3 4))
+(test 2 source-location-column (vector 'here 1 2 3 4))
+(test 2 source-location-column (make-srcloc 'here 1 2 3 4))
+(test 2 source-location-column (datum->syntax #f null (list 'here 1 2 3 4)))
+
+(test #f source-location-position #f)
+(test 3 source-location-position (list 'here 1 2 3 4))
+(test 3 source-location-position (vector 'here 1 2 3 4))
+(test 3 source-location-position (make-srcloc 'here 1 2 3 4))
+(test 3 source-location-position (datum->syntax #f null (list 'here 1 2 3 4)))
+
+(test #f source-location-span #f)
+(test 4 source-location-span (list 'here 1 2 3 4))
+(test 4 source-location-span (vector 'here 1 2 3 4))
+(test 4 source-location-span (make-srcloc 'here 1 2 3 4))
+(test 4 source-location-span (datum->syntax #f null (list 'here 1 2 3 4)))
+
+(test #f source-location-end #f)
+(test 7 source-location-end (list 'here 1 2 3 4))
+(test #f source-location-end (list 'here 1 2 #f 4))
+(test #f source-location-end (list 'here 1 2 3 #f))
+(test 7 source-location-end (vector 'here 1 2 3 4))
+(test #f source-location-end (vector 'here 1 2 #f 4))
+(test #f source-location-end (vector 'here 1 2 3 #f))
+(test 7 source-location-end (make-srcloc 'here 1 2 3 4))
+(test #f source-location-end (make-srcloc 'here 1 2 #f 4))
+(test #f source-location-end (make-srcloc 'here 1 2 3 #f))
+(test 7 source-location-end (datum->syntax #f null (list 'here 1 2 3 4)))
+(test #f source-location-end (datum->syntax #f null (list 'here 1 2 #f 4)))
+(test #f source-location-end (datum->syntax #f null (list 'here 1 2 3 #f)))
+
+(test "" source-location->string #f)
+
+(test "" source-location->string (list #f #f #f #f #f))
+(test "here" source-location->string (list 'here #f #f #f #f))
+(test "here:1.2" source-location->string (list 'here 1 2 3 #f))
+(test "here::3" source-location->string (list 'here #f #f 3 #f))
+(test "::3-7" source-location->string (list #f #f #f 3 4))
+(test ":1.2" source-location->string (list #f 1 2 3 #f))
+(test "::3" source-location->string (list #f #f #f 3 #f))
+(test "::3-7" source-location->string (list #f #f #f 3 4))
+
+(test "" source-location->string (vector #f #f #f #f #f))
+(test "here" source-location->string (vector 'here #f #f #f #f))
+(test "here:1.2" source-location->string (vector 'here 1 2 3 #f))
+(test "here::3" source-location->string (vector 'here #f #f 3 #f))
+(test "::3-7" source-location->string (vector #f #f #f 3 4))
+(test ":1.2" source-location->string (vector #f 1 2 3 #f))
+(test "::3" source-location->string (vector #f #f #f 3 #f))
+(test "::3-7" source-location->string (vector #f #f #f 3 4))
+
+(test "" source-location->string (make-srcloc #f #f #f #f #f))
+(test "here" source-location->string (make-srcloc 'here #f #f #f #f))
+(test "here:1.2" source-location->string (make-srcloc 'here 1 2 3 #f))
+(test "here::3" source-location->string (make-srcloc 'here #f #f 3 #f))
+(test "::3-7" source-location->string (make-srcloc #f #f #f 3 4))
+(test ":1.2" source-location->string (make-srcloc #f 1 2 3 #f))
+(test "::3" source-location->string (make-srcloc #f #f #f 3 #f))
+(test "::3-7" source-location->string (make-srcloc #f #f #f 3 4))
+
+(test "" source-location->string (datum->syntax #f null (list #f #f #f #f #f)))
+(test "here" source-location->string (datum->syntax #f null (list 'here #f #f #f #f)))
+(test "here:1.2" source-location->string (datum->syntax #f null (list 'here 1 2 3 #f)))
+(test "here::3" source-location->string (datum->syntax #f null (list 'here #f #f 3 #f)))
+(test "::3-7" source-location->string (datum->syntax #f null (list #f #f #f 3 4)))
+(test ":1.2" source-location->string (datum->syntax #f null (list #f 1 2 3 #f)))
+(test "::3" source-location->string (datum->syntax #f null (list #f #f #f 3 #f)))
+(test "::3-7" source-location->string (datum->syntax #f null (list #f #f #f 3 4)))
+
+(test "" source-location->prefix #f)
+
+(test "" source-location->prefix (list #f #f #f #f #f))
+(test "here: " source-location->prefix (list 'here #f #f #f #f))
+(test "here:1.2: " source-location->prefix (list 'here 1 2 3 #f))
+(test "here::3: " source-location->prefix (list 'here #f #f 3 #f))
+(test "::3-7: " source-location->prefix (list #f #f #f 3 4))
+(test ":1.2: " source-location->prefix (list #f 1 2 3 #f))
+(test "::3: " source-location->prefix (list #f #f #f 3 #f))
+(test "::3-7: " source-location->prefix (list #f #f #f 3 4))
+
+(test "" source-location->prefix (vector #f #f #f #f #f))
+(test "here: " source-location->prefix (vector 'here #f #f #f #f))
+(test "here:1.2: " source-location->prefix (vector 'here 1 2 3 #f))
+(test "here::3: " source-location->prefix (vector 'here #f #f 3 #f))
+(test "::3-7: " source-location->prefix (vector #f #f #f 3 4))
+(test ":1.2: " source-location->prefix (vector #f 1 2 3 #f))
+(test "::3: " source-location->prefix (vector #f #f #f 3 #f))
+(test "::3-7: " source-location->prefix (vector #f #f #f 3 4))
+
+(test "" source-location->prefix (make-srcloc #f #f #f #f #f))
+(test "here: " source-location->prefix (make-srcloc 'here #f #f #f #f))
+(test "here:1.2: " source-location->prefix (make-srcloc 'here 1 2 3 #f))
+(test "here::3: " source-location->prefix (make-srcloc 'here #f #f 3 #f))
+(test "::3-7: " source-location->prefix (make-srcloc #f #f #f 3 4))
+(test ":1.2: " source-location->prefix (make-srcloc #f 1 2 3 #f))
+(test "::3: " source-location->prefix (make-srcloc #f #f #f 3 #f))
+(test "::3-7: " source-location->prefix (make-srcloc #f #f #f 3 4))
+
+(test "" source-location->prefix (datum->syntax #f null (list #f #f #f #f #f)))
+(test "here: " source-location->prefix (datum->syntax #f null (list 'here #f #f #f #f)))
+(test "here:1.2: " source-location->prefix (datum->syntax #f null (list 'here 1 2 3 #f)))
+(test "here::3: " source-location->prefix (datum->syntax #f null (list 'here #f #f 3 #f)))
+(test "::3-7: " source-location->prefix (datum->syntax #f null (list #f #f #f 3 4)))
+(test ":1.2: " source-location->prefix (datum->syntax #f null (list #f 1 2 3 #f)))
+(test "::3: " source-location->prefix (datum->syntax #f null (list #f #f #f 3 #f)))
+(test "::3-7: " source-location->prefix (datum->syntax #f null (list #f #f #f 3 4)))
+
+(report-errs)
diff --git a/collects/unstable/scribblings/srcloc.scrbl b/collects/unstable/scribblings/srcloc.scrbl
new file mode 100644
index 0000000000..f4e69e78c2
--- /dev/null
+++ b/collects/unstable/scribblings/srcloc.scrbl
@@ -0,0 +1,123 @@
+#lang scribble/manual
+@(require scribble/eval "utils.ss" (for-label scheme/base unstable/srcloc))
+
+@(define evaluator (make-base-eval))
+@(evaluator '(require unstable/srcloc))
+
+@title[#:tag "srcloc"]{Source Locations}
+
+@defmodule[unstable/srcloc]
+
+@unstable[@author+email["Carl Eastlund" "cce@ccs.neu.edu"]]
+
+This module defines utilities for manipulating representations of source
+locations, including both @scheme[srcloc] structures and all the values accepted
+by @scheme[datum->syntax]'s third argument: syntax objects, lists, vectors, and
+@scheme[#f].
+
+@deftogether[(
+@defproc[(source-location? [x any/c]) boolean?]{}
+@defproc[(source-location-list? [x any/c]) boolean?]{}
+@defproc[(source-location-vector? [x any/c]) boolean?]{}
+)]{
+
+These functions recognize valid source location representations.  The first,
+@scheme[source-location?], recognizes @scheme[srcloc] structures, syntax
+objects, lists, and vectors with appropriate structure, as well as @scheme[#f].
+The latter predicates recognize only valid lists and vectors, respectively.
+
+@examples[#:eval evaluator
+(source-location? #f)
+(source-location? #'here)
+(source-location? (make-srcloc 'here 1 0 1 0))
+(source-location? (make-srcloc 'bad 1 #f 1 0))
+(source-location? (list 'here 1 0 1 0))
+(source-location? (list* 'bad 1 0 1 0 'tail))
+(source-location? (vector 'here 1 0 1 0))
+(source-location? (vector 'bad 0 0 0 0))
+]
+
+}
+
+@defproc[(check-source-location! [name symbol?] [x any/c]) void?]{
+
+This procedure checks that its input is a valid source location.  If it is, the
+procedure returns @scheme[(void)].  If it is not,
+@scheme[check-source-location!] raises a detailed error message in terms of
+@scheme[name] and the problem with @scheme[x].
+
+@examples[#:eval evaluator
+(check-source-location! 'this-example #f)
+(check-source-location! 'this-example #'here)
+(check-source-location! 'this-example (make-srcloc 'here 1 0 1 0))
+(check-source-location! 'this-example (make-srcloc 'bad 1 #f 1 0))
+(check-source-location! 'this-example (list 'here 1 0 1 0))
+(check-source-location! 'this-example (list* 'bad 1 0 1 0 'tail))
+(check-source-location! 'this-example (vector 'here 1 0 1 0))
+(check-source-location! 'this-example (vector 'bad 0 0 0 0))
+]
+
+}
+
+@deftogether[(
+@defproc[(build-source-location [loc source-location?] ...) srcloc?]{}
+@defproc[(build-source-location-list [loc source-location?] ...) source-location-list?]{}
+@defproc[(build-source-location-vector [loc source-location?] ...) source-location-vector?]{}
+@defproc[(build-source-location-syntax [loc source-location?] ...) syntax?]{}
+)]{
+
+These procedures combine multiple (zero or more) source locations, merging
+locations within the same source and reporting @scheme[#f] for locations that
+span sources.  They also convert the result to the desired representation:
+@scheme[srcloc], list, vector, or syntax object, respectively.
+
+@examples[#:eval evaluator
+(build-source-location)
+(build-source-location-list)
+(build-source-location-vector)
+(build-source-location-syntax)
+(build-source-location #f)
+(build-source-location-list #f)
+(build-source-location-vector #f)
+(build-source-location-syntax #f)
+(build-source-location (list 'here 1 2 3 4))
+(build-source-location-list (make-srcloc 'here 1 2 3 4))
+(build-source-location-vector (make-srcloc 'here 1 2 3 4))
+(build-source-location-syntax (make-srcloc 'here 1 2 3 4))
+(build-source-location (list 'here 1 2 3 4) (vector 'here 5 6 7 8))
+(build-source-location-list (make-srcloc 'here 1 2 3 4) (vector 'here 5 6 7 8))
+(build-source-location-vector (make-srcloc 'here 1 2 3 4) (vector 'here 5 6 7 8))
+(build-source-location-syntax (make-srcloc 'here 1 2 3 4) (vector 'here 5 6 7 8))
+(build-source-location (list 'here 1 2 3 4) (vector 'there 5 6 7 8))
+(build-source-location-list (make-srcloc 'here 1 2 3 4) (vector 'there 5 6 7 8))
+(build-source-location-vector (make-srcloc 'here 1 2 3 4) (vector 'there 5 6 7 8))
+(build-source-location-syntax (make-srcloc 'here 1 2 3 4) (vector 'there 5 6 7 8))
+]
+
+}
+
+@deftogether[(
+@defproc[(source-location->string [loc source-location?]) string?]{}
+@defproc[(source-location->prefix [loc source-location?]) string?]{}
+)]{
+
+These procedures convert source locations to strings for use in error messages.
+The first produces a string describing the source location; the second appends
+@scheme[": "] to the string if it is non-empty.
+
+@examples[#:eval evaluator
+(source-location->string (make-srcloc 'here 1 2 3 4))
+(source-location->string (make-srcloc 'here #f #f 3 4))
+(source-location->string (make-srcloc 'here #f #f #f #f))
+(source-location->string (make-srcloc #f 1 2 3 4))
+(source-location->string (make-srcloc #f #f #f 3 4))
+(source-location->string (make-srcloc #f #f #f #f #f))
+(source-location->prefix (make-srcloc 'here 1 2 3 4))
+(source-location->prefix (make-srcloc 'here #f #f 3 4))
+(source-location->prefix (make-srcloc 'here #f #f #f #f))
+(source-location->prefix (make-srcloc #f 1 2 3 4))
+(source-location->prefix (make-srcloc #f #f #f 3 4))
+(source-location->prefix (make-srcloc #f #f #f #f #f))
+]
+
+}
diff --git a/collects/unstable/scribblings/unstable.scrbl b/collects/unstable/scribblings/unstable.scrbl
index 907a540732..b5eff58733 100644
--- a/collects/unstable/scribblings/unstable.scrbl
+++ b/collects/unstable/scribblings/unstable.scrbl
@@ -77,6 +77,7 @@ Keep documentation and tests up to date.
 @include-section["list.scrbl"]
 @include-section["net.scrbl"]
 @include-section["path.scrbl"]
+@include-section["srcloc.scrbl"]
 @include-section["string.scrbl"]
 @include-section["struct.scrbl"]
 @include-section["syntax.scrbl"]
diff --git a/collects/unstable/srcloc.ss b/collects/unstable/srcloc.ss
new file mode 100644
index 0000000000..89251f6318
--- /dev/null
+++ b/collects/unstable/srcloc.ss
@@ -0,0 +1,321 @@
+#lang scheme/base
+
+;; Unstable library by: Carl Eastlund <cce@ccs.neu.edu>
+;; intended for use in scheme/contract, so don't try to add contracts!
+
+(provide
+
+ ;; type predicates
+ source-location?
+ source-location-list?
+ source-location-vector?
+
+ ;; error checks
+ check-source-location!
+
+ ;; conversion and combination
+ build-source-location
+ build-source-location-list
+ build-source-location-vector
+ build-source-location-syntax
+
+ ;; accessors
+ source-location-known?
+ source-location-source
+ source-location-line
+ source-location-column
+ source-location-position
+ source-location-span
+ source-location-end
+
+ ;; rendering
+ source-location->string
+ source-location->prefix
+
+ )
+
+(define (source-location? x)
+  (process-source-location x good? bad? 'source-location?))
+
+(define (source-location-list? x)
+  (process-list x good? bad? 'source-location-list?))
+
+(define (source-location-vector? x)
+  (process-vector x good? bad? 'source-location-vector?))
+
+(define (check-source-location! name x)
+  (process-source-location x good! bad! name))
+
+(define (source-location-known? x)
+  (process-source-location x good-known? bad! 'source-location-known?))
+
+(define (source-location-source x)
+  (process-source-location x good-source bad! 'source-location-source))
+
+(define (source-location-line x)
+  (process-source-location x good-line bad! 'source-location-line))
+
+(define (source-location-position x)
+  (process-source-location x good-position bad! 'source-location-position))
+
+(define (source-location-column x)
+  (process-source-location x good-column bad! 'source-location-column))
+
+(define (source-location-span x)
+  (process-source-location x good-span bad! 'source-location-span))
+
+(define (source-location-end x)
+  (process-source-location x good-end bad! 'source-location-end))
+
+(define (source-location->string x)
+  (process-source-location x good-string bad! 'source-location->string))
+
+(define (source-location->prefix x)
+  (process-source-location x good-prefix bad! 'source-location->prefix))
+
+(define (build-source-location . locs)
+  (combine-source-locations locs good-srcloc bad!
+                            'build-source-location))
+
+(define (build-source-location-list . locs)
+  (combine-source-locations locs good-list bad!
+                            'build-source-location-list))
+
+(define (build-source-location-vector . locs)
+  (combine-source-locations locs good-vector bad!
+                            'build-source-location-vector))
+
+(define (build-source-location-syntax . locs)
+  (combine-source-locations locs good-syntax bad!
+                            'build-source-location-syntax))
+
+(define (good? x src line col pos span) #t)
+(define (bad? fmt . args) #f)
+
+(define (good! x src line col pos span) (void))
+(define (bad! fmt . args)
+  (raise
+   (make-exn:fail:contract
+    (apply format fmt args)
+    (current-continuation-marks))))
+
+(define (good-known? x src line col pos span)
+  (and (or src line col pos span) #t))
+
+(define (good-source x src line col pos span) src)
+(define (good-line x src line col pos span) line)
+(define (good-column x src line col pos span) col)
+(define (good-position x src line col pos span) pos)
+(define (good-span x src line col pos span) span)
+(define (good-end x src line col pos span) (and pos span (+ pos span)))
+
+(define (good-srcloc x src line col pos span)
+  (if (srcloc? x) x (make-srcloc src line col pos span)))
+
+(define (good-list x src line col pos span)
+  (if (list? x) x (list src line col pos span)))
+
+(define (good-vector x src line col pos span)
+  (if (vector? x) x (vector src line col pos span)))
+
+(define (good-syntax x src line col pos span)
+  (cond
+   [(syntax? x) x]
+   [(or (list? x) (vector? x)) (datum->syntax #f null x)]
+   [else (datum->syntax #f null (vector src line col pos span))]))
+
+(define (good-string x src line col pos span)
+  (format "~a~a"
+          (or src "")
+          (if line
+            (if col
+              (format ":~a.~a" line col)
+              (format ":~a" line))
+            (if pos
+              (if span
+                (format "::~a-~a" pos (+ pos span))
+                (format "::~a" pos))
+              ""))))
+
+(define (good-prefix x src line col pos span)
+  (let ([str (good-string x src line col pos span)])
+    (if (string=? str "") "" (string-append str ": "))))
+
+(define (combine-source-locations locs good bad name)
+
+  (define (loop loc1 src1 line1 col1 pos1 span1 locs)
+    (if (null? locs)
+      (good loc1 src1 line1 col1 pos1 span1)
+      (process-source-location
+       (car locs)
+       (lambda (loc2 src2 line2 col2 pos2 span2)
+         (combine-two
+          src1 line1 col1 pos1 span1
+          src2 line2 col2 pos2 span2
+          (lambda (loc src line col pos span)
+            (loop loc src line col pos span (cdr locs)))))
+       bad
+       name)))
+
+  (if (null? locs)
+    (process-source-location #f good bad name)
+    (process-source-location
+     (car locs)
+     (lambda (loc src line col pos span)
+       (loop loc src line col pos span (cdr locs)))
+     bad
+     name)))
+
+(define (combine-two src1 line1 col1 pos1 span1
+                     src2 line2 col2 pos2 span2
+                     good)
+  (if (and src1 src2 (equal? src1 src2))
+    (let-values
+        ([(src) src1]
+         [(line col)
+          (cond
+           [(and line1 line2)
+            (cond
+             [(< line1 line2) (values line1 col1)]
+             [(> line1 line2) (values line2 col2)]
+             [else (values line1
+                           (if (and col1 col2)
+                             (min col1 col2)
+                             (or col1 col2)))])]
+           [line1 (values line1 col1)]
+           [line2 (values line2 col2)]
+           [else (values #f #f)])]
+         [(pos span)
+          (cond
+           [(and pos1 pos2)
+            (let ([pos (min pos1 pos2)])
+              (cond
+               [(and span1 span2)
+                (let ([end (max (+ pos1 span1) (+ pos2 span2))])
+                  (values pos (- end pos)))]
+               [span1 (values pos (- (+ pos1 span1) pos))]
+               [span2 (values pos (- (+ pos2 span2) pos))]
+               [else (values pos #f)]))])])
+      (good #f src line col pos span))
+    (good #f #f #f #f #f #f)))
+
+(define (process-source-location x good bad name)
+  (cond
+   ;; #f
+   [(not x) (process-false x good bad name)]
+   ;; srcloc
+   [(srcloc? x) (process-srcloc x good bad name)]
+   ;; list
+   [(or (null? x) (pair? x)) (process-list x good bad name)]
+   ;; vector
+   [(vector? x) (process-vector x good bad name)]
+   ;; syntax
+   [(syntax? x) (process-syntax x good bad name)]
+   ;; other
+   [else
+    (bad
+     "~a: expected a source location (srcloc struct, syntax object, list, vector, or #f); got: ~e"
+     name
+     x)]))
+
+(define (process-false x good bad name)
+  (process-elements #f good bad name #f #f #f #f #f))
+
+(define (process-srcloc x good bad name)
+  (process-elements x good bad name
+                    (srcloc-source x)
+                    (srcloc-line x)
+                    (srcloc-column x)
+                    (srcloc-position x)
+                    (srcloc-span x)))
+
+(define (process-syntax x good bad name)
+  (process-elements x good bad name
+                    (syntax-source x)
+                    (syntax-line x)
+                    (syntax-column x)
+                    (syntax-position x)
+                    (syntax-span x)))
+
+(define (process-list x good bad name)
+  (cond
+   [(null? x)
+    (bad
+     "~a: expected a source location (a list of 5 elements); got an empty list: ~e"
+     name
+     x)]
+   [(list? x)
+    (let ([n (length x)])
+      (if (= n 5)
+        (apply process-elements x good bad name x)
+        (bad
+         "~a: expected a source location (a list of 5 elements); got a list of ~a elements: ~e"
+         name
+         n
+         x)))]
+   [(pair? x)
+    (bad
+     "~a: expected a source location (a list of 5 elements); got an improper list: ~e"
+     name
+     x)]
+   [else
+    (bad
+     "~a: expected a source location list; got: ~e"
+     name
+     x)]))
+
+(define (process-vector x good bad name)
+  (if (vector? x)
+    (let ([n (vector-length x)])
+      (if (= n 5)
+        (process-elements x good bad name
+                          (vector-ref x 0)
+                          (vector-ref x 1)
+                          (vector-ref x 2)
+                          (vector-ref x 3)
+                          (vector-ref x 4))
+        (bad
+         "~a: expected a source location (a vector of 5 elements); got a vector of ~a elements: ~e"
+         name
+         n
+         x)))
+    (bad
+     "~a: expected a source location vector; got: ~e"
+     name
+     x)))
+
+(define (process-elements x good bad name src line col pos span)
+  (cond
+   [(and line (not (exact-positive-integer? line)))
+    (bad
+     "~a: expected a source location with a positive line number or #f (second element); got line number ~e: ~e"
+     name
+     line
+     x)]
+   [(and col (not (exact-nonnegative-integer? col)))
+    (bad
+     "~a: expected a source location with a non-negative column number or #f (third element); got column number ~e: ~e"
+     name
+     col
+     x)]
+   [(or (and col (not line)) (and (not col) line))
+    (bad
+     "~a: expected a source location with line number and column number both numeric or both #f; got ~a and ~a respectively: ~e"
+     name
+     line
+     col
+     x)]
+   [(and pos (not (exact-positive-integer? pos)))
+    (bad
+     "~a: expected a source location with a positive position or #f (fourth element); got line number ~e: ~e"
+     name
+     pos
+     x)]
+   [(and span (not (exact-nonnegative-integer? span)))
+    (bad
+     "~a: expected a source location with a non-negative span or #f (fifth element); got column number ~e: ~e"
+     name
+     span
+     x)]
+   [else (good x src line col pos span)]))
+