diff --git a/collects/typed-racket/optimizer/tool/inlining.rkt b/collects/typed-racket/optimizer/tool/inlining.rkt index d5cd4a0094..d1d734b850 100644 --- a/collects/typed-racket/optimizer/tool/inlining.rkt +++ b/collects/typed-racket/optimizer/tool/inlining.rkt @@ -20,9 +20,9 @@ ;;; This is similar in spirit to the post-processing done for missed-opts in ;;; the TR logger. -(define (success? l) (equal? success-regexp (log-entry-kind l))) -(define (failure? l) (equal? failure-regexp (log-entry-kind l))) -(define (out-of-fuel? l) (equal? out-of-fuel-regexp (log-entry-kind l))) +(define (success? l) (equal? success-key (log-entry-kind l))) +(define (failure? l) (equal? failure-key (log-entry-kind l))) +(define (out-of-fuel? l) (equal? out-of-fuel-key (log-entry-kind l))) ;; f gets inlined in f (or tried to) (define (self-inline? l) diff --git a/collects/typed-racket/optimizer/tool/instrumentation.rkt b/collects/typed-racket/optimizer/tool/instrumentation.rkt index fd6889815d..85238100c2 100644 --- a/collects/typed-racket/optimizer/tool/instrumentation.rkt +++ b/collects/typed-racket/optimizer/tool/instrumentation.rkt @@ -55,20 +55,47 @@ ;;;; Inlining pre-processing -(provide success-regexp failure-regexp out-of-fuel-regexp) +(provide success-key failure-key out-of-fuel-key) ;;; Low-level log parsing. Goes from strings to log-entry structs. +(define success-key 'inlining) +(define failure-key 'no-inlining) +(define out-of-fuel-key 'out-of-fuel) -(define success-regexp "inlining: ") -(define failure-regexp "no inlining: ") -(define out-of-fuel-regexp "no inlining, out of fuel: ") -(define any-inlining-event-regexp - (format "^optimizer: (~a)" (string-join (list success-regexp - failure-regexp - out-of-fuel-regexp) - "|"))) +;; Inliner logs contain path literals, which are not readable. +;; Use a custom reader to parse the logs. +;; At this point, the #< has already been seen. +;; For now, returns a string. Maybe return a path eventually. +(define (read-path port) + (let ([s (open-output-string)]) + (unless (string=? (read-string 5 port) "path:") + (error "OC path reader: bad path syntax")) + (let loop ([c (read-char port)]) + ;; parse until the closing > + (cond [(eof-object? c) + (error "OC path reader: bad path syntax")] + [(not (equal? c #\>)) + (write-char c s) + (loop (read-char port))] + [else + ;; we saw the closing broket, we're done + (values (get-output-string s))])))) +(define path-readtable + (make-readtable + (current-readtable) + #\< + 'dispatch-macro + (case-lambda + [(char port) ; read + (read-path port)] + [(char port src line col pos) ; read-syntax + (error "OC path reader: read-syntax is not supported")]))) +(define (read/path s) + (parameterize ([current-readtable path-readtable] + [current-input-port (open-input-string s)]) + (read))) ;; String (message from the mzc optimizer) -> log-entry (define (mzc-opt-log-message->log-entry l) @@ -76,68 +103,67 @@ (define forged-stx (inlining-event->forged-stx evt)) (define kind (match (inlining-event-kind evt) - [(and k (== success-regexp)) success-regexp] - [(and k (== failure-regexp)) failure-regexp] - [(and k (== out-of-fuel-regexp)) out-of-fuel-regexp] + [(== success-key) success-key] + [(== failure-key) failure-key] + [(== out-of-fuel-key) out-of-fuel-key] [_ (error "Unknown log message type" l)])) (inliner-log-entry kind kind forged-stx forged-stx (syntax-position forged-stx) evt)) -(define inlining-event-regexp - ;; Last bit is `generated?'. We don't care about that. - ;; The middle elements of the vector are numbers of #f. +;; _Where_ this happens (in which function, can't get more precise info). +;; Note: sadly, this part still needs to be parsed by a regexp. Inliner logging +;; doesn't have control over the format for that part. Since it may include +;; unquoted paths, which can include spaces, can't really use the reader +;; approach. Backslashes are doubled before we get here, to handle Windows +;; paths. +(define where-regexp (string-append - ;; Attempt at making this thing readable. - any-inlining-event-regexp - "involving: " - ;; _What_ gets inlined (or not). - (string-append ; either a vector with name and source info, or just name - "(" - "#\\(([^ ]+) " - "(" "#" "|" "([^ ]+)" ")" - " ([^ ]+) ([^ ]+) ([^ ]+) ([^ ]+) [^ ]+\\)" - "|" - "([^ ]+)" ; just name, we won't be able to do much with it - ")") - ;; _Where_ this happens (in which function, can't get more precise info). - (string-append - ;; maybe full path info: path, line, col, name - ;; path allows `:' as the second character (and first, but not a problem) - ;; to support absolute windows paths (e.g. C:\...) - "( in: (([^ :]?[^ ]?[^:]+):([^ :]+):([^ :]+): )?([^ ]+))?" - ;; maybe module info, useless to us (at least for now) - "( in module: [^ ]+)?") - " size: ([^ ]+) threshold: ([^ ]+)" - "$")) + ;; maybe full path info: path, line, col, name + ;; path allows `:' as the second character (and first, but not a problem) + ;; to support absolute windows paths (e.g. C:\...) + "( in: (([^ :]?[^ ]?[^:]+):([^ :]+):([^ :]+): )?([^ ]+))?" + ;; maybe module info, useless to us (at least for now) + "( in module: [^ ]+)?")) +(define (parse-where l) + (match (regexp-match where-regexp l) + [`(,all + ,where ,where-loc ,where-path ,where-line ,where-col ,where-name + ,maybe-module-info) + (values (and where-name (string->symbol where-name)) + (if where-loc + (list where-path + (string->number where-line) + (string->number where-col)) + #f))])) ; no source location (define (parse-inlining-event l) - (match (regexp-match inlining-event-regexp l) - [`(,all ,kind - ,what ,name ,path ,file-path ,unsaved-path ,line ,col ,pos ,span - ,only-name - ,where ,where-loc ,where-path ,where-line ,where-col ,where-name - ,maybe-module-info - ,size ,threshold) + ;; Inlining log entry strings consist of two parts. + ;; The first is `read'-able, given the custom reader above that can + ;; read path literals. + ;; The second part needs to be parsed with a regexp (see above). + ;; The two are separated by "#", which shouldn't clash with + ;; program identifiers. + (match-define `(,readable-part ,parsable-part) + (regexp-split #rx"#" l)) + (match (read/path (format "(~a)" readable-part)) + [`(optimizer: ,kind ,what + size: ,size threshold: ,threshold) + (define-values (what-name what-loc) + (match what + [`#(,what-name ,what-path ,what-line ,what-col ,what-pos ,what-span ,gen?) + (values what-name + (list what-path what-line what-col what-pos what-span))] + [only-name + (values only-name #f)])) + (define-values (where-name where-loc) + (parse-where parsable-part)) (inlining-event kind - (string->symbol (or name only-name)) - (if only-name - #f ; no source location - (list (or file-path unsaved-path) - (string->number line) - (string->number col) - (string->number pos) - (string->number span))) - where-name - (if where-loc - (list where-path - (string->number where-line) - (string->number where-col)) - #f) ; no source location - (string->number size) - (string->number threshold))] - [_ (error "ill-formed inlining log entry" l)])) + what-name what-loc + where-name where-loc + size threshold)] + [_ (error "OC log parser: ill-formed inlining log entry" l)])) (define (inlining-event->forged-stx evt) @@ -152,96 +178,52 @@ ;; log parsing tests - (define (parse l) (regexp-match inlining-event-regexp l)) - ;; Windows path - (check-equal? (parse "optimizer: no inlining, out of fuel: involving: #(.../private/map.rkt:22:14 # 22 14 620 335 #t) in: C:\\Users\\bernardip\\Documents\\Scheme\\fotografia.rkt:23:0: prova2 in module: 'anonymous-module size: 55 threshold: 8") - '("optimizer: no inlining, out of fuel: involving: #(.../private/map.rkt:22:14 # 22 14 620 335 #t) in: C:\\Users\\bernardip\\Documents\\Scheme\\fotografia.rkt:23:0: prova2 in module: 'anonymous-module size: 55 threshold: 8" - "no inlining, out of fuel: " - "#(.../private/map.rkt:22:14 # 22 14 620 335 #t)" - ".../private/map.rkt:22:14" - "#" - "C:\\Users\\bernardip\\Documents\\Local\\RacketPortable\\App\\Racket\\collects\\racket\\private\\map.rkt" - #f - "22" - "14" - "620" - "335" - #f - " in: C:\\Users\\bernardip\\Documents\\Scheme\\fotografia.rkt:23:0: prova2" - "C:\\Users\\bernardip\\Documents\\Scheme\\fotografia.rkt:23:0: " - "C:\\Users\\bernardip\\Documents\\Scheme\\fotografia.rkt" - "23" - "0" - "prova2" - " in module: 'anonymous-module" - "55" - "8")) + (check-equal? + (parse-inlining-event "optimizer: out-of-fuel #(.../private/map.rkt:22:14 # 22 14 620 335 #t) size: 55 threshold: 8# in: C:\\Users\\bernardip\\Documents\\Scheme\\fotografia.rkt:23:0: prova2 in module: 'anonymous-module") + (inlining-event + 'out-of-fuel '.../private/map.rkt:22:14 + (list "C:\\Users\\bernardip\\Documents\\Local\\RacketPortable\\App\\Racket\\collects\\racket\\private\\map.rkt" 22 14 620 335) + 'prova2 + (list "C:\\Users\\bernardip\\Documents\\Scheme\\fotografia.rkt" 23 0) + 55 8)) - (check-equal? (parse "optimizer: no inlining, out of fuel: involving: #(sqr # 35 2 838 93 #f) in: /home/stamourv/src/examples/example-shapes.rkt:41:0: inC in module: 'example-shapes size: 21 threshold: 6") - '("optimizer: no inlining, out of fuel: involving: #(sqr # 35 2 838 93 #f) in: /home/stamourv/src/examples/example-shapes.rkt:41:0: inC in module: 'example-shapes size: 21 threshold: 6" - "no inlining, out of fuel: " - "#(sqr # 35 2 838 93 #f)" - "sqr" - "#" - "/home/stamourv/src/plt/collects/racket/math.rkt" - #f - "35" - "2" - "838" - "93" - #f - " in: /home/stamourv/src/examples/example-shapes.rkt:41:0: inC" - "/home/stamourv/src/examples/example-shapes.rkt:41:0: " - "/home/stamourv/src/examples/example-shapes.rkt" - "41" - "0" - "inC" - " in module: 'example-shapes" - "21" - "6")) + (check-equal? + (parse-inlining-event "optimizer: out-of-fuel #(sqr # 35 2 838 93 #f) size: 21 threshold: 6# in: /home/stamourv/src/examples/example-shapes.rkt:41:0: inC in module: 'example-shapes") + (inlining-event + 'out-of-fuel 'sqr + (list "/home/stamourv/src/plt/collects/racket/math.rkt" 35 2 838 93) + 'inC (list "/home/stamourv/src/examples/example-shapes.rkt" 41 0) + 21 6)) - (check-equal? (parse "optimizer: inlining: involving: #(inC # 41 0 993 165 #f) in: /home/stamourv/src/examples/example-shapes.rkt:27:0: in in module: 'example-shapes size: 41 threshold: 128") - '("optimizer: inlining: involving: #(inC # 41 0 993 165 #f) in: /home/stamourv/src/examples/example-shapes.rkt:27:0: in in module: 'example-shapes size: 41 threshold: 128" - "inlining: " - "#(inC # 41 0 993 165 #f)" - "inC" - "#" - "/home/stamourv/src/examples/example-shapes.rkt" - #f - "41" - "0" - "993" - "165" - #f - " in: /home/stamourv/src/examples/example-shapes.rkt:27:0: in" - "/home/stamourv/src/examples/example-shapes.rkt:27:0: " - "/home/stamourv/src/examples/example-shapes.rkt" - "27" - "0" - "in" - " in module: 'example-shapes" - "41" - "128")) - (check-equal? (parse "optimizer: no inlining, out of fuel: involving: #(sqr # 35 2 838 93 #f) in: /Users/user/Desktop/Optimization Coach/example-shapes.rkt:41:0: inC in module: 'anonymous-module size: 21 threshold: 6") - '("optimizer: no inlining, out of fuel: involving: #(sqr # 35 2 838 93 #f) in: /Users/user/Desktop/Optimization Coach/example-shapes.rkt:41:0: inC in module: 'anonymous-module size: 21 threshold: 6" - "no inlining, out of fuel: " - "#(sqr # 35 2 838 93 #f)" - "sqr" - "#" - "/Applications/Racket v5.3/collects/racket/math.rkt" - #f - "35" - "2" - "838" - "93" - #f - " in: /Users/user/Desktop/Optimization Coach/example-shapes.rkt:41:0: inC" - "/Users/user/Desktop/Optimization Coach/example-shapes.rkt:41:0: " - "/Users/user/Desktop/Optimization Coach/example-shapes.rkt" - "41" - "0" - "inC" - " in module: 'anonymous-module" - "21" - "6"))) + (check-equal? + (parse-inlining-event "optimizer: inlining #(inC # 41 0 993 165 #f) size: 41 threshold: 128# in: /home/stamourv/src/examples/example-shapes.rkt:27:0: in in module: 'example-shapes") + (inlining-event + 'inlining 'inC + (list "/home/stamourv/src/examples/example-shapes.rkt" 41 0 993 165) + 'in (list "/home/stamourv/src/examples/example-shapes.rkt" 27 0) + 41 128)) + + (check-equal? + (parse-inlining-event "optimizer: out-of-fuel #(sqr # 35 2 838 93 #f) size: 21 threshold: 6# in: /Users/user/Desktop/Optimization Coach/example-shapes.rkt:41:0: inC in module: 'anonymous-module") + (inlining-event + 'out-of-fuel 'sqr + (list "/Applications/Racket v5.3/collects/racket/math.rkt" 35 2 838 93) + 'inC (list "/Users/user/Desktop/Optimization Coach/example-shapes.rkt" 41 0) + 21 6)) + + (check-equal? + (parse-inlining-event + "optimizer: inlining #(f unsaved-editor590 2 0 20 14 #f) size: 0 threshold: 64# in: unsaved-editor590:3:0: g in module: 'anonymous-module") + (inlining-event + 'inlining 'f (list 'unsaved-editor590 2 0 20 14) + 'g (list "unsaved-editor590" 3 0) + 0 64)) + + (check-equal? + (parse-inlining-event + "optimizer: inlining #(g unsaved-editor590 3 0 35 16 #f) size: 0 threshold: 64# in module: 'anonymous-module") + (inlining-event + 'inlining 'g (list 'unsaved-editor590 3 0 35 16) + #f #f 0 64)) + ) diff --git a/collects/typed-racket/optimizer/tool/structs.rkt b/collects/typed-racket/optimizer/tool/structs.rkt index 4b1a77c2d7..8d33f9c1d0 100644 --- a/collects/typed-racket/optimizer/tool/structs.rkt +++ b/collects/typed-racket/optimizer/tool/structs.rkt @@ -40,4 +40,5 @@ size ; size of the closure being inlined threshold ; how big of a closure can we inline ;; the last two use the same units - )) + ) + #:transparent) diff --git a/src/racket/src/optimize.c b/src/racket/src/optimize.c index d33df98a8d..b304849285 100644 --- a/src/racket/src/optimize.c +++ b/src/racket/src/optimize.c @@ -1540,11 +1540,11 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a scheme_log(info->logger, SCHEME_LOG_DEBUG, 0, - "inlining: involving: %s%s size: %d threshold: %d", + "inlining %s size: %d threshold: %d#%s", scheme_write_to_string(data->name ? data->name : scheme_false, NULL), - scheme_optimize_context_to_string(info->context), sz, - threshold); + threshold, + scheme_optimize_context_to_string(info->context)); le = apply_inlined(le, data, sub_info, argc, app, app2, app3, context, nested_count, orig_le, prev, prev_offset); if (nested_count) @@ -1555,11 +1555,11 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a scheme_log(info->logger, SCHEME_LOG_DEBUG, 0, - "no inlining: involving: %s%s size: %d threshold: %d", + "no-inlining %s size: %d threshold: %d#%s", scheme_write_to_string(data->name ? data->name : scheme_false, NULL), - scheme_optimize_context_to_string(info->context), sz, - threshold); + threshold, + scheme_optimize_context_to_string(info->context)); } } else { LOG_INLINE(fprintf(stderr, "No fuel %s %d[%d]>%d@%d %d\n", scheme_write_to_string(data->name ? data->name : scheme_false, NULL), @@ -1568,11 +1568,11 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a scheme_log(info->logger, SCHEME_LOG_DEBUG, 0, - "no inlining, out of fuel: involving: %s%s size: %d threshold: %d", + "out-of-fuel %s size: %d threshold: %d#%s", scheme_write_to_string(data->name ? data->name : scheme_false, NULL), - scheme_optimize_context_to_string(info->context), sz, - threshold); + threshold, + scheme_optimize_context_to_string(info->context)); } } else { /* Issue warning below */ @@ -3567,22 +3567,22 @@ int scheme_compiled_propagate_ok(Scheme_Object *value, Optimize_Info *info) 0, /* actual cause: contains non-copyable body elements that prevent inlining */ /* TODO have OC recognize this as a separate event instead of reusing failure */ - "no inlining: involving: %s%s size: %d threshold: %d", + "no-inlining %s size: %d threshold: %d#%s", scheme_write_to_string(data->name ? data->name : scheme_false, NULL), - scheme_optimize_context_to_string(info->context), sz, - 0); /* TODO no sensible threshold here */ + 0, /* TODO no sensible threshold here */ + scheme_optimize_context_to_string(info->context)); else scheme_log(info->logger, SCHEME_LOG_DEBUG, 0, /* actual cause: too big for an inlining candidate */ /* TODO have OC recognize this as a separate event instead of reusing OOF */ - "no inlining, out of fuel: involving: %s%s size: %d threshold: %d", + "out-of-fuel %s size: %d threshold: %d#%s", scheme_write_to_string(data->name ? data->name : scheme_false, NULL), - scheme_optimize_context_to_string(info->context), sz, - 0); /* TODO no sensible threshold here */ + 0, /* TODO no sensible threshold here */ + scheme_optimize_context_to_string(info->context)); return 0; }