diff options
Diffstat (limited to 'Semestr 2/racket/egzamin')
| -rw-r--r-- | Semestr 2/racket/egzamin/rozw2.txt | 1 | ||||
| -rw-r--r-- | Semestr 2/racket/egzamin/zad1.bak | 1 | ||||
| -rw-r--r-- | Semestr 2/racket/egzamin/zad1.rkt | 300 | ||||
| -rw-r--r-- | Semestr 2/racket/egzamin/zad1a.bak | 300 | ||||
| -rw-r--r-- | Semestr 2/racket/egzamin/zad1a.rkt | 314 | ||||
| -rw-r--r-- | Semestr 2/racket/egzamin/zad1b.bak | 314 | ||||
| -rw-r--r-- | Semestr 2/racket/egzamin/zad1b.rkt | 482 | ||||
| -rw-r--r-- | Semestr 2/racket/egzamin/zad2.bak | 119 | ||||
| -rw-r--r-- | Semestr 2/racket/egzamin/zad2.rkt | 186 | ||||
| -rw-r--r-- | Semestr 2/racket/egzamin/zad3.bak | 4 | ||||
| -rw-r--r-- | Semestr 2/racket/egzamin/zad3.rkt | 347 | ||||
| -rw-r--r-- | Semestr 2/racket/egzamin/zad3a.bak | 298 | ||||
| -rw-r--r-- | Semestr 2/racket/egzamin/zad3a.rkt | 301 |
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 |