From fe5e6603a5864c1c4aa957fd2498297db4dea98d Mon Sep 17 00:00:00 2001 From: dvanhorn Date: Sat, 1 Nov 2025 17:11:34 +0000 Subject: [PATCH 1/2] crook --- iniquity-plus/ast.rkt | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/iniquity-plus/ast.rkt b/iniquity-plus/ast.rkt index 19ffeea..b8929d5 100644 --- a/iniquity-plus/ast.rkt +++ b/iniquity-plus/ast.rkt @@ -1,8 +1,7 @@ #lang racket (provide Lit Prim0 Prim1 Prim2 Prim3 If Eof Begin - Let Var Prog Defn App - Apply FunPlain FunRest FunCase) + Let Var Prog Defn App FunPlain FunRest FunCase) ;; type Prog = (Prog (Listof Defn) Expr) (struct Prog (ds e) #:prefab) @@ -29,7 +28,6 @@ ;; | (Let Id Expr Expr) ;; | (Var Id) ;; | (App Id (Listof Expr)) -;; | (Apply Id (Listof Expr) Expr) ;; type ClosedExpr = { e ∈ Expr | e contains no free variables } @@ -66,5 +64,4 @@ (struct Let (x e1 e2) #:prefab) (struct Var (x) #:prefab) (struct App (f es) #:prefab) -(struct Apply (f es e) #:prefab) From e6ca88c93721e1f8332223b22e48d8c102ba7f75 Mon Sep 17 00:00:00 2001 From: dvanhorn Date: Tue, 4 Nov 2025 05:52:14 +0000 Subject: [PATCH 2/2] crook --- fraud-plus/test/parse.rkt | 9 ++++++++- iniquity-plus/parse.rkt | 12 ++++++++---- iniquity-plus/test/parse.rkt | 35 +++++++++++++++++++++++++++++++++++ knock-plus/parse.rkt | 18 +++++++++--------- knock-plus/test/parse.rkt | 1 + 5 files changed, 61 insertions(+), 14 deletions(-) diff --git a/fraud-plus/test/parse.rkt b/fraud-plus/test/parse.rkt index f39429a..00544f7 100644 --- a/fraud-plus/test/parse.rkt +++ b/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)))))) diff --git a/iniquity-plus/parse.rkt b/iniquity-plus/parse.rkt index 571f80b..e242b4e 100644 --- a/iniquity-plus/parse.rkt +++ b/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) diff --git a/iniquity-plus/test/parse.rkt b/iniquity-plus/test/parse.rkt index 0c4cfd6..b8d9178 100644 --- a/iniquity-plus/test/parse.rkt +++ b/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)))) + diff --git a/knock-plus/parse.rkt b/knock-plus/parse.rkt index 1cb74cf..ff0c373 100644 --- a/knock-plus/parse.rkt +++ b/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) diff --git a/knock-plus/test/parse.rkt b/knock-plus/test/parse.rkt index e24f612..31d5363 100644 --- a/knock-plus/test/parse.rkt +++ b/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)))