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))