From 1393ce3878e5d14214631fb83d58c819a7849b18 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 7 Jul 2022 18:40:27 +0200 Subject: work. --- module/c/compiler.scm | 21 +-- module/c/cpp-environment.scm | 22 ++-- module/c/lex2.scm | 13 +- module/c/preprocessor.scm | 34 +---- module/c/preprocessor2.scm | 302 ++++++++++++++++++++++++++++--------------- 5 files changed, 236 insertions(+), 156 deletions(-) (limited to 'module') diff --git a/module/c/compiler.scm b/module/c/compiler.scm index 121e6c07..801c3752 100644 --- a/module/c/compiler.scm +++ b/module/c/compiler.scm @@ -2,14 +2,17 @@ :use-module ((c lex2) :select (lex)) :use-module ((c trigraph) :select (replace-trigraphs)) :use-module ((c line-fold) :select (fold-lines)) + :use-module (c cpp-environment object-like-macro) + :use-module ((c cpp-environment) + :select (make-environment + extend-environment + enter-file)) :use-module (hnh util) + ;; TODO importort + ;; handle-preprocessing-tokens + ;; load-and-tokenize-file :export (run-compiler)) -(define (comment->whitespace expr) - (match expr - (('comment _) '(whitespace " ")) - (other other))) - " #define __STDC__ 1 #define __STDC_HOSTED__ 1 @@ -36,17 +39,15 @@ body: `(preprocessing-token (string-literal ,(strftime "%b %_d %Y" now)))) (object-like-macro identifier: "__TIME__" - body: (preprocessing-token - (string-literal - ,(strftime "%H:%M:%S" now)))))) + body: `(preprocessing-token + (string-literal + ,(strftime "%H:%M:%S" now)))))) (define environment (-> (make-environment) (extend-environment default-macros))) -(define (read-file path) - (call-with-input-file path read-string)) ;;; 5.1.11.2 Translation phases 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))) diff --git a/module/c/lex2.scm b/module/c/lex2.scm index 23fa9da4..6083190f 100644 --- a/module/c/lex2.scm +++ b/module/c/lex2.scm @@ -144,7 +144,7 @@ hexadecimal-floating-constant)) ;; (6.4.4.2) -(define-peg-pattern floating-constant all +(define-peg-pattern decimal-floating-constant all (or (and fractional-constant (? exponent-part) (? floating-suffix)) (and digit-sequence exponent-part (? floating-suffix)))) @@ -253,10 +253,12 @@ ;; (6.4.6) (define-peg-pattern punctuator all - (or "[" "]" "(" ")" "{" "}" "." "->" + (or "[" "]" "(" ")" "{" "}" + "..." ; Moved to be before "." + "." "->" "++" "--" "&" "*" "+" "-" "~" "!" "/" "%" "<<" ">>" "<" ">" "<=" ">=" "==" "!=" "^" "|" "&&" "||" - "?" ":" ";" "..." + "?" ":" ";" "=" "*=" "/=" "%=" "+=" "-=" "<<=" ">>=" "&=" "^=" "|=" "," "#" "##" "<:" ":>" "<%" "%>" "%:" "%:%:")) @@ -313,11 +315,12 @@ (define-peg-pattern comment all (or line-comment block-comment)) -(define-peg-pattern preprocessing-tokens body +(define-peg-pattern preprocessing-tokens all (* (or whitespace comment preprocessing-token))) +;; returns a list of lexemes (define (lex string) - (peg:tree (match-pattern preprocessing-tokens string))) + (cdr (peg:tree (match-pattern preprocessing-tokens string)))) diff --git a/module/c/preprocessor.scm b/module/c/preprocessor.scm index 49ecfa27..71712b17 100644 --- a/module/c/preprocessor.scm +++ b/module/c/preprocessor.scm @@ -139,27 +139,6 @@ (every predicate lst)) -(define-type (cpp-environment) - (cpp-if-status type: (list-of? (lambda (x) (memv x '(outside active-if inactive-if)))) - ;; type: (list-of? (memv '(outside active-if inactive-if))) - default: '(outside)) - (cpp-variabes type: hash-table? default: (make-hash-table))) - -(define (make-environment) (cpp-environment)) - -(define (in-envirnoment? 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) - (assert (string? key)) - (assert (macro? value)) - (hash-set! (cpp-variables environment) key value) - environment) - ;; Parantheses when defining macro (define (parse-parameter-string string) (map string-trim-both @@ -174,15 +153,12 @@ (formals type: (list-of? string?)) (body type: string?)) -(define (macro? x) - (or (object-macro? x) - (function-macro? x))) ;; The interesting part ;; environment, (list string) -> (values (list string) (list strings)) ;; multiple lines since since a function-like macro can extend over multiple lines -(define (expand-macros environment strings) - ) +;; (define (expand-macros environment strings) +;; ) (define (crash-if-not-if body guilty) @@ -235,7 +211,7 @@ ((elif) (case (car (cpp-if-status environment)) ((outside) (crash-if-not-if (directive-body m) "elif")) - (else ;; TODO + (else 'TODO ;; TODO ) )) @@ -272,7 +248,7 @@ xcons 'inactive-if) (cdr lines) done)) - (else ;; TODO + (else 'TODO ;; TODO ))) @@ -286,7 +262,7 @@ ((#\") (handle-file environment filename)))))) (else (scm-error 'cpp-error "parse-directives" "Invalid include" - '() #f)))) + '() #f))))) ((define) ;; TODO what are valid names? (cond ((string-match "^(\\w+)([(][^)]*[)])?\\s+(.*)" (directive-body directive?)) diff --git a/module/c/preprocessor2.scm b/module/c/preprocessor2.scm index 19daabfb..e99b1049 100644 --- a/module/c/preprocessor2.scm +++ b/module/c/preprocessor2.scm @@ -16,82 +16,120 @@ :use-module ((c line-fold) :select (fold-lines)) :export ()) +;; Returns two values: +;; - tokens until a newline token is met +;; - (potentially the newline token) and the remaining tokens (define (tokens-until-eol tokens) (break (lambda (token) (equal? token '(whitespace "\n"))) tokens)) +;; match in predicates so non-lists fail properly (define (whitespace-token? token) - (eq? 'whitespace (car token))) + (match token + (`(whitespace ,_) #t) + (_ #f))) + +(define (unwrap-preprocessing-token token) + (match token + (`(preprocessing-token ,x) x) + (_ (scm-error 'wrong-type-arg "unwrap-preprocessing-token" + "Not a preprocessing token: ~s" (list token) + #f)))) (define (preprocessing-token? token) - (eq? 'preprocessing-token token)) + (catch 'wrong-type-arg + (lambda () (unwrap-preprocessing-token token)) + (const #f))) + +;; Replace all whitespace with single spaces. (define (squeeze-whitespace tokens) (match tokens ('() '()) - (`((whitespace ,_) (whitespace ,_) ,rest ...) + ((`(whitespace ,_) `(whitespace ,_) rest ...) (squeeze-whitespace (cons '(whitespace " ") rest))) - (`((whitespace ,_) ,rest ...) + ((`(whitespace ,_) rest ...) (cons '(whitespace " ") (squeeze-whitespace rest))) ((token rest ...) (cons token (squeeze-whitespace rest))))) -(define (stringify-token token) - ;; TODO propperly implement this - `(preprocessing-token - (string-literal ,(with-output-to-string (lambda () (display token)))))) +;; Returns the "source" of the token, as a preprocessing string literal token +(define (stringify-token unwrapped-preprocessing-token) + (match unwrapped-preprocessing-token + (`(string-literal ,s) + (format #f "~s" s)) + (`(header-name (q-string ,s)) + (format #f "~s" s)) + (`(header-name (h-string ,s)) + (format #f "<~a>" s)) + (`(identifier ,id) id) + (`(pp-number ,n) n) + (`(character-constant ,c) + (format #f "'~a'" c)) + (`(punctuator ,p) p))) (define (stringify-tokens tokens) - (with-output-to-string - (lambda () - (for-each (compose display stringify-token) - (squeeze-whitespace tokens))))) + `(preprocessing-token + (string-literal + ,(string-concatenate + (map (match-lambda (`(preprocessing-token ,body) (stringify-token body)) + (`(whitespace ,_) " ")) + (squeeze-whitespace tokens)))))) ;; Expand ## tokens ;; TODO (define (expand-join macro tokens) tokens) -;; expand function like macro -(define (apply-macro environment macro parameters) - (define parameter-map - (if (macro-variadic? macro) - (let ((head rest (split-at parameters (length (macro-identifier-list macro))))) - ;; TODO commas (,) should be interleaved with rest - (cons (cons "__VA_ARGS__" rest) - (map cons (macro-identifier-list macro) head))) - (map cons - (macro-identifier-list macro) - parameters))) - - ;; resolve strigify operators - (define stringify-resolved - (let loop ((tokens (macro-body macro))) - (match tokens - (`((preprocessing-token (punctuator "#")) - (whitespace ,_) ... - (preprocessing-token (identifier ,x)) - ,rest ...) - (unless (member x (macro-identifier-list macro)) - (scm-error 'macro-expand-error "apply-macro" - "'#' is not followed by a macro parameter: ~s" - (list x) #f) +;; parameters is a lexeme list, as returned by parse-parameter-list +(define (build-parameter-map macro parameters) + (if (macro-variadic? macro) + (let ((head rest (split-at parameters (length (macro-identifier-list macro))))) + ;; TODO commas (,) should be interleaved with rest + (cons (cons "__VA_ARGS__" rest) + (map cons (macro-identifier-list macro) head))) + (map cons + (macro-identifier-list macro) + parameters))) + +;; Drop leading whitespace tokens +(define (drop-whitespace tokens) + (drop-while whitespace-token? tokens)) + +(define (drop-whitespace-right tokens) + (-> tokens reverse drop-whitespace reverse)) + +(define (drop-whitespace-both tokens) + (-> tokens + drop-whitespace + drop-whitespace-right)) + +(define (expand-stringifiers macro parameter-map) + (let loop ((tokens (macro-body macro))) + (match tokens + (('(preprocessing-token (punctuator "#")) + rest ...) + (match (drop-whitespace rest) + ((`(preprocessing-token (identifier ,x)) rest ...) + (unless (member x (macro-identifier-list macro)) + (scm-error 'macro-expand-error "expand-stringifiers" + "'#' is not followed by a macro parameter: ~s" + (list x) #f)) (cons (stringify-tokens (assoc-ref parameter-map x)) - (loop rest)))) - ('() '()) - ((token rest ...) - (cons token (loop rest)))))) - - ;; TODO - ;; - resolve ## - (define resulting-body - (expand-join macro stringify-resolved)) + (loop rest))))) + ('() '()) + ((token rest ...) + (cons token (loop rest)))))) - ;; - subtitute parameters - ;; TODO what am I doing here? - (expand-macro (-> environment - (extend-environment parameter-map)) - resulting-body)) +;; expand function like macro +(define (apply-macro environment macro parameters) + (define parameter-map (build-parameter-map macro parameters)) + (define stringify-resolved (expand-stringifiers macro parameter-map)) + ;; TODO resolve ## + (define resulting-body stringify-resolved #; (expand-join macro stringify-resolved) + ) + (resolve-token-stream (extend-environment environment parameter-map) + resulting-body)) @@ -103,8 +141,10 @@ ;; OTHER ;; ⇒ "VALUE" +;; token should be the token stream just after the name of the macro (define (expand-macro environment macro tokens) (cond ((object-macro? macro) + ;; Shouldn't we expand the macro body here? (values environment (append (macro-body macro) tokens))) ((function-macro? macro) @@ -118,7 +158,12 @@ (let ((containing remaining newlines (parse-parameter-list tokens))) (values (bump-line environment newlines) (append ((macro-body macro) environment containing) - remaining)))))) + remaining)))) + + (else + (scm-error 'wrong-type-arg "expand-macro" + "Macro isn't a macro: ~s" + (list macro) #f)))) ;; Takes a list of preprocessing tokens, and returns two values ;; if the last token was '...' @@ -130,16 +175,19 @@ (match tokens ('() (values #f (reverse done))) - ((`(preprocessing-token (punctuation "..."))) - (values #t (reverse done))) - ((`(preprocessing-token (identifier ,id)) rest ...) (loop rest (cons id done))) - ((`(preprocessing-token (punctuation "...")) rest ...) + ((`(preprocessing-token (punctuator "..."))) + (values #t (reverse done))) + + ((`(preprocessing-token (punctuator "...")) rest ...) (scm-error 'cpp-error "parse-identifier-list" - "'...' only allowed as last argument in identifier list" - '() #f)) + "'...' only allowed as last argument in identifier list. Rest: ~s" + (list rest) #f)) + + ((`(preprocessing-token (punctuator ",")) rest ...) + (loop rest done)) ((`(preprocessing-token ,other) rest ...) (scm-error 'cpp-error "parse-identifier-list" @@ -147,10 +195,23 @@ (list other) #f))))) + +;; helper procedure to parse-parameter-list. +;; If a parameter is complex then whitespace is kept, but squeezed to single spaces. Surounding whitespace is removed. +;; Example: +;; #define str(x, y) #y +;; str(x, ( 2, 4 ) ) +;; expands to: +;; "( 2, 4 )" +;; 6.10.3.2 p 2 +(define (cleanup-whitespace tokens) + (-> tokens drop-whitespace-both squeeze-whitespace)) + ;; returns three values: ;; - a list of tokens where each is a parameter to the function like macro ;; - the remaining tokenstream ;; - how many newlines were encountered +;; The standard might call these "replacement lists" (define (parse-parameter-list tokens) (let %loop ((depth 0) (newlines 0) (current '()) (parameters '()) (tokens tokens) (%first-iteration? #t)) @@ -162,26 +223,45 @@ current (cons (car tokens) current)))) (match tokens - (`((whitespace "\n") ,rest ...) + (('(whitespace "\n") rest ...) (loop rest newlines: (1+ newlines) current: current*)) - (`((whitespace ,_) ,rest ...) + ((`(whitespace ,_) rest ...) (loop rest current: current*)) - (`((preprocessing-token (punctuator "(")) ,rest ...) + (('(preprocessing-token (punctuator "(")) rest ...) (loop rest depth: (1+ depth) current: current*)) - (`((preprocessing-token (punctuator ")")) ,rest ...) + (('(preprocessing-token (punctuator ")")) rest ...) (if (= 1 depth) - (values (reverse (cons (reverse current) parameters)) + ;; return value + (values + (if (null? parameters) + (cond ((null? current) '()) + ((every whitespace-token? current) '()) + (else (reverse + (cons (cleanup-whitespace (reverse current)) + parameters)))) + (reverse + (cond ((null? current) parameters) + ((every whitespace-token? current) parameters) + (else (cons (cleanup-whitespace (reverse current)) + parameters))))) + rest newlines) (loop rest depth: (1- depth) current: current*))) - (`((preprocessing-token (punctuator ",")) ,rest ...) + (('(preprocessing-token (punctuator ",")) rest ...) (if (= 1 depth) (loop rest current: '() - parameters: (cons (reverse current) parameters)) - (loop rest current: current*))))))) + parameters: + (cons (cond ((null? current) '()) + ((every whitespace-token? current) '()) + (else (cleanup-whitespace (reverse current)))) + parameters)) + (loop rest current: current*))) + ((_ rest ...) + (loop rest current: current*)))))) (define (join-file-line environment) @@ -190,8 +270,13 @@ (extend-environment environment ;; 6.10.8 - `(("__FILE__" . (preprocessing-token (string-literal ,file))) - ("__LINE__" . (preprocessing-token (pp-number ,(number->string line))))))) + (list + (object-like-macro + identifier: "__FILE__" + body: `((preprocessing-token (string-literal ,file)))) + (object-like-macro + identifier: "__LINE__" + body: `((preprocessing-token (pp-number ,(number->string line)))))))) (define (c-search-path) (make-parameter (list "." "/usr/include"))) @@ -219,8 +304,8 @@ identifier: "defined" body: (lambda (environment tokens) (match tokens - (`((preprocessor-token (identifier ,id))) - `(preprocessor-token (pp-number ,(boolean->c-boolean (in-environment? environment id))))) + (`((preprocessing-token (identifier ,id))) + `(preprocessing-token (pp-number ,(boolean->c-boolean (in-environment? environment id))))) (_ (scm-error 'cpp-error "defined" "Invalid parameter list to `defined': ~s" (list tokens) #f)))))) @@ -252,14 +337,15 @@ 'TODO ) +;; Expands a token-stream which contains no pre-processing directives (#if:s, ...) (define (resolve-token-stream environment tokens) (let loop ((tokens tokens)) (match tokens ('() '()) - (`((preprocessing-token (identifier ,id)) ,rest ...) + ((`(preprocessing-token (identifier ,id)) rest ...) (call-with-values (lambda () (maybe-extend-identifier environment id rest)) (lambda (_ tokens) (loop tokens)))) - (`((whitespace ,_) ,rest ...) + ((`(whitespace ,_) rest ...) (loop rest)) ((token rest ...) (cons token (loop rest)))))) @@ -278,13 +364,16 @@ ;; environment, string, (list token) → environment, (list token) (define (maybe-extend-identifier environment identifier remaining-tokens) (cond ((get-identifier environment identifier) - => (lambda (value) (expand-macro (join-file-line environment) value remaining-tokens))) + => (lambda (value) (expand-macro (join-file-line environment) + value + remaining-tokens))) (else ; It wasn't an identifier, leave it as is + ;; TODO shouldn't we include the identifier in the remaining tokens stream? (values environment remaining-tokens)))) (define (resolve-and-include-header environment tokens) (let loop ((%first-time #t) (tokens tokens)) - (match (drop-while whitespace-token? tokens) + (match (drop-whitespace tokens) ((`(header-name (h-string ,str)) rest ...) (cond ((remove whitespace-token? rest) (negate null?) @@ -341,27 +430,28 @@ ;; environment, tokens → environment (define (resolve-define environment tokens) (match tokens - (`((preprocessing-token (identifier ,identifier)) tail ...) + ((`(preprocessing-token (identifier ,identifier)) tail ...) (-> environment bump-line (add-identifier! identifier - (if (equal? '(preprocessing-token (punctuator "(")) (car tail)) - ;; function like macro - (call-with-values (lambda () (break (lambda (token) (equal? token '(preprocessing-token (punctuator ")")))) - (cdr tail))) - (lambda (identifier-list replacement-list) - (let ((variadic? identifiers (parse-identifier-list identifier-list))) - (function-like-macro - identifier: identifier - variadic?: variadic? - identifier-list: identifiers - ;; NOTE 6.10.3 states that there needs to be at least on whitespace here - body: (cdr replacement-list))))) - - (object-like-macro - identifier: identifier - body: tail))))))) + (match tail + (('(preprocessing-token (punctuator "(")) rest ...) + ;; function like macro + (call-with-values (lambda () (break (lambda (token) (equal? token '(preprocessing-token (punctuator ")")))) + rest)) + (lambda (identifier-list replacement-list) + (let ((variadic? identifiers (parse-identifier-list identifier-list))) + + (function-like-macro + identifier: identifier + variadic?: variadic? + identifier-list: identifiers + ;; NOTE 6.10.3 states that there needs to be at least on whitespace here + body: (cdr replacement-list)))))) + (_ (object-like-macro + identifier: identifier + body: tail)))))))) @@ -376,14 +466,18 @@ args) #f)) + ;; TODO all of this needs to be surounded with a conditional for + ;; environmentns if status. However, ensure that each directive + ;; starts at start of line + (match tokens ('() '()) - (`((whitespace "\n") (whitespace ,_) ... (preprocessing-token (puntuator "#")) ,rest ...) + ((`(whitespace "\n") `(whitespace ,_) '... '(preprocessing-token (puntuator "#")) rest ...) ;; Line tokens are those in this line, ;; while remaining tokens are the newline, follewed by the rest of the files tokens (let ((line-tokens remaining-tokens (tokens-until-eol rest))) ;; Actual tokens just removes all whitespace between "#" and "define" - (let ((actual-tokens (drop-while whitespace-token? line-tokens))) + (let ((actual-tokens (drop-whitespace line-tokens))) (if (null? actual-tokens) (loop (bump-line environment) remaining-tokens) (match (car actual-tokens) @@ -393,7 +487,7 @@ (`(preprocessing-token (identifier "ifdef")) (match actual-tokens - (`((preprocessing-token (identifier ,id)) ,_ ...) + ((`(preprocessing-token (identifier ,id)) _ ...) (loop ((if (in-environment? environment id) enter-active-if enter-inactive-if) @@ -403,7 +497,7 @@ (`(preprocessing-token (identifier "ifndef")) (match actual-tokens - (`((preprocessing-token (identifier ,id)) ,_ ...) + ((`(preprocessing-token (identifier ,id)) _ ...) (loop ((if (in-environment? environment id) enter-inactive-if enter-active-if) @@ -411,49 +505,49 @@ remaining-tokens)) (_ (err "Non identifier in ifndef: ~s" actual-tokens)))) - (`(preprocessing-token (identifier "else")) + ('(preprocessing-token (identifier "else")) ;; TODO 'TODO ) - (`(preprocessing-token (identifier "elif")) + ('(preprocessing-token (identifier "elif")) (-> environment leave-if (resolve-for-if actual-tokens) (loop remaining-tokens))) - (`(preprocessing-token (identifier "endif")) + ('(preprocessing-token (identifier "endif")) (loop (leave-if environment) remaining-tokens)) - (`(preprocessing-token (identifier "include")) + ('(preprocessing-token (identifier "include")) (call-with-values (lambda () (resolve-and-include-header environment (cdr actual-tokens))) (lambda (environment tokens) (loop environment (append tokens remaining-tokens))))) - (`(preprocessing-token (identifier "define")) + ('(preprocessing-token (identifier "define")) (let ((env (resolve-define environment (cdr actual-tokens)))) (loop env remaining-tokens)) ) - (`(preprocessing-token (identifier "undef")) + ('(preprocessing-token (identifier "undef")) (loop (match actual-tokens (`((preprocessing-token (identifier ,id))) (-> environment bump-line (remove-identifier! id)))) remaining-tokens)) - (`(preprocessing-token (identifier "line")) + ('(preprocessing-token (identifier "line")) (loop (handle-line-directive environment actual-tokens) remaining-tokens)) - (`(preprocessing-token (identifier "error")) + ('(preprocessing-token (identifier "error")) ;; NOTE this is an "expected" error (throw 'cpp-error actual-tokens)) - (`(preprocessing-token (identifier "pragma")) + ('(preprocessing-token (identifier "pragma")) (loop (handle-pragma environment actual-tokens) remaining-tokens))))))) - (`((preprocessing-token (identifier ,id)) ,rest ...) + ((`(preprocessing-token (identifier ,id)) rest ...) (call-with-values (lambda () (maybe-extend-identifier environment id rest)) loop)) -- cgit v1.2.3