{-# Language GADTs, NamedFieldPuns #-}
module Daedalus.Type.CheckUnused where

import Data.Foldable(toList)
import Data.Maybe(isNothing)

import Daedalus.Rec

import Daedalus.Type.AST

-- import Debug.Trace
  import Daedalus . PP

checkTCModule :: TCModule SourceRange -> [SourceRange]
checkTCModule = concatMap checkTCDecl . forgetRecs . tcModuleDecls

checkTCDecl :: TCDecl SourceRange -> [SourceRange]
checkTCDecl TCDecl { tcDeclCtxt, tcDeclDef } =
  case tcDeclCtxt of
    AGrammar | Defined e <- tcDeclDef -> checkTC False e
    _ -> []

checkTC :: Bool -> TC SourceRange Grammar -> [SourceRange]
checkTC triv tc =
  --  | trace (show (triv, pp tc)) False = undefined
  --  | otherwise =
  let warnIf b = if b then [ texprAnnot tc ] else []
      okLeaf   = []
  in
  case texprValue tc of
    TCPure e -> case typeOf e of
                  Type TUnit -> okLeaf
                  _          -> warnIf triv

    TCDo mb e1 e2 ->
      checkTC (isNothing mb) e1 ++ checkTC False e2

    TCLabel _ g -> checkTC triv g

    TCMatch {}      -> okLeaf
    TCMatchBytes {} -> okLeaf

    TCChoice _ gs _ -> concatMap (checkTC False) gs
    TCOptional _ g  -> checkTC True g
    TCMany _ _ _ g  -> checkTC True g

    TCEnd           -> okLeaf
    TCOffset        -> warnIf triv
    TCCurrentStream -> warnIf triv
    TCSetStream {}  -> okLeaf
    TCStreamLen {}  -> okLeaf
    TCStreamOff {}  -> okLeaf

    TCMapLookup {}  -> okLeaf
    TCMapInsert {}  -> okLeaf
    TCArrayIndex {} -> okLeaf
    TCCoerceCheck {} -> okLeaf

    TCFor lp -> checkTC False (loopBody lp)

    TCIf _ th el -> checkTC False th ++ checkTC False el
    TCCall {} -> okLeaf

    TCVar {} -> okLeaf
    TCErrorMode _ g -> checkTC triv g
    TCFail {} -> okLeaf

    -- we don't treat unused results in a case as an error
    TCCase _ as d ->
      concat $  map (checkTC False) (toList d) ++ map checkAlt (toList as)
      where
      checkAlt a = checkTC False (tcAltBody a)



# Language GADTs, NamedFieldPuns #
 import Debug.Trace
  | trace (show (triv, pp tc)) False = undefined
  | otherwise =
 we don't treat unused results in a case as an error
module Daedalus.Type.CheckUnused where

import Data.Foldable(toList)
import Data.Maybe(isNothing)

import Daedalus.Rec

import Daedalus.Type.AST

  import Daedalus . PP

checkTCModule :: TCModule SourceRange -> [SourceRange]
checkTCModule = concatMap checkTCDecl . forgetRecs . tcModuleDecls

checkTCDecl :: TCDecl SourceRange -> [SourceRange]
checkTCDecl TCDecl { tcDeclCtxt, tcDeclDef } =
  case tcDeclCtxt of
    AGrammar | Defined e <- tcDeclDef -> checkTC False e
    _ -> []

checkTC :: Bool -> TC SourceRange Grammar -> [SourceRange]
checkTC triv tc =
  let warnIf b = if b then [ texprAnnot tc ] else []
      okLeaf   = []
  in
  case texprValue tc of
    TCPure e -> case typeOf e of
                  Type TUnit -> okLeaf
                  _          -> warnIf triv

    TCDo mb e1 e2 ->
      checkTC (isNothing mb) e1 ++ checkTC False e2

    TCLabel _ g -> checkTC triv g

    TCMatch {}      -> okLeaf
    TCMatchBytes {} -> okLeaf

    TCChoice _ gs _ -> concatMap (checkTC False) gs
    TCOptional _ g  -> checkTC True g
    TCMany _ _ _ g  -> checkTC True g

    TCEnd           -> okLeaf
    TCOffset        -> warnIf triv
    TCCurrentStream -> warnIf triv
    TCSetStream {}  -> okLeaf
    TCStreamLen {}  -> okLeaf
    TCStreamOff {}  -> okLeaf

    TCMapLookup {}  -> okLeaf
    TCMapInsert {}  -> okLeaf
    TCArrayIndex {} -> okLeaf
    TCCoerceCheck {} -> okLeaf

    TCFor lp -> checkTC False (loopBody lp)

    TCIf _ th el -> checkTC False th ++ checkTC False el
    TCCall {} -> okLeaf

    TCVar {} -> okLeaf
    TCErrorMode _ g -> checkTC triv g
    TCFail {} -> okLeaf

    TCCase _ as d ->
      concat $  map (checkTC False) (toList d) ++ map checkAlt (toList as)
      where
      checkAlt a = checkTC False (tcAltBody a)


