diff --git a/egison.cabal b/egison.cabal --- a/egison.cabal +++ b/egison.cabal @@ -1,5 +1,5 @@ Name: egison -Version: 2.3.8 +Version: 2.3.9 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. @@ -18,12 +18,13 @@ Data-files: lib/core/base.egi lib/core/number.egi lib/core/collection.egi lib/core/array.egi lib/graph.egi lib/poker-hands.egi sample/number-test.egi sample/collection-test.egi sample/array-test.egi sample/graph-test.egi - sample/poker-hands-test.egi sample/compile-test.egi + sample/poker-hands-test.egi sample/io/argv-test.egi sample/io/cat.egi sample/io/copy.egi sample/io/char-test.egi sample/io/hello.egi sample/io/read-write-test.egi sample/n-queen.egi sample/icfpc2012/mine.egi sample/icfpc2012/maps/*.map elisp/egison-mode.el etc/template.hs + etc/template-for-test.hs Library Build-Depends: base >= 4.0 && < 5, array, containers, haskeline, transformers, mtl, parsec >= 3.0, directory, ghc, ghc-paths diff --git a/elisp/egison-mode.el b/elisp/egison-mode.el --- a/elisp/egison-mode.el +++ b/elisp/egison-mode.el @@ -87,7 +87,8 @@ (ip (keyword-indent-point op))) (if ip (+ ip cp) - (+ 2 (length op) cp)))) + (progn (forward-sexp) + (+ 1 (current-column)))))) ((eq (string-to-char (thing-at-point 'char)) 60) (forward-char) (let ((op (current-word))) @@ -132,6 +133,7 @@ (modify-syntax-entry 62 ")" egison-mode-syntax-table) (modify-syntax-entry 59 "<" egison-mode-syntax-table) (modify-syntax-entry 10 ">" egison-mode-syntax-table) + (modify-syntax-entry 63 "w" egison-mode-syntax-table) egison-mode-syntax-table) ;; (copy-syntax-table lisp-mode-syntax-table) "Syntax table for Egison mode") diff --git a/etc/template-for-test.hs b/etc/template-for-test.hs new file mode 100644 --- /dev/null +++ b/etc/template-for-test.hs @@ -0,0 +1,17 @@ +module Main where +import Language.Egison.Core +import Language.Egison.Types +import Control.Monad.Error + +evalTopExprs :: Env -> [TopExpr] -> IO () +evalTopExprs _ [] = return () +evalTopExprs env (topExpr:rest) = do + str <- runIOThrowsREPL $ evalTopExpr env topExpr + putStrLn str + evalTopExprs env rest + +main :: IO () +main = do + env <- primitiveBindings + evalTopExprs env topExprs + diff --git a/etc/template.hs b/etc/template.hs --- a/etc/template.hs +++ b/etc/template.hs @@ -1,13 +1,8 @@ module Main where -import Language.Egison.Core -- Egison Interpreter -import Language.Egison.Types -- Egison data types ---import Language.Egison.Variables -- Egison variable operations ---import Language.Egison.Parser -- Egison variable operations ---import Control.Monad (when) +import Language.Egison.Core +import Language.Egison.Types import Control.Monad.Error ---import System.IO import System.Environment - main :: IO () main = do diff --git a/hs-src/Compiler/egisonc.hs b/hs-src/Compiler/egisonc.hs --- a/hs-src/Compiler/egisonc.hs +++ b/hs-src/Compiler/egisonc.hs @@ -15,6 +15,9 @@ templateFile :: String templateFile = "etc/template.hs" +templateFileForTest :: String +templateFileForTest = "etc/template-for-test.hs" + main :: IO () main = do args <- getArgs @@ -23,7 +26,7 @@ case opts of Options {optShowHelp = True} -> printHelp Options {optShowVersion = True} -> printVersionNumber - Options {optOutput = output, optProf = prof} -> + Options {optOutput = output} -> if null nonOpts then showUsage else do @@ -31,13 +34,14 @@ outExec = case output of Just outFile -> outFile Nothing -> dropExtension inFile - process prof inFile outExec + process opts inFile outExec data Options = Options { optShowVersion :: Bool, optShowHelp :: Bool, optOutput :: Maybe String, - optProf :: Bool + optProf :: Bool, + optTest :: Bool } showUsage :: IO () @@ -49,7 +53,8 @@ optShowVersion = False, optShowHelp = False, optOutput = Nothing, - optProf = False + optProf = False, + optTest = False } options :: [OptDescr (Options -> Options)] @@ -66,7 +71,10 @@ "output file to write", Option ['p'] ["prof"] (NoArg (\opts -> opts {optProf = True})) - "use profiling system" + "use profiling system", + Option ['t'] ["test"] + (NoArg (\opts -> opts {optTest = True})) + "execute test expressions" ] printVersionNumber :: IO () @@ -83,15 +91,16 @@ putStrLn " --version Display egison version information" putStrLn " --output filename Write executable to the given filename" putStrLn " --prof Make use of GHC profiling system" + putStrLn " --test Execute test expressions" putStrLn "" exitWith ExitSuccess -process :: Bool -> String -> String -> IO () -process prof inFile outExec = do - result <- (runIOThrows $ liftM show $ createHaskellFile inFile) +process :: Options -> String -> String -> IO () +process opts inFile outExec = do + result <- (runIOThrows $ liftM show $ createHaskellFile opts inFile) case result of Just errMsg -> putStrLn errMsg - _ -> compileHaskellFile prof outExec + _ -> compileHaskellFile opts outExec appendLoadExprForCoreLibraries :: [TopExpr] -> [TopExpr] appendLoadExprForCoreLibraries topExprs = [(Load "lib/core/base.egi"), @@ -100,49 +109,69 @@ (Load "lib/core/array.egi") ] ++ topExprs -createHaskellFile :: String -> IOThrowsError () -createHaskellFile inFile = do - templatePath <- liftIO $ getDataFileName templateFile - liftIO $ copyFile templatePath "./_tmp.hs" - egisonProgram <- liftIO $ readFile inFile - topExprs <- liftThrows $ readTopExprList egisonProgram - topExprs2 <- expandLoadExprs $ appendLoadExprForCoreLibraries topExprs - liftIO $ appendFile "./_tmp.hs" "\ntopExprs :: [TopExpr]\n" - liftIO $ appendFile "./_tmp.hs" "topExprs = " - liftIO $ appendFile "./_tmp.hs" $ show topExprs2 - return () +createHaskellFile :: Options -> String -> IOThrowsError () +createHaskellFile opts inFile = + case opts of + Options {optTest = True} -> do + templatePath <- liftIO $ getDataFileName templateFileForTest + liftIO $ copyFile templatePath "./_tmp.hs" + egisonProgram <- liftIO $ readFile inFile + topExprs <- liftThrows $ readTopExprList egisonProgram + topExprs2 <- expandLoadExprs opts $ appendLoadExprForCoreLibraries topExprs + liftIO $ appendFile "./_tmp.hs" "\ntopExprs :: [TopExpr]\n" + liftIO $ appendFile "./_tmp.hs" "topExprs = " + liftIO $ appendFile "./_tmp.hs" $ show topExprs2 + return () + _ -> do + templatePath <- liftIO $ getDataFileName templateFile + liftIO $ copyFile templatePath "./_tmp.hs" + egisonProgram <- liftIO $ readFile inFile + topExprs <- liftThrows $ readTopExprList egisonProgram + topExprs2 <- expandLoadExprs opts $ appendLoadExprForCoreLibraries topExprs + liftIO $ appendFile "./_tmp.hs" "\ntopExprs :: [TopExpr]\n" + liftIO $ appendFile "./_tmp.hs" "topExprs = " + liftIO $ appendFile "./_tmp.hs" $ show topExprs2 + return () -expandLoadExprs :: [TopExpr] -> IOThrowsError [TopExpr] -expandLoadExprs [] = return [] -expandLoadExprs ((LoadFile filename):topExprs) = do +expandLoadExprs :: Options -> [TopExpr] -> IOThrowsError [TopExpr] +expandLoadExprs _ [] = return [] +expandLoadExprs opts ((LoadFile filename):topExprs) = do result <- liftIO $ doesFileExist filename if result then do loadProgram <- liftIO $ readFile filename loadTopExprs <- liftThrows $ readTopExprList loadProgram - rets <- expandLoadExprs topExprs + rets <- expandLoadExprs opts topExprs return $ loadTopExprs ++ rets else throwError $ Default $ "File does not exist: " ++ filename -expandLoadExprs ((Load libname):topExprs) = do +expandLoadExprs opts ((Load libname):topExprs) = do filename <- liftIO (getDataFileName libname) result <- liftIO $ doesFileExist filename if result then do loadProgram <- liftIO $ readFile filename loadTopExprs <- liftThrows $ readTopExprList loadProgram - rets <- expandLoadExprs topExprs + rets <- expandLoadExprs opts topExprs return $ loadTopExprs ++ rets else throwError $ Default $ "Library does not exist: " ++ libname -expandLoadExprs (topExpr:topExprs) = do - rets <- expandLoadExprs topExprs +expandLoadExprs opts (topExpr@(Test _):topExprs) = + case opts of + Options {optTest = True} -> do + rets <- expandLoadExprs opts topExprs + return $ topExpr:rets + _ -> expandLoadExprs opts topExprs +expandLoadExprs opts (topExpr:topExprs) = do + rets <- expandLoadExprs opts topExprs return $ topExpr:rets -compileHaskellFile :: Bool -> String -> IO () -compileHaskellFile prof filename = do +compileHaskellFile :: Options -> String -> IO () +compileHaskellFile opts filename = do let ghc = "ghc" - if prof - then system $ ghc ++ " -prof -auto-all -o " ++ filename ++ " _tmp.hs" - else system $ ghc ++ " -O2 -o " ++ filename ++ " _tmp.hs" + case opts of + Options {optProf = True} -> + system $ ghc ++ " -prof -auto-all -o " ++ filename ++ " _tmp.hs" + _ -> + system $ ghc ++ " -O2 -o " ++ filename ++ " _tmp.hs" removeFile "./_tmp.hs" removeFile "./_tmp.hi" removeFile "./_tmp.o" diff --git a/hs-src/Interpreter/egisoni.hs b/hs-src/Interpreter/egisoni.hs --- a/hs-src/Interpreter/egisoni.hs +++ b/hs-src/Interpreter/egisoni.hs @@ -1,10 +1,8 @@ module Main where -import Paths_egison import Language.Egison.Core -- Egison Interpreter import Language.Egison.Parser import Language.Egison.Types -- Egison data types import Language.Egison.Variables -- Egison variable operations ---import Control.Monad (when) import Control.Monad.Error import System.IO import System.Environment @@ -70,19 +68,3 @@ loop env "> " "" else loop env "> " "" ---countParens :: String -> Bool ---countParens str = let countOpen = length $ filter ((==) '(') str in --- let countClose = length $ filter ((==) ')') str in --- (countOpen > 0) && (countOpen <= countClose) - --- End REPL Section - --- Begin Util section, of generic functions - -{- Remove leading/trailing white space from a string; based on corresponding Python function - Code taken from: http://gimbo.org.uk/blog/2007/04/20/splitting-a-string-in-haskell/ -} -strip :: String -> String -strip s = dropWhile ws $ reverse $ dropWhile ws $ reverse s - where ws = (`elem` [' ', '\n', '\t', '\r']) - --- End Util diff --git a/lib/core/number.egi b/lib/core/number.egi --- a/lib/core/number.egi +++ b/lib/core/number.egi @@ -104,10 +104,13 @@ (define $fib (lambda [$n] - (match n Nat - {[ 1] - [> 1] - [> (+ (fib (+ n1 1)) (fib n1))]}))) + (letrec {[$fib1 (lambda [$n $ret1 $ret2] + (match n Nat + {[ ret2] + [> ret1] + [ (fib1 (- n 1) (+ ret1 ret2) ret1)] + }))]} + (fib1 n 1 1)))) (define $fact diff --git a/sample/collection-test.egi b/sample/collection-test.egi --- a/sample/collection-test.egi +++ b/sample/collection-test.egi @@ -101,12 +101,9 @@ ] [_ ]})) - - (test (match-all {1 2 3 4} (List Integer) [> ns])) - ;; pattern macro (define $pair (macro [$s $pat] @@ -144,4 +141,4 @@ (test (isStraight? {1 2})) ;; comparison of large list -(test (match-all (between 1 2000) (List Integer) [> x])) +(test (match (between 1 10000) (List Integer) {[,(between 1 10000) ] [_ ]})) diff --git a/sample/compile-test.egi b/sample/compile-test.egi deleted file mode 100644 --- a/sample/compile-test.egi +++ /dev/null @@ -1,6 +0,0 @@ -(define $main - (lambda [$: $argv] - (do {[$: (write-string : "output : ")] - [$: (write : argv)] - [$: (write-char : '\n')]} - :))) diff --git a/sample/n-queen.egi b/sample/n-queen.egi --- a/sample/n-queen.egi +++ b/sample/n-queen.egi @@ -4,8 +4,7 @@ [ diff --git a/sample/number-test.egi b/sample/number-test.egi --- a/sample/number-test.egi +++ b/sample/number-test.egi @@ -1,5 +1,24 @@ -(test (fib 10)) +(test (if ((= (List Integer)) (between 3 5) + {3 4 5}) + + )) -(test (fact 10)) +(test (if (eq? (min&max {10 20 4 40 23}) + [4 40]) + + )) -(test (gcd {10 20 40 35})) +(test (if (eq-n? (fib 10) + 89) + + )) + +(test (if (eq-n? (fact 10) + 3628800) + + )) + +(test (if (eq-n? (gcd {10 20 40 35}) + 5) + + ))