{-# LANGUAGE OverloadedStrings #-}

{- | Front end of the compiler pipeline.

Throughout this stage, high-level syntax is progressively parsed and desugared
into simpler AST constructs.
-}
module Front where

import Common.Compiler (
  Pass,
  dump,
 )
import Common.Default (Default (..))

import qualified Front.Ast as A

import Front.DesugarLists (desugarLists)
import Front.DesugarPatTup (desugarPatTup)
import Front.DesugarStrings (desugarStrings)
import Front.ParseOperators (parseOperators)
import Front.Parser (parseProgram)
import Front.Scanner (scanTokens)
import Front.Scope (scopeProgram)
import Front.Token (prettyTokens)

import Common.Pretty (Pretty (pretty))
import Control.Monad (when)
import System.Console.GetOpt (
  ArgDescr (..),
  OptDescr (..),
 )


-- | Operation modes for the front end compiler stage.
data Mode
  = -- | Compile end-to-end (default).
    Continue
  | -- | Print the token stream from the scanner.
    DumpTokens
  | -- | Print the initial parsed AST, before operators are parsed.
    DumpAst
  | -- | Print the AST after operators are parsed.
    DumpAstParsed
  | -- | Print the AST after all desugaring, just before lowering.
    DumpAstFinal
  deriving (Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq, Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show)


-- | Compiler options for the front end compiler stage.
newtype Options = Options {Options -> Mode
optMode :: Mode} deriving (Options -> Options -> Bool
(Options -> Options -> Bool)
-> (Options -> Options -> Bool) -> Eq Options
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c== :: Options -> Options -> Bool
Eq, Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
(Int -> Options -> ShowS)
-> (Options -> String) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> String
$cshow :: Options -> String
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show)


instance Default Options where
  def :: Options
def = Options :: Mode -> Options
Options{optMode :: Mode
optMode = Mode
Continue}


-- | CLI options for the front end compiler stage.
options :: [OptDescr (Options -> Options)]
options :: [OptDescr (Options -> Options)]
options =
  [ String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      String
""
      [String
"dump-tokens"]
      ((Options -> Options) -> ArgDescr (Options -> Options)
forall a. a -> ArgDescr a
NoArg ((Options -> Options) -> ArgDescr (Options -> Options))
-> (Options -> Options) -> ArgDescr (Options -> Options)
forall a b. (a -> b) -> a -> b
$ Mode -> Options -> Options
setMode Mode
DumpTokens)
      String
"Print the token stream from the scanner"
  , String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      String
""
      [String
"dump-ast"]
      ((Options -> Options) -> ArgDescr (Options -> Options)
forall a. a -> ArgDescr a
NoArg ((Options -> Options) -> ArgDescr (Options -> Options))
-> (Options -> Options) -> ArgDescr (Options -> Options)
forall a b. (a -> b) -> a -> b
$ Mode -> Options -> Options
setMode Mode
DumpAst)
      String
"Print the initial parsed AST, before operators are parsed"
  , String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      String
""
      [String
"dump-ast-parsed"]
      ((Options -> Options) -> ArgDescr (Options -> Options)
forall a. a -> ArgDescr a
NoArg ((Options -> Options) -> ArgDescr (Options -> Options))
-> (Options -> Options) -> ArgDescr (Options -> Options)
forall a b. (a -> b) -> a -> b
$ Mode -> Options -> Options
setMode Mode
DumpAstParsed)
      String
"Print the AST after operators are parsed"
  , String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      String
""
      [String
"dump-ast-final"]
      ((Options -> Options) -> ArgDescr (Options -> Options)
forall a. a -> ArgDescr a
NoArg ((Options -> Options) -> ArgDescr (Options -> Options))
-> (Options -> Options) -> ArgDescr (Options -> Options)
forall a b. (a -> b) -> a -> b
$ Mode -> Options -> Options
setMode Mode
DumpAstFinal)
      String
"Print the AST after all desugaring, just before lowering to IR"
  ]
 where
  setMode :: Mode -> Options -> Options
  setMode :: Mode -> Options -> Options
setMode Mode
m Options
o = Options
o{optMode :: Mode
optMode = Mode
m}


-- | Parse a fully-formed AST from some String input.
parseAst :: Options -> String -> Pass A.Program
parseAst :: Options -> String -> Pass Program
parseAst Options
opt String
src = do
  Bool -> Pass () -> Pass ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Mode
optMode Options
opt Mode -> Mode -> Bool
forall a. Eq a => a -> a -> Bool
== Mode
DumpTokens) (Pass () -> Pass ()) -> Pass () -> Pass ()
forall a b. (a -> b) -> a -> b
$ do
    [Token]
