egison 3.10.0 → 3.10.1
raw patch · 11 files changed
+255/−160 lines, 11 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- egison.cabal +1/−1
- hs-src/Interpreter/egison.hs +0/−1
- hs-src/Language/Egison/AST.hs +3/−3
- hs-src/Language/Egison/ParserNonS.hs +105/−112
- hs-src/Language/Egison/Pretty.hs +32/−8
- hs-src/Language/Egison/Types.hs +7/−7
- hs-src/Tool/translator.hs +4/−4
- nons-test/test/dp.egi +7/−7
- nons-test/test/poker-joker.egi +37/−0
- nons-test/test/poker.egi +9/−9
- nons-test/test/syntax.egi +50/−8
egison.cabal view
@@ -1,5 +1,5 @@ Name: egison-Version: 3.10.0+Version: 3.10.1 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.
hs-src/Interpreter/egison.hs view
@@ -7,7 +7,6 @@ import Control.Exception (AsyncException (..), catch) import Control.Monad.Except import Control.Monad.Trans.State-import Prelude hiding (catch) import qualified Data.Text as T
hs-src/Language/Egison/AST.hs view
@@ -18,9 +18,9 @@ , Index (..) , PMMode (..) , InnerExpr (..)- , BindingExpr (..)- , MatchClause (..)- , PatternDef (..)+ , BindingExpr+ , MatchClause+ , PatternDef , LoopRange (..) , PrimitivePatPattern (..) , PrimitiveDataPattern (..)
hs-src/Language/Egison/ParserNonS.hs view
@@ -32,7 +32,7 @@ import Control.Monad.State (unless) import Data.Functor (($>))-import Data.List (find)+import Data.List (find, groupBy) import Data.Maybe (fromJust, isJust) import Data.Text (pack) import Data.Traversable (mapM)@@ -138,8 +138,8 @@ -- topExpr :: Parser EgisonTopExpr-topExpr = Load <$> (keywordLoad >> stringLiteral)- <|> LoadFile <$> (keywordLoadFile >> stringLiteral)+topExpr = Load <$> (reserved "load" >> stringLiteral)+ <|> LoadFile <$> (reserved "loadFile" >> stringLiteral) <|> defineOrTestExpr <?> "toplevel expression" @@ -177,7 +177,20 @@ ScalarArg x : xs -> exprToArgs lhs ++ TensorArg x : xs expr :: Parser EgisonExpr-expr = ifExpr+expr = do+ body <- exprWithoutWhere+ bindings <- optional whereDefs+ return $ case bindings of+ Nothing -> body+ Just bindings -> LetRecExpr bindings body+ where+ whereDefs = do+ pos <- reserved "where" >> L.indentLevel+ some (L.indentGuard sc EQ pos >> binding)++exprWithoutWhere :: Parser EgisonExpr+exprWithoutWhere =+ ifExpr <|> patternMatchExpr <|> lambdaExpr <|> letExpr@@ -200,53 +213,46 @@ opExpr = do pos <- L.indentLevel makeExprParser atomOrApplyExpr (makeTable pos)++makeTable :: Pos -> [[Operator Parser EgisonExpr]]+makeTable pos =+ -- prefixes have top priority+ let prefixes = [ [ Prefix (unary "-")+ , Prefix (unary "!") ] ]+ -- Generate binary operator table from reservedBinops+ binops = map (map binOpToOperator)+ (groupBy (\x y -> priority x == priority y) reservedBinops)+ in prefixes ++ binops where- makeTable :: Pos -> [[Operator Parser EgisonExpr]]- makeTable pos =- let unary sym = UnaryOpExpr <$> operator sym- binary sym = do- op <- try (L.indentGuard sc GT pos >> binOpLiteral sym <* notFollowedBy (symbol ")"))- return $ BinaryOpExpr op- in- [ [ Prefix (unary "-" )- , Prefix (unary "!" ) ]- -- 8- , [ InfixL (binary "^" ) ]- -- 7- , [ InfixL (binary "*" )- , InfixL (binary "/" )- , InfixL (binary "%" ) ]- -- 6- , [ InfixL (binary "+" )- , InfixL (binary "-" ) ]- -- 5- , [ InfixR (binary "::" )- , InfixR (binary "++") ]- -- 4- , [ InfixL (binary "=")- , InfixL (binary "<=")- , InfixL (binary "<" )- , InfixL (binary ">=")- , InfixL (binary ">" ) ]- -- 3- , [ InfixR (binary "&&") ]- -- 2- , [ InfixR (binary "||") ]- ]+ unary :: String -> Parser (EgisonExpr -> EgisonExpr)+ unary sym = UnaryOpExpr <$> operator sym + binary :: String -> Parser (EgisonExpr -> EgisonExpr -> EgisonExpr)+ binary sym = do+ -- TODO: Is this indentation guard necessary?+ op <- try (L.indentGuard sc GT pos >> binOpLiteral sym <* notFollowedBy (symbol ")"))+ return $ BinaryOpExpr op++ binOpToOperator :: EgisonBinOp -> Operator Parser EgisonExpr+ binOpToOperator op = case assoc op of+ LeftAssoc -> InfixL (binary (repr op))+ RightAssoc -> InfixR (binary (repr op))+ NonAssoc -> InfixN (binary (repr op))++ ifExpr :: Parser EgisonExpr-ifExpr = keywordIf >> IfExpr <$> expr <* keywordThen <*> expr <* keywordElse <*> expr+ifExpr = reserved "if" >> IfExpr <$> expr <* reserved "then" <*> expr <* reserved "else" <*> expr patternMatchExpr :: Parser EgisonExpr-patternMatchExpr = makeMatchExpr keywordMatch (MatchExpr BFSMode)- <|> makeMatchExpr keywordMatchDFS (MatchExpr DFSMode)- <|> makeMatchExpr keywordMatchAll (MatchAllExpr BFSMode)- <|> makeMatchExpr keywordMatchAllDFS (MatchAllExpr DFSMode)+patternMatchExpr = makeMatchExpr (reserved "match") (MatchExpr BFSMode)+ <|> makeMatchExpr (reserved "matchDFS") (MatchExpr DFSMode)+ <|> makeMatchExpr (reserved "matchAll") (MatchAllExpr BFSMode)+ <|> makeMatchExpr (reserved "matchAllDFS") (MatchAllExpr DFSMode) <?> "pattern match expression" where makeMatchExpr keyword ctor = ctor <$> (keyword >> expr)- <*> (keywordAs >> expr)- <*> (keywordWith >> matchClauses1)+ <*> (reserved "as" >> expr)+ <*> (reserved "with" >> matchClauses1) -- Parse more than 1 match clauses. matchClauses1 :: Parser [MatchClause]@@ -263,15 +269,15 @@ lambdaExpr :: Parser EgisonExpr lambdaExpr = symbol "\\" >> (- makeMatchLambdaExpr keywordMatch MatchLambdaExpr- <|> makeMatchLambdaExpr keywordMatchAll MatchAllLambdaExpr+ makeMatchLambdaExpr (reserved "match") MatchLambdaExpr+ <|> makeMatchLambdaExpr (reserved "matchAll") MatchAllLambdaExpr <|> try (LambdaExpr <$> some arg <*> (symbol "->" >> expr)) <|> PatternFunctionExpr <$> some lowerId <*> (symbol "=>" >> pattern)) <?> "lambda or pattern function expression" where makeMatchLambdaExpr keyword ctor = do- matcher <- keyword >> keywordAs >> expr- clauses <- keywordWith >> matchClauses1+ matcher <- keyword >> reserved "as" >> expr+ clauses <- reserved "with" >> matchClauses1 return $ ctor matcher clauses arg :: Parser Arg@@ -282,10 +288,13 @@ letExpr :: Parser EgisonExpr letExpr = do- pos <- keywordLet >> L.indentLevel- binds <- some (L.indentGuard sc EQ pos *> binding)- body <- keywordIn >> expr+ pos <- reserved "let" >> L.indentLevel+ binds <- oneLiner <|> some (L.indentGuard sc EQ pos *> binding)+ body <- reserved "in" >> expr return $ LetRecExpr binds body+ where+ oneLiner :: Parser [BindingExpr]+ oneLiner = braces $ sepBy binding (symbol ";") binding :: Parser BindingExpr binding = do@@ -299,24 +308,29 @@ _ -> (vars, LambdaExpr args body) withSymbolsExpr :: Parser EgisonExpr-withSymbolsExpr = WithSymbolsExpr <$> (keywordWithSymbols >> brackets (sepBy lowerId comma)) <*> expr+withSymbolsExpr = WithSymbolsExpr <$> (reserved "withSymbols" >> brackets (sepBy lowerId comma)) <*> expr doExpr :: Parser EgisonExpr doExpr = do- pos <- keywordDo >> L.indentLevel- stmts <- some $ L.indentGuard sc EQ pos >> statement- ret <- option (makeApply' "return" []) $ L.indentGuard sc EQ pos >> expr- return $ DoExpr stmts ret+ pos <- reserved "do" >> L.indentLevel+ stmts <- oneLiner <|> some (L.indentGuard sc EQ pos >> statement)+ return $ case last stmts of+ ([], retExpr@(ApplyExpr (VarExpr (Var ["return"] _)) _)) ->+ DoExpr (init stmts) retExpr+ _ -> DoExpr stmts (makeApply' "return" []) where statement :: Parser BindingExpr- statement = (keywordLet >> binding) <|> ([],) <$> expr+ statement = (reserved "let" >> binding) <|> ([],) <$> expr + oneLiner :: Parser [BindingExpr]+ oneLiner = braces $ sepBy statement (symbol ";")+ ioExpr :: Parser EgisonExpr-ioExpr = IoExpr <$> (keywordIo >> expr)+ioExpr = IoExpr <$> (reserved "io" >> expr) matcherExpr :: Parser EgisonExpr matcherExpr = do- keywordMatcher+ reserved "matcher" pos <- L.indentLevel -- In matcher expression, the first '|' (bar) is indispensable info <- some (L.indentGuard sc EQ pos >> symbol "|" >> patternDef)@@ -325,7 +339,7 @@ patternDef :: Parser (PrimitivePatPattern, EgisonExpr, [(PrimitiveDataPattern, EgisonExpr)]) patternDef = do pp <- ppPattern- returnMatcher <- keywordAs >> expr <* keywordWith+ returnMatcher <- reserved "as" >> expr <* reserved "with" pos <- L.indentLevel datapat <- some (L.indentGuard sc EQ pos >> symbol "|" >> dataCases) return (pp, returnMatcher, datapat)@@ -335,7 +349,7 @@ algebraicDataMatcherExpr :: Parser EgisonExpr algebraicDataMatcherExpr = do- keywordAlgebraicDataMatcher+ reserved "algebraicDataMatcher" pos <- L.indentLevel defs <- some (L.indentGuard sc EQ pos >> symbol "|" >> patternDef) return $ AlgebraicDataMatcherExpr defs@@ -348,24 +362,24 @@ return (patternCtor, args) memoizedLambdaExpr :: Parser EgisonExpr-memoizedLambdaExpr = MemoizedLambdaExpr <$> (keywordMemoizedLambda >> many lowerId) <*> (symbol "->" >> expr)+memoizedLambdaExpr = MemoizedLambdaExpr <$> (reserved "memoizedLambda" >> many lowerId) <*> (symbol "->" >> expr) procedureExpr :: Parser EgisonExpr-procedureExpr = ProcedureExpr <$> (keywordProcedure >> many lowerId) <*> (symbol "->" >> expr)+procedureExpr = ProcedureExpr <$> (reserved "procedure" >> many lowerId) <*> (symbol "->" >> expr) macroExpr :: Parser EgisonExpr-macroExpr = MacroExpr <$> (keywordMacro >> many lowerId) <*> (symbol "->" >> expr)+macroExpr = MacroExpr <$> (reserved "macro" >> many lowerId) <*> (symbol "->" >> expr) generateTensorExpr :: Parser EgisonExpr-generateTensorExpr = GenerateTensorExpr <$> (keywordGenerateTensor >> atomExpr) <*> atomExpr+generateTensorExpr = GenerateTensorExpr <$> (reserved "generateTensor" >> atomExpr) <*> atomExpr tensorExpr :: Parser EgisonExpr-tensorExpr = TensorExpr <$> (keywordTensor >> atomExpr) <*> atomExpr+tensorExpr = TensorExpr <$> (reserved "tensor" >> atomExpr) <*> atomExpr <*> option (CollectionExpr []) atomExpr <*> option (CollectionExpr []) atomExpr functionExpr :: Parser EgisonExpr-functionExpr = FunctionExpr <$> (keywordFunction >> parens (sepBy expr comma))+functionExpr = FunctionExpr <$> (reserved "function" >> parens (sepBy expr comma)) collectionExpr :: Parser EgisonExpr collectionExpr = symbol "[" >> (try betweenOrFromExpr <|> elementsExpr)@@ -465,7 +479,7 @@ atomExpr' :: Parser EgisonExpr atomExpr' = constantExpr <|> VarExpr <$> varLiteral- <|> (\x -> InductiveDataExpr x []) <$> upperId+ <|> inductiveDataOrModuleExpr <|> vectorExpr -- must come before collectionExpr <|> arrayExpr -- must come before tupleOrParenExpr <|> collectionExpr@@ -475,13 +489,20 @@ <|> QuoteSymbolExpr <$> (char '`' >> atomExpr') <?> "atomic expression" +inductiveDataOrModuleExpr :: Parser EgisonExpr+inductiveDataOrModuleExpr = do+ (ident, rest) <- upperOrModuleId+ return $ case rest of+ [] -> InductiveDataExpr ident []+ _ -> VarExpr (Var (ident : rest) [])+ constantExpr :: Parser EgisonExpr constantExpr = numericExpr <|> BoolExpr <$> boolLiteral <|> CharExpr <$> try charLiteral -- try for quoteExpr <|> StringExpr . pack <$> stringLiteral- <|> SomethingExpr <$ keywordSomething- <|> UndefinedExpr <$ keywordUndefined+ <|> SomethingExpr <$ reserved "something"+ <|> UndefinedExpr <$ reserved "undefined" numericExpr :: Parser EgisonExpr numericExpr = FloatExpr <$> try positiveFloatLiteral@@ -499,14 +520,14 @@ letPattern :: Parser EgisonPattern letPattern = do- pos <- keywordLet >> L.indentLevel+ pos <- reserved "let" >> L.indentLevel binds <- some (L.indentGuard sc EQ pos *> binding)- body <- keywordIn >> pattern+ body <- reserved "in" >> pattern return $ LetPat binds body loopPattern :: Parser EgisonPattern loopPattern =- LoopPat <$> (keywordLoop >> patVarLiteral) <*> loopRange+ LoopPat <$> (reserved "loop" >> patVarLiteral) <*> loopRange <*> atomPattern <*> atomPattern where loopRange :: Parser LoopRange@@ -550,6 +571,7 @@ case (func, args) of (_, []) -> return func (InductivePat x [], _) -> return $ InductivePat x args+ _ -> error (show (func, args)) atomPattern :: Parser EgisonPattern atomPattern = do@@ -705,50 +727,22 @@ then fail $ "keyword " ++ show x ++ " cannot be an identifier" else return x -keywordLoadFile = reserved "loadFile"-keywordLoad = reserved "load"-keywordIf = reserved "if"-keywordThen = reserved "then"-keywordElse = reserved "else"-keywordSeq = reserved "seq"-keywordApply = reserved "apply"-keywordCApply = reserved "capply"-keywordMemoizedLambda = reserved "memoizedLambda"-keywordCambda = reserved "cambda"-keywordProcedure = reserved "procedure"-keywordMacro = reserved "macro"-keywordLet = reserved "let"-keywordIn = reserved "in"-keywordWithSymbols = reserved "withSymbols"-keywordLoop = reserved "loop"-keywordMatch = reserved "match"-keywordMatchDFS = reserved "matchDFS"-keywordMatchAll = reserved "matchAll"-keywordMatchAllDFS = reserved "matchAllDFS"-keywordAs = reserved "as"-keywordWith = reserved "with"-keywordMatcher = reserved "matcher"-keywordDo = reserved "do"-keywordIo = reserved "io"-keywordSomething = reserved "something"-keywordUndefined = reserved "undefined"-keywordAlgebraicDataMatcher = reserved "algebraicDataMatcher"-keywordGenerateTensor = reserved "generateTensor"-keywordTensor = reserved "tensor"-keywordTensorContract = reserved "contract"-keywordSubrefs = reserved "subrefs"-keywordSubrefsNew = reserved "subrefs!"-keywordSuprefs = reserved "suprefs"-keywordSuprefsNew = reserved "suprefs!"-keywordUserrefs = reserved "userRefs"-keywordUserrefsNew = reserved "userRefs!"-keywordFunction = reserved "function"+-- Parses both InductiveDataExpr and Var with module+-- ex. "Greater" -> ("Greater", [])+-- "S.intercalate" -> ("S", ["intercalate"])+upperOrModuleId :: Parser (String, [String])+upperOrModuleId = do+ ident <- (:) <$> upperChar <*> many alphaNumChar+ follows <- many (char '.' >> some alphaNumChar) <* sc+ return (ident, follows) +upperReservedWords :: [String] upperReservedWords = [ "True" , "False" ] +lowerReservedWords :: [String] lowerReservedWords = [ "loadFile" , "load"@@ -764,10 +758,9 @@ , "macro" , "let" , "in"+ , "where" , "withSymbols" , "loop"- , "from"- , "to" , "of" , "match" , "matchDFS"
hs-src/Language/Egison/Pretty.hs view
@@ -33,7 +33,7 @@ instance Pretty EgisonTopExpr where pretty (Define x (LambdaExpr args body)) =- pretty x <+> hsep (map pretty args) <+> pretty ":=" <> nest 2 (softline <> pretty body)+ pretty x <+> hsep (map pretty args) <+> pretty ":=" <> nest 2 (hardline <> pretty body) pretty (Define x expr) = pretty x <+> pretty ":=" <> nest 2 (softline <> pretty expr) pretty (Test expr) = pretty expr pretty (LoadFile file) = pretty "loadFile" <+> pretty (show file)@@ -93,8 +93,12 @@ else pretty x <+> pretty (repr op) <+> pretty' y pretty (BinaryOpExpr op x y) = pretty x <+> pretty (repr op) <+> pretty' y - pretty (ApplyExpr x (TupleExpr ys)) = nest 2 (pretty x <+> fillSep (map pretty ys))+ -- TODO: Fix display of binding expr for do+ pretty (DoExpr xs y) = pretty "do" <+> pretty xs <> hardline <> pretty y+ pretty (IoExpr x) = pretty "io" <+> pretty x + pretty (ApplyExpr x (TupleExpr ys)) = nest 2 (pretty x <+> fillSep (map pretty' ys))+ pretty SomethingExpr = pretty "something" pretty UndefinedExpr = pretty "undefined" @@ -119,23 +123,43 @@ pretty (pat, expr) = pipe <+> pretty pat <+> pretty "->" <> softline <> pretty expr instance Pretty EgisonPattern where+ -- TODO: Add parenthesis according to priority pretty WildCard = pretty "_" pretty (PatVar x) = pretty "$" <> pretty x- pretty (ValuePat v) = pretty "#" <> parens (pretty v) -- TODO: remove parens- pretty (PredPat v) = pretty "?" <> parens (pretty v)+ pretty (ValuePat v) = pretty "#" <> pretty v+ pretty (PredPat v) = pretty "?" <> pretty v+ pretty (InductivePat "nil" []) = pretty "[]"+ pretty (InductivePat "cons" [x, y]) = pretty x <+> pretty "::" <+> pretty y+ pretty (InductivePat "join" [x, y]) = pretty x <+> pretty "++" <+> pretty y+ pretty (InductivePat ctor xs) = pretty ctor <+> hsep (map pretty xs)+ pretty (AndPat xs) = pintercalate (pretty "&") (map pretty xs)+ pretty (OrPat xs) = pintercalate (pretty "|") (map pretty xs)+ pretty (TuplePat xs) = tupled $ map pretty xs pretty _ = pretty "hoge" pretty' :: EgisonExpr -> Doc ann-pretty' x@(UnaryOpExpr _ _) = parens $ pretty x-pretty' x = pretty x+pretty' x =+ case x of+ UnaryOpExpr _ _ -> parens $ pretty x+ ApplyExpr _ _ -> parens $ pretty x+ LambdaExpr _ _ -> parens $ pretty x+ IfExpr _ _ _ -> parens $ pretty x+ LetRecExpr _ _ -> parens $ pretty x+ MatchExpr _ _ _ _ -> parens $ pretty x+ MatchLambdaExpr _ _ -> parens $ pretty x+ MatchAllLambdaExpr _ _ -> parens $ pretty x+ _ -> pretty x prettyMatch :: EgisonExpr -> [MatchClause] -> Doc ann prettyMatch matcher clauses =- pretty "as" <+> pretty matcher <+> pretty "with" <> hardline <>- align (vsep (map pretty clauses))+ pretty "as" <+> group (pretty matcher) <+> pretty "with" <>+ (nest 2 (hardline <> align (vsep (map pretty clauses)))) listoid :: String -> String -> [Doc ann] -> Doc ann listoid lp rp elems = encloseSep (pretty lp) (pretty rp) (comma <> space) elems++pintercalate :: Doc ann -> [Doc ann] -> Doc ann+pintercalate sep elems = encloseSep emptyDoc emptyDoc (space <> sep <> space) elems -- -- Pretty printer for S-expression
hs-src/Language/Egison/Types.hs view
@@ -17,8 +17,8 @@ ( -- * Egison values EgisonValue (..)- , Matcher (..)- , PrimitiveFunc (..)+ , Matcher+ , PrimitiveFunc , ScalarData (..) , PolyExpr (..) , TermExpr (..)@@ -69,7 +69,7 @@ , extractScalar' -- * Internal data , Object (..)- , ObjectRef (..)+ , ObjectRef , WHNFData (..) , Intermediate (..) , Inner (..)@@ -77,7 +77,7 @@ -- * Environment , Env (..) , VarWithIndices (..)- , Binding (..)+ , Binding , nullEnv , extendEnv , refVar@@ -86,7 +86,7 @@ , Match , MatchingTree (..) , MatchingState (..)- , PatternBinding (..)+ , PatternBinding , LoopPatContext (..) , SeqPatContext (..) -- * Errors@@ -98,10 +98,10 @@ , liftEgisonM , fromEgisonM , FreshT (..)- , Fresh (..)+ , Fresh , MonadFresh (..) , runFreshT- , MatchM (..)+ , MatchM , matchFail , MList (..) , fromList
hs-src/Tool/translator.hs view
@@ -19,7 +19,7 @@ instance SyntaxElement EgisonTopExpr where toNonS (Define x y) = Define (toNonS x) (toNonS y)- toNonS (Redefine x y) = error "Not supported"+ toNonS (Redefine _ _) = error "Not supported" toNonS (Test x) = Test (toNonS x) toNonS (Execute x) = Execute (toNonS x) toNonS x = x@@ -70,11 +70,11 @@ toNonS (DoExpr xs y) = DoExpr (map toNonS xs) (toNonS y) toNonS (IoExpr x) = IoExpr (toNonS x) - toNonS (ApplyExpr x@(VarExpr (Var [f] [])) (TupleExpr (y:ys)))- | any (\op -> repr op == f) reservedBinops =+ toNonS (ApplyExpr (VarExpr (Var [f] [])) (TupleExpr (y:ys)))+ | any (\op -> func op == f) reservedBinops = foldl (\acc x -> BinaryOpExpr op acc (toNonS x)) (toNonS y) ys where- op = fromJust $ find (\op -> repr op == f) reservedBinops+ op = fromJust $ find (\op -> func op == f) reservedBinops toNonS (ApplyExpr x y) = ApplyExpr (toNonS x) (toNonS y) toNonS x = x
nons-test/test/dp.egi view
@@ -38,10 +38,10 @@ -> dp vs (resolveOn v cnf ++ deleteClausesWith v (deleteClausesWith (neg v) cnf)) -dp [1] [[1]] -- True-dp [1] [[1],[-1]] -- False-dp [1,2,3] [[1,2],[-1,3],[1,-3]] -- True-dp [1,2] [[1,2],[-1,-2],[1,-2]] -- True-dp [1,2] [[1,2],[-1,-2],[1,-2],[-1,2]] -- False-dp [1,2,3,4,5] [[-1,-2,3],[-1,-2,-3],[1,2,3,4],[-4,-2,3],[5,1,2,-3],[-3,1,-5],[1,-2,3,4],[1,-2,-3,5]] -- True-dp [1,2] [[-1,-2],[1]] -- True+assertEqual "dp" (dp [1] [[1]]) True+assertEqual "dp" (dp [1] [[1],[-1]]) False+assertEqual "dp" (dp [1,2,3] [[1,2],[-1,3],[1,-3]]) True+assertEqual "dp" (dp [1,2] [[1,2],[-1,-2],[1,-2]]) True+assertEqual "dp" (dp [1,2] [[1,2],[-1,-2],[1,-2],[-1,2]]) False+assertEqual "dp" (dp [1,2,3,4,5] [[-1,-2,3],[-1,-2,-3],[1,2,3,4],[-4,-2,3],[5,1,2,-3],[-3,1,-5],[1,-2,3,4],[1,-2,-3,5]]) True+assertEqual "dp" (dp [1,2] [[-1,-2],[1]]) True
+ nons-test/test/poker-joker.egi view
@@ -0,0 +1,37 @@+suit := algebraicDataMatcher+ | spade+ | heart+ | club+ | diamond++card := matcher+ | card $ $ as (suit, mod 13) with + | Card $s $n -> [(s, n)]+ | Joker -> matchAll ([Spade, Heart, Club, Diamond], [1..13])+ as (set suit, set integer) with+ | ($s :: _, $n :: _) -> (s, n)+ | $ as something with+ | $tgt -> [tgt]++poker cs :=+ match cs as multiset card with+ | card $s $n :: card #s #(n-1) :: card #s #(n-2) :: card #s #(n-3) :: card #s #(n-4) :: _+ -> "Straight flush"+ | card _ $n :: card _ #n :: card _ #n :: card _ #n :: _ :: []+ -> "Four of a kind"+ | card _ $m :: card _ #m :: card _ #m :: card _ $n :: card _ #n :: []+ -> "Full house"+ | card $s _ :: card #s _ :: card #s _ :: card #s _ :: card #s _ :: []+ -> "Flush"+ | card _ $n :: card _ #(n-1) :: card _ #(n-2) :: card _ #(n-3) :: card _ #(n-4) :: []+ -> "Straight"+ | card _ $n :: card _ #n :: card _ #n :: _ :: _ :: []+ -> "Three of a kind"+ | card _ $m :: card _ #m :: card _ $n :: card _ #n :: _ :: []+ -> "Two pair"+ | card _ $n :: card _ #n :: _ :: _ :: _ :: []+ -> "One pair"+ | _ :: _ :: _ :: _ :: _ :: [] -> "Nothing"++assertEqual "poker-joker" (poker [Card Spade 5, Card Spade 6, Joker, Card Spade 8, Card Spade 9]) "Straight flush"+assertEqual "poker-joker" (poker [Card Spade 5, Card Diamond 5, Joker, Card Club 5, Card Heart 7]) "Four of a kind"
nons-test/test/poker.egi view
@@ -28,12 +28,12 @@ | _ :: _ :: _ :: _ :: _ :: [] -> "Nothing" -poker [Card Spade 5, Card Spade 6, Card Spade 7, Card Spade 8, Card Spade 9] -- "Straight flush"-poker [Card Spade 5, Card Diamond 5, Card Spade 7, Card Club 5, Card Heart 5] -- "Four of a kind"-poker [Card Spade 5, Card Diamond 5, Card Spade 7, Card Club 5, Card Heart 7] -- "Full house"-poker [Card Spade 5, Card Spade 6, Card Spade 7, Card Spade 13, Card Spade 9] -- "Flush"-poker [Card Spade 5, Card Club 6, Card Spade 7, Card Spade 8, Card Spade 9] -- "Straight"-poker [Card Spade 5, Card Diamond 5, Card Spade 7, Card Club 5, Card Heart 8] -- "Three of a kind"-poker [Card Spade 5, Card Diamond 10, Card Spade 7, Card Club 5, Card Heart 10] -- "Two pair"-poker [Card Spade 5, Card Diamond 10, Card Spade 7, Card Club 5, Card Heart 8] -- "One pair"-poker [Card Spade 5, Card Spade 6, Card Spade 7, Card Spade 8, Card Diamond 11] -- "Nothing"+assertEqual "poker" (poker [Card Spade 5, Card Spade 6, Card Spade 7, Card Spade 8, Card Spade 9]) "Straight flush"+assertEqual "poker" (poker [Card Spade 5, Card Diamond 5, Card Spade 7, Card Club 5, Card Heart 5]) "Four of a kind"+assertEqual "poker" (poker [Card Spade 5, Card Diamond 5, Card Spade 7, Card Club 5, Card Heart 7]) "Full house"+assertEqual "poker" (poker [Card Spade 5, Card Spade 6, Card Spade 7, Card Spade 13, Card Spade 9]) "Flush"+assertEqual "poker" (poker [Card Spade 5, Card Club 6, Card Spade 7, Card Spade 8, Card Spade 9]) "Straight"+assertEqual "poker" (poker [Card Spade 5, Card Diamond 5, Card Spade 7, Card Club 5, Card Heart 8]) "Three of a kind"+assertEqual "poker" (poker [Card Spade 5, Card Diamond 10, Card Spade 7, Card Club 5, Card Heart 10]) "Two pair"+assertEqual "poker" (poker [Card Spade 5, Card Diamond 10, Card Spade 7, Card Club 5, Card Heart 8]) "One pair"+assertEqual "poker" (poker [Card Spade 5, Card Spade 6, Card Spade 7, Card Spade 8, Card Diamond 11]) "Nothing"
nons-test/test/syntax.egi view
@@ -62,6 +62,29 @@ in y) 2 +assertEqual "let binding without indent"+ (let { x := 1; y := x + 1 } in y)+ 2++io do print "io and do expression"+ return 0++io do { print "io and do expression without indent"; return 0 }++assertEqual "where"+ (f 0 + y + 1+ where f x := 2 + x+ y := 3)+ 6++assertEqual "nested where"+ (f 0 + 1+ where+ f x := 2 + y + z+ where y := 3+ z := 4)+ 10+ assertEqual "mutual recursion" (let even? n := if n = 0 then True else odd? (n - 1) odd? n := if n = 0 then False else even? (n - 1)@@ -104,7 +127,8 @@ primeTriplets := matchAll primes as list integer with- | _ ++ $p :: ((#(p + 2) | #(p + 4)) & $m) :: #(p + 6) :: _ -> (p, m, p + 6)+ | _ ++ $p :: ((#(p + 2) | #(p + 4)) & $m) :: #(p + 6) :: _+ -> (p, m, p + 6) assertEqual "prime triplets" (take 10 primeTriplets)@@ -118,10 +142,10 @@ 7 gcd m n :=- if (m >= n) then- if (n = 0) then m- else gcd n (m % n)- else gcd n m+ if m >= n then+ if n = 0 then m+ else gcd n (m % n)+ else gcd n m assertEqual "recursive function definition" (gcd 143 22)@@ -313,6 +337,16 @@ | _ ++ $m :: _ ++ $n :: _ -> [m, n])) [[1, 2], [1, 3], [2, 3], [1, 4], [2, 4], [3, 4], [1, 5], [2, 5], [3, 5], [4, 5]] +assertEqual "combinations"+ (matchAll [1,2,3] as list something with+ | _ ++ $x :: _ ++ $y :: _ -> (x, y))+ [(1, 2), (1, 3), (2, 3)]++assertEqual "permutations"+ (matchAll [1,2,3] as multiset something with+ | $x :: $y :: _ -> (x, y))+ [(1, 2), (1, 3), (2, 1), (2, 3), (3, 1), (3, 2)]+ tree a := algebraicDataMatcher | leaf | node (tree a) a (tree a)@@ -340,9 +374,17 @@ assert "sequential pattern" (match [2,3,1,4,5] as list integer with- { @ :: @ :: $x :: _,- (#(x + 1), @),- #(x + 2)} -> True)+ | { @ :: @ :: $x :: _,+ (#(x + 1), @),+ #(x + 2)}+ -> True)++assertEqual "sequential not pattern"+ (matchAll ([1,2,3], [4,3,5]) as (multiset eq, multiset eq) with+ | { ($x :: @, #x :: @),+ !($y :: _, #y :: _) }+ -> x)+ [3] -- -- Tensor