Catch edge case with lambda app, cleanup debug tracing

This commit is contained in:
Justin Ethier 2019-01-07 13:13:20 -05:00
parent a8f2b11f78
commit adb703c321

View file

@ -25,7 +25,7 @@
;; symbol -> hash-table -> boolean ;; symbol -> hash-table -> boolean
;; Is it OK to inline code replacing ref, based on call graph data from lookup table? ;; Is it OK to inline code replacing ref, based on call graph data from lookup table?
(define (inline-ok-from-call-graph? ref tbl) (define (inline-ok-from-call-graph? ref tbl)
(let ((result ;(let ((result
(let ((vars (hash-table-ref/default tbl ref #f))) (let ((vars (hash-table-ref/default tbl ref #f)))
(call/cc (call/cc
(lambda (return) (lambda (return)
@ -41,9 +41,9 @@
) )
(cdr vars))) ;; Skip ref itself (cdr vars))) ;; Skip ref itself
(return #t))))) (return #t)))))
) ;)
(trace:error `(inline-ok-from-call-graph? ,ref ,result ,(hash-table-ref/default tbl ref #f))) ;(trace:error `(inline-ok-from-call-graph? ,ref ,result ,(hash-table-ref/default tbl ref #f)))
result)) ;result))
;; Analyze call graph. The goal is to be able to figure out which variables a primitive call ;; Analyze call graph. The goal is to be able to figure out which variables a primitive call
@ -92,12 +92,17 @@ result))
(lambda (e) (lambda (e)
(scan e vars)) (scan e vars))
(ast:lambda-formals->list (car exp))) (ast:lambda-formals->list (car exp)))
;; Scan body, with reset vars (??) ;; Scan body, with reset vars (??)
(for-each (for-each
(lambda (e) (lambda (e)
(scan e '())) (scan e '()))
(ast:lambda-body (car exp)))) (ast:lambda-body (car exp)))
;; Scan lambda arg(s), again also with reset vars
(for-each
(lambda (e)
(scan e '()))
(cdr exp))
)
((and (ref? (car exp)) ((and (ref? (car exp))
(list? exp) (list? exp)
(> (length exp) 1)) (> (length exp) 1))
@ -125,7 +130,9 @@ result))
(cond-expand (cond-expand
(program (program
(define trace:error write) (define (trace:error exp)
(write exp)
(newline))
(define sexp (define sexp
'( '(