blob: a44afe4f58a747f04acb39c41c6fa8c1af817d34 (
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
|
#lang racket
(provide (struct-out const) (struct-out binop) rpn->arith)
;; -------------------------------
;; Wyrazenia w odwr. not. polskiej
;; -------------------------------
(define (rpn-expr? e)
(and (list? e)
(pair? e)
(andmap (lambda (x) (or (number? x) (member x '(+ - * /))))
e)))
;; ----------------------
;; Wyrazenia arytmetyczne
;; ----------------------
(struct const (val) #:transparent)
(struct binop (op l r) #:transparent)
(define (arith-expr? e)
(match e
[(const n) (number? n)]
[(binop op l r)
(and (symbol? op) (arith-expr? l) (arith-expr? r))]
[_ false]))
;; ----------
;; Kompilacja
;; ----------
(struct stack (xs))
(define empty-stack (stack null))
(define (empty-stack? s) (null? (stack-xs s)))
(define (top s) (car (stack-xs s)))
(define (push a s) (stack (cons a (stack-xs s))))
(define (pop s) (stack (cdr (stack-xs s))))
(define (op->proc op)
(match op ['+ +] ['- -] ['* *] ['/ /]))
(define (eval-am e s)
(cond [(null? e)
(top s)]
[(number? (car e))
(eval-am (cdr e) (push (const (car e)) s))]
[(symbol? (car e))
(eval-am (cdr e)
(push (binop (car e) (top (pop s)) (top s))
(pop (pop s))))]))
(define (rpn->arith e)
(eval-am e empty-stack))
; Mozesz tez dodac jakies procedury pomocnicze i testy
|
