asil-1.2: src/SymView.ag

MODULE {SymView} {} {}

INCLUDE "SymViewAst.ag"

imports
{
import Data.Word
import ProgInfo
import Data.Maybe
}

DERIVING * : Eq, Show


-- Operations to construct views

{

tablesView :: [SymbolTables] -> FileV
tablesView tbls = FileV_File $ map tableView tbls

tableView :: SymbolTables -> TableV
tableView tbls = TableV_Table classes methods where
  classes = map (classView tbls) (map Ref $ keysEnv $ tableClasses tbls)
  methods = map (methodView tbls) (map Ref $ keysEnv $ tableSigs tbls)


classView :: SymbolTables -> ClassRef -> ClassV
classView tbls ref = res where
  c         = lookupClass ref tbls
  nm        = nameView tbls (clName c)
  mbSuper   = fmap (SuperV_Super . TypeV_Type (refNull $ fromJust $ clSuper c)) $ mbNameView tbls $ clSuper c
  itfs      = map (\tpRef -> ItfV_Itf $ TypeV_Type (refNull tpRef) $ nameView tbls tpRef) (clInterfaces c)
  dynTraits = map (traitView tbls) (clDynTraits c)
  staTraits = map (traitView tbls) (clStaTraits c)
  res       = ClassV_Class ref nm mbSuper itfs dynTraits staTraits

traitView :: SymbolTables -> TraitDescr -> TraitV
traitView tbls tr = case trData tr of
  TraitMethod mRef -> TraitV_Method nm $ sigView tbls mRef
  TraitField tpRef -> TraitV_Field nm $ TypeV_Type (refNull tpRef) $ nameView tbls tpRef
  TraitClass _     -> TraitV_Other nm
  where nm = nameView tbls (trName tr)


methodView :: SymbolTables -> MethodRef -> MethodV
methodView tbls ref = res where
  m    = lookupMethod ref tbls
  mbNm = mbStringView tbls $ sigName m
  sig  = sigView' tbls ref m
  res  = MethodV_Method mbNm sig

sigView :: SymbolTables -> MethodRef -> SigV
sigView tbls ref = sigView' tbls ref m where
  m    = lookupMethod ref tbls

sigView' :: SymbolTables -> MethodRef -> Sig -> SigV
sigView' tbls ref m = res where
  mbNm = mbStringView tbls $ sigName m
  tRef = sigReturn m
  ret  = TypeV_Type (refNull tRef) $ nameView tbls tRef
  ps   = map (paramView tbls) (sigParams m)
  res  = SigV_Sig ref ret ps

paramView :: SymbolTables -> SigParam -> ParamV
paramView tbls p = ParamV_Param (mbStringView tbls $ spName p) (TypeV_Type (refNull tpRef) $ nameView tbls tpRef)
  where tpRef = spType p


mbNameView :: SymbolTables -> Maybe NameRef -> MbNmV
mbNameView tbls = maybe Nothing (Just . nameView tbls)

nameView :: SymbolTables -> NameRef -> NmV
nameView tbls ref = case nmStr nm of
  Nothing -> NmV_Other ref
  Just strRef -> case nmQual nm of
    QualNs nsRef -> NmV_Qual ref (namespaceView tbls nsRef) (stringView tbls strRef)
    QualNss sRef -> case nsSpaces $ lookupNameset sRef tbls of
      [nsRef]    -> NmV_Qual ref (namespaceView tbls nsRef) (stringView tbls strRef)
      _          -> NmV_Quals ref (namesetsView tbls  sRef) (stringView tbls strRef)
    _            -> NmV_Other ref
 where nm = lookupName ref tbls

mbStringView :: SymbolTables -> Maybe StringRef -> MbStrV
mbStringView tbls = maybe Nothing (Just . stringView tbls)

stringView :: SymbolTables -> StringRef -> StrV
stringView tbls ref = StrV_Str ref (lookupString ref tbls)

namespaceView :: SymbolTables -> NamespaceRef -> NsV
namespaceView tbls ref = NsV_Ns ref (stringView tbls $ nsName $ lookupNamespace ref tbls)

namesetsView :: SymbolTables -> NamesetRef -> NsSetV
namesetsView tbls ref = NsSetV_Set ref views where
  spaces = nsSpaces $ lookupNameset ref tbls
  views  = map (namespaceView tbls) spaces
}