diff --git a/egison.cabal b/egison.cabal
--- a/egison.cabal
+++ b/egison.cabal
@@ -1,5 +1,5 @@
 Name:                egison
-Version:             2.4.0
+Version:             2.4.1
 Synopsis:            An Interpreter for the Programming Language Egison
 Description:         An interpreter for the programming language Egison.
                      A feature of Egison is the strong pattern match facility.
diff --git a/hs-src/Language/Egison/Core.hs b/hs-src/Language/Egison/Core.hs
--- a/hs-src/Language/Egison/Core.hs
+++ b/hs-src/Language/Egison/Core.hs
@@ -505,12 +505,12 @@
           let tgtObjRefs = [tgtObjRef]
           if (length typObjRefs == length patObjRefs) && (length typObjRefs == length tgtObjRefs)
             then patternMatch flag $ (MState frame ((map (\(pat,tgt,typ) -> MAtom (PClosure bf pat) tgt typ) (zip3 patObjRefs tgtObjRefs typObjRefs)) ++ atoms)):states
-            else throwError $ Default "patternMatch: number of types, patterns and targets are different"
+            else throwError $ Default "patternMatch(ITuple-1): number of types, patterns and targets are different"
         else do
           tgtObjRefs <- tupleToObjRefs tgtObjRef
           if (length typObjRefs == length patObjRefs) && (length typObjRefs == length tgtObjRefs)
             then patternMatch flag $ (MState frame ((map (\(pat,tgt,typ) -> MAtom (PClosure bf pat) tgt typ) (zip3 patObjRefs tgtObjRefs typObjRefs)) ++ atoms)):states
-            else throwError $ Default "patternMatch: number of types, patterns and targets are different"
+            else throwError $ Default "patternMatch(ITuple): number of types, patterns and targets are different"
     Value (Tuple pats) -> do
       patObjRefs <- liftIO $ mapM (newIORef . Value) pats
       typObjRefs <- tupleToObjRefs typObjRef
@@ -519,12 +519,12 @@
           let tgtObjRefs = [tgtObjRef]
           if (length typObjRefs == length patObjRefs) && (length typObjRefs == length tgtObjRefs)
             then patternMatch flag $ (MState frame ((map (\(pat,tgt,typ) -> MAtom (PClosure bf pat) tgt typ) (zip3 patObjRefs tgtObjRefs typObjRefs)) ++ atoms)):states
-            else throwError $ Default "patternMatch: number of types, patterns and targets are different"
+            else throwError $ Default "patternMatch(Tuple-1): number of types, patterns and targets are different"
         else do
           tgtObjRefs <- tupleToObjRefs tgtObjRef
           if (length typObjRefs == length patObjRefs) && (length typObjRefs == length tgtObjRefs)
             then patternMatch flag $ (MState frame ((map (\(pat,tgt,typ) -> MAtom (PClosure bf pat) tgt typ) (zip3 patObjRefs tgtObjRefs typObjRefs)) ++ atoms)):states
-            else throwError $ Default "patternMatch: number of types, patterns and targets are different"
+            else throwError $ Default "patternMatch(Tuple): number of types, patterns and targets are different"
     Value (PredPat predObjRef patObjRefs) -> do
       argsObjRef <- liftIO $ newIORef $ Intermidiate $ ITuple $ patObjRefs ++ [tgtObjRef]
       ret <- cApply1 predObjRef argsObjRef
