added cond form

parse.rkt

@@ -17,11 +17,20 @@
      (make-Branch (parse (if-predicate exp))
                   (parse (if-consequent exp))
                   (parse (if-alternative exp)))]
+    [(cond? exp)
+     (parse (desugar-cond exp))]
+    
     [(lambda? exp)
      (make-Lam (lambda-parameters exp)
                (make-Seq (map parse (lambda-body exp))))]
+ 
     [(begin? exp)
-     (make-Seq (map parse (begin-actions exp)))]
+     (let ([actions (map parse (begin-actions exp))])
+       (cond
+         [(= 1 (length actions))
+          (car actions)]
+         [else
+          (make-Seq actions)]))]
     
     [(application? exp)
      (make-App (parse (operator exp))
@@ -95,3 +104,32 @@
 (define (application? exp) (pair? exp))
 (define (operator exp) (car exp))
 (define (operands exp) (cdr exp))
+
+
+(define (cond? exp)
+  (tagged-list? exp 'cond))
+
+(define (desugar-cond exp)
+  (let loop ([clauses (cdr exp)])
+    (cond
+      [(null? clauses)
+       '(void)]
+      [(null? (cdr clauses))
+       (let* ([clause (car clauses)]
+              [question (car clause)]
+              [answer `(begin ,@(cdr clause))])
+         (cond
+           [(eq? question 'else)
+            answer]
+           [else
+            `(if ,question 
+                 ,answer
+                 (void))]))]
+      [else
+       (let* ([clause (car clauses)]
+              [question (car clause)]
+              [answer `(begin ,@(cdr clause))])
+         `(if ,question 
+              ,answer
+              ,(loop (cdr clauses))))])))
+         

simulator-prims.rkt

@@ -39,5 +39,8 @@
                                                      null?
                                                      add1
                                                      sub1
-                                                     abs)
+                                                     abs
+                                                     void
+                                                     quotient
+                                                     remainder)
                                       #:constants (null pi e)))

simulator-structs.rkt

@@ -5,10 +5,12 @@
 (require "il-structs.rkt")
 
 
-(define-type PrimitiveValue (Rec PrimitiveValue (U String Number Symbol Boolean Null
+(define-type PrimitiveValue (Rec PrimitiveValue (U String Number Symbol Boolean
+                                                   Null Void
                                                    primitive-proc 
                                                    closure
                                                    undefined
+
                                                    (Pairof PrimitiveValue PrimitiveValue)
                                                    )))
 (define-type SlotValue (U PrimitiveValue toplevel))

simulator.rkt

@@ -15,7 +15,9 @@
                [lookup-primitive (Symbol -> PrimitiveValue)])
                
 
-(provide new-machine can-step? step current-instruction)
+(provide new-machine can-step? step current-instruction
+         
+         machine-control-size)
 
 
 (: new-machine ((Listof Statement) -> machine))
@@ -23,6 +25,14 @@
   (make-machine (make-undefined) (make-undefined) '() '() 0 (list->vector program-text) 0))
 
 
+
+(: machine-control-size (machine -> Natural))
+(define (machine-control-size m)
+  (length (machine-control m)))
+
+
+
+
 (: can-step? (machine -> Boolean))
 ;; Produces true if we can make a further step in the simulation.
 (define (can-step? m)

test-compiler.rkt

@@ -54,19 +54,25 @@
 ;; Run the machine to completion.
 (define (run m 
              #:debug? (debug? false)
-             #:stack-limit (stack-limit false))
+             #:stack-limit (stack-limit false)
+             #:control-limit (control-limit false))
   
   (let loop ([m m]
              [steps 0])
     (when debug?
       (when (can-step? m)
-        (printf "env-depth=~s instruction=~s\n" 
+        (printf "|env|=~s, |control|=~s,  instruction=~s\n" 
                 (length (machine-env m))
+                (length (machine-control m))
                 (current-instruction m))))
     (when stack-limit
       (when (> (machine-stack-size m) stack-limit)
         (error 'run "Stack overflow")))
     
+    (when control-limit
+      (when (> (machine-control-size m) control-limit)
+        (error 'run "Control overflow")))
+
     (cond
       [(can-step? m)
        (loop (step m) (add1 steps))]
@@ -376,6 +382,70 @@
 
       '(3.00009155413138 154.73202642085838 177.02259745919164))
 
+;; fibonacci
+(test (begin (define (fib n)
+               (if (= n 0) 0
+                   (if (= n 1) 1
+                       (+ (fib (- n 1))
+                          (fib (- n 2))))))
+             (fib 10))
+      55)
+
+;; Fibonacci, iterative.  This should be computable while using at most 10 spots.
+(test (begin 
+        (define (fib n)
+          (fib-iter 1 0 n))
+        
+        (define (fib-iter a b count)
+          (if (= count 0)
+              b
+              (fib-iter (+ a b) a (- count 1))))
+        (fib 10000))
+      33644764876431783266621612005107543310302148460680063906564769974680081442166662368155595513633734025582065332680836159373734790483865268263040892463056431887354544369559827491606602099884183933864652731300088830269235673613135117579297437854413752130520504347701602264758318906527890855154366159582987279682987510631200575428783453215515103870818298969791613127856265033195487140214287532698187962046936097879900350962302291026368131493195275630227837628441540360584402572114334961180023091208287046088923962328835461505776583271252546093591128203925285393434620904245248929403901706233888991085841065183173360437470737908552631764325733993712871937587746897479926305837065742830161637408969178426378624212835258112820516370298089332099905707920064367426202389783111470054074998459250360633560933883831923386783056136435351892133279732908133732642652633989763922723407882928177953580570993691049175470808931841056146322338217465637321248226383092103297701648054726243842374862411453093812206564914032751086643394517512161526545361333111314042436854805106765843493523836959653428071768775328348234345557366719731392746273629108210679280784718035329131176778924659089938635459327894523777674406192240337638674004021330343297496902028328145933418826817683893072003634795623117103101291953169794607632737589253530772552375943788434504067715555779056450443016640119462580972216729758615026968443146952034614932291105970676243268515992834709891284706740862008587135016260312071903172086094081298321581077282076353186624611278245537208532365305775956430072517744315051539600905168603220349163222640885248852433158051534849622434848299380905070483482449327453732624567755879089187190803662058009594743150052402532709746995318770724376825907419939632265984147498193609285223945039707165443156421328157688908058783183404917434556270520223564846495196112460268313970975069382648706613264507665074611512677522748621598642530711298441182622661057163515069260029861704945425047491378115154139941550671256271197133252763631939606902895650288268608362241082050562430701794976171121233066073310059947366875
+      
+      #:stack-limit 10
+      #:control-limit 1)
+                  
+
+
+
+;; Exponentiation
+(test (begin (define (expt b n)
+               (if (= n 0)
+                   1
+                   (* b (expt b (- n 1)))))
+             (expt 2 30))
+      (expt 2 30))
+
+(test (begin 
+        (define (expt b n)
+          (expt-iter b n 1))
+        
+        (define (expt-iter b counter product)
+          (if (= counter 0)
+              product
+              (expt-iter b
+                         (- counter 1)
+                         (* b product))))
+        (expt 2 30))
+      (expt 2 30))
+
+(test (begin
+        (define (fast-expt b n)
+          (cond ((= n 0) 1)
+                ((even? n) (square (fast-expt b (/ n 2))))
+                (else (* b (fast-expt b (- n 1))))))
+        (define (square x) (* x x))
+        (define (expt b n)
+          (fast-expt b n))
+        (define (even? n)
+          (= (remainder n 2) 0))
+        
+        (list (expt 2 30)
+              (expt 2 23984000)))
+      
+      (list (expt 2 30)
+            (expt 2 23984000)))
 
 
 ;(simulate (compile (parse '42) 'val 'next))