never executed always true always false

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