diff --git a/README b/README index f1da814..43d9cbb 100644 --- a/README +++ b/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. diff --git a/parse.rkt b/parse.rkt index 33cd0cc..82359b5 100644 --- a/parse.rkt +++ b/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) diff --git a/test-parse.rkt b/test-parse.rkt index f57fc0f..b7c586d 100644 --- a/test-parse.rkt +++ b/test-parse.rkt @@ -515,4 +515,40 @@ (make-App (make-ToplevelRef 3 0) (list (make-Constant 'hello) (make-Constant 'world) - (make-Constant 'testing)))))) \ No newline at end of file + (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)))