From 1393ce3878e5d14214631fb83d58c819a7849b18 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Thu, 7 Jul 2022 18:40:27 +0200
Subject: work.

---
 module/c/cpp-environment.scm | 22 ++++++++++++++--------
 1 file changed, 14 insertions(+), 8 deletions(-)

(limited to 'module/c/cpp-environment.scm')

diff --git a/module/c/cpp-environment.scm b/module/c/cpp-environment.scm
index 20589b8e..3ce754df 100644
--- a/module/c/cpp-environment.scm
+++ b/module/c/cpp-environment.scm
@@ -43,7 +43,10 @@
   (define identifier
    (cond ((obj:object-like-macro? x)   obj:identifier)
          ((fun:function-like-macro? x) fun:identifier)
-         ((int:internal-macro? x)      int:identifier)))
+         ((int:internal-macro? x)      int:identifier)
+         (else (scm-error 'wrong-type-arg "macro-identifier"
+                          "Not a macro: ~s"
+                          (list x) #f))))
   (identifier x))
 
 
@@ -51,7 +54,10 @@
   (define body-proc
     (cond ((obj:object-like-macro? macro)   obj:body)
           ((fun:function-like-macro? macro) fun:body)
-          ((int:internal-macro? macro)      int:body)))
+          ((int:internal-macro? macro)      int:body)
+          (else (scm-error 'wrong-type-arg "macro-body"
+                           "Not a macro: ~s"
+                           (list macro) #f))))
   (body-proc macro))
 
 (define macro-identifier-list fun:identifier-list)
@@ -69,9 +75,10 @@
 (define-type (cpp-environment)
   (cpp-if-status type: (list-of (memv '(outside active-if inactive-if)))
                  default: '(outside))
-  (cpp-variabes type: hash-table? default: (make-hash-table))
-  (cpp-file-stack type: list?
-                  default: '()))
+  (cpp-variables type: hash-table? default: (make-hash-table))
+  (cpp-file-stack type: (and ((negate null?))
+                             (list-of (pair-of string? exact-integer?)))
+                  default: '(("*outside*" . 1))))
 
 
 
@@ -116,7 +123,7 @@
     (scm-error 'wrong-type-arg "add-identifier!"
                "Key must be a string, got: ~s"
                (list key) #f))
-  (unless (macro? key)
+  (unless (macro? value)
     (scm-error 'wrong-type-arg "add-identifier!"
                "Value must be a macro, got: ~s"
                (list value) #f))
@@ -131,7 +138,6 @@
 
 (define (extend-environment environment macros)
   (let ((env (modify environment cpp-variables clone-hash-table)))
-    (fold (lambda (pair m)
-            (add-identifier! env (macro-identifier m) m ))
+    (fold (lambda (m env) (add-identifier! env (macro-identifier m) m))
           env macros)))
 
-- 
cgit v1.2.3