egison 3.7.13 → 3.7.14

raw patch · 9 files changed

+104/−119 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• egison.cabal +1/−1
• elisp/egison-mode.el +1/−10
• hs-src/Language/Egison/Core.hs +35/−17
• hs-src/Language/Egison/Desugar.hs +2/−0
• hs-src/Language/Egison/Parser.hs +30/−52
• hs-src/Language/Egison/ParserNonS.hs +24/−31
• hs-src/Language/Egison/Types.hs +5/−6
• lib/core/collection.egi +2/−2
• sample/n-queen.egi +4/−0

@@ -1,5 +1,5 @@ Name:                egison-Version:             3.7.13+Version:             3.7.14 Synopsis:            Programming language with non-linear pattern-matching against non-free data Description:   An interpreter for Egison, a **pattern-matching-oriented**, purely functional programming language.

@@ -74,11 +74,6 @@      "\\<match-lambda\\>"      "\\<match-all\\>"      "\\<match-all-lambda\\>"-     "\\<next-match\\>"-     "\\<next-match-lambda\\>"-     "\\<next-match-all\\>"-     "\\<next-match-all-lambda\\>"-     "\\<next-matcher\\>"      "\\<matcher\\>"      "\\<self\\>"      "\\<algebraic-data-matcher\\>"@@ -90,7 +85,7 @@       "\\<undefined\\>"      "\\<something\\>"-     +      "\\\.\\\.\\\."      "\\\," ;     "'"@@ -202,10 +197,6 @@         ((equal "match-lambda" name) 2)         ((equal "match-all" name) 2)         ((equal "match-all-lambda" name) 2)-        ((equal "next-match" name) 2)-        ((equal "next-match-lambda" name) 2)-        ((equal "next-match-all" name) 2)-        ((equal "next-match-all-lambda" name) 2)         ((equal "matcher" name) 2)         ((equal "algebraic-data-matcher" name) 2)         ((equal "pattern-function" name) 2)

