diff --git a/egison.cabal b/egison.cabal --- a/egison.cabal +++ b/egison.cabal @@ -1,5 +1,5 @@ Name: egison -Version: 3.3.9 +Version: 3.3.10 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. diff --git a/hs-src/Interpreter/egison.hs b/hs-src/Interpreter/egison.hs --- a/hs-src/Interpreter/egison.hs +++ b/hs-src/Interpreter/egison.hs @@ -25,34 +25,43 @@ case opts of Options {optShowHelp = True} -> printHelp Options {optShowVersion = True} -> printVersionNumber - Options {optEvalString = mExpr, optPrompt = prompt, optShowBanner = bannerFlag, optNoIO = noIOFlag} -> do + Options {optEvalString = mExpr, optExecuteString = mCmd, optLoadFiles = loadFiles, optPrompt = prompt, optShowBanner = bannerFlag, optNoIO = noIOFlag} -> do env <- if noIOFlag then initialEnvNoIO else initialEnv - 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 + result <- evalEgisonTopExprs env (map LoadFile loadFiles) + case result of + Left err -> putStrLn $ show err + Right env -> do + 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 mCmd of + Just cmd -> runEgisonTopExpr env ("(execute " ++ cmd ++ ")") >> return () + 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, + optExecuteString :: Maybe String, + optLoadFiles :: [String], optNoIO :: Bool, optShowBanner :: Bool, optTestOnly :: Bool, @@ -64,6 +73,8 @@ optShowVersion = False, optShowHelp = False, optEvalString = Nothing, + optExecuteString = Nothing, + optLoadFiles = [], optNoIO = False, optShowBanner = True, optTestOnly = False, @@ -82,6 +93,14 @@ (ReqArg (\expr opts -> opts {optEvalString = Just expr}) "String") "eval the argument string", + Option ['c'] ["command"] + (ReqArg (\expr opts -> opts {optExecuteString = Just expr}) + "String") + "execute the argument string", + Option ['l'] ["load-file"] + (ReqArg (\d opts -> opts {optLoadFiles = optLoadFiles opts ++ [d]}) + "[String]") + "load files", Option [] ["no-io"] (NoArg (\opts -> opts {optNoIO = True})) "prohibit all io primitives", @@ -103,13 +122,15 @@ putStrLn " egison [options] file" putStrLn "" putStrLn "Options:" - 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 " --help, -h Display this information" + putStrLn " --version, -v Display egison version information" + putStrLn " --eval, -e string Evaluate the argument string" + putStrLn " --command, -c string Execute the argument string" + putStrLn " --load-file, -l string Load the argument file" + putStrLn " --test, -t Run 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 diff --git a/hs-src/Language/Egison/Core.hs b/hs-src/Language/Egison/Core.hs --- a/hs-src/Language/Egison/Core.hs +++ b/hs-src/Language/Egison/Core.hs @@ -246,7 +246,7 @@ genVar = modify (1+) >> gets (('#':) . show) evalExpr env (DoExpr bindings expr) = return $ Value $ IOFunc $ do - let body = foldr genLet (TupleExpr [VarExpr "#1", expr]) bindings + let body = foldr genLet (ApplyExpr expr $ TupleExpr [VarExpr "#1"]) bindings applyFunc (Value $ Func env ["#1"] body) $ Value World where genLet (names, expr) expr' = diff --git a/hs-src/Language/Egison/Parser.hs b/hs-src/Language/Egison/Parser.hs --- a/hs-src/Language/Egison/Parser.hs +++ b/hs-src/Language/Egison/Parser.hs @@ -315,7 +315,7 @@ letExpr = keywordLet >> LetExpr <$> bindings <*> expr doExpr :: Parser EgisonExpr -doExpr = keywordDo >> DoExpr <$> statements <*> option (TupleExpr []) expr +doExpr = keywordDo >> DoExpr <$> statements <*> option (ApplyExpr (VarExpr "return") (TupleExpr [])) expr statements :: Parser [BindingExpr] statements = braces $ sepEndBy statement whiteSpace diff --git a/lib/core/io.egi b/lib/core/io.egi --- a/lib/core/io.egi +++ b/lib/core/io.egi @@ -3,12 +3,6 @@ ;;;;; ;;; -;;; Basic -;;; -(define $nop - (return [])) - -;;; ;;; IO ;;; (define $print @@ -23,20 +17,24 @@ [(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 {})))) +(define $each-line + (lambda [$proc] + (do {[$eof (eof?)]} + (if eof + (return []) + (do {[$line (read-line)] + [(proc line)]} + (each-line proc)))))) +(define $each-line-from-port + (lambda [$port $proc] + (do {[$eof (eof-port? port)]} + (if eof + (return []) + (do {[$line (read-line-from-port port)] + [(proc line)]} + (each-line-from-port port proc)))))) + ;;; ;;; Collection ;;; @@ -45,9 +43,8 @@ (match xs (list something) {[ (do {})] [ - (do {[(proc x)] - [(each proc rs)] - })]}))) + (do {[(proc x)]} + (each proc rs))]}))) ;;; ;;; Others diff --git a/sample/io/argv.egi b/sample/io/argv.egi --- a/sample/io/argv.egi +++ b/sample/io/argv.egi @@ -4,9 +4,8 @@ {[ (do {} [])] [ (do {[(write x)] - [(write "\n")] - [(write-each rs)] - })]}))) + [(write "\n")]} + (write-each rs))]}))) (define $main (lambda [$argv] diff --git a/sample/io/cat.egi b/sample/io/cat.egi --- a/sample/io/cat.egi +++ b/sample/io/cat.egi @@ -1,44 +1,15 @@ (define $main - (lambda [$argv] - (match argv (list string) - {[ (letrec {[$iter - (do {[$eof (eof?)] - [(unless eof - (do {[$line (read-line)] - [(write line)] - [(write-char '\n')] - [iter]} - []))]} - [])]} - iter)] - [_ (cat-files argv)]}))) - -(define $cat-files - (match-lambda (list string) - {[ nop] - [ - (do {[$port (open-input-file file)] - [(letrec {[$iter - (do {[$eof (eof-port? port)] - [(unless eof - (do {[$line (read-line-from-port port)] - [(write line)] - [(write-char '\n')] - [iter]} - []))]} - [])]} - iter)] - [(close-input-port port)] - [(cat-files files)]} - [])]})) - -(define $nop - (return [])) - -(define $when - (lambda [$cond $action] - (if cond action nop))) + (lambda [$args] + (match args (list string) + {[ (each-line print)] + [_ (each-file args)]}))) -(define $unless - (lambda [$cond $action] - (when (not cond) action))) +(define $each-file + (lambda [$files] + (match files (list string) + {[ (return [])] + [ + (do {[$port (open-input-file file)] + [(each-line-from-port port print)] + [(close-input-port port)]} + (each-file rest))]}))) diff --git a/sample/io/cat2.egi b/sample/io/cat2.egi deleted file mode 100644 --- a/sample/io/cat2.egi +++ /dev/null @@ -1,4 +0,0 @@ -(define $main - (lambda [$argv] - (do {[$content (read-file (car argv))] - [(write content)]}))) diff --git a/sample/io/cat3.egi b/sample/io/cat3.egi deleted file mode 100644 --- a/sample/io/cat3.egi +++ /dev/null @@ -1,3 +0,0 @@ -(define $main - (lambda [$args] - (interact id))) diff --git a/sample/tail-recursion.egi b/sample/tail-recursion.egi new file mode 100644 --- /dev/null +++ b/sample/tail-recursion.egi @@ -0,0 +1,10 @@ +(define $f (lambda [$x] + (if (eq? x 0) + (f (+ x 1)) + (f (- x 1))))) + +(define $g (lambda [$x] (h (+ x 1)))) +(define $h (lambda [$x] (g (- x 1)))) + +(f 0) +;(g 0) diff --git a/sample/tail-reursion.egi b/sample/tail-reursion.egi deleted file mode 100644 --- a/sample/tail-reursion.egi +++ /dev/null @@ -1,5 +0,0 @@ -(define $fib-naive - (memoized-lambda [$n] - (if (lte? n 1) - 1 - (+ (fib-naive (- n 1)) (fib-naive (- n 2))))))