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

add support to xform to output source line numbers

Browse Source 
svn: r12419
This commit is contained in:
Matthew Flatt 2008-11-13 00:26:04 +00:00
parent d56eed754b
commit ba7ad5d2e6
7 changed files with 101 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -9,6 +9,7 @@
cpp cpp
file-in file-in
file-out file-out
keep-lines?
palm? pgc? pgc-really? palm? pgc? pgc-really?
precompiling-header? precompiled-header precompiling-header? precompiled-header
show-info? output-depends-info? show-info? output-depends-info?
@ -1044,10 +1045,6 @@
(define (display/indent v s) (define (display/indent v s)
(when next-indent (when next-indent
;; can't get pre-processor line directive to work
'(when (and v (tok-file v) (tok-line v))
(printf "# ~a ~s~n" (max 1 (- (tok-line v) 1)) (tok-file v)))
(display (make-string next-indent #\space)) (display (make-string next-indent #\space))
(set! next-indent #f)) (set! next-indent #f))
(display s)) (display s))
@ -1099,34 +1096,56 @@
(get-variable-size (cdr x))) (get-variable-size (cdr x)))
vars))) vars)))
(define (print-it e indent semi-newlines? ordered?) (define (print-it e indent semi-newlines? ordered? line file)
(let loop ([e e][prev #f][prevs null]) (let loop ([e e][prev #f][prevs null][old-line line][old-file file])
(unless (null? e) (if (null? e)
(let ([v (car e)]) (values old-line old-file)
(let* ([v (car e)]
[line (or (and (tok? v) (tok-line v))
old-line)]
[file (or (and (tok? v) (tok-file v))
old-file)]
[inc-line! (lambda () (set! line (add1 line)))])
(when keep-lines?
(unless (and (equal? line old-line)
(equal? file old-file))
(if (and (equal? file old-file)
(line . > . old-line)
((- line old-line) . < . 10))
(display (make-string (- line old-line) #\newline))
(printf "\n# ~a \"~a\"\n" line file))
(set! next-indent indent)))
(cond (cond
[(pragma? v) [(pragma? v)
(let ([s (format "#pragma ~a" (pragma-s v))]) (let ([s (format "#pragma ~a" (pragma-s v))])
(unless (regexp-match re:boring s) (unless (regexp-match re:boring s)
(printf "\n~a\n\n" s)))] (printf "\n~a\n\n" s)
(set! line (+ line 3))))]
[(seq? v) [(seq? v)
(display/indent v (tok-n v)) (display/indent v (tok-n v))
(let ([subindent (if (braces? v) (let ([subindent (if (braces? v)
(begin (begin
(newline/indent (+ indent 2)) (newline/indent (+ indent 2))
(inc-line!)
(+ indent 2)) (+ indent 2))
indent)]) indent)])
(let-values ([(l f)
(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)])
(set! line l)
(set! file f))
(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))
(cond (cond
[(braces? v) [(braces? v)
(newline/indent indent)] (newline/indent indent)
(inc-line!)]
[(brackets? v) [(brackets? v)
(display/indent v " ")] (display/indent v " ")]
[(parens? v) [(parens? v)
@ -1135,12 +1154,15 @@
(memq (tok-n prev) '(if)) (memq (tok-n prev) '(if))
(or (null? (cdr e)) (or (null? (cdr e))
(not (braces? (cadr e))))) (not (braces? (cadr e)))))
(begin
(newline/indent (+ indent 2)) (newline/indent (+ indent 2))
(inc-line!))
(display/indent v " "))] (display/indent v " "))]
[else (error 'xform "unknown brace: ~a" (caar v))])] [else (error 'xform "unknown brace: ~a" (caar v))])]
[(note? v) [(note? v)
(display/indent v (note-s v)) (display/indent v (note-s v))
(newline/indent indent)] (newline/indent indent)
(inc-line!)]
[(call? v) [(call? v)
(if (not (call-nonempty? v)) (if (not (call-nonempty? v))
(display/indent v "FUNCCALL_EMPTY(") (display/indent v "FUNCCALL_EMPTY(")
@ -1160,7 +1182,11 @@
(display/indent v ")")) (display/indent v ")"))
(display/indent v "_")) (display/indent v "_"))
(display/indent v "), ")))) (display/indent v "), "))))
(print-it (append (call-func v) (list (call-args v))) indent #f #f) (let-values ([(l f)
(print-it (append (call-func v) (list (call-args v)))
indent #f #f line file)])
(set! line l)
(set! file f))
(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))]
@ -1175,15 +1201,18 @@
(display/indent v (format "BLOCK_SETUP~a((" (if (block-push-top? v) "_TOP" ""))) (display/indent v (format "BLOCK_SETUP~a((" (if (block-push-top? v) "_TOP" "")))
(push-vars (block-push-vars v) prev-add "") (push-vars (block-push-vars v) prev-add "")
(display/indent v "));") (display/indent v "));")
(newline)) (newline)
(inc-line!))
(printf "#~adefine ~a_COUNT (~a~a)~n" tabbing tag size prev-add) (printf "#~adefine ~a_COUNT (~a~a)~n" tabbing tag size prev-add)
(inc-line!)
(printf "#~adefine SETUP_~a(x) " tabbing tag) (printf "#~adefine SETUP_~a(x) " tabbing tag)
(cond (cond
[(and (zero? size) (block-push-super-tag v)) [(and (zero? size) (block-push-super-tag v))
(printf "SETUP_~a(x)" (block-push-super-tag v))] (printf "SETUP_~a(x)" (block-push-super-tag v))]
[per-block-push? (printf "SETUP(~a_COUNT)" tag)] [per-block-push? (printf "SETUP(~a_COUNT)" tag)]
[else (printf "x")]) [else (printf "x")])
(newline/indent indent))] (newline/indent indent)
(inc-line!))]
[(nested-setup? v) [(nested-setup? v)
(let ([tabbing (if (zero? indent) (let ([tabbing (if (zero? indent)
"" ""
@ -1203,9 +1232,11 @@
(printf "#~aundef BLOCK_SETUP~n" tabbing) (printf "#~aundef BLOCK_SETUP~n" tabbing)
(printf "#~aundef FUNCCALL~n" tabbing) (printf "#~aundef FUNCCALL~n" tabbing)
(printf "#~aundef FUNCCALL_EMPTY~n" tabbing) (printf "#~aundef FUNCCALL_EMPTY~n" tabbing)
(printf "#~aundef FUNCCALL_AGAIN~n" tabbing)]))] (printf "#~aundef FUNCCALL_AGAIN~n" tabbing)])
(set! line (+ 4 line)))]
[(memq (tok-n v) asm-commands) [(memq (tok-n v) asm-commands)
(newline/indent indent) (newline/indent indent)
(inc-line!)
(display/indent v (tok-n v)) (display/indent v (tok-n v))
(display/indent v " ")] (display/indent v " ")]
[(and (or (eq? '|HIDE_FROM_XFORM| (tok-n v)) [(and (or (eq? '|HIDE_FROM_XFORM| (tok-n v))
@ -1235,8 +1266,9 @@
(display/indent v " ")) (display/indent v " "))
(when (and (eq? semi (tok-n v)) (when (and (eq? semi (tok-n v))
semi-newlines?) semi-newlines?)
(newline/indent indent))]) (newline/indent indent)
(loop (cdr e) v (cons v prevs)))))) (inc-line!))])
(loop (cdr e) v (cons v prevs) line file)))))
;; prev-was-funcall? implements a last-ditch optimization: if ;; prev-was-funcall? implements a last-ditch optimization: if
@ -3079,7 +3111,6 @@
[len (if last? [len (if last?
(length e) (length e)
(sub1 (length e)))]) (sub1 (length e)))])
(printf "/* this far ~a */~n" (tok-line (car e)))
(let ([k (lift-in-arithmetic? (let loop ([e e]) (let ([k (lift-in-arithmetic? (let loop ([e e])
(if (null? ((if last? (if (null? ((if last?
cddr cddr
@ -3831,7 +3862,9 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let* ([e e-raw]) (let* ([e e-raw]
[line -inf.0]
[file #f])
(set! e-raw #f) ;; to allow GC (set! e-raw #f) ;; to allow GC
(foldl-statement (foldl-statement
e e
@ -3842,7 +3875,9 @@
(or (tok-file (car sube)) (or (tok-file (car sube))
where))] where))]
[sube (top-level sube where #t)]) [sube (top-level sube where #t)])
(print-it sube 0 #t #f) (let-values ([(l f) (print-it sube 0 #t #f line file)])
(set! line l)
(set! file f))
where)) where))
#f)) #f))

10
collects/compiler/xform.ss
View File

@ -1,11 +1,11 @@
#lang scheme/base
(module xform mzscheme
(require dynext/compile (require dynext/compile
(prefix xform: "private/xform.ss")) (prefix-in xform: "private/xform.ss"))
(provide xform) (provide xform)
(define (xform quiet? src dest header-dirs) (define (xform quiet? src dest header-dirs #:keep-lines? keep-lines?)
(let ([exe (current-extension-compiler)] (let ([exe (current-extension-compiler)]
[flags (expand-for-compile-variant [flags (expand-for-compile-variant
(current-extension-preprocess-flags))] (current-extension-preprocess-flags))]
@ -17,7 +17,9 @@
(append flags headers)) (append flags headers))
src src
dest dest
keep-lines?
#f #t #t #f #t #t
#f #f #f #f
#f #f #f #f
#f)))) #f)))

8
src/configure vendored
View File

@ -694,6 +694,7 @@ CGCOPTIONS
GC2OPTIONS GC2OPTIONS
MROPTIONS MROPTIONS
GCDIR GCDIR
XFORMFLAGS
MZBINTARGET MZBINTARGET
MZINSTALLTARGET MZINSTALLTARGET
EXTRA_GMP_OBJ EXTRA_GMP_OBJ
@ -4189,6 +4190,7 @@ fi
# If using gcc, we want all warnings: # If using gcc, we want all warnings:
if test "$CC" = "gcc" ; then if test "$CC" = "gcc" ; then
COMPFLAGS="$COMPFLAGS -Wall" COMPFLAGS="$COMPFLAGS -Wall"
XFORMFLAGS="$XFORMFLAGS --keep-lines"
# Use -MMD when we have gcc and gnumake: # Use -MMD when we have gcc and gnumake:
is_gmake=`make -v no-such-target-we-hope 2>&1 | grep "GNU Make"` is_gmake=`make -v no-such-target-we-hope 2>&1 | grep "GNU Make"`
@ -11809,6 +11811,7 @@ LIBS="$LIBS $EXTRALIBS"
mk_needed_dir() mk_needed_dir()
@ -12675,6 +12678,7 @@ CGCOPTIONS!$CGCOPTIONS$ac_delim
GC2OPTIONS!$GC2OPTIONS$ac_delim GC2OPTIONS!$GC2OPTIONS$ac_delim
MROPTIONS!$MROPTIONS$ac_delim MROPTIONS!$MROPTIONS$ac_delim
GCDIR!$GCDIR$ac_delim GCDIR!$GCDIR$ac_delim
XFORMFLAGS!$XFORMFLAGS$ac_delim
MZBINTARGET!$MZBINTARGET$ac_delim MZBINTARGET!$MZBINTARGET$ac_delim
MZINSTALLTARGET!$MZINSTALLTARGET$ac_delim MZINSTALLTARGET!$MZINSTALLTARGET$ac_delim
EXTRA_GMP_OBJ!$EXTRA_GMP_OBJ$ac_delim EXTRA_GMP_OBJ!$EXTRA_GMP_OBJ$ac_delim
@ -12691,7 +12695,6 @@ LIBSFX!$LIBSFX$ac_delim
WXLIBS!$WXLIBS$ac_delim WXLIBS!$WXLIBS$ac_delim
WXVARIANT!$WXVARIANT$ac_delim WXVARIANT!$WXVARIANT$ac_delim
ICP!$ICP$ac_delim ICP!$ICP$ac_delim
MRLIBINSTALL!$MRLIBINSTALL$ac_delim
_ACEOF _ACEOF
if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 97; then if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 97; then
@ -12733,6 +12736,7 @@ _ACEOF
ac_delim='%!_!# ' ac_delim='%!_!# '
for ac_last_try in false false false false false :; do for ac_last_try in false false false false false :; do
cat >conf$$subs.sed <<_ACEOF cat >conf$$subs.sed <<_ACEOF
MRLIBINSTALL!$MRLIBINSTALL$ac_delim
LIBFINISH!$LIBFINISH$ac_delim LIBFINISH!$LIBFINISH$ac_delim
MAKE_MRED!$MAKE_MRED$ac_delim MAKE_MRED!$MAKE_MRED$ac_delim
MAKE_WBUILD!$MAKE_WBUILD$ac_delim MAKE_WBUILD!$MAKE_WBUILD$ac_delim
@ -12773,7 +12777,7 @@ LIBOBJS!$LIBOBJS$ac_delim
LTLIBOBJS!$LTLIBOBJS$ac_delim LTLIBOBJS!$LTLIBOBJS$ac_delim
_ACEOF _ACEOF
if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 38; then if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 39; then
break break
elif $ac_last_try; then elif $ac_last_try; then
{ { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5

4
src/mred/gc2/Makefile.in
View File

@ -66,8 +66,8 @@ MZMMM = $(MZMMM_@WXVARIANT@)
XFORM_CMD = $(MZMMM) -cqu $(srcdir)/../../mzscheme/gc2/xform.ss --setup ../../mzscheme/gc2 XFORM_CMD = $(MZMMM) -cqu $(srcdir)/../../mzscheme/gc2/xform.ss --setup ../../mzscheme/gc2
XFORM_CPP_ARGS = -I$(srcdir)/../../mzscheme/gc2 $(NOGCINC) $(XINCLUDE) $(OPTIONS) @PREFLAGS@ $(XFORM_INC_@WXVARIANT@) @JPEG_INC@ @ZLIB_INC@ XFORM_CPP_ARGS = -I$(srcdir)/../../mzscheme/gc2 $(NOGCINC) $(XINCLUDE) $(OPTIONS) @PREFLAGS@ $(XFORM_INC_@WXVARIANT@) @JPEG_INC@ @ZLIB_INC@
XFORMXX = $(XFORM_CMD) --cpp "$(CXXCPP) $(XFORM_CPP_ARGS)" -o XFORMXX = $(XFORM_CMD) --cpp "$(CXXCPP) $(XFORM_CPP_ARGS)" @XFORMFLAGS@ -o
XFORM = $(XFORM_CMD) --cpp "$(CPP) $(XFORM_CPP_ARGS)" -o XFORM = $(XFORM_CMD) --cpp "$(CPP) $(XFORM_CPP_ARGS)" @XFORMFLAGS@ -o
XFORMDEP = $(srcdir)/../../mzscheme/gc2/xform.ss $(srcdir)/../../mzscheme/gc2/xform-mod.ss $(srcdir)/../../mzscheme/gc2/gc2.h XFORMDEP = $(srcdir)/../../mzscheme/gc2/xform.ss $(srcdir)/../../mzscheme/gc2/xform-mod.ss $(srcdir)/../../mzscheme/gc2/gc2.h
WXBDIR=../../wxxt WXBDIR=../../wxxt

2
src/mzscheme/configure.ac
View File

@ -419,6 +419,7 @@ fi
# If using gcc, we want all warnings: # If using gcc, we want all warnings:
if test "$CC" = "gcc" ; then if test "$CC" = "gcc" ; then
COMPFLAGS="$COMPFLAGS -Wall" COMPFLAGS="$COMPFLAGS -Wall"
XFORMFLAGS="$XFORMFLAGS --keep-lines"
# Use -MMD when we have gcc and gnumake: # Use -MMD when we have gcc and gnumake:
is_gmake=`make -v no-such-target-we-hope 2>&1 | grep "GNU Make"` is_gmake=`make -v no-such-target-we-hope 2>&1 | grep "GNU Make"`
@ -1309,6 +1310,7 @@ AC_SUBST(CGCOPTIONS)
AC_SUBST(GC2OPTIONS) AC_SUBST(GC2OPTIONS)
AC_SUBST(MROPTIONS) AC_SUBST(MROPTIONS)
AC_SUBST(GCDIR) AC_SUBST(GCDIR)
AC_SUBST(XFORMFLAGS)
AC_SUBST(MZBINTARGET) AC_SUBST(MZBINTARGET)
AC_SUBST(MZINSTALLTARGET) AC_SUBST(MZINSTALLTARGET)
AC_SUBST(EXTRA_GMP_OBJ) AC_SUBST(EXTRA_GMP_OBJ)

4
src/mzscheme/gc2/Makefile.in
View File

@ -25,12 +25,12 @@ LIBS = @LIBS@
DEF_COLLECTS_DIR = +D INITIAL_COLLECTS_DIRECTORY='"'"`cd $(srcdir)/../../../collects; pwd`"'"' DEF_COLLECTS_DIR = +D INITIAL_COLLECTS_DIRECTORY='"'"`cd $(srcdir)/../../../collects; pwd`"'"'
XFORM_SETUP = ../mzscheme@CGC@ -cqu $(srcdir)/xform.ss --setup . XFORM_SETUP = ../mzscheme@CGC@ -cqu $(srcdir)/xform.ss --setup .
XFORM_NOPRECOMP = $(XFORM_SETUP) --cpp "$(CPP) $(CPPFLAGS)" -o XFORM_NOPRECOMP = $(XFORM_SETUP) --cpp "$(CPP) $(CPPFLAGS)" @XFORMFLAGS@ -o
XSRCDIR = xsrc XSRCDIR = xsrc
XFORM = env XFORM_USE_PRECOMP=$(XSRCDIR)/precomp.h $(XFORM_NOPRECOMP) XFORM = env XFORM_USE_PRECOMP=$(XSRCDIR)/precomp.h $(XFORM_NOPRECOMP)
SRCDIR = $(srcdir)/../src SRCDIR = $(srcdir)/../src
XFORM_COMPACT_GC_NOPRECOMP = $(XFORM_SETUP) --cpp "$(CPP) $(CPPFLAGS) -DUSE_COMPACT_3M_GC" -o XFORM_COMPACT_GC_NOPRECOMP = $(XFORM_SETUP) --cpp "$(CPP) $(CPPFLAGS) -DUSE_COMPACT_3M_GC" @XFORMFLAGS@ -o
XFORM_COMPACT_GC = env XFORM_USE_PRECOMP=$(XSRCDIR)/precomp.h $(XFORM_COMPACT_GC_NOPRECOMP) XFORM_COMPACT_GC = env XFORM_USE_PRECOMP=$(XSRCDIR)/precomp.h $(XFORM_COMPACT_GC_NOPRECOMP)
FOREIGN_USED_OBJ = foreign.@LTO@ FOREIGN_USED_OBJ = foreign.@LTO@

5
src/mzscheme/gc2/xform-mod.ss
View File

@ -13,6 +13,8 @@
(define pgc? #t) (define pgc? #t)
(define pgc-really? #t) (define pgc-really? #t)
(define keep-lines? #f)
(define cpp #f) (define cpp #f)
(define file-in #f) (define file-in #f)
(define file-out #f) (define file-out #f)
@ -36,6 +38,8 @@
(set! palm? #t) (set! palm? #t)
(set! pgc? #f) (set! pgc? #f)
(set! pgc-really? #f)] (set! pgc-really? #f)]
[("--keep-lines") "keep source line information"
(set! keep-lines? #t)]
[("--cgc") "conservative collection mode" [("--cgc") "conservative collection mode"
(set! pgc-really? #f)] (set! pgc-really? #f)]
[("--cpp") cmdline "set CPP command line" [("--cpp") cmdline "set CPP command line"
@ -53,6 +57,7 @@
(xform #t cpp (xform #t cpp
file-in file-in
file-out file-out
keep-lines?
palm? pgc? pgc-really? palm? pgc? pgc-really?
precompiling-header? precompiled-header precompiling-header? precompiled-header
show-info? output-depends-info? show-info? output-depends-info?