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

squashing labels

Browse Source
This commit is contained in:
Danny Yoo 2011-07-30 19:55:52 -04:00
parent 72392a7a4c
commit 875f270aa6
1 changed files with 123 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

134
compiler/optimize-il.rkt
View File

@ -17,9 +17,10 @@
(define (optimize-il statements) (define (optimize-il statements)
;; For now, replace pairs of PushEnvironment / AssignImmediate(0, ...) ;; For now, replace pairs of PushEnvironment / AssignImmediate(0, ...)
;; We should do some more optimizations here, like peephole... ;; We should do some more optimizations here, like peephole...
(let* ([statements (filter not-no-op? statements)]) (let* ([statements (filter not-no-op? statements)]
(flatten-adjacent-labels [statements (eliminate-no-ops statements)]
(eliminate-no-ops statements)))) [statements (flatten-adjacent-labels statements)])
statements))
@ -57,27 +58,138 @@
(: rewrite-target (Target -> Target)) (: rewrite-target (Target -> Target))
(define (rewrite-target target) (define (rewrite-target target)
;; fixme
target) target)
(: rewrite-oparg (OpArg -> OpArg)) (: rewrite-oparg (OpArg -> OpArg))
(define (rewrite-oparg oparg) (define (rewrite-oparg oparg)
;; fixme (cond
oparg) [(Const? oparg)
oparg]
[(Label? oparg)
(make-Label (ref (Label-name oparg)))]
[(Reg? oparg)
oparg]
[(EnvLexicalReference? oparg)
oparg]
[(EnvPrefixReference? oparg)
oparg]
[(EnvWholePrefixReference? oparg)
oparg]
[(SubtractArg? oparg)
oparg]
[(ControlStackLabel? oparg)
oparg]
[(ControlStackLabel/MultipleValueReturn? oparg)
oparg]
[(ControlFrameTemporary? oparg)
oparg]
[(CompiledProcedureEntry? oparg)
oparg]
[(CompiledProcedureClosureReference? oparg)
oparg]
[(ModuleEntry? oparg)
oparg]
[(IsModuleInvoked? oparg)
oparg]
[(IsModuleLinked? oparg)
oparg]
[(PrimitiveKernelValue? oparg)
oparg]
[(VariableReference? oparg)
oparg]))
(: rewrite-primop (PrimitiveOperator -> PrimitiveOperator)) (: rewrite-primop (PrimitiveOperator -> PrimitiveOperator))
(define (rewrite-primop op) (define (rewrite-primop op)
;; fixme (cond
op) [(GetCompiledProcedureEntry? op)
op]
[(MakeCompiledProcedure? op)
(make-MakeCompiledProcedure (ref (MakeCompiledProcedure-label op))
(MakeCompiledProcedure-arity op)
(MakeCompiledProcedure-closed-vals op)
(MakeCompiledProcedure-display-name op))]
[(MakeCompiledProcedureShell? op)
(make-MakeCompiledProcedureShell (ref (MakeCompiledProcedureShell-label op))
(MakeCompiledProcedureShell-arity op)
(MakeCompiledProcedureShell-display-name op))]
[(ApplyPrimitiveProcedure? op)
op]
[(MakeBoxedEnvironmentValue? op)
op]
[(CaptureEnvironment? op)
op]
[(CaptureControl? op)
op]
[(CallKernelPrimitiveProcedure? op)
op]))
(: rewrite-primcmd (PrimitiveCommand -> PrimitiveCommand)) (: rewrite-primcmd (PrimitiveCommand -> PrimitiveCommand))
(define (rewrite-primcmd cmd) (define (rewrite-primcmd cmd)
;; fixme (cond
cmd) [(InstallModuleEntry!? cmd)
(make-InstallModuleEntry! (InstallModuleEntry!-name cmd)
(InstallModuleEntry!-path cmd)
(ref (InstallModuleEntry!-entry-point cmd)))]
[else
cmd]
;; [(CheckToplevelBound!? cmd)
;; cmd]
;; [(CheckClosureArity!? cmd)
;; cmd]
;; [(CheckPrimitiveArity!? cmd)
;; cmd]
;; [(ExtendEnvironment/Prefix!? cmd)
;; cmd]
;; [(InstallClosureValues!? cmd)
;; cmd]
;; [(FixClosureShellMap!? cmd)
;; cmd]
;; [(InstallContinuationMarkEntry!? cmd)
;; cmd]
;; [(SetFrameCallee!? cmd)
;; cmd]
;; [(SpliceListIntoStack!? cmd)
;; cmd]
;; [(UnspliceRestFromStack!? cmd)
;; cmd]
;; [(RaiseContextExpectedValuesError!? cmd)
;; cmd]
;; [(RaiseArityMismatchError!? cmd)
;; cmd]
;; [(RaiseOperatorApplicationError!? cmd)
;; cmd]
;; [(RaiseUnimplementedPrimitiveError!? cmd)
;; cmd]
;; [(RestoreEnvironment!? cmd)
;; cmd]
;; [(RestoreControl!? cmd)
;; cmd]
;; [(MarkModuleInvoked!? cmd)
;; cmd]
;; [(AliasModuleAsMain!? cmd)
;; cmd]
;; [(FinalizeModuleInvokation!? cmd)
;; cmd]
))
(: rewrite-primtest (PrimitiveTest -> PrimitiveTest)) (: rewrite-primtest (PrimitiveTest -> PrimitiveTest))
(define (rewrite-primtest test) (define (rewrite-primtest test)
;; fixme
test) test)