test cases for parsing caselam

README

@@ -5,8 +5,8 @@ Compiler from Racket to JavaScript.
 
 Prerequisite: Racket 5.1.1.  The majority of the project is written
 Typed Racket, and I highly recommend you use a version of Racket
-that's at least 5.1.1; otherwise, compilation times may take an
-unusual amount of time.
+that's at least 5.1.1; otherwise, compilation may take an unusual
+amount of time.
 
 
 

parse.rkt

@@ -119,6 +119,9 @@
     [(lambda? exp)
      (parse-lambda exp cenv)]
     
+    [(case-lambda? exp)
+     (parse-case-lambda exp cenv)]
+    
     [(begin? exp)
      (let ([actions (map (lambda (e)
                            (parse e cenv at-toplevel?))
@@ -223,6 +226,23 @@
       (string->symbol (format "lamEntry~a" lam-label-counter))))
 
 
+
+(define (parse-case-lambda exp cenv)
+  (let* ([entry-label (fresh-lam-label)]
+         [parsed-lams (map (lambda (lam)
+                             (parse-lambda lam cenv))
+                           (case-lambda-clauses exp))])
+    (make-CaseLam (current-defined-name)
+                  parsed-lams
+                  entry-label)))
+
+
+
+
+
+
+
+
 (define (seq codes)
   (cond
     [(= 1 (length codes))
@@ -268,6 +288,9 @@
         (list-difference (apply append (map loop (lambda-body exp)))
                          (lambda-parameters exp))]
        
+       [(case-lambda? exp)
+        (apply append (map loop (case-lambda-clauses exp)))]
+       
        [(begin? exp)
         (apply append (map loop (begin-actions exp)))]
        
@@ -343,6 +366,9 @@
         (list-difference (loop (lambda-body exp))
                          (lambda-parameters exp))]
        
+       [(case-lambda? exp)
+        (apply append (map loop (case-lambda-clauses exp)))]
+       
        [(begin? exp)
         (apply append (map loop (begin-actions exp)))]
        
@@ -468,6 +494,18 @@
 (define (make-lambda parameters body)
   (cons 'lambda (cons parameters body)))
 
+
+
+
+(define (case-lambda? exp)
+  (tagged-list? exp 'case-lambda))
+
+(define (case-lambda-clauses exp)
+  (map (lambda (a-clause)
+         `(lambda ,@a-clause))
+       (cdr exp)))
+
+
 (define (if? exp)
   (tagged-list? exp 'if))
 (define (if-predicate exp)

test-parse.rkt

@@ -515,4 +515,40 @@
                                 (make-App (make-ToplevelRef 3 0) 
                                           (list (make-Constant 'hello)
                                                 (make-Constant 'world)
-                                                (make-Constant 'testing))))))
+                                                (make-Constant 'testing))))))
+
+
+
+
+
+;; CaseLam
+(test (parse '(case-lambda))
+      (make-Top (make-Prefix '())
+                (make-CaseLam #f (list) 'lamEntry1)))
+
+
+(test (parse '(case-lambda [(x) x]))
+      (make-Top (make-Prefix '())
+                (make-CaseLam 
+                 #f
+                 (list (make-Lam #f 1 #f (make-LocalRef 0 #f) '() 'lamEntry2))
+                 'lamEntry1)))
+
+
+(test (parse '(case-lambda [(x) x]
+                           [(x y) x]))
+      (make-Top (make-Prefix '())
+                (make-CaseLam 
+                 #f
+                 (list (make-Lam #f 1 #f (make-LocalRef 0 #f) '() 'lamEntry2)
+                       (make-Lam #f 2 #f (make-LocalRef 0 #f) '() 'lamEntry3))
+                 'lamEntry1)))
+
+(test (parse '(case-lambda [(x) x]
+                           [(x y) y]))
+      (make-Top (make-Prefix '())
+                (make-CaseLam 
+                 #f
+                 (list (make-Lam #f 1 #f (make-LocalRef 0 #f) '() 'lamEntry2)
+                       (make-Lam #f 2 #f (make-LocalRef 1 #f) '() 'lamEntry3))
+                 'lamEntry1)))