-- SPDX-FileCopyrightText: 2025 Sören Tempel <soeren+git@soeren-tempel.net>
--
-- SPDX-License-Identifier: GPL-3.0-only

-- | This module provides top-level definitions for representing programs
-- written in the [QBE](https://c9x.me/compile/) intermediate representation.
module Language.QBE
  ( Program,
    Definition (..),
    globalFuncs,
    Language.QBE.parse,
    ExecError (..),
    parseAndFind,
  )
where

import Control.Monad.Catch (Exception, MonadThrow, throwM)
import Data.List (find)
import Data.Maybe (mapMaybe)
import Language.QBE.Parser (dataDef, fileDef, funcDef, skipInitComments, typeDef)
import Language.QBE.Types (DataDef, FuncDef, GlobalIdent, TypeDef, fName)
import Text.ParserCombinators.Parsec
  ( ParseError,
    Parser,
    SourceName,
    choice,
    eof,
    many,
    parse,
    try,
  )

-- | A QBE program consists of a sequence of definitions. Four types of objects
-- can be defined: aggregate types, data, functions, and debugging information.
--
-- See also: The corresponding section of the [QBE specification](https://c9x.me/compile/doc/il-v1.2.html#Definitions).
data Definition
  = -- | Definition of data (e.g. a string).
    DefData DataDef
  | -- | Definition of an aggregate data type.
    DefType TypeDef
  | -- | Definition of a function.
    DefFunc FuncDef
  | -- | Definition of a debug file.
    DefFile String
  deriving (Definition -> Definition -> Bool
(Definition -> Definition -> Bool)
-> (Definition -> Definition -> Bool) -> Eq Definition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Definition -> Definition -> Bool
== :: Definition -> Definition -> Bool
$c/= :: Definition -> Definition -> Bool
/= :: Definition -> Definition -> Bool
Eq, Int -> Definition -> ShowS
[Definition] -> ShowS
Definition -> String
(Int -> Definition -> ShowS)
-> (Definition -> String)
-> ([Definition] -> ShowS)
-> Show Definition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Definition -> ShowS
showsPrec :: Int -> Definition -> ShowS
$cshow :: Definition -> String
show :: Definition -> String
$cshowList :: [Definition] -> ShowS
showList :: [Definition] -> ShowS
Show)

parseDef :: Parser Definition
parseDef :: Parser Definition
parseDef =
  [Parser Definition] -> Parser Definition
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
    [ TypeDef -> Definition
DefType (TypeDef -> Definition)
-> ParsecT String () Identity TypeDef -> Parser Definition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity TypeDef
typeDef,
      -- Need to try funcDef as both funcDef and
      -- dataDef start with a linkage definition.
      --
      -- TODO: Try parsing linkage then funcDef <|> dataDef.
      DataDef -> Definition
DefData (DataDef -> Definition)
-> ParsecT String () Identity DataDef -> Parser Definition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity DataDef
-> ParsecT String () Identity DataDef
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String () Identity DataDef
dataDef,
      FuncDef -> Definition
DefFunc (FuncDef -> Definition)
-> ParsecT String () Identity FuncDef -> Parser Definition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity FuncDef
funcDef,
      String -> Definition
DefFile (String -> Definition)
-> ParsecT String () Identity String -> Parser Definition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity String
fileDef
    ]

-- | A parsed QBE program, represented as a list of 'Definition' values.
type Program = [Definition]

-- | Wrapper to parse a QBE program using 'Text.ParserCombinators.Parsec.parse'.
parse :: SourceName -> String -> Either ParseError Program
parse :: String -> String -> Either ParseError [Definition]
parse =
  Parsec String () [Definition]
-> String -> String -> Either ParseError [Definition]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
Text.ParserCombinators.Parsec.parse
    (Parser ()
skipInitComments Parser ()
-> Parsec String () [Definition] -> Parsec String () [Definition]
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Definition -> Parsec String () [Definition]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser Definition
parseDef Parsec String () [Definition]
-> Parser () -> Parsec String () [Definition]
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)

-- | Utility function to obtain all functions defined in a QBE 'Program'.
globalFuncs :: Program -> [FuncDef]
globalFuncs :: [Definition] -> [FuncDef]
globalFuncs = (Definition -> Maybe FuncDef) -> [Definition] -> [FuncDef]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Definition -> Maybe FuncDef
globalFuncs'
  where
    globalFuncs' :: Definition -> Maybe FuncDef
    globalFuncs' :: Definition -> Maybe FuncDef
globalFuncs' (DefFunc FuncDef
f) = FuncDef -> Maybe FuncDef
forall a. a -> Maybe a
Just FuncDef
f
    globalFuncs' Definition
_ = Maybe FuncDef
forall a. Maybe a
Nothing

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

-- | Custom 'Exception' used for error handling in 'parseAndFind'.
data ExecError
  = -- | The input is not a valid QBE program.
    ESyntaxError ParseError
  | -- | The given entry function is not defined in the QBE program.
    EUnknownEntry GlobalIdent
  deriving (Int -> ExecError -> ShowS
[ExecError] -> ShowS
ExecError -> String
(Int -> ExecError -> ShowS)
-> (ExecError -> String)
-> ([ExecError] -> ShowS)
-> Show ExecError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecError -> ShowS
showsPrec :: Int -> ExecError -> ShowS
$cshow :: ExecError -> String
show :: ExecError -> String
$cshowList :: [ExecError] -> ShowS
showList :: [ExecError] -> ShowS
Show)

instance Exception ExecError

-- | Utility function for the common task of parsing an input as a QBE
-- 'Program' and, within that program, finding the entry function. If the
-- function doesn't exist or a the input is invalid a 'ExecError' exception
-- is thrown.
parseAndFind ::
  (MonadThrow m) =>
  GlobalIdent ->
  String ->
  m (Program, FuncDef)
parseAndFind :: forall (m :: * -> *).
MonadThrow m =>
GlobalIdent -> String -> m ([Definition], FuncDef)
parseAndFind GlobalIdent
entryIdent String
input = do
  [Definition]
prog <- case String -> String -> Either ParseError [Definition]
Language.QBE.parse String
"" String
input of -- TODO: file name
    Right [Definition]
rt -> [Definition] -> m [Definition]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Definition]
rt
    Left ParseError
err -> ExecError -> m [Definition]
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (ExecError -> m [Definition]) -> ExecError -> m [Definition]
forall a b. (a -> b) -> a -> b
$ ParseError -> ExecError
ESyntaxError ParseError
err

  let funcs :: [FuncDef]
funcs = [Definition] -> [FuncDef]
globalFuncs [Definition]
prog
  FuncDef
func <- case (FuncDef -> Bool) -> [FuncDef] -> Maybe FuncDef
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\FuncDef
f -> FuncDef -> GlobalIdent
fName FuncDef
f GlobalIdent -> GlobalIdent -> Bool
forall a. Eq a => a -> a -> Bool
== GlobalIdent
entryIdent) [FuncDef]
funcs of
    Just FuncDef
x -> FuncDef -> m FuncDef
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FuncDef
x
    Maybe FuncDef
Nothing -> ExecError -> m FuncDef
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (ExecError -> m FuncDef) -> ExecError -> m FuncDef
forall a b. (a -> b) -> a -> b
$ GlobalIdent -> ExecError
EUnknownEntry GlobalIdent
entryIdent

  ([Definition], FuncDef) -> m ([Definition], FuncDef)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Definition]
prog, FuncDef
func)