Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #lang racket
- ;;; rozdział 3.1.1
- (define balance 100)
- (define (withdraw amount)
- (if (>= balance amount)
- (begin (set! balance (- balance amount))
- balance)
- "Insufficient funds"))
- ;: (withdraw 25)
- ;: (withdraw 25)
- ;: (withdraw 60)
- ;: (withdraw 15)
- (define new-withdraw
- (let ((balance 100))
- (lambda (amount)
- (if (>= balance amount)
- (begin (set! balance (- balance amount))
- balance)
- "Insufficient funds"))))
- (define (make-withdraw balance)
- (lambda (amount)
- (if (>= balance amount)
- (begin (set! balance (- balance amount))
- balance)
- "Insufficient funds")))
- ;: (define W1 (make-withdraw 100))
- ;: (define W2 (make-withdraw 100))
- ;: (W1 50)
- ;: (W2 70)
- ;: (W2 40)
- ;: (W1 40)
- (define (make-account balance password)
- (define (withdraw amount)
- (if (>= balance amount)
- (begin (set! balance (- balance amount))
- balance)
- "Insufficient funds"))
- (define (deposit amount)
- (set! balance (+ balance amount))
- balance)
- (define (incorrect-pass i)
- 'incorect-pass)
- (define (change-pass p)
- (set! password p))
- (define (dispatch m p)
- (cond ((not (eq? p password)) incorrect-pass)
- ((eq? m 'change-pass) change-pass)
- ((eq? m 'withdraw) withdraw)
- ((eq? m 'deposit) deposit)
- (else (error "Unknown request -- MAKE-ACCOUNT"
- m))))
- dispatch)
- ;: (define acc (make-account 100))
- ;: ((acc 'withdraw) 50)
- ;: ((acc 'withdraw) 60)
- ;: ((acc 'deposit) 40)
- ;: ((acc 'withdraw) 60)
- ;;; rozdział 3.1.3
- (define (make-simplified-withdraw balance)
- (lambda (amount)
- (set! balance (- balance amount))
- balance))
- ;: (define W (make-simplified-withdraw 25))
- ;: (W 20)
- ;: (W 10)
- (define (make-decrementer balance)
- (lambda (amount)
- (- balance amount)))
- ;: (define D (make-decrementer 25))
- ;: (D 20)
- ;: (D 10)
- ;: ((make-decrementer 25) 20)
- ;: ((lambda (amount) (- 25 amount)) 20)
- ;: (- 25 20)
- ;: ((make-simplified-withdraw 25) 20)
- ;: ((lambda (amount) (set! balance (- 25 amount)) 25) 20)
- ;: (set! balance (- 25 20)) 25
- ;;; Toższamość obiektów
- ;: (define D1 (make-decrementer 25))
- ;: (define D2 (make-decrementer 25))
- ;:
- ;: (define W1 (make-simplified-withdraw 25))
- ;: (define W2 (make-simplified-withdraw 25))
- ;:
- ;: (W1 20)
- ;: (W1 20)
- ;: (W2 20)
- ;: (define peter-acc (make-account 100))
- ;: (define paul-acc (make-account 100))
- ;:
- ;: (define peter-acc (make-account 100))
- ;: (define paul-acc peter-acc)
- ;;; Kłopoty z programowaniem imperatywnym
- #|(define (factorial n)
- (define (iter product counter)
- (if (> counter n)
- product
- (iter (* counter product)
- (+ counter 1))))
- (iter 1 1))
- |#
- (define (factorial n)
- (let ((product 1)
- (counter 1))
- (define (iter)
- (if (> counter n)
- product
- (begin (set! product (* counter product))
- (set! counter (+ counter 1))
- (iter))))
- (iter)))
- (define (cons x y)
- (define (set-x! v) (set! x v))
- (define (set-y! v) (set! y v))
- (define (dispatch m)
- (cond ((eq? m 'car) x)
- ((eq? m 'cdr) y)
- ((eq? m 'set-car!) set-x!)
- ((eq? m 'set-cdr!) set-y!)
- (else (error "Undefined operation -- CONS" m))))
- dispatch)
- (define (car z) (z 'car))
- (define (cdr z) (z 'cdr))
- (define (set-car! z new-value)
- ((z 'set-car!) new-value)
- z)
- (define (set-cdr! z new-value)
- ((z 'set-cdr!) new-value)
- z)
- ;; zad 2
- (define (make-cycle l)
- (define (aux x)
- (if (null? (mcdr x))
- (set-mcdr! x l)
- (aux (mcdr l))))
- (aux l))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement