practical-language-learning

accumulator-tree

;; The first three lines of this file were inserted by DrRacket. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-advanced-reader.ss" "lang")((modname accumulator-tree) (read-case-sensitive #t) (teachpacks ((lib "image.rkt" "teachpack" "2htdp") (lib "universe.rkt" "teachpack" "2htdp") (lib "batch-io.rkt" "teachpack" "2htdp") (lib "web-io.rkt" "teachpack" "2htdp") (lib "dir.rkt" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ((lib "image.rkt" "teachpack" "2htdp") (lib "universe.rkt" "teachpack" "2htdp") (lib "batch-io.rkt" "teachpack" "2htdp") (lib "web-io.rkt" "teachpack" "2htdp") (lib "dir.rkt" "teachpack" "htdp")) #f)))
(define ex1 '(λ (x) x))
(define ex2 '(λ (x) y))
(define ex3 '(λ (y) (λ (x) y)))
(define ex4 '((λ (x) (x x)) (λ (x) (x x))))
(define ex5 'a)

; Exercise 512

; Lam -> Boolean
; variable
(check-expect (is-var? ex5) #true)

(define (is-var? lam)
  (symbol? lam))

; Lam -> Boolean
; λ expressions
(check-expect (is-λ? ex1) #true)

(define (is-λ? lam)
  (symbol=? (first lam) 'λ))

; Lam -> Boolean
; applications
(check-expect (is-app? ex4) #true)

(define (is-app? lam)
  (local ((define fl (first lam))
          (define bool (or (is-var? fl) (is-λ? fl))))
    (cond
      [(empty? (rest lam)) bool]
      [else (and bool (is-app? (rest lam)))])))


; Lam -> Lam
; extract the parameter from a λ expression
(check-expect (λ-para ex1) '(x))

(define (λ-para lam)
  (second lam))


; Lam -> Lam
; extracts the body from a λ expression
(check-expect (λ-body ex2) 'y)

(define (λ-body lam)
  (first (reverse lam)))


; Lam -> Lam
; extracts the function from an application
(check-expect (app-fun ex4) '((λ (x) (x x)) (λ (x) (x x))))

(define (app-fun lam)
  (cond
    [(empty? lam) '()]
    [else (if (is-λ? (first lam))
              (cons (first lam) (app-fun (rest lam)))
              (rest lam))]))


; Lam -> Lam
; extracts the argument from an application
(check-expect (app-arg ex4) '((x) (x)))

(define (app-arg lam)
  (local ((define af (app-fun lam))
          (define (app-arg/a l)
            (cond
              [(empty? l) '()]
              [else (cons (λ-para (first l))
                          (app-arg/a (rest l)))])))
    (app-arg/a af)))


; Lam -> Lam
; produces the list of all symbols
; used as λ parameters in a λ term
(check-expect (declareds ex4) '(x x))

(define (declareds lam)
  (local ((define lp (app-arg lam))
          (define (hd l)
            (cond
              [(empty? l) '()]
              [else (append (first l) (hd (rest l)))])))
    (hd lp)))


; Lam -> Lam 
(define (undeclareds le0)
  (local (; Lam [List-of Symbol] -> Lam
          ; accumulator declareds is a list of all λ 
          ; parameters on the path from le0 to le
          (define (undeclareds/a le declareds)
            (cond
              [(is-var? le)
               (if (member? le declareds) le '*undeclared)]
              [(is-λ? le)
               (local ((define para (λ-para le))
                       (define body (λ-body le))
                       (define newd (cons para declareds)))
                 (list 'λ (list para)
                   (undeclareds/a body newd)))]
              [(is-app? le)
               (local ((define fun (app-fun le))
                       (define arg (app-arg le)))
               (list (undeclareds/a fun declareds)
                     (undeclareds/a arg declareds)))])))
    (undeclareds/a le0 '())))

(define ex6 '(λ(x) y))
(define ex7 '(λ (*undeclared) ((λ (x) (x *undeclared)) y)))

(define-struct pair [left right])
; ConsOrEmpty is one of: 
; – '()
; – (make-pair Any ConsOrEmpty)

; Any ConsOrEmpty -> ConsOrEmpty
(define (our-cons a-value a-list)
  (cond
    [(empty? a-list) (make-pair a-value a-list)]
    [(pair? a-list) (make-pair a-value a-list)]
    [else (error "our-cons: ...")]))

; ConsOrEmpty -> Any
; extracts the left part of the given pair
(define (our-first mimicked-list)
  (if (empty? mimicked-list)
      (error "our-first: ...")
      (pair-left mimicked-list)))

; ConsOrEmpty -> Any
; extracts the right part of the given pair
(define (our-rest mimcked-list)
  (if (empty? mimicked-list)
      (error "our-rest: ...")
      (pair-right mimicked-list)))