diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-07-22 17:21:23 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-07-22 17:23:32 +0200 |
commit | a66525db9c4c07c8cff6f927bd930f62f7d1ccdf (patch) | |
tree | 061a872003ce41cc8dce12cf52a3153f88e68a97 /module/c/cpp-environment.scm | |
parent | Add procedures for referencing specifier value. (diff) | |
download | calp-a66525db9c4c07c8cff6f927bd930f62f7d1ccdf.tar.gz calp-a66525db9c4c07c8cff6f927bd930f62f7d1ccdf.tar.xz |
Handle nested #if trees.
Diffstat (limited to 'module/c/cpp-environment.scm')
-rw-r--r-- | module/c/cpp-environment.scm | 100 |
1 files changed, 79 insertions, 21 deletions
diff --git a/module/c/cpp-environment.scm b/module/c/cpp-environment.scm index a6401e71..39e596d1 100644 --- a/module/c/cpp-environment.scm +++ b/module/c/cpp-environment.scm @@ -2,6 +2,7 @@ :use-module (srfi srfi-1) :use-module (srfi srfi-88) :use-module (ice-9 hash-table) + :use-module ((hnh util) :select (->>)) :use-module (hnh util object) :use-module (hnh util type) :use-module (hnh util lens) @@ -9,6 +10,7 @@ :use-module ((c cpp-environment object-like-macro) :prefix #{obj:}#) :use-module ((c cpp-environment internal-macro) :prefix #{int:}#) :use-module ((c unlex) :select (unlex)) + :use-module ((rnrs enums)) :export ( macro-identifier @@ -18,11 +20,12 @@ cpp-macro? ;; pprint-macro - enter-active-if - enter-inactive-if - flip-flop-if + enter-into-if + transition-to-if + if-status leave-if in-conditional/active? + in-conditional/inactive-inactive? in-conditional/inactive? in-conditional? @@ -90,9 +93,21 @@ + +(define-enumeration if-status + (active ; We are in the "executing" branch of an if + inactive ; We are in a non-"executing" branch, which may be followed by an "executing" branch + inactive-inactive ; We are in a branch which will never execute, and neither will its children or further siblings + outside) ; We aren't in an if-condition + if-status-set) + +(define (if-status? x) + (enum-set-member? x (enum-set-universe (if-status-set)))) + (define-type (cpp-environment) - (cpp-if-status type: (list-of (memv '(outside active-if inactive-if))) - default: '(outside)) + (cpp-if-status type: (and (list-of if-status?) + (not null?)) + default: (list (if-status outside))) ;; not exported since type signatures don't hold inside the hash table ;; TODO replace hash table with something that doesn't require copying the ;; entire structure every time @@ -104,27 +119,70 @@ -(define (enter-active-if environment) - (modify environment cpp-if-status xcons 'active-if)) - -(define (enter-inactive-if environment) - (modify environment cpp-if-status xcons 'inactive-if)) - -;; for #else -(define (flip-flop-if environment) - ((if (in-conditional/inactive? environment) - enter-active-if - enter-inactive-if) - (leave-if environment))) - +;; Morph the current if status into another +;; non-allowed transitions throws +(define (transition-to-if env next) + (define valid-next + (case (car (cpp-if-status env)) + ;; After an active if or elif no further elif's or else's can ever be active + ((active) (if-status-set inactive-inactive)) + ;; We can from an inactive if or elif move into an active elif or else + ((inactive) (if-status-set active inactive)) + ;; once nothing more can be active, nothing more can be active + ((inactive-inactive) (if-status-set inactive-inactive)) + ;; outside can never be moved away from + ((outside) (if-status-set)) + (else => (lambda (x) (scm-error 'misc-error "transition-to-if" + "Unknown enum: ~s" (list x) #f))))) + (unless (enum-set-member? next valid-next) + (scm-error 'misc-error "transition-to-if" + "Invalid transition, ~a → ~a (valid next: ~s)" + (list (car (cpp-if-status env)) + next + (enum-set->list valid-next)) + #f)) + (set env cpp-if-status car* next)) + +;; enter into a nested if statement +;; An exception is thrown if the resulting if-stack is invalid +(define (enter-into-if env next) + (define valid-next + (case (car (cpp-if-status env)) + ;; from an active if statement, both positive and negative if's are possible + ((active outside) (if-status-set active inactive)) + ;; from an inactive if clause nothing can ever be active + ((inactive inactive-inactive) (if-status-set inactive-inactive)) + (else => (lambda (x) (scm-error 'misc-error "enter-into-if" + "Unknown enum: ~s" (list x) #f))))) + + (unless (enum-set-member? next valid-next) + (scm-error 'misc-error "enter-into-if" + "Can't enter ~a from ~a (valid: ~s)" + (list next + (car (cpp-if-status env)) + (enum-set->list valid-next)) + #f)) + + (modify env cpp-if-status xcons next)) + +;; Leaves the current if statement (define (leave-if environment) + (when (eq? (if-status outside) (car (cpp-if-status environment))) + (scm-error 'misc-error "leave-if" + "Can't leave 'outside'" + '() #f)) (modify environment cpp-if-status cdr)) +(define (in-conditional/inactive-inactive? environment) + (eq? (if-status inactive-inactive) (get environment cpp-if-status car*))) + (define (in-conditional/inactive? environment) - (eq? 'inactive-if (get environment cpp-if-status car*))) + (enum-set-member? + (get environment cpp-if-status car*) + (if-status-set inactive inactive-inactive))) (define (in-conditional/active? environment) - (eq? 'active-if (get environment cpp-if-status car*))) + (eq? (if-status active) (get environment cpp-if-status car*))) (define (in-conditional? environment) (or (in-conditional/inactive? environment) @@ -191,7 +249,7 @@ (define* (pprint-environment environment optional: (port (current-error-port))) - (display "== Environment ==\n") + (display "== Environment ==\n" port) (hash-for-each (lambda (key macro) (pprint-macro macro port) (newline port)) |