{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | This module implements the Scope Binding pass.
--
-- This pass traverses the AST and replaces all variable names (Text) with
-- unique identifiers (ScopedId). This eliminates any ambiguity from name
-- shadowing and is a prerequisite for a correct and precise points-to analysis.
module Tokstyle.Analysis.Scope
    ( ScopedId(..)
    , ScopeState(..)
    , runScopePass
    , initialScopeState
    , dummyScopedId
    ) where

import           Control.Monad              (forM, msum, when)
import           Control.Monad.State.Strict (State, get, gets, modify, put,
                                             runState)
import           Data.Fix                   (Fix (..), unFix)
import           Data.List                  (permutations)
import           Data.Map.Strict            (Map)
import qualified Data.Map.Strict            as Map
import           Data.Maybe                 (fromMaybe)
import           Data.Text                  (Text)
import qualified Data.Text                  as Text
import           Debug.Trace                (trace)
import qualified Language.Cimple            as C
import           Language.Cimple.Pretty     (showNodePlain)
import           Prettyprinter              (Pretty (..), (<>))
import           Text.Groom                 (groom)

debugging :: Bool
debugging :: Bool
debugging = Bool
False

dtrace :: String -> a -> a
dtrace :: String -> a -> a
dtrace String
msg a
x = if Bool
debugging then String -> a -> a
forall a. String -> a -> a
trace String
msg a
x else a
x

-- | A unique identifier for a variable, including its original name and scope info.
data ScopedId = ScopedId
    { ScopedId -> Int
sidUniqueId :: Int    -- ^ The globally unique ID.
    , ScopedId -> Text
sidName     :: Text   -- ^ The original name, for debugging.
    , ScopedId -> Scope
sidScope    :: C.Scope -- ^ The scope it was defined in (Global or Static).
    } deriving (Int -> ScopedId -> ShowS
[ScopedId] -> ShowS
ScopedId -> String
(Int -> ScopedId -> ShowS)
-> (ScopedId -> String) -> ([ScopedId] -> ShowS) -> Show ScopedId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScopedId] -> ShowS
$cshowList :: [ScopedId] -> ShowS
show :: ScopedId -> String
$cshow :: ScopedId -> String
showsPrec :: Int -> ScopedId -> ShowS
$cshowsPrec :: Int -> ScopedId -> ShowS
Show, ScopedId -> ScopedId -> Bool
(ScopedId -> ScopedId -> Bool)
-> (ScopedId -> ScopedId -> Bool) -> Eq ScopedId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScopedId -> ScopedId -> Bool
$c/= :: ScopedId -> ScopedId -> Bool
== :: ScopedId -> ScopedId -> Bool
$c== :: ScopedId -> ScopedId -> Bool
Eq, Eq ScopedId
Eq ScopedId
-> (ScopedId -> ScopedId -> Ordering)
-> (ScopedId -> ScopedId -> Bool)
-> (ScopedId -> ScopedId -> Bool)
-> (ScopedId -> ScopedId -> Bool)
-> (ScopedId -> ScopedId -> Bool)
-> (ScopedId -> ScopedId -> ScopedId)
-> (ScopedId -> ScopedId -> ScopedId)
-> Ord ScopedId
ScopedId -> ScopedId -> Bool
ScopedId -> ScopedId -> Ordering
ScopedId -> ScopedId -> ScopedId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ScopedId -> ScopedId -> ScopedId
$cmin :: ScopedId -> ScopedId -> ScopedId
max :: ScopedId -> ScopedId -> ScopedId
$cmax :: ScopedId -> ScopedId -> ScopedId
>= :: ScopedId -> ScopedId -> Bool
$c>= :: ScopedId -> ScopedId -> Bool
> :: ScopedId -> ScopedId -> Bool
$c> :: ScopedId -> ScopedId -> Bool
<= :: ScopedId -> ScopedId -> Bool
$c<= :: ScopedId -> ScopedId -> Bool
< :: ScopedId -> ScopedId -> Bool
$c< :: ScopedId -> ScopedId -> Bool
compare :: ScopedId -> ScopedId -> Ordering
$ccompare :: ScopedId -> ScopedId -> Ordering
$cp1Ord :: Eq ScopedId
Ord)

instance Pretty ScopedId where
    pretty :: ScopedId -> Doc ann
pretty ScopedId
sid | ScopedId -> Int
sidUniqueId ScopedId
sid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ScopedId -> Text
sidName ScopedId
sid)
               | Bool
otherwise            = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ScopedId -> Text
sidName ScopedId
sid) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"_" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ScopedId -> Int
sidUniqueId ScopedId
sid)


-- | A stack of symbol tables, one for each scope.
type SymbolTable = [Map Text ScopedId]

-- | The state for the scope analysis traversal.
data ScopeState = ScopeState
    { ScopeState -> SymbolTable
ssTable        :: SymbolTable -- ^ The stack of symbol tables.
    , ScopeState -> Int
ssNextId       :: Int         -- ^ The next available unique ID.
    , ScopeState -> Scope
ssCurrentScope :: C.Scope     -- ^ The scope of the current function.
    , ScopeState -> [String]
ssErrors       :: [String]    -- ^ A list of errors encountered.
    } deriving (Int -> ScopeState -> ShowS
[ScopeState] -> ShowS
ScopeState -> String
(Int -> ScopeState -> ShowS)
-> (ScopeState -> String)
-> ([ScopeState] -> ShowS)
-> Show ScopeState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScopeState] -> ShowS
$cshowList :: [ScopeState] -> ShowS
show :: ScopeState -> String
$cshow :: ScopeState -> String
showsPrec :: Int -> ScopeState -> ShowS
$cshowsPrec :: Int -> ScopeState -> ShowS
Show)

-- | The initial state for the scope analysis.
initialScopeState :: ScopeState
initialScopeState :: ScopeState
initialScopeState = SymbolTable -> Int -> Scope -> [String] -> ScopeState
ScopeState [Map Text ScopedId
forall k a. Map k a
Map.empty] Int
1 Scope
C.Global []

-- | Runs the scope binding pass on a list of translation units.
runScopePass :: [C.Node (C.Lexeme Text)] -> ([C.Node (C.Lexeme ScopedId)], ScopeState)
runScopePass :: [Node (Lexeme Text)] -> ([Node (Lexeme ScopedId)], ScopeState)
runScopePass [Node (Lexeme Text)]
tu = State ScopeState [Node (Lexeme ScopedId)]
-> ScopeState -> ([Node (Lexeme ScopedId)], ScopeState)
forall s a. State s a -> s -> (a, s)
runState ([Node (Lexeme Text)] -> State ScopeState [Node (Lexeme ScopedId)]
transformToplevels [Node (Lexeme Text)]
tu) ScopeState
initialScopeState

-- | Helper to push a new scope onto the symbol table stack.
pushScope :: State ScopeState ()
pushScope :: State ScopeState ()
pushScope = do
    ScopeState
st <- StateT ScopeState Identity ScopeState
forall s (m :: * -> *). MonadState s m => m s
get
    let newSt :: ScopeState
newSt = ScopeState
st { ssTable :: SymbolTable
ssTable = Map Text ScopedId
forall k a. Map k a
Map.empty Map Text ScopedId -> SymbolTable -> SymbolTable
forall a. a -> [a] -> [a]
: ScopeState -> SymbolTable
ssTable ScopeState
st }
    String -> State ScopeState () -> State ScopeState ()
