Stare semestry, niepoukladane

2 files changed, 369 insertions, 0 deletions

diff --git a/Semestr 2/racket/l8z15/solution.bak b/Semestr 2/racket/l8z15/solution.bak
new file mode 100644
index 0000000..cdc84f9
--- /dev/null
+++ b/Semestr 2/racket/l8z15/solution.bak
@@ -0,0 +1,187 @@
+#lang racket

+

+; Do list.rkt dodajemy procedury

+;

+; Miejsca, ktore sie zmienily oznaczone sa przez !!!

+

+(provide parse eval)

+

+; --------- ;

+; Wyrazenia ;

+; --------- ;

+

+(struct const      (val)      #:transparent)

+(struct binop      (op l r)   #:transparent)

+(struct var-expr   (id)       #:transparent)

+(struct let-expr   (id e1 e2) #:transparent)

+(struct if-expr    (eb et ef) #:transparent)

+(struct cons-expr  (e1 e2)    #:transparent)

+(struct car-expr   (e)        #:transparent)

+(struct cdr-expr   (e)        #:transparent)

+(struct null-expr  ()         #:transparent)

+(struct null?-expr (e)        #:transparent)

+(struct app        (f e)      #:transparent) ; <------------------ !!!

+(struct lam        (id e)     #:transparent) ; <------------------ !!!

+

+(define (expr? e)

+  (match e

+    [(const n) (or (number? n) (boolean? n))]

+    [(binop op l r) (and (symbol? op) (expr? l) (expr? r))]

+    [(var-expr x) (symbol? x)]

+    [(let-expr x e1 e2)

+     (and (symbol? x) (expr? e1) (expr? e2))]

+    [(if-expr eb et ef)

+     (and (expr? eb) (expr? et) (expr? ef))]

+    [(cons-expr e1 e2) (and (expr? e1) (expr? e2))]

+    [(car-expr e) (expr? e)]

+    [(cdr-expr e) (expr? e)]

+    [(null-expr) true]

+    [(null?-expr e) (expr? e)]

+    [(app f e) (and (expr? f) (expr? e))] ; <--------------------- !!!

+    [(lam id e) (and (symbol? id) (expr? e))] ; <----------------- !!!

+    [_ false]))

+

+(define (parse q)

+  (cond

+    [(number? q) (const q)]

+    [(eq? q 'true)  (const true)]

+    [(eq? q 'false) (const false)]

+    [(eq? q 'null)  (null-expr)]

+    [(symbol? q) (var-expr q)]

+    [(and (list? q) (eq? (length q) 2) (eq? (first q) 'null?))

+     (null?-expr (parse (second q)))]

+    [(and (list? q) (eq? (length q) 3) (eq? (first q) 'cons))

+     (cons-expr (parse (second q))

+                (parse (third q)))]

+    [(and (list? q) (eq? (length q) 2) (eq? (first q) 'car))

+     (car-expr (parse (second q)))]

+    [(and (list? q) (eq? (length q) 2) (eq? (first q) 'cdr))

+     (cdr-expr (parse (second q)))]

+    [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let))

+     (let-expr (first (second q))

+               (parse (second (second q)))

+               (parse (third q)))]

+    [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if))

+     (if-expr (parse (second q))

+              (parse (third q))

+              (parse (fourth q)))]

+    [(and (list? q) (eq? (length q) 3) (eq? (first q) 'lambda)) ; <!!!

+     (parse-lam (second q) (third q))]

+    [(and (list? q) (pair? q) (not (op->proc (car q)))) ; <------- !!!

+     (parse-app q)]

+    [(and (list? q) (eq? (length q) 3) (symbol? (first q)))

+     (binop (first q)

+            (parse (second q))

+            (parse (third q)))]))

+

+(define (parse-app q) ; <----------------------------------------- !!!

+  (define (parse-app-accum q acc)

+    (cond [(= 1 (length q)) (app acc (parse (car q)))]

+          [else (parse-app-accum (cdr q) (app acc (parse (car q))))]))

+  (parse-app-accum (cdr q) (parse (car q))))

+

+(define (parse-lam pat e) ; <------------------------------------- !!!

+  (cond [(= 1 (length pat))

+         (lam (car pat) (parse e))]

+        [else

+         (lam (car pat) (parse-lam (cdr pat) e))]))

+

+; ---------- ;

+; Srodowiska ;

+; ---------- ;

+

+(struct environ (xs) #:transparent)

+

+(define env-empty (environ null))

+(define (env-add x v env)

+  (environ (cons (cons x v) (environ-xs env))))

+(define (env-lookup x env)

+  (define (assoc-lookup xs)

+    (cond [(null? xs) (error "Unknown identifier" x)]

+          [(eq? x (car (car xs))) (cdr (car xs))]

+          [else (assoc-lookup (cdr xs))]))

+  (assoc-lookup (environ-xs env)))

+

+; --------- ;

+; Ewaluacja ;

+; --------- ;

+

+(struct clo (id e env) #:transparent) ; <------------------------- !!!

+(struct odr (e env)    #:transparent)

+

+(define (value? v)

+  (or (number? v)

+      (boolean? v)

+      (and (pair? v) (value? (car v)) (value? (cdr v)))

+      (null? v)

+      (clo? v))) ; <---------------------------------------------- !!!

+

+(define (op->proc op)

+  (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo]

+            ['= =] ['> >] ['>= >=] ['< <] ['<= <=]

+            ['and (lambda (x y) (and x y))]

+            ['or  (lambda (x y) (or  x y))]

+            [_ false])) ; <--------------------------------------- !!!

+

+(define (eval-env e env)

+  (match e

+    [(const n) n]

+    [(binop op l r) ((op->proc op) (eval-env l env)

+                                   (eval-env r env))]

+    [(let-expr x e1 e2)

+     (eval-env e2 (env-add x (eval-env e1 env) env))]

+    [(var-expr x) (match (env-lookup x env)

+                    [(odr e env) (eval-env e env)]

+                    [f f])]

+    [(if-expr eb et ef) (if (eval-env eb env)

+                            (eval-env et env)

+                            (eval-env ef env))]

+    [(cons-expr e1 e2) (cons (odr e1 env)

+                             (odr e2 env))]

+    [(car-expr e) (let ([p (eval-env e env)])

+                    (match (car p)

+                      [(odr e env) (eval-env e env)]))]

+    [(cdr-expr e) (let ([p (eval-env e env)])

+                (match (cdr p)

+                  [(odr e env) (eval-env e env)]))]

+    [(null-expr) null]

+    [(null?-expr e) (null? (eval-env e env))]

+    [(lam x e) (clo x e env)] ; <--------------------------------- !!!

+    [(app f e) ; <------------------------------------------------ !!!

+     (let ([vf (eval-env f env)]

+           [ve (odr e env)])

+       (match vf [(clo x body fun-env)

+                  (eval-env body (env-add x ve fun-env))]))]))

+

+(define (eval e) (eval-env e env-empty))

+

+(define program

+  '(let [twice (lambda (f x) (f (f x)))]

+   (let [inc (lambda (x) (+ 1 x))]

+     (twice twice twice twice inc 1))))

+    

+

+;;; Testy wspólnie z Karolem Ochmanem

+

+(define (test-eval program) (eval (parse program)))

+

+(define program1

+  '((lambda (x) (+ 3 3)) (/ 5 0)))

+(define program2

+  '(let [if-fun (lambda (b t e) (if b t e))]

+     (if-fun true 4 (/ 5 0))))

+(define program3

+  '(car (cdr (cons 1 (cons 2 (cons 3 (cons 4 null)))))))

+(define program4

+  '(car (cons (+ 3 4) (/ 5 0))))

+(define program5

+  '(cons (+ 5 6) (- 4 3)))

+(define program6

+  '(car (cdr (cdr (car (cons (cons (/ 0 0) (cons (/ 0 0) (cons 1 (/ 0 0)))) (cdr (cons (/ 0 0) null))))))))

+;;; (test-eval program)

+;;; (test-eval program1)

+;;; (test-eval program2)

+;;; (test-eval program3)

+;;; (test-eval program4)

+;;; (test-eval program5)

+;;; (test-eval program6)
\ No newline at end of file
diff --git a/Semestr 2/racket/l8z15/solution.rkt b/Semestr 2/racket/l8z15/solution.rkt
new file mode 100644
index 0000000..54b6cd3
--- /dev/null
+++ b/Semestr 2/racket/l8z15/solution.rkt
@@ -0,0 +1,182 @@
+#lang racket

+

+; Do list.rkt dodajemy procedury

+;

+; Miejsca, ktore sie zmienily oznaczone sa przez !!!

+

+(provide parse eval)

+

+; --------- ;

+; Wyrazenia ;

+; --------- ;

+

+(struct const      (val)      #:transparent)

+(struct binop      (op l r)   #:transparent)

+(struct var-expr   (id)       #:transparent)

+(struct let-expr   (id e1 e2) #:transparent)

+(struct if-expr    (eb et ef) #:transparent)

+(struct cons-expr  (e1 e2)    #:transparent)

+(struct car-expr   (e)        #:transparent)

+(struct cdr-expr   (e)        #:transparent)

+(struct null-expr  ()         #:transparent)

+(struct null?-expr (e)        #:transparent)

+(struct app        (f e)      #:transparent) ; <------------------ !!!

+(struct lam        (id e)     #:transparent) ; <------------------ !!!

+

+(define (expr? e)

+  (match e

+    [(const n) (or (number? n) (boolean? n))]

+    [(binop op l r) (and (symbol? op) (expr? l) (expr? r))]

+    [(var-expr x) (symbol? x)]

+    [(let-expr x e1 e2)

+     (and (symbol? x) (expr? e1) (expr? e2))]

+    [(if-expr eb et ef)

+     (and (expr? eb) (expr? et) (expr? ef))]

+    [(cons-expr e1 e2) (and (expr? e1) (expr? e2))]

+    [(car-expr e) (expr? e)]

+    [(cdr-expr e) (expr? e)]

+    [(null-expr) true]

+    [(null?-expr e) (expr? e)]

+    [(app f e) (and (expr? f) (expr? e))] ; <--------------------- !!!

+    [(lam id e) (and (symbol? id) (expr? e))] ; <----------------- !!!

+    [_ false]))

+

+(define (parse q)

+  (cond

+    [(number? q) (const q)]

+    [(eq? q 'true)  (const true)]

+    [(eq? q 'false) (const false)]

+    [(eq? q 'null)  (null-expr)]

+    [(symbol? q) (var-expr q)]

+    [(and (list? q) (eq? (length q) 2) (eq? (first q) 'null?))

+     (null?-expr (parse (second q)))]

+    [(and (list? q) (eq? (length q) 3) (eq? (first q) 'cons))

+     (cons-expr (parse (second q))

+                (parse (third q)))]

+    [(and (list? q) (eq? (length q) 2) (eq? (first q) 'car))

+     (car-expr (parse (second q)))]

+    [(and (list? q) (eq? (length q) 2) (eq? (first q) 'cdr))

+     (cdr-expr (parse (second q)))]

+    [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let))

+     (let-expr (first (second q))

+               (parse (second (second q)))

+               (parse (third q)))]

+    [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if))

+     (if-expr (parse (second q))

+              (parse (third q))

+              (parse (fourth q)))]

+    [(and (list? q) (eq? (length q) 3) (eq? (first q) 'lambda)) ; <!!!

+     (parse-lam (second q) (third q))]

+    [(and (list? q) (pair? q) (not (op->proc (car q)))) ; <------- !!!

+     (parse-app q)]

+    [(and (list? q) (eq? (length q) 3) (symbol? (first q)))

+     (binop (first q)

+            (parse (second q))

+            (parse (third q)))]))

+

+(define (parse-app q) ; <----------------------------------------- !!!

+  (define (parse-app-accum q acc)

+    (cond [(= 1 (length q)) (app acc (parse (car q)))]

+          [else (parse-app-accum (cdr q) (app acc (parse (car q))))]))

+  (parse-app-accum (cdr q) (parse (car q))))

+

+(define (parse-lam pat e) ; <------------------------------------- !!!

+  (cond [(= 1 (length pat))

+         (lam (car pat) (parse e))]

+        [else

+         (lam (car pat) (parse-lam (cdr pat) e))]))

+

+; ---------- ;

+; Srodowiska ;

+; ---------- ;

+

+(struct environ (xs) #:transparent)

+

+(define env-empty (environ null))

+(define (env-add x v env)

+  (environ (cons (cons x v) (environ-xs env))))

+(define (env-lookup x env)

+  (define (assoc-lookup xs)

+    (cond [(null? xs) (error "Unknown identifier" x)]

+          [(eq? x (car (car xs))) (cdr (car xs))]

+          [else (assoc-lookup (cdr xs))]))

+  (assoc-lookup (environ-xs env)))

+

+; --------- ;

+; Ewaluacja ;

+; --------- ;

+

+(struct clo (id e env) #:transparent) ; <------------------------- !!!

+(struct odr (e env)    #:transparent)

+

+(define (value? v)

+  (or (number? v)

+      (boolean? v)

+      (and (pair? v) (value? (car v)) (value? (cdr v)))

+      (null? v)

+      (clo? v))) ; <---------------------------------------------- !!!

+

+(define (op->proc op)

+  (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo]

+            ['= =] ['> >] ['>= >=] ['< <] ['<= <=]

+            ['and (lambda (x y) (and x y))]

+            ['or  (lambda (x y) (or  x y))]

+            [_ false])) ; <--------------------------------------- !!!

+

+(define (eval-env e env)

+  (match e

+    [(const n) n]

+    [(binop op l r) ((op->proc op) (eval-env l env)

+                                   (eval-env r env))]

+    [(let-expr x e1 e2)

+     (eval-env e2 (env-add x (eval-env e1 env) env))]

+    [(var-expr x) (match (env-lookup x env)

+                    [(odr e env) (eval-env e env)]

+                    [f f])]

+    [(if-expr eb et ef) (if (eval-env eb env)

+                            (eval-env et env)

+                            (eval-env ef env))]

+    [(cons-expr e1 e2) (cons (odr e1 env)

+                             (odr e2 env))]

+    [(car-expr e) (let ([p (eval-env e env)])

+                    (match (car p)

+                      [(odr e env) (eval-env e env)]))]

+    [(cdr-expr e) (let ([p (eval-env e env)])

+                    (match (cdr p)

+                      [(odr e env) (eval-env e env)]))]

+    [(null-expr) null]

+    [(null?-expr e) (null? (eval-env e env))]

+    [(lam x e) (clo x e env)] ; <--------------------------------- !!!

+    [(app f e) ; <------------------------------------------------ !!!

+     (let ([vf (eval-env f env)]

+           [ve (odr e env)])

+       (match vf [(clo x body fun-env)

+                  (eval-env body (env-add x ve fun-env))]))]))

+

+(define (eval e) (eval-env e env-empty))

+    

+

+;;; Testy wspólnie z Karolem Ochmanem

+

+(define (test-eval program) (eval (parse program)))

+

+(define program1

+  '((lambda (x) (+ 3 3)) (/ 5 0)))

+(define program2

+  '(let [if-fun (lambda (b t e) (if b t e))]

+     (if-fun true 4 (/ 5 0))))

+(define program3

+  '(car (cdr (cons 1 (cons 2 (cons 3 (cons 4 null)))))))

+(define program4

+  '(car (cons (+ 3 4) (/ 5 0))))

+(define program5

+  '(cons (+ 5 6) (- 4 3)))

+(define program6

+  '(car (cdr (cdr (car (cons (cons (/ 0 0) (cons (/ 0 0) (cons 1 (/ 0 0)))) (cdr (cons (/ 0 0) null))))))))

+;;; (test-eval program)

+;;; (test-eval program1)

+;;; (test-eval program2)

+;;; (test-eval program3)

+;;; (test-eval program4)

+;;; (test-eval program5)

+;;; (test-eval program6)
\ No newline at end of file