Makra 2 Makro realizující let pomocí -výraz· ;; základní let umoº¬ující vázat hodnoty (define-macro let (lambda (assgn . body) `((lambda ,(map car assgn) (begin ,@body)) ,@(map cadr assgn)))) (let ((x 10) (y (+ x 1))) (list x y)) + ((lambda (x y) (begin (list x y))) 10 (+ x 1)) Z=)    (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 2 / 41 Pojmenovaný let ;; pojmenovaný let umoº¬ující vázat hodnoty (define-macro let (lambda (sym assgn . body) `((lambda () (define ,syn (lambda ,(map car assgn) (begin ,@body))) (,sym ,@(map cadr assgn)))) (let func ((x 10) (y (+ x 1))) (list func x y)) + ((lambda () (define func (lambda (x y) (begin (list func x y)))) (func 10 (+ x 1)))) Z=)    (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 3 / 41 Ob� let� � jedno� ;� makr� rozli²uj� pojmenovaný/nepojmenovan� le� (define-macr� le� (lambd� arg� (i� (symbol� (ca� args)� ;� pojmenovan� le� `((lambd� (� (defin� ,(ca� args� (lambd� ,(ma� ca� (cad� args)� (begi� ,@(cdd� args)))� (,(ca� args� ,@(ma� cad� (cad� args))))� ;� nepojmenovan� le� `((lambd� ,(ma� ca� (ca� args)� (begi� ,@(cd� args))� ,@(ma� cad� (ca� args)))))� (KI� U� Olomouc� P� 2A� Lekc� � Makr� I� � � 4� let* pomocí rekurzivního vno°ení (define-macro let* (lambda (assgn . body) (define iter (lambda (assgn) (if (null? assgn) `((lambda () ,@body)) `((lambda (,(caar assgn)) ,(iter (cdr assgn))) ,(cadar assgn))))) (iter assgn))) (let* ((x 10) (y (+ x 1))) (list x y)) Z=) ((lambda (x) ((lambda (y) ((lambda () (list x y)))) (+ x 1))) 10) Z=)    (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 5 / 41 let� jak� rekurzivn� makr� (define-macr� let� (lambd� (assg� � body� (i� (null� assgn� `((lambd� (� ,@body)� `((lambd� (,(caa� assgn)� (let� ,(cd� assgn� ,@body)� ,(cada� assgn))))� let� jak� rekurzivn� makr� vyuºívajíc� vytvo°en� le� (define-macr� let� (lambd� (assg� � body� (i� (null� assgn� `((lambd� (� ,@body)� `(le� (,(ca� assgn)� (let� ,(cd� assgn� ,@body))))� (KI� U� Olomouc� P� 2A� Lekc� � Makr� I� � � 4� Poku� pouºijem� míst� (lambd� (� ,@body� form� begi� takto� (define-macr� let� (lambd� (assg� � body� (i� (null� assgn� `(begi� ,@body� `(le� (,(ca� assgn)� (let� ,(cd� assgn� ,@body))))� ta� bud� mí� ná� let� jin� význa� nap°íklad� (let� (� (defin� � 10)� b� provedl� denic� � globální� prost°ed� (!!� (KI� U� Olomouc� P� 2A� Lekc� � Makr� I� � � 4� letrec� pomoc� set� (define-macr� letre� (lambd� (assg� � body� `((lambd� ,(ma� ca� assgn� ,@(ma� (lambd� (i� `(set� ,(ca� i� ,(cad� i))� assgn� ,@body� ,@(ma� (lambd� (i� #f� assgn)))� letrec� pomoc� defin� (define-macr� letre� (lambd� (assg� � body� `((lambd� (� ,@(ma� (lambd� (i� `(defin� ,(ca� i� ,(cad� i))� assgn� ,@body)))� (KI� U� Olomouc� P� 2A� Lekc� � Makr� I� � � 4� Makr� pr� vytvá°en� rekurzivníc� procedu� Makr� pr� vytvá°en� rekurzivníc� procedu� be� defin� pouºívám� princi� � -kombinátor� (define-macr� procedur� (lambd� (arg� � body� `(lambd� ,arg� ((lambd� (y� (� � ,@args)� (lambd� (self� ,@args� ,@body))))� makr� realizujíc� volán� seb� sam� (define-macr� sel� (lambd� arg� `(self� self� ,@args))� (KI� U� Olomouc� P� 2A� Lekc� � Makr� I� � � 4� P°íkla� pouºití� (procedur� (n� (i� (� � 1� � (� � (sel� (� � 1))))))� � (lambd� (n� ((lambd� (y� (� � n)� (lambd� (self� n� (i� (� � 1� � (� � (sel� (� � 1))))))� � (je²t� p� expanz� self� (lambd� (n� ((lambd� (y� (� � n)� (lambd� (self� n� (i� (� � 1� � (� � (self� self� (� � 1))))))� (KI� U� Olomouc� P� 2A� Lekc� � Makr� I� 1� � 4� P°íklad pouºití: (let ((f (procedure (n) (if (= n 1) 1 (* n (self (- n 1))))))) (map f '(1 2 3 4 5 6 7))) má jednu drobnou vadu na kráse: self se uvnit° procedury nechová jako procedura: (let ((f (procedure (x) (if (list? x) (apply + (map self x)) 1)))) (f '(a ((b c) ((d))) ((e) f)))) Z=) Error (self není procedura) (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 11 / 41 e²ení p°edchozího problému (define-macro procedure (lambda (args . body) `(lambda ,args ((lambda (y) (y y ,@args)) (lambda (self ,@args) (let ((self (lambda ,args (self self ,@args)))) ,@body)))))) P°íklad: (let ((f (procedure (x) (if (list? x) (apply + (map self x)) 1)))) (f '(a ((b c) ((d))) ((e) f)))) Z=) 6 (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 12 / 41 e²en� p°edchozíh� problém� P°íklad� (le� ((� (procedur� (x� (i� (list� x� (appl� � (ma� sel� x)� 1)))� (� '(� ((� c� ((d))� ((e� f)))� � (le� ((� (lambd� (x� ((lambd� (y� (� � x)� (lambd� (sel� x� (le� ((sel� (lambd� (x� (sel� sel� x)))� (i� (list� x� (appl� � (ma� sel� x)� 1))))))� (� '(� ((� c� ((d))� ((e� f)))� (KI� U� Olomouc� P� 2A� Lekc� � Makr� I� 1� � 4� Speciální forma let-values: na²e vylep²ené let P°íklad pouºití let-values: (let ((seznam `("Vilem" 100 blah ,(+ 1 2)))) (let-values ((blah 10) ((name value next comment) seznam) ((v n c) (cdr seznam)) (x (+ 10 20))) (list blah name value next comment v n c x))) Z=) (10 "Vilem" 100 blah 3 100 blah 3 30) (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 14 / 41 P°íkla� pouºit� let-values� (le� ((sezna� `("Vilem� 10� bla� ,(� � 2)))� (let-value� ((bla� 10� ((nam� valu� nex� comment� seznam� ((� � c� (cd� seznam)� (� (� 1� 20))� (lis� bla� nam� valu� nex� commen� � � � x))� � (le� ((sezna� `("Vilem� 10� bla� ,(� � 2)))� (appl� (lambd� (bla� nam� valu� nex� commen� � � � x� (begi� (lis� bla� nam� valu� nex� commen� � � � x))� (appen� (lis� 10� sezna� (cd� seznam� (lis� (� 1� 20))))� (KI� U� Olomouc� P� 2A� Lekc� � Makr� I� 1� � 4� Implementac� makra� (define-macr� let-value� (lambd� (assg� � body� `(appl� (lambd� ,(appl� appen� (ma� (lambd� (x� (i� (list� (ca� x)� (ca� x� (lis� (ca� x)))� assgn)� (begi� ,@body)� (appen� ,@(ma� (lambd� (x� (i� (list� (ca� x)� (cad� x� `(lis� ,(cad� x)))� assgn))))� (KI� U� Olomouc� P� 2A� Lekc� � Makr� I� 1� � 4� Speciální forma letref: na²e vylep²ení letrec ;; forma umí obnovit hodnoty vazeb, pokud byly zm¥n¥ny, nap°íklad: (letref ((x 10) (f (lambda (n) (if (= n 0) 1 (* n (f (- n 1)))))) (y 100)) (display x) zobrazí: 10 (newline) (set! x (f 20)) (display x) zobrazí: 2432902008176640000 (newline) (refresh 'x) provede návrat k p·vodní hodnot¥ (display x) zobrazí: 10 (newline) #f) Z=) #f (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 16 / 41 Tém¥� správn� °e²ení� (define-macr� letre� (lambd� (binding� � body� `((lambd� (� ,@(ma� (lambd� (b� `(defin� ,(ca� b� ,(cad� b))� bindings� (defin� refres� (lambd� (symbol� (con� ,@(ma� (lambd� (x� `((equal� symbo� ',(ca� x)� (set� ,(ca� x� ,(cad� x)))� bindings)))� (begi� ,@body))))� (KI� U� Olomouc� P� 2A� Lekc� � Makr� I� 1� � 4� (letref ((x 10) (f (lambda (n) (if (= n 0) 1 (* n (f (- n 1)))))) (y 100)) (display x) (newline) (set! x (f 20)) (display x) (newline) (refresh 'x) (display x) (newline) #f) Z=) #f + ((lambda () (define x 10) (define f (lambda (n) (if (= n 0) 1 (* n (f (- n 1)))))) (define y 100) (define refresh (lambda (symbol) (cond ((equal? symbol 'x) (set! x 10)) ((equal? symbol 'f) (set! f (lambda (n) ...))) ((equal? symbol 'y) (set! y 100))))) ... (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 18 / 41 ((lambd� (� (defin� � 10� (defin� � (lambd� (n� (i� (� � 0� � (� � (� (� � 1)))))� (defin� � 100� (defin� refres� (lambd� (symbol� (con� ((equal� symbo� 'x� (set� � 10)� ((equal� symbo� 'f� (set� � (lambd� (n� ...))� ((equal� symbo� 'y� (set� � 100))))� (begi� (displa� x� (newline� (set� � (� 20)� (displa� x� (newline� (refres� 'x� (displa� x� (newline� #f))� (KI� U� Olomouc� P� 2A� Lekc� � Makr� I� 1� � 4� V p°ípad¥ vedlej²ího efektu se dostaneme do problému: (letref ((i 0) (x (begin (display "VOLANA") (set! i (+ i 1)) i))) (display (list i x)) zobrazí: (1 1) (set! x 'blah) (display (list i x)) zobrazí: (1 blah) (refresh 'x) dojde k druhému vyhodnocení (display (list i x)) zobrazí: (2 2) #f) Z=) #f Protoºe refresh vypada takto: (define refresh (lambda (symbol) (cond ((equal? symbol 'i) (set! i 0)) ((equal? symbol 'x) (set! x (begin (display "VOLANA") (set! i (+ i 1)) i)))))) (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 20 / 41 P°edchoz� vad� odstraním� p°eprogramování� refres� (define-macr� letre� (lambd� (binding� � body� `((lambd� (� ,@(ma� (lambd� (b� `(defin� ,(ca� b� ,(cad� b))� bindings� (defin� refres� (le� ((me� (lis� ,@(ma� (lambd� (x� `(con� ',(ca� x� ,(ca� x))� bindings)))� (lambd� (symbol� (con� ,@(ma� (lambd� (x� `((equal� symbo� ',(ca� x)� (set� ,(ca� x� (cd� (asso� ',(ca� x� mem))))� bindings))))� (begi� ,@body))))� (KI� U� Olomouc� P� 2A� Lekc� � Makr� I� 2� � 4� Expandovan� kó� p°edchoz� ukázk� bud� vypada� takto� ((lambd� (� (defin� � 0� (defin� � (begi� (displa� "VOLANA"� (set� � (� � 1)� i)� (defin� refres� (le� ((me� (lis� (con� '� i� (con� '� x)))� (lambd� (symbol� (con� ((equal� symbo� 'i� (set� � (cd� (asso� '� mem)))� ((equal� symbo� 'x� (set� � (cd� (asso� '� mem)))))))� (begi� (displa� (lis� � x)� (set� � 'blah� (displa� (lis� � x)� (refres� 'x� (displa� (lis� � x)� #f))� (KI� U� Olomouc� P� 2A� Lekc� � Makr� I� 2� � 4� Motivace: Chceme vy°e²it problém se symbol capture V následujícím makru dochází k zachyceni symbolu curval (define-macro capture (lambda body `(let ((curval 100)) ,@body))) P°íklad pouºití: (let ((curval 10)) (capture (display "Hodnota: ") (display curval) (newline) (+ curval 1))) Z=) 101 (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 23 / 41 Motivace: Chceme vy°e²it problém se symbol capture D·vod zachycení symbolu (capture (display "Hodnota: ") (display curval) (newline) (+ curval 1)) + (let ((curval 100)) (display "Hodnota: ") (display curval) (newline) (+ curval 1)) Z=) 101 (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 24 / 41 P°edchozí problém lze £ist¥ vy°e²it zavedením nového typu symbol·. V²echny symboly, které jsme doposud uvaºovali byly tzv. pojmenované. 'ahoj Z=) element symbol, který má jméno ahoj 'blah Z=) element symbol, který má jméno blah' (define s 'ahoj) na s se naváºe ahoj s Z=) ahoj (to jest na s je jako hodnota navázaný symbol) Porovnávání pojmenovaných symbol· probíhá vzhledem k jejich jmén·m. (equal? 'ahoj 'blah) Z=) #f (equal? 'ahoj 'ahoj) Z=) #t (eq? 'ahoj 'blah) Z=) #f (eq? 'ahoj 'ahoj) Z=) #t D·vod: v prost°edích se hledají vazby podle jmen symbol·, nikoliv podle jejich fyzického uloºení v pam¥ti. (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 25 / 41 Nový typ symbolu: bezejmenný (generovaný) symbol: vzniká voláním procedury bez argumentu gensym, kaºdý generovaný symbol je roven pouze sám sob¥, nemá ºádnou £itelnou externí reprezentaci . (gensym) Z=) nov¥ vygenerovaný symbol (symbol? (gensym)) Z=) #t (equal? (gensym) (gensym)) Z=) #f (define s (gensym)) (equal? s s) Z=) #t s Z=) g3 (vypí²e Dr. Scheme) Poznámka: i kdyby interpret dva nov¥ vygenerované symboly vypisoval stejn¥ , nejedná se o týº symbol. (!) (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 26 / 41 e²en� motiva£níh� problém� místo� (define-macr� captur� (lambd� bod� `(le� ((curva� 100)� ,@body))� napí²eme� (define-macr� no-captur� (lambd� bod� (le� ((new-unnamed-symbo� (gensym))� `(le� ((,new-unnamed-symbo� 100)� ,@body)))� N� new-unnamed-symbo� bud� vázá� nov� vygenerovan� symbol� Jeliko� j� tent� symbo� bez� jména� nelz� s� n� n¥� � bod� nija� dostat� (KI� U� Olomouc� P� 2A� Lekc� � Makr� I� 2� � 4� P°íklad: (let ((curval 10)) (no-capture (display "Hodnota: ") (display curval) (newline) (+ curval 1))) + (let ((vygenerovaný symbol 100)) (display "Hodnota: ") (display curval) (newline) (+ curval 1)) Z=) 11 (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 28 / 41 e²en� problém� � makre� realizující� spec� form� o� � ;� Makr� o� £istý� zp·sobe� (define-macr� o� (lambd� arg� (i� (null� args� #� (i� (null� (cd� args)� (ca� args� (le� ((resul� (gensym))� `(le� ((,resul� ,(ca� args))� (i� ,resul� ,resul� (o� ,@(cd� args))))))))� (KI� U� Olomouc� P� 2A� Lekc� � Makr� I� 2� � 4� Nyní vypadá p°epis takto: (or 1 2 3) + (let ((symbol 1)) (if symbol symbol (or 2 3))) Z=)    V po°ádku (jednonásobné vyhodnocení): (let ((x 0)) (or (begin (set! x (+ x 1)) x) blah)) Z=) 1 Rovn¥º v po°ádku (nedochází k symbol capture): (let ((result 10)) (or #f result)) Z=) 10 (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 30 / 41 Speciální forma case P°íklad pouºití: (case (+ 1 2) ((0 1 2) 'blah) ((3 4) 'ahoj) (else 'nic)) Z=) ahoj ;; naivní makro (má capture na result) (define-macro case (lambda (value . clist) `(let ((result ,value)) (cond ,@(map (lambda (x) (if (list? (car x)) `((member result ',(car x)) ,(cadr x)) `(else ,(cadr x)))) clist))))) (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 31 / 41 Op¥t nefunguje (let ((result 1000)) (case 10 ((10 20) result) (else #f))) Z=) 10 místo 1000 protoºe case se expanduje takto: (let ((result 10)) (cond ((member result '(10 20)) result) (else #f))) (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 32 / 41 e²en� j� op¥� jednoduché� (define-macr� cas� (lambd� (valu� � clist� (le� ((resul� (gensym))� `(le� ((,resul� ,value)� (con� ,@(ma� (lambd� (x� (i� (list� (ca� x)� `((membe� ,resul� ',(ca� x)� ,(cad� x)� `(els� ,(cad� x)))� clist)))))� Pa� t� bud� vypada� takto� (le� (� symbol� 10)� (con� ((membe� symbol� '(1� 20)� result� (els� #f))� (KI� U� Olomouc� P� 2A� Lekc� � Makr� I� 3� � 4� Speciální forma cond podle R6RS. N¥které moºnosti cond jsme zatím zatajovali. víc argument· v t¥le, prázdné t¥lo, klí£ové slovo => (cond) Z=) nedenovaná hodnota (cond (else 'blah)) Z=) blah (cond ('blah)) Z=) blah (cond (10 => -)) Z=) -10 (cond ((= 1 1) (display "X") (newline) (+ 1 2))) Z=) 3 rovn¥º zobrazí X (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 34 / 41 Dal²í p°íklad: (define test (lambda (n) (cond ((= n 1) 'jedna) ((= n 2)) ((= n 3) (display n) (newline) (+ n 1)) ((and (> n 4) n) => (lambda (x) (* x x))) (else 'nevim)))) (test 0) Z=) nevim (test 1) Z=) jedna (test 2) Z=) #t (test 3) Z=) 4 rovn¥º zobrazí 3 (test 10) Z=) 100 (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 35 / 41 Speciáln� form� con� podl� R6R� (define-macr� con� (lambd� clis� (le� ((symbo� (gensym))� (i� (null� clist� `(i� #� #f� (i� (equal� (caa� clist� 'else� `(begi� ,@(cda� clist)� `(le� ((,symbo� ,(caa� clist))� (i� ,symbo� ,(i� (null� (cda� clist)� symbo� (i� (equal� (cada� clist� '=>� `(,(cadda� clist� ,symbol� `(begi� ,@(cda� clist)))� (con� ,@(cd� clist))))))))� (KI� U� Olomouc� P� 2A� Lekc� � Makr� I� 3� � 4� (con� ((� � 1� 'jedna� ((� � 2)� ((� � 3� (displa� n� (newline� (� � 1)� ((an� (� � 4� n� =� (lambd� (x� (� � x))� (els� 'nevim)))� � (le� (� symbol1� (� � 1))� (i� symbol1� (begi� (quot� jedna)� (le� (� symbol2� (� � 2))� (i� symbol2� symbol2� (le� (� symbol3� (� � 3))� (i� symbol3� (begi� (displa� n� (newline� (� � 1)� (le� (� symbol4� (an� (� � 4� n))� (i� symbol4� ((lambd� (x� (� � x)� symbol4� � (begi� (quot� (KI� U� Olomouc� P� 2A� Lekc� � Makr� I� 3� � 4� nevim)))))))))) Implementace maker realizujících cykly ;; cyklus typu while (define-macro while (lambda (condition . body) (let ((loop-name (gensym))) `(let ,loop-name () (if ,condition (begin ,@body (,loop-name))))))) P°íklad pouºití: (let ((i 0) (j 0)) (while (< i 10) (set! j (+ j i)) (set! i (+ i 1))) (list i j)) Z=) (10 45) (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 38 / 41 P°íklad pouºití: (let ((i 0) (j 0)) (while (< i 10) (set! j (+ j i)) (set! i (+ i 1))) (list i j)) Z=) (10 45) + (let symbol () (if (< i 10) (begin (set! j (+ j i)) (set! i (+ i 1)) (list i j) (symbol)))) Tohle ale bude vracet nedenovanou hodnotu. (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 39 / 41 Úprava: vrací hodnotu vyhodnocení posledního výrazu v t¥le (define-macro while (lambda (condition . body) (let ((loop-name (gensym)) (last-value (gensym))) `(let ,loop-name ((,last-value (if #f #f))) (if ,condition (,loop-name (begin ,@body)) ,last-value))))) P°íklad pouºití: (let ((i 0) (j 0)) (while (< i 10) (set! j (+ j i)) (set! i (+ i 1)) (list i j))) Z=) (10 45) (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 40 / 41 P°íklad pouºití: (let ((i 0) (j 0)) (while (< i 10) (set! j (+ j i)) (set! i (+ i 1)) (list i j))) Z=) (10 45) (let symbol1 ((symbol2 (if #f #f))) (if (< i 10) (symbol1 (begin (set! j (+ j i)) (set! i (+ i 1)) (list i j))) symbol2)) (KI, UP Olomouc) PP 2A, Lekce 4 Makra II 41 / 41