6d01828 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

put ideslave_counter into IState

commit6d01828d3bd0bfe592a57c8f7b4c5e2675eb36d6 authorHannes Mehnert <hannes@mehnert.org> dateSat 4 May 2013, 13:06 (13 years ago) parent4343d42

3 files changed+46−35

compare with master

unifiedsplit

src/Idris/AbsSyntaxTree.hs+3−2 src/Idris/IdeSlave.hs+22−12 src/Idris/REPL.hs+21−21

src/Idris/AbsSyntaxTree.hs+3−2

@@ -93,7 +93,8 @@ data IState = IState {

9393 ibc_write :: [IBCWrite],

9494 compiled_so :: Maybe String,

9595 idris_dynamic_libs :: [DynamicLib],

96− idris_language_extensions :: [LanguageExt]

96+ idris_language_extensions :: [LanguageExt],

97+ ideslave_counter :: Integer

9798 }

9899

99100data SizeChange = Smaller | Same | Bigger | Unknown

@@ -145,7 +146,7 @@ idrisInit = IState initContext [] [] emptyContext emptyContext emptyContext

145146 emptyContext emptyContext emptyContext emptyContext

146147 emptyContext emptyContext emptyContext emptyContext

147148 [] "" defaultOpts 6 [] [] [] [] [] [] [] [] []

148− [] Nothing Nothing [] [] [] Hidden False [] Nothing [] []

149+ [] Nothing Nothing [] [] [] Hidden False [] Nothing [] [] 0

149150

150151-- | The monad for the main REPL - reading and processing files and updating

151152-- global state (hence the IO inner monad).

src/Idris/IdeSlave.hs+22−12

@@ -2,6 +2,11 @@

33module Idris.IdeSlave(receiveMessage, sendMessage, IdeSlaveCommand(..), sexpToCommand, SExp(..)) where

5+import Idris.AbsSyntaxTree

6+import Idris.AbsSyntax

8+import Control.Monad.Trans ( liftIO, lift )

510import Text.Printf

611import Numeric

712import Data.List

@@ -92,10 +97,14 @@ sexpToCommand (List [SymbolAtom "repl-completions", StringAtom prefix]) = Just (

9297sexpToCommand (List [SymbolAtom "load-file", StringAtom filename]) = Just (LoadFile filename)

9398sexpToCommand _ = Nothing

9499

95−receiveMessage :: IO (SExp)

96−receiveMessage

97− = do x <- getLine

98− return (receiveString x)

100+receiveMessage :: Idris (SExp)

101+receiveMessage = do x <- liftIO $ getLine

102+ case receiveString x of

103+ (List [cmd, (IntegerAtom id)]) ->

104+ do i <- getIState

105+ putIState $ (i { ideslave_counter = id } )

106+ return cmd

107+

99108

100109receiveString :: String -> SExp

101110receiveString x =

@@ -109,14 +118,15 @@ receiveString x =

109118 Right r -> r)

110119 _ -> error "readHex failed"

111120

112−sendMessage :: SExpable a => Integer -> Either a a -> IO ()

113−sendMessage id s =

114− -- TODO: get real output here!!!

115− case s of

116− Left err -> putStrLn $ conv (List [SymbolAtom "error", toSExp err])

117− Right succ -> putStrLn $ conv (List [SymbolAtom "ok", toSExp succ])

118− where conv sexp =

119− let str = sExpToString (List [SymbolAtom "return", sexp, IntegerAtom id]) in (getHexLength str) ++ str

121+sendMessage :: SExpable a => Either a a -> Idris ()

122+sendMessage s =

123+ do i <- getIState

124+ let msg = case s of

125+ Left err -> List [SymbolAtom "error", toSExp err]

126+ Right succ -> List [SymbolAtom "ok", toSExp succ]

127+ liftIO $ putStrLn (conv (ideslave_counter i) msg)

128+ where conv id sexp =

129+ let str = sExpToString (List [SymbolAtom "return", sexp, IntegerAtom id]) in (getHexLength str) ++ str

120130

121131getHexLength :: String -> String

122132getHexLength s = printf "%06x" (1 + (length s))

src/Idris/REPL.hs+21−21

@@ -85,27 +85,27 @@ repl orig mods

8585ideslave :: IState -> [FilePath] -> Idris ()

8686ideslave orig mods

8787 = do idrisCatch

88− (do x <- liftIO $ receiveMessage

89− case x of

90− (List [(SymbolAtom "idris"), cmd, (IntegerAtom id)]) ->

91− case sexpToCommand cmd of

92− Just (Interpret cmd) ->

93− do i <- getIState

94− let fn = case mods of

95− (f:_) -> f

96− _ -> ""

97− case parseCmd i cmd of

98− Left err -> do liftIO $ sendMessage id (Left (show err))

99− Right cmd -> do idrisCatch (do xs <- process fn cmd

100− liftIO $ sendMessage id (Right (xs, "no output")))

101− (\e -> do liftIO $ sendMessage id (Left (show e)))

102− Just (REPLCompletions str) -> do (unused, compls) <- replCompletion (reverse str, "")

103− liftIO $ sendMessage id (Right (map replacement compls, reverse unused))

104− Just (LoadFile filename) -> do clearErr

105− mod <- loadModule filename

106− liftIO $ sendMessage id (Right (SymbolAtom ":good"))

107− Nothing -> do liftIO $ sendMessage id (Left "did not understand"))

108− (\e -> do liftIO $ sendMessage 0 (Left (show e)))

88+ (do sexp <- receiveMessage

89+ case sexpToCommand sexp of

90+ Just (Interpret cmd) ->

91+ do i <- getIState

92+ let fn = case mods of

93+ (f:_) -> f

94+ _ -> ""

95+ case parseCmd i cmd of

96+ Left err -> do sendMessage (Left (show err))

97+ Right cmd -> do idrisCatch

98+ (do xs <- process fn cmd

99+ sendMessage (Right (xs, "no output")))

100+ (\e -> do sendMessage (Left (show e)))

101+ Just (REPLCompletions str) ->

102+ do (unused, compls) <- replCompletion (reverse str, "")

103+ sendMessage (Right (map replacement compls, reverse unused))

104+ Just (LoadFile filename) -> do clearErr

105+ mod <- loadModule filename

106+ sendMessage (Right (SymbolAtom "good"))

107+ Nothing -> do sendMessage (Left "did not understand"))

108+ (\e -> do sendMessage (Left (show e)))

109109 ideslave orig mods

110110

111111-- | The prompt consists of the currently loaded modules, or "Idris" if there are none