{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright 2014 2015 2016, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE

-- Allow us to use a shorter form of Name.
{-# LANGUAGE PatternSynonyms #-}

-- The entry point for parsing an ExtOpenScad program.
module Graphics.Implicit.ExtOpenScad.Parser.Statement (parseProgram) where

import Prelude(Char, Either, String, ($), (*>), Bool(False, True), (<$>), (<*>), (.), (<$), flip, fmap, filter, not, pure)

import Data.Maybe(Maybe(Just, Nothing))

import Graphics.Implicit.ExtOpenScad.Definitions (Statement(DoNothing, NewModule, Include, If, ModuleCall, (:=)), Expr(LamE), StatementI(StatementI), Symbol(Symbol), SourcePosition)

import qualified Graphics.Implicit.ExtOpenScad.Definitions as GIED (Pattern(Name))

import Graphics.Implicit.ExtOpenScad.Parser.Util ((*<|>), patternMatcher, sourcePosition)

-- the top level of the expression parser.
import Graphics.Implicit.ExtOpenScad.Parser.Expr (expr0)

-- The lexer.
import Graphics.Implicit.ExtOpenScad.Parser.Lexer (whiteSpace, matchFunction, matchInclude, matchUse, matchIf, matchElse, matchModule, matchTok, matchComma, matchSemi, surroundedBy, matchIdentifier)

-- We use parsec to parse.
import Text.Parsec (SourceName, (<?>), sepBy, oneOf, getPosition, parse, eof, ParseError, many, noneOf, option, between, char, optionMaybe)

import Text.Parsec.String (GenParser)

import Control.Applicative ((<*), (<|>))

import Data.Functor (($>))

import Data.Text.Lazy (Text, pack)

-- Let us use the old syntax when defining Names.
pattern Name :: Text -> GIED.Pattern
pattern $bName :: Text -> Pattern
$mName :: forall r. Pattern -> (Text -> r) -> (Void# -> r) -> r
Name n = GIED.Name (Symbol n)

data CompIdx = A1 | A2

-- | all of the token parsers are lexemes which consume all trailing spaces nicely.
-- | This leaves us to deal only with the first spaces in the file.
parseProgram :: SourceName -> String -> Either ParseError [StatementI]
parseProgram :: SourceName -> SourceName -> Either ParseError [StatementI]
parseProgram = Parsec SourceName () [StatementI]
-> SourceName -> SourceName -> Either ParseError [StatementI]
forall s t a.
Stream s Identity t =>
Parsec s () a -> SourceName -> s -> Either ParseError a
parse Parsec SourceName () [StatementI]
forall st. GenParser Char st [StatementI]
program where
    program :: GenParser Char st [StatementI]
    program :: GenParser Char st [StatementI]
program = [StatementI] -> [StatementI]
removeNoOps ([StatementI] -> [StatementI])
-> GenParser Char st [StatementI] -> GenParser Char st [StatementI]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GenParser Char st ()
forall st. GenParser Char st ()
whiteSpace GenParser Char st ()
-> GenParser Char st [StatementI] -> GenParser Char st [StatementI]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT SourceName st Identity StatementI
-> GenParser Char st [StatementI]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (CompIdx -> ParsecT SourceName st Identity StatementI
forall st. CompIdx -> GenParser Char st StatementI
computation CompIdx
A1) GenParser Char st [StatementI]
-> GenParser Char st () -> GenParser Char st [StatementI]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* GenParser Char st ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)

-- | A computable block of code in our openscad-like programming language.
computation :: CompIdx -> GenParser Char st StatementI
computation :: CompIdx -> GenParser Char st StatementI
computation CompIdx
A1 =
  CompIdx -> GenParser Char st StatementI
forall st. CompIdx -> GenParser Char st StatementI
computation CompIdx
A2
  GenParser Char st StatementI
-> GenParser Char st StatementI -> GenParser Char st StatementI
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  GenParser Char st StatementI
forall st. GenParser Char st StatementI
throwAway

computation CompIdx
A2 =
  -- suite statements: no semicolon...
  GenParser Char st StatementI
forall st. GenParser Char st StatementI
userModule
  GenParser Char st StatementI
-> GenParser Char st StatementI -> GenParser Char st StatementI
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  GenParser Char st StatementI
forall st. GenParser Char st StatementI
ifStatementI
  GenParser Char st StatementI
-> GenParser Char st StatementI -> GenParser Char st StatementI
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  GenParser Char st StatementI
forall st. GenParser Char st StatementI
userModuleDeclaration
  GenParser Char st StatementI
-> GenParser Char st StatementI -> GenParser Char st StatementI
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> -- Non suite statements. Semicolon needed...
  ( GenParser Char st StatementI
forall st. GenParser Char st StatementI
include
    GenParser Char st StatementI
-> GenParser Char st StatementI -> GenParser Char st StatementI
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    GenParser Char st StatementI
forall st. GenParser Char st StatementI
function
  ) GenParser Char st StatementI
-> ParsecT SourceName st Identity Text
-> GenParser Char st StatementI
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT SourceName st Identity Text
forall st. GenParser Char st Text
matchSemi
  GenParser Char st StatementI
-> GenParser Char st StatementI -> GenParser Char st StatementI
forall tok u a.
GenParser tok u a -> GenParser tok u a -> GenParser tok u a
*<|>
  GenParser Char st StatementI
forall st. GenParser Char st StatementI
assignment GenParser Char st StatementI
-> ParsecT SourceName st Identity Text
-> GenParser Char st StatementI
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT SourceName st Identity Text
forall st. GenParser Char st Text
matchSemi

-- | A suite of s!
--   What's a suite? Consider:
--
--      union() {
--         sphere(3);
--      }
--
--  The suite was in the braces ({}). Similarily, the
--  following has the same suite:
--
--      union() sphere(3);
--
--  We consider it to be a list of computables which
--  are in turn StatementI s.
suite :: GenParser Char st [StatementI]
suite :: GenParser Char st [StatementI]
suite = (
    [StatementI] -> [StatementI]
removeNoOps ([StatementI] -> [StatementI])
-> (StatementI -> [StatementI]) -> StatementI -> [StatementI]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StatementI -> [StatementI] -> [StatementI]
forall a. a -> [a] -> [a]
:[]) (StatementI -> [StatementI])
-> ParsecT SourceName st Identity StatementI
-> GenParser Char st [StatementI]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompIdx -> ParsecT SourceName st Identity StatementI
forall st. CompIdx -> GenParser Char st StatementI
computation CompIdx
A1
  GenParser Char st [StatementI]
-> GenParser Char st [StatementI] -> GenParser Char st [StatementI]
forall tok u a.
GenParser tok u a -> GenParser tok u a -> GenParser tok u a
*<|>
    [StatementI] -> [StatementI]
removeNoOps ([StatementI] -> [StatementI])
-> GenParser Char st [StatementI] -> GenParser Char st [StatementI]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char
-> GenParser Char st [StatementI]
-> Char
-> GenParser Char st [StatementI]
forall st a.
Char -> GenParser Char st a -> Char -> GenParser Char st a
surroundedBy Char
'{' (ParsecT SourceName st Identity StatementI
-> GenParser Char st [StatementI]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (CompIdx -> ParsecT SourceName st Identity StatementI
forall st. CompIdx -> GenParser Char st StatementI
computation CompIdx
A1)) Char
'}'
  ) GenParser Char st [StatementI]
-> SourceName -> GenParser Char st [StatementI]
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"suite"

-- | Every StatementI requires a source position, thus we can build a combinator.
statementI :: GenParser Char st (Statement StatementI) -> GenParser Char st StatementI
statementI :: GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
statementI GenParser Char st (Statement StatementI)
p = SourcePosition -> Statement StatementI -> StatementI
StatementI (SourcePosition -> Statement StatementI -> StatementI)
-> ParsecT SourceName st Identity SourcePosition
-> ParsecT
     SourceName st Identity (Statement StatementI -> StatementI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SourceName st Identity SourcePosition
forall st. GenParser Char st SourcePosition
sourcePos ParsecT SourceName st Identity (Statement StatementI -> StatementI)
-> GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenParser Char st (Statement StatementI)
p

-- | Commenting out a computation: use % or * before the statement, and it will not be run.
throwAway :: GenParser Char st StatementI
throwAway :: GenParser Char st StatementI
throwAway = GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
forall st.
GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
statementI (GenParser Char st (Statement StatementI)
 -> GenParser Char st StatementI)
-> GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
forall a b. (a -> b) -> a -> b
$ Statement StatementI
forall st. Statement st
DoNothing Statement StatementI
-> ParsecT SourceName st Identity Char
-> GenParser Char st (Statement StatementI)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SourceName -> ParsecT SourceName st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m Char
oneOf SourceName
"%*" GenParser Char st (Statement StatementI)
-> ParsecT SourceName st Identity ()
-> GenParser Char st (Statement StatementI)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT SourceName st Identity ()
forall st. GenParser Char st ()
whiteSpace GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
-> GenParser Char st (Statement StatementI)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CompIdx -> GenParser Char st StatementI
forall st. CompIdx -> GenParser Char st StatementI
computation CompIdx
A2

-- | An include! Basically, inject another extopenscad file here...
include :: GenParser Char st StatementI
include :: GenParser Char st StatementI
include = GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
forall st.
GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
statementI GenParser Char st (Statement StatementI)
forall st. GenParser Char st (Statement StatementI)
p GenParser Char st StatementI
-> SourceName -> GenParser Char st StatementI
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"include/use"
  where
    p :: GenParser Char st (Statement StatementI)
    p :: GenParser Char st (Statement StatementI)
p = (Text -> Bool -> Statement StatementI)
-> Bool -> Text -> Statement StatementI
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Bool -> Statement StatementI
forall st. Text -> Bool -> Statement st
Include
      (Bool -> Text -> Statement StatementI)
-> ParsecT SourceName st Identity Bool
-> ParsecT SourceName st Identity (Text -> Statement StatementI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GenParser Char st ()
forall st. GenParser Char st ()
matchInclude GenParser Char st () -> Bool -> ParsecT SourceName st Identity Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True ParsecT SourceName st Identity Bool
-> ParsecT SourceName st Identity Bool
-> ParsecT SourceName st Identity Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> GenParser Char st ()
forall st. GenParser Char st ()
matchUse GenParser Char st () -> Bool -> ParsecT SourceName st Identity Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False)
      -- FIXME: better definition of valid filename characters.
      ParsecT SourceName st Identity (Text -> Statement StatementI)
-> ParsecT SourceName st Identity Text
-> GenParser Char st (Statement StatementI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SourceName -> Text
pack (SourceName -> Text)
-> ParsecT SourceName st Identity SourceName
-> ParsecT SourceName st Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SourceName st Identity Char
-> ParsecT SourceName st Identity Char
-> ParsecT SourceName st Identity SourceName
-> ParsecT SourceName st Identity SourceName
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT SourceName st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<') (Char -> ParsecT SourceName st Identity Char
forall st. Char -> GenParser Char st Char
matchTok Char
'>') (ParsecT SourceName st Identity Char
-> ParsecT SourceName st Identity SourceName
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT SourceName st Identity Char
 -> ParsecT SourceName st Identity SourceName)
-> ParsecT SourceName st Identity Char
-> ParsecT SourceName st Identity SourceName
forall a b. (a -> b) -> a -> b
$ SourceName -> ParsecT SourceName st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m Char
noneOf SourceName
"<> "))

