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

simplifying code

Browse Source
This commit is contained in:
Danny Yoo 2011-04-28 16:47:47 -04:00
parent ba8e8d26af
commit e5509eecd3
1 changed files with 17 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
compiler.rkt
View File

@ -610,9 +610,8 @@
(make-EnvLexicalReference i #f) (make-EnvLexicalReference i #f)
'val))))]) 'val))))])
(append-instruction-sequences (append-instruction-sequences
(if (not (empty? (App-operands exp))) (make-instruction-sequence
(make-instruction-sequence `(,(make-PushEnvironment (length (App-operands exp)) #f))) `(,(make-PushEnvironment (length (App-operands exp)) #f)))
empty-instruction-sequence)
proc-code proc-code
(juggle-operands operand-codes) (juggle-operands operand-codes)
(make-instruction-sequence `(,(make-AssignImmediateStatement (make-instruction-sequence `(,(make-AssignImmediateStatement
@ -733,17 +732,13 @@
operand-knowledge)] operand-knowledge)]
[(stack-pushing-code) [(stack-pushing-code)
(if (empty? rest-operands) (make-instruction-sequence `(,(make-PushEnvironment
empty-instruction-sequence (length rest-operands)
(make-instruction-sequence `(,(make-PushEnvironment #f)))]
(length rest-operands)
#f))))]
[(stack-popping-code) [(stack-popping-code)
(if (empty? rest-operands) (make-instruction-sequence `(,(make-PopEnvironment
empty-instruction-sequence (make-Const (length rest-operands))
(make-instruction-sequence `(,(make-PopEnvironment (make-Const 0))))]
(make-Const (length rest-operands))
(make-Const 0)))))]
[(constant-operand-poss) [(constant-operand-poss)
(simple-operands->opargs constant-operands)] (simple-operands->opargs constant-operands)]
@ -922,9 +917,7 @@
(make-EnvLexicalReference i #f) (make-EnvLexicalReference i #f)
'val))))]) 'val))))])
(append-instruction-sequences (append-instruction-sequences
(if (not (empty? (App-operands exp))) (make-instruction-sequence `(,(make-PushEnvironment (length (App-operands exp)) #f)))
(make-instruction-sequence `(,(make-PushEnvironment (length (App-operands exp)) #f)))
empty-instruction-sequence)
proc-code proc-code
(juggle-operands operand-codes) (juggle-operands operand-codes)
arity-check arity-check
@ -1343,14 +1336,12 @@
linkage linkage
extended-cenv extended-cenv
(append-instruction-sequences (append-instruction-sequences
(if (> n 0) (make-instruction-sequence
(make-instruction-sequence `(,(make-PushEnvironment n (LetVoid-boxes? exp)))) `(,(make-PushEnvironment n (LetVoid-boxes? exp))))
empty-instruction-sequence)
body-code body-code
after-body-code after-body-code
(if (> n 0) (make-instruction-sequence
(make-instruction-sequence `(,(make-PopEnvironment (make-Const n) (make-Const 0)))) `(,(make-PopEnvironment (make-Const n) (make-Const 0))))
empty-instruction-sequence)
after-let)))) after-let))))
@ -1388,9 +1379,8 @@
linkage linkage
extended-cenv extended-cenv
(append-instruction-sequences (append-instruction-sequences
(if (> n 0) (make-instruction-sequence
(make-instruction-sequence `(,(make-PushEnvironment n #f))) `(,(make-PushEnvironment n #f)))
empty-instruction-sequence)
;; Install each of the closure shells ;; Install each of the closure shells
(apply append-instruction-sequences (apply append-instruction-sequences
@ -1418,9 +1408,8 @@
(compile (LetRec-body exp) extended-cenv (adjust-target-depth target n) letrec-linkage) (compile (LetRec-body exp) extended-cenv (adjust-target-depth target n) letrec-linkage)
after-body-code after-body-code
(if (> n 0)
(make-instruction-sequence `(,(make-PopEnvironment (make-Const n) (make-Const 0)))) (make-instruction-sequence `(,(make-PopEnvironment (make-Const n) (make-Const 0))))))))
empty-instruction-sequence)))))