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/l7z13/solution.rkt | 104 ------------------------------------ 1 file changed, 104 deletions(-) delete mode 100644 Semestr 2/racket/l7z13/solution.rkt (limited to 'Semestr 2/racket/l7z13') diff --git a/Semestr 2/racket/l7z13/solution.rkt b/Semestr 2/racket/l7z13/solution.rkt deleted file mode 100644 index 0a0278a..0000000 --- a/Semestr 2/racket/l7z13/solution.rkt +++ /dev/null @@ -1,104 +0,0 @@ -#lang racket - -(provide (struct-out const) (struct-out binop) (struct-out var-expr) (struct-out let-expr) (struct-out var-dead) find-dead-vars) - - -; --------- ; -; Wyrazenia ; -; --------- ; - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) -(struct var-expr (id) #:transparent) -(struct var-dead (id) #:transparent) -(struct let-expr (id e1 e2) #:transparent) - -(define (expr? e) - (match e - [(const n) (number? n)] - [(binop op l r) (and (symbol? op) (expr? l) (expr? r))] - [(var-expr x) (symbol? x)] - [(var-dead x) (symbol? x)] - [(let-expr x e1 e2) (and (symbol? x) (expr? e1) (expr? e2))] - [_ false])) - -(define (parse q) - (cond - [(number? q) (const q)] - [(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) 3) (symbol? (first q))) - (binop (first q) - (parse (second q)) - (parse (third q)))])) - -; ---------------------------------- ; -; Wyszukaj ostatnie uzycie zmiennych ; -; ---------------------------------- ; - -(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 "unbound identifier" x)] - [(eq? x (car (car xs))) (cdr (car xs))] - [else (assoc-lookup (cdr xs))])) - (assoc-lookup (environ-xs env))) -(define (env-erase x env) - (define (assoc-lookup xs) - (cond [(null? xs) (error "unbound identifier" x)] - [(eq? x (caar xs)) (cdr xs)] - [else (cons (car xs) (assoc-lookup (cdr xs)))])) - (if (env-lookup x env) - (environ (assoc-lookup (assoc-lookup (environ-xs env)))) - (environ (assoc-lookup (environ-xs env))))) - - -(define (find-dead-vars-env e env) - (match e - [(const r) (cons (const r) env)] - [(var-expr x) (if (env-lookup x env) - (cons (var-expr x) env) - (cons (var-dead x) (env-add x true env)))] - [(binop op l r) (let* ((right-expr (find-dead-vars-env r env)) - (r (car right-expr)) - (env (cdr right-expr)) - (left-expr (find-dead-vars-env l env)) - (l (car left-expr)) - (env (cdr left-expr))) - (cons (binop op l r) env))] - [(let-expr x e1 e2) (let* ((right-expr (find-dead-vars-env e2 (env-add x false env))) - (e2 (car right-expr)) - (env (env-erase x (cdr right-expr))) - (left-expr (find-dead-vars-env e1 env)) - (e1 (car left-expr)) - (env (cdr left-expr))) - (cons (let-expr x e1 e2) env))])) - -(define (find-dead-vars e) - (car (find-dead-vars-env e env-empty))) - - -(define (sample2) (find-dead-vars (let-expr 'x (const 3) - (binop '+ (var-expr 'x) - (let-expr 'x (const 5) (binop '+ (var-expr 'x) (var-expr 'x))))))) - -(define (test1) (find-dead-vars (parse '(let (x 3) (let (x (* x (+ x x))) (+ x x)))))) -(define (test2) (find-dead-vars (parse '(let (x 2) (let [x (let [x (+ x 2)] x)] x))))) -(define (test3) (find-dead-vars (parse '(let [x 2] (+ (let [x (+ 2 x)] (* 3 x)) x))))) -(define (test4) (find-dead-vars (parse '(let [x 2] (let [x (+ x 3)] (* x x)))))) -(define (test5) (find-dead-vars (parse '(let [x 2] (+ x (let [x (+ 2 x)] x)))))) -(define (test6) (find-dead-vars (parse '(let [x 2] - (let [y (let [x (* x (+ x x))] - (let [y (* x x)] - (+ y 2)))] - (+ x (* y y))))))) -(define (test7) (find-dead-vars (parse '(let [x (let [x (let [x 2] (+ x x))] (+ x x))] (+ x x))))) -;;; (define (test7) (find-dead-vars (parse '(let [x (let [x (let [x 2] (let (x 2) (+ x x)))] (+ x x))] (+ x x))))) -(define (test8) (find-dead-vars (parse '(let [x 2] (let [x 2] (+ x x)))))) \ No newline at end of file -- cgit v1.2.3