[plt-scheme] hey

From: emre berat nebioğlu (beratn at gmail.com)
Date: Sat Feb 28 08:32:41 EST 2009

(define (valid-symbol? x)
(and (symbol? x) (not (equal? x 'λ))))

;;;

(define-type LS
(id (s symbol?))
(func-def (id symbol?) (body LS?))
(func-app (applier LS?) (applyed LS?)))

;;recognizer: s-expression -> boolean
;;x -> #t
;;(x y) -> #t
;;(x) -> #f

(define (hof-filter s body)
(filter (lambda(x) (equal? x s)) body))

(define (recognizer sexp)
(cond
((valid-symbol? sexp) true)
((and (list? sexp) (= (length sexp) 3) (equal? (first sexp) 'λ)) (and
(valid-symbol? (second sexp)) (recognizer (third sexp))))
((and (list? sexp) (= (length sexp) 2)) (and (recognizer (first sexp))
(recognizer (second sexp))))
(else false)))

;(test (recognizer 'ali) true)
;(test (recognizer '(λ ali veli)) true)
;(test (recognizer '(λ ali (λ veli nuri))) true)
;(test (recognizer '(λ ali veli nuri)) false)
;(test (recognizer '(ali nuri)) true)
;(test (recognizer '(ali '(λ ali nuri))) true)
;(test (recognizer '(ali)) false)
;(test (recognizer '(k l z)) false)
;(test (recognizer '(λ x)) false)
;(test (recognizer '(λ λ x)) false)
;(test (recognizer '(λ x λ)) false)

;;parser
;;parser: s-exp--> lambda-sentence

(define (parser sexp)
(cond
((valid-symbol? sexp) (id sexp))
((and (list? sexp) (= (length sexp) 3) (equal? (first sexp) 'λ)) (func-def
(second sexp) (parser (third sexp))))
((and (list? sexp) (= (length sexp) 2)) (func-app (parser (first sexp))
(parser (second sexp))))
(else (error "z"))))
;(parser '(λ x (λ y (y x))))
;(test (parser 'x) (id 'x))
;(test (parser '(x y)) (func-app (id 'x) (id 'y)))
(parser '(λ x (λ y ((y z) v))))
;(func-def 'x (id 'y)))
;(test (parser '((λ x y) (λ z x))))
;(test (parse '(λ x(λ y ((y x) z)))))
;(parser 'x)
;(parser '(x y))
;(parser '(λ x y))

;

(define (remove-from-body s body)
(cond
((null? body) null)
((not (equal? s (car body))) (cons (car body) (remove-from-body s (cdr
body))))
(else
(remove-from-body s (cdr body)))))
;contract : s(element) body(list) -> body
(define (addition s body)
(cond
((null? body) null)
((eqv? s (car body)) body)
;(((not (eqv? s (car body))) (cons s (car body)))))
(else
(cons s (car body)))))



(define (append-my-own-ver body1 body2)
(cond
((null? body1) body2)
((null? body2) body1)
(else
(cons (car body1) (append-my-own-ver (cdr body1) body2)))))

;;LS--> list-of-free variables
(define (find-frees ls)
(type-case LS ls
(id (x) (list x))
(func-def (name body) (remove-from-body name (find-frees body)))
(func-app (body1 body2) (append-my-own-ver (find-frees body1) (find-frees
body2)))))

(define (find-bounds ls)
(type-case LS ls
(id (x) (list x))
(func-def (name body) (addition name (find-bounds body)))

(func-app (body1 body2) (append-my-own-ver (find-bounds body1) (find-bounds
body2)))))


i try to implement lambda calculuıs in plai scheme.I define find-frees which
help from a function that is remove-from body.That works perfectly.

And i wrote find-bounds which takes help from a function whose name is
addition.But find-bounds is little problematic and i cannot find the
mistake.How can i fix that ?

thank very regards.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20090228/2480b4d0/attachment.html>

Posted on the users mailing list.