diff --git a/lib/core/collection.egi b/lib/core/collection.egi
--- a/lib/core/collection.egi
+++ b/lib/core/collection.egi
@@ -35,20 +35,20 @@
                  (helper pys tgt))]}]
        [<join _ _> [(List a) (List a)]
 		{[$tgt (letrec {[$helper (lambda [$xs $ys]
-								   (match ys (List a)
-									 {[<nil> {[xs {}]}]
-									  [<cons $z $zs> {[xs ys] @(helper {@xs z} zs {[xs ys]})}]}))]}
-				 (helper {} tgt))]}]
+					   (match ys (List a)
+					     {[<nil> {[xs {}]}]
+					      [<cons $z $zs> {[xs ys] @(helper {@xs z} zs)}]}))]}
+			 (helper {} tgt))]}]
        [<nioj ,$pxs _> [(List a)]
         {[$tgt (match-all tgt (List a) [<join $ys ,pxs> ys])]}]
        [<nioj _ ,$pys> [(List a)]
         {[$tgt (match-all tgt (List a) [<join ,pys $xs> xs])]}]
        [<nioj _ _> [(List a) (List a)]
-		{[$tgt (letrec {[$helper (lambda [$xs $ys]
-								   (match ys (List a)
-									 {[<nil> {[{} xs]}]
-									  [<cons $z $zs> {[ys xs] @(helper {@xs z} zs)}]}))]}
-				 (helper {} tgt {}))]}]
+	{[$tgt (letrec {[$helper (lambda [$xs $ys]
+				   (match ys (List a)
+				     {[<nil> {[{} xs]}]
+				      [<cons $z $zs> {[ys xs] @(helper {@xs z} zs)}]}))]}
+		 (helper {} tgt))]}]
        [_ [Something]
         {[$tgt {tgt}]}]
        })))
@@ -59,6 +59,12 @@
       {[<nil> {}]
        [<cons $x $xs> {(fn x) @(map fn xs)}]})))
 
+(define $map&concat
+  (lambda [$fn $ls]
+    (match ls (List Something)
+      {[<nil> {}]
+       [<cons $x $xs> {@(fn x) @(map&concat fn xs)}]})))
+
 (define $foldr
   (lambda [$fn $init $ls]
     (match ls (List Something)
@@ -118,14 +124,35 @@
         {[<nil> xs]
          [<cons $y $rs> ((union a) ((add a) xs y) rs)]}))))
 
+(define $occurence
+  (lambda [$a]
+	(lambda [$xs]
+	  (letrec
+		{[$remove&count (lambda [$x $xs]
+						  (match xs (List a)
+							{[<nil> [{} 1]]
+							 [<cons ,x $ys> (let {[[$r $i] (remove&count x ys)]}
+											  [r (+ i 1)])]
+							 [<cons $y $ys> (let {[[$r $i] (remove&count x ys)]}
+											  [{y @r} i])]}))]}
+		(match xs (List Something)
+		  {[<nil> {}]
+		   [<cons $x $ys> (let {[[$rs $i] (remove&count x ys)]}
+							{[x i] @((occurence a) rs)})]})))))
+
 (define $subcollections
-  (lambda [$xs]
-    (match xs (List Something)
-	  {[<nil> {{}}]
-	   [<cons $x $rs>
-        (let {[$subs (subcollections rs)]} 
-		  {@subs @(map (lambda [$sub] {x @sub}) subs)})]})))
+  (lambda [$a]
+	(lambda [$xs]
+	  (foldr
+			 (lambda [$x $rs]
+			   (let {[[$y $i] x]} 
+				 (map&concat (lambda [$sub] 
+							   (match-all (loop $l $j (between 1 i) {y @l} {}) (List a) [<join $ys _> {@ys @sub}]))
+							 rs)))
+			 {{}}
+			 ((occurence a) xs)))))
 
