`*-----------------------------------*`

`*           >>>Pico 2.0<<<          *`

`*         Wolfgang De Meuter        *`

`*  VUB Programming Technology Lab   *`

`*               ©2004               *`

`*-----------------------------------*`

`*  Pico Extensions for Scheme       *`

`*     and Java Programmers          *`

`*-----------------------------------*`

{ `load("MetaAbstractions.pco");

  ` The following definitions make up an exception handling system for Pico `

  `    try(...expression to try...,                                        `

  `        ...test to see if 'exception' is the one to catch here,         `

  `        ...expression to execute if 'exception' was caught with 'value')`

  `    raise(...an exception,     `

  `          ...a value)          `

  raise:void;

  raise(exc,val):=error("UNCAUGHT EXCEPTION");

  trycatch(try(), filter(exception), catch(exception,value)):

     call({ keep:raise;

            raise(id,retval):={ raise:=keep;

                                if(filter(id),

                                   continue(continuation,catch(id,retval)),

                                   raise(id,retval)) };

            res:try();

            raise:=keep;

            res });

  ` The following definitions make up a Scheme-like conditional for Pico `

  `    cond(test1 ==> expression1,`

  `         test2 ==> expression2,`

  `         ...                   `

  `         testk ==> expressionk)`

  test() ==> code() :: [test,code];

  cond@clauses:: { k:1;

                   test:clauses[k,1];

                   while(!test() & (k<size(clauses)),test:=clauses[k:=k+1,1]);

                   clauses[k,2]()};

  else::true;

  ` The following definitions make up a Scheme-like let for Pico `

  `    let(var1 ## expression1,`

  `        var2 ## expression2,`

  `         ...                `

  `        vark ## expressionk,`

  `        body-expression)    `

  nam() ## val(): (lambda(env):

                     META.VAR(META.REF_NAM(META.FUN_BOD(nam)), val(),env));

  let@f():: { dct: META.FUN_DCT(f[1]);

              idx: 0;

              siz: size(f);

              while((idx:=idx+1)<siz,

                dct:=f[idx]()(dct));

              META.FUN_DCT_(f[idx],dct);

              f[idx]() };

  `* SAMPLE CODE *`

  noRoots:: 'noRoots;

  root(a,b,c)::let( d ## b*b-4*a*c,

                    cond( (d=0) ==> (-b/2/a),

                          (d>0) ==> [ (-b + sqrt(d)) / 2 / a,

                                      (-b - sqrt(d)) / 2 / a ],

                          (d<0) ==> raise(noRoots,d) ));

  safe_root(a,b,c)::trycatch( root(a,b,c),

                              exception ~ noRoots,

                              display("Delta was negative:",value) );

  display("Pico Extensions loaded",eoln)

}