1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
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)))))))))
|