-- | An assignment (parser)
assignment :: GenParser Char st StatementI
assignment :: GenParser Char st StatementI
assignment = GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
forall st.
GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
statementI GenParser Char st (Statement StatementI)
forall st. GenParser Char st (Statement StatementI)
p GenParser Char st StatementI
-> SourceName -> GenParser Char st StatementI
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"assignment"
  where
    p :: GenParser Char st (Statement StatementI)
    p :: GenParser Char st (Statement StatementI)
p = Pattern -> Expr -> Statement StatementI
forall st. Pattern -> Expr -> Statement st
(:=) (Pattern -> Expr -> Statement StatementI)
-> ParsecT SourceName st Identity Pattern
-> ParsecT SourceName st Identity (Expr -> Statement StatementI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SourceName st Identity Pattern
forall st. GenParser Char st Pattern
patternMatcher ParsecT SourceName st Identity (Expr -> Statement StatementI)
-> ParsecT SourceName st Identity Char
-> ParsecT SourceName st Identity (Expr -> Statement StatementI)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT SourceName st Identity Char
forall st. Char -> GenParser Char st Char
matchTok Char
'=' ParsecT SourceName st Identity (Expr -> Statement StatementI)
-> ParsecT SourceName st Identity Expr
-> GenParser Char st (Statement StatementI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT SourceName st Identity Expr
forall st. GenParser Char st Expr
expr0

-- | A function declaration (parser)
function :: GenParser Char st StatementI
function :: GenParser Char st StatementI
function = GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
forall st.
GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
statementI GenParser Char st (Statement StatementI)
forall st. GenParser Char st (Statement StatementI)
p GenParser Char st StatementI
-> SourceName -> GenParser Char st StatementI
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"function"
  where
    p :: GenParser Char st (Statement StatementI)
    p :: GenParser Char st (Statement StatementI)
p = Pattern -> Expr -> Statement StatementI
forall st. Pattern -> Expr -> Statement st
(:=) (Pattern -> Expr -> Statement StatementI)
-> ParsecT SourceName st Identity Pattern
-> ParsecT SourceName st Identity (Expr -> Statement StatementI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SourceName st Identity Pattern
forall st. GenParser Char st Pattern
lval ParsecT SourceName st Identity (Expr -> Statement StatementI)
-> ParsecT SourceName st Identity Expr
-> GenParser Char st (Statement StatementI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT SourceName st Identity Expr
forall st. GenParser Char st Expr
rval
    lval :: GenParser Char st GIED.Pattern
    lval :: GenParser Char st Pattern
lval = Text -> Pattern
Name (Text -> Pattern) -> (SourceName -> Text) -> SourceName -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceName -> Text
pack (SourceName -> Pattern)
-> ParsecT SourceName st Identity SourceName
-> GenParser Char st Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GenParser Char st ()
forall st. GenParser Char st ()
matchFunction GenParser Char st ()
-> ParsecT SourceName st Identity SourceName
-> ParsecT SourceName st Identity SourceName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT SourceName st Identity SourceName
forall st. GenParser Char st SourceName
matchIdentifier)
    rval :: GenParser Char st Expr
    rval :: GenParser Char st Expr
rval = [Pattern] -> Expr -> Expr
LamE ([Pattern] -> Expr -> Expr)
-> ParsecT SourceName st Identity [Pattern]
-> ParsecT SourceName st Identity (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char
-> ParsecT SourceName st Identity [Pattern]
-> Char
-> ParsecT SourceName st Identity [Pattern]
forall st a.
Char -> GenParser Char st a -> Char -> GenParser Char st a
surroundedBy Char
'(' (ParsecT SourceName st Identity Pattern
-> ParsecT SourceName st Identity Text
-> ParsecT SourceName st Identity [Pattern]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT SourceName st Identity Pattern
forall st. GenParser Char st Pattern
patternMatcher ParsecT SourceName st Identity Text
forall st. GenParser Char st Text
matchComma) Char
')' ParsecT SourceName st Identity (Expr -> Expr)
-> GenParser Char st Expr -> GenParser Char st Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> GenParser Char st Char
forall st. Char -> GenParser Char st Char
matchTok Char
'=' GenParser Char st Char
-> GenParser Char st Expr -> GenParser Char st Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GenParser Char st Expr
forall st. GenParser Char st Expr
expr0)

-- | An if statement (parser)
ifStatementI :: GenParser Char st StatementI
ifStatementI :: GenParser Char st StatementI
ifStatementI = GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
forall st.
GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
statementI GenParser Char st (Statement StatementI)
forall st. GenParser Char st (Statement StatementI)
p GenParser Char st StatementI
-> SourceName -> GenParser Char st StatementI
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"if"
  where
    p :: GenParser Char st (Statement StatementI)
    p :: GenParser Char st (Statement StatementI)
p = Expr -> [StatementI] -> [StatementI] -> Statement StatementI
forall st. Expr -> [st] -> [st] -> Statement st
If (Expr -> [StatementI] -> [StatementI] -> Statement StatementI)
-> ParsecT SourceName st Identity Expr
-> ParsecT
     SourceName
     st
     Identity
     ([StatementI] -> [StatementI] -> Statement StatementI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GenParser Char st ()
forall st. GenParser Char st ()
matchIf GenParser Char st ()
-> ParsecT SourceName st Identity Expr
-> ParsecT SourceName st Identity Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char
-> ParsecT SourceName st Identity Expr
-> Char
-> ParsecT SourceName st Identity Expr
forall st a.
Char -> GenParser Char st a -> Char -> GenParser Char st a
surroundedBy Char
'(' ParsecT SourceName st Identity Expr
forall st. GenParser Char st Expr
expr0 Char
')') ParsecT
  SourceName
  st
  Identity
  ([StatementI] -> [StatementI] -> Statement StatementI)
-> ParsecT SourceName st Identity [StatementI]
-> ParsecT
     SourceName st Identity ([StatementI] -> Statement StatementI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT SourceName st Identity [StatementI]
forall st. GenParser Char st [StatementI]
suite ParsecT
  SourceName st Identity ([StatementI] -> Statement StatementI)
-> ParsecT SourceName st Identity [StatementI]
-> GenParser Char st (Statement StatementI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [StatementI]
-> ParsecT SourceName st Identity [StatementI]
-> ParsecT SourceName st Identity [StatementI]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (GenParser Char st ()
forall st. GenParser Char st ()
matchElse GenParser Char st ()
-> ParsecT SourceName st Identity [StatementI]
-> ParsecT SourceName st Identity [StatementI]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT SourceName st Identity [StatementI]
forall st. GenParser Char st [StatementI]
suite)

-- | parse a call to a module.
userModule :: GenParser Char st StatementI
userModule :: GenParser Char st StatementI
userModule = GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
forall st.
GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
statementI GenParser Char st (Statement StatementI)
forall st. GenParser Char st (Statement StatementI)
p GenParser Char st StatementI
-> SourceName -> GenParser Char st StatementI
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"module call"
  where
    p :: GenParser Char st (Statement StatementI)
    p :: GenParser Char st (Statement StatementI)
p = Symbol
-> [(Maybe Symbol, Expr)] -> [StatementI] -> Statement StatementI
forall st. Symbol -> [(Maybe Symbol, Expr)] -> [st] -> Statement st
ModuleCall (Symbol
 -> [(Maybe Symbol, Expr)] -> [StatementI] -> Statement StatementI)
-> ParsecT SourceName st Identity Symbol
-> ParsecT
     SourceName
     st
     Identity
     ([(Maybe Symbol, Expr)] -> [StatementI] -> Statement StatementI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SourceName -> Symbol)
-> ParsecT SourceName st Identity SourceName
-> ParsecT SourceName st Identity Symbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Symbol
Symbol (Text -> Symbol) -> (SourceName -> Text) -> SourceName -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceName -> Text
pack) ParsecT SourceName st Identity SourceName
forall st. GenParser Char st SourceName
matchIdentifier ParsecT
  SourceName
  st
  Identity
  ([(Maybe Symbol, Expr)] -> [StatementI] -> Statement StatementI)
-> ParsecT SourceName st Identity [(Maybe Symbol, Expr)]
-> ParsecT
     SourceName st Identity ([StatementI] -> Statement StatementI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT SourceName st Identity [(Maybe Symbol, Expr)]
forall st. GenParser Char st [(Maybe Symbol, Expr)]
moduleArgsUnit ParsecT
  SourceName st Identity ([StatementI] -> Statement StatementI)
-> ParsecT SourceName st Identity [StatementI]
-> GenParser Char st (Statement StatementI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT SourceName st Identity [StatementI]
forall st. GenParser Char st [StatementI]
suite ParsecT SourceName st Identity [StatementI]
-> ParsecT SourceName st Identity [StatementI]
-> ParsecT SourceName st Identity [StatementI]
forall tok u a.
GenParser tok u a -> GenParser tok u a -> GenParser tok u a
*<|> (GenParser Char st Text
forall st. GenParser Char st Text
matchSemi GenParser Char st Text
-> [StatementI] -> ParsecT SourceName st Identity [StatementI]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> []))

-- | declare a module.
userModuleDeclaration :: GenParser Char st StatementI
userModuleDeclaration :: GenParser Char st StatementI
userModuleDeclaration = GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
forall st.
GenParser Char st (Statement StatementI)
-> GenParser Char st StatementI
statementI GenParser Char st (Statement StatementI)
forall st. GenParser Char st (Statement StatementI)
p GenParser Char st StatementI
-> SourceName -> GenParser Char st StatementI
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"module declaration"
  where
    p :: GenParser Char st (Statement StatementI)
    p :: GenParser Char st (Statement StatementI)
p = Symbol
-> [(Symbol, Maybe Expr)] -> [StatementI] -> Statement StatementI
forall st. Symbol -> [(Symbol, Maybe Expr)] -> [st] -> Statement st
NewModule (Symbol
 -> [(Symbol, Maybe Expr)] -> [StatementI] -> Statement StatementI)
-> ParsecT SourceName st Identity Symbol
-> ParsecT
     SourceName
     st
     Identity
     ([(Symbol, Maybe Expr)] -> [StatementI] -> Statement StatementI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SourceName -> Symbol)
-> ParsecT SourceName st Identity SourceName
-> ParsecT SourceName st Identity Symbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Symbol
Symbol (Text -> Symbol) -> (SourceName -> Text) -> SourceName -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceName -> Text
pack) (GenParser Char st ()
forall st. GenParser Char st ()
matchModule GenParser Char st ()
-> ParsecT SourceName st Identity SourceName
-> ParsecT SourceName st Identity SourceName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT SourceName st Identity SourceName
forall st. GenParser Char st SourceName
matchIdentifier) ParsecT
  SourceName
  st
  Identity
  ([(Symbol, Maybe Expr)] -> [StatementI] -> Statement StatementI)
-> ParsecT SourceName st Identity [(Symbol, Maybe Expr)]
-> ParsecT
     SourceName st Identity ([StatementI] -> Statement StatementI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT SourceName st Identity [(Symbol, Maybe Expr)]
forall st. GenParser Char st [(Symbol, Maybe Expr)]
moduleArgsUnitDecl ParsecT
  SourceName st Identity ([StatementI] -> Statement StatementI)
-> ParsecT SourceName st Identity [StatementI]
-> GenParser Char st (Statement StatementI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT SourceName st Identity [StatementI]
forall st. GenParser Char st [StatementI]
suite

-- | parse the arguments passed to a module.
moduleArgsUnit :: GenParser Char st [(Maybe Symbol, Expr)]
moduleArgsUnit :: GenParser Char st [(Maybe Symbol, Expr)]
moduleArgsUnit =
    Char
-> GenParser Char st [(Maybe Symbol, Expr)]
-> Char
-> GenParser Char st [(Maybe Symbol, Expr)]
forall st a.
Char -> GenParser Char st a -> Char -> GenParser Char st a
surroundedBy Char
'('
      (ParsecT SourceName st Identity (Maybe Symbol, Expr)
-> ParsecT SourceName st Identity Text
-> GenParser Char st [(Maybe Symbol, Expr)]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy (
        do
            -- eg. a = 12
            SourceName
symb <- GenParser Char st SourceName
forall st. GenParser Char st SourceName
matchIdentifier
            Expr
expr <- Char -> GenParser Char st Char
forall st. Char -> GenParser Char st Char
matchTok Char
'=' GenParser Char st Char
-> ParsecT SourceName st Identity Expr
-> ParsecT SourceName st Identity Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT SourceName st Identity Expr
forall st. GenParser Char st Expr
expr0
            (Maybe Symbol, Expr)
-> ParsecT SourceName st Identity (Maybe Symbol, Expr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Symbol -> Maybe Symbol
forall a. a -> Maybe a
Just (Text -> Symbol
Symbol (Text -> Symbol) -> Text -> Symbol
forall a b. (a -> b) -> a -> b
$ SourceName -> Text
pack SourceName
symb), Expr
expr)
        ParsecT SourceName st Identity (Maybe Symbol, Expr)
-> ParsecT SourceName st Identity (Maybe Symbol, Expr)
-> ParsecT SourceName st Identity (Maybe Symbol, Expr)
forall tok u a.
GenParser tok u a -> GenParser tok u a -> GenParser tok u a
*<|> do
            -- eg. a(x,y) = 12
            SourceName
symb <- GenParser Char st SourceName
forall st. GenParser Char st SourceName
matchIdentifier
            [SourceName]
argVars <- Char
-> GenParser Char st [SourceName]
-> Char
-> GenParser Char st [SourceName]
forall st a.
Char -> GenParser Char st a -> Char -> GenParser Char st a
surroundedBy Char
'(' (GenParser Char st SourceName
-> ParsecT SourceName st Identity Text
-> GenParser Char st [SourceName]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy GenParser Char st SourceName
forall st. GenParser Char st SourceName
matchIdentifier ParsecT SourceName st Identity Text
forall st. GenParser Char st Text
matchComma) Char
')'
            Expr
expr <- Char -> GenParser Char st Char
forall st. Char -> GenParser Char st Char
matchTok Char
'=' GenParser Char st Char
-> ParsecT SourceName st Identity Expr
-> ParsecT SourceName st Identity Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT SourceName st Identity Expr
forall st. GenParser Char st Expr
expr0
            (Maybe Symbol, Expr)
-> ParsecT SourceName st Identity (Maybe Symbol, Expr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Symbol -> Maybe Symbol
forall a. a -> Maybe a
Just (Text -> Symbol
Symbol (Text -> Symbol) -> Text -> Symbol
forall a b. (a -> b) -> a -> b
$ SourceName -> Text
pack SourceName
symb), [Pattern] -> Expr -> Expr
LamE ((SourceName -> Pattern) -> [SourceName] -> [Pattern]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Pattern
Name (Text -> Pattern) -> (SourceName -> Text) -> SourceName -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceName -> Text
pack) [SourceName]
argVars) Expr
expr)
        ParsecT SourceName st Identity (Maybe Symbol, Expr)
-> ParsecT SourceName st Identity (Maybe Symbol, Expr)
-> ParsecT SourceName st Identity (Maybe Symbol, Expr)
forall tok u a.
GenParser tok u a -> GenParser tok u a -> GenParser tok u a
*<|> do
            -- eg. 12
            Expr
expr <- ParsecT SourceName st Identity Expr
forall st. GenParser Char st Expr
expr0
            (Maybe Symbol, Expr)
-> ParsecT SourceName st Identity (Maybe Symbol, Expr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Symbol
forall a. Maybe a
Nothing, Expr
expr)
      ) ParsecT SourceName st Identity Text
forall st. GenParser Char st Text
matchComma)
      Char
')'

-- | parse the arguments in the module declaration.
moduleArgsUnitDecl ::  GenParser Char st [(Symbol, Maybe Expr)]
moduleArgsUnitDecl :: GenParser Char st [(Symbol, Maybe Expr)]
moduleArgsUnitDecl =
    Char
-> GenParser Char st [(Symbol, Maybe Expr)]
-> Char
-> GenParser Char st [(Symbol, Maybe Expr)]
forall st a.
Char -> GenParser Char st a -> Char -> GenParser Char st a
surroundedBy Char
'('
      (ParsecT SourceName st Identity (Symbol, Maybe Expr)
-> ParsecT SourceName st Identity Text
-> GenParser Char st [(Symbol, Maybe Expr)]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy (
        do
          SourceName
symb <- GenParser Char st SourceName
forall st. GenParser Char st SourceName
matchIdentifier
          Maybe Expr
expr <- ParsecT SourceName st Identity Expr
-> ParsecT SourceName st Identity (Maybe Expr)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (Char -> GenParser Char st Char
forall st. Char -> GenParser Char st Char
matchTok Char
'=' GenParser Char st Char
-> ParsecT SourceName st Identity Expr
-> ParsecT SourceName st Identity Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT SourceName st Identity Expr
forall st. GenParser Char st Expr
expr0)
          (Symbol, Maybe Expr)
-> ParsecT SourceName st Identity (Symbol, Maybe Expr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Symbol
Symbol (Text -> Symbol) -> Text -> Symbol
forall a b. (a -> b) -> a -> b
$ SourceName -> Text
pack SourceName
symb, Maybe Expr
expr)
      ) ParsecT SourceName st Identity Text
forall st. GenParser Char st Text
matchComma)
      Char
')'

-- | Find the source position. Used when generating errors.
sourcePos :: GenParser Char st SourcePosition
sourcePos :: GenParser Char st SourcePosition
sourcePos = SourcePos -> SourcePosition
sourcePosition (SourcePos -> SourcePosition)
-> ParsecT SourceName st Identity SourcePos
-> GenParser Char st SourcePosition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SourceName st Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition

isNoOp :: StatementI -> Bool
isNoOp :: StatementI -> Bool
isNoOp (StatementI SourcePosition
_ Statement StatementI
DoNothing) = Bool
True
isNoOp StatementI
_                        = Bool
False

-- | Remove statements that do nothing.
removeNoOps :: [StatementI] -> [StatementI]
removeNoOps :: [StatementI] -> [StatementI]
removeNoOps = (StatementI -> Bool) -> [StatementI] -> [StatementI]
forall a. (a -> Bool) -> [a] -> [a]
filter ((StatementI -> Bool) -> [StatementI] -> [StatementI])
-> (StatementI -> Bool) -> [StatementI] -> [StatementI]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (StatementI -> Bool) -> StatementI -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatementI -> Bool
isNoOp