@@ -232,10 +232,7 @@   f (x, _) = x   g (Value (ScalarData (Div (Plus [Term 1 [(FunctionData fn argnames args js, 1)]]) p)), ms) =     let Env _ maybe_vwi = env in-    let fn' = case maybe_vwi of-                Nothing -> fn-                Just (VarWithIndices nameString indexList) ->-                   Just $ symbolScalarData "" $ show $ VarWithIndices nameString $ changeIndexList indexList ms in+    let fn' = maybe fn (\(VarWithIndices nameString indexList) -> Just $ symbolScalarData "" $ show $ VarWithIndices nameString $ changeIndexList indexList ms) maybe_vwi in     Value $ ScalarData $ Div (Plus [Term 1 [(FunctionData fn' argnames args js, 1)]]) p   g (x, _) = x @@ -694,12 +691,10 @@   ns <- (mapM fromEgison size'') :: EgisonM [Integer]   let Env frame maybe_vwi = env   xs <- mapM (\ms -> do-    let env' = case maybe_vwi of-                 Nothing -> env-                 Just (VarWithIndices nameString indexList) -> Env frame (Just $ VarWithIndices nameString $ changeIndexList indexList ms)+    let env' = maybe env (\(VarWithIndices nameString indexList) -> Env frame $ Just $ VarWithIndices nameString $ changeIndexList indexList ms) maybe_vwi     fn <- evalExpr env' fnExpr-    applyFunc env fn (Value (makeTuple ms)))-                (map (\ms -> map toEgison ms) (enumTensorIndices ns))+    applyFunc env fn $ Value $ makeTuple ms)+                (map (\ms -> map toEgison ms) $ enumTensorIndices ns)   fromTensor (Tensor ns (V.fromList xs) [])  evalExpr env (TensorContractExpr fnExpr tExpr) = do@@ -1027,8 +1022,7 @@                    whnf <- evalExpr env' expr                    case whnf of                      (Value (CFunc _ env arg body)) -> liftIO . writeIORef ref . WHNF $ (Value (CFunc (Just name) env arg body))-                 FunctionExpr args -> do-                   liftIO . writeIORef ref . Thunk $ evalExpr (Env frame (Just $ varToVarWithIndices name)) $ FunctionExpr args+                 FunctionExpr args -> liftIO . writeIORef ref . Thunk $ evalExpr (Env frame (Just $ varToVarWithIndices name)) $ FunctionExpr args                  _ | isVarWithIndices name -> liftIO . writeIORef ref . Thunk $ evalExpr (Env frame (Just $ varToVarWithIndices name)) expr                    | otherwise -> liftIO . writeIORef ref . Thunk $ evalExpr env' expr)             refs bindings@@ -1068,9 +1062,15 @@ processMStatesAll depth streams = do   (matches, streams') <- (\(a, b) -> (fromList a, b)) <$> (processMStatesLine depth streams >>= extractMatches)   if null (streams' ^. normalTree)-     then do matches' <- mapM (\id -> processMStatesAll 0 $ MatchingStates { _normalTree = map snd (toAscList $ (streams' ^. orderedOrTrees) M.! id), _orderedOrTrees = M.empty, _ids = [], _bool = streams' ^. bool }) $ streams' ^. ids+     then do matches' <- mapM (\id -> processMStatesAll 0 $ MatchingStates { _normalTree = convert ((streams' ^. orderedOrTrees) M.! id), _orderedOrTrees = M.empty, _ids = [], _bool = streams' ^. bool }) $ streams' ^. ids              mappend matches $ mconcat $ fromList matches'      else mappend matches $ processMStatesAll (depth + 1) streams'+ where+  convert :: Map Int [a] -> [[a]]+  convert ms = let ((start, root), ms') = M.deleteFindMin ms in+                   M.foldlWithKey (\l k x -> let k' = k - start in+                                                 if length l <= k' then l ++ (replicate (k' - length l) []) ++ [x]+                                                                   else let (xs, y:ys) = splitAt k' l in xs ++ (x:ys)) [root] ms'  processMStatesLine :: Int -> MatchingStates -> EgisonM MatchingStates processMStatesLine depth streams = do@@ -1169,6 +1169,9 @@       case result of         MNil -> return $ msingleton state2         _    -> return MNil+    MAtom (LaterPat _) _ _ -> do+      let state' = swapMState state+      processMState' state'     _ -> processMState' state  where   splitMState :: MatchingState -> (MatchingState, MatchingState)@@ -1177,6 +1180,12 @@   splitMState (MState mode env loops bindings ((MNode penv state') : trees)) =     let (state1, state2) = splitMState state'      in (MState mode env loops bindings [MNode penv state1], MState mode env loops bindings (MNode penv state2 : trees))+  swapMState :: MatchingState -> MatchingState+  swapMState (MState mode env loops bindings ((MAtom (LaterPat pattern) target matcher) : trees)) =+    MState mode env loops bindings (trees ++ [MAtom pattern target matcher])+  swapMState (MState mode env loops bindings ((MNode penv state') : trees)) =+    let state'' = swapMState state'+     in MState mode env loops bindings ((MNode penv state''):trees)  processMState' :: MatchingState -> EgisonM (MList EgisonM MatchingState) processMState' (MState _ _ _ _ []) = throwError $ EgisonBug "should not reach here (empty matching-state)"@@ -1284,11 +1293,20 @@     _ ->       case matcher of         UserMatcher _ _ _ -> do-          (patterns, targetss, matchers) <- inductiveMatch env' pattern target matcher-          mfor targetss $ \ref -> do-            targets <- evalRef ref >>= fromTupleWHNF-            let trees' = zipWith3 MAtom patterns targets matchers ++ trees-            return $ MState mode env loops bindings trees'+          case pattern of+            _ -> do+              (patterns, targetss, matchers) <- inductiveMatch env' pattern target matcher+              case (length patterns, length matchers) of+                (1,1) -> do+                  mfor targetss $ \ref -> do+                    targets <- evalRef ref >>= (\x -> return [x])+                    let trees' = zipWith3 MAtom patterns targets matchers ++ trees+                    return $ MState mode env loops bindings trees'+                _ -> do+                  mfor targetss $ \ref -> do+                    targets <- evalRef ref >>= fromTupleWHNF+                    let trees' = zipWith3 MAtom patterns targets matchers ++ trees+                    return $ MState mode env loops bindings trees'          Tuple matchers ->           case pattern of

@@ -435,6 +435,7 @@     collectName :: EgisonPattern -> Set String    collectName (NotPat pattern) = collectName pattern+   collectName (LaterPat pattern) = collectName pattern    collectName (AndPat patterns) = collectNames patterns    collectName (TuplePat patterns) = collectNames patterns    collectName (InductivePat _ patterns) = collectNames patterns@@ -459,6 +460,7 @@ desugarPattern' (ValuePat expr) = ValuePat <$> desugar expr desugarPattern' (PredPat expr) = PredPat <$> desugar expr desugarPattern' (NotPat pattern) = NotPat <$> desugarPattern' pattern+desugarPattern' (LaterPat pattern) = LaterPat <$> desugarPattern' pattern desugarPattern' (AndPat patterns) = AndPat <$> mapM desugarPattern' patterns desugarPattern' (OrPat patterns)  =  OrPat <$> mapM desugarPattern' patterns desugarPattern' (OrderedOrPat' [pat1, pat2])  = OrderedOrPat <$> fresh <*> desugarPattern' pat1 <*> desugarPattern' pat2

@@ -122,6 +122,10 @@     fromParsecError :: ParseError -> EgisonError     fromParsecError = Parser . show +doParse' :: Parser a -> String -> a+doParse' p input = case doParse p input of+                     Right x -> x+ -- -- Expressions --@@ -140,7 +144,7 @@          <|> try (parens (do keywordDefine                              (VarWithIndices name is) <- (char '$' >> identVarWithIndices)                              body <- expr-                             return $ Define (Var name (map f is)) (WithSymbolsExpr (map g is) (TransposeExpr (CollectionExpr (map (ElementExpr . h) is)) body))))+                             return $ Define (Var name (map f is)) (WithSymbolsExpr (map g is) (TransposeExpr (CollectionExpr (map (ElementExpr . VarExpr . stringToVar . g) is)) body))))  where   f (Superscript _) = Superscript ()   f (Subscript _) = Subscript ()@@ -148,9 +152,6 @@   g (Superscript i) = i   g (Subscript i) = i   g (SupSubscript i) = i-  h (Superscript i) = (VarExpr $ stringToVar i)-  h (Subscript i) = (VarExpr $ stringToVar i)-  h (SupSubscript i) = (VarExpr $ stringToVar i)  redefineExpr :: Parser EgisonTopExpr redefineExpr = (keywordRedefine <|> keywordSet) >> Redefine <$> (char '$' >> identVar) <*> expr@@ -230,10 +231,6 @@                          <|> matchExpr                          <|> matchAllLambdaExpr                          <|> matchLambdaExpr-                         <|> nextMatchAllExpr-                         <|> nextMatchExpr-                         <|> nextMatchAllLambdaExpr-                         <|> nextMatchLambdaExpr                          <|> matcherExpr                          <|> matcherDFSExpr                          <|> seqExpr@@ -329,18 +326,6 @@ matchLambdaExpr :: Parser EgisonExpr matchLambdaExpr = keywordMatchLambda >> MatchLambdaExpr <$> expr <*> matchClauses -nextMatchAllExpr :: Parser EgisonExpr-nextMatchAllExpr = keywordNextMatchAll >> NextMatchAllExpr <$> expr <*> expr <*> matchClause--nextMatchExpr :: Parser EgisonExpr-nextMatchExpr = keywordNextMatch >> NextMatchExpr <$> expr <*> expr <*> matchClauses--nextMatchAllLambdaExpr :: Parser EgisonExpr-nextMatchAllLambdaExpr = keywordNextMatchAllLambda >> NextMatchAllLambdaExpr <$> expr <*> matchClause--nextMatchLambdaExpr :: Parser EgisonExpr-nextMatchLambdaExpr = keywordNextMatchLambda >> NextMatchLambdaExpr <$> expr <*> matchClauses- matchClauses :: Parser [MatchClause] matchClauses = braces $ sepEndBy matchClause whiteSpace @@ -540,9 +525,7 @@ generateArrayExpr = keywordGenerateArray >> GenerateArrayExpr <$> expr <*> arrayRange  arrayRange :: Parser (EgisonExpr, EgisonExpr)-arrayRange = brackets (do s <- expr-                          e <- expr-                          return (s, e))+arrayRange = brackets $ (,) <$> expr <*> expr  arrayBoundsExpr :: Parser EgisonExpr arrayBoundsExpr = keywordArrayBounds >> ArrayBoundsExpr <$> expr@@ -611,6 +594,7 @@                     <|> orPat                     <|> loopPat                     <|> letPat+                    <|> laterPat                     <|> bfsPat                     <|> dfsPat                     <|> try divPat@@ -618,7 +602,6 @@                     <|> try multPat                     <|> try dApplyPat                     <|> try pApplyPat---                    <|> powerPat                     )  pattern'' :: Parser EgisonPattern@@ -644,6 +627,9 @@ letPat :: Parser EgisonPattern letPat = keywordLet >> LetPat <$> bindings <*> pattern +laterPat :: Parser EgisonPattern+laterPat = keywordLater >> LaterPat <$> pattern+ notPat :: Parser EgisonPattern notPat = char '!' >> NotPat <$> pattern @@ -678,13 +664,10 @@ loopPat = keywordLoop >> char '$' >> LoopPat <$> identVarWithoutIndex <*> loopRange <*> pattern <*> option (NotPat WildCard) pattern  loopRange :: Parser LoopRange-loopRange = brackets (try (do s <- expr-                              e <- expr+loopRange = brackets (try (LoopRange <$> expr <*> expr <*> option WildCard pattern)+                      <|> (do s <- expr                               ep <- option WildCard pattern-                              return (LoopRange s e ep))-                 <|> (do s <- expr-                         ep <- option WildCard pattern-                         return (LoopRange s (ApplyExpr (VarExpr $ stringToVar "from") (ApplyExpr (VarExpr $ stringToVar "-'") (TupleExpr [s, (IntegerExpr 1)]))) ep)))+                              return (LoopRange s (ApplyExpr (VarExpr $ stringToVar "from") (ApplyExpr (VarExpr $ stringToVar "-'") (TupleExpr [s, (IntegerExpr 1)]))) ep)))  divPat :: Parser EgisonPattern divPat = reservedOp "/" >> DivPat <$> pattern <*> pattern@@ -696,11 +679,8 @@ multPat = reservedOp "*" >> MultPat <$> sepEndBy powerPat whiteSpace  powerPat :: Parser EgisonPattern-powerPat = try (do pat1 <- pattern-                   char '^'-                   pat2 <- pattern-                   return $ PowerPat pat1 pat2)-       <|> pattern+powerPat = try (PowerPat <$> pattern <* char '^' <*> pattern)+            <|> pattern  dfsPat :: Parser EgisonPattern dfsPat = keywordDFS >> DFSPat' <$> pattern@@ -721,7 +701,7 @@                  <?> "constant"  charExpr :: Parser EgisonExpr-charExpr = CharExpr <$> charLiteral+charExpr = CharExpr <$> oneChar  stringExpr :: Parser EgisonExpr stringExpr = StringExpr . T.pack <$> stringLiteral@@ -731,15 +711,9 @@  floatExpr :: Parser EgisonExpr floatExpr = do-  (x,y) <- try (do x <- floatLiteral'-                   y <- sign' <*> positiveFloatLiteral-                   char 'i'-                   return (x,y))-            <|> try (do y <- floatLiteral'-                        char 'i'-                        return (0,y))-            <|> try (do x <- floatLiteral'-                        return (x,0))+  (x,y) <- try ((,) <$> floatLiteral' <*> (sign' <*> positiveFloatLiteral) <* char 'i')+            <|> try ((,) 0 <$> floatLiteral' <* char 'i')+            <|> try (flip (,) 0 <$> floatLiteral')   return $ FloatExpr x y  integerExpr :: Parser EgisonExpr@@ -814,6 +788,9 @@   , "let"   , "let*"   , "with-symbols"+--  , "not"+--  , "and"+--  , "or"   , "loop"   , "match-all"   , "match"@@ -880,6 +857,7 @@ keywordNot                  = reserved "not" keywordAnd                  = reserved "and" keywordOr                   = reserved "or"+keywordLater                = reserved "later" keywordSeq                  = reserved "seq" keywordApply                = reserved "apply" keywordCApply               = reserved "capply"@@ -900,10 +878,6 @@ keywordMatchAllLambda       = reserved "match-all-lambda" keywordMatch                = reserved "match" keywordMatchLambda          = reserved "match-lambda"-keywordNextMatchAll         = reserved "next-match-all"-keywordNextMatchAllLambda   = reserved "next-match-all-lambda"-keywordNextMatch            = reserved "next-match"-keywordNextMatchLambda      = reserved "next-match-lambda" keywordMatcher              = reserved "matcher" keywordMatcherDFS           = reserved "matcher-dfs" keywordDo                   = reserved "do"@@ -955,10 +929,14 @@ stringLiteral :: Parser String stringLiteral = P.stringLiteral lexer ---charLiteral :: Parser Char---charLiteral = P.charLiteral lexer charLiteral :: Parser Char-charLiteral = string "c#" >> anyChar+charLiteral = P.charLiteral lexer++oneChar :: Parser Char+oneChar = do+  string "c#"+  x <- (char '\\' >> anyChar >>= (\x -> return ['\\', x])) <|> (anyChar >>= (\x -> return [x]))+  return $ doParse' charLiteral $ "'" ++ x ++ "'"  boolLiteral :: Parser Bool boolLiteral = char '#' >> (char 't' *> pure True <|> char 'f' *> pure False)

@@ -124,6 +124,10 @@     fromParsecError :: ParseError -> EgisonError     fromParsecError = Parser . show +doParse' :: Parser a -> String -> a+doParse' p input = case doParse p input of+                     Right x -> x+ -- -- Expressions --@@ -142,7 +146,7 @@              <|> try (do (VarWithIndices name is) <- identVarWithIndices                          inSpaces $ string "=" >> notFollowedBy (string "=")                          body <- expr-                         return $ Define (Var name (map f is)) (WithSymbolsExpr (map g is) (TransposeExpr (CollectionExpr (map (ElementExpr . h) is)) body)))+                         return $ Define (Var name (map f is)) (WithSymbolsExpr (map g is) (TransposeExpr (CollectionExpr (map (ElementExpr . VarExpr . stringToVar . g) is)) body)))  where   argNames' :: Parser [Arg]   argNames' = sepEndBy argName' comma@@ -156,9 +160,6 @@   g (Superscript i) = i   g (Subscript i) = i   g (SupSubscript i) = i-  h (Superscript i) = (VarExpr $ stringToVar i)-  h (Subscript i) = (VarExpr $ stringToVar i)-  h (SupSubscript i) = (VarExpr $ stringToVar i)  testExpr :: Parser EgisonTopExpr testExpr = keywordTest >> Test <$> parens expr@@ -190,7 +191,7 @@           , [binary "+" "+" AssocLeft, binary "-" "-" AssocLeft, binary "%" "remainder" AssocLeft]           , [binary "==" "eq?" AssocLeft, binary "<=" "lte?" AssocLeft, binary "<" "lt?" AssocLeft, binary ">=" "gte?" AssocLeft, binary ">" "gt?" AssocLeft]           , [binary ":" "cons" AssocLeft, binary ".." "between" AssocLeft]-          , [binary "and" "and" AssocLeft, binary "or" "or" AssocLeft]+          , [binary "&&" "and" AssocLeft, binary "||" "or" AssocLeft]           , [binary "++" "join" AssocRight]           ]   unary "-" assoc = Prefix (try $ inSpaces (string "-") >> (return $ \x -> (makeApply (VarExpr $ stringToVar "*") [IntegerExpr (-1), x])))@@ -279,7 +280,7 @@ freshVarExpr = char '#' >> return FreshVarExpr  inductiveDataExpr :: Parser EgisonExpr-inductiveDataExpr = angles $ InductiveDataExpr <$> upperName <*> sepEndBy expr whiteSpace+inductiveDataExpr = angles $ InductiveDataExpr <$> upperName <*> sepEndBy term whiteSpace  tupleExpr :: Parser EgisonExpr tupleExpr = parens $ TupleExpr <$> sepEndBy expr comma@@ -356,8 +357,8 @@  ppPattern :: Parser PrimitivePatPattern ppPattern = P.lexeme lexer (ppWildCard+                        <|> try ppValuePat                         <|> ppPatVar-                        <|> ppValuePat                         <|> ppInductivePat                         <?> "primitive-pattren-pattern") @@ -368,7 +369,7 @@ ppPatVar = reservedOp "$" *> pure PPPatVar  ppValuePat :: Parser PrimitivePatPattern-ppValuePat = reservedOp ",$" >> PPValuePat <$> ident+ppValuePat = reservedOp "$" >> PPValuePat <$> ident  ppInductivePat :: Parser PrimitivePatPattern ppInductivePat = angles (PPInductivePat <$> lowerName <*> sepEndBy ppPattern whiteSpace)@@ -382,7 +383,7 @@                     <|> brackets ((PDConsPat <$> pdPattern <* comma <*> (char '@' *> pdPattern))                             <|> (PDSnocPat <$> (char '@' *> pdPattern) <* comma <*> pdPattern)                             <|> pure PDEmptyPat)-                    <|> angles (PDInductivePat <$> upperName <*> sepEndBy pdPattern comma)+                    <|> angles (PDInductivePat <$> upperName <*> sepEndBy pdPattern whiteSpace)                     <|> parens (PDTuplePat <$> sepEndBy pdPattern comma)                     <|> PDConstantPat <$> constantExpr                     <?> "primitive-data-pattern"@@ -443,14 +444,14 @@ binding = (,) <$> varNames' <* inSpaces (string "=") <*> expr  varNames :: Parser [String]-varNames = sepEndBy (char '$' >> ident) spaces+varNames = sepEndBy (char '$' >> ident) whiteSpace  varNames' :: Parser [Var] varNames' = return <$> identVar             <|> parens (sepEndBy identVar comma)  argNames :: Parser [Arg]-argNames = sepEndBy argName spaces+argNames = sepEndBy argName whiteSpace  argName :: Parser Arg argName = try (char '$' >> ident >>= return . ScalarArg)@@ -653,12 +654,7 @@ loopPat = keywordLoop >> parens (char '$' >> LoopPat <$> identVarWithoutIndex <*> (comma >> loopRange) <*> (comma >> pattern) <*> (comma >> option (NotPat WildCard) pattern))  loopRange :: Parser LoopRange-loopRange = brackets (try (do s <- expr-                              comma-                              e <- expr-                              comma-                              ep <- option WildCard pattern-                              return (LoopRange s e ep))+loopRange = parens (try (LoopRange <$> expr <* comma <*> expr <*> option WildCard (comma >> pattern))                  <|> (do s <- expr                          comma                          ep <- option WildCard pattern@@ -683,7 +679,7 @@                  <?> "constant"  charExpr :: Parser EgisonExpr-charExpr = CharExpr <$> charLiteral+charExpr = CharExpr <$> oneChar  stringExpr :: Parser EgisonExpr stringExpr = StringExpr . T.pack <$> stringLiteral@@ -693,15 +689,9 @@  floatExpr :: Parser EgisonExpr floatExpr = do-  (x,y) <- try (do x <- floatLiteral'-                   y <- sign' <*> positiveFloatLiteral-                   char 'i'-                   return (x,y))-            <|> try (do y <- floatLiteral'-                        char 'i'-                        return (0,y))-            <|> try (do x <- floatLiteral'-                        return (x,0))+  (x,y) <- try ((,) <$> floatLiteral' <*> (sign' <*> positiveFloatLiteral) <* char 'i')+            <|> try ((,) 0 <$> floatLiteral' <* char 'i')+            <|> try (flip (,) 0 <$> floatLiteral')   return $ FloatExpr x y  integerExpr :: Parser EgisonExpr@@ -806,7 +796,6 @@ reservedOperators :: [String] reservedOperators =   [ "$"-  , ",$"   , "_"   , "^"   , "&"@@ -898,10 +887,14 @@ stringLiteral :: Parser String stringLiteral = P.stringLiteral lexer ---charLiteral :: Parser Char---charLiteral = P.charLiteral lexer charLiteral :: Parser Char-charLiteral = string "c#" >> anyChar+charLiteral = P.charLiteral lexer++oneChar :: Parser Char+oneChar = do+  string "c#"+  x <- (char '\\' >> anyChar >>= (\x -> return ['\\', x])) <|> (anyChar >>= (\x -> return [x]))+  return $ doParse' charLiteral $ "'" ++ x ++ "'"  boolLiteral :: Parser Bool boolLiteral = char '#' >> (char 't' *> pure True <|> char 'f' *> pure False)

@@ -256,11 +256,6 @@   | MatchLambdaExpr EgisonExpr [MatchClause]   | MatchAllLambdaExpr EgisonExpr [MatchClause] -  | NextMatchExpr EgisonExpr EgisonExpr [MatchClause]-  | NextMatchAllExpr EgisonExpr EgisonExpr MatchClause-  | NextMatchLambdaExpr EgisonExpr [MatchClause]-  | NextMatchAllLambdaExpr EgisonExpr MatchClause-   | MatcherExpr MatcherInfo   | MatcherDFSExpr MatcherInfo   | AlgebraicDataMatcherExpr [(String, [EgisonExpr])]@@ -338,6 +333,7 @@   | PredPat EgisonExpr   | IndexedPat EgisonPattern [EgisonExpr]   | LetPat [BindingExpr] EgisonPattern+  | LaterPat EgisonPattern   | NotPat EgisonPattern   | AndPat [EgisonPattern]   | OrPat [EgisonPattern]@@ -1211,6 +1207,7 @@   show (ApplyExpr fn (TupleExpr args)) = "(" ++ show fn ++ " " ++ unwords (map show args) ++ ")"   show (ApplyExpr fn arg) = "(" ++ show fn ++ " " ++ show arg ++ ")"   show (VectorExpr xs) = "[| " ++ unwords (map show xs) ++ " |]"+  show (WithSymbolsExpr xs e) = "(withSymbols {" ++ unwords (map show xs) ++ "} " ++ show e ++ ")"   show _ = "(not supported)"  instance Show EgisonValue where@@ -1646,7 +1643,8 @@  topDFS :: EgisonPattern -> Bool topDFS (DFSPat _ _) = True-topDFS (InductivePat _ patterns) = any topDFS patterns+topDFS (InductivePat _ (pattern:_)) = topDFS pattern+topDFS (LetPat _ pattern) = topDFS pattern topDFS _ = False  containBFS :: EgisonPattern -> Bool@@ -1666,6 +1664,7 @@ containBFS (MultPat patterns) = any containBFS patterns containBFS (PowerPat pat1 pat2) = containBFS pat1 || containBFS pat2 containBFS (DFSPat _ pattern) = containBFS pattern+containBFS (LetPat _ pattern) = containBFS pattern containBFS _ = False  --

@@ -574,7 +574,7 @@                   [(map (lambda [$i] x_i) (between 1 n))                    tgt]])]}]        [,$val []-        {[$tgt (match [val tgt] [(list a) (multiset a)]+        {[$tgt (match [(unique val) (unique tgt)] [(list a) (multiset a)]                  {[[<nil> <nil>] {[]}]                   [[<cons $x $xs> <cons ,x ,xs>] {[]}]                   [[_ _] {}]})]}]@@ -593,7 +593,7 @@ (define $unique   (lambda [$xs]     (reverse (match-all (reverse xs) (list something)-      [<join _ <cons $x !<join _ <cons ,x _>>>> x]))))+               [<join _ <cons $x !<join _ <cons ,x _>>>> x]))))  (define $unique/m   (lambda [$a $xs]

@@ -55,6 +55,10 @@                    <nil>)>       a]))) +(test (n-queen 4))+(test (n-queen 5))+(test (n-queen 6))+(test (n-queen 7)) (test (n-queen 8)) (test (n-queen 9)) (test (n-queen 10))