Cvičení 9.
----------

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:
=============

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_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)) (else (begin (print 'blah) 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