From 08b84c6b42312aa2bb4d854367b4a17cafcf28c2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sat, 23 Jul 2022 20:44:05 +0200 Subject: Merge cpp-environment sub-modules into main module. The modules where sepparate before to allow multiple objects to share keys for the constructor. This is not needed any more since the introduction of key: to define-type. --- module/c/cpp-environment.scm | 87 ++++++++++++------------ module/c/cpp-environment/function-like-macro.scm | 25 ------- module/c/cpp-environment/internal-macro.scm | 11 --- module/c/cpp-environment/object-like-macro.scm | 18 ----- module/c/preprocessor2.scm | 16 ++--- 5 files changed, 49 insertions(+), 108 deletions(-) delete mode 100644 module/c/cpp-environment/function-like-macro.scm delete mode 100644 module/c/cpp-environment/internal-macro.scm delete mode 100644 module/c/cpp-environment/object-like-macro.scm (limited to 'module/c') diff --git a/module/c/cpp-environment.scm b/module/c/cpp-environment.scm index da8e4413..3bc94020 100644 --- a/module/c/cpp-environment.scm +++ b/module/c/cpp-environment.scm @@ -1,13 +1,10 @@ (define-module (c cpp-environment) :use-module (srfi srfi-1) :use-module (srfi srfi-88) - :use-module ((hnh util) :select (->>)) :use-module (hnh util object) :use-module (hnh util type) :use-module (hnh util lens) - :use-module ((c cpp-environment function-like-macro) :prefix #{fun:}#) - :use-module ((c cpp-environment object-like-macro) :prefix #{obj:}#) - :use-module ((c cpp-environment internal-macro) :prefix #{int:}#) + :use-module ((c lex2) :select (lexeme?)) :use-module ((c unlex) :select (unlex)) :use-module ((rnrs enums)) :export ( @@ -18,6 +15,14 @@ macro-variadic? cpp-macro? + function-macro? + object-macro? + internal-macro? + + object-macro + function-macro + internal-macro + enter-into-if transition-to-if if-status @@ -33,29 +38,44 @@ current-line current-file - function-macro? - object-macro? - internal-macro? - cpp-environment? - cpp-if-status cpp-file-stack make-environment in-environment? remove-identifier add-identifier get-identifier extend-environment - disjoin-macro pprint-environment pprint-macro )) + +(define (%printer r p) + (format p "#<~a>" (pprint-macro r))) + +(define-type (function-macro printer: %printer) + (fun:identifier type: string? key: identifier) + (macro-identifier-list type: (list-of string?) + key: identifier-list) + (fun:body type: (list-of lexeme?) key: body) + (macro-variadic? type: boolean? default: #f + key: variadic?)) + + +(define-type (internal-macro printer: %printer) + (int:identifier type: string? key: identifier) + (int:body type: procedure? #| of arity 2 |# key: body)) + +(define-type (object-macro printer: %printer) + (obj:identifier type: string? key: identifier) + (obj:body type: (list-of lexeme?) key: body)) + (define (macro-identifier x) (define identifier - (cond ((obj:object-like-macro? x) obj:identifier) - ((fun:function-like-macro? x) fun:identifier) - ((int:internal-macro? x) int:identifier) + (cond ((object-macro? x) obj:identifier) + ((function-macro? x) fun:identifier) + ((internal-macro? x) int:identifier) (else (scm-error 'wrong-type-arg "macro-identifier" "Not a macro: ~s" (list x) #f)))) @@ -63,9 +83,9 @@ (define (macro-body-proc macro) - (cond ((obj:object-like-macro? macro) obj:body) - ((fun:function-like-macro? macro) fun:body) - ((int:internal-macro? macro) int:body) + (cond ((object-macro? macro) obj:body) + ((function-macro? macro) fun:body) + ((internal-macro? macro) int:body) (else (scm-error 'wrong-type-arg "macro-body" "Not a macro: ~s" (list macro) #f)))) @@ -74,17 +94,10 @@ (case-lambda ((macro) ((macro-body-proc macro) macro)) ((macro value) ((macro-body-proc macro) macro value)))) -(define macro-identifier-list fun:identifier-list) -(define macro-variadic? fun:variadic?) - -(define function-macro? fun:function-like-macro?) -(define object-macro? obj:object-like-macro?) -(define internal-macro? int:internal-macro?) - (define (cpp-macro? x) - (or (obj:object-like-macro? x) - (fun:function-like-macro? x) - (int:internal-macro? x))) + (or (object-macro? x) + (function-macro? x) + (internal-macro? x))) @@ -202,12 +215,6 @@ (define (make-environment) (cpp-environment)) -;; (define (clone-hash-table ht) -;; (alist->hash-table (hash-map->list cons ht))) - -;; (define (clone-environment environment) -;; (modify environment cpp-variables clone-hash-table)) - (define (in-environment? environment key) (assoc key (cpp-variables environment))) @@ -218,31 +225,25 @@ (lambda (vars) (remove (lambda (slot) (string=? key (car slot))) vars)))) -(define (add-identifier environment key value) - (typecheck key string?) - (typecheck value cpp-macro?) +(define (add-identifier environment macro) + (typecheck macro cpp-macro?) (modify environment cpp-variables - (lambda (vars) (acons key value vars)))) + (lambda (vars) (acons (macro-identifier macro) macro vars)))) (define (get-identifier environment key) (assoc-ref (cpp-variables environment) key)) - (define (extend-environment environment macros) (typecheck macros (list-of cpp-macro?)) - (fold (lambda (m env) (add-identifier env (macro-identifier m) m)) + (fold (lambda (m env) (add-identifier env m)) environment macros)) -(define (disjoin-macro environment name) - (typecheck name string?) - (remove-identifier environment name)) - (define* (pprint-environment environment optional: (port (current-error-port))) - (display "== Environment ==\n" port) + (display "/*** Environment ***/\n" port) (for-each (lambda (pair) (pprint-macro (cdr pair) port) (newline port)) diff --git a/module/c/cpp-environment/function-like-macro.scm b/module/c/cpp-environment/function-like-macro.scm deleted file mode 100644 index 59b47c9c..00000000 --- a/module/c/cpp-environment/function-like-macro.scm +++ /dev/null @@ -1,25 +0,0 @@ -(define-module (c cpp-environment function-like-macro) - :use-module (hnh util object) - :use-module (hnh util type) - :use-module ((c lex2) :select (lexeme?)) - :use-module ((c unlex) :select (unlex)) - :export (function-like-macro - function-like-macro? - identifier - identifier-list - body - variadic?)) - -(define-type (function-like-macro - printer: (lambda (r p) - (format p "#<#define ~a~a ~a>" - (identifier r) - (append (identifier-list r) - (if (variadic? r) - '("...") '())) - (unlex (body r))))) - (identifier type: string?) - (identifier-list type: (list-of string?)) - (body type: (list-of lexeme?)) - (variadic? type: boolean? - default: #f)) diff --git a/module/c/cpp-environment/internal-macro.scm b/module/c/cpp-environment/internal-macro.scm deleted file mode 100644 index 3c946738..00000000 --- a/module/c/cpp-environment/internal-macro.scm +++ /dev/null @@ -1,11 +0,0 @@ -(define-module (c cpp-environment internal-macro) - :use-module (hnh util object) - :export (internal-macro - internal-macro? - identifier body)) - -(define-type (internal-macro) - (identifier type: string?) - (body type: procedure? - ;; Arity 2 - )) diff --git a/module/c/cpp-environment/object-like-macro.scm b/module/c/cpp-environment/object-like-macro.scm deleted file mode 100644 index 90a3ad23..00000000 --- a/module/c/cpp-environment/object-like-macro.scm +++ /dev/null @@ -1,18 +0,0 @@ -(define-module (c cpp-environment object-like-macro) - :use-module (hnh util object) - :use-module (hnh util type) - :use-module ((c lex2) :select (lexeme?)) - :use-module ((c unlex) :select (unlex)) - :export (object-like-macro - object-like-macro? - identifier - body)) - - -(define-type (object-like-macro - printer: (lambda (r p) - (format p "#<#define ~a ~a>" - (identifier r) - (unlex (body r))))) - (identifier type: string?) - (body type: (list-of lexeme?))) diff --git a/module/c/preprocessor2.scm b/module/c/preprocessor2.scm index d65a4ac9..229b1ae9 100644 --- a/module/c/preprocessor2.scm +++ b/module/c/preprocessor2.scm @@ -6,11 +6,6 @@ :use-module (c cpp-environment) :use-module ((c eval2) :select (c-boolean->boolean)) :use-module ((c eval-basic) :select (eval-basic-c)) - :use-module ((c cpp-environment function-like-macro) - :select (function-like-macro variadic?)) - :use-module ((c cpp-environment object-like-macro) - :select (object-like-macro)) - :use-module ((c cpp-environment internal-macro) :select (internal-macro)) :use-module ((hnh util) :select (-> ->> intersperse unless unval break/all)) :use-module ((hnh util lens) :select (set modify cdr*)) :use-module (hnh util path) @@ -110,7 +105,7 @@ (define (check-arity macro parameters) - (if (variadic? macro) + (if (macro-variadic? macro) (unless (>= (length parameters) (length (macro-identifier-list macro))) (scm-error 'cpp-arity-error "apply-macro" @@ -345,10 +340,10 @@ environment ;; 6.10.8 (list - (object-like-macro + (object-macro identifier: "__FILE__" body: (lex (format #f "~s" (current-file environment)))) - (object-like-macro + (object-macro identifier: "__LINE__" body: (lex (number->string (current-line environment))))))) @@ -619,20 +614,19 @@ (-> environment bump-line (add-identifier - identifier (cond ((and (not (null? tail)) (left-parenthesis-token? (car tail))) ;; function like macro (let ((variadic? identifiers replacement-list (parse-identifier-list tail))) - (function-like-macro + (function-macro identifier: identifier variadic?: variadic? identifier-list: identifiers ;; surrounding whitespace is not part of the replacement list ;; (6.10.3 p.7) body: (drop-whitespace-both replacement-list)))) - (else (object-like-macro + (else (object-macro identifier: identifier body: (drop-whitespace-both tail)))))))) -- cgit v1.2.3