crook

Author: dvanhorn

fraud-plus/test/parse.rkt

@@ -43,5 +43,12 @@
   (check-equal? (parse-closed '(let ((x 1)) (let ((x 2)) x)))
                 (p (Let '(x) (list (Lit 1)) (Let '(x) (list (Lit 2)) (Var 'x)))))
   (check-equal? (parse-closed '(let* ((x 1) (x 2)) x))
-                (p (Let* '(x x) (list (Lit 1) (Lit 2)) (Var 'x)))))
+                (p (Let* '(x x) (list (Lit 1) (Lit 2)) (Var 'x))))
+  (check-equal? (parse '(let ((let 1) (x 2)) let))
+                (p (Let '(let x) (list (Lit 1) (Lit 2)) (Var 'let))))
+  (check-equal? (parse '(let* ((let* 1) (x 2)) let*))
+                (p (Let* '(let* x) (list (Lit 1) (Lit 2)) (Var 'let*))))
+  (check-equal? (parse '(let* ((let* 1) (let* 2)) let*))
+                (p (Let* '(let* let*) (list (Lit 1) (Lit 2)) (Var 'let*))))
+  (check-exn exn:fail? (λ () (parse '(let ((let 1)) (let ((x 1)) x))))))
 

iniquity-plus/parse.rkt

@@ -35,7 +35,7 @@
   (define (rec ss fs)
     (match ss
       [(list s) fs]
-      [(cons (cons 'define sd) sr)
+      [(cons (cons (? (not-in fs) 'define) sd) sr)
        (match (parse-defn-name sd)
          [f (if (memq f fs)
                 (error "duplicate definition" f)
@@ -79,7 +79,7 @@
 (provide (all-defined-out))
 (define (parse-define/acc s fs xs ys gs)
   (match s
-    [(list 'define (? symbol? f) (cons 'case-lambda sr))
+    [(list 'define (? symbol? f) (cons (? (not-in (append fs xs)) 'case-lambda) sr))
      (match (parse-case-lambda/acc sr fs xs ys gs)
        [(list ys gs fun)
         (list ys gs (Defn f fun))])]
@@ -113,9 +113,13 @@
     [(list (cons (? symbol? x) r) s)
      (match (parse-define-plain-or-rest-fun/acc (list r s) fs (cons x xs) ys gs)
        [(list ys gs (FunPlain xs e))
-        (list ys gs (FunPlain (cons x xs) e))]
+        (if (memq x xs)
+            (error "duplicate identifier" x)
+            (list ys gs (FunPlain (cons x xs) e)))]
        [(list ys gs (FunRest xs r e))
-        (list ys gs (FunRest (cons x xs) r e))])]
+        (if (or (memq x xs) (eq? x r))
+            (error "duplicate identifier" x)
+            (list ys gs (FunRest (cons x xs) r e)))])]
     [_ (error "parse error")]))
 
 ;; S-Expr [Listof Id] [Listof Id] [Listof Id] [Listof Id] -> (list [Listof Id] [Listof Id] Expr)

iniquity-plus/test/parse.rkt

@@ -48,3 +48,38 @@
   (check-equal? (parse '(make-string 10 #\a))
                 (p (Prim2 'make-string (Lit 10) (Lit #\a)))))
 
+(begin ; Iniquity (in Iniquity+)
+  (check-equal? (parse '(define (f x) x) 1)
+                (Prog (list (Defn 'f (FunPlain '(x) (Var 'x)))) (Lit 1)))
+  (check-equal? (parse '(define (define) 0) '(define))
+                (Prog (list (Defn 'define (FunPlain '() (Lit 0))))
+                      (App 'define '())))
+  (check-exn exn:fail? (λ () (parse '(define (f y y) y) 1)))
+  (check-exn exn:fail? (λ () (parse '(define (f y) y) '(define (f x) x) 1)))
+  (check-equal? (parse-closed '(define (f x) (g x))
+                              '(define (g x) (f x))
+                              '(f 0))
+                (Prog (list (Defn 'f (FunPlain '(x) (App 'g (list (Var 'x)))))
+                            (Defn 'g (FunPlain '(x) (App 'f (list (Var 'x))))))
+                      (App 'f (list (Lit 0)))))
+  (check-equal? (parse '(define (define x) x)
+                       '(define 1))
+                (Prog (list (Defn 'define (FunPlain '(x) (Var 'x))))
+                      (App 'define (list (Lit 1)))))
+  (check-exn exn:fail? (λ () (parse '(define (define x) x)
+                                    '(define (g x) x)
+                                    '(define (g 1))))))
+
+(begin ; Iniquity+
+  (check-equal? (parse '(define (f . x) x) 1)
+                (Prog (list (Defn 'f (FunRest '() 'x (Var 'x)))) (Lit 1)))
+  (check-exn exn:fail? (λ () (parse '(define (f x . x)) 1)))
+  (check-exn exn:fail? (λ () (parse '(define (f x x . y)) 1)))
+  (check-exn exn:fail? (λ () (parse '(define (f . x)) '(define (f y) y) 1)))
+  (check-equal? (parse '(define f (case-lambda)) '(f))
+                (Prog (list (Defn 'f (FunCase '()))) (App 'f '())))
+  (check-exn exn:fail? (λ () (parse '(define case-lambda (case-lambda)) 1)))
+  (check-exn exn:fail? (λ () (parse '(define f (case-lambda [(x x) x])) 1)))
+  (check-equal? (parse '(define f (case-lambda [(x) x] [(x y) y])) 1)
+                (Prog (list (Defn 'f (FunCase (list (FunPlain '(x) (Var 'x)) (FunPlain '(x y) (Var 'y)))))) (Lit 1))))
+

knock-plus/parse.rkt

@@ -41,7 +41,7 @@
   (define (rec ss fs)
     (match ss
       [(list s) fs]
-      [(cons (cons 'define sd) sr)
+      [(cons (cons (? (not-in fs) 'define) sd) sr)
        (match (parse-defn-name sd)
          [f (if (memq f fs)
                 (error "duplicate definition" f)
@@ -126,14 +126,14 @@
                    (list ys gs (Let x e1 e2))])])]
             [_ (error "let: bad syntax" s)])]
          ['match
-           (match sr
-             [(cons s sr)
-              (match (rec s xs ys gs)
-                [(list ys gs e)
-                 (match (parse-match-clauses/acc sr fs xs ys gs)
-                   [(list ys gs ps es)
-                    (list ys gs (Match e ps es))])])]
-             [_ (error "match: bad syntax" s)])]
+          (match sr
+            [(cons s sr)
+             (match (rec s xs ys gs)
+               [(list ys gs e)
+                (match (parse-match-clauses/acc sr fs xs ys gs)
+                  [(list ys gs ps es)
+                   (list ys gs (Match e ps es))])])]
+            [_ (error "match: bad syntax" s)])]
          [_
           (match (parse-es/acc sr fs xs ys gs)
             [(list ys gs es)

knock-plus/test/parse.rkt

@@ -47,6 +47,7 @@
   (check-equal? (parse "asdf") (p (Lit "asdf")))
   (check-equal? (parse '(make-string 10 #\a))
                 (p (Prim2 'make-string (Lit 10) (Lit #\a)))))
+
 (begin ; Iniquity
   (check-equal? (parse '(define (f x) x) 1)
                 (Prog (list (Defn 'f '(x) (Var 'x))) (Lit 1)))