packages feed

egison 3.3.3 → 3.3.4

raw patch · 12 files changed

+59/−29 lines, 12 files

Files

egison.cabal view
@@ -1,5 +1,5 @@ Name:                egison-Version:             3.3.3+Version:             3.3.4 Synopsis:            Programming language with non-linear pattern-matching with backtracking Description:   An interpreter for Egison, the programming langugage that realized non-linear pattern-matching with backtracking.
hs-src/Interpreter/egison.hs view
@@ -26,14 +26,17 @@             Options {optShowHelp = True} -> printHelp             Options {optShowVersion = True} -> printVersionNumber             Options {optPrompt = prompt, optShowBanner = bannerFlag, optNoIO = noIOFlag} -> do-              env <-if noIOFlag then initialEnvNoIO else initialEnv+              env <- if noIOFlag then initialEnvNoIO else initialEnv               case nonOpts of                 [] -> do-                  when bannerFlag showBanner >> repl env prompt >> when bannerFlag showByebyeMessage+                  when bannerFlag showBanner >> repl noIOFlag env prompt >> when bannerFlag showByebyeMessage                 (file:args) -> do                   case opts of                     Options {optLoadOnly = True} -> do-                      result <- evalEgisonTopExprs env [LoadFile file]+                      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)))]@@ -115,8 +118,8 @@   putStrLn $ "Leaving Egison Interpreter."   exitWith ExitSuccess -repl :: Env -> String -> IO ()-repl env prompt = do+repl :: Bool -> Env -> String -> IO ()+repl noIOFlag env prompt = do   loop env  where   settings :: MonadIO m => FilePath -> Settings m@@ -126,9 +129,15 @@   loop env = (do      home <- getHomeDirectory     input <- liftIO $ runInputT (settings home) $ getEgisonExpr prompt-    case input of-      Nothing -> return ()-      Just (topExpr, _) -> do+    case (noIOFlag, input) of+      (_, Nothing) -> return ()+      (True, Just (_, (LoadFile _))) -> do+        putStrLn "error: No IO support"+        loop env+      (True, Just (_, (Load _))) -> do+        putStrLn "error: No IO support"+        loop env+      (_, Just (topExpr, _)) -> do         result <- liftIO $ runEgisonTopExpr env topExpr         case result of           Left err -> do
hs-src/Language/Egison.hs view
@@ -17,6 +17,7 @@        , runEgisonExpr        , runEgisonTopExpr        , runEgisonTopExprs+       , runEgisonTopExprsNoIO        -- * Load Egison files        , loadEgisonLibrary        , loadEgisonFile@@ -62,6 +63,10 @@ -- |eval Egison top expressions. Input is a Haskell string. runEgisonTopExprs :: Env -> String -> IO (Either EgisonError Env) runEgisonTopExprs env input = fromEgisonM $ readTopExprs input >>= evalTopExprs env++-- |eval Egison top expressions without IO. Input is a Haskell string.+runEgisonTopExprsNoIO :: Env -> String -> IO (Either EgisonError Env)+runEgisonTopExprsNoIO env input = fromEgisonM $ readTopExprs input >>= evalTopExprsNoIO env  -- |load an Egison file loadEgisonFile :: Env -> FilePath -> IO (Either EgisonError Env)
hs-src/Language/Egison/Core.hs view
@@ -12,6 +12,7 @@     (     -- * Egison code evaluation       evalTopExprs+    , evalTopExprsNoIO     , evalTopExpr     , evalExpr     , evalExprDeep@@ -79,6 +80,21 @@       LoadFile file -> do         exprs' <- loadFile file         collectDefs (exprs' ++ exprs) bindings rest+      _ -> collectDefs exprs bindings (expr : rest)+  collectDefs [] bindings rest = return (bindings, reverse rest)++evalTopExprsNoIO :: Env -> [EgisonTopExpr] -> EgisonM Env+evalTopExprsNoIO 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 _ -> throwError $ strMsg "No IO support"+      LoadFile _ -> throwError $ strMsg "No IO support"       _ -> collectDefs exprs bindings (expr : rest)   collectDefs [] bindings rest = return (bindings, reverse rest) 
hs-src/Language/Egison/Parser.hs view
@@ -117,12 +117,12 @@ -- Expressions -- topExpr :: Parser EgisonTopExpr-topExpr = try (parens (defineExpr+topExpr = try (Test <$> expr)+      <|> try (parens (defineExpr                    <|> testExpr                    <|> executeExpr                    <|> loadFileExpr                    <|> loadExpr))-      <|> Test <$> expr       <?> "top-level expression"  defineExpr :: Parser EgisonTopExpr
hs-src/Language/Egison/Primitives.hs view
@@ -500,12 +500,12 @@                , ("read-char", readChar)                , ("read-line", readLine)                , ("write-char", writeChar)-               , ("write-string", writeString)+               , ("write", writeString)                                  , ("read-char-from-port", readCharFromPort)                , ("read-line-from-port", readLineFromPort)                , ("write-char-to-port", writeCharToPort)-               , ("write-string-to-port", writeStringToPort)+               , ("write-to-port", writeStringToPort)                                  , ("eof?", isEOFStdin)                , ("flush", flushStdout)
lib/core/io.egi view
@@ -7,15 +7,15 @@ ;;; (define $print   (lambda [$x]-    (do {[(write-string x)]-         [(write-string "\n")]+    (do {[(write x)]+         [(write "\n")]          }         [])))  (define $print-to-port   (lambda [$port $x]-    (do {[(write-string-to-port port x)]-         [(write-string-to-port port "\n")]+    (do {[(write-to-port port x)]+         [(write-to-port port "\n")]          }         []))) 
lib/core/natural-number.egi view
@@ -96,4 +96,6 @@  (define $prime?   (lambda [$n]-    (eq? (rac (while (lte? $ n) primes)) n)))+    (if (eq? n 1)+      #f+      (eq? (rac (while (lte? $ n) primes)) n))))
sample/io/argv.egi view
@@ -3,16 +3,16 @@     (match xs (list something)       {[<nil> (do {} [])]        [<cons $x $rs>-        (do {[(write-string x)]-             [(write-string "\n")]+        (do {[(write x)]+             [(write "\n")]              [(write-each rs)]              }           [])]})))  (define $main   (lambda [$argv]-    (do {[(write-string "argv: ")]+    (do {[(write "argv: ")]          [(write argv)]-         [(write-string "\n")]+         [(write "\n")]          [(write-each argv)]}       [])))
sample/io/cat.egi view
@@ -5,7 +5,7 @@                         (do {[$eof (eof?)]                              [(unless eof                                 (do {[$line (read-line)]-                                     [(write-string line)]+                                     [(write line)]                                      [(write-char '\n')]                                      [iter]}                                   []))]}@@ -22,7 +22,7 @@                      (do {[$eof (eof-port? port)]                           [(unless eof                              (do {[$line (read-line-from-port port)]-                                  [(write-string line)]+                                  [(write line)]                                   [(write-char '\n')]                                   [iter]}                                []))]}
sample/io/cat2.egi view
@@ -1,5 +1,5 @@ (define $main   (lambda [$argv]     (do {[$content (read-file (car argv))]-         [(write-string content)]}+         [(write content)]}         [])))
sample/io/interactive.egi view
@@ -1,11 +1,9 @@ (define $repl   (lambda []-    (do {[(write-string "input: ")]+    (do {[(write "input: ")]          [(flush)]-         [$input (read)]+         [$input (read-line)]          [(write input)]-         [(print "")]-         [(write (take 3 input))]          [(print "")]          [(repl)]          }