From c8ad7426e28d753816239c4fd17e11e5619db3ed Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Mon, 21 Oct 2013 16:32:36 +0200 Subject: [PATCH] add lookup-block-scope * module/language/cps/dfg.scm (lookup-block-scope): New interface. (visit-fun): Give a bit more info if link-blocks! fails. --- module/language/cps/dfg.scm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/module/language/cps/dfg.scm b/module/language/cps/dfg.scm index 1f7a78764..d81a52b6d 100644 --- a/module/language/cps/dfg.scm +++ b/module/language/cps/dfg.scm @@ -50,6 +50,7 @@ lookup-uses lookup-predecessors lookup-successors + lookup-block-scope find-call call-expression find-expression @@ -599,7 +600,7 @@ (let ((pred-block (hashq-ref blocks pred)) (succ-block (hashq-ref blocks succ))) (unless (and pred-block succ-block) - (error "internal error")) + (error "internal error" pred-block succ-block)) (set-block-succs! pred-block (cons succ (block-succs pred-block))) (set-block-preds! succ-block (cons pred (block-preds succ-block))))) @@ -727,6 +728,9 @@ (($ $use-map name sym def uses) uses))))) +(define (lookup-block-scope k dfg) + (block-scope (lookup-block k (dfg-blocks dfg)))) + (define (lookup-predecessors k dfg) (match (lookup-block k (dfg-blocks dfg)) (($ $block _ _ preds succs) preds)))