Attempting (and failing) to serialize some shit

This commit is contained in:
Runar Bjarnason 2018-11-05 17:51:59 -05:00
parent 75641892e5
commit 4e63387799
9 changed files with 121 additions and 51 deletions

View File

@ -197,8 +197,9 @@ main dir currentBranchName initialFile startRuntime codebase = do
putStrLn ""
putStrLn
"👀 Now evaluating any watch expressions (lines starting with `>`) ...\n"
RT.evaluate runtime (UF.discardTypes' unisonFile) codebase
-- todo: actually wait until evaluation completes
(watchExpressions, _term) <-
RT.evaluate runtime (UF.discardTypes' unisonFile) codebase
uncurry (Watch.watchPrinter names) `traverse_` watchExpressions
go :: Branch -> Name -> IO ()
go branch name = do

View File

@ -1,10 +1,16 @@
{-#LANGUAGE RankNTypes#-}
module Unison.Codebase.Runtime where
import Unison.Codebase (Codebase)
import Unison.UnisonFile (UnisonFile)
import Data.Text ( Text )
import Unison.Codebase ( Codebase )
import Unison.UnisonFile ( UnisonFile )
import Unison.Term ( Term )
data Runtime v = Runtime
{ terminate :: IO ()
, evaluate :: forall a b . UnisonFile v a -> Codebase IO v b -> IO () -- but eventually IO (Term v)
, evaluate
:: forall a b
. UnisonFile v a
-> Codebase IO v b
-> IO ([(Text, Term v)], Term v)
}

View File

@ -1,37 +1,72 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Unison.Codebase.Runtime.JVM where
import Control.Applicative
import Control.Monad.State (evalStateT)
import Data.Bytes.Put (runPutS)
import Data.ByteString (ByteString)
import Data.Functor
import Control.Monad.State ( evalStateT )
import Data.Bytes.Get ( getWord8
, runGetS
, MonadGet
)
import Data.Bytes.Put ( runPutS )
import Data.ByteString ( ByteString )
import Data.Text ( Text )
import Network.Socket
import System.IO.Streams (InputStream, OutputStream)
import qualified System.IO.Streams as Streams
import qualified System.IO.Streams.ByteString as BSS
import qualified System.IO.Streams.Network as N
import qualified System.Process as P
import Unison.Codebase (Codebase)
import Unison.Codebase.Runtime (Runtime (..))
import qualified Unison.Codecs as Codecs
import Unison.UnisonFile (UnisonFile)
import Unison.Var (Var)
import System.IO.Streams ( InputStream
, OutputStream
)
import qualified System.IO.Streams as Streams
import qualified System.IO.Streams.ByteString as BSS
import qualified System.IO.Streams.Network as N
import qualified System.Process as P
import Unison.Codebase ( Codebase )
import Unison.Codebase.Runtime ( Runtime(..) )
import qualified Unison.Codebase.Serialization.V0
as Szn
import qualified Unison.Codecs as Codecs
import Unison.Term ( Term )
import Unison.UnisonFile ( UnisonFile )
import Unison.Var ( Var )
javaRuntime :: Var v => Int -> IO (Runtime v)
javaRuntime suggestedPort = do
javaRuntime :: Var v => (forall g. MonadGet g => g v) -> Int -> IO (Runtime v)
javaRuntime getv suggestedPort = do
(listeningSocket, port) <- choosePortAndListen suggestedPort
(killme, input, output) <- connectToRuntime listeningSocket port
pure $ Runtime killme (feedme input output)
where
feedme :: Var v
=> InputStream ByteString -> OutputStream ByteString
-> UnisonFile v a -> Codebase IO v b -> IO ()
feedme input output unisonFile _codebase = do
pure $ Runtime killme (feedme getv input output)
where
processWatches getv acc = do
marker <- getWord8
case marker of
0 -> do
label <- Szn.getText
term <- Szn.getTerm getv (pure ())
processWatches getv $ (label, term) : acc
1 -> do
term <- Szn.getTerm getv (pure ())
pure $ (reverse acc, term)
x -> fail $ "Unexpected byte in JVM output: " ++ show x
feedme
:: forall v a b. Var v
=> (forall g. MonadGet g => g v)
-> InputStream ByteString
-> OutputStream ByteString
-> UnisonFile v a
-> Codebase IO v b
-> IO ([(Text, Term v)], Term v)
feedme getv input output unisonFile _codebase = do
-- todo: runtime should be able to request more terms/types/arities by hash
let bs = runPutS $ flip evalStateT 0 $ Codecs.serializeFile unisonFile
Streams.write (Just bs) output
-- todo: read some actual results here, rather than just reading a sync byte
void $ BSS.readExactly 1 input
bs <- BSS.readExactly 8 input
case runGetS Szn.getInt bs of
Left e -> fail e
Right size -> do
bs <- BSS.readExactly (fromIntegral size) input
case runGetS (processWatches getv []) bs of
Left e -> fail e
Right x -> pure x
-- open a listening socket for the runtime to connect to
choosePortAndListen :: Int -> IO (Socket, Int)

View File

@ -1,3 +1,4 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE OverloadedStrings #-}
@ -36,13 +37,17 @@ import Unison.Codebase ( Codebase )
import Unison.Codebase.Runtime ( Runtime(..) )
import qualified Unison.Codebase.Runtime as RT
import qualified Unison.FileParsers as FileParsers
import Unison.Names ( Names )
import qualified Unison.Parsers as Parsers
import Unison.PrintError ( renderParseErrorAsANSI
, renderNoteAsANSI
)
import Unison.Result ( pattern Result )
import qualified Unison.TermPrinter as TermPrinter
import Unison.Term ( Term )
import qualified Unison.UnisonFile as UF
import Unison.Util.Monoid
import qualified Unison.PrettyPrintEnv as PPE
import Unison.Util.TQueue ( TQueue )
import qualified Unison.Util.TQueue as TQueue
import Unison.Var ( Var )
@ -102,6 +107,24 @@ watchDirectory dir allow = do
else await
pure await
watchPrinter :: Var v => Names v a -> Text -> Term v -> IO ()
watchPrinter names label term = do
-- I guess this string constant comes from somewhere, and we are using
-- a bunch of spaces of the same total length.
let lead = const ' ' <$> " | > "
-- weird that this doesn't incorporate the previous constant somehow
let arr = ""
-- todo: replace 80 with some number calculated from the terminal width
-- e.g. http://hackage.haskell.org/package/terminal-size
let tm = TermPrinter.pretty' (Just 80) (PPE.fromNames names) term
let tm2 = tm >>= \case
'\n' -> '\n' : lead
c -> pure c
putStrLn $ Text.unpack label
putStrLn arr
putStrLn $ lead ++ tm2 ++ "\n"
watcher
:: Var v
=> Maybe FilePath
@ -151,7 +174,7 @@ watcher initialFile dir runtime codebase = do
Console.setTitle "Unison ✅"
putStrLn
"✅ Typechecked! Any watch expressions (lines starting with `>`) are shown below.\n"
RT.evaluate runtime (UF.discardTypes' typecheckedUnisonFile) codebase
void $ RT.evaluate runtime (UF.discardTypes' typecheckedUnisonFile) codebase
(`finally` RT.terminate runtime) $ do
case initialFile of
Just sourceFile -> do

View File

@ -12,9 +12,8 @@ import qualified Unison.Codebase.CommandLine as CommandLine
import qualified Unison.Codebase.FileCodebase as FileCodebase
import Unison.Codebase.Runtime.JVM (javaRuntime)
import qualified Unison.Codebase.Serialization as S
import Unison.Codebase.Serialization.V0 (formatSymbol)
import Unison.Codebase.Serialization.V0 (formatSymbol, getSymbol)
import Unison.Parser (Ann (External))
import Unison.Symbol (Symbol)
main :: IO ()
main = do
@ -26,7 +25,7 @@ main = do
scratchFilePath = "."
launch = CommandLine.main scratchFilePath initialBranchName
(headMay args)
(javaRuntime @Symbol 42441)
(javaRuntime getSymbol 42441)
(FileCodebase.codebase1 External formatSymbol formatAnn codebasePath)
exists <- FileCodebase.exists codebasePath

View File

@ -5,13 +5,13 @@ import Safe (headMay)
import System.Environment (getArgs)
-- import qualified Unison.Codebase as Codebase
import qualified Unison.Codebase.Watch as W
import Unison.Symbol (Symbol)
import Unison.Codebase.Serialization.V0 (getSymbol)
import Unison.Codebase.Runtime.JVM (javaRuntime)
main :: IO ()
main = do
args <- getArgs
runtime <- javaRuntime @Symbol 42441
runtime <- javaRuntime getSymbol 42441
case args of
[""] -> go runtime Nothing
_ -> go runtime (headMay args)

View File

@ -68,20 +68,17 @@ object BootstrapStream {
println("Shutting down runtime.")
return ()
}
if (wrangle) {
// serialize term back to the channel
val serialized = Codecs.encodeTerm(t)
def go(s: Sequence[Array[Byte]]): Unit = s.headOption match {
case Some(array) =>
channel.write(ByteBuffer.wrap(array))
go(s.drop(1))
case None => ()
}
}
else {
// sync byte
channel.write(ByteBuffer.wrap(Array[Byte](74)))
// serialize term back to the channel
def go(s: Sequence[Array[Byte]]): Unit = s.headOption match {
case Some(array) =>
channel.write(ByteBuffer.wrap(array))
go(s.drop(1))
case None => ()
}
// We're done with watch expressions.
// Send marker that we're about to send the final term.
go(Sequence(Array(1)))
go(Codecs.encodeTerm(t))
}
}
@ -93,10 +90,17 @@ object Bootstrap0 {
// to the channel, after sending the label.
def watchChanneler(chan: SocketChannel)(label: String, v: Value): Unit = {
val chunks = Sink.toChunks(64 * 1024) { sink =>
// Send marker that a watch expression follows.
sink.putByte(0)
sink.putString(label)
Serialization.V0.putTerm(sink, Term.fullyDecompile(v.decompile))
}
chunks foreach { chunk =>
val size = chunks.map(_.size).foldLeft(0)(_ + _)
val sizeChunks = Sink.toChunks(256) { sink =>
sink.putLong(size)
}
(sizeChunks ++ chunks) foreach { chunk =>
val _ = chan.write(ByteBuffer.wrap(chunk))
}
}

View File

@ -190,9 +190,11 @@ object Serialization {
case Id.Builtin(Name(name)) =>
putByte(0)
putString(name)
case Id.HashRef(Hash(bytes)) =>
case Id.HashRef(Id.H(Hash(bytes), pos, sz)) =>
putByte(1)
put(bytes)
putVarLong(pos)
putVarLong(sz)
}
putFramedSeq1(freeVars)(putVar _)
go(ABT.annotateBound(term))

View File

@ -8,7 +8,7 @@ increment n = n + 1
> increment 99
replicate : Nat -> a -> [a]
replicate n a = to-sequence (take n (constant a))
replicate n a = toSequence (take n (constant a))
-- this is nice for quick testing!