forall a. String -> a -> a
dtrace (String
"pushScope: new depth = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (SymbolTable -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ScopeState -> SymbolTable
ssTable ScopeState
newSt))) (State ScopeState () -> State ScopeState ())
-> State ScopeState () -> State ScopeState ()
forall a b. (a -> b) -> a -> b
$ ScopeState -> State ScopeState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ScopeState
newSt

-- | Helper to pop a scope from the symbol table stack.
popScope :: State ScopeState ()
popScope :: State ScopeState ()
popScope = do
    ScopeState
st <- StateT ScopeState Identity ScopeState
forall s (m :: * -> *). MonadState s m => m s
get
    let newSt :: ScopeState
newSt = ScopeState
st { ssTable :: SymbolTable
ssTable = SymbolTable -> SymbolTable
forall a. [a] -> [a]
tail (ScopeState -> SymbolTable
ssTable ScopeState
st) }
    String -> State ScopeState () -> State ScopeState ()
forall a. String -> a -> a
dtrace (String
"popScope: new depth = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (SymbolTable -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ScopeState -> SymbolTable
ssTable ScopeState
newSt))) (State ScopeState () -> State ScopeState ())
-> State ScopeState () -> State ScopeState ()
forall a b. (a -> b) -> a -> b
$ ScopeState -> State ScopeState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ScopeState
newSt

-- | Adds a new variable to the current scope.
addVarToScope :: C.Scope -> Text -> State ScopeState ScopedId
addVarToScope :: Scope -> Text -> State ScopeState ScopedId
addVarToScope Scope
scope Text
name = do
    ScopeState
st <- StateT ScopeState Identity ScopeState
forall s (m :: * -> *). MonadState s m => m s
get
    let newId :: Int
newId = ScopeState -> Int
ssNextId ScopeState
st
    let scopedId :: ScopedId
scopedId = Int -> Text -> Scope -> ScopedId
ScopedId Int
newId Text
name Scope
scope
    let newTable :: SymbolTable
newTable = case ScopeState -> SymbolTable
ssTable ScopeState
st of
            []             -> String -> SymbolTable
forall a. HasCallStack => String -> a
error String
"Symbol table stack is empty"
            (Map Text ScopedId
current:SymbolTable
rest) -> Text -> ScopedId -> Map Text ScopedId -> Map Text ScopedId
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
name ScopedId
scopedId Map Text ScopedId
current Map Text ScopedId -> SymbolTable -> SymbolTable
forall a. a -> [a] -> [a]
: SymbolTable
rest
    String -> State ScopeState () -> State ScopeState ()
forall a. String -> a -> a
dtrace (String
"addVarToScope: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
groom Text
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ScopedId -> String
forall a. Show a => a -> String
groom ScopedId
scopedId String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in scope " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Scope -> String
forall a. Show a => a -> String
show Scope
scope String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n  TABLE_BEFORE: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SymbolTable -> String
forall a. Show a => a -> String
groom (ScopeState -> SymbolTable
ssTable ScopeState
st) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n  TABLE_AFTER: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SymbolTable -> String
forall a. Show a => a -> String
groom SymbolTable
newTable) (State ScopeState () -> State ScopeState ())
-> State ScopeState () -> State ScopeState ()
forall a b. (a -> b) -> a -> b
$
        ScopeState -> State ScopeState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ScopeState -> State ScopeState ())
-> ScopeState -> State ScopeState ()
forall a b. (a -> b) -> a -> b
$ ScopeState
st { ssTable :: SymbolTable
ssTable = SymbolTable
newTable, ssNextId :: Int
ssNextId = Int
newId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
    ScopedId -> State ScopeState ScopedId
forall (m :: * -> *) a. Monad m => a -> m a
return ScopedId
scopedId

-- | Adds a variable to the global scope (the last element in the symbol table stack)
addVarToGlobalScope :: C.Scope -> Text -> State ScopeState ScopedId
addVarToGlobalScope :: Scope -> Text -> State ScopeState ScopedId
addVarToGlobalScope Scope
scope Text
name = do
    ScopeState
st <- StateT ScopeState Identity ScopeState
forall s (m :: * -> *). MonadState s m => m s
get
    let newId :: Int
newId = ScopeState -> Int
ssNextId ScopeState
st
    let scopedId :: ScopedId
scopedId = Int -> Text -> Scope -> ScopedId
ScopedId Int
newId Text
name Scope
scope
    let (Map Text ScopedId
globals:SymbolTable
locals) = SymbolTable -> SymbolTable
forall a. [a] -> [a]
reverse (ScopeState -> SymbolTable
ssTable ScopeState
st)
    let newGlobals :: Map Text ScopedId
newGlobals = Text -> ScopedId -> Map Text ScopedId -> Map Text ScopedId
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
name ScopedId
scopedId Map Text ScopedId
globals
    let newTable :: SymbolTable
newTable = SymbolTable -> SymbolTable
forall a. [a] -> [a]
reverse (Map Text ScopedId
newGlobalsMap Text ScopedId -> SymbolTable -> SymbolTable
forall a. a -> [a] -> [a]
:SymbolTable
locals)
    String -> State ScopeState () -> State ScopeState ()
forall a. String -> a -> a
dtrace (String
"addVarToGlobalScope: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
groom Text
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ScopedId -> String
forall a. Show a => a -> String
groom ScopedId
scopedId String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n  TABLE_BEFORE: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SymbolTable -> String
forall a. Show a => a -> String
groom (ScopeState -> SymbolTable
ssTable ScopeState
st) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n  TABLE_AFTER: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SymbolTable -> String
forall a. Show a => a -> String
groom SymbolTable
newTable) (State ScopeState () -> State ScopeState ())
-> State ScopeState () -> State ScopeState ()
forall a b. (a -> b) -> a -> b
$
        ScopeState -> State ScopeState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ScopeState -> State ScopeState ())
