9 import qualified Data.Map.Strict as M
10 import Data.Map.Strict ((!))
11 import Control.Lens -- hiding ((<|), (|>), (:>), (:<), indices)
13 import Control.Monad.State.Strict
14 import Control.Monad.Reader
15 import Control.Monad.Writer
16 import Control.Monad.RWS.Strict
20 import Data.Binary.Get
21 import qualified Data.ByteString.Lazy as BL
24 data SynacorState = SynacorState
25 { _ssMachines :: [Machine]
26 , _ssInputs :: [String]
27 , _ssOutputs :: [String]
30 , _ssState :: [ExecutionState]
32 makeLenses ''SynacorState
34 instance Show SynacorState
39 , (show (length (state ^. ssMachines)) ++ " machines")
40 , "inputs " ++ (intercalate ":" $ state ^. ssInputs)
41 , "outputs " ++ (intercalate ":" $ fmap (take 20) $ state ^. ssOutputs)
42 , "conts " ++ (show $ state ^. ssContinue)
43 , "unsaved " ++ (show $ state ^. ssUnsaved)
44 , "states " ++ (show $ state ^. ssState)
49 do -- mem <- getMemory
50 -- print $ [(n, showHex (mem ! n) "") | n <- [0..5] ]
51 -- machineInput <- readFile "adventure_input.txt"
52 -- let mInp = wordify machineInput
53 -- let machine = makeMachine mem
54 -- let (exState, _machine, output) = runMachine mInp machine
56 -- putStrLn $ showOutput output
59 let state1 = runWithoutInput state0
60 let newOutput = head $ state1 ^. ssOutputs
62 -- let state1 = runOneInput state "take tablet"
67 stateF <- adventureHarness state1
69 -- print $ stateF ^. ssInputs
70 -- print $ stateF ^. ssOutputs
71 -- print $ stateF ^. ssState
72 -- let machs = stateF ^. ssMachines
73 -- let machPairs = zipWith (==) machs $ tail machs
76 emptyState :: IO SynacorState
79 let machine = makeMachine mem
80 return $ SynacorState [machine] [] [] True False [Runnable]
82 adventureHarness :: SynacorState -> IO SynacorState
83 adventureHarness state =
84 do command <- prompt "> "
85 state' <- handleCommand command state
86 let newOutput = head $ state' ^. ssOutputs
88 if (state' ^. ssContinue)
89 then (adventureHarness state')
93 handleCommand :: String -> SynacorState -> IO SynacorState
94 handleCommand ":quit" state = return $ state & ssContinue .~ False
95 handleCommand ":save" state =
96 do filename <- prompt "Save as? "
97 let inputs = unlines $ tail $ reverse $ state ^. ssInputs
98 writeFile filename inputs
99 return $ state & ssUnsaved .~ True
100 handleCommand ":load" state =
101 do filename <- prompt "From? "
102 machineInput <- readFile filename
103 let inputs = lines machineInput
104 initialState <- emptyState
105 let nonComments = filter (\i -> head i == '#') inputs
106 let state = foldl' runOneInput initialState ("" : nonComments)
107 return $ state & ssUnsaved .~ False
108 handleCommand ":undo" state =
109 return $ state & ssMachines %~ tail
115 handleCommand ":recap" state =
116 do let inputs = take 3 $ state ^. ssInputs
117 let outputs = "" : (tail $ take 3 $ state ^. ssOutputs)
118 let inOuts = reverse $ zip inputs outputs
119 forM_ inOuts (\(i, o) ->
120 do putStrLn ("#> " ++ i)
124 handleCommand command state = return $ runOneInput state command
127 runWithoutInput :: SynacorState -> SynacorState
128 runWithoutInput state = state & ssMachines %~ (machine' :)
129 -- & ssInputs %~ (input :)
130 & ssOutputs %~ ((showOutput output) :)
133 & ssState %~ (exState :)
134 where machine = head $ state ^. ssMachines
135 (exState, machine', output) = runMachine [] (machine & inputIndex .~ 0)
137 runOneInput :: SynacorState -> String -> SynacorState
138 runOneInput state input = state & ssMachines %~ (machine' :)
139 & ssInputs %~ (input :)
140 & ssOutputs %~ ((showOutput output) :)
143 & ssState %~ (exState :)
144 where machine = head $ state ^. ssMachines
145 inputW = wordify (input ++ "\n")
146 (exState, machine', output) = runMachine inputW (machine & inputIndex .~ 0)
147 -- output' = trace ("runone " ++ (show (machine == machine')) ++ " " ++ (show exState) ++ " " ++ (showOutput output)) output
150 prompt :: String -> IO String
156 wordify :: String -> [Word16]
157 wordify cs = fmap (fromIntegral . ord) cs
159 showOutput :: [Word16] -> String
160 showOutput output = fmap (chr . fromInteger . fromIntegral) output
162 getMemory :: IO Memory
164 input <- BL.readFile "challenge.bin"
165 let cells = runGet getCells input
166 return $ M.fromList $ zip [0..] cells
168 getCells :: Get [Word16]
173 else do cell <- getWord16le