packages feed

stim-parser (empty) → 0.1.0.0

raw patch · 13 files changed

+1420/−0 lines, 13 filesdep +HUnitdep +basedep +containers

Dependencies added: HUnit, base, containers, megaparsec, mtl, stim-parser, unordered-containers

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for stim-parser++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ app/Example.hs view
@@ -0,0 +1,33 @@+import StimParser.Expr+import StimParser.Parse+import StimParser.ParseUtils++main :: IO ()+main = do +  print gateTyList+  print $ run parseGateTy "I"+  print $ run parseGateTy "X"+  print $ run parseGateTy "C_NXYZ"+  print $ run parseGate "CY sweep[5] 7 sweep[5] 8 \n CY"+  print $ run parseMeasureTy "MXX"+  print $ run parseMeasure "MXX(0.01) 2 3 \n CY"+  print $ run parsePauliChain "X1*Z1*Y2 X1*Z1*Y2"+  print $ run parsePauliChain "!X1*Z1*Y2 !X1*Z1*Y2"+  print $ run parsePauliChain "X1*Z1 !X1*Z1*Y2"+  print $ run (parseExhaust parsePauliChain) "X1*Z1 !X1*Z1*Y2 \n CY"+  print $ run parseGpp "MPP(0.001) Z1*Z2 X1*X2 \n CY"+  print $ run parseGpp "MPP Z1*Z2 X1*X2 \n CY"+  print $ run parseNoise "HERALDED_PAULI_CHANNEL_1(0.01, 0.02, 0.03, 0.04) 0 1 \n CY"+  print $ run parseNoise "CORRELATED_ERROR(0.2) X1 Y2 \n CY"+  print $ run parseNoise "II_ERROR 0 1 \n CY"+  print $ run parseNoise "II_ERROR[TWO_QUBIT_LEAKAGE_NOISE_FOR_AN_ADVANCED_SIMULATOR:0.1] 0 2 4 6 \n CY"+  print $ run parseNoise "II_ERROR[MULTIPLE_TWO_QUBIT_NOISE_MECHANISMS](0.1, 0.2) 0 2 4 6 \n CY"+  print $ run parseAnn "DETECTOR(1, 0) rec[-3] rec[-6] \n CY"+  print $ run parseAnn "DETECTOR rec[-3] rec[-4] rec[-7] \n CY"+  print $ run parseAnn "SHIFT_COORDS(500.5) \n CY"+  print $ run parseAnn "TICK \n CY"++  let file = "data/example.stim"+  s <- readFile file+  print $ run parseStim ("!!!Start " ++ s) +
+ app/Main.hs view
@@ -0,0 +1,17 @@+import StimParser.Parse+import StimParser.ParseUtils (run)++-- Parse a stim gate+main :: IO ()+main = do+  -- Parse individual elements+  print $ run parseGate "CNOT 0 1 2 3"+  -- => Gate CNOT [Q 0,Q 1,Q 2,Q 3]+  +  print $ run parseMeasure "MXX(0.01) 2 3"+  -- => Measure MXX (Just 0.01) [Q 2,Q 3]+  +  -- Parse a full stim file+  s <- readFile "data/example.stim"+  print $ run parseStim ("!!!Start " ++ s)+  -- => StimList [...]
+ src/StimParser/Expr.hs view
@@ -0,0 +1,213 @@+{-# LANGUAGE InstanceSigs #-}+module StimParser.Expr where ++type Ind = Int+type Ph = Float+newtype Rec = Rec Int+  deriving (Show)+newtype Sweep = Sweep Int+  deriving (Show)++-- example:+--    CY sweep[5] 7 sweep[5] 8+--    CY rec[-1] 6+--    CY 2 5 4 2+--    MXX !1 2+data Q = Q Int | QRec Rec | QSweep Sweep | Not Int+  deriving (Show)++data Pauli = PX | PY | PZ +  deriving (Show)+data PauliInd = PauliInd Pauli Ind+  deriving (Show)++data PauliChain = P [PauliInd]+  | N [PauliInd]+  deriving (Show)++data GateTy =+  -- Pauli+  I | X | Y | Z +  -- Single Qubit Clifford Gates  +  | C_NXYZ | C_NZYX | C_XNYZ | C_XYNZ | C_XYZ | C_ZNYX | C_ZYNX | C_ZYX | H | H_NXY | H_NXZ | H_NYZ | H_XY | H_XZ | H_YZ | S | SQRT_X | SQRT_X_DAG | SQRT_Y | SQRT_Y_DAG | SQRT_Z | SQRT_Z_DAG | S_DAG +  -- Two Qubit Clifford Gates +  | CNOT | CX | CXSWAP | CY | CZ | CZSWAP | II | ISWAP | ISWAP_DAG | SQRT_XX | SQRT_XX_DAG | SQRT_YY | SQRT_YY_DAG | SQRT_ZZ | SQRT_ZZ_DAG | SWAP | SWAPCX | SWAPCZ | XCX | XCY | XCZ | YCX | YCY | YCZ | ZCX | ZCY | ZCZ+  -- Collapsing Gates +  | RX | RY | RZ+  | R +  deriving (Show, Eq, Ord, Bounded, Enum)++-- property of dataclass Enum from GHC.Enum+gateTyList :: [GateTy]+gateTyList = [I ..] ++-- Gate examples:+--    CY sweep[5] 7 sweep[5] 8+--    CY rec[-1] 6+--    CY 2 5 4 2+--    H[custom] 0+data Gate = Gate GateTy (Maybe Tag) [Q] +  deriving (Show)++-- Collapsing Gates and Pair Measurement Gates +data MeasureTy = +  M +  | MXX | MYY | MZZ -- Pair Measurement Gates +  | MRX | MRY | MRZ +  | MX | MY | MZ +  | MR +  deriving (Show, Eq, Ord, Bounded, Enum)++measureTyList :: [MeasureTy]+measureTyList = [M ..] ++-- Collapsing Gates examples:+--    M 5+--    MZ !5+--       only single ph+--    MZ(0.02) 2 3 5+--    M[custom] 0+-- Pair Measurement Gates examples:+--    MXX 1 2+--    MXX !1 2+--    MXX(0.01) 2 3++data Measure = Measure MeasureTy (Maybe Tag) (Maybe Ph) [Q]+  deriving (Show)++-- Generalized Pauli Product Gates +data GppTy = +  MPP +  | SPP_DAG+  | SPP +  deriving (Show, Eq, Ord, Bounded, Enum)++gppTyList :: [GppTy]+gppTyList = [MPP ..] ++-- Generalized Pauli Product Gates  examples:+--    MPP X2*X3*X5*X7+--    MPP !Z5+--    MPP X1*Y2 !Z3*Z4*Z5+--    MPP(0.001) Z1*Z2 X1*X2+--    SPP !X1*Y2*Z3+--    MPP[custom] X1*X2++data Gpp = Gpp GppTy (Maybe Tag) (Maybe Ph) [PauliChain]+  deriving (Show)++-- Noise Channels +data NoiseTy = +  E +  | CORRELATED_ERROR | DEPOLARIZE1 | DEPOLARIZE2 +  | ELSE_CORRELATED_ERROR | HERALDED_ERASE | HERALDED_PAULI_CHANNEL_1 | II_ERROR | I_ERROR | PAULI_CHANNEL_1 | PAULI_CHANNEL_2 | X_ERROR | Y_ERROR | Z_ERROR+  deriving (Show, Eq, Ord, Bounded, Enum)++noiseTyList :: [NoiseTy]+noiseTyList = [E ..] ++-- Noise Channels examples:+-- normal type:+--    DEPOLARIZE1(0.01) 2 3 5+--    DEPOLARIZE2(0.01) 2 3 5 7+--    HERALDED_ERASE(0.01) 2 3 5 7+--    HERALDED_PAULI_CHANNEL_1(0.01, 0.02, 0.03, 0.04) 0 1+--    PAULI_CHANNEL_1(0.1, 0.15, 0.2) 1 2 4+--    PAULI_CHANNEL_2(0,0,0, 0.1,0,0,0, 0,0,0,0.2, 0,0,0,0) 1 2 5 6 8 3+--    X_ERROR(0.001) 5 42+--    Z_ERROR(0.001) 5 42+--    Y_ERROR(0.001) 5 42+--    II_ERROR(0.1) 0 1+--    I_ERROR(0.1) 0+--  E type:+--    CORRELATED_ERROR(0.2) X1 Y2+--    ELSE_CORRELATED_ERROR(0.25) Z2 Z3+-- xx_ERROR type+--    II_ERROR 0 1+--    II_ERROR[TWO_QUBIT_LEAKAGE_NOISE_FOR_AN_ADVANCED_SIMULATOR:0.1] 0 2 4 6+--    II_ERROR[MULTIPLE_TWO_QUBIT_NOISE_MECHANISMS](0.1, 0.2) 0 2 4 6+--    I_ERROR 0+--    I_ERROR[LEAKAGE_NOISE_FOR_AN_ADVANCED_SIMULATOR:0.1] 0 2 4+--    I_ERROR[MULTIPLE_NOISE_MECHANISMS](0.1, 0.2) 0 2 4++data ErrorTagTy = TWO_QUBIT_LEAKAGE_NOISE_FOR_AN_ADVANCED_SIMULATOR+  | LEAKAGE_NOISE_FOR_AN_ADVANCED_SIMULATOR+  | MULTIPLE_TWO_QUBIT_NOISE_MECHANISMS+  | MULTIPLE_NOISE_MECHANISMS+  deriving (Show, Eq, Ord, Bounded, Enum)++errorTagTyList :: [ErrorTagTy]+errorTagTyList = [TWO_QUBIT_LEAKAGE_NOISE_FOR_AN_ADVANCED_SIMULATOR ..] ++data ErrorTag = ErrorTag ErrorTagTy+  | ErrorTagCoef ErrorTagTy Float +  deriving (Show)++data Noise = +  NoiseNormal NoiseTy (Maybe Tag) (Maybe ErrorTag) [Ph] [Q]+  | NoiseE NoiseTy (Maybe Tag) Float [PauliInd]+  deriving (Show)++-- General Instruction Tag (v1.15+)+-- Examples: TICK[100ns], X_ERROR[custom](0.1) 0+newtype Tag = Tag String+  deriving (Show)++-- Annotations +data AnnTy = +  DETECTOR | MPAD | OBSERVABLE_INCLUDE | QUBIT_COORDS | SHIFT_COORDS | TICK+  deriving (Show, Eq, Ord, Bounded, Enum)++annTyList :: [AnnTy]+annTyList = [DETECTOR ..] ++-- Annotations examples:+--    DETECTOR(1, 0) rec[-3] rec[-6]+--    DETECTOR(2, 0, 0) rec[-8]+--    DETECTOR rec[-3] rec[-4] rec[-7]+--    OBSERVABLE_INCLUDE(0) rec[-1] rec[-2]+--    QUBIT_COORDS(0, 0) 0+--    MPAD 0 0 1 0 1+--    SHIFT_COORDS(500.5)+--    SHIFT_COORDS(0, 1)  # Advance 2nd coordinate to track loop iterations.+--    TICK+--    TICK[100ns]++-- seperate Integer and Float cases+data FInd = In Ind | Fl Float+  deriving (Show)++instance Num FInd where+  (+) (In i1) (In i2) = In (i1 + i2)+  (+) (Fl i1) (Fl i2) = Fl (i1 + i2)+  (+) (In i1) (Fl i2) = Fl (fromIntegral i1 + i2)+  (+) (Fl i1) (In i2) = Fl (i1 + fromIntegral i2)++  (*) = undefined+  negate = undefined+  abs = undefined+  signum = undefined+  +  fromInteger :: Integer -> FInd+  fromInteger = In . fromInteger ++newtype Coords = Coords [FInd]++data Ann = Ann AnnTy (Maybe Tag) [FInd] [Q]+  deriving (Show)++-- repeat example:+-- REPEAT 0 {+--     M 0+--     OBSERVABLE_INCLUDE(0) rec[-1]+-- }++data Stim = +  StimG Gate +  | StimM Measure+  | StimGpp Gpp+  | StimNoise Noise+  | StimAnn Ann+  | StimList [Stim]+  | StimRepeat Int Stim+  deriving (Show)
+ src/StimParser/Parse.hs view
@@ -0,0 +1,342 @@+{-# OPTIONS_GHC -Wno-unused-do-bind #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Use <$>" #-}+module StimParser.Parse where+import StimParser.Expr+import StimParser.ParseUtils+import Control.Monad+import Data.List+import Text.Megaparsec hiding (State)+import Text.Megaparsec.Char+import qualified Text.Megaparsec.Char.Lexer as L++-- parsePauli is not lexemed+parsePauli :: Parser Pauli+parsePauli = +  try (string "X" >> return PX) +  <|> try (string "Y" >> return PY)+  <|> (string "Z" >> return PZ)++-- parsePauliInd is not lexemed+parsePauliInd :: Parser PauliInd+parsePauliInd = do +  p <- parsePauli+  i <- L.decimal+  return $ PauliInd p i++parseExhaust :: Parser a -> Parser [a]+parseExhaust parseElm = safeManyTill parseElm (notFollowedBy parseElm)++parsePauliChain :: Parser PauliChain+parsePauliChain = do +  let+    parseElm = do +      pp <- parsePauliInd+      string "*"+      return pp ++    parsePCs_ = do +      pcs <- parseExhaust parseElm+      pp <- parsePauliInd+      return $ pcs ++ [pp]++    -- parser for case: X2*X3*X5*X7+    parsePCs = P <$> parsePCs_+    -- parser for case: !Z3*Z4*Z5+    parseNPCs = do +      string "!"+      N <$> parsePCs_+  lexeme $ try parseNPCs <|> parsePCs+      ++parseQ :: Parser Q+parseQ = do+  let+    qint = Q <$> parseInt+    qrec = do+      lstring "rec"+      lstring "["+      i <- parseInt+      lstring "]"+      if i < 0 +        then return $ QRec (Rec i)+        else fail "rec[] index must be negative (e.g., rec[-1])"+    qsweep = do+      lstring "sweep"+      lstring "["+      i <- parseInt+      lstring "]"+      return $ QSweep (Sweep i)+    qnot = do+      lstring "!"+      Not <$> parseInt+  try qint <|> try qrec <|> try qsweep <|> qnot+++parseShow :: (Show a) => a -> Parser a+parseShow x = lstring (show x) >> return x++-- | Case-insensitive version of parseShow+parseShowCI :: (Show a) => a -> Parser a+parseShowCI x = lstringCI (show x) >> return x++-- parseEnum :: (Show a) => [a] -> Parser a+-- parseEnum (x:xs) = do+--   let+--     parseTail = msum $ try . parseShow <$> xs+--   parseTail <|> parseShow x+-- parseEnum [] = error "value error"++parseEnum :: (Show a) => [a] -> Parser a+parseEnum [] = error "value error"+parseEnum xs = msum $ map parseShowCI $ sortOn (negate . length . show) xs++-- | Parse an optional tag: [tag_content]+-- Tag content can be any character except ], \r, \n+parseTag :: Parser Tag+parseTag = do+  lstring "["+  content <- many $ satisfy (\c -> c /= ']' && c /= '\r' && c /= '\n')+  lstring "]"+  return $ Tag content++parseGateTy :: Parser GateTy+parseGateTy = parseEnum gateTyList++-- -- always remember to update this, when new syntax element is supported+-- preparseNext :: Parser ()+-- preparseNext = +--   try (void parseGateTy)+--   <|> try (void parseMeasureTy)+--   <|> void parseGppTy++parseGate :: Parser Gate+parseGate = do+  gty <- parseGateTy+  tag <- optional parseTag+  qs <- parseExhaust parseQ+  return $ Gate gty tag qs++parseMeasureTy :: Parser MeasureTy+parseMeasureTy = parseEnum measureTyList++parsePh :: Parser Float +parsePh = do +  lstring "("+  ph <- parseFloat+  lstring ")"+  return ph++parseMeasure :: Parser Measure+parseMeasure = do +  let +    -- parser for case: M[tag](0.02) 2 3 5+    pm1 = do +      mty <- parseMeasureTy+      tag <- optional parseTag+      ph <- parsePh+      qs <- parseExhaust parseQ+      return $ Measure mty tag (Just ph) qs+    -- parser for case: M[tag] 0+    pm2 = do +      mty <- parseMeasureTy+      tag <- optional parseTag+      qs <- parseExhaust parseQ+      return $ Measure mty tag Nothing qs+  -- the order is tricky - try phase version first+  try pm1 <|> pm2+++parseGppTy :: Parser GppTy+parseGppTy = parseEnum gppTyList++parseGpp :: Parser Gpp +parseGpp = do +  let +    -- parser for case: MPP[tag](0.001) Z1*Z2 X1*X2+    pm1 = do +      gty <- parseGppTy+      tag <- optional parseTag+      ph <- parsePh+      pcs <- parseExhaust parsePauliChain+      return $ Gpp gty tag (Just ph) pcs+    -- parser for case: MPP[tag] X1*Y2 !Z3*Z4*Z5+    pm2 = do +      gty <- parseGppTy+      tag <- optional parseTag+      pcs <- parseExhaust parsePauliChain+      return $ Gpp gty tag Nothing pcs+  -- the order is tricky - try phase version first+  try pm1 <|> pm2++parseNoiseTy :: Parser NoiseTy+parseNoiseTy = parseEnum noiseTyList++parseErrorTagTy :: Parser ErrorTagTy+parseErrorTagTy = parseEnum errorTagTyList++parseErrorTag :: Parser ErrorTag+parseErrorTag = do +  let +    -- parser for case: MULTIPLE_NOISE_MECHANISMS+    pm1 = ErrorTag <$> parseErrorTagTy+    -- parser for case: LEAKAGE_NOISE_FOR_AN_ADVANCED_SIMULATOR:0.1+    pm2 = do +      ett <- parseErrorTagTy+      lstring ":"+      ph <- parseFloat+      return $ ErrorTagCoef ett ph +  -- the order is tricky+  try pm2 <|> pm1++parseTuple :: Parser a -> Parser [a]+parseTuple pm = do +  lstring "("+  let +    parseE = do +      f <- pm+      lstring ","+      return f+    parseTuple_ = (++) <$> parseExhaust parseE <*> ((: []) <$> pm)+  phs <- parseTuple_+  lstring ")"+  return phs++parseTupleFloat :: Parser [Float]+parseTupleFloat = parseTuple parseFloat+  -- lstring "("+  -- let +  --   parseE = do +  --     f <- parseFloat+  --     lstring ","+  --     return f+  --   parseTuple = (++) <$> parseExhaust parseE <*> ((: []) <$> parseFloat)+  -- phs <- parseTuple+  -- lstring ")"+  -- return phs+++parseNoise :: Parser Noise+parseNoise = do +  let +    -- parser for case: X_ERROR[tag](0.01) 0 - with general tag and args+    pm1 = do +      ty <- parseNoiseTy+      tag <- optional parseTag+      phs <- parseTupleFloat+      qs <- parseExhaust parseQ +      return $ NoiseNormal ty tag Nothing phs qs +    -- parser for case: CORRELATED_ERROR[tag](0.2) X1 Y2+    pm2 = do +      ty <- parseNoiseTy+      tag <- optional parseTag+      lstring "("+      ph <- parseFloat+      lstring ")"+      ps <- some (lexeme parsePauliInd)+      return $ NoiseE ty tag ph ps +    -- parser for case: X_ERROR[tag] 0 - with general tag, no args+    pm3 = do +      ty <- parseNoiseTy+      tag <- optional parseTag+      qs <- parseExhaust parseQ +      return $ NoiseNormal ty tag Nothing [] qs+    -- parser for case: II_ERROR[ErrorTag:coef] 0 2 4 6 - error tag without args+    pm4 = do +      ty <- parseNoiseTy+      lstring "["+      et <- parseErrorTag+      lstring "]"+      tag <- optional parseTag  -- Optional general tag after error tag+      qs <- parseExhaust parseQ +      return $ NoiseNormal ty tag (Just et) [] qs+    -- parser for case: II_ERROR[ErrorTag](0.1, 0.2) 0 2 4 6 - error tag with args+    pm5 = do +      ty <- parseNoiseTy+      lstring "["+      et <- parseErrorTag+      lstring "]"+      tag <- optional parseTag  -- Optional general tag after error tag+      phs <- parseTupleFloat+      qs <- parseExhaust parseQ +      return $ NoiseNormal ty tag (Just et) phs qs+  -- the order is tricky - try most specific first+  try pm2 <|> try pm5 <|> try pm4 <|> try pm1 <|> pm3++parseAnnTy :: Parser AnnTy+parseAnnTy = parseEnum annTyList++parseFInd :: Parser FInd+parseFInd = do +  let +    -- In Ind+    pm1 = do +      i <- parseInt+      return $ In i +    -- Fl Float+    pm2 = do+      f <- parseFloat+      return $ Fl f +  -- the order is tricky +  try pm2 <|> pm1++parseAnn :: Parser Ann +parseAnn = do +  let +    -- parser for case: DETECTOR[tag](1, 0) rec[-3] rec[-6]+    pm1 = do +      ty <- parseAnnTy +      tag <- optional parseTag+      fds <- parseTuple parseFInd+      qs <- parseExhaust parseQ+      return $ Ann ty tag fds qs+    -- parser for case: DETECTOR[tag] rec[-3] rec[-4] rec[-7]+    pm2 = do +      ty <- parseAnnTy+      tag <- optional parseTag+      qs <- parseExhaust parseQ+      return $ Ann ty tag [] qs+    -- parser for case: SHIFT_COORDS[tag](500.5)+    pm3 = do +      ty <- parseAnnTy+      tag <- optional parseTag+      fds <- parseTuple parseFInd+      return $ Ann ty tag fds []+    -- parser for case: TICK[tag]+    pm4 = do+      ty <- parseShowCI TICK+      tag <- optional parseTag+      return $ Ann ty tag [] []+  -- the order is tricky+  try pm1 <|> try pm2 <|> try pm3 <|> pm4 ++parseStart :: Parser ()+parseStart = void (lstring "!!!Start") ++parseStim :: Parser Stim +parseStim = do +  let +    -- the order may be tricky+    parseUnit = +      try (StimG <$> parseGate)+      <|> try (StimM <$> parseMeasure)+      <|> try (StimGpp <$> parseGpp)+      <|> try (StimNoise <$> parseNoise)+      <|> (StimAnn <$> parseAnn)++    parseUnitList = StimList <$> parseExhaust parseUnit+    parseRepeat = do +      lstring "REPEAT"+      i <- parseInt+      lstring "{"+      us <- parseUnitList+      lstring "}"+      return $ StimRepeat i us++    parseUR = try parseRepeat <|> parseUnit++  parseStart+  +  StimList <$> safeManyTill parseUR eof++
+ src/StimParser/ParseUtils.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Use <$>" #-}+{-# HLINT ignore "Use <&>" #-}+module StimParser.ParseUtils where+import Data.Void+import Text.Megaparsec hiding (State)+import Text.Megaparsec.Char+import qualified Text.Megaparsec.Char.Lexer as L+-- import System.IO+import Control.Applicative+import GHC.Stack (HasCallStack)+import Control.Monad.State.Lazy++import qualified Data.HashMap.Strict as HS+import qualified Data.Set as Set+import Data.Maybe+import Data.Char (toLower)++type Parser = Parsec Void String+-- type Parser = ParsecT Void String (State Env)++sc :: Parser ()+sc = L.space+  space1+  (L.skipLineComment "#")+  (L.skipBlockComment "(*" "*)")++-- cosume all the white spaces following a Parser+-- white spaces include: " " "\n" "\t"+lexeme :: Parser a -> Parser a+lexeme = L.lexeme sc++lstring :: String -> Parser String+lstring = lexeme . string++-- | Case-insensitive string parser (custom implementation)+stringCI :: String -> Parser String+stringCI s = try $ mapM charCI s+  where+    charCI c = do+      x <- satisfy (\x -> toLower x == toLower c)+      return x  -- Return the actual matched character, not the expected one++-- | Case-insensitive lexeme string parser  +lstringCI :: String -> Parser String+lstringCI = lexeme . stringCI++safeManyTill :: MonadParsec e s f => f a -> f b -> f [a]+safeManyTill p end = go+  where+    go = try ([] <$ end) <|> liftA2 (:) p go++manyBetween :: Parser a -> Parser a -> Parser String+manyBetween s e = s *> safeManyTill L.charLiteral e++run :: HasCallStack => Parser a -> String -> a+run p s = case m of+  Left bundle -> error (errorBundlePretty bundle)+  Right r -> r+  where+   m = runParser p "" s++parseInt :: Parser Int+parseInt = lexeme $ L.signed sc L.decimal++parseFloat :: Parser Float +parseFloat = lexeme $ L.signed sc L.float++parseVar :: Parser String+parseVar = do+  lexeme $ safeManyTill L.charLiteral (lookAhead (try space1 <|> eof))++excludePredict :: Parser a -> Parser ()+excludePredict p = lookAhead $ notFollowedBy p+
+ src/StimParser/Trans.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE TypeFamilies #-}+module StimParser.Trans where +import Control.Monad.State.Lazy+import Control.Monad++import StimParser.Expr+import Data.Maybe++type Env = State (Int, Coords)++-- questions raised:+  -- is that `Measure` the only case where we increase the count? +    -- no, each Gpp also increases the count+  -- if `Measure` contains multiple qubits, do we increase the count by one for each qubit?+    -- yes+  -- how could we deal with the rec inside the Repeat block?+    -- just, expand it into List++-- TODO: SHIFT_COORDS will affect the coordinate in stim annotation++-- transform all (QRec Rec) into (Q Int)+class FlattenQ a where+  type Out a+  flattenQ :: a -> Env (Out a) ++instance FlattenQ Q where+  type Out Q = Q+  flattenQ (Q i) = return (Q i)+  flattenQ (QRec (Rec r)) = do +    (count, _) <- get +    return $ Q (count + r + 1)+  flattenQ _ = error "currently flattenQ does not support this qtype"++instance FlattenQ Gate where+  type Out Gate = Gate+  flattenQ (Gate gt tag qs) = do +    nqs <- mapM flattenQ qs +    return $ Gate gt tag nqs ++-- for each measure, we increase the count by 1+-- currently, we assume measure does not contains (QRec Rec)+instance FlattenQ Measure where+  type Out Measure = Measure+  flattenQ m@(Measure mty tag mph qs) = do +    (count, cs) <- get +    let ncount = count + length qs +    put (ncount, cs) +    return m++instance FlattenQ Gpp where+  type Out Gpp = Gpp+  flattenQ g = do +    (count, cs) <- get +    let ncount = count + 1+    put (ncount, cs) +    return g++instance FlattenQ Noise where+  type Out Noise = Noise+  flattenQ (NoiseNormal nty tag errTag phs qs) = do +    nqs <- mapM flattenQ qs +    return $ NoiseNormal nty tag errTag phs nqs++  flattenQ n@(NoiseE {}) = return n++instance FlattenQ Ann where+  type Out Ann = Maybe Ann+  flattenQ (Ann SHIFT_COORDS tag fs qs) = do+    -- nqs <- mapM flattenQ qs+    (count, Coords cs) <- get+    let ncs = zipWith (+) fs cs+    put (count, Coords ncs)+    return Nothing++  -- TODO: type-level constraint that fs and cs should be of the same length+  -- TODO: type-level constraint that count should not be used in this case+  flattenQ (Ann DETECTOR tag fs qs) = do+    (count, Coords cs) <- get+    let nfs = zipWith (+) fs cs+    nqs <- mapM flattenQ qs+    return $ Just $ Ann DETECTOR tag nfs nqs+    +  flattenQ (Ann aty tag fs qs) = do +    nqs <- mapM flattenQ qs +    return $ Just $ Ann aty tag fs nqs++instance FlattenQ Stim where+  type Out Stim = Maybe Stim+  flattenQ (StimG g) = (Just . StimG) <$> flattenQ g +  flattenQ (StimM g) = (Just . StimM) <$> flattenQ g  +  flattenQ (StimGpp g) = (Just . StimGpp) <$> flattenQ g +  flattenQ (StimNoise g) = (Just . StimNoise) <$> flattenQ g +  flattenQ (StimAnn g) = do+    ng <- flattenQ g+    case ng of+      Nothing -> return Nothing+      Just nng -> return $ Just $ StimAnn nng+  flattenQ (StimList gs) = do+    ngs <- mapM flattenQ gs+    let nngs = map fromJust $ filter isJust ngs+    return $ Just $ StimList nngs+    -- StimList <$> mapM flattenQ gs+  flattenQ (StimRepeat n s) = do+    ns <- replicateM n (flattenQ s)+    let nns = map fromJust $ filter isJust ns+    return $ Just $ StimList nns+    -- StimList <$> replicateM n (flattenQ s)
+ stim-parser.cabal view
@@ -0,0 +1,144 @@+cabal-version:      3.0+-- The cabal-version field refers to the version of the .cabal specification,+-- and can be different from the cabal-install (the tool) version and the+-- Cabal (the library) version you are using. As such, the Cabal (the library)+-- version used must be equal or greater than the version stated in this field.+-- Starting from the specification version 2.2, the cabal-version field must be+-- the first thing in the cabal file.++-- Initial package description 'stim-parser' generated by+-- 'cabal init'. For further documentation, see:+--   http://haskell.org/cabal/users-guide/+--+-- The name of the package.+name:               stim-parser++-- The package version.+-- See the Haskell package versioning policy (PVP) for standards+-- guiding when and how versions should be incremented.+-- https://pvp.haskell.org+-- PVP summary:     +-+------- breaking API changes+--                  | | +----- non-breaking API additions+--                  | | | +--- code changes with no API change+version:            0.1.0.0++-- A short (one-line) description of the package.+synopsis:           A parser combinator library for STIM quantum circuit files++-- A longer description of the package.+description:        A Haskell library for parsing STIM quantum circuit files into an AST.+                    STIM is a file format for describing quantum stabilizer circuits.+                    This library provides parsers for gates, measurements, noise channels,+                    annotations, and complete STIM circuits.++-- The license under which the package is released.+license:            MIT++-- Package category (Parsing, Physics, Quantum)+category:           Parsing, Physics++-- The package author(s).+author:             le.niu++-- An email address to which users can send suggestions, bug reports, and patches.+maintainer:         le.niu@hotmail.com++-- A copyright notice.+-- copyright:+build-type:         Simple++-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.+extra-doc-files:    CHANGELOG.md++-- Extra source files to be distributed with the package, such as examples, or a tutorial module.+-- extra-source-files:++common warnings+    ghc-options: -Wall++library+    import:           warnings+    default-language: Haskell2010+    hs-source-dirs:   src+    build-depends:    +        base                 >= 4.11.0.0 && < 4.22+      , unordered-containers >= 0.2.8    && < 0.3+      , containers           >= 0.5     && < 0.8+      , megaparsec           >= 8.0.0   && < 10+      , mtl                  >= 2.2.2   && < 2.4+    -- other-modules:+    --    ParseUtils+    exposed-modules:     +        StimParser.Expr+      , StimParser.Parse+      , StimParser.ParseUtils+      , StimParser.Trans+    ++executable stim-parser-unit-example+    -- Import common warning flags.+    import:           warnings++    -- .hs or .lhs file containing the Main module.+    main-is:          Example.hs++    -- Modules included in this executable, other than Main.+    -- other-modules:++    -- LANGUAGE extensions used by modules in this package.+    -- other-extensions:++    -- Other library packages from which modules are imported.+    build-depends:    +        base                 >= 4.11.0.0 && < 4.22+      , stim-parser++    -- Directories containing source files.+    hs-source-dirs:   app++    -- Base language which the package is written in.+    default-language: Haskell2010++executable stim-parser-example+    -- Import common warning flags.+    import:           warnings++    -- .hs or .lhs file containing the Main module.+    main-is:          Main.hs++    -- Modules included in this executable, other than Main.+    -- other-modules:++    -- LANGUAGE extensions used by modules in this package.+    -- other-extensions:++    -- Other library packages from which modules are imported.+    build-depends:    +        base                 >= 4.11.0.0 && < 4.22+      , stim-parser++    -- Directories containing source files.+    hs-source-dirs:   app++    -- Base language which the package is written in.+    default-language: Haskell2010++test-suite stim-parser-test+    import:           warnings+    default-language: Haskell2010+    type:             exitcode-stdio-1.0+    hs-source-dirs:   test+    main-is:          Main.hs+    other-modules:    Test.Expr+                    , Test.ParseUtils+                    , Test.Parse+                    , Test.Trans+    build-depends:    base                 >= 4.11.0.0 && < 4.22+                    , stim-parser+                    , HUnit              >= 1.6     && < 1.7+                    , mtl                >= 2.2.2   && < 2.4+                    , megaparsec         >= 8.0.0   && < 10++source-repository head+    type:     git+    location: https://github.com/overshiki/stim-parser.git
+ test/Main.hs view
@@ -0,0 +1,24 @@+module Main where++import Test.HUnit+import System.Exit (exitFailure, exitSuccess)++import qualified Test.Expr as Expr+import qualified Test.ParseUtils as ParseUtils+import qualified Test.Parse as Parse+import qualified Test.Trans as Trans++main :: IO ()+main = do+  counts <- runTestTT tests+  if errors counts + failures counts == 0+    then exitSuccess+    else exitFailure++tests :: Test+tests = TestList+  [ Expr.tests+  , ParseUtils.tests+  , Parse.tests+  , Trans.tests+  ]
+ test/Test/Expr.hs view
@@ -0,0 +1,22 @@+module Test.Expr where++import Test.HUnit+import StimParser.Expr++tests :: Test+tests = TestList+  [ testFIndNumInstance+  ]+++-- Test FInd Num instance (compare using show since no Eq instance)+testFIndNumInstance :: Test+testFIndNumInstance = TestCase $ do+  -- Test In + In+  assertEqual "In + In" (show (In 3)) (show (In 1 + In 2))+  -- Test Fl + Fl+  assertEqual "Fl + Fl" (show (Fl 3.5)) (show (Fl 1.5 + Fl 2.0))+  -- Test In + Fl+  assertEqual "In + Fl" (show (Fl 3.5)) (show (In 1 + Fl 2.5))+  -- Test Fl + In+  assertEqual "Fl + In" (show (Fl 3.5)) (show (Fl 1.5 + In 2))
+ test/Test/Parse.hs view
@@ -0,0 +1,273 @@+module Test.Parse where++import Test.HUnit+import StimParser.Parse+import StimParser.ParseUtils (run)+import StimParser.Expr++tests :: Test+tests = TestList+  [ testParsePauli+  , testParsePauliInd+  , testParsePauliChain+  , testParseQ+  , testParseGateTy+  , testParseGate+  , testParseMeasureTy+  , testParsePh+  , testParseMeasure+  , testParseGppTy+  , testParseGpp+  , testParseNoiseTy+  , testParseErrorTag+  , testParseNoise+  , testParseAnnTy+  , testParseFInd+  , testParseAnn+  ]++-- Helper to compare using show (since types don't derive Eq)+assertShowEqual :: (Show a) => String -> a -> a -> Test+assertShowEqual name expected actual = +  TestCase $ assertEqual name (show expected) (show actual)++-- Test Pauli parsing+testParsePauli :: Test+testParsePauli = TestList+  [ assertShowEqual "parsePauli X" PX (run parsePauli "X")+  , assertShowEqual "parsePauli Y" PY (run parsePauli "Y")+  , assertShowEqual "parsePauli Z" PZ (run parsePauli "Z")+  ]++-- Test PauliInd parsing+testParsePauliInd :: Test+testParsePauliInd = TestList+  [ assertShowEqual "parsePauliInd X0" (PauliInd PX 0) (run parsePauliInd "X0")+  , assertShowEqual "parsePauliInd Y5" (PauliInd PY 5) (run parsePauliInd "Y5")+  , assertShowEqual "parsePauliInd Z10" (PauliInd PZ 10) (run parsePauliInd "Z10")+  ]++-- Test PauliChain parsing+testParsePauliChain :: Test+testParsePauliChain = TestList+  [ assertShowEqual "parsePauliChain simple" +      (P [PauliInd PX 1]) (run parsePauliChain "X1")+  , assertShowEqual "parsePauliChain with *" +      (P [PauliInd PX 1, PauliInd PX 2]) (run parsePauliChain "X1*X2")+  , assertShowEqual "parsePauliChain multiple" +      (P [PauliInd PX 1, PauliInd PY 2, PauliInd PZ 3]) (run parsePauliChain "X1*Y2*Z3")+  , assertShowEqual "parsePauliChain negated" +      (N [PauliInd PZ 5]) (run parsePauliChain "!Z5")+  , assertShowEqual "parsePauliChain negated multiple" +      (N [PauliInd PX 1, PauliInd PZ 2]) (run parsePauliChain "!X1*Z2")+  ]++-- Test Q parsing+testParseQ :: Test+testParseQ = TestList+  [ assertShowEqual "parseQ simple" (Q 5) (run parseQ "5")+  , assertShowEqual "parseQ rec" (QRec (Rec (-1))) (run parseQ "rec[-1]")+  , assertShowEqual "parseQ rec negative" (QRec (Rec (-5))) (run parseQ "rec[-5]")+  , assertShowEqual "parseQ sweep" (QSweep (Sweep 5)) (run parseQ "sweep[5]")+  , assertShowEqual "parseQ not" (Not 3) (run parseQ "!3")+  -- Note: rec[5] and rec[0] should fail - they are tested via parse failure tests+  ]++-- Test GateTy parsing+testParseGateTy :: Test+testParseGateTy = TestList+  [ assertShowEqual "parseGateTy I" I (run parseGateTy "I")+  , assertShowEqual "parseGateTy X" X (run parseGateTy "X")+  , assertShowEqual "parseGateTy H" H (run parseGateTy "H")+  , assertShowEqual "parseGateTy CNOT" CNOT (run parseGateTy "CNOT")+  , assertShowEqual "parseGateTy SQRT_X" SQRT_X (run parseGateTy "SQRT_X")+  , assertShowEqual "parseGateTy ISWAP_DAG" ISWAP_DAG (run parseGateTy "ISWAP_DAG")+  -- Case-insensitive tests+  , assertShowEqual "parseGateTy lowercase cnot" CNOT (run parseGateTy "cnot")+  , assertShowEqual "parseGateTy mixed case Cnot" CNOT (run parseGateTy "Cnot")+  , assertShowEqual "parseGateTy lowercase h" H (run parseGateTy "h")+  , assertShowEqual "parseGateTy lowercase sqrt_x" SQRT_X (run parseGateTy "sqrt_x")+  , assertShowEqual "parseGateTy mixed case Sqrt_X_Dag" SQRT_X_DAG (run parseGateTy "Sqrt_X_Dag")+  ]++-- Test Gate parsing+testParseGate :: Test+testParseGate = TestList+  [ assertShowEqual "parseGate single qubit" +      (Gate X Nothing [Q 0]) (run parseGate "X 0")+  , assertShowEqual "parseGate multiple qubits" +      (Gate H Nothing [Q 0, Q 1, Q 2]) (run parseGate "H 0 1 2")+  , assertShowEqual "parseGate with rec" +      (Gate CY Nothing [QRec (Rec (-1)), Q 6]) (run parseGate "CY rec[-1] 6")+  , assertShowEqual "parseGate with sweep" +      (Gate CY Nothing [QSweep (Sweep 5), Q 7, QSweep (Sweep 5), Q 8]) (run parseGate "CY sweep[5] 7 sweep[5] 8")+  , assertShowEqual "parseGate with not" +      (Gate X Nothing [Not 1, Q 2]) (run parseGate "X !1 2")+  ]++-- Test MeasureTy parsing+testParseMeasureTy :: Test+testParseMeasureTy = TestList+  [ assertShowEqual "parseMeasureTy M" M (run parseMeasureTy "M")+  , assertShowEqual "parseMeasureTy MX" MX (run parseMeasureTy "MX")+  , assertShowEqual "parseMeasureTy MXX" MXX (run parseMeasureTy "MXX")+  , assertShowEqual "parseMeasureTy MR" MR (run parseMeasureTy "MR")+  -- Case-insensitive tests+  , assertShowEqual "parseMeasureTy lowercase m" M (run parseMeasureTy "m")+  , assertShowEqual "parseMeasureTy lowercase mx" MX (run parseMeasureTy "mx")+  , assertShowEqual "parseMeasureTy lowercase mxx" MXX (run parseMeasureTy "mxx")+  , assertShowEqual "parseMeasureTy mixed case Mr" MR (run parseMeasureTy "Mr")+  ]++-- Test Ph (phase) parsing+testParsePh :: Test+testParsePh = TestList+  [ "parsePh float" ~: 0.02 ~=? run parsePh "(0.02)"+  , "parsePh negative" ~: (-0.5) ~=? run parsePh "(-0.5)"+  ]++-- Test Measure parsing+testParseMeasure :: Test+testParseMeasure = TestList+  [ assertShowEqual "parseMeasure simple" +      (Measure M Nothing Nothing [Q 5]) (run parseMeasure "M 5")+  , assertShowEqual "parseMeasure with phase" +      (Measure MZ Nothing (Just 0.02) [Q 2, Q 3, Q 5]) (run parseMeasure "MZ(0.02) 2 3 5")+  , assertShowEqual "parseMeasure pair" +      (Measure MXX Nothing Nothing [Q 1, Q 2]) (run parseMeasure "MXX 1 2")+  -- Case-insensitive tests+  , assertShowEqual "parseMeasure lowercase m" +      (Measure M Nothing Nothing [Q 5]) (run parseMeasure "m 5")+  , assertShowEqual "parseMeasure lowercase mz" +      (Measure MZ Nothing (Just 0.02) [Q 2]) (run parseMeasure "mz(0.02) 2")+  , assertShowEqual "parseMeasure pair with phase" +      (Measure MXX Nothing (Just 0.01) [Q 2, Q 3]) (run parseMeasure "MXX(0.01) 2 3")+  , assertShowEqual "parseMeasure with not" +      (Measure MZ Nothing Nothing [Not 5]) (run parseMeasure "MZ !5")+  ]++-- Test GppTy parsing+testParseGppTy :: Test+testParseGppTy = TestList+  [ assertShowEqual "parseGppTy MPP" MPP (run parseGppTy "MPP")+  , assertShowEqual "parseGppTy SPP" SPP (run parseGppTy "SPP")+  , assertShowEqual "parseGppTy SPP_DAG" SPP_DAG (run parseGppTy "SPP_DAG")+  ]++-- Test Gpp parsing+testParseGpp :: Test+testParseGpp = TestList+  [ assertShowEqual "parseGpp simple" +      (Gpp MPP Nothing Nothing [P [PauliInd PX 2, PauliInd PX 3, PauliInd PX 5, PauliInd PX 7]]) +      (run parseGpp "MPP X2*X3*X5*X7")+  , assertShowEqual "parseGpp with negation" +      (Gpp MPP Nothing Nothing [N [PauliInd PZ 5]]) +      (run parseGpp "MPP !Z5")+  , assertShowEqual "parseGpp with phase" +      (Gpp MPP Nothing (Just 0.001) [P [PauliInd PZ 1, PauliInd PZ 2], P [PauliInd PX 1, PauliInd PX 2]]) +      (run parseGpp "MPP(0.001) Z1*Z2 X1*X2")+  , assertShowEqual "parseGpp mixed" +      (Gpp SPP Nothing Nothing [N [PauliInd PX 1, PauliInd PY 2, PauliInd PZ 3]]) +      (run parseGpp "SPP !X1*Y2*Z3")+  ]++-- Test NoiseTy parsing+testParseNoiseTy :: Test+testParseNoiseTy = TestList+  [ assertShowEqual "parseNoiseTy E" E (run parseNoiseTy "E")+  , assertShowEqual "parseNoiseTy X_ERROR" X_ERROR (run parseNoiseTy "X_ERROR")+  , assertShowEqual "parseNoiseTy DEPOLARIZE1" DEPOLARIZE1 (run parseNoiseTy "DEPOLARIZE1")+  , assertShowEqual "parseNoiseTy CORRELATED_ERROR" CORRELATED_ERROR (run parseNoiseTy "CORRELATED_ERROR")+  ]++-- Test ErrorTag parsing+testParseErrorTag :: Test+testParseErrorTag = TestList+  [ assertShowEqual "parseErrorTag simple" +      (ErrorTag MULTIPLE_NOISE_MECHANISMS) (run parseErrorTag "MULTIPLE_NOISE_MECHANISMS")+  , assertShowEqual "parseErrorTag with coef" +      (ErrorTagCoef LEAKAGE_NOISE_FOR_AN_ADVANCED_SIMULATOR 0.1) +      (run parseErrorTag "LEAKAGE_NOISE_FOR_AN_ADVANCED_SIMULATOR:0.1")+  ]++-- Test Noise parsing with all tag/arg combinations+testParseNoise :: Test+testParseNoise = TestList+  -- Basic noise without tag+  [ assertShowEqual "parseNoise X_ERROR with args" +      (NoiseNormal X_ERROR Nothing Nothing [0.01] [Q 5]) +      (run parseNoise "X_ERROR(0.01) 5")+  , assertShowEqual "parseNoise DEPOLARIZE1" +      (NoiseNormal DEPOLARIZE1 Nothing Nothing [0.01] [Q 2,Q 3]) +      (run parseNoise "DEPOLARIZE1(0.01) 2 3")+  -- II_ERROR variants+  , assertShowEqual "parseNoise II_ERROR no args no tag" +      (NoiseNormal II_ERROR Nothing Nothing [] [Q 0,Q 1]) +      (run parseNoise "II_ERROR 0 1")+  , assertShowEqual "parseNoise II_ERROR args no tag" +      (NoiseNormal II_ERROR Nothing Nothing [0.1] [Q 0,Q 1]) +      (run parseNoise "II_ERROR(0.1) 0 1")+  , assertShowEqual "parseNoise II_ERROR ErrorTag no args" +      (NoiseNormal II_ERROR Nothing (Just (ErrorTag TWO_QUBIT_LEAKAGE_NOISE_FOR_AN_ADVANCED_SIMULATOR)) [] [Q 0,Q 1]) +      (run parseNoise "II_ERROR[TWO_QUBIT_LEAKAGE_NOISE_FOR_AN_ADVANCED_SIMULATOR] 0 1")+  , assertShowEqual "parseNoise II_ERROR ErrorTag coef no args" +      (NoiseNormal II_ERROR Nothing (Just (ErrorTagCoef TWO_QUBIT_LEAKAGE_NOISE_FOR_AN_ADVANCED_SIMULATOR 0.1)) [] [Q 0,Q 1]) +      (run parseNoise "II_ERROR[TWO_QUBIT_LEAKAGE_NOISE_FOR_AN_ADVANCED_SIMULATOR:0.1] 0 1")+  , assertShowEqual "parseNoise II_ERROR ErrorTag with args" +      (NoiseNormal II_ERROR Nothing (Just (ErrorTag MULTIPLE_TWO_QUBIT_NOISE_MECHANISMS)) [0.1,0.2] [Q 0,Q 1]) +      (run parseNoise "II_ERROR[MULTIPLE_TWO_QUBIT_NOISE_MECHANISMS](0.1, 0.2) 0 1")+  , assertShowEqual "parseNoise II_ERROR ErrorTag coef with args" +      (NoiseNormal II_ERROR Nothing (Just (ErrorTagCoef MULTIPLE_TWO_QUBIT_NOISE_MECHANISMS 0.5)) [0.1,0.2] [Q 0,Q 1]) +      (run parseNoise "II_ERROR[MULTIPLE_TWO_QUBIT_NOISE_MECHANISMS:0.5](0.1, 0.2) 0 1")+  -- I_ERROR variants+  , assertShowEqual "parseNoise I_ERROR no args no tag" +      (NoiseNormal I_ERROR Nothing Nothing [] [Q 0]) +      (run parseNoise "I_ERROR 0")+  , assertShowEqual "parseNoise I_ERROR args no tag" +      (NoiseNormal I_ERROR Nothing Nothing [0.1] [Q 0]) +      (run parseNoise "I_ERROR(0.1) 0")+  -- CORRELATED_ERROR (NoiseE type)+  , assertShowEqual "parseNoise CORRELATED_ERROR" +      (NoiseE CORRELATED_ERROR Nothing 0.2 [PauliInd PX 1,PauliInd PY 2]) +      (run parseNoise "CORRELATED_ERROR(0.2) X1 Y2")+  , assertShowEqual "parseNoise E (alias)" +      (NoiseE E Nothing 0.15 [PauliInd PZ 3]) +      (run parseNoise "E(0.15) Z3")+  ]++-- Test AnnTy parsing+testParseAnnTy :: Test+testParseAnnTy = TestList+  [ assertShowEqual "parseAnnTy DETECTOR" DETECTOR (run parseAnnTy "DETECTOR")+  , assertShowEqual "parseAnnTy TICK" TICK (run parseAnnTy "TICK")+  , assertShowEqual "parseAnnTy SHIFT_COORDS" SHIFT_COORDS (run parseAnnTy "SHIFT_COORDS")+  , assertShowEqual "parseAnnTy QUBIT_COORDS" QUBIT_COORDS (run parseAnnTy "QUBIT_COORDS")+  ]++-- Test FInd parsing+testParseFInd :: Test+testParseFInd = TestList+  [ assertShowEqual "parseFInd Int" (In 5) (run parseFInd "5")+  , assertShowEqual "parseFInd Float" (Fl 3.14) (run parseFInd "3.14")+  , assertShowEqual "parseFInd negative Int" (In (-3)) (run parseFInd "-3")+  , assertShowEqual "parseFInd negative Float" (Fl (-2.5)) (run parseFInd "-2.5")+  ]++-- Test Ann parsing+testParseAnn :: Test+testParseAnn = TestList+  [ assertShowEqual "parseAnn TICK" +      (Ann TICK Nothing [] []) (run parseAnn "TICK")+  , assertShowEqual "parseAnn DETECTOR with coords and rec" +      (Ann DETECTOR Nothing [In 1, In 0] [QRec (Rec (-3)), QRec (Rec (-6))]) +      (run parseAnn "DETECTOR(1, 0) rec[-3] rec[-6]")+  , assertShowEqual "parseAnn DETECTOR without coords" +      (Ann DETECTOR Nothing [] [QRec (Rec (-3)), QRec (Rec (-4))]) +      (run parseAnn "DETECTOR rec[-3] rec[-4]")+  , assertShowEqual "parseAnn SHIFT_COORDS" +      (Ann SHIFT_COORDS Nothing [Fl 500.5] []) +      (run parseAnn "SHIFT_COORDS(500.5)")+  , assertShowEqual "parseAnn OBSERVABLE_INCLUDE" +      (Ann OBSERVABLE_INCLUDE Nothing [In 0] [QRec (Rec (-1))]) +      (run parseAnn "OBSERVABLE_INCLUDE(0) rec[-1]")+  ]
+ test/Test/ParseUtils.hs view
@@ -0,0 +1,51 @@+module Test.ParseUtils where++import Test.HUnit+import Text.Megaparsec (runParser)+import StimParser.ParseUtils++tests :: Test+tests = TestList+  [ testParseInt+  , testParseFloat+  , testRunParser+  ]++-- Test parseInt with various inputs+testParseInt :: Test+testParseInt = TestCase $ do+  -- Test positive integer+  case runParser parseInt "" "42" of+    Right r -> assertEqual "parseInt positive" 42 r+    Left _ -> assertFailure "parseInt should parse positive integer"+  -- Test negative integer+  case runParser parseInt "" "-42" of+    Right r -> assertEqual "parseInt negative" (-42) r+    Left _ -> assertFailure "parseInt should parse negative integer"+  -- Test with whitespace+  case runParser parseInt "" "123  " of+    Right r -> assertEqual "parseInt with spaces" 123 r+    Left _ -> assertFailure "parseInt should handle whitespace"++-- Test parseFloat with various inputs+testParseFloat :: Test+testParseFloat = TestCase $ do+  -- Test positive float+  case runParser parseFloat "" "3.14" of+    Right r -> assertEqual "parseFloat positive" 3.14 r+    Left _ -> assertFailure "parseFloat should parse positive float"+  -- Test negative float+  case runParser parseFloat "" "-3.14" of+    Right r -> assertEqual "parseFloat negative" (-3.14) r+    Left _ -> assertFailure "parseFloat should parse negative float"+  -- Test scientific notation+  case runParser parseFloat "" "1.5e2" of+    Right r -> assertEqual "parseFloat scientific" 150.0 r+    Left _ -> assertFailure "parseFloat should parse scientific notation"++-- Test run helper function+testRunParser :: Test+testRunParser = TestList+  [ "run parseInt" ~: 42 ~=? run parseInt "42"+  , "run parseFloat" ~: 3.14 ~=? run parseFloat "3.14"+  ]
+ test/Test/Trans.hs view
@@ -0,0 +1,113 @@+module Test.Trans where++import Test.HUnit+import Control.Monad.State.Lazy (evalState, runState)++import StimParser.Trans+import StimParser.Expr++tests :: Test+tests = TestList+  [ testFlattenQQ+  , testFlattenQGate+  , testFlattenQMeasure+  , testFlattenQGpp+  , testFlattenQNoise+  , testFlattenQAnn+  , testFlattenQStim+  ]++-- Helper to compare using show (since types don't derive Eq)+assertShowEqual :: (Show a) => String -> a -> a -> Test+assertShowEqual name expected actual = +  TestCase $ assertEqual name (show expected) (show actual)++-- Test FlattenQ instance for Q+testFlattenQQ :: Test+testFlattenQQ = TestList+  [ assertShowEqual "flattenQ Q simple" +      (Q 5) (evalState (flattenQ (Q 5)) (0, Coords [In 0]))+  , assertShowEqual "flattenQ QRec with count 0" +      (Q 0) (evalState (flattenQ (QRec (Rec (-1)))) (0, Coords [In 0]))+  , assertShowEqual "flattenQ QRec with count 5" +      (Q 5) (evalState (flattenQ (QRec (Rec (-1)))) (5, Coords [In 0]))+  , assertShowEqual "flattenQ QRec rec[-3] with count 10" +      (Q 8) (evalState (flattenQ (QRec (Rec (-3)))) (10, Coords [In 0]))+  ]++-- Test FlattenQ instance for Gate+testFlattenQGate :: Test+testFlattenQGate = TestList+  [ assertShowEqual "flattenQ Gate simple" +      (Gate X Nothing [Q 0, Q 1]) (evalState (flattenQ (Gate X Nothing [Q 0, Q 1])) (0, Coords [In 0]))+  , assertShowEqual "flattenQ Gate with rec" +      (Gate X Nothing [Q 10, Q 9]) (evalState (flattenQ (Gate X Nothing [QRec (Rec (-1)), QRec (Rec (-2))])) (10, Coords [In 0]))+  ]++-- Test FlattenQ instance for Measure+testFlattenQMeasure :: Test+testFlattenQMeasure = TestCase $ do+  -- Test that count is updated+  let (result, (count, _)) = runState (flattenQ (Measure M Nothing Nothing [Q 0, Q 1])) (0, Coords [In 0])+  assertEqual "count increased by 2" 2 count+  assertEqual "result unchanged" (show (Measure M Nothing Nothing [Q 0, Q 1])) (show result)+  +  -- Test single qubit+  let (_, (count2, _)) = runState (flattenQ (Measure MX Nothing Nothing [Q 0])) (5, Coords [In 0])+  assertEqual "count increased to 6" 6 count2++-- Test FlattenQ instance for Gpp+testFlattenQGpp :: Test+testFlattenQGpp = TestCase $ do+  let (result, (count, _)) = runState (flattenQ (Gpp MPP Nothing Nothing [P [PauliInd PX 1]])) (0, Coords [In 0])+  assertEqual "count increased by 1" 1 count+  assertEqual "result unchanged" (show (Gpp MPP Nothing Nothing [P [PauliInd PX 1]])) (show result)++-- Test FlattenQ instance for Noise+testFlattenQNoise :: Test+testFlattenQNoise = TestList+  [ assertShowEqual "flattenQ NoiseNormal simple" +      (NoiseNormal X_ERROR Nothing Nothing [0.01] [Q 0, Q 1]) +      (evalState (flattenQ (NoiseNormal X_ERROR Nothing Nothing [0.01] [Q 0, Q 1])) (0, Coords [In 0]))+  , assertShowEqual "flattenQ NoiseNormal with rec" +      (NoiseNormal X_ERROR Nothing Nothing [0.01] [Q 10, Q 9]) +      (evalState (flattenQ (NoiseNormal X_ERROR Nothing Nothing [0.01] [QRec (Rec (-1)), QRec (Rec (-2))])) (10, Coords [In 0]))+  , assertShowEqual "flattenQ NoiseE" +      (NoiseE CORRELATED_ERROR Nothing 0.2 [PauliInd PX 1, PauliInd PZ 2]) +      (evalState (flattenQ (NoiseE CORRELATED_ERROR Nothing 0.2 [PauliInd PX 1, PauliInd PZ 2])) (0, Coords [In 0]))+  ]++-- Test FlattenQ instance for Ann+testFlattenQAnn :: Test+testFlattenQAnn = TestList+  [ assertShowEqual "flattenQ Ann TICK" +      (Just (Ann TICK Nothing [] [])) (evalState (flattenQ (Ann TICK Nothing [] [])) (0, Coords [In 0]))+  , assertShowEqual "flattenQ Ann DETECTOR" +      (Just (Ann DETECTOR Nothing [In 1, In 0] [Q 10])) +      (evalState (flattenQ (Ann DETECTOR Nothing [In 1, In 0] [Q 10])) (10, Coords [In 0, In 0]))+  ]+  -- Note: SHIFT_COORDS test moved to separate test case++-- Test FlattenQ instance for Stim+testFlattenQStim :: Test+testFlattenQStim = TestList+  [ assertShowEqual "flattenQ StimG" +      (Just (StimG (Gate X Nothing [Q 0]))) +      (evalState (flattenQ (StimG (Gate X Nothing [Q 0]))) (0, Coords [In 0]))+  , TestCase $ do+      let (result, (count, _)) = runState (flattenQ (StimM (Measure M Nothing Nothing [Q 0, Q 1]))) (0, Coords [In 0])+      assertEqual "count increased by 2" 2 count+      assertEqual "result" (show (Just (StimM (Measure M Nothing Nothing [Q 0, Q 1])))) (show result)+  , assertShowEqual "flattenQ StimList" +      (Just (StimList [StimG (Gate X Nothing [Q 0]), StimG (Gate Y Nothing [Q 1])])) +      (evalState (flattenQ (StimList [StimG (Gate X Nothing [Q 0]), StimG (Gate Y Nothing [Q 1])])) (0, Coords [In 0]))+  , TestCase $ do+      let (result, (count, _)) = runState (flattenQ (StimRepeat 2 (StimM (Measure M Nothing Nothing [Q 0])))) (0, Coords [In 0])+      assertEqual "count increased by 2" 2 count+      case result of+        Just (StimList ms) -> assertEqual "result has 2 elements" 2 (length ms)+        _ -> assertFailure "Expected Just (StimList _)"+  , assertShowEqual "flattenQ StimAnn SHIFT_COORDS returns Nothing" +      (Nothing :: Maybe Stim) +      (evalState (flattenQ (StimAnn (Ann SHIFT_COORDS Nothing [In 1] []))) (0, Coords [In 0]))+  ]