From 9477dbe667f250ecd23f8fc0d56b942191526421 Mon Sep 17 00:00:00 2001 From: Franciszek Malinka Date: Thu, 25 Feb 2021 14:42:55 +0100 Subject: Stare semestry, niepoukladane --- Semestr 2/racket/l11/solution.rkt | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) create mode 100644 Semestr 2/racket/l11/solution.rkt (limited to 'Semestr 2/racket/l11/solution.rkt') diff --git a/Semestr 2/racket/l11/solution.rkt b/Semestr 2/racket/l11/solution.rkt new file mode 100644 index 0000000..55e4ba6 --- /dev/null +++ b/Semestr 2/racket/l11/solution.rkt @@ -0,0 +1,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)))) \ No newline at end of file -- cgit v1.2.3