{- -----------------------------------------------------------------------------
Copyright 2019-2023 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- -}

-- Author: Kevin P. Barry [ta0kira@gmail.com]

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Safe #-}

module CompilerCxx.Procedure (
  CxxFunctionType(..),
  categoriesFromTypes,
  categoriesFromDefine,
  categoriesFromRefine,
  compileExecutableProcedure,
  compileMainProcedure,
  compileLazyInit,
  compileRegularInit,
  compileTestProcedure,
  compileWrapTestcase,
  procedureDeclaration,
  selectTestFromArgv1,
) where

import Control.Applicative ((<|>))
import Control.Monad (when)
import Control.Monad.Trans.State (execStateT,get,put,runStateT)
import Control.Monad.Trans (lift)
import Data.List (intercalate,nub)
import qualified Data.Map as Map
import qualified Data.Set as Set

import Base.CompilerError
import Base.GeneralType
import Base.Mergeable (mergeAny)
import Base.MergeTree
import Base.Positional
import Compilation.CompilerState
import Compilation.ProcedureContext (ExprMap)
import Compilation.ScopeContext
import CompilerCxx.CategoryContext
import CompilerCxx.Code
import CompilerCxx.Naming
import Types.Builtin
import Types.DefinedCategory
import Types.Function
import Types.Procedure
import Types.TypeCategory
import Types.TypeInstance
import Types.Variance


procedureDeclaration :: Monad m => Bool -> Bool -> ScopedFunction c -> m (CompiledData [String])
procedureDeclaration :: forall (m :: * -> *) c.
Monad m =>
Bool -> Bool -> ScopedFunction c -> m (CompiledData [String])
procedureDeclaration Bool
immutable Bool
abstract ScopedFunction c
f = CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode String
func where
  func :: String
func
    | Bool
abstract = String
"virtual " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
proto String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = 0;"
    | Bool
otherwise = String
proto String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
  name :: String
name = FunctionName -> String
callName (ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f)
  suffix :: String
suffix
    | Bool
immutable = String
" const"
    | Bool
otherwise = String
""
  proto :: String
proto
    | ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope ScopedFunction c
f SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope =
      String
"ReturnTuple " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(const ParamsArgs& params_args)"
    | ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope ScopedFunction c
f SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
TypeScope =
      String
"ReturnTuple " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(const ParamsArgs& params_args) const"
    | ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope ScopedFunction c
f SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope =
      String
"ReturnTuple " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(const ParamsArgs& params_args)" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix
    | Bool
otherwise = String
forall a. HasCallStack => a
undefined

data CxxFunctionType =
  InlineFunction |
  OutOfLineFunction String |
  FinalInlineFunction
  deriving Int -> CxxFunctionType -> String -> String
[CxxFunctionType] -> String -> String
CxxFunctionType -> String
(Int -> CxxFunctionType -> String -> String)
-> (CxxFunctionType -> String)
-> ([CxxFunctionType] -> String -> String)
-> Show CxxFunctionType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> CxxFunctionType -> String -> String
showsPrec :: Int -> CxxFunctionType -> String -> String
$cshow :: CxxFunctionType -> String
show :: CxxFunctionType -> String
$cshowList :: [CxxFunctionType] -> String -> String
showList :: [CxxFunctionType] -> String -> String
Show

compileExecutableProcedure :: (Ord c, Show c, CollectErrorsM m) =>
  Bool -> Bool -> CxxFunctionType -> ScopeContext c -> ScopedFunction c ->
  ExecutableProcedure c -> m (CompiledData [String])
compileExecutableProcedure :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Bool
-> Bool
-> CxxFunctionType
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (CompiledData [String])
compileExecutableProcedure Bool
to Bool
immutable CxxFunctionType
cxxType ScopeContext c
ctx
  ff :: ScopedFunction c
ff@(ScopedFunction [c]
_ FunctionName
_ CategoryName
_ SymbolScope
s FunctionVisibility c
_ Positional (PassedValue c, Maybe (CallArgLabel c))
as1 Positional (PassedValue c)
rs1 Positional (ValueParam c)
ps1 [ParamFilter c]
_ [ScopedFunction c]
_)
  pp :: ExecutableProcedure c
pp@(ExecutableProcedure [c]
c [PragmaProcedure c]
pragmas [c]
c2 FunctionName
n ArgValues c
as2 ReturnValues c
rs2 Procedure c
p) = do
  ProcedureContext c
ctx' <- Bool
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (ProcedureContext c)
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
Bool
-> ScopeContext c
-> ScopedFunction c
-> ExecutableProcedure c
-> m (ProcedureContext c)
getProcedureContext Bool
to ScopeContext c
ctx ScopedFunction c
ff ExecutableProcedure c
pp
  CompiledData [String]
output <- CompilerState (ProcedureContext c) m ()
-> ProcedureContext c -> m (CompiledData [String])
forall c (m :: * -> *) s a b.
CompilerContext c m s a =>
CompilerState a m b -> a -> m (CompiledData s)
runDataCompiler CompilerState (ProcedureContext c) m ()
compileWithReturn ProcedureContext c
ctx'
  [String]
procedureTrace <- m [String]
setProcedureTrace
  [String]
creationTrace  <- m [String]
setCreationTrace
  CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ CompiledData [String]
-> [String] -> [String] -> CompiledData [String]
wrapProcedure CompiledData [String]
output [String]
procedureTrace [String]
creationTrace
  where
    compileWithReturn :: CompilerState (ProcedureContext c) m ()
compileWithReturn = do
      ProcedureContext c
ctx0 <- CompilerState (ProcedureContext c) m (ProcedureContext c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m a
getCleanContext CompilerState (ProcedureContext c) m (ProcedureContext c)
-> (ProcedureContext c
    -> CompilerState (ProcedureContext c) m (ProcedureContext c))
-> CompilerState (ProcedureContext c) m (ProcedureContext c)
forall a b.
StateT (ProcedureContext c) m a
-> (a -> StateT (ProcedureContext c) m b)
-> StateT (ProcedureContext c) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (ProcedureContext c)
-> CompilerState (ProcedureContext c) m (ProcedureContext c)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (ProcedureContext c) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (ProcedureContext c)
 -> CompilerState (ProcedureContext c) m (ProcedureContext c))
-> (ProcedureContext c -> m (ProcedureContext c))
-> ProcedureContext c
-> CompilerState (ProcedureContext c) m (ProcedureContext c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProcedureContext c -> Bool -> m (ProcedureContext c))
-> Bool -> ProcedureContext c -> m (ProcedureContext c)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ProcedureContext c -> Bool -> m (ProcedureContext c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> Bool -> m a
ccSetNoTrace ((PragmaProcedure c -> Bool) -> [PragmaProcedure c] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any PragmaProcedure c -> Bool
forall c. PragmaProcedure c -> Bool
isNoTrace [PragmaProcedure c]
pragmas)
      ProcedureContext c
-> Procedure c
-> CompilerState (ProcedureContext c) m (ProcedureContext c)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> Procedure c -> CompilerState a m a
compileProcedure ProcedureContext c
ctx0 Procedure c
p CompilerState (ProcedureContext c) m (ProcedureContext c)
-> (ProcedureContext c -> CompilerState (ProcedureContext c) m ())
-> CompilerState (ProcedureContext c) m ()
forall a b.
StateT (ProcedureContext c) m a
-> (a -> StateT (ProcedureContext c) m b)
-> StateT (ProcedureContext c) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcedureContext c -> CompilerState (ProcedureContext c) m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put
      Bool
unreachable <- CompilerState (ProcedureContext c) m Bool
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m Bool
csIsUnreachable
      Bool
-> CompilerState (ProcedureContext c) m ()
-> CompilerState (ProcedureContext c) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
unreachable) (CompilerState (ProcedureContext c) m ()
 -> CompilerState (ProcedureContext c) m ())
-> CompilerState (ProcedureContext c) m ()
-> CompilerState (ProcedureContext c) m ()
forall a b. (a -> b) -> a -> b
$
        [c] -> CompilerState (ProcedureContext c) m ()
forall (m :: * -> *) c a.
(CollectErrorsM m, Ord c, Show c,
 CompilerContext c m [String] a) =>
[c] -> CompilerState a m ()
doImplicitReturn [c]
c2 CompilerState (ProcedureContext c) m ()
-> String -> CompilerState (ProcedureContext c) m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<??
          String
"In implicit return from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
    funcMergeDeps :: ScopedFunction c -> CompiledData [String]
funcMergeDeps ScopedFunction c
f = [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat ([CompiledData [String]] -> CompiledData [String])
-> [CompiledData [String]] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ (Set CategoryName -> CompiledData [String]
onlyDeps ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [ScopedFunction c -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
f]))CompiledData [String]
-> [CompiledData [String]] -> [CompiledData [String]]
forall a. a -> [a] -> [a]
:((ScopedFunction c -> CompiledData [String])
-> [ScopedFunction c] -> [CompiledData [String]]
forall a b. (a -> b) -> [a] -> [b]
map ScopedFunction c -> CompiledData [String]
funcMergeDeps ([ScopedFunction c] -> [CompiledData [String]])
-> [ScopedFunction c] -> [CompiledData [String]]
forall a b. (a -> b) -> a -> b
$ ScopedFunction c -> [ScopedFunction c]
forall c. ScopedFunction c -> [ScopedFunction c]
sfMerges ScopedFunction c
f)
    wrapProcedure :: CompiledData [String]
