From d3ceee5a6376bbff47977adb4d7298f431ac4ed3 Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@cs.wpi.edu>
Date: Fri, 4 Mar 2011 13:52:22 -0500
Subject: [PATCH] popframe

---
 simulator-prims.rkt   | 13 +++++++++++++
 simulator-structs.rkt |  2 ++
 simulator.rkt         | 34 ++++++++++++++++++++++++++--------
 test-simulator.rkt    | 36 ++++++++++++++++++++++++++++++++++++
 4 files changed, 77 insertions(+), 8 deletions(-)
 create mode 100644 simulator-prims.rkt

diff --git a/simulator-prims.rkt b/simulator-prims.rkt
new file mode 100644
index 0000000..25ccb34
--- /dev/null
+++ b/simulator-prims.rkt
@@ -0,0 +1,13 @@
+#lang racket/base
+(require "simulator-structs.rkt")
+
+(provide lookup-primitive)
+
+(define (lookup-primitive name)
+  (cond
+    [(eq? name '+)
+     (make-primitive-proc +)]
+    [(eq? name '=)
+     (make-primitive-proc =)]
+    [else
+     (void)]))
\ No newline at end of file
diff --git a/simulator-structs.rkt b/simulator-structs.rkt
index 3720819..7275c88 100644
--- a/simulator-structs.rkt
+++ b/simulator-structs.rkt
@@ -20,3 +20,5 @@
   #:transparent)
 
 
+;; Primitive procedure wrapper
+(define-struct: primitive-proc ([f : (Any * -> Any)]))
\ No newline at end of file
diff --git a/simulator.rkt b/simulator.rkt
index 126a95b..d9b5a24 100644
--- a/simulator.rkt
+++ b/simulator.rkt
@@ -5,7 +5,12 @@
 (require "il-structs.rkt"
          "simulator-structs.rkt"
          racket/list
-         racket/match)
+         racket/match
+         (for-syntax racket/base))
+
+(require/typed "simulator-prims.rkt"
+               [lookup-primitive (Symbol -> (Any * -> Any))])
+               
 
 (provide new-machine can-step? step)
 
@@ -45,9 +50,10 @@
            [(PushEnvironment? i)
             (step-push-environment m i)]
            [(PushControlFrame? i)
-            (error 'step)]
+            (step-push-control-frame m i)]
            [(PopControlFrame? i)
-            (error 'step)]))))
+            (step-pop-control-frame m i)]))))
+
   
     
 (: step-goto (machine GotoStatement -> machine))
@@ -90,12 +96,22 @@
              (sub1 n))])))
 
 (: step-pop-environment (machine PopEnvironment -> machine))
-(define (step-pop-environment machine stmt)
-  (env-pop machine
+(define (step-pop-environment m stmt)
+  (env-pop m
            (PopEnvironment-n stmt)
            (PopEnvironment-skip stmt)))
 
 
+(: step-push-control-frame (machine PushControlFrame -> machine))
+(define (step-push-control-frame m stmt)
+  (control-push m (PushControlFrame-label stmt)))
+
+(: step-pop-control-frame (machine PopControlFrame -> machine))
+(define (step-pop-control-frame m stmt)
+  (let-values: ([([m : machine]
+                  [l : Symbol])
+                 (control-pop m)])
+               m))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -197,8 +213,8 @@
      (make-machine val proc env (cons (make-frame l) control) pc text)]))
 
 
-(: control-pop (machine Symbol -> (values machine Symbol)))
-(define (control-pop m l)
+(: control-pop (machine -> (values machine Symbol)))
+(define (control-pop m)
   (match m
     [(struct machine (val proc env control pc text))
      (values (make-machine val proc env (rest control) pc text)
@@ -226,4 +242,6 @@
           [(eq? (vector-ref vec i) x)
            i]
           [else
-           (loop (add1 i))])))
\ No newline at end of file
+           (loop (add1 i))])))
+
+
diff --git a/test-simulator.rkt b/test-simulator.rkt
index db48d7f..e48db7b 100644
--- a/test-simulator.rkt
+++ b/test-simulator.rkt
@@ -118,3 +118,39 @@
                         ,(make-AssignImmediateStatement (make-EnvLexicalReference 2) (make-Const "louie"))
                         ,(make-PopEnvironment 2 1)))])
   (test (machine-env (run m)) '("hewie")))
+
+
+
+;; PushControl
+(let ([m (new-machine `(foo 
+                        ,(make-PushControlFrame 'foo)
+                        bar
+                        ,(make-PushControlFrame 'bar)
+                        baz
+                        ))])
+  (test (machine-control (run m))
+        (list (make-frame 'bar)
+              (make-frame 'foo))))
+
+
+
+;; PopControl
+(let ([m (new-machine `(foo 
+                        ,(make-PushControlFrame 'foo)
+                        bar
+                        ,(make-PushControlFrame 'bar)
+                        baz
+                        ,(make-PopControlFrame)
+                        ))])
+  (test (machine-control (run m))
+        (list (make-frame 'foo))))
+
+(let ([m (new-machine `(foo 
+                        ,(make-PushControlFrame 'foo)
+                        bar
+                        ,(make-PushControlFrame 'bar)
+                        baz
+                        ,(make-PopControlFrame)
+                        ,(make-PopControlFrame)))])
+  (test (machine-control (run m))
+        (list)))
\ No newline at end of file