1 files changed, 63 insertions, 0 deletions
diff --git a/module/c/eval-basic.scm b/module/c/eval-basic.scm
new file mode 100644
index 00000000..9a16a095
--- /dev/null
+++ b/module/c/eval-basic.scm
@@ -0,0 +1,63 @@
+(define-module (c eval-basic)
+  :use-module (ice-9 match)
+  :use-module (c eval2)
+  :export (eval-basic-c))
+
+(define operators
+  `((bitwise-ior . ,(@ (srfi srfi-60) bitwise-ior))
+    (bitwise-xor . ,(@ (srfi srfi-60) bitwise-xor))
+    (bitwise-and . ,(@ (srfi srfi-60) bitwise-and))
+    (bitwise-not . ,(@ (srfi srfi-60) bitwise-not))
+    (== . ,(compose boolean->c-boolean =))
+    (!= . ,(compose boolean->c-boolean not =))
+    (<=  . ,(compose boolean->c-boolean <=))
+    (>=  . ,(compose boolean->c-boolean <=))
+    (<  . ,(compose boolean->c-boolean <))
+    (>  . ,(compose boolean->c-boolean >))
+    (not . ,c-not)
+    (<< . ,(lambda (n c) (ash n c)))
+    (>> . ,(lambda (n c) (ash (- n) c)))
+    (+ . ,+)
+    (- . ,-)
+    (* . ,*)
+    (/ . ,floor-quotient)
+    (% . ,floor-remainder)
+    (unary+ . ,+)
+    (unary- . ,-)))
+
+(define (eval-basic-c ast)
+  (define (err fmt . args)
+    (scm-error 'cpp-error "eval-basic-c"
+               fmt args #f))
+  (match ast
+    (`((constexpr ,body))
+     (let loop ((ast body))
+       (match ast
+         (('begin forms ...)
+          (err "begin should be impossible here: ~s" forms))
+         (('constant value)
+          (if (exact-integer? value)
+              value
+              (err "Only exact integers supported, got: ~s" value)))
+         (('string-literal value)
+          (err "String literals not supported: ~s" value))
+         (('ternary expr true false)
+          (if (c-boolean->boolean (loop expr))
+              (loop true)
+              (loop false)))
+         (('and a b)
+          (let ((a* (loop a)))
+              (if (c-boolean->boolean a*)
+                  (loop b)
+                  a*)))
+         (('or a b)
+          (let ((a* (loop a)))
+            (if (c-boolean->boolean a*)
+                a*
+                (loop b))))
+         ((f args ...)
+          (cond ((assoc-ref operators f)
+                 => (lambda (op)
+                      (apply op (map loop args))))
+                (else
+                 (err "Unknown operator ~s" f)))))))))