Merge branch 'ht/blank' into ht/namespaces
[shapes.git] / examples / features / cond-impl.blank
blob73784b47c89708119a8903ca3b756375358a26ec
1 /** This file is part of Shapes.
2  **
3  ** Shapes is free software: you can redistribute it and/or modify
4  ** it under the terms of the GNU General Public License as published by
5  ** the Free Software Foundation, either version 3 of the License, or
6  ** any later version.
7  **
8  ** Shapes is distributed in the hope that it will be useful,
9  ** but WITHOUT ANY WARRANTY; without even the implied warranty of
10  ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11  ** GNU General Public License for more details.
12  **
13  ** You should have received a copy of the GNU General Public License
14  ** along with Shapes.  If not, see <http://www.gnu.org/licenses/>.
15  **
16  ** Copyright 2009, 2010, 2014, 2015 Henrik Tidefelt
17  **/
19 ##lookin Shapes
21 /** This is what the standard implementation of <cond> looks like (or at least
22  ** it did look like this at one point).  It uses forced immediate evaluation.
23  **/
24 |** cond: \ <>cases →
25 |**   (escape_continuation return
26 |**     {
27 |**       ![(list []<>cases).foldr
28 |**          \ p e → [if e.car (escape_continue return e.cdr) p]
29 |**          void]
30 |**       ![error `No matching cond clause.´]
31 |**     })
33 •stdout
34   << `cond: ´
35   << [cond [cons 1=0 `Doesn't happen, but not evaluated anyway.´]
36            [cons 1=0 [error 'bad `(while testing cond)´ `This should never be evaluated (false case)!´]]
37            [cons 1=1 `This is the correct answer.´]
38            [cons 1=1 [error 'bad `(while testing cond)´ `This should never be evaluated (after true case)!´]]
39            [cons true `This is the default, in case no other case is true.´]]
40   << "{n}
43 purecond: \ <>cases →
44  {
45    tmp: [(list []<>cases).foldr
46             \ p e → [if [typeof p] = §Void
47                         [if e.car e p]
48                         p]
49             void]
50    [if [typeof tmp] = §Void
51        [error 'misc VARNAME `No matching cond clause.´]
52        tmp.cdr]
53   }
55 •stdout
56   << `purecond: ´
57   << [purecond [cons 1=0 `Doesn't happen, but not evaluated anyway.´]
58                [cons 1=0 [error 'bad `(while testing purecond)´ `This should never be evaluated (false case)!´]]
59                [cons 1=1 `This is the correct answer.´]
60                [cons 1=1 [error 'bad `(while testing purecond)´ `This should never be evaluated (after true case)!´]]
61                [cons true `This is the default, in case no other case is true.´]]
62   << "{n}