From eeccf193ff6313abedede827f3096b84428762eb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Mon, 11 Jul 2022 22:47:58 +0200
Subject: Remove linear update environment procedures.

---
 module/c/cpp-environment.scm       | 43 +++++++++++++++++++-------------------
 module/c/preprocessor2.scm         |  4 ++--
 tests/test/cpp/cpp-environment.scm |  6 ++----
 tests/test/cpp/preprocessor2.scm   | 16 ++++++++++++++
 4 files changed, 41 insertions(+), 28 deletions(-)

diff --git a/module/c/cpp-environment.scm b/module/c/cpp-environment.scm
index 913e905e..c3bd79f1 100644
--- a/module/c/cpp-environment.scm
+++ b/module/c/cpp-environment.scm
@@ -40,7 +40,7 @@
            cpp-file-stack
 
            make-environment in-environment?
-           remove-identifier! add-identifier!
+           remove-identifier add-identifier
            get-identifier
            extend-environment
            disjoin-macro
@@ -91,6 +91,8 @@
   (cpp-if-status type: (list-of (memv '(outside active-if inactive-if)))
                  default: '(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
   (cpp-variables type: hash-table? default: (make-hash-table))
   (cpp-file-stack type: (and (not null?)
                              (list-of (pair-of string? exact-integer?)))
@@ -147,21 +149,20 @@
 (define (in-environment? environment key)
   (hash-get-handle (cpp-variables environment) key))
 
-(define (remove-identifier! environment key)
-  (hash-remove! (cpp-variables environment) key)
-  environment)
-
-(define (add-identifier! environment key value)
-  (unless (string? key)
-    (scm-error 'wrong-type-arg "add-identifier!"
-               "Key must be a string, got: ~s"
-               (list key) #f))
-  (unless (macro? value)
-    (scm-error 'wrong-type-arg "add-identifier!"
-               "Value must be a macro, got: ~s"
-               (list value) #f))
-  (hash-set! (cpp-variables environment) key value)
-  environment)
+(define (remove-identifier environment key)
+  (typecheck key string?)
+
+  (let ((environment (clone-environment environment)))
+    (hash-remove! (cpp-variables environment) key)
+    environment))
+
+(define (add-identifier environment key value)
+  (typecheck key string?)
+  (typecheck value macro?)
+
+  (let ((environment (clone-environment environment)))
+    (hash-set! (cpp-variables environment) key value)
+    environment))
 
 (define (get-identifier environment key)
   (hash-ref (cpp-variables environment) key))
@@ -169,15 +170,13 @@
 
 (define (extend-environment environment macros)
   (typecheck macros (list-of macro?))
-  (let ((env (clone-environment environment)))
-    (fold (lambda (m env) (add-identifier! env (macro-identifier m) m))
-          env macros)))
+  (fold (lambda (m env) (add-identifier env (macro-identifier m) m))
+        environment macros))
 
 (define (disjoin-macro environment name)
   (typecheck name string?)
-  (let ((env (clone-environment environment)))
-    (remove-identifier! env name)
-    env))
+  (remove-identifier env name))
+
 
 
 
diff --git a/module/c/preprocessor2.scm b/module/c/preprocessor2.scm
index 8bec237a..7e6de2e1 100644
--- a/module/c/preprocessor2.scm
+++ b/module/c/preprocessor2.scm
@@ -490,7 +490,7 @@
         (tail (cdr tokens)))
     (-> environment
         bump-line
-        (add-identifier!
+        (add-identifier
          identifier
          (cond ((and (not (null? tail))
                      (equal? '(punctuator "(") (lexeme-body (car tail))))
@@ -576,7 +576,7 @@
                                                  (if (in-environment? env (identifier-token? (car body)))
                                                      enter-inactive-if enter-active-if)))
                                               ((define) resolve-define)
-                                              ((undef) (lambda (env body) (remove-identifier! env (car body))))
+                                              ((undef) (lambda (env body) (remove-identifier env (identifier-token? (car body)))))
                                               ((line) handle-line-directive)
                                               ((error) (lambda (_ body) (throw 'cpp-error body)))
                                               ((pragma) handle-pragma)
diff --git a/tests/test/cpp/cpp-environment.scm b/tests/test/cpp/cpp-environment.scm
index df4736fb..1b24676f 100644
--- a/tests/test/cpp/cpp-environment.scm
+++ b/tests/test/cpp/cpp-environment.scm
@@ -28,7 +28,7 @@
 
 
 (let ((e (make-environment)))
-  (let ((e* (add-identifier!
+  (let ((e* (add-identifier
              e "key"
              (object-like-macro
               identifier: "key"
@@ -36,9 +36,7 @@
     (let ((result (get-identifier e* "key")))
       (test-assert (macro? result))
       (test-equal (lex "value")
-        (macro-body result))))
-  ;; (get-identifier e "key") here is undefined
-  )
+        (macro-body result)))))
 
 (let ((e (make-environment)))
   (let ((result (get-identifier e "key")))
diff --git a/tests/test/cpp/preprocessor2.scm b/tests/test/cpp/preprocessor2.scm
index 4f0918ff..01c46dff 100644
--- a/tests/test/cpp/preprocessor2.scm
+++ b/tests/test/cpp/preprocessor2.scm
@@ -738,6 +738,22 @@ wf(x, y)
 ")))
 
 
+(test-equal "Usage before #define"
+  (lex "X")
+  (run "X
+
+#define X 100"))
+
+(test-equal "#undef"
+  (append (lex "X") (lex "10") (lex "X"))
+  (run "
+X
+#define X 10
+X
+#undef X
+X
+")
+  )
 ;; #undef
 ;; #error
 
-- 
cgit v1.2.3