egison 3.3.8 → 3.3.9
raw patch · 16 files changed
+267/−94 lines, 16 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Language.Egison: evalEgisonTopExprsTestOnly :: Env -> [EgisonTopExpr] -> IO (Either EgisonError Env)
+ Language.Egison.Core: evalTopExprsTestOnly :: Env -> [EgisonTopExpr] -> EgisonM Env
Files
- egison.cabal +1/−1
- hs-src/Interpreter/egison.hs +46/−31
- hs-src/Language/Egison.hs +5/−0
- hs-src/Language/Egison/Core.hs +23/−1
- hs-src/Language/Egison/Parser.hs +1/−1
- lib/core/collection.egi +21/−24
- lib/core/io.egi +24/−7
- lib/core/string.egi +6/−0
- sample/io/argv.egi +3/−5
- sample/io/cat2.egi +1/−2
- sample/io/cat3.egi +3/−0
- sample/io/dice.egi +2/−3
- sample/io/interactive.egi +0/−15
- sample/io/print-primes.egi +2/−2
- sample/poker-hands-with-joker.egi +120/−0
- sample/sequence.egi +9/−2
egison.cabal view
@@ -1,5 +1,5 @@ Name: egison-Version: 3.3.8+Version: 3.3.9 Synopsis: Programming language with non-linear pattern-matching against unfree data Description: An interpreter for Egison, the programming langugage that realized non-linear pattern-matching against unfree data types.
hs-src/Interpreter/egison.hs view
@@ -25,29 +25,37 @@ case opts of Options {optShowHelp = True} -> printHelp Options {optShowVersion = True} -> printVersionNumber- Options {optPrompt = prompt, optShowBanner = bannerFlag, optNoIO = noIOFlag} -> do+ Options {optEvalString = mExpr, optPrompt = prompt, optShowBanner = bannerFlag, optNoIO = noIOFlag} -> do env <- if noIOFlag then initialEnvNoIO else initialEnv- case nonOpts of- [] -> do- when bannerFlag showBanner >> repl noIOFlag env prompt >> when bannerFlag showByebyeMessage- (file:args) -> do- case opts of- Options {optLoadOnly = True} -> do- result <- if noIOFlag- then do input <- readFile file- runEgisonTopExprsNoIO env input- else evalEgisonTopExprs env [LoadFile file]- either print (const $ return ()) result- Options {optLoadOnly = False} -> do- result <- evalEgisonTopExprs env [LoadFile file, Execute (ApplyExpr (VarExpr "main") (CollectionExpr (map (ElementExpr . StringExpr) args)))]- either print (const $ return ()) result+ case mExpr of+ Just expr -> do+ ret <- runEgisonExpr env expr+ case ret of+ Left err -> putStrLn $ show err+ Right val -> putStrLn $ show val+ Nothing ->+ case nonOpts of+ [] -> do+ when bannerFlag showBanner >> repl noIOFlag env prompt >> when bannerFlag showByebyeMessage+ (file:args) -> do+ case opts of+ Options {optTestOnly = True} -> do+ result <- if noIOFlag+ then do input <- readFile file+ runEgisonTopExprsNoIO env input+ else evalEgisonTopExprsTestOnly env [LoadFile file]+ either print (const $ return ()) result+ Options {optTestOnly = False} -> do+ result <- evalEgisonTopExprs env [LoadFile file, Execute (ApplyExpr (VarExpr "main") (CollectionExpr (map (ElementExpr . StringExpr) args)))]+ either print (const $ return ()) result data Options = Options { optShowVersion :: Bool, optShowHelp :: Bool,+ optEvalString :: Maybe String, optNoIO :: Bool, optShowBanner :: Bool,- optLoadOnly :: Bool,+ optTestOnly :: Bool, optPrompt :: String } @@ -55,9 +63,10 @@ defaultOptions = Options { optShowVersion = False, optShowHelp = False,+ optEvalString = Nothing, optNoIO = False, optShowBanner = True,- optLoadOnly = False,+ optTestOnly = False, optPrompt = "> " } @@ -69,32 +78,38 @@ Option ['h', '?'] ["help"] (NoArg (\opts -> opts {optShowHelp = True})) "show usage information",+ Option ['e'] ["eval"]+ (ReqArg (\expr opts -> opts {optEvalString = Just expr})+ "String")+ "eval the argument string", Option [] ["no-io"] (NoArg (\opts -> opts {optNoIO = True}))- "show usage information",+ "prohibit all io primitives", Option [] ["no-banner"] (NoArg (\opts -> opts {optShowBanner = False}))- "show usage information",- Option ['l'] ["load"]- (NoArg (\opts -> opts {optLoadOnly = True}))- "show usage information",+ "do not display banner",+ Option ['t'] ["test"]+ (NoArg (\opts -> opts {optTestOnly = True}))+ "execute only test expressions", Option ['p'] ["prompt"] (ReqArg (\prompt opts -> opts {optPrompt = prompt}) "String")- "prompt string"+ "set prompt string" ] printHelp :: IO () printHelp = do- putStrLn "Usage: egison [options] file"+ putStrLn "Usage: egison [option]"+ putStrLn " egison [options] file" putStrLn "" putStrLn "Options:"- putStrLn " --help Display this information"- putStrLn " --version Display egison version information"- putStrLn " --no-io No IO primitives"- putStrLn " --no-banner Don't show banner"- putStrLn " --load Don't execute main function"+ putStrLn " --help, -h Display this information"+ putStrLn " --version, -v Display egison version information"+ putStrLn " --eval, -e string Evaluate the argument string"+ putStrLn " --test, -t Execute only test expressions" putStrLn " --prompt string Set prompt of the interpreter"+ putStrLn " --no-banner Don't show banner"+ putStrLn " --no-io Prohibit all IO primitives" putStrLn "" exitWith ExitSuccess @@ -109,8 +124,8 @@ putStrLn $ "http://www.egison.org" putStrLn $ "Welcome to Egison Interpreter!" putStrLn $ "** Information **"- putStrLn $ "We can use a \'Tab\' key to complete keywords on the interpreter."- putStrLn $ "If we type a \'Tab\' key after a closed parenthesis, the next closed parenthesis will be completed."+ putStrLn $ "We can use the tab key to complete keywords on the interpreter."+ putStrLn $ "If we press the tab key after a closed parenthesis, the next closed parenthesis will be completed." putStrLn $ "*****************" showByebyeMessage :: IO ()
hs-src/Language/Egison.hs view
@@ -14,6 +14,7 @@ , evalEgisonExpr , evalEgisonTopExpr , evalEgisonTopExprs+ , evalEgisonTopExprsTestOnly , runEgisonExpr , runEgisonTopExpr , runEgisonTopExprs@@ -51,6 +52,10 @@ -- |eval Egison top expressions evalEgisonTopExprs :: Env -> [EgisonTopExpr] -> IO (Either EgisonError Env) evalEgisonTopExprs env exprs = fromEgisonM $ evalTopExprs env exprs++-- |eval Egison top expressions and execute test expressions+evalEgisonTopExprsTestOnly :: Env -> [EgisonTopExpr] -> IO (Either EgisonError Env)+evalEgisonTopExprsTestOnly env exprs = fromEgisonM $ evalTopExprsTestOnly env exprs -- |eval an Egison expression. Input is a Haskell string. runEgisonExpr :: Env -> String -> IO (Either EgisonError EgisonValue)
hs-src/Language/Egison/Core.hs view
@@ -12,6 +12,7 @@ ( -- * Egison code evaluation evalTopExprs+ , evalTopExprsTestOnly , evalTopExprsNoIO , evalTopExpr , evalExpr@@ -79,7 +80,28 @@ LoadFile file -> do exprs' <- loadFile file collectDefs (exprs' ++ exprs) bindings rest- _ -> collectDefs exprs bindings (expr : rest)+ Execute _ -> collectDefs exprs bindings (expr : rest)+ _ -> collectDefs exprs bindings rest+ collectDefs [] bindings rest = return (bindings, reverse rest)++evalTopExprsTestOnly :: Env -> [EgisonTopExpr] -> EgisonM Env+evalTopExprsTestOnly env exprs = do+ (bindings, rest) <- collectDefs exprs [] []+ env <- recursiveBind env bindings+ forM_ rest $ evalTopExpr env+ return env+ where+ collectDefs (expr:exprs) bindings rest =+ case expr of+ Define name expr -> collectDefs exprs ((name, expr) : bindings) rest+ Load file -> do+ exprs' <- loadLibraryFile file+ collectDefs (exprs' ++ exprs) bindings rest+ LoadFile file -> do+ exprs' <- loadFile file+ collectDefs (exprs' ++ exprs) bindings rest+ Test _ -> collectDefs exprs bindings (expr : rest)+ _ -> collectDefs exprs bindings rest collectDefs [] bindings rest = return (bindings, reverse rest) evalTopExprsNoIO :: Env -> [EgisonTopExpr] -> EgisonM Env
hs-src/Language/Egison/Parser.hs view
@@ -315,7 +315,7 @@ letExpr = keywordLet >> LetExpr <$> bindings <*> expr doExpr :: Parser EgisonExpr-doExpr = keywordDo >> DoExpr <$> statements <*> expr+doExpr = keywordDo >> DoExpr <$> statements <*> option (TupleExpr []) expr statements :: Parser [BindingExpr] statements = braces $ sepEndBy statement whiteSpace
lib/core/collection.egi view
@@ -77,30 +77,6 @@ (lambda [$xs] {@xs @(repeat xs)})) -(define $filter- (lambda [$pred $xs]- (match xs (list something)- {[<nil> {}]- [<cons $x $rs>- (if (pred x)- {x @(filter pred rs)}- (filter pred rs))]})))--(define $separate- (lambda [$pred $ls]- (letrec {[$helper (lambda [$ls $xs $ys]- (match ls (list something)- {[<nil> [xs ys]]- [<cons (& ?pred $l) $rs> (helper rs {l @xs} ys)]- [<cons $l $rs> (helper rs xs {l @ys})]}))]}- (helper ls {} {}))))--(define $concat- (lambda [$xss]- (match xss (list something)- {[<nil> {}]- [<cons $xs $rss> {@xs @(concat rss)}]})))- (define $foldr (lambda [$fn $init $ls] (match ls (list something)@@ -120,6 +96,27 @@ [<cons $x $xs> (let {[$z (fn init x)]} (seq z (foldl' fn z xs)))]})))++(define $filter+ (lambda [$pred $xs]+ (foldr (lambda [$y $ys] (if (pred y) {y @ys} ys))+ {}+ xs)))++(define $separate+ (lambda [$pred $ls]+ (letrec {[$helper (lambda [$ls $xs $ys]+ (match ls (list something)+ {[<nil> [xs ys]]+ [<cons (& ?pred $l) $rs> (helper rs {l @xs} ys)]+ [<cons $l $rs> (helper rs xs {l @ys})]}))]}+ (helper ls {} {}))))++(define $concat+ (lambda [$xss]+ (foldr (lambda [$xs $rs] {@xs @rs})+ {}+ xss))) (define $scanl (lambda [$fn $init $ls]
lib/core/io.egi view
@@ -3,34 +3,51 @@ ;;;;; ;;;+;;; Basic+;;;+(define $nop+ (return []))++;;; ;;; IO ;;; (define $print (lambda [$x] (do {[(write x)] [(write "\n")]- }- [])))+ }))) (define $print-to-port (lambda [$port $x] (do {[(write-to-port port x)] [(write-to-port port "\n")]- }- [])))+ }))) +(define $interact+ (lambda [$fn]+ (letrec {[$interact2+ (lambda [$xs]+ (do {[$eof (eof?)]+ [(if eof+ (write (fn xs))+ (do {[$c (read-char)]+ [(match c char+ {[,'\n' (do {[(write (fn {@xs c}))]+ [(interact2 {})]})]+ [_ (interact2 {@xs c})]})]}))]}))]}+ (interact2 {}))))+ ;;; ;;; Collection ;;; (define $each (lambda [$proc $xs] (match xs (list something)- {[<nil> (do {} [])]+ {[<nil> (do {})] [<cons $x $rs> (do {[(proc x)] [(each proc rs)]- }- [])]})))+ })]}))) ;;; ;;; Others
lib/core/string.egi view
@@ -15,6 +15,12 @@ (helper x)) #f))) +(define $chop+ (lambda [$xs]+ (match xs string+ {[<snoc (| ,'\n' ,' ') $ys> (chop ys)]+ [_ xs]})))+ (define $intersperse (lambda [$in $ws] (foldl (lambda [$s1 $s2] {@s1 in s2}) {(car ws)} (cdr ws))))
sample/io/argv.egi view
@@ -6,13 +6,11 @@ (do {[(write x)] [(write "\n")] [(write-each rs)]- }- [])]})))+ })]}))) (define $main (lambda [$argv] (do {[(write "argv: ")]- [(write argv)]+ [(write (show argv))] [(write "\n")]- [(write-each argv)]}- [])))+ [(write-each argv)]})))
sample/io/cat2.egi view
@@ -1,5 +1,4 @@ (define $main (lambda [$argv] (do {[$content (read-file (car argv))]- [(write content)]}- [])))+ [(write content)]})))
+ sample/io/cat3.egi view
@@ -0,0 +1,3 @@+(define $main+ (lambda [$args]+ (interact id)))
sample/io/dice.egi view
@@ -1,6 +1,5 @@ (define $main (lambda [$argv] (do {[$v (rand 1 6)]- [(write v)]- [(write-char '\n')]}- [])))+ [(write (show v))]+ [(write-char '\n')]})))
− sample/io/interactive.egi
@@ -1,15 +0,0 @@-(define $repl- (lambda []- (do {[(write "input: ")]- [(flush)]- [$input (read-line)]- [(write input)]- [(print "")]- [(repl)]- }- [])))--(define $main- (lambda [$argv]- (do {[(repl)]}- [])))
sample/io/print-primes.egi view
@@ -1,4 +1,4 @@ (define $main (lambda [$argv]- (do {[(each print (map itos primes))]}- [])))+ (each print (map show primes))))+
+ sample/poker-hands-with-joker.egi view
@@ -0,0 +1,120 @@+;;;+;;;+;;; Poker-hands demonstration+;;;+;;;++;;+;; Matcher definitions+;;+(define $suit+ (algebraic-data-matcher+ {<spade> <heart> <club> <diamond>}))++(define $card+ (matcher+ {[<card $ $> [suit (mod 13)]+ {[<Card $x $y> {[x y]}]+ [<Joker> (match-all [{<Spade> <Heart> <Club> <Diamond>} (between 1 13)] [(set suit) (set integer)]+ [[<cons $s _> <cons $n _>] [s n]])]}]+ [<joker> []+ {[<Joker> {[]}]}]+ [$ [something] {[$tgt {tgt}]}]}))++;;+;; A function that determins poker-hands+;;+(define $poker-hands+ (lambda [$cs]+ (match cs (multiset card)+ {[<cons <card $s $n>+ <cons <card ,s ,(- n 1)>+ <cons <card ,s ,(- n 2)>+ <cons <card ,s ,(- n 3)>+ <cons <card ,s ,(- n 4)>+ <nil>>>>>>+ <Straight-Flush>]+ [<cons <card _ $n>+ <cons <card _ ,n>+ <cons <card _ ,n>+ <cons <card _ ,n>+ <cons _+ <nil>>>>>>+ <Four-of-Kind>]+ [<cons <card _ $m>+ <cons <card _ ,m>+ <cons <card _ ,m>+ <cons <card _ $n>+ <cons <card _ ,n>+ <nil>>>>>>+ <Full-House>]+ [<cons <card $s _>+ <cons <card ,s _>+ <cons <card ,s _>+ <cons <card ,s _>+ <cons <card ,s _>+ <nil>>>>>>+ <Flush>]+ [<cons <card _ $n>+ <cons <card _ ,(- n 1)>+ <cons <card _ ,(- n 2)>+ <cons <card _ ,(- n 3)>+ <cons <card _ ,(- n 4)>+ <nil>>>>>>+ <Straight>]+ [<cons <card _ $n>+ <cons <card _ ,n>+ <cons <card _ ,n>+ <cons _+ <cons _+ <nil>>>>>>+ <Three-of-Kind>]+ [<cons <card _ $m>+ <cons <card _ ,m>+ <cons <card _ $n>+ <cons <card _ ,n>+ <cons _+ <nil>>>>>>+ <Two-Pair>]+ [<cons <card _ $n>+ <cons <card _ ,n>+ <cons _+ <cons _+ <cons _+ <nil>>>>>>+ <One-Pair>]+ [<cons _+ <cons _+ <cons _+ <cons _+ <cons _+ <nil>>>>>>+ <Nothing>]})))++;;+;; Demonstration code+;;+(test (poker-hands {<Card <Club> 12>+ <Card <Club> 10>+ <Joker>+ <Card <Club> 1>+ <Card <Club> 11>}))++(test (poker-hands {<Card <Diamond> 1>+ <Card <Club> 2>+ <Joker>+ <Card <Heart> 1>+ <Card <Diamond> 2>}))++(test (poker-hands {<Card <Diamond> 4>+ <Card <Club> 2>+ <Joker>+ <Card <Heart> 1>+ <Card <Diamond> 3>}))++(test (poker-hands {<Card <Diamond> 4>+ <Card <Club> 10>+ <Joker>+ <Card <Heart> 1>+ <Card <Diamond> 3>}))+
sample/sequence.egi view
@@ -13,5 +13,12 @@ ;; Enumerate first 10 twin primes (test (take 10 twin-primes)) -;; Enumerate first 100 twin primes-(test (take 100 twin-primes))+;; Extract all prime-triplets from the infinite list of prime numbers with pattern-matching!+(define $prime-triplets+ (match-all primes (list integer)+ [<join _ <cons $n <cons (& $m (| ,(+ n 2) ,(+ n 4))) <cons ,(+ n 6) _>>>>+ [n m (+ n 6)]]))++;; Enumerate first 10 twin primes+(test (take 10 prime-triplets))+