;;modyfikowalne pary/obiekty
(define (make-account balance)
  (define (withdraw amount)
    (if (>= balance amount)
        (begin (set! balance (- balance amount))
               balance)
        "Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (dispatch m)
    (cond ((eq? m 'withdraw) withdraw)
          ((eq? m 'deposit) deposit)
          (else (error "Unknown request -- MAKE-ACCOUNT"
                       m))))
  dispatch)

(define (cons x y)
  (define (set-x! v) (set! x v))
  (define (set-y! v) (set! y v))
  (define (dispatch m)
    (cond ((eq? m 'car) x)
          ((eq? m 'cdr) y)
          ((eq? m 'set-car!) set-x!)
          ((eq? m 'set-cdr!) set-y!)
          (else (error "Undefined operation -- CONS" m))))
  dispatch)

(define (car z) (z 'car))
(define (cdr z) (z 'cdr))

(define (set-car! z new-value)
  ((z 'set-car!) new-value)
  z)

(define (set-cdr! z new-value)
  ((z 'set-cdr!) new-value)
  z)
;; leniwe listy

(define (lcons x f)
  (cons x f))

(define (lhead l)
  (car l))

(define (ltail l)
  ((cdr l)))

(define (nats-from m)
  (lcons
   m
   (lambda () (nats-from (+ m 1)))))

(define nats
  (nats-from 0))

(define (take n l)
  (if (or (null? l) (= n 0))
      null
      (cons (lhead l)
            (take (- n 1) (ltail l)))))

(define (filter p l)
  (cond [(null? l) null]
        [(p (lhead l))
         (lcons (lhead l)
                (lambda ()
                  (filter p (ltail l))))]
        [else (filter p (ltail l))]))

(define (prime? n)
  (define (div-by m)
    (cond [(= m n) true]
          [(= (modulo n m) 0) false]
          [else (div-by (+ m 1))]))
  (if (< n 2)
      false
      (div-by 2)))


;; racklog
(define %male
  (%rel ()
        [('adam)]
        [('john)]
        [('joshua)]
        [('mark)]
        [('david)]))


(define %female
  (%rel ()
        [('eve)]
        [('helen)]
        [('ivonne)]
        [('anna)]))

(define %parent
  (%rel ()
        [('adam 'helen)]
        [('adam 'ivonne)]
        [('adam 'anna)]
        [('eve 'helen)]
        [('eve 'ivonne)]
        [('eve 'anna)]
        [('john 'joshua)]
        [('helen 'joshua)]
        [('ivonne 'david)]
        [('mark 'david)]))

(define %sibling
  (%rel (a b c)
        [(a b)
         (%parent c a)
         (%parent c b)]))

(define %sister
  (%rel (a b)
        [(a b)
         (%sibling a b)
         (%female a)]))


(define %ancestor
  (%rel (a b c)
        [(a b)
         (%parent a b)]
        [(a b)
         (%parent a c)
         (%ancestor c b)]))
define %my-append
  (%rel (x xs ys zs)
        [(null ys ys)]
        [((cons x xs) ys (cons x zs))
         (%my-append xs ys zs)]))

(define %my-member
  (%rel (x xs y)
        [(x (cons x xs))]
        [(y (cons x xs))
         (%my-member y xs)]))

(define %select
  (%rel (x xs y ys)
        [(x (cons x xs) xs)]
        [(y (cons x xs) (cons x ys))
         (%select y xs ys)]))

;; prosta rekurencyjna definicja
(define %simple-length
  (%rel (x xs n m)
        [(null 0)]
        [((cons x xs) n)
         (%simple-length xs m)
         (%is n (+ m 1))]))

;; test w trybie +- (działa)
(%find-all (a) (%simple-length (list 1 2) a))
;; test w trybie ++ (działa)
(%find-all () (%simple-length (list 1 2) 2))
;; test w trybie -+ (1 odpowiedź, pętli się)
(%which (xs) (%simple-length xs 2))
;; test w trybie -- (nieskończona liczba odpowiedzi)
(%which (xs a) (%simple-length xs a))

;; definicja zakładająca, że długość jest znana
(define %gen-length
  (%rel (x xs n m)
        [(null 0) !]
        [((cons x xs) n)
         (%is m (- n 1))
         (%gen-length xs m)]))
;; test w trybie ++ (działa)
(%find-all () (%gen-length (list 1 2) 2))
;; test w trybie -+ (działa)
(%find-all (xs) (%gen-length xs 2))


;; funkcje proste

(define (append xs ys)
  (if (null? xs)
      ys
      (cons (car xs) (append (cdr xs) ys))))

(define (mult-append . x)
  (define (iter xs acc)
    (if (null? xs)
        acc
        (append (car xs) (iter (cdr xs) acc))))
  (iter x null))

(define (map f xs)
  (if (null? xs)
      null
      (cons (f (car xs))
            (map f (cdr xs)))))

(define (foldr f start xs)
  (if (null? xs)
      start
      (f (car xs) (foldl f start (cdr xs)))))

(define (foldl f start xs)
  (if (null? xs)
      start
      (foldl f (f (car xs) start) (cdr xs))))

(define (reverse xs)
  (if (null? xs)
      null
      (append (reverse (cdr xs)) (list (car xs)))))

(define (reverseI xs)
  (define (reverse-iter xs acc)
    (if (null? xs)
        acc
        (reverse-iter (cdr xs) (cons (car xs) acc))))
  (reverse-iter xs null))
#lang racket

;; spoko funkcje


(define (reverse-rek xs)
  (if (pair? xs)
      (append (reverse-rek (cdr xs)) (cons (car xs) null))
      xs))

(define (fold-right op nval xs) ;; spoko funkcja
  (if (null? xs)
      nval
      (op (car xs)
          (fold-right op nval (cdr xs)))))


(define (insert xs n)
  (if (> n (car xs))
      (cons (car xs) (insert (cdr xs) n))
      (cons n xs)))


(define (append-s . xs)
  (fold-right append null xs))

(define (permi xs)
  (if (null? xs)
      null
      (append-s (map (lambda (zs) (insert (car zs) zs)) (permi (cdr xs))))))



(define (mirror tree) ;3
  (if (leaf? tree)
      tree
      (make-node (node-val tree )
                 (mirror (node-right tree))
                 (mirror (node-left tree)))))

(define (flatten tree) ;4
  (if (leaf? tree)
      null
      (append (flatten (node-left tree))
            (cons (node-val tree)
                  (flatten (node-right tree))))))

(define (treesort xs) ;5
  (define (treesorcik xs tree)
    (if (null? xs)
        tree
       (treesorcik (cdr xs) (bst-insert (car xs) tree))))
  (flatten (treesorcik xs 'leaf)))

(define (append xs ys)
  (if (null? xs)
      ys
      (cons (car xs) (append (cdr xs) ys))))

(define (map f xs)
  (if (null? xs)
      null
      (cons (f (car xs))
            (map f (cdr xs)))))

(define (flatten2 t)
  (define (flat t acc)
    (if (leaf? t)
        acc
        (flat (node-left t) (cons (node-value t) (flat (node-right t) acc)))))
  (flat t null))


;;interpreter
    [(if? e)
         (if (val->bool (eval-env (if-cond e) env))
             (eval-env (if-then e) env)
             (eval-env (if-else e) env))]
        [(cond? e)
         (eval-cond-clauses (cond-clauses e) env)]
        [(var? e)
         (find-in-env (var-var e) env)]
        [(lambda? e)
         (closure-cons (lambda-vars e) (lambda-expr e) env)]
        [(lambda-rec? e)
         (closure-rec-cons (lambda-rec-name e)
                           (lambda-rec-vars e)
                           (lambda-rec-expr e)
                           env)]
        [(app? e)
         (apply-closure ;; gdy podamy (list lambda-rec/lamba argumenty)
           (eval-env (app-proc e) env) ;; <- wylicza domkniecie
           (map (lambda (a) (eval-env a env)) ;;<- ewaluuję podaną liste argumentów
                (app-args e)))])) ;; cala funkcja polega na dodaniu do srodowika argumentu z lambda-rec/lambda polaczony z ewaluowana lista argumentow
;;                                     i a nastepnie ewaluacji lambda-rec-expr/lambda-expr; z Lambda podobnie, tylko ze nie laczy nazwy lambdy
;;                                       z expr

(define (eval-cond-clauses cs env)
  (if (null? cs)
      (error "no true clause in cond")
      (let ([cond (cond-clause-cond (car cs))]
            [expr (cond-clause-expr (car cs))])
           (if (val->bool (eval-env cond env))
               (eval-env expr env)
               (eval-cond-clauses (cdr cs) env)))))

(define (apply-closure c args)
  (cond [(closure? c)
         (eval-env
            (closure-expr c)
            (env-for-closure
              (closure-vars c)
              args
              (closure-env c)))]
        [(closure-rec? c)
         (eval-env
           (closure-rec-expr c)
           (add-to-env
            (closure-rec-name c)
            c
            (env-for-closure
              (closure-rec-vars c)
              args
              (closure-rec-env c))))]))

(define x2 (lambda-rec-cons '(mnozenie x ) '(* x 2)))




(define (env-for-closure xs vs env)
  (cond [(and (null? xs) (null? vs)) env]
        [(and (not (null? xs)) (not (null? vs)))
         (add-to-env
           (car xs)
           (car vs)
           (env-for-closure (cdr xs) (cdr vs) env))]
        [else (error "arity mismatch")])) ;; dodaje rownolegle zmienne z definicji domkniecia z argumentami

(define (env-for-let def env)
  (add-to-env
    (let-def-var def)
    (eval-env (let-def-expr def) env) ;; dodaje symbol z def-leta do srodowiska wraz z ewaluacja wyrazenia z definicji
    env))

;;kontrakty
(define/contract ( x y
(-> predykat? predykat? predykat?)
(def funkcji)

(define natural/c (and/c integer? (not/c negative?)))
(define exact-natural/c (and/c natural/c exact?))
(define positive-natural/c (and/c integer? positive?))

(define/contract (jakiesgowno f x)
(-> (-> number? number?) number? (-> number? number?))
      ^^ to tyczy sie f   ^x       ^ zwraca funkcje ktora bierze number i zwraca number


;; wyłącznie wyniki funkcji f
(define/contract (map f xs)
  (let ([a (new-?/c 'a)] <- ważne
        [b (new-?/c 'b)]) <- ważne mówi o tym że f zmienia z a na b i wynikowa lista bedzie tylko z b sie skladala
    (-> (-> a b) (listof a) (listof b)))
  (if (null? xs)
      null
      (cons (f (car xs))
            (map f (cdr xs)))))


(define sort2/c jakis konrakt)

(define/contract sort sort2/c funkcja) <- funkcja z kontraktem sort2

(and/c (listof integer?) sorted?) <- w kontrakcie mogą być normalnie zdefiniowane predykaty

 [dict-insert (->i ([d dict?]
                       [k string?]
                       [v any/c])
                      [result (and/c dict? (not/c dict-empty?))]
                      #:post (result k v)
                      (let ((p (dict-lookup result k)))
                        (and
                          (pair? p)
                          (eq? (car p) k)
                          (eq? (cdr p) v))))]
    [dict-remove (->i ([d dict?]
                       [k string?])
                      [result dict?]
                      #:post (result k)
                      (eq? #f (dict-lookup result k)))]
    [dict-lookup (->i ([d dict?]
                       [k string?])
                     (result (or/c (cons/c string? any/c) #f))
                     #:post (result d)
                     (if (dict-empty? d) (eq? #f result) #t))])))


(->



;;typowany racket

#lang typed/racket

(: funkcja (typy))
(: funkcja (All (A B) (-> A A B) <- wszystko mozemy podac jako A i sie bedzie zgadzac)

(define-type (Node A B) (List 'node A B B))

(define-predicate node? (Node Any Any))

(:print-type node?)
dało by (-> Any Boolean : (List 'node Any Any Any))

(define-type (Node A B) (List 'node A B B) )

 (define-predicate node? (Node Any Any))


(define-type Rat (Pairof Integer Integer))


(define-type Gowno Integer)

(define-predicate kupa? Gowno)

(define-predicate git? Integer)



(: make-rat (-> Integer Integer Rat))
(define (make-rat n d)
  (let ((c (gcd n d)))
    (cons (quotient n c) (quotient d c))))


(define-type BinopRel (U '= '>))
(define-type BinopBool (U 'and 'or))
(define-type BinopSym (U BinopNum BinopRel BinopBool))
(struct expr-binop ([op : BinopSym] [l : Expr] [r : Expr]))
(struct expr-if ([c : Expr] [t : Expr] [f : Expr]))
(struct expr-let ([var : Symbol] [def : Expr] [expr : Expr]))
(define-type Literal (U Integer Boolean))
(define-type Expr (U Symbol Literal expr-binop expr-if expr-let))

(define-predicate literal? Literal)
(define-predicate op-num? BinopNum)
(define-predicate op-rel? BinopRel)
(define-predicate op-bool? BinopBool)

;; środowiska

(define-type Value (U Integer Boolean))
(define-type (Env A) (Listof (List Symbol A)))
(define-type VEnv (Env Value))

(: empty-env (All (A) (-> (Env A))))
(define (empty-env)
  null)

(: add-to-env (All (A) (-> Symbol A (Env A) (Env A))))
(define (add-to-env x v env)
  (cons (list x v) env))

;; słowniki
#lang racket

;; sygnatura słowników bez kontraktów
;(define-signature dict^
;  (dict? dict-empty? empty-dict dict-insert dict-remove dict-lookup))

;; sygnatura słowników z prostymi kontraktami
;(define-signature dict^
;  ((contracted
;    [dict?       (-> any/c boolean?)]
;    [dict-empty? (-> dict? boolean?)]
;    [empty-dict  (and/c dict? dict-empty?)]
;    [dict-insert (-> dict? string? any/c dict?)]
;    [dict-remove (-> dict? string? dict?)]
;    [dict-lookup (-> dict? string?
;                     (or/c (cons/c string? any/c) #f))])))

;; sygnatura słowników z kontraktami zależnymi
(define-signature dict^
  ((contracted
    [dict?       (-> any/c boolean?)]
    [dict-empty? (-> dict? boolean?)]
    [empty-dict  (and/c dict? dict-empty?)]
    [dict-insert (->i ([d dict?]
                       [k string?]
                       [v any/c])
                      [result (and/c dict? (not/c dict-empty?))]
                      #:post (result k v)
                      (let ((p (dict-lookup result k)))
                        (and
                          (pair? p)
                          (eq? (car p) k)
                          (eq? (cdr p) v))))]
    [dict-remove (->i ([d dict?]
                       [k string?])
                      [result dict?]
                      #:post (result k)
                      (eq? #f (dict-lookup result k)))]
    [dict-lookup (->i ([d dict?]
                       [k string?])
                     (result (or/c (cons/c string? any/c) #f))
                     #:post (result d)
                     (if (dict-empty? d) (eq? #f result) #t))])))

;; implementacja słowników na listach
(define-unit dict-list@
  (import)
  (export dict^)

  (define (dict? d)
    (and (list? d)
         (eq? (length d) 2)
         (eq? (car d) 'dict-list)))

  (define (dict-list d) (cadr d))
  (define (dict-cons l) (list 'dict-list l))

  (define (dict-empty? d)
    (eq? (dict-list d) '()))

  (define empty-dict (dict-cons '()))

  (define (dict-lookup d k) (assoc k (dict-list d)))

  (define (dict-remove d k)
    (dict-cons (remf (lambda (p) (eq? (car p) k)) (dict-list d))))

  (define (dict-insert d k v)
    (dict-cons (cons (cons k v)
                     (dict-list (dict-remove d k))))))

;; otwarcie implementacji słownika
(define-values/invoke-unit/infer dict-list@)