egison 3.3.0 → 3.3.1
raw patch · 10 files changed
+276/−180 lines, 10 files
Files
- egison.cabal +6/−7
- hs-src/Interpreter/egison.hs +153/−0
- hs-src/Interpreter/egisoni.hs +0/−152
- hs-src/Language/Egison/Core.hs +1/−1
- hs-src/Language/Egison/Primitives.hs +65/−2
- lib/core/collection.egi +20/−1
- lib/core/string.egi +13/−0
- sample/demo1.egi +9/−0
- sample/one-minute-first.egi +0/−1
- sample/sequence.egi +9/−16
egison.cabal view
@@ -1,14 +1,13 @@ Name: egison-Version: 3.3.0-Synopsis: Programming language with non-linear pattern-matching against unfree data types+Version: 3.3.1+Synopsis: Programming language with non-linear pattern-matching with backtracking Description:- An interpreter for Egison, the programming langugage that realized non-linear pattern-matching against unfree data types.- With Egison, you can represent pattern-matching against unfree data types intuitively,- especially for collection data, such as lists, multisets, sets.+ An interpreter for Egison, the programming langugage that realized non-linear pattern-matching with backtracking.+ With Egison, we can directly represent pattern-matching against lists, multisets, sets, trees, graphs and any kind of data types. We can find Egison programs in @lib@ and @sample@ directories. This package also include Emacs Lisp file @egison-mode.el@ in @elisp@ directory. .- The following code is the program that determins poker-hands written in Egison.+ The following code is the program that determines poker-hands written in Egison. All hands are expressed in a single pattern. We can run this code online at <http://www.egison.org/demonstrations/poker-hands.html>. .@@ -66,7 +65,7 @@ Other-modules: Paths_egison Executable egison- Main-is: egisoni.hs+ Main-is: egison.hs Build-depends: egison, base >= 4.0 && < 5, array, containers, unordered-containers, haskeline, transformers, mtl, parsec >= 3.0, directory, ghc, ghc-paths, filepath, strict-io, bytestring Hs-Source-Dirs: hs-src/Interpreter Other-modules: Paths_egison
+ hs-src/Interpreter/egison.hs view
@@ -0,0 +1,153 @@+module Main where++import Prelude hiding ( catch )+import Control.Exception ( AsyncException(..), catch )+import Control.Monad.Error++import Data.ByteString.Lazy.Char8 ()++import Data.Version++import System.Environment+import System.Directory (getHomeDirectory)+import System.FilePath ((</>))+import System.Console.Haskeline hiding (handle, catch, throwTo)+import System.Console.GetOpt+import System.Exit (ExitCode (..), exitWith, exitFailure)++import Language.Egison+import Language.Egison.Util++main :: IO ()+main = do args <- getArgs+ let (actions, nonOpts, _) = getOpt Permute options args+ let opts = foldl (flip id) defaultOptions actions+ case opts of+ Options {optShowHelp = True} -> printHelp+ Options {optShowVersion = True} -> printVersionNumber+ Options {optPrompt = prompt, optShowBanner = bannerFlag, optNoIO = noIOFlag} -> do+ env <-if noIOFlag then initialEnvNoIO else initialEnv+ case nonOpts of+ [] -> do+ when bannerFlag showBanner >> repl env prompt >> when bannerFlag showByebyeMessage+ (file:args) -> do+ case opts of+ Options {optLoadOnly = True} -> do+ result <- 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++data Options = Options {+ optShowVersion :: Bool,+ optShowHelp :: Bool,+ optNoIO :: Bool,+ optShowBanner :: Bool,+ optLoadOnly :: Bool,+ optPrompt :: String+ }++defaultOptions :: Options+defaultOptions = Options {+ optShowVersion = False,+ optShowHelp = False,+ optNoIO = False,+ optShowBanner = True,+ optLoadOnly = False,+ optPrompt = "> "+ }++options :: [OptDescr (Options -> Options)]+options = [+ Option ['v', 'V'] ["version"]+ (NoArg (\opts -> opts {optShowVersion = True}))+ "show version number",+ Option ['h', '?'] ["help"]+ (NoArg (\opts -> opts {optShowHelp = True}))+ "show usage information",+ Option [] ["no-io"]+ (NoArg (\opts -> opts {optNoIO = True}))+ "show usage information",+ Option [] ["no-banner"]+ (NoArg (\opts -> opts {optShowBanner = False}))+ "show usage information",+ Option ['l'] ["load"]+ (NoArg (\opts -> opts {optLoadOnly = True}))+ "show usage information",+ Option ['p'] ["prompt"]+ (ReqArg (\prompt opts -> opts {optPrompt = prompt})+ "String")+ "prompt string"+ ]++printHelp :: IO ()+printHelp = do+ putStrLn "Usage: 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 " --prompt string Set prompt of the interpreter"+ putStrLn ""+ exitWith ExitSuccess++printVersionNumber :: IO ()+printVersionNumber = do+ putStrLn $ showVersion version + exitWith ExitSuccess++showBanner :: IO ()+showBanner = do+ putStrLn $ "Egison Version " ++ showVersion version ++ " (C) 2011-2014 Satoshi Egi"+ 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 $ "*****************"++showByebyeMessage :: IO ()+showByebyeMessage = do+ putStrLn $ "Leaving Egison Interpreter."+ exitWith ExitSuccess++repl :: Env -> String -> IO ()+repl env prompt = do+ loop env+ where+ settings :: MonadIO m => FilePath -> Settings m+ settings home = setComplete completeEgison $ defaultSettings { historyFile = Just (home </> ".egison_history") }+ + loop :: Env -> IO ()+ loop env = (do + home <- getHomeDirectory+ input <- liftIO $ runInputT (settings home) $ getEgisonExpr prompt+ case input of+ Nothing -> return ()+ Just (Left (topExpr, _)) -> do+ result <- liftIO $ runEgisonTopExpr env topExpr+ case result of+ Left err -> do+ liftIO $ putStrLn $ show err+ loop env+ Right env' -> loop env'+ Just (Right (expr, _)) -> do+ result <- liftIO $ runEgisonExpr env expr+ case result of+ Left err -> do+ liftIO $ putStrLn $ show err+ loop env+ Right val -> do+ liftIO $ putStrLn $ show val+ loop env)+ `catch`+ (\e -> case e of+ UserInterrupt -> putStrLn "" >> loop env+ StackOverflow -> putStrLn "Stack over flow!" >> loop env+ HeapOverflow -> putStrLn "Heap over flow!" >> loop env+ _ -> putStrLn "error!" >> loop env+ )
− hs-src/Interpreter/egisoni.hs
@@ -1,152 +0,0 @@-module Main where--import Prelude hiding ( catch )-import Control.Exception ( AsyncException(..), catch )-import Control.Monad.Error--import Data.ByteString.Lazy.Char8 ()--import Data.Version--import System.Environment-import System.Directory (getHomeDirectory)-import System.FilePath ((</>))-import System.Console.Haskeline hiding (handle, catch, throwTo)-import System.Console.GetOpt-import System.Exit (ExitCode (..), exitWith, exitFailure)--import Language.Egison-import Language.Egison.Util--main :: IO ()-main = do args <- getArgs- let (actions, nonOpts, _) = getOpt Permute options args- let opts = foldl (flip id) defaultOptions actions- case opts of- Options {optShowHelp = True} -> printHelp- Options {optShowVersion = True} -> printVersionNumber- Options {optPrompt = prompt, optShowBanner = bannerFlag, optNoIO = noIOFlag} -> do- env <-if noIOFlag then initialEnvNoIO else initialEnv- case nonOpts of- [] -> do- when bannerFlag showBanner >> repl env prompt >> when bannerFlag showByebyeMessage- (file:args) -> do- case opts of- Options {optLoadOnly = True} -> do- result <- 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--data Options = Options {- optShowVersion :: Bool,- optShowHelp :: Bool,- optNoIO :: Bool,- optShowBanner :: Bool,- optLoadOnly :: Bool,- optPrompt :: String- }--defaultOptions :: Options-defaultOptions = Options {- optShowVersion = False,- optShowHelp = False,- optNoIO = False,- optShowBanner = True,- optLoadOnly = False,- optPrompt = "> "- }--options :: [OptDescr (Options -> Options)]-options = [- Option ['v', 'V'] ["version"]- (NoArg (\opts -> opts {optShowVersion = True}))- "show version number",- Option ['h', '?'] ["help"]- (NoArg (\opts -> opts {optShowHelp = True}))- "show usage information",- Option [] ["no-io"]- (NoArg (\opts -> opts {optNoIO = True}))- "show usage information",- Option [] ["no-banner"]- (NoArg (\opts -> opts {optShowBanner = False}))- "show usage information",- Option ['l'] ["load"]- (NoArg (\opts -> opts {optLoadOnly = True}))- "show usage information",- Option ['p'] ["prompt"]- (ReqArg (\prompt opts -> opts {optPrompt = prompt})- "String")- "prompt string"- ]--printHelp :: IO ()-printHelp = do- putStrLn "Usage: 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 " --prompt string Set prompt of the interpreter"- putStrLn ""- exitWith ExitSuccess--printVersionNumber :: IO ()-printVersionNumber = do- putStrLn $ showVersion version - exitWith ExitSuccess--showBanner :: IO ()-showBanner = do- putStrLn $ "Egison Version " ++ showVersion version ++ " (C) 2011-2014 Satoshi Egi"- putStrLn $ "http://www.egison.org"- putStrLn $ "Welcome to Egison Interpreter!"- putStrLn $ "** Info **"- 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."--showByebyeMessage :: IO ()-showByebyeMessage = do- putStrLn $ "Leaving Egison Interpreter."- exitWith ExitSuccess--repl :: Env -> String -> IO ()-repl env prompt = do- loop env- where- settings :: MonadIO m => FilePath -> Settings m- settings home = setComplete completeEgison $ defaultSettings { historyFile = Just (home </> ".egison_history") }- - loop :: Env -> IO ()- loop env = (do - home <- getHomeDirectory- input <- liftIO $ runInputT (settings home) $ getEgisonExpr prompt- case input of- Nothing -> return ()- Just (Left (topExpr, _)) -> do- result <- liftIO $ runEgisonTopExpr env topExpr- case result of- Left err -> do- liftIO $ putStrLn $ show err- loop env- Right env' -> loop env'- Just (Right (expr, _)) -> do- result <- liftIO $ runEgisonExpr env expr- case result of- Left err -> do- liftIO $ putStrLn $ show err- loop env- Right val -> do- liftIO $ putStrLn $ show val- loop env)- `catch`- (\e -> case e of- UserInterrupt -> putStrLn "" >> loop env- StackOverflow -> putStrLn "Stack over flow!" >> loop env- HeapOverflow -> putStrLn "Heap over flow!" >> loop env- _ -> putStrLn "error!" >> loop env- )
hs-src/Language/Egison/Core.hs view
@@ -775,7 +775,7 @@ fromTuple :: WHNFData -> EgisonM [ObjectRef] fromTuple (Intermediate (ITuple refs)) = return refs fromTuple (Value (Tuple vals)) = mapM (newEvalutedObjectRef . Value) vals-fromTuple val = return <$> newEvalutedObjectRef val+fromTuple whnf = return <$> newEvalutedObjectRef whnf fromTupleValue :: EgisonValue -> [EgisonValue] fromTupleValue (Tuple vals) = vals
hs-src/Language/Egison/Primitives.hs view
@@ -149,7 +149,15 @@ , ("empty?", isEmpty') , ("uncons", uncons') , ("unsnoc", unsnoc')- ++ , ("bool?", isBool)+ , ("integer?", isInteger)+ , ("rational?", isRational)+ , ("float?", isFloat)+ , ("char?", isChar)+ , ("tuple?", isTuple)+ , ("collection?", isCollection)+ , ("assert", assert) , ("assert-equal", assertEqual) ]@@ -386,13 +394,68 @@ Just (carObjRef, cdrObjRef) -> return $ Intermediate $ ITuple [carObjRef, cdrObjRef] Nothing -> throwError $ Default $ "cannot uncons collection" - unsnoc' :: PrimitiveFunc unsnoc' whnf = do mRet <- runMaybeT (unsnocCollection whnf) case mRet of Just (racObjRef, rdcObjRef) -> return $ Intermediate $ ITuple [racObjRef, rdcObjRef] Nothing -> throwError $ Default $ "cannot unsnoc collection"++-- Typing++isBool :: PrimitiveFunc+isBool (Value (Bool _)) = return $ Value $ Bool True+isBool _ = return $ Value $ Bool False++isInteger :: PrimitiveFunc+isInteger (Value (Integer _)) = return $ Value $ Bool True+isInteger _ = return $ Value $ Bool False++isRational :: PrimitiveFunc+isRational (Value (Rational _)) = return $ Value $ Bool True+isRational _ = return $ Value $ Bool False++isFloat :: PrimitiveFunc+isFloat (Value (Float _)) = return $ Value $ Bool True+isFloat _ = return $ Value $ Bool False++isChar :: PrimitiveFunc+isChar (Value (Char _)) = return $ Value $ Bool True+isChar _ = return $ Value $ Bool False++isTuple :: PrimitiveFunc+isTuple args = do+ args' <- fromTuple args+ case args' of+ ((Value (Integer n)):whnf:[]) -> isTuple' n whnf+ (whnf:_) -> throwError $ TypeMismatch "number" whnf+ where+ fromTuple :: WHNFData -> EgisonM [WHNFData]+ fromTuple (Intermediate (ITuple refs)) = do+ objs <- liftIO $ mapM readIORef refs+ mapM (\obj -> case obj of+ Thunk thunk -> thunk+ WHNF whnf -> return whnf) objs+ fromTuple (Value (Tuple vals)) = return $ map Value vals+ fromTuple whnf = return [whnf]+ isTuple' :: Integer -> WHNFData -> EgisonM WHNFData+ isTuple' n (Value (Tuple vals)) =+ if n == ((fromIntegral (length vals)) :: Integer)+ then return $ Value $ Bool True+ else return $ Value $ Bool False+ isTuple' n (Intermediate (ITuple refs)) =+ if n == ((fromIntegral (length refs)) :: Integer)+ then return $ Value $ Bool True+ else return $ Value $ Bool False+ isTuple' 1 _ = return $ Value $ Bool True+ isTuple' _ _ = return $ Value $ Bool False++isCollection :: PrimitiveFunc+isCollection (Value (Collection _)) = return $ Value $ Bool True+isCollection (Intermediate (ICollection _)) = return $ Value $ Bool True+isCollection _ = return $ Value $ Bool False++-- Test assert :: PrimitiveFunc assert = twoArgs $ \label test -> do
lib/core/collection.egi view
@@ -292,7 +292,16 @@ {[$tgt (match-all tgt (list a) [<join $hs <cons $x $ts>> [x {@hs @ts}]])]}] [<join ,$pxs $> [(multiset a)]- {[$tgt {(difference/m a tgt pxs)}]}]+ {[$tgt (match [pxs tgt] [(list a) (multiset a)]+ {[[(loop $i [1 $n] <cons $x_i ...> <nil>)+ (loop $i [1 n] <cons ,x_i ...> $rs)]+ {rs}]+ [_ {}]})]}]+ [<join $ $> [(multiset a) (multiset a)]+ {[$tgt (match-all tgt (list a)+ [(loop $i [1 $n] <join $rs_i <cons $x_i ...>> $ts)+ [(map (lambda [$i] x_i) (between 1 n))+ (concat {@(map (lambda [$i] rs_i) (between 1 n)) ts})]])]}] [$ [something] {[$tgt {tgt}]}] })))@@ -392,6 +401,16 @@ [<cons $ $> [a (set a)] {[$tgt (match-all tgt (list a) [<join _ <cons $x _>> [x tgt]])]}]+ [<join ,$pxs $> [(set a)]+ {[$tgt (match [pxs tgt] [(list a) (set a)]+ {[[(loop $i [1 $n] <cons $x_i ...> <nil>)+ (loop $i [1 n] <cons ,x_i ...> _)]+ {tgt}]+ [_ {}]})]}]+ [<join $ $> [(set a) (set a)]+ {[$tgt (match-all tgt (multiset a)+ [(loop $i [1 $n] <cons $x_i ...> _)+ [(map (lambda [$i] x_i) (between 1 n)) tgt]])]}] [$ [something] {[$tgt {tgt}]}] })))
lib/core/string.egi view
@@ -2,6 +2,19 @@ ;;; String.egi ;;; +(define $string?+ (lambda [$x]+ (if (collection? x)+ (letrec {[$helper (lambda [$cs]+ (match cs (list something)+ {[<nil> #t]+ [<cons $c $rs>+ (if (char? c)+ (helper rs)+ #f)]}))]}+ (helper x))+ #f)))+ (define $intersperse (lambda [$in $ws] (foldl (lambda [$s1 $s2] {@s1 in s2}) {(car ws)} (cdr ws))))
+ sample/demo1.egi view
@@ -0,0 +1,9 @@+;; Extract all twin primes with non-linear pattern-matching against the infinite list of prime numbers+(define $twin-primes+ (match-all primes (list integer)+ [<join _ <cons $p <cons ,(+ p 2) _>>>+ [p (+ p 2)]]))++;; Enumerate first 10 twin primes+(test (take 10 twin-primes))+;=>{[3 5] [5 7] [11 13] [17 19] [29 31] [41 43] [59 61] [71 73] [101 103] [107 109]}
sample/one-minute-first.egi view
@@ -6,4 +6,3 @@ ; enumerate the elements of the collection if all of the three consecutive numbers from it are contained in the collection. (test (match-all {1 2 13 14 3 15 2 6} (multiset integer) [<cons $x <cons ,(+ x 1) <cons ,(+ x 2) _>>> x]))-
sample/sequence.egi view
@@ -4,21 +4,14 @@ ;;; ;;; -; first 100 natural numbers-(test (take 100 nats))--; inifinite list of two-combinations of numbers-(define $pairs (match-all nats (list integer)- [<join _ (& <cons $m _> <join _ <cons $n _>>)>- [m n]]))--; test 'pairs'-(test (take 100 pairs))--; first 100 prime numbers-(test (take 100 primes))--; enumerate first 100 twin primes-(test (take 100 (match-all primes (list integer) [<join _ <cons $p <cons ,(+ p 2) _>>> [p (+ p 2)]])))+;; Extract all twin primes with non-linear pattern-matching against the infinite list of prime numbers+(define $twin-primes+ (match-all primes (list integer)+ [<join _ <cons $p <cons ,(+ p 2) _>>>+ [p (+ p 2)]])) +;; Enumerate first 10 twin primes+(test (take 10 twin-primes)) +;; Enumerate first 100 twin primes+(test (take 100 twin-primes))