blob: 503099d3610fb1a187e6f381370d0fea974a12c3 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
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)))
|
