Duzy commit ze smieciami

4 files changed, 353 insertions, 0 deletions

diff --git a/semestr-2/racket/l13/oceny.txt b/semestr-2/racket/l13/oceny.txt
new file mode 100644
index 0000000..9f17cad
--- /dev/null
+++ b/semestr-2/racket/l13/oceny.txt
@@ -0,0 +1,18 @@
+1 sem

+

+MDM - 5 5

+AO - 5

+AM 1 - 5 5

+LDI - 5 5

+MIA - 5

+

+8 * 5

+

+

+2 sem

+

+Topologia - 5 3

+Analiza - 4 4

+MP - 5 5

+PPS - 5

+Algebra - 5 5
\ No newline at end of file
diff --git a/semestr-2/racket/l13/rozw.rkt b/semestr-2/racket/l13/rozw.rkt
new file mode 100644
index 0000000..b4094db
--- /dev/null
+++ b/semestr-2/racket/l13/rozw.rkt
@@ -0,0 +1,79 @@
+#lang typed/racket

+

+

+;;; zadanie 1

+

+(: prefixes (All (a) (-> (Listof a) (Listof (Listof a)))))

+(define (prefixes xs)

+  (if (null? xs)

+      (list null)

+      (cons xs (prefixes (cdr xs)))))

+

+

+

+;;; zadanie 2

+

