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

git.iko.soy/Idris-dev

on master help sign in

put ideslave_counter into IState

6d01828Hannes Mehnert13 years ago

src/Idris/AbsSyntaxTree.hs+3−2

compare with master

unifiedsplit

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

93 ibc_write :: [IBCWrite],

94 compiled_so :: Maybe String,

95 idris_dynamic_libs :: [DynamicLib],

96− idris_language_extensions :: [LanguageExt]

96+ idris_language_extensions :: [LanguageExt],

97+ ideslave_counter :: Integer

97 }

98 }

99data SizeChange = Smaller | Same | Bigger | Unknown

100data SizeChange = Smaller | Same | Bigger | Unknown

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

145 emptyContext emptyContext emptyContext emptyContext

146 emptyContext emptyContext emptyContext emptyContext

147 emptyContext emptyContext emptyContext emptyContext

147 [] "" defaultOpts 6 [] [] [] [] [] [] [] [] []

148 [] "" defaultOpts 6 [] [] [] [] [] [] [] [] []

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

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

149

150

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

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

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

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

src/Idris/IdeSlave.hs+22−12

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

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

5+import Idris.AbsSyntaxTree

6+import Idris.AbsSyntax

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

5import Text.Printf

10import Text.Printf

6import Numeric

11import Numeric

7import Data.List

12import Data.List

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

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

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

93sexpToCommand _ = Nothing

98sexpToCommand _ = Nothing

95−receiveMessage :: IO (SExp)

100+receiveMessage :: Idris (SExp)

96−receiveMessage

101+receiveMessage = do x <- liftIO $ getLine

97− = do x <- getLine

102+ case receiveString x of

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

104+ do i <- getIState

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

98− return (receiveString x)

106+ return cmd

107+

108

100receiveString :: String -> SExp

109receiveString :: String -> SExp

101receiveString x =

110receiveString x =

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

109 Right r -> r)

118 Right r -> r)

110 _ -> error "readHex failed"

119 _ -> error "readHex failed"

111

120

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

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

113−sendMessage id s =

122+sendMessage s =

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

123+ do i <- getIState

115− case s of

124+ let msg = case s of

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

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

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

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

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

118− where conv sexp =

128+ where conv id sexp =

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

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

120

130

121getHexLength :: String -> String

131getHexLength :: String -> String

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

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

src/Idris/REPL.hs+21−21

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

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

86ideslave orig mods

87 = do idrisCatch

88− (do x <- liftIO $ receiveMessage

88+ (do sexp <- receiveMessage

89− case x of

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

91− case sexpToCommand cmd of

89+ case sexpToCommand sexp of

92− Just (Interpret cmd) ->

90+ Just (Interpret cmd) ->

93− do i <- getIState

91+ do i <- getIState

94− let fn = case mods of

92+ let fn = case mods of

95− (f:_) -> f

93+ (f:_) -> f

96− _ -> ""

94+ _ -> ""

97− case parseCmd i cmd of

95+ case parseCmd i cmd of

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

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

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

97+ Right cmd -> do idrisCatch

98+ (do xs <- process fn cmd

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

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

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

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

101+ Just (REPLCompletions str) ->

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

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

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

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

104− Just (LoadFile filename) -> do clearErr

104+ Just (LoadFile filename) -> do clearErr

105− mod <- loadModule filename

105+ mod <- loadModule filename

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

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

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

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

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

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

109 ideslave orig mods

110

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