X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=ghc%2Fcompiler%2FyaccParser%2Flistcomp.c;fp=ghc%2Fcompiler%2FyaccParser%2Flistcomp.c;h=6258869966277ccb7f05e110a1fa7ce7e56ae468;hp=0000000000000000000000000000000000000000;hb=e7d21ee4f8ac907665a7e170c71d59e13a01da09;hpb=e48474bff05e6cfb506660420f025f694c870d38

diff --git a/ghc/compiler/yaccParser/listcomp.c b/ghc/compiler/yaccParser/listcomp.c
new file mode 100644
index 0000000..6258869
--- /dev/null
+++ b/ghc/compiler/yaccParser/listcomp.c
@@ -0,0 +1,67 @@
+/*
+   Implementation of optimally compiled list comprehensions using Wadler's algorithm from
+   Peyton-Jones "Implementation of Functional Programming Languages", 1987
+
+   TQ transforms a list of qualifiers (either boolean expressions or generators) into a
+   single expression which implements the list comprehension.
+
+   TE << [E || Q] >>  =  TQ <<  [E || Q] ++ [] >>
+
+   TQ << [E || p <- L1, Q]  ++  L2 >> =
+
+      h ( TE << L1 >> ) where
+      			h = us -> case us in
+	  			[]        ->  TE << L2 >>
+				(u : us') ->
+					(TE << p >> ->  ( TQ << [E || Q]  ++  (h us') >> )) u
+ */
+
+tree TQ(quals,l2)
+list quals, l2;
+{
+  tree qualh;
+  list rest;
+
+  if(tlist(quals) == lnil)
+    return(mkcons(zfexpr,l2));
+
+  qualh = (tree) lhd(quals);
+  rest = ltl(quals);
+
+  if(ttree(qualh) != qual)
+    return(mkif(qualh,TQ(rest,l2),l2));
+
+  {
+    tree h = mkident(uniqueident("Zh%d")),
+         u = mkident(uniqueident("Iu%d")),
+         us = mkident(uniqueident("Ius%d")),
+         pat = gqpat(qualh);
+
+    pbinding tq = mkppat(gqpat(qualh),TQ(rest,mkap(h,us)));
+
+
+    return(
+       mkletv(
+	 mkrbind(
+	   mkpbind(
+	     lsing(
+	       mkppat(h,
+		 mklam(us,
+		   mkcasee(us,
+		     ldub(
+		       mkppat(niltree,l2),
+		       mkppat(
+			  mkcons(u,us),
+			  mkcasee(u,lsing(tq))
+/*
+  replaces the following code which elides patterns in list comprehensions a la M*****a
+
+			  mkcasee(u,
+			    ttree(pat) == ident && !isconstr(gident(pat))?
+			      lsing(tq):
+			      ldub(tq,mkppat(mkident("_"),mkap(h,us))))
+*/
+			    )))))))),
+	 mkap(h,gqexp(qualh))));
+  }
+}