Cvičení 6
---------

RIZIKA MAKER
============
- vícenásobné vyhodnocení
- (nechtěné) zakrytí symbolu = symbol capture


  PR:
  (define-macro square
    (lambda (x)
      `(* ,x ,x)))

  (square 5) => (* 5 5)

  (define a 10)
  (square (begin (set! a (+ a 1) 3))

Co se s tím dá dělat?
  - zapamatujeme si výsledek vyhodnocení x
  (define-macro square
    (lambda (x)
      `(let ((tmp ,x))
          (* tmp tmp))))

Potenciálně ale může nastat problém jinde např.:
------------------------------------------------

  (define-macro swap
    (lambda (x y)
      `(let ((tmp ,x))
          (set! ,x ,y)
          (set! ,y tmp))))

Kde je problém?
  (define tmp 10)
  (define my 2)

  (swap tmp my) =EXP=> ??
  tmp => ??

  Reseni, vygenerovani jednoznacneho symbolu v letu (nicim jinym nepouziteho - jedinecny nazev promenne), to umi procedura gensym
  PR:  (gensym)
        g4750
       (gensym)
        g4781

  (define-macro swap2
    (lambda (x y)
      (let ((symb-name (gensym)))
         `(let ((,symb-name ,x))
            (set! ,x ,y)
            (set! ,y ,symb-name))))

ZNOVU:
  (define tmp 10)
  (define my 2)

  (swap tmp my) =EXP=> ??
  tmp => ??


Hygienická makra:
=================

Speciální forma define-syntax, se syntaxí

(define-syntax <nazev_makra> <prepisovaci_procedura_syntax_rules>)

Prepisovaci procedura je spec. proc. syntax rules s touto syntaxí:
(syntax-rules (keyword1 keyword2 ...) pravidlo1 pravidlo2 ...)

Pravidla jsou ve tvaru (vzor nahrazeni)
Ve vzoru se mohou objevit klicova slova, proměnné a výpustka (může tam být libovolný počet výskytů čehokoli - i nulový)
Nahrazení je validní Schemeovský kód

Sémantika:
==========
  - expanze hygienických maker se spouští až za běhu, tudíž mají přístup do svého lexikálního prostředí (narozdíl od maker)
  - nemůže dojít k symbol capture problému
  - vyhodnocovací proces vypadá takto:
      - na klíčová slova se nenavazují hodnoty
      - na ostatní symboly se naváží hodnoty z aplikace hygienckého makra, pokud odpovídají vzoru
      - procházejí se postupně pravidla a při první shodě se vzorem dojde k expanzi, ta se vyhodnotí,

PŘ:

 (define-syntax myor
  (syntax-rules ()
    ((myor) #t)
    ((myor test) test)
    ((myor a b ...)
     (let ((result a))
      (if result result (myor b ...))))))

Vyhodnoťte:
===========
(define-syntax foreach
  (syntax-rules (in do)
    ((foreach var in list do stmt ...)
     (let loop ((l list))
       (if (not (null? l))
           (let ((var (car l)))
             stmt ...
             (loop (cdr l))))))))

;(foreach cislo in '(1 4 5 7) do (display cislo) (newline))

(define-syntax myfor
  (syntax-rules (:= to modified by do)
    ((myfor var := from to end modified by proc do stmt ...)
     (let loop ((i from))
       (if (<= i end)
           (let ((var (proc i)))
             stmt ...
             (loop (+ i 1))))))))

;(myfor xyz := 5 to 10 modified by (lambda (x) (* x x 2)) do (display xyz) (newline))

(define proc-or
  (lambda args
    (if (null? args) #f
        (if (car args) #t
            (apply proc-or (cdr args))))))

;(proc-or)
;(proc-or #f #f 1)

(define-syntax for
  (syntax-rules (in do)
      ((for vars in lists do stmt1 ...)
       (let loop ((l lists))
         (if (not (apply proc-or (map null? l)))
             (begin
               (apply (lambda vars
                        stmt1 ...)
                      (map car l))
               (loop (map cdr l))))))))
   
;(for (a b) in '((1 2) (3 4)) do (display a) (newline) (display b) (newline))

(define-syntax multifor
  (syntax-rules (in do)
    ((multifor ((var in value ...) ...) do statement ...)
       (for (var ...) in '((value ...) ...) do statement ...))))

;(multifor ((a in 1 2) (b in 3 4)) do (display a) (newline) (display b) (newline))

(define-syntax multifor
  (syntax-rules (in do)
    ((multifor ((var in value ...) ...) do statement ...)
     (let-syntax ((m-for (syntax-rules (in do)
                           ((m-for vars in lists do stmt)
                            (let loop ((l lists))
                              (if (not (apply proc-or (map null? l)))
                                  (begin
                                    (apply (lambda vars
                                             stmt)
                                           (map car l))
                                    (loop (map cdr l)))))))))
       (m-for (var ...) in '((value ...) ...) do (begin statement ...))))))


;(multifor ((a in 1 2 10) (b in 3 4 5)) do (display (+ a b)) (newline))

Domácí úkoly:
=============
Napiste (klasické) makro dotuplets, s touto syntaxi (2 body)
     POZOR! nesmi dojit k symbol capture ani k vícenásobnému vyhodnoceni, jinak 0 bodu!

      (dotuplets (n (x lst)) . body)

      rozdeli seznam na n-tice a projde je jako foreach ale po n-ticich (ty se postupne budou objevovat v x), pokud nebude delka seznamu delitelna n, skonci chybou

      n ... pocet prvku v tuplu (ntici)
      x ... promenna pres kterou iterujeme
      lst ... seznam, ze ktereho vybirame tuply zleva do prava
      body ... telo, ktera se zavola pri vytvoreni kazdeho tuplu, krome posledniho, musi byt videt promenna x

      procedura vraci hodnotu posledniho vyhodnoceni

  PR: (dotuplets (3 (x '(1 2 3 4 5 6 7))) (display x) x)
      => chyba

 PR: (dotuplets (3 (x '(1 2 3 4 5 6 7 8 9))) (display x) x)
      (1 2 3)
      (4 5 6)
      (7 8 9)
      => (7 8 9)



Pomoci hygienickeho makra napiste jednoduchy mycond: (1 bod)
(mycond ((< 3 2) 'hello)
        ((= 3 2) 'world)
        (else 'none))
=> none


Napiste makro pattern-if (muzete psat normalnim makrem nebo hygienckym makrem) (2 body)
SYNTAXE: (pattern-if <tuplet-condition> (<tuplet1_cond> statement1) (<tuplet2_cond> statement2) ... (else <else_code>))
  - zjisti shodu tuplet-condition s tupletN_cond (chova se linym zpusobem - nevyhodnti zbyle prvky podminky, kdyz je jiste, ze bude nesplnena)
  - pokud je shoda vyhodnoti dany statement
  - pokud neni shoda s zadnym statementem, vyhodnoti else_code

;(pattern-if ((= 1 2) (= 0 0) (= 3 4)) ((#f #t #f) (+ 555 111)) (print 'blah) (else 300))
=> 666

Nesmi vyhodit chybu!:
;(pattern-if ((= 1 2) (= 0 0) xxx) ((#t #f #f) (print 'blah) 200) ((#t #t #f) (+ 1 2)) (else 123))
=> 123