From 5915c42fe3cc6b909634bc3d722335650c98bf59 Mon Sep 17 00:00:00 2001
From: Dane Johnson <daneallenjohnson@protonmail.com>
Date: Mon, 8 Sep 2025 19:05:25 -0500
Subject: [PATCH] Atomic cps operations (ints lol)

---
 scmvm/assembler.scm    |  2 ++
 scmvm/language/cps.scm | 14 ++++++++++++++
 tests.scm              | 13 ++++++++++++-
 3 files changed, 28 insertions(+), 1 deletion(-)
 create mode 100644 scmvm/language/cps.scm

diff --git a/scmvm/assembler.scm b/scmvm/assembler.scm
index 20f08b9..6dc8af3 100644
--- a/scmvm/assembler.scm
+++ b/scmvm/assembler.scm
@@ -6,6 +6,8 @@
   #:use-module ((scheme base) #:select (write-bytevector))
   #:export ((make-assembler* . make-assembler)
 	    assembler?
+	    assembler-pos
+	    assembler-buf
 	    assembler-labels
 	    emit-label
 	    emit-instruction
diff --git a/scmvm/language/cps.scm b/scmvm/language/cps.scm
new file mode 100644
index 0000000..b15d413
--- /dev/null
+++ b/scmvm/language/cps.scm
@@ -0,0 +1,14 @@
+(define-module (scmvm language cps)
+  #:use-module (scmvm assembler)
+  #:use-module (ice-9 match)
+  #:export (compile-cps))
+
+(define (compile-atom asm atom)
+  (cond
+   [(number? atom) (emit-literal asm atom)]))
+
+(define (compile-cps asm soup)
+  (when (not (null? soup))
+    (match (car soup)
+      [(? (negate pair?) atom) (compile-atom asm atom)])
+    (compile-cps asm (cdr soup))))
diff --git a/tests.scm b/tests.scm
index 647a096..d615245 100644
--- a/tests.scm
+++ b/tests.scm
@@ -1,8 +1,9 @@
 (use-modules (d- test)
 	     (scmvm assembler)
-             (scmvm language assembly)
              (scmvm vm)
 	     (scmvm debugger)
+	     (scmvm language assembly)
+	     (scmvm language cps)
              (rnrs bytevectors)
              (rnrs io ports)
              ((scheme base)
@@ -166,3 +167,13 @@
     (debugger-continue my-debugger)
     (assert-equal 23 (vm-pc my-vm)) ;; continue stops stepping
     ))
+
+(define-test-suite "cps"
+  (define-test "atomics"
+    (define asm (make-assembler))
+    (compile-cps asm '(1))
+    (assert-equal 1 (bytevector-u32-native-ref (assembler-buf asm) 0)))
+  (define-test "atomics"
+    (define asm (make-assembler))
+    (compile-cps asm '(1))
+    (assert-equal 1 (bytevector-u32-native-ref (assembler-buf asm) 0))))