never executed always true always false

    1 {-# LANGUAGE DeriveDataTypeable #-}
    2 module Conjure.Language.AST.Reformer (HighLevelTree(..),HLTree(..),flatten,flattenSeq,contains,filterContaining,TreeItemLinks(..),ListItemClasses(..)) where
    3 
    4 import Conjure.Language.AST.Syntax
    5 import Conjure.Language.Lexer (ETok (..), trueStart, sourcePosAfter)
    6 import Conjure.Prelude
    7 
    8 
    9 import Data.Semigroup ((<>))
   10 import qualified Data.Sequence as S
   11 import Text.Megaparsec (SourcePos (SourcePos))
   12 
   13 
   14 
   15 
   16 -- class HighLevelTree a where
   17 --     makeTree :: HighLevelTree a => a -> S.Seq ETok
   18 flatten :: HighLevelTree a => a -> [ETok]
   19 flatten x = case makeTree x of
   20     HLNone -> []
   21     HLTagged _ xs -> concatMap flatten xs
   22     HLLeaf t -> [t]
   23 flattenSeq :: HighLevelTree a => a -> S.Seq ETok
   24 flattenSeq = S.fromList . flatten
   25 
   26 instance HighLevelTree HLTree where
   27     makeTree = id
   28 
   29 instance HighLevelTree StatementNode where
   30     makeTree x = case x of
   31         DeclarationStatement dsn -> makeTree dsn
   32         BranchingStatement bsn -> makeTree bsn
   33         SuchThatStatement stsn -> makeTree stsn
   34         WhereStatement wsn -> makeTree wsn
   35         ObjectiveStatement osn -> makeTree osn
   36         HeuristicStatement l1 ex -> makeTree l1 <> makeTree ex
   37         UnexpectedToken tok -> makeTree tok
   38 
   39 instance HighLevelTree DeclarationStatementNode where
   40     makeTree x = case x of
   41         FindStatement f fsn -> makeTree f <> makeTree fsn
   42         GivenStatement g gsn -> makeTree g <> makeTree gsn
   43         LettingStatement t lsn -> makeTree t <> makeTree lsn
   44 
   45 
   46 instance HighLevelTree LettingStatementNode where 
   47     makeTree (LettingStatementNode a b c) = mconcat[ makeTree a, makeTree b, makeTree c]
   48 
   49 instance HighLevelTree LettingAssignmentNode where
   50     makeTree x = case x of
   51         LettingExpr d ->  makeTree d
   52         LettingDomain d e -> makeTree d <> makeTree e
   53         LettingEnum d e f g -> mconcat [makeTree d, makeTree e, makeTree f, makeTree g]
   54         LettingUnnamed d e f g h -> mconcat [makeTree d, makeTree e, makeTree f, makeTree g, makeTree h]
   55 
   56 instance HighLevelTree FindStatementNode where
   57     makeTree (FindStatementNode a b c) = mconcat  [makeTree a, makeTree b, makeTree c]
   58 
   59 instance HighLevelTree GivenStatementNode where
   60     makeTree x = case x of
   61         GivenStatementNode a b c -> mconcat [makeTree a, makeTree b, makeTree c]
   62         GivenEnumNode a b c d -> mconcat [makeTree a, makeTree b, makeTree c, makeTree d]
   63 
   64 
   65 
   66 instance HighLevelTree BranchingStatementNode where
   67     makeTree (BranchingStatementNode lt lt' ln) = mconcat [makeTree lt, makeTree lt', makeTree ln]
   68 
   69 
   70 instance HighLevelTree SuchThatStatementNode where
   71     makeTree (SuchThatStatementNode l1 l2 l3) =  makeTree l1 <> makeTree l2 <> makeTree l3
   72 instance HighLevelTree WhereStatementNode where
   73     makeTree (WhereStatementNode l1 l2) =  makeTree l1 <> makeTree l2
   74 instance HighLevelTree ObjectiveStatementNode where
   75     makeTree x =  case x of
   76         ObjectiveMin lt en -> makeTree lt <> makeTree en
   77         ObjectiveMax lt en -> makeTree lt <> makeTree en
   78 
   79 
   80 
   81 
   82 instance HighLevelTree ExpressionNode where
   83     makeTree x = HLTagged (TIExpression x) $ case x of
   84         Literal ln -> [makeTree ln]
   85         IdentifierNode nn -> [makeTree nn]
   86         MetaVarExpr tk -> [makeTree tk]
   87         QuantificationExpr qen -> [makeTree qen]
   88         OperatorExpressionNode oen -> [makeTree oen]
   89         ParenExpression pen ->[makeTree pen]
   90         AbsExpression pen ->  [makeTree pen]
   91         DomainExpression dex -> [makeTree dex]
   92         FunctionalApplicationNode lt ln ->  [makeTree lt ,makeTree ln]
   93         SpecialCase nd -> [makeTree nd]
   94         AttributeAsConstriant l1 exprs -> [makeTree l1 , makeTree exprs]
   95         MissingExpressionNode e ->  [makeTree e]
   96 
   97 instance HighLevelTree SpecialCaseNode where 
   98     makeTree x = case x of 
   99         ExprWithDecls l1 en l2 sns l3 -> mconcat [makeTree l1,makeTree en,makeTree l2, makeTree sns , makeTree l3]
  100 
  101 
  102 instance HighLevelTree DomainExpressionNode where
  103     makeTree (DomainExpressionNode a b c) = makeTree a <> makeTree b <> makeTree c
  104 instance HighLevelTree QuantificationExpressionNode where
  105     makeTree (QuantificationExpressionNode a b c d e f) = mconcat [
  106         makeTree a, makeTree b, makeTree c, makeTree d, makeTree e, makeTree f]
  107 
  108 instance HighLevelTree QuantificationOverNode where
  109     makeTree x = case x of
  110       QuantifiedSubsetOfNode a b -> makeTree a <> makeTree b
  111       QuantifiedMemberOfNode a b -> makeTree a <> makeTree b
  112       QuantifiedDomainNode a -> makeTree a
  113 
  114 instance HighLevelTree OverDomainNode where
  115     makeTree (OverDomainNode a b) = makeTree a <> makeTree b
  116 
  117 instance HighLevelTree QuanticationGuard where
  118     makeTree (QuanticationGuard a b ) = makeTree a <> makeTree b
  119 
  120 instance HighLevelTree AbstractPatternNode where
  121     makeTree x = case x of
  122       AbstractIdentifier nn -> makeTree nn
  123       AbstractMetaVar lt -> makeTree lt
  124       AbstractPatternTuple a b -> makeTree a <> makeTree b
  125       AbstractPatternMatrix ln -> makeTree ln
  126       AbstractPatternSet ln -> makeTree ln
  127 instance HighLevelTree QuantificationPattern where
  128     makeTree (QuantificationPattern en) = makeTree en
  129 
  130 instance HighLevelTree LiteralNode where
  131     makeTree x = case x of
  132         IntLiteral lt -> makeTree lt
  133         BoolLiteral lt -> makeTree lt
  134         MatrixLiteral mln -> makeTree mln
  135         TupleLiteralNode lt -> makeTree lt
  136         TupleLiteralNodeShort st -> makeTree st
  137         RecordLiteral lt ln -> makeTree lt <> makeTree ln
  138         VariantLiteral lt ln -> makeTree lt <> makeTree ln
  139         SetLiteral ln -> makeTree ln
  140         MSetLiteral lt ln -> makeTree lt <> makeTree ln
  141         FunctionLiteral lt ln -> makeTree lt <> makeTree ln
  142         SequenceLiteral lt ln -> makeTree lt <> makeTree ln
  143         RelationLiteral lt ln -> makeTree lt <> makeTree ln
  144         PartitionLiteral lt ln -> makeTree lt <> makeTree ln
  145 
  146 instance HighLevelTree PartitionElemNode where
  147     makeTree (PartitionElemNode ln) = makeTree ln
  148 
  149 instance HighLevelTree RelationElemNode where
  150     makeTree x = case x of
  151         RelationElemNodeLabeled lt -> makeTree lt
  152         RelationElemNodeShort st -> makeTree st
  153 
  154 instance HighLevelTree ArrowPairNode where
  155     makeTree (ArrowPairNode a b c) = mconcat [makeTree a, makeTree b, makeTree c]
  156 
  157 instance HighLevelTree RecordMemberNode where
  158     makeTree (RecordMemberNode nn lt en) =  mconcat [makeTree nn, makeTree lt, makeTree en]
  159 instance HighLevelTree LongTuple where
  160     makeTree (LongTuple a b) =  makeTree a <> makeTree b
  161 
  162 instance HighLevelTree ShortTuple where
  163     makeTree (ShortTuple a) = makeTree a
  164 
  165 instance HighLevelTree MatrixLiteralNode where
  166     makeTree ( MatrixLiteralNode a b c d e) = mconcat
  167             [ makeTree a
  168             , makeTree b
  169             , makeTree c
  170             , makeTree d
  171             , makeTree e
  172             ]
  173 
  174 instance HighLevelTree ComprehensionNode where
  175     makeTree (ComprehensionNode a b) = makeTree a <> makeTree b
  176 instance HighLevelTree ComprehensionExpressionNode where
  177     makeTree (ComprehensionExpressionNode a b c d e) =
  178         mconcat
  179             [ makeTree a
  180             , makeTree b
  181             , makeTree c
  182             , makeTree d
  183             , makeTree e
  184             ]
  185 
  186 instance HighLevelTree ComprehensionBodyNode where
  187     makeTree x =  case x of
  188         CompBodyCondition en -> makeTree en
  189         CompBodyDomain a b c -> makeTree a <> makeTree b <> makeTree c
  190         CompBodyGenExpr a b c -> makeTree a <> makeTree b <> makeTree c
  191         CompBodyLettingNode a b c d -> mconcat [makeTree a, makeTree b, makeTree c, makeTree d]
  192 
  193 instance HighLevelTree OperatorExpressionNode where
  194     makeTree x =  case x of
  195         PostfixOpNode en pon -> makeTree en <> makeTree pon
  196         PrefixOpNode lt en -> makeTree lt <> makeTree en
  197         BinaryOpNode en lt en' -> mconcat [makeTree en, makeTree lt, makeTree en']
  198 
  199 instance HighLevelTree PostfixOpNode where
  200     makeTree x =  case x of
  201         IndexedNode l -> makeTree l
  202         OpFactorial lt -> makeTree lt
  203         ApplicationNode ln -> makeTree ln
  204         ExplicitDomain l1 l2 dom l3 -> mconcat  [makeTree l1,makeTree l2,makeTree dom,makeTree l3]
  205 
  206 
  207 
  208 
  209 instance HighLevelTree DomainNode where
  210     makeTree x = HLTagged (TIDomain x) $ case x of
  211         ParenDomainNode a b c -> [makeTree a, makeTree b, makeTree c]
  212         BoolDomainNode lt -> [makeTree lt]
  213         RangedIntDomainNode lt ln -> [makeTree lt,makeTree ln]
  214         MetaVarDomain a -> [makeTree a]
  215         RangedEnumNode nn ln -> [makeTree nn ,  makeTree ln]
  216         -- EnumDomainNode nn -> makeTree nn
  217         ShortTupleDomainNode ln -> [makeTree ln]
  218         TupleDomainNode lt ln -> [makeTree lt , makeTree ln]
  219         RecordDomainNode lt ln -> [makeTree lt , makeTree ln]
  220         VariantDomainNode lt ln -> [makeTree lt , makeTree ln]
  221         MatrixDomainNode a m_ib b c d -> [makeTree a ,makeTree m_ib, makeTree b , makeTree c , makeTree d]
  222         SetDomainNode a b c d -> [makeTree a , makeTree  b , makeTree c , makeTree d]
  223         MSetDomainNode a b c d -> [makeTree a , makeTree  b, makeTree c , makeTree d]
  224         FunctionDomainNode a b c d e -> [makeTree a , makeTree  b , makeTree c , makeTree d,makeTree e]
  225         SequenceDomainNode a b c d -> [makeTree a , makeTree  b , makeTree c , makeTree d]
  226         RelationDomainNode a b c d -> [makeTree a , makeTree b , makeTree c , makeTree d]
  227         PartitionDomainNode a b c d -> [makeTree a , makeTree b , makeTree c , makeTree d]
  228         MissingDomainNode m -> [makeTree m]
  229 
  230 instance HighLevelTree IndexedByNode where
  231     makeTree (IndexedByNode a b ) = makeTree a <> makeTree b
  232 
  233 
  234 instance HighLevelTree a => HighLevelTree (Maybe a) where
  235   makeTree = maybe mempty makeTree 
  236 
  237 instance HighLevelTree AttributeNode where
  238     makeTree x =  case x of
  239         NamedAttributeNode nn m_e -> makeTree nn <> makeTree m_e
  240         -- NamedExpressionAttribute nn en -> makeTree nn <> makeTree en
  241 
  242 instance HighLevelTree RangeNode where
  243     makeTree x =  case x of
  244         SingleRangeNode en -> makeTree en
  245         OpenRangeNode ddn -> makeTree ddn
  246         RightUnboundedRangeNode en ddn -> makeTree en <> makeTree ddn
  247         LeftUnboundedRangeNode ddn en -> makeTree ddn <> makeTree en
  248         BoundedRangeNode en ddn en' -> mconcat [makeTree en, makeTree ddn, makeTree en']
  249 
  250 -- instance HighLevelTree DoubleDotNode where
  251 --     makeTree (DoubleDotNode a b) =  makeTree a <> makeTree b
  252 
  253 instance HighLevelTree NamedDomainNode where
  254     makeTree (NameDomainNode a Nothing) = makeTree a
  255     makeTree (NameDomainNode a (Just (b,c))) = mconcat [makeTree a,makeTree b,makeTree c]
  256 
  257 instance HighLevelTree NameNode where
  258     makeTree (NameNode n) =  makeTree n
  259     makeTree (MissingNameNode n) =  makeTree n
  260 
  261 instance HighLevelTree NameNodeS where
  262     makeTree (NameNodeS n) =  makeTree n
  263 instance HighLevelTree ParenExpressionNode where
  264     makeTree (ParenExpressionNode a b c) =  makeTree a <> makeTree b <> makeTree c
  265 
  266 
  267 
  268 
  269 
  270 instance HighLevelTree b => HighLevelTree (Sequence b) where
  271     makeTree (Seq es) = mconcat $ map makeTree es
  272 
  273 instance HighLevelTree b => HighLevelTree (SeqElem b) where
  274     makeTree (SeqElem v s) =  makeTree v <> makeTree s
  275     makeTree (MissingSeqElem v s) =  makeTree v <> makeTree s
  276 instance HighLevelTree b => HighLevelTree [b] where
  277     makeTree = HLTagged TIGeneral . map makeTree 
  278 
  279 type TreeTag = ListItemClasses
  280 data HLTree 
  281     = HLTagged TreeItemLinks [HLTree]
  282     | HLLeaf ETok
  283     | HLNone
  284     deriving (Show,Data,Typeable)
  285 
  286 instance Semigroup HLTree where
  287     HLNone <> a = a
  288     a <> HLNone = a
  289     HLTagged TIGeneral xs <> a = HLTagged TIGeneral (xs++[a])
  290     a <> HLTagged TIGeneral xs = HLTagged TIGeneral $ a:xs
  291     a <> b = HLTagged TIGeneral [a,b]
  292 
  293 instance Monoid HLTree where
  294     mempty = HLNone
  295 
  296 taggedSeq :: HighLevelTree a => TreeTag -> Sequence a -> HLTree
  297 taggedSeq s (Seq els) = HLTagged (TIList s) $ makeTree <$> els 
  298 taggedList :: HighLevelTree a => TreeTag -> ListNode a -> HLTree
  299 taggedList s (ListNode a b c) = HLTagged TIGeneral $ makeTree a : taggedSeq s b  : [makeTree c]
  300 
  301 -- Tag types for nodes, mainly used to guide completions
  302 data ListItemClasses 
  303     = ICAttribute
  304     | ICExpression
  305     | ICDomain
  306     | ICRange
  307     | ICIdentifier
  308     | ICStatement
  309     deriving (Show,Data,Ord,Eq)
  310 
  311 -- Embed the actual syntax portion into the tree, in case needed
  312 data TreeItemLinks
  313     = TIExpression ExpressionNode
  314     | TIDomain DomainNode
  315     | TIList ListItemClasses
  316     | TIGeneral
  317     deriving (Show,Data)
  318 instance Eq TreeItemLinks where
  319     TIGeneral == TIGeneral = True
  320     _ == _ = False
  321 instance HighLevelTree (ListNode ExpressionNode) where
  322     makeTree = taggedList ICExpression
  323 instance HighLevelTree (ListNode NameNode) where
  324     makeTree = taggedList ICIdentifier
  325 instance HighLevelTree (ListNode DomainNode) where
  326     makeTree = taggedList ICDomain
  327 
  328 instance HighLevelTree (ListNode RangeNode) where
  329     makeTree = taggedList ICRange
  330 
  331 instance HighLevelTree (ListNode AttributeNode) where
  332     makeTree = taggedList ICAttribute
  333 instance HighLevelTree (ListNode RecordMemberNode) where
  334     makeTree = taggedList ICIdentifier
  335 instance HighLevelTree (ListNode ArrowPairNode) where
  336     makeTree = taggedList ICIdentifier
  337 instance HighLevelTree (ListNode RelationElemNode) where
  338     makeTree = taggedList ICIdentifier
  339 instance HighLevelTree (ListNode PartitionElemNode) where
  340     makeTree = taggedList ICIdentifier
  341 instance HighLevelTree (ListNode NamedDomainNode) where
  342     makeTree = taggedList ICIdentifier
  343 
  344 instance HighLevelTree (ListNode AbstractPatternNode) where
  345     makeTree = taggedList ICIdentifier
  346 class HighLevelTree a where
  347     makeTree :: a -> HLTree
  348 
  349 instance HighLevelTree LToken where
  350     makeTree (RealToken a) = makeTree a
  351     makeTree (SkippedToken t) = HLLeaf t
  352     makeTree (MissingToken m) = HLLeaf m
  353 instance HighLevelTree SToken where
  354     makeTree (StrictToken ts t) =  HLTagged TIGeneral $ (HLLeaf <$> ts) ++ [HLLeaf t] 
  355 
  356 instance HighLevelTree ProgramTree where
  357   makeTree (ProgramTree Nothing sts cln) = HLTagged TIGeneral $ (HLTagged (TIList ICStatement) $ makeTree <$> sts) : [makeTree cln] 
  358   makeTree (ProgramTree (Just lv) sts cln) = HLTagged TIGeneral $ [makeTree lv] ++ (makeTree <$> sts) ++ [makeTree cln] 
  359 
  360 instance HighLevelTree LangVersionNode where
  361     makeTree (LangVersionNode a b c) = HLTagged TIGeneral $ makeTree a : makeTree b : [makeTree c]
  362 
  363 
  364 -- getContainers :: HLTree -> Int -> Int -> HLTree
  365 -- getContainers HLNone r c = HLNone
  366 
  367 
  368 bounds :: ETok -> SourcePos -> Bool
  369 bounds t (SourcePos _ r c)= let
  370     (SourcePos _ rl cl,SourcePos _ rr cr) = (trueStart t,sourcePosAfter  t)
  371         in r >= rl && c >= cl && r <= rr && c <= cr
  372 
  373 -- inBounds :: SourcePos -> HLTree -> Bool
  374 -- inBounds (SourcePos _ r c) t 
  375 --     | null $ flatten t = False
  376 --     | otherwise = let 
  377 --         (SourcePos _ rl cl,SourcePos _ rr cr) = bounds t
  378 --         in r >= rl && c >= cl && r <= rr && c <= cr
  379 
  380 contains :: SourcePos -> HLTree -> Bool
  381 contains p t = case t of 
  382     HLNone -> False
  383     HLLeaf e -> bounds e p
  384     HLTagged _ xs -> any (contains p) xs
  385     -- HLGeneral xs -> any (contains p) xs
  386     -- HLList _ xs -> any (contains p ) xs
  387 
  388 filterContaining :: SourcePos -> HLTree -> [HLTree]
  389 filterContaining _ HLNone = []
  390 filterContaining p n@(HLLeaf _) = [n |contains p n]
  391 filterContaining p (HLTagged t xs) = let cs = [x | x <-xs,contains p x]
  392                                         in HLTagged t cs : concatMap (filterContaining p) cs