ts <- String -> Pass [Token]
scanTokens String
src
    String -> Pass ()
forall a x. Pretty a => a -> Pass x
dump (String -> Pass ()) -> String -> Pass ()
forall a b. (a -> b) -> a -> b
$ [Token] -> String
prettyTokens [Token]
ts

  Program
ast <- String -> Pass Program
parseProgram String
src
  Bool -> Pass () -> Pass ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Mode
optMode Options
opt Mode -> Mode -> Bool
forall a. Eq a => a -> a -> Bool
== Mode
DumpAst) (Pass () -> Pass ()) -> Pass () -> Pass ()
forall a b. (a -> b) -> a -> b
$ String -> Pass ()
forall a x. Pretty a => a -> Pass x
dump (String -> Pass ()) -> String -> Pass ()
forall a b. (a -> b) -> a -> b
$ Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String) -> Doc Any -> String
forall a b. (a -> b) -> a -> b
$ Program -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty Program
ast

  Program
astP <- Program -> Pass Program
parseOperators Program
ast
  Bool -> Pass () -> Pass ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Mode
optMode Options
opt Mode -> Mode -> Bool
forall a. Eq a => a -> a -> Bool
== Mode
DumpAstParsed) (Pass () -> Pass ()) -> Pass () -> Pass ()
forall a b. (a -> b) -> a -> b
$ String -> Pass ()
forall a x. Pretty a => a -> Pass x
dump (String -> Pass ()) -> String -> Pass ()
forall a b. (a -> b) -> a -> b
$ Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String) -> Doc Any -> String
forall a b. (a -> b) -> a -> b
$ Program -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty Program
astP

  Program
astS <- Program -> Pass Program
desugarStrings Program
astP
  Program
astL <- Program -> Pass Program
desugarLists Program
astS
  Program
astT <- Program -> Pass Program
desugarPatTup Program
astL

  Bool -> Pass () -> Pass ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Mode
optMode Options
opt Mode -> Mode -> Bool
forall a. Eq a => a -> a -> Bool
== Mode
DumpAstFinal) (Pass () -> Pass ()) -> Pass () -> Pass ()
forall a b. (a -> b) -> a -> b
$ String -> Pass ()
forall a x. Pretty a => a -> Pass x
dump (String -> Pass ()) -> String -> Pass ()
forall a b. (a -> b) -> a -> b
$ Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String) -> Doc Any -> String
forall a b. (a -> b) -> a -> b
$ Program -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty Program
astT
  Program -> Pass Program
forall (m :: * -> *) a. Monad m => a -> m a
return Program
astT


-- | Semantic checking on an AST.
checkAst :: Options -> A.Program -> Pass ()
checkAst :: Options -> Program -> Pass ()
checkAst Options
_opt Program
ast = do
  Program -> Pass ()
scopeProgram Program
ast


-- | Front end compiler stage.
run :: Options -> String -> Pass A.Program
run :: Options -> String -> Pass Program
run Options
opt String
src = do
  Program
ast <- Options -> String -> Pass Program
parseAst Options
opt String
src
  Options -> Program -> Pass ()
checkAst Options
opt Program
ast
  Program -> Pass Program
forall (m :: * -> *) a. Monad m => a -> m a
return Program
ast