+
 (define $size
   (lambda [$xs]
     (match xs (List Something)
@@ -201,41 +228,52 @@
 (define $Multiset
   (lambda [$a]
     (type
-      {[,$val []
+	  {[,$val []
         {[$tgt (match [val tgt] [(List a) (Multiset a)]
                  {[[<nil> <nil>] {[]}]
-                  [[<cons $x $xs> <cons ,x ,xs>] {[]}]
-                  [[_ _] {}]})]}]
-       [<nil> []
+				  [[<cons $x $xs> <cons ,x ,xs>] {[]}]
+				  [[_ _] {}]})]}]
+	   [<nil> []
         {[{} {[]}]
          [_ {}]}]
-       [<cons ,$px _> [(Multiset a)]
+	   [<cons ,$px _> [(Multiset a)]
+        {[$tgt (if ((member? a) px tgt)
+				   {((remove a) tgt px)}
+				   {})]}]
+	   [<cons _ _> [a (Multiset a)]
         {[$tgt (letrec {[$helper (lambda [$xs $ys]
-				   (match xs (List a)
-				     {[<nil> {}]
-				      [<cons ,px $zs> {{@ys @zs}}]
-				      [<cons $z $zs> (helper zs {@ys z})]}))]}
-		 (helper tgt {}))]}]
-       [<cons _ _> [a (Multiset a)]
+								   (match ys (List a)
+									 {[<nil> {}]
+									  [<cons $z $zs> (if ((member? a) z xs)
+														 (helper {@xs z} zs)
+														 {[z {@xs @zs}] @(helper {@xs z} zs)})]}))]}
+				 (helper {} tgt))]}]
+	   [<join ,$pxs _> [(Multiset a)]
         {[$tgt (letrec {[$helper (lambda [$xs $ys]
-				   (match ys (List a)
-				     {[<nil> {}]
-				      [<cons $z $zs> (if ((member? a) z xs)
-							 (helper {@xs z} zs)
-							 {[z {@xs @zs}] @(helper {@xs z} zs)})]}))]}
-		 (helper {} tgt))]}]
-       [<join ,$pxs _> [(Multiset a)]
-        {[$tgt (if ((subcollection? a) pxs tgt)
-                   {((remove-collection a) tgt pxs)}
-                   {})]}]
-       [<join _ ,$pys> [(Multiset a)]
+								   (match xs (List Something)
+									 {[<nil> ys]
+									  [<cons $z $zs> (if ((member? a) z ys)
+														 (helper zs ((remove a) ys z))
+														 {})]}))]}
+				 {(helper pxs tgt)})]}]
+	   [<join _ ,$pys> [(Multiset a)]
         {[$tgt (match-all tgt (Multiset a) [<join ,pys $xs> xs])]}]
-       [<join _ _> [(Multiset a) (Multiset a)]
-        {[$tgt (map (lambda [$ts] [ts ((remove-collection a) tgt ts)])
-                    (subcollections tgt))]}]
-       [_ [Something]
+	   [<join _ _> [(Multiset a) (Multiset a)]
+		{[$tgt
+		  (foldr
+				 (lambda [$xi $xs]
+				   (let {[[$x $i] xi]}
+					 (map&concat
+								 (lambda [$sub] 
+								   (do {[[$ys $zs] sub]
+										[$zs ((remove-all a) zs x)]}
+									   (match-all (loop $l $j (between 1 i) {x @l} {}) (List a) [<join $us $vs> [{@us @ys} {@zs @vs}]])))
+								 xs)))
+				 {[{} tgt]}
+				 ((occurence a) tgt))]}]
+	   [_ [Something]
         {[$tgt {tgt}]}]
-       })))
+	   })))
 
 (define $Set
   (lambda [$a]
@@ -265,9 +303,9 @@
 		   (helper tgt2 {})))]}]
        [<join _ _> [(Set a) (Set a)]
         {[$tgt (let {[$tgt2 ((unique a) tgt)]}
-                 (concat (map (lambda [$xs $ys] (map (lambda [$sxs] [xs {@ys @sxs}])
-                                                     (subcollections xs)))
-                              (match-all tgt2 (Multiset a) [<join $xs $ys> [xs ys]]))))]}]
+                 (map&concat (lambda [$xs $ys] (map (lambda [$sxs] [xs {@ys @sxs}])
+                                                     ((subcollections a) xs)))
+                              (match-all tgt2 (Multiset a) [<join $xs $ys> [xs ys]])))]}]
        [_ [Something]
         {[$tgt {tgt}]}]
        })))
diff --git a/sample/collection-test.egi b/sample/collection-test.egi
--- a/sample/collection-test.egi
+++ b/sample/collection-test.egi
@@ -2,17 +2,22 @@
 
 ;; match List
 (test (match-all {1 2 3 4 5} (List Integer) [<snoc $x $xs> [x xs]]))
