suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

xform: keep system-header flag in line info

Browse Source 
svn: r12435
This commit is contained in:
Matthew Flatt 2008-11-14 01:22:58 +00:00
parent 59f3f19f84
commit 14f57a3f37
1 changed files with 37 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
collects/compiler/private/xform.ss
View File

@ -44,6 +44,7 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-struct tok (n line file) (make-inspector)) (define-struct tok (n line file) (make-inspector))
(define-struct (sysheader-tok tok) ())
(define-struct (seq tok) (close in)) (define-struct (seq tok) (close in))
(define-struct (parens seq) ()) (define-struct (parens seq) ())
(define-struct (brackets seq) ()) (define-struct (brackets seq) ())
@ -81,7 +82,7 @@
;; For dependency tracking: ;; For dependency tracking:
(define depends-files (make-hash-table 'equal)) (define depends-files (make-hash-table 'equal))
(define (make-triple v src line) (define (make-triple v src line sysheader?)
(when (symbol? v) (when (symbol? v)
(hash-table-put! used-symbols v (hash-table-put! used-symbols v
(add1 (hash-table-get (add1 (hash-table-get
@ -90,7 +91,9 @@
(lambda () 0))))) (lambda () 0)))))
(when (and src output-depends-info?) (when (and src output-depends-info?)
(hash-table-put! depends-files src #t)) (hash-table-put! depends-files src #t))
(make-tok v line src)) (if sysheader?
(make-sysheader-tok v line src)
(make-tok v line src)))
(define (make-a-seq opener src line body) (define (make-a-seq opener src line body)
((case opener ((case opener
@ -155,14 +158,15 @@
(add1 p) (add1 p)
(loop (add1 p)))))) (loop (add1 p))))))
(define re:line #rx#"^#[^\n\r]* ([0-9]+) \"([^\"]*)\"" ) (define re:line #rx#"^#[^\n\r]* ([0-9]+) \"([^\"]*)\"([^\r\n]*)" )
(define re:pragma #rx#"^#pragma ([^\r\n]*)") (define re:pragma #rx#"^#pragma ([^\r\n]*)")
(define (do-cpp s p) (define (do-cpp s p)
(let ([m (regexp-match re:line s p)]) (let ([m (regexp-match re:line s p)])
(when m (when m
(set! source-line (string->number (bytes->string/utf-8 (cadr m)))) (set! source-line (string->number (bytes->string/utf-8 (cadr m))))
(set! source-file (caddr m)))) (set! source-file (caddr m))
(set! source-sysheader? (regexp-match? #px#"\\b3\\b" (cadddr m)))))
(let ([pragma (regexp-match re:pragma s p)]) (let ([pragma (regexp-match re:pragma s p)])
(if (and pragma (if (and pragma
(not (regexp-match-positions re:boring (car pragma)))) (not (regexp-match-positions re:boring (car pragma))))
@ -172,8 +176,9 @@
(define (result s) (define (result s)
(make-triple (make-triple
s s
source-file ; file source-file
source-line)) ; line source-line
source-sysheader?))
(define (symbol s) (define (symbol s)
(result (string->symbol (bytes->string/utf-8 s)))) (result (string->symbol (bytes->string/utf-8 s))))
@ -313,6 +318,7 @@
(define source-file #f) (define source-file #f)
(define source-line 0) (define source-line 0)
(define source-sysheader? #f)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -980,6 +986,7 @@
(define makers (make-hash-table)) (define makers (make-hash-table))
(hash-table-put! makers 'struct:tok (cons 'make-tok make-tok)) (hash-table-put! makers 'struct:tok (cons 'make-tok make-tok))
(hash-table-put! makers 'struct:sysheader-tok (cons 'make-sysheader-tok make-sysheader-tok))
(hash-table-put! makers 'struct:seq (cons 'make-a-seq make-a-seq)) (hash-table-put! makers 'struct:seq (cons 'make-a-seq make-a-seq))
(hash-table-put! makers 'struct:parens (cons 'make-parens make-parens)) (hash-table-put! makers 'struct:parens (cons 'make-parens make-parens))
(hash-table-put! makers 'struct:brackets (cons 'make-brackets make-brackets)) (hash-table-put! makers 'struct:brackets (cons 'make-brackets make-brackets))
@ -1104,10 +1111,10 @@
[(call? v) (extract-src-tok (call-func v))] [(call? v) (extract-src-tok (call-func v))]
[else #f])) [else #f]))
(define (print-it e indent semi-newlines? ordered? line file keep-lines?) (define (print-it e indent semi-newlines? ordered? line file sysheader? keep-lines?)
(let loop ([e e][prev #f][prevs null][old-line line][old-file file]) (let loop ([e e][prev #f][prevs null][old-line line][old-file file][old-sysheader? sysheader?])
(if (null? e) (if (null? e)
(values old-line old-file) (values old-line old-file old-sysheader?)
(let* ([v (car e)] (let* ([v (car e)]
[sv (extract-src-tok v)] [sv (extract-src-tok v)]
[line (if keep-lines? [line (if keep-lines?
@ -1118,6 +1125,11 @@
(or (and sv (tok-file sv)) (or (and sv (tok-file sv))
old-file) old-file)
old-file)] old-file)]
[sysheader? (if keep-lines?
(if (and sv (tok-file sv))
(sysheader-tok? sv)
old-sysheader?)
old-sysheader?)]
[inc-line! (lambda () (set! line (add1 line)))]) [inc-line! (lambda () (set! line (add1 line)))])
(when keep-lines? (when keep-lines?
(unless (and (equal? line old-line) (unless (and (equal? line old-line)
@ -1126,7 +1138,8 @@
(line . > . old-line) (line . > . old-line)
((- line old-line) . < . 10)) ((- line old-line) . < . 10))
(display (make-string (- line old-line) #\newline)) (display (make-string (- line old-line) #\newline))
(printf "\n# ~a \"~a\"\n" line file)) (printf "\n# ~a \"~a\"~a\n" line file
(if sysheader? " 3" "")))
(set! next-indent indent))) (set! next-indent indent)))
(cond (cond
[(pragma? v) [(pragma? v)
@ -1142,18 +1155,19 @@
(inc-line!) (inc-line!)
(+ indent 2)) (+ indent 2))
indent)]) indent)])
(let-values ([(l f) (let-values ([(l f s?)
(print-it (seq->list (seq-in v)) subindent (print-it (seq->list (seq-in v)) subindent
(not (and (parens? v) (not (and (parens? v)
prev prev
(tok? prev) (tok? prev)
(memq (tok-n prev) '(for)))) (memq (tok-n prev) '(for))))
(or (braces? v) (callstage-parens? v)) (or (braces? v) (callstage-parens? v))
line file line file sysheader?
(and keep-lines? (and keep-lines?
(not (nosrc-parens? v))))]) (not (nosrc-parens? v))))])
(set! line l) (set! line l)
(set! file f)) (set! file f)
(set! sysheader? s?))
(when (and next-indent (= next-indent subindent)) (when (and next-indent (= next-indent subindent))
(set! next-indent indent))) (set! next-indent indent)))
(display/indent #f (seq-close v)) (display/indent #f (seq-close v))
@ -1197,13 +1211,14 @@
(display/indent v ")")) (display/indent v ")"))
(display/indent v "_")) (display/indent v "_"))
(display/indent v "), ")))) (display/indent v "), "))))
(let-values ([(l f) (let-values ([(l f s?)
(print-it (append (call-func v) (list (call-args v))) (print-it (append (call-func v) (list (call-args v)))
indent #f #f line file indent #f #f line file sysheader?
;; Can't put srcloc within macro call: ;; Can't put srcloc within macro call:
#f)]) #f)])
(set! line l) (set! line l)
(set! file f)) (set! file f)
(set! sysheader? s?))
(display/indent v ")")] (display/indent v ")")]
[(block-push? v) [(block-push? v)
(let ([size (total-push-size (block-push-vars v))] (let ([size (total-push-size (block-push-vars v))]
@ -1285,7 +1300,7 @@
semi-newlines?) semi-newlines?)
(newline/indent indent) (newline/indent indent)
(inc-line!))]) (inc-line!))])
(loop (cdr e) v (cons v prevs) line file))))) (loop (cdr e) v (cons v prevs) line file sysheader?)))))
;; prev-was-funcall? implements a last-ditch optimization: if ;; prev-was-funcall? implements a last-ditch optimization: if
@ -3881,7 +3896,8 @@
(let* ([e e-raw] (let* ([e e-raw]
[line -inf.0] [line -inf.0]
[file #f]) [file #f]
[sysheader? #f])
(set! e-raw #f) ;; to allow GC (set! e-raw #f) ;; to allow GC
(foldl-statement (foldl-statement
e e
@ -3892,9 +3908,10 @@
(or (tok-file (car sube)) (or (tok-file (car sube))
where))] where))]
[sube (top-level sube where #t)]) [sube (top-level sube where #t)])
(let-values ([(l f) (print-it sube 0 #t #f line file keep-lines?)]) (let-values ([(l f s?) (print-it sube 0 #t #f line file sysheader? keep-lines?)])
(set! line l) (set! line l)
(set! file f)) (set! file f)
(set! sysheader? s?))
where)) where))
#f)) #f))