Types and conversion for Tank/Plum.

This commit is contained in:
Benjamin Summers 2019-06-01 14:49:21 -07:00
parent 5b3ab33dac
commit 54fc5f6078
2 changed files with 75 additions and 19 deletions

View File

@ -29,9 +29,45 @@ import qualified Control.Monad.Fail as Fail
data Nullable a = Nil | NotNil a data Nullable a = Nil | NotNil a
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
newtype Tour = Tour [Char]
deriving (Eq, Ord, Show)
newtype Tape = Tape ByteString
deriving (Eq, Ord, Show)
newtype Cord = Cord ByteString newtype Cord = Cord ByteString
deriving newtype (Eq, Ord, Show) deriving newtype (Eq, Ord, Show)
type Tang = [Tank]
data Tank
= TLeaf Tape
| TPlum Plum
| TPalm (Tape, Tape, Tape, Tape) [Tank]
| TRose (Tape, Tape, Tape) [Tank]
deriving (Eq, Ord, Show)
type Tile = Cord
data WideFmt
= WideFmt { delimit :: Tile, enclose :: Maybe (Tile, Tile) }
deriving (Eq, Ord, Show)
data TallFmt
= TallFmt { intro :: Tile, indef :: Maybe (Tile, Tile) }
deriving (Eq, Ord, Show)
data PlumFmt
= PlumFmt (Maybe WideFmt) (Maybe TallFmt)
deriving (Eq, Ord, Show)
data Plum
= PAtom Cord
| PPara Tile [Cord]
| PTree PlumFmt [Plum]
| PSbrk Plum
deriving (Eq, Ord, Show)
-- IResult --------------------------------------------------------------------- -- IResult ---------------------------------------------------------------------
@ -294,6 +330,33 @@ instance FromNoun Cord where
pure $ Cord (atom ^. pill . pillBS) pure $ Cord (atom ^. pill . pillBS)
-- Tank and Plum Conversion ----------------------------------------------------
instance ToNoun WideFmt where toNoun (WideFmt x xs) = toNoun (x, xs)
instance ToNoun TallFmt where toNoun (TallFmt x xs) = toNoun (x, xs)
instance ToNoun PlumFmt where toNoun (PlumFmt wide tall) = toNoun (wide, tall)
instance FromNoun WideFmt where parseNoun = fmap (uncurry WideFmt) . parseNoun
instance FromNoun TallFmt where parseNoun = fmap (uncurry TallFmt) . parseNoun
instance FromNoun PlumFmt where parseNoun = fmap (uncurry PlumFmt) . parseNoun
instance ToNoun Plum where
toNoun = \case
PAtom cord -> toNoun cord
PPara t cs -> toNoun (Cord "para", t, cs)
PTree f ps -> toNoun (Cord "tree", f, ps)
PSbrk p -> toNoun (Cord "sbrk", p)
instance FromNoun Plum where
parseNoun = undefined
instance ToNoun Tank where
toNoun = undefined
instance FromNoun Tank where
parseNoun = undefined
-- Pair Conversion ------------------------------------------------------------- -- Pair Conversion -------------------------------------------------------------
instance (ToNoun a, ToNoun b) => ToNoun (a, b) where instance (ToNoun a, ToNoun b) => ToNoun (a, b) where

View File

@ -27,16 +27,21 @@ data Worker = Worker
} }
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Think about how to handle process exit
-- Tear down subprocess on exit? (terminiteProcess)
start :: IO Worker start :: IO Worker
start = do start =
-- Think about how to handle process exit do
-- Tear down subprocess on exit? (terminiteProcess) (Just i, Just o, _, p) <- createProcess pSpec
(Just stdin, Just stdout, _, ph) <- pure (Worker i o p)
createProcess (proc "urbit-worker" []){ std_in = CreatePipe, where
std_out = CreatePipe } pSpec =
pure (Worker stdin stdout ph) (proc "urbit-worker" []) { std_in = CreatePipe
, std_out = CreatePipe
}
kill :: Worker -> IO ExitCode kill :: Worker -> IO ExitCode
kill w = do kill w = do
@ -49,9 +54,6 @@ work id (Jam a) = jam $ toNoun (Cord "work", id, a)
newtype Job = Job Void newtype Job = Job Void
deriving newtype (Eq, Show, ToNoun, FromNoun) deriving newtype (Eq, Show, ToNoun, FromNoun)
newtype Tank = Tank Void
deriving newtype (Eq, Show, ToNoun, FromNoun)
type EventId = Word64 type EventId = Word64
newtype Ship = Ship Word64 -- @p newtype Ship = Ship Word64 -- @p
@ -219,15 +221,6 @@ computeThread w = start
-- response <- recvAtom w -- response <- recvAtom w
-- Basic Send and Receive Operations ------------------------------------------- -- Basic Send and Receive Operations -------------------------------------------
sendAtom :: Worker -> Atom -> IO () sendAtom :: Worker -> Atom -> IO ()