diff options
| -rw-r--r-- | sem7/pp/lec2.scm | 99 | ||||
| -rw-r--r-- | sem7/pp/lec3.scm | 125 |
2 files changed, 224 insertions, 0 deletions
diff --git a/sem7/pp/lec2.scm b/sem7/pp/lec2.scm new file mode 100644 index 0000000..72d6904 --- /dev/null +++ b/sem7/pp/lec2.scm @@ -0,0 +1,99 @@ +;; This is not meant do be, please do not use define-syntax too much. +;; Just leaving this here to remember how it works. +(define-syntax lambda-curry + (syntax-rules () + [(_ (x) b1 b2 ...) + (lambda (x) b1 b2 ...)] + [(_ (x r ...) b1 b2 ...) + (lambda (x) + (lambda-curry (r ...) b1 b2 ...) + )] + )) + +(define-syntax call-curry + (syntax-rules () + [(_ f x) + (f x)] + [(_ f x r ...) + (call-curry (f x) r ...)] + )) + +;;# Exercise 2.21 +;;? Create a differentiation function +;;? For the delta use a very small number ;-) +(define (diff f) + (lambda (x) + (let [(delta 0.00001)] + (/ (- (f (+ delta x)) (f x)) delta)) + )) + +;; Lets get a text function +(define (f x) (* x x)) +(define (fd x) (* 2 x)) + +;;? Create compare-2-function which takes two functions and and array of numbers +(define (compare-2-funcs f1 f2 numbers) + (map (lambda (num) + (- (f2 num) (f1 num))) + numbers)) + +;; Yeah not tail recursive, but its fine +(define (linspace start stop step) + (if (> start stop) + '() + (cons start (linspace (+ start step) stop step)) + )) + +(define (accumulate f nul) + (letrec [(self (lambda (lst) + (if (null? lst) + nul + (f (car lst) (self (cdr lst))) + )) + )] self)) + +(define sum (accumulate + 0)) + +;;# Exercise 2.11 +;;? Create a generator function for (cmp x y) which takes a lt (less than) function. +;;? (cmp x y) returns -1 if x < y, 0 when x = y and 1 when x > y. +(define (make-cmp lt) + (lambda (x y) + (cond [(lt x y) -1] + [(lt y x) 1] + [else 0]) + )) + +(define (from-cmp cmp) + (let* ([lt (lambda (x y) (= -1 (cmp x y)))] + [gt (lambda (x y) (= 1 (cmp x y)))] + [eq (lambda (x y) (= 0 (cmp x y)))] + ) (values lt gt eq))) + +;;# Exercise 2.2 +(define (replication-to list len) + (letrec ([recur (lambda (part len res) + (cond [(zero? len) res] + [(null? part) (recur list len res)] + [else (recur (cdr part) (1- len) (cons (car part) res))] + ))] + ) (reverse (recur list len '())))) + +;;# Exercise 2.16 +(define (for-all-1 lst p) + ((accumulate (lambda (x y) (and y (p x))) #t) lst)) + +(define (there-exists lst p) + ((accumulate (lambda (x y) (or y (p x))) #f) lst)) + +;; Wow im a bit stupid, but this is much easier with a filter function +;; The above one's too +;; I dont want to implement it right now +(define (there-exists-1 lst p) + (car ((accumulate (lambda (x state) (let ([good (p x)]) + (cons (cond [(not (cdr state)) good] + [good #f] + [else #t]) + (or good (cdr state)) + ))) (cons #f #f)) lst))) + diff --git a/sem7/pp/lec3.scm b/sem7/pp/lec3.scm new file mode 100644 index 0000000..7babbb8 --- /dev/null +++ b/sem7/pp/lec3.scm @@ -0,0 +1,125 @@ +(define (to-string thing) + (let ([format-pair-tail + (lambda (tail) + (apply string-append (cond [(null? tail) (list "")] + [(pair? tail) (list " " (to-string tail))] + [else (list " . " (to-string tail))]))) + ]) + (cond [(number? thing) (number->string thing)] + [(symbol? thing) (symbol->string thing)] + [(null? thing) "()"] + [(procedure? thing) "#function#"] + [(pair? thing) (string-append + (to-string (car thing)) + (format-pair-tail (cdr thing)))] + [(string? thing) thing] + [else "?"] + ))) + +(define (create-dispatch methods super-func) + (lambda (msg) + (let ([method (assoc msg methods)]) + (if method (cdr method) ((super-func) msg)) + ))) + +(define (send obj msg . para) + (let ((method (obj msg))) + (apply method para))) + +(define (new-instance class . para) + (apply class (cons '() para))) + +;; TODO implement str +(define (object self-into) + (letrec ([whoami 'object] + [dispatch (create-dispatch (list + [cons 'pretty-str (lambda () + (to-string (send (self) 'pretty)))] + [cons 'pretty (lambda () (list whoami))] + [cons 'type-of (lambda () whoami)] + [cons 'class-of (lambda () object)] + ) '())] + [self (lambda () (if (null? self-into) dispatch self-into))] + ) dispatch)) + +(define (point self-into x y) + (letrec ([whoami 'point] + [super (lambda () (object (self)))] + [self (lambda () (if (null? self-into) (dispatch) self-into))] + [pretty (lambda () (list whoami x y))] + [move (lambda (dx dy) + (send (self) 'add (new-instance point dx dy)))] + [add (lambda (other) + (new-instance (send (self) 'class-of) (+ x (send other 'getx)) + (+ y (send other 'gety)) + ))] + [with-color (lambda (color) (new-instance color-point + (send (self) 'getx) + (send (self) 'gety) + color))] + [dispatch (lambda () (create-dispatch (list + [cons 'getx (lambda () x)] + [cons 'gety (lambda () y)] + [cons 'add add] + [cons 'pretty pretty] + [cons 'move move] + [cons 'type-of (lambda () whoami)] + [cons 'class-of (lambda () point)] + [cons 'with-color with-color] + ) super))] + ) (dispatch))) + +(define p1 (new-instance point 10 20)) +(define p2 (new-instance point 1 1)) + +(define (color-point self-into x y . color) + (let ((color (if (null? color) 'green (car color)))) + (letrec ([whoami 'color-point] + [super (lambda () (point (self) x y))] + [self (lambda () (if (null? self-into) (dispatch) self-into))] + [pretty (lambda () (list whoami + (send (self) 'getx) + (send (self) 'gety) + color))] + [dispatch (lambda () (create-dispatch (list + [cons 'get-color (lambda () color)] + [cons 'type-of (lambda () whoami)] + [cons 'pretty pretty] + [cons 'class-of (lambda () color-point)] + ) super))] + ) (dispatch)))) + +;;# Exercise 3.7 +;;? What is the value of the expression +(let ((x 1) + (y 2) + (z 3) + (v 5)) + (cons x + (call/cc (lambda (e) + (cons y + (cons z + (if (even? v) v (e (+ v 1))))))))) +;; Okay lets start by looking at it: +;; Okay, we define x y z and v +;; Then we create a cons with x and the continuations, so the result must be +;; something like (1 . ???) +;; If v is even, it will do some cons stuff with the other guys, but it's not. +;; Therefore the result of (call/cc ...) is (e (+ v 1)) which is 6. +;; Therefore the result must be (1 . 6) + +;; Okay when running it is (1 . 6). + +;;# Exercise 3.4 +;;? Program (lambda (a b c) (- (* b b) (* 4 a c))) in CPS +(define (sub a b k) + (k (- a b))) +(define (mult a b k) + (k (* a b))) +(define (dist a b c k) + (mult a c (lambda (v) + (mult 4 v (lambda (v1) + (mult b b (lambda (v2) + (sub v2 v1 k)))))))) + +(define dist-old (lambda (a b c) (- (* b b) (* 4 a c)))) |