blob: bcf457c125154e3d8fa766e94e45ebb4fe3ee4e8 (
plain)
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
|
#!/usr/bin/env sh
# -*- mode: scheme -*-
here=$(dirname $(realpath $0))
. $here/env
exec $GUILE -e main -s "$0" "$@"
!#
(use-modules ((c preprocessor2) :select (cpp make-default-environment))
((c cpp-environment) :select (pprint-environment))
((c lex2) :select (tokenize))
((c unlex) :select (unlex))
((hnh util values) :select (on-snd abort*))
(srfi srfi-71)
(srfi srfi-88))
(define-syntax fold/mv
(syntax-rules ()
((_ procedure producer lst)
(fold/mv-procedure procedure (lambda () producer) lst))))
(define (fold/mv-procedure procedure producer lst)
(if (null? lst)
(producer)
(call-with-values producer
(lambda returned
(fold/mv procedure
(apply procedure (car lst) returned)
(cdr lst))))))
(define (run-instructions instructions)
(fold/mv (lambda (expr env tokens)
(on-snd (append tokens (abort* (cpp expr env)))))
(values (make-default-environment) '())
instructions))
(define (main args)
(system "cpp -dM /dev/null > /tmp/cpp-default.h")
(let* ((env tokens
(run-instructions
(list "#include </tmp/cpp-default.h>"
"#define __restrict restrict"
(format #f "#include \"~a\"" (cadr args))))))
(pprint-environment env) (newline)
(display "/*** tokens ***/") (newline)
(display (unlex tokens)) (newline)))
|
