aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2022-07-13 12:46:45 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2022-07-13 12:46:45 +0200
commitc1defcf83c0eedd2fc5cf70c43239336d5abf238 (patch)
treeae6678bec98c057f855a44ed16fc3b3e650f3ff9
parentResolve #ifdef, #ifndef, #else, #endif. (diff)
downloadcalp-c1defcf83c0eedd2fc5cf70c43239336d5abf238.tar.gz
calp-c1defcf83c0eedd2fc5cf70c43239336d5abf238.tar.xz
Clearen conditional status predicates.
-rw-r--r--module/c/cpp-environment.scm15
-rw-r--r--module/c/preprocessor2.scm14
2 files changed, 22 insertions, 7 deletions
diff --git a/module/c/cpp-environment.scm b/module/c/cpp-environment.scm
index 76219edc..a6401e71 100644
--- a/module/c/cpp-environment.scm
+++ b/module/c/cpp-environment.scm
@@ -22,7 +22,9 @@
enter-inactive-if
flip-flop-if
leave-if
- in-comment-block?
+ in-conditional/active?
+ in-conditional/inactive?
+ in-conditional?
enter-file
leave-file
@@ -110,7 +112,7 @@
;; for #else
(define (flip-flop-if environment)
- ((if (in-comment-block? environment)
+ ((if (in-conditional/inactive? environment)
enter-active-if
enter-inactive-if)
(leave-if environment)))
@@ -118,9 +120,16 @@
(define (leave-if environment)
(modify environment cpp-if-status cdr))
-(define (in-comment-block? environment)
+(define (in-conditional/inactive? environment)
(eq? 'inactive-if (get environment cpp-if-status car*)))
+(define (in-conditional/active? environment)
+ (eq? 'active-if (get environment cpp-if-status car*)))
+
+(define (in-conditional? environment)
+ (or (in-conditional/inactive? environment)
+ (in-conditional/active? environment)))
+
(define (enter-file environment filename)
diff --git a/module/c/preprocessor2.scm b/module/c/preprocessor2.scm
index 28d11901..6757521f 100644
--- a/module/c/preprocessor2.scm
+++ b/module/c/preprocessor2.scm
@@ -607,7 +607,7 @@
;; null directive
(loop environment remaining-tokens))
- ((in-comment-block? environment)
+ ((in-conditional/inactive? environment)
(case (string->symbol (identifier-token? (car line-tokens)))
((else) (loop (flip-flop-if environment) remaining-tokens))
((endif) (loop (leave-if environment) remaining-tokens))
@@ -642,8 +642,14 @@
enter-inactive-if enter-active-if)
env)))
;; NOTE possibly validate that body is empty for endif and else
- ((endif) (lambda (env _) (leave-if env)))
- ((else) (lambda (env _) (flip-flop-if env)))
+ ((endif) (lambda (env _)
+ (unless (in-conditional? env)
+ (err "#endif outside conditional"))
+ (leave-if env)))
+ ((else) (lambda (env _)
+ (unless (in-conditional? env)
+ (err "#else outside conditional"))
+ (flip-flop-if env)))
;; ((elif) (lambda ))
((define) resolve-define)
((undef) (lambda (env body) (remove-identifier env (identifier-token? (car body)))))
@@ -658,7 +664,7 @@
;; Line is not a pre-processing directive
(else (let ((preceding-tokens remaining-tokens (tokens-until-cpp-directive (cdr tokens))))
- (let* ((env* resolved-tokens (if (in-comment-block? environment)
+ (let* ((env* resolved-tokens (if (in-conditional/inactive? environment)
(values environment '())
(resolve-token-stream environment preceding-tokens))))
(on-snd (append resolved-tokens