ghc/compiler/yaccParser/listcomp.c

   1 /*
   2    Implementation of optimally compiled list comprehensions using Wadler's algorithm from
   3    Peyton-Jones "Implementation of Functional Programming Languages", 1987
   4
   5    TQ transforms a list of qualifiers (either boolean expressions or generators) into a
   6    single expression which implements the list comprehension.
   7
   8    TE << [E || Q] >>  =  TQ <<  [E || Q] ++ [] >>
   9
  10    TQ << [E || p <- L1, Q]  ++  L2 >> =
  11
  12       h ( TE << L1 >> ) where
  13                         h = us -> case us in
  14                                 []        ->  TE << L2 >>
  15                                 (u : us') ->
  16                                         (TE << p >> ->  ( TQ << [E || Q]  ++  (h us') >> )) u
  17  */
  18
  19 tree TQ(quals,l2)
  20 list quals, l2;
  21 {
  22   tree qualh;
  23   list rest;
  24
  25   if(tlist(quals) == lnil)
  26     return(mkcons(zfexpr,l2));
  27
  28   qualh = (tree) lhd(quals);
  29   rest = ltl(quals);
  30
  31   if(ttree(qualh) != qual)
  32     return(mkif(qualh,TQ(rest,l2),l2));
  33
  34   {
  35     tree h = mkident(uniqueident("Zh%d")),
  36          u = mkident(uniqueident("Iu%d")),
  37          us = mkident(uniqueident("Ius%d")),
  38          pat = gqpat(qualh);
  39
  40     pbinding tq = mkppat(gqpat(qualh),TQ(rest,mkap(h,us)));
  41
  42
  43     return(
  44        mkletv(
  45          mkrbind(
  46            mkpbind(
  47              lsing(
  48                mkppat(h,
  49                  mklam(us,
  50                    mkcasee(us,
  51                      ldub(
  52                        mkppat(niltree,l2),
  53                        mkppat(
  54                           mkcons(u,us),
  55                           mkcasee(u,lsing(tq))
  56 /*
  57   replaces the following code which elides patterns in list comprehensions a la M*****a
  58
  59                           mkcasee(u,
  60                             ttree(pat) == ident && !isconstr(gident(pat))?
  61                               lsing(tq):
  62                               ldub(tq,mkppat(mkident("_"),mkap(h,us))))
  63 */
  64                             )))))))),
  65          mkap(h,gqexp(qualh))));
  66   }
  67 }