aboutsummaryrefslogtreecommitdiff
path: root/Semestr 2/racket/l11/solution.rkt
blob: 55e4ba62a03447b5b8afa71408b53c24a07d6123 (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
#lang racket

(provide (contract-out
           [with-labels with-labels/c]
           [foldr-map foldr-map/c]
           [pair-from pair-from/c]))
(provide with-labels/c foldr-map/c pair-from/c)


(define with-labels/c (parametric->/c [a b] (-> (-> a b) (listof a) (listof (cons/c b (cons/c a null?))))))

(define (with-labels f xs)
  (if (null? xs)
      null
      (cons (list (f (car xs)) (car xs)) (with-labels f (cdr xs)))))



(define foldr-map/c (parametric->/c [x a f] (-> (-> x a (cons/c f a)) a (listof x) (cons/c (listof f) a))))

(define (foldr-map f a xs)
  (define (it a xs ys)
    (if (null? xs)
        (cons ys a)
        (let [(p (f (car xs) a))]
          (it (cdr p)
              (cdr xs)
              (cons (car p) ys)))))
  (it a (reverse xs) null))


(define pair-from/c (parametric->/c [x fx gx] (-> (-> x fx) (-> x gx) (-> x (cons/c fx gx)))))

(define (pair-from f g)
  (lambda (x) (cons (f x) (g x))))