-> ScopeState -> State ScopeState ()
forall a b. (a -> b) -> a -> b
$ ScopeState
st { ssTable :: SymbolTable
ssTable = SymbolTable
newTable, ssNextId :: Int
ssNextId = Int
newId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
    ScopedId -> State ScopeState ScopedId
forall (m :: * -> *) a. Monad m => a -> m a
return ScopedId
scopedId

-- | Looks up a variable only in the global scope
lookupVarInGlobalScope :: Text -> State ScopeState (Maybe ScopedId)
lookupVarInGlobalScope :: Text -> State ScopeState (Maybe ScopedId)
lookupVarInGlobalScope Text
name = do
    ScopeState
st <- StateT ScopeState Identity ScopeState
forall s (m :: * -> *). MonadState s m => m s
get
    let result :: Maybe ScopedId
result = Text -> Map Text ScopedId -> Maybe ScopedId
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name (SymbolTable -> Map Text ScopedId
forall a. [a] -> a
last (ScopeState -> SymbolTable
ssTable ScopeState
st))
    String
-> State ScopeState (Maybe ScopedId)
-> State ScopeState (Maybe ScopedId)
forall a. String -> a -> a
dtrace (String
"lookupVarInGlobalScope: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
groom Text
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe ScopedId -> String
forall a. Show a => a -> String
groom Maybe ScopedId
result) (State ScopeState (Maybe ScopedId)
 -> State ScopeState (Maybe ScopedId))
-> State ScopeState (Maybe ScopedId)
-> State ScopeState (Maybe ScopedId)
forall a b. (a -> b) -> a -> b
$ Maybe ScopedId -> State ScopeState (Maybe ScopedId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ScopedId
result

-- | Finds an existing ScopedId for a toplevel name or creates a new one.
findOrCreateToplevelId :: C.Scope -> Text -> State ScopeState ScopedId
findOrCreateToplevelId :: Scope -> Text -> State ScopeState ScopedId
findOrCreateToplevelId Scope
scope Text
name = do
    String -> State ScopeState ScopedId -> State ScopeState ScopedId
forall a. String -> a -> a
dtrace (String
"findOrCreateToplevelId: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
groom Text
name) (State ScopeState ScopedId -> State ScopeState ScopedId)
-> State ScopeState ScopedId -> State ScopeState ScopedId
forall a b. (a -> b) -> a -> b
$ do
        Maybe ScopedId
mSid <- Text -> State ScopeState (Maybe ScopedId)
lookupVarInGlobalScope Text
name
        case Maybe ScopedId
mSid of
            Just ScopedId
sid -> String -> State ScopeState ScopedId -> State ScopeState ScopedId
forall a. String -> a -> a
dtrace (String
"  found existing: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ScopedId -> String
forall a. Show a => a -> String
groom ScopedId
sid) (State ScopeState ScopedId -> State ScopeState ScopedId)
-> State ScopeState ScopedId -> State ScopeState ScopedId
forall a b. (a -> b) -> a -> b
$ ScopedId -> State ScopeState ScopedId
forall (m :: * -> *) a. Monad m => a -> m a
return ScopedId
sid
            Maybe ScopedId
Nothing  -> String -> State ScopeState ScopedId -> State ScopeState ScopedId
forall a. String -> a -> a
dtrace String
"  not found, creating new." (State ScopeState ScopedId -> State ScopeState ScopedId)
-> State ScopeState ScopedId -> State ScopeState ScopedId
forall a b. (a -> b) -> a -> b
$ Scope -> Text -> State ScopeState ScopedId
addVarToGlobalScope Scope
scope Text
name

-- | Looks up a variable in the symbol table stack.
lookupVar :: Text -> State ScopeState ScopedId
lookupVar :: Text -> State ScopeState ScopedId
lookupVar Text
name = do
    ScopeState
st <- StateT ScopeState Identity ScopeState
forall s (m :: * -> *). MonadState s m => m s
get
    let result :: Maybe ScopedId
result = [Maybe ScopedId] -> Maybe ScopedId
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe ScopedId] -> Maybe ScopedId)
-> [Maybe ScopedId] -> Maybe ScopedId
forall a b. (a -> b) -> a -> b
$ (Map Text ScopedId -> Maybe ScopedId)
-> SymbolTable -> [Maybe ScopedId]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Map Text ScopedId -> Maybe ScopedId
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name) (ScopeState -> SymbolTable
ssTable ScopeState
st)
    String -> State ScopeState ScopedId -> State ScopeState ScopedId
forall a. String -> a -> a
dtrace (String
"lookupVar: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
groom Text
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in table " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SymbolTable -> String
forall a. Show a => a -> String
groom (ScopeState -> SymbolTable
ssTable ScopeState
st) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe ScopedId -> String
forall a. Show a => a -> String
groom Maybe ScopedId
result) (State ScopeState ScopedId -> State ScopeState ScopedId)
-> State ScopeState ScopedId -> State ScopeState ScopedId
forall a b. (a -> b) -> a -> b
$
        case Maybe ScopedId
result of
            Just ScopedId
scopedId -> ScopedId -> State ScopeState ScopedId
forall (m :: * -> *) a. Monad m => a -> m a
return ScopedId
scopedId
            Maybe ScopedId
Nothing       -> do
                let err :: String
err = String
"Undeclared variable: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
name
                ScopeState -> State ScopeState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ScopeState -> State ScopeState ())
-> ScopeState -> State ScopeState ()
forall a b. (a -> b) -> a -> b
$ ScopeState
st { ssErrors :: [String]
ssErrors = ScopeState -> [String]
ssErrors ScopeState
st [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
err] }
                ScopedId -> State ScopeState ScopedId
forall (m :: * -> *) a. Monad m => a -> m a
return (ScopedId -> State ScopeState ScopedId)
-> ScopedId -> State ScopeState ScopedId
forall a b. (a -> b) -> a -> b
$ Text -> ScopedId
dummyScopedId Text
name

-- | Creates a dummy ScopedId for non-variable identifiers like struct fields.
dummyScopedId :: Text -> ScopedId
dummyScopedId :: Text -> ScopedId
dummyScopedId Text
name = Int -> Text -> Scope -> ScopedId
ScopedId Int
0 Text
name Scope
C.Global

transformToplevels :: [C.Node (C.Lexeme Text)] -> State ScopeState [C.Node (C.Lexeme ScopedId)]
transformToplevels :: [Node (Lexeme Text)] -> State ScopeState [Node (Lexeme ScopedId)]
transformToplevels = (Node (Lexeme Text)
 -> StateT ScopeState Identity (Node (Lexeme ScopedId)))
-> [Node (Lexeme Text)]
-> State ScopeState [Node (Lexeme ScopedId)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode

transformLexeme :: C.Lexeme Text -> State ScopeState (C.Lexeme ScopedId)
transformLexeme :: Lexeme Text -> State ScopeState (Lexeme ScopedId)
transformLexeme (C.L AlexPosn
pos LexemeClass
cls Text
text) = Lexeme ScopedId -> State ScopeState (Lexeme ScopedId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Lexeme ScopedId -> State ScopeState (Lexeme ScopedId))
-> Lexeme ScopedId -> State ScopeState (Lexeme ScopedId)
forall a b. (a -> b) -> a -> b
$ AlexPosn -> LexemeClass -> ScopedId -> Lexeme ScopedId
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
C.L AlexPosn
pos LexemeClass
cls (Text -> ScopedId
dummyScopedId Text
text)

transformNode :: C.Node (C.Lexeme Text) -> State ScopeState (C.Node (C.Lexeme ScopedId))
transformNode :: Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode (Fix NodeF (Lexeme Text) (Node (Lexeme Text))
node) = String
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
forall a. String -> a -> a
dtrace (String
"transformNode: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack (Node (Lexeme Text) -> Text
forall a. Pretty a => Node (Lexeme a) -> Text
showNodePlain (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix NodeF (Lexeme Text) (Node (Lexeme Text))
node))) (StateT ScopeState Identity (Node (Lexeme ScopedId))
 -> StateT ScopeState Identity (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
forall a b. (a -> b) -> a -> b
$ NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> Node (Lexeme ScopedId)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
 -> Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case NodeF (Lexeme Text) (Node (Lexeme Text))
node of
    C.FunctionDefn Scope
fScope (Fix (C.FunctionPrototype Node (Lexeme Text)
ty (C.L AlexPosn
pos LexemeClass
cls Text
name) [Node (Lexeme Text)]
params)) Node (Lexeme Text)
body -> do
        ScopedId
funcSid <- Scope -> Text -> State ScopeState ScopedId
findOrCreateToplevelId Scope
C.Global Text
name
        (ScopeState -> ScopeState) -> State ScopeState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ScopeState -> ScopeState) -> State ScopeState ())
