aboutsummaryrefslogtreecommitdiff
path: root/Semestr 2/racket/l8z14
diff options
context:
space:
mode:
Diffstat (limited to 'Semestr 2/racket/l8z14')
-rw-r--r--Semestr 2/racket/l8z14/solution.bak155
-rw-r--r--Semestr 2/racket/l8z14/solution.rkt201
2 files changed, 0 insertions, 356 deletions
diff --git a/Semestr 2/racket/l8z14/solution.bak b/Semestr 2/racket/l8z14/solution.bak
deleted file mode 100644
index b51383a..0000000
--- a/Semestr 2/racket/l8z14/solution.bak
+++ /dev/null
@@ -1,155 +0,0 @@
-#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 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 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))]
- [(car-expr e) (expr? e)]
- [(cdr-expr e) (expr? e)]
- [(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) 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) (eq? (first q) 'lambda)) ; <!!!
- (parse-lam (second q) (third q))]
- [(and (list? q) (pair? q) (not (op->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)))]))
-
-(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))]
- [_ 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))]
- [(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))]
- [(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/l8z14/solution.rkt b/Semestr 2/racket/l8z14/solution.rkt
deleted file mode 100644
index 59556cf..0000000
--- a/Semestr 2/racket/l8z14/solution.rkt
+++ /dev/null
@@ -1,201 +0,0 @@
-#lang racket
-
-; Do list.rkt dodajemy procedury
-;
-; Miejsca, ktore sie zmienily oznaczone sa przez !!!
-
-; --------- ;
-; Wyrazenia ;
-; --------- ;
-
-(provide eval parse)
-
-
-(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 null-expr () #:transparent)
-(struct null?-expr (e) #:transparent)
-(struct app (f e) #:transparent) ; <------------------ !!!
-(struct lam (id e) #:transparent) ; <------------------ !!!
-(struct apply-expr (f xs) #: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)]
- [(null-expr) true]
- [(null?-expr e) (expr? e)]
- [(app f e) (and (expr? f) (expr? e))] ; <--------------------- !!!
- [(lam id e) (and (symbol? id) (expr? e))] ; <----------------- !!!
- [(apply-expr f xs) (and (expr? f) (expr? xs))]
- [_ 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 (> (length q) 0) (list? q) (eq? (first q) 'list))
- (parse-list (cdr 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) 'apply))
- (apply-expr (parse (second q))
- (parse (third 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) (eq? (first q) 'lambda)) ; <!!!
- (parse-lam (second q) (third q))]
- [(and (list? q) (pair? q) (not (op->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)))]))
-
-
-(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))]))
-
-(define (parse-list q)
- (if (null? q)
- (null-expr)
- (cons-expr (parse (car q)) (parse-list (cdr q)))))
-
-; ---------- ;
-; 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))]
- [_ 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))]
- [(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))]
- [(null-expr) null]
- [(null?-expr e) (null? (eval-env e env))]
- [(apply-expr e1 e2)
- (let ([xs (eval-env e2 env)])
- (eval-env (eval-apply e1 (reverse xs)) 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-apply e xs)
- (if (null? xs)
- e
- (app (eval-apply e (cdr xs)) (const (car xs)))))
-
-(define (eval e) (eval-env e env-empty))
-
-;; testy wspólnie z Karolem Ochmanem
-
-(define program1
- '(apply (lambda (x y) (+ x y))
- (cons 1 (cons 2 null))))
-(define program2
- '(apply (lambda (x y z) (+ x (+ y z)))
- (cons 1 (cons 2 null))))
-(define program3
- '(apply (lambda (x y) (lambda (z) (+ x (+ y z))))
- (cons 1 (cons 2 (cons 3 null)))))
-(define program4
- '(apply (lambda (x y) (+ x y))
- (cons 1 (cons 2 (cons 3 null)))))
-(define program5
- '(let [f (lambda (x y z) (+ z (+ x y)))]
- (apply (f 3) (cons 1 (cons 2 null)))))
-(define program6
- '(let [f (lambda (x) x)]
- (apply (f 4) null)))
-(define program7
- '(apply (lambda (q w e r t y u i o p a s d f g h j k l) 3)
- (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 (cons 1
- (cons 1 (cons 1 (cons 1 (cons 1 (cons 1
- (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 null)))))))))))))))))))))
-(define program8
- '(apply (lambda (q w e r t y u i o p a s d f g h j k l) 3)
- (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 (cons 1
- (cons 1 (cons 1 (cons 1 (cons 1 null))))))))))))))) \ No newline at end of file