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/l7z12/solution.rkt | 95 ------------------------------------- 1 file changed, 95 deletions(-) delete mode 100644 Semestr 2/racket/l7z12/solution.rkt (limited to 'Semestr 2/racket/l7z12') diff --git a/Semestr 2/racket/l7z12/solution.rkt b/Semestr 2/racket/l7z12/solution.rkt deleted file mode 100644 index 089dee4..0000000 --- a/Semestr 2/racket/l7z12/solution.rkt +++ /dev/null @@ -1,95 +0,0 @@ -#lang racket - -(provide (struct-out const) - (struct-out binop) - (struct-out var-expr) - (struct-out let-expr) - (struct-out pos) - (struct-out var-free) - (struct-out var-bound) - annotate-expression) - -;; --------------- -;; Jezyk wejsciowy -;; --------------- - -(struct pos (file line col) #:transparent) - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) -(struct var-expr (id) #:transparent) -(struct let-expr (loc 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)] - [(let-expr loc x e1 e2) - (and (pos? loc) (symbol? x) (expr? e1) (expr? e2))] - [_ false])) - -(define (make-pos s) - (pos (syntax-source s) - (syntax-line s) - (syntax-column s))) - -(define (parse e) - (let ([r (syntax-e e)]) - (cond - [(number? r) (const r)] - [(symbol? r) (var-expr r)] - [(and (list? r) (= 3 (length r))) - (match (syntax-e (car r)) - ['let (let* ([e-def (syntax-e (second r))] - [x (syntax-e (first e-def))]) - (let-expr (make-pos (first e-def)) - (if (symbol? x) x (error "parse error!")) - (parse (second e-def)) - (parse (third r))))] - [op (binop op (parse (second r)) (parse (third r)))])] - [else (error "parse error!")]))) - -;; --------------- -;; Jezyk wyjsciowy -;; --------------- - -(struct var-free (id) #:transparent) -(struct var-bound (pos id) #:transparent) - -(define (expr-annot? e) - (match e - [(const n) (number? n)] - [(binop op l r) (and (symbol? op) (expr-annot? l) (expr-annot? r))] - [(var-free x) (symbol? x)] - [(var-bound loc x) (and (pos? loc) (symbol? x))] - [(let-expr loc x e1 e2) - (and (pos? loc) (symbol? x) (expr-annot? e1) (expr-annot? e2))] - [_ false])) - -(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) false] - [(eq? x (car (car xs))) (cdr (car xs))] - [else (assoc-lookup (cdr xs))])) - (assoc-lookup (environ-xs env))) - -(define (annotate-expression-env e env) - (match e - [(const r) (const r)] - [(binop op l r) (binop op (annotate-expression-env l env) (annotate-expression-env r env))] - [(var-expr x) (let ((pos (env-lookup x env))) - (if pos - (var-bound pos x) - (var-free x)))] - [(let-expr loc x e1 e2) (let-expr loc x (annotate-expression-env e1 env) (annotate-expression-env e2 (env-add x loc env)))])) - -(define (annotate-expression e) - (annotate-expression-env e env-empty)) - -(define (test) (annotate-expression (parse #'(let [x 5] (let [x (* x y)] (+ x y)))))) -- cgit v1.2.3