From 9477dbe667f250ecd23f8fc0d56b942191526421 Mon Sep 17 00:00:00 2001 From: Franciszek Malinka Date: Thu, 25 Feb 2021 14:42:55 +0100 Subject: Stare semestry, niepoukladane --- Semestr 2/racket/lista6/lista8/kappa.py | 13 +++ Semestr 2/racket/lista6/lista8/zad1.bak | 98 +++++++++++++++++ Semestr 2/racket/lista6/lista8/zad1.rkt | 104 ++++++++++++++++++ Semestr 2/racket/lista6/lista8/zad4.bak | 114 +++++++++++++++++++ Semestr 2/racket/lista6/lista8/zad4.rkt | 118 ++++++++++++++++++++ Semestr 2/racket/lista6/lista8/zad5.bak | 1 + Semestr 2/racket/lista6/lista8/zad5.rkt | 151 +++++++++++++++++++++++++ Semestr 2/racket/lista6/lista8/zad6.bak | 151 +++++++++++++++++++++++++ Semestr 2/racket/lista6/lista8/zad6.rkt | 171 +++++++++++++++++++++++++++++ Semestr 2/racket/lista6/lista8/zadanie.rkt | 98 +++++++++++++++++ 10 files changed, 1019 insertions(+) create mode 100644 Semestr 2/racket/lista6/lista8/kappa.py create mode 100644 Semestr 2/racket/lista6/lista8/zad1.bak create mode 100644 Semestr 2/racket/lista6/lista8/zad1.rkt create mode 100644 Semestr 2/racket/lista6/lista8/zad4.bak create mode 100644 Semestr 2/racket/lista6/lista8/zad4.rkt create mode 100644 Semestr 2/racket/lista6/lista8/zad5.bak create mode 100644 Semestr 2/racket/lista6/lista8/zad5.rkt create mode 100644 Semestr 2/racket/lista6/lista8/zad6.bak create mode 100644 Semestr 2/racket/lista6/lista8/zad6.rkt create mode 100644 Semestr 2/racket/lista6/lista8/zadanie.rkt (limited to 'Semestr 2/racket/lista6/lista8') diff --git a/Semestr 2/racket/lista6/lista8/kappa.py b/Semestr 2/racket/lista6/lista8/kappa.py new file mode 100644 index 0000000..f359d5c --- /dev/null +++ b/Semestr 2/racket/lista6/lista8/kappa.py @@ -0,0 +1,13 @@ +import pylab + +a = int(input("podaj liczbe: ")) +b = int(input("podaj liczbe: ")) + +x = range(-10, 11) +y = [] +for i in x: + y.append(a * i + b) +pylab.plot(x, y) +pylab.title('Wykres f(x) = a*x - b') +pylab.grid(True) +pylab.show() diff --git a/Semestr 2/racket/lista6/lista8/zad1.bak b/Semestr 2/racket/lista6/lista8/zad1.bak new file mode 100644 index 0000000..0960f21 --- /dev/null +++ b/Semestr 2/racket/lista6/lista8/zad1.bak @@ -0,0 +1,98 @@ +#lang racket + +; Do let-env.rkt dodajemy wartosci boolowskie +; +; Miejsca, ktore sie zmienily oznaczone sa przez !!! + +; --------- ; +; Wyrazenia ; +; --------- ; + +(struct const (val) #:transparent) +(struct binop (op l r) #:transparent) +(struct var-expr (id) #:transparent) +(struct let-expr (id e1 e2) #:transparent) +(struct if-expr (eb et ef) #:transparent) + +(define (expr? e) + (match e + [(const n) (or (number? n) (boolean? n))] ; <----------------- !!! + [(binop op l r) (and (symbol? op) (expr? l) (expr? r))] + [(var-expr x) (symbol? x)] + [(let-expr x e1 e2) + (and (symbol? x) (expr? e1) (expr? e2))] + [(if-expr eb et ef) ; <--------------------------------------- !!! + (and (expr? eb) (expr? et) (expr? ef))] + [_ false])) + +(define (parse q) + (cond + [(number? q) (const q)] + [(eq? q 'true) (const true)] ; <---------------------------- !!! + [(eq? q 'false) (const false)] ; <---------------------------- !!! + [(symbol? q) (var-expr q)] + [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let)) + (let-expr (first (second q)) + (parse (second (second q))) + (parse (third q)))] + [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if)) ; <--- !!! + (if-expr (parse (second q)) + (parse (third q)) + (parse (fourth q)))] + [(and (list? q) (eq? (length q) 3) (symbol? (first q))) + (binop (first q) + (parse (second q)) + (parse (third q)))])) + +(define (test-parse) (parse '(let [x (+ 2 2)] (+ x 1)))) + +; ---------- ; +; Srodowiska ; +; ---------- ; + +(struct environ (xs)) + +(define env-empty (environ null)) +(define (env-add x v env) + (environ (cons (cons x v) (environ-xs env)))) +(define (env-lookup x env) + (define (assoc-lookup xs) + (cond [(null? xs) (error "Unknown identifier" x)] + [(eq? x (car (car xs))) (cdr (car xs))] + [else (assoc-lookup (cdr xs))])) + (assoc-lookup (environ-xs env))) + +; --------- ; +; Ewaluacja ; +; --------- ; + +(define (value? v) + (or (number? v) (boolean? v))) + +(define (op->proc op) + (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo] ; <----------- !!! + ['= =] ['> >] ['>= >=] ['< <] ['<= <=] + ['and (lambda (x y) (and x y))] + ['or (lambda (x y) (or x y))])) + +(define (eval-env e env) + (match e + [(const n) n] + [(binop op l r) ((op->proc op) (eval-env l env) + (eval-env r env))] + [(let-expr x e1 e2) + (eval-env e2 (env-add x (eval-env e1 env) env))] + [(var-expr x) (env-lookup x env)] + [(if-expr eb et ef) (if (eval-env eb env) ; <----------------- !!! + (eval-env et env) + (eval-env ef env))])) + +(define (eval e) (eval-env e env-empty)) + +(define program + '(if (or (< (% 123 10) 5) + true) + (+ 2 3) + (/ 2 0))) + +(define (test-eval) (eval (parse program))) \ No newline at end of file diff --git a/Semestr 2/racket/lista6/lista8/zad1.rkt b/Semestr 2/racket/lista6/lista8/zad1.rkt new file mode 100644 index 0000000..1cd6b0b --- /dev/null +++ b/Semestr 2/racket/lista6/lista8/zad1.rkt @@ -0,0 +1,104 @@ +#lang racket + +; Do let-env.rkt dodajemy wartosci boolowskie +; +; Miejsca, ktore sie zmienily oznaczone sa przez !!! + +; --------- ; +; Wyrazenia ; +; --------- ; + +(struct const (val) #:transparent) +(struct binop (op l r) #:transparent) +(struct var-expr (id) #:transparent) +(struct let-expr (id e1 e2) #:transparent) +(struct if-expr (eb et ef) #:transparent) + +(define (expr? e) + (match e + [(const n) (or (number? n) (boolean? n))] ; <----------------- !!! + [(binop op l r) (and (symbol? op) (expr? l) (expr? r))] + [(var-expr x) (symbol? x)] + [(let-expr x e1 e2) + (and (symbol? x) (expr? e1) (expr? e2))] + [(if-expr eb et ef) ; <--------------------------------------- !!! + (and (expr? eb) (expr? et) (expr? ef))] + [_ false])) + +(define (parse q) + (cond + [(number? q) (const q)] + [(eq? q 'true) (const true)] ; <---------------------------- !!! + [(eq? q 'false) (const false)] ; <---------------------------- !!! + [(symbol? q) (var-expr q)] + [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let)) + (let-expr (first (second q)) + (parse (second (second q))) + (parse (third q)))] + [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if)) ; <--- !!! + (if-expr (parse (second q)) + (parse (third q)) + (parse (fourth q)))] + [(and (list? q) (eq? (length q) 3) (eq? (first q) 'and)) + (if-expr (parse (second q)) + (parse (third q)) + (const false))] + [(and (list? q) (eq? (length q) 3) (eq? (first q) 'or)) + (if-expr (parse (second q)) + (const true) + (parse (third q)))] + [(and (list? q) (eq? (length q) 3) (symbol? (first q))) + (binop (first q) + (parse (second q)) + (parse (third q)))])) + +(define (test-parse) (parse '(let [x (+ 2 2)] (+ x 1)))) + +; ---------- ; +; Srodowiska ; +; ---------- ; + +(struct environ (xs)) + +(define env-empty (environ null)) +(define (env-add x v env) + (environ (cons (cons x v) (environ-xs env)))) +(define (env-lookup x env) + (define (assoc-lookup xs) + (cond [(null? xs) (error "Unknown identifier" x)] + [(eq? x (car (car xs))) (cdr (car xs))] + [else (assoc-lookup (cdr xs))])) + (assoc-lookup (environ-xs env))) + +; --------- ; +; Ewaluacja ; +; --------- ; + +(define (value? v) + (or (number? v) (boolean? v))) + +(define (op->proc op) + (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo] ; <----------- !!! + ['= =] ['> >] ['>= >=] ['< <] ['<= <=])) + +(define (eval-env e env) + (match e + [(const n) n] + [(binop op l r) ((op->proc op) (eval-env l env) + (eval-env r env))] + [(let-expr x e1 e2) + (eval-env e2 (env-add x (eval-env e1 env) env))] + [(var-expr x) (env-lookup x env)] + [(if-expr eb et ef) (if (eval-env eb env) ; <----------------- !!! + (eval-env et env) + (eval-env ef env))])) + +(define (eval e) (eval-env e env-empty)) + +(define program + '(if (or (< (% 123 10) 5) + true) + (+ 2 3) + (/ 2 0))) + +(define (test-eval) (eval (parse program))) \ No newline at end of file diff --git a/Semestr 2/racket/lista6/lista8/zad4.bak b/Semestr 2/racket/lista6/lista8/zad4.bak new file mode 100644 index 0000000..503099d --- /dev/null +++ b/Semestr 2/racket/lista6/lista8/zad4.bak @@ -0,0 +1,114 @@ +#lang racket + +; Do boolean.rkt dodajemy pary +; +; Miejsca, ktore sie zmienily oznaczone sa przez !!! + +; --------- ; +; Wyrazenia ; +; --------- ; + +(struct const (val) #:transparent) +(struct binop (op l r) #:transparent) +(struct var-expr (id) #:transparent) +(struct let-expr (id e1 e2) #:transparent) +(struct if-expr (eb et ef) #:transparent) +(struct cons-expr (e1 e2) #:transparent) ; <------------------- !!! +(struct car-expr (e) #:transparent) ; <------------------- !!! +(struct cdr-expr (e) #:transparent) ; <------------------- !!! + +(define (expr? e) + (match e + [(const n) (or (number? n) (boolean? n))] + [(binop op l r) (and (symbol? op) (expr? l) (expr? r))] + [(var-expr x) (symbol? x)] + [(let-expr x e1 e2) + (and (symbol? x) (expr? e1) (expr? e2))] + [(if-expr eb et ef) + (and (expr? eb) (expr? et) (expr? ef))] + [(cons-expr e1 e2) (and (expr? e1) (expr? e2))] ; <----------- !!! + [(car-expr e) (expr? e)] ; <---------------------------------- !!! + [(cdr-expr e) (expr? e)] ; <---------------------------------- !!! + [_ false])) + +(define (parse q) + (cond + [(number? q) (const q)] + [(eq? q 'true) (const true)] + [(eq? q 'false) (const false)] + [(symbol? q) (var-expr q)] + [(and (list? q) (eq? (length q) 3) (eq? (first q) 'cons)) ; <- !!! + (cons-expr (parse (second q)) + (parse (third q)))] + [(and (list? q) (eq? (length q) 2) (eq? (first q) 'car)) ; <-- !!! + (car-expr (parse (second q)))] + [(and (list? q) (eq? (length q) 2) (eq? (first q) 'cdr)) ; <-- !!! + (cdr-expr (parse (second q)))] + [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let)) + (let-expr (first (second q)) + (parse (second (second q))) + (parse (third q)))] + [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if)) + (if-expr (parse (second q)) + (parse (third q)) + (parse (fourth q)))] + [(and (list? q) (eq? (length q) 3) (symbol? (first q))) + (binop (first q) + (parse (second q)) + (parse (third q)))])) + +(define (test-parse) (parse '(let [x (+ 2 2)] (+ x 1)))) + +; ---------- ; +; Srodowiska ; +; ---------- ; + +(struct environ (xs)) + +(define env-empty (environ null)) +(define (env-add x v env) + (environ (cons (cons x v) (environ-xs env)))) +(define (env-lookup x env) + (define (assoc-lookup xs) + (cond [(null? xs) (error "Unknown identifier" x)] + [(eq? x (car (car xs))) (cdr (car xs))] + [else (assoc-lookup (cdr xs))])) + (assoc-lookup (environ-xs env))) + +; --------- ; +; Ewaluacja ; +; --------- ; + +(define (value? v) + (or (number? v) + (boolean? v) + (and (pair? v) (value? (car v)) (value? (cdr v))))) + +(define (op->proc op) + (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo] + ['= =] ['> >] ['>= >=] ['< <] ['<= <=] + ['and (lambda (x y) (and x y))] + ['or (lambda (x y) (or x y))])) + +(define (eval-env e env) + (match e + [(const n) n] + [(binop op l r) ((op->proc op) (eval-env l env) + (eval-env r env))] + [(let-expr x e1 e2) + (eval-env e2 (env-add x (eval-env e1 env) env))] + [(var-expr x) (env-lookup x env)] + [(if-expr eb et ef) (if (eval-env eb env) + (eval-env et env) + (eval-env ef env))] + [(cons-expr e1 e2) (cons (eval-env e1 env) ; <---------------- !!! + (eval-env e2 env))] + [(car-expr e) (car (eval-env e env))] ; <--------------------- !!! + [(cdr-expr e) (cdr (eval-env e env))])) ; <------------------- !!! + +(define (eval e) (eval-env e env-empty)) + +(define program + '(car (if true (cons 1 2) false))) + +(define (test-eval) (eval (parse program))) \ No newline at end of file diff --git a/Semestr 2/racket/lista6/lista8/zad4.rkt b/Semestr 2/racket/lista6/lista8/zad4.rkt new file mode 100644 index 0000000..7934435 --- /dev/null +++ b/Semestr 2/racket/lista6/lista8/zad4.rkt @@ -0,0 +1,118 @@ +#lang racket + +; Do boolean.rkt dodajemy pary +; +; Miejsca, ktore sie zmienily oznaczone sa przez !!! + +; --------- ; +; Wyrazenia ; +; --------- ; + +(struct const (val) #:transparent) +(struct binop (op l r) #:transparent) +(struct var-expr (id) #:transparent) +(struct let-expr (id e1 e2) #:transparent) +(struct if-expr (eb et ef) #:transparent) +(struct cons-expr (e1 e2) #:transparent) ; <------------------- !!! +(struct car-expr (e) #:transparent) ; <------------------- !!! +(struct cdr-expr (e) #:transparent) ; <------------------- !!! +(struct is-pair (e) #:transparent) + +(define (expr? e) + (match e + [(const n) (or (number? n) (boolean? n))] + [(binop op l r) (and (symbol? op) (expr? l) (expr? r))] + [(var-expr x) (symbol? x)] + [(let-expr x e1 e2) + (and (symbol? x) (expr? e1) (expr? e2))] + [(if-expr eb et ef) + (and (expr? eb) (expr? et) (expr? ef))] + [(cons-expr e1 e2) (and (expr? e1) (expr? e2))] ; <----------- !!! + [(car-expr e) (expr? e)] ; <---------------------------------- !!! + [(cdr-expr e) (expr? e)] ; <---------------------------------- !!! + [(is-pair e) (expr? e)] + [_ false])) + +(define (parse q) + (cond + [(number? q) (const q)] + [(eq? q 'true) (const true)] + [(eq? q 'false) (const false)] + [(symbol? q) (var-expr q)] + [(and (list? q) (eq? (length q) 3) (eq? (first q) 'cons)) ; <- !!! + (cons-expr (parse (second q)) + (parse (third q)))] + [(and (list? q) (eq? (length q) 2) (eq? (first q) 'car)) ; <-- !!! + (car-expr (parse (second q)))] + [(and (list? q) (eq? (length q) 2) (eq? (first q) 'cdr)) ; <-- !!! + (cdr-expr (parse (second q)))] + [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let)) + (let-expr (first (second q)) + (parse (second (second q))) + (parse (third q)))] + [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if)) + (if-expr (parse (second q)) + (parse (third q)) + (parse (fourth q)))] + [(and (list? q) (eq? (length q) 3) (symbol? (first q))) + (binop (first q) + (parse (second q)) + (parse (third q)))] + [(and (list? q) (eq? (length q) 2) (eq? (first q) 'pair?)) + (is-pair (parse (second q)))])) + +(define (test-parse) (parse '(let [x (+ 2 2)] (+ x 1)))) + +; ---------- ; +; Srodowiska ; +; ---------- ; + +(struct environ (xs)) + +(define env-empty (environ null)) +(define (env-add x v env) + (environ (cons (cons x v) (environ-xs env)))) +(define (env-lookup x env) + (define (assoc-lookup xs) + (cond [(null? xs) (error "Unknown identifier" x)] + [(eq? x (car (car xs))) (cdr (car xs))] + [else (assoc-lookup (cdr xs))])) + (assoc-lookup (environ-xs env))) + +; --------- ; +; Ewaluacja ; +; --------- ; + +(define (value? v) + (or (number? v) + (boolean? v) + (and (pair? v) (value? (car v)) (value? (cdr v))))) + +(define (op->proc op) + (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo] + ['= =] ['> >] ['>= >=] ['< <] ['<= <=] + ['and (lambda (x y) (and x y))] + ['or (lambda (x y) (or x y))])) + +(define (eval-env e env) + (match e + [(const n) n] + [(binop op l r) ((op->proc op) (eval-env l env) + (eval-env r env))] + [(let-expr x e1 e2) + (eval-env e2 (env-add x (eval-env e1 env) env))] + [(var-expr x) (env-lookup x env)] + [(if-expr eb et ef) (if (eval-env eb env) + (eval-env et env) + (eval-env ef env))] + [(cons-expr e1 e2) (cons (eval-env e1 env) ; <---------------- !!! + (eval-env e2 env))] + [(car-expr e) (car (eval-env e env))] ; <--------------------- !!! + [(cdr-expr e) (cdr (eval-env e env))] ; <------------------- !!! + [(is-pair e) (cons? (eval-env e env))])) +(define (eval e) (eval-env e env-empty)) + +(define program + '(car (if true (cons 1 2) false))) + +(define (test-eval) (eval (parse program))) \ No newline at end of file diff --git a/Semestr 2/racket/lista6/lista8/zad5.bak b/Semestr 2/racket/lista6/lista8/zad5.bak new file mode 100644 index 0000000..6f1f7b4 --- /dev/null +++ b/Semestr 2/racket/lista6/lista8/zad5.bak @@ -0,0 +1 @@ +#lang racket diff --git a/Semestr 2/racket/lista6/lista8/zad5.rkt b/Semestr 2/racket/lista6/lista8/zad5.rkt new file mode 100644 index 0000000..721f5bf --- /dev/null +++ b/Semestr 2/racket/lista6/lista8/zad5.rkt @@ -0,0 +1,151 @@ +#lang racket + +; Do list.rkt dodajemy procedury +; +; Miejsca, ktore sie zmienily oznaczone sa przez !!! + +; --------- ; +; Wyrazenia ; +; --------- ; + +(struct const (val) #:transparent) +(struct binop (op l r) #:transparent) +(struct unop (op e) #:transparent) +(struct var-expr (id) #:transparent) +(struct let-expr (id e1 e2) #:transparent) +(struct if-expr (eb et ef) #:transparent) +(struct cons-expr (e1 e2) #:transparent) +(struct null-expr () #:transparent) +(struct null?-expr (e) #:transparent) +(struct app (f e) #:transparent) ; <------------------ !!! +(struct lam (id e) #:transparent) ; <------------------ !!! + + +(define (expr? e) + (match e + [(const n) (or (number? n) (boolean? n))] + [(binop op l r) (and (symbol? op) (expr? l) (expr? r))] + [(var-expr x) (symbol? x)] + [(let-expr x e1 e2) + (and (symbol? x) (expr? e1) (expr? e2))] + [(if-expr eb et ef) + (and (expr? eb) (expr? et) (expr? ef))] + [(cons-expr e1 e2) (and (expr? e1) (expr? e2))] + [(null-expr) true] + [(null?-expr e) (expr? e)] + [(app f e) (and (expr? f) (expr? e))] ; <--------------------- !!! + [(lam id e) (and (symbol? id) (expr? e))] ; <----------------- !!! + [_ false])) + +(define (parse q) + (cond + [(number? q) (const q)] + [(eq? q 'true) (const true)] + [(eq? q 'false) (const false)] + [(eq? q 'null) (null-expr)] + [(symbol? q) (var-expr q)] + [(and (list? q) (eq? (length q) 2) (eq? (first q) 'null?)) + (null?-expr (parse (second q)))] + [(and (list? q) (eq? (length q) 3) (eq? (first q) 'cons)) + (cons-expr (parse (second q)) + (parse (third q)))] + [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let)) + (let-expr (first (second q)) + (parse (second (second q))) + (parse (third q)))] + [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if)) + (if-expr (parse (second q)) + (parse (third q)) + (parse (fourth q)))] + [(and (list? q) (eq? (length q) 3) (eq? (first q) 'lambda)) ; proc (car q)))) ; <------- !!! + (parse-app q)] + [(and (list? q) (eq? (length q) 3) (symbol? (first q))) + (binop (first q) + (parse (second q)) + (parse (third q)))] + [(and (list? q) (eq? (length q) 2) (symbol? (first q))) + (unop (first q) (parse (second q)))])) + +(define (parse-app q) ; <----------------------------------------- !!! + (define (parse-app-accum q acc) + (cond [(= 1 (length q)) (app acc (parse (car q)))] + [else (parse-app-accum (cdr q) (app acc (parse (car q))))])) + (parse-app-accum (cdr q) (parse (car q)))) + +(define (parse-lam pat e) ; <------------------------------------- !!! + (cond [(= 1 (length pat)) + (lam (car pat) (parse e))] + [else + (lam (car pat) (parse-lam (cdr pat) e))])) + +; ---------- ; +; Srodowiska ; +; ---------- ; + +(struct environ (xs) #:transparent) + +(define env-empty (environ null)) +(define (env-add x v env) + (environ (cons (cons x v) (environ-xs env)))) +(define (env-lookup x env) + (define (assoc-lookup xs) + (cond [(null? xs) (error "Unknown identifier" x)] + [(eq? x (car (car xs))) (cdr (car xs))] + [else (assoc-lookup (cdr xs))])) + (assoc-lookup (environ-xs env))) + +; --------- ; +; Ewaluacja ; +; --------- ; + +(struct clo (id e env) #:transparent) ; <------------------------- !!! + +(define (value? v) + (or (number? v) + (boolean? v) + (and (pair? v) (value? (car v)) (value? (cdr v))) + (null? v) + (clo? v))) ; <---------------------------------------------- !!! + +(define (op->proc op) + (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo] + ['= =] ['> >] ['>= >=] ['< <] ['<= <=] + ['and (lambda (x y) (and x y))] + ['or (lambda (x y) (or x y))] + ['not not] ['car car] ['cdr cdr] + [_ false])) ; <--------------------------------------- !!! + +(define (eval-env e env) + (match e + [(const n) n] + [(binop op l r) ((op->proc op) (eval-env l env) + (eval-env r env))] + [(unop op e) ((op->proc op) (eval-env e env))] + [(let-expr x e1 e2) + (eval-env e2 (env-add x (eval-env e1 env) env))] + [(var-expr x) (env-lookup x env)] + [(if-expr eb et ef) (if (eval-env eb env) + (eval-env et env) + (eval-env ef env))] + [(cons-expr e1 e2) (cons (eval-env e1 env) + (eval-env e2 env))] + [(null-expr) null] + [(null?-expr e) (null? (eval-env e env))] + [(lam x e) (clo x e env)] ; <--------------------------------- !!! + [(app f e) ; <------------------------------------------------ !!! + (let ([vf (eval-env f env)] + [ve (eval-env e env)]) + (match vf [(clo x body fun-env) + (eval-env body (env-add x ve fun-env))]))])) + +(define (eval e) (eval-env e env-empty)) + +(define program + '(let [twice (lambda (f x) (f (f x)))] + (let [inc (lambda (x) (+ 1 x))] + (twice twice twice twice inc 1)))) + + +(define (test-eval) (eval (parse program))) \ No newline at end of file diff --git a/Semestr 2/racket/lista6/lista8/zad6.bak b/Semestr 2/racket/lista6/lista8/zad6.bak new file mode 100644 index 0000000..721f5bf --- /dev/null +++ b/Semestr 2/racket/lista6/lista8/zad6.bak @@ -0,0 +1,151 @@ +#lang racket + +; Do list.rkt dodajemy procedury +; +; Miejsca, ktore sie zmienily oznaczone sa przez !!! + +; --------- ; +; Wyrazenia ; +; --------- ; + +(struct const (val) #:transparent) +(struct binop (op l r) #:transparent) +(struct unop (op e) #:transparent) +(struct var-expr (id) #:transparent) +(struct let-expr (id e1 e2) #:transparent) +(struct if-expr (eb et ef) #:transparent) +(struct cons-expr (e1 e2) #:transparent) +(struct null-expr () #:transparent) +(struct null?-expr (e) #:transparent) +(struct app (f e) #:transparent) ; <------------------ !!! +(struct lam (id e) #:transparent) ; <------------------ !!! + + +(define (expr? e) + (match e + [(const n) (or (number? n) (boolean? n))] + [(binop op l r) (and (symbol? op) (expr? l) (expr? r))] + [(var-expr x) (symbol? x)] + [(let-expr x e1 e2) + (and (symbol? x) (expr? e1) (expr? e2))] + [(if-expr eb et ef) + (and (expr? eb) (expr? et) (expr? ef))] + [(cons-expr e1 e2) (and (expr? e1) (expr? e2))] + [(null-expr) true] + [(null?-expr e) (expr? e)] + [(app f e) (and (expr? f) (expr? e))] ; <--------------------- !!! + [(lam id e) (and (symbol? id) (expr? e))] ; <----------------- !!! + [_ false])) + +(define (parse q) + (cond + [(number? q) (const q)] + [(eq? q 'true) (const true)] + [(eq? q 'false) (const false)] + [(eq? q 'null) (null-expr)] + [(symbol? q) (var-expr q)] + [(and (list? q) (eq? (length q) 2) (eq? (first q) 'null?)) + (null?-expr (parse (second q)))] + [(and (list? q) (eq? (length q) 3) (eq? (first q) 'cons)) + (cons-expr (parse (second q)) + (parse (third q)))] + [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let)) + (let-expr (first (second q)) + (parse (second (second q))) + (parse (third q)))] + [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if)) + (if-expr (parse (second q)) + (parse (third q)) + (parse (fourth q)))] + [(and (list? q) (eq? (length q) 3) (eq? (first q) 'lambda)) ; proc (car q)))) ; <------- !!! + (parse-app q)] + [(and (list? q) (eq? (length q) 3) (symbol? (first q))) + (binop (first q) + (parse (second q)) + (parse (third q)))] + [(and (list? q) (eq? (length q) 2) (symbol? (first q))) + (unop (first q) (parse (second q)))])) + +(define (parse-app q) ; <----------------------------------------- !!! + (define (parse-app-accum q acc) + (cond [(= 1 (length q)) (app acc (parse (car q)))] + [else (parse-app-accum (cdr q) (app acc (parse (car q))))])) + (parse-app-accum (cdr q) (parse (car q)))) + +(define (parse-lam pat e) ; <------------------------------------- !!! + (cond [(= 1 (length pat)) + (lam (car pat) (parse e))] + [else + (lam (car pat) (parse-lam (cdr pat) e))])) + +; ---------- ; +; Srodowiska ; +; ---------- ; + +(struct environ (xs) #:transparent) + +(define env-empty (environ null)) +(define (env-add x v env) + (environ (cons (cons x v) (environ-xs env)))) +(define (env-lookup x env) + (define (assoc-lookup xs) + (cond [(null? xs) (error "Unknown identifier" x)] + [(eq? x (car (car xs))) (cdr (car xs))] + [else (assoc-lookup (cdr xs))])) + (assoc-lookup (environ-xs env))) + +; --------- ; +; Ewaluacja ; +; --------- ; + +(struct clo (id e env) #:transparent) ; <------------------------- !!! + +(define (value? v) + (or (number? v) + (boolean? v) + (and (pair? v) (value? (car v)) (value? (cdr v))) + (null? v) + (clo? v))) ; <---------------------------------------------- !!! + +(define (op->proc op) + (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo] + ['= =] ['> >] ['>= >=] ['< <] ['<= <=] + ['and (lambda (x y) (and x y))] + ['or (lambda (x y) (or x y))] + ['not not] ['car car] ['cdr cdr] + [_ false])) ; <--------------------------------------- !!! + +(define (eval-env e env) + (match e + [(const n) n] + [(binop op l r) ((op->proc op) (eval-env l env) + (eval-env r env))] + [(unop op e) ((op->proc op) (eval-env e env))] + [(let-expr x e1 e2) + (eval-env e2 (env-add x (eval-env e1 env) env))] + [(var-expr x) (env-lookup x env)] + [(if-expr eb et ef) (if (eval-env eb env) + (eval-env et env) + (eval-env ef env))] + [(cons-expr e1 e2) (cons (eval-env e1 env) + (eval-env e2 env))] + [(null-expr) null] + [(null?-expr e) (null? (eval-env e env))] + [(lam x e) (clo x e env)] ; <--------------------------------- !!! + [(app f e) ; <------------------------------------------------ !!! + (let ([vf (eval-env f env)] + [ve (eval-env e env)]) + (match vf [(clo x body fun-env) + (eval-env body (env-add x ve fun-env))]))])) + +(define (eval e) (eval-env e env-empty)) + +(define program + '(let [twice (lambda (f x) (f (f x)))] + (let [inc (lambda (x) (+ 1 x))] + (twice twice twice twice inc 1)))) + + +(define (test-eval) (eval (parse program))) \ No newline at end of file diff --git a/Semestr 2/racket/lista6/lista8/zad6.rkt b/Semestr 2/racket/lista6/lista8/zad6.rkt new file mode 100644 index 0000000..c7ea9f0 --- /dev/null +++ b/Semestr 2/racket/lista6/lista8/zad6.rkt @@ -0,0 +1,171 @@ +#lang racket + +; Do list.rkt dodajemy procedury +; +; Miejsca, ktore sie zmienily oznaczone sa przez !!! + +; --------- ; +; Wyrazenia ; +; --------- ; + +(struct const (val) #:transparent) +(struct binop (op l r) #:transparent) +(struct unop (op e) #:transparent) +(struct var-expr (id) #:transparent) +(struct let-expr (id e1 e2) #:transparent) +(struct if-expr (eb et ef) #:transparent) +(struct cons-expr (e1 e2) #:transparent) +(struct null-expr () #:transparent) +(struct null?-expr (e) #:transparent) +(struct app (f e) #:transparent) ; <------------------ !!! +(struct lam (id e) #:transparent) ; <------------------ !!! + +(define (expr? e) + (match e + [(const n) (or (number? n) (boolean? n))] + [(unop op e) (and (symbol? op) (expr? e))] + [(binop op l r) (and (symbol? op) (expr? l) (expr? r))] + [(var-expr x) (symbol? x)] + [(let-expr x e1 e2) + (and (symbol? x) (expr? e1) (expr? e2))] + [(if-expr eb et ef) + (and (expr? eb) (expr? et) (expr? ef))] + [(cons-expr e1 e2) (and (expr? e1) (expr? e2))] + [(null-expr) true] + [(null?-expr e) (expr? e)] + [(app f e) (and (expr? f) (expr? e))] ; <--------------------- !!! + [(lam id e) (and (symbol? id) (expr? e))] ; <----------------- !!! + [_ false])) + +(define (cedar? f) + (let ((letters (string->list (symbol->string f)))) + (and (> (length letters) 2) + (eq? (first letters) #\c) + (eq? (first (reverse letters)) #\r) + (andmap (lambda (x) (or (eq? x #\a) (eq? x #\d))) + (cdr letters))))) + +(define (get-cedar letters xs) + (cond [(eq? (car letters) #\r) xs] + [(eq? (car letters) #\a) (unop 'car (get-cedar (cdr letters) xs))] + [(eq? (car letters) #\d) (unop 'cdr (get-cedar (cdr letters) xs))])) + +(define (cedar f xs) + (let ((letters (string->list (symbol->string f)))) + (get-cedar (cdr (reverse letters)) xs))) + +(define (parse q) + (cond + [(number? q) (const q)] + [(eq? q 'true) (const true)] + [(eq? q 'false) (const false)] + [(eq? q 'null) (null-expr)] + [(symbol? q) (var-expr q)] + [(and (list? q) (eq? (length q) 2) (eq? (first q) 'null?)) + (null?-expr (parse (second q)))] + [(and (list? q) (eq? (length q) 3) (eq? (first q) 'cons)) + (cons-expr (parse (second q)) + (parse (third q)))] + [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let)) + (let-expr (first (second q)) + (parse (second (second q))) + (parse (third q)))] + [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if)) + (if-expr (parse (second q)) + (parse (third q)) + (parse (fourth q)))] + [(and (list? q) (eq? (length q) 3) (eq? (first q) 'lambda)) ; proc (car q)))) ; <------- !!! + (parse-app q)] + [(and (list? q) (eq? (length q) 3) (symbol? (first q))) + (binop (first q) + (parse (second q)) + (parse (third q)))] + [(and (list? q) (eq? (length q) 2) (symbol? (first q))) + (unop (first q) (parse (second q)))])) + +(define (parse-app q) ; <----------------------------------------- !!! + (define (parse-app-accum q acc) + (cond [(= 1 (length q)) (app acc (parse (car q)))] + [else (parse-app-accum (cdr q) (app acc (parse (car q))))])) + (parse-app-accum (cdr q) (parse (car q)))) + +(define (parse-lam pat e) ; <------------------------------------- !!! + (cond [(= 1 (length pat)) + (lam (car pat) (parse e))] + [else + (lam (car pat) (parse-lam (cdr pat) e))])) + +; ---------- ; +; Srodowiska ; +; ---------- ; + +(struct environ (xs) #:transparent) + +(define env-empty (environ null)) +(define (env-add x v env) + (environ (cons (cons x v) (environ-xs env)))) +(define (env-lookup x env) + (define (assoc-lookup xs) + (cond [(null? xs) (error "Unknown identifier" x)] + [(eq? x (car (car xs))) (cdr (car xs))] + [else (assoc-lookup (cdr xs))])) + (assoc-lookup (environ-xs env))) + +; --------- ; +; Ewaluacja ; +; --------- ; + +(struct clo (id e env) #:transparent) ; <------------------------- !!! + +(define (value? v) + (or (number? v) + (boolean? v) + (and (pair? v) (value? (car v)) (value? (cdr v))) + (null? v) + (clo? v))) ; <---------------------------------------------- !!! + +(define (op->proc op) + (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo] + ['= =] ['> >] ['>= >=] ['< <] ['<= <=] + ['and (lambda (x y) (and x y))] + ['or (lambda (x y) (or x y))] + ['not not] ['car car] ['cdr cdr] + [_ false])) ; <--------------------------------------- !!! + +(define (eval-env e env) + (match e + [(const n) n] + [(binop op l r) ((op->proc op) (eval-env l env) + (eval-env r env))] + [(unop op e) ((op->proc op) (eval-env e env))] + [(let-expr x e1 e2) + (eval-env e2 (env-add x (eval-env e1 env) env))] + [(var-expr x) (env-lookup x env)] + [(if-expr eb et ef) (if (eval-env eb env) + (eval-env et env) + (eval-env ef env))] + [(cons-expr e1 e2) (cons (eval-env e1 env) + (eval-env e2 env))] + [(null-expr) null] + [(null?-expr e) (null? (eval-env e env))] + [(lam x e) (clo x e env)] ; <--------------------------------- !!! + [(app f e) ; <------------------------------------------------ !!! + (let ([vf (eval-env f env)] + [ve (eval-env e env)]) + (match vf [(clo x body fun-env) + (eval-env body (env-add x ve fun-env))]))])) + +(define (eval e) (eval-env e env-empty)) + +(define program + '(let [twice (lambda (f x) (f (f x)))] + (let [inc (lambda (x) (+ 1 x))] + (twice twice twice twice inc 1)))) + + +(define (test-eval) (eval (parse program))) \ No newline at end of file diff --git a/Semestr 2/racket/lista6/lista8/zadanie.rkt b/Semestr 2/racket/lista6/lista8/zadanie.rkt new file mode 100644 index 0000000..0960f21 --- /dev/null +++ b/Semestr 2/racket/lista6/lista8/zadanie.rkt @@ -0,0 +1,98 @@ +#lang racket + +; Do let-env.rkt dodajemy wartosci boolowskie +; +; Miejsca, ktore sie zmienily oznaczone sa przez !!! + +; --------- ; +; Wyrazenia ; +; --------- ; + +(struct const (val) #:transparent) +(struct binop (op l r) #:transparent) +(struct var-expr (id) #:transparent) +(struct let-expr (id e1 e2) #:transparent) +(struct if-expr (eb et ef) #:transparent) + +(define (expr? e) + (match e + [(const n) (or (number? n) (boolean? n))] ; <----------------- !!! + [(binop op l r) (and (symbol? op) (expr? l) (expr? r))] + [(var-expr x) (symbol? x)] + [(let-expr x e1 e2) + (and (symbol? x) (expr? e1) (expr? e2))] + [(if-expr eb et ef) ; <--------------------------------------- !!! + (and (expr? eb) (expr? et) (expr? ef))] + [_ false])) + +(define (parse q) + (cond + [(number? q) (const q)] + [(eq? q 'true) (const true)] ; <---------------------------- !!! + [(eq? q 'false) (const false)] ; <---------------------------- !!! + [(symbol? q) (var-expr q)] + [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let)) + (let-expr (first (second q)) + (parse (second (second q))) + (parse (third q)))] + [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if)) ; <--- !!! + (if-expr (parse (second q)) + (parse (third q)) + (parse (fourth q)))] + [(and (list? q) (eq? (length q) 3) (symbol? (first q))) + (binop (first q) + (parse (second q)) + (parse (third q)))])) + +(define (test-parse) (parse '(let [x (+ 2 2)] (+ x 1)))) + +; ---------- ; +; Srodowiska ; +; ---------- ; + +(struct environ (xs)) + +(define env-empty (environ null)) +(define (env-add x v env) + (environ (cons (cons x v) (environ-xs env)))) +(define (env-lookup x env) + (define (assoc-lookup xs) + (cond [(null? xs) (error "Unknown identifier" x)] + [(eq? x (car (car xs))) (cdr (car xs))] + [else (assoc-lookup (cdr xs))])) + (assoc-lookup (environ-xs env))) + +; --------- ; +; Ewaluacja ; +; --------- ; + +(define (value? v) + (or (number? v) (boolean? v))) + +(define (op->proc op) + (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo] ; <----------- !!! + ['= =] ['> >] ['>= >=] ['< <] ['<= <=] + ['and (lambda (x y) (and x y))] + ['or (lambda (x y) (or x y))])) + +(define (eval-env e env) + (match e + [(const n) n] + [(binop op l r) ((op->proc op) (eval-env l env) + (eval-env r env))] + [(let-expr x e1 e2) + (eval-env e2 (env-add x (eval-env e1 env) env))] + [(var-expr x) (env-lookup x env)] + [(if-expr eb et ef) (if (eval-env eb env) ; <----------------- !!! + (eval-env et env) + (eval-env ef env))])) + +(define (eval e) (eval-env e env-empty)) + +(define program + '(if (or (< (% 123 10) 5) + true) + (+ 2 3) + (/ 2 0))) + +(define (test-eval) (eval (parse program))) \ No newline at end of file -- cgit v1.2.3