+Implemented common Prelude list functions +test/ShowList.hs

Ignore-this: b7b97fbcd58bf07a2ae83b069e00a5a0

darcs-hash:20100222145819-09b00-59ef449a1f3c7067bdb9975d3f1ab3aa82553c9f

Front.hs

@@ -317,7 +317,7 @@ moveDecls e ds=HsLet ds e
 -- | Merge multiple 'HsMatch' in HsFunBind into one.
 mergeMatches :: [HsMatch] -> HsDecl
 mergeMatches []=error "Front: mergeMatches: empty [HsMatch] found!"
-mergeMatches [m]=HsFunBind [m]
+-- mergeMatches [m]=HsFunBind [m]
 mergeMatches ms=HsFunBind [HsMatch loc0 n0 (map HsPVar args) (HsUnGuardedRhs expr) []]
     where
         HsMatch loc0 n0 ps0 _ _=head ms

GMachine.hs

@@ -90,7 +90,8 @@ rlscAux m col front
     |otherwise    = rlscAux m col' (S.difference new col')
     where
         col'=S.union col front
-        new=S.unions $ map (S.unions . map collectDepSC . (m M.!)) $ S.toList front
+        new=S.unions $ map (S.unions . map collectDepSC . find) $ S.toList front
+        find x=M.findWithDefault (error $ "rlscAux:"++show x) x m
 
 
 collectDepSC :: GMCode -> S.Set String

auto-test

@@ -2,6 +2,7 @@
 
 function test_bf
     echo "=== $argv[1] ==="
+    rm -f test/(basename $argv[1] .hs).bf
     ~/devenv/hs2bf/hs2bf --make $argv[1] > test/(basename $argv[1] .hs).bf
     time -f 'user:%U sys:%S' ~/bin/bfi test/(basename $argv[1] .hs).bf
     echo ""
@@ -15,9 +16,8 @@ and test_bf test/Hello.hs
 and test_bf test/LocalFun.hs
 and test_bf test/Lambda.hs
 and test_bf test/Arithmetic.hs
+and test_bf test/ShowList.hs
+# and test_bf test/QuickSort.hs
 # and test_bf test/TypeClass.hs
 # and test_bf test/ConstPattern.hs
 # and test_bf test/
-
-rm -f test/*.bf
-

test/Prelude.hs

@@ -13,6 +13,7 @@ data Ordering
 
 data XT1 a=XT1 a
 data XT2 a b=XT2 a b
+data XT3 a b c=XT3 a b c
 
 data XList a
     =XCons a (XList a)
@@ -78,3 +79,35 @@ addInt (NInt x) (PInt y)
 
 -}
 
+
+-- list functions
+head (x:xs)=x
+tail (x:xs)=xs
+
+reverse []=[]
+reverse (x:xs)=reverse xs++[x]
+
+map f []=[]
+map f (x:xs)=f x:map f xs
+
+filter f []=[]
+filter f (x:xs)
+    |f x       = x:filter f xs
+    |otherwise = filter f xs
+
+(x:xs) !! n
+    |n `eqByte` 0 = x
+    |otherwise    = xs !! (n `subByte` 1)
+
+[]++ys=ys
+(x:xs)++ys=x:(xs++ys)
+
+length []=0
+length (x:xs)=1 `addByte` (length xs)
+
+foldr f z []=z
+foldr f z (x:xs)=f x (foldr f z xs)
+
+foldl f z []=z
+foldl f z (x:xs)=foldl f (f x z) xs
+

test/ShowList.hs

@@ -0,0 +1,9 @@
+
+
+main=outputStr Halt (map showByte1 [1,2,3,4])
+
+showByte1 x=addByte '0' x
+
+outputStr k []=k
+outputStr k (x:xs)=Output x (outputStr k xs)
+