+(test {[5 {1 2 3 4}]})
 
 (test (match-all {1 2 3 4 5} (List Integer) [<join ,{1 2} $xs> xs]))
+(test {{3 4 5}})
 
-(test (match-all {1 2 3 4 5} (List Integer) [<join ,{1 2} $xs> xs]))
+(test (match-all {1 2 3 4 5} (List Integer) [<join _ <join $xs _>> xs]))
+(test {{} {1} {1 2} {1 2 3} {1 2 3 4} {1 2 3 4 5} {} {2} {2 3} {2 3 4} {2 3 4 5} {} {3} {3 4} {3 4 5} {} {4} {4 5} {} {5} {}})
 
 (test (match-all {[1 2] [1 2]} (List [Integer Integer])
         [<cons [$a $b] _> [a b]]))
+(test {[1 2]})
 
 ;; match Multiset
 (test (match-all {1 2 3 4 5} (Multiset Integer)
         [<cons $m <cons $n _>> [m n]]))
+(test {[1 2] [1 3] [1 4] [1 5] [2 1] [2 3] [2 4] [2 5] [3 1] [3 2] [3 4] [3 5] [4 1] [4 2] [4 3] [4 5] [5 1] [5 2] [5 3] [5 4]})
 
 ;; match a collection of collections
 (test (match-all {{1 2 3} {11} {21 22}} (List (Multiset Integer))
@@ -21,6 +26,7 @@
            <cons <cons $z _>
             <nil>>>>
          [x y z]]))
+(test {[1 11 21] [1 11 22] [2 11 21] [2 11 22] [3 11 21] [3 11 22]})
 
 ;; match a collection of collections with value patterns
 (test (match-all {{1 2 3 4 5} {4 5 1} {6 1 7 4}} (List (Multiset Integer))
@@ -29,26 +35,30 @@
            <cons <cons ,n _>
             <nil>>>>
          n]))
+(test {1 4})
 
 ;; pattern as first class object
 (test (let {[$pat <cons ,1 <nil>>]}
         (match {1} (Multiset Integer)
           {[pat <ok>]
            [_ <not-ok>]})))
-
+(test <ok>)
+      
 ;; Or-pattern test1
 (test (match {} (Multiset Integer)
         {[(| <nil> <cons ,1 <nil>>) <ok>]
          [_ <not-ok>]}))
+(test <ok>)
 
 ;; Or-pattern test2
 (test (match {1} (Multiset Integer)
         {[(| <nil> <cons ,1 <nil>>) <ok>]
          [_ <not-ok>]}))
-
+(test <ok>)
 
 (test (match-all {1 2 3 4 5 6 7 1 3 5 7} (Multiset Integer)
         [<cons $x ^<cons ,x _>> x]))
+(test {2 4 6})
 
 (test (match-all {{1 2 3} {2 3 4} {1}} (Multiset (Multiset Integer))
         [<cons <cons $x ^<cons ,x _>>
@@ -56,27 +66,35 @@
            <cons ^<cons ,x _>
             <nil>>>>
          x]))
+(test {4 4}) ; is really ok?
 
 (test (match-all {{1 2 3} {2 3 4}} (Multiset (Multiset Integer))
         [<cons <cons $x ^<cons ,x _>>
            <cons ^<cons ,x _>
             <nil>>>
          x]))
+(test {1 4})
 
 (test (match-all {1 2 3} (List Integer)
         [<join $hs $ts> [hs ts]]))
+(test "here")
+(test {[{} {1 2 3}] [{1} {2 3}] [{1 2} {3}] [{1 2 3} {}]})
 
 (test (match-all {1 2 3} (List Integer)
         [<nioj $hs $ts> [hs ts]]))
+(test {[{1 2 3} {}] [{2 3} {1}] [{3} {1 2}] [{} {1 2 3}]})
 
 (test (match-all {1 2 3} (Multiset Integer)
         [<join $hs $ts> [hs ts]]))
+(test {[{} {3 2 1}] [{1} {3 2}] [{2} {3 1}] [{1 2} {3}] [{3} {2 1}] [{1 3} {2}] [{2 3} {1}] [{1 2 3} {}]})
 
 (test (match-all {1 2 3} (Set Integer)
         [<join $hs $ts> [hs ts]]))
