Fix omission of match in fv and lambdas.

Author: dvanhorn

langs/loot/fv.rkt

@@ -18,4 +18,18 @@
     [(Let x e1 e2)      (append (fv* e1) (remq* (list x) (fv* e2)))]
     [(App e1 es)        (append (fv* e1) (append-map fv* es))]
     [(Lam f xs e)       (remq* xs (fv* e))]
+    [(Match e ps es)    (append (fv* e) (append-map fv-clause* ps es))]
     [_                  '()]))
+
+;; Pat Expr -> [Listof Id]
+(define (fv-clause* p e)
+  (remq* (bv-pat* p) (fv* e)))
+
+;; Pat -> [Listof Id]
+(define (bv-pat* p)
+  (match p
+    [(PVar x) (list x)]
+    [(PCons p1 p2) (append (bv-pat* p1) (bv-pat* p2))]
+    [(PAnd p1 p2) (append (bv-pat* p1) (bv-pat* p2))]
+    [(PBox p) (bv-pat* p)]
+    [_ '()]))

langs/loot/lambdas.rkt

@@ -31,4 +31,5 @@
     [(Let x e1 e2)      (append (lambdas-e e1) (lambdas-e e2))]
     [(App e1 es)        (append (lambdas-e e1) (append-map lambdas-e es))]
     [(Lam f xs e1)      (cons e (lambdas-e e1))]
+    [(Match e ps es)    (append (lambdas-e e) (append-map lambdas-e es))]
     [_                  '()]))

langs/loot/test/test-runner.rkt

@@ -269,7 +269,21 @@
                                 0
                                 (+ n (tri (sub1 n)))))))
                        36))
-                666))
+                666)
+  (check-equal? (run '(define (tri n)
+                        (if (zero? n)
+                            0
+                            (+ n (tri (sub1 n)))))
+                     '(tri 36))
+                666)
+  (check-equal? (run '(define (tri n)
+                        (match n
+                          [0 0]
+                          [m (+ m (tri (sub1 m)))]))
+                     '(tri 36))
+                666)
+  (check-equal? (run '((match 8 [8 (lambda (x) x)]) 12))
+                12))
 
 (define (test-runner-io run)
   ;; Evildoer examples

langs/mountebank/fv.rkt

@@ -18,4 +18,18 @@
     [(Let x e1 e2)      (append (fv* e1) (remq* (list x) (fv* e2)))]
     [(App e1 es)        (append (fv* e1) (append-map fv* es))]
     [(Lam f xs e)       (remq* xs (fv* e))]
+    [(Match e ps es)    (append (fv* e) (append-map fv-clause* ps es))]
     [_                  '()]))
+
+;; Pat Expr -> [Listof Id]
+(define (fv-clause* p e)
+  (remq* (bv-pat* p) (fv* e)))
+
+;; Pat -> [Listof Id]
+(define (bv-pat* p)
+  (match p
+    [(PVar x) (list x)]
+    [(PCons p1 p2) (append (bv-pat* p1) (bv-pat* p2))]
+    [(PAnd p1 p2) (append (bv-pat* p1) (bv-pat* p2))]
+    [(PBox p) (bv-pat* p)]
+    [_ '()]))

langs/mountebank/lambdas.rkt

@@ -31,4 +31,5 @@
     [(Let x e1 e2)      (append (lambdas-e e1) (lambdas-e e2))]
     [(App e1 es)        (append (lambdas-e e1) (append-map lambdas-e es))]
     [(Lam f xs e1)      (cons e (lambdas-e e1))]
+    [(Match e ps es)    (append (lambdas-e e) (append-map lambdas-e es))]
     [_                  '()]))

langs/mountebank/test/test-runner.rkt

@@ -270,6 +270,20 @@
                                 (+ n (tri (sub1 n)))))))
                        36))
                 666)
+  (check-equal? (run '(define (tri n)
+                        (if (zero? n)
+                            0
+                            (+ n (tri (sub1 n)))))
+                     '(tri 36))
+                666)
+  (check-equal? (run '(define (tri n)
+                        (match n
+                          [0 0]
+                          [m (+ m (tri (sub1 m)))]))
+                     '(tri 36))
+                666)
+  (check-equal? (run '((match 8 [8 (lambda (x) x)]) 12))
+                12)
 
   ;; Mug examples
   (check-equal? (run '(symbol? 'foo)) #t)

langs/mug/fv.rkt

@@ -18,4 +18,18 @@
     [(Let x e1 e2)      (append (fv* e1) (remq* (list x) (fv* e2)))]
     [(App e1 es)        (append (fv* e1) (append-map fv* es))]
     [(Lam f xs e)       (remq* xs (fv* e))]
+    [(Match e ps es)    (append (fv* e) (append-map fv-clause* ps es))]
     [_                  '()]))
+
+;; Pat Expr -> [Listof Id]
+(define (fv-clause* p e)
+  (remq* (bv-pat* p) (fv* e)))
+
+;; Pat -> [Listof Id]
+(define (bv-pat* p)
+  (match p
+    [(PVar x) (list x)]
+    [(PCons p1 p2) (append (bv-pat* p1) (bv-pat* p2))]
+    [(PAnd p1 p2) (append (bv-pat* p1) (bv-pat* p2))]
+    [(PBox p) (bv-pat* p)]
+    [_ '()]))

langs/mug/lambdas.rkt

@@ -31,4 +31,5 @@
     [(Let x e1 e2)      (append (lambdas-e e1) (lambdas-e e2))]
     [(App e1 es)        (append (lambdas-e e1) (append-map lambdas-e es))]
     [(Lam f xs e1)      (cons e (lambdas-e e1))]
+    [(Match e ps es)    (append (lambdas-e e) (append-map lambdas-e es))]
     [_                  '()]))

langs/mug/test/test-runner.rkt

@@ -270,6 +270,20 @@
                                 (+ n (tri (sub1 n)))))))
                        36))
                 666)
+  (check-equal? (run '(define (tri n)
+                        (if (zero? n)
+                            0
+                            (+ n (tri (sub1 n)))))
+                     '(tri 36))
+                666)
+  (check-equal? (run '(define (tri n)
+                        (match n
+                          [0 0]
+                          [m (+ m (tri (sub1 m)))]))
+                     '(tri 36))
+                666)
+  (check-equal? (run '((match 8 [8 (lambda (x) x)]) 12))
+                12)
 
   ;; Mug examples
   (check-equal? (run '(symbol? 'foo)) #t)