Add tests for recursion

This commit is contained in:
Yiyun Liu 2025-06-07 17:37:29 -04:00
parent d950cce57b
commit 815fb10e89
2 changed files with 27 additions and 0 deletions

View file

@ -27,8 +27,17 @@
(define (exp-final-node e) (define (exp-final-node e)
(program-final-node (exp->program e))) (program-final-node (exp->program e)))
(define rec-program
'((define (pair x y f) ((f x) y))
(define (fst p) (p K))
(define (snd p) (p K1))
(define (f x y)
(letrec ((a ((pair x) b)) (b ((pair y) a))) (fst (snd (snd (snd a))))))
(define (main) ((f 3) 4))))
(check-equal? (exp-final-node (ap-exp 'S 'K 'K 3)) 3) (check-equal? (exp-final-node (ap-exp 'S 'K 'K 3)) 3)
(check-equal? (exp-final-node (ap-exp 'K 100 99)) 100) (check-equal? (exp-final-node (ap-exp 'K 100 99)) 100)
(check-equal? (exp-final-node `(let ((x ,(ap-exp 'S 'K 'K 3)) (y 5)) ,(ap-exp 'K 'x 'x))) 3) (check-equal? (exp-final-node `(let ((x ,(ap-exp 'S 'K 'K 3)) (y 5)) ,(ap-exp 'K 'x 'x))) 3)
(check-equal? (exp-final-node `(let ((x ,(ap-exp 'S 'K 'K 3)) (y 5)) ,(ap-exp 'K 'y 'x))) 5) (check-equal? (exp-final-node `(let ((x ,(ap-exp 'S 'K 'K 3)) (y 5)) ,(ap-exp 'K 'y 'x))) 5)
(check-equal? (exp-final-node `(letrec ((y x) (x ,(ap-exp 'S 'K 'K 3))) ,(ap-exp 'K 'y 'x))) 3) (check-equal? (exp-final-node `(letrec ((y x) (x ,(ap-exp 'S 'K 'K 3))) ,(ap-exp 'K 'y 'x))) 3)
(check-equal? (program-final-node rec-program) 4)

View file

@ -1,7 +1,25 @@
#lang typed/racket #lang typed/racket
(require "ast.rkt") (require "ast.rkt")
(require racket/cmdline)
(require/typed "parser.rkt" (require/typed "parser.rkt"
[parse-from-port (-> Input-Port CoreProgram)] [parse-from-port (-> Input-Port CoreProgram)]
[parse-from-string (-> String CoreProgram)]) [parse-from-string (-> String CoreProgram)])
(module* main #f
(: filename Path-String)
(define filename
(let ([result (command-line
#:program "core-parser"
#:args (filename)
filename)])
(if (path-string? result)
result
(error "Commandline parser returned unexpected results"))))
(pretty-print (parse-from-port
(open-input-file filename))))
(provide parse-from-port parse-from-string) (provide parse-from-port parse-from-string)