Last active
March 12, 2023 06:21
-
-
Save ijaketak/7ea6bf3f509250b6d9739216e546f144 to your computer and use it in GitHub Desktop.
Parsing mixfix operators
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE OverloadedStrings #-} | |
{-# LANGUAGE TemplateHaskell #-} | |
module Language.Parser where | |
import Control.Applicative | |
import Control.Lens | |
import Control.Monad | |
import Data.Either | |
import Data.Function (on) | |
import Data.Maybe (fromJust, fromMaybe, isNothing, maybeToList) | |
import qualified Data.Map as M | |
import Data.Text (Text) | |
import qualified Data.Text as T | |
import qualified Data.Text.IO as T | |
zigzag :: [a] -> [a] -> [a] | |
zigzag [] _ = [] | |
zigzag (x:xs) ys = x : zigzag ys xs | |
data OpType | |
= OpType'Closed | |
| OpType'OpenBoth | |
| OpType'OpenLeft | |
| OpType'OpenRight | |
deriving (Enum, Eq, Show) | |
data OpAssocs | |
= OpAssocs'None | |
| OpAssocs'Left | |
| OpAssocs'Right | |
deriving (Enum, Eq, Show) | |
data Op = Op | |
{ _opSymbol :: Either Text [Text] | |
, _opPrefix :: Maybe Text | |
, _opPostfix :: Maybe Text | |
, _opRank :: Int | |
, _opAssocs :: OpAssocs | |
} | |
deriving (Eq, Show) | |
$(makeLenses ''Op) | |
opNum :: Op -> Maybe Int | |
opNum o = case _opSymbol o of | |
Left _ -> Nothing | |
Right ss -> Just $ length ss + 1 | |
opType :: Op -> OpType | |
opType o = case (_opPrefix o, _opPostfix o) of | |
(Nothing, Nothing) -> OpType'OpenBoth | |
(Nothing, Just _) -> OpType'OpenLeft | |
(Just _, Nothing) -> OpType'OpenRight | |
(Just _, Just _) -> OpType'Closed | |
opOpenLeft :: Op -> Bool | |
opOpenLeft o = opType o `elem` [OpType'OpenBoth, OpType'OpenLeft] | |
opOpenRight :: Op -> Bool | |
opOpenRight o = opType o `elem` [OpType'OpenBoth, OpType'OpenRight] | |
opClosedLeft :: Op -> Bool | |
opClosedLeft o = opType o `elem` [OpType'Closed, OpType'OpenRight] | |
opClosedRight :: Op -> Bool | |
opClosedRight o = opType o `elem` [OpType'Closed, OpType'OpenLeft] | |
opIsDelimiter :: Op -> Bool | |
opIsDelimiter o = isNothing (opNum o) | |
opCondByNum :: Op -> Bool -> Int -> Bool | |
opCondByNum o b x = case opNum o of | |
Nothing -> b | |
Just n -> n == x | |
validOp :: Op -> Bool | |
validOp o = opType o /= OpType'Closed || _opAssocs o == OpAssocs'None | |
type OpsMap = M.Map Text (Either (Bool, Op) (Int, Op)) | |
type DelimitersMap = M.Map Text Op | |
opsMapFromList :: [Op] -> OpsMap | |
opsMapFromList = foldl opsMapAdd M.empty | |
opsMapAdd :: OpsMap -> Op -> OpsMap | |
opsMapAdd ops o = foldl (\m (k, v) -> M.insert k v m) ops $ pre ++ post ++ ss | |
where | |
pre = map (\s -> (s, Left (False, o))) $ maybeToList $ _opPrefix o | |
post = map (\s -> (s, Left (True, o))) $ maybeToList $ _opPostfix o | |
ss = fromMaybe [] $ fmap f $ o ^? opSymbol . _Right | |
where | |
f ns = flip map (zip [1..] ns) $ \(i, s) -> (s, Right (i, o)) | |
delimitersMapFromList :: [Op] -> DelimitersMap | |
delimitersMapFromList = foldl delimitersMapAdd M.empty | |
delimitersMapAdd :: DelimitersMap -> Op -> DelimitersMap | |
delimitersMapAdd ds o = case o ^? opSymbol . _Left of | |
Nothing -> ds | |
Just s -> M.insert s o ds | |
data Expr | |
= Expr'Var Text | |
| Expr'Op Op [Expr] | |
| Expr'Fn Expr [Expr] | |
deriving (Eq, Show) | |
validExpr :: Expr -> Bool | |
validExpr (Expr'Var _) = True | |
validExpr (Expr'Op o es) = opCondByNum o True (length es) && all validExpr es | |
validExpr (Expr'Fn e es) = validExpr e && all validExpr es | |
debugExpr :: Expr -> Text | |
debugExpr (Expr'Var i) = i | |
debugExpr (Expr'Op o es) = if opType o /= OpType'Closed | |
then "❪" <> pre <> mconcat ts <> post <> "❫" | |
else pre <> mconcat ts <> post | |
where | |
pre = case _opPrefix o of { Nothing -> mempty; Just s -> s } | |
post = case _opPostfix o of { Nothing -> mempty; Just s -> s } | |
ds = map debugExpr es | |
ts = zigzag ds $ case _opSymbol o of | |
Left d -> flip replicate d $ pred $ length es | |
Right ss -> ss | |
debugExpr (Expr'Fn e es) = mconcat $ zigzag (map debugExpr $ e : es) $ flip replicate " " $ length es | |
data Token | |
= Token'Var Text | |
| Token'Op Int Op | |
| Token'OpPrefix Op | |
| Token'OpPostfix Op | |
| Token'Delimiter Op | |
deriving (Eq, Show) | |
tokenize :: (OpsMap, DelimitersMap) -> Text -> Token | |
tokenize (om, dm) t = case M.lookup t om of | |
Nothing -> case M.lookup t dm of | |
Nothing -> Token'Var t | |
Just o -> Token'Delimiter o | |
Just (Right (i, o)) -> Token'Op i o | |
Just (Left (False, o)) -> Token'OpPrefix o | |
Just (Left (True, o)) -> Token'OpPostfix o | |
showToken :: Token -> Text | |
showToken (Token'Var i) = i | |
showToken (Token'Op i o) = fromRight [] (_opSymbol o) !! i | |
showToken (Token'OpPrefix o) = fromJust $ _opPrefix o | |
showToken (Token'OpPostfix o) = fromJust $ _opPostfix o | |
showToken (Token'Delimiter o) = fromLeft mempty $ _opSymbol o | |
-- variable and function is not partial expr. | |
-- arg list holds by reversed way | |
-- Left False: previous token is not operator symbol | |
-- Left True: previous token is operator symbol | |
-- Right pe: last term with partial expr | |
data PartialExpr | |
= PartialExpr'Op Op [Expr] (Either Bool PartialExpr) | |
| PartialExpr'Fn Expr [Expr] PartialExpr | |
deriving (Eq, Show) | |
startPartialExpr :: Token -> Maybe (Either PartialExpr Expr) | |
startPartialExpr (Token'Var i) = Just $ Right $ Expr'Var i | |
startPartialExpr (Token'Op i o) = Nothing | |
startPartialExpr (Token'OpPrefix o) = do | |
guard $ opClosedLeft o | |
return $ Left $ PartialExpr'Op o [] $ Left True | |
startPartialExpr (Token'OpPostfix _) = Nothing | |
startPartialExpr (Token'Delimiter _) = Nothing | |
nextPartialExpr :: Token -> Either PartialExpr Expr -> Maybe (Either PartialExpr Expr) | |
nextPartialExpr (Token'Var i) (Left (PartialExpr'Op o e0es (Left False))) = do | |
let e0 = head e0es | |
es = tail e0es | |
e = embedExpr i e0 | |
return $ Left $ PartialExpr'Op o (e : es) $ Left False | |
nextPartialExpr (Token'Var i) (Left (PartialExpr'Op o es (Left True))) = | |
Just $ if opCondByNum o True (succ $ length es) && opOpenRight o | |
then Right $ Expr'Op o $ reverse $ Expr'Var i : es | |
else Left $ PartialExpr'Op o (Expr'Var i : es) $ Left False | |
nextPartialExpr (Token'Var i) (Right e) = | |
Just $ Right $ embedExpr i e | |
nextPartialExpr (Token'Op j o2) epe@(Left (PartialExpr'Op o1 es (Left False))) = | |
if o2 == o1 && j == length es | |
then Just $ Left $ PartialExpr'Op o1 es $ Left True | |
else do | |
guard $ j == 1 && opOpenLeft o2 | |
composePartialExpr o2 epe | |
nextPartialExpr (Token'Op j o2) (Left (PartialExpr'Op o1 es (Left True))) = Nothing | |
nextPartialExpr (Token'Op j o) epe@(Right e) = do | |
guard $ j == 1 && opOpenLeft o | |
composePartialExpr o epe | |
nextPartialExpr (Token'OpPrefix o2) (Left (PartialExpr'Op o1 e0es (Left False))) = do | |
let e0 = head e0es | |
es = tail e0es | |
pe = embedOpPrefixExpr o2 e0 | |
return $ Left $ PartialExpr'Op o1 es $ Right pe | |
nextPartialExpr (Token'OpPrefix o2) (Left (PartialExpr'Op o1 es (Left True))) = | |
Just $ Left $ PartialExpr'Op o1 es $ Right $ PartialExpr'Op o2 [] $ Left True | |
nextPartialExpr (Token'OpPrefix o) (Right e) = | |
Just $ Left $ embedOpPrefixExpr o e | |
nextPartialExpr (Token'OpPostfix o2) epe@(Left (PartialExpr'Op o1 es (Left False))) = do | |
if o1 == o2 | |
then do | |
guard $ opCondByNum o1 True (length es) && opClosedRight o1 | |
return $ Right $ Expr'Op o1 $ reverse es | |
else do | |
guard $ opCondByNum o2 False 1 && opOpenLeft o2 | |
composePartialExpr o2 epe | |
nextPartialExpr (Token'OpPostfix o2) (Left (PartialExpr'Op o1 es (Left True))) = do | |
guard $ null es | |
guard $ o1 == o2 | |
guard $ opIsDelimiter o1 && opClosedLeft o1 && opClosedRight o1 | |
return $ Right $ Expr'Op o1 $ reverse es | |
nextPartialExpr (Token'OpPostfix o) epe@(Right e) = do | |
guard $ opCondByNum o False 1 && opOpenLeft o | |
composePartialExpr o epe | |
nextPartialExpr (Token'Delimiter o2) (Left (PartialExpr'Op o1 e0es (Left False))) = do | |
if o1 == o2 | |
then Just $ Left $ PartialExpr'Op o1 e0es $ Left True | |
else do | |
guard $ opOpenLeft o2 | |
let e0 = head e0es | |
es = tail e0es | |
pe <- embedDelimiterExpr o2 e0 | |
return $ Left $ PartialExpr'Op o1 es $ Right pe | |
nextPartialExpr (Token'Delimiter o2) (Left (PartialExpr'Op o1 es (Left True))) = Nothing | |
nextPartialExpr (Token'Delimiter o) (Right e) = | |
Left <$> embedDelimiterExpr o e | |
nextPartialExpr t (Left (PartialExpr'Op o es (Right pe))) = do | |
epe <- nextPartialExpr t $ Left pe | |
return $ case epe of | |
Left pen -> Left $ PartialExpr'Op o es $ Right pen | |
Right e -> if opCondByNum o True (succ $ length es) && opOpenRight o | |
then Right $ Expr'Op o $ reverse $ e : es | |
else Left $ PartialExpr'Op o (e : es) $ Left False | |
nextPartialExpr t (Left (PartialExpr'Fn e es pe)) = do | |
epe <- nextPartialExpr t $ Left pe | |
return $ case epe of | |
Left pen -> Left $ PartialExpr'Fn e es pen | |
Right e1 -> Right $ Expr'Fn e $ reverse $ e1 : es | |
-- compute e + (Token'Var i), which is guaranteed to be Expr | |
embedExpr :: Text -> Expr -> Expr | |
embedExpr i e@(Expr'Var i0) = Expr'Fn e [Expr'Var i] | |
embedExpr i (Expr'Fn e es) = Expr'Fn e $ es ++ [Expr'Var i] | |
embedExpr i e@(Expr'Op o ese0) = if opClosedRight o | |
then Expr'Fn e [Expr'Var i] | |
else | |
let es = init ese0 | |
e0 = last ese0 | |
e1 = embedExpr i e0 | |
in Expr'Op o $ es ++ [e1] | |
-- compute e + (Token'OpPrefix d), which is guaranteed to be PartialExpr | |
embedOpPrefixExpr :: Op -> Expr -> PartialExpr | |
embedOpPrefixExpr o e@(Expr'Var i) = | |
PartialExpr'Fn e [] $ PartialExpr'Op o [] $ Left True | |
embedOpPrefixExpr o (Expr'Fn e es) = | |
PartialExpr'Fn e (reverse es) $ PartialExpr'Op o [] $ Left True | |
embedOpPrefixExpr o2 e@(Expr'Op o1 ese0) = if opClosedRight o1 | |
then PartialExpr'Fn e [] $ PartialExpr'Op o2 [] $ Left True | |
else case uncons $ reverse ese0 of | |
Nothing -> error "embedDelimiterPrefixExpr error: unreachable branch" | |
Just (e0, es) -> PartialExpr'Op o1 es $ Right $ embedOpPrefixExpr o2 e0 | |
-- compute e + (Token'Delimiter o) | |
embedDelimiterExpr :: Op -> Expr -> Maybe PartialExpr | |
embedDelimiterExpr o e@(Expr'Var i) = | |
Just $ PartialExpr'Op o [e] $ Left True | |
embedDelimiterExpr o e@(Expr'Fn _ _) = | |
Just $ PartialExpr'Op o [e] $ Left True | |
embedDelimiterExpr o2 e@(Expr'Op o1 ese0) = if opClosedLeft o2 | |
then Nothing | |
else if opClosedRight o1 | |
then Just $ PartialExpr'Op o2 [e] $ Left True | |
else if o1 == o2 | |
then Just $ PartialExpr'Op o1 (reverse ese0) $ Left True | |
else case viewOpCompare o1 o2 of | |
OpAssocs'Left -> Just $ PartialExpr'Op o2 [e] $ Left True | |
OpAssocs'Right -> case uncons $ reverse ese0 of | |
Nothing -> error "embedDelimiterExpr error: unreachable branch" | |
Just (e0, es) -> Just $ PartialExpr'Op o1 es $ Right $ PartialExpr'Op o2 [e0] $ Left True | |
OpAssocs'None -> Nothing | |
-- compute epe + (Token'Op 1 o2) only if opOpenLeft o2 | |
composePartialExpr :: Op -> Either PartialExpr Expr -> Maybe (Either PartialExpr Expr) | |
composePartialExpr o2 epe = case viewPartialExpr epe of | |
Left e -> Just $ if opCondByNum o2 False 1 | |
then Right $ Expr'Op o2 [e] | |
else Left $ PartialExpr'Op o2 [e] $ Left True | |
Right (b, o1, es0) -> | |
let es = tail es0 | |
e = head es0 | |
cond1 = opClosedRight o1 | |
cond2 = opCondByNum o1 True $ length es0 | |
e0 = Expr'Op o1 $ reverse es0 | |
in if b && cond1 | |
then Just $ if opCondByNum o2 False 1 | |
then Right $ Expr'Op o2 [e0] | |
else Left $ PartialExpr'Op o2 [e0] $ Left True | |
else if not b && cond1 || not cond2 | |
then do | |
epe1 <- composePartialExpr o2 $ Right e | |
return $ Left $ case epe1 of | |
Left pe -> PartialExpr'Op o1 es $ Right pe | |
Right e1 -> PartialExpr'Op o1 (e1 : es) $ Left False | |
else case viewOpCompare o1 o2 of | |
OpAssocs'Left -> | |
Just $ if opCondByNum o2 False 1 | |
then Right $ Expr'Op o2 [e0] | |
else Left $ PartialExpr'Op o2 [e0] $ Left True | |
OpAssocs'Right -> do | |
epe1 <- composePartialExpr o2 $ Right e | |
return $ case epe1 of | |
Left pe -> Left $ PartialExpr'Op o1 es $ Right pe | |
Right e1 -> Right $ Expr'Op o1 $ reverse $ e1 : es | |
OpAssocs'None -> Nothing | |
where | |
viewPartialExpr (Right e@(Expr'Var _)) = Left e | |
viewPartialExpr (Right (Expr'Op o es)) = Right (True, o, reverse es) | |
viewPartialExpr (Right e@(Expr'Fn _ _)) = Left e | |
viewPartialExpr (Left (PartialExpr'Op o es (Left False))) = Right (False, o, es) | |
viewPartialExpr _ = error "viewPartialExpr error: unreachable branch" | |
viewOpCompare :: Op -> Op -> OpAssocs | |
viewOpCompare o1 o2 = | |
case (_opRank o1 `compare` _opRank o2, _opAssocs o1, _opAssocs o2) of | |
(GT, _, _) -> OpAssocs'Left | |
(LT, _, _) -> OpAssocs'Right | |
(EQ, OpAssocs'Left, OpAssocs'Left) -> OpAssocs'Left | |
(EQ, OpAssocs'Right, OpAssocs'Right) -> OpAssocs'Right | |
_ -> OpAssocs'None | |
parse :: [Op] -> [Text] -> Maybe Expr | |
parse ops xs = do | |
let om = opsMapFromList ops | |
dm = delimitersMapFromList ops | |
ts0 = flip map xs $ tokenize (om, dm) | |
case uncons ts0 of | |
Nothing -> Nothing | |
Just (t, ts) -> do | |
es <- startPartialExpr t | |
epe <- foldM (flip nextPartialExpr) es ts | |
case epe of | |
Left _ -> Nothing | |
Right e -> Just e | |
-- opRank :: Lens' Op Int | |
-- number > boolean > monoid = 0 | |
-- 0 > apply operator > expression structure > parenthesis | |
-- number: !, negate > * > + | |
opsForTest :: [Op] | |
opsForTest = | |
-- ops | |
[ Op (Right []) (Just "negate") Nothing 4 OpAssocs'None | |
, Op (Right []) (Just "(") (Just ")") (negate 3) OpAssocs'None | |
, Op (Right ["+"]) Nothing Nothing 2 OpAssocs'Left | |
, Op (Right ["*"]) Nothing Nothing 3 OpAssocs'Left | |
, Op (Right ["then", "else"]) (Just "if") Nothing (negate 2) OpAssocs'None | |
, Op (Right ["?", ":"]) Nothing Nothing (negate 2) OpAssocs'Right | |
, Op (Right []) Nothing (Just "!") 4 OpAssocs'None | |
, Op (Right ["$"]) Nothing Nothing (negate 1) OpAssocs'Right | |
-- ops for debugging | |
, Op (Right []) Nothing (Just "!l") 5 OpAssocs'Left | |
, Op (Right []) Nothing (Just "!r") 5 OpAssocs'Right | |
, Op (Right []) (Just "#l") Nothing 5 OpAssocs'Left | |
, Op (Right []) (Just "#r") Nothing 5 OpAssocs'Right | |
, Op (Right ["$5"]) Nothing Nothing 5 OpAssocs'Right | |
, Op (Right ["+-5"]) Nothing Nothing (negate 5) OpAssocs'Left | |
, Op (Right ["$-4"]) Nothing Nothing (negate 4) OpAssocs'Right | |
, Op (Right ["+-4"]) Nothing Nothing (negate 4) OpAssocs'Left | |
, Op (Right []) Nothing (Just "!-5") (negate 5) OpAssocs'None | |
-- delimiters | |
, Op (Left ";") (Just "[") (Just "]") (negate 4) OpAssocs'None | |
, Op (Left ",") Nothing Nothing (negate 4) OpAssocs'None | |
-- delimiters for debugging | |
, Op (Left ",debug") Nothing Nothing (negate 4) OpAssocs'None | |
, Op (Left ",left1") Nothing Nothing (negate 4) OpAssocs'Left | |
, Op (Left ",left2") Nothing Nothing (negate 4) OpAssocs'Left | |
, Op (Left ",right1") Nothing Nothing (negate 4) OpAssocs'Right | |
, Op (Left ",right2") Nothing Nothing (negate 4) OpAssocs'Right | |
, Op (Left ";left") (Just "[left") (Just "]left") (negate 4) OpAssocs'Left | |
, Op (Left ";right") (Just "[right") (Just "]right") (negate 4) OpAssocs'Right | |
] | |
ts1 = ["(", "(", "b", ")", ")"] | |
ts2 = ["b", "?", "b", "?", "a", ":", "c", ":", "b", "?", "d", ":", "e"] | |
ts3 = ["negate", "(", "5", "!", ")"] | |
ts4 = ["5", "!", "!"] | |
ts5 = ["5", "!", "+", "3", "+", "a", "!"] | |
ts6 = ["(", "5", "!", ")", "!"] | |
ts7 = ["#l", "5", "!l"] | |
ts8 = ["#r", "5", "!r"] | |
ts9 = ["1", "+", "2", "*", "3", "+", "4"] | |
ts10 = ["1", "*", "(", "2", "+", "3", ")", "*", "4"] | |
ts11 = ["1", "*", "2", "+", "3", "*", "4"] | |
ts12 = ["#r", "f", "$5", "x"] | |
ts13 = ["#r", "f", "$", "g", "$", "x"] | |
ts14 = ["#r", "5", "!"] | |
ts15 = ["f", "2"] | |
ts16 = ["(", "(", "f", "2", ")", ")"] | |
ts17 = ["(", "(", "f", "2", ")", "3", "(", "g", "5", ")", ")"] | |
ts18 = ["f", "b", "?", "g", "b", "?", "a", ":", "c", ":", "h", "b", "?", "d", ":", "e"] | |
ts19 = ["negate", "(", "f", "5", "!", ")"] | |
ts20 = ["f", "5", "!", "!"] | |
ts21 = ["f", "5", "!", "+", "g", "3", "+", "h", "a", "!"] | |
ts22 = ["(", "f", "5", "!", ")", "!"] | |
ts23 = ["#l", "f", "5", "!l"] | |
ts24 = ["#r", "f", "5", "!r"] | |
ts25 = ["f", "1", "+", "f", "2", "*", "f", "3", "+", "f", "4"] | |
ts26 = ["f", "1", "*", "(", "f", "2", "+", "f", "3", ")", "*", "f", "4"] | |
ts27 = ["1", "*", "(", "g", "$", "f", "2", "+", "f", "3", ")", "5", "*", "4"] | |
ts28 = ["f", "1", "*", "f", "2", "+", "f", "3", "*", "f", "4"] | |
ts29 = ["#r", "f", "y", "$5", "g", "x"] | |
ts30 = ["#r", "f", "z", "$", "g", "y", "$", "h", "x"] | |
ts31 = ["#r", "f", "5", "!"] | |
ts32 = ["(", "(", "f", "b", ")", "(", "(", "g", "c", "d", ")", ")", ")", "(", "3", ")", "4"] | |
ts33 = ["f", "negate", "5", "negate", "5"] | |
ts34 = ["[", "]"] | |
ts35 = ["h", "(", "f", "3", ",", "g", "5", "!", ")"] | |
ts36 = ["a", ",", "[", "]", ",", "f", "b", "+", "g", "c", ",", "negate", "5"] | |
ts37 = ["(", "a", ",", "f", "b", "!", ")"] | |
ts38 = ["f", "[", "a", ";", "b", ",", "c", "]"] | |
ts39 = ["f", "a", "2", "[", "[", "g", "b", ";", "c", "]", "]"] | |
ts40 = ["f", "+", "[", "]", "+", "g", "[", "]", ",", "h", "x", "[", "]"] | |
ts41 = ["[", "]", "x", "!", "[", "]"] | |
ts42 = ["[", "]", "[", "]", ",", "x", "+", "y"] | |
ts43 = ["[", "x", "!", "?", "y", ":", "z", ";", "3", "]", "!"] | |
ts44 = ["[", "]", "?", "x", ":", "y"] | |
ts45 = ["[", "]", ",", "3", "+-5", "x"] | |
ts46 = ["(", "f", "[", "]", ")", "[", "g", "[", "]", "]"] | |
ts47 = ["(", "x", ",left1", "y", ",left2", "z", ")", "(", "a", ",right1", "b", ",right2", "c", ")"] | |
ts48 = ["[left", "x", ";left", "y", ",left1", "z", "]left", "[right", "a", ";right", "b", ",right2", "c", "]right"] | |
ts49 = ["(", "x", "+", "y", ")", ",right1", "f", "$-4", "z", ",right1", "w"] | |
ts50 = ["x", ",left1", "y", "+-4", "z", ",left1", "w"] | |
ts51 = ["2", ",", "3", "!-5", "+-5", "7", ",", "x"] | |
ts52 = ["[", "x", ";", "y", ",", "z", "]"] | |
tsc1 = [] | |
tsc2 = ["negate"] | |
tsc3 = ["negate", "5", "!"] | |
tsc4 = ["1", "*", "else"] | |
tsc5 = ["1", "?", "3", "else"] | |
tsc6 = ["1", "?", "3", "5"] | |
tsc7 = ["1", "?", "3", "(", "5", ")"] | |
tsc8 = ["negate", "f", "5", "!"] | |
tsc9 = ["f", "1", "*", "else"] | |
tsc10 = ["f", "1", "?", "f", "3", "else"] | |
tsc11 = ["f", "1", "?", "g", "5"] | |
tsc12 = ["f", "1", "?", "g", "(", "5", ")"] | |
tsc13 = ["5", "else"] | |
tsc14 = [";"] | |
tsc15 = ["]"] | |
tsc16 = ["x", "]"] | |
tsc17 = ["negate", "]"] | |
tsc18 = ["negate", ","] | |
tsc19 = ["[", "3", ";", "]"] | |
tsc20 = ["(", "3", ",", ")"] | |
tsc21 = ["[", "3", ";", "5", ",", "]"] | |
tsc22 = ["(", "3", ",", "5", ";"] | |
tsc23 = ["x", ",", ";"] | |
tsc24 = ["3", "+", "2", ";"] | |
tsc25 = ["3", ",", "2", ";"] | |
tsc26 = ["x", ",", "y", ",debug"] | |
tsc27 = ["(", "x", ",left1", "y", ",right1"] | |
tsc28 = ["[left", "x", ";left", "y", ",right1"] | |
tsc29 = ["x", ",right1", "y", "+-4"] | |
tsc30 = ["x", "+-4", "y", ","] | |
tsc31 = ["[left", "x", ";left", "y", ";"] | |
tsc32 = ["?"] | |
spec :: IO () | |
spec = do | |
forM_ [ts1, ts2, ts3, ts4, ts5, ts6, ts7, ts8, ts9, ts10, ts11, ts12, ts13, ts14, ts15, ts16, ts17, ts18, ts19, ts20, ts21, ts22, ts23, ts24, ts25, ts26, ts27, ts28, ts29, ts30, ts31, ts32, ts33, ts34, ts35, ts36, ts37, ts38, ts39, ts40, ts41, ts42, ts43, ts44, ts45, ts46, ts47, ts48, ts49, ts50, ts51, ts52] $ \ts -> do | |
let ee = parse opsForTest ts | |
case ee of | |
Nothing -> putStrLn "produced Nothing!" | |
Just e -> do | |
T.putStrLn $ "debugExpr: " <> debugExpr e | |
T.putStrLn $ "validExpr: " <> T.pack (show $ validExpr e) | |
forM_ [tsc1, tsc2, tsc3, tsc4, tsc5, tsc6, tsc7, tsc8, tsc9, tsc10, tsc11, tsc12, tsc13, tsc14, tsc15, tsc16, tsc17, tsc18, tsc19, tsc20, tsc21, tsc22, tsc23, tsc24, tsc25, tsc26, tsc27, tsc28, tsc29, tsc30, tsc31, tsc32] $ \ts -> do | |
let ee = parse opsForTest ts | |
case ee of | |
Nothing -> putStrLn "produced Nothing" | |
Just e -> do | |
putStrLn "produced not Nothing!" | |
T.putStrLn $ "debugExpr: " <> debugExpr e | |
T.putStrLn $ "validExpr: " <> T.pack (show $ validExpr e) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment