start work on the fundamental syntax object

7 files changed, 807 insertions, 0 deletions

diff --git a/COPYING b/COPYING
new file mode 100644
index 0000000..d645695
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,202 @@
+
+                                 Apache License
+                           Version 2.0, January 2004
+                        http://www.apache.org/licenses/
+
+   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
+
+   1. Definitions.
+
+      "License" shall mean the terms and conditions for use, reproduction,
+      and distribution as defined by Sections 1 through 9 of this document.
+
+      "Licensor" shall mean the copyright owner or entity authorized by
+      the copyright owner that is granting the License.
+
+      "Legal Entity" shall mean the union of the acting entity and all
+      other entities that control, are controlled by, or are under common
+      control with that entity. For the purposes of this definition,
+      "control" means (i) the power, direct or indirect, to cause the
+      direction or management of such entity, whether by contract or
+      otherwise, or (ii) ownership of fifty percent (50%) or more of the
+      outstanding shares, or (iii) beneficial ownership of such entity.
+
+      "You" (or "Your") shall mean an individual or Legal Entity
+      exercising permissions granted by this License.
+
+      "Source" form shall mean the preferred form for making modifications,
+      including but not limited to software source code, documentation
+      source, and configuration files.
+
+      "Object" form shall mean any form resulting from mechanical
+      transformation or translation of a Source form, including but
+      not limited to compiled object code, generated documentation,
+      and conversions to other media types.
+
+      "Work" shall mean the work of authorship, whether in Source or
+      Object form, made available under the License, as indicated by a
+      copyright notice that is included in or attached to the work
+      (an example is provided in the Appendix below).
+
+      "Derivative Works" shall mean any work, whether in Source or Object
+      form, that is based on (or derived from) the Work and for which the
+      editorial revisions, annotations, elaborations, or other modifications
+      represent, as a whole, an original work of authorship. For the purposes
+      of this License, Derivative Works shall not include works that remain
+      separable from, or merely link (or bind by name) to the interfaces of,
+      the Work and Derivative Works thereof.
+
+      "Contribution" shall mean any work of authorship, including
+      the original version of the Work and any modifications or additions
+      to that Work or Derivative Works thereof, that is intentionally
+      submitted to Licensor for inclusion in the Work by the copyright owner
+      or by an individual or Legal Entity authorized to submit on behalf of
+      the copyright owner. For the purposes of this definition, "submitted"
+      means any form of electronic, verbal, or written communication sent
+      to the Licensor or its representatives, including but not limited to
+      communication on electronic mailing lists, source code control systems,
+      and issue tracking systems that are managed by, or on behalf of, the
+      Licensor for the purpose of discussing and improving the Work, but
+      excluding communication that is conspicuously marked or otherwise
+      designated in writing by the copyright owner as "Not a Contribution."
+
+      "Contributor" shall mean Licensor and any individual or Legal Entity
+      on behalf of whom a Contribution has been received by Licensor and
+      subsequently incorporated within the Work.
+
+   2. Grant of Copyright License. Subject to the terms and conditions of
+      this License, each Contributor hereby grants to You a perpetual,
+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+      copyright license to reproduce, prepare Derivative Works of,
+      publicly display, publicly perform, sublicense, and distribute the
+      Work and such Derivative Works in Source or Object form.
+
+   3. Grant of Patent License. Subject to the terms and conditions of
+      this License, each Contributor hereby grants to You a perpetual,
+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+      (except as stated in this section) patent license to make, have made,
+      use, offer to sell, sell, import, and otherwise transfer the Work,
+      where such license applies only to those patent claims licensable
+      by such Contributor that are necessarily infringed by their
+      Contribution(s) alone or by combination of their Contribution(s)
+      with the Work to which such Contribution(s) was submitted. If You
+      institute patent litigation against any entity (including a
+      cross-claim or counterclaim in a lawsuit) alleging that the Work
+      or a Contribution incorporated within the Work constitutes direct
+      or contributory patent infringement, then any patent licenses
+      granted to You under this License for that Work shall terminate
+      as of the date such litigation is filed.
+
+   4. Redistribution. You may reproduce and distribute copies of the
+      Work or Derivative Works thereof in any medium, with or without
+      modifications, and in Source or Object form, provided that You
+      meet the following conditions:
+
+      (a) You must give any other recipients of the Work or
+          Derivative Works a copy of this License; and
+
+      (b) You must cause any modified files to carry prominent notices
+          stating that You changed the files; and
+
+      (c) You must retain, in the Source form of any Derivative Works
+          that You distribute, all copyright, patent, trademark, and
+          attribution notices from the Source form of the Work,
+          excluding those notices that do not pertain to any part of
+          the Derivative Works; and
+
+      (d) If the Work includes a "NOTICE" text file as part of its
+          distribution, then any Derivative Works that You distribute must
+          include a readable copy of the attribution notices contained
+          within such NOTICE file, excluding those notices that do not
+          pertain to any part of the Derivative Works, in at least one
+          of the following places: within a NOTICE text file distributed
+          as part of the Derivative Works; within the Source form or
+          documentation, if provided along with the Derivative Works; or,
+          within a display generated by the Derivative Works, if and
+          wherever such third-party notices normally appear. The contents
+          of the NOTICE file are for informational purposes only and
+          do not modify the License. You may add Your own attribution
+          notices within Derivative Works that You distribute, alongside
+          or as an addendum to the NOTICE text from the Work, provided
+          that such additional attribution notices cannot be construed
+          as modifying the License.
+
+      You may add Your own copyright statement to Your modifications and
+      may provide additional or different license terms and conditions
+      for use, reproduction, or distribution of Your modifications, or
+      for any such Derivative Works as a whole, provided Your use,
+      reproduction, and distribution of the Work otherwise complies with
+      the conditions stated in this License.
+
+   5. Submission of Contributions. Unless You explicitly state otherwise,
+      any Contribution intentionally submitted for inclusion in the Work
+      by You to the Licensor shall be under the terms and conditions of
+      this License, without any additional terms or conditions.
+      Notwithstanding the above, nothing herein shall supersede or modify
+      the terms of any separate license agreement you may have executed
+      with Licensor regarding such Contributions.
+
+   6. Trademarks. This License does not grant permission to use the trade
+      names, trademarks, service marks, or product names of the Licensor,
+      except as required for reasonable and customary use in describing the
+      origin of the Work and reproducing the content of the NOTICE file.
+
+   7. Disclaimer of Warranty. Unless required by applicable law or
+      agreed to in writing, Licensor provides the Work (and each
+      Contributor provides its Contributions) on an "AS IS" BASIS,
+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+      implied, including, without limitation, any warranties or conditions
+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
+      PARTICULAR PURPOSE. You are solely responsible for determining the
+      appropriateness of using or redistributing the Work and assume any
+      risks associated with Your exercise of permissions under this License.
+
+   8. Limitation of Liability. In no event and under no legal theory,
+      whether in tort (including negligence), contract, or otherwise,
+      unless required by applicable law (such as deliberate and grossly
+      negligent acts) or agreed to in writing, shall any Contributor be
+      liable to You for damages, including any direct, indirect, special,
+      incidental, or consequential damages of any character arising as a
+      result of this License or out of the use or inability to use the
+      Work (including but not limited to damages for loss of goodwill,
+      work stoppage, computer failure or malfunction, or any and all
+      other commercial damages or losses), even if such Contributor
+      has been advised of the possibility of such damages.
+
+   9. Accepting Warranty or Additional Liability. While redistributing
+      the Work or Derivative Works thereof, You may choose to offer,
+      and charge a fee for, acceptance of support, warranty, indemnity,
+      or other liability obligations and/or rights consistent with this
+      License. However, in accepting such obligations, You may act only
+      on Your own behalf and on Your sole responsibility, not on behalf
+      of any other Contributor, and only if You agree to indemnify,
+      defend, and hold each Contributor harmless for any liability
+      incurred by, or claims asserted against, such Contributor by reason
+      of your accepting any such warranty or additional liability.
+
+   END OF TERMS AND CONDITIONS
+
+   APPENDIX: How to apply the Apache License to your work.
+
+      To apply the Apache License to your work, attach the following
+      boilerplate notice, with the fields enclosed by brackets "[]"
+      replaced with your own identifying information. (Don't include
+      the brackets!)  The text should be enclosed in the appropriate
+      comment syntax for the file format. We also recommend that a
+      file or class name and description of purpose be included on the
+      same "printed page" as the copyright notice for easier
+      identification within third-party archives.
+
+   Copyright [yyyy] [name of copyright owner]
+
+   Licensed under the Apache License, Version 2.0 (the "License");
+   you may not use this file except in compliance with the License.
+   You may obtain a copy of the License at
+
+       http://www.apache.org/licenses/LICENSE-2.0
+
+   Unless required by applicable law or agreed to in writing, software
+   distributed under the License is distributed on an "AS IS" BASIS,
+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+   See the License for the specific language governing permissions and
+   limitations under the License.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..b69328b
--- /dev/null
+++ b/README.md
@@ -0,0 +1,5 @@
+# Multisyntax
+
+An implementation of `syntax-rules` using marks and substitutions
+as in `syntax-case`. This library can be thought of as "first-order
+`syntax-case`".
diff --git a/multisyntax/syntax-object.scm b/multisyntax/syntax-object.scm
new file mode 100644
index 0000000..9eae3b9
--- /dev/null
+++ b/multisyntax/syntax-object.scm
@@ -0,0 +1,390 @@
+#| Copyright (c) Peter McGoron 2025
+ |
+ | Licensed under the Apache License, Version 2.0 (the "License");
+ | you may not use this file except in compliance with the License.
+ | You may obtain a copy of the License at
+ |
+ |     http://www.apache.org/licenses/LICENSE-2.0
+ |
+ | Unless required by applicable law or agreed to in writing, software
+ | distributed under the License is distributed on an "AS IS" BASIS,
+ | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ | See the License for the specific language governing permissions and
+ | limitations under the License.
+ |------------------------------------------------------------------------
+ | Hygenic syntax transformer based on Dybvig, Hieb, and Bruggeman 1992.
+ |#
+
+;;; ;;;;;;;;;;
+;;; Timestamps
+;;; ;;;;;;;;;;
+
+(define generate-unique-integer
+  ;; Generate a unique positive integer.
+  (let ((x 1))
+    (lambda ()
+      (set! x (+ x 1))
+      x)))
+
+(define generate-timestamp
+  ;; A timestamp is an integer.
+  generate-unique-integer)
+
+(define timestamp-comparator
+  (make-comparator exact-integer? = < number-hash))
+
+;;; ;;;;;;;;;;;;;;;
+;;; Locations and substitutions
+
+(define-record-type <lexical-location>
+  (raw-lexical-location symbol value)
+  lexical-location?
+  (symbol lexical-location->symbol)
+  (value lexical-location->unique-id))
+
+(define lexical-location-comparator
+  (make-comparator
+   lexical-location?
+   (lambda (x y)
+     (= (lexical-location->unique-id x)
+        (lexical-location->unique-id y)))
+   (lambda (x y)
+     (< (lexical-location->unique-id x)
+        (lexical-location->unique-id y)))
+   (lambda (x) (number-hash (lexical-location->unique-id x)))))
+
+(define (generate-lexical-location symbol)
+  (raw-lexical-location symbol (generate-unique-integer)))
+
+(define (lexical-location->string ll)
+  (string-append (symbol->string (lexical-location->symbol ll))
+                 "."
+                 (number->string (lexical-location->unique-id ll))))
+
+(define symbol-comparator
+  (make-comparator
+   symbol?
+   symbol=?
+   (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
+   symbol-hash))
+
+(define environment-key-comparator
+  ;; Comparator for keys to the environment that stores substitutions.
+  ;; 
+  ;; Keys are either regular Scheme symbols or unique lexical locations.
+  (make-sum-comparator lexical-location-comparator
+                       symbol-comparator))
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Syntax objects
+;;; 
+;;; Some properties of the DHB expander, and how they relate to the
+;;; `<wrap>` object:
+;;; 
+;;; 1. Marks and substitutions are constructors of the identifier set.
+;;;    This means that marks made after a substitution do not affect the
+;;;    substitution. In the absence of mutation, a substitution will
+;;;    always fail if the marks of the object that it wraps do not match
+;;;    the marks of the identifier it matches against.
+;;; 2. The `resolve` function will do intermediate substitutions. This is
+;;;    the reason that the `<wrap>` object contains an
+;;;    `inverse-environment` object. If a substitution maps an identifier
+;;;    produced by a substitution into another identifier, then that
+;;;    mapping is replaced.
+;;; 
+;;; This implementation uses flat sets and flat maps, as opposed to a
+;;; direct implementation of the algorithm, which would make both into a
+;;; list.
+;;; 
+;;; The advantage of flat sets and flat maps is the asymtopic complexity
+;;; of various set/map implementations (HAMT, AVL tree, etc.) However,
+;;; the implementation must preserve the invariant that no wrapped syntax
+;;; object contains another wrapped syntax object. This means that the
+;;; *introduced* portion of a macro transformer must be scanned twice:
+;;; once to add the timestamp of the end of the macro step, and once again
+;;; to do the actual macro expansion. This still results in linear
+;;; time complexity, but with a larger constant.
+;;; 
+;;; The direct-implementation has the property that no eager wrap
+;;; propagation must be done. However, it requires linear behavior for the
+;;; set of marks and substitutions. This would make the expander very slow
+;;; if it used to implement a module system (although Scheme gets away
+;;; with having such a small amount of things to import in the first
+;;; place).
+
+(define-record-type <wrap>
+  ;; A `<wrap>` contains
+  ;; 
+  ;; * `expr`, which is Scheme data,
+  ;; * `timestamps`, a set of timestamps
+  ;; * `environment`, a map from locations/symbols to locations,
+  ;; * `inverse-environment`, a map from locations to a list of
+  ;;   locations/symbols
+  (raw-wrap expr timestamps environment inverse-environment)
+  wrap?
+  (expr wrap->expr)
+  (timestamps wrap->timestamps)
+  (environment wrap->environment)
+  (inverse-environment wrap->inverse-environment))
+
+(define empty-wrap
+  ;; Wrap `expr` with an empty timestamp set and environment.
+  (let ((empty-timestamp-set (set timestamp-comparator))
+        (empty-mapping (mapping environment-key-comparator)))
+    (lambda (expr)
+      (raw-wrap expr
+                empty-timestamp-set
+                empty-mapping
+                empty-mapping))))
+
+(define (self-syntax? obj)
+  ;; A self-syntax object cannot contain an identifier.
+  (or (null? obj)
+      (char? obj)
+      (string? obj)
+      (bytevector? obj)
+      (boolean? obj)
+      (number? obj)))
+
+(define (syntax? obj)
+  (or (wrap? obj)
+      (and (pair? obj)
+           (syntax? (car obj))
+           (syntax? (cdr obj)))
+      (and (vector? obj)
+           (vector-every syntax? obj))
+      (self-syntax? obj)))
+
+(define (identifier? obj)
+  ;; An identifier is a wrapped symbol.
+  (and (wrap? obj) (symbol? (wrap->expr obj))))
+
+(define (add-timestamp stx ts)
+  ;; Adds a timestamp to the syntax object `stx`. If the timestamp is
+  ;; already in the wrap, the timestamp is removed instead.
+  (cond
+    ((pair? stx) (cons (add-timestamp (car stx) ts)
+                       (add-timestamp (cdr stx) ts)))
+    ((vector? stx) (vector-map (cut add-timestamp <> ts) stx))
+    ((self-syntax? stx) stx)
+    ((wrap? stx)
+     (let* ((timestamps (wrap->timestamps stx))
+            (timestamps (if (set-contains? timestamps ts)
+                            (set-delete timestamps ts)
+                            (set-adjoin timestamps ts))))
+       (raw-wrap (wrap->expr stx)
+                 timestamps
+                 (wrap->environment stx)
+                 (wrap->inverse-environment stx))))))
+
+(define (resolve id)
+  ;; Get the location that `id` ultimately resolves to.
+  (let ((sym (wrap->expr id))
+        (environment (wrap->environment id)))
+    (mapping-ref/default environment sym sym)))
+
+(define (add-timestamps/same-wrap stx id location-to)
+  ;; TODO: Make more functional?
+  (let ((location-from (resolve id))
+        (env (wrap->environment stx))
+        (invenv (wrap->inverse-environment stx)))
+    ;; If there are mappings in the environment to `location-from`,
+    ;; then those must be updated to `location-to`. The inverse
+    ;; environment stores these mappings.
+    ;; 
+    ;; The inverse environment has no need to store the
+    ;; intermediate substitutions after this. The new mapping
+    ;; inherits the old intermediate substitution's mappings.
+    (cond
+      ((mapping-ref/default invenv location-from '())
+       => (lambda (lst)
+            (for-each (lambda (maps-to-location-from)
+                        (display "a\n")
+                        (set! env (mapping-set
+                                   env
+                                   maps-to-location-from
+                                   location-to)))
+                      lst)
+            (set! invenv (mapping-delete invenv location-from))
+            (set! invenv (mapping-set invenv location-to lst)))))
+    (raw-wrap (wrap->expr stx)
+              (wrap->timestamps stx)
+              (mapping-set env location-from location-to)
+              (mapping-update/default invenv
+                                      location-to
+                                      (cut cons location-from <>)
+                                      '()))))
+
+(define (add-substitution stx id location-to)
+  ;; Add to the lexical environment of `stx` a mapping from the location
+  ;; that `id` resolves to to the location `location-to`.
+  ;; 
+  ;; If the identifier does not satisfy the marks of the expression, then
+  ;; it is never added.
+  ;; 
+  ;; Otherwise update `environment` and `inverse-environment` with the
+  ;; new locations.
+  (cond
+    ((pair? stx) (cons (add-substitution (car stx)
+                                         id
+                                         location-to)
+                       (add-substitution (cdr stx)
+                                         id
+                                         location-to)))
+    ((vector? stx) (vector-map (cut add-substitution <> id location-to)
+                               stx))
+    ((self-syntax? stx) stx)
+    (else
+     (let ((timestamps (wrap->timestamps stx)))
+       (if (not (set=? timestamps (wrap->timestamps id)))
+           stx
+           (add-timestamps/same-wrap stx id location-to))))))
+
+(define (generate-unique-symbol)
+  ;; An actual implementation of this procedure would require implementation
+  ;; support.
+  (string->symbol
+   (string-append "gensym."
+                  (number->string
+                   (generate-unique-integer)))))
+
+(define (identifier-lexically-bound? id)
+  ;; Returns true if `id` was bound by some lexical construct. Returns
+  ;; false for globally bound identifiers.
+  (lexical-location? (resolve id)))
+
+(define generate-identifier
+  ;; Generate an identifier that is never `bound-identifier=?` to any
+  ;; previous identifier.
+  (case-lambda
+    (() (generate-identifier (generate-unique-symbol)))
+    ((symbol) (raw-wrap symbol
+                        (set timestamp-comparator (generate-unique-integer))
+                        (mapping environment-key-comparator)
+                        (mapping environment-key-comparator)))))
+
+(define (generate-temporaries lst)
+  ;; Generate a list of identifiers from `generate-identifier`.
+  (map generate-identifier lst))
+
+(define (symbolic-identifier=? id1 id2)
+  ;; Returns true if the underlying symbol of each identifier is the same.
+  (symbol=? (syntax->datum id1) (syntax->datum id2)))
+
+(define (free-identifier=? id1 id2)
+  ;; Returns true if, when inserted into output as free identifiers, `id1`
+  ;; and `id2` would refer to the same location.
+  (=? environment-key-comparator (resolve id1) (resolve id2)))
+
+(define (bound-identifier=? id1 id2)
+  ;; Returns true if binding one identifier would cause the other
+  ;; identifier to be bound.
+  (and (free-identifier=? id1 id2)
+       (set=? (wrap->timestamps id1) (wrap->timestamps id2))))
+
+(define bound-identifier-comparator
+  (make-comparator
+   identifier?
+   bound-identifier=?
+   (lambda (id-1 id-2)
+     (if (<? environment-key-comparator (resolve id-1) (resolve id-2))
+         #t
+         (<? set-comparator
+             (wrap->timestamps id-1)
+             (wrap->timestamps id-2))))
+   (lambda (id)
+     (+ (comparator-hash set-comparator (wrap->timestamps id))
+        (comparator-hash environment-key-comparator (resolve id))))))
+
+(define (push-wrap stx expr)
+  ;; Give `expr` the wrap of `stx`. This does not check that `stx` does
+  ;; not contain wrapped syntax objects.
+  (raw-wrap expr
+            (wrap->timestamps stx)
+            (wrap->environment stx)
+            (wrap->inverse-environment stx)))
+
+(define (unwrap-syntax stx)
+  ;; If `stx` is a wrapped pair or vector, return a pair/vector of syntax
+  ;; objects with the same wrap. Otherwise return the syntax object unchanged.
+  (if (wrap? stx)
+      (let ((expr (wrap->expr stx)))
+        (cond
+          ((pair? expr) (cons (push-wrap stx (car expr))
+                              (push-wrap stx (cdr expr))))
+          ((vector? expr) (vector-map (cut push-wrap stx <>) expr))
+          (else stx)))
+      stx))
+
+(define (syntax->datum stx)
+  ;; Remove wraps from the syntax object.
+  (cond
+    ((pair? stx) (cons (syntax->datum (car stx))
+                       (syntax->datum (cdr stx))))
+    ((vector? stx) (vector-map syntax->datum stx))
+    ((wrap? stx) (wrap->expr stx))
+    (else stx)))
+
+(define (if-contains-wrap operate obj)
+  ;; If `obj` does not contain a wrapped syntax object, return `#f`.
+  ;; 
+  ;; Otherwise, return a wrapped syntax object. This is an object that
+  ;; 
+  ;; 1. All wrapped syntax objects have `operate` called on them, and
+  ;; 2. The maximal subsections of `obj` that do not contain wrapped syntax
+  ;;    objects have `operate` called on them.
+  ;; 
+  ;; `operate` is either passed a wrap or an object which does not have
+  ;; wrapped syntax objects inside of it.
+  ;; 
+  ;; A maximal subsection is a part of `obj` that is contained in another
+  ;; object which has a wrapped syntax object inside of it.
+  ;; 
+  ;; This procedure is used to deal with unwrapped syntax objects without
+  ;; violating the invariant that no wrapped syntax object can contain
+  ;; another wrapped syntax object.
+  (cond
+    ((or (self-syntax? obj) (symbol? obj)) #f)
+    ((wrap? obj) (operate (wrap->expr obj)))
+    ((pair? obj)
+     (let ((first (if-contains-wrap operate obj))
+           (second (if-contains-wrap operate obj)))
+       (cond
+         ((and (not first) (not second)) #f)
+         ((not first) (cons (operate first) second))
+         ((not second) (cons first (operate second)))
+         (else (error "internal error" obj)))))
+    ((vector? obj)
+     (letrec ((loop
+               (lambda (i)
+                 (if (= i (vector-length obj))
+                     #f
+                     (let ((value (if-contains-wrap operate
+                                                    (vector-ref obj i))))
+                       (if (not value)
+                           (loop (+ i 1))
+                           (create-new-vector))))))
+              (create-new-vector
+               (lambda ()
+                 (let ((returned-vector (make-vector (vector-length obj))))
+                   (do ((i 0 (+ i 1)))
+                       ((= (vector-length returned-vector) i)
+                        returned-vector)
+                     (let* ((datum (vector-ref obj i))
+                            (value (if-contains-wrap operate datum)))
+                       (if (not value)
+                           (vector-set! returned-vector (operate datum))
+                           (vector-set! returned-vector value))))))))
+       (loop 0)))
+    (else (error "invalid nested obj" obj))))
+
+(define (datum->syntax context-id datum)
+  ;; Create `datum` as a syntax object with the same wrap as `context-id`.
+  (define (operate obj)
+    (if (wrap? obj)
+        (push-wrap context-id (wrap->expr obj))
+        (push-wrap context-id obj)))
+  (cond
+    ((self-syntax? datum) datum)
+    ((if-contains-wrap operate datum) => values)
+    (else (push-wrap context-id datum))))
diff --git a/multisyntax/syntax-object.sld b/multisyntax/syntax-object.sld
new file mode 100644
index 0000000..ab0ad15
--- /dev/null
+++ b/multisyntax/syntax-object.sld
@@ -0,0 +1,37 @@
+#| Copyright (c) Peter McGoron 2025
+ |
+ | Licensed under the Apache License, Version 2.0 (the "License");
+ | you may not use this file except in compliance with the License.
+ | You may obtain a copy of the License at
+ |
+ |     http://www.apache.org/licenses/LICENSE-2.0
+ |
+ | Unless required by applicable law or agreed to in writing, software
+ | distributed under the License is distributed on an "AS IS" BASIS,
+ | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ | See the License for the specific language governing permissions and
+ | limitations under the License.
+ |------------------------------------------------------------------------
+ | Hygenic syntax transformer based on Dybvig, Hieb, and Bruggeman 1992.
+ |#
+
+(define-library (multisyntax syntax-object)
+  (import (scheme base) (scheme case-lambda)
+          (scheme write)
+          (srfi 26) (srfi 113) (srfi 128) (srfi 133) (srfi 146) (srfi 228))
+  (export generate-lexical-location
+          lexical-location->string
+          lexical-location-comparator
+          environment-key-comparator
+          ;; Misc. predicates
+          self-syntax? syntax?
+          ;; Operations on wraps
+          generate-timestamp empty-wrap add-timestamp add-substitution
+          wrap->timestamps resolve
+          ;; Standard operations
+          symbolic-identifier=? free-identifier=? bound-identifier=?
+          identifier?
+          generate-identifier generate-temporaries
+          unwrap-syntax syntax->datum
+          if-contains-wrap datum->syntax)
+  (include "syntax-object.scm"))
diff --git a/test/run.scm b/test/run.scm
new file mode 100644
index 0000000..66a719a
--- /dev/null
+++ b/test/run.scm
@@ -0,0 +1,16 @@
+(import r7rs)
+
+(cond-expand
+  (chicken (import (prefix (mcgoron srfi 64)
+                           mcgoron-)
+                   (srfi 64))
+           (test-runner-factory mcgoron-factory)
+           (test-runner-current (mcgoron-factory))))
+
+(load "../multisyntax/syntax-object.sld")
+(load "syntax-object.sld")
+
+(import (rename (multisyntax syntax-object test)
+                (test test-syntax-object)))
+
+(test-syntax-object)
diff --git a/test/syntax-object.scm b/test/syntax-object.scm
new file mode 100644
index 0000000..fcd8215
--- /dev/null
+++ b/test/syntax-object.scm
@@ -0,0 +1,132 @@
+#| Copyright (c) Peter McGoron 2025
+ |
+ | Licensed under the Apache License, Version 2.0 (the "License");
+ | you may not use this file except in compliance with the License.
+ | You may obtain a copy of the License at
+ |
+ |     http://www.apache.org/licenses/LICENSE-2.0
+ |
+ | Unless required by applicable law or agreed to in writing, software
+ | distributed under the License is distributed on an "AS IS" BASIS,
+ | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ | See the License for the specific language governing permissions and
+ | limitations under the License.
+ |#
+
+(define examples-of-self-syntax
+  (list '() 1 #\a #f "a" #u8(1 2 3 4)))
+
+(define (test)
+  (test-group "locations"
+    (test-assert (comparator-test-type environment-key-comparator
+                                       (generate-lexical-location 'test)))
+    (test-assert (comparator-test-type environment-key-comparator
+                                       'test)))
+  (test-group "self-syntax?"
+    (for-each (lambda (x)
+                (test-assert "example of self-syntax" (self-syntax? x)))
+              examples-of-self-syntax)
+    (test-assert "symbol is not self-syntax" (not (self-syntax? 'x)))
+    (test-assert "cons is not self-syntax" (not (self-syntax? (cons 1 2))))
+    (test-assert "vector is not self-syntax" (not (self-syntax? #(1 2)))))
+  (test-group "syntax?"
+    (for-each (lambda (x)
+                (test-assert "self-syntax is syntax" (syntax? x)))
+              examples-of-self-syntax)
+    (for-each (lambda (x)
+                (test-assert "wrap of self-syntax is syntax" (syntax? (empty-wrap x))))
+              examples-of-self-syntax)
+    (test-assert "list of self-syntax is syntax"
+                 (syntax? examples-of-self-syntax))
+    (test-assert "vector of self-syntax is syntax"
+                 (syntax? (list->vector examples-of-self-syntax)))
+    (test-assert "wrap of symbol is syntax"
+                 (syntax? (empty-wrap 'x))))
+  (test-group "identifier?"
+    (for-each (lambda (x)
+                (test-assert "self-syntax is not identifier"
+                             (not (identifier? x))))
+              examples-of-self-syntax)
+    (test-assert "wrap of symbol is identifier"
+                 (identifier? (empty-wrap 'x)))
+    (test-assert "wrap of list is not identifier"
+                 (not (identifier? (empty-wrap (list 'x))))))
+  (test-group "add-timestamp"
+    (test-assert "timestamps are unique"
+                 (not (equal? (generate-timestamp) (generate-timestamp))))
+    (let ((ts (generate-timestamp))
+          (id (empty-wrap 'test)))
+      (test-assert "empty wrap has no timestamps"
+                   (set-empty? (wrap->timestamps id)))
+      (set! id (add-timestamp id ts))
+      (test-equal "adding a timestamp adds that timestamp"
+                  (list ts)
+                  (set->list (wrap->timestamps id)))
+      (set! id (add-timestamp id ts))
+      (test-assert "adding the same timestamp removes the timestamp"
+                   (set-empty? (wrap->timestamps id)))
+      (let ((new-ts (generate-timestamp)))
+        (set! id (add-timestamp id ts))
+        (set! id (add-timestamp id new-ts))
+        (test-assert "adding one timestamp makes the wrap contain that timestamp"
+                     (set-contains? (wrap->timestamps id) ts))
+        (test-assert "adding another timestamp makes the wrap contain that timestamp"
+                     (set-contains? (wrap->timestamps id) new-ts))
+        (test-equal "only two timestamps were added"
+                    (set-size (wrap->timestamps id))
+                    2)
+        (set! id (add-timestamp id new-ts))
+        (test-equal "adding one timestamp removes one and keeps the other"
+                    (list ts)
+                    (set->list (wrap->timestamps id))))))
+  (test-group "resolve a symbol"
+    (test-eq (resolve (empty-wrap 'test)) 'test))
+  (test-group "add-substitution"
+    (test-group "no timestamps"
+      (let* ((newloc (generate-lexical-location 'test))
+             (stx (add-substitution (empty-wrap 'test)
+                                    (empty-wrap 'test)
+                                    newloc)))
+        (test-assert (=? lexical-location-comparator
+                         newloc
+                         (resolve stx)))))
+    (test-group "mismatched timestamps"
+      (let* ((newloc (generate-lexical-location 'test))
+             (stx (add-substitution (add-timestamp (empty-wrap 'test)
+                                                   (generate-timestamp))
+                                    (empty-wrap 'test)
+                                    newloc)))
+        (test-assert (=? environment-key-comparator
+                         'test
+                         (resolve stx)))))
+    (test-group "mismatched resolved name"
+      (let* ((newloc (generate-lexical-location 'test))
+             (stx (add-substitution (empty-wrap 'test)
+                                    (empty-wrap 'test2)
+                                    newloc)))
+        (test-assert (=? environment-key-comparator
+                         'test
+                         (resolve stx)))))
+    (test-group "multiple names in environment"
+      (let* ((loc1 (generate-lexical-location 'test1))
+             (loc2 (generate-lexical-location 'test2))
+             (stx (add-substitution (empty-wrap 'test)
+                                    (empty-wrap 'test)
+                                    loc1))
+             (stx (add-substitution stx
+                                    (empty-wrap 'test2)
+                                    loc2)))
+        (test-assert (=? environment-key-comparator
+                         (resolve stx)
+                         loc1))))
+    (test-group "intermediate substitutions"
+      (let* ((loc1 (generate-lexical-location 'test1))
+             (loc2 (generate-lexical-location 'test2))
+             (stx (add-substitution (empty-wrap 'test)
+                                    (empty-wrap 'test)
+                                    loc1))
+             (stx (add-substitution stx stx loc2)))
+        (test-assert (=? environment-key-comparator
+                         (resolve stx)
+                         loc2))))))
+
diff --git a/test/syntax-object.sld b/test/syntax-object.sld
new file mode 100644
index 0000000..8b09ead
--- /dev/null
+++ b/test/syntax-object.sld
@@ -0,0 +1,25 @@
+#| Copyright (c) Peter McGoron 2025
+ |
+ | Licensed under the Apache License, Version 2.0 (the "License");
+ | you may not use this file except in compliance with the License.
+ | You may obtain a copy of the License at
+ |
+ |     http://www.apache.org/licenses/LICENSE-2.0
+ |
+ | Unless required by applicable law or agreed to in writing, software
+ | distributed under the License is distributed on an "AS IS" BASIS,
+ | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ | See the License for the specific language governing permissions and
+ | limitations under the License.
+ |#
+
+(define-library (multisyntax syntax-object test)
+  (import (scheme base)
+          (multisyntax syntax-object)
+          (srfi 113) (srfi 128) (srfi 146))
+  (cond-expand
+    (chicken (import (srfi 64)
+                     (chicken condition)))
+    (else))
+  (export test)
+  (include "syntax-object.scm"))