+(struct vector2 ([x : Real] [y : Real])             #:transparent)

+(struct vector3 ([x : Real] [y : Real] [z : Real])  #:transparent)

+

+(define-type Vector (U vector2 vector3))

+(define-predicate vector? Vector)

+

+

+(: square (-> Real Nonnegative-Real))

+(define (square x)

+  (if (< x 0) (* x x) (* x x)))

+

+

+;;; pierwsza wersja

+

+(: vector-length (-> Vector Nonnegative-Real))

+(define (vector-length v)

+  (if (vector2? v)

+      (match v [(vector2 x y) (sqrt (+ (square x) (square y)))])

+      (match v [(vector3 x y z) (sqrt (+ (square x) (square y) (square z)))])))

+

+

+;;; druga wersja

+

+(: vector-length-match (-> Vector Nonnegative-Real))

+(define (vector-length-match v)

+  (match v

+    [(vector2 x y) (sqrt (+ (square x) (square y)))]

+    [(vector3 x y z) (sqrt (+ (square x) (square y) (square z)))]))

+

+

+

+;;; zadanie 4

+

+(struct leaf () #:transparent)

+(struct [a] node ([v : a] [xs : (Listof (Tree a))]) #:transparent)

+

+(define-type (Tree a) (node a))

+(define-predicate tree? (Tree Any))

+

+

+(: flat-map (All (a) (-> (-> (Tree a) (Listof a)) (Listof (Tree a)) (Listof a))))

+(define (flat-map f xs)

+  (if (null? xs)

+      null

+      (append (f (car xs)) (flat-map f (cdr xs)))))

+

+(: preorder (All (a) (-> (Tree a) (Listof a))))

+(define (preorder t)

+  (match t

+    [(node v xs)

+     (cons v (flat-map preorder xs))]))

+

+;;;  (preorder (node 1 (list 

+;;;                     (node 2 (list 

+;;;                               (node 3 '()) 

+;;;                               (node 4 '()))) 

+;;;                     (node 5 '()) 

+;;;                     (node 'x (list 

+;;;                               (node 't (list 

+;;;                                           (node 'z '()))))))))

+

+

+;;; zadanie 6

+

diff --git a/semestr-2/racket/l13/solution.rkt b/semestr-2/racket/l13/solution.rkt
new file mode 100644
index 0000000..61804b3
--- /dev/null
+++ b/semestr-2/racket/l13/solution.rkt
@@ -0,0 +1,124 @@
+#lang typed/racket

+

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

+; Wyrazenia ;

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

+

+(provide parse typecheck)

+

+(define-type Expr (U const binop var-expr let-expr if-expr))

+(define-type Value (U Real Boolean))

+(define-type ArithOp (U '+ '- '/ '* '%))

+;;; (define-type ModOp '%)

+(define-type CompOp (U '= '> '>= '< '<=))

+(define-type LogicOp (U 'and 'or))

+(define-type BinopSym (U ArithOp CompOp LogicOp))

+

+(struct const    ([val : Value])                          #:transparent)

+(struct binop    ([op : BinopSym] [l : Expr] [r : Expr])  #:transparent)

+(struct var-expr ([id : Symbol])                          #:transparent)

+(struct let-expr ([id : Symbol] [e1 : Expr] [e2 : Expr])  #:transparent)

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

+

+(define-predicate expr? Expr)

+(define-predicate value? Value)

+(define-predicate arith-op? ArithOp)

+;;; (define-predicate mod-op? ModOp)

+(define-predicate comp-op? CompOp)

+(define-predicate logic-op? LogicOp)

+(define-predicate binop-sym? BinopSym)

+(define-predicate let-list? (List Symbol Any))

+

+(: parse (-> Any Expr))

+(define (parse q)

+  (match q

+    [_ #:when (value? q) (const q)]

+    [_ #:when (eq? q 'true) (const true)] 

+    [_ #:when (eq? q 'false) (const false)] ; <---------------------------- !!!

+    [_ #:when (symbol? q) (var-expr q)]

+    [`(,s ,e1 ,e2)

+      #:when (and (eq? s 'let) (let-list? e1))

+      (let-expr (car e1)

+                (parse (cadr e1))

+                (parse e2))]

+    [`(,s ,eb ,et ,ef)

+      #:when (eq? s 'if)

+     (if-expr (parse eb)

+              (parse et)

+              (parse ef))]

+    [`(,s ,e1 ,e2)

+      #:when (binop-sym? s)

+     (binop s

+            (parse e1)

+            (parse e2))]

+    [else (error "Parse error" q)]))

+

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

+; Srodowiska ;

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

+

+(define-type EType (U 'real 'boolean))

+(define-predicate EType? EType)

+

+(struct environ ([xs : (Listof (Pairof Symbol EType))]))

+(define env-empty (environ null))

+

+(: env-add (-> Symbol EType environ environ))

+(define (env-add x v env)

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

+

+(: env-lookup (-> Symbol environ EType))

+(define (env-lookup x env) 

+  (: assoc-lookup (-> (Listof (Pairof Symbol EType)) EType))

+  (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)))

+

+(: check-op (-> Expr Expr EType EType environ (U EType #f)))

+(define (check-op e1 e2 arg-type ret-type env)

+  (if (and (eq? (typecheck-env e1 env) arg-type)

+           (eq? (typecheck-env e2 env) arg-type))

+      ret-type

+      #f))

+

+(: typecheck-env (-> Expr environ (U EType #f)))

+(define (typecheck-env e env)

+  (match e

+    [(const val) 

+      (cond

+        [(real? val)    'real]

+        [(boolean? val) 'boolean])]

+    [(var-expr id) (env-lookup id env)]

+    [(binop op e1 e2)

+      (cond 

+        [(arith-op? op) (check-op e1 e2 'real 'real env)]

+        [(comp-op? op)  (check-op e1 e2 'real 'boolean env)]

+        [(logic-op? op) (check-op e1 e2 'boolean 'boolean env)])]

+    [(let-expr id e1 e2)

+      (let ((id-type (typecheck-env e1 env)))

+        (if id-type

+            (typecheck-env e2 (env-add id id-type env))

+            #f))]

+    [(if-expr eb et ef)

+      (let ((eb-type (typecheck-env eb env)))

+        (if (not (eq? eb-type 'boolean))

+            #f

+            (let ((et-type (typecheck-env et env))

+                  (ef-type (typecheck-env ef env)))

+              (if (eq? et-type ef-type)   ;;; nie trzeba sprawdzac czy ktores z nich to #f

+                  et-type                 ;;; jesli tak jest, to i tak sie na pewno zwroci #f    

+                  #f))))]))

+

+(: typecheck (-> Expr (U EType #f)))

+(define (typecheck e)

+  (typecheck-env e env-empty))

+

+(define program

+  '(if (or (< (% 123 10) 5)

+           true)

+       (+ 2 3)

+       (/ 2 0)))

+

+(define (test-eval) (eval (parse program)))
\ No newline at end of file
diff --git a/semestr-2/racket/l13/zad6.rkt b/semestr-2/racket/l13/zad6.rkt
new file mode 100644
index 0000000..1dcfbfc
--- /dev/null
+++ b/semestr-2/racket/l13/zad6.rkt
@@ -0,0 +1,132 @@
+#lang typed/racket

+

+; Do let-env.rkt dodajemy wartosci boolowskie

+;

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

+

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

+; Wyrazenia ;

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

+

+(define-type Expr (U const binop var-expr let-expr if-expr))

+(define-type Value (U Real Boolean))

+(define-type BinopSym (U '+ '- '/ '* '% '= '> '>= '< '<= 'and 'or))

+

+(struct const    ([val : Value])                          #:transparent)

+(struct binop    ([op : BinopSym] [l : Expr] [r : Expr])  #:transparent)

+(struct var-expr ([id : Symbol])                          #:transparent)

+(struct let-expr ([id : Symbol] [e1 : Expr] [e2 : Expr])  #:transparent)

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

+

+

+(define-predicate expr? Expr)

+(define-predicate value? Value)

+(define-predicate binop-sym? BinopSym)

+(define-predicate let-list? (List Symbol Any))

+

+(: parse (-> Any Expr))

+(define (parse q)

+  (match q

+    [_ #:when (value? q) (const  q)]

+    [_ #:when (eq? q 'true) (const true)] 

+    [_ #:when (eq? q 'false) (const false)] ; <---------------------------- !!!

+    [_ #:when (symbol? q) (var-expr q)]

+    [`(,s ,e1 ,e2)

+      #:when (and (eq? s 'let) (let-list? e1))

+      (let-expr (car e1)

+                (parse (cadr e1))

+                (parse e2))]

+    [`(,s ,eb ,et ,ef)

+      #:when (eq? s 'if)

+     (if-expr (parse eb)

+              (parse et)

+              (parse ef))]

+    [`(,s ,e1 ,e2)

+      #:when (binop-sym? s)

+     (binop s

+            (parse e1)

+            (parse e2))]

+    [else (error "Parse error" q)]))

+

+;;; (define (test-parse) (parse '(let [x (+ 2 2)] (+ x 1))))

+

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

+; Srodowiska ;

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

+

+(struct environ ([xs : (Listof (Pairof Symbol Value))]))

+(define env-empty (environ null))

+

+(: env-add (-> Symbol Value environ environ))

+(define (env-add x v env)

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

+

+(: env-lookup (-> Symbol environ Value))

+(define (env-lookup x env) 

+  (: assoc-lookup (-> (Listof (Pairof Symbol Value)) Value))

+  (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 ;

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

+

+(: arith-op (-> (-> Real Real Real) (-> Value Value Value)))

+(define (arith-op op)

+  (lambda (x y) (if (and (real? x) (real? y))

+                    (ann (op x y) Value)

+                    (error "Wrong args for arithmetic operator" op x y))))

+

+(: mod-op (-> (-> Integer Integer Integer) (-> Value Value Value)))

+(define (mod-op op)

+  (lambda (x y) (if (and (exact-integer? x) (exact-integer? y))

+                    (ann (op x y) Value)

+                    (error "Wrong args for modulo operator" op x y))))

+

+(: logic-op (-> (-> Boolean Boolean Boolean) (-> Value Value Value)))

+(define (logic-op op)

+  (lambda (x y) (if (and (boolean? x) (boolean? y))

+                    (ann (op x y) Value)

+                    (error "Wrong args for logic operator" op x y))))

+

+(: comp-op (-> (-> Real Real Boolean) (-> Value Value Value)))

+(define (comp-op op)

+  (lambda (x y) (if (and (real? x) (real? y))

+                    (ann (op x y) Value)

+                    (error "Wrong args for comparator" op x y))))

+

+

+(: op->proc (-> BinopSym (-> Value Value Value)))

+(define (op->proc op)

+  (match op ['+ (arith-op +)] ['- (arith-op -)] ['* (arith-op *)] ['/ (arith-op /)] 

+            ['% (mod-op modulo)]

+            ['= (comp-op =)] ['> (comp-op >)] ['>= (comp-op >=)] ['< (comp-op <)] ['<= (comp-op <=)]

+            ['and (logic-op (lambda (x y) (and x y)))]

+            ['or  (logic-op (lambda (x y) (or  x y)))]))

+

+(: eval-env (-> Expr environ Value))

+(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) (env-lookup x env)]

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

+                            (eval-env et env)

+                            (eval-env ef env))]))

+

+(: eval (-> Expr Value))

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

+

+(define program

+  '(if (or (< (% 123 10) 5)

+           true)

+       (+ 2 3)

+       (/ 2 0)))

+

+;;; (define (test-eval) (eval (parse program)))
\ No newline at end of file