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

adding pushimmediateontoenvironment

Browse Source
This commit is contained in:
Danny Yoo 2011-04-10 21:25:52 -04:00
parent 5952ca7cf3
commit 66a2d6b0ef
5 changed files with 54 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
assemble.rkt
View File

@ -200,6 +200,8 @@ EOF
empty]
[(PopEnvironment? stmt)
empty]
[(PushImmediateOntoEnvironment? stmt)
(collect-input (PushImmediateOntoEnvironment-value stmt))]
[(PushControlFrame? stmt)
(list (PushControlFrame-label stmt))]
[(PushControlFrame/Prompt? stmt)
@ -298,7 +300,13 @@ EOF
(format "MACHINE.env.splice(MACHINE.env.length - (~a + ~a), ~a);"
(assemble-oparg (PopEnvironment-skip stmt))
(assemble-oparg (PopEnvironment-n stmt))
(assemble-oparg (PopEnvironment-n stmt)))]))])))
(assemble-oparg (PopEnvironment-n stmt)))]))]
[(PushImmediateOntoEnvironment? stmt)
(format "MACHINE.env.push(~a)"
(cond [(PushImmediateOntoEnvironment-box? stmt)
(format "[~a]" (assemble-oparg (PushImmediateOntoEnvironment-value stmt)))
(assemble-oparg (PushImmediateOntoEnvironment-value stmt))]))])))
(: ensure-natural (Any -> Natural))

28
compile.rkt
View File

@ -4,6 +4,7 @@
"lexical-structs.rkt"
"il-structs.rkt"
"kernel-primitives.rkt"
"optimize-il.rkt"
racket/bool
racket/list)
@ -23,19 +24,20 @@
(define (-compile exp target linkage)
(let ([after-lam-bodies (make-label 'afterLamBodies)]
[before-pop-prompt (make-label 'beforePopPrompt)])
(statements
(append-instruction-sequences
(make-instruction-sequence
`(,(make-GotoStatement (make-Label after-lam-bodies))))
(compile-lambda-bodies (collect-all-lams exp))
after-lam-bodies
(make-instruction-sequence
`(,(make-PushControlFrame/Prompt default-continuation-prompt-tag
before-pop-prompt)))
(compile exp '() target prompt-linkage)
before-pop-prompt))))
(optimize-il
(statements
(append-instruction-sequences
(make-instruction-sequence
`(,(make-GotoStatement (make-Label after-lam-bodies))))
(compile-lambda-bodies (collect-all-lams exp))
after-lam-bodies
(make-instruction-sequence
`(,(make-PushControlFrame/Prompt default-continuation-prompt-tag
before-pop-prompt)))
(compile exp '() target prompt-linkage)
before-pop-prompt)))))
(define-struct: lam+cenv ([lam : Lam]
[cenv : CompileTimeEnvironment]))

9
il-structs.rkt
View File

@ -71,6 +71,9 @@
PopEnvironment
PushEnvironment
PushImmediateOntoEnvironment
PushControlFrame
PushControlFrame/Prompt
@ -98,6 +101,12 @@
#:transparent)
;; Evaluate the value, and then push it onto the top of the environment.
(define-struct: PushImmediateOntoEnvironment ([value : OpArg]
[box? : Boolean])
#:transparent)
(define-struct: PopControlFrame ()
#:transparent)
(define-struct: PopControlFrame/Prompt ()

13
optimize-il.rkt Normal file
View File

@ -0,0 +1,13 @@
#lang typed/racket/base
(require "il-structs.rkt")
(provide optimize-il)
;; perform optimizations on the intermediate language.
;;
(: optimize-il ((Listof Statement) -> (Listof Statement)))
(define (optimize-il statements)
statements)

8
simulator.rkt
View File

@ -103,6 +103,8 @@
(step-pop-environment! m i)]
[(PushEnvironment? i)
(step-push-environment! m i)]
[(PushImmediateOntoEnvironment? i)
(step-push-immediate-onto-environment! m i)]
[(PushControlFrame? i)
(step-push-control-frame! m i)]
[(PushControlFrame/Prompt? i)
@ -156,6 +158,12 @@
(ensure-natural (evaluate-oparg m (PopEnvironment-n stmt)))
(ensure-natural (evaluate-oparg m (PopEnvironment-skip stmt)))))
(: step-push-immediate-onto-environment! (machine PushImmediateOntoEnvironment -> 'ok))
(define (step-push-immediate-onto-environment! m stmt)
(let ([t (make-EnvLexicalReference 0 (PushImmediateOntoEnvironment-box? stmt))]
[v (evaluate-oparg m (PushImmediateOntoEnvironment-value stmt))])
(step-push-environment! m (make-PushEnvironment 1 (PushImmediateOntoEnvironment-box? stmt)))
((get-target-updater t) m v)))
(: step-push-control-frame! (machine PushControlFrame -> 'ok))
(define (step-push-control-frame! m stmt)