From 9477dbe667f250ecd23f8fc0d56b942191526421 Mon Sep 17 00:00:00 2001
From: Franciszek Malinka <franciszek.malinka@gmail.com>
Date: Thu, 25 Feb 2021 14:42:55 +0100
Subject: Stare semestry, niepoukladane

---
 Semestr 2/racket/lista6/zad11/solution.bak | 36 +++++++++++++++++++
 Semestr 2/racket/lista6/zad11/solution.rkt | 58 ++++++++++++++++++++++++++++++
 2 files changed, 94 insertions(+)
 create mode 100644 Semestr 2/racket/lista6/zad11/solution.bak
 create mode 100644 Semestr 2/racket/lista6/zad11/solution.rkt

(limited to 'Semestr 2/racket/lista6/zad11')

diff --git a/Semestr 2/racket/lista6/zad11/solution.bak b/Semestr 2/racket/lista6/zad11/solution.bak
new file mode 100644
index 0000000..f449481
--- /dev/null
+++ b/Semestr 2/racket/lista6/zad11/solution.bak	
@@ -0,0 +1,36 @@
+#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
+;; ----------
+
+(define (rpn->arith e)
+  (error "TODO: Uzupelnij tutaj"))
+
+; Mozesz tez dodac jakies procedury pomocnicze i testy
\ No newline at end of file
diff --git a/Semestr 2/racket/lista6/zad11/solution.rkt b/Semestr 2/racket/lista6/zad11/solution.rkt
new file mode 100644
index 0000000..a44afe4
--- /dev/null
+++ b/Semestr 2/racket/lista6/zad11/solution.rkt	
@@ -0,0 +1,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
\ No newline at end of file
-- 
cgit v1.2.3