#lang racket

;; pomocnicza funkcja dla list tagowanych o określonej długości

(define (tagged-tuple? tag len p)
  (and (list? p)
       (= (length p) len)
       (eq? (car p) tag)))

(define (tagged-list? tag p)
  (and (pair? p)
       (eq? (car p) tag)
       (list? (cdr p))))

;;
;; WHILE
;;

; memory

(define empty-mem
  null)

(define (set-mem x v m)
  (cond [(null? m)
         (list (cons x v))]
        [(eq? x (caar m))
         (cons (cons x v) (cdr m))]
        [else
         (cons (car m) (set-mem x v (cdr m)))]))

(define (get-mem x m)
  (cond [(null? m) 0]
        [(eq? x (caar m)) (cdar m)]
        [else (get-mem x (cdr m))]))

; arith and bool expressions: syntax and semantics

(define (const? t)
  (number? t))

(define (true? t)
  (eq? t 'true))

(define (false? t)
  (eq? t 'false))

(define (op? t)
  (and (list? t)
       (member (car t) '(+ - * / = > >= < <= not and or mod expt))))

(define (op-op e)
  (car e))

(define (op-args e)
  (cdr e))

(define (op->proc op)
  (cond [(eq? op '+) +]
        [(eq? op '*) *]
        [(eq? op '-) -]
        [(eq? op '/) /]
        [(eq? op '=) =]
        [(eq? op '>) >]
        [(eq? op '>=) >=]
        [(eq? op '<)  <]
        [(eq? op '<=) <=]
        [(eq? op 'not) not]
        [(eq? op 'and) (lambda x (andmap identity x))]
        [(eq? op 'or) (lambda x (ormap identity x))]
        [(eq? op 'mod) modulo]
        [(eq? op 'expt) expt]))

(define (var? t)
  (symbol? t))

(define (eval-arith e m)
  (cond [(true? e) true]
        [(false? e) false]
        [(var? e) (get-mem e m)]
        [(op? e)
         (apply
          (op->proc (op-op e))
          (map (lambda (x) (eval-arith x m))
               (op-args e)))]
        [(const? e) e]))

;; syntax of commands

(define (assign? t)
  (and (list? t)
       (= (length t) 3)
       (eq? (second t) ':=)))

(define (assign-var e)
  (first e))

(define (assign-expr e)
  (third e))

(define (if? t)
  (tagged-tuple? 'if 4 t))

(define (if-cond e)
  (second e))

(define (if-then e)
  (third e))

(define (if-else e)
  (fourth e))

(define (while? t)
  (tagged-tuple? 'while 3 t))

(define (while-cond t)
  (second t))

(define (while-expr t)
  (third t))

(define (block? t)
  (list? t))

;; state

(define (res v s)
  (cons v s))

(define (res-val r)
  (car r))

(define (res-state r)
  (cdr r))

;; psedo-random generator

(define initial-seed
  123456789)

(define (rand max)
  (lambda (i)
    (let ([v (modulo (+ (* 1103515245 i) 12345) (expt 2 32))])
      (res (modulo v max) v))))

;; WHILE interpreter

(define (old-eval e m)
  (cond [(assign? e)
         (set-mem
          (assign-var e)
          (eval-arith (assign-expr e) m)
          m)]
        [(if? e)
         (if (eval-arith (if-cond e) m)
             (old-eval (if-then e) m)
             (old-eval (if-else e) m))]
        [(while? e)
         (if (eval-arith (while-cond e) m)
             (old-eval e (old-eval (while-expr e) m))
             m)]
        [(block? e)
         (if (null? e)
             m
             (old-eval (cdr e) (old-eval (car e) m)))]))
;; ZAD B

(define (my-res val mem) ;;moja abstrakcja danych do eval-arith-n
  (cons val mem))
(define (my-val e)
  (car e))
(define (my-mem e)
  (cdr e))

(define (eval e m seed) ;;seed bedzie w memory
  (define (eval-h e m) ;;działa podobnie do old z wyjątkiem takim że po wykonaniu eval-arith-n
  (cond [(assign? e)  ;;zwróci pare wartość i pamięć w której może być zmodyfkiowana zmienna seed
         (let ((expr (eval-arith-n (assign-expr e) m)))
           (set-mem
            (assign-var e)
            (my-val expr)
            (my-mem expr)))]
        [(if? e)
         (let ((if-cond-res (eval-arith-n (if-cond e) m)))
         (if (my-val if-cond-res)
             (eval-h (if-then e) (my-mem if-cond-res))
             (eval-h (if-else e) (my-mem if-cond-res))))]
        [(while? e)
         (let ((while-cond-res (eval-arith-n (while-cond e) m)))
           (if (my-val while-cond-res)
               (eval-h e (eval-h (while-expr e) (my-mem while-cond-res)))
               (my-mem while-cond-res)))]
        [(block? e)
         (if (null? e)
             m
             (eval-h (cdr e) (eval-h (car e) m)))]))
  (eval-h e (set-mem 'seed seed m)))

(define (rand? e) ;;predykat do rand
  (and (list? e)
       (= (length e) 2)
       (eq? (car e) 'rand)))

(define (eval-arith-n e m) ;;teraz zwróci wartość i memory
  (cond [(true? e) (my-res true m)]
        [(false? e) (my-res false m)]
        [(var? e) (my-res (get-mem e m) m)]
        [(rand? e) ((lambda (max) (let* ([max-res (eval-arith-n max m)] ;;najpierw wyliczy max
                                       [res ((rand (my-val max-res)) (get-mem 'seed (my-mem max-res)))]) ;;potem robi rand na seedzie z memory wyciagniętego z policzonego max
                                 (my-res (car res) ;;tworzy pare z wartości
                                       (set-mem 'seed (cdr res) m))));;i pamięci z zupdatowanym seedem
                    (second e))] ;;nakarmi randa drugim elementem
        [(op? e)
         (let ((res (mymap (op-args e) m))) ;;wykona
         (my-res
          (apply (op->proc (op-op e)) (car res)) ;; (car res) trzyma zmapowana liste eval-arithem
                 (cdr res)))] ;;memory
        [(const? e) (my-res e m)]))


(define (mymap args m) ;;dziala jak map z napisany iteracyjne zwraca pare (zmapowana liste i pamiec)
  (define (iter arg acc m) ;;mapuje eval-arithem z ciągle przekazywaną pamięcią
    (if (null? arg)
        (cons (reverse acc) m)
        (let ((res (eval-arith-n (car arg) m)))
          (iter (cdr arg) (cons (my-val res) acc) (my-mem res)))))
  (iter args null m))




(define (run e)
  (eval e empty-mem initial-seed))

;;ZAD A

(define fermat-test
  '{
    (composite := false)
    (while (and (> k 0) (not composite) (not (= n 2)) (not (= n 3))) { ;;2 i 3 wyrzucam
            (a := (+ 2 (rand (- n 3))))
            (if (not (= (mod (expt a (- n 1)) n) 1))
                (composite := true) ())
            (k := (- k 1))})
    }
  )

(define (probably-prime? n k) ; check if a number n is prime using
                              ; k iterations of Fermat's primality
                              ; test
  (let ([memory (set-mem 'k k
                (set-mem 'n n empty-mem))])
    (not (get-mem
           'composite
           (eval fermat-test memory initial-seed)))))

(define (test n k) ;;do debugowania pokaże pamięć a nie tylko #t #f
  (let ([memory (set-mem 'k k
                (set-mem 'n n empty-mem))])
           (eval fermat-test memory initial-seed)))


(display "101? ")
(probably-prime? 101 1000)
(display "2? ")
(probably-prime? 2 100)
(display "3? ")
(probably-prime? 3 100)
(display "4? ")
(probably-prime? 4 10)
(display "5? ")
(probably-prime? 5 100)
(display "10? ")
(probably-prime? 10 100)
(display "14? ")
(probably-prime? 14 88)
(display "9? ")
(probably-prime? 9 11)
(display "21? ")
(probably-prime? 21 37)
(display "13? ")
(probably-prime? 13 37)
(display "42? ")
(probably-prime? 42 100)
(display "18? ")
(probably-prime? 18 100)
(display "100? ")
(probably-prime? 100 100)
(display "20443? ")
(probably-prime? 20443 100)
(display "22501? ")
(probably-prime? 22501 10)
(display "95111? ")
(probably-prime? 95111 10)
(display "1000000? ")
(probably-prime? 1000000 10)
(display "104639? ")
(probably-prime? 104639 10)