diff --git a/Pugs.cabal b/Pugs.cabal --- a/Pugs.cabal +++ b/Pugs.cabal @@ -1,5 +1,5 @@ Name : Pugs -Version : 6.2.13.7 +Version : 6.2.13.8 license : BSD3 license-file : LICENSE cabal-version : >= 1.2 @@ -7,7 +7,7 @@ maintainer : Audrey Tang category : Language, Pugs stability : experimental -build-type : Simple +build-type : Custom homepage : http://pugscode.org/ synopsis : A Perl 6 Implementation description : A Perl 6 Implementation @@ -115,17 +115,13 @@ src/Pugs/Val/Code.hs src/Pugs/Version.hs -flag EnableReadLine - description: Indicates System.Console.Readline is available - default: True - flag Optimize description: Enable optimizations default: False -flag Debug - description: Enable debugging hooks - default: False +-- flag Debug +-- description: Enable debugging hooks +-- default: False executable pugs main-is: Main.hs @@ -134,7 +130,7 @@ build-depends: base, haskell98, filepath, mtl, stm, parsec < 3.0.0, network, pretty, time, random, process, containers, bytestring, - array, directory, utf8-string, binary, + array, directory, utf8-string, binary, haskeline >= 0.2, MetaObject >= 0.0.4, HsParrot >= 0.0.2, @@ -144,16 +140,17 @@ HsSyck >= 0.44 -- HsPerl5 - if !os(win32) && flag(EnableReadLine) - build-depends: readline - cpp-options: -DPUGS_HAVE_READLINE=1 - if flag(Optimize) ghc-options: -O2 -- if flag(Debug) -- ghc-options: -prof -auto-all + -- cpp-options: -DPUGS_HAVE_PERL5=1 + c-sources: cbits/Prelude_pm.c cbits/Test_pm.c + -- perl5/p5embed.c + -- includes: + -- perl5/p5embed.h diff --git a/src/Pugs.hs b/src/Pugs.hs --- a/src/Pugs.hs +++ b/src/Pugs.hs @@ -123,9 +123,8 @@ return (ch:rest) repLoop :: IO () -repLoop = do - initializeShell - tvEnv <- io . newTVarIO . noEnvDebug =<< tabulaRasa defaultProgramName +repLoop = initializeShell $ do + tvEnv <- io . newTVarIO . noEnvDebug =<< io (tabulaRasa defaultProgramName) fix $ \loop -> do command <- getCommand let parseEnv f prog = do @@ -134,14 +133,16 @@ resetEnv = do env <- fmap noEnvDebug (tabulaRasa defaultProgramName) stm (writeTVar tvEnv env) - case command of - CmdQuit -> putStrLn "Leaving pugs." - CmdLoad fn -> doLoad tvEnv fn >> loop - CmdRun opts prog -> doRunSingle tvEnv opts prog >> loop - CmdParse prog -> parseEnv pretty prog >> loop - CmdParseRaw prog -> parseEnv show prog >> loop - CmdHelp -> printInteractiveHelp >> loop - CmdReset -> resetEnv >> loop + if command == CmdQuit then io $ putStrLn "Leaving pugs." else do + io $ case command of + CmdLoad fn -> doLoad tvEnv fn + CmdRun opts prog -> doRunSingle tvEnv opts prog + CmdParse prog -> parseEnv pretty prog + CmdParseRaw prog -> parseEnv show prog + CmdHelp -> printInteractiveHelp + CmdReset -> resetEnv + _ -> return () + loop mainWith :: ([String] -> IO a) -> IO () mainWith run = do diff --git a/src/Pugs/Shell.hs b/src/Pugs/Shell.hs --- a/src/Pugs/Shell.hs +++ b/src/Pugs/Shell.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fglasgow-exts -cpp #-} +{-# OPTIONS_GHC -fglasgow-exts #-} {-| Interactive shell. @@ -16,43 +16,46 @@ initializeShell, getCommand, readline, + module System.Console.Haskeline ) where import Pugs.Internals import Data.Char (isSpace) - -#ifdef PUGS_HAVE_READLINE -{-# INCLUDE "readline/readline.h" #-} -import qualified System.Console.Readline as Readline -#endif +import System.Console.Haskeline +import System.FilePath +import System.Directory(getHomeDirectory) data Command - = CmdLoad FilePath - | CmdQuit - | CmdParse String - | CmdParseRaw String - | CmdRun { runOpt :: RunOptions, runProg :: String } - | CmdHelp - | CmdReset + = CmdLoad FilePath + | CmdQuit + | CmdParse String + | CmdParseRaw String + | CmdRun { runOpt :: RunOptions, runProg :: String } + | CmdHelp + | CmdReset + deriving Eq data RunOptions = RunOpts { runOptDebug :: Bool , runOptSeparately :: Bool , runOptShowPretty :: Bool} + deriving Eq +type Input = InputT IO + -- | read some input from the user -- parse the input and return the corresponding command -getCommand :: IO Command +getCommand :: Input Command getCommand = do - input <- readline "pugs> " + input <- liftM (fmap encodeUTF8) $ getInputLine "pugs> " doCommand input -doCommand :: Maybe String -> IO Command +doCommand :: Maybe String -> Input Command doCommand Nothing = return CmdQuit doCommand (Just line) | all isSpace line = getCommand | (s, _) <- break (== '#') line , all isSpace s = getCommand | otherwise = do - addHistory line + -- addHistory line return $ parseCommandLine line parseCommandLine :: String -> Command @@ -68,30 +71,17 @@ parseCommandLine (':':'l':str) = CmdLoad $ unwords (words str) parseCommandLine str = CmdRun (RunOpts False False True) str -initializeShell :: IO () -initializeShell = do -#ifdef PUGS_HAVE_READLINE -#ifdef RL_READLINE_VERSION - Readline.setCatchSignals False -#endif - Readline.initialize -#endif - return () +initializeShell :: Input a -> IO a +initializeShell f = (`runInputT` f) =<< pugsSettings readline :: String -> IO (Maybe String) -readline prompt = do -#ifdef PUGS_HAVE_READLINE - Readline.readline prompt -#else - putStr prompt - input <- getLine - return $ Just input -#endif +readline prompt = (`runInputT` liftM (fmap encodeUTF8) (getInputLine prompt)) =<< pugsSettings +pugsSettings :: IO (Settings IO) +pugsSettings = do + home <- getHomeDirectory + return $ defaultSettings { historyFile = Just (home ".pugs_history") } + addHistory :: String -> IO () -#ifdef PUGS_HAVE_READLINE -addHistory str = Readline.addHistory str -#else -addHistory _ = return () -#endif +addHistory str = return () -- Readline.addHistory str diff --git a/src/Pugs/Version.hs b/src/Pugs/Version.hs --- a/src/Pugs/Version.hs +++ b/src/Pugs/Version.hs @@ -14,10 +14,10 @@ -- #include "pugs_version.h" #ifndef PUGS_VERSION -#define PUGS_VERSION "6.2.13.7" +#define PUGS_VERSION "6.2.13.8" #endif #ifndef PUGS_DATE -#define PUGS_DATE "June 30, 2008" +#define PUGS_DATE "July 19, 2008" #endif #ifndef PUGS_SVN_REVISION #define PUGS_SVN_REVISION 0