-> (ScopeState -> ScopeState) -> State ScopeState ()
forall a b. (a -> b) -> a -> b
$ \ScopeState
st -> ScopeState
st { ssCurrentScope :: Scope
ssCurrentScope = Scope
fScope }
        State ScopeState ()
pushScope
        [Node (Lexeme ScopedId)]
transformedParams <- (Node (Lexeme Text)
 -> StateT ScopeState Identity (Node (Lexeme ScopedId)))
-> [Node (Lexeme Text)]
-> State ScopeState [Node (Lexeme ScopedId)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode [Node (Lexeme Text)]
params
        Node (Lexeme ScopedId)
transformedBody <- Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
body
        State ScopeState ()
popScope
        (ScopeState -> ScopeState) -> State ScopeState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ScopeState -> ScopeState) -> State ScopeState ())
-> (ScopeState -> ScopeState) -> State ScopeState ()
forall a b. (a -> b) -> a -> b
$ \ScopeState
st -> ScopeState
st { ssCurrentScope :: Scope
ssCurrentScope = Scope
C.Global }
        Node (Lexeme ScopedId)
transformedTy <- Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
ty
        let transformedProto :: NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
transformedProto = Node (Lexeme ScopedId)
-> Lexeme ScopedId
-> [Node (Lexeme ScopedId)]
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> lexeme -> [a] -> NodeF lexeme a
C.FunctionPrototype Node (Lexeme ScopedId)
transformedTy (AlexPosn -> LexemeClass -> ScopedId -> Lexeme ScopedId
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
C.L AlexPosn
pos LexemeClass
cls ScopedId
funcSid) [Node (Lexeme ScopedId)]
transformedParams
        NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Scope
-> Node (Lexeme ScopedId)
-> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. Scope -> a -> a -> NodeF lexeme a
C.FunctionDefn Scope
fScope (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> Node (Lexeme ScopedId)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
transformedProto) Node (Lexeme ScopedId)
transformedBody)

    C.FunctionDecl Scope
scope (Fix (C.FunctionPrototype Node (Lexeme Text)
ty (C.L AlexPosn
pos LexemeClass
cls Text
name) [Node (Lexeme Text)]
params)) -> do
        ScopedId
funcSid <- Scope -> Text -> State ScopeState ScopedId
findOrCreateToplevelId Scope
scope Text
name
        State ScopeState ()
pushScope
        [Node (Lexeme ScopedId)]
transformedParams <- (Node (Lexeme Text)
 -> StateT ScopeState Identity (Node (Lexeme ScopedId)))
-> [Node (Lexeme Text)]
-> State ScopeState [Node (Lexeme ScopedId)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode [Node (Lexeme Text)]
params
        State ScopeState ()
popScope
        Node (Lexeme ScopedId)
transformedTy <- Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
ty
        let transformedProto :: NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
transformedProto = Node (Lexeme ScopedId)
-> Lexeme ScopedId
-> [Node (Lexeme ScopedId)]
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> lexeme -> [a] -> NodeF lexeme a
C.FunctionPrototype Node (Lexeme ScopedId)
transformedTy (AlexPosn -> LexemeClass -> ScopedId -> Lexeme ScopedId
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
C.L AlexPosn
pos LexemeClass
cls ScopedId
funcSid) [Node (Lexeme ScopedId)]
transformedParams
        NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Scope
-> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. Scope -> a -> NodeF lexeme a
C.FunctionDecl Scope
scope (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> Node (Lexeme ScopedId)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
transformedProto))

    C.CompoundStmt [Node (Lexeme Text)]
stmts -> do
        State ScopeState ()
pushScope
        [Node (Lexeme ScopedId)]
transformedStmts <- (Node (Lexeme Text)
 -> StateT ScopeState Identity (Node (Lexeme ScopedId)))
-> [Node (Lexeme Text)]
-> State ScopeState [Node (Lexeme ScopedId)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode [Node (Lexeme Text)]
stmts
        State ScopeState ()
popScope
        NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return ([Node (Lexeme ScopedId)]
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. [a] -> NodeF lexeme a
C.CompoundStmt [Node (Lexeme ScopedId)]
transformedStmts)

    C.ForStmt Node (Lexeme Text)
init' Node (Lexeme Text)
cond Node (Lexeme Text)
next Node (Lexeme Text)
body -> do
        State ScopeState ()
pushScope
        Node (Lexeme ScopedId)
transformedInit <- Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
init'
        Node (Lexeme ScopedId)
transformedCond <- Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
cond
        Node (Lexeme ScopedId)
transformedNext <- Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
next
        Node (Lexeme ScopedId)
transformedBody <- Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
body
        State ScopeState ()
popScope
        NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Node (Lexeme ScopedId)
-> Node (Lexeme ScopedId)
-> Node (Lexeme ScopedId)
-> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> a -> a -> a -> NodeF lexeme a
C.ForStmt Node (Lexeme ScopedId)
transformedInit Node (Lexeme ScopedId)
transformedCond Node (Lexeme ScopedId)
transformedNext Node (Lexeme ScopedId)
transformedBody)

    C.VarDecl Node (Lexeme Text)
ty (C.L AlexPosn
pos LexemeClass
cls Text
name) [Node (Lexeme Text)]
arr -> do
        Scope
scope <- (ScopeState -> Scope) -> StateT ScopeState Identity Scope
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ScopeState -> Scope
ssCurrentScope
        ScopedId
scopedId <- Scope -> Text -> State ScopeState ScopedId
addVarToScope Scope
scope Text
name
        Node (Lexeme ScopedId)