+(test {[{} {3 2 1}] [{1} {3 2}] [{1} {3 2 1}] [{2} {3 1}] [{2} {3 1 2}] [{1 2} {3}] [{1 2} {3 1}] [{1 2} {3 2}] [{1 2} {3 1 2}] [{3} {2 1}] [{3} {2 1 3}] [{1 3} {2}] [{1 3} {2 1}] [{1 3} {2 3}] [{1 3} {2 1 3}] [{2 3} {1}] [{2 3} {1 2}] [{2 3} {1 3}] [{2 3} {1 2 3}] [{1 2 3} {}] [{1 2 3} {1}] [{1 2 3} {2}] [{1 2 3} {1 2}] [{1 2 3} {3}] [{1 2 3} {1 3}] [{1 2 3} {2 3}] [{1 2 3} {1 2 3}]})
 
 (test (match-all {1 2 3} (List Integer)
         [<join $hs <cons $x $ts>> [hs x ts]]))
+(test {[{} 1 {2 3}] [{1} 2 {3}] [{1 2} 3 {}]})
 
 ;; noij
 (test (match-all {<x> <y> <z>} (List Something) [<nioj $xs $ys> [xs ys]]))
@@ -117,6 +135,7 @@
 
 (test (match-all {1 2 3 1 2} (Multiset Integer)
         [(single %k _) k]))
+(test {1 2 3})
 
 (define $pair
   (macro [$s $pat]
@@ -124,6 +143,7 @@
 
 (test (match-all {1 2 3 1 2} (Multiset Integer)
         [(pair %k _) k]))
+(test {1 2})
 
 (define $loop-pat
   (lambda [$k $i]
diff --git a/sample/graph-test.egi b/sample/graph-test.egi
--- a/sample/graph-test.egi
+++ b/sample/graph-test.egi
@@ -13,13 +13,13 @@
              <node 5 {4} {4}>})
 
 (test (hamilton-cycle g1))
-(test {[1 2 3 4 5] [1 5 4 3 2] [2 1 5 4 3] [2 3 4 5 1] [3 2 1 5 4] [3 4 5 1 2] [4 3 2 1 5] [4 5 1 2 3] [5 1 2 3 4] [5 4 3 2 1]})
+(test {{1 2 3 4 5} {1 5 4 3 2} {2 1 5 4 3} {2 3 4 5 1} {3 2 1 5 4} {3 4 5 1 2} {4 3 2 1 5} {4 5 1 2 3} {5 1 2 3 4} {5 4 3 2 1}})
 
 (test (hamilton-path g1))
-(test {[1 2 3 4 5] [1 5 4 3 2] [2 1 3 4 5] [2 1 5 4 3] [2 3 1 4 5] [2 3 1 5 4] [2 3 4 1 5] [2 3 4 5 1] [3 2 1 4 5] [3 2 1 5 4] [3 4 5 1 2] [4 3 2 1 5] [4 5 1 2 3] [4 5 1 3 2] [5 1 2 3 4] [5 1 4 3 2] [5 4 1 2 3] [5 4 1 3 2] [5 4 3 1 2] [5 4 3 2 1]})
+(test {{1 2 3 4 5} {1 5 4 3 2} {2 1 3 4 5} {2 1 5 4 3} {2 3 1 4 5} {2 3 1 5 4} {2 3 4 1 5} {2 3 4 5 1} {3 2 1 4 5} {3 2 1 5 4} {3 4 5 1 2} {4 3 2 1 5} {4 5 1 2 3} {4 5 1 3 2} {5 1 2 3 4} {5 1 4 3 2} {5 4 1 2 3} {5 4 1 3 2} {5 4 3 1 2} {5 4 3 2 1}})
 
 (test (hamilton-cycle g2))
 (test {})
 
 (test (hamilton-path g2))
-(test {[1 2 3 4 5] [5 4 3 2 1]})
+(test {{1 2 3 4 5} {5 4 3 2 1}})