never executed always true always false

    1 module HelVM.HelMA.Automata.ETA.Optimizer (
    2   optimize,
    3 )
    4 where
    5 
    6 import           HelVM.HelMA.Automata.ETA.OperandParsers
    7 import           HelVM.HelMA.Automata.ETA.Token
    8 
    9 import           HelVM.HelMA.Automaton.Instruction
   10 import           HelVM.HelMA.Automaton.Instruction.Extras.Constructors
   11 
   12 import           HelVM.HelIO.Control.Safe
   13 
   14 import           Control.Applicative.Tools
   15 
   16 import           Data.List.Extra
   17 import qualified Data.List.Index                                       as List
   18 
   19 import qualified Data.ListLike                                         as LL
   20 
   21 optimize :: MonadSafe m => TokenList -> m InstructionList
   22 optimize = appendEnd <.> join <.> optimizeLines
   23 
   24 appendEnd :: InstructionList -> InstructionList
   25 appendEnd l = l <> [markNI 0 , End]
   26 
   27 optimizeLines :: MonadSafe m => TokenList -> m [InstructionList]
   28 optimizeLines = sequence . optimizeLineInit <.> lineFromTuple2 <.> splitOnRAndIndex2
   29 
   30 splitOnRAndIndex2 :: TokenList -> [(Natural, [TokenList])]
   31 splitOnRAndIndex2 = indexedByNaturalWithOffset 1 <.> List.indexed . filterNull . tails . splitOn [R]
   32 
   33 indexedByNaturalWithOffset :: Int -> (Int , a) -> (Natural , a)
   34 indexedByNaturalWithOffset offset (i , a) = (fromIntegral (i + offset) , a)
   35 
   36 optimizeLineInit :: MonadSafe m => Line -> m InstructionList
   37 optimizeLineInit line = (markNI (currentAddress line) : ) <$> optimizeLineTail line
   38 
   39 optimizeLineTail:: MonadSafe m => Line -> m InstructionList
   40 optimizeLineTail line = check (currentTL line) where
   41   check (t : tl) = optimizeLineForToken t $ line { currentTL = tl }
   42   check []       = pure []
   43 
   44 optimizeLineForToken :: MonadSafe m => Token -> Line -> m InstructionList
   45 optimizeLineForToken O = (sOutputI  : ) <.> optimizeLineTail
   46 optimizeLineForToken I = (sInputI   : ) <.> optimizeLineTail
   47 
   48 optimizeLineForToken S = (subI      : ) <.> optimizeLineTail
   49 optimizeLineForToken E = prependDivMod
   50 
   51 optimizeLineForToken H = (halibutI  : ) <.> optimizeLineTail
   52 optimizeLineForToken T = (bNeTI     : ) <.> optimizeLineTail
   53 
   54 optimizeLineForToken A = prependAddress
   55 optimizeLineForToken N = prependNumber
   56 
   57 optimizeLineForToken R = optimizeLineTail
   58 
   59 prependDivMod :: MonadSafe m => Line -> m InstructionList
   60 prependDivMod line = check $ numberFlag line where
   61   check False = prependDivModSimple line
   62   check True  = prependStaticMakr line <.> optimizeLineTail $ line {numberFlag = False}
   63 
   64 prependStaticMakr :: Line -> InstructionList -> InstructionList
   65 prependStaticMakr line il = divModI : markSI (show $ currentAddress line) : il
   66 
   67 prependDivModSimple :: MonadSafe m => Line -> m InstructionList
   68 prependDivModSimple = (divModI : ) <.> optimizeLineTail
   69 
   70 prependAddress :: MonadSafe m => Line -> m InstructionList
   71 prependAddress line = ((consI $ fromIntegral $ nextAddress line) : ) <$> optimizeLineTail line
   72 
   73 prependNumber :: MonadSafe m => Line -> m InstructionList
   74 prependNumber line = flip buildNumber line =<< parseNumberFromTLL (currentTL line , nextTLL line)
   75 
   76 buildNumber :: MonadSafe m => (Integer , (TokenList , [TokenList])) -> Line -> m InstructionList
   77 buildNumber (n , (tl , ttl) ) line = build (LL.length (nextTLL line) - LL.length ttl) where
   78   build 0      = (consI n :) <$> optimizeLineTail (line {currentTL = tl})
   79   build offset = pure [consI n , jumpSI $ show $ currentAddress line + fromIntegral offset]
   80 
   81 -- | Accessors
   82 
   83 nextAddress :: Line -> Natural
   84 nextAddress line = currentAddress line + 1
   85 
   86 -- | Constructors
   87 
   88 lineFromTuple2 :: (Natural, [TokenList]) -> Line
   89 lineFromTuple2 (a, []) = Line
   90   { currentAddress = a
   91   , currentTL = []
   92   , nextTLL = []
   93   , numberFlag = True
   94   }
   95 lineFromTuple2 (a, l : ls) = Line
   96   { currentAddress = a
   97   , currentTL = l
   98   , nextTLL = ls
   99   , numberFlag = True
  100   }
  101 
  102 data Line = Line
  103   { currentTL      :: TokenList
  104   , currentAddress :: Natural
  105   , numberFlag     :: Bool
  106   , nextTLL        :: [TokenList]
  107   }
  108 
  109 --consM :: Functor f => a -> f [a] -> f [a]
  110 --consM a l = (a : ) <$> l
  111 
  112 filterNull :: [[a]] -> [[a]]
  113 filterNull = filter notNull