diff options
Diffstat (limited to '')
-rw-r--r-- | module/c/eval-basic.scm | 63 |
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))))))))) |