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

testandbranch

Browse Source
This commit is contained in:
Danny Yoo 2011-03-04 14:11:15 -05:00
parent d3ceee5a63
commit 9277109351
3 changed files with 90 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
il-structs.rkt
View File

@ -91,7 +91,7 @@
[rands : (Listof (U Label Reg Const))])
#:transparent)
(define-struct: TestAndBranchStatement ([op : PrimitiveTest]
[register-rand : AtomicRegisterSymbol]
[register : AtomicRegisterSymbol]
[label : Symbol])
#:transparent)

23
simulator.rkt
View File

@ -1,6 +1,9 @@
#lang typed/racket/base
;; An evaluator for the intermediate language, so I can do experiments.
;;
;; For example, I'll need to be able to count the number of statements executed by an evaluation.
;; I also need to do things like count pushes and pops. Basically, low-level benchmarking.
(require "il-structs.rkt"
"simulator-structs.rkt"
@ -44,7 +47,7 @@
[(GotoStatement? i)
(step-goto m i)]
[(TestAndBranchStatement? i)
(error 'step)]
(step-test-and-branch m i)]
[(PopEnvironment? i)
(step-pop-environment m i)]
[(PushEnvironment? i)
@ -113,7 +116,25 @@
(control-pop m)])
m))
(: step-test-and-branch (machine TestAndBranchStatement -> machine))
(define (step-test-and-branch m stmt)
(let: ([test : PrimitiveTest (TestAndBranchStatement-op stmt)]
[argval : Any (lookup-atomic-register m (TestAndBranchStatement-register stmt))])
(if (cond
[(eq? test 'false?)
(not argval)]
[(eq? test 'primitive-procedure?)
(primitive-proc? argval)])
(jump m (TestAndBranchStatement-label stmt))
m)))
(: lookup-atomic-register (machine AtomicRegisterSymbol -> Any))
(define (lookup-atomic-register m reg)
(cond [(eq? reg 'val)
(machine-val m)]
[(eq? reg 'proc)
(machine-proc m)]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

68
test-simulator.rkt
View File

@ -2,6 +2,7 @@
(require "il-structs.rkt"
"simulator-structs.rkt"
"simulator-prims.rkt"
"simulator.rkt")
@ -153,4 +154,69 @@
,(make-PopControlFrame)
,(make-PopControlFrame)))])
(test (machine-control (run m))
(list)))
(list)))
;; TestAndBranch: try the true branch
(let ([m (new-machine `(,(make-AssignImmediateStatement 'val (make-Const 42))
,(make-TestAndBranchStatement 'false? 'val 'on-false)
,(make-AssignImmediateStatement 'val (make-Const 'ok))
,(make-GotoStatement (make-Label 'end))
on-false
,(make-AssignImmediateStatement 'val (make-Const 'not-ok))
end))])
(test (machine-val (run m))
'ok))
;; TestAndBranch: try the false branch
(let ([m (new-machine `(,(make-AssignImmediateStatement 'val (make-Const #f))
,(make-TestAndBranchStatement 'false? 'val 'on-false)
,(make-AssignImmediateStatement 'val (make-Const 'not-ok))
,(make-GotoStatement (make-Label 'end))
on-false
,(make-AssignImmediateStatement 'val (make-Const 'ok))
end))])
(test (machine-val (run m))
'ok))
;; Test for primitive procedure
(let ([m (new-machine `(,(make-AssignImmediateStatement 'val (make-Const '+))
,(make-TestAndBranchStatement 'primitive-procedure? 'val 'on-true)
,(make-AssignImmediateStatement 'val (make-Const 'ok))
,(make-GotoStatement (make-Label 'end))
on-true
,(make-AssignImmediateStatement 'val (make-Const 'not-ok))
end))])
(test (machine-val (run m))
'ok))
;; Give a primitive procedure in val
(let ([m (new-machine `(,(make-AssignImmediateStatement 'val (make-Const (lookup-primitive '+)))
,(make-TestAndBranchStatement 'primitive-procedure? 'val 'on-true)
,(make-AssignImmediateStatement 'val (make-Const 'not-ok))
,(make-GotoStatement (make-Label 'end))
on-true
,(make-AssignImmediateStatement 'val (make-Const 'ok))
end))])
(test (machine-val (run m))
'ok))
;; Give a primitive procedure in proc, but test val
(let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const (lookup-primitive '+)))
,(make-TestAndBranchStatement 'primitive-procedure? 'val 'on-true)
,(make-AssignImmediateStatement 'val (make-Const 'not-a-procedure))
,(make-GotoStatement (make-Label 'end))
on-true
,(make-AssignImmediateStatement 'val (make-Const 'a-procedure))
end))])
(test (machine-val (run m))
'not-a-procedure))
;; Give a primitive procedure in proc and test proc
(let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const (lookup-primitive '+)))
,(make-TestAndBranchStatement 'primitive-procedure? 'proc 'on-true)
,(make-AssignImmediateStatement 'val (make-Const 'not-a-procedure))
,(make-GotoStatement (make-Label 'end))
on-true
,(make-AssignImmediateStatement 'val (make-Const 'a-procedure))
end))])
(test (machine-val (run m))
'a-procedure))