Garbage.purs

-- | Given a representation of an arithmetic expression, convert
-- | it into a format (involving assignments) such that every
-- | operand to an operator is either a variable or integer
-- | literal.
-- |
-- | For example:
-- | ```
-- | x * 3 + y + a * b
-- | ```
-- | ->
-- | ```
-- | t0 = x * 3
-- | t1 = t0 + y
-- | t2 = a * b
-- | t3 = t1 + t2
-- | ```

module Garbage where

import Prelude

import Control.Monad.State (State, evalState, get, modify_)
import Data.Array (fold)
import Data.Foldable (for_)
import Data.Generic.Rep (class Generic)
import Data.List (List, sortBy)
import Data.List as List
import Data.Show.Generic (genericShow)
import Effect (Effect)
import Effect.Class.Console (log)

---------------------------------------------

data BOp
  = Add
  | Mul

derive instance Eq BOp

derive instance Ord BOp

derive instance Generic BOp _

instance Show BOp where
  show = genericShow

opToString :: BOp -> String
opToString Add = "+"
opToString Mul = "*"

---------------------------------------------

data Expr
  = Integer Int
  | Var String
  | BinOp BOp Expr Expr

derive instance Eq Expr

derive instance Ord Expr

---------------------------------------------

data Intermediate
  = Labeled String BOp Intermediate Intermediate
  | Integer' Int
  | Var' String

derive instance Eq Intermediate

derive instance Ord Intermediate

---------------------------------------------


data FinalPrim
  = Integer'' Int
  | Var'' String

derive instance Generic FinalPrim _

instance Show FinalPrim where
  show = genericShow

data FinalExprType
  = Labeled'' String BOp FinalPrim FinalPrim

derive instance Generic FinalExprType _

instance Show FinalExprType where
  show = genericShow

---------------------------------------------

sampleExpr :: Expr
sampleExpr = BinOp Add (BinOp Add (BinOp Mul (Var "x") (Integer 3)) (Var "y")) (BinOp Mul (Var "a") (Var "b"))

toVars :: Expr -> Intermediate
toVars expr = evalState (toVars' expr) 0
  where
    toVars' :: Expr -> State Int Intermediate
    toVars' (Integer a) = pure (Integer' a)
    toVars' (Var a) = pure (Var' a)
    toVars' (BinOp op l r) = do
      left <- toVars' l
      right <- toVars' r
      currentCount <- get
      let name = "t" <> show currentCount
      modify_ ((+) 1)
      pure $ Labeled name op left right

finale :: Intermediate -> List FinalExprType
finale = sortBy (\(Labeled'' nameA _ _ _) (Labeled'' nameB _ _ _) -> compare nameA nameB) <<< finale'
  where
  finale' (Labeled name op lft@(Labeled _ _ _ _) right@(Labeled _ _ _ _)) = List.singleton (Labeled'' name op (toPrim lft) (toPrim right)) <> finale lft <> finale right
  finale' (Labeled name op lft@(Labeled _ _ _ _) right) = List.singleton (Labeled'' name op (toPrim lft) (toPrim right)) <> finale lft
  finale' (Labeled name op lft right@(Labeled _ _ _ _)) = List.singleton (Labeled'' name op (toPrim lft) (toPrim right)) <> finale right
  finale' (Labeled name op lft right) = List.singleton (Labeled'' name op (toPrim lft) (toPrim right))
  finale' _ = List.Nil

  toPrim :: Intermediate -> FinalPrim
  toPrim (Labeled name _ _ _) = Var'' name
  toPrim (Integer' n) = Integer'' n
  toPrim (Var' n) = Var'' n

solution ∷ Expr -> List FinalExprType
solution = finale <<< toVars

prettyPrintFinalExprType :: FinalExprType -> String
prettyPrintFinalExprType (Labeled'' name op l r) = fold [name, " = ", showFinalPrim l, " ",  opToString op, " ", showFinalPrim r]
  where
  showFinalPrim (Integer'' n) = show n
  showFinalPrim (Var'' n) = n

main :: Effect Unit
main = for_ (solution sampleExpr) (log <<< prettyPrintFinalExprType)