fix set and trie, add compat COND-EXPAND for chez

1 files changed, 49 insertions, 0 deletions

diff --git a/chez-compat.scm b/chez-compat.scm
new file mode 100644
index 0000000..39cb31a
--- /dev/null
+++ b/chez-compat.scm
@@ -0,0 +1,49 @@
+;;; Copyright (C) Peter McGoron 2024
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, version 3 of the License.
+;;; 
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+;;; 
+;;; Simple COND-EXPAND using SYNTAX-RULES. Designed for chez.
+
+(define-syntax cond-expand-conditional
+  (syntax-rules (and or not chez r6rs)
+    ;; Defined keywords
+    ((cond-expand-conditional chez execute alt) execute)
+    ((cond-expand-conditional r6rs execute alt) execute)
+    ;; Conditional statements: AND
+    ((cond-expand-conditional (and e1 e2 ...) execute alt)
+     (cond-expand-conditional e1
+                              (cond-expand-conditional
+                               (and e2 ...)
+                               execute
+                               alt)
+                              alt))
+    ((cond-expand-conditional (and) execute alt) execute)
+    ;; OR
+    ((cond-expand-conditional (or e1 e2 ...) execute alt)
+     (cond-expand-conditional e1 execute
+                              (cond-expand-conditional
+                               (or e2 ...) execute alt)))
+    ((cond-expand-conditional (or) execute alt) alt)
+    ;; NOT
+    ((cond-expand-conditional (not e) execute alt)
+     (cond-expand-conditional e alt execute))
+    ;; All other conditions
+    ((cond-expand-conditional unknown execute alt) alt)))
+
+(define-syntax cond-expand
+  (syntax-rules (else)
+    ((cond-expand (else evaluated ...)) (begin evaluated ...))
+    ((cond-expand (conditional evaluated ...) rest ...)
+     (cond-expand-conditional conditional
+                              (begin evaluated ...)
+                              (cond-expand rest ...)))))
+