-> [String] -> [String] -> CompiledData [String]
wrapProcedure CompiledData [String]
output [String]
pt [String]
ct =
      [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat [
          ScopedFunction c -> CompiledData [String]
forall {c}. ScopedFunction c -> CompiledData [String]
funcMergeDeps ScopedFunction c
ff,
          String -> CompiledData [String]
onlyCode String
proto,
          CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData [String] -> CompiledData [String])
-> CompiledData [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes [String]
pt,
          CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData [String] -> CompiledData [String])
-> CompiledData [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes [String]
ct,
          CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData [String] -> CompiledData [String])
-> CompiledData [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes [String]
defineReturns,
          CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData [String] -> CompiledData [String])
-> CompiledData [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes [String]
nameParams,
          CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData [String] -> CompiledData [String])
-> CompiledData [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes [String]
nameArgs,
          CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData [String] -> CompiledData [String])
-> CompiledData [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [String] -> CompiledData [String]
onlyCodes [String]
nameReturns,
          CompiledData [String] -> CompiledData [String]
indentCompiled CompiledData [String]
output,
          String -> CompiledData [String]
onlyCode String
close
        ]
    close :: String
close = String
"}"
    name :: String
name = FunctionName -> String
callName FunctionName
n
    prefix :: String
prefix = case CxxFunctionType
cxxType of
                  OutOfLineFunction String
cn -> String
cn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::"
                  CxxFunctionType
_ -> String
""
    final :: String
final = case CxxFunctionType
cxxType of
                 CxxFunctionType
FinalInlineFunction -> String
" final"
                 CxxFunctionType
_ -> String
""
    suffix :: String
suffix
      | Bool
immutable = String
" const"
      | Bool
otherwise = String
""
    proto :: String
proto
      | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope =
        String
"ReturnTuple " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(const ParamsArgs& params_args)" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
final String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" {"
      | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
TypeScope =
        String
"ReturnTuple " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(const ParamsArgs& params_args) const" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
final String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" {"
      | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
ValueScope =
        String
"ReturnTuple " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(const ParamsArgs& params_args)" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
final String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" {"
      | Bool
otherwise = String
forall a. HasCallStack => a
undefined
    setProcedureTrace :: m [String]
setProcedureTrace
      | (PragmaProcedure c -> Bool) -> [PragmaProcedure c] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any PragmaProcedure c -> Bool
forall c. PragmaProcedure c -> Bool
isNoTrace [PragmaProcedure c]
pragmas = [String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      | Bool
otherwise             = [String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [CategoryName -> ScopedFunction c -> String
forall c. CategoryName -> ScopedFunction c -> String
startFunctionTracing (ScopeContext c -> CategoryName
forall c. ScopeContext c -> CategoryName
scName ScopeContext c
ctx) ScopedFunction c
ff]
    setCreationTrace :: m [String]
setCreationTrace
      | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (PragmaProcedure c -> Bool) -> [PragmaProcedure c] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any PragmaProcedure c -> Bool
forall c. PragmaProcedure c -> Bool
isTraceCreation [PragmaProcedure c]
pragmas = [String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      | SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
/= SymbolScope
ValueScope =
          (String -> m ()
forall (m :: * -> *). ErrorContextM m => String -> m ()
compilerWarningM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Creation tracing ignored for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SymbolScope -> String
forall a. Show a => a -> String
show SymbolScope
s String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
" functions" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c) m () -> m [String] -> m [String]
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      | Bool
otherwise = [String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [String
showCreationTrace]
    defineReturns :: [String]
defineReturns
      | ReturnValues c -> Bool
forall c. ReturnValues c -> Bool
isUnnamedReturns ReturnValues c
rs2 = []
      | Bool
otherwise            = [String
"ReturnTuple returns(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([PassedValue c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([PassedValue c] -> Int) -> [PassedValue c] -> Int
forall a b. (a -> b) -> a -> b
$ Positional (PassedValue c) -> [PassedValue c]
forall a. Positional a -> [a]
pValues Positional (PassedValue c)
rs1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");"]
    nameParams :: [String]
nameParams = (((Int, ValueParam c) -> String)
 -> [(Int, ValueParam c)] -> [String])
-> [(Int, ValueParam c)]
-> ((Int, ValueParam c) -> String)
-> [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Int, ValueParam c) -> String)
-> [(Int, ValueParam c)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> [ValueParam c] -> [(Int, ValueParam c)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..] :: [Int]) ([ValueParam c] -> [(Int, ValueParam c)])
-> [ValueParam c] -> [(Int, ValueParam c)]
forall a b. (a -> b) -> a -> b
$ Positional (ValueParam c) -> [ValueParam c]
forall a. Positional a -> [a]
pValues Positional (ValueParam c)
ps1) (((Int, ValueParam c) -> String) -> [String])
-> ((Int, ValueParam c) -> String) -> [String]
forall a b. (a -> b) -> a -> b
$
      (\(Int
i,ValueParam c
p2) -> String
paramType String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParamName -> String
paramName (ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam ValueParam c
p2) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = params_args.GetParam(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");")
    nameArgs :: [String]
nameArgs = ((Int, (PassedValue c, InputValue c)) -> String)
-> [(Int, (PassedValue c, InputValue c))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, (PassedValue c, InputValue c)) -> String
forall {a} {c} {c}.
Show a =>
(a, (PassedValue c, InputValue c)) -> String
nameSingleArg ([Int]
-> [(PassedValue c, InputValue c)]
-> [(Int, (PassedValue c, InputValue c))]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..] :: [Int]) ([(PassedValue c, InputValue c)]
 -> [(Int, (PassedValue c, InputValue c))])
-> [(PassedValue c, InputValue c)]
-> [(Int, (PassedValue c, InputValue c))]
forall a b. (a -> b) -> a -> b
$ [PassedValue c]
-> [InputValue c] -> [(PassedValue c, InputValue c)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((PassedValue c, Maybe (CallArgLabel c)) -> PassedValue c)
-> [(PassedValue c, Maybe (CallArgLabel c))] -> [PassedValue c]
forall a b. (a -> b) -> [a] -> [b]
map (PassedValue c, Maybe (CallArgLabel c)) -> PassedValue c
forall a b. (a, b) -> a
fst ([(PassedValue c, Maybe (CallArgLabel c))] -> [PassedValue c])
-> [(PassedValue c, Maybe (CallArgLabel c))] -> [PassedValue c]
forall a b. (a -> b) -> a -> b
$ Positional (PassedValue c, Maybe (CallArgLabel c))
-> [(PassedValue c, Maybe (CallArgLabel c))]
forall a. Positional a -> [a]
pValues Positional (PassedValue c, Maybe (CallArgLabel c))
as1) (Positional (InputValue c) -> [InputValue c]
forall a. Positional a -> [a]
pValues (Positional (InputValue c) -> [InputValue c])
-> Positional (InputValue c) -> [InputValue c]
forall a b. (a -> b) -> a -> b
$ ArgValues c -> Positional (InputValue c)
forall c. ArgValues c -> Positional (InputValue c)
avNames ArgValues c
as2))
    nameSingleArg :: (a, (PassedValue c, InputValue c)) -> String
nameSingleArg (a
i,(PassedValue c
t2,InputValue c
n2))
      | InputValue c -> Bool
forall c. InputValue c -> Bool
isDiscardedInput InputValue c
n2 = String
"// Arg " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> String
forall a. Show a => a -> String
show (PassedValue c -> ValueType
forall c. PassedValue c -> ValueType
pvType PassedValue c
t2) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") is discarded"
      | Bool
otherwise = String
"const " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> String
variableProxyType (PassedValue c -> ValueType
forall c. PassedValue c -> ValueType
pvType PassedValue c
t2) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
variableName (InputValue c -> VariableName
forall c. InputValue c -> VariableName
ivName InputValue c
n2) String -> String -> String
forall a. [a] -> [a] -> [a]
++
                    String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> ExpressionValue -> String
writeStoredVariable (PassedValue c -> ValueType
forall c. PassedValue c -> ValueType
pvType PassedValue c
t2) (String -> ExpressionValue
UnwrappedSingle (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
"params_args.GetArg(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
    nameReturns :: [String]
nameReturns
      | ReturnValues c -> Bool
forall c. ReturnValues c -> Bool
isUnnamedReturns ReturnValues c
rs2 = []
      | Bool
otherwise = ((Int, (PassedValue c, OutputValue c)) -> String)
-> [(Int, (PassedValue c, OutputValue c))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i,(PassedValue c
t2,OutputValue c
n2)) -> Int -> ValueType -> OutputValue c -> String
forall {a} {c}. Show a => a -> ValueType -> OutputValue c -> String
nameReturn Int
i (PassedValue c -> ValueType
forall c. PassedValue c -> ValueType
pvType PassedValue c
t2) OutputValue c
n2) ([Int]
-> [(PassedValue c, OutputValue c)]
-> [(Int, (PassedValue c, OutputValue c))]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..] :: [Int]) ([(PassedValue c, OutputValue c)]
 -> [(Int, (PassedValue c, OutputValue c))])
-> [(PassedValue c, OutputValue c)]
-> [(Int, (PassedValue c, OutputValue c))]
forall a b. (a -> b) -> a -> b
$ [PassedValue c]
-> [OutputValue c] -> [(PassedValue c, OutputValue c)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Positional (PassedValue c) -> [PassedValue c]
forall a. Positional a -> [a]
pValues Positional (PassedValue c)
rs1) (Positional (OutputValue c) -> [OutputValue c]
forall a. Positional a -> [a]
pValues (Positional (OutputValue c) -> [OutputValue c])
-> Positional (OutputValue c) -> [OutputValue c]
forall a b. (a -> b) -> a -> b
$ ReturnValues c -> Positional (OutputValue c)
forall c. ReturnValues c -> Positional (OutputValue c)
nrNames ReturnValues c
rs2))
    nameReturn :: a -> ValueType -> OutputValue c -> String
nameReturn a
i ValueType
t2 OutputValue c
n2
      | ValueType -> Bool
isStoredUnboxed ValueType
t2 = ValueType -> String
variableProxyType ValueType
t2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
variableName (OutputValue c -> VariableName
forall c. OutputValue c -> VariableName
ovName OutputValue c
n2) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
      | Bool
otherwise =
        ValueType -> String
variableProxyType ValueType
t2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
variableName (OutputValue c -> VariableName
forall c. OutputValue c -> VariableName
ovName OutputValue c
n2) String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> ExpressionValue -> String
writeStoredVariable ValueType
t2 (String -> ExpressionValue
UnwrappedSingle (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
"returns.At(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"

compileCondition :: (Ord c, Show c, CollectErrorsM m,
                     CompilerContext c m [String] a) =>
  a -> [c] -> Expression c -> CompilerState a m (String,a)
compileCondition :: forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> [c] -> Expression c -> CompilerState a m (String, a)
compileCondition a
ctx [c]
c Expression c
e = do
  (String
e',a
ctx') <- CompilerState a m (String, a) -> CompilerState a m (String, a)
forall a. StateT a m a -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => m a -> m a
resetBackgroundM (CompilerState a m (String, a) -> CompilerState a m (String, a))
-> CompilerState a m (String, a) -> CompilerState a m (String, a)
forall a b. (a -> b) -> a -> b
$ m (String, a) -> CompilerState a m (String, a)
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (String, a) -> CompilerState a m (String, a))
-> m (String, a) -> CompilerState a m (String, a)
forall a b. (a -> b) -> a -> b
$ StateT a m String -> a -> m (String, a)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT a m String
compile a
ctx
  Bool
noTrace <- CompilerState a m Bool
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m Bool
csGetNoTrace
  if Bool
noTrace
     then (String, a) -> CompilerState a m (String, a)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
e',a
ctx')
     else do
       let c2 :: [c]
c2 = Expression c -> [c]
forall c. Expression c -> [c]
getExpressionContext Expression c
e
       String -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
String -> CompilerState a m ()
csAddTrace (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c2
       (String, a) -> CompilerState a m (String, a)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([c] -> String
forall a. Show a => [a] -> String
predTraceContext [c]
c2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")",a
ctx')
  where
    compile :: StateT a m String
compile = String
"In condition at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c String -> StateT a m String -> StateT a m String
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
      (ExpressionType
ts,ExpressionValue
e') <- Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression Expression c
e
      ExpressionType -> CompilerState a m ()
forall {m :: * -> *}. ErrorContextM m => ExpressionType -> m ()
checkCondition ExpressionType
ts
      String -> StateT a m String
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> StateT a m String) -> String -> StateT a m String
forall a b. (a -> b) -> a -> b
$ PrimitiveType -> ExpressionValue -> String
useAsUnboxed PrimitiveType
PrimBool ExpressionValue
e'
      where
        checkCondition :: ExpressionType -> m ()
checkCondition (Positional [ValueType
t]) | ValueType
t ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
boolRequiredValue = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        checkCondition (Positional [ValueType]
ts) =
          String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected exactly one Bool value but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                           String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((ValueType -> String) -> [ValueType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ValueType -> String
forall a. Show a => a -> String
show [ValueType]
ts)

-- Returns the state so that returns can be properly checked for if/elif/else.
compileProcedure :: (Ord c, Show c, CollectErrorsM m,
                     CompilerContext c m [String] a) =>
  a -> Procedure c -> CompilerState a m a
compileProcedure :: forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> Procedure c -> CompilerState a m a
compileProcedure a
ctx (Procedure [c]
_ [Statement c]
ss) = do
  a
ctx' <- m a -> CompilerState a m a
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> CompilerState a m a) -> m a -> CompilerState a m a
forall a b. (a -> b) -> a -> b
$ StateT a m [()] -> a -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT ([StateT a m ()] -> StateT a m [()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([StateT a m ()] -> StateT a m [()])
-> [StateT a m ()] -> StateT a m [()]
forall a b. (a -> b) -> a -> b
$ (Statement c -> StateT a m ()) -> [Statement c] -> [StateT a m ()]
forall a b. (a -> b) -> [a] -> [b]
map Statement c -> StateT a m ()
forall {m :: * -> *} {c} {a}.
(Show c, Ord c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Statement c -> StateT a m ()
compile [Statement c]
ss) a
ctx
  a -> CompilerState a m a
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
ctx' where
    compile :: Statement c -> StateT a m ()
compile Statement c
s = do
      Bool
unreachable <- CompilerState a m Bool
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m Bool
csIsUnreachable
      if Bool
unreachable Bool -> Bool -> Bool
&& Bool -> Bool
not (Statement c -> Bool
forall c. Statement c -> Bool
isRawCodeLine Statement c
s)
         then String -> StateT a m ()
forall (m :: * -> *). ErrorContextM m => String -> m ()
compilerWarningM (String -> StateT a m ()) -> String -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ String
"Statement at " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                 [c] -> String
forall a. Show a => [a] -> String
formatFullContext (Statement c -> [c]
forall c. Statement c -> [c]
getStatementContext Statement c
s) String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                 String
" is unreachable (skipping compilation)"
         else do
           ()
s' <- StateT a m () -> StateT a m ()
forall a. StateT a m a -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => m a -> m a
resetBackgroundM (StateT a m () -> StateT a m ()) -> StateT a m () -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ Statement c -> StateT a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Statement c -> CompilerState a m ()
compileStatement Statement c
s
           () -> StateT a m ()
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
s'

maybeSetTrace :: (Ord c, Show c, CollectErrorsM m,
                  CompilerContext c m [String] a) =>
  [c] -> CompilerState a m ()
maybeSetTrace :: forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
[c] -> CompilerState a m ()
maybeSetTrace [c]
c = do
  Bool
noTrace <- CompilerState a m Bool
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m Bool
csGetNoTrace
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
noTrace) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ do
    [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite ([String] -> CompilerState a m ())
-> [String] -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ [c] -> [String]
forall c. Show c => [c] -> [String]
setTraceContext [c]
c
    String -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
String -> CompilerState a m ()
csAddTrace (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c

compileStatement :: (Ord c, Show c, CollectErrorsM m,
                     CompilerContext c m [String] a) =>
  Statement c -> CompilerState a m ()
compileStatement :: forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Statement c -> CompilerState a m ()
compileStatement (EmptyReturn [c]
c) = do
  [c] -> CompilerState a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
[c] -> CompilerState a m ()
maybeSetTrace [c]
c
  [c] -> CompilerState a m ()
forall (m :: * -> *) c a.
(CollectErrorsM m, Ord c, Show c,
 CompilerContext c m [String] a) =>
[c] -> CompilerState a m ()
doImplicitReturn [c]
c
compileStatement (ExplicitReturn [c]
c Positional (Expression c)
es) = do
  [(ExpressionType, ExpressionValue)]
es' <- [StateT a m (ExpressionType, ExpressionValue)]
-> StateT a m [(ExpressionType, ExpressionValue)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([StateT a m (ExpressionType, ExpressionValue)]
 -> StateT a m [(ExpressionType, ExpressionValue)])
-> [StateT a m (ExpressionType, ExpressionValue)]
-> StateT a m [(ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> a -> b
$ (Expression c -> StateT a m (ExpressionType, ExpressionValue))
-> [Expression c] -> [StateT a m (ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> [a] -> [b]
map Expression c -> StateT a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression ([Expression c] -> [StateT a m (ExpressionType, ExpressionValue)])
-> [Expression c] -> [StateT a m (ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> a -> b
$ Positional (Expression c) -> [Expression c]
forall a. Positional a -> [a]
pValues Positional (Expression c)
es
  [([c], (ExpressionType, ExpressionValue))] -> CompilerState a m ()
forall {m :: * -> *} {a} {a}.
(CompilerContext c m [String] a, CollectErrorsM m) =>
[(a, (ExpressionType, ExpressionValue))] -> StateT a m ()
getReturn ([([c], (ExpressionType, ExpressionValue))]
 -> CompilerState a m ())
-> [([c], (ExpressionType, ExpressionValue))]
-> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ [[c]]
-> [(ExpressionType, ExpressionValue)]
-> [([c], (ExpressionType, ExpressionValue))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Expression c -> [c]) -> [Expression c] -> [[c]]
forall a b. (a -> b) -> [a] -> [b]
map Expression c -> [c]
forall c. Expression c -> [c]
getExpressionContext ([Expression c] -> [[c]]) -> [Expression c] -> [[c]]
forall a b. (a -> b) -> a -> b
$ Positional (Expression c) -> [Expression c]
forall a. Positional a -> [a]
pValues Positional (Expression c)
es) [(ExpressionType, ExpressionValue)]
es'
  where
    -- Single expression, but possibly multi-return.
    getReturn :: [(a, (ExpressionType, ExpressionValue))] -> StateT a m ()
getReturn [(a
_,(Positional [ValueType]
ts,ExpressionValue
e))] = do
      [c] -> Maybe ExpressionType -> StateT a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c] -> Maybe ExpressionType -> CompilerState a m ()
csRegisterReturn [c]
c (Maybe ExpressionType -> StateT a m ())
-> Maybe ExpressionType -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ ExpressionType -> Maybe ExpressionType
forall a. a -> Maybe a
Just ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType]
ts)
      [c] -> StateT a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
[c] -> CompilerState a m ()
maybeSetTrace [c]
c
      [c] -> ExpressionValue -> StateT a m ()
forall c (m :: * -> *) a.
(Ord c, Eq c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
[c] -> ExpressionValue -> CompilerState a m ()
autoPositionalCleanup [c]
c ExpressionValue
e
    -- Multi-expression => must all be singles.
    getReturn [(a, (ExpressionType, ExpressionValue))]
rs = do
      m () -> StateT a m ()
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (((Int, ExpressionType) -> m ()) -> [(Int, ExpressionType)] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (Int, ExpressionType) -> m ()
forall {m :: * -> *} {a} {a}.
(ErrorContextM m, Show a) =>
(a, Positional a) -> m ()
checkArity ([(Int, ExpressionType)] -> m ())
-> [(Int, ExpressionType)] -> m ()
forall a b. (a -> b) -> a -> b
$ [Int] -> [ExpressionType] -> [(Int, ExpressionType)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..] :: [Int]) ([ExpressionType] -> [(Int, ExpressionType)])
-> [ExpressionType] -> [(Int, ExpressionType)]
forall a b. (a -> b) -> a -> b
$ ((a, (ExpressionType, ExpressionValue)) -> ExpressionType)
-> [(a, (ExpressionType, ExpressionValue))] -> [ExpressionType]
forall a b. (a -> b) -> [a] -> [b]
map ((ExpressionType, ExpressionValue) -> ExpressionType
forall a b. (a, b) -> a
fst ((ExpressionType, ExpressionValue) -> ExpressionType)
-> ((a, (ExpressionType, ExpressionValue))
    -> (ExpressionType, ExpressionValue))
-> (a, (ExpressionType, ExpressionValue))
-> ExpressionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
forall a b. (a, b) -> b
snd) [(a, (ExpressionType, ExpressionValue))]
rs) StateT a m () -> String -> StateT a m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<??
        (String
"In return at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c)
      [c] -> Maybe ExpressionType -> StateT a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c] -> Maybe ExpressionType -> CompilerState a m ()
csRegisterReturn [c]
c (Maybe ExpressionType -> StateT a m ())
-> Maybe ExpressionType -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ ExpressionType -> Maybe ExpressionType
forall a. a -> Maybe a
Just (ExpressionType -> Maybe ExpressionType)
-> ExpressionType -> Maybe ExpressionType
forall a b. (a -> b) -> a -> b
$ [ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional ([ValueType] -> ExpressionType) -> [ValueType] -> ExpressionType
forall a b. (a -> b) -> a -> b
$ ((a, (ExpressionType, ExpressionValue)) -> ValueType)
-> [(a, (ExpressionType, ExpressionValue))] -> [ValueType]
forall a b. (a -> b) -> [a] -> [b]
map ([ValueType] -> ValueType
forall a. HasCallStack => [a] -> a
head ([ValueType] -> ValueType)
-> ((a, (ExpressionType, ExpressionValue)) -> [ValueType])
-> (a, (ExpressionType, ExpressionValue))
-> ValueType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpressionType -> [ValueType]
forall a. Positional a -> [a]
pValues (ExpressionType -> [ValueType])
-> ((a, (ExpressionType, ExpressionValue)) -> ExpressionType)
-> (a, (ExpressionType, ExpressionValue))
-> [ValueType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExpressionType, ExpressionValue) -> ExpressionType
forall a b. (a, b) -> a
fst ((ExpressionType, ExpressionValue) -> ExpressionType)
-> ((a, (ExpressionType, ExpressionValue))
    -> (ExpressionType, ExpressionValue))
-> (a, (ExpressionType, ExpressionValue))
-> ExpressionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
forall a b. (a, b) -> b
snd) [(a, (ExpressionType, ExpressionValue))]
rs
      let e :: ExpressionValue
e = String -> ExpressionValue
OpaqueMulti (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
"ReturnTuple(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," (((a, (ExpressionType, ExpressionValue)) -> String)
-> [(a, (ExpressionType, ExpressionValue))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ExpressionValue -> String
useAsUnwrapped (ExpressionValue -> String)
-> ((a, (ExpressionType, ExpressionValue)) -> ExpressionValue)
-> (a, (ExpressionType, ExpressionValue))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExpressionType, ExpressionValue) -> ExpressionValue
forall a b. (a, b) -> b
snd ((ExpressionType, ExpressionValue) -> ExpressionValue)
-> ((a, (ExpressionType, ExpressionValue))
    -> (ExpressionType, ExpressionValue))
-> (a, (ExpressionType, ExpressionValue))
-> ExpressionValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
forall a b. (a, b) -> b
snd) [(a, (ExpressionType, ExpressionValue))]
rs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
      [c] -> StateT a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
[c] -> CompilerState a m ()
maybeSetTrace [c]
c
      [c] -> ExpressionValue -> StateT a m ()
forall c (m :: * -> *) a.
(Ord c, Eq c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
[c] -> ExpressionValue -> CompilerState a m ()
autoPositionalCleanup [c]
c ExpressionValue
e
    checkArity :: (a, Positional a) -> m ()
checkArity (a
_,Positional [a
_]) = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    checkArity (a
i,Positional [a]
ts)  =
      String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Return position " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" has " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ts) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" values but should have 1"
compileStatement (LoopBreak [c]
c) = do
  LoopSetup [String]
loop <- CompilerState a m (LoopSetup [String])
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m (LoopSetup s)
csGetLoop
  case LoopSetup [String]
loop of
       LoopSetup [String]
NotInLoop ->
         String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Using break outside of while is no allowed" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
       LoopSetup [String]
_ -> () -> CompilerState a m ()
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  [c] -> JumpType -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c] -> JumpType -> CompilerState a m ()
csSetJumpType [c]
c JumpType
JumpBreak
  StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m a -> (a -> CompilerState a m ()) -> CompilerState a m ()
forall a b. StateT a m a -> (a -> StateT a m b) -> StateT a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [c] -> JumpType -> a -> CompilerState a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
[c] -> JumpType -> a -> CompilerState a m ()
autoInsertCleanup [c]
c JumpType
JumpBreak
  [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"break;"]
compileStatement (LoopContinue [c]
c) = do
  LoopSetup [String]
loop <- CompilerState a m (LoopSetup [String])
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m (LoopSetup s)
csGetLoop
  case LoopSetup [String]
loop of
       LoopSetup [String]
NotInLoop ->
         String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Using continue outside of while is no allowed" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
       LoopSetup [String]
_ -> () -> CompilerState a m ()
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  [c] -> JumpType -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c] -> JumpType -> CompilerState a m ()
csSetJumpType [c]
c JumpType
JumpContinue
  StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m a -> (a -> CompilerState a m ()) -> CompilerState a m ()
forall a b. StateT a m a -> (a -> StateT a m b) -> StateT a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [c] -> JumpType -> a -> CompilerState a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
[c] -> JumpType -> a -> CompilerState a m ()
autoInsertCleanup [c]
c JumpType
JumpContinue
  [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite ([String] -> CompilerState a m ())
-> [String] -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ [String
"{"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ LoopSetup [String] -> [String]
forall s. LoopSetup s -> s
lsUpdate LoopSetup [String]
loop [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"}",String
"continue;"]
compileStatement (FailCall [c]
c Expression c
e) = do
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName
BuiltinFormatted,CategoryName
BuiltinString])
  (ExpressionType, ExpressionValue)
e' <- Expression c -> StateT a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression Expression c
e
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ValueType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ExpressionType -> [ValueType]
forall a. Positional a -> [a]
pValues (ExpressionType -> [ValueType]) -> ExpressionType -> [ValueType]
forall a b. (a -> b) -> a -> b
$ (ExpressionType, ExpressionValue) -> ExpressionType
forall a b. (a, b) -> a
fst (ExpressionType, ExpressionValue)
e') Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected single return in argument" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  let (Positional [ValueType
t0],ExpressionValue
e0) = (ExpressionType, ExpressionValue)
e'
  AnyTypeResolver
r <- CompilerState a m AnyTypeResolver
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m AnyTypeResolver
csResolver
  ParamFilters
fa <- CompilerState a m ParamFilters
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m ParamFilters
csAllFilters
  m () -> CompilerState a m ()
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> CompilerState a m ()) -> m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ (AnyTypeResolver -> ParamFilters -> ValueType -> ValueType -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> ValueType -> ValueType -> m ()
checkValueAssignment AnyTypeResolver
r ParamFilters
fa ValueType
t0 ValueType
formattedRequiredValue) m () -> String -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<??
    String
"In fail call at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
  [c] -> JumpType -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c] -> JumpType -> CompilerState a m ()
csSetJumpType [c]
c JumpType
JumpImmediateExit
  [c] -> CompilerState a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
[c] -> CompilerState a m ()
maybeSetTrace [c]
c
  [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"BUILTIN_FAIL(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpressionValue -> String
useAsUnwrapped ExpressionValue
e0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"]
compileStatement (ExitCall [c]
c Expression c
e) = do
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName
BuiltinInt])
  (ExpressionType, ExpressionValue)
e' <- Expression c -> StateT a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression Expression c
e
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ValueType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ExpressionType -> [ValueType]
forall a. Positional a -> [a]
pValues (ExpressionType -> [ValueType]) -> ExpressionType -> [ValueType]
forall a b. (a -> b) -> a -> b
$ (ExpressionType, ExpressionValue) -> ExpressionType
forall a b. (a, b) -> a
fst (ExpressionType, ExpressionValue)
e') Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected single return in argument" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  let (Positional [ValueType
t0],ExpressionValue
e0) = (ExpressionType, ExpressionValue)
e'
  AnyTypeResolver
r <- CompilerState a m AnyTypeResolver
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m AnyTypeResolver
csResolver
  ParamFilters
fa <- CompilerState a m ParamFilters
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m ParamFilters
csAllFilters
  m () -> CompilerState a m ()
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> CompilerState a m ()) -> m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ (AnyTypeResolver -> ParamFilters -> ValueType -> ValueType -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> ValueType -> ValueType -> m ()
checkValueAssignment AnyTypeResolver
r ParamFilters
fa ValueType
t0 ValueType
intRequiredValue) m () -> String -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<??
    String
"In exit call at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
  [c] -> JumpType -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c] -> JumpType -> CompilerState a m ()
csSetJumpType [c]
c JumpType
JumpImmediateExit
  [c] -> CompilerState a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
[c] -> CompilerState a m ()
maybeSetTrace [c]
c
  [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"BUILTIN_EXIT(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PrimitiveType -> ExpressionValue -> String
useAsUnboxed PrimitiveType
PrimInt ExpressionValue
e0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"]
compileStatement (RawFailCall String
s) = do
  [c] -> JumpType -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c] -> JumpType -> CompilerState a m ()
csSetJumpType [] JumpType
JumpImmediateExit
  [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"RAW_FAIL(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"]
compileStatement (IgnoreValues [c]
c Expression c
e) = do
  (ExpressionType
_,ExpressionValue
e') <- Expression c -> StateT a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression Expression c
e
  [c] -> CompilerState a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
[c] -> CompilerState a m ()
maybeSetTrace [c]
c
  [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"(void) (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpressionValue -> String
useAsWhatever ExpressionValue
e' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");"]
compileStatement (DeferredVariables [c]
c [Assignable c]
as) = String
message String -> CompilerState a m () -> CompilerState a m ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> (Assignable c -> CompilerState a m ())
-> [Assignable c] -> CompilerState a m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Assignable c -> CompilerState a m ()
forall {c} {m :: * -> *} {a}.
(CompilerContext c m [String] a, CollectErrorsM m, Show c) =>
Assignable c -> StateT a m ()
createVariable [Assignable c]
as
  where
    message :: String
message = String
"Deferred initialization at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
    createVariable :: Assignable c -> StateT a m ()
createVariable (CreateVariable [c]
c2 ValueType
t1 VariableName
n) =
      String
"In creation of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c2 String -> StateT a m () -> StateT a m ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
        GeneralInstance
self <- CompilerState a m GeneralInstance
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m GeneralInstance
autoSelfType
        ValueType
t1' <- m ValueType -> StateT a m ValueType
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ValueType -> StateT a m ValueType)
-> m ValueType -> StateT a m ValueType
forall a b. (a -> b) -> a -> b
$ GeneralInstance -> ValueType -> m ValueType
forall (m :: * -> *).
CollectErrorsM m =>
GeneralInstance -> ValueType -> m ValueType
replaceSelfValueType GeneralInstance
self ValueType
t1
        UsedVariable c -> VariableValue c -> StateT a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
UsedVariable c -> VariableValue c -> CompilerState a m ()
csAddVariable ([c] -> VariableName -> UsedVariable c
forall c. [c] -> VariableName -> UsedVariable c
UsedVariable [c]
c2 VariableName
n) ([c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
forall c.
[c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
VariableValue [c]
c2 SymbolScope
LocalScope ValueType
t1' VariableRule c
forall c. VariableRule c
VariableDefault)
        [String] -> StateT a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [ValueType -> String
variableStoredType ValueType
t1' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
variableName VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"]
        UsedVariable c -> StateT a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
UsedVariable c -> CompilerState a m ()
csSetDeferred ([c] -> VariableName -> UsedVariable c
forall c. [c] -> VariableName -> UsedVariable c
UsedVariable [c]
c2 VariableName
n)
    createVariable (ExistingVariable (InputValue [c]
c2 VariableName
n)) =
      String
"In deferring of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c2 String -> StateT a m () -> StateT a m ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??>
      UsedVariable c -> StateT a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
UsedVariable c -> CompilerState a m ()
csSetDeferred ([c] -> VariableName -> UsedVariable c
forall c. [c] -> VariableName -> UsedVariable c
UsedVariable [c]
c2 VariableName
n)
    createVariable (ExistingVariable (DiscardInput [c]
c2)) =
      String -> StateT a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> StateT a m ()) -> String -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ String
"Cannot defer discarded value" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c2
compileStatement (VariableSwap [c]
c OutputValue c
vl OutputValue c
vr) = String
message String -> CompilerState a m () -> CompilerState a m ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> OutputValue c -> OutputValue c -> CompilerState a m ()
forall {m :: * -> *} {c} {a}.
(CollectErrorsM m, Show c, CompilerContext c m [String] a) =>
OutputValue c -> OutputValue c -> StateT a m ()
handle OutputValue c
vl OutputValue c
vr where
  message :: String
message = String
"In variable swap at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
  handle :: OutputValue c -> OutputValue c -> StateT a m ()
handle (OutputValue [c]
cl VariableName
nl) (OutputValue [c]
cr VariableName
nr) = do
    AnyTypeResolver
r <- CompilerState a m AnyTypeResolver
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m AnyTypeResolver
csResolver
    ParamFilters
fa <- CompilerState a m ParamFilters
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m ParamFilters
csAllFilters
    (VariableValue [c]
_ SymbolScope
sl ValueType
tl VariableRule c
_) <- [c] -> VariableName -> CompilerState a m (VariableValue c)
forall c (m :: * -> *) a.
(Show c, CollectErrorsM m, CompilerContext c m [String] a) =>
[c] -> VariableName -> CompilerState a m (VariableValue c)
getWritableVariable [c]
cl VariableName
nl
    (VariableValue [c]
_ SymbolScope
sr ValueType
tr VariableRule c
_) <- [c] -> VariableName -> CompilerState a m (VariableValue c)
forall c (m :: * -> *) a.
(Show c, CollectErrorsM m, CompilerContext c m [String] a) =>
[c] -> VariableName -> CompilerState a m (VariableValue c)
getWritableVariable [c]
cr VariableName
nr
    m () -> StateT a m ()
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT a m ()) -> m () -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ AnyTypeResolver -> ParamFilters -> ValueType -> ValueType -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> ValueType -> ValueType -> m ()
checkValueAssignment AnyTypeResolver
r ParamFilters
fa ValueType
tl ValueType
tr
    m () -> StateT a m ()
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT a m ()) -> m () -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ AnyTypeResolver -> ParamFilters -> ValueType -> ValueType -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> ValueType -> ValueType -> m ()
checkValueAssignment AnyTypeResolver
r ParamFilters
fa ValueType
tr ValueType
tl
    [UsedVariable c] -> StateT a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[UsedVariable c] -> CompilerState a m ()
csCheckVariableInit [[c] -> VariableName -> UsedVariable c
forall c. [c] -> VariableName -> UsedVariable c
UsedVariable [c]
cl VariableName
nl, [c] -> VariableName -> UsedVariable c
forall c. [c] -> VariableName -> UsedVariable c
UsedVariable [c]
cr VariableName
nr]
    String
scopedL <- SymbolScope -> CompilerState a m String
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
SymbolScope -> CompilerState a m String
autoScope SymbolScope
sl
    String
scopedR <- SymbolScope -> CompilerState a m String
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
SymbolScope -> CompilerState a m String
autoScope SymbolScope
sr
    [String] -> StateT a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"SwapValues(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
scopedL String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
variableName VariableName
nl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
scopedR String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
variableName VariableName
nr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");"]
compileStatement (Assignment [c]
c Positional (Assignable c)
as Expression c
e) = String
message String -> CompilerState a m () -> CompilerState a m ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
  (ExpressionType
ts,ExpressionValue
e') <- Expression c -> StateT a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression Expression c
e
  AnyTypeResolver
r <- CompilerState a m AnyTypeResolver
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m AnyTypeResolver
csResolver
  ParamFilters
fa <- CompilerState a m ParamFilters
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m ParamFilters
csAllFilters
  -- Check for a count match first, to avoid the default error message.
  [(VariableName, ValueType)]
_ <- (VariableName -> ValueType -> StateT a m (VariableName, ValueType))
-> Positional VariableName
-> ExpressionType
-> StateT a m [(VariableName, ValueType)]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b c.
(MonadTrans t, Monad (t m), Show a, Show b, ErrorContextM m) =>
(a -> b -> t m c) -> Positional a -> Positional b -> t m [c]
processPairsT VariableName -> ValueType -> StateT a m (VariableName, ValueType)
forall (m :: * -> *) a b. Monad m => a -> b -> m (a, b)
alwaysPair ((Assignable c -> VariableName)
-> Positional (Assignable c) -> Positional VariableName
forall a b. (a -> b) -> Positional a -> Positional b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Assignable c -> VariableName
forall c. Assignable c -> VariableName
assignableName Positional (Assignable c)
as) ExpressionType
ts
  [()]
_ <- (Assignable c -> ValueType -> CompilerState a m ())
-> Positional (Assignable c) -> ExpressionType -> StateT a m [()]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b c.
(MonadTrans t, Monad (t m), Show a, Show b, ErrorContextM m) =>
(a -> b -> t m c) -> Positional a -> Positional b -> t m [c]
processPairsT (AnyTypeResolver
-> ParamFilters
-> Assignable c
-> ValueType
-> CompilerState a m ()
forall {m :: * -> *} {r} {c} {a}.
(CollectErrorsM m, TypeResolver r, Show c,
 CompilerContext c m [String] a) =>
r -> ParamFilters -> Assignable c -> ValueType -> StateT a m ()
createVariable AnyTypeResolver
r ParamFilters
fa) Positional (Assignable c)
as ExpressionType
ts
  [c] -> CompilerState a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
[c] -> CompilerState a m ()
maybeSetTrace [c]
c
  [ValueType]
variableTypes <- [StateT a m ValueType] -> StateT a m [ValueType]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([StateT a m ValueType] -> StateT a m [ValueType])
-> [StateT a m ValueType] -> StateT a m [ValueType]
forall a b. (a -> b) -> a -> b
$ (Assignable c -> StateT a m ValueType)
-> [Assignable c] -> [StateT a m ValueType]
forall a b. (a -> b) -> [a] -> [b]
map Assignable c -> StateT a m ValueType
forall {m :: * -> *} {c} {s} {a}.
CompilerContext c m s a =>
Assignable c -> StateT a m ValueType
getVariableType (Positional (Assignable c) -> [Assignable c]
forall a. Positional a -> [a]
pValues Positional (Assignable c)
as)
  [(Int, ValueType, Assignable c)]
-> ExpressionValue -> CompilerState a m ()
forall {m :: * -> *} {a} {a}.
(CompilerContext c m [String] a, Show a) =>
[(a, ValueType, Assignable c)]
-> ExpressionValue -> CompilerState a m ()
assignAll ([Int]
-> [ValueType]
-> [Assignable c]
-> [(Int, ValueType, Assignable c)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 ([Int
0..] :: [Int]) [ValueType]
variableTypes (Positional (Assignable c) -> [Assignable c]
forall a. Positional a -> [a]
pValues Positional (Assignable c)
as)) ExpressionValue
e'
  where
    message :: String
message = String
"In assignment at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
    assignAll :: [(a, ValueType, Assignable c)]
-> ExpressionValue -> CompilerState a m ()
assignAll [(a, ValueType, Assignable c)
v] ExpressionValue
e2 = (a, ValueType, Assignable c)
-> ExpressionValue -> CompilerState a m ()
forall {m :: * -> *} {c} {a} {a}.
CompilerContext c m [String] a =>
(a, ValueType, Assignable c)
-> ExpressionValue -> CompilerState a m ()
assignSingle (a, ValueType, Assignable c)
v ExpressionValue
e2
    assignAll [(a, ValueType, Assignable c)]
vs ExpressionValue
e2 = do
      [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"{",String
"const auto r = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpressionValue -> String
useAsReturns ExpressionValue
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"]
      [CompilerState a m ()] -> CompilerState a m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([CompilerState a m ()] -> CompilerState a m ())
-> [CompilerState a m ()] -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ ((a, ValueType, Assignable c) -> CompilerState a m ())
-> [(a, ValueType, Assignable c)] -> [CompilerState a m ()]
forall a b. (a -> b) -> [a] -> [b]
map (a, ValueType, Assignable c) -> CompilerState a m ()
forall {m :: * -> *} {a} {a} {c}.
(CompilerContext c m [String] a, Show a) =>
(a, ValueType, Assignable c) -> CompilerState a m ()
assignMulti [(a, ValueType, Assignable c)]
vs
      [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"}"]
    getVariableType :: Assignable c -> StateT a m ValueType
getVariableType (CreateVariable [c]
_ ValueType
t VariableName
_) = ValueType -> StateT a m ValueType
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ValueType
t
    getVariableType (ExistingVariable (InputValue [c]
c2 VariableName
n)) = do
      (VariableValue [c]
_ SymbolScope
_ ValueType
t VariableRule c
_) <- UsedVariable c -> CompilerState a m (VariableValue c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
UsedVariable c -> CompilerState a m (VariableValue c)
csGetVariable ([c] -> VariableName -> UsedVariable c
forall c. [c] -> VariableName -> UsedVariable c
UsedVariable [c]
c2 VariableName
n)
      ValueType -> StateT a m ValueType
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ValueType
t
    getVariableType Assignable c
_ = ValueType -> StateT a m ValueType
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ValueType
forall a. HasCallStack => a
undefined
    createVariable :: r -> ParamFilters -> Assignable c -> ValueType -> StateT a m ()
createVariable r
r ParamFilters
fa (CreateVariable [c]
c2 ValueType
t1 VariableName
n) ValueType
t2 =
      String
"In creation of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c2 String -> StateT a m () -> StateT a m ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
        GeneralInstance
self <- CompilerState a m GeneralInstance
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m GeneralInstance
autoSelfType
        ValueType
t1' <- m ValueType -> StateT a m ValueType
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ValueType -> StateT a m ValueType)
-> m ValueType -> StateT a m ValueType
forall a b. (a -> b) -> a -> b
$ GeneralInstance -> ValueType -> m ValueType
forall (m :: * -> *).
CollectErrorsM m =>
GeneralInstance -> ValueType -> m ValueType
replaceSelfValueType GeneralInstance
self ValueType
t1
        -- TODO: Call csAddRequired for t1'. (Maybe needs a helper function.)
        m () -> StateT a m ()
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT a m ()) -> m () -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ [m ()] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, CollectErrorsM m) =>
f (m a) -> m ()
collectAllM_ [r -> Set ParamName -> GeneralInstance -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> Set ParamName -> GeneralInstance -> m ()
validateGeneralInstance r
r (ParamFilters -> Set ParamName
forall k a. Map k a -> Set k
Map.keysSet ParamFilters
fa) (ValueType -> GeneralInstance
vtType ValueType
t1'),
                             r -> ParamFilters -> ValueType -> ValueType -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> ValueType -> ValueType -> m ()
checkValueAssignment r
r ParamFilters
fa ValueType
t2 ValueType
t1']
        UsedVariable c -> VariableValue c -> StateT a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
UsedVariable c -> VariableValue c -> CompilerState a m ()
csAddVariable ([c] -> VariableName -> UsedVariable c
forall c. [c] -> VariableName -> UsedVariable c
UsedVariable [c]
c2 VariableName
n) ([c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
forall c.
[c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
VariableValue [c]
c2 SymbolScope
LocalScope ValueType
t1' VariableRule c
forall c. VariableRule c
VariableDefault)
        [String] -> StateT a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [ValueType -> String
variableStoredType ValueType
t1' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
variableName VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"]
    createVariable r
r ParamFilters
fa (ExistingVariable (InputValue [c]
c2 VariableName
n)) ValueType
t2 =
      String
"In assignment to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c2 String -> StateT a m () -> StateT a m ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
        (VariableValue [c]
_ SymbolScope
_ ValueType
t1 VariableRule c
_) <- [c] -> VariableName -> CompilerState a m (VariableValue c)
forall c (m :: * -> *) a.
(Show c, CollectErrorsM m, CompilerContext c m [String] a) =>
[c] -> VariableName -> CompilerState a m (VariableValue c)
getWritableVariable [c]
c2 VariableName
n
        -- TODO: Also show original context.
        m () -> StateT a m ()
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT a m ()) -> m () -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ (r -> ParamFilters -> ValueType -> ValueType -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> ValueType -> ValueType -> m ()
checkValueAssignment r
r ParamFilters
fa ValueType
t2 ValueType
t1)
        VariableName -> StateT a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
VariableName -> CompilerState a m ()
csUpdateAssigned VariableName
n
    createVariable r
_ ParamFilters
_ Assignable c
_ ValueType
_ = () -> StateT a m ()
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    assignSingle :: (a, ValueType, Assignable c)
-> ExpressionValue -> CompilerState a m ()
assignSingle (a
_,ValueType
t,CreateVariable [c]
_ ValueType
_ VariableName
n) ExpressionValue
e2 =
      [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [VariableName -> String
variableName VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> ExpressionValue -> String
writeStoredVariable ValueType
t ExpressionValue
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"]
    assignSingle (a
_,ValueType
t,ExistingVariable (InputValue [c]
c2 VariableName
n)) ExpressionValue
e2 = do
      (VariableValue [c]
_ SymbolScope
s ValueType
_ VariableRule c
_) <- UsedVariable c -> CompilerState a m (VariableValue c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
UsedVariable c -> CompilerState a m (VariableValue c)
csGetVariable ([c] -> VariableName -> UsedVariable c
forall c. [c] -> VariableName -> UsedVariable c
UsedVariable [c]
c2 VariableName
n)
      String
scoped <- SymbolScope -> CompilerState a m String
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
SymbolScope -> CompilerState a m String
autoScope SymbolScope
s
      [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
scoped String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
variableName VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> ExpressionValue -> String
writeStoredVariable ValueType
t ExpressionValue
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"]
    assignSingle (a
_,ValueType
_,ExistingVariable (DiscardInput [c]
_)) ExpressionValue
e2 = do
      [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"(void) (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpressionValue -> String
useAsWhatever ExpressionValue
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");"]
    assignMulti :: (a, ValueType, Assignable c) -> CompilerState a m ()
assignMulti (a
i,ValueType
t,CreateVariable [c]
_ ValueType
_ VariableName
n) =
      [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [VariableName -> String
variableName VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++
               ValueType -> ExpressionValue -> String
writeStoredVariable ValueType
t (String -> ExpressionValue
UnwrappedSingle (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
"r.At(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"]
    assignMulti (a
i,ValueType
t,ExistingVariable (InputValue [c]
_ VariableName
n)) = do
      (VariableValue [c]
_ SymbolScope
s ValueType
_ VariableRule c
_) <- UsedVariable c -> CompilerState a m (VariableValue c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
UsedVariable c -> CompilerState a m (VariableValue c)
csGetVariable ([c] -> VariableName -> UsedVariable c
forall c. [c] -> VariableName -> UsedVariable c
UsedVariable [c]
c VariableName
n)
      String
scoped <- SymbolScope -> CompilerState a m String
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
SymbolScope -> CompilerState a m String
autoScope SymbolScope
s
      [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
scoped String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
variableName VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++
               ValueType -> ExpressionValue -> String
writeStoredVariable ValueType
t (String -> ExpressionValue
UnwrappedSingle (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
"r.At(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"]
    assignMulti (a, ValueType, Assignable c)
_ = () -> CompilerState a m ()
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
compileStatement (AssignmentEmpty [c]
c VariableName
n Expression c
e) = do
  (ExpressionType
_,ExpressionValue
e') <- ExpressionStart c -> StateT a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
ExpressionStart c
-> CompilerState a m (ExpressionType, ExpressionValue)
compileExpressionStart ([c]
-> VariableName
-> AssignmentType
-> Expression c
-> ExpressionStart c
forall c.
[c]
-> VariableName
-> AssignmentType
-> Expression c
-> ExpressionStart c
InlineAssignment [c]
c VariableName
n AssignmentType
AssignIfEmpty Expression c
e)
  [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"(void) (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpressionValue -> String
useAsWhatever ExpressionValue
e' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");"]
compileStatement (NoValueExpression [c]
_ VoidExpression c
v) = VoidExpression c -> CompilerState a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
VoidExpression c -> CompilerState a m ()
compileVoidExpression VoidExpression c
v
compileStatement (MarkReadOnly [c]
c [VariableName]
vs) = (VariableName -> CompilerState a m ())
-> [VariableName] -> CompilerState a m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\VariableName
v -> UsedVariable c -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
UsedVariable c -> CompilerState a m ()
csSetReadOnly ([c] -> VariableName -> UsedVariable c
forall c. [c] -> VariableName -> UsedVariable c
UsedVariable [c]
c VariableName
v)) [VariableName]
vs
compileStatement (MarkHidden   [c]
c [VariableName]
vs) = (VariableName -> CompilerState a m ())
-> [VariableName] -> CompilerState a m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\VariableName
v -> UsedVariable c -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
UsedVariable c -> CompilerState a m ()
csSetHidden   ([c] -> VariableName -> UsedVariable c
forall c. [c] -> VariableName -> UsedVariable c
UsedVariable [c]
c VariableName
v)) [VariableName]
vs
compileStatement (ValidateRefs [c]
c [VariableName]
vs) = (VariableName -> CompilerState a m ())
-> [VariableName] -> CompilerState a m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ VariableName -> CompilerState a m ()
forall {m :: * -> *} {a}.
(CompilerContext c m [String] a, CollectErrorsM m) =>
VariableName -> StateT a m ()
validate [VariableName]
vs where
  validate :: VariableName -> StateT a m ()
validate VariableName
n = do
    (VariableValue [c]
_ SymbolScope
_ ValueType
t VariableRule c
_) <- UsedVariable c -> CompilerState a m (VariableValue c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
UsedVariable c -> CompilerState a m (VariableValue c)
csGetVariable ([c] -> VariableName -> UsedVariable c
forall c. [c] -> VariableName -> UsedVariable c
UsedVariable [c]
c VariableName
n)
    let e :: ExpressionValue
e = Bool -> ValueType -> String -> ExpressionValue
readStoredVariable Bool
False ValueType
t (VariableName -> String
variableName VariableName
n)
    [c] -> StateT a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
[c] -> CompilerState a m ()
maybeSetTrace [c]
c
    [String] -> StateT a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [ExpressionValue -> String
useAsUnwrapped ExpressionValue
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".Validate(\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\");"]
compileStatement (ShowVariable [c]
c ValueType
t VariableName
n) = UsedVariable c -> VariableValue c -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
UsedVariable c -> VariableValue c -> CompilerState a m ()
csAddVariable ([c] -> VariableName -> UsedVariable c
forall c. [c] -> VariableName -> UsedVariable c
UsedVariable [c]
c VariableName
n) ([c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
forall c.
[c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
VariableValue [c]
c SymbolScope
LocalScope ValueType
t VariableRule c
forall c. VariableRule c
VariableDefault)
compileStatement (RawCodeLine String
s) = [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
s]

compileRegularInit :: (Ord c, Show c, CollectErrorsM m,
                       CompilerContext c m [String] a) =>
  DefinedMember c -> CompilerState a m ()
compileRegularInit :: forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
DefinedMember c -> CompilerState a m ()
compileRegularInit (DefinedMember [c]
_ SymbolScope
_ ValueType
_ VariableName
_ Maybe (Expression c)
Nothing) = () -> StateT a m ()
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
compileRegularInit (DefinedMember [c]
c2 SymbolScope
s ValueType
t VariableName
n2 (Just Expression c
e)) = StateT a m () -> StateT a m ()
forall a. StateT a m a -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => m a -> m a
resetBackgroundM (StateT a m () -> StateT a m ()) -> StateT a m () -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ do
  UsedVariable c -> VariableValue c -> StateT a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
UsedVariable c -> VariableValue c -> CompilerState a m ()
csAddVariable ([c] -> VariableName -> UsedVariable c
forall c. [c] -> VariableName -> UsedVariable c
UsedVariable [c]
c2 VariableName
n2) ([c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
forall c.
[c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
VariableValue [c]
c2 SymbolScope
s ValueType
t VariableRule c
forall c. VariableRule c
VariableDefault)
  let assign :: Statement c
assign = [c] -> Positional (Assignable c) -> Expression c -> Statement c
forall c.
[c] -> Positional (Assignable c) -> Expression c -> Statement c
Assignment [c]
c2 ([Assignable c] -> Positional (Assignable c)
forall a. [a] -> Positional a
Positional [InputValue c -> Assignable c
forall c. InputValue c -> Assignable c
ExistingVariable ([c] -> VariableName -> InputValue c
forall c. [c] -> VariableName -> InputValue c
InputValue [c]
c2 VariableName
n2)]) Expression c
e
  Statement c -> StateT a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Statement c -> CompilerState a m ()
compileStatement Statement c
assign

getWritableVariable :: (Show c, CollectErrorsM m, CompilerContext c m [String] a) =>
  [c] -> VariableName -> CompilerState a m (VariableValue c)
getWritableVariable :: forall c (m :: * -> *) a.
(Show c, CollectErrorsM m, CompilerContext c m [String] a) =>
[c] -> VariableName -> CompilerState a m (VariableValue c)
getWritableVariable [c]
c VariableName
n = do
  v :: VariableValue c
v@(VariableValue [c]
_ SymbolScope
_ ValueType
_ VariableRule c
ro) <- UsedVariable c -> CompilerState a m (VariableValue c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
UsedVariable c -> CompilerState a m (VariableValue c)
csGetVariable ([c] -> VariableName -> UsedVariable c
forall c. [c] -> VariableName -> UsedVariable c
UsedVariable [c]
c VariableName
n)
  case VariableRule c
ro of
       VariableReadOnly [] -> String -> CompilerState a m (VariableValue c)
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m (VariableValue c))
-> String -> CompilerState a m (VariableValue c)
forall a b. (a -> b) -> a -> b
$ String
"Variable " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
                              [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is read-only"
       VariableReadOnly [c]
c2 -> String -> CompilerState a m (VariableValue c)
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m (VariableValue c))
-> String -> CompilerState a m (VariableValue c)
forall a b. (a -> b) -> a -> b
$ String
"Variable " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
                              [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is marked read-only at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c2
       VariableRule c
_ -> VariableValue c -> CompilerState a m (VariableValue c)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return VariableValue c
v

compileLazyInit :: (Ord c, Show c, CollectErrorsM m,
                   CompilerContext c m [String] a) =>
  CategoryName -> DefinedMember c -> CompilerState a m ()
compileLazyInit :: forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
CategoryName -> DefinedMember c -> CompilerState a m ()
compileLazyInit CategoryName
_ (DefinedMember [c]
_ SymbolScope
_ ValueType
_ VariableName
_ Maybe (Expression c)
Nothing) = () -> StateT a m ()
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
compileLazyInit CategoryName
t0 (DefinedMember [c]
c SymbolScope
_ ValueType
t1 VariableName
n (Just Expression c
e)) = StateT a m () -> StateT a m ()
forall a. StateT a m a -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => m a -> m a
resetBackgroundM (StateT a m () -> StateT a m ()) -> StateT a m () -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ do
  (ExpressionType
ts,ExpressionValue
e') <- Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression Expression c
e
  Bool -> StateT a m () -> StateT a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ValueType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ExpressionType -> [ValueType]
forall a. Positional a -> [a]
pValues ExpressionType
ts) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (StateT a m () -> StateT a m ()) -> StateT a m () -> StateT a m ()
forall a b. (a -> b) -> a -> b
$
    String -> StateT a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> StateT a m ()) -> String -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected single return in initializer" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (Expression c -> [c]
forall c. Expression c -> [c]
getExpressionContext Expression c
e)
  AnyTypeResolver
r <- CompilerState a m AnyTypeResolver
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m AnyTypeResolver
csResolver
  ParamFilters
fa <- CompilerState a m ParamFilters
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m ParamFilters
csAllFilters
  let Positional [ValueType
t2] = ExpressionType
ts
  m () -> StateT a m ()
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT a m ()) -> m () -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ (AnyTypeResolver -> ParamFilters -> ValueType -> ValueType -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> ValueType -> ValueType -> m ()
checkValueAssignment AnyTypeResolver
r ParamFilters
fa ValueType
t2 ValueType
t1) m () -> String -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<??
    String
"In initialization of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
  let maybeTrace :: [String]
maybeTrace = [c] -> [String]
forall c. Show c => [c] -> [String]
setTraceContext [c]
c
  let trace :: String
trace = case [String]
maybeTrace of
                   [String
v] -> String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v
                   [String]
_ -> String
""
  -- NOTE: This needs to be on one line, due to how multiple member inits are concatenated.
  [String] -> StateT a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [VariableName -> String
variableName VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"([this]() { " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CategoryName -> SymbolScope -> String
startInitTracing CategoryName
t0 SymbolScope
CategoryScope String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
trace String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
" return " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> ExpressionValue -> String
writeStoredVariable ValueType
t1 ExpressionValue
e' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"; })"
    ]

compileVoidExpression :: (Ord c, Show c, CollectErrorsM m,
                         CompilerContext c m [String] a) =>
  VoidExpression c -> CompilerState a m ()
compileVoidExpression :: forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
VoidExpression c -> CompilerState a m ()
compileVoidExpression (Conditional IfElifElse c
ie) = IfElifElse c -> CompilerState a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
IfElifElse c -> CompilerState a m ()
compileIfElifElse IfElifElse c
ie
compileVoidExpression (Loop IteratedLoop c
l) = IteratedLoop c -> CompilerState a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
IteratedLoop c -> CompilerState a m ()
compileIteratedLoop IteratedLoop c
l
compileVoidExpression (WithScope ScopedBlock c
s) = ScopedBlock c -> CompilerState a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
ScopedBlock c -> CompilerState a m ()
compileScopedBlock ScopedBlock c
s
compileVoidExpression (LineComment String
s) = [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite ([String] -> CompilerState a m ())
-> [String] -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"// " String -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
s
compileVoidExpression (Unconditional Procedure c
p) = do
  a
ctx0 <- CompilerState a m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m a
getCleanContext
  a
ctx <- a -> Procedure c -> CompilerState a m a
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> Procedure c -> CompilerState a m a
compileProcedure a
ctx0 Procedure c
p
  [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"{"]
  a -> CompilerState a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> CompilerState a m ()
autoInlineOutput a
ctx
  [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"}"]

compileIfElifElse :: (Ord c, Show c, CollectErrorsM m,
                      CompilerContext c m [String] a) =>
  IfElifElse c -> CompilerState a m ()
compileIfElifElse :: forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
IfElifElse c -> CompilerState a m ()
compileIfElifElse (IfStatement [c]
c Expression c
e Procedure c
p IfElifElse c
es) = do
  a
ctx0 <- CompilerState a m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m a
getCleanContext
  [a]
cs <- a
-> String
-> [c]
-> Expression c
-> Procedure c
-> IfElifElse c
-> StateT a m [a]
forall {m :: * -> *} {c} {a}.
(CollectErrorsM m, Ord c, Show c,
 CompilerContext c m [String] a) =>
a
-> String
-> [c]
-> Expression c
-> Procedure c
-> IfElifElse c
-> StateT a m [a]
commonIf a
ctx0 String
"if" [c]
c Expression c
e Procedure c
p IfElifElse c
es
  [a] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[a] -> CompilerState a m ()
csInheritStatic [a]
cs
  where
    unwind :: a -> IfElifElse c -> StateT a m [a]
unwind a
ctx0 (IfStatement [c]
c2 Expression c
e2 Procedure c
p2 IfElifElse c
es2) = a
-> String
-> [c]
-> Expression c
-> Procedure c
-> IfElifElse c
-> StateT a m [a]
commonIf a
ctx0 String
"else if" [c]
c2 Expression c
e2 Procedure c
p2 IfElifElse c
es2
    unwind a
ctx0 (ElseStatement [c]
_ Procedure c
p2) = do
      a
ctx <- a -> Procedure c -> CompilerState a m a
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> Procedure c -> CompilerState a m a
compileProcedure a
ctx0 Procedure c
p2
      a -> CompilerState a m ()
forall (m :: * -> *) c a.
(CollectErrorsM m, CompilerContext c m [String] a) =>
a -> CompilerState a m ()
inheritRequired a
ctx
      [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"else {"]
      a -> CompilerState a m [String]
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> CompilerState a m [String]
getAndIndentOutput a
ctx CompilerState a m [String]
-> ([String] -> CompilerState a m ()) -> CompilerState a m ()
forall a b. StateT a m a -> (a -> StateT a m b) -> StateT a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite
      [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"}"]
      [a] -> StateT a m [a]
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return [a
ctx]
    unwind a
ctx0 IfElifElse c
TerminateConditional = [a] -> StateT a m [a]
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return [a
ctx0]
    commonIf :: a
-> String
-> [c]
-> Expression c
-> Procedure c
-> IfElifElse c
-> StateT a m [a]
commonIf a
ctx0 String
s [c]
c2 Expression c
e2 Procedure c
p2 IfElifElse c
es2 = do
      (String
e2',a
ctx1) <- a -> [c] -> Expression c -> CompilerState a m (String, a)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> [c] -> Expression c -> CompilerState a m (String, a)
compileCondition a
ctx0 [c]
c2 Expression c
e2
      a
ctx <- a -> Procedure c -> CompilerState a m a
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> Procedure c -> CompilerState a m a
compileProcedure a
ctx1 Procedure c
p2
      a -> CompilerState a m ()
forall (m :: * -> *) c a.
(CollectErrorsM m, CompilerContext c m [String] a) =>
a -> CompilerState a m ()
inheritRequired a
ctx
      [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e2' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") {"]
      a -> CompilerState a m [String]
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> CompilerState a m [String]
getAndIndentOutput a
ctx CompilerState a m [String]
-> ([String] -> CompilerState a m ()) -> CompilerState a m ()
forall a b. StateT a m a -> (a -> StateT a m b) -> StateT a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite
      [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"}"]
      [a]
cs <- a -> IfElifElse c -> StateT a m [a]
unwind a
ctx1 IfElifElse c
es2
      [a] -> StateT a m [a]
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> StateT a m [a]) -> [a] -> StateT a m [a]
forall a b. (a -> b) -> a -> b
$ a
ctxa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
cs
compileIfElifElse IfElifElse c
_ = CompilerState a m ()
forall a. HasCallStack => a
undefined

compileIteratedLoop :: (Ord c, Show c, CollectErrorsM m, CompilerContext c m [String] a) =>
  IteratedLoop c -> CompilerState a m ()
compileIteratedLoop :: forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
IteratedLoop c -> CompilerState a m ()
compileIteratedLoop (WhileLoop [c]
c Expression c
e Procedure c
p Maybe (Procedure c)
u) = do
  a
ctx0 <- CompilerState a m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m a
getCleanContext
  (String
e',a
ctx1) <- a -> [c] -> Expression c -> CompilerState a m (String, a)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> [c] -> Expression c -> CompilerState a m (String, a)
compileCondition a
ctx0 [c]
c Expression c
e
  [a] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[a] -> CompilerState a m ()
csInheritStatic [a
ctx1]
  a
ctx0' <- case Maybe (Procedure c)
u of
                Just Procedure c
p2 -> do
                  a
ctx2 <- m a -> CompilerState a m a
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> CompilerState a m a) -> m a -> CompilerState a m a
forall a b. (a -> b) -> a -> b
$ a -> LoopSetup [String] -> m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> LoopSetup s -> m a
ccStartLoop a
ctx1 ([String] -> LoopSetup [String]
forall s. s -> LoopSetup s
LoopSetup [])
                  a
ctx3 <- a -> Procedure c -> CompilerState a m a
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> Procedure c -> CompilerState a m a
compileProcedure a
ctx2 Procedure c
p2
                  a -> CompilerState a m ()
forall (m :: * -> *) c a.
(CollectErrorsM m, CompilerContext c m [String] a) =>
a -> CompilerState a m ()
inheritRequired a
ctx3
                  [String]
p2' <- a -> CompilerState a m [String]
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> CompilerState a m [String]
getAndIndentOutput a
ctx3
                  m a -> CompilerState a m a
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> CompilerState a m a) -> m a -> CompilerState a m a
forall a b. (a -> b) -> a -> b
$ a -> LoopSetup [String] -> m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> LoopSetup s -> m a
ccStartLoop a
ctx1 ([String] -> LoopSetup [String]
forall s. s -> LoopSetup s
LoopSetup [String]
p2')
                Maybe (Procedure c)
_ -> m a -> CompilerState a m a
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> CompilerState a m a) -> m a -> CompilerState a m a
forall a b. (a -> b) -> a -> b
$ a -> LoopSetup [String] -> m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> LoopSetup s -> m a
ccStartLoop a
ctx1 ([String] -> LoopSetup [String]
forall s. s -> LoopSetup s
LoopSetup [])
  (LoopSetup [String]
u') <- m (LoopSetup [String]) -> StateT a m (LoopSetup [String])
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (LoopSetup [String]) -> StateT a m (LoopSetup [String]))
-> m (LoopSetup [String]) -> StateT a m (LoopSetup [String])
forall a b. (a -> b) -> a -> b
$ a -> m (LoopSetup [String])
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> m (LoopSetup s)
ccGetLoop a
ctx0'
  a
ctx <- a -> Procedure c -> CompilerState a m a
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> Procedure c -> CompilerState a m a
compileProcedure a
ctx0' Procedure c
p
  a -> CompilerState a m ()
forall (m :: * -> *) c a.
(CollectErrorsM m, CompilerContext c m [String] a) =>
a -> CompilerState a m ()
inheritRequired a
ctx
  [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"while (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") {"]
  a -> CompilerState a m [String]
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> CompilerState a m [String]
getAndIndentOutput a
ctx CompilerState a m [String]
-> ([String] -> CompilerState a m ()) -> CompilerState a m ()
forall a b. StateT a m a -> (a -> StateT a m b) -> StateT a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite
  [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite ([String] -> CompilerState a m ())
-> [String] -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ [String
"{"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
u' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"}"]
  [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"}"]
compileIteratedLoop (TraverseLoop [c]
c1 Expression c
e [c]
c2 Assignable c
a (Procedure [c]
c3 [Statement c]
ss) Maybe (Procedure c)
u) = String
"In compilation of traverse at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c1 String -> CompilerState a m () -> CompilerState a m ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
  (Positional [ValueType]
ts,ExpressionValue
e') <- Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression Expression c
e
  [ValueType] -> CompilerState a m ()
forall {m :: * -> *} {a}. (ErrorContextM m, Show a) => [a] -> m ()
checkContainer [ValueType]
ts
  AnyTypeResolver
r <- CompilerState a m AnyTypeResolver
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m AnyTypeResolver
csResolver
  ParamFilters
fa <- CompilerState a m ParamFilters
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m ParamFilters
csAllFilters
  let [ValueType
t] = [ValueType]
ts
  let autoParam :: ParamName
autoParam = String -> ParamName
ParamName String
"#auto"
  let autoType :: GeneralInstance
autoType  = TypeInstanceOrParam -> GeneralInstance
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType (TypeInstanceOrParam -> GeneralInstance)
-> TypeInstanceOrParam -> GeneralInstance
forall a b. (a -> b) -> a -> b
$ Bool -> ParamName -> TypeInstanceOrParam
JustParamName Bool
False ParamName
autoParam
  (Positional [GeneralInstance
t2]) <- m (Positional GeneralInstance)
-> StateT a m (Positional GeneralInstance)
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Positional GeneralInstance)
 -> StateT a m (Positional GeneralInstance))
-> m (Positional GeneralInstance)
-> StateT a m (Positional GeneralInstance)
forall a b. (a -> b) -> a -> b
$ AnyTypeResolver
-> ParamFilters
-> ExpressionType
-> Positional ParamName
-> Positional (InstanceOrInferred c)
-> ExpressionType
-> m (Positional GeneralInstance)
forall c (m :: * -> *) r.
(Ord c, Show c, CollectErrorsM m, TypeResolver r) =>
r
-> ParamFilters
-> ExpressionType
-> Positional ParamName
-> Positional (InstanceOrInferred c)
-> ExpressionType
-> m (Positional GeneralInstance)
guessParams AnyTypeResolver
r ParamFilters
fa ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [GeneralInstance -> ValueType
orderOptionalValue GeneralInstance
autoType])
                                               ([ParamName] -> Positional ParamName
forall a. [a] -> Positional a
Positional [ParamName
autoParam])
                                               ([InstanceOrInferred c] -> Positional (InstanceOrInferred c)
forall a. [a] -> Positional a
Positional [[c] -> InstanceOrInferred c
forall c. [c] -> InstanceOrInferred c
InferredInstance [c]
c1])
                                               ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
t])
  let currVar :: String
currVar = VariableName -> String
hiddenVariableName (VariableName -> String) -> VariableName -> String
forall a b. (a -> b) -> a -> b
$ String -> VariableName
VariableName String
"traverse"
  let currType :: ValueType
currType = GeneralInstance -> ValueType
orderOptionalValue (GeneralInstance -> ValueType) -> GeneralInstance -> ValueType
forall a b. (a -> b) -> a -> b
$ GeneralInstance -> GeneralInstance
fixTypeParams GeneralInstance
t2
  let currExpr :: ExpressionStart c
currExpr    = [c] -> FunctionCall c -> ExpressionStart c
forall c. [c] -> FunctionCall c -> ExpressionStart c
BuiltinCall [] (FunctionCall c -> ExpressionStart c)
-> FunctionCall c -> ExpressionStart c
forall a b. (a -> b) -> a -> b
$ [c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
forall c.
[c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
FunctionCall [] FunctionName
BuiltinRequire ([InstanceOrInferred c] -> Positional (InstanceOrInferred c)
forall a. [a] -> Positional a
Positional []) ([(Maybe (CallArgLabel c), Expression c)]
-> Positional (Maybe (CallArgLabel c), Expression c)
forall a. [a] -> Positional a
Positional [(Maybe (CallArgLabel c)
forall a. Maybe a
Nothing,ExpressionType -> ExpressionValue -> Expression c
forall c. ExpressionType -> ExpressionValue -> Expression c
RawExpression ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
currType]) (String -> ExpressionValue
UnwrappedSingle String
currVar))])
  let currPresent :: ExpressionStart c
currPresent = [c] -> FunctionCall c -> ExpressionStart c
forall c. [c] -> FunctionCall c -> ExpressionStart c
BuiltinCall [] (FunctionCall c -> ExpressionStart c)
-> FunctionCall c -> ExpressionStart c
forall a b. (a -> b) -> a -> b
$ [c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
forall c.
[c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
FunctionCall [] FunctionName
BuiltinPresent ([InstanceOrInferred c] -> Positional (InstanceOrInferred c)
forall a. [a] -> Positional a
Positional []) ([(Maybe (CallArgLabel c), Expression c)]
-> Positional (Maybe (CallArgLabel c), Expression c)
forall a. [a] -> Positional a
Positional [(Maybe (CallArgLabel c)
forall a. Maybe a
Nothing,ExpressionType -> ExpressionValue -> Expression c
forall c. ExpressionType -> ExpressionValue -> Expression c
RawExpression ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
currType]) (String -> ExpressionValue
UnwrappedSingle String
currVar))])
  let callNext :: Expression c
callNext = [c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
forall c.
[c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
Expression [c]
c1 ExpressionStart c
forall {c}. ExpressionStart c
currExpr [[c] -> ValueCallType -> FunctionCall c -> ValueOperation c
forall c.
[c] -> ValueCallType -> FunctionCall c -> ValueOperation c
ValueCall [c]
c1 ValueCallType
AlwaysCall (FunctionCall c -> ValueOperation c)
-> FunctionCall c -> ValueOperation c
forall a b. (a -> b) -> a -> b
$ [c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
forall c.
[c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
FunctionCall [c]
c1 (String -> FunctionName
FunctionName String
"next") ([InstanceOrInferred c] -> Positional (InstanceOrInferred c)
forall a. [a] -> Positional a
Positional []) ([(Maybe (CallArgLabel c), Expression c)]
-> Positional (Maybe (CallArgLabel c), Expression c)
forall a. [a] -> Positional a
Positional [])]
  let callGet :: Expression c
callGet  = [c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
forall c.
[c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
Expression [c]
c2 ExpressionStart c
forall {c}. ExpressionStart c
currExpr [[c] -> ValueCallType -> FunctionCall c -> ValueOperation c
forall c.
[c] -> ValueCallType -> FunctionCall c -> ValueOperation c
ValueCall [c]
c2 ValueCallType
AlwaysCall (FunctionCall c -> ValueOperation c)
-> FunctionCall c -> ValueOperation c
forall a b. (a -> b) -> a -> b
$ [c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
forall c.
[c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
FunctionCall [c]
c2 (String -> FunctionName
FunctionName String
"get")  ([InstanceOrInferred c] -> Positional (InstanceOrInferred c)
forall a. [a] -> Positional a
Positional []) ([(Maybe (CallArgLabel c), Expression c)]
-> Positional (Maybe (CallArgLabel c), Expression c)
forall a. [a] -> Positional a
Positional [])]
  (Positional [ValueType
typeGet],ExpressionValue
exprNext) <- Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression Expression c
callNext
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ValueType
typeGet ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
/= ValueType
currType) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Unexpected return type from next(): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> String
forall a. Show a => a -> String
show ValueType
typeGet String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (expected) " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> String
forall a. Show a => a -> String
show ValueType
currType String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (actual)"
  let assnGet :: [Statement c]
assnGet = if Assignable c -> Bool
forall c. Assignable c -> Bool
isAssignableDiscard Assignable c
a then [] else [[c] -> Positional (Assignable c) -> Expression c -> Statement c
forall c.
[c] -> Positional (Assignable c) -> Expression c -> Statement c
Assignment [c]
c2 ([Assignable c] -> Positional (Assignable c)
forall a. [a] -> Positional a
Positional [Assignable c
a]) Expression c
callGet]
  let showVar :: [Statement c]
showVar = case Assignable c
a of
                     CreateVariable [c]
c4 ValueType
t3 VariableName
n -> [[c] -> ValueType -> VariableName -> Statement c
forall c. [c] -> ValueType -> VariableName -> Statement c
ShowVariable [c]
c4 ValueType
t3 VariableName
n]
                     Assignable c
_ -> []
  let next :: [Statement c]
next = [String -> Statement c
forall c. String -> Statement c
RawCodeLine (String -> Statement c) -> String -> Statement c
forall a b. (a -> b) -> a -> b
$ String
currVar String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> ExpressionValue -> String
writeStoredVariable ValueType
currType ExpressionValue
exprNext String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"]
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired (Set CategoryName -> CompilerState a m ())
-> Set CategoryName -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ GeneralInstance -> Set CategoryName
categoriesFromTypes (GeneralInstance -> Set CategoryName)
-> GeneralInstance -> Set CategoryName
forall a b. (a -> b) -> a -> b
$ ValueType -> GeneralInstance
vtType ValueType
currType
  Statement c -> CompilerState a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Statement c -> CompilerState a m ()
compileStatement (Statement c -> CompilerState a m ())
-> Statement c -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ [c] -> VoidExpression c -> Statement c
forall c. [c] -> VoidExpression c -> Statement c
NoValueExpression [] (VoidExpression c -> Statement c)
-> VoidExpression c -> Statement c
forall a b. (a -> b) -> a -> b
$ ScopedBlock c -> VoidExpression c
forall c. ScopedBlock c -> VoidExpression c
WithScope (ScopedBlock c -> VoidExpression c)
-> ScopedBlock c -> VoidExpression c
forall a b. (a -> b) -> a -> b
$ [c]
-> Procedure c
-> Maybe (Procedure c)
-> [c]
-> Statement c
-> ScopedBlock c
forall c.
[c]
-> Procedure c
-> Maybe (Procedure c)
-> [c]
-> Statement c
-> ScopedBlock c
ScopedBlock []
    ([c] -> [Statement c] -> Procedure c
forall c. [c] -> [Statement c] -> Procedure c
Procedure [] [String -> Statement c
forall c. String -> Statement c
RawCodeLine (String -> Statement c) -> String -> Statement c
forall a b. (a -> b) -> a -> b
$ ValueType -> String
variableStoredType ValueType
currType String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
currVar String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> ExpressionValue -> String
writeStoredVariable ValueType
currType ExpressionValue
e' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"]) Maybe (Procedure c)
forall a. Maybe a
Nothing []
    ([c] -> VoidExpression c -> Statement c
forall c. [c] -> VoidExpression c -> Statement c
NoValueExpression [] (VoidExpression c -> Statement c)
-> VoidExpression c -> Statement c
forall a b. (a -> b) -> a -> b
$ IteratedLoop c -> VoidExpression c
forall c. IteratedLoop c -> VoidExpression c
Loop (IteratedLoop c -> VoidExpression c)
-> IteratedLoop c -> VoidExpression c
forall a b. (a -> b) -> a -> b
$ [c]
-> Expression c
-> Procedure c
-> Maybe (Procedure c)
-> IteratedLoop c
forall c.
[c]
-> Expression c
-> Procedure c
-> Maybe (Procedure c)
-> IteratedLoop c
WhileLoop [] ([c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
forall c.
[c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
Expression [] ExpressionStart c
forall {c}. ExpressionStart c
currPresent [])
      ([c] -> [Statement c] -> Procedure c
forall c. [c] -> [Statement c] -> Procedure c
Procedure [c]
c3 ([Statement c]
assnGet [Statement c] -> [Statement c] -> [Statement c]
forall a. [a] -> [a] -> [a]
++ [Statement c]
ss))
      (Procedure c -> Maybe (Procedure c)
forall a. a -> Maybe a
Just (Procedure c -> Maybe (Procedure c))
-> Procedure c -> Maybe (Procedure c)
forall a b. (a -> b) -> a -> b
$ [c] -> [Statement c] -> Procedure c
forall c. [c] -> [Statement c] -> Procedure c
Procedure [] ([Statement c]
forall {c}. [Statement c]
next [Statement c] -> [Statement c] -> [Statement c]
forall a. [a] -> [a] -> [a]
++ [Statement c]
showVar [Statement c] -> [Statement c] -> [Statement c]
forall a. [a] -> [a] -> [a]
++ [Statement c]
update)))
    where
      update :: [Statement c]
update = case Maybe (Procedure c)
u of
                    Just (Procedure [c]
_ [Statement c]
ss2) -> [Statement c]
ss2
                    Maybe (Procedure c)
_                      -> []
      checkContainer :: [a] -> m ()
checkContainer [a
_] = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      checkContainer [a]
ts =
        String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected exactly one Order<?> value but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                         String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show [a]
ts)

compileScopedBlock :: (Ord c, Show c, CollectErrorsM m,
                       CompilerContext c m [String] a) =>
  ScopedBlock c -> CompilerState a m ()
compileScopedBlock :: forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
ScopedBlock c -> CompilerState a m ()
compileScopedBlock s :: ScopedBlock c
s@(ScopedBlock [c]
_ Procedure c
_ Maybe (Procedure c)
_ [c]
c2 Statement c
_) = do
  let ([([c], ValueType, VariableName)]
vs,Procedure c
p,Maybe (Procedure c)
cl,Statement c
st) = ScopedBlock c
-> ([([c], ValueType, VariableName)], Procedure c,
    Maybe (Procedure c), Statement c)
forall {c}.
ScopedBlock c
-> ([([c], ValueType, VariableName)], Procedure c,
    Maybe (Procedure c), Statement c)
rewriteScoped ScopedBlock c
s
  case Statement c
st of
       DeferredVariables [c]
c3 [Assignable c]
_ ->
         String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Cannot defer variable initialization at the top level of scoped/cleanup in statements" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c3
       Statement c
_ -> () -> CompilerState a m ()
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  GeneralInstance
self <- CompilerState a m GeneralInstance
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m GeneralInstance
autoSelfType
  [([c], ValueType, VariableName)]
vs' <- m [([c], ValueType, VariableName)]
-> StateT a m [([c], ValueType, VariableName)]
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [([c], ValueType, VariableName)]
 -> StateT a m [([c], ValueType, VariableName)])
-> m [([c], ValueType, VariableName)]
-> StateT a m [([c], ValueType, VariableName)]
forall a b. (a -> b) -> a -> b
$ (([c], ValueType, VariableName)
 -> m ([c], ValueType, VariableName))
-> [([c], ValueType, VariableName)]
-> m [([c], ValueType, VariableName)]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (GeneralInstance
-> ([c], ValueType, VariableName)
-> m ([c], ValueType, VariableName)
forall {m :: * -> *} {a} {c}.
CollectErrorsM m =>
GeneralInstance -> (a, ValueType, c) -> m (a, ValueType, c)
replaceSelfVariable GeneralInstance
self) [([c], ValueType, VariableName)]
vs
  -- Capture context so we can discard scoped variable names.
  a
ctx0 <- CompilerState a m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m a
getCleanContext
  AnyTypeResolver
r <- CompilerState a m AnyTypeResolver
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m AnyTypeResolver
csResolver
  ParamFilters
fa <- CompilerState a m ParamFilters
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m ParamFilters
csAllFilters
  [CompilerState a m ()] -> CompilerState a m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([CompilerState a m ()] -> CompilerState a m ())
-> [CompilerState a m ()] -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ (([c], ValueType, VariableName) -> CompilerState a m ())
-> [([c], ValueType, VariableName)] -> [CompilerState a m ()]
forall a b. (a -> b) -> [a] -> [b]
map (AnyTypeResolver
-> ParamFilters
-> ([c], ValueType, VariableName)
-> CompilerState a m ()
forall {m :: * -> *} {r} {a} {c} {a} {a}.
(CollectErrorsM m, TypeResolver r, Show a,
 CompilerContext c m [String] a) =>
r
-> Map ParamName a
-> ([a], ValueType, VariableName)
-> StateT a m ()
createVariable AnyTypeResolver
r ParamFilters
fa) [([c], ValueType, VariableName)]
vs'
  a
ctxP0 <- a -> Procedure c -> CompilerState a m a
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> Procedure c -> CompilerState a m a
compileProcedure a
ctx0 Procedure c
p
  -- Make variables to be created visible *after* p has been compiled so that p
  -- can't refer to them.
  a
ctxP <- m a -> CompilerState a m a
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> CompilerState a m a) -> m a -> CompilerState a m a
forall a b. (a -> b) -> a -> b
$ StateT a m [()] -> a -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT ([CompilerState a m ()] -> StateT a m [()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([CompilerState a m ()] -> StateT a m [()])
-> [CompilerState a m ()] -> StateT a m [()]
forall a b. (a -> b) -> a -> b
$ (([c], ValueType, VariableName) -> CompilerState a m ())
-> [([c], ValueType, VariableName)] -> [CompilerState a m ()]
forall a b. (a -> b) -> [a] -> [b]
map ([c], ValueType, VariableName) -> CompilerState a m ()
forall {c} {m :: * -> *} {s} {a}.
CompilerContext c m s a =>
([c], ValueType, VariableName) -> CompilerState a m ()
showVariable [([c], ValueType, VariableName)]
vs') a
ctxP0
  a
ctxCl0 <- m a -> CompilerState a m a
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> CompilerState a m a) -> m a -> CompilerState a m a
forall a b. (a -> b) -> a -> b
$ a -> m a
forall c (m :: * -> *) s a. CompilerContext c m s a => a -> m a
ccClearOutput a
ctxP m a -> (a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> [c] -> m a) -> [c] -> a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> [c] -> m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> [c] -> m a
ccStartCleanup [c]
c2
  a
ctxP' <-
    case Maybe (Procedure c)
cl of
         -- Insert cleanup into the context for the in block.
         Just (Procedure [c]
c [Statement c]
ss) -> do
           Bool
noTrace <- CompilerState a m Bool
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m Bool
csGetNoTrace
           let trace :: [Statement c]
trace = if Bool
noTrace then [] else [String -> Statement c
forall c. String -> Statement c
RawCodeLine String
startCleanupTracing]
           let p2' :: Procedure c
p2' = [c] -> [Statement c] -> Procedure c
forall c. [c] -> [Statement c] -> Procedure c
Procedure [c]
c ([Statement c] -> Procedure c) -> [Statement c] -> Procedure c
forall a b. (a -> b) -> a -> b
$ [String -> Statement c
forall c. String -> Statement c
RawCodeLine String
"{"] [Statement c] -> [Statement c] -> [Statement c]
forall a. [a] -> [a] -> [a]
++ [Statement c]
forall {c}. [Statement c]
trace [Statement c] -> [Statement c] -> [Statement c]
forall a. [a] -> [a] -> [a]
++ [Statement c]
ss [Statement c] -> [Statement c] -> [Statement c]
forall a. [a] -> [a] -> [a]
++ [String -> Statement c
forall c. String -> Statement c
RawCodeLine String
"}"]
           a
ctxCl <- a -> Procedure c -> CompilerState a m a
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> Procedure c -> CompilerState a m a
compileProcedure a
ctxCl0 Procedure c
p2' CompilerState a m a -> String -> CompilerState a m a
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<?? String
"In cleanup starting at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
           a
ctxP' <- m a -> CompilerState a m a
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> CompilerState a m a) -> m a -> CompilerState a m a
forall a b. (a -> b) -> a -> b
$ a -> a -> m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> a -> m a
ccPushCleanup a
ctxP a
ctxCl
           a -> CompilerState a m a
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
ctxP'
         -- Insert an empty cleanup so that it can be used below.
         Maybe (Procedure c)
Nothing -> m a -> CompilerState a m a
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> CompilerState a m a) -> m a -> CompilerState a m a
forall a b. (a -> b) -> a -> b
$ a -> a -> m a
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> a -> m a
ccPushCleanup a
ctxP a
ctxCl0
  a
ctxS <- a -> Procedure c -> CompilerState a m a
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> Procedure c -> CompilerState a m a
compileProcedure a
ctxP' ([c] -> [Statement c] -> Procedure c
forall c. [c] -> [Statement c] -> Procedure c
Procedure [] [Statement c
st])
  case Statement c
st of
       -- Make sure that top-level assignments removed deferred status.
       Assignment [c]
_ (Positional [Assignable c]
existing) Expression c
_ -> (Assignable c -> CompilerState a m ())
-> [Assignable c] -> CompilerState a m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Assignable c -> CompilerState a m ()
forall {c} {m :: * -> *} {s} {a} {c}.
CompilerContext c m s a =>
Assignable c -> CompilerState a m ()
setAssigned [Assignable c]
existing
       Statement c
_ -> () -> CompilerState a m ()
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"{"]
  a -> CompilerState a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> CompilerState a m ()
autoInlineOutput a
ctxS
  -- NOTE: Keep this after inlining the in block in case the in block contains a
  -- jump. (If it does, the cleanup will already be inlined.)
  Bool
unreachable <- CompilerState a m Bool
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m Bool
csIsUnreachable
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
unreachable) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ [c] -> JumpType -> a -> CompilerState a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
[c] -> JumpType -> a -> CompilerState a m ()
autoInsertCleanup [c]
c2 JumpType
NextStatement a
ctxP'
  [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"}"]
  [CompilerState a m ()] -> CompilerState a m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([CompilerState a m ()] -> CompilerState a m ())
-> [CompilerState a m ()] -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ (([c], ValueType, VariableName) -> CompilerState a m ())
-> [([c], ValueType, VariableName)] -> [CompilerState a m ()]
forall a b. (a -> b) -> [a] -> [b]
map ([c], ValueType, VariableName) -> CompilerState a m ()
forall {c} {m :: * -> *} {s} {a}.
CompilerContext c m s a =>
([c], ValueType, VariableName) -> CompilerState a m ()
showVariable [([c], ValueType, VariableName)]
vs'
  where
    setAssigned :: Assignable c -> CompilerState a m ()
setAssigned (ExistingVariable (InputValue [c]
_ VariableName
n)) = VariableName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
VariableName -> CompilerState a m ()
csUpdateAssigned VariableName
n
    setAssigned Assignable c
_ = () -> CompilerState a m ()
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    replaceSelfVariable :: GeneralInstance -> (a, ValueType, c) -> m (a, ValueType, c)
replaceSelfVariable GeneralInstance
self (a
c,ValueType
t,c
n) = do
      ValueType
t' <- GeneralInstance -> ValueType -> m ValueType
forall (m :: * -> *).
CollectErrorsM m =>
GeneralInstance -> ValueType -> m ValueType
replaceSelfValueType GeneralInstance
self ValueType
t
      (a, ValueType, c) -> m (a, ValueType, c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
c,ValueType
t',c
n)
    createVariable :: r
-> Map ParamName a
-> ([a], ValueType, VariableName)
-> StateT a m ()
createVariable r
r Map ParamName a
fa ([a]
c,ValueType
t,VariableName
n) = do
      m () -> StateT a m ()
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT a m ()) -> m () -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ r -> Set ParamName -> GeneralInstance -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> Set ParamName -> GeneralInstance -> m ()
validateGeneralInstance r
r (Map ParamName a -> Set ParamName
forall k a. Map k a -> Set k
Map.keysSet Map ParamName a
fa) (ValueType -> GeneralInstance
vtType ValueType
t) m () -> String -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<??
        String
"In creation of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
forall a. Show a => a -> String
show VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContext [a]
c
      [String] -> StateT a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [ValueType -> String
variableStoredType ValueType
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
variableName VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"]
    showVariable :: ([c], ValueType, VariableName) -> CompilerState a m ()
showVariable ([c]
c,ValueType
t,VariableName
n) = do
      -- TODO: Call csAddRequired for t. (Maybe needs a helper function.)
      UsedVariable c -> VariableValue c -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
UsedVariable c -> VariableValue c -> CompilerState a m ()
csAddVariable ([c] -> VariableName -> UsedVariable c
forall c. [c] -> VariableName -> UsedVariable c
UsedVariable [c]
c VariableName
n) ([c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
forall c.
[c]
-> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
VariableValue [c]
c SymbolScope
LocalScope ValueType
t VariableRule c
forall c. VariableRule c
VariableDefault)
    -- Don't merge if the second scope has cleanup, so that the latter can't
    -- refer to variables defined in the first scope.
    rewriteScoped :: ScopedBlock c
-> ([([c], ValueType, VariableName)], Procedure c,
    Maybe (Procedure c), Statement c)
rewriteScoped (ScopedBlock [c]
_ Procedure c
p cl :: Maybe (Procedure c)
cl@(Just Procedure c
_) [c]
_
                               s2 :: Statement c
s2@(NoValueExpression [c]
_ (WithScope
                                   (ScopedBlock [c]
_ Procedure c
_ (Just Procedure c
_) [c]
_ Statement c
_)))) =
      ([],Procedure c
p,Maybe (Procedure c)
cl,Statement c
s2)
    -- Merge chained scoped sections into a single section.
    rewriteScoped (ScopedBlock [c]
c (Procedure [c]
c3 [Statement c]
ss1) Maybe (Procedure c)
cl1 [c]
c4
                               (NoValueExpression [c]
_ (WithScope
                                (ScopedBlock [c]
_ (Procedure [c]
_ [Statement c]
ss2) Maybe (Procedure c)
cl2 [c]
_ Statement c
s2)))) =
      ScopedBlock c
-> ([([c], ValueType, VariableName)], Procedure c,
    Maybe (Procedure c), Statement c)
rewriteScoped (ScopedBlock c
 -> ([([c], ValueType, VariableName)], Procedure c,
     Maybe (Procedure c), Statement c))
-> ScopedBlock c
-> ([([c], ValueType, VariableName)], Procedure c,
    Maybe (Procedure c), Statement c)
forall a b. (a -> b) -> a -> b
$ [c]
-> Procedure c
-> Maybe (Procedure c)
-> [c]
-> Statement c
-> ScopedBlock c
forall c.
[c]
-> Procedure c
-> Maybe (Procedure c)
-> [c]
-> Statement c
-> ScopedBlock c
ScopedBlock [c]
c ([c] -> [Statement c] -> Procedure c
forall c. [c] -> [Statement c] -> Procedure c
Procedure [c]
c3 ([Statement c] -> Procedure c) -> [Statement c] -> Procedure c
forall a b. (a -> b) -> a -> b
$ [Statement c]
ss1 [Statement c] -> [Statement c] -> [Statement c]
forall a. [a] -> [a] -> [a]
++ [Statement c]
ss2) (Maybe (Procedure c)
cl1 Maybe (Procedure c) -> Maybe (Procedure c) -> Maybe (Procedure c)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Procedure c)
cl2) [c]
c4 Statement c
s2
    -- Gather to-be-created variables.
    rewriteScoped (ScopedBlock [c]
_ Procedure c
p Maybe (Procedure c)
cl [c]
_ (Assignment [c]
c3 Positional (Assignable c)
vs Expression c
e)) =
      ([([c], ValueType, VariableName)]
created,Procedure c
p,Maybe (Procedure c)
cl,[c] -> Positional (Assignable c) -> Expression c -> Statement c
forall c.
[c] -> Positional (Assignable c) -> Expression c -> Statement c
Assignment [c]
c3 ([Assignable c] -> Positional (Assignable c)
forall a. [a] -> Positional a
Positional [Assignable c]
existing) Expression c
e) where
        ([([c], ValueType, VariableName)]
created,[Assignable c]
existing) = (Assignable c
 -> ([([c], ValueType, VariableName)], [Assignable c])
 -> ([([c], ValueType, VariableName)], [Assignable c]))
-> ([([c], ValueType, VariableName)], [Assignable c])
-> [Assignable c]
-> ([([c], ValueType, VariableName)], [Assignable c])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Assignable c
-> ([([c], ValueType, VariableName)], [Assignable c])
-> ([([c], ValueType, VariableName)], [Assignable c])
forall {c}.
Assignable c
-> ([([c], ValueType, VariableName)], [Assignable c])
-> ([([c], ValueType, VariableName)], [Assignable c])
update ([],[]) (Positional (Assignable c) -> [Assignable c]
forall a. Positional a -> [a]
pValues Positional (Assignable c)
vs)
        update :: Assignable c
-> ([([c], ValueType, VariableName)], [Assignable c])
-> ([([c], ValueType, VariableName)], [Assignable c])
update (CreateVariable [c]
c ValueType
t VariableName
n) ([([c], ValueType, VariableName)]
cs,[Assignable c]
es) = (([c]
c,ValueType
t,VariableName
n)([c], ValueType, VariableName)
-> [([c], ValueType, VariableName)]
-> [([c], ValueType, VariableName)]
forall a. a -> [a] -> [a]
:[([c], ValueType, VariableName)]
cs,(InputValue c -> Assignable c
forall c. InputValue c -> Assignable c
ExistingVariable (InputValue c -> Assignable c) -> InputValue c -> Assignable c
forall a b. (a -> b) -> a -> b
$ [c] -> VariableName -> InputValue c
forall c. [c] -> VariableName -> InputValue c
InputValue [c]
c VariableName
n)Assignable c -> [Assignable c] -> [Assignable c]
forall a. a -> [a] -> [a]
:[Assignable c]
es)
        update Assignable c
e2 ([([c], ValueType, VariableName)]
cs,[Assignable c]
es) = ([([c], ValueType, VariableName)]
cs,Assignable c
e2Assignable c -> [Assignable c] -> [Assignable c]
forall a. a -> [a] -> [a]
:[Assignable c]
es)
    rewriteScoped (ScopedBlock [c]
_ Procedure c
p Maybe (Procedure c)
cl [c]
_ (DeferredVariables [c]
c3 [Assignable c]
vs)) =
      ([([c], ValueType, VariableName)]
created,Procedure c
p,Maybe (Procedure c)
cl,[c] -> [Assignable c] -> Statement c
forall c. [c] -> [Assignable c] -> Statement c
DeferredVariables [c]
c3 [Assignable c]
existing) where
        ([([c], ValueType, VariableName)]
created,[Assignable c]
existing) = (Assignable c
 -> ([([c], ValueType, VariableName)], [Assignable c])
 -> ([([c], ValueType, VariableName)], [Assignable c]))
-> ([([c], ValueType, VariableName)], [Assignable c])
-> [Assignable c]
-> ([([c], ValueType, VariableName)], [Assignable c])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Assignable c
-> ([([c], ValueType, VariableName)], [Assignable c])
-> ([([c], ValueType, VariableName)], [Assignable c])
forall {c}.
Assignable c
-> ([([c], ValueType, VariableName)], [Assignable c])
-> ([([c], ValueType, VariableName)], [Assignable c])
update ([],[]) [Assignable c]
vs
        update :: Assignable c
-> ([([c], ValueType, VariableName)], [Assignable c])
-> ([([c], ValueType, VariableName)], [Assignable c])
update (CreateVariable [c]
c ValueType
t VariableName
n) ([([c], ValueType, VariableName)]
cs,[Assignable c]
es) = (([c]
c,ValueType
t,VariableName
n)([c], ValueType, VariableName)
-> [([c], ValueType, VariableName)]
-> [([c], ValueType, VariableName)]
forall a. a -> [a] -> [a]
:[([c], ValueType, VariableName)]
cs,(InputValue c -> Assignable c
forall c. InputValue c -> Assignable c
ExistingVariable (InputValue c -> Assignable c) -> InputValue c -> Assignable c
forall a b. (a -> b) -> a -> b
$ [c] -> VariableName -> InputValue c
forall c. [c] -> VariableName -> InputValue c
InputValue [c]
c VariableName
n)Assignable c -> [Assignable c] -> [Assignable c]
forall a. a -> [a] -> [a]
:[Assignable c]
es)
        update Assignable c
e2 ([([c], ValueType, VariableName)]
cs,[Assignable c]
es) = ([([c], ValueType, VariableName)]
cs,Assignable c
e2Assignable c -> [Assignable c] -> [Assignable c]
forall a. a -> [a] -> [a]
:[Assignable c]
es)
    -- Merge the statement into the scoped block.
    rewriteScoped (ScopedBlock [c]
_ Procedure c
p Maybe (Procedure c)
cl [c]
_ Statement c
s2) =
      ([],Procedure c
p,Maybe (Procedure c)
cl,Statement c
s2)

compileExpression :: (Ord c, Show c, CollectErrorsM m,
                      CompilerContext c m [String] a) =>
  Expression c -> CompilerState a m (ExpressionType,ExpressionValue)
compileExpression :: forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression = Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
forall {m :: * -> *} {c} {a}.
(CollectErrorsM m, Ord c, CompilerContext c m [String] a,
 Show c) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compile where
  callFunctionSpec :: [c]
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionSpec c
-> CompilerState a m (ExpressionType, ExpressionValue)
callFunctionSpec [c]
c Positional (Maybe (CallArgLabel c), Expression c)
as (FunctionSpec [c]
_ (CategoryFunction [c]
c2 CategoryName
cn) FunctionName
fn Positional (InstanceOrInferred c)
ps) =
    Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compile ([c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
forall c.
[c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
Expression [c]
c ([c] -> CategoryName -> FunctionCall c -> ExpressionStart c
forall c.
[c] -> CategoryName -> FunctionCall c -> ExpressionStart c
CategoryCall [c]
c2 CategoryName
cn ([c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
forall c.
[c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
FunctionCall [c]
c FunctionName
fn Positional (InstanceOrInferred c)
ps Positional (Maybe (CallArgLabel c), Expression c)
as)) [])
  callFunctionSpec [c]
c Positional (Maybe (CallArgLabel c), Expression c)
as (FunctionSpec [c]
_ (TypeFunction [c]
c2 TypeInstanceOrParam
tn) FunctionName
fn Positional (InstanceOrInferred c)
ps) =
    Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compile ([c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
forall c.
[c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
Expression [c]
c ([c] -> TypeInstanceOrParam -> FunctionCall c -> ExpressionStart c
forall c.
[c] -> TypeInstanceOrParam -> FunctionCall c -> ExpressionStart c
TypeCall [c]
c2 TypeInstanceOrParam
tn ([c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
forall c.
[c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
FunctionCall [c]
c FunctionName
fn Positional (InstanceOrInferred c)
ps Positional (Maybe (CallArgLabel c), Expression c)
as)) [])
  callFunctionSpec [c]
c Positional (Maybe (CallArgLabel c), Expression c)
as (FunctionSpec [c]
_ (ValueFunction [c]
c2 ValueCallType
o Expression c
e0) FunctionName
fn Positional (InstanceOrInferred c)
ps) =
    Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compile ([c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
forall c.
[c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
Expression [c]
c ([c] -> Expression c -> ExpressionStart c
forall c. [c] -> Expression c -> ExpressionStart c
ParensExpression [c]
c2 Expression c
e0) [[c] -> ValueCallType -> FunctionCall c -> ValueOperation c
forall c.
[c] -> ValueCallType -> FunctionCall c -> ValueOperation c
ValueCall [c]
c ValueCallType
o ([c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
forall c.
[c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
FunctionCall [c]
c FunctionName
fn Positional (InstanceOrInferred c)
ps Positional (Maybe (CallArgLabel c), Expression c)
as)])
  callFunctionSpec [c]
c Positional (Maybe (CallArgLabel c), Expression c)
as (FunctionSpec [c]
c2 FunctionQualifier c
UnqualifiedFunction FunctionName
fn Positional (InstanceOrInferred c)
ps) =
    Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compile ([c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
forall c.
[c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
Expression [c]
c ([c] -> FunctionCall c -> ExpressionStart c
forall c. [c] -> FunctionCall c -> ExpressionStart c
UnqualifiedCall [c]
c2 ([c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
forall c.
[c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
FunctionCall [c]
c FunctionName
fn Positional (InstanceOrInferred c)
ps Positional (Maybe (CallArgLabel c), Expression c)
as)) [])
  compile :: Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compile (Literal ValueLiteral c
l) = ValueLiteral c
-> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
ValueLiteral c
-> CompilerState a m (ExpressionType, ExpressionValue)
compileValueLiteral ValueLiteral c
l
  compile (Expression [c]
_ ExpressionStart c
s [ValueOperation c]
os) = do
    (CompilerState a m (ExpressionType, ExpressionValue)
 -> ValueOperation c
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> CompilerState a m (ExpressionType, ExpressionValue)
-> [ValueOperation c]
-> CompilerState a m (ExpressionType, ExpressionValue)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl CompilerState a m (ExpressionType, ExpressionValue)
-> ValueOperation c
-> CompilerState a m (ExpressionType, ExpressionValue)
forall {m :: * -> *} {a} {a}.
(Show a, CollectErrorsM m, Ord a,
 CompilerContext a m [String] a) =>
StateT a m (ExpressionType, ExpressionValue)
-> ValueOperation a -> StateT a m (ExpressionType, ExpressionValue)
transform (ExpressionStart c
-> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
ExpressionStart c
-> CompilerState a m (ExpressionType, ExpressionValue)
compileExpressionStart ExpressionStart c
s) [ValueOperation c]
os
  compile (DelegatedFunctionCall [c]
c FunctionSpec c
f) = String
"In function delegation at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c String
-> CompilerState a m (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
    Positional (Maybe (CallArgLabel c), VariableName)
args <- CompilerState
  a m (Positional (Maybe (CallArgLabel c), VariableName))
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState
  a m (Positional (Maybe (CallArgLabel c), VariableName))
csDelegateArgs
    let vars :: Positional (Maybe (CallArgLabel c), Expression c)
vars = ((Maybe (CallArgLabel c), VariableName)
 -> (Maybe (CallArgLabel c), Expression c))
-> Positional (Maybe (CallArgLabel c), VariableName)
-> Positional (Maybe (CallArgLabel c), Expression c)
forall a b. (a -> b) -> Positional a -> Positional b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Maybe (CallArgLabel c)
l,VariableName
v) -> (Maybe (CallArgLabel c)
l,[c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
forall c.
[c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
Expression [c]
c (OutputValue c -> ExpressionStart c
forall c. OutputValue c -> ExpressionStart c
NamedVariable ([c] -> VariableName -> OutputValue c
forall c. [c] -> VariableName -> OutputValue c
OutputValue [c]
c VariableName
v)) [])) Positional (Maybe (CallArgLabel c), VariableName)
args
    [c]
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionSpec c
-> CompilerState a m (ExpressionType, ExpressionValue)
callFunctionSpec [c]
c Positional (Maybe (CallArgLabel c), Expression c)
vars FunctionSpec c
f
  compile (DelegatedInitializeValue [c]
c Maybe TypeInstance
t) = String
"In initialization delegation at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c String
-> CompilerState a m (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
    Positional (Maybe (CallArgLabel c), VariableName)
args <- CompilerState
  a m (Positional (Maybe (CallArgLabel c), VariableName))
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState
  a m (Positional (Maybe (CallArgLabel c), VariableName))
csDelegateArgs
    let vars :: Positional (Expression c)
vars = ((Maybe (CallArgLabel c), VariableName) -> Expression c)
-> Positional (Maybe (CallArgLabel c), VariableName)
-> Positional (Expression c)
forall a b. (a -> b) -> Positional a -> Positional b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Maybe (CallArgLabel c)
_,VariableName
v) -> [c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
forall c.
[c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
Expression [c]
c (OutputValue c -> ExpressionStart c
forall c. OutputValue c -> ExpressionStart c
NamedVariable ([c] -> VariableName -> OutputValue c
forall c. [c] -> VariableName -> OutputValue c
OutputValue [c]
c VariableName
v)) []) Positional (Maybe (CallArgLabel c), VariableName)
args
    Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compile ([c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
forall c.
[c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
Expression [c]
c  ([c]
-> Maybe TypeInstance
-> Positional (Expression c)
-> ExpressionStart c
forall c.
[c]
-> Maybe TypeInstance
-> Positional (Expression c)
-> ExpressionStart c
InitializeValue [c]
c Maybe TypeInstance
t Positional (Expression c)
vars) [])
  compile (UnaryExpression [c]
c (FunctionOperator [c]
_ fa :: FunctionSpec c
fa@(FunctionSpec [c]
_ FunctionQualifier c
_ FunctionName
_ Positional (InstanceOrInferred c)
_)) Expression c
e) =
    [c]
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionSpec c
-> CompilerState a m (ExpressionType, ExpressionValue)
callFunctionSpec [c]
c ([(Maybe (CallArgLabel c), Expression c)]
-> Positional (Maybe (CallArgLabel c), Expression c)
forall a. [a] -> Positional a
Positional [(Maybe (CallArgLabel c)
forall a. Maybe a
Nothing,Expression c
e)]) FunctionSpec c
fa
  compile (UnaryExpression [c]
_ (NamedOperator [c]
c String
"-") (Literal (IntegerLiteral [c]
_ Bool
_ Integer
l))) =
    Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compile (ValueLiteral c -> Expression c
forall c. ValueLiteral c -> Expression c
Literal ([c] -> Bool -> Integer -> ValueLiteral c
forall c. [c] -> Bool -> Integer -> ValueLiteral c
IntegerLiteral [c]
c Bool
False (-Integer
l)))
  compile (UnaryExpression [c]
_ (NamedOperator [c]
c String
"-") (Literal (DecimalLiteral [c]
_ Integer
l Integer
e Integer
b))) =
    Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compile (ValueLiteral c -> Expression c
forall c. ValueLiteral c -> Expression c
Literal ([c] -> Integer -> Integer -> Integer -> ValueLiteral c
forall c. [c] -> Integer -> Integer -> Integer -> ValueLiteral c
DecimalLiteral [c]
c (-Integer
l) Integer
e Integer
b))
  compile (UnaryExpression [c]
_ (NamedOperator [c]
c String
o) Expression c
e) = do
    (Positional [ValueType]
ts,ExpressionValue
e') <- Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression Expression c
e
    ValueType
t' <- [c] -> [ValueType] -> StateT a m ValueType
forall {m :: * -> *} {a} {a}.
(ErrorContextM m, Show a, Show a) =>
[a] -> [a] -> m a
requireSingle [c]
c [ValueType]
ts
    ValueType
-> ExpressionValue
-> CompilerState a m (ExpressionType, ExpressionValue)
forall {m :: * -> *}.
ErrorContextM m =>
ValueType -> ExpressionValue -> m (ExpressionType, ExpressionValue)
doUnary ValueType
t' ExpressionValue
e'
    where
      doUnary :: ValueType -> ExpressionValue -> m (ExpressionType, ExpressionValue)
doUnary ValueType
t ExpressionValue
e2
        | String
o String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"!" = ValueType -> ExpressionValue -> m (ExpressionType, ExpressionValue)
forall {m :: * -> *}.
ErrorContextM m =>
ValueType -> ExpressionValue -> m (ExpressionType, ExpressionValue)
doNot ValueType
t ExpressionValue
e2
        | String
o String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-" = ValueType -> ExpressionValue -> m (ExpressionType, ExpressionValue)
forall {m :: * -> *}.
ErrorContextM m =>
ValueType -> ExpressionValue -> m (ExpressionType, ExpressionValue)
doNeg ValueType
t ExpressionValue
e2
        | String
o String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"~" = ValueType -> ExpressionValue -> m (ExpressionType, ExpressionValue)
forall {m :: * -> *}.
ErrorContextM m =>
ValueType -> ExpressionValue -> m (ExpressionType, ExpressionValue)
doComp ValueType
t ExpressionValue
e2
        | Bool
otherwise = String -> m (ExpressionType, ExpressionValue)
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m (ExpressionType, ExpressionValue))
-> String -> m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ String
"Unknown unary operator \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                       [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
      doNot :: ValueType -> ExpressionValue -> m (ExpressionType, ExpressionValue)
doNot ValueType
t ExpressionValue
e2 = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ValueType
t ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
/= ValueType
boolRequiredValue) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Cannot use " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> String
forall a. Show a => a -> String
show ValueType
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" with unary ! operator" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                            [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
        (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExpressionType, ExpressionValue)
 -> m (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
boolRequiredValue],PrimitiveType -> String -> ExpressionValue
UnboxedPrimitive PrimitiveType
PrimBool (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
"!(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PrimitiveType -> ExpressionValue -> String
useAsUnboxed PrimitiveType
PrimBool ExpressionValue
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
      doNeg :: ValueType -> ExpressionValue -> m (ExpressionType, ExpressionValue)
doNeg ValueType
t ExpressionValue
e2
        | ValueType
t ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
intRequiredValue = (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExpressionType, ExpressionValue)
 -> m (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
intRequiredValue],
                                            PrimitiveType -> String -> ExpressionValue
UnboxedPrimitive PrimitiveType
PrimInt (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PrimitiveType -> ExpressionValue -> String
useAsUnboxed PrimitiveType
PrimInt ExpressionValue
e2)
        | ValueType
t ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
floatRequiredValue = (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExpressionType, ExpressionValue)
 -> m (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
floatRequiredValue],
                                             PrimitiveType -> String -> ExpressionValue
UnboxedPrimitive PrimitiveType
PrimFloat (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
"-(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PrimitiveType -> ExpressionValue -> String
useAsUnboxed PrimitiveType
PrimFloat ExpressionValue
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
        | Bool
otherwise = String -> m (ExpressionType, ExpressionValue)
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m (ExpressionType, ExpressionValue))
-> String -> m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ String
"Cannot use " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> String
forall a. Show a => a -> String
show ValueType
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" with unary - operator" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                       [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
      doComp :: ValueType -> ExpressionValue -> m (ExpressionType, ExpressionValue)
doComp ValueType
t ExpressionValue
e2
        | ValueType
t ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
intRequiredValue = (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExpressionType, ExpressionValue)
 -> m (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
intRequiredValue],
                                            PrimitiveType -> String -> ExpressionValue
UnboxedPrimitive PrimitiveType
PrimInt (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
"~(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PrimitiveType -> ExpressionValue -> String
useAsUnboxed PrimitiveType
PrimInt ExpressionValue
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
        | Bool
otherwise = String -> m (ExpressionType, ExpressionValue)
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m (ExpressionType, ExpressionValue))
-> String -> m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ String
"Cannot use " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> String
forall a. Show a => a -> String
show ValueType
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" with unary ~ operator" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                       [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  compile (InfixExpression [c]
c Expression c
e1 (FunctionOperator [c]
_ (FunctionSpec [c]
_ (CategoryFunction [c]
c2 CategoryName
cn) FunctionName
fn Positional (InstanceOrInferred c)
ps)) Expression c
e2) =
    Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compile ([c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
forall c.
[c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
Expression [c]
c ([c] -> CategoryName -> FunctionCall c -> ExpressionStart c
forall c.
[c] -> CategoryName -> FunctionCall c -> ExpressionStart c
CategoryCall [c]
c2 CategoryName
cn ([c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
forall c.
[c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
FunctionCall [c]
c FunctionName
fn Positional (InstanceOrInferred c)
ps ([(Maybe (CallArgLabel c), Expression c)]
-> Positional (Maybe (CallArgLabel c), Expression c)
forall a. [a] -> Positional a
Positional [(Maybe (CallArgLabel c)
forall a. Maybe a
Nothing,Expression c
e1),(Maybe (CallArgLabel c)
forall a. Maybe a
Nothing,Expression c
e2)]))) [])
  compile (InfixExpression [c]
c Expression c
e1 (FunctionOperator [c]
_ (FunctionSpec [c]
_ (TypeFunction [c]
c2 TypeInstanceOrParam
tn) FunctionName
fn Positional (InstanceOrInferred c)
ps)) Expression c
e2) =
    Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compile ([c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
forall c.
[c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
Expression [c]
c ([c] -> TypeInstanceOrParam -> FunctionCall c -> ExpressionStart c
forall c.
[c] -> TypeInstanceOrParam -> FunctionCall c -> ExpressionStart c
TypeCall [c]
c2 TypeInstanceOrParam
tn ([c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
forall c.
[c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
FunctionCall [c]
c FunctionName
fn Positional (InstanceOrInferred c)
ps ([(Maybe (CallArgLabel c), Expression c)]
-> Positional (Maybe (CallArgLabel c), Expression c)
forall a. [a] -> Positional a
Positional [(Maybe (CallArgLabel c)
forall a. Maybe a
Nothing,Expression c
e1),(Maybe (CallArgLabel c)
forall a. Maybe a
Nothing,Expression c
e2)]))) [])
  compile (InfixExpression [c]
c Expression c
e1 (FunctionOperator [c]
_ (FunctionSpec [c]
_ (ValueFunction [c]
c2 ValueCallType
o Expression c
e0) FunctionName
fn Positional (InstanceOrInferred c)
ps)) Expression c
e2) =
    Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compile ([c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
forall c.
[c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
Expression [c]
c ([c] -> Expression c -> ExpressionStart c
forall c. [c] -> Expression c -> ExpressionStart c
ParensExpression [c]
c2 Expression c
e0) [[c] -> ValueCallType -> FunctionCall c -> ValueOperation c
forall c.
[c] -> ValueCallType -> FunctionCall c -> ValueOperation c
ValueCall [c]
c ValueCallType
o ([c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
forall c.
[c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
FunctionCall [c]
c FunctionName
fn Positional (InstanceOrInferred c)
ps ([(Maybe (CallArgLabel c), Expression c)]
-> Positional (Maybe (CallArgLabel c), Expression c)
forall a. [a] -> Positional a
Positional [(Maybe (CallArgLabel c)
forall a. Maybe a
Nothing,Expression c
e1),(Maybe (CallArgLabel c)
forall a. Maybe a
Nothing,Expression c
e2)]))])
  compile (InfixExpression [c]
c Expression c
e1 (FunctionOperator [c]
_ (FunctionSpec [c]
c2 FunctionQualifier c
UnqualifiedFunction FunctionName
fn Positional (InstanceOrInferred c)
ps)) Expression c
e2) =
    Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compile ([c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
forall c.
[c] -> ExpressionStart c -> [ValueOperation c] -> Expression c
Expression [c]
c ([c] -> FunctionCall c -> ExpressionStart c
forall c. [c] -> FunctionCall c -> ExpressionStart c
UnqualifiedCall [c]
c2 ([c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
forall c.
[c]
-> FunctionName
-> Positional (InstanceOrInferred c)
-> Positional (Maybe (CallArgLabel c), Expression c)
-> FunctionCall c
FunctionCall [c]
c FunctionName
fn Positional (InstanceOrInferred c)
ps ([(Maybe (CallArgLabel c), Expression c)]
-> Positional (Maybe (CallArgLabel c), Expression c)
forall a. [a] -> Positional a
Positional [(Maybe (CallArgLabel c)
forall a. Maybe a
Nothing,Expression c
e1),(Maybe (CallArgLabel c)
forall a. Maybe a
Nothing,Expression c
e2)]))) [])
  compile (InfixExpression [c]
_ Expression c
e1 (NamedOperator [c]
c String
o) Expression c
e2) = do
    (ExpressionType, ExpressionValue)
e1' <- Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression Expression c
e1
    (ExpressionType, ExpressionValue)
e2' <- if String
o String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
logical
              then Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
forall {m :: * -> *} {c} {s}.
(CollectErrorsM m, Ord c, Show c,
 CompilerContext c m [String] s) =>
Expression c -> StateT s m (ExpressionType, ExpressionValue)
isolateExpression Expression c
e2 -- Ignore named-return assignments.
              else Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression Expression c
e2
    [c]
-> (ExpressionType, ExpressionValue)
-> String
-> (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall {m :: * -> *} {a}.
(ErrorContextM m, Show a) =>
[a]
-> (ExpressionType, ExpressionValue)
-> String
-> (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
bindInfix [c]
c (ExpressionType, ExpressionValue)
e1' String
o (ExpressionType, ExpressionValue)
e2'
  compile (RawExpression ExpressionType
ts ExpressionValue
e) = (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExpressionType
ts,ExpressionValue
e)
  isolateExpression :: Expression c -> StateT s m (ExpressionType, ExpressionValue)
isolateExpression Expression c
e = do
    s
ctx <- CompilerState s m s
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m a
getCleanContext
    ((ExpressionType, ExpressionValue)
e',s
ctx') <- m ((ExpressionType, ExpressionValue), s)
-> StateT s m ((ExpressionType, ExpressionValue), s)
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ((ExpressionType, ExpressionValue), s)
 -> StateT s m ((ExpressionType, ExpressionValue), s))
-> m ((ExpressionType, ExpressionValue), s)
-> StateT s m ((ExpressionType, ExpressionValue), s)
forall a b. (a -> b) -> a -> b
$ StateT s m (ExpressionType, ExpressionValue)
-> s -> m ((ExpressionType, ExpressionValue), s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Expression c -> StateT s m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression Expression c
e) s
ctx
    s -> CompilerState s m ()
forall (m :: * -> *) c a.
(CollectErrorsM m, CompilerContext c m [String] a) =>
a -> CompilerState a m ()
inheritRequired s
ctx'
    s -> CompilerState s m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> CompilerState a m ()
csInheritUsed s
ctx'
    (ExpressionType, ExpressionValue)
-> StateT s m (ExpressionType, ExpressionValue)
forall a. a -> StateT s m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExpressionType, ExpressionValue)
e'
  arithmetic1 :: Set String
arithmetic1 = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String
"*",String
"/"]
  arithmetic2 :: Set String
arithmetic2 = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String
"%"]
  arithmetic3 :: Set String
arithmetic3 = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String
"+",String
"-"]
  equals :: Set String
equals = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String
"==",String
"!="]
  comparison :: Set String
comparison = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String
"==",String
"!=",String
"<",String
"<=",String
">",String
">="]
  logical :: Set String
logical = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String
"&&",String
"||"]
  bitwise :: Set String
bitwise = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String
"&",String
"|",String
"^",String
">>",String
"<<"]
  bindInfix :: [a]
-> (ExpressionType, ExpressionValue)
-> String
-> (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
bindInfix [a]
c (Positional [ValueType]
ts1,ExpressionValue
e1) String
o (Positional [ValueType]
ts2,ExpressionValue
e2) = do
    -- TODO: Needs better error messages.
    ValueType
t1' <- [a] -> [ValueType] -> m ValueType
forall {m :: * -> *} {a} {a}.
(ErrorContextM m, Show a, Show a) =>
[a] -> [a] -> m a
requireSingle [a]
c [ValueType]
ts1
    ValueType
t2' <- [a] -> [ValueType] -> m ValueType
forall {m :: * -> *} {a} {a}.
(ErrorContextM m, Show a, Show a) =>
[a] -> [a] -> m a
requireSingle [a]
c [ValueType]
ts2
    ValueType -> ValueType -> m (ExpressionType, ExpressionValue)
forall {m :: * -> *}.
ErrorContextM m =>
ValueType -> ValueType -> m (ExpressionType, ExpressionValue)
bind ValueType
t1' ValueType
t2'
    where
      bind :: ValueType -> ValueType -> m (ExpressionType, ExpressionValue)
bind ValueType
t1 ValueType
t2
        | String
o String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"<||" = do
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ValueType -> Bool
isOptionalValue ValueType
t1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"<|| requires the left expression to be optional but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> String
forall a. Show a => a -> String
show ValueType
t1
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ValueType -> Bool
isWeakValue ValueType
t2) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"<|| requires the right expression to be not be weak but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> String
forall a. Show a => a -> String
show ValueType
t2
          (ValueType, ExpressionValue)
-> (ValueType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall {m :: * -> *}.
Monad m =>
(ValueType, ExpressionValue)
-> (ValueType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
compileOptionalOr (ValueType
t1,ExpressionValue
e1) (ValueType
t2,ExpressionValue
e2)
        | String
o String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
comparison Bool -> Bool -> Bool
&& ValueType -> Bool
isIdentifierRequiredValue ValueType
t1 Bool -> Bool -> Bool
&& ValueType -> Bool
isIdentifierRequiredValue ValueType
t2 = do
          (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
boolRequiredValue],PrimitiveType
-> PrimitiveType
-> ExpressionValue
-> String
-> ExpressionValue
-> ExpressionValue
glueInfix PrimitiveType
PrimIdentifier PrimitiveType
PrimBool ExpressionValue
e1 String
o ExpressionValue
e2)
        | ValueType
t1 ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
/= ValueType
t2 =
          String -> m (ExpressionType, ExpressionValue)
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m (ExpressionType, ExpressionValue))
-> String -> m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ String
"Cannot " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> String
forall a. Show a => a -> String
show ValueType
t1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" and " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                           ValueType -> String
forall a. Show a => a -> String
show ValueType
t2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [a]
c
        | String
o String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
comparison Bool -> Bool -> Bool
&& ValueType
t1 ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
intRequiredValue = do
          (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
boolRequiredValue],PrimitiveType
-> PrimitiveType
-> ExpressionValue
-> String
-> ExpressionValue
-> ExpressionValue
glueInfix PrimitiveType
PrimInt PrimitiveType
PrimBool ExpressionValue
e1 String
o ExpressionValue
e2)
        | String
o String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
comparison Bool -> Bool -> Bool
&& ValueType
t1 ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
floatRequiredValue = do
          (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
boolRequiredValue],PrimitiveType
-> PrimitiveType
-> ExpressionValue
-> String
-> ExpressionValue
-> ExpressionValue
glueInfix PrimitiveType
PrimFloat PrimitiveType
PrimBool ExpressionValue
e1 String
o ExpressionValue
e2)
        | String
o String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
comparison Bool -> Bool -> Bool
&& ValueType
t1 ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
stringRequiredValue = do
          (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
boolRequiredValue],PrimitiveType
-> PrimitiveType
-> ExpressionValue
-> String
-> ExpressionValue
-> ExpressionValue
glueInfix PrimitiveType
PrimString PrimitiveType
PrimBool ExpressionValue
e1 String
o ExpressionValue
e2)
        | String
o String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
comparison Bool -> Bool -> Bool
&& ValueType
t1 ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
charRequiredValue = do
          (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
boolRequiredValue],PrimitiveType
-> PrimitiveType
-> ExpressionValue
-> String
-> ExpressionValue
-> ExpressionValue
glueInfix PrimitiveType
PrimChar PrimitiveType
PrimBool ExpressionValue
e1 String
o ExpressionValue
e2)
        | String
o String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
arithmetic1 Bool -> Bool -> Bool
&& ValueType
t1 ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
intRequiredValue = do
          (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
intRequiredValue],PrimitiveType
-> PrimitiveType
-> ExpressionValue
-> String
-> ExpressionValue
-> ExpressionValue
glueInfix PrimitiveType
PrimInt PrimitiveType
PrimInt ExpressionValue
e1 String
o ExpressionValue
e2)
        | String
o String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
bitwise Bool -> Bool -> Bool
&& ValueType
t1 ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
intRequiredValue = do
          (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
intRequiredValue],PrimitiveType
-> PrimitiveType
-> ExpressionValue
-> String
-> ExpressionValue
-> ExpressionValue
glueInfix PrimitiveType
PrimInt PrimitiveType
PrimInt ExpressionValue
e1 String
o ExpressionValue
e2)
        | String
o String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
arithmetic2 Bool -> Bool -> Bool
&& ValueType
t1 ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
intRequiredValue = do
          (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
intRequiredValue],PrimitiveType
-> PrimitiveType
-> ExpressionValue
-> String
-> ExpressionValue
-> ExpressionValue
glueInfix PrimitiveType
PrimInt PrimitiveType
PrimInt ExpressionValue
e1 String
o ExpressionValue
e2)
        | String
o String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
arithmetic3 Bool -> Bool -> Bool
&& ValueType
t1 ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
intRequiredValue = do
          (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
intRequiredValue],PrimitiveType
-> PrimitiveType
-> ExpressionValue
-> String
-> ExpressionValue
-> ExpressionValue
glueInfix PrimitiveType
PrimInt PrimitiveType
PrimInt ExpressionValue
e1 String
o ExpressionValue
e2)
        | String
o String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
arithmetic1 Bool -> Bool -> Bool
&& ValueType
t1 ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
floatRequiredValue = do
          (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
floatRequiredValue],PrimitiveType
-> PrimitiveType
-> ExpressionValue
-> String
-> ExpressionValue
-> ExpressionValue
glueInfix PrimitiveType
PrimFloat PrimitiveType
PrimFloat ExpressionValue
e1 String
o ExpressionValue
e2)
        | String
o String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
arithmetic3 Bool -> Bool -> Bool
&& ValueType
t1 ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
floatRequiredValue = do
          (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
floatRequiredValue],PrimitiveType
-> PrimitiveType
-> ExpressionValue
-> String
-> ExpressionValue
-> ExpressionValue
glueInfix PrimitiveType
PrimFloat PrimitiveType
PrimFloat ExpressionValue
e1 String
o ExpressionValue
e2)
        | String
o String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"+" Bool -> Bool -> Bool
&& ValueType
t1 ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
stringRequiredValue = do
          (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
stringRequiredValue],PrimitiveType
-> PrimitiveType
-> ExpressionValue
-> String
-> ExpressionValue
-> ExpressionValue
glueInfix PrimitiveType
PrimString PrimitiveType
PrimString ExpressionValue
e1 String
o ExpressionValue
e2)
        | String
o String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
logical Bool -> Bool -> Bool
&& ValueType
t1 ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
boolRequiredValue = do
          (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
boolRequiredValue],PrimitiveType
-> PrimitiveType
-> ExpressionValue
-> String
-> ExpressionValue
-> ExpressionValue
glueInfix PrimitiveType
PrimBool PrimitiveType
PrimBool ExpressionValue
e1 String
o ExpressionValue
e2)
        | String
o String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"^" Bool -> Bool -> Bool
&& ValueType
t1 ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
boolRequiredValue = do
          (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
boolRequiredValue],PrimitiveType
-> PrimitiveType
-> ExpressionValue
-> String
-> ExpressionValue
-> ExpressionValue
glueInfix PrimitiveType
PrimBool PrimitiveType
PrimBool ExpressionValue
e1 String
o ExpressionValue
e2)
        | String
o String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-" Bool -> Bool -> Bool
&& ValueType
t1 ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
charRequiredValue = do
          (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
intRequiredValue],PrimitiveType
-> PrimitiveType
-> ExpressionValue
-> String
-> ExpressionValue
-> ExpressionValue
glueInfix PrimitiveType
PrimChar PrimitiveType
PrimInt ExpressionValue
e1 String
o ExpressionValue
e2)
        | String
o String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
equals Bool -> Bool -> Bool
&& ValueType
t1 ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
boolRequiredValue = do
          (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
boolRequiredValue],PrimitiveType
-> PrimitiveType
-> ExpressionValue
-> String
-> ExpressionValue
-> ExpressionValue
glueInfix PrimitiveType
PrimBool PrimitiveType
PrimBool ExpressionValue
e1 String
o ExpressionValue
e2)
        | Bool
otherwise =
          String -> m (ExpressionType, ExpressionValue)
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m (ExpressionType, ExpressionValue))
-> String -> m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ String
"Cannot " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> String
forall a. Show a => a -> String
show ValueType
t1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" and " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                 ValueType -> String
forall a. Show a => a -> String
show ValueType
t2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [a]
c
      glueInfix :: PrimitiveType
-> PrimitiveType
-> ExpressionValue
-> String
-> ExpressionValue
-> ExpressionValue
glueInfix PrimitiveType
t1 PrimitiveType
t2 ExpressionValue
e3 String
o2 ExpressionValue
e4 =
        PrimitiveType -> String -> ExpressionValue
UnboxedPrimitive PrimitiveType
t2 (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PrimitiveType -> ExpressionValue -> String
useAsUnboxed PrimitiveType
t1 ExpressionValue
e3 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
o2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PrimitiveType -> ExpressionValue -> String
useAsUnboxed PrimitiveType
t1 ExpressionValue
e4 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
  transform :: StateT a m (ExpressionType, ExpressionValue)
-> ValueOperation a -> StateT a m (ExpressionType, ExpressionValue)
transform StateT a m (ExpressionType, ExpressionValue)
e (TypeConversion [a]
c GeneralInstance
t) = do
    (Positional [ValueType]
ts,ExpressionValue
e') <- StateT a m (ExpressionType, ExpressionValue)
e
    ValueType
t' <- [a] -> [ValueType] -> StateT a m ValueType
forall {m :: * -> *} {a} {a}.
(ErrorContextM m, Show a, Show a) =>
[a] -> [a] -> m a
requireSingle [a]
c [ValueType]
ts
    AnyTypeResolver
r <- CompilerState a m AnyTypeResolver
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m AnyTypeResolver
csResolver
    ParamFilters
fa <- CompilerState a m ParamFilters
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m ParamFilters
csAllFilters
    let vt :: ValueType
vt = StorageType -> GeneralInstance -> ValueType
ValueType (ValueType -> StorageType
vtRequired ValueType
t') GeneralInstance
t
    (m () -> StateT a m ()
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT a m ()) -> m () -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ AnyTypeResolver -> ParamFilters -> ValueType -> ValueType -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> ValueType -> ValueType -> m ()
checkValueAssignment AnyTypeResolver
r ParamFilters
fa ValueType
t' ValueType
vt) StateT a m () -> String -> StateT a m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<??
      String
"In explicit type conversion at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContext [a]
c
    (ExpressionType, ExpressionValue)
-> StateT a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
vt],ExpressionValue
e')
  transform StateT a m (ExpressionType, ExpressionValue)
e (ValueCall [a]
c ValueCallType
o FunctionCall a
f) = do
    (Positional [ValueType]
ts,ExpressionValue
e') <- StateT a m (ExpressionType, ExpressionValue)
e
    ValueType
t' <- [a] -> [ValueType] -> StateT a m ValueType
forall {m :: * -> *} {a} {a}.
(ErrorContextM m, Show a, Show a) =>
[a] -> [a] -> m a
requireSingle [a]
c [ValueType]
ts
    ScopedFunction a
f' <- ValueType
-> ValueCallType
-> FunctionCall a
-> CompilerState a m (ScopedFunction a)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
ValueType
-> ValueCallType
-> FunctionCall c
-> CompilerState a m (ScopedFunction c)
lookupValueFunction ValueType
t' ValueCallType
o FunctionCall a
f
    Bool
-> Maybe String
-> ScopedFunction a
-> FunctionCall a
-> StateT a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Bool
-> Maybe String
-> ScopedFunction c
-> FunctionCall c
-> CompilerState a m (ExpressionType, ExpressionValue)
compileFunctionCall (ValueCallType
o ValueCallType -> ValueCallType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueCallType
CallUnlessEmpty) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ExpressionValue -> String
useAsUnwrapped ExpressionValue
e') ScopedFunction a
f' FunctionCall a
f
  transform StateT a m (ExpressionType, ExpressionValue)
e (SelectReturn [a]
c Int
pos) = do
    (Positional [ValueType]
ts,ExpressionValue
e') <- StateT a m (ExpressionType, ExpressionValue)
e
    Bool -> StateT a m () -> StateT a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ExpressionValue -> Bool
isOpaqueMulti ExpressionValue
e') (StateT a m () -> StateT a m ()) -> StateT a m () -> StateT a m ()
forall a b. (a -> b) -> a -> b
$
      String -> StateT a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> StateT a m ()) -> String -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ String
"Return selection can only be used with function returns" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [a]
c
    Bool -> StateT a m () -> StateT a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [ValueType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ValueType]
ts) (StateT a m () -> StateT a m ()) -> StateT a m () -> StateT a m ()
forall a b. (a -> b) -> a -> b
$
      String -> StateT a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> StateT a m ()) -> String -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ String
"Position " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
pos String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" exceeds return count " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([ValueType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ValueType]
ts) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContext [a]
c
    (ExpressionType, ExpressionValue)
-> StateT a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [[ValueType]
ts [ValueType] -> Int -> ValueType
forall a. HasCallStack => [a] -> Int -> a
!! Int
pos],String -> ExpressionValue
WrappedSingle (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ ExpressionValue -> String
useAsReturns ExpressionValue
e' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".At(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
pos String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
  requireSingle :: [a] -> [a] -> m a
requireSingle [a]
_ [a
t] = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
t
  requireSingle [a]
c2 [a]
ts =
    String -> m a
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Function call requires one return but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatTypes [a]
ts String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [a]
c2
  formatTypes :: [a] -> String
formatTypes [] = String
"none"
  formatTypes [a]
ts = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show [a]
ts)
  compileOptionalOr :: (ValueType, ExpressionValue)
-> (ValueType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
compileOptionalOr (ValueType
t1,ExpressionValue
e1) (ValueType
t2,ExpressionValue
e2) = do
    let t' :: ValueType
t' = ValueType -> ValueType -> ValueType
combineTypes ValueType
t1 ValueType
t2
    let code :: ExpressionValue
code = String -> ExpressionValue
WrappedSingle (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
"TYPE_VALUE_LEFT_UNLESS_EMPTY(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpressionValue -> String
useAsUnwrapped ExpressionValue
e1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpressionValue -> String
useAsUnwrapped ExpressionValue
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    (ExpressionType, ExpressionValue)
-> m (ExpressionType, ExpressionValue)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
t'], ExpressionValue
code)
  combineTypes :: ValueType -> ValueType -> ValueType
combineTypes (ValueType StorageType
_ GeneralInstance
t1) (ValueType StorageType
s GeneralInstance
t2) = StorageType -> GeneralInstance -> ValueType
ValueType StorageType
s ([GeneralInstance] -> GeneralInstance
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
forall (f :: * -> *).
Foldable f =>
f GeneralInstance -> GeneralInstance
mergeAny [GeneralInstance
t1,GeneralInstance
t2])

forceOptionalReturns :: [c] -> ScopedFunction c -> ScopedFunction c
forceOptionalReturns :: forall c. [c] -> ScopedFunction c -> ScopedFunction c
forceOptionalReturns [c]
c0 (ScopedFunction [c]
c FunctionName
n CategoryName
t SymbolScope
s FunctionVisibility c
v Positional (PassedValue c, Maybe (CallArgLabel c))
as Positional (PassedValue c)
rs Positional (ValueParam c)
ps [ParamFilter c]
fs [ScopedFunction c]
ms) =
  [c]
-> FunctionName
-> CategoryName
-> SymbolScope
-> FunctionVisibility c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
-> Positional (PassedValue c)
-> Positional (ValueParam c)
-> [ParamFilter c]
-> [ScopedFunction c]
-> ScopedFunction c
forall c.
[c]
-> FunctionName
-> CategoryName
-> SymbolScope
-> FunctionVisibility c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
-> Positional (PassedValue c)
-> Positional (ValueParam c)
-> [ParamFilter c]
-> [ScopedFunction c]
-> ScopedFunction c
ScopedFunction [c]
c FunctionName
n CategoryName
t SymbolScope
s FunctionVisibility c
v Positional (PassedValue c, Maybe (CallArgLabel c))
as Positional (PassedValue c)
rs' Positional (ValueParam c)
ps [ParamFilter c]
fs [ScopedFunction c]
ms where
    rs' :: Positional (PassedValue c)
rs' = (PassedValue c -> PassedValue c)
-> Positional (PassedValue c) -> Positional (PassedValue c)
forall a b. (a -> b) -> Positional a -> Positional b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PassedValue c -> PassedValue c
forceOptional Positional (PassedValue c)
rs
    forceOptional :: PassedValue c -> PassedValue c
forceOptional (PassedValue [c]
c2 (ValueType StorageType
RequiredValue GeneralInstance
t2)) = ([c] -> ValueType -> PassedValue c
forall c. [c] -> ValueType -> PassedValue c
PassedValue ([c]
c0 [c] -> [c] -> [c]
forall a. [a] -> [a] -> [a]
++ [c]
c2) (StorageType -> GeneralInstance -> ValueType
ValueType StorageType
OptionalValue GeneralInstance
t2))
    forceOptional PassedValue c
t2 = PassedValue c
t2

lookupValueFunction :: (Ord c, Show c, CollectErrorsM m,
                        CompilerContext c m [String] a) =>
  ValueType -> ValueCallType -> FunctionCall c -> CompilerState a m (ScopedFunction c)
lookupValueFunction :: forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
ValueType
-> ValueCallType
-> FunctionCall c
-> CompilerState a m (ScopedFunction c)
lookupValueFunction (ValueType StorageType
OptionalValue GeneralInstance
t) ValueCallType
CallUnlessEmpty f :: FunctionCall c
f@(FunctionCall [c]
c FunctionName
_ Positional (InstanceOrInferred c)
_ Positional (Maybe (CallArgLabel c), Expression c)
_) = do
  ScopedFunction c
f' <- ValueType
-> ValueCallType
-> FunctionCall c
-> CompilerState a m (ScopedFunction c)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
ValueType
-> ValueCallType
-> FunctionCall c
-> CompilerState a m (ScopedFunction c)
lookupValueFunction (StorageType -> GeneralInstance -> ValueType
ValueType StorageType
RequiredValue GeneralInstance
t) ValueCallType
AlwaysCall FunctionCall c
f
  ScopedFunction c -> CompilerState a m (ScopedFunction c)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScopedFunction c -> CompilerState a m (ScopedFunction c))
-> ScopedFunction c -> CompilerState a m (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ [c] -> ScopedFunction c -> ScopedFunction c
forall c. [c] -> ScopedFunction c -> ScopedFunction c
forceOptionalReturns [c]
c ScopedFunction c
f'
lookupValueFunction ValueType
t ValueCallType
CallUnlessEmpty (FunctionCall [c]
c FunctionName
_ Positional (InstanceOrInferred c)
_ Positional (Maybe (CallArgLabel c), Expression c)
_) =
  String -> CompilerState a m (ScopedFunction c)
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m (ScopedFunction c))
-> String -> CompilerState a m (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ String
"Optional type required for &. but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> String
forall a. Show a => a -> String
show ValueType
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
lookupValueFunction (ValueType StorageType
WeakValue GeneralInstance
t) ValueCallType
_ (FunctionCall [c]
c FunctionName
_ Positional (InstanceOrInferred c)
_ Positional (Maybe (CallArgLabel c), Expression c)
_) =
  String -> CompilerState a m (ScopedFunction c)
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m (ScopedFunction c))
-> String -> CompilerState a m (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ String
"Use strong to convert weak " String -> String -> String
forall a. [a] -> [a] -> [a]
++ GeneralInstance -> String
forall a. Show a => a -> String
show GeneralInstance
t String -> String -> String
forall a. [a] -> [a] -> [a]
++
                        String
" to optional first" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
lookupValueFunction (ValueType StorageType
OptionalValue GeneralInstance
t) ValueCallType
_ (FunctionCall [c]
c FunctionName
_ Positional (InstanceOrInferred c)
_ Positional (Maybe (CallArgLabel c), Expression c)
_) =
  String -> CompilerState a m (ScopedFunction c)
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m (ScopedFunction c))
-> String -> CompilerState a m (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ String
"Use require to convert optional " String -> String -> String
forall a. [a] -> [a] -> [a]
++ GeneralInstance -> String
forall a. Show a => a -> String
show GeneralInstance
t String -> String -> String
forall a. [a] -> [a] -> [a]
++
                        String
" to required first" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
lookupValueFunction (ValueType StorageType
RequiredValue GeneralInstance
t) ValueCallType
_ (FunctionCall [c]
c FunctionName
n Positional (InstanceOrInferred c)
_ Positional (Maybe (CallArgLabel c), Expression c)
_) = do
  ScopedFunction c
f' <- [c]
-> Maybe GeneralInstance
-> FunctionName
-> CompilerState a m (ScopedFunction c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c]
-> Maybe GeneralInstance
-> FunctionName
-> CompilerState a m (ScopedFunction c)
csGetTypeFunction [c]
c (GeneralInstance -> Maybe GeneralInstance
forall a. a -> Maybe a
Just GeneralInstance
t) FunctionName
n
  Bool -> StateT a m () -> StateT a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope ScopedFunction c
f' SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
/= SymbolScope
ValueScope) (StateT a m () -> StateT a m ()) -> StateT a m () -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ String -> StateT a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> StateT a m ()) -> String -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ String
"Function " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                     String
" cannot be used as a value function" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                     [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  ScopedFunction c -> CompilerState a m (ScopedFunction c)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ScopedFunction c
f'

compileExpressionStart :: (Ord c, Show c, CollectErrorsM m,
                           CompilerContext c m [String] a) =>
  ExpressionStart c -> CompilerState a m (ExpressionType,ExpressionValue)
compileExpressionStart :: forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
ExpressionStart c
-> CompilerState a m (ExpressionType, ExpressionValue)
compileExpressionStart (NamedVariable (OutputValue [c]
c VariableName
n)) = do
  let var :: UsedVariable c
var = [c] -> VariableName -> UsedVariable c
forall c. [c] -> VariableName -> UsedVariable c
UsedVariable [c]
c VariableName
n
  (VariableValue [c]
_ SymbolScope
s ValueType
t VariableRule c
_) <- UsedVariable c -> CompilerState a m (VariableValue c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
UsedVariable c -> CompilerState a m (VariableValue c)
csGetVariable UsedVariable c
var
  [UsedVariable c] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[UsedVariable c] -> CompilerState a m ()
csCheckVariableInit [UsedVariable c
var]
  UsedVariable c -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
UsedVariable c -> CompilerState a m ()
csAddUsed UsedVariable c
var
  String
scoped <- SymbolScope -> CompilerState a m String
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
SymbolScope -> CompilerState a m String
autoScope SymbolScope
s
  let lazy :: Bool
lazy = SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope
  (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
t],Bool -> ValueType -> String -> ExpressionValue
readStoredVariable Bool
lazy ValueType
t (String
scoped String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
variableName VariableName
n))
compileExpressionStart (NamedMacro [c]
c MacroName
n) = do
  Expression c
e <- [c] -> MacroName -> CompilerState a m (Expression c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c] -> MacroName -> CompilerState a m (Expression c)
csExprLookup [c]
c MacroName
n
  [c] -> MacroName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c] -> MacroName -> CompilerState a m ()
csReserveExprMacro [c]
c MacroName
n
  (ExpressionType, ExpressionValue)
e' <- Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression Expression c
e CompilerState a m (ExpressionType, ExpressionValue)
-> String -> CompilerState a m (ExpressionType, ExpressionValue)
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<?? String
"In expansion of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ MacroName -> String
forall a. Show a => a -> String
show MacroName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
  -- NOTE: This will be skipped if expression compilation fails.
  [c] -> MacroName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c] -> MacroName -> CompilerState a m ()
csReleaseExprMacro [c]
c MacroName
n
  (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExpressionType, ExpressionValue)
e'
compileExpressionStart (ExpressionMacro [c]
c MacroExpression
MacroCallTrace) = do
  Bool
to <- CompilerState a m Bool
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m Bool
csGetTestsOnly
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
to) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"$CallTrace$ is a $TestsOnly$ macro" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired (Set CategoryName -> CompilerState a m ())
-> Set CategoryName -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ [CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName
BuiltinOrder,CategoryName
BuiltinFormatted]
  let formatted :: GeneralInstance
formatted = TypeInstanceOrParam -> GeneralInstance
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType (TypeInstanceOrParam -> GeneralInstance)
-> TypeInstanceOrParam -> GeneralInstance
forall a b. (a -> b) -> a -> b
$ TypeInstance -> TypeInstanceOrParam
JustTypeInstance (CategoryName -> Positional GeneralInstance -> TypeInstance
TypeInstance CategoryName
BuiltinFormatted ([GeneralInstance] -> Positional GeneralInstance
forall a. [a] -> Positional a
Positional []))
  let order :: GeneralInstance
order = TypeInstanceOrParam -> GeneralInstance
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType (TypeInstanceOrParam -> GeneralInstance)
-> TypeInstanceOrParam -> GeneralInstance
forall a b. (a -> b) -> a -> b
$ TypeInstance -> TypeInstanceOrParam
JustTypeInstance (CategoryName -> Positional GeneralInstance -> TypeInstance
TypeInstance CategoryName
BuiltinOrder ([GeneralInstance] -> Positional GeneralInstance
forall a. [a] -> Positional a
Positional [GeneralInstance
formatted]))
  ScopedFunction c
nextFunc <- [c]
-> Maybe GeneralInstance
-> FunctionName
-> CompilerState a m (ScopedFunction c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c]
-> Maybe GeneralInstance
-> FunctionName
-> CompilerState a m (ScopedFunction c)
csGetTypeFunction [c]
c (GeneralInstance -> Maybe GeneralInstance
forall a. a -> Maybe a
Just GeneralInstance
order) (String -> FunctionName
FunctionName String
"next")
  ScopedFunction c
getFunc <- [c]
-> Maybe GeneralInstance
-> FunctionName
-> CompilerState a m (ScopedFunction c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c]
-> Maybe GeneralInstance
-> FunctionName
-> CompilerState a m (ScopedFunction c)
csGetTypeFunction [c]
c (GeneralInstance -> Maybe GeneralInstance
forall a. a -> Maybe a
Just GeneralInstance
order) (String -> FunctionName
FunctionName String
"get")
  let getTrace :: String
getTrace = String
"GetCallTrace(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ScopedFunction c -> String
forall c. ScopedFunction c -> String
functionName ScopedFunction c
getFunc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ScopedFunction c -> String
forall c. ScopedFunction c -> String
functionName ScopedFunction c
nextFunc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
  (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [GeneralInstance -> ValueType
orderOptionalValue GeneralInstance
formatted],String -> ExpressionValue
UnwrappedSingle String
getTrace)
compileExpressionStart (CategoryCall [c]
c CategoryName
t f :: FunctionCall c
f@(FunctionCall [c]
_ FunctionName
n Positional (InstanceOrInferred c)
_ Positional (Maybe (CallArgLabel c), Expression c)
_)) = do
  ScopedFunction c
f' <- [c]
-> Maybe CategoryName
-> FunctionName
-> CompilerState a m (ScopedFunction c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c]
-> Maybe CategoryName
-> FunctionName
-> CompilerState a m (ScopedFunction c)
csGetCategoryFunction [c]
c (CategoryName -> Maybe CategoryName
forall a. a -> Maybe a
Just CategoryName
t) FunctionName
n
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired (Set CategoryName -> CompilerState a m ())
-> Set CategoryName -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ [CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName
t,ScopedFunction c -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
f']
  String
t' <- CategoryName -> CompilerState a m String
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CategoryName -> CompilerState a m String
expandCategory CategoryName
t
  Bool
-> Maybe String
-> ScopedFunction c
-> FunctionCall c
-> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Bool
-> Maybe String
-> ScopedFunction c
-> FunctionCall c
-> CompilerState a m (ExpressionType, ExpressionValue)
compileFunctionCall Bool
False (String -> Maybe String
forall a. a -> Maybe a
Just String
t') ScopedFunction c
f' FunctionCall c
f
compileExpressionStart (TypeCall [c]
c TypeInstanceOrParam
t f :: FunctionCall c
f@(FunctionCall [c]
_ FunctionName
n Positional (InstanceOrInferred c)
_ Positional (Maybe (CallArgLabel c), Expression c)
_)) = do
  GeneralInstance
self <- CompilerState a m GeneralInstance
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m GeneralInstance
autoSelfType
  GeneralInstance
t' <- m GeneralInstance -> CompilerState a m GeneralInstance
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m GeneralInstance -> CompilerState a m GeneralInstance)
-> m GeneralInstance -> CompilerState a m GeneralInstance
forall a b. (a -> b) -> a -> b
$ GeneralInstance -> GeneralInstance -> m GeneralInstance
forall (m :: * -> *).
CollectErrorsM m =>
GeneralInstance -> GeneralInstance -> m GeneralInstance
replaceSelfInstance GeneralInstance
self (TypeInstanceOrParam -> GeneralInstance
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType TypeInstanceOrParam
t)
  AnyTypeResolver
r <- CompilerState a m AnyTypeResolver
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m AnyTypeResolver
csResolver
  ParamFilters
fa <- CompilerState a m ParamFilters
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m ParamFilters
csAllFilters
  m () -> CompilerState a m ()
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> CompilerState a m ()) -> m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ AnyTypeResolver -> ParamFilters -> GeneralInstance -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> GeneralInstance -> m ()
validateGeneralInstanceForCall AnyTypeResolver
r ParamFilters
fa GeneralInstance
t' m () -> String -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<?? String
"In function call at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
  ScopedFunction c
f' <- [c]
-> Maybe GeneralInstance
-> FunctionName
-> CompilerState a m (ScopedFunction c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c]
-> Maybe GeneralInstance
-> FunctionName
-> CompilerState a m (ScopedFunction c)
csGetTypeFunction [c]
c (GeneralInstance -> Maybe GeneralInstance
forall a. a -> Maybe a
Just GeneralInstance
t') FunctionName
n
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope ScopedFunction c
f' SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
/= SymbolScope
TypeScope) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Function " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                    String
" cannot be used as a type function" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                    [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired (Set CategoryName -> CompilerState a m ())
-> Set CategoryName -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ [Set CategoryName] -> Set CategoryName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set CategoryName] -> Set CategoryName)
-> [Set CategoryName] -> Set CategoryName
forall a b. (a -> b) -> a -> b
$ (GeneralInstance -> Set CategoryName)
-> [GeneralInstance] -> [Set CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map GeneralInstance -> Set CategoryName
categoriesFromTypes [GeneralInstance
t']
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired (Set CategoryName -> CompilerState a m ())
-> Set CategoryName -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ [CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [ScopedFunction c -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
f']
  Bool
same <- GeneralInstance -> StateT a m (Maybe (T GeneralInstance))
maybeSingleType GeneralInstance
t' StateT a m (Maybe TypeInstanceOrParam)
-> (Maybe TypeInstanceOrParam -> CompilerState a m Bool)
-> CompilerState a m Bool
forall a b. StateT a m a -> (a -> StateT a m b) -> StateT a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe TypeInstanceOrParam -> CompilerState a m Bool
forall {c} {m :: * -> *} {s} {a}.
CompilerContext c m s a =>
Maybe TypeInstanceOrParam -> CompilerState a m Bool
checkSame
  Maybe String
t2 <- if Bool
same
           then Maybe String -> StateT a m (Maybe String)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
           else (String -> Maybe String)
-> CompilerState a m String -> StateT a m (Maybe String)
forall a b. (a -> b) -> StateT a m a -> StateT a m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Maybe String
forall a. a -> Maybe a
Just (CompilerState a m String -> StateT a m (Maybe String))
-> CompilerState a m String -> StateT a m (Maybe String)
forall a b. (a -> b) -> a -> b
$ GeneralInstance -> CompilerState a m String
forall (m :: * -> *) c s a.
(CollectErrorsM m, CompilerContext c m s a) =>
GeneralInstance -> CompilerState a m String
expandGeneralInstance GeneralInstance
t'
  Bool
-> Maybe String
-> ScopedFunction c
-> FunctionCall c
-> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Bool
-> Maybe String
-> ScopedFunction c
-> FunctionCall c
-> CompilerState a m (ExpressionType, ExpressionValue)
compileFunctionCall Bool
False Maybe String
t2 ScopedFunction c
f' FunctionCall c
f
  where
    maybeSingleType :: GeneralInstance -> StateT a m (Maybe (T GeneralInstance))
maybeSingleType = m (Maybe (T GeneralInstance))
-> StateT a m (Maybe (T GeneralInstance))
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (T GeneralInstance))
 -> StateT a m (Maybe (T GeneralInstance)))
-> (GeneralInstance -> m (Maybe (T GeneralInstance)))
-> GeneralInstance
-> StateT a m (Maybe (T GeneralInstance))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (T GeneralInstance) -> m (Maybe (T GeneralInstance))
forall (m :: * -> *) a. CollectErrorsM m => m a -> m (Maybe a)
tryCompilerM (m (T GeneralInstance) -> m (Maybe (T GeneralInstance)))
-> (GeneralInstance -> m (T GeneralInstance))
-> GeneralInstance
-> m (Maybe (T GeneralInstance))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeneralInstance -> m (T GeneralInstance)
forall a (m :: * -> *).
(PreserveMerge a, CollectErrorsM m) =>
a -> m (T a)
matchOnlyLeaf
    checkSame :: Maybe TypeInstanceOrParam -> CompilerState a m Bool
checkSame (Just (JustTypeInstance TypeInstance
t2)) = TypeInstance -> CompilerState a m Bool
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
TypeInstance -> CompilerState a m Bool
csSameType TypeInstance
t2
    checkSame Maybe TypeInstanceOrParam
_ = Bool -> CompilerState a m Bool
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
compileExpressionStart (UnqualifiedCall [c]
c f :: FunctionCall c
f@(FunctionCall [c]
_ FunctionName
n Positional (InstanceOrInferred c)
_ Positional (Maybe (CallArgLabel c), Expression c)
_)) = do
  a
ctx <- StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get
  ScopedFunction c
f' <- m (ScopedFunction c) -> CompilerState a m (ScopedFunction c)
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (ScopedFunction c) -> CompilerState a m (ScopedFunction c))
-> m (ScopedFunction c) -> CompilerState a m (ScopedFunction c)
forall a b. (a -> b) -> a -> b
$ [m (ScopedFunction c)] -> m (ScopedFunction c)
forall (m :: * -> *) (f :: * -> *) a.
(CollectErrorsM m, Foldable f) =>
f (m a) -> m a
forall (f :: * -> *) a. Foldable f => f (m a) -> m a
collectFirstM [a -> m (ScopedFunction c)
forall {m :: * -> *} {s} {a}.
CompilerContext c m s a =>
a -> m (ScopedFunction c)
tryCategory a
ctx,a -> m (ScopedFunction c)
forall {m :: * -> *} {s} {a}.
(CompilerContext c m s a, ErrorContextM m) =>
a -> m (ScopedFunction c)
tryNonCategory a
ctx] m (ScopedFunction c) -> String -> m (ScopedFunction c)
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<?? String
"In function call at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired (Set CategoryName -> CompilerState a m ())
-> Set CategoryName -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ [CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [ScopedFunction c -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
f']
  Bool
-> Maybe String
-> ScopedFunction c
-> FunctionCall c
-> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Bool
-> Maybe String
-> ScopedFunction c
-> FunctionCall c
-> CompilerState a m (ExpressionType, ExpressionValue)
compileFunctionCall Bool
False Maybe String
forall a. Maybe a
Nothing ScopedFunction c
f' FunctionCall c
f
  where
    tryCategory :: a -> m (ScopedFunction c)
tryCategory a
ctx = a
-> [c]
-> Maybe CategoryName
-> FunctionName
-> m (ScopedFunction c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a
-> [c]
-> Maybe CategoryName
-> FunctionName
-> m (ScopedFunction c)
ccGetCategoryFunction a
ctx [c]
c Maybe CategoryName
forall a. Maybe a
Nothing FunctionName
n
    tryNonCategory :: a -> m (ScopedFunction c)
tryNonCategory a
ctx = do
      ScopedFunction c
f' <- a
-> [c]
-> Maybe GeneralInstance
-> FunctionName
-> m (ScopedFunction c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a
-> [c]
-> Maybe GeneralInstance
-> FunctionName
-> m (ScopedFunction c)
ccGetTypeFunction a
ctx [c]
c Maybe GeneralInstance
forall a. Maybe a
Nothing FunctionName
n
      SymbolScope
s <- a -> m SymbolScope
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> m SymbolScope
ccCurrentScope a
ctx
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope ScopedFunction c
f' SymbolScope -> SymbolScope -> Bool
forall a. Ord a => a -> a -> Bool
> SymbolScope
s) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$
        String
"Function " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not in scope here" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
      ScopedFunction c -> m (ScopedFunction c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ScopedFunction c
f'
-- TODO: Compile BuiltinCall like regular functions, for consistent validation.
compileExpressionStart (BuiltinCall [c]
c (FunctionCall [c]
_ FunctionName
BuiltinPresent Positional (InstanceOrInferred c)
ps Positional (Maybe (CallArgLabel c), Expression c)
es)) = do
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName
BuiltinBool])
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([InstanceOrInferred c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Positional (InstanceOrInferred c) -> [InstanceOrInferred c]
forall a. Positional a -> [a]
pValues Positional (InstanceOrInferred c)
ps) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected 0 type parameters" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(Maybe (CallArgLabel c), Expression c)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Positional (Maybe (CallArgLabel c), Expression c)
-> [(Maybe (CallArgLabel c), Expression c)]
forall a. Positional a -> [a]
pValues Positional (Maybe (CallArgLabel c), Expression c)
es) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected 1 argument" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  [(ExpressionType, ExpressionValue)]
es' <- [CompilerState a m (ExpressionType, ExpressionValue)]
-> StateT a m [(ExpressionType, ExpressionValue)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([CompilerState a m (ExpressionType, ExpressionValue)]
 -> StateT a m [(ExpressionType, ExpressionValue)])
-> [CompilerState a m (ExpressionType, ExpressionValue)]
-> StateT a m [(ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> a -> b
$ ((Maybe (CallArgLabel c), Expression c)
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> [(Maybe (CallArgLabel c), Expression c)]
-> [CompilerState a m (ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> [a] -> [b]
map (Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression (Expression c
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> ((Maybe (CallArgLabel c), Expression c) -> Expression c)
-> (Maybe (CallArgLabel c), Expression c)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (CallArgLabel c), Expression c) -> Expression c
forall a b. (a, b) -> b
snd) ([(Maybe (CallArgLabel c), Expression c)]
 -> [CompilerState a m (ExpressionType, ExpressionValue)])
-> [(Maybe (CallArgLabel c), Expression c)]
-> [CompilerState a m (ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> a -> b
$ Positional (Maybe (CallArgLabel c), Expression c)
-> [(Maybe (CallArgLabel c), Expression c)]
forall a. Positional a -> [a]
pValues Positional (Maybe (CallArgLabel c), Expression c)
es
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ValueType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ExpressionType -> [ValueType]
forall a. Positional a -> [a]
pValues (ExpressionType -> [ValueType]) -> ExpressionType -> [ValueType]
forall a b. (a -> b) -> a -> b
$ (ExpressionType, ExpressionValue) -> ExpressionType
forall a b. (a, b) -> a
fst ((ExpressionType, ExpressionValue) -> ExpressionType)
-> (ExpressionType, ExpressionValue) -> ExpressionType
forall a b. (a -> b) -> a -> b
$ [(ExpressionType, ExpressionValue)]
-> (ExpressionType, ExpressionValue)
forall a. HasCallStack => [a] -> a
head [(ExpressionType, ExpressionValue)]
es') Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected single return in argument" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  let (Positional [ValueType
t0],ExpressionValue
e) = [(ExpressionType, ExpressionValue)]
-> (ExpressionType, ExpressionValue)
forall a. HasCallStack => [a] -> a
head [(ExpressionType, ExpressionValue)]
es'
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ValueType -> Bool
isWeakValue ValueType
t0) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Weak values not allowed here" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExpressionType, ExpressionValue)
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
boolRequiredValue],
            PrimitiveType -> String -> ExpressionValue
UnboxedPrimitive PrimitiveType
PrimBool (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
"BoxedValue::Present(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpressionValue -> String
useAsUnwrapped ExpressionValue
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
compileExpressionStart (BuiltinCall [c]
c (FunctionCall [c]
_ FunctionName
BuiltinIdentify Positional (InstanceOrInferred c)
ps Positional (Maybe (CallArgLabel c), Expression c)
es)) = do
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([InstanceOrInferred c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Positional (InstanceOrInferred c) -> [InstanceOrInferred c]
forall a. Positional a -> [a]
pValues Positional (InstanceOrInferred c)
ps) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected 0 type parameters" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(Maybe (CallArgLabel c), Expression c)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Positional (Maybe (CallArgLabel c), Expression c)
-> [(Maybe (CallArgLabel c), Expression c)]
forall a. Positional a -> [a]
pValues Positional (Maybe (CallArgLabel c), Expression c)
es) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected 1 argument" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  [(ExpressionType, ExpressionValue)]
es' <- [CompilerState a m (ExpressionType, ExpressionValue)]
-> StateT a m [(ExpressionType, ExpressionValue)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([CompilerState a m (ExpressionType, ExpressionValue)]
 -> StateT a m [(ExpressionType, ExpressionValue)])
-> [CompilerState a m (ExpressionType, ExpressionValue)]
-> StateT a m [(ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> a -> b
$ ((Maybe (CallArgLabel c), Expression c)
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> [(Maybe (CallArgLabel c), Expression c)]
-> [CompilerState a m (ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> [a] -> [b]
map (Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression (Expression c
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> ((Maybe (CallArgLabel c), Expression c) -> Expression c)
-> (Maybe (CallArgLabel c), Expression c)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (CallArgLabel c), Expression c) -> Expression c
forall a b. (a, b) -> b
snd) ([(Maybe (CallArgLabel c), Expression c)]
 -> [CompilerState a m (ExpressionType, ExpressionValue)])
-> [(Maybe (CallArgLabel c), Expression c)]
-> [CompilerState a m (ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> a -> b
$ Positional (Maybe (CallArgLabel c), Expression c)
-> [(Maybe (CallArgLabel c), Expression c)]
forall a. Positional a -> [a]
pValues Positional (Maybe (CallArgLabel c), Expression c)
es
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ValueType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ExpressionType -> [ValueType]
forall a. Positional a -> [a]
pValues (ExpressionType -> [ValueType]) -> ExpressionType -> [ValueType]
forall a b. (a -> b) -> a -> b
$ (ExpressionType, ExpressionValue) -> ExpressionType
forall a b. (a, b) -> a
fst ((ExpressionType, ExpressionValue) -> ExpressionType)
-> (ExpressionType, ExpressionValue) -> ExpressionType
forall a b. (a -> b) -> a -> b
$ [(ExpressionType, ExpressionValue)]
-> (ExpressionType, ExpressionValue)
forall a. HasCallStack => [a] -> a
head [(ExpressionType, ExpressionValue)]
es') Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected single return in argument" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  let (Positional [ValueType
t0],ExpressionValue
e) = [(ExpressionType, ExpressionValue)]
-> (ExpressionType, ExpressionValue)
forall a. HasCallStack => [a] -> a
head [(ExpressionType, ExpressionValue)]
es'
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ValueType -> Bool
isWeakValue ValueType
t0) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Weak values not allowed here" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired (Set CategoryName -> CompilerState a m ())
-> Set CategoryName -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ [CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName
BuiltinIdentifier]
  (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExpressionType, ExpressionValue)
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [StorageType -> GeneralInstance -> ValueType
ValueType StorageType
RequiredValue (TypeInstanceOrParam -> GeneralInstance
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType (TypeInstanceOrParam -> GeneralInstance)
-> TypeInstanceOrParam -> GeneralInstance
forall a b. (a -> b) -> a -> b
$ TypeInstance -> TypeInstanceOrParam
JustTypeInstance (CategoryName -> Positional GeneralInstance -> TypeInstance
TypeInstance CategoryName
BuiltinIdentifier ([GeneralInstance] -> Positional GeneralInstance
forall a. [a] -> Positional a
Positional [(ValueType -> GeneralInstance
vtType ValueType
t0)])))],
            PrimitiveType -> String -> ExpressionValue
UnboxedPrimitive PrimitiveType
PrimIdentifier (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
"BoxedValue::Identify(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpressionValue -> String
useAsUnwrapped ExpressionValue
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
compileExpressionStart (BuiltinCall [c]
c (FunctionCall [c]
_ FunctionName
BuiltinReduce Positional (InstanceOrInferred c)
ps Positional (Maybe (CallArgLabel c), Expression c)
es)) = do
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([InstanceOrInferred c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Positional (InstanceOrInferred c) -> [InstanceOrInferred c]
forall a. Positional a -> [a]
pValues Positional (InstanceOrInferred c)
ps) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
2) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected 2 type parameters" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(Maybe (CallArgLabel c), Expression c)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Positional (Maybe (CallArgLabel c), Expression c)
-> [(Maybe (CallArgLabel c), Expression c)]
forall a. Positional a -> [a]
pValues Positional (Maybe (CallArgLabel c), Expression c)
es) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected 1 argument" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  [(ExpressionType, ExpressionValue)]
es' <- [CompilerState a m (ExpressionType, ExpressionValue)]
-> StateT a m [(ExpressionType, ExpressionValue)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([CompilerState a m (ExpressionType, ExpressionValue)]
 -> StateT a m [(ExpressionType, ExpressionValue)])
-> [CompilerState a m (ExpressionType, ExpressionValue)]
-> StateT a m [(ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> a -> b
$ ((Maybe (CallArgLabel c), Expression c)
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> [(Maybe (CallArgLabel c), Expression c)]
-> [CompilerState a m (ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> [a] -> [b]
map (Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression (Expression c
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> ((Maybe (CallArgLabel c), Expression c) -> Expression c)
-> (Maybe (CallArgLabel c), Expression c)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (CallArgLabel c), Expression c) -> Expression c
forall a b. (a, b) -> b
snd) ([(Maybe (CallArgLabel c), Expression c)]
 -> [CompilerState a m (ExpressionType, ExpressionValue)])
-> [(Maybe (CallArgLabel c), Expression c)]
-> [CompilerState a m (ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> a -> b
$ Positional (Maybe (CallArgLabel c), Expression c)
-> [(Maybe (CallArgLabel c), Expression c)]
forall a. Positional a -> [a]
pValues Positional (Maybe (CallArgLabel c), Expression c)
es
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ValueType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ExpressionType -> [ValueType]
forall a. Positional a -> [a]
pValues (ExpressionType -> [ValueType]) -> ExpressionType -> [ValueType]
forall a b. (a -> b) -> a -> b
$ (ExpressionType, ExpressionValue) -> ExpressionType
forall a b. (a, b) -> a
fst ((ExpressionType, ExpressionValue) -> ExpressionType)
-> (ExpressionType, ExpressionValue) -> ExpressionType
forall a b. (a -> b) -> a -> b
$ [(ExpressionType, ExpressionValue)]
-> (ExpressionType, ExpressionValue)
forall a. HasCallStack => [a] -> a
head [(ExpressionType, ExpressionValue)]
es') Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected single return in argument" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  let (Positional [ValueType
t0],ExpressionValue
e) = [(ExpressionType, ExpressionValue)]
-> (ExpressionType, ExpressionValue)
forall a. HasCallStack => [a] -> a
head [(ExpressionType, ExpressionValue)]
es'
  GeneralInstance
self <- CompilerState a m GeneralInstance
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m GeneralInstance
autoSelfType
  [GeneralInstance]
ps' <- m [GeneralInstance] -> StateT a m [GeneralInstance]
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [GeneralInstance] -> StateT a m [GeneralInstance])
-> m [GeneralInstance] -> StateT a m [GeneralInstance]
forall a b. (a -> b) -> a -> b
$ Positional (InstanceOrInferred c) -> m [GeneralInstance]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Positional (InstanceOrInferred c) -> m [GeneralInstance]
disallowInferred Positional (InstanceOrInferred c)
ps
  [GeneralInstance
t1,GeneralInstance
t2] <- m [GeneralInstance] -> StateT a m [GeneralInstance]
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [GeneralInstance] -> StateT a m [GeneralInstance])
-> m [GeneralInstance] -> StateT a m [GeneralInstance]
forall a b. (a -> b) -> a -> b
$ (GeneralInstance -> m GeneralInstance)
-> [GeneralInstance] -> m [GeneralInstance]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (GeneralInstance -> GeneralInstance -> m GeneralInstance
forall (m :: * -> *).
CollectErrorsM m =>
GeneralInstance -> GeneralInstance -> m GeneralInstance
replaceSelfInstance GeneralInstance
self) [GeneralInstance]
ps'
  AnyTypeResolver
r <- CompilerState a m AnyTypeResolver
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m AnyTypeResolver
csResolver
  ParamFilters
fa <- CompilerState a m ParamFilters
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m ParamFilters
csAllFilters
  m () -> CompilerState a m ()
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> CompilerState a m ()) -> m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ AnyTypeResolver -> Set ParamName -> GeneralInstance -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> Set ParamName -> GeneralInstance -> m ()
validateGeneralInstance AnyTypeResolver
r (ParamFilters -> Set ParamName
forall k a. Map k a -> Set k
Map.keysSet ParamFilters
fa) GeneralInstance
t1
  m () -> CompilerState a m ()
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> CompilerState a m ()) -> m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ AnyTypeResolver -> Set ParamName -> GeneralInstance -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> Set ParamName -> GeneralInstance -> m ()
validateGeneralInstance AnyTypeResolver
r (ParamFilters -> Set ParamName
forall k a. Map k a -> Set k
Map.keysSet ParamFilters
fa) GeneralInstance
t2
  m () -> CompilerState a m ()
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> CompilerState a m ()) -> m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ (AnyTypeResolver -> ParamFilters -> ValueType -> ValueType -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> ValueType -> ValueType -> m ()
checkValueAssignment AnyTypeResolver
r ParamFilters
fa ValueType
t0 (StorageType -> GeneralInstance -> ValueType
ValueType StorageType
OptionalValue GeneralInstance
t1)) m () -> String -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<??
    String
"In argument to reduce call at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
  -- TODO: If t1 -> t2 then just return e without a Reduce call.
  String
t1' <- GeneralInstance -> CompilerState a m String
forall (m :: * -> *) c s a.
(CollectErrorsM m, CompilerContext c m s a) =>
GeneralInstance -> CompilerState a m String
expandGeneralInstance GeneralInstance
t1
  String
t2' <- GeneralInstance -> CompilerState a m String
forall (m :: * -> *) c s a.
(CollectErrorsM m, CompilerContext c m s a) =>
GeneralInstance -> CompilerState a m String
expandGeneralInstance GeneralInstance
t2
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired (Set CategoryName -> CompilerState a m ())
-> Set CategoryName -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ GeneralInstance -> Set CategoryName
categoriesFromTypes GeneralInstance
t1
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired (Set CategoryName -> CompilerState a m ())
-> Set CategoryName -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ GeneralInstance -> Set CategoryName
categoriesFromTypes GeneralInstance
t2
  (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExpressionType, ExpressionValue)
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [StorageType -> GeneralInstance -> ValueType
ValueType StorageType
OptionalValue GeneralInstance
t2],
            String -> ExpressionValue
UnwrappedSingle (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
typeBase String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::Reduce(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t1' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t2' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpressionValue -> String
useAsUnwrapped ExpressionValue
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
compileExpressionStart (BuiltinCall [c]
c (FunctionCall [c]
_ FunctionName
BuiltinRequire Positional (InstanceOrInferred c)
ps Positional (Maybe (CallArgLabel c), Expression c)
es)) = do
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([InstanceOrInferred c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Positional (InstanceOrInferred c) -> [InstanceOrInferred c]
forall a. Positional a -> [a]
pValues Positional (InstanceOrInferred c)
ps) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected 0 type parameters" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(Maybe (CallArgLabel c), Expression c)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Positional (Maybe (CallArgLabel c), Expression c)
-> [(Maybe (CallArgLabel c), Expression c)]
forall a. Positional a -> [a]
pValues Positional (Maybe (CallArgLabel c), Expression c)
es) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected 1 argument" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  [(ExpressionType, ExpressionValue)]
es' <- [CompilerState a m (ExpressionType, ExpressionValue)]
-> StateT a m [(ExpressionType, ExpressionValue)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([CompilerState a m (ExpressionType, ExpressionValue)]
 -> StateT a m [(ExpressionType, ExpressionValue)])
-> [CompilerState a m (ExpressionType, ExpressionValue)]
-> StateT a m [(ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> a -> b
$ ((Maybe (CallArgLabel c), Expression c)
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> [(Maybe (CallArgLabel c), Expression c)]
-> [CompilerState a m (ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> [a] -> [b]
map (Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression (Expression c
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> ((Maybe (CallArgLabel c), Expression c) -> Expression c)
-> (Maybe (CallArgLabel c), Expression c)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (CallArgLabel c), Expression c) -> Expression c
forall a b. (a, b) -> b
snd) ([(Maybe (CallArgLabel c), Expression c)]
 -> [CompilerState a m (ExpressionType, ExpressionValue)])
-> [(Maybe (CallArgLabel c), Expression c)]
-> [CompilerState a m (ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> a -> b
$ Positional (Maybe (CallArgLabel c), Expression c)
-> [(Maybe (CallArgLabel c), Expression c)]
forall a. Positional a -> [a]
pValues Positional (Maybe (CallArgLabel c), Expression c)
es
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ValueType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ExpressionType -> [ValueType]
forall a. Positional a -> [a]
pValues (ExpressionType -> [ValueType]) -> ExpressionType -> [ValueType]
forall a b. (a -> b) -> a -> b
$ (ExpressionType, ExpressionValue) -> ExpressionType
forall a b. (a, b) -> a
fst ((ExpressionType, ExpressionValue) -> ExpressionType)
-> (ExpressionType, ExpressionValue) -> ExpressionType
forall a b. (a -> b) -> a -> b
$ [(ExpressionType, ExpressionValue)]
-> (ExpressionType, ExpressionValue)
forall a. HasCallStack => [a] -> a
head [(ExpressionType, ExpressionValue)]
es') Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected single return in argument" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  let (Positional [ValueType
t0],ExpressionValue
e) = [(ExpressionType, ExpressionValue)]
-> (ExpressionType, ExpressionValue)
forall a. HasCallStack => [a] -> a
head [(ExpressionType, ExpressionValue)]
es'
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ValueType -> Bool
isWeakValue ValueType
t0) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Weak values not allowed here" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExpressionType, ExpressionValue)
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [StorageType -> GeneralInstance -> ValueType
ValueType StorageType
RequiredValue (ValueType -> GeneralInstance
vtType ValueType
t0)],
            String -> ExpressionValue
UnwrappedSingle (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
"BoxedValue::Require(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpressionValue -> String
useAsUnwrapped ExpressionValue
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
compileExpressionStart (BuiltinCall [c]
c (FunctionCall [c]
_ FunctionName
BuiltinStrong Positional (InstanceOrInferred c)
ps Positional (Maybe (CallArgLabel c), Expression c)
es)) = do
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([InstanceOrInferred c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Positional (InstanceOrInferred c) -> [InstanceOrInferred c]
forall a. Positional a -> [a]
pValues Positional (InstanceOrInferred c)
ps) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected 0 type parameters" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(Maybe (CallArgLabel c), Expression c)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Positional (Maybe (CallArgLabel c), Expression c)
-> [(Maybe (CallArgLabel c), Expression c)]
forall a. Positional a -> [a]
pValues Positional (Maybe (CallArgLabel c), Expression c)
es) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected 1 argument" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  [(ExpressionType, ExpressionValue)]
es' <- [CompilerState a m (ExpressionType, ExpressionValue)]
-> StateT a m [(ExpressionType, ExpressionValue)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([CompilerState a m (ExpressionType, ExpressionValue)]
 -> StateT a m [(ExpressionType, ExpressionValue)])
-> [CompilerState a m (ExpressionType, ExpressionValue)]
-> StateT a m [(ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> a -> b
$ ((Maybe (CallArgLabel c), Expression c)
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> [(Maybe (CallArgLabel c), Expression c)]
-> [CompilerState a m (ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> [a] -> [b]
map (Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression (Expression c
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> ((Maybe (CallArgLabel c), Expression c) -> Expression c)
-> (Maybe (CallArgLabel c), Expression c)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (CallArgLabel c), Expression c) -> Expression c
forall a b. (a, b) -> b
snd) ([(Maybe (CallArgLabel c), Expression c)]
 -> [CompilerState a m (ExpressionType, ExpressionValue)])
-> [(Maybe (CallArgLabel c), Expression c)]
-> [CompilerState a m (ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> a -> b
$ Positional (Maybe (CallArgLabel c), Expression c)
-> [(Maybe (CallArgLabel c), Expression c)]
forall a. Positional a -> [a]
pValues Positional (Maybe (CallArgLabel c), Expression c)
es
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ValueType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ExpressionType -> [ValueType]
forall a. Positional a -> [a]
pValues (ExpressionType -> [ValueType]) -> ExpressionType -> [ValueType]
forall a b. (a -> b) -> a -> b
$ (ExpressionType, ExpressionValue) -> ExpressionType
forall a b. (a, b) -> a
fst ((ExpressionType, ExpressionValue) -> ExpressionType)
-> (ExpressionType, ExpressionValue) -> ExpressionType
forall a b. (a -> b) -> a -> b
$ [(ExpressionType, ExpressionValue)]
-> (ExpressionType, ExpressionValue)
forall a. HasCallStack => [a] -> a
head [(ExpressionType, ExpressionValue)]
es') Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected single return in argument" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  let (Positional [ValueType
t0],ExpressionValue
e) = [(ExpressionType, ExpressionValue)]
-> (ExpressionType, ExpressionValue)
forall a. HasCallStack => [a] -> a
head [(ExpressionType, ExpressionValue)]
es'
  let t1 :: ExpressionType
t1 = [ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [StorageType -> GeneralInstance -> ValueType
ValueType StorageType
OptionalValue (ValueType -> GeneralInstance
vtType ValueType
t0)]
  if ValueType -> Bool
isWeakValue ValueType
t0
     -- Weak values are already unboxed.
     then (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExpressionType
t1,String -> ExpressionValue
UnwrappedSingle (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
"BoxedValue::Strong(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpressionValue -> String
useAsUnwrapped ExpressionValue
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
     else (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExpressionType
t1,ExpressionValue
e)
compileExpressionStart (BuiltinCall [c]
c (FunctionCall [c]
_ FunctionName
BuiltinTypename Positional (InstanceOrInferred c)
ps Positional (Maybe (CallArgLabel c), Expression c)
es)) = do
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([InstanceOrInferred c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Positional (InstanceOrInferred c) -> [InstanceOrInferred c]
forall a. Positional a -> [a]
pValues Positional (InstanceOrInferred c)
ps) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected 1 type parameter" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(Maybe (CallArgLabel c), Expression c)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Positional (Maybe (CallArgLabel c), Expression c)
-> [(Maybe (CallArgLabel c), Expression c)]
forall a. Positional a -> [a]
pValues Positional (Maybe (CallArgLabel c), Expression c)
es) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected 0 arguments" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  GeneralInstance
self <- CompilerState a m GeneralInstance
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m GeneralInstance
autoSelfType
  [GeneralInstance]
ps' <- m [GeneralInstance] -> StateT a m [GeneralInstance]
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [GeneralInstance] -> StateT a m [GeneralInstance])
-> m [GeneralInstance] -> StateT a m [GeneralInstance]
forall a b. (a -> b) -> a -> b
$ Positional (InstanceOrInferred c) -> m [GeneralInstance]
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Positional (InstanceOrInferred c) -> m [GeneralInstance]
disallowInferred Positional (InstanceOrInferred c)
ps
  [GeneralInstance
t] <- m [GeneralInstance] -> StateT a m [GeneralInstance]
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [GeneralInstance] -> StateT a m [GeneralInstance])
-> m [GeneralInstance] -> StateT a m [GeneralInstance]
forall a b. (a -> b) -> a -> b
$ (GeneralInstance -> m GeneralInstance)
-> [GeneralInstance] -> m [GeneralInstance]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (GeneralInstance -> GeneralInstance -> m GeneralInstance
forall (m :: * -> *).
CollectErrorsM m =>
GeneralInstance -> GeneralInstance -> m GeneralInstance
replaceSelfInstance GeneralInstance
self) [GeneralInstance]
ps'
  AnyTypeResolver
r <- CompilerState a m AnyTypeResolver
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m AnyTypeResolver
csResolver
  ParamFilters
fa <- CompilerState a m ParamFilters
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m ParamFilters
csAllFilters
  m () -> CompilerState a m ()
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> CompilerState a m ()) -> m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ AnyTypeResolver -> Set ParamName -> GeneralInstance -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> Set ParamName -> GeneralInstance -> m ()
validateGeneralInstance AnyTypeResolver
r (ParamFilters -> Set ParamName
forall k a. Map k a -> Set k
Map.keysSet ParamFilters
fa) GeneralInstance
t
  String
t' <- GeneralInstance -> CompilerState a m String
forall (m :: * -> *) c s a.
(CollectErrorsM m, CompilerContext c m s a) =>
GeneralInstance -> CompilerState a m String
expandGeneralInstance GeneralInstance
t
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired (Set CategoryName -> CompilerState a m ())
-> Set CategoryName -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ [Set CategoryName] -> Set CategoryName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set CategoryName] -> Set CategoryName)
-> [Set CategoryName] -> Set CategoryName
forall a b. (a -> b) -> a -> b
$ (GeneralInstance -> Set CategoryName)
-> [GeneralInstance] -> [Set CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map GeneralInstance -> Set CategoryName
categoriesFromTypes [GeneralInstance
t]
  (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExpressionType, ExpressionValue)
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
formattedRequiredValue],
            ExpressionValue -> ExpressionValue
valueAsWrapped (ExpressionValue -> ExpressionValue)
-> ExpressionValue -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ PrimitiveType -> String -> ExpressionValue
UnboxedPrimitive PrimitiveType
PrimString (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
typeBase String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::TypeName(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
compileExpressionStart (BuiltinCall [c]
_ FunctionCall c
_) = CompilerState a m (ExpressionType, ExpressionValue)
forall a. HasCallStack => a
undefined
compileExpressionStart (ParensExpression [c]
_ Expression c
e) = Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression Expression c
e
compileExpressionStart (InlineAssignment [c]
c VariableName
n AssignmentType
o Expression c
e) = do
  (VariableValue [c]
_ SymbolScope
s ValueType
t0 VariableRule c
_) <- [c] -> VariableName -> CompilerState a m (VariableValue c)
forall c (m :: * -> *) a.
(Show c, CollectErrorsM m, CompilerContext c m [String] a) =>
[c] -> VariableName -> CompilerState a m (VariableValue c)
getWritableVariable [c]
c VariableName
n
  (ExpressionType, ExpressionValue)
e2 <- Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression Expression c
e
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ValueType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ExpressionType -> [ValueType]
forall a. Positional a -> [a]
pValues (ExpressionType -> [ValueType]) -> ExpressionType -> [ValueType]
forall a b. (a -> b) -> a -> b
$ (ExpressionType, ExpressionValue) -> ExpressionType
forall a b. (a, b) -> a
fst ((ExpressionType, ExpressionValue) -> ExpressionType)
-> (ExpressionType, ExpressionValue) -> ExpressionType
forall a b. (a -> b) -> a -> b
$ (ExpressionType, ExpressionValue)
e2) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected single return" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  let (Positional [ValueType
t],ExpressionValue
e') = (ExpressionType, ExpressionValue)
e2
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AssignmentType
o AssignmentType -> AssignmentType -> Bool
forall a. Eq a => a -> a -> Bool
== AssignmentType
AssignIfEmpty Bool -> Bool -> Bool
&& Bool -> Bool
not (ValueType -> Bool
isOptionalValue ValueType
t0)) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String
"Variable must have an optional type" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AssignmentType
o AssignmentType -> AssignmentType -> Bool
forall a. Eq a => a -> a -> Bool
== AssignmentType
AssignIfEmpty) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ [UsedVariable c] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[UsedVariable c] -> CompilerState a m ()
csCheckVariableInit [[c] -> VariableName -> UsedVariable c
forall c. [c] -> VariableName -> UsedVariable c
UsedVariable [c]
c VariableName
n]
  AnyTypeResolver
r <- CompilerState a m AnyTypeResolver
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m AnyTypeResolver
csResolver
  ParamFilters
fa <- CompilerState a m ParamFilters
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m ParamFilters
csAllFilters
  m () -> CompilerState a m ()
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> CompilerState a m ()) -> m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ (AnyTypeResolver -> ParamFilters -> ValueType -> ValueType -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> ValueType -> ValueType -> m ()
checkValueAssignment AnyTypeResolver
r ParamFilters
fa ValueType
t ValueType
t0) m () -> String -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<??
    String
"In assignment at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
  VariableName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
VariableName -> CompilerState a m ()
csUpdateAssigned VariableName
n
  String
scoped <- SymbolScope -> CompilerState a m String
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
SymbolScope -> CompilerState a m String
autoScope SymbolScope
s
  let lazy :: Bool
lazy = SymbolScope
s SymbolScope -> SymbolScope -> Bool
forall a. Eq a => a -> a -> Bool
== SymbolScope
CategoryScope
  let variable :: String
variable = String
scoped String -> String -> String
forall a. [a] -> [a] -> [a]
++ VariableName -> String
variableName VariableName
n
  let assign :: String
assign = String
variable String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> ExpressionValue -> String
writeStoredVariable ValueType
t0 ExpressionValue
e'
  let check :: String
check = String
"BoxedValue::Present(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpressionValue -> String
useAsUnwrapped (Bool -> ValueType -> String -> ExpressionValue
readStoredVariable Bool
lazy ValueType
t0 String
variable) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
  let assignAndGet :: ExpressionValue
assignAndGet = Bool -> ValueType -> String -> ExpressionValue
readStoredVariable Bool
lazy ValueType
t0 String
assign
  let alwaysAssign :: ExpressionValue
alwaysAssign = if ValueType -> Bool
isWeakValue ValueType
t0 Bool -> Bool -> Bool
&& Bool -> Bool
not (ValueType -> Bool
isWeakValue ValueType
t)
                        then String -> ExpressionValue
UnwrappedSingle (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
"BoxedValue::Strong(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpressionValue -> String
useAsUnwrapped ExpressionValue
assignAndGet String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
                        else ExpressionValue
assignAndGet
  let maybeAssign :: ExpressionValue
maybeAssign = Bool -> ValueType -> String -> ExpressionValue
readStoredVariable Bool
lazy ValueType
t0 (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
check String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ? " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
variable String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" : (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
assign String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
  case AssignmentType
o of
       AssignmentType
AlwaysAssign -> (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
t],ExpressionValue
alwaysAssign)
       AssignmentType
AssignIfEmpty -> (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType -> ValueType -> ValueType
combineTypes ValueType
t0 ValueType
t],ExpressionValue
maybeAssign)
  where
    combineTypes :: ValueType -> ValueType -> ValueType
combineTypes (ValueType StorageType
_ GeneralInstance
t1) (ValueType StorageType
s GeneralInstance
_) = StorageType -> GeneralInstance -> ValueType
ValueType StorageType
s GeneralInstance
t1
compileExpressionStart (InitializeValue [c]
c Maybe TypeInstance
t Positional (Expression c)
es) = do
  SymbolScope
scope <- CompilerState a m SymbolScope
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m SymbolScope
csCurrentScope
  TypeInstance
t' <- case SymbolScope
scope of
              SymbolScope
CategoryScope -> case Maybe TypeInstance
t of
                                    Maybe TypeInstance
Nothing -> String -> StateT a m TypeInstance
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> StateT a m TypeInstance)
-> String -> StateT a m TypeInstance
forall a b. (a -> b) -> a -> b
$ String
"Param " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParamName -> String
forall a. Show a => a -> String
show ParamName
ParamSelf String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not found"
                                    Just TypeInstance
t0 -> TypeInstance -> StateT a m TypeInstance
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInstance
t0
              SymbolScope
_ -> do
                TypeInstance
self <- StateT a m TypeInstance
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m TypeInstance
csSelfType
                case Maybe TypeInstance
t of
                    Just TypeInstance
t0 -> m TypeInstance -> StateT a m TypeInstance
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m TypeInstance -> StateT a m TypeInstance)
-> m TypeInstance -> StateT a m TypeInstance
forall a b. (a -> b) -> a -> b
$ GeneralInstance -> TypeInstance -> m TypeInstance
forall (m :: * -> *).
CollectErrorsM m =>
GeneralInstance -> TypeInstance -> m TypeInstance
replaceSelfSingle (TypeInstanceOrParam -> GeneralInstance
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType (TypeInstanceOrParam -> GeneralInstance)
-> TypeInstanceOrParam -> GeneralInstance
forall a b. (a -> b) -> a -> b
$ TypeInstance -> TypeInstanceOrParam
JustTypeInstance TypeInstance
self) TypeInstance
t0
                    Maybe TypeInstance
Nothing -> TypeInstance -> StateT a m TypeInstance
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInstance
self
  [(ExpressionType, ExpressionValue)]
es' <- [CompilerState a m (ExpressionType, ExpressionValue)]
-> StateT a m [(ExpressionType, ExpressionValue)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([CompilerState a m (ExpressionType, ExpressionValue)]
 -> StateT a m [(ExpressionType, ExpressionValue)])
-> [CompilerState a m (ExpressionType, ExpressionValue)]
-> StateT a m [(ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> a -> b
$ (Expression c
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> [Expression c]
-> [CompilerState a m (ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> [a] -> [b]
map Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression ([Expression c]
 -> [CompilerState a m (ExpressionType, ExpressionValue)])
-> [Expression c]
-> [CompilerState a m (ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> a -> b
$ Positional (Expression c) -> [Expression c]
forall a. Positional a -> [a]
pValues Positional (Expression c)
es
  ([ValueType]
ts,String
es'') <- m ([ValueType], String) -> StateT a m ([ValueType], String)
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ([ValueType], String) -> StateT a m ([ValueType], String))
-> m ([ValueType], String) -> StateT a m ([ValueType], String)
forall a b. (a -> b) -> a -> b
$ [(ExpressionType, ExpressionValue)] -> m ([ValueType], String)
forall {m :: * -> *} {a}.
CollectErrorsM m =>
[(Positional a, ExpressionValue)] -> m ([a], String)
getValues [(ExpressionType, ExpressionValue)]
es'
  [c] -> TypeInstance -> ExpressionType -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c] -> TypeInstance -> ExpressionType -> CompilerState a m ()
csCheckValueInit [c]
c TypeInstance
t' ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType]
ts)
  String
params <- Positional GeneralInstance -> CompilerState a m String
forall (m :: * -> *) c s a.
(CollectErrorsM m, CompilerContext c m s a) =>
Positional GeneralInstance -> CompilerState a m String
expandParams (Positional GeneralInstance -> CompilerState a m String)
-> Positional GeneralInstance -> CompilerState a m String
forall a b. (a -> b) -> a -> b
$ TypeInstance -> Positional GeneralInstance
tiParams TypeInstance
t'
  Bool
sameType <- TypeInstance -> CompilerState a m Bool
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
TypeInstance -> CompilerState a m Bool
csSameType TypeInstance
t'
  SymbolScope
s <- CompilerState a m SymbolScope
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m SymbolScope
csCurrentScope
  let typeInstance :: String
typeInstance = TypeInstance -> Bool -> SymbolScope -> String -> String
getType TypeInstance
t' Bool
sameType SymbolScope
s String
params
  String
args <- String -> CompilerState a m String
forall {m :: * -> *} {c} {s} {a}.
(CollectErrorsM m, CompilerContext c m s a) =>
String -> StateT a m String
getArgs String
es''
  -- TODO: This is unsafe if used in a type or category constructor.
  (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [StorageType -> GeneralInstance -> ValueType
ValueType StorageType
RequiredValue (GeneralInstance -> ValueType) -> GeneralInstance -> ValueType
forall a b. (a -> b) -> a -> b
$ TypeInstanceOrParam -> GeneralInstance
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType (TypeInstanceOrParam -> GeneralInstance)
-> TypeInstanceOrParam -> GeneralInstance
forall a b. (a -> b) -> a -> b
$ TypeInstance -> TypeInstanceOrParam
JustTypeInstance TypeInstance
t'],
          String -> ExpressionValue
UnwrappedSingle (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ CategoryName -> String
valueCreator (TypeInstance -> CategoryName
tiName TypeInstance
t') String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typeInstance String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
args String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
  where
    getType :: TypeInstance -> Bool -> SymbolScope -> String -> String
getType TypeInstance
_  Bool
True SymbolScope
ValueScope String
_      = String
"PARAM_SELF"
    getType TypeInstance
_  Bool
True SymbolScope
TypeScope  String
_      = String
"PARAM_SELF"
    getType TypeInstance
t2 Bool
_    SymbolScope
_          String
params = CategoryName -> String
typeCreator (TypeInstance -> CategoryName
tiName TypeInstance
t2) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
params String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    -- Single expression, but possibly multi-return.
    getValues :: [(Positional a, ExpressionValue)] -> m ([a], String)
getValues [(Positional [a]
ts,ExpressionValue
e)] = ([a], String) -> m ([a], String)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
ts,ExpressionValue -> String
useAsArgs ExpressionValue
e)
    -- Multi-expression => must all be singles.
    getValues [(Positional a, ExpressionValue)]
rs = do
      (((Int, Positional a) -> m ()) -> [(Int, Positional a)] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (Int, Positional a) -> m ()
forall {m :: * -> *} {a} {a}.
(ErrorContextM m, Show a) =>
(a, Positional a) -> m ()
checkArity ([(Int, Positional a)] -> m ()) -> [(Int, Positional a)] -> m ()
forall a b. (a -> b) -> a -> b
$ [Int] -> [Positional a] -> [(Int, Positional a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..] :: [Int]) ([Positional a] -> [(Int, Positional a)])
-> [Positional a] -> [(Int, Positional a)]
forall a b. (a -> b) -> a -> b
$ ((Positional a, ExpressionValue) -> Positional a)
-> [(Positional a, ExpressionValue)] -> [Positional a]
forall a b. (a -> b) -> [a] -> [b]
map (Positional a, ExpressionValue) -> Positional a
forall a b. (a, b) -> a
fst [(Positional a, ExpressionValue)]
rs) m () -> String -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<??
        String
"In return at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
      ([a], String) -> m ([a], String)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (((Positional a, ExpressionValue) -> a)
-> [(Positional a, ExpressionValue)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ([a] -> a
forall a. HasCallStack => [a] -> a
head ([a] -> a)
-> ((Positional a, ExpressionValue) -> [a])
-> (Positional a, ExpressionValue)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positional a -> [a]
forall a. Positional a -> [a]
pValues (Positional a -> [a])
-> ((Positional a, ExpressionValue) -> Positional a)
-> (Positional a, ExpressionValue)
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Positional a, ExpressionValue) -> Positional a
forall a b. (a, b) -> a
fst) [(Positional a, ExpressionValue)]
rs, String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (((Positional a, ExpressionValue) -> String)
-> [(Positional a, ExpressionValue)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ExpressionValue -> String
useAsUnwrapped (ExpressionValue -> String)
-> ((Positional a, ExpressionValue) -> ExpressionValue)
-> (Positional a, ExpressionValue)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Positional a, ExpressionValue) -> ExpressionValue
forall a b. (a, b) -> b
snd) [(Positional a, ExpressionValue)]
rs))
    checkArity :: (a, Positional a) -> m ()
checkArity (a
_,Positional [a
_]) = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    checkArity (a
i,Positional [a]
ts)  =
      String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Initializer position " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" has " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ts) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" values but should have 1"
    getArgs :: String -> StateT a m String
getArgs String
argEs = do
      Maybe [VariableName]
asNames <- m (Maybe [VariableName]) -> StateT a m (Maybe [VariableName])
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe [VariableName]) -> StateT a m (Maybe [VariableName]))
-> m (Maybe [VariableName]) -> StateT a m (Maybe [VariableName])
forall a b. (a -> b) -> a -> b
$ [Expression c] -> m (Maybe [VariableName])
forall (m :: * -> *) c.
CollectErrorsM m =>
[Expression c] -> m (Maybe [VariableName])
collectArgNames ([Expression c] -> m (Maybe [VariableName]))
-> [Expression c] -> m (Maybe [VariableName])
forall a b. (a -> b) -> a -> b
$ Positional (Expression c) -> [Expression c]
forall a. Positional a -> [a]
pValues Positional (Expression c)
es
      Bool
canForward <- case Maybe [VariableName]
asNames of
                         Just [VariableName]
an -> [ParamName] -> [VariableName] -> StateT a m Bool
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[ParamName] -> [VariableName] -> CompilerState a m Bool
csCanForward [] [VariableName]
an
                         Maybe [VariableName]
_       -> Bool -> StateT a m Bool
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      if Bool
canForward
         then String -> StateT a m String
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"params_args"
         else String -> StateT a m String
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> StateT a m String) -> String -> StateT a m String
forall a b. (a -> b) -> a -> b
$ String
"PassParamsArgs(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
argEs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
compileExpressionStart (UnambiguousLiteral ValueLiteral c
l) = ValueLiteral c
-> CompilerState a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
ValueLiteral c
-> CompilerState a m (ExpressionType, ExpressionValue)
compileValueLiteral ValueLiteral c
l

compileValueLiteral :: (Ord c, Show c, CollectErrorsM m,
                           CompilerContext c m [String] a) =>
  ValueLiteral c -> CompilerState a m (ExpressionType,ExpressionValue)
compileValueLiteral :: forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
ValueLiteral c
-> CompilerState a m (ExpressionType, ExpressionValue)
compileValueLiteral (StringLiteral [c]
_ String
l) = do
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName
BuiltinString])
  (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExpressionType, ExpressionValue)
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ PrimitiveType -> String -> (ExpressionType, ExpressionValue)
expressionFromLiteral PrimitiveType
PrimString (String -> String
escapeChars String
l)
compileValueLiteral (CharLiteral [c]
_ Char
l) = do
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName
BuiltinChar])
  (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExpressionType, ExpressionValue)
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ PrimitiveType -> String -> (ExpressionType, ExpressionValue)
expressionFromLiteral PrimitiveType
PrimChar (String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
escapeChar Char
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'")
compileValueLiteral (IntegerLiteral [c]
c Bool
True Integer
l) = do
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName
BuiltinInt])
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
l Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
2Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Integer
64 :: Integer) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String
"Literal " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is greater than the max value for 64-bit unsigned"
  (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExpressionType, ExpressionValue)
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ PrimitiveType -> String -> (ExpressionType, ExpressionValue)
expressionFromLiteral PrimitiveType
PrimInt (Integer -> String
forall a. Show a => a -> String
show Integer
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"ULL")
compileValueLiteral (IntegerLiteral [c]
c Bool
False Integer
l) = do
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName
BuiltinInt])
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
l Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
2Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Integer
63 :: Integer) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String
"Literal " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is greater than the max value for 64-bit signed"
  Bool -> CompilerState a m () -> CompilerState a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((-Integer
l) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
2Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Integer
63 :: Integer)) (CompilerState a m () -> CompilerState a m ())
-> CompilerState a m () -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ String -> CompilerState a m ()
forall a. String -> StateT a m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> CompilerState a m ()) -> String -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$
    String
"Literal " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is less than the min value for 64-bit signed"
  -- NOTE: clang++ processes -abcLL as -(abcLL), which means that -(2^63)
  -- written out as a literal looks like an unsigned overflow. Using ULL here
  -- silences that warning.
  (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExpressionType, ExpressionValue)
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ PrimitiveType -> String -> (ExpressionType, ExpressionValue)
expressionFromLiteral PrimitiveType
PrimInt (Integer -> String
forall a. Show a => a -> String
show Integer
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"ULL")
compileValueLiteral (DecimalLiteral [c]
_ Integer
l Integer
e Integer
10) = do
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName
BuiltinFloat])
  -- TODO: Check bounds.
  (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExpressionType, ExpressionValue)
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ PrimitiveType -> String -> (ExpressionType, ExpressionValue)
expressionFromLiteral PrimitiveType
PrimFloat (Integer -> String
forall a. Show a => a -> String
show Integer
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"E" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
e)
compileValueLiteral (DecimalLiteral [c]
_ Integer
l Integer
e Integer
b) = do
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName
BuiltinFloat])
  let scale :: String
scale = if Integer
e Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
                 then String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (Integer
bInteger -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(-Integer
e))
                 else String
"*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (Integer
bInteger -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
e)
  -- TODO: Check bounds.
  (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExpressionType, ExpressionValue)
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ PrimitiveType -> String -> (ExpressionType, ExpressionValue)
expressionFromLiteral PrimitiveType
PrimFloat (String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"E0" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
scale String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
compileValueLiteral (BoolLiteral [c]
_ Bool
True) = do
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName
BuiltinBool])
  (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExpressionType, ExpressionValue)
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ PrimitiveType -> String -> (ExpressionType, ExpressionValue)
expressionFromLiteral PrimitiveType
PrimBool String
"true"
compileValueLiteral (BoolLiteral [c]
_ Bool
False) = do
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [CategoryName
BuiltinBool])
  (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExpressionType, ExpressionValue)
 -> CompilerState a m (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ PrimitiveType -> String -> (ExpressionType, ExpressionValue)
expressionFromLiteral PrimitiveType
PrimBool String
"false"
compileValueLiteral (EmptyLiteral [c]
_) = do
  (ExpressionType, ExpressionValue)
-> CompilerState a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType
emptyType],String -> ExpressionValue
UnwrappedSingle String
"Var_empty")

disallowInferred :: (Ord c, Show c, CollectErrorsM m) => Positional (InstanceOrInferred c) -> m [GeneralInstance]
disallowInferred :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
Positional (InstanceOrInferred c) -> m [GeneralInstance]
disallowInferred = (InstanceOrInferred c -> m GeneralInstance)
-> [InstanceOrInferred c] -> m [GeneralInstance]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM InstanceOrInferred c -> m GeneralInstance
forall {m :: * -> *} {a}.
(ErrorContextM m, Show a) =>
InstanceOrInferred a -> m GeneralInstance
disallow ([InstanceOrInferred c] -> m [GeneralInstance])
-> (Positional (InstanceOrInferred c) -> [InstanceOrInferred c])
-> Positional (InstanceOrInferred c)
-> m [GeneralInstance]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positional (InstanceOrInferred c) -> [InstanceOrInferred c]
forall a. Positional a -> [a]
pValues where
  disallow :: InstanceOrInferred a -> m GeneralInstance
disallow (AssignedInstance [a]
_ GeneralInstance
t) = GeneralInstance -> m GeneralInstance
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return GeneralInstance
t
  disallow (InferredInstance [a]
c) =
    String -> m GeneralInstance
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m GeneralInstance) -> String -> m GeneralInstance
forall a b. (a -> b) -> a -> b
$ String
"Type inference is not allowed in reduce calls" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [a]
c

compileFunctionCall :: (Ord c, Show c, CollectErrorsM m,
                        CompilerContext c m [String] a) =>
  Bool -> Maybe String -> ScopedFunction c -> FunctionCall c ->
  CompilerState a m (ExpressionType,ExpressionValue)
compileFunctionCall :: forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Bool
-> Maybe String
-> ScopedFunction c
-> FunctionCall c
-> CompilerState a m (ExpressionType, ExpressionValue)
compileFunctionCall Bool
optionalValue Maybe String
e ScopedFunction c
f (FunctionCall [c]
c FunctionName
_ Positional (InstanceOrInferred c)
ps Positional (Maybe (CallArgLabel c), Expression c)
es) = String
message String
-> StateT a m (ExpressionType, ExpressionValue)
-> StateT a m (ExpressionType, ExpressionValue)
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> do
  AnyTypeResolver
r <- CompilerState a m AnyTypeResolver
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m AnyTypeResolver
csResolver
  ParamFilters
fa <- CompilerState a m ParamFilters
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m ParamFilters
csAllFilters
  [(ExpressionType, ExpressionValue)]
es' <- [StateT a m (ExpressionType, ExpressionValue)]
-> StateT a m [(ExpressionType, ExpressionValue)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([StateT a m (ExpressionType, ExpressionValue)]
 -> StateT a m [(ExpressionType, ExpressionValue)])
-> [StateT a m (ExpressionType, ExpressionValue)]
-> StateT a m [(ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> a -> b
$ ((Maybe (CallArgLabel c), Expression c)
 -> StateT a m (ExpressionType, ExpressionValue))
-> [(Maybe (CallArgLabel c), Expression c)]
-> [StateT a m (ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> [a] -> [b]
map (Expression c -> StateT a m (ExpressionType, ExpressionValue)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
Expression c -> CompilerState a m (ExpressionType, ExpressionValue)
compileExpression (Expression c -> StateT a m (ExpressionType, ExpressionValue))
-> ((Maybe (CallArgLabel c), Expression c) -> Expression c)
-> (Maybe (CallArgLabel c), Expression c)
-> StateT a m (ExpressionType, ExpressionValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (CallArgLabel c), Expression c) -> Expression c
forall a b. (a, b) -> b
snd) ([(Maybe (CallArgLabel c), Expression c)]
 -> [StateT a m (ExpressionType, ExpressionValue)])
-> [(Maybe (CallArgLabel c), Expression c)]
-> [StateT a m (ExpressionType, ExpressionValue)]
forall a b. (a -> b) -> a -> b
$ Positional (Maybe (CallArgLabel c), Expression c)
-> [(Maybe (CallArgLabel c), Expression c)]
forall a. Positional a -> [a]
pValues Positional (Maybe (CallArgLabel c), Expression c)
es
  ([ValueType]
ts,[String]
es'') <- m ([ValueType], [String]) -> StateT a m ([ValueType], [String])
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ([ValueType], [String]) -> StateT a m ([ValueType], [String]))
-> m ([ValueType], [String]) -> StateT a m ([ValueType], [String])
forall a b. (a -> b) -> a -> b
$ [(ExpressionType, ExpressionValue)] -> m ([ValueType], [String])
forall {m :: * -> *} {a}.
CollectErrorsM m =>
[(Positional a, ExpressionValue)] -> m ([a], [String])
getValues [(ExpressionType, ExpressionValue)]
es'
  FunctionType
f' <- m FunctionType -> StateT a m FunctionType
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m FunctionType -> StateT a m FunctionType)
-> m FunctionType -> StateT a m FunctionType
forall a b. (a -> b) -> a -> b
$ ScopedFunction c -> m FunctionType
forall c (m :: * -> *).
(Show c, CollectErrorsM m) =>
ScopedFunction c -> m FunctionType
parsedToFunctionType ScopedFunction c
f
  let psActual :: Positional (InstanceOrInferred c)
psActual = case Positional (InstanceOrInferred c)
ps of
                      (Positional []) -> [InstanceOrInferred c] -> Positional (InstanceOrInferred c)
forall a. [a] -> Positional a
Positional ([InstanceOrInferred c] -> Positional (InstanceOrInferred c))
-> [InstanceOrInferred c] -> Positional (InstanceOrInferred c)
forall a b. (a -> b) -> a -> b
$ Int -> [InstanceOrInferred c] -> [InstanceOrInferred c]
forall a. Int -> [a] -> [a]
take ([ParamName] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ParamName] -> Int) -> [ParamName] -> Int
forall a b. (a -> b) -> a -> b
$ Positional ParamName -> [ParamName]
forall a. Positional a -> [a]
pValues (Positional ParamName -> [ParamName])
-> Positional ParamName -> [ParamName]
forall a b. (a -> b) -> a -> b
$ FunctionType -> Positional ParamName
ftParams FunctionType
f') ([InstanceOrInferred c] -> [InstanceOrInferred c])
-> [InstanceOrInferred c] -> [InstanceOrInferred c]
forall a b. (a -> b) -> a -> b
$ InstanceOrInferred c -> [InstanceOrInferred c]
forall a. a -> [a]
repeat ([c] -> InstanceOrInferred c
forall c. [c] -> InstanceOrInferred c
InferredInstance [c]
c)
                      Positional (InstanceOrInferred c)
_ -> Positional (InstanceOrInferred c)
ps
  GeneralInstance
self <- CompilerState a m GeneralInstance
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m GeneralInstance
autoSelfType
  Positional (InstanceOrInferred c)
ps' <- m (Positional (InstanceOrInferred c))
-> StateT a m (Positional (InstanceOrInferred c))
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Positional (InstanceOrInferred c))
 -> StateT a m (Positional (InstanceOrInferred c)))
-> m (Positional (InstanceOrInferred c))
-> StateT a m (Positional (InstanceOrInferred c))
forall a b. (a -> b) -> a -> b
$ ([InstanceOrInferred c] -> Positional (InstanceOrInferred c))
-> m [InstanceOrInferred c]
-> m (Positional (InstanceOrInferred c))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [InstanceOrInferred c] -> Positional (InstanceOrInferred c)
forall a. [a] -> Positional a
Positional (m [InstanceOrInferred c] -> m (Positional (InstanceOrInferred c)))
-> m [InstanceOrInferred c]
-> m (Positional (InstanceOrInferred c))
forall a b. (a -> b) -> a -> b
$ (InstanceOrInferred c -> m (InstanceOrInferred c))
-> [InstanceOrInferred c] -> m [InstanceOrInferred c]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (GeneralInstance -> InstanceOrInferred c -> m (InstanceOrInferred c)
forall {m :: * -> *} {c}.
CollectErrorsM m =>
GeneralInstance -> InstanceOrInferred c -> m (InstanceOrInferred c)
replaceSelfParam GeneralInstance
self) ([InstanceOrInferred c] -> m [InstanceOrInferred c])
-> [InstanceOrInferred c] -> m [InstanceOrInferred c]
forall a b. (a -> b) -> a -> b
$ Positional (InstanceOrInferred c) -> [InstanceOrInferred c]
forall a. Positional a -> [a]
pValues Positional (InstanceOrInferred c)
psActual
  Positional GeneralInstance
ps2 <- m (Positional GeneralInstance)
-> StateT a m (Positional GeneralInstance)
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Positional GeneralInstance)
 -> StateT a m (Positional GeneralInstance))
-> m (Positional GeneralInstance)
-> StateT a m (Positional GeneralInstance)
forall a b. (a -> b) -> a -> b
$ AnyTypeResolver
-> ParamFilters
-> ScopedFunction c
-> Positional (InstanceOrInferred c)
-> ExpressionType
-> m (Positional GeneralInstance)
forall c (m :: * -> *) r.
(Ord c, Show c, CollectErrorsM m, TypeResolver r) =>
r
-> ParamFilters
-> ScopedFunction c
-> Positional (InstanceOrInferred c)
-> ExpressionType
-> m (Positional GeneralInstance)
guessParamsFromArgs AnyTypeResolver
r ParamFilters
fa ScopedFunction c
f Positional (InstanceOrInferred c)
ps' ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType]
ts)
  FunctionType
f'' <- m FunctionType -> StateT a m FunctionType
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m FunctionType -> StateT a m FunctionType)
-> m FunctionType -> StateT a m FunctionType
forall a b. (a -> b) -> a -> b
$ AnyTypeResolver
-> ParamFilters
-> ParamValues
-> Positional GeneralInstance
-> FunctionType
-> m FunctionType
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r
-> ParamFilters
-> ParamValues
-> Positional GeneralInstance
-> FunctionType
-> m FunctionType
assignFunctionParams AnyTypeResolver
r ParamFilters
fa ParamValues
forall k a. Map k a
Map.empty Positional GeneralInstance
ps2 FunctionType
f'
  m () -> StateT a m ()
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT a m ()) -> m () -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ ((ParamName, InstanceOrInferred c, GeneralInstance) -> m ())
-> [(ParamName, InstanceOrInferred c, GeneralInstance)] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (ParamName, InstanceOrInferred c, GeneralInstance) -> m ()
forall {m :: * -> *} {a} {a} {a}.
(ErrorContextM m, Show a, Show a, Show a) =>
(a, InstanceOrInferred a, a) -> m ()
backgroundMessage ([(ParamName, InstanceOrInferred c, GeneralInstance)] -> m ())
-> [(ParamName, InstanceOrInferred c, GeneralInstance)] -> m ()
forall a b. (a -> b) -> a -> b
$ [ParamName]
-> [InstanceOrInferred c]
-> [GeneralInstance]
-> [(ParamName, InstanceOrInferred c, GeneralInstance)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 ((ValueParam c -> ParamName) -> [ValueParam c] -> [ParamName]
forall a b. (a -> b) -> [a] -> [b]
map ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam ([ValueParam c] -> [ParamName]) -> [ValueParam c] -> [ParamName]
forall a b. (a -> b) -> a -> b
$ Positional (ValueParam c) -> [ValueParam c]
forall a. Positional a -> [a]
pValues (Positional (ValueParam c) -> [ValueParam c])
-> Positional (ValueParam c) -> [ValueParam c]
forall a b. (a -> b) -> a -> b
$ ScopedFunction c -> Positional (ValueParam c)
forall c. ScopedFunction c -> Positional (ValueParam c)
sfParams ScopedFunction c
f) (Positional (InstanceOrInferred c) -> [InstanceOrInferred c]
forall a. Positional a -> [a]
pValues Positional (InstanceOrInferred c)
ps') (Positional GeneralInstance -> [GeneralInstance]
forall a. Positional a -> [a]
pValues Positional GeneralInstance
ps2)
  -- Called an extra time so arg count mismatches have reasonable errors.
  m () -> StateT a m ()
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT a m ()) -> m () -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ (ValueType -> ValueType -> m ())
-> ExpressionType -> ExpressionType -> m ()
forall a b (m :: * -> *) c.
(Show a, Show b, CollectErrorsM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m ()
processPairs_ (\ValueType
_ ValueType
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (FunctionType -> ExpressionType
ftArgs FunctionType
f'') ([ValueType] -> ExpressionType
forall a. [a] -> Positional a
Positional [ValueType]
ts)
  m () -> StateT a m ()
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT a m ()) -> m () -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ if ([ValueType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ValueType]
ts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [(Maybe (CallArgLabel c), Expression c)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Positional (Maybe (CallArgLabel c), Expression c)
-> [(Maybe (CallArgLabel c), Expression c)]
forall a. Positional a -> [a]
pValues Positional (Maybe (CallArgLabel c), Expression c)
es))
            then do
              ((Maybe (CallArgLabel c), Expression c) -> m ())
-> [(Maybe (CallArgLabel c), Expression c)] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (Maybe (CallArgLabel c) -> m ()
forall {m :: * -> *} {a}.
(ErrorContextM m, Show a) =>
Maybe a -> m ()
labelNotAllowedError (Maybe (CallArgLabel c) -> m ())
-> ((Maybe (CallArgLabel c), Expression c)
    -> Maybe (CallArgLabel c))
-> (Maybe (CallArgLabel c), Expression c)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (CallArgLabel c), Expression c) -> Maybe (CallArgLabel c)
forall a b. (a, b) -> a
fst) ([(Maybe (CallArgLabel c), Expression c)] -> m ())
-> [(Maybe (CallArgLabel c), Expression c)] -> m ()
forall a b. (a -> b) -> a -> b
$ Positional (Maybe (CallArgLabel c), Expression c)
-> [(Maybe (CallArgLabel c), Expression c)]
forall a. Positional a -> [a]
pValues Positional (Maybe (CallArgLabel c), Expression c)
es
              ((PassedValue c, Maybe (CallArgLabel c)) -> m ())
-> [(PassedValue c, Maybe (CallArgLabel c))] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (Maybe (CallArgLabel c) -> m ()
forall {m :: * -> *} {a}.
(ErrorContextM m, Show a) =>
Maybe a -> m ()
labelNotSetError (Maybe (CallArgLabel c) -> m ())
-> ((PassedValue c, Maybe (CallArgLabel c))
    -> Maybe (CallArgLabel c))
-> (PassedValue c, Maybe (CallArgLabel c))
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PassedValue c, Maybe (CallArgLabel c)) -> Maybe (CallArgLabel c)
forall a b. (a, b) -> b
snd) ([(PassedValue c, Maybe (CallArgLabel c))] -> m ())
-> [(PassedValue c, Maybe (CallArgLabel c))] -> m ()
forall a b. (a -> b) -> a -> b
$ Positional (PassedValue c, Maybe (CallArgLabel c))
-> [(PassedValue c, Maybe (CallArgLabel c))]
forall a. Positional a -> [a]
pValues (Positional (PassedValue c, Maybe (CallArgLabel c))
 -> [(PassedValue c, Maybe (CallArgLabel c))])
-> Positional (PassedValue c, Maybe (CallArgLabel c))
-> [(PassedValue c, Maybe (CallArgLabel c))]
forall a b. (a -> b) -> a -> b
$ ScopedFunction c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
forall c.
ScopedFunction c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
sfArgs ScopedFunction c
f
            else (Maybe (CallArgLabel c) -> (Int, Maybe (CallArgLabel c)) -> m ())
-> Positional (Maybe (CallArgLabel c))
-> Positional (Int, Maybe (CallArgLabel c))
-> m ()
forall a b (m :: * -> *) c.
(Show a, Show b, CollectErrorsM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m ()
processPairs_ Maybe (CallArgLabel c) -> (Int, Maybe (CallArgLabel c)) -> m ()
forall {m :: * -> *} {a} {c} {c}.
(ErrorContextM m, Show a, Show c, Show c) =>
Maybe (CallArgLabel c) -> (a, Maybe (CallArgLabel c)) -> m ()
checkArgLabel (((PassedValue c, Maybe (CallArgLabel c)) -> Maybe (CallArgLabel c))
-> Positional (PassedValue c, Maybe (CallArgLabel c))
-> Positional (Maybe (CallArgLabel c))
forall a b. (a -> b) -> Positional a -> Positional b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PassedValue c, Maybe (CallArgLabel c)) -> Maybe (CallArgLabel c)
forall a b. (a, b) -> b
snd (Positional (PassedValue c, Maybe (CallArgLabel c))
 -> Positional (Maybe (CallArgLabel c)))
-> Positional (PassedValue c, Maybe (CallArgLabel c))
-> Positional (Maybe (CallArgLabel c))
forall a b. (a -> b) -> a -> b
$ ScopedFunction c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
forall c.
ScopedFunction c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
sfArgs ScopedFunction c
f) ([(Int, Maybe (CallArgLabel c))]
-> Positional (Int, Maybe (CallArgLabel c))
forall a. [a] -> Positional a
Positional ([(Int, Maybe (CallArgLabel c))]
 -> Positional (Int, Maybe (CallArgLabel c)))
-> [(Int, Maybe (CallArgLabel c))]
-> Positional (Int, Maybe (CallArgLabel c))
forall a b. (a -> b) -> a -> b
$ [Int]
-> [Maybe (CallArgLabel c)] -> [(Int, Maybe (CallArgLabel c))]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..] :: [Int]) ([Maybe (CallArgLabel c)] -> [(Int, Maybe (CallArgLabel c))])
-> [Maybe (CallArgLabel c)] -> [(Int, Maybe (CallArgLabel c))]
forall a b. (a -> b) -> a -> b
$ ((Maybe (CallArgLabel c), Expression c) -> Maybe (CallArgLabel c))
-> [(Maybe (CallArgLabel c), Expression c)]
-> [Maybe (CallArgLabel c)]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (CallArgLabel c), Expression c) -> Maybe (CallArgLabel c)
forall a b. (a, b) -> a
fst ([(Maybe (CallArgLabel c), Expression c)]
 -> [Maybe (CallArgLabel c)])
-> [(Maybe (CallArgLabel c), Expression c)]
-> [Maybe (CallArgLabel c)]
forall a b. (a -> b) -> a -> b
$ Positional (Maybe (CallArgLabel c), Expression c)
-> [(Maybe (CallArgLabel c), Expression c)]
forall a. Positional a -> [a]
pValues Positional (Maybe (CallArgLabel c), Expression c)
es)
  m () -> StateT a m ()
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT a m ()) -> m () -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ (ValueType -> (Int, ValueType) -> m ())
-> ExpressionType -> Positional (Int, ValueType) -> m ()
forall a b (m :: * -> *) c.
(Show a, Show b, CollectErrorsM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m ()
processPairs_ (AnyTypeResolver
-> ParamFilters -> ValueType -> (Int, ValueType) -> m ()
forall {m :: * -> *} {r} {a}.
(CollectErrorsM m, TypeResolver r, Show a) =>
r -> ParamFilters -> ValueType -> (a, ValueType) -> m ()
checkArg AnyTypeResolver
r ParamFilters
fa) (FunctionType -> ExpressionType
ftArgs FunctionType
f'') ([(Int, ValueType)] -> Positional (Int, ValueType)
forall a. [a] -> Positional a
Positional ([(Int, ValueType)] -> Positional (Int, ValueType))
-> [(Int, ValueType)] -> Positional (Int, ValueType)
forall a b. (a -> b) -> a -> b
$ [Int] -> [ValueType] -> [(Int, ValueType)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..] :: [Int]) [ValueType]
ts)
  Set CategoryName -> StateT a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired (Set CategoryName -> StateT a m ())
-> Set CategoryName -> StateT a m ()
forall a b. (a -> b) -> a -> b
$ [Set CategoryName] -> Set CategoryName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set CategoryName] -> Set CategoryName)
-> [Set CategoryName] -> Set CategoryName
forall a b. (a -> b) -> a -> b
$ (GeneralInstance -> Set CategoryName)
-> [GeneralInstance] -> [Set CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map GeneralInstance -> Set CategoryName
categoriesFromTypes ([GeneralInstance] -> [Set CategoryName])
-> [GeneralInstance] -> [Set CategoryName]
forall a b. (a -> b) -> a -> b
$ Positional GeneralInstance -> [GeneralInstance]
forall a. Positional a -> [a]
pValues Positional GeneralInstance
ps2
  Set CategoryName -> StateT a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired ([CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [ScopedFunction c -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
f])
  [String]
params <- Positional GeneralInstance -> CompilerState a m [String]
forall (m :: * -> *) c s a.
(CollectErrorsM m, CompilerContext c m s a) =>
Positional GeneralInstance -> CompilerState a m [String]
expandParams2 Positional GeneralInstance
ps2
  SymbolScope
scope <- CompilerState a m SymbolScope
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m SymbolScope
csCurrentScope
  String
scoped <- SymbolScope -> CompilerState a m String
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
SymbolScope -> CompilerState a m String
autoScope (ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope ScopedFunction c
f)
  String
paramsArgs <- [GeneralInstance]
-> [String] -> [String] -> CompilerState a m String
forall {c} {s} {a}.
CompilerContext c m s a =>
[GeneralInstance] -> [String] -> [String] -> StateT a m String
getParamsArgs (Positional GeneralInstance -> [GeneralInstance]
forall a. Positional a -> [a]
pValues Positional GeneralInstance
ps2) [String]
params [String]
es''
  String
call <- Maybe String
-> String
-> SymbolScope
-> SymbolScope
-> String
-> CompilerState a m String
forall {m :: * -> *}.
Monad m =>
Maybe String
-> String -> SymbolScope -> SymbolScope -> String -> m String
assemble Maybe String
e String
scoped SymbolScope
scope (ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope ScopedFunction c
f) String
paramsArgs
  (ExpressionType, ExpressionValue)
-> StateT a m (ExpressionType, ExpressionValue)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExpressionType, ExpressionValue)
 -> StateT a m (ExpressionType, ExpressionValue))
-> (ExpressionType, ExpressionValue)
-> StateT a m (ExpressionType, ExpressionValue)
forall a b. (a -> b) -> a -> b
$ (FunctionType -> ExpressionType
ftReturns FunctionType
f'',String -> ExpressionValue
OpaqueMulti String
call)
  where
    labelNotAllowedError :: Maybe a -> m ()
labelNotAllowedError (Just a
l) = String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Arg label " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not allowed when forwarding multiple returns"
    labelNotAllowedError Maybe a
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    labelNotSetError :: Maybe a -> m ()
labelNotSetError (Just a
l) = String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Arg label " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" cannot be set when forwarding multiple returns"
    labelNotSetError Maybe a
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    replaceSelfParam :: GeneralInstance -> InstanceOrInferred c -> m (InstanceOrInferred c)
replaceSelfParam GeneralInstance
self (AssignedInstance [c]
c2 GeneralInstance
t) = do
      GeneralInstance
t' <- GeneralInstance -> GeneralInstance -> m GeneralInstance
forall (m :: * -> *).
CollectErrorsM m =>
GeneralInstance -> GeneralInstance -> m GeneralInstance
replaceSelfInstance GeneralInstance
self GeneralInstance
t
      InstanceOrInferred c -> m (InstanceOrInferred c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (InstanceOrInferred c -> m (InstanceOrInferred c))
-> InstanceOrInferred c -> m (InstanceOrInferred c)
forall a b. (a -> b) -> a -> b
$ [c] -> GeneralInstance -> InstanceOrInferred c
forall c. [c] -> GeneralInstance -> InstanceOrInferred c
AssignedInstance [c]
c2 GeneralInstance
t'
    replaceSelfParam GeneralInstance
_ InstanceOrInferred c
t = InstanceOrInferred c -> m (InstanceOrInferred c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return InstanceOrInferred c
t
    message :: String
message = String
"In call to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show (ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
    backgroundMessage :: (a, InstanceOrInferred a, a) -> m ()
backgroundMessage (a
n,(InferredInstance [a]
c2),a
t) = do
      let funcName :: String
funcName = CategoryName -> ScopedFunction c -> String
forall c. CategoryName -> ScopedFunction c -> String
functionDebugName (ScopedFunction c -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
f) ScopedFunction c
f
      String -> m ()
forall (m :: * -> *). ErrorContextM m => String -> m ()
compilerBackgroundM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Parameter " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
funcName String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
") inferred as " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContext [a]
c2
    backgroundMessage (a, InstanceOrInferred a, a)
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    getParamsArgs :: [GeneralInstance] -> [String] -> [String] -> StateT a m String
getParamsArgs [GeneralInstance]
ps2 [String]
paramEs [String]
argEs = do
      Maybe [ParamName]
psNames <- m (Maybe [ParamName]) -> StateT a m (Maybe [ParamName])
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe [ParamName]) -> StateT a m (Maybe [ParamName]))
-> m (Maybe [ParamName]) -> StateT a m (Maybe [ParamName])
forall a b. (a -> b) -> a -> b
$ [GeneralInstance] -> m (Maybe [ParamName])
collectParamNames [GeneralInstance]
ps2
      Maybe [VariableName]
asNames <- m (Maybe [VariableName]) -> StateT a m (Maybe [VariableName])
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe [VariableName]) -> StateT a m (Maybe [VariableName]))
-> m (Maybe [VariableName]) -> StateT a m (Maybe [VariableName])
forall a b. (a -> b) -> a -> b
$ [Expression c] -> m (Maybe [VariableName])
forall (m :: * -> *) c.
CollectErrorsM m =>
[Expression c] -> m (Maybe [VariableName])
collectArgNames ([Expression c] -> m (Maybe [VariableName]))
-> [Expression c] -> m (Maybe [VariableName])
forall a b. (a -> b) -> a -> b
$ ((Maybe (CallArgLabel c), Expression c) -> Expression c)
-> [(Maybe (CallArgLabel c), Expression c)] -> [Expression c]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (CallArgLabel c), Expression c) -> Expression c
forall a b. (a, b) -> b
snd ([(Maybe (CallArgLabel c), Expression c)] -> [Expression c])
-> [(Maybe (CallArgLabel c), Expression c)] -> [Expression c]
forall a b. (a -> b) -> a -> b
$ Positional (Maybe (CallArgLabel c), Expression c)
-> [(Maybe (CallArgLabel c), Expression c)]
forall a. Positional a -> [a]
pValues Positional (Maybe (CallArgLabel c), Expression c)
es
      Bool
canForward <- case (Maybe [ParamName]
psNames,Maybe [VariableName]
asNames) of
                         (Just [ParamName]
pn,Just [VariableName]
an) -> [ParamName] -> [VariableName] -> StateT a m Bool
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[ParamName] -> [VariableName] -> CompilerState a m Bool
csCanForward [ParamName]
pn [VariableName]
an
                         (Maybe [ParamName], Maybe [VariableName])
_                 -> Bool -> StateT a m Bool
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      if Bool
canForward
         then String -> StateT a m String
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"params_args"
         else String -> StateT a m String
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> StateT a m String) -> String -> StateT a m String
forall a b. (a -> b) -> a -> b
$ String
"PassParamsArgs(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String]
paramEs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
argEs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    assemble :: Maybe String
-> String -> SymbolScope -> SymbolScope -> String -> m String
assemble Maybe String
Nothing String
_ SymbolScope
ValueScope SymbolScope
ValueScope String
paramsArgs =
      String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ FunctionName -> String
callName (ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
paramsArgs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    assemble Maybe String
Nothing String
_ SymbolScope
TypeScope SymbolScope
TypeScope String
paramsArgs =
      String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ FunctionName -> String
callName (ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
paramsArgs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    assemble Maybe String
Nothing String
scoped SymbolScope
ValueScope SymbolScope
TypeScope String
paramsArgs =
      String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
scoped String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
callName (ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
paramsArgs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    assemble Maybe String
Nothing String
scoped SymbolScope
_ SymbolScope
_ String
paramsArgs =
      String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
scoped String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
callName (ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
paramsArgs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    assemble (Just String
e2) String
_ SymbolScope
_ SymbolScope
ValueScope String
paramsArgs =
      if Bool
optionalValue
         then String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
"TYPE_VALUE_CALL_UNLESS_EMPTY(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ScopedFunction c -> String
forall c. ScopedFunction c -> String
functionName ScopedFunction c
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
paramsArgs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
returnCount String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
         else String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
valueBase String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::Call(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ScopedFunction c -> String
forall c. ScopedFunction c -> String
functionName ScopedFunction c
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
paramsArgs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    assemble (Just String
e2) String
_ SymbolScope
_ SymbolScope
TypeScope String
paramsArgs =
      String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
typeBase String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::Call(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ScopedFunction c -> String
forall c. ScopedFunction c -> String
functionName ScopedFunction c
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
paramsArgs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    assemble (Just String
e2) String
_ SymbolScope
_ SymbolScope
_ String
paramsArgs =
      String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".Call(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ScopedFunction c -> String
forall c. ScopedFunction c -> String
functionName ScopedFunction c
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
paramsArgs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    returnCount :: Int
returnCount = [PassedValue c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([PassedValue c] -> Int) -> [PassedValue c] -> Int
forall a b. (a -> b) -> a -> b
$ Positional (PassedValue c) -> [PassedValue c]
forall a. Positional a -> [a]
pValues (Positional (PassedValue c) -> [PassedValue c])
-> Positional (PassedValue c) -> [PassedValue c]
forall a b. (a -> b) -> a -> b
$ ScopedFunction c -> Positional (PassedValue c)
forall c. ScopedFunction c -> Positional (PassedValue c)
sfReturns ScopedFunction c
f
    -- TODO: Lots of duplication with assignments and initialization.
    -- Single expression, but possibly multi-return.
    getValues :: [(Positional a, ExpressionValue)] -> m ([a], [String])
getValues [(Positional [a]
ts,ExpressionValue
e2)] = ([a], [String]) -> m ([a], [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
ts,[ExpressionValue -> String
useAsArgs ExpressionValue
e2])
    -- Multi-expression => must all be singles.
    getValues [(Positional a, ExpressionValue)]
rs = do
      (((Int, Positional a) -> m ()) -> [(Int, Positional a)] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (Int, Positional a) -> m ()
forall {m :: * -> *} {a} {a}.
(ErrorContextM m, Show a) =>
(a, Positional a) -> m ()
checkArity ([(Int, Positional a)] -> m ()) -> [(Int, Positional a)] -> m ()
forall a b. (a -> b) -> a -> b
$ [Int] -> [Positional a] -> [(Int, Positional a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..] :: [Int]) ([Positional a] -> [(Int, Positional a)])
-> [Positional a] -> [(Int, Positional a)]
forall a b. (a -> b) -> a -> b
$ ((Positional a, ExpressionValue) -> Positional a)
-> [(Positional a, ExpressionValue)] -> [Positional a]
forall a b. (a -> b) -> [a] -> [b]
map (Positional a, ExpressionValue) -> Positional a
forall a b. (a, b) -> a
fst [(Positional a, ExpressionValue)]
rs) m () -> String -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<??
        String
"In return at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
      ([a], [String]) -> m ([a], [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (((Positional a, ExpressionValue) -> a)
-> [(Positional a, ExpressionValue)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ([a] -> a
forall a. HasCallStack => [a] -> a
head ([a] -> a)
-> ((Positional a, ExpressionValue) -> [a])
-> (Positional a, ExpressionValue)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positional a -> [a]
forall a. Positional a -> [a]
pValues (Positional a -> [a])
-> ((Positional a, ExpressionValue) -> Positional a)
-> (Positional a, ExpressionValue)
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Positional a, ExpressionValue) -> Positional a
forall a b. (a, b) -> a
fst) [(Positional a, ExpressionValue)]
rs,((Positional a, ExpressionValue) -> String)
-> [(Positional a, ExpressionValue)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ExpressionValue -> String
useAsUnwrapped (ExpressionValue -> String)
-> ((Positional a, ExpressionValue) -> ExpressionValue)
-> (Positional a, ExpressionValue)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Positional a, ExpressionValue) -> ExpressionValue
forall a b. (a, b) -> b
snd) [(Positional a, ExpressionValue)]
rs)
    checkArity :: (a, Positional a) -> m ()
checkArity (a
_,Positional [a
_]) = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    checkArity (a
i,Positional [a]
ts)  =
      String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Return position " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" has " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ts) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" values but should have 1"
    checkArg :: r -> ParamFilters -> ValueType -> (a, ValueType) -> m ()
checkArg r
r ParamFilters
fa ValueType
t0 (a
i,ValueType
t1) = do
      r -> ParamFilters -> ValueType -> ValueType -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> ValueType -> ValueType -> m ()
checkValueAssignment r
r ParamFilters
fa ValueType
t1 ValueType
t0 m () -> String -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<?? String
"In argument " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show (ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f)
    checkArgLabel :: Maybe (CallArgLabel c) -> (a, Maybe (CallArgLabel c)) -> m ()
checkArgLabel (Just (CallArgLabel [c]
_ String
n1)) (a
_,Just (CallArgLabel [c]
_ String
n2))
      | String
n1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n2 = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    checkArgLabel Maybe (CallArgLabel c)
l1 (a
i,Maybe (CallArgLabel c)
l2) = String
"In argument " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show (ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f) String -> m () -> m ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a -> m a
??> Maybe (CallArgLabel c) -> Maybe (CallArgLabel c) -> m ()
forall {m :: * -> *} {a} {a}.
(ErrorContextM m, Show a, Show a) =>
Maybe a -> Maybe a -> m ()
labelError Maybe (CallArgLabel c)
l1 Maybe (CallArgLabel c)
l2
    labelError :: Maybe a -> Maybe a -> m ()
labelError (Just a
l1) (Just a
l2) =
      String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected arg label " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
l1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
l2
    labelError (Just a
l1) Maybe a
_ =
      String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected arg label " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
l1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" but label is missing"
    labelError Maybe a
_ (Just a
l2) =
      String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected no arg label but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
l2
    labelError Maybe a
_ Maybe a
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    collectParamNames :: [GeneralInstance] -> m (Maybe [ParamName])
collectParamNames = ([Maybe ParamName] -> Maybe [ParamName])
-> m [Maybe ParamName] -> m (Maybe [ParamName])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe ParamName] -> Maybe [ParamName]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (m [Maybe ParamName] -> m (Maybe [ParamName]))
-> ([GeneralInstance] -> m [Maybe ParamName])
-> [GeneralInstance]
-> m (Maybe [ParamName])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GeneralInstance -> m (Maybe ParamName))
-> [GeneralInstance] -> m [Maybe ParamName]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM GeneralInstance -> m (Maybe ParamName)
collectParamName
    collectParamName :: GeneralInstance -> m (Maybe ParamName)
collectParamName = (Maybe TypeInstanceOrParam -> Maybe ParamName)
-> m (Maybe TypeInstanceOrParam) -> m (Maybe ParamName)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe TypeInstanceOrParam -> Maybe ParamName
getParamName (m (Maybe TypeInstanceOrParam) -> m (Maybe ParamName))
-> (GeneralInstance -> m (Maybe TypeInstanceOrParam))
-> GeneralInstance
-> m (Maybe ParamName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m TypeInstanceOrParam -> m (Maybe TypeInstanceOrParam)
forall (m :: * -> *) a. CollectErrorsM m => m a -> m (Maybe a)
tryCompilerM (m TypeInstanceOrParam -> m (Maybe TypeInstanceOrParam))
-> (GeneralInstance -> m TypeInstanceOrParam)
-> GeneralInstance
-> m (Maybe TypeInstanceOrParam)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeneralInstance -> m (T GeneralInstance)
GeneralInstance -> m TypeInstanceOrParam
forall a (m :: * -> *).
(PreserveMerge a, CollectErrorsM m) =>
a -> m (T a)
matchOnlyLeaf
    getParamName :: Maybe TypeInstanceOrParam -> Maybe ParamName
getParamName (Just (JustParamName Bool
_ ParamName
n)) = ParamName -> Maybe ParamName
forall a. a -> Maybe a
Just ParamName
n
    getParamName Maybe TypeInstanceOrParam
_ = Maybe ParamName
forall a. Maybe a
Nothing

collectArgNames :: CollectErrorsM m => [Expression c] -> m (Maybe [VariableName])
collectArgNames :: forall (m :: * -> *) c.
CollectErrorsM m =>
[Expression c] -> m (Maybe [VariableName])
collectArgNames = ([Maybe VariableName] -> Maybe [VariableName])
-> m [Maybe VariableName] -> m (Maybe [VariableName])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe VariableName] -> Maybe [VariableName]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (m [Maybe VariableName] -> m (Maybe [VariableName]))
-> ([Expression c] -> m [Maybe VariableName])
-> [Expression c]
-> m (Maybe [VariableName])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expression c -> m (Maybe VariableName))
-> [Expression c] -> m [Maybe VariableName]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM Expression c -> m (Maybe VariableName)
forall {m :: * -> *} {c}.
Monad m =>
Expression c -> m (Maybe VariableName)
collectArgName where
  collectArgName :: Expression c -> m (Maybe VariableName)
collectArgName (Expression [c]
_ (NamedVariable (OutputValue [c]
_ VariableName
n)) []) = Maybe VariableName -> m (Maybe VariableName)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe VariableName -> m (Maybe VariableName))
-> Maybe VariableName -> m (Maybe VariableName)
forall a b. (a -> b) -> a -> b
$ VariableName -> Maybe VariableName
forall a. a -> Maybe a
Just VariableName
n
  collectArgName Expression c
_ = Maybe VariableName -> m (Maybe VariableName)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VariableName
forall a. Maybe a
Nothing

guessParamsFromArgs :: (Ord c, Show c, CollectErrorsM m, TypeResolver r) =>
  r -> ParamFilters -> ScopedFunction c -> Positional (InstanceOrInferred c) ->
  Positional ValueType -> m (Positional GeneralInstance)
guessParamsFromArgs :: forall c (m :: * -> *) r.
(Ord c, Show c, CollectErrorsM m, TypeResolver r) =>
r
-> ParamFilters
-> ScopedFunction c
-> Positional (InstanceOrInferred c)
-> ExpressionType
-> m (Positional GeneralInstance)
guessParamsFromArgs r
r ParamFilters
fa ScopedFunction c
f Positional (InstanceOrInferred c)
ps ExpressionType
ts = do
  ParamFilters
fm <- ScopedFunction c -> m ParamFilters
forall (m :: * -> *) c.
CollectErrorsM m =>
ScopedFunction c -> m ParamFilters
getFunctionFilterMap ScopedFunction c
f
  [PatternMatch]
args <- (ValueType -> ValueType -> m PatternMatch)
-> ExpressionType -> ExpressionType -> m [PatternMatch]
forall a b (m :: * -> *) c.
(Show a, Show b, CollectErrorsM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m [c]
processPairs (\ValueType
t1 ValueType
t2 -> PatternMatch -> m PatternMatch
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PatternMatch -> m PatternMatch) -> PatternMatch -> m PatternMatch
forall a b. (a -> b) -> a -> b
$ Variance -> ValueType -> ValueType -> PatternMatch
TypePattern Variance
Covariant ValueType
t1 ValueType
t2) ExpressionType
ts (((PassedValue c, Maybe (CallArgLabel c)) -> ValueType)
-> Positional (PassedValue c, Maybe (CallArgLabel c))
-> ExpressionType
forall a b. (a -> b) -> Positional a -> Positional b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PassedValue c -> ValueType
forall c. PassedValue c -> ValueType
pvType (PassedValue c -> ValueType)
-> ((PassedValue c, Maybe (CallArgLabel c)) -> PassedValue c)
-> (PassedValue c, Maybe (CallArgLabel c))
-> ValueType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PassedValue c, Maybe (CallArgLabel c)) -> PassedValue c
forall a b. (a, b) -> a
fst) (Positional (PassedValue c, Maybe (CallArgLabel c))
 -> ExpressionType)
-> Positional (PassedValue c, Maybe (CallArgLabel c))
-> ExpressionType
forall a b. (a -> b) -> a -> b
$ ScopedFunction c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
forall c.
ScopedFunction c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
sfArgs ScopedFunction c
f)
  [PatternMatch]
filts <- ([[PatternMatch]] -> [PatternMatch])
-> m [[PatternMatch]] -> m [PatternMatch]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[PatternMatch]] -> [PatternMatch]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[PatternMatch]] -> m [PatternMatch])
-> m [[PatternMatch]] -> m [PatternMatch]
forall a b. (a -> b) -> a -> b
$ (ValueType -> ValueType -> m [PatternMatch])
-> ExpressionType -> ExpressionType -> m [[PatternMatch]]
forall a b (m :: * -> *) c.
(Show a, Show b, CollectErrorsM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m [c]
processPairs (ParamFilters -> ValueType -> ValueType -> m [PatternMatch]
forall (m :: * -> *).
CollectErrorsM m =>
ParamFilters -> ValueType -> ValueType -> m [PatternMatch]
guessesFromFilters ParamFilters
fm) ExpressionType
ts (((PassedValue c, Maybe (CallArgLabel c)) -> ValueType)
-> Positional (PassedValue c, Maybe (CallArgLabel c))
-> ExpressionType
forall a b. (a -> b) -> Positional a -> Positional b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PassedValue c -> ValueType
forall c. PassedValue c -> ValueType
pvType (PassedValue c -> ValueType)
-> ((PassedValue c, Maybe (CallArgLabel c)) -> PassedValue c)
-> (PassedValue c, Maybe (CallArgLabel c))
-> ValueType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PassedValue c, Maybe (CallArgLabel c)) -> PassedValue c
forall a b. (a, b) -> a
fst) (Positional (PassedValue c, Maybe (CallArgLabel c))
 -> ExpressionType)
-> Positional (PassedValue c, Maybe (CallArgLabel c))
-> ExpressionType
forall a b. (a -> b) -> a -> b
$ ScopedFunction c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
forall c.
ScopedFunction c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
sfArgs ScopedFunction c
f)
  ParamValues
pa <- ([(ParamName, GeneralInstance)] -> ParamValues)
-> m [(ParamName, GeneralInstance)] -> m ParamValues
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ParamName, GeneralInstance)] -> ParamValues
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (m [(ParamName, GeneralInstance)] -> m ParamValues)
-> m [(ParamName, GeneralInstance)] -> m ParamValues
forall a b. (a -> b) -> a -> b
$ (ParamName
 -> InstanceOrInferred c -> m (ParamName, GeneralInstance))
-> Positional ParamName
-> Positional (InstanceOrInferred c)
-> m [(ParamName, GeneralInstance)]
forall a b (m :: * -> *) c.
(Show a, Show b, CollectErrorsM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m [c]
processPairs ParamName -> InstanceOrInferred c -> m (ParamName, GeneralInstance)
forall {m :: * -> *} {c}.
Monad m =>
ParamName -> InstanceOrInferred c -> m (ParamName, GeneralInstance)
toInstance ((ValueParam c -> ParamName)
-> Positional (ValueParam c) -> Positional ParamName
forall a b. (a -> b) -> Positional a -> Positional b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueParam c -> ParamName
forall c. ValueParam c -> ParamName
vpParam (Positional (ValueParam c) -> Positional ParamName)
-> Positional (ValueParam c) -> Positional ParamName
forall a b. (a -> b) -> a -> b
$ ScopedFunction c -> Positional (ValueParam c)
forall c. ScopedFunction c -> Positional (ValueParam c)
sfParams ScopedFunction c
f) Positional (InstanceOrInferred c)
ps
  MergeTree InferredTypeGuess
gs <- r
-> ParamFilters
-> ParamValues
-> [PatternMatch]
-> m (MergeTree InferredTypeGuess)
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r
-> ParamFilters
-> ParamValues
-> [PatternMatch]
-> m (MergeTree InferredTypeGuess)
inferParamTypes r
r ParamFilters
fa ParamValues
pa ([PatternMatch]
args [PatternMatch] -> [PatternMatch] -> [PatternMatch]
forall a. [a] -> [a] -> [a]
++ [PatternMatch]
filts)
  ParamValues
gs' <- r
-> ParamFilters
-> ParamFilters
-> ParamValues
-> MergeTree InferredTypeGuess
-> m ParamValues
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r
-> ParamFilters
-> ParamFilters
-> ParamValues
-> MergeTree InferredTypeGuess
-> m ParamValues
mergeInferredTypes r
r ParamFilters
fa ParamFilters
fm ParamValues
pa MergeTree InferredTypeGuess
gs
  let pa3 :: ParamValues
pa3 = ParamValues
gs' ParamValues -> ParamValues -> ParamValues
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` ParamValues
pa
  ([GeneralInstance] -> Positional GeneralInstance)
-> m [GeneralInstance] -> m (Positional GeneralInstance)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [GeneralInstance] -> Positional GeneralInstance
forall a. [a] -> Positional a
Positional (m [GeneralInstance] -> m (Positional GeneralInstance))
-> m [GeneralInstance] -> m (Positional GeneralInstance)
forall a b. (a -> b) -> a -> b
$ (ValueParam c -> m GeneralInstance)
-> [ValueParam c] -> m [GeneralInstance]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (ParamValues -> ValueParam c -> m GeneralInstance
forall {m :: * -> *} {a}.
(ErrorContextM m, Show a) =>
ParamValues -> ValueParam a -> m GeneralInstance
subPosition ParamValues
pa3) (Positional (ValueParam c) -> [ValueParam c]
forall a. Positional a -> [a]
pValues (Positional (ValueParam c) -> [ValueParam c])
-> Positional (ValueParam c) -> [ValueParam c]
forall a b. (a -> b) -> a -> b
$ ScopedFunction c -> Positional (ValueParam c)
forall c. ScopedFunction c -> Positional (ValueParam c)
sfParams ScopedFunction c
f) where
    subPosition :: ParamValues -> ValueParam a -> m GeneralInstance
subPosition ParamValues
pa2 ValueParam a
p =
      case (ValueParam a -> ParamName
forall c. ValueParam c -> ParamName
vpParam ValueParam a
p) ParamName -> ParamValues -> Maybe GeneralInstance
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` ParamValues
pa2 of
           Just GeneralInstance
t  -> if Bool -> Bool
not (GeneralInstance -> Bool
hasInferredParams GeneralInstance
t)
                         then GeneralInstance -> m GeneralInstance
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return GeneralInstance
t
                         else String -> m GeneralInstance
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m GeneralInstance) -> String -> m GeneralInstance
forall a b. (a -> b) -> a -> b
$ String
"Could not infer param " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                              ParamName -> String
forall a. Show a => a -> String
show (ValueParam a -> ParamName
forall c. ValueParam c -> ParamName
vpParam ValueParam a
p) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (ValueParam a -> [a]
forall c. ValueParam c -> [c]
vpContext ValueParam a
p)
           Maybe GeneralInstance
Nothing -> String -> m GeneralInstance
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m GeneralInstance) -> String -> m GeneralInstance
forall a b. (a -> b) -> a -> b
$ String
"Something went wrong inferring " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                      ParamName -> String
forall a. Show a => a -> String
show (ValueParam a -> ParamName
forall c. ValueParam c -> ParamName
vpParam ValueParam a
p) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => [a] -> String
formatFullContextBrace (ValueParam a -> [a]
forall c. ValueParam c -> [c]
vpContext ValueParam a
p)
    toInstance :: ParamName -> InstanceOrInferred c -> m (ParamName, GeneralInstance)
toInstance ParamName
p1 (AssignedInstance [c]
_ GeneralInstance
t) = (ParamName, GeneralInstance) -> m (ParamName, GeneralInstance)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParamName
p1,GeneralInstance
t)
    toInstance ParamName
p1 (InferredInstance [c]
_)   = (ParamName, GeneralInstance) -> m (ParamName, GeneralInstance)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParamName
p1,TypeInstanceOrParam -> GeneralInstance
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType (TypeInstanceOrParam -> GeneralInstance)
-> TypeInstanceOrParam -> GeneralInstance
forall a b. (a -> b) -> a -> b
$ ParamName -> TypeInstanceOrParam
JustInferredType ParamName
p1)

guessParams :: (Ord c, Show c, CollectErrorsM m, TypeResolver r) =>
  r -> ParamFilters -> Positional ValueType -> Positional ParamName ->
  Positional (InstanceOrInferred c) -> Positional ValueType -> m (Positional GeneralInstance)
guessParams :: forall c (m :: * -> *) r.
(Ord c, Show c, CollectErrorsM m, TypeResolver r) =>
r
-> ParamFilters
-> ExpressionType
-> Positional ParamName
-> Positional (InstanceOrInferred c)
-> ExpressionType
-> m (Positional GeneralInstance)
guessParams r
r ParamFilters
fa ExpressionType
args Positional ParamName
params Positional (InstanceOrInferred c)
ps ExpressionType
ts = do
  [PatternMatch]
args' <- (ValueType -> ValueType -> m PatternMatch)
-> ExpressionType -> ExpressionType -> m [PatternMatch]
forall a b (m :: * -> *) c.
(Show a, Show b, CollectErrorsM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m [c]
processPairs (\ValueType
t1 ValueType
t2 -> PatternMatch -> m PatternMatch
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PatternMatch -> m PatternMatch) -> PatternMatch -> m PatternMatch
forall a b. (a -> b) -> a -> b
$ Variance -> ValueType -> ValueType -> PatternMatch
TypePattern Variance
Covariant ValueType
t1 ValueType
t2) ExpressionType
ts ExpressionType
args
  ParamValues
pa <- ([(ParamName, GeneralInstance)] -> ParamValues)
-> m [(ParamName, GeneralInstance)] -> m ParamValues
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ParamName, GeneralInstance)] -> ParamValues
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (m [(ParamName, GeneralInstance)] -> m ParamValues)
-> m [(ParamName, GeneralInstance)] -> m ParamValues
forall a b. (a -> b) -> a -> b
$ (ParamName
 -> InstanceOrInferred c -> m (ParamName, GeneralInstance))
-> Positional ParamName
-> Positional (InstanceOrInferred c)
-> m [(ParamName, GeneralInstance)]
forall a b (m :: * -> *) c.
(Show a, Show b, CollectErrorsM m) =>
(a -> b -> m c) -> Positional a -> Positional b -> m [c]
processPairs ParamName -> InstanceOrInferred c -> m (ParamName, GeneralInstance)
forall {m :: * -> *} {c}.
Monad m =>
ParamName -> InstanceOrInferred c -> m (ParamName, GeneralInstance)
toInstance Positional ParamName
params Positional (InstanceOrInferred c)
ps
  MergeTree InferredTypeGuess
gs <- r
-> ParamFilters
-> ParamValues
-> [PatternMatch]
-> m (MergeTree InferredTypeGuess)
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r
-> ParamFilters
-> ParamValues
-> [PatternMatch]
-> m (MergeTree InferredTypeGuess)
inferParamTypes r
r ParamFilters
fa ParamValues
pa [PatternMatch]
args'
  ParamValues
gs' <- r
-> ParamFilters
-> ParamFilters
-> ParamValues
-> MergeTree InferredTypeGuess
-> m ParamValues
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r
-> ParamFilters
-> ParamFilters
-> ParamValues
-> MergeTree InferredTypeGuess
-> m ParamValues
mergeInferredTypes r
r ParamFilters
fa ([(ParamName, [TypeFilter])] -> ParamFilters
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ParamName, [TypeFilter])] -> ParamFilters)
-> [(ParamName, [TypeFilter])] -> ParamFilters
forall a b. (a -> b) -> a -> b
$ [ParamName] -> [[TypeFilter]] -> [(ParamName, [TypeFilter])]
forall a b. [a] -> [b] -> [(a, b)]
zip (Positional ParamName -> [ParamName]
forall a. Positional a -> [a]
pValues Positional ParamName
params) ([TypeFilter] -> [[TypeFilter]]
forall a. a -> [a]
repeat [])) ParamValues
pa MergeTree InferredTypeGuess
gs
  let pa3 :: ParamValues
pa3 = ParamValues
gs' ParamValues -> ParamValues -> ParamValues
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` ParamValues
pa
  ([GeneralInstance] -> Positional GeneralInstance)
-> m [GeneralInstance] -> m (Positional GeneralInstance)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [GeneralInstance] -> Positional GeneralInstance
forall a. [a] -> Positional a
Positional (m [GeneralInstance] -> m (Positional GeneralInstance))
-> m [GeneralInstance] -> m (Positional GeneralInstance)
forall a b. (a -> b) -> a -> b
$ (ParamName -> m GeneralInstance)
-> [ParamName] -> m [GeneralInstance]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (ParamValues -> ParamName -> m GeneralInstance
forall {a} {m :: * -> *} {a}.
(Ord a, ErrorContextM m, Show a) =>
Map a a -> a -> m a
subPosition ParamValues
pa3) (Positional ParamName -> [ParamName]
forall a. Positional a -> [a]
pValues Positional ParamName
params) where
    subPosition :: Map a a -> a -> m a
subPosition Map a a
pa2 a
p =
      case a
p a -> Map a a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map a a
pa2 of
           Just a
t  -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
t
           Maybe a
Nothing -> String -> m a
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Something went wrong inferring " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
p
    toInstance :: ParamName -> InstanceOrInferred c -> m (ParamName, GeneralInstance)
toInstance ParamName
p1 (AssignedInstance [c]
_ GeneralInstance
t) = (ParamName, GeneralInstance) -> m (ParamName, GeneralInstance)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParamName
p1,GeneralInstance
t)
    toInstance ParamName
p1 (InferredInstance [c]
_)   = (ParamName, GeneralInstance) -> m (ParamName, GeneralInstance)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParamName
p1,TypeInstanceOrParam -> GeneralInstance
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType (TypeInstanceOrParam -> GeneralInstance)
-> TypeInstanceOrParam -> GeneralInstance
forall a b. (a -> b) -> a -> b
$ ParamName -> TypeInstanceOrParam
JustInferredType ParamName
p1)

compileMainProcedure :: (Ord c, Show c, CollectErrorsM m) =>
  CategoryMap c -> ExprMap c -> Expression c -> m (CompiledData [String])
compileMainProcedure :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
CategoryMap c
-> ExprMap c -> Expression c -> m (CompiledData [String])
compileMainProcedure CategoryMap c
tm ExprMap c
em Expression c
e = do
  ProcedureContext c
ctx <- Bool -> CategoryMap c -> ExprMap c -> m (ProcedureContext c)
forall (m :: * -> *) c.
CollectErrorsM m =>
Bool -> CategoryMap c -> ExprMap c -> m (ProcedureContext c)
getMainContext Bool
False CategoryMap c
tm ExprMap c
em
  CompilerState (ProcedureContext c) m ()
-> ProcedureContext c -> m (CompiledData [String])
forall c (m :: * -> *) s a b.
CompilerContext c m s a =>
CompilerState a m b -> a -> m (CompiledData s)
runDataCompiler CompilerState (ProcedureContext c) m ()
compiler ProcedureContext c
ctx where
    procedure :: Procedure c
procedure = [c] -> [Statement c] -> Procedure c
forall c. [c] -> [Statement c] -> Procedure c
Procedure [] [[c] -> Expression c -> Statement c
forall c. [c] -> Expression c -> Statement c
IgnoreValues [] Expression c
e]
    compiler :: CompilerState (ProcedureContext c) m ()
compiler = do
      ProcedureContext c
ctx0 <- CompilerState (ProcedureContext c) m (ProcedureContext c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m a
getCleanContext
      ProcedureContext c
-> Procedure c
-> CompilerState (ProcedureContext c) m (ProcedureContext c)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> Procedure c -> CompilerState a m a
compileProcedure ProcedureContext c
ctx0 Procedure c
procedure CompilerState (ProcedureContext c) m (ProcedureContext c)
-> (ProcedureContext c -> CompilerState (ProcedureContext c) m ())
-> CompilerState (ProcedureContext c) m ()
forall a b.
StateT (ProcedureContext c) m a
-> (a -> StateT (ProcedureContext c) m b)
-> StateT (ProcedureContext c) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcedureContext c -> CompilerState (ProcedureContext c) m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put

compileWrapTestcase :: (Ord c, Show c, CollectErrorsM m) =>
  CategoryMap c -> ([c],TypeInstance) -> m (CompiledData [String])
compileWrapTestcase :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
CategoryMap c -> ([c], TypeInstance) -> m (CompiledData [String])
compileWrapTestcase CategoryMap c
tm ([c]
c,TypeInstance
t) = do
  ProcedureContext c
ctx <- Bool -> CategoryMap c -> ExprMap c -> m (ProcedureContext c)
forall (m :: * -> *) c.
CollectErrorsM m =>
Bool -> CategoryMap c -> ExprMap c -> m (ProcedureContext c)
getMainContext Bool
False CategoryMap c
tm ExprMap c
forall k a. Map k a
Map.empty
  CompilerState (ProcedureContext c) m ()
-> ProcedureContext c -> m (CompiledData [String])
forall c (m :: * -> *) s a b.
CompilerContext c m s a =>
CompilerState a m b -> a -> m (CompiledData s)
runDataCompiler CompilerState (ProcedureContext c) m ()
compiler ProcedureContext c
ctx m (CompiledData [String]) -> String -> m (CompiledData [String])
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<??
    String
"In custom testcase checker at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
  where
    compiler :: CompilerState (ProcedureContext c) m ()
compiler = do
      ProcedureContext c
ctx0 <- CompilerState (ProcedureContext c) m (ProcedureContext c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m a
getCleanContext
      m (ProcedureContext c)
-> CompilerState (ProcedureContext c) m (ProcedureContext c)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (ProcedureContext c) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (CompilerState (ProcedureContext c) m ()
-> ProcedureContext c -> m (ProcedureContext c)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT CompilerState (ProcedureContext c) m ()
testcase ProcedureContext c
ctx0) CompilerState (ProcedureContext c) m (ProcedureContext c)
-> (ProcedureContext c -> CompilerState (ProcedureContext c) m ())
-> CompilerState (ProcedureContext c) m ()
forall a b.
StateT (ProcedureContext c) m a
-> (a -> StateT (ProcedureContext c) m b)
-> StateT (ProcedureContext c) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcedureContext c -> CompilerState (ProcedureContext c) m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put
    testcase :: CompilerState (ProcedureContext c) m ()
testcase = do
      let t2 :: GeneralInstance
t2 = TypeInstanceOrParam -> GeneralInstance
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType (TypeInstanceOrParam -> GeneralInstance)
-> TypeInstanceOrParam -> GeneralInstance
forall a b. (a -> b) -> a -> b
$ TypeInstance -> TypeInstanceOrParam
JustTypeInstance TypeInstance
t
      AnyTypeResolver
r <- CompilerState (ProcedureContext c) m AnyTypeResolver
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m AnyTypeResolver
csResolver
      m () -> CompilerState (ProcedureContext c) m ()
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (ProcedureContext c) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> CompilerState (ProcedureContext c) m ())
-> m () -> CompilerState (ProcedureContext c) m ()
forall a b. (a -> b) -> a -> b
$ AnyTypeResolver -> ParamFilters -> GeneralInstance -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> GeneralInstance -> m ()
validateGeneralInstanceForCall AnyTypeResolver
r ParamFilters
forall k a. Map k a
Map.empty GeneralInstance
t2
      m () -> CompilerState (ProcedureContext c) m ()
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (ProcedureContext c) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> CompilerState (ProcedureContext c) m ())
-> m () -> CompilerState (ProcedureContext c) m ()
forall a b. (a -> b) -> a -> b
$ AnyTypeResolver
-> ParamFilters -> GeneralInstance -> [TypeFilter] -> m ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> GeneralInstance -> [TypeFilter] -> m ()
validateAssignment AnyTypeResolver
r ParamFilters
forall k a. Map k a
Map.empty GeneralInstance
t2 [DefinesInstance -> TypeFilter
DefinesFilter (CategoryName -> Positional GeneralInstance -> DefinesInstance
DefinesInstance CategoryName
BuiltinTestcase ([GeneralInstance] -> Positional GeneralInstance
forall a. [a] -> Positional a
Positional []))]
      ScopedFunction c
start <- [c]
-> Maybe GeneralInstance
-> FunctionName
-> CompilerState (ProcedureContext c) m (ScopedFunction c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c]
-> Maybe GeneralInstance
-> FunctionName
-> CompilerState a m (ScopedFunction c)
csGetTypeFunction [c]
c (GeneralInstance -> Maybe GeneralInstance
forall a. a -> Maybe a
Just GeneralInstance
t2) (String -> FunctionName
FunctionName String
"start")
      ScopedFunction c
finish <- [c]
-> Maybe GeneralInstance
-> FunctionName
-> CompilerState (ProcedureContext c) m (ScopedFunction c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c]
-> Maybe GeneralInstance
-> FunctionName
-> CompilerState a m (ScopedFunction c)
csGetTypeFunction [c]
c (GeneralInstance -> Maybe GeneralInstance
forall a. a -> Maybe a
Just GeneralInstance
t2) (String -> FunctionName
FunctionName String
"finish")
      Set CategoryName -> CompilerState (ProcedureContext c) m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired (Set CategoryName -> CompilerState (ProcedureContext c) m ())
-> Set CategoryName -> CompilerState (ProcedureContext c) m ()
forall a b. (a -> b) -> a -> b
$ [CategoryName] -> Set CategoryName
forall a. Ord a => [a] -> Set a
Set.fromList [ScopedFunction c -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
start,ScopedFunction c -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
finish]
      Set CategoryName -> CompilerState (ProcedureContext c) m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired (Set CategoryName -> CompilerState (ProcedureContext c) m ())
-> Set CategoryName -> CompilerState (ProcedureContext c) m ()
forall a b. (a -> b) -> a -> b
$ GeneralInstance -> Set CategoryName
categoriesFromTypes GeneralInstance
t2
      String
t2' <- GeneralInstance -> CompilerState (ProcedureContext c) m String
forall (m :: * -> *) c s a.
(CollectErrorsM m, CompilerContext c m s a) =>
GeneralInstance -> CompilerState a m String
expandGeneralInstance GeneralInstance
t2
      [String] -> CompilerState (ProcedureContext c) m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"WrapTypeCall check_test(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t2' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", &" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ScopedFunction c -> String
forall c. ScopedFunction c -> String
functionName ScopedFunction c
start String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", &" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ScopedFunction c -> String
forall c. ScopedFunction c -> String
functionName ScopedFunction c
finish String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");"]

compileTestProcedure :: (Ord c, Show c, CollectErrorsM m) =>
  CategoryMap c -> ExprMap c -> TestProcedure c -> m (CompiledData [String])
compileTestProcedure :: forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
CategoryMap c
-> ExprMap c -> TestProcedure c -> m (CompiledData [String])
compileTestProcedure CategoryMap c
tm ExprMap c
em (TestProcedure [c]
c FunctionName
n Bool
cov Procedure c
p) = do
  ProcedureContext c
ctx <- Bool -> CategoryMap c -> ExprMap c -> m (ProcedureContext c)
forall (m :: * -> *) c.
CollectErrorsM m =>
Bool -> CategoryMap c -> ExprMap c -> m (ProcedureContext c)
getMainContext Bool
True CategoryMap c
tm ExprMap c
em
  CompiledData [String]
p' <- CompilerState (ProcedureContext c) m ()
-> ProcedureContext c -> m (CompiledData [String])
forall c (m :: * -> *) s a b.
CompilerContext c m s a =>
CompilerState a m b -> a -> m (CompiledData s)
runDataCompiler CompilerState (ProcedureContext c) m ()
compiler ProcedureContext c
ctx m (CompiledData [String]) -> String -> m (CompiledData [String])
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<??
    String
"In unittest " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContextBrace [c]
c
  CompiledData [String] -> m (CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledData [String] -> m (CompiledData [String]))
-> CompiledData [String] -> m (CompiledData [String])
forall a b. (a -> b) -> a -> b
$ [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat [
      String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"ReturnTuple " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
testFunctionName FunctionName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"() {",
      CompiledData [String] -> CompiledData [String]
indentCompiled CompiledData [String]
handleCoverage,
      CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData [String] -> CompiledData [String])
-> CompiledData [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ FunctionName -> String
startTestTracing FunctionName
n,
      CompiledData [String] -> CompiledData [String]
indentCompiled CompiledData [String]
p',
      CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData [String] -> CompiledData [String])
-> CompiledData [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String -> CompiledData [String]
onlyCode (String -> CompiledData [String])
-> String -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ String
"return ReturnTuple();",
      String -> CompiledData [String]
onlyCode String
"}"
    ] where
    compiler :: CompilerState (ProcedureContext c) m ()
compiler = do
      ProcedureContext c
ctx0 <- CompilerState (ProcedureContext c) m (ProcedureContext c)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m a
getCleanContext
      ProcedureContext c
-> Procedure c
-> CompilerState (ProcedureContext c) m (ProcedureContext c)
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> Procedure c -> CompilerState a m a
compileProcedure ProcedureContext c
ctx0 Procedure c
p CompilerState (ProcedureContext c) m (ProcedureContext c)
-> (ProcedureContext c -> CompilerState (ProcedureContext c) m ())
-> CompilerState (ProcedureContext c) m ()
forall a b.
StateT (ProcedureContext c) m a
-> (a -> StateT (ProcedureContext c) m b)
-> StateT (ProcedureContext c) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcedureContext c -> CompilerState (ProcedureContext c) m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put
    handleCoverage :: CompiledData [String]
handleCoverage
      | Bool
cov       = String -> CompiledData [String]
onlyCode String
"LogCalls::DisableCallLogging();"
      | Bool
otherwise = CompiledData [String]
emptyCode

selectTestFromArgv1 :: CollectErrorsM m => [FunctionName] -> m ([String],CompiledData [String])
selectTestFromArgv1 :: forall (m :: * -> *).
CollectErrorsM m =>
[FunctionName] -> m ([String], CompiledData [String])
selectTestFromArgv1 [FunctionName]
fs = ([String], CompiledData [String])
-> m ([String], CompiledData [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
includes,CompiledData [String]
allCode) where
  allCode :: CompiledData [String]
allCode = [CompiledData [String]] -> CompiledData [String]
forall a. Monoid a => [a] -> a
mconcat [
      CompiledData [String]
initMap,
      CompiledData [String]
selectFromMap
    ]
  initMap :: CompiledData [String]
initMap = [String] -> CompiledData [String]
onlyCodes ([String] -> CompiledData [String])
-> [String] -> CompiledData [String]
forall a b. (a -> b) -> a -> b
$ [
      String
"const std::unordered_map<std::string, ReturnTuple(*)()> tests{"
    ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (FunctionName -> String) -> [FunctionName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> (FunctionName -> String) -> FunctionName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionName -> String
testEntry) [FunctionName]
fs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
      String
"};"
    ]
  selectFromMap :: CompiledData [String]
selectFromMap = [String] -> CompiledData [String]
onlyCodes [
      String
"if (argc < 2) FAIL() << argv[0] << \" [unittest name]\";",
      String
"const auto name = argv[1];",
      String
"const auto test = tests.find(name);",
      String
"if (test != tests.end()) {",
      String
"  (void) (*test->second)();",
      String
" } else {",
      String
"  FAIL() << argv[0] << \": unittest \" << name << \" does not exist\";",
      String
"}"
    ]
  testEntry :: FunctionName -> String
testEntry FunctionName
f = String
"{ \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\", &" String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
testFunctionName FunctionName
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" },"
  includes :: [String]
includes = [
      String
"#include <string>",
      String
"#include <unordered_map>"
    ]

autoScope :: CompilerContext c m s a =>
  SymbolScope -> CompilerState a m String
autoScope :: forall c (m :: * -> *) s a.
CompilerContext c m s a =>
SymbolScope -> CompilerState a m String
autoScope SymbolScope
s = do
  SymbolScope
s1 <- CompilerState a m SymbolScope
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m SymbolScope
csCurrentScope
  String -> CompilerState a m String
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> CompilerState a m String)
-> String -> CompilerState a m String
forall a b. (a -> b) -> a -> b
$ SymbolScope -> SymbolScope -> String
scoped SymbolScope
s1 SymbolScope
s
  where
    scoped :: SymbolScope -> SymbolScope -> String
scoped SymbolScope
ValueScope SymbolScope
TypeScope     = String
"parent->"
    scoped SymbolScope
ValueScope SymbolScope
CategoryScope = String
"parent->parent."
    scoped SymbolScope
TypeScope  SymbolScope
CategoryScope = String
"parent."
    -- NOTE: Don't use this->; otherwise, self won't work properly.
    scoped SymbolScope
_ SymbolScope
_ = String
""

categoriesFromTypes :: GeneralInstance -> Set.Set CategoryName
categoriesFromTypes :: GeneralInstance -> Set CategoryName
categoriesFromTypes = ([Set CategoryName] -> Set CategoryName)
-> ([Set CategoryName] -> Set CategoryName)
-> (T GeneralInstance -> Set CategoryName)
-> GeneralInstance
-> Set CategoryName
forall a b.
PreserveMerge a =>
([b] -> b) -> ([b] -> b) -> (T a -> b) -> a -> b
reduceMergeTree [Set CategoryName] -> Set CategoryName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set CategoryName] -> Set CategoryName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions T GeneralInstance -> Set CategoryName
TypeInstanceOrParam -> Set CategoryName
getAll where
  getAll :: TypeInstanceOrParam -> Set CategoryName
getAll (JustTypeInstance (TypeInstance CategoryName
t Positional GeneralInstance
ps)) =
    CategoryName
t CategoryName -> Set CategoryName -> Set CategoryName
forall a. Ord a => a -> Set a -> Set a
`Set.insert` ([Set CategoryName] -> Set CategoryName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set CategoryName] -> Set CategoryName)
-> [Set CategoryName] -> Set CategoryName
forall a b. (a -> b) -> a -> b
$ (GeneralInstance -> Set CategoryName)
-> [GeneralInstance] -> [Set CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map GeneralInstance -> Set CategoryName
categoriesFromTypes ([GeneralInstance] -> [Set CategoryName])
-> [GeneralInstance] -> [Set CategoryName]
forall a b. (a -> b) -> a -> b
$ Positional GeneralInstance -> [GeneralInstance]
forall a. Positional a -> [a]
pValues Positional GeneralInstance
ps)
  getAll TypeInstanceOrParam
_ = Set CategoryName
forall a. Set a
Set.empty

categoriesFromRefine :: TypeInstance -> Set.Set CategoryName
categoriesFromRefine :: TypeInstance -> Set CategoryName
categoriesFromRefine (TypeInstance CategoryName
t Positional GeneralInstance
ps) = CategoryName
t CategoryName -> Set CategoryName -> Set CategoryName
forall a. Ord a => a -> Set a -> Set a
`Set.insert` ([Set CategoryName] -> Set CategoryName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set CategoryName] -> Set CategoryName)
-> [Set CategoryName] -> Set CategoryName
forall a b. (a -> b) -> a -> b
$ (GeneralInstance -> Set CategoryName)
-> [GeneralInstance] -> [Set CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map GeneralInstance -> Set CategoryName
categoriesFromTypes ([GeneralInstance] -> [Set CategoryName])
-> [GeneralInstance] -> [Set CategoryName]
forall a b. (a -> b) -> a -> b
$ Positional GeneralInstance -> [GeneralInstance]
forall a. Positional a -> [a]
pValues Positional GeneralInstance
ps)

categoriesFromDefine :: DefinesInstance -> Set.Set CategoryName
categoriesFromDefine :: DefinesInstance -> Set CategoryName
categoriesFromDefine (DefinesInstance CategoryName
t Positional GeneralInstance
ps) = CategoryName
t CategoryName -> Set CategoryName -> Set CategoryName
forall a. Ord a => a -> Set a -> Set a
`Set.insert` ([Set CategoryName] -> Set CategoryName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set CategoryName] -> Set CategoryName)
-> [Set CategoryName] -> Set CategoryName
forall a b. (a -> b) -> a -> b
$ (GeneralInstance -> Set CategoryName)
-> [GeneralInstance] -> [Set CategoryName]
forall a b. (a -> b) -> [a] -> [b]
map GeneralInstance -> Set CategoryName
categoriesFromTypes ([GeneralInstance] -> [Set CategoryName])
-> [GeneralInstance] -> [Set CategoryName]
forall a b. (a -> b) -> a -> b
$ Positional GeneralInstance -> [GeneralInstance]
forall a. Positional a -> [a]
pValues Positional GeneralInstance
ps)

expandParams :: (CollectErrorsM m, CompilerContext c m s a) =>
  Positional GeneralInstance -> CompilerState a m String
expandParams :: forall (m :: * -> *) c s a.
(CollectErrorsM m, CompilerContext c m s a) =>
Positional GeneralInstance -> CompilerState a m String
expandParams Positional GeneralInstance
ps = do
  [String]
ps' <- [CompilerState a m String] -> StateT a m [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([CompilerState a m String] -> StateT a m [String])
-> [CompilerState a m String] -> StateT a m [String]
forall a b. (a -> b) -> a -> b
$ (GeneralInstance -> CompilerState a m String)
-> [GeneralInstance] -> [CompilerState a m String]
forall a b. (a -> b) -> [a] -> [b]
map GeneralInstance -> CompilerState a m String
forall (m :: * -> *) c s a.
(CollectErrorsM m, CompilerContext c m s a) =>
GeneralInstance -> CompilerState a m String
expandGeneralInstance ([GeneralInstance] -> [CompilerState a m String])
-> [GeneralInstance] -> [CompilerState a m String]
forall a b. (a -> b) -> a -> b
$ Positional GeneralInstance -> [GeneralInstance]
forall a. Positional a -> [a]
pValues Positional GeneralInstance
ps
  String -> CompilerState a m String
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> CompilerState a m String)
-> String -> CompilerState a m String
forall a b. (a -> b) -> a -> b
$ String
"T_get(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
ps' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

expandParams2 :: (CollectErrorsM m, CompilerContext c m s a) =>
  Positional GeneralInstance -> CompilerState a m [String]
expandParams2 :: forall (m :: * -> *) c s a.
(CollectErrorsM m, CompilerContext c m s a) =>
Positional GeneralInstance -> CompilerState a m [String]
expandParams2 Positional GeneralInstance
ps = [StateT a m String] -> StateT a m [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([StateT a m String] -> StateT a m [String])
-> [StateT a m String] -> StateT a m [String]
forall a b. (a -> b) -> a -> b
$ (GeneralInstance -> StateT a m String)
-> [GeneralInstance] -> [StateT a m String]
forall a b. (a -> b) -> [a] -> [b]
map GeneralInstance -> StateT a m String
forall (m :: * -> *) c s a.
(CollectErrorsM m, CompilerContext c m s a) =>
GeneralInstance -> CompilerState a m String
expandGeneralInstance ([GeneralInstance] -> [StateT a m String])
-> [GeneralInstance] -> [StateT a m String]
forall a b. (a -> b) -> a -> b
$ Positional GeneralInstance -> [GeneralInstance]
forall a. Positional a -> [a]
pValues Positional GeneralInstance
ps

expandCategory :: CompilerContext c m s a =>
  CategoryName -> CompilerState a m String
expandCategory :: forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CategoryName -> CompilerState a m String
expandCategory CategoryName
t = String -> StateT a m String
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> StateT a m String) -> String -> StateT a m String
forall a b. (a -> b) -> a -> b
$ CategoryName -> String
categoryGetter CategoryName
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"()"

expandGeneralInstance :: (CollectErrorsM m, CompilerContext c m s a) =>
  GeneralInstance -> CompilerState a m String
expandGeneralInstance :: forall (m :: * -> *) c s a.
(CollectErrorsM m, CompilerContext c m s a) =>
GeneralInstance -> CompilerState a m String
expandGeneralInstance GeneralInstance
t = do
  AnyTypeResolver
r <- CompilerState a m AnyTypeResolver
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m AnyTypeResolver
csResolver
  ParamFilters
f <- CompilerState a m ParamFilters
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m ParamFilters
csAllFilters
  SymbolScope
scope <- CompilerState a m SymbolScope
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m SymbolScope
csCurrentScope
  GeneralInstance
t' <- m GeneralInstance -> StateT a m GeneralInstance
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m GeneralInstance -> StateT a m GeneralInstance)
-> m GeneralInstance -> StateT a m GeneralInstance
forall a b. (a -> b) -> a -> b
$ AnyTypeResolver
-> ParamFilters -> GeneralInstance -> m GeneralInstance
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> ParamFilters -> GeneralInstance -> m GeneralInstance
dedupGeneralInstance AnyTypeResolver
r ParamFilters
f GeneralInstance
t
  GeneralInstance
t'' <-  case SymbolScope
scope of
               SymbolScope
CategoryScope -> GeneralInstance -> StateT a m GeneralInstance
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return GeneralInstance
t'
               SymbolScope
_ -> do
                 TypeInstance
self <- CompilerState a m TypeInstance
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m TypeInstance
csSelfType
                 m GeneralInstance -> StateT a m GeneralInstance
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m GeneralInstance -> StateT a m GeneralInstance)
-> m GeneralInstance -> StateT a m GeneralInstance
forall a b. (a -> b) -> a -> b
$ TypeInstance -> GeneralInstance -> m GeneralInstance
forall (m :: * -> *).
CollectErrorsM m =>
TypeInstance -> GeneralInstance -> m GeneralInstance
reverseSelfInstance TypeInstance
self GeneralInstance
t'
  GeneralInstance -> CompilerState a m String
forall {m :: * -> *} {c} {s} {a}.
CompilerContext c m s a =>
GeneralInstance -> StateT a m String
expand GeneralInstance
t'' where
    expand :: GeneralInstance -> StateT a m String
expand GeneralInstance
t2
      | GeneralInstance
t2 GeneralInstance -> GeneralInstance -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralInstance
forall a. Bounded a => a
minBound = String -> StateT a m String
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> StateT a m String) -> String -> StateT a m String
forall a b. (a -> b) -> a -> b
$ String
allGetter String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"()"
      | GeneralInstance
t2 GeneralInstance -> GeneralInstance -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralInstance
forall a. Bounded a => a
maxBound = String -> StateT a m String
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> StateT a m String) -> String -> StateT a m String
forall a b. (a -> b) -> a -> b
$ String
anyGetter String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"()"
      | Bool
otherwise = ([StateT a m String] -> StateT a m String)
-> ([StateT a m String] -> StateT a m String)
-> (T GeneralInstance -> StateT a m String)
-> GeneralInstance
-> StateT a m String
forall a b.
PreserveMerge a =>
([b] -> b) -> ([b] -> b) -> (T a -> b) -> a -> b
reduceMergeTree [StateT a m String] -> StateT a m String
forall {m :: * -> *}. Monad m => [m String] -> m String
getAny [StateT a m String] -> StateT a m String
forall {m :: * -> *}. Monad m => [m String] -> m String
getAll T GeneralInstance -> StateT a m String
TypeInstanceOrParam -> StateT a m String
getSingle GeneralInstance
t2
    getAny :: [m String] -> m String
getAny [m String]
ts = [m String] -> m String
forall {m :: * -> *}. Monad m => [m String] -> m String
combine [m String]
ts m String -> (String -> m String) -> m String
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> (String -> String) -> String -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
unionGetter String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    getAll :: [m String] -> m String
getAll [m String]
ts = [m String] -> m String
forall {m :: * -> *}. Monad m => [m String] -> m String
combine [m String]
ts m String -> (String -> m String) -> m String
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> (String -> String) -> String -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
intersectGetter String -> String -> String
forall a. [a] -> [a] -> [a]
++)
    getSingle :: TypeInstanceOrParam -> StateT a m String
getSingle (JustTypeInstance (TypeInstance CategoryName
t2 Positional GeneralInstance
ps)) = do
      [String]
ps' <- [StateT a m String] -> StateT a m [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([StateT a m String] -> StateT a m [String])
-> [StateT a m String] -> StateT a m [String]
forall a b. (a -> b) -> a -> b
$ (GeneralInstance -> StateT a m String)
-> [GeneralInstance] -> [StateT a m String]
forall a b. (a -> b) -> [a] -> [b]
map GeneralInstance -> StateT a m String
expand ([GeneralInstance] -> [StateT a m String])
-> [GeneralInstance] -> [StateT a m String]
forall a b. (a -> b) -> a -> b
$ Positional GeneralInstance -> [GeneralInstance]
forall a. Positional a -> [a]
pValues Positional GeneralInstance
ps
      let count :: Int
count = [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ps'
      String -> StateT a m String
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> StateT a m String) -> String -> StateT a m String
forall a b. (a -> b) -> a -> b
$ CategoryName -> String
typeGetter CategoryName
t2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(Params<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">::Type(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
ps' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))"
    getSingle (JustParamName Bool
_ ParamName
ParamSelf) = String -> StateT a m String
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"S<const TypeInstance>(PARAM_SELF)"
    getSingle (JustParamName Bool
_ ParamName
p)  = do
      SymbolScope
s <- ParamName -> CompilerState a m SymbolScope
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
ParamName -> CompilerState a m SymbolScope
csGetParamScope ParamName
p
      String
scoped <- SymbolScope -> StateT a m String
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
SymbolScope -> CompilerState a m String
autoScope SymbolScope
s
      String -> StateT a m String
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> StateT a m String) -> String -> StateT a m String
forall a b. (a -> b) -> a -> b
$ String
scoped String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParamName -> String
paramName ParamName
p
    getSingle (JustInferredType ParamName
p) = TypeInstanceOrParam -> StateT a m String
getSingle (Bool -> ParamName -> TypeInstanceOrParam
JustParamName Bool
False ParamName
p)
    combine :: [m String] -> m String
combine [m String]
ps = do
      [String]
ps' <- [m String] -> m [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [m String]
ps
      String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
"(L_get<S<const " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typeBase String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">>(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
ps' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))"

doImplicitReturn :: (CollectErrorsM m, Ord c, Show c, CompilerContext c m [String] a) =>
  [c] -> CompilerState a m ()
doImplicitReturn :: forall (m :: * -> *) c a.
(CollectErrorsM m, Ord c, Show c,
 CompilerContext c m [String] a) =>
[c] -> CompilerState a m ()
doImplicitReturn [c]
c = do
  Bool
named <- CompilerState a m Bool
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m Bool
csIsNamedReturns
  [c] -> Maybe ExpressionType -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c] -> Maybe ExpressionType -> CompilerState a m ()
csRegisterReturn [c]
c Maybe ExpressionType
forall a. Maybe a
Nothing
  StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m a -> (a -> CompilerState a m ()) -> CompilerState a m ()
forall a b. StateT a m a -> (a -> StateT a m b) -> StateT a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [c] -> JumpType -> a -> CompilerState a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
[c] -> JumpType -> a -> CompilerState a m ()
autoInsertCleanup [c]
c JumpType
JumpReturn
  if Bool -> Bool
not Bool
named
     then [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"return ReturnTuple();"]
     else do
       CompilerState a m ()
forall (m :: * -> *) c a.
(CollectErrorsM m, CompilerContext c m [String] a) =>
CompilerState a m ()
getPrimNamedReturns
       [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"return returns;"]
  where

autoPositionalCleanup :: (Ord c,Eq c,Show c,CollectErrorsM m, CompilerContext c m [String] a) =>
  [c] -> ExpressionValue -> CompilerState a m ()
autoPositionalCleanup :: forall c (m :: * -> *) a.
(Ord c, Eq c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
[c] -> ExpressionValue -> CompilerState a m ()
autoPositionalCleanup [c]
c ExpressionValue
e = do
  Bool
named <- CompilerState a m Bool
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m Bool
csIsNamedReturns
  (CleanupBlock [String]
ss DeferVariable c
_ [UsedVariable c]
_ JumpType
_ Set CategoryName
_) <- JumpType -> CompilerState a m (CleanupBlock c [String])
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
JumpType -> CompilerState a m (CleanupBlock c s)
csGetCleanup JumpType
JumpReturn
  if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ss
     then do
       [c] -> JumpType -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c] -> JumpType -> CompilerState a m ()
csSetJumpType [c]
c JumpType
JumpReturn
       [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"return " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpressionValue -> String
useAsReturns ExpressionValue
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"]
     else do
       if Bool
named
          then do
            [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"returns.TransposeFrom(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpressionValue -> String
useAsReturns ExpressionValue
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");"]
            CompilerState a m ()
forall (m :: * -> *) c a.
(CollectErrorsM m, CompilerContext c m [String] a) =>
CompilerState a m ()
setPrimNamedReturns
            StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m a -> (a -> CompilerState a m ()) -> CompilerState a m ()
forall a b. StateT a m a -> (a -> StateT a m b) -> StateT a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [c] -> JumpType -> a -> CompilerState a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
[c] -> JumpType -> a -> CompilerState a m ()
autoInsertCleanup [c]
c JumpType
JumpReturn
            [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"return returns;"]
          else do
            [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"{",String
"ReturnTuple returns = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpressionValue -> String
useAsReturns ExpressionValue
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"]
            StateT a m a
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT a m a -> (a -> CompilerState a m ()) -> CompilerState a m ()
forall a b. StateT a m a -> (a -> StateT a m b) -> StateT a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [c] -> JumpType -> a -> CompilerState a m ()
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
[c] -> JumpType -> a -> CompilerState a m ()
autoInsertCleanup [c]
c JumpType
JumpReturn
            [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String
"return returns;",String
"}"]

setPrimNamedReturns ::  (CollectErrorsM m, CompilerContext c m [String] a) =>
  CompilerState a m ()
setPrimNamedReturns :: forall (m :: * -> *) c a.
(CollectErrorsM m, CompilerContext c m [String] a) =>
CompilerState a m ()
setPrimNamedReturns = do
  [ReturnVariable]
vars <- CompilerState a m [ReturnVariable]
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m [ReturnVariable]
csPrimNamedReturns
  [CompilerState a m ()] -> CompilerState a m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([CompilerState a m ()] -> CompilerState a m ())
-> [CompilerState a m ()] -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ (ReturnVariable -> CompilerState a m ())
-> [ReturnVariable] -> [CompilerState a m ()]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite ([String] -> CompilerState a m ())
-> (ReturnVariable -> [String])
-> ReturnVariable
-> CompilerState a m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (String -> [String])
-> (ReturnVariable -> String) -> ReturnVariable -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReturnVariable -> String
assign) [ReturnVariable]
vars where
    assign :: ReturnVariable -> String
assign (ReturnVariable Int
i VariableName
n ValueType
t) =
      VariableName -> String
variableName VariableName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueType -> ExpressionValue -> String
writeStoredVariable ValueType
t (Int -> ExpressionValue
forall {a}. Show a => a -> ExpressionValue
position Int
i) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
    position :: a -> ExpressionValue
position a
i = String -> ExpressionValue
WrappedSingle (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ String
"returns.At(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

getPrimNamedReturns ::  (CollectErrorsM m, CompilerContext c m [String] a) =>
  CompilerState a m ()
getPrimNamedReturns :: forall (m :: * -> *) c a.
(CollectErrorsM m, CompilerContext c m [String] a) =>
CompilerState a m ()
getPrimNamedReturns = do
  [ReturnVariable]
vars <- CompilerState a m [ReturnVariable]
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
CompilerState a m [ReturnVariable]
csPrimNamedReturns
  [CompilerState a m ()] -> CompilerState a m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([CompilerState a m ()] -> CompilerState a m ())
-> [CompilerState a m ()] -> CompilerState a m ()
forall a b. (a -> b) -> a -> b
$ (ReturnVariable -> CompilerState a m ())
-> [ReturnVariable] -> [CompilerState a m ()]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite ([String] -> CompilerState a m ())
-> (ReturnVariable -> [String])
-> ReturnVariable
-> CompilerState a m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (String -> [String])
-> (ReturnVariable -> String) -> ReturnVariable -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReturnVariable -> String
assign) [ReturnVariable]
vars where
    assign :: ReturnVariable -> String
assign (ReturnVariable Int
i VariableName
n ValueType
t) =
      String
"returns.At(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpressionValue -> String
useAsUnwrapped (Bool -> ValueType -> String -> ExpressionValue
readStoredVariable Bool
False ValueType
t (String -> ExpressionValue) -> String -> ExpressionValue
forall a b. (a -> b) -> a -> b
$ VariableName -> String
variableName VariableName
n) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"

autoInsertCleanup :: (Ord c, Show c, CollectErrorsM m, CompilerContext c m [String] a) =>
  [c] -> JumpType -> a -> CompilerState a m ()
autoInsertCleanup :: forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
[c] -> JumpType -> a -> CompilerState a m ()
autoInsertCleanup [c]
c JumpType
j a
ctx = do
  (CleanupBlock [String]
ss DeferVariable c
ds [UsedVariable c]
vs JumpType
jump Set CategoryName
req) <- m (CleanupBlock c [String]) -> StateT a m (CleanupBlock c [String])
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (CleanupBlock c [String])
 -> StateT a m (CleanupBlock c [String]))
-> m (CleanupBlock c [String])
-> StateT a m (CleanupBlock c [String])
forall a b. (a -> b) -> a -> b
$ a -> JumpType -> m (CleanupBlock c [String])
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> JumpType -> m (CleanupBlock c s)
ccGetCleanup a
ctx JumpType
j
  [UsedVariable c] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[UsedVariable c] -> CompilerState a m ()
csCheckVariableInit ([UsedVariable c] -> [UsedVariable c]
forall a. Eq a => [a] -> [a]
nub [UsedVariable c]
vs) CompilerState a m () -> String -> CompilerState a m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<??
    String
"In inlining of cleanup block after statement at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [c] -> String
forall a. Show a => [a] -> String
formatFullContext [c]
c
  let vs2 :: [UsedVariable c]
vs2 = (UsedVariable c -> UsedVariable c)
-> [UsedVariable c] -> [UsedVariable c]
forall a b. (a -> b) -> [a] -> [b]
map (\(UsedVariable [c]
c0 VariableName
v) -> [c] -> VariableName -> UsedVariable c
forall c. [c] -> VariableName -> UsedVariable c
UsedVariable ([c]
c [c] -> [c] -> [c]
forall a. [a] -> [a] -> [a]
++ [c]
c0) VariableName
v) [UsedVariable c]
vs
  DeferVariable c -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
DeferVariable c -> CompilerState a m ()
csInheritDeferred DeferVariable c
ds
  -- This is needed in case a cleanup is inlined within another cleanup, e.g.,
  -- e.g., if the latter has a break statement.
  (UsedVariable c -> CompilerState a m ())
-> [UsedVariable c] -> CompilerState a m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ UsedVariable c -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
UsedVariable c -> CompilerState a m ()
csAddUsed [UsedVariable c]
vs2
  [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite [String]
ss
  Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired Set CategoryName
req
  [c] -> JumpType -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[c] -> JumpType -> CompilerState a m ()
csSetJumpType [c]
c JumpType
jump

inheritRequired :: (CollectErrorsM m, CompilerContext c m [String] a) =>
  a -> CompilerState a m ()
inheritRequired :: forall (m :: * -> *) c a.
(CollectErrorsM m, CompilerContext c m [String] a) =>
a -> CompilerState a m ()
inheritRequired a
ctx = do
  m (Set CategoryName) -> StateT a m (Set CategoryName)
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (a -> m (Set CategoryName)
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> m (Set CategoryName)
ccGetRequired a
ctx) StateT a m (Set CategoryName)
-> (Set CategoryName -> CompilerState a m ())
-> CompilerState a m ()
forall a b. StateT a m a -> (a -> StateT a m b) -> StateT a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Set CategoryName -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
Set CategoryName -> CompilerState a m ()
csAddRequired
  m [String] -> StateT a m [String]
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (a -> m [String]
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
a -> m [String]
ccGetTraces a
ctx) StateT a m [String]
-> ([String] -> StateT a m [()]) -> StateT a m [()]
forall a b. StateT a m a -> (a -> StateT a m b) -> StateT a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [CompilerState a m ()] -> StateT a m [()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([CompilerState a m ()] -> StateT a m [()])
-> ([String] -> [CompilerState a m ()])
-> [String]
-> StateT a m [()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> CompilerState a m ())
-> [String] -> [CompilerState a m ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
String -> CompilerState a m ()
csAddTrace StateT a m [()] -> CompilerState a m () -> CompilerState a m ()
forall a b. StateT a m a -> StateT a m b -> StateT a m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> CompilerState a m ()
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

autoInlineOutput :: (Ord c, Show c, CollectErrorsM m, CompilerContext c m [String] a) =>
  a -> CompilerState a m ()
autoInlineOutput :: forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> CompilerState a m ()
autoInlineOutput a
ctx = do
  a -> CompilerState a m ()
forall (m :: * -> *) c a.
(CollectErrorsM m, CompilerContext c m [String] a) =>
a -> CompilerState a m ()
inheritRequired a
ctx
  a -> CompilerState a m [String]
forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> CompilerState a m [String]
getAndIndentOutput a
ctx CompilerState a m [String]
-> ([String] -> CompilerState a m ()) -> CompilerState a m ()
forall a b. StateT a m a -> (a -> StateT a m b) -> StateT a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
s -> CompilerState a m ()
csWrite
  [a] -> CompilerState a m ()
forall c (m :: * -> *) s a.
CompilerContext c m s a =>
[a] -> CompilerState a m ()
csInheritStatic [a
ctx]

getAndIndentOutput :: (Ord c, Show c, CollectErrorsM m, CompilerContext c m [String] a) =>
  a -> CompilerState a m [String]
getAndIndentOutput :: forall c (m :: * -> *) a.
(Ord c, Show c, CollectErrorsM m,
 CompilerContext c m [String] a) =>
a -> CompilerState a m [String]
getAndIndentOutput a
ctx = ([String] -> [String])
-> StateT a m [String] -> StateT a m [String]
forall a b. (a -> b) -> StateT a m a -> StateT a m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> [String]
indentCode (m [String] -> StateT a m [String]
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [String] -> StateT a m [String])
-> m [String] -> StateT a m [String]
forall a b. (a -> b) -> a -> b
$ a -> m [String]
forall c (m :: * -> *) s a. CompilerContext c m s a => a -> m s
ccGetOutput a
ctx)

indentCode :: [String] -> [String]
indentCode :: [String] -> [String]
indentCode = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++)