From c5fcf7179a83ef65c86c6a4a390029149e518649 Mon Sep 17 00:00:00 2001 From: Franciszek Malinka Date: Tue, 5 Oct 2021 21:49:54 +0200 Subject: Duzy commit ze smieciami --- Semestr 2/racket/egzamin/rozw2.txt | 1 - Semestr 2/racket/egzamin/zad1.bak | 1 - Semestr 2/racket/egzamin/zad1.rkt | 300 ----------------------- Semestr 2/racket/egzamin/zad1a.bak | 300 ----------------------- Semestr 2/racket/egzamin/zad1a.rkt | 314 ------------------------ Semestr 2/racket/egzamin/zad1b.bak | 314 ------------------------ Semestr 2/racket/egzamin/zad1b.rkt | 482 ------------------------------------- Semestr 2/racket/egzamin/zad2.bak | 119 --------- Semestr 2/racket/egzamin/zad2.rkt | 186 -------------- Semestr 2/racket/egzamin/zad3.bak | 4 - Semestr 2/racket/egzamin/zad3.rkt | 347 -------------------------- Semestr 2/racket/egzamin/zad3a.bak | 298 ----------------------- Semestr 2/racket/egzamin/zad3a.rkt | 301 ----------------------- 13 files changed, 2967 deletions(-) delete mode 100644 Semestr 2/racket/egzamin/rozw2.txt delete mode 100644 Semestr 2/racket/egzamin/zad1.bak delete mode 100644 Semestr 2/racket/egzamin/zad1.rkt delete mode 100644 Semestr 2/racket/egzamin/zad1a.bak delete mode 100644 Semestr 2/racket/egzamin/zad1a.rkt delete mode 100644 Semestr 2/racket/egzamin/zad1b.bak delete mode 100644 Semestr 2/racket/egzamin/zad1b.rkt delete mode 100644 Semestr 2/racket/egzamin/zad2.bak delete mode 100644 Semestr 2/racket/egzamin/zad2.rkt delete mode 100644 Semestr 2/racket/egzamin/zad3.bak delete mode 100644 Semestr 2/racket/egzamin/zad3.rkt delete mode 100644 Semestr 2/racket/egzamin/zad3a.bak delete mode 100644 Semestr 2/racket/egzamin/zad3a.rkt (limited to 'Semestr 2/racket/egzamin') diff --git a/Semestr 2/racket/egzamin/rozw2.txt b/Semestr 2/racket/egzamin/rozw2.txt deleted file mode 100644 index a70232e..0000000 --- a/Semestr 2/racket/egzamin/rozw2.txt +++ /dev/null @@ -1 +0,0 @@ -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 deleted file mode 100644 index 6f1f7b4..0000000 --- a/Semestr 2/racket/egzamin/zad1.bak +++ /dev/null @@ -1 +0,0 @@ -#lang racket diff --git a/Semestr 2/racket/egzamin/zad1.rkt b/Semestr 2/racket/egzamin/zad1.rkt deleted file mode 100644 index a90d2fd..0000000 --- a/Semestr 2/racket/egzamin/zad1.rkt +++ /dev/null @@ -1,300 +0,0 @@ -#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 deleted file mode 100644 index a90d2fd..0000000 --- a/Semestr 2/racket/egzamin/zad1a.bak +++ /dev/null @@ -1,300 +0,0 @@ -#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 deleted file mode 100644 index a587359..0000000 --- a/Semestr 2/racket/egzamin/zad1a.rkt +++ /dev/null @@ -1,314 +0,0 @@ -#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 deleted file mode 100644 index a587359..0000000 --- a/Semestr 2/racket/egzamin/zad1b.bak +++ /dev/null @@ -1,314 +0,0 @@ -#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 deleted file mode 100644 index 628619f..0000000 --- a/Semestr 2/racket/egzamin/zad1b.rkt +++ /dev/null @@ -1,482 +0,0 @@ -#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 deleted file mode 100644 index 02e2ae0..0000000 --- a/Semestr 2/racket/egzamin/zad2.bak +++ /dev/null @@ -1,119 +0,0 @@ -#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 deleted file mode 100644 index e549f07..0000000 --- a/Semestr 2/racket/egzamin/zad2.rkt +++ /dev/null @@ -1,186 +0,0 @@ -#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 deleted file mode 100644 index 20115e9..0000000 --- a/Semestr 2/racket/egzamin/zad3.bak +++ /dev/null @@ -1,4 +0,0 @@ -#lang racket - - - diff --git a/Semestr 2/racket/egzamin/zad3.rkt b/Semestr 2/racket/egzamin/zad3.rkt deleted file mode 100644 index 9bfed02..0000000 --- a/Semestr 2/racket/egzamin/zad3.rkt +++ /dev/null @@ -1,347 +0,0 @@ -#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: -;; ::= -;; 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 deleted file mode 100644 index 81570d0..0000000 --- a/Semestr 2/racket/egzamin/zad3a.bak +++ /dev/null @@ -1,298 +0,0 @@ -#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: -;; ::= -;; 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 -;; 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 deleted file mode 100644 index eaa6645..0000000 --- a/Semestr 2/racket/egzamin/zad3a.rkt +++ /dev/null @@ -1,301 +0,0 @@ -#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: -;; ::= -;; 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 -;; 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 -- cgit v1.2.3