82 lines
2.2 KiB
Haskell
82 lines
2.2 KiB
Haskell
|
|
||
|
|
module CircuitParser (parseCircuit, showCircuit) where
|
||
|
|
|
||
|
|
import Text.ParserCombinators.ReadP
|
||
|
|
import Data.List
|
||
|
|
|
||
|
|
import CircuitBase
|
||
|
|
|
||
|
|
-- instance Show Circuit where
|
||
|
|
-- show = showCircuit
|
||
|
|
|
||
|
|
showCircuit (Circuit op inpins) = (formatPin ip) ++ ":" ++ (joinWith "," (nodes inpins outpins)) ++ ":" ++ (formatPin op) where
|
||
|
|
nodes :: [Int] -> [Int] -> [String]
|
||
|
|
nodes [] [] = []
|
||
|
|
nodes (a:b:i) (c:d:o) = ((formatPin a) ++ (formatPin b) ++ "0#" ++ (formatPin c) ++ (formatPin d)):nodes i o
|
||
|
|
joinWith sep [] = []
|
||
|
|
joinWith sep (x:xs) = (x ++) $ concat $ map (sep ++) xs
|
||
|
|
-- build reverse pin mapping
|
||
|
|
(ip:outpins) = map snd $ sort $ zip (op:inpins) [-1..]
|
||
|
|
formatPin p = if (-1 == p) then "X" else (show (p `div` 2)) ++ (if even p then "L" else "R")
|
||
|
|
|
||
|
|
-- Circuit Syntax:
|
||
|
|
-- <inPin>:[<gates>]:<outPin>
|
||
|
|
-- each Pin is either "X" (circuit IN or OUT)
|
||
|
|
-- or <gate-number> + ("L" | "R")
|
||
|
|
-- gates are numbered from 0
|
||
|
|
-- one gate is <inPinLeft><inPinRight>0#<outPinLeft><outPinRight>
|
||
|
|
-- obviously you specify the connector of the other side
|
||
|
|
-- (0 is probably the gate "function")
|
||
|
|
-- this contains redundancy ofc, it would be enough to specify only the in pins of the gates and the circuit OUT
|
||
|
|
-- (internal representation)
|
||
|
|
|
||
|
|
readPlace :: ReadP Int
|
||
|
|
readPlace = (char 'L' >> return 0) <++ (char 'R' >> return 1)
|
||
|
|
|
||
|
|
readInt :: ReadP Int
|
||
|
|
readInt = readS_to_P reads
|
||
|
|
|
||
|
|
readPin :: ReadP Int
|
||
|
|
readPin = (char 'X' >> return (-1)) <++ do
|
||
|
|
i <- readInt
|
||
|
|
p <- readPlace
|
||
|
|
return $ (2*i) + p
|
||
|
|
|
||
|
|
readNode :: ReadP [Int]
|
||
|
|
readNode = do
|
||
|
|
a <- readPin
|
||
|
|
b <- readPin
|
||
|
|
char '0'
|
||
|
|
char '#'
|
||
|
|
readPin
|
||
|
|
readPin
|
||
|
|
return [a,b]
|
||
|
|
|
||
|
|
readNodes1 :: ReadP [Int]
|
||
|
|
readNodes1 = (do
|
||
|
|
char ','
|
||
|
|
x <- readNode
|
||
|
|
xl <- readNodes1
|
||
|
|
return $ x ++ xl
|
||
|
|
) <++ (return [])
|
||
|
|
|
||
|
|
readNodes :: ReadP [Int]
|
||
|
|
readNodes = (do
|
||
|
|
x <- readNode
|
||
|
|
xl <- readNodes1
|
||
|
|
return $ x ++ xl
|
||
|
|
) <++ (return [])
|
||
|
|
|
||
|
|
|
||
|
|
readCircuit :: ReadP Circuit
|
||
|
|
readCircuit = do
|
||
|
|
readPin
|
||
|
|
char ':'
|
||
|
|
nodes <- readNodes
|
||
|
|
char ':'
|
||
|
|
outPin <- readPin
|
||
|
|
return $ Circuit outPin nodes
|
||
|
|
|
||
|
|
doparse p s = fst $ head $ readP_to_S p s
|
||
|
|
parseCircuit s = doparse readCircuit s
|