-> Lexeme ScopedId
-> [Node (Lexeme ScopedId)]
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> lexeme -> [a] -> NodeF lexeme a
C.VarDecl (Node (Lexeme ScopedId)
 -> Lexeme ScopedId
 -> [Node (Lexeme ScopedId)]
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (Lexeme ScopedId
      -> [Node (Lexeme ScopedId)]
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
ty
                   StateT
  ScopeState
  Identity
  (Lexeme ScopedId
   -> [Node (Lexeme ScopedId)]
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> State ScopeState (Lexeme ScopedId)
-> StateT
     ScopeState
     Identity
     ([Node (Lexeme ScopedId)]
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Lexeme ScopedId -> State ScopeState (Lexeme ScopedId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AlexPosn -> LexemeClass -> ScopedId -> Lexeme ScopedId
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
C.L AlexPosn
pos LexemeClass
cls ScopedId
scopedId)
                   StateT
  ScopeState
  Identity
  ([Node (Lexeme ScopedId)]
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> State ScopeState [Node (Lexeme ScopedId)]
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node (Lexeme Text)
 -> StateT ScopeState Identity (Node (Lexeme ScopedId)))
-> [Node (Lexeme Text)]
-> State ScopeState [Node (Lexeme ScopedId)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode [Node (Lexeme Text)]
arr

    C.VarDeclStmt Node (Lexeme Text)
decl Maybe (Node (Lexeme Text))
mInit -> do
        Node (Lexeme ScopedId)
transformedDecl <- Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
decl
        Maybe (Node (Lexeme ScopedId))
transformedMInit <- (Node (Lexeme Text)
 -> StateT ScopeState Identity (Node (Lexeme ScopedId)))
-> Maybe (Node (Lexeme Text))
-> StateT ScopeState Identity (Maybe (Node (Lexeme ScopedId)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Maybe (Node (Lexeme Text))
mInit
        NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Node (Lexeme ScopedId)
-> Maybe (Node (Lexeme ScopedId))
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> Maybe a -> NodeF lexeme a
C.VarDeclStmt Node (Lexeme ScopedId)
transformedDecl Maybe (Node (Lexeme ScopedId))
transformedMInit)

    C.VarExpr (C.L AlexPosn
pos LexemeClass
cls Text
name) -> do
        ScopedId
scopedId <- Text -> State ScopeState ScopedId
lookupVar Text
name
        NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
 -> StateT
      ScopeState
      Identity
      (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))))
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall a b. (a -> b) -> a -> b
$ Lexeme ScopedId -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. lexeme -> NodeF lexeme a
C.VarExpr (AlexPosn -> LexemeClass -> ScopedId -> Lexeme ScopedId
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
C.L AlexPosn
pos LexemeClass
cls ScopedId
scopedId)

    C.IfStmt Node (Lexeme Text)
cond Node (Lexeme Text)
thenB Maybe (Node (Lexeme Text))
mElseB -> do
        Node (Lexeme ScopedId)
transformedCond <- Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
cond
        Node (Lexeme ScopedId)
transformedThenB <- Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
thenB
        Maybe (Node (Lexeme ScopedId))
transformedMElseB <- (Node (Lexeme Text)
 -> StateT ScopeState Identity (Node (Lexeme ScopedId)))
-> Maybe (Node (Lexeme Text))
-> StateT ScopeState Identity (Maybe (Node (Lexeme ScopedId)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Maybe (Node (Lexeme Text))
mElseB
        NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Node (Lexeme ScopedId)
-> Node (Lexeme ScopedId)
-> Maybe (Node (Lexeme ScopedId))
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> a -> Maybe a -> NodeF lexeme a
C.IfStmt Node (Lexeme ScopedId)
transformedCond Node (Lexeme ScopedId)
transformedThenB Maybe (Node (Lexeme ScopedId))
transformedMElseB)

    C.ConstDefn Scope
scope Node (Lexeme Text)
ty (C.L AlexPosn
pos LexemeClass
cls Text
name) Node (Lexeme Text)
val -> do
        ScopedId
scopedId <- Scope -> Text -> State ScopeState ScopedId
addVarToScope Scope
scope Text
name
        Scope
-> Node (Lexeme ScopedId)
-> Lexeme ScopedId
-> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. Scope -> a -> lexeme -> a -> NodeF lexeme a
C.ConstDefn Scope
scope (Node (Lexeme ScopedId)
 -> Lexeme ScopedId
 -> Node (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (Lexeme ScopedId
      -> Node (Lexeme ScopedId)
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
ty
                           StateT
  ScopeState
  Identity
  (Lexeme ScopedId
   -> Node (Lexeme ScopedId)
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> State ScopeState (Lexeme ScopedId)
-> StateT
     ScopeState
     Identity
     (Node (Lexeme ScopedId)
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Lexeme ScopedId -> State ScopeState (Lexeme ScopedId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AlexPosn -> LexemeClass -> ScopedId -> Lexeme ScopedId
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
C.L AlexPosn
pos LexemeClass
cls ScopedId
scopedId)
                           StateT
  ScopeState
  Identity
  (Node (Lexeme ScopedId)
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
val

    C.ConstDecl Node (Lexeme Text)
ty (C.L AlexPosn
pos LexemeClass
cls Text
name) -> do
        ScopedId
scopedId <- Scope -> Text -> State ScopeState ScopedId
addVarToGlobalScope Scope
C.Global Text
name
        Node (Lexeme ScopedId)
-> Lexeme ScopedId
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> lexeme -> NodeF lexeme a
C.ConstDecl (Node (Lexeme ScopedId)
 -> Lexeme ScopedId
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (Lexeme ScopedId
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
ty
                     StateT
  ScopeState
  Identity
  (Lexeme ScopedId
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> State ScopeState (Lexeme ScopedId)
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Lexeme ScopedId -> State ScopeState (Lexeme ScopedId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AlexPosn -> LexemeClass -> ScopedId -> Lexeme ScopedId
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
C.L AlexPosn
pos LexemeClass
cls ScopedId
scopedId)

    C.Typedef Node (Lexeme Text)
ty (C.L AlexPosn
pos LexemeClass
cls Text
name) -> do
        -- We don't need to store typedefs in the variable symbol table.
        Node (Lexeme ScopedId)
-> Lexeme ScopedId
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> lexeme -> NodeF lexeme a
C.Typedef (Node (Lexeme ScopedId)
 -> Lexeme ScopedId
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (Lexeme ScopedId
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
ty StateT
  ScopeState
  Identity
  (Lexeme ScopedId
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> State ScopeState (Lexeme ScopedId)
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Lexeme ScopedId -> State ScopeState (Lexeme ScopedId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AlexPosn -> LexemeClass -> ScopedId -> Lexeme ScopedId
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
C.L AlexPosn
pos LexemeClass
cls (Text -> ScopedId
dummyScopedId Text
name))

    C.AggregateDecl Node (Lexeme Text)
decl -> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> NodeF lexeme a
C.AggregateDecl (Node (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
decl

    C.Struct (C.L AlexPosn
pos LexemeClass
cls Text
name) [Node (Lexeme Text)]
members -> do
        -- We don't need to store struct names in the variable symbol table.
        Lexeme ScopedId
-> [Node (Lexeme ScopedId)]
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. lexeme -> [a] -> NodeF lexeme a
C.Struct (AlexPosn -> LexemeClass -> ScopedId -> Lexeme ScopedId
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
C.L AlexPosn
pos LexemeClass
cls (Text -> ScopedId
dummyScopedId Text
name)) ([Node (Lexeme ScopedId)]
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> State ScopeState [Node (Lexeme ScopedId)]
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node (Lexeme Text)
 -> StateT ScopeState Identity (Node (Lexeme ScopedId)))
-> [Node (Lexeme Text)]
-> State ScopeState [Node (Lexeme ScopedId)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode [Node (Lexeme Text)]
members

    C.Union (C.L AlexPosn
pos LexemeClass
cls Text
name) [Node (Lexeme Text)]
members -> do
        -- We don't need to store union names in the variable symbol table.
        Lexeme ScopedId
-> [Node (Lexeme ScopedId)]
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. lexeme -> [a] -> NodeF lexeme a
C.Union (AlexPosn -> LexemeClass -> ScopedId -> Lexeme ScopedId
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
C.L AlexPosn
pos LexemeClass
cls (Text -> ScopedId
dummyScopedId Text
name)) ([Node (Lexeme ScopedId)]
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> State ScopeState [Node (Lexeme ScopedId)]
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node (Lexeme Text)
 -> StateT ScopeState Identity (Node (Lexeme ScopedId)))
-> [Node (Lexeme Text)]
-> State ScopeState [Node (Lexeme ScopedId)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode [Node (Lexeme Text)]
members

    C.EnumDecl (C.L AlexPosn
pos LexemeClass
cls Text
name) [Node (Lexeme Text)]
enums (C.L AlexPosn
pos' LexemeClass
cls' Text
tyName) -> do
        -- We don't need to store enum type names in the variable symbol table.
        -- However, the enumerators themselves are constants and should be added.
        [Node (Lexeme ScopedId)]
transformedEnums <- (Node (Lexeme Text)
 -> StateT ScopeState Identity (Node (Lexeme ScopedId)))
-> [Node (Lexeme Text)]
-> State ScopeState [Node (Lexeme ScopedId)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode [Node (Lexeme Text)]
enums
        NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Lexeme ScopedId
-> [Node (Lexeme ScopedId)]
-> Lexeme ScopedId
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. lexeme -> [a] -> lexeme -> NodeF lexeme a
C.EnumDecl (AlexPosn -> LexemeClass -> ScopedId -> Lexeme ScopedId
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
C.L AlexPosn
pos LexemeClass
cls (Text -> ScopedId
dummyScopedId Text
name)) [Node (Lexeme ScopedId)]
transformedEnums (AlexPosn -> LexemeClass -> ScopedId -> Lexeme ScopedId
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
C.L AlexPosn
pos' LexemeClass
cls' (Text -> ScopedId
dummyScopedId Text
tyName)))

    C.EnumConsts Maybe (Lexeme Text)
mName [Node (Lexeme Text)]
enums -> do
        -- Enum constants are added to the global scope.
        Maybe (Lexeme ScopedId)
mScopedId <- Maybe (Lexeme Text)
-> (Lexeme Text -> State ScopeState (Lexeme ScopedId))
-> StateT ScopeState Identity (Maybe (Lexeme ScopedId))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (Lexeme Text)
mName ((Lexeme Text -> State ScopeState (Lexeme ScopedId))
 -> StateT ScopeState Identity (Maybe (Lexeme ScopedId)))
-> (Lexeme Text -> State ScopeState (Lexeme ScopedId))
-> StateT ScopeState Identity (Maybe (Lexeme ScopedId))
forall a b. (a -> b) -> a -> b
$ \(C.L AlexPosn
pos LexemeClass
cls Text
name) -> do
            ScopedId
scopedId <- Scope -> Text -> State ScopeState ScopedId
addVarToGlobalScope Scope
C.Global Text
name
            Lexeme ScopedId -> State ScopeState (Lexeme ScopedId)
forall (m :: * -> *) a. Monad m => a -> m a
return (AlexPosn -> LexemeClass -> ScopedId -> Lexeme ScopedId
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
C.L AlexPosn
pos LexemeClass
cls ScopedId
scopedId)
        [Node (Lexeme ScopedId)]
transformedEnums <- (Node (Lexeme Text)
 -> StateT ScopeState Identity (Node (Lexeme ScopedId)))
-> [Node (Lexeme Text)]
-> State ScopeState [Node (Lexeme ScopedId)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode [Node (Lexeme Text)]
enums
        NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Lexeme ScopedId)
-> [Node (Lexeme ScopedId)]
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. Maybe lexeme -> [a] -> NodeF lexeme a
C.EnumConsts Maybe (Lexeme ScopedId)
mScopedId [Node (Lexeme ScopedId)]
transformedEnums)

    C.Enumerator (C.L AlexPosn
pos LexemeClass
cls Text
name) Maybe (Node (Lexeme Text))
mVal -> do
        -- Each enumerator is a constant in the global scope.
        ScopedId
scopedId <- Scope -> Text -> State ScopeState ScopedId
addVarToGlobalScope Scope
C.Global Text
name
        Lexeme ScopedId
-> Maybe (Node (Lexeme ScopedId))
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. lexeme -> Maybe a -> NodeF lexeme a
C.Enumerator (AlexPosn -> LexemeClass -> ScopedId -> Lexeme ScopedId
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
C.L AlexPosn
pos LexemeClass
cls ScopedId
scopedId) (Maybe (Node (Lexeme ScopedId))
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Maybe (Node (Lexeme ScopedId)))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node (Lexeme Text)
 -> StateT ScopeState Identity (Node (Lexeme ScopedId)))
-> Maybe (Node (Lexeme Text))
-> StateT ScopeState Identity (Maybe (Node (Lexeme ScopedId)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Maybe (Node (Lexeme Text))
mVal

    C.MemberDecl Node (Lexeme Text)
decl Maybe (Lexeme Text)
mBits -> Node (Lexeme ScopedId)
-> Maybe (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> Maybe lexeme -> NodeF lexeme a
C.MemberDecl (Node (Lexeme ScopedId)
 -> Maybe (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (Maybe (Lexeme ScopedId)
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
decl StateT
  ScopeState
  Identity
  (Maybe (Lexeme ScopedId)
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Maybe (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Lexeme Text -> State ScopeState (Lexeme ScopedId))
-> Maybe (Lexeme Text)
-> StateT ScopeState Identity (Maybe (Lexeme ScopedId))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Lexeme Text -> State ScopeState (Lexeme ScopedId)
transformLexeme Maybe (Lexeme Text)
mBits

    C.TypedefFunction (Fix (C.FunctionPrototype Node (Lexeme Text)
ty (C.L AlexPosn
pos LexemeClass
cls Text
name) [Node (Lexeme Text)]
params)) -> do
        -- The typedef name itself is a type, not a variable.
        -- The parameters are in a temporary scope for the declaration.
        State ScopeState ()
pushScope
        [Node (Lexeme ScopedId)]
transformedParams <- (Node (Lexeme Text)
 -> StateT ScopeState Identity (Node (Lexeme ScopedId)))
-> [Node (Lexeme Text)]
-> State ScopeState [Node (Lexeme ScopedId)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode [Node (Lexeme Text)]
params
        State ScopeState ()
popScope
        Node (Lexeme ScopedId)
transformedTy <- Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
ty
        let transformedProtoNode :: NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
transformedProtoNode = Node (Lexeme ScopedId)
-> Lexeme ScopedId
-> [Node (Lexeme ScopedId)]
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> lexeme -> [a] -> NodeF lexeme a
C.FunctionPrototype Node (Lexeme ScopedId)
transformedTy (AlexPosn -> LexemeClass -> ScopedId -> Lexeme ScopedId
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
C.L AlexPosn
pos LexemeClass
cls (Text -> ScopedId
dummyScopedId Text
name)) [Node (Lexeme ScopedId)]
transformedParams
        NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> NodeF lexeme a
C.TypedefFunction (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> Node (Lexeme ScopedId)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
transformedProtoNode))

    C.FunctionCall Node (Lexeme Text)
fun [Node (Lexeme Text)]
args -> Node (Lexeme ScopedId)
-> [Node (Lexeme ScopedId)]
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> [a] -> NodeF lexeme a
C.FunctionCall (Node (Lexeme ScopedId)
 -> [Node (Lexeme ScopedId)]
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     ([Node (Lexeme ScopedId)]
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
fun StateT
  ScopeState
  Identity
  ([Node (Lexeme ScopedId)]
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> State ScopeState [Node (Lexeme ScopedId)]
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node (Lexeme Text)
 -> StateT ScopeState Identity (Node (Lexeme ScopedId)))
-> [Node (Lexeme Text)]
-> State ScopeState [Node (Lexeme ScopedId)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode [Node (Lexeme Text)]
args
    C.Label (C.L AlexPosn
pos LexemeClass
cls Text
name) Node (Lexeme Text)
stmt -> Lexeme ScopedId
-> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. lexeme -> a -> NodeF lexeme a
C.Label (AlexPosn -> LexemeClass -> ScopedId -> Lexeme ScopedId
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
C.L AlexPosn
pos LexemeClass
cls (Text -> ScopedId
dummyScopedId Text
name)) (Node (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
stmt
    C.Goto (C.L AlexPosn
pos LexemeClass
cls Text
name) -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
 -> StateT
      ScopeState
      Identity
      (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))))
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall a b. (a -> b) -> a -> b
$ Lexeme ScopedId -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. lexeme -> NodeF lexeme a
C.Goto (AlexPosn -> LexemeClass -> ScopedId -> Lexeme ScopedId
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
C.L AlexPosn
pos LexemeClass
cls (Text -> ScopedId
dummyScopedId Text
name))
    C.SwitchStmt Node (Lexeme Text)
cond [Node (Lexeme Text)]
body -> Node (Lexeme ScopedId)
-> [Node (Lexeme ScopedId)]
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> [a] -> NodeF lexeme a
C.SwitchStmt (Node (Lexeme ScopedId)
 -> [Node (Lexeme ScopedId)]
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     ([Node (Lexeme ScopedId)]
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
cond StateT
  ScopeState
  Identity
  ([Node (Lexeme ScopedId)]
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> State ScopeState [Node (Lexeme ScopedId)]
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node (Lexeme Text)
 -> StateT ScopeState Identity (Node (Lexeme ScopedId)))
-> [Node (Lexeme Text)]
-> State ScopeState [Node (Lexeme ScopedId)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode [Node (Lexeme Text)]
body
    C.WhileStmt Node (Lexeme Text)
cond Node (Lexeme Text)
body -> Node (Lexeme ScopedId)
-> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> a -> NodeF lexeme a
C.WhileStmt (Node (Lexeme ScopedId)
 -> Node (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (Node (Lexeme ScopedId)
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
cond StateT
  ScopeState
  Identity
  (Node (Lexeme ScopedId)
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
body
    C.DoWhileStmt Node (Lexeme Text)
body Node (Lexeme Text)
cond -> Node (Lexeme ScopedId)
-> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> a -> NodeF lexeme a
C.DoWhileStmt (Node (Lexeme ScopedId)
 -> Node (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (Node (Lexeme ScopedId)
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
body StateT
  ScopeState
  Identity
  (Node (Lexeme ScopedId)
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
cond
    C.Return Maybe (Node (Lexeme Text))
mExpr -> Maybe (Node (Lexeme ScopedId))
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. Maybe a -> NodeF lexeme a
C.Return (Maybe (Node (Lexeme ScopedId))
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Maybe (Node (Lexeme ScopedId)))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node (Lexeme Text)
 -> StateT ScopeState Identity (Node (Lexeme ScopedId)))
-> Maybe (Node (Lexeme Text))
-> StateT ScopeState Identity (Maybe (Node (Lexeme ScopedId)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Maybe (Node (Lexeme Text))
mExpr
    C.ExprStmt Node (Lexeme Text)
expr -> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> NodeF lexeme a
C.ExprStmt (Node (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
expr
    C.AssignExpr Node (Lexeme Text)
lhs AssignOp
op Node (Lexeme Text)
rhs -> Node (Lexeme ScopedId)
-> AssignOp
-> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> AssignOp -> a -> NodeF lexeme a
C.AssignExpr (Node (Lexeme ScopedId)
 -> AssignOp
 -> Node (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (AssignOp
      -> Node (Lexeme ScopedId)
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
lhs StateT
  ScopeState
  Identity
  (AssignOp
   -> Node (Lexeme ScopedId)
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity AssignOp
-> StateT
     ScopeState
     Identity
     (Node (Lexeme ScopedId)
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AssignOp -> StateT ScopeState Identity AssignOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssignOp
op StateT
  ScopeState
  Identity
  (Node (Lexeme ScopedId)
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
rhs
    C.MemberAccess Node (Lexeme Text)
base (C.L AlexPosn
pos LexemeClass
cls Text
field) -> Node (Lexeme ScopedId)
-> Lexeme ScopedId
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> lexeme -> NodeF lexeme a
C.MemberAccess (Node (Lexeme ScopedId)
 -> Lexeme ScopedId
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (Lexeme ScopedId
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
base StateT
  ScopeState
  Identity
  (Lexeme ScopedId
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> State ScopeState (Lexeme ScopedId)
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Lexeme ScopedId -> State ScopeState (Lexeme ScopedId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AlexPosn -> LexemeClass -> ScopedId -> Lexeme ScopedId
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
C.L AlexPosn
pos LexemeClass
cls (Text -> ScopedId
dummyScopedId Text
field))
    C.PointerAccess Node (Lexeme Text)
base (C.L AlexPosn
pos LexemeClass
cls Text
field) -> Node (Lexeme ScopedId)
-> Lexeme ScopedId
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> lexeme -> NodeF lexeme a
C.PointerAccess (Node (Lexeme ScopedId)
 -> Lexeme ScopedId
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (Lexeme ScopedId
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
base StateT
  ScopeState
  Identity
  (Lexeme ScopedId
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> State ScopeState (Lexeme ScopedId)
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Lexeme ScopedId -> State ScopeState (Lexeme ScopedId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AlexPosn -> LexemeClass -> ScopedId -> Lexeme ScopedId
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
C.L AlexPosn
pos LexemeClass
cls (Text -> ScopedId
dummyScopedId Text
field))
    C.ArrayAccess Node (Lexeme Text)
base Node (Lexeme Text)
idx -> Node (Lexeme ScopedId)
-> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> a -> NodeF lexeme a
C.ArrayAccess (Node (Lexeme ScopedId)
 -> Node (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (Node (Lexeme ScopedId)
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
base StateT
  ScopeState
  Identity
  (Node (Lexeme ScopedId)
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
idx
    C.UnaryExpr UnaryOp
op Node (Lexeme Text)
expr -> UnaryOp
-> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. UnaryOp -> a -> NodeF lexeme a
C.UnaryExpr UnaryOp
op (Node (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
expr
    C.BinaryExpr Node (Lexeme Text)
lhs BinaryOp
op Node (Lexeme Text)
rhs -> Node (Lexeme ScopedId)
-> BinaryOp
-> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> BinaryOp -> a -> NodeF lexeme a
C.BinaryExpr (Node (Lexeme ScopedId)
 -> BinaryOp
 -> Node (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (BinaryOp
      -> Node (Lexeme ScopedId)
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
lhs StateT
  ScopeState
  Identity
  (BinaryOp
   -> Node (Lexeme ScopedId)
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity BinaryOp
-> StateT
     ScopeState
     Identity
     (Node (Lexeme ScopedId)
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinaryOp -> StateT ScopeState Identity BinaryOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinaryOp
op StateT
  ScopeState
  Identity
  (Node (Lexeme ScopedId)
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
rhs
    C.TernaryExpr Node (Lexeme Text)
cond Node (Lexeme Text)
thenExpr Node (Lexeme Text)
elseExpr -> Node (Lexeme ScopedId)
-> Node (Lexeme ScopedId)
-> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> a -> a -> NodeF lexeme a
C.TernaryExpr (Node (Lexeme ScopedId)
 -> Node (Lexeme ScopedId)
 -> Node (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (Node (Lexeme ScopedId)
      -> Node (Lexeme ScopedId)
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
cond StateT
  ScopeState
  Identity
  (Node (Lexeme ScopedId)
   -> Node (Lexeme ScopedId)
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (Node (Lexeme ScopedId)
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
thenExpr StateT
  ScopeState
  Identity
  (Node (Lexeme ScopedId)
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
elseExpr
    C.ParenExpr Node (Lexeme Text)
expr -> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> NodeF lexeme a
C.ParenExpr (Node (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
expr
    C.CastExpr Node (Lexeme Text)
ty Node (Lexeme Text)
expr -> Node (Lexeme ScopedId)
-> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> a -> NodeF lexeme a
C.CastExpr (Node (Lexeme ScopedId)
 -> Node (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (Node (Lexeme ScopedId)
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
ty StateT
  ScopeState
  Identity
  (Node (Lexeme ScopedId)
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
expr
    C.SizeofExpr Node (Lexeme Text)
expr -> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> NodeF lexeme a
C.SizeofExpr (Node (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
expr
    C.SizeofType Node (Lexeme Text)
ty -> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> NodeF lexeme a
C.SizeofType (Node (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
ty
    C.LiteralExpr LiteralType
C.ConstId (C.L AlexPosn
pos LexemeClass
cls Text
name) -> do
        ScopedId
scopedId <- Text -> State ScopeState ScopedId
lookupVar Text
name
        NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
 -> StateT
      ScopeState
      Identity
      (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))))
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall a b. (a -> b) -> a -> b
$ Lexeme ScopedId -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. lexeme -> NodeF lexeme a
C.VarExpr (AlexPosn -> LexemeClass -> ScopedId -> Lexeme ScopedId
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
C.L AlexPosn
pos LexemeClass
cls ScopedId
scopedId)
    C.LiteralExpr LiteralType
ty Lexeme Text
l -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
 -> StateT
      ScopeState
      Identity
      (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))))
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall a b. (a -> b) -> a -> b
$ LiteralType
-> Lexeme ScopedId
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. LiteralType -> lexeme -> NodeF lexeme a
C.LiteralExpr LiteralType
ty ((Text -> ScopedId) -> Lexeme Text -> Lexeme ScopedId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ScopedId
dummyScopedId Lexeme Text
l)
    C.TyStd Lexeme Text
l -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
 -> StateT
      ScopeState
      Identity
      (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))))
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall a b. (a -> b) -> a -> b
$ Lexeme ScopedId -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. lexeme -> NodeF lexeme a
C.TyStd ((Text -> ScopedId) -> Lexeme Text -> Lexeme ScopedId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ScopedId
dummyScopedId Lexeme Text
l)
    C.TyPointer Node (Lexeme Text)
ty -> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> NodeF lexeme a
C.TyPointer (Node (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
ty
    C.TyStruct Lexeme Text
l -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
 -> StateT
      ScopeState
      Identity
      (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))))
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall a b. (a -> b) -> a -> b
$ Lexeme ScopedId -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. lexeme -> NodeF lexeme a
C.TyStruct ((Text -> ScopedId) -> Lexeme Text -> Lexeme ScopedId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ScopedId
dummyScopedId Lexeme Text
l)
    C.TyUnion Lexeme Text
l -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
 -> StateT
      ScopeState
      Identity
      (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))))
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall a b. (a -> b) -> a -> b
$ Lexeme ScopedId -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. lexeme -> NodeF lexeme a
C.TyUnion ((Text -> ScopedId) -> Lexeme Text -> Lexeme ScopedId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ScopedId
dummyScopedId Lexeme Text
l)
    C.TyUserDefined Lexeme Text
l -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
 -> StateT
      ScopeState
      Identity
      (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))))
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall a b. (a -> b) -> a -> b
$ Lexeme ScopedId -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. lexeme -> NodeF lexeme a
C.TyUserDefined ((Text -> ScopedId) -> Lexeme Text -> Lexeme ScopedId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ScopedId
dummyScopedId Lexeme Text
l)
    NodeF (Lexeme Text) (Node (Lexeme Text))
C.Break -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. NodeF lexeme a
C.Break
    NodeF (Lexeme Text) (Node (Lexeme Text))
C.Continue -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. NodeF lexeme a
C.Continue
    C.Case Node (Lexeme Text)
cond Node (Lexeme Text)
stmt -> Node (Lexeme ScopedId)
-> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> a -> NodeF lexeme a
C.Case (Node (Lexeme ScopedId)
 -> Node (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (Node (Lexeme ScopedId)
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
cond StateT
  ScopeState
  Identity
  (Node (Lexeme ScopedId)
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
stmt
    C.Default Node (Lexeme Text)
stmt -> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> NodeF lexeme a
C.Default (Node (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
stmt
    C.InitialiserList [Node (Lexeme Text)]
exprs -> [Node (Lexeme ScopedId)]
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. [a] -> NodeF lexeme a
C.InitialiserList ([Node (Lexeme ScopedId)]
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> State ScopeState [Node (Lexeme ScopedId)]
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node (Lexeme Text)
 -> StateT ScopeState Identity (Node (Lexeme ScopedId)))
-> [Node (Lexeme Text)]
-> State ScopeState [Node (Lexeme ScopedId)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode [Node (Lexeme Text)]
exprs
    C.Commented Node (Lexeme Text)
c Node (Lexeme Text)
e -> Node (Lexeme ScopedId)
-> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> a -> NodeF lexeme a
C.Commented (Node (Lexeme ScopedId)
 -> Node (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (Node (Lexeme ScopedId)
      -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
c StateT
  ScopeState
  Identity
  (Node (Lexeme ScopedId)
   -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
e
    C.TyConst Node (Lexeme Text)
ty -> Node (Lexeme ScopedId)
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. a -> NodeF lexeme a
C.TyConst (Node (Lexeme ScopedId)
 -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node (Lexeme Text)
-> StateT ScopeState Identity (Node (Lexeme ScopedId))
transformNode Node (Lexeme Text)
ty
    C.TyFunc Lexeme Text
l -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
 -> StateT
      ScopeState
      Identity
      (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))))
-> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall a b. (a -> b) -> a -> b
$ Lexeme ScopedId -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. lexeme -> NodeF lexeme a
C.TyFunc ((Text -> ScopedId) -> Lexeme Text -> Lexeme ScopedId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ScopedId
dummyScopedId Lexeme Text
l)
    NodeF (Lexeme Text) (Node (Lexeme Text))
C.Ellipsis -> NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall (m :: * -> *) a. Monad m => a -> m a
return NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))
forall lexeme a. NodeF lexeme a
C.Ellipsis

    NodeF (Lexeme Text) (Node (Lexeme Text))
other -> String
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall a. HasCallStack => String -> a
error (String
 -> StateT
      ScopeState
      Identity
      (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId))))
-> String
-> StateT
     ScopeState
     Identity
     (NodeF (Lexeme ScopedId) (Node (Lexeme ScopedId)))
forall a b. (a -> b) -> a -> b
$ String
"transformNode: Unhandled AST node: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ NodeF (Lexeme Text) () -> String
forall a. Show a => a -> String
show ((Node (Lexeme Text) -> ())
-> NodeF (Lexeme Text) (Node (Lexeme Text))
-> NodeF (Lexeme Text) ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> Node (Lexeme Text) -> ()
forall a b. a -> b -> a
const ()) NodeF (Lexeme Text) (Node (Lexeme Text))
other)