aboutsummaryrefslogtreecommitdiff
path: root/Semestr 2/racket/egzamin
diff options
context:
space:
mode:
Diffstat (limited to 'Semestr 2/racket/egzamin')
-rw-r--r--Semestr 2/racket/egzamin/rozw2.txt1
-rw-r--r--Semestr 2/racket/egzamin/zad1.bak1
-rw-r--r--Semestr 2/racket/egzamin/zad1.rkt300
-rw-r--r--Semestr 2/racket/egzamin/zad1a.bak300
-rw-r--r--Semestr 2/racket/egzamin/zad1a.rkt314
-rw-r--r--Semestr 2/racket/egzamin/zad1b.bak314
-rw-r--r--Semestr 2/racket/egzamin/zad1b.rkt482
-rw-r--r--Semestr 2/racket/egzamin/zad2.bak119
-rw-r--r--Semestr 2/racket/egzamin/zad2.rkt186
-rw-r--r--Semestr 2/racket/egzamin/zad3.bak4
-rw-r--r--Semestr 2/racket/egzamin/zad3.rkt347
-rw-r--r--Semestr 2/racket/egzamin/zad3a.bak298
-rw-r--r--Semestr 2/racket/egzamin/zad3a.rkt301
13 files changed, 2967 insertions, 0 deletions
diff --git a/Semestr 2/racket/egzamin/rozw2.txt b/Semestr 2/racket/egzamin/rozw2.txt
new file mode 100644
index 0000000..a70232e
--- /dev/null
+++ b/Semestr 2/racket/egzamin/rozw2.txt
@@ -0,0 +1 @@
+Zasada indukcji dla \ No newline at end of file
diff --git a/Semestr 2/racket/egzamin/zad1.bak b/Semestr 2/racket/egzamin/zad1.bak
new file mode 100644
index 0000000..6f1f7b4
--- /dev/null
+++ b/Semestr 2/racket/egzamin/zad1.bak
@@ -0,0 +1 @@
+#lang racket
diff --git a/Semestr 2/racket/egzamin/zad1.rkt b/Semestr 2/racket/egzamin/zad1.rkt
new file mode 100644
index 0000000..a90d2fd
--- /dev/null
+++ b/Semestr 2/racket/egzamin/zad1.rkt
@@ -0,0 +1,300 @@
+#lang racket
+
+;; ZADANIE 1
+;; =========
+
+;; W tym zadaniu rozważamy język WHILE (w formie z grubsza
+;; odpowiadającej tej z wykładu), z blokami deklarującymi zmienne o
+;; lokalnym zakresie.
+
+;; Zadanie polega na dodaniu do języka procedur definiowanych na
+;; zewnątrz głównego polecenia programu (podobnie jak w C, gdzie
+;; główne polecenie odpowiadałoby procedurze main, czy Pascalu) — o
+;; dowolnym wybranym przez siebie modelu działania. W tym celu należy:
+;; · rozszerzyć składnię abstrakcyjną o składnię procedur i rozbudować odpowiednio składnię programów
+;; · rozszerzyć procedurę parsowania
+;; · rozszerzyć ewaluator
+;; · *opisać* wybrany model działania procedur, w tym jego potencjalne zalety lub ograniczenia
+;; Należy rozszerzyć poniższy szablon, a część słowną zadania umieścić
+;; w komentarzu, podobnie jak niniejsze polecenie.
+
+;; Uwaga! Zadanie jest *bardzo* szeroko sformułowane, jest wiele
+;; sensownych rozwiązań które stosowały liczne języki imperatywne w
+;; historii — nie jest treścią zadania znalezienie *najlepszego*,
+;; tylko swojego, które *rozumiecie*. Wybrany model działania procedur
+;; *może* być relatywnie ubogi, jednak jeśli tak się zrobi, warto
+;; pokazać że ma się tego świadomość w słownym opisie jego działania.
+
+(struct const (val) #:transparent)
+(struct binop (op l r) #:transparent)
+(struct var-expr (name) #:transparent)
+(struct call-expr (name args) #:transparent)
+(struct return-expr (val) #:transparent)
+
+(define (operator? x)
+ (member x '(+ * - / > < = >= <=)))
+
+(define (keyword? x)
+ (member x '(skip while if := func call return)))
+
+(define (expr? e)
+ (match e
+ [(const v)
+ (integer? v)]
+ [(var-expr x)
+ (and (symbol? x)
+ (not (keyword? x)))]
+ [(binop op l r)
+ (and (operator? op)
+ (expr? l)
+ (expr? r))]
+ [_ false]))
+
+(struct skip () #:transparent)
+(struct assign (id exp) #:transparent)
+(struct if-cmd (exp ct cf) #:transparent)
+(struct while (exp cmd) #:transparent)
+(struct comp (left right) #:transparent)
+(struct var-in (name expr cmd) #:transparent)
+(struct function (name args cmd) #:transparent)
+
+(define (cmd? c)
+ (match c
+ [(skip) true]
+ [(assign x e) (and (symbol? x) (expr? e))]
+ [(if-cmd e ct cf) (and (expr? e) (cmd? ct) (cmd? cf))]
+ [(while e c) (and (expr? e) (cmd? c))]
+ [(comp c1 c2) (and (cmd? c1) (cmd? c2))]
+ [(var-in x e c) (and (symbol? x) (expr? e) (cmd? c))]
+ [(function f a c) (and (symbol? f) (list? a) (andmap symbol? a) (cmd? c))]))
+
+(define (prog? p)
+ (cmd? p))
+
+(define (parse-expr p)
+ (cond
+ [(number? p) (const p)]
+ [(and (symbol? p)
+ (not (keyword? p)))
+ (var-expr p)]
+ [(and (list? p)
+ (= 3 (length p))
+ (operator? (car p)))
+ (binop (first p)
+ (parse-expr (second p))
+ (parse-expr (third p)))]
+ [(and (list? p) ; <------ wywołanie funkcji
+ (= (length p) 3)
+ (eq? (first p) 'call)
+ (symbol? (second p))
+ (list? (third p)))
+ (call-expr (second p) (map parse-expr (third p)))]
+ [else false]))
+
+(define (parse-cmd q)
+ (cond
+ [(eq? q 'skip) (skip)]
+ [(and (list? q)
+ (= (length q) 3)
+ (eq? (second q) ':=))
+ (assign (first q) (parse-expr (third q)))]
+ [(and (list? q)
+ (= (length q) 4)
+ (eq? (first q) 'if))
+ (if-cmd (parse-expr (second q)) (parse-cmd (third q)) (parse-cmd (fourth q)))]
+ [(and (list? q)
+ (= (length q) 3)
+ (eq? (first q) 'while))
+ (while (parse-expr (second q)) (parse-cmd (third q)))]
+ [(and (list? q)
+ (= (length q) 3)
+ (eq? (first q) 'var)
+ (list? (second q))
+ (= (length (second q)) 2))
+ (var-in (first (second q))
+ (parse-expr (second (second q)))
+ (parse-cmd (third q)))]
+ [(and (list? q) ; <------ funkcje
+ (= (length q) 4)
+ (eq? (first q) 'func)
+ (symbol? (second q))
+ (list? (third q))
+ (andmap symbol? (third q)))
+ (function (second q) (third q) (parse-cmd (fourth q)))]
+ [(and (list? q)
+ (= (length q) 2)
+ (eq? (first q) 'return))
+ (return-expr (parse-expr (second q)))]
+ [(and (list? q)
+ (>= (length q) 2))
+ (desugar-comp (map parse-cmd q))]
+ [else false]))
+
+(define (desugar-comp cs)
+ (if (null? (cdr cs))
+ (car cs)
+ (comp (car cs)
+ (desugar-comp (cdr cs)))))
+
+(define (value? v)
+ (number? v))
+
+(struct mem (xs) #:transparent)
+
+(define (mem-lookup x m)
+ (define (assoc-lookup xs)
+ (cond
+ [(null? xs) (error "Undefined variable" x)]
+ [(eq? x (caar xs)) (cdar xs)]
+ [else (assoc-lookup (cdr xs))]))
+ (assoc-lookup (mem-xs m)))
+
+(define (mem-defined? x m) ; <----------- !!! Sprawdz, czy x jest w ogole zdefiniowane
+ (define (assoc-lookup xs)
+ (cond
+ [(null? xs) #f]
+ [(eq? x (caar xs) #t)]
+ [else (assoc-lookup (cdr xs))]))
+ (assoc-lookup (mem-xs m)))
+
+(define (mem-update x v m)
+ (define (assoc-update xs)
+ (cond
+ [(null? xs) (error "Undefined variable" x)]
+ [(eq? x (caar xs)) (cons (cons x v) (cdr xs))]
+ [else (cons (car xs) (assoc-update (cdr xs)))]))
+ (mem (assoc-update (mem-xs m))))
+
+(define (mem-alloc x v m)
+ (mem (cons (cons x v) (mem-xs m))))
+
+(define (mem-drop-last m)
+ (cond
+ [(null? (mem-xs m))
+ (error "Deallocating from empty memory")]
+ [else
+ (mem (cdr (mem-xs m)))]))
+
+(define empty-mem
+ (mem null))
+
+(define (op->proc op)
+ (match op
+ ['+ +]
+ ['- -]
+ ['* *]
+ ['/ /]
+ ['< (lambda (x y) (if (< x y) 1 0))]
+ ['> (lambda (x y) (if (> x y) 1 0))]
+ ['= (lambda (x y) (if (= x y) 1 0))]
+ ['<= (lambda (x y) (if (<= x y) 1 0))]
+ ['>= (lambda (x y) (if (>= x y) 1 0))]
+ ))
+
+;; zał: (expr? e) i (mem? m) jest prawdą
+;; (value? (eval e m)) jest prawdą
+(define (eval e m)
+ (match e
+ [(const v) v]
+ [(var-expr x) (mem-lookup x m)]
+ [(binop op l r)
+ (let ((vl (eval l m))
+ (vr (eval r m))
+ (p (op->proc op)))
+ (p vl vr))]
+ [(call-expr name args)
+ (match (mem-lookup name m)
+ [(clo func-args cmd)
+ (if (= (length args) (length func-args))
+ (let* ([func-mem (assign-values args func-args m)]
+ [final-mem (eval-cmd cmd func-mem)]
+ [ret (mem-lookup 'RETURN final-mem)])
+ (if ret
+ ret
+ (error "No return statement in function" name)))
+ (error "Arity mismatch, function" name "takes" (length func-args) ", got" (length args)))]
+ [else (error "Undefined function" name)])]))
+
+(define (assign-values args func-args mem)
+ (if (null? args)
+ mem
+ (assign-values (cdr args) (cdr func-args) (mem-alloc (car func-args) (eval (car args) mem) mem))))
+
+
+(struct clo (args cmd))
+
+;; zał: (cmd? c) (mem? m)
+;; (mem? (eval-cmd c m))
+(define (eval-cmd c m)
+ (if (mem-lookup 'RETURN m)
+ m
+ (match c
+ [(skip) m]
+ [(assign x e) (mem-update x (eval e m) m)]
+ [(if-cmd e ct cf) (if (= (eval e m) 0)
+ (eval-cmd cf m)
+ (eval-cmd ct m))]
+ [(while e cw) (if (= (eval e m) 0)
+ m
+ (let* ((m1 (eval-cmd cw m))
+ (m2 (eval-cmd c m1)))
+ m2))]
+ [(comp c1 c2) (let* ((m1 (eval-cmd c1 m))
+ (m2 (eval-cmd c2 m1)))
+ m2)]
+ [(var-in x e c) (let* ((v (eval e m))
+ (m1 (mem-alloc x v m))
+ (m2 (eval-cmd c m1)))
+ (mem-drop-last m2))]
+ [(function name args cmd)
+ (mem-alloc name (clo args cmd) m)]
+ [(return-expr val)
+ (mem-update 'RETURN (eval val m) m)]
+ [_ (error "Unknown command" c "— likely a syntax error")])))
+
+
+(define (eval-prog p m)
+ (let ((final-mem (eval-cmd p (mem-alloc 'RETURN #f m))))
+ (with-handlers ([exn:fail? (lambda (v) (error "Undefined reference to main"))])
+ (match (mem-lookup 'main final-mem)
+ [(clo args cmd) (mem-lookup 'RETURN (eval-cmd cmd final-mem))]))))
+
+(define WHILE_FACT
+ '({func decr (x)
+ {(x := (- x 1))
+ (return x)}}
+ {func main ()
+ {(i := 1)
+ (while (> t 0)
+ {(i := (* i t))
+ (t := (call decr (t)))})
+ (return i)}}
+ ))
+
+(define TEST
+ '({func decr (x) (return (- x 1))}
+ {func main ()
+ (var (x 1)
+ {(x := (+ x 1))
+ (return (call decr (x)))})}))
+
+(define TEST2
+ '({func decr (x) (return (- x 1))}
+ {func main () (return (call decr (3)))}))
+
+(define TEST3
+ '({func sth (x)
+ {(i := -1)
+ (return x)}}
+ {func main ()
+ {(i := 2)
+ (return (call sth (i)))}}))
+
+(define TEST4
+ '(func f ()
+ {return 1}))
+
+(define (fact n)
+ (let* ([init-env (mem-alloc 'i 1 (mem-alloc 't n empty-mem))])
+ (eval-prog (parse-cmd WHILE_FACT) init-env)))
+
diff --git a/Semestr 2/racket/egzamin/zad1a.bak b/Semestr 2/racket/egzamin/zad1a.bak
new file mode 100644
index 0000000..a90d2fd
--- /dev/null
+++ b/Semestr 2/racket/egzamin/zad1a.bak
@@ -0,0 +1,300 @@
+#lang racket
+
+;; ZADANIE 1
+;; =========
+
+;; W tym zadaniu rozważamy język WHILE (w formie z grubsza
+;; odpowiadającej tej z wykładu), z blokami deklarującymi zmienne o
+;; lokalnym zakresie.
+
+;; Zadanie polega na dodaniu do języka procedur definiowanych na
+;; zewnątrz głównego polecenia programu (podobnie jak w C, gdzie
+;; główne polecenie odpowiadałoby procedurze main, czy Pascalu) — o
+;; dowolnym wybranym przez siebie modelu działania. W tym celu należy:
+;; · rozszerzyć składnię abstrakcyjną o składnię procedur i rozbudować odpowiednio składnię programów
+;; · rozszerzyć procedurę parsowania
+;; · rozszerzyć ewaluator
+;; · *opisać* wybrany model działania procedur, w tym jego potencjalne zalety lub ograniczenia
+;; Należy rozszerzyć poniższy szablon, a część słowną zadania umieścić
+;; w komentarzu, podobnie jak niniejsze polecenie.
+
+;; Uwaga! Zadanie jest *bardzo* szeroko sformułowane, jest wiele
+;; sensownych rozwiązań które stosowały liczne języki imperatywne w
+;; historii — nie jest treścią zadania znalezienie *najlepszego*,
+;; tylko swojego, które *rozumiecie*. Wybrany model działania procedur
+;; *może* być relatywnie ubogi, jednak jeśli tak się zrobi, warto
+;; pokazać że ma się tego świadomość w słownym opisie jego działania.
+
+(struct const (val) #:transparent)
+(struct binop (op l r) #:transparent)
+(struct var-expr (name) #:transparent)
+(struct call-expr (name args) #:transparent)
+(struct return-expr (val) #:transparent)
+
+(define (operator? x)
+ (member x '(+ * - / > < = >= <=)))
+
+(define (keyword? x)
+ (member x '(skip while if := func call return)))
+
+(define (expr? e)
+ (match e
+ [(const v)
+ (integer? v)]
+ [(var-expr x)
+ (and (symbol? x)
+ (not (keyword? x)))]
+ [(binop op l r)
+ (and (operator? op)
+ (expr? l)
+ (expr? r))]
+ [_ false]))
+
+(struct skip () #:transparent)
+(struct assign (id exp) #:transparent)
+(struct if-cmd (exp ct cf) #:transparent)
+(struct while (exp cmd) #:transparent)
+(struct comp (left right) #:transparent)
+(struct var-in (name expr cmd) #:transparent)
+(struct function (name args cmd) #:transparent)
+
+(define (cmd? c)
+ (match c
+ [(skip) true]
+ [(assign x e) (and (symbol? x) (expr? e))]
+ [(if-cmd e ct cf) (and (expr? e) (cmd? ct) (cmd? cf))]
+ [(while e c) (and (expr? e) (cmd? c))]
+ [(comp c1 c2) (and (cmd? c1) (cmd? c2))]
+ [(var-in x e c) (and (symbol? x) (expr? e) (cmd? c))]
+ [(function f a c) (and (symbol? f) (list? a) (andmap symbol? a) (cmd? c))]))
+
+(define (prog? p)
+ (cmd? p))
+
+(define (parse-expr p)
+ (cond
+ [(number? p) (const p)]
+ [(and (symbol? p)
+ (not (keyword? p)))
+ (var-expr p)]
+ [(and (list? p)
+ (= 3 (length p))
+ (operator? (car p)))
+ (binop (first p)
+ (parse-expr (second p))
+ (parse-expr (third p)))]
+ [(and (list? p) ; <------ wywołanie funkcji
+ (= (length p) 3)
+ (eq? (first p) 'call)
+ (symbol? (second p))
+ (list? (third p)))
+ (call-expr (second p) (map parse-expr (third p)))]
+ [else false]))
+
+(define (parse-cmd q)
+ (cond
+ [(eq? q 'skip) (skip)]
+ [(and (list? q)
+ (= (length q) 3)
+ (eq? (second q) ':=))
+ (assign (first q) (parse-expr (third q)))]
+ [(and (list? q)
+ (= (length q) 4)
+ (eq? (first q) 'if))
+ (if-cmd (parse-expr (second q)) (parse-cmd (third q)) (parse-cmd (fourth q)))]
+ [(and (list? q)
+ (= (length q) 3)
+ (eq? (first q) 'while))
+ (while (parse-expr (second q)) (parse-cmd (third q)))]
+ [(and (list? q)
+ (= (length q) 3)
+ (eq? (first q) 'var)
+ (list? (second q))
+ (= (length (second q)) 2))
+ (var-in (first (second q))
+ (parse-expr (second (second q)))
+ (parse-cmd (third q)))]
+ [(and (list? q) ; <------ funkcje
+ (= (length q) 4)
+ (eq? (first q) 'func)
+ (symbol? (second q))
+ (list? (third q))
+ (andmap symbol? (third q)))
+ (function (second q) (third q) (parse-cmd (fourth q)))]
+ [(and (list? q)
+ (= (length q) 2)
+ (eq? (first q) 'return))
+ (return-expr (parse-expr (second q)))]
+ [(and (list? q)
+ (>= (length q) 2))
+ (desugar-comp (map parse-cmd q))]
+ [else false]))
+
+(define (desugar-comp cs)
+ (if (null? (cdr cs))
+ (car cs)
+ (comp (car cs)
+ (desugar-comp (cdr cs)))))
+
+(define (value? v)
+ (number? v))
+
+(struct mem (xs) #:transparent)
+
+(define (mem-lookup x m)
+ (define (assoc-lookup xs)
+ (cond
+ [(null? xs) (error "Undefined variable" x)]
+ [(eq? x (caar xs)) (cdar xs)]
+ [else (assoc-lookup (cdr xs))]))
+ (assoc-lookup (mem-xs m)))
+
+(define (mem-defined? x m) ; <----------- !!! Sprawdz, czy x jest w ogole zdefiniowane
+ (define (assoc-lookup xs)
+ (cond
+ [(null? xs) #f]
+ [(eq? x (caar xs) #t)]
+ [else (assoc-lookup (cdr xs))]))
+ (assoc-lookup (mem-xs m)))
+
+(define (mem-update x v m)
+ (define (assoc-update xs)
+ (cond
+ [(null? xs) (error "Undefined variable" x)]
+ [(eq? x (caar xs)) (cons (cons x v) (cdr xs))]
+ [else (cons (car xs) (assoc-update (cdr xs)))]))
+ (mem (assoc-update (mem-xs m))))
+
+(define (mem-alloc x v m)
+ (mem (cons (cons x v) (mem-xs m))))
+
+(define (mem-drop-last m)
+ (cond
+ [(null? (mem-xs m))
+ (error "Deallocating from empty memory")]
+ [else
+ (mem (cdr (mem-xs m)))]))
+
+(define empty-mem
+ (mem null))
+
+(define (op->proc op)
+ (match op
+ ['+ +]
+ ['- -]
+ ['* *]
+ ['/ /]
+ ['< (lambda (x y) (if (< x y) 1 0))]
+ ['> (lambda (x y) (if (> x y) 1 0))]
+ ['= (lambda (x y) (if (= x y) 1 0))]
+ ['<= (lambda (x y) (if (<= x y) 1 0))]
+ ['>= (lambda (x y) (if (>= x y) 1 0))]
+ ))
+
+;; zał: (expr? e) i (mem? m) jest prawdą
+;; (value? (eval e m)) jest prawdą
+(define (eval e m)
+ (match e
+ [(const v) v]
+ [(var-expr x) (mem-lookup x m)]
+ [(binop op l r)
+ (let ((vl (eval l m))
+ (vr (eval r m))
+ (p (op->proc op)))
+ (p vl vr))]
+ [(call-expr name args)
+ (match (mem-lookup name m)
+ [(clo func-args cmd)
+ (if (= (length args) (length func-args))
+ (let* ([func-mem (assign-values args func-args m)]
+ [final-mem (eval-cmd cmd func-mem)]
+ [ret (mem-lookup 'RETURN final-mem)])
+ (if ret
+ ret
+ (error "No return statement in function" name)))
+ (error "Arity mismatch, function" name "takes" (length func-args) ", got" (length args)))]
+ [else (error "Undefined function" name)])]))
+
+(define (assign-values args func-args mem)
+ (if (null? args)
+ mem
+ (assign-values (cdr args) (cdr func-args) (mem-alloc (car func-args) (eval (car args) mem) mem))))
+
+
+(struct clo (args cmd))
+
+;; zał: (cmd? c) (mem? m)
+;; (mem? (eval-cmd c m))
+(define (eval-cmd c m)
+ (if (mem-lookup 'RETURN m)
+ m
+ (match c
+ [(skip) m]
+ [(assign x e) (mem-update x (eval e m) m)]
+ [(if-cmd e ct cf) (if (= (eval e m) 0)
+ (eval-cmd cf m)
+ (eval-cmd ct m))]
+ [(while e cw) (if (= (eval e m) 0)
+ m
+ (let* ((m1 (eval-cmd cw m))
+ (m2 (eval-cmd c m1)))
+ m2))]
+ [(comp c1 c2) (let* ((m1 (eval-cmd c1 m))
+ (m2 (eval-cmd c2 m1)))
+ m2)]
+ [(var-in x e c) (let* ((v (eval e m))
+ (m1 (mem-alloc x v m))
+ (m2 (eval-cmd c m1)))
+ (mem-drop-last m2))]
+ [(function name args cmd)
+ (mem-alloc name (clo args cmd) m)]
+ [(return-expr val)
+ (mem-update 'RETURN (eval val m) m)]
+ [_ (error "Unknown command" c "— likely a syntax error")])))
+
+
+(define (eval-prog p m)
+ (let ((final-mem (eval-cmd p (mem-alloc 'RETURN #f m))))
+ (with-handlers ([exn:fail? (lambda (v) (error "Undefined reference to main"))])
+ (match (mem-lookup 'main final-mem)
+ [(clo args cmd) (mem-lookup 'RETURN (eval-cmd cmd final-mem))]))))
+
+(define WHILE_FACT
+ '({func decr (x)
+ {(x := (- x 1))
+ (return x)}}
+ {func main ()
+ {(i := 1)
+ (while (> t 0)
+ {(i := (* i t))
+ (t := (call decr (t)))})
+ (return i)}}
+ ))
+
+(define TEST
+ '({func decr (x) (return (- x 1))}
+ {func main ()
+ (var (x 1)
+ {(x := (+ x 1))
+ (return (call decr (x)))})}))
+
+(define TEST2
+ '({func decr (x) (return (- x 1))}
+ {func main () (return (call decr (3)))}))
+
+(define TEST3
+ '({func sth (x)
+ {(i := -1)
+ (return x)}}
+ {func main ()
+ {(i := 2)
+ (return (call sth (i)))}}))
+
+(define TEST4
+ '(func f ()
+ {return 1}))
+
+(define (fact n)
+ (let* ([init-env (mem-alloc 'i 1 (mem-alloc 't n empty-mem))])
+ (eval-prog (parse-cmd WHILE_FACT) init-env)))
+
diff --git a/Semestr 2/racket/egzamin/zad1a.rkt b/Semestr 2/racket/egzamin/zad1a.rkt
new file mode 100644
index 0000000..a587359
--- /dev/null
+++ b/Semestr 2/racket/egzamin/zad1a.rkt
@@ -0,0 +1,314 @@
+#lang racket
+
+;; ZADANIE 1
+;; =========
+
+;; W tym zadaniu rozważamy język WHILE (w formie z grubsza
+;; odpowiadającej tej z wykładu), z blokami deklarującymi zmienne o
+;; lokalnym zakresie.
+
+;; Zadanie polega na dodaniu do języka procedur definiowanych na
+;; zewnątrz głównego polecenia programu (podobnie jak w C, gdzie
+;; główne polecenie odpowiadałoby procedurze main, czy Pascalu) — o
+;; dowolnym wybranym przez siebie modelu działania. W tym celu należy:
+;; · rozszerzyć składnię abstrakcyjną o składnię procedur i rozbudować odpowiednio składnię programów
+;; · rozszerzyć procedurę parsowania
+;; · rozszerzyć ewaluator
+;; · *opisać* wybrany model działania procedur, w tym jego potencjalne zalety lub ograniczenia
+;; Należy rozszerzyć poniższy szablon, a część słowną zadania umieścić
+;; w komentarzu, podobnie jak niniejsze polecenie.
+
+;; Uwaga! Zadanie jest *bardzo* szeroko sformułowane, jest wiele
+;; sensownych rozwiązań które stosowały liczne języki imperatywne w
+;; historii — nie jest treścią zadania znalezienie *najlepszego*,
+;; tylko swojego, które *rozumiecie*. Wybrany model działania procedur
+;; *może* być relatywnie ubogi, jednak jeśli tak się zrobi, warto
+;; pokazać że ma się tego świadomość w słownym opisie jego działania.
+
+(struct const (val) #:transparent)
+(struct binop (op l r) #:transparent)
+(struct var-expr (name) #:transparent)
+(struct call-expr (name args) #:transparent)
+(struct return-expr (val) #:transparent)
+
+(define (operator? x)
+ (member x '(+ * - / > < = >= <=)))
+
+(define (keyword? x)
+ (member x '(skip while if := func call return)))
+
+(define (expr? e)
+ (match e
+ [(const v)
+ (integer? v)]
+ [(var-expr x)
+ (and (symbol? x)
+ (not (keyword? x)))]
+ [(binop op l r)
+ (and (operator? op)
+ (expr? l)
+ (expr? r))]
+ [_ false]))
+
+(struct skip () #:transparent)
+(struct assign (id exp) #:transparent)
+(struct if-cmd (exp ct cf) #:transparent)
+(struct while (exp cmd) #:transparent)
+(struct comp (left right) #:transparent)
+(struct var-in (name expr cmd) #:transparent)
+(struct function (name args cmd) #:transparent)
+
+(define (cmd? c)
+ (match c
+ [(skip) true]
+ [(assign x e) (and (symbol? x) (expr? e))]
+ [(if-cmd e ct cf) (and (expr? e) (cmd? ct) (cmd? cf))]
+ [(while e c) (and (expr? e) (cmd? c))]
+ [(comp c1 c2) (and (cmd? c1) (cmd? c2))]
+ [(var-in x e c) (and (symbol? x) (expr? e) (cmd? c))]
+ [(function f a c) (and (symbol? f) (list? a) (andmap symbol? a) (cmd? c))]))
+
+(define (prog? p)
+ (cmd? p))
+
+(define (parse-expr p)
+ (cond
+ [(number? p) (const p)]
+ [(and (symbol? p)
+ (not (keyword? p)))
+ (var-expr p)]
+ [(and (list? p)
+ (= 3 (length p))
+ (operator? (car p)))
+ (binop (first p)
+ (parse-expr (second p))
+ (parse-expr (third p)))]
+ [(and (list? p) ; <------ wywołanie funkcji
+ (= (length p) 3)
+ (eq? (first p) 'call)
+ (symbol? (second p))
+ (list? (third p)))
+ (call-expr (second p) (map parse-expr (third p)))]
+ [else false]))
+
+(define (parse-cmd q)
+ (cond
+ [(eq? q 'skip) (skip)]
+ [(and (list? q)
+ (= (length q) 3)
+ (eq? (second q) ':=))
+ (assign (first q) (parse-expr (third q)))]
+ [(and (list? q)
+ (= (length q) 4)
+ (eq? (first q) 'if))
+ (if-cmd (parse-expr (second q)) (parse-cmd (third q)) (parse-cmd (fourth q)))]
+ [(and (list? q)
+ (= (length q) 3)
+ (eq? (first q) 'while))
+ (while (parse-expr (second q)) (parse-cmd (third q)))]
+ [(and (list? q)
+ (= (length q) 3)
+ (eq? (first q) 'var)
+ (list? (second q))
+ (= (length (second q)) 2))
+ (var-in (first (second q))
+ (parse-expr (second (second q)))
+ (parse-cmd (third q)))]
+ [(and (list? q) ; <------ funkcje
+ (= (length q) 4)
+ (eq? (first q) 'func)
+ (symbol? (second q))
+ (list? (third q))
+ (andmap symbol? (third q)))
+ (function (second q) (third q) (parse-cmd (fourth q)))]
+ [(and (list? q)
+ (= (length q) 2)
+ (eq? (first q) 'return))
+ (return-expr (parse-expr (second q)))]
+ [(and (list? q)
+ (>= (length q) 2))
+ (desugar-comp (map parse-cmd q))]
+ [else false]))
+
+(define (desugar-comp cs)
+ (if (null? (cdr cs))
+ (car cs)
+ (comp (car cs)
+ (desugar-comp (cdr cs)))))
+
+(define (value? v)
+ (number? v))
+
+(struct mem (xs) #:transparent)
+
+(define (mem-lookup x m)
+ (define (assoc-lookup xs)
+ (cond
+ [(null? xs) (error "Undefined variable" x)]
+ [(eq? x (caar xs)) (cdar xs)]
+ [else (assoc-lookup (cdr xs))]))
+ (assoc-lookup (mem-xs m)))
+
+(define (mem-defined? x m) ; <----------- !!! Sprawdz, czy x jest w ogole zdefiniowane
+ (define (assoc-lookup xs)
+ (cond
+ [(null? xs) #f]
+ [(eq? x (caar xs) #t)]
+ [else (assoc-lookup (cdr xs))]))
+ (assoc-lookup (mem-xs m)))
+
+(define (mem-update x v m)
+ (define (assoc-update xs)
+ (cond
+ [(null? xs) (error "Undefined variable" x)]
+ [(eq? x (caar xs)) (cons (cons x v) (cdr xs))]
+ [else (cons (car xs) (assoc-update (cdr xs)))]))
+ (mem (assoc-update (mem-xs m))))
+
+(define (mem-alloc x v m)
+ (mem (cons (cons x v) (mem-xs m))))
+
+(define (mem-drop-last m)
+ (cond
+ [(null? (mem-xs m))
+ (error "Deallocating from empty memory")]
+ [else
+ (mem (cdr (mem-xs m)))]))
+
+(define empty-mem
+ (mem null))
+
+(define (op->proc op)
+ (match op
+ ['+ +]
+ ['- -]
+ ['* *]
+ ['/ /]
+ ['< (lambda (x y) (if (< x y) 1 0))]
+ ['> (lambda (x y) (if (> x y) 1 0))]
+ ['= (lambda (x y) (if (= x y) 1 0))]
+ ['<= (lambda (x y) (if (<= x y) 1 0))]
+ ['>= (lambda (x y) (if (>= x y) 1 0))]
+ ))
+
+;; zał: (expr? e) i (mem? m) jest prawdą
+;; (value? (eval e m)) jest prawdą
+(define (eval e m)
+ (match e
+ [(const v) v]
+ [(var-expr x) (mem-lookup x m)]
+ [(binop op l r)
+ (let ((vl (eval l m))
+ (vr (eval r m))
+ (p (op->proc op)))
+ (p vl vr))]
+ [(call-expr name args)
+ (match (mem-lookup name m)
+ [(clo func-args cmd)
+ (if (= (length args) (length func-args))
+ (let* ([func-mem (assign-values args func-args m)]
+ [final-mem (eval-cmd cmd func-mem)]
+ [ret (mem-lookup 'RETURN final-mem)])
+ (if ret
+ ret
+ (error "No return statement in function" name)))
+ (error "Arity mismatch, function" name "takes" (length func-args) ", got" (length args)))]
+ [else (error "Undefined function" name)])]))
+
+(define (assign-values args func-args mem)
+ (define (iter args func-args new-mem)
+ (if (null? args)
+ new-mem
+ (iter (cdr args) (cdr func-args) (mem-alloc (car func-args) (eval (car args) mem) new-mem))))
+ (iter args func-args mem))
+
+
+(struct clo (args cmd))
+
+;; zał: (cmd? c) (mem? m)
+;; (mem? (eval-cmd c m))
+(define (eval-cmd c m)
+ (if (mem-lookup 'RETURN m)
+ m
+ (match c
+ [(skip) m]
+ [(assign x e) (mem-update x (eval e m) m)]
+ [(if-cmd e ct cf) (if (= (eval e m) 0)
+ (eval-cmd cf m)
+ (eval-cmd ct m))]
+ [(while e cw) (if (= (eval e m) 0)
+ m
+ (let* ((m1 (eval-cmd cw m))
+ (m2 (eval-cmd c m1)))
+ m2))]
+ [(comp c1 c2) (let* ((m1 (eval-cmd c1 m))
+ (m2 (eval-cmd c2 m1)))
+ m2)]
+ [(var-in x e c) (let* ((v (eval e m))
+ (m1 (mem-alloc x v m))
+ (m2 (eval-cmd c m1)))
+ (mem-drop-last m2))]
+ [(function name args cmd)
+ (mem-alloc name (clo args cmd) m)]
+ [(return-expr val)
+ (mem-update 'RETURN (eval val m) m)]
+ [_ (error "Unknown command" c "— likely a syntax error")])))
+
+
+(define (eval-prog p m)
+ (let ((final-mem (eval-cmd p (mem-alloc 'RETURN #f m))))
+ (with-handlers ([exn:fail? (lambda (v) (error "Undefined reference to main"))])
+ (match (mem-lookup 'main final-mem)
+ [(clo args cmd) (mem-lookup 'RETURN (eval-cmd cmd final-mem))]))))
+
+(define WHILE_FACT
+ '({func decr (x)
+ {(x := (- x 1))
+ (return x)}}
+ {func main ()
+ {(i := 1)
+ (while (> t 0)
+ {(i := (* i t))
+ (t := (call decr (t)))})
+ (return i)}}
+ ))
+
+(define (fact n)
+ (let* ([init-env (mem-alloc 'i 1 (mem-alloc 't n empty-mem))])
+ (eval-prog (parse-cmd WHILE_FACT) init-env)))
+
+(define TEST
+ '({func decr (x) (return (- x 1))}
+ {func main ()
+ (var (x 1)
+ {(x := (+ x 1))
+ (return (call decr (x)))})}))
+
+(define TEST2
+ '({func decr (x) (return (- x 1))}
+ {func main () (return (call decr (3)))}))
+
+(define TEST3
+ '({func sth (x)
+ {(i := -1)
+ (return x)}}
+ {func main ()
+ {(i := 2)
+ (return (call sth (i)))}}))
+
+(define TEST4
+ '(func f ()
+ {return 1}))
+
+(define TEST5
+ '({func f1 (x y z)
+ (return y)}
+ {func f2 (x y z)
+ (return (+ (+ x y) z))}
+ {func main ()
+ {(if (> 4 3)
+ (var (x 2)
+ (return (call f1 (1 x 3))))
+ (x := 5))
+ (return (call f2 (x 3 4)))}}))
+ \ No newline at end of file
diff --git a/Semestr 2/racket/egzamin/zad1b.bak b/Semestr 2/racket/egzamin/zad1b.bak
new file mode 100644
index 0000000..a587359
--- /dev/null
+++ b/Semestr 2/racket/egzamin/zad1b.bak
@@ -0,0 +1,314 @@
+#lang racket
+
+;; ZADANIE 1
+;; =========
+
+;; W tym zadaniu rozważamy język WHILE (w formie z grubsza
+;; odpowiadającej tej z wykładu), z blokami deklarującymi zmienne o
+;; lokalnym zakresie.
+
+;; Zadanie polega na dodaniu do języka procedur definiowanych na
+;; zewnątrz głównego polecenia programu (podobnie jak w C, gdzie
+;; główne polecenie odpowiadałoby procedurze main, czy Pascalu) — o
+;; dowolnym wybranym przez siebie modelu działania. W tym celu należy:
+;; · rozszerzyć składnię abstrakcyjną o składnię procedur i rozbudować odpowiednio składnię programów
+;; · rozszerzyć procedurę parsowania
+;; · rozszerzyć ewaluator
+;; · *opisać* wybrany model działania procedur, w tym jego potencjalne zalety lub ograniczenia
+;; Należy rozszerzyć poniższy szablon, a część słowną zadania umieścić
+;; w komentarzu, podobnie jak niniejsze polecenie.
+
+;; Uwaga! Zadanie jest *bardzo* szeroko sformułowane, jest wiele
+;; sensownych rozwiązań które stosowały liczne języki imperatywne w
+;; historii — nie jest treścią zadania znalezienie *najlepszego*,
+;; tylko swojego, które *rozumiecie*. Wybrany model działania procedur
+;; *może* być relatywnie ubogi, jednak jeśli tak się zrobi, warto
+;; pokazać że ma się tego świadomość w słownym opisie jego działania.
+
+(struct const (val) #:transparent)
+(struct binop (op l r) #:transparent)
+(struct var-expr (name) #:transparent)
+(struct call-expr (name args) #:transparent)
+(struct return-expr (val) #:transparent)
+
+(define (operator? x)
+ (member x '(+ * - / > < = >= <=)))
+
+(define (keyword? x)
+ (member x '(skip while if := func call return)))
+
+(define (expr? e)
+ (match e
+ [(const v)
+ (integer? v)]
+ [(var-expr x)
+ (and (symbol? x)
+ (not (keyword? x)))]
+ [(binop op l r)
+ (and (operator? op)
+ (expr? l)
+ (expr? r))]
+ [_ false]))
+
+(struct skip () #:transparent)
+(struct assign (id exp) #:transparent)
+(struct if-cmd (exp ct cf) #:transparent)
+(struct while (exp cmd) #:transparent)
+(struct comp (left right) #:transparent)
+(struct var-in (name expr cmd) #:transparent)
+(struct function (name args cmd) #:transparent)
+
+(define (cmd? c)
+ (match c
+ [(skip) true]
+ [(assign x e) (and (symbol? x) (expr? e))]
+ [(if-cmd e ct cf) (and (expr? e) (cmd? ct) (cmd? cf))]
+ [(while e c) (and (expr? e) (cmd? c))]
+ [(comp c1 c2) (and (cmd? c1) (cmd? c2))]
+ [(var-in x e c) (and (symbol? x) (expr? e) (cmd? c))]
+ [(function f a c) (and (symbol? f) (list? a) (andmap symbol? a) (cmd? c))]))
+
+(define (prog? p)
+ (cmd? p))
+
+(define (parse-expr p)
+ (cond
+ [(number? p) (const p)]
+ [(and (symbol? p)
+ (not (keyword? p)))
+ (var-expr p)]
+ [(and (list? p)
+ (= 3 (length p))
+ (operator? (car p)))
+ (binop (first p)
+ (parse-expr (second p))
+ (parse-expr (third p)))]
+ [(and (list? p) ; <------ wywołanie funkcji
+ (= (length p) 3)
+ (eq? (first p) 'call)
+ (symbol? (second p))
+ (list? (third p)))
+ (call-expr (second p) (map parse-expr (third p)))]
+ [else false]))
+
+(define (parse-cmd q)
+ (cond
+ [(eq? q 'skip) (skip)]
+ [(and (list? q)
+ (= (length q) 3)
+ (eq? (second q) ':=))
+ (assign (first q) (parse-expr (third q)))]
+ [(and (list? q)
+ (= (length q) 4)
+ (eq? (first q) 'if))
+ (if-cmd (parse-expr (second q)) (parse-cmd (third q)) (parse-cmd (fourth q)))]
+ [(and (list? q)
+ (= (length q) 3)
+ (eq? (first q) 'while))
+ (while (parse-expr (second q)) (parse-cmd (third q)))]
+ [(and (list? q)
+ (= (length q) 3)
+ (eq? (first q) 'var)
+ (list? (second q))
+ (= (length (second q)) 2))
+ (var-in (first (second q))
+ (parse-expr (second (second q)))
+ (parse-cmd (third q)))]
+ [(and (list? q) ; <------ funkcje
+ (= (length q) 4)
+ (eq? (first q) 'func)
+ (symbol? (second q))
+ (list? (third q))
+ (andmap symbol? (third q)))
+ (function (second q) (third q) (parse-cmd (fourth q)))]
+ [(and (list? q)
+ (= (length q) 2)
+ (eq? (first q) 'return))
+ (return-expr (parse-expr (second q)))]
+ [(and (list? q)
+ (>= (length q) 2))
+ (desugar-comp (map parse-cmd q))]
+ [else false]))
+
+(define (desugar-comp cs)
+ (if (null? (cdr cs))
+ (car cs)
+ (comp (car cs)
+ (desugar-comp (cdr cs)))))
+
+(define (value? v)
+ (number? v))
+
+(struct mem (xs) #:transparent)
+
+(define (mem-lookup x m)
+ (define (assoc-lookup xs)
+ (cond
+ [(null? xs) (error "Undefined variable" x)]
+ [(eq? x (caar xs)) (cdar xs)]
+ [else (assoc-lookup (cdr xs))]))
+ (assoc-lookup (mem-xs m)))
+
+(define (mem-defined? x m) ; <----------- !!! Sprawdz, czy x jest w ogole zdefiniowane
+ (define (assoc-lookup xs)
+ (cond
+ [(null? xs) #f]
+ [(eq? x (caar xs) #t)]
+ [else (assoc-lookup (cdr xs))]))
+ (assoc-lookup (mem-xs m)))
+
+(define (mem-update x v m)
+ (define (assoc-update xs)
+ (cond
+ [(null? xs) (error "Undefined variable" x)]
+ [(eq? x (caar xs)) (cons (cons x v) (cdr xs))]
+ [else (cons (car xs) (assoc-update (cdr xs)))]))
+ (mem (assoc-update (mem-xs m))))
+
+(define (mem-alloc x v m)
+ (mem (cons (cons x v) (mem-xs m))))
+
+(define (mem-drop-last m)
+ (cond
+ [(null? (mem-xs m))
+ (error "Deallocating from empty memory")]
+ [else
+ (mem (cdr (mem-xs m)))]))
+
+(define empty-mem
+ (mem null))
+
+(define (op->proc op)
+ (match op
+ ['+ +]
+ ['- -]
+ ['* *]
+ ['/ /]
+ ['< (lambda (x y) (if (< x y) 1 0))]
+ ['> (lambda (x y) (if (> x y) 1 0))]
+ ['= (lambda (x y) (if (= x y) 1 0))]
+ ['<= (lambda (x y) (if (<= x y) 1 0))]
+ ['>= (lambda (x y) (if (>= x y) 1 0))]
+ ))
+
+;; zał: (expr? e) i (mem? m) jest prawdą
+;; (value? (eval e m)) jest prawdą
+(define (eval e m)
+ (match e
+ [(const v) v]
+ [(var-expr x) (mem-lookup x m)]
+ [(binop op l r)
+ (let ((vl (eval l m))
+ (vr (eval r m))
+ (p (op->proc op)))
+ (p vl vr))]
+ [(call-expr name args)
+ (match (mem-lookup name m)
+ [(clo func-args cmd)
+ (if (= (length args) (length func-args))
+ (let* ([func-mem (assign-values args func-args m)]
+ [final-mem (eval-cmd cmd func-mem)]
+ [ret (mem-lookup 'RETURN final-mem)])
+ (if ret
+ ret
+ (error "No return statement in function" name)))
+ (error "Arity mismatch, function" name "takes" (length func-args) ", got" (length args)))]
+ [else (error "Undefined function" name)])]))
+
+(define (assign-values args func-args mem)
+ (define (iter args func-args new-mem)
+ (if (null? args)
+ new-mem
+ (iter (cdr args) (cdr func-args) (mem-alloc (car func-args) (eval (car args) mem) new-mem))))
+ (iter args func-args mem))
+
+
+(struct clo (args cmd))
+
+;; zał: (cmd? c) (mem? m)
+;; (mem? (eval-cmd c m))
+(define (eval-cmd c m)
+ (if (mem-lookup 'RETURN m)
+ m
+ (match c
+ [(skip) m]
+ [(assign x e) (mem-update x (eval e m) m)]
+ [(if-cmd e ct cf) (if (= (eval e m) 0)
+ (eval-cmd cf m)
+ (eval-cmd ct m))]
+ [(while e cw) (if (= (eval e m) 0)
+ m
+ (let* ((m1 (eval-cmd cw m))
+ (m2 (eval-cmd c m1)))
+ m2))]
+ [(comp c1 c2) (let* ((m1 (eval-cmd c1 m))
+ (m2 (eval-cmd c2 m1)))
+ m2)]
+ [(var-in x e c) (let* ((v (eval e m))
+ (m1 (mem-alloc x v m))
+ (m2 (eval-cmd c m1)))
+ (mem-drop-last m2))]
+ [(function name args cmd)
+ (mem-alloc name (clo args cmd) m)]
+ [(return-expr val)
+ (mem-update 'RETURN (eval val m) m)]
+ [_ (error "Unknown command" c "— likely a syntax error")])))
+
+
+(define (eval-prog p m)
+ (let ((final-mem (eval-cmd p (mem-alloc 'RETURN #f m))))
+ (with-handlers ([exn:fail? (lambda (v) (error "Undefined reference to main"))])
+ (match (mem-lookup 'main final-mem)
+ [(clo args cmd) (mem-lookup 'RETURN (eval-cmd cmd final-mem))]))))
+
+(define WHILE_FACT
+ '({func decr (x)
+ {(x := (- x 1))
+ (return x)}}
+ {func main ()
+ {(i := 1)
+ (while (> t 0)
+ {(i := (* i t))
+ (t := (call decr (t)))})
+ (return i)}}
+ ))
+
+(define (fact n)
+ (let* ([init-env (mem-alloc 'i 1 (mem-alloc 't n empty-mem))])
+ (eval-prog (parse-cmd WHILE_FACT) init-env)))
+
+(define TEST
+ '({func decr (x) (return (- x 1))}
+ {func main ()
+ (var (x 1)
+ {(x := (+ x 1))
+ (return (call decr (x)))})}))
+
+(define TEST2
+ '({func decr (x) (return (- x 1))}
+ {func main () (return (call decr (3)))}))
+
+(define TEST3
+ '({func sth (x)
+ {(i := -1)
+ (return x)}}
+ {func main ()
+ {(i := 2)
+ (return (call sth (i)))}}))
+
+(define TEST4
+ '(func f ()
+ {return 1}))
+
+(define TEST5
+ '({func f1 (x y z)
+ (return y)}
+ {func f2 (x y z)
+ (return (+ (+ x y) z))}
+ {func main ()
+ {(if (> 4 3)
+ (var (x 2)
+ (return (call f1 (1 x 3))))
+ (x := 5))
+ (return (call f2 (x 3 4)))}}))
+ \ No newline at end of file
diff --git a/Semestr 2/racket/egzamin/zad1b.rkt b/Semestr 2/racket/egzamin/zad1b.rkt
new file mode 100644
index 0000000..628619f
--- /dev/null
+++ b/Semestr 2/racket/egzamin/zad1b.rkt
@@ -0,0 +1,482 @@
+#lang racket
+
+
+
+;; Oświadczam, że rozwiązanie zadania egzaminacyjnego przygotowałem
+;; w pełni samodzielnie, korzystając wyłącznie z materiałów do wykładu,
+;; notatek, podręcznika, oraz materiałów zacytowanych w treści rozwiązania.
+;; Oświadczam że nie korzystałem w żadnej formie z pomocy osób trzecich
+;; w przygotowaniu rozwiązania ani też takiej pomocy nie udzielałem
+;; i nie udostępniałem nikomu swojego rozwiązania.
+
+;; ZADANIE 1
+;; =========
+
+;; W tym zadaniu rozważamy język WHILE (w formie z grubsza
+;; odpowiadającej tej z wykładu), z blokami deklarującymi zmienne o
+;; lokalnym zakresie.
+
+;; Zadanie polega na dodaniu do języka procedur definiowanych na
+;; zewnątrz głównego polecenia programu (podobnie jak w C, gdzie
+;; główne polecenie odpowiadałoby procedurze main, czy Pascalu) — o
+;; dowolnym wybranym przez siebie modelu działania. W tym celu należy:
+;; · rozszerzyć składnię abstrakcyjną o składnię procedur i rozbudować odpowiednio składnię programów
+;; · rozszerzyć procedurę parsowania
+;; · rozszerzyć ewaluator
+;; · *opisać* wybrany model działania procedur, w tym jego potencjalne zalety lub ograniczenia
+;; Należy rozszerzyć poniższy szablon, a część słowną zadania umieścić
+;; w komentarzu, podobnie jak niniejsze polecenie.
+
+;; Uwaga! Zadanie jest *bardzo* szeroko sformułowane, jest wiele
+;; sensownych rozwiązań które stosowały liczne języki imperatywne w
+;; historii — nie jest treścią zadania znalezienie *najlepszego*,
+;; tylko swojego, które *rozumiecie*. Wybrany model działania procedur
+;; *może* być relatywnie ubogi, jednak jeśli tak się zrobi, warto
+;; pokazać że ma się tego świadomość w słownym opisie jego działania.
+
+
+
+
+
+
+
+;; Postanowiłem, że struktura programów w moim języku będzie miała trochę z pythona i trochę z C.
+;; Istotną decyzją którą podjąłem jest to, że wszystkie funkcje w naszym języku muszą zwracać
+;; jakąś wartość (zawsze zwracają inta), łącznie z funkcją main, przy pomocy dyrektywy "return".
+;; To, co zwraca main, jest tym co zwraca
+;; cały program (z małym wyjątkiem, ale o tym później). Okazało się, że takie podejście
+;; do sprawy jest bardzo wygodne -- nie musiałem się dzięki temu nawet przejmować
+;; osobnym implementowaniem funkcji rekurencyjnych, wzajemnie rekurencyjnych
+;; czy nawet zagnieżdżonych, a do tego można definiować funkcje w dowolnej kolejności!
+;; Co więcej, funkcje przyjmują dowolnie wiele argumentów, również 0.
+;; On top of that, do funkcji można przekazywać cokolwiek co ewaluuje się do wartości
+;; Czyli mozna przekazywać wartości zmiennych, jak i dowolne wyrażenia!
+
+;; Oto przykładowy kod, po którym raczej jasno widać w jak wygląda nowa składnia:
+(define BINOM '({func main ()
+ (return (call binom (N K)))}
+ {func fact (t)
+ (if (= t 0)
+ (return 1)
+ ({func decr (x) (return (- x 1))}
+ (return (* t (call fact ((call decr (t))))))))}
+ {func binom (n k)
+ (if (= k 0)
+ (return 1)
+ (var (num (call fact (n)))
+ (var (den (* (call fact (k)) (call fact ((- n k)))))
+ (return (/ num den)))))}
+ ))
+(define (bin n k)
+ (eval-prog (parse-cmd BINOM) (mem-alloc 'i 1 (mem-alloc 'N n (mem-alloc 'K k empty-mem)))))
+;; Specjalnie trochę pokomplikowałem, ale widać featury naszego języka.
+
+;; Jak to w ogóle działa?
+
+;; Za każdym razem, kiedy definiuję funkcję, to do środowiska dodaję parę (nazwa funkcji . clo),
+;; gdzie clo jest takim quasi-domknięciem, jest to po prostu struktura trzymająca nazwy
+;; argumentów funkcji oraz jej ciało. Właśnie takie podejście bardzo dobrze
+;; załatwiło łatwość w definiowaniu funkcji rekurencyjnych oraz wzajemnie rekurencyjnych i
+;; zagnieżdżonych -- żadna funkcja nie zostanie wywołana, dopóki nie wywołam maina,
+;; a tego wywołam dopiero po zewaluowaniu wszystkich definicji (tym samym dodaniu ich do środowiska).
+
+;; Takie podejście ma trochę problemów, chyba największym z nich jest to, że nie ma możliwości
+;; zmiany wartości globalnych wewnątrz funkcji. Tj. możemy je zmieniać, ale zmiany będą
+;; widoczne jedynie w jej lokalnym zakresie.
+;; W zasadzie nie jest to aż tak bolesne -- globalne zmienne możemy traktować po prostu
+;; jak argumenty wywołania funkcji main.
+
+;; Wywoływać funkcję mogę tylko za pomocą specjalnego wyrażenia call,
+;; które jako pierwszy argument
+;; przyjmuje nazwę funkcji, a jako drugi przyjmuje listę argumentów.
+;; Żeby wiedzieć jak działa call, spójrzmy najpierw jak działa return.
+
+;; return napisane jest tak, że jeśli w jakimkolwiek miejscu funkcji
+;; się na niego trafi, to reszta funkcji nie jest już wywoływana
+;; (czyli tak jakbyśmy sie spodziewali). Jak on w sumie działa?
+;; Na samym początku eval-prog, zanim zacznę w ogóle ewaluować definicje funkcji,
+;; dodaje do środowiska specjalną zmienną o nazwie RETURN o wartości #f.
+;; Jeśli w funkcji gdziekolwiek wywołam returna, to
+;; zmieniam wartość RETURN w środowisku na to, co chcę zwrócić.
+;; W eval-cmd za każdym razem sprawdzam jaka jest wartość RETURN.
+;; Jeśli jest to #f, to pracuje jakby nigdy nic, a jeśli jest to coś innego,
+;; to po prostu zwracam aktualne środowisko.
+;; Zatem funkcja zwraca środowisko, w którym zmienna RETURN
+;; ustawiona jest na wynik jej obliczenia.
+
+;; Teraz już prosto widać, że jedyne co robi call, to szuka ciała funkcji
+;; w środowisku i wywołuje ją dla podanych argumentów, dostaje od tej
+;; funkcji środowisko, a następnie odzyskuje wartość RETURN w zwróconym
+;; przez nią środowisku. Dzięki temu po wywołaniu funkcji
+;; wewnątrz innej funkcji nie zmienią się wartości żadnych zmiennych (w tym globalnych).
+;; Jest to dosyć podobne do pythona -- tam inty są immutable i nie można ich wysłać przez
+;; referencję. Ale możemy to robić jeśli się uprzemy np. tak:
+;; {func decr (x)
+;; (return (- x 1))}
+;; {func main ()
+;; {(i := (call decr (i)))
+;; (return i)}
+;; Uruchomienie takiego programu ze zmienną globalną i zwróci oczywiście i-1.
+
+;; Mały problem którego za bardzo nie umiem rozwiązać jest taki, że jeśli gdzieś poza
+;; jakąkolwiek funkcją wywołam return, to wartość którą tam zwrócę będzie
+;; wartością dla całego programu, bo zmienna RETURN w środowisku zmieni swoją wartość
+;; na coś innego od #f i niestety main nawet się nie wykona (na samym wstępie stwierdzi,
+;; że coś zostało już zwrócone). Widać to w TEST10. Generalnie co za tym idzie,
+;; między definicjami funkcji mogą być jakieś instrukcje, które zostaną
+;; wywołane razem z ewaluacją programu, zanim zostanie wywołany main.
+
+;; Dodatkowe informacje umieściłem w komentarzach w odpowiednich miejscach pliku.
+;; Na dole umieściłem kilka testów które pokazują co jak działa.
+
+(struct const (val) #:transparent)
+(struct binop (op l r) #:transparent)
+(struct var-expr (name) #:transparent)
+(struct call-expr (name args) #:transparent) ;; wywołanie funkcji
+
+(define (operator? x)
+ (member x '(+ * - / > < = >= <=)))
+
+(define (keyword? x)
+ (member x '(skip while if := func func-rec call return))) ;; kilka nowych słów kluczowych
+
+(define (expr? e)
+ (match e
+ [(const v)
+ (integer? v)]
+ [(var-expr x)
+ (and (symbol? x)
+ (not (keyword? x)))]
+ [(binop op l r)
+ (and (operator? op)
+ (expr? l)
+ (expr? r))]
+ [(call-expr n a)
+ (and (symbol? n)
+ (list? a)
+ (andmap expr? a))]
+ [_ false]))
+
+(struct skip () #:transparent)
+(struct assign (id exp) #:transparent)
+(struct if-cmd (exp ct cf) #:transparent)
+(struct while (exp cmd) #:transparent)
+(struct comp (left right) #:transparent)
+(struct var-in (name expr cmd) #:transparent)
+(struct function (name args cmd) #:transparent) ;; dodane funkcje, funkcje rekurencyjne oraz return
+(struct funcrec (name args cmd) #:transparent)
+(struct return-stat (exp) #:transparent)
+
+(define (cmd? c)
+ (match c
+ [(skip) true]
+ [(assign x e) (and (symbol? x) (expr? e))]
+ [(if-cmd e ct cf) (and (expr? e) (cmd? ct) (cmd? cf))]
+ [(while e c) (and (expr? e) (cmd? c))]
+ [(comp c1 c2) (and (cmd? c1) (cmd? c2))]
+ [(var-in x e c) (and (symbol? x) (expr? e) (cmd? c))]
+ [(function f a c) (and (symbol? f) (list? a) (andmap symbol? a) (cmd? c))]
+ [(funcrec f a c) (and (symbol? f) (list? a) (andmap symbol? a) (cmd? c))]
+ [(return-stat exp) (expr? exp)]))
+
+(define (prog? p)
+ (cmd? p))
+
+(define (parse-expr p)
+ (cond
+ [(number? p) (const p)]
+ [(and (symbol? p)
+ (not (keyword? p)))
+ (var-expr p)]
+ [(and (list? p)
+ (= 3 (length p))
+ (operator? (car p)))
+ (binop (first p)
+ (parse-expr (second p))
+ (parse-expr (third p)))]
+ [(and (list? p) ; <------ wywołanie funkcji
+ (= (length p) 3)
+ (eq? (first p) 'call)
+ (symbol? (second p))
+ (list? (third p)))
+ (call-expr (second p) (map parse-expr (third p)))]
+ [else false]))
+
+(define (parse-cmd q)
+ (cond
+ [(eq? q 'skip) (skip)]
+ [(and (list? q)
+ (= (length q) 3)
+ (eq? (second q) ':=))
+ (assign (first q) (parse-expr (third q)))]
+ [(and (list? q)
+ (= (length q) 4)
+ (eq? (first q) 'if))
+ (if-cmd (parse-expr (second q)) (parse-cmd (third q)) (parse-cmd (fourth q)))]
+ [(and (list? q)
+ (= (length q) 3)
+ (eq? (first q) 'while))
+ (while (parse-expr (second q)) (parse-cmd (third q)))]
+ [(and (list? q)
+ (= (length q) 3)
+ (eq? (first q) 'var)
+ (list? (second q))
+ (= (length (second q)) 2))
+ (var-in (first (second q))
+ (parse-expr (second (second q)))
+ (parse-cmd (third q)))]
+ [(and (list? q) ; <------ funkcje
+ (= (length q) 4)
+ (eq? (first q) 'func)
+ (symbol? (second q))
+ (list? (third q))
+ (andmap symbol? (third q)))
+ (function (second q) (third q) (parse-cmd (fourth q)))]
+ [(and (list? q) ; <------ return
+ (= (length q) 2)
+ (eq? (first q) 'return))
+ (return-stat (parse-expr (second q)))]
+ [(and (list? q)
+ (>= (length q) 2))
+ (desugar-comp (map parse-cmd q))]
+ [else false]))
+
+(define (desugar-comp cs)
+ (if (null? (cdr cs))
+ (car cs)
+ (comp (car cs)
+ (desugar-comp (cdr cs)))))
+
+(define (value? v)
+ (number? v))
+
+(struct mem (xs) #:transparent)
+
+(define (mem-lookup x m)
+ (define (assoc-lookup xs)
+ (cond
+ [(null? xs) (error "Undefined variable" x)]
+ [(eq? x (caar xs)) (cdar xs)]
+ [else (assoc-lookup (cdr xs))]))
+ (assoc-lookup (mem-xs m)))
+
+(define (mem-update x v m)
+ (define (assoc-update xs)
+ (cond
+ [(null? xs) (error "Undefined variable" x)]
+ [(eq? x (caar xs)) (cons (cons x v) (cdr xs))]
+ [else (cons (car xs) (assoc-update (cdr xs)))]))
+ (mem (assoc-update (mem-xs m))))
+
+(define (mem-alloc x v m)
+ (mem (cons (cons x v) (mem-xs m))))
+
+(define (mem-drop-last m)
+ (cond
+ [(null? (mem-xs m))
+ (error "Deallocating from empty memory")]
+ [else
+ (mem (cdr (mem-xs m)))]))
+
+(define empty-mem
+ (mem null))
+
+(define (op->proc op)
+ (match op
+ ['+ +]
+ ['- -]
+ ['* *]
+ ['/ /]
+ ['< (lambda (x y) (if (< x y) 1 0))]
+ ['> (lambda (x y) (if (> x y) 1 0))]
+ ['= (lambda (x y) (if (= x y) 1 0))]
+ ['<= (lambda (x y) (if (<= x y) 1 0))]
+ ['>= (lambda (x y) (if (>= x y) 1 0))]
+ ))
+
+;; zał: (expr? e) i (mem? m) jest prawdą
+;; (value? (eval e m)) jest prawdą
+(define (eval e m)
+ (match e
+ [(const v) v]
+ [(var-expr x) (mem-lookup x m)]
+ [(binop op l r)
+ (let ((vl (eval l m))
+ (vr (eval r m))
+ (p (op->proc op)))
+ (p vl vr))]
+ [(call-expr name args) ;; <------ ewaluacja wywołania funkcji
+ (match (mem-lookup name m)
+ [(clo func-args cmd)
+ (if (= (length args) (length func-args)) ;; <------ sprawdzanie arnosci
+ (let* ([func-mem (assign-values args func-args m)]
+ [final-mem (eval-cmd cmd func-mem)]
+ [ret (mem-lookup 'RETURN final-mem)])
+ (if ret
+ ret
+ (error "No return statement in function" name)))
+ (error "Arity mismatch, function" name "takes" (length func-args) "arguments, got" (length args)))]
+ [else (error "Undefined function" name)])]))
+
+(define (assign-values args func-args mem) ;; <------ przypisanie wartosci do argumentow funkcji
+ (define (iter args func-args new-mem)
+ (if (null? args)
+ new-mem
+ (iter (cdr args) (cdr func-args) (mem-alloc (car func-args) (eval (car args) mem) new-mem))))
+ (iter args func-args mem))
+
+
+(struct clo (args cmd)) ; <----- tak trzymana jest funkcja w środowisku, tj. jako lista nazw argumentow i cialo funkcji
+
+;; zał: (cmd? c) (mem? m)
+;; (mem? (eval-cmd c m))
+(define (eval-cmd c m)
+ (if (mem-lookup 'RETURN m) ; <----- jeśli RETURN jest na coś ustawione, to chcemy zrwócic pamięc
+ m
+ (match c
+ [(skip) m]
+ [(assign x e) (mem-update x (eval e m) m)]
+ [(if-cmd e ct cf) (if (= (eval e m) 0)
+ (eval-cmd cf m)
+ (eval-cmd ct m))]
+ [(while e cw) (if (= (eval e m) 0)
+ m
+ (let* ((m1 (eval-cmd cw m))
+ (m2 (eval-cmd c m1)))
+ m2))]
+ [(comp c1 c2) (let* ((m1 (eval-cmd c1 m))
+ (m2 (eval-cmd c2 m1)))
+ m2)]
+ [(var-in x e c) (let* ((v (eval e m))
+ (m1 (mem-alloc x v m))
+ (m2 (eval-cmd c m1)))
+ (mem-drop-last m2))]
+ [(function name args cmd) ; <------ dodanie ciała funkcji do środowiska
+ (mem-alloc name (clo args cmd) m)]
+ [(return-stat val) ; <------ zmiana wartości zmiennej RETURN
+ (mem-update 'RETURN (eval val m) m)]
+ [_ (error "Unknown command" c "— likely a syntax error")])))
+
+
+;; program ewaluowany jest tak
+;; ewaluowane są wszystkie definicje funkcji, wtedy
+;; ręcznie szukam definicji main i ewaluuje jej ciało i zwracam to co zwróci main.
+;; zakładam, że main nie przyjmuje żadnych argumentów.
+(define (eval-prog p m)
+ (let ((final-mem (eval-cmd p (mem-alloc 'RETURN #f m))))
+ (match (mem-lookup 'main final-mem)
+ [(clo args cmd)
+ (let ((res (mem-lookup 'RETURN (eval-cmd cmd final-mem))))
+ (if res res (error "No return statement in main")))])))
+
+(define WHILE_FACT
+ '({func decr (x)
+ {(x := (- x 1))
+ (return x)}}
+ {func main ()
+ {(i := 1)
+ (while (> t 0)
+ {(i := (* i t))
+ (t := (call decr (t)))})
+ (return i)}}
+ ))
+
+(define (fact n)
+ (let* ([init-env (mem-alloc 'i 1 (mem-alloc 't n empty-mem))])
+ (eval-prog (parse-cmd WHILE_FACT) init-env)))
+
+(define TEST
+ '({func decr (x) (return (- x 1))}
+ {func main ()
+ (var (x 1)
+ {(x := (+ x 2))
+ (return (call decr (x)))})}))
+(define (test) (eval-prog (parse-cmd TEST) empty-mem))
+
+(define TEST2
+ '({func decr (x) (return (- x 1))}
+ {func main () (return (call decr (3)))}))
+(define (test2) (eval-prog (parse-cmd TEST2) empty-mem))
+
+; nie da się zmienić wartości zmiennej globalnej, zmienne są wysyłane przez kopie
+(define TEST3
+ '({func sth (x)
+ {(i := -1)
+ (return x)}}
+ {func main ()
+ {(i := 2)
+ (return (call sth (i)))}}))
+(define (test3) (eval-prog (parse-cmd TEST3) (mem-alloc 'i 3 empty-mem)))
+
+; nie ma maina, wywala błąd
+(define TEST4
+ '(func f ()
+ {return 1}))
+(define (test4) (eval-prog (parse-cmd TEST4) empty-mem))
+
+; funkcje wieloargumentowe
+(define TEST5
+ '({func f1 (x y z)
+ (return y)}
+ {func f2 (x y z)
+ (return (+ (+ x y) z))}
+ {func main ()
+ {(if (> X 3)
+ (var (x 2)
+ (return (call f1 (1 x 3))))
+ (x := 5))
+ (return (call f2 (x 3 4)))}}))
+(define (test5) (eval-prog (parse-cmd TEST5) (mem-alloc 'x -1 (mem-alloc 'X 4 empty-mem))))
+
+; Działa rekurencja!!
+(define TEST6
+ '({func f (x)
+ (if (= x 0)
+ (return 1)
+ (return (* x (call f ((- x 1))))))}
+ {func main ()
+ (return (call f (X)))}))
+(define (test6) (eval-prog (parse-cmd TEST6) (mem-alloc 'X 5 empty-mem)))
+
+; kolejnośc deklaracji funkcji nie ma znaczenia, można zagnieżdżać funkcje
+(define TEST7
+ '(
+ {func main ()
+ (return (call f (2)))}
+ {func f (x)
+ (return (call f1 (x)))}
+ {func f1 (x)
+ {{func local-fun (x)
+ (return (+ 1 x))}
+ (return (call local-fun (x)))}}))
+(define (test7) (eval-prog (parse-cmd TEST7) empty-mem))
+
+; instrukcje poza jakimikolwiek funkcjami sa wykonywane przed wywołaniem main
+(define TEST8
+ '({func main ()
+ (return i)}
+ (i := 2)))
+(define (test8) (eval-prog (parse-cmd TEST8) (mem-alloc 'i 1 empty-mem)))
+
+; nic nie zwraca main, wywala błąd
+(define TEST9
+ '(func main ()
+ (i := 1)))
+(define (test9) (eval-prog (parse-cmd TEST9) (mem-alloc 'i 1 empty-mem)))
+
+; return poza jakąkolwiek funkcją jest wynikiem programu
+(define TEST10
+ '({func main ()
+ (return i)}
+ (i := 2)
+ (return -1)))
+(define (test10) (eval-prog (parse-cmd TEST10) (mem-alloc 'i 1 empty-mem)))
+
+
+; arity mismatch
+(define TEST11
+ '({func main ()
+ (return (call decr ()))}
+ {func decr (x)
+ (return (- x 1))}))
+(define (test11) (eval-prog (parse-cmd TEST11) empty-mem))
diff --git a/Semestr 2/racket/egzamin/zad2.bak b/Semestr 2/racket/egzamin/zad2.bak
new file mode 100644
index 0000000..02e2ae0
--- /dev/null
+++ b/Semestr 2/racket/egzamin/zad2.bak
@@ -0,0 +1,119 @@
+#lang racket
+
+;; ZADANIE 2
+;; =========
+
+;; W tym zadaniu przyjrzymy się pierwszemu "językowi programowania"
+;; który widzieliśmy na zajęciach: wyrażeniom arytmetycznym. Ich
+;; prostota przejawia się przede wszystkim tym że nie występują w nich
+;; zmienne (a w szczególności ich wiązanie) — dlatego możemy o nich
+;; wnioskować nie używając narzędzi cięższych niż te poznane na
+;; wykładzie.
+
+;; W tym zadaniu będziemy chcieli udowodnić że nasza prosta kompilacja
+;; do odwrotnej notacji polskiej jest poprawna. Konkretniej, należy
+;; · sformułować zasady indukcji dla obydwu typów danych
+;; reprezentujących wyrażenia (expr? i rpn-expr?)
+;; · sformułować i udowodnić twierdzenie mówiące że kompilacja
+;; zachowuje wartość programu, tj. że obliczenie wartości programu
+;; jest równoważne skompilowaniu go do RPN i obliczeniu.
+;; · sformułować i udowodnić twierdzenie mówiące że translacja z RPN
+;; do wyrażeń arytmetycznych (ta która była zadaniem domowym;
+;; implementacja jest poniżej) jest (prawą) odwrotnością translacji
+;; do RPN (czyli że jak zaczniemy od wyrażenia i przetłumaczymy do
+;; RPN i z powrotem, to dostaniemy to samo wyrażenie).
+;; Swoje rozwiązanie należy wpisać na końcu tego szablonu w
+;; komentarzu, podobnie do niniejszej treści zadania; proszę zadbać o
+;; czytelność dowodów!
+
+(struct const (val) #:transparent)
+(struct binop (op l r) #:transparent)
+
+(define (operator? x)
+ (member x '(+ * - /)))
+
+(define (expr? e)
+ (match e
+ [(const v)
+ (integer? v)]
+ [(binop op l r)
+ (and (operator? op)
+ (expr? l)
+ (expr? r))]
+ [_ false]))
+
+
+(define (value? v)
+ (number? v))
+
+(define (op->proc op)
+ (match op
+ ['+ +]
+ ['- -]
+ ['* *]
+ ['/ /]))
+
+;; zał: (expr? e) jest prawdą
+;; (value? (eval e)) jest prawdą
+(define (eval e)
+ (match e
+ [(const v) v]
+ [(binop op l r)
+ (let ((vl (eval l))
+ (vr (eval r))
+ (p (op->proc op)))
+ (p vl vr))]))
+
+(define (rpn-expr? e)
+ (and (list? e)
+ (pair? e)
+ (andmap (lambda (x) (or (number? x) (operator? x))) e)))
+
+
+(struct stack (xs))
+
+(define empty-stack (stack null))
+(define (empty-stack? s) (null? (stack-xs s)))
+(define (top s) (car (stack-xs s)))
+(define (push a s) (stack (cons a (stack-xs s))))
+(define (pop s) (stack (cdr (stack-xs s))))
+
+
+(define (eval-am e s)
+ (cond
+ [(null? e) (top s)]
+ [(number? (car e)) (eval-am (cdr e) (push (car e) s))]
+ [(operator? (car e))
+ (let* ((vr (top s))
+ (s (pop s))
+ (vl (top s))
+ (s (pop s))
+ (v ((op->proc (car e)) vl vr)))
+ (eval-am (cdr e) (push v s)))]))
+
+(define (rpn-eval e)
+ (eval-am e empty-stack))
+
+(define (arith->rpn e)
+ (match e
+ [(const v) (list v)]
+ [(binop op l r) (append (arith->rpn l) (arith->rpn r) (list op))]))
+
+(define (rpn-translate e s)
+ (cond
+ [(null? e)
+ (top s)]
+
+ [(number? (car e))
+ (rpn-translate (cdr e) (push (const (car e)) s))]
+
+ [(operator? (car e))
+ (let* ((er (top s))
+ (s (pop s))
+ (el (top s))
+ (s (pop s))
+ (en (binop (car e) el er)))
+ (rpn-translate (cdr e) (push en s)))]))
+
+(define (rpn->arith e)
+ (rpn-translate e empty-stack)) \ No newline at end of file
diff --git a/Semestr 2/racket/egzamin/zad2.rkt b/Semestr 2/racket/egzamin/zad2.rkt
new file mode 100644
index 0000000..e549f07
--- /dev/null
+++ b/Semestr 2/racket/egzamin/zad2.rkt
@@ -0,0 +1,186 @@
+#lang racket
+
+;; Oświadczam, że rozwiązanie zadania egzaminacyjnego przygotowałem
+;; w pełni samodzielnie, korzystając wyłącznie z materiałów do wykładu,
+;; notatek, podręcznika, oraz materiałów zacytowanych w treści rozwiązania.
+;; Oświadczam że nie korzystałem w żadnej formie z pomocy osób trzecich
+;; w przygotowaniu rozwiązania ani też takiej pomocy nie udzielałem
+;; i nie udostępniałem nikomu swojego rozwiązania.
+
+;; ZADANIE 2
+;; =========
+
+;; W tym zadaniu przyjrzymy się pierwszemu "językowi programowania"
+;; który widzieliśmy na zajęciach: wyrażeniom arytmetycznym. Ich
+;; prostota przejawia się przede wszystkim tym że nie występują w nich
+;; zmienne (a w szczególności ich wiązanie) — dlatego możemy o nich
+;; wnioskować nie używając narzędzi cięższych niż te poznane na
+;; wykładzie.
+
+;; W tym zadaniu będziemy chcieli udowodnić że nasza prosta kompilacja
+;; do odwrotnej notacji polskiej jest poprawna. Konkretniej, należy
+;; · sformułować zasady indukcji dla obydwu typów danych
+;; reprezentujących wyrażenia (expr? i rpn-expr?)
+;; · sformułować i udowodnić twierdzenie mówiące że kompilacja
+;; zachowuje wartość programu, tj. że obliczenie wartości programu
+;; jest równoważne skompilowaniu go do RPN i obliczeniu.
+;; · sformułować i udowodnić twierdzenie mówiące że translacja z RPN
+;; do wyrażeń arytmetycznych (ta która była zadaniem domowym;
+;; implementacja jest poniżej) jest (prawą) odwrotnością translacji
+;; do RPN (czyli że jak zaczniemy od wyrażenia i przetłumaczymy do
+;; RPN i z powrotem, to dostaniemy to samo wyrażenie).
+;; Swoje rozwiązanie należy wpisać na końcu tego szablonu w
+;; komentarzu, podobnie do niniejszej treści zadania; proszę zadbać o
+;; czytelność dowodów!
+
+(struct const (val) #:transparent)
+(struct binop (op l r) #:transparent)
+
+(define (operator? x)
+ (member x '(+ * - /)))
+
+(define (expr? e)
+ (match e
+ [(const v)
+ (integer? v)]
+ [(binop op l r)
+ (and (operator? op)
+ (expr? l)
+ (expr? r))]
+ [_ false]))
+
+
+(define (value? v)
+ (number? v))
+
+(define (op->proc op)
+ (match op
+ ['+ +]
+ ['- -]
+ ['* *]
+ ['/ /]))
+
+;; zał: (expr? e) jest prawdą
+;; (value? (eval e)) jest prawdą
+(define (eval e)
+ (match e
+ [(const v) v]
+ [(binop op l r)
+ (let ((vl (eval l))
+ (vr (eval r))
+ (p (op->proc op)))
+ (p vl vr))]))
+
+(define (rpn-expr? e)
+ (and (list? e)
+ (pair? e)
+ (andmap (lambda (x) (or (number? x) (operator? x))) e)))
+
+;; mój kod
+(define (parse-expr q)
+ (cond
+ [(integer? q) (const q)]
+ [(and (list? q) (= (length q) 3) (operator? (first q)))
+ (binop (first q) (parse-expr (second q)) (parse-expr (third q)))]))
+
+(struct stack (xs))
+
+(define empty-stack (stack null))
+(define (empty-stack? s) (null? (stack-xs s)))
+(define (top s) (car (stack-xs s)))
+(define (push a s) (stack (cons a (stack-xs s))))
+(define (pop s) (stack (cdr (stack-xs s))))
+
+
+(define (eval-am e s)
+ (cond
+ [(null? e) (top s)]
+ [(number? (car e)) (eval-am (cdr e) (push (car e) s))]
+ [(operator? (car e))
+ (let* ((vr (top s))
+ (s (pop s))
+ (vl (top s))
+ (s (pop s))
+ (v ((op->proc (car e)) vl vr)))
+ (eval-am (cdr e) (push v s)))]))
+
+(define (rpn-eval e)
+ (eval-am e empty-stack))
+
+(define (arith->rpn e)
+ (match e
+ [(const v) (list v)]
+ [(binop op l r) (append (arith->rpn l) (arith->rpn r) (list op))]))
+
+(define (rpn-translate e s)
+ (cond
+ [(null? e)
+ (top s)]
+
+ [(number? (car e))
+ (rpn-translate (cdr e) (push (const (car e)) s))]
+
+ [(operator? (car e))
+ (let* ((er (top s))
+ (s (pop s))
+ (el (top s))
+ (s (pop s))
+ (en (binop (car e) el er)))
+ (rpn-translate (cdr e) (push en s)))]))
+
+(define (rpn->arith e)
+ (rpn-translate e empty-stack))
+
+
+;; W kilku miejscach pozwoliłem sobie zapomnieć że symbol operatora i operator
+;; to nie to samo, ale nie ma to znaczenia w kontekście dowodów.
+;; Przez ES oznaczam empty-stack
+;;
+;; Zasada indukcji dla expr:
+;; Dla dowolnej własności P, jeśli
+;; · zachodzi P((const x)) dla dowolnego x oraz
+;; · dla dowolnych e1, e2 oraz operator op jeśli zachodzi P(e1), P(e2)
+;; to zachodzi P((binop op e1 e2))
+;; to dla dowolnego e, jeśli zachodzi (expr? e) to zachodzi P(e)
+;;
+;; Zasada indukcji dla rpn (ale tego wg rpn-expr?):
+;; Dla dowolnej własności P, jeśli
+;; · zachodzi P(x) dla dowolnej liczby lub opeartora x oraz
+;; · dla dowolnej listy liczb lub operatorów xs oraz dowolnej liczby lub
+;; operatora x, jesli zachodzi P(xs), to zachodzi P((cons x xs))
+;; to dla dowolnej listy xs liczb lub operatorów zachodzi P(xs)
+;;
+;;
+;; Tw. 1: Jeśli spełnione jest (expr? e), to (eval e) ≡ (rpn-eval (arith->rpn e))
+;;
+;; D-d. Skorzystamy z zasady indukcji dla wyrażeń.
+;; · Weźmy dowolną liczbę x. Wtedy jeśli e ≡ (const x), to zachodzi
+;; (eval (const x)) ≡ x ≡ (rpn-eval '(x)) ≡ (rpn-eval (arith->rpn (const x)))
+;; · Weźmy dowolne e1, e2 spełniające naszą tezę oraz jakiś operator op. Wtedy
+;; (eval (binop op e1 e2)) ≡
+;; (op (eval e1) (eval e2)) ≡ [Z definicji eval-am]
+;; (eval-am '() (push (op (eval e1) (eval e2)) ES)) ≡
+;; (eval-am '(op) (push (eval e2) (push (eval e1) ES))) ≡ [Z założenia indukcyjnego]
+;; (eval-am '(op) (push (rpn-eval (arith->rpn e2)) (push (eval e1) ES))) ≡
+;; (eval-am (append (arith->rpn e2) '(op)) (push (eval e1) ES)) ≡ [Z założenia indukcyjnego]
+;; (eval-am (append (arith->rpn e1) (arith->rpn e2) '(op)) ES) ≡
+;; (rpn-eval (append (arith->rpn e1) (arith->rpn e2) '(op))) ≡ [Z definicji arith->rpn]
+;; (rpn-eval (arith->rpn (binop op e1 e2)))
+;; Pokazaliśmy oba warunki indukcji dla wyrażeń, zatem twierdzenie prawdziwe jest
+;; dla dowolnego wyrażenia e spełniającego (expr? e).
+;;
+;; Tw. 2: Jeśli spełnione jest (expr? e), to (rpn->arith (arith->rpn e)) ≡ e
+;;
+;; D-d. Skoryzstamy z indukcji dla wyrażeń.
+;; · Weźmy dowolną liczbę x. Wtedy dla e ≡ (const x) zachodzi
+;; (rpn->arith (arith->rpn e)) ≡ (rpn->arith '(x)) ≡ (const x)
+;; · Weźmy dowolne e1, e2 dla których twierdzenie zachodzi oraz operator op. Wtedy
+;; (rpn->arith (arith->rpn (binop op e1 e2))) ≡ [Z definicji arith->rpn]
+;; (rpn->arith (append (arith->rpn e1) (arith->rpn e2) '(op))) ≡
+;; (rpn-translate (append (arith->rpn e1) (arith->rpn e2) '(op)) ES) ≡ [Z zał. (arith->rpn e1) ewaluuje się do liczby]
+;; (rpn-translate (append (arith->rpn e2) '(op)) (push e1 ES)) ≡ [Z zał. (arith->rpn e2) ewaluuje się do liczby]
+;; (rpn-translate '(op) (push e2 (push e1 ES))) ≡ [Z definicji rpn-translate]
+;; (rpn-translate '() (push (binop op e1 e2) ES)) ≡
+;; (binop op e1 e2)
+;; Pokazaliśmy oba warunki indukcji dla wyrażeń, zatem twierdzenie jest prawdziwe
+;; dla dowolnego e spełniającego (expr? e).
diff --git a/Semestr 2/racket/egzamin/zad3.bak b/Semestr 2/racket/egzamin/zad3.bak
new file mode 100644
index 0000000..20115e9
--- /dev/null
+++ b/Semestr 2/racket/egzamin/zad3.bak
@@ -0,0 +1,4 @@
+#lang racket
+
+
+
diff --git a/Semestr 2/racket/egzamin/zad3.rkt b/Semestr 2/racket/egzamin/zad3.rkt
new file mode 100644
index 0000000..9bfed02
--- /dev/null
+++ b/Semestr 2/racket/egzamin/zad3.rkt
@@ -0,0 +1,347 @@
+#lang racket
+
+;; Oświadczam, że rozwiązanie zadania egzaminacyjnego przygotowałem
+;; w pełni samodzielnie, korzystając wyłącznie z materiałów do wykładu,
+;; notatek, podręcznika, oraz materiałów zacytowanych w treści rozwiązania.
+;; Oświadczam że nie korzystałem w żadnej formie z pomocy osób trzecich
+;; w przygotowaniu rozwiązania ani też takiej pomocy nie udzielałem
+;; i nie udostępniałem nikomu swojego rozwiązania.
+
+;; ZADANIE 3
+;; =========
+
+;; Z gramatykami bezkontekstowymi spotkaliście się już na Wstępie do
+;; Informatyki. W tym zadaniu potraktujemy je jako dane dla naszych
+;; programów.
+
+;; Przypomnijmy, że gramatyka bezkontekstowa składa się z
+;; · skończonego zbioru *symboli nieterminalnych*
+;; · skończonego zbioru *symboli terminalnych*
+;; · wybranego nieterminalnego symbolu startowego
+;; · zbioru *produkcji*, czyli par symbol nieterminalny - lista
+;; (potencjalnie pusta) symboli terminalnych lub nieterminalnych
+
+;; Słowo (ciąg symboli terminalnych) możemy wyprowadzić z gramatyki,
+;; jeśli możemy zacząć od ciągu składającego się z symbolu startowego
+;; możemy użyć skończonej liczby produkcji z gramatyki przepisując
+;; symbol nieterminalny na ciąg symboli mu odpowiadających (w danej
+;; produkcji).
+
+
+;; Przykład: poprawne nawiasowania
+
+;; Gramatyka składa się z jednego symbolu nieterminalnego, S (który
+;; jest oczywiście symbolem startowym) i dwóch symboli terminalnych
+;; "(" i ")", i zawiera następujące produkcje (zwyczajowo zapisywane
+;; przy użyciu strzałki; zwróćcie uwagę że pierwszy ciąg jest pusty!):
+;; S ->
+;; S -> SS
+;; S -> (S)
+
+;; W często spotykanej, bardziej zwięzłej, postaci BNF moglibyśmy tę
+;; gramatykę zapisać tak (dbając trochę bardziej o wizualne
+;; oddzielenie symboli terminalnych i nieterminalnych):
+;; S ::= "" | SS | "(" S ")"
+;; Mamy tu te same produkcje, ale tylko raz zapisujemy każdą z
+;; powtarzających się lewych stron.
+
+;; Z gramatyki tej da się wyprowadzić wszystkie poprawnie rozstawione
+;; ciągi nawiasów — zobaczmy jak wyprowadzić (na jeden ze sposobów)
+;; ciąg "(()())". Zaczynamy, jak zawsze, od słowa złożonego z symbolu
+;; startowego i przepisujemy:
+;; S -> (S) -> (SS) -> ((S)S) -> ((S)(S)) -> (()(S)) -> (()())
+
+
+;; Zadanie cz. 1
+
+;; Zdefiniuj reprezentację gramatyki jako typu danych w
+;; Rackecie. Warto zastanowić się co można uprościć względem definicji
+;; matematycznej — w szczególności możemy założyć że dowolne napisy
+;; (typu string) są ciągami symboli terminalnych, i że nie musimy
+;; podawać jawnie zbioru nieterminali; również reprezentacja produkcji
+;; gramatyki jako worka z parami wejście-wyjście niekoniecznie jest
+;; najwygodniejsza.
+
+;; Uwaga: w tym zadaniu nie wymagamy definiowania składni konkretnej i
+;; parsowania, ale bardzo polecamy wybranie jakiejś formy, żeby móc
+;; sensownie przetestować swoje rozwiązanie!
+
+
+;; "Optymalizacja" gramatyk
+
+;; Gramatyki, podobnie jak programy, piszą ludzie — może więc zdarzyć
+;; się że znajdą się tam śmieci. Mogą one mieć dwojaką formę: symboli
+;; nieterminalnych, których nie da się wyprowadzić z symbolu
+;; startowego, lub symboli nieterminalnych z których nie da się
+;; wyprowadzić żadnego słowa terminalnego (tj. niezawierającego
+;; symboli nieterminalnych). Przykładowo, do naszej gramatyki
+;; moglibyśmy dodać symbole P i Q, i produkcje:
+;; S -> ")(" P
+;; P -> PP "qed"
+;; Q -> "abc"
+
+;; Mimo że nasza gramatyka wygląda inaczej na pierwszy rzut oka, tak
+;; naprawdę się nie zmieniła: do symbolu Q nie możemy dojść z symbolu
+;; S, a więc "abc" nigdy nie wystąpi w słowie wyprowadzalnym z
+;; gramatyki. Analogicznie, z P nie da się wyprowadzić żadnego słowa,
+;; które nie zawierałoby symbolu P — a zatem żadnego słowa złożonego
+;; tylko z symboli terminalnych. To znaczy, że naszą gramatykę możemy
+;; uprościć wyrzucając z niej symbole nieterminalne (i produkcje które
+;; ich używają) do których nie da się dojść (tj. są *nieosiągalne*) i
+;; te, z których nie da się ułożyć słowa terminalnego (tj. są
+;; *nieproduktywne*). Jeśli z naszej rozszerzonej gramatyki wyrzucimy
+;; takie symbole, dostaniemy oczywiście gramatykę początkową.
+
+
+;; Zadanie cz. 2
+
+;; Dla swojej reprezentacji gramatyki z poprzedniej części zadania
+;; napisz dwie procedury: cfg-unreachable, znajdującą symbole
+;; nieterminalne które są nieosiągalne z symbolu startowego, i
+;; cfg-unproductive, znajdującą symbole nieterminalne które nie są
+;; produktywne. Następnie użyj tych procedur żeby zdefiniować
+;; procedurę cfg-optimize, która uprości daną gramatykę usuwając z
+;; niej symbole nieosiągalne i nieproduktywne, a także odpowiednie
+;; produkcje.
+
+;; Rozwiązanie wpisz w poniższym pliku, i opatrz komentarzem
+;; opisującym wybraną reprezentację (i podjęte przy jej projektowaniu
+;; decyzje), a także zaimplementowane w cz. 2. algorytmy.
+
+
+
+
+
+
+;; Zadanie 1
+
+;; Reprezentacja jest docyś prosta, mianowicie stworzyłem struktury
+;; terminal, non-terminal, rule oraz grammar. Dwa pierwsze to
+;; po prostu jednoelementowe struktury utrzymujące nazwę symboli.
+;; grammar to dwuelementowa struktura, jej pierwszym elementem
+;; jest symbol startowy, a następnym produkcja, czyli lista reguł (listof rule),
+;; a reguły to dwuelementowe struktury (symbol niterminalny - lista nonterminali lub termianli).
+;; Generalnie dzięki temu, że mam te struktury terminal oraz non-terminal
+;; to symbol nieterminalne i temrinalne mogą być czykolwiek. Dodatkowo
+;; dla uproszczenia w miejscach, gdzie mam pewność że chodzi mi o
+;; symbol nieterminalny, to nie opakowuję go w strukturę.
+;; Przykładowo rules w gramatyce może wyglądać tak:
+;; (list
+;; (rule 'S (list (terminal "")))
+;; (rule 'S (list (non-terminal 'S) (non-terminal 'S)))
+;; (rule 'S (list (terminal "(") (non-terminal 'S) (terminal ")"))))
+;; Oczywiście symbol nieterminalny nie musi być racketowym symbolem, może być czymkolwiek.
+;; Podobnie z symbolami terminalnymi. Proszę również zauważyć, że dzięki
+;; strukturom non-terminal oraz terminal te same racketowe obiekty mogą być jednocześnie
+;; terminalami oraz nieterminalami!
+;; W tych parach na pierwszym miejscu nie jest non-terminal, tylko po prostu cokolwiek
+;; no i oczywiście mam wtedy pewność że musi być to non-terminal, nie ma potrzeby
+;; żeby pakować go również w tę strukturę.
+
+
+;; Postanowiłem napisać parser (make-cfg q), generuje on gramatyki w bardzo konkretny sposób,
+;; trochę ograniczo to czym mogą być symbole nieterminalne oraz terminalne,
+;; ale nie wydaje mi się że i tak składnia jest bardzo wygodna i mało ograniczająca.
+
+;; Składnia konkretna naszych gramatyk wygląda bardzo podobnie do zapisu
+;; przedstawionego w treści zadania.
+;; np. gramatyka nawiasowania będzie wyglądać następująco:
+;; '(grammar S (S ::= "" -- SS -- "(" S ")"))
+;; ale mogłaby wyglądać też tak:
+;; '(grammar S (S ::= "") (S ::= SS -- "(" S ")"))
+;; a np. ta nieciekawa gramatyka przedstawiona w treści zadania:
+;; '(grammar S (S ::= "] [" P) (P ::= PP "qed") (Q ::= "abc"))
+;; Zatem będzie to lista, która na pierwszym miejscu ma symbol 'grammar
+;; na drugim miejscu ma symbol startowy
+;; następnie następuje lista produkcji w formacie:
+;; <non-terminal> ::= <lista produkcji, produkcje oddzielone są separatorem -->
+;; Zalety:
+;; - rozróżnienie w składni konkretnej symboli nieterminalnych i terminalnych
+;; przez użycie symboli i stringów pozwala na to, aby symbole terminalne nazywały się tak
+;; jak terminalne, tj. "S" nie jest tym samym co 'S.
+;; - składnia wydaje się bardzo wygodna w użyciu, nie ma też problemu, żeby później dopisać
+;; dodatkowe reguły dla jakiegoś nieterminala,
+;; - parser jest całkiem łatwy w implementacji
+;; Wady:
+;; - symbole nieterminalne mogą składać się jedynie z jednego symbolu, zatem nie możemy robić ich
+;; zbyt wiele. Jest tak dlatego, że np. tutaj (S ::= SS) nie chodzi mi o symbol SS, tylko
+;; o sąsiadujące symbole SS (jednak gdyby nie używać parsera to normalnie moglibyśmy
+;; mieć wieloznakowe symbole nieterminalne!).
+
+;; Dla przykładu taka gramatyka:
+;; '(grammar S (S ::= "" -- SS -- "(" S ")" -- Q) (Q ::= "" -- QS -- "[" Q "]"))
+;; będzie reprezentowana następująco:
+;; (grammar
+;; 'S
+;; (list
+;; (rule 'S (list (terminal "")))
+;; (rule 'S (list (non-terminal 'S) (non-terminal 'S)))
+;; (rule 'S (list (terminal "(") (non-terminal 'S) (terminal ")")))
+;; (rule 'S (list (non-terminal 'Q)))
+;; (rule 'Q (list (terminal "")))
+;; (rule 'Q (list (non-terminal 'Q) (non-terminal 'S)))
+;; (rule 'Q (list (terminal "[") (non-terminal 'Q) (terminal "]")))))
+
+;; Cała reprezentacja :D
+(struct non-terminal (sym) #:transparent)
+(struct terminal (sym) #:transparent)
+(struct rule (nt xs) #:transparent)
+(struct grammar (start rules) #:transparent)
+
+
+;; PARSER
+(define SEPARATOR '--)
+
+(define (split-at-symb symb xs)
+ (define (iter left right)
+ (cond
+ [(null? right) (cons left null)]
+ [(eq? symb (car right)) (cons left (cdr right))]
+ [else (iter (cons (car right) left) (cdr right))]))
+ (let ([res (iter null xs)])
+ (cons (reverse (car res)) (cdr res))))
+
+(define (split-by-separator xs)
+ (let ([res (split-at-symb SEPARATOR xs)])
+ (if (null? (cdr res))
+ res
+ (cons (car res) (split-by-separator (cdr res))))))
+
+;; PARSER SKŁADNI KONKRETNEJ DO JEJ REPREZENTACJI
+(define (make-cfg q)
+ (cond
+ [(and (list? q) (eq? 'grammar (first q)))
+ (grammar (second q) (append-map make-cfg (cddr q)))]
+ [(and (list? q) (eq? '::= (second q)))
+ (let ([nt (first q)]
+ [rules (split-by-separator (cddr q))])
+ (map (lambda (x) (rule nt x)) (map make-prod rules)))]))
+
+(define (symbol->list s)
+ (map string->symbol
+ (map string
+ (string->list (symbol->string s)))))
+
+(define (make-prod xs)
+ (cond
+ [(null? xs) null]
+ [(string? (car xs)) (cons (terminal (car xs)) (make-prod (cdr xs)))]
+ [(symbol? (car xs)) (append (map non-terminal (symbol->list (car xs))) (make-prod (cdr xs)))]
+ [else (error "Invalid syntax in production" xs)]))
+
+
+(define sample '(S ::= "" -- SS -- "(" S ")"))
+(define sample2 '(grammar S (S ::= "" -- SS -- "(" S ")" -- Q) (Q ::= "" -- QQ -- "[" Q "]")))
+(define sample3 '(grammar S
+ (S ::= A B -- D E)
+ (A ::= "a")
+ (B ::= "b" C)
+ (C ::= "c")
+ (D ::= "d" F)
+ (E ::= "e")
+ (F ::= "f" D)))
+
+(define (sample-grammar) (make-cfg sample3))
+
+;; zadanie 2
+
+;; korzystam z algorytmów przedstawionych w tej książce:
+;; https://bit.ly/3ev0NUA, konkretnie te ze stron 50-51
+;; Pozwoliłem sobie trochę zmienić przeznaczenie funkcji cfg-unreachable oraz cfg-unproductive
+;; Zamiast zwracać nieproduktywne nieterminale, zwracają właśnie produktywne
+;; i analogicznie w tym drugim. Po prostu taka implementacja jest dla mnie wygodniejsza,
+;; a jest bardzo nieistotną zmianą koncepcyjną.
+;; Stąd zmiana nazwy na cfg-productive oraz cfg-reachable
+
+;; cfg-productive działa w ten sposób:
+;; Jakiś nieterminal nazywamy produktywnym, jeśli ma co najmniej jedną produktywną zasadę
+;; Jakąś regułę nazywamy produktywną, jeśli składa się z terminali lub produktywnych nieterminali
+;; Jasno widać, że wg tej definicji te nieterminale, które nie są produktywne, są nieproduktywne
+;; wg definicji zadania, a cała reszta jest produktwna.
+
+;; Algorytm znajdowania produktywnych nieterminali:
+;; Mamy listę produktywnych nieterminali P, początkowo pustą
+;; 1. Stwórz nową listę P'
+;; 2. Przejdź po liście reguł
+;; -> jeśli dana reguła jest produktywna (wg P), dodaj jej nieterminal do P'
+;; 3. Jeśli P != P', zrób P := P' i wróć do 1.
+;; 4. Zwróć P
+
+;; Fajne w tym algorytmie jest to, że jeśli mamy jakiś nieterminal, którego
+;; używamy w jakiejś regule, ale ten nieterminal nie ma zdefiniowanej żadnej reguły,
+;; to nie zostanie oznaczony jako produktywny, co jest dla nas korzystne.
+
+;; Algorytm znajdowania osiągalnych nieterminali:
+;; Traktujemy nitereminale jak wierzchołki w grafie a reguły jako listy sąsiedztwa.
+;; Terminale są liśćmi, a nieterminale węzłami. Robimy po prostu DFSa z nieterminala
+;; startowego i węzły do których dotrzemy oznaczamy jako osiągalne.
+
+;; Wg papierka który tutaj podałem, jeśli najpierw usuniemy nieproduktywne nieterminale,
+;; a w następnej kolejności nieosiągalne, to nasza gramatyka stanie się regularna.
+;; Wydaje się to w miarę sensowne -- pierszy algorytm to takie odcinanie liści i odcyklanie
+;; grafu, a ten drugi to po prostu DFS.
+
+;; przydatne predykaty -- na productive-nt mam listę symboli niterminalnych
+;; (nie struktury non-terminal, tylko te symbole!)
+;; które wiem że są produktywne.
+;; productive? sprawdza, czy nietermial jest produktywny
+;; to drugie sprawdza czy reguła jest produktywna
+;; (czyli czy składa się z produktywnych nonterminali lub terminali)
+(define (productive? p productive-nt)
+ (or (terminal? p) (member (non-terminal-sym p) productive-nt)))
+(define (rule-productive? r productive-nt)
+ (andmap (lambda (x) (productive? x productive-nt)) r))
+
+;; zwraca listę produktywnych symboli (nie nonterminali!)
+(define (cfg-productive g)
+ (define (find-productive-nt productive-nt rules)
+ (cond
+ [(null? rules) (remove-duplicates productive-nt)]
+ [(rule-productive? (rule-xs (car rules)) productive-nt)
+ (find-productive-nt (cons (rule-nt (car rules)) productive-nt) (cdr rules))]
+ [else (find-productive-nt productive-nt (cdr rules))]))
+ (define (iter productive-nt)
+ (let ([new-prod-nt (find-productive-nt productive-nt (grammar-rules g))])
+ (if (equal? productive-nt new-prod-nt)
+ productive-nt
+ (iter new-prod-nt))))
+ (iter null))
+
+;; zwraca listę osiągalnych symboli
+(define (cfg-reachable g)
+ (define (iter verts vis)
+ (cond
+ [(null? verts) vis]
+ [(member (car verts) vis) (iter (cdr verts) vis)]
+ [else (iter (cdr verts) (dfs (car verts) vis))]))
+ (define (dfs v vis)
+ (let* ([rules (filter (lambda (r) (eq? (rule-nt r) v)) (grammar-rules g))]
+ [verts (append-map (lambda (r) (rule-xs r)) rules)]
+ [verts (filter non-terminal? verts)]
+ [verts (map non-terminal-sym verts)])
+ (iter verts (cons v vis))))
+ (dfs (grammar-start g) null))
+
+
+;; robi z gramatyki g gramatykę regularną
+(define (cfg-optimize g)
+ (let* ([productive-nt (cfg-productive g)]
+ [productive-rules (filter (lambda (r)
+ (rule-productive? (rule-xs r) productive-nt))
+ (grammar-rules g))]
+ [new-g (grammar (grammar-start g) productive-rules)] ; <----- nowa gramatyka, bez nieproduktywnych
+ [reachable-nt (cfg-reachable new-g)] ; reguł i symboli nieterminalnych
+ [res-g (grammar (grammar-start new-g) (filter ; <----- dobra gramatyka
+ (lambda (r) (member (rule-nt r) reachable-nt))
+ (grammar-rules new-g)))])
+ res-g))
+
+(define (test) (cfg-optimize (make-cfg sample3)))
+
+;; Pokazanie że symbole nie muszą być racketowymi symbolami :)
+(define (test2) (cfg-optimize
+ (grammar '()
+ (list (cons '() (list (terminal '())))
+ (cons '() (list (terminal "(") (non-terminal '()) (terminal ")")))
+ (cons '() (list (non-terminal '()) (non-terminal '())))))))
+ \ No newline at end of file
diff --git a/Semestr 2/racket/egzamin/zad3a.bak b/Semestr 2/racket/egzamin/zad3a.bak
new file mode 100644
index 0000000..81570d0
--- /dev/null
+++ b/Semestr 2/racket/egzamin/zad3a.bak
@@ -0,0 +1,298 @@
+#lang racket
+
+;; ZADANIE 3
+;; =========
+
+;; Z gramatykami bezkontekstowymi spotkaliście się już na Wstępie do
+;; Informatyki. W tym zadaniu potraktujemy je jako dane dla naszych
+;; programów.
+
+;; Przypomnijmy, że gramatyka bezkontekstowa składa się z
+;; · skończonego zbioru *symboli nieterminalnych*
+;; · skończonego zbioru *symboli terminalnych*
+;; · wybranego nieterminalnego symbolu startowego
+;; · zbioru *produkcji*, czyli par symbol nieterminalny - lista
+;; (potencjalnie pusta) symboli terminalnych lub nieterminalnych
+
+;; Słowo (ciąg symboli terminalnych) możemy wyprowadzić z gramatyki,
+;; jeśli możemy zacząć od ciągu składającego się z symbolu startowego
+;; możemy użyć skończonej liczby produkcji z gramatyki przepisując
+;; symbol nieterminalny na ciąg symboli mu odpowiadających (w danej
+;; produkcji).
+
+
+;; Przykład: poprawne nawiasowania
+
+;; Gramatyka składa się z jednego symbolu nieterminalnego, S (który
+;; jest oczywiście symbolem startowym) i dwóch symboli terminalnych
+;; "(" i ")", i zawiera następujące produkcje (zwyczajowo zapisywane
+;; przy użyciu strzałki; zwróćcie uwagę że pierwszy ciąg jest pusty!):
+;; S ->
+;; S -> SS
+;; S -> (S)
+
+;; W często spotykanej, bardziej zwięzłej, postaci BNF moglibyśmy tę
+;; gramatykę zapisać tak (dbając trochę bardziej o wizualne
+;; oddzielenie symboli terminalnych i nieterminalnych):
+;; S ::= "" | SS | "(" S ")"
+;; Mamy tu te same produkcje, ale tylko raz zapisujemy każdą z
+;; powtarzających się lewych stron.
+
+;; Z gramatyki tej da się wyprowadzić wszystkie poprawnie rozstawione
+;; ciągi nawiasów — zobaczmy jak wyprowadzić (na jeden ze sposobów)
+;; ciąg "(()())". Zaczynamy, jak zawsze, od słowa złożonego z symbolu
+;; startowego i przepisujemy:
+;; S -> (S) -> (SS) -> ((S)S) -> ((S)(S)) -> (()(S)) -> (()())
+
+
+;; Zadanie cz. 1
+
+;; Zdefiniuj reprezentację gramatyki jako typu danych w
+;; Rackecie. Warto zastanowić się co można uprościć względem definicji
+;; matematycznej — w szczególności możemy założyć że dowolne napisy
+;; (typu string) są ciągami symboli terminalnych, i że nie musimy
+;; podawać jawnie zbioru nieterminali; również reprezentacja produkcji
+;; gramatyki jako worka z parami wejście-wyjście niekoniecznie jest
+;; najwygodniejsza.
+
+;; Uwaga: w tym zadaniu nie wymagamy definiowania składni konkretnej i
+;; parsowania, ale bardzo polecamy wybranie jakiejś formy, żeby móc
+;; sensownie przetestować swoje rozwiązanie!
+
+
+;; "Optymalizacja" gramatyk
+
+;; Gramatyki, podobnie jak programy, piszą ludzie — może więc zdarzyć
+;; się że znajdą się tam śmieci. Mogą one mieć dwojaką formę: symboli
+;; nieterminalnych, których nie da się wyprowadzić z symbolu
+;; startowego, lub symboli nieterminalnych z których nie da się
+;; wyprowadzić żadnego słowa terminalnego (tj. niezawierającego
+;; symboli nieterminalnych). Przykładowo, do naszej gramatyki
+;; moglibyśmy dodać symbole P i Q, i produkcje:
+;; S -> ")(" P
+;; P -> PP "qed"
+;; Q -> "abc"
+
+;; Mimo że nasza gramatyka wygląda inaczej na pierwszy rzut oka, tak
+;; naprawdę się nie zmieniła: do symbolu Q nie możemy dojść z symbolu
+;; S, a więc "abc" nigdy nie wystąpi w słowie wyprowadzalnym z
+;; gramatyki. Analogicznie, z P nie da się wyprowadzić żadnego słowa,
+;; które nie zawierałoby symbolu P — a zatem żadnego słowa złożonego
+;; tylko z symboli terminalnych. To znaczy, że naszą gramatykę możemy
+;; uprościć wyrzucając z niej symbole nieterminalne (i produkcje które
+;; ich używają) do których nie da się dojść (tj. są *nieosiągalne*) i
+;; te, z których nie da się ułożyć słowa terminalnego (tj. są
+;; *nieproduktywne*). Jeśli z naszej rozszerzonej gramatyki wyrzucimy
+;; takie symbole, dostaniemy oczywiście gramatykę początkową.
+
+
+;; Zadanie cz. 2
+
+;; Dla swojej reprezentacji gramatyki z poprzedniej części zadania
+;; napisz dwie procedury: cfg-unreachable, znajdującą symbole
+;; nieterminalne które są nieosiągalne z symbolu startowego, i
+;; cfg-unproductive, znajdującą symbole nieterminalne które nie są
+;; produktywne. Następnie użyj tych procedur żeby zdefiniować
+;; procedurę cfg-optimize, która uprości daną gramatykę usuwając z
+;; niej symbole nieosiągalne i nieproduktywne, a także odpowiednie
+;; produkcje.
+
+;; Rozwiązanie wpisz w poniższym pliku, i opatrz komentarzem
+;; opisującym wybraną reprezentację (i podjęte przy jej projektowaniu
+;; decyzje), a także zaimplementowane w cz. 2. algorytmy.
+
+
+
+
+
+
+;; Zadanie 1
+
+;; Postanowiłem napisać parser, bo bez tego zadanie wydaje mi się dosyć ubogie
+;; Składnia konkretna naszych gramatyk wygląda bardzo podobnie do zapisu
+;; przedstawionego w treści zadania.
+;; np. gramatyka nawiasowania będzie wyglądać następująco:
+;; '(grammar S (S ::= "" -- SS -- "(" S ")"))
+;; ale mogłaby wyglądać też tak:
+;; '(grammar S (S ::= "") (S ::= SS -- "(" S ")"))
+;; a np. ta nieciekawa gramatyka przedstawiona w treści zadania:
+;; '(grammar S (S ::= "] [" P) (P ::= PP "qed") (Q ::= "abc"))
+;; Zatem będzie to lista, która na pierwszym miejscu ma symbol 'grammar
+;; na drugim miejscu ma symbol startowy
+;; następnie następuje lista produkcji w formacie:
+;; <non-terminal> ::= <lista produkcji, produkcje oddzielone są separatorem -->
+;; Zalety:
+;; - rozróżnienie w składni konkretnej symboli nieterminalnych i terminalnych
+;; przez użycie symboli i stringów pozwala na to, aby symbole terminalne nazywały się tak
+;; jak terminalne, tj. "S" nie jest tym samym co 'S.
+;; - składnia wydaje się bardzo wygodna w użyciu, nie ma też problemu, żeby później dopisać
+;; dodatkowe produkcje dla jednego symbolu nieterminalnego, np. (S ::= "") (S ::= SS)
+;; - parser jest łatwy w implementacji
+;; Wady:
+;; - symbole nieterminalne mogą składać się jedynie z jednego symbolu, zatem nie możemy robić ich
+;; zbyt wiele
+
+;; Reprezentacja gramatyki: podczas parsowania gramatyki symbole i stringi wewnątrz produkcji
+;; reprezentowane są przez struktury terminal oraz non-terminal. Cała gramatyka to
+;; struktura dwuelementowa - pierwszym jest symbol startowy, a drugim lista par <symbol . produkcja>
+;; Taka decyzja właśnie pozwoliła na to, że zaproponowana przeze mnie składania konkretna jest
+;; bardzo prosta do sparsowania - wystarczy każdą produkcję podzielić ze względu na separator '--
+;; i do czegoś podobnego do środowisk dodawać po prostu odpowiednie pary.
+;; dla przykładu taka gramatyka:
+;; '(grammar S (S ::= "" -- SS -- "(" S ")" -- Q) (Q ::= "" -- QS -- "[" Q "]"))
+;; będzie reprezentowana następująco:
+;; (grammar
+;; 'S
+;; (production
+;; (list
+;; (list 'S (terminal ""))
+;; (list 'S (non-terminal 'S) (non-terminal 'S))
+;; (list 'S (terminal "(") (non-terminal 'S) (terminal ")"))
+;; (list 'S (non-terminal 'Q))
+;; (list 'Q (terminal ""))
+;; (list 'Q (non-terminal 'Q) (non-terminal 'S))
+;; (list 'Q (terminal "[") (non-terminal 'Q) (terminal "]")))))
+;; Prosze zauważyć, że np. SS zostało zamienione na dwa sąsiednie nieterminalne symbole S
+;; (to właśnie powód, dlaczego symbole nieterminalne mogą być jedynie jednoznakowe).
+
+;; Zdecydowałem się dodać strukturę production, bo wtedy łatwo można na niej operować
+;; pisząc funkcje production-add, czy production-lookup itp.
+
+
+(struct non-terminal (sym) #:transparent)
+(struct terminal (sym) #:transparent)
+(struct grammar (start rules) #:transparent)
+
+(define SEPARATOR '--)
+
+(define (split-at-symb symb xs)
+ (define (iter left right)
+ (cond
+ [(null? right) (cons left null)]
+ [(eq? symb (car right)) (cons left (cdr right))]
+ [else (iter (cons (car right) left) (cdr right))]))
+ (let ([res (iter null xs)])
+ (cons (reverse (car res)) (cdr res))))
+
+(define (split-by-separator xs)
+ (let ([res (split-at-symb SEPARATOR xs)])
+ (if (null? (cdr res))
+ res
+ (cons (car res) (split-by-separator (cdr res))))))
+
+(define (make-cfg q)
+ (cond
+ [(and (list? q) (eq? 'grammar (first q)))
+ (grammar (second q) (append-map make-cfg (cddr q)))]
+ [(and (list? q) (eq? '::= (second q)))
+ (let ([nt (first q)]
+ [rules (split-by-separator (cddr q))])
+ (map (lambda (x) (cons nt x)) (map make-prod rules)))]))
+
+(define (symbol->list s)
+ (map string->symbol
+ (map string
+ (string->list (symbol->string s)))))
+
+(define (make-prod xs)
+ (cond
+ [(null? xs) null]
+ [(string? (car xs)) (cons (terminal (car xs)) (make-prod (cdr xs)))]
+ [(symbol? (car xs)) (append (map non-terminal (symbol->list (car xs))) (make-prod (cdr xs)))]
+ [else (error "Invalid syntax in production" xs)]))
+
+
+(define sample '(S ::= "" -- SS -- "(" S ")"))
+(define sample2 '(grammar S (S ::= "" -- SS -- "(" S ")" -- Q) (Q ::= "" -- QQ -- "[" Q "]")))
+(define sample3 '(grammar S
+ (S ::= A B -- D E)
+ (A ::= "a")
+ (B ::= "b" C)
+ (C ::= "c")
+ (D ::= "d" F)
+ (E ::= "e")
+ (F ::= "f" D)))
+
+;; zadanie 2
+
+;; korzystam z algorytmów przedstawionych w tej książce:
+;; https://bit.ly/3ev0NUA, konkretnie te ze stron 50-51
+;; Pozwoliłem sobie trochę zmienić przeznaczenie funkcji cfg-unreachable oraz cfg-unproductive
+;; Zamiast zwracać nieproduktywne nieterminale, zwracają właśnie produktywne
+;; i analogicznie w tym drugim. Po prostu taka implementacja jest dla mnie wygodniejsza,
+;; a jest bardzo nieistotną zmianą koncepcyjną.
+;; Stąd zmiana nazwy na cfg-productive oraz cfg-reachable
+
+;; cfg-productive działa w ten sposób:
+;; Jakiś nieterminal nazywamy produktywnym, jeśli ma co najmniej jedną produktywną zasadę
+;; Jakąś zasadę nazywamy produktywną, jeśli składa się z terminali oraz produktywnych nieterminali
+;; Jasno widać, że wg tej definicji te nieterminale, które nie są produktywne, są nieproduktywne
+;; wg definicji zadania, a cała reszta jest produktwna.
+
+;; Algorytm znajdowania produktywnych nieterminali:
+;; Mamy listę produktywnych nieterminali P, początkowo pustą
+;; 1. Stwórz nową listę P'
+;; 2. Przejdź po liście produkcji
+;; -> jeśli dana produkcja jest produktywna (wg P), dodaj jej nieterminal do P'
+;; 3. Jeśli P != P', zrób P := P' i wróć do 1.
+;; 4. Zwróć P
+
+;; Fajne w tym algorytmie jest to, że jeśli mamy jakiś nieterminal, którego
+;; używamy w jakiejś produkcji, ale ten nieterminal nie ma zdefiniowanej swojej produkcji
+;; to nie zostanie oznaczony jako produktywny, co jest dla nas korzystne
+
+;; Algorytm znajdowania osiągalnych nieterminali:
+;; Traktujemy nitereminale jak wierzchołki w grafie a zasady jako listy sąsiedztwa.
+;; Terminale są liśćmi, a nieterminale węzłami. Robimy po prostu DFSa z nieterminalu
+;; startowego i węzły do których dotrzemy oznaczamy jako osiągalne.
+
+;; Wg papierka który tutaj podałem, jeśli najpierw usuniemy nieproduktywne nieterminale,
+;; a w następnej kolejności nieosiągalne, to nasza gramatyka stanie się regularna.
+
+(define (productive? p productive-nt)
+ (or (terminal? p) (member (non-terminal-sym p) productive-nt)))
+(define (rule-productive? r productive-nt)
+ (andmap (lambda (x) (productive? x productive-nt)) r))
+
+(define (cfg-productive g)
+ (define (find-productive-nt productive-nt rules)
+ (cond
+ [(null? rules) (remove-duplicates productive-nt)]
+ [(rule-productive? (cdar rules) productive-nt)
+ (find-productive-nt (cons (caar rules) productive-nt) (cdr rules))]
+ [else (find-productive-nt productive-nt (cdr rules))]))
+ (define (iter productive-nt)
+ (let ([new-prod-nt (find-productive-nt productive-nt (grammar-rules g))])
+ (if (equal? productive-nt new-prod-nt)
+ productive-nt
+ (iter new-prod-nt))))
+ (iter null))
+
+(define (cfg-reachable g)
+ (define (iter verts vis)
+ (cond
+ [(null? verts) vis]
+ [(member (car verts) vis) (iter (cdr verts) vis)]
+ [else (iter (cdr verts) (dfs (car verts) vis))]))
+ (define (dfs v vis)
+ (display v)
+ (newline)
+ (let* ([rules (filter (lambda (r) (eq? (car r) v)) (grammar-rules g))]
+ [verts (append-map (lambda (r) (cdr r)) rules)]
+ [verts (filter non-terminal? verts)]
+ [verts (map non-terminal-sym verts)])
+ (iter verts (cons v vis))))
+ (dfs (grammar-start g) null))
+
+(define (cfg-optimize g)
+ (let* ([productive-nt (cfg-productive g)]
+ [productive-rules (filter (lambda (r)
+ (rule-productive? (cdr r) productive-nt))
+ (grammar-rules g))]
+ [new-g (grammar (grammar-start g) productive-rules)]
+ [reachable-nt (cfg-reachable new-g)]
+ [res-g (grammar (grammar-start new-g) (filter
+ (lambda (r) (member (car r) reachable-nt))
+ (grammar-rules new-g)))])
+ res-g))
+ \ No newline at end of file
diff --git a/Semestr 2/racket/egzamin/zad3a.rkt b/Semestr 2/racket/egzamin/zad3a.rkt
new file mode 100644
index 0000000..eaa6645
--- /dev/null
+++ b/Semestr 2/racket/egzamin/zad3a.rkt
@@ -0,0 +1,301 @@
+#lang racket
+
+;; ZADANIE 3
+;; =========
+
+;; Z gramatykami bezkontekstowymi spotkaliście się już na Wstępie do
+;; Informatyki. W tym zadaniu potraktujemy je jako dane dla naszych
+;; programów.
+
+;; Przypomnijmy, że gramatyka bezkontekstowa składa się z
+;; · skończonego zbioru *symboli nieterminalnych*
+;; · skończonego zbioru *symboli terminalnych*
+;; · wybranego nieterminalnego symbolu startowego
+;; · zbioru *produkcji*, czyli par symbol nieterminalny - lista
+;; (potencjalnie pusta) symboli terminalnych lub nieterminalnych
+
+;; Słowo (ciąg symboli terminalnych) możemy wyprowadzić z gramatyki,
+;; jeśli możemy zacząć od ciągu składającego się z symbolu startowego
+;; możemy użyć skończonej liczby produkcji z gramatyki przepisując
+;; symbol nieterminalny na ciąg symboli mu odpowiadających (w danej
+;; produkcji).
+
+
+;; Przykład: poprawne nawiasowania
+
+;; Gramatyka składa się z jednego symbolu nieterminalnego, S (który
+;; jest oczywiście symbolem startowym) i dwóch symboli terminalnych
+;; "(" i ")", i zawiera następujące produkcje (zwyczajowo zapisywane
+;; przy użyciu strzałki; zwróćcie uwagę że pierwszy ciąg jest pusty!):
+;; S ->
+;; S -> SS
+;; S -> (S)
+
+;; W często spotykanej, bardziej zwięzłej, postaci BNF moglibyśmy tę
+;; gramatykę zapisać tak (dbając trochę bardziej o wizualne
+;; oddzielenie symboli terminalnych i nieterminalnych):
+;; S ::= "" | SS | "(" S ")"
+;; Mamy tu te same produkcje, ale tylko raz zapisujemy każdą z
+;; powtarzających się lewych stron.
+
+;; Z gramatyki tej da się wyprowadzić wszystkie poprawnie rozstawione
+;; ciągi nawiasów — zobaczmy jak wyprowadzić (na jeden ze sposobów)
+;; ciąg "(()())". Zaczynamy, jak zawsze, od słowa złożonego z symbolu
+;; startowego i przepisujemy:
+;; S -> (S) -> (SS) -> ((S)S) -> ((S)(S)) -> (()(S)) -> (()())
+
+
+;; Zadanie cz. 1
+
+;; Zdefiniuj reprezentację gramatyki jako typu danych w
+;; Rackecie. Warto zastanowić się co można uprościć względem definicji
+;; matematycznej — w szczególności możemy założyć że dowolne napisy
+;; (typu string) są ciągami symboli terminalnych, i że nie musimy
+;; podawać jawnie zbioru nieterminali; również reprezentacja produkcji
+;; gramatyki jako worka z parami wejście-wyjście niekoniecznie jest
+;; najwygodniejsza.
+
+;; Uwaga: w tym zadaniu nie wymagamy definiowania składni konkretnej i
+;; parsowania, ale bardzo polecamy wybranie jakiejś formy, żeby móc
+;; sensownie przetestować swoje rozwiązanie!
+
+
+;; "Optymalizacja" gramatyk
+
+;; Gramatyki, podobnie jak programy, piszą ludzie — może więc zdarzyć
+;; się że znajdą się tam śmieci. Mogą one mieć dwojaką formę: symboli
+;; nieterminalnych, których nie da się wyprowadzić z symbolu
+;; startowego, lub symboli nieterminalnych z których nie da się
+;; wyprowadzić żadnego słowa terminalnego (tj. niezawierającego
+;; symboli nieterminalnych). Przykładowo, do naszej gramatyki
+;; moglibyśmy dodać symbole P i Q, i produkcje:
+;; S -> ")(" P
+;; P -> PP "qed"
+;; Q -> "abc"
+
+;; Mimo że nasza gramatyka wygląda inaczej na pierwszy rzut oka, tak
+;; naprawdę się nie zmieniła: do symbolu Q nie możemy dojść z symbolu
+;; S, a więc "abc" nigdy nie wystąpi w słowie wyprowadzalnym z
+;; gramatyki. Analogicznie, z P nie da się wyprowadzić żadnego słowa,
+;; które nie zawierałoby symbolu P — a zatem żadnego słowa złożonego
+;; tylko z symboli terminalnych. To znaczy, że naszą gramatykę możemy
+;; uprościć wyrzucając z niej symbole nieterminalne (i produkcje które
+;; ich używają) do których nie da się dojść (tj. są *nieosiągalne*) i
+;; te, z których nie da się ułożyć słowa terminalnego (tj. są
+;; *nieproduktywne*). Jeśli z naszej rozszerzonej gramatyki wyrzucimy
+;; takie symbole, dostaniemy oczywiście gramatykę początkową.
+
+
+;; Zadanie cz. 2
+
+;; Dla swojej reprezentacji gramatyki z poprzedniej części zadania
+;; napisz dwie procedury: cfg-unreachable, znajdującą symbole
+;; nieterminalne które są nieosiągalne z symbolu startowego, i
+;; cfg-unproductive, znajdującą symbole nieterminalne które nie są
+;; produktywne. Następnie użyj tych procedur żeby zdefiniować
+;; procedurę cfg-optimize, która uprości daną gramatykę usuwając z
+;; niej symbole nieosiągalne i nieproduktywne, a także odpowiednie
+;; produkcje.
+
+;; Rozwiązanie wpisz w poniższym pliku, i opatrz komentarzem
+;; opisującym wybraną reprezentację (i podjęte przy jej projektowaniu
+;; decyzje), a także zaimplementowane w cz. 2. algorytmy.
+
+
+
+
+
+
+;; Zadanie 1
+
+;; Postanowiłem napisać parser, bo bez tego zadanie wydaje mi się dosyć ubogie
+;; Składnia konkretna naszych gramatyk wygląda bardzo podobnie do zapisu
+;; przedstawionego w treści zadania.
+;; np. gramatyka nawiasowania będzie wyglądać następująco:
+;; '(grammar S (S ::= "" -- SS -- "(" S ")"))
+;; ale mogłaby wyglądać też tak:
+;; '(grammar S (S ::= "") (S ::= SS -- "(" S ")"))
+;; a np. ta nieciekawa gramatyka przedstawiona w treści zadania:
+;; '(grammar S (S ::= "] [" P) (P ::= PP "qed") (Q ::= "abc"))
+;; Zatem będzie to lista, która na pierwszym miejscu ma symbol 'grammar
+;; na drugim miejscu ma symbol startowy
+;; następnie następuje lista produkcji w formacie:
+;; <non-terminal> ::= <lista produkcji, produkcje oddzielone są separatorem -->
+;; Zalety:
+;; - rozróżnienie w składni konkretnej symboli nieterminalnych i terminalnych
+;; przez użycie symboli i stringów pozwala na to, aby symbole terminalne nazywały się tak
+;; jak terminalne, tj. "S" nie jest tym samym co 'S.
+;; - składnia wydaje się bardzo wygodna w użyciu, nie ma też problemu, żeby później dopisać
+;; dodatkowe produkcje dla jednego symbolu nieterminalnego, np. (S ::= "") (S ::= SS)
+;; - parser jest łatwy w implementacji
+;; Wady:
+;; - symbole nieterminalne mogą składać się jedynie z jednego symbolu, zatem nie możemy robić ich
+;; zbyt wiele
+
+;; Reprezentacja gramatyki: podczas parsowania gramatyki symbole i stringi wewnątrz produkcji
+;; reprezentowane są przez struktury terminal oraz non-terminal. Cała gramatyka to
+;; struktura dwuelementowa - pierwszym jest symbol startowy, a drugim lista par <symbol . produkcja>
+;; Taka decyzja właśnie pozwoliła na to, że zaproponowana przeze mnie składania konkretna jest
+;; bardzo prosta do sparsowania - wystarczy każdą produkcję podzielić ze względu na separator '--
+;; i do czegoś podobnego do środowisk dodawać po prostu odpowiednie pary.
+;; dla przykładu taka gramatyka:
+;; '(grammar S (S ::= "" -- SS -- "(" S ")" -- Q) (Q ::= "" -- QS -- "[" Q "]"))
+;; będzie reprezentowana następująco:
+;; (grammar
+;; 'S
+;; (production
+;; (list
+;; (list 'S (terminal ""))
+;; (list 'S (non-terminal 'S) (non-terminal 'S))
+;; (list 'S (terminal "(") (non-terminal 'S) (terminal ")"))
+;; (list 'S (non-terminal 'Q))
+;; (list 'Q (terminal ""))
+;; (list 'Q (non-terminal 'Q) (non-terminal 'S))
+;; (list 'Q (terminal "[") (non-terminal 'Q) (terminal "]")))))
+;; Prosze zauważyć, że np. SS zostało zamienione na dwa sąsiednie nieterminalne symbole S
+;; (to właśnie powód, dlaczego symbole nieterminalne mogą być jedynie jednoznakowe).
+
+;; Zdecydowałem się dodać strukturę production, bo wtedy łatwo można na niej operować
+;; pisząc funkcje production-add, czy production-lookup itp.
+
+
+(struct non-terminal (sym) #:transparent)
+(struct terminal (sym) #:transparent)
+(struct grammar (start rules) #:transparent)
+
+(define SEPARATOR '--)
+
+(define (make-cfg q)
+ (cond
+ [(and (list? q) (eq? 'grammar (first q)))
+ (grammar (second q) (append-map make-cfg (cddr q)))]
+ [(and (list? q) (eq? '::= (second q)))
+ (let ([nt (first q)]
+ [rules (split-by-separator (cddr q))])
+ (map (lambda (x) (cons nt x)) (map make-rules rules)))]
+ [else (error "MAKE-CFG -- Parse error, unknown token" q)]))
+
+(define (make-cfg start rules)
+ (grammar start (make-rules rules)))
+
+(define (make-rules xs)
+ (cond
+ [(null? xs) null]
+ [(string? (car xs)) (cons (terminal (car xs)) (make-rules (cdr xs)))]
+ [(symbol? (car xs)) (append (map non-terminal (symbol->list (car xs))) (make-rules (cdr xs)))]
+ [else (error "Invalid syntax in production" xs)]))
+
+(define (split-at-symb symb xs)
+ (define (iter left right)
+ (cond
+ [(null? right) (cons left null)]
+ [(eq? symb (car right)) (cons left (cdr right))]
+ [else (iter (cons (car right) left) (cdr right))]))
+ (let ([res (iter null xs)])
+ (cons (reverse (car res)) (cdr res))))
+
+(define (split-by-separator xs)
+ (let ([res (split-at-symb SEPARATOR xs)])
+ (if (null? (cdr res))
+ res
+ (cons (car res) (split-by-separator (cdr res))))))
+
+(define (symbol->list s)
+ (map string->symbol
+ (map string
+ (string->list (symbol->string s)))))
+
+(define sample '(S ::= "" -- SS -- "(" S ")"))
+(define sample2 '(grammar S (S ::= "" -- SS -- "(" S ")" -- Q) (Q ::= "" -- QQ -- "[" Q "]")))
+(define sample3 '(grammar S
+ (S ::= A B -- D E)
+ (A ::= "a")
+ (B ::= "b" C)
+ (C ::= "c")
+ (D ::= "d" F)
+ (E ::= "e")
+ (F ::= "f" D)))
+
+;; zadanie 2
+
+;; korzystam z algorytmów przedstawionych w tej książce:
+;; https://bit.ly/3ev0NUA, konkretnie te ze stron 50-51
+;; Pozwoliłem sobie trochę zmienić przeznaczenie funkcji cfg-unreachable oraz cfg-unproductive
+;; Zamiast zwracać nieproduktywne nieterminale, zwracają właśnie produktywne
+;; i analogicznie w tym drugim. Po prostu taka implementacja jest dla mnie wygodniejsza,
+;; a jest bardzo nieistotną zmianą koncepcyjną.
+;; Stąd zmiana nazwy na cfg-productive oraz cfg-reachable
+
+;; cfg-productive działa w ten sposób:
+;; Jakiś nieterminal nazywamy produktywnym, jeśli ma co najmniej jedną produktywną zasadę
+;; Jakąś zasadę nazywamy produktywną, jeśli składa się z terminali oraz produktywnych nieterminali
+;; Jasno widać, że wg tej definicji te nieterminale, które nie są produktywne, są nieproduktywne
+;; wg definicji zadania, a cała reszta jest produktwna.
+
+;; Algorytm znajdowania produktywnych nieterminali:
+;; Mamy listę produktywnych nieterminali P, początkowo pustą
+;; 1. Stwórz nową listę P'
+;; 2. Przejdź po liście produkcji
+;; -> jeśli dana produkcja jest produktywna (wg P), dodaj jej nieterminal do P'
+;; 3. Jeśli P != P', zrób P := P' i wróć do 1.
+;; 4. Zwróć P
+
+;; Fajne w tym algorytmie jest to, że jeśli mamy jakiś nieterminal, którego
+;; używamy w jakiejś produkcji, ale ten nieterminal nie ma zdefiniowanej swojej produkcji
+;; to nie zostanie oznaczony jako produktywny, co jest dla nas korzystne
+
+;; Algorytm znajdowania osiągalnych nieterminali:
+;; Traktujemy nitereminale jak wierzchołki w grafie a zasady jako listy sąsiedztwa.
+;; Terminale są liśćmi, a nieterminale węzłami. Robimy po prostu DFSa z nieterminalu
+;; startowego i węzły do których dotrzemy oznaczamy jako osiągalne.
+
+;; Wg papierka który tutaj podałem, jeśli najpierw usuniemy nieproduktywne nieterminale,
+;; a w następnej kolejności nieosiągalne, to nasza gramatyka stanie się regularna.
+
+(define (productive? p productive-nt)
+ (or (terminal? p) (member (non-terminal-sym p) productive-nt)))
+(define (rule-productive? r productive-nt)
+ (andmap (lambda (x) (productive? x productive-nt)) r))
+
+(define (cfg-productive g)
+ (define (find-productive-nt productive-nt rules)
+ (cond
+ [(null? rules) (remove-duplicates productive-nt)]
+ [(rule-productive? (cdar rules) productive-nt)
+ (find-productive-nt (cons (caar rules) productive-nt) (cdr rules))]
+ [else (find-productive-nt productive-nt (cdr rules))]))
+ (define (iter productive-nt)
+ (let ([new-prod-nt (find-productive-nt productive-nt (grammar-rules g))])
+ (if (equal? productive-nt new-prod-nt)
+ productive-nt
+ (iter new-prod-nt))))
+ (iter null))
+
+(define (cfg-reachable g)
+ (define (iter verts vis)
+ (cond
+ [(null? verts) vis]
+ [(member (car verts) vis) (iter (cdr verts) vis)]
+ [else (iter (cdr verts) (dfs (car verts) vis))]))
+ (define (dfs v vis)
+ (display v)
+ (newline)
+ (let* ([rules (filter (lambda (r) (eq? (car r) v)) (grammar-rules g))]
+ [verts (append-map (lambda (r) (cdr r)) rules)]
+ [verts (filter non-terminal? verts)]
+ [verts (map non-terminal-sym verts)])
+ (iter verts (cons v vis))))
+ (dfs (grammar-start g) null))
+
+(define (cfg-optimize g)
+ (let* ([productive-nt (cfg-productive g)]
+ [productive-rules (filter (lambda (r)
+ (rule-productive? (cdr r) productive-nt))
+ (grammar-rules g))]
+ [new-g (grammar (grammar-start g) productive-rules)]
+ [reachable-nt (cfg-reachable new-g)]
+ [res-g (grammar (grammar-start new-g) (filter
+ (lambda (r) (member (car r) reachable-nt))
+ (grammar-rules new-g)))])
+ res-g))
+ \ No newline at end of file