{-# LANGUAGE OverloadedStrings #-}

-- | @futhark defs@
module Futhark.CLI.Defs (main) where

import Data.List (isPrefixOf)
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Futhark.Compiler
import Futhark.Util.Loc
import Futhark.Util.Options
import Language.Futhark

isBuiltin :: String -> Bool
isBuiltin :: String -> Bool
isBuiltin = (String
"/prelude/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)

data DefKind = Value | Module | ModuleType | Type

data Def = Def DefKind Name Loc

kindText :: DefKind -> T.Text
kindText :: DefKind -> Text
kindText DefKind
Value = Text
"value"
kindText DefKind
Module = Text
"module"
kindText DefKind
ModuleType = Text
"module type"
kindText DefKind
Type = Text
"type"

printDef :: Def -> IO ()
printDef :: Def -> IO ()
printDef (Def DefKind
k Name
name Loc
loc) = do
  Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [DefKind -> Text
kindText DefKind
k, Name -> Text
nameToText Name
name, String -> Text
T.pack (Loc -> String
forall a. Located a => a -> String
locStr Loc
loc)]

defsInProg :: UncheckedProg -> Seq.Seq Def
defsInProg :: UncheckedProg -> Seq Def
defsInProg = (DecBase NoInfo Name -> Seq Def)
-> [DecBase NoInfo Name] -> Seq Def
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap DecBase NoInfo Name -> Seq Def
forall (f :: * -> *). DecBase f Name -> Seq Def
defsInDec ([DecBase NoInfo Name] -> Seq Def)
-> (UncheckedProg -> [DecBase NoInfo Name])
-> UncheckedProg
-> Seq Def
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UncheckedProg -> [DecBase NoInfo Name]
forall (f :: * -> *) vn. ProgBase f vn -> [DecBase f vn]
progDecs
  where
    defsInDec :: DecBase f Name -> Seq Def
defsInDec (ValDec ValBindBase f Name
vb) =
      Def -> Seq Def
forall a. a -> Seq a
Seq.singleton (Def -> Seq Def) -> Def -> Seq Def
forall a b. (a -> b) -> a -> b
$ DefKind -> Name -> Loc -> Def
Def DefKind
Value (ValBindBase f Name -> Name
forall (f :: * -> *) vn. ValBindBase f vn -> vn
valBindName ValBindBase f Name
vb) (ValBindBase f Name -> Loc
forall a. Located a => a -> Loc
locOf ValBindBase f Name
vb)
    defsInDec (TypeDec TypeBindBase f Name
tb) =
      Def -> Seq Def
forall a. a -> Seq a
Seq.singleton (Def -> Seq Def) -> Def -> Seq Def
forall a b. (a -> b) -> a -> b
$ DefKind -> Name -> Loc -> Def
Def DefKind
Type (TypeBindBase f Name -> Name
forall (f :: * -> *) vn. TypeBindBase f vn -> vn
typeAlias TypeBindBase f Name
tb) (TypeBindBase f Name -> Loc
forall a. Located a => a -> Loc
locOf TypeBindBase f Name
tb)
    defsInDec (LocalDec DecBase f Name
d SrcLoc
_) = DecBase f Name -> Seq Def
defsInDec DecBase f Name
d
    defsInDec (OpenDec ModExpBase f Name
me SrcLoc
_) = ModExpBase f Name -> Seq Def
defsInModExp ModExpBase f Name
me
    defsInDec (ModDec ModBindBase f Name
mb) = ModExpBase f Name -> Seq Def
defsInModExp (ModExpBase f Name -> Seq Def) -> ModExpBase f Name -> Seq Def
forall a b. (a -> b) -> a -> b
$ ModBindBase f Name -> ModExpBase f Name
forall (f :: * -> *) vn. ModBindBase f vn -> ModExpBase f vn
modExp ModBindBase f Name
mb
    defsInDec SigDec {} = Seq Def
forall a. Monoid a => a
mempty
    defsInDec ImportDec {} = Seq Def
forall a. Monoid a => a
mempty

    defsInModExp :: ModExpBase f Name -> Seq Def
defsInModExp ModVar {} = Seq Def
forall a. Monoid a => a
mempty
    defsInModExp (ModParens ModExpBase f Name
me SrcLoc
_) = ModExpBase f Name -> Seq Def
defsInModExp ModExpBase f Name
me
    defsInModExp ModImport {} = Seq Def
forall a. Monoid a => a
mempty
    defsInModExp (ModDecs [DecBase f Name]
ds SrcLoc
_) = (DecBase f Name -> Seq Def) -> [DecBase f Name] -> Seq Def
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap DecBase f Name -> Seq Def
defsInDec [DecBase f Name]
ds
    defsInModExp (ModApply ModExpBase f Name
me1 ModExpBase f Name
me2 f (Map VName VName)
_ f (Map VName VName)
_ SrcLoc
_) = ModExpBase f Name -> Seq Def
defsInModExp ModExpBase f Name
me1 Seq Def -> Seq Def -> Seq Def
forall a. Semigroup a => a -> a -> a
<> ModExpBase f Name -> Seq Def
defsInModExp ModExpBase f Name
me2
    defsInModExp (ModAscript ModExpBase f Name
me SigExpBase f Name
_ f (Map VName VName)
_ SrcLoc
_) = ModExpBase f Name -> Seq Def
defsInModExp ModExpBase f Name
me
    defsInModExp (ModLambda ModParamBase f Name
_ Maybe (SigExpBase f Name, f (Map VName VName))
_ ModExpBase f Name
me SrcLoc
_) = ModExpBase f Name -> Seq Def
defsInModExp ModExpBase f Name
me

-- | Run @futhark defs@.
main :: String -> [String] -> IO ()
main :: String -> [String] -> IO ()
main = ()
-> [FunOptDescr ()]
-> String
-> ([String] -> () -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions () [] String
"program" (([String] -> () -> Maybe (IO ())) -> String -> [String] -> IO ())
-> ([String] -> () -> Maybe (IO ())) -> String -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ \[String]
args () ->
  case [String]
args of
    [String
file] -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ do
      [(String, UncheckedProg)]
prog <- String -> IO [(String, UncheckedProg)]
forall (m :: * -> *).
MonadIO m =>
String -> m [(String, UncheckedProg)]
readUntypedProgramOrDie String
file
      (Def -> IO ()) -> Seq Def -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Def -> IO ()
printDef (Seq Def -> IO ())
-> ([(String, UncheckedProg)] -> Seq Def)
-> [(String, UncheckedProg)]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, UncheckedProg) -> Seq Def)
-> [(String, UncheckedProg)] -> Seq Def
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (UncheckedProg -> Seq Def
defsInProg (UncheckedProg -> Seq Def)
-> ((String, UncheckedProg) -> UncheckedProg)
-> (String, UncheckedProg)
-> Seq Def
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, UncheckedProg) -> UncheckedProg
forall a b. (a, b) -> b
snd) ([(String, UncheckedProg)] -> IO ())
-> [(String, UncheckedProg)] -> IO ()
forall a b. (a -> b) -> a -> b
$
        ((String, UncheckedProg) -> Bool)
-> [(String, UncheckedProg)] -> [(String, UncheckedProg)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((String, UncheckedProg) -> Bool)
-> (String, UncheckedProg)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isBuiltin (String -> Bool)
-> ((String, UncheckedProg) -> String)
-> (String, UncheckedProg)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, UncheckedProg) -> String
forall a b. (a, b) -> a
fst) [(String, UncheckedProg)]
prog
    [String]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing