76 lines
2.1 KiB
Racket
76 lines
2.1 KiB
Racket
#lang typed/racket/base
|
|
|
|
;; Does some basic optimizations at the level of basic blocks.
|
|
|
|
|
|
(require "assemble-structs.rkt"
|
|
"../compiler/il-structs.rkt"
|
|
racket/list)
|
|
|
|
|
|
(require/typed "../logger.rkt" [log-debug (String -> Void)])
|
|
|
|
|
|
(provide optimize-basic-blocks)
|
|
|
|
|
|
(define-type Blockht (HashTable Symbol BasicBlock))
|
|
|
|
;; We want maps from unlabeled statements to their respective blocks.
|
|
(define-type Bodyht (HashTable (Listof UnlabeledStatement) (Listof Symbol)))
|
|
|
|
|
|
(: optimize-basic-blocks ((Listof BasicBlock) -> (Listof BasicBlock)))
|
|
(define (optimize-basic-blocks blocks)
|
|
|
|
(: blockht : Blockht)
|
|
(define blockht (make-hasheq))
|
|
|
|
(: bodyht : Bodyht)
|
|
(define bodyht (make-hasheq))
|
|
|
|
;; First, scan through the blocks, and pick up their names and bodies.
|
|
(for ([b blocks])
|
|
(hash-set! blockht (BasicBlock-name b) b)
|
|
|
|
(when (hash-has-key? bodyht (BasicBlock-stmts b))
|
|
(log-debug (format "block ~a has the same content as another block" (BasicBlock-name b))))
|
|
(hash-set! bodyht (BasicBlock-stmts b)
|
|
(cons (BasicBlock-name b)
|
|
(hash-ref bodyht (BasicBlock-stmts b) (lambda () '())))))
|
|
|
|
blocks
|
|
#;(define inlined-blocks
|
|
(map (lambda: ([b : BasicBlock])
|
|
(optimize-block b blockht))
|
|
blocks))
|
|
#;inlined-blocks)
|
|
|
|
|
|
|
|
|
|
(: optimize-block (BasicBlock Blockht -> BasicBlock))
|
|
;; Simple optimization: optimize away single-statement goto blocks with their
|
|
;; immediate contents.
|
|
(define (optimize-block b blocks)
|
|
(define stmts (BasicBlock-stmts b))
|
|
(cond
|
|
[(= (length stmts) 1)
|
|
(define first-stmt (first stmts))
|
|
(cond
|
|
[(GotoStatement? first-stmt)
|
|
(define target (GotoStatement-target first-stmt))
|
|
(cond
|
|
[(Label? target)
|
|
(log-debug (format "inlining basic block ~a" (BasicBlock-name b)))
|
|
(optimize-block (make-BasicBlock (BasicBlock-name b)
|
|
(BasicBlock-stmts
|
|
(hash-ref blocks (Label-name target))))
|
|
blocks)]
|
|
[else
|
|
b])]
|
|
[else
|
|
b])]
|
|
[else
|
|
b]))
|