syfco-1.1.0.0: src/Data/SymbolTable.hs
-----------------------------------------------------------------------------
-- |
-- Module : Data.SymbolTable
-- License : MIT (see the LICENSE file)
-- Maintainer : Felix Klein (klein@react.uni-saarland.de)
--
-- Data type to store all identifier specific content.
--
-----------------------------------------------------------------------------
{-# LANGUAGE
ViewPatterns
, LambdaCase
, RecordWildCards
#-}
-----------------------------------------------------------------------------
module Data.SymbolTable
( SymbolTable
, IdRec(..)
, st2csv
) where
-----------------------------------------------------------------------------
import Data.Types
( IdType(..)
, SignalType(..)
)
import Data.Expression
( Expr(..)
, Expr'(..)
, ExprPos(..)
, SrcPos(..)
, prExpr
, expr
)
import Data.Char
( ord
, chr
)
import Data.Array
( Array
, (!)
, assocs
)
-----------------------------------------------------------------------------
-- | A symbol table is an array mapping identifieres, represend by integers,
-- to blocks of information.
type SymbolTable = Array Int IdRec
-----------------------------------------------------------------------------
-- | Data type representing a single entry in the symbol table.
data IdRec =
IdRec
{ -- | The name of the identifier.
idName :: String
, -- | The position of the identifer definition in the source file.
idPos :: ExprPos
, -- | The arguemnts, in case the identifier describes a function.
idArgs :: [Int]
, -- | The expression, the identifier is bound to.
idBindings :: Expr Int
, -- | The type of the identifier.
idType :: IdType
, -- | The list of identifiers, which have to be evaluated first
-- to evaluate this identifier.
idDeps :: [Int]
}
-----------------------------------------------------------------------------
-- | Prints a symbol table in the CVS format (for debugging purposes only).
st2csv
:: SymbolTable -> String
st2csv lt =
"Id;Name;Position;Arguments;Type;Dependencies;\n"
-- putStrLn "Id;Name;Position;Arguments;Bindings;Type;Dependencies;"
++ (unlines $ map printEntry $ assocs lt)
where
printEntry (i,r@IdRec{..}) =
concat
[ show i
, ";"
, "\"" ++ idName ++ "\""
, ";"
, prExprPos idPos
, ";"
, commasepxs idArgs
, ";"
-- , prPrettyExpr lt r idBindings
-- , ";"
, prType idArgs idType
, ";"
, commasepxs idDeps
, ";"
]
commasepxs = \case
(x:xr) -> show x ++ concatMap ((:) ',') (map show xr)
[] -> ""
prExprPos pos =
let
bl = srcLine $ srcBegin pos
bc = srcColumn $ srcBegin pos
el = srcLine $ srcEnd pos
ec = srcColumn $ srcEnd pos
in
"(" ++ show bl ++ "," ++ show bc ++
if bl == el then
"-" ++ show ec ++ ")"
else
show el ++ ":" ++ show ec ++ ")"
prType xs t = concatMap prArgType xs ++ case t of
TNumber -> "Int"
TLtl -> "Ltl"
TBoolean -> "Bool"
TPattern -> "Pattern"
TEmptySet -> "Empty Set"
TSet x -> prType [] x ++ " Set"
TPoly i ->
if i >= ord 'a' && i <= ord 'z'
then [chr i]
else "a" ++ show i
TSignal STInput -> "Input"
TSignal STOutput -> "Output"
TSignal STGeneric -> "In|Out"
TBus STInput -> "Input Bus"
TBus STOutput -> "Output Bus"
TBus STGeneric -> "In|Out Bus"
TTypedBus STInput s _ -> "Input[" ++ s ++ "]"
TTypedBus STOutput s _ -> "Output[" ++ s ++ "]"
TTypedBus STGeneric s _ -> "In|Out[" ++ s ++ "]"
TEnum s _ -> s
prArgType x =
let
r = lt ! x
args = idArgs r
in
if length args > 1
then "(" ++ prType args (idType r) ++ ") -> "
else prType args (idType r) ++ " -> "
-----------------------------------------------------------------------------
prPrettyExpr
:: SymbolTable -> IdRec -> Expr Int -> String
prPrettyExpr _ _ (expr -> SetExplicit []) = ""
prPrettyExpr st r e = pr e
where
pr = pr' . expr
pr' = \case
BaseWild -> "_"
BaseTrue -> "\"true\""
BaseFalse -> "\"false\""
BaseOtherwise -> "otherwise"
BaseCon x -> "\"" ++ show x ++ "\""
BaseId x -> "\"" ++ idName (st ! x) ++ "\"<" ++ show x ++ ">"
BaseBus x y -> "\"" ++ idName (st ! y) ++ "\"<" ++ show y ++ ">[" ++ pr x ++ "]"
BaseFml xs y -> "\"" ++ idName (st ! y) ++ "\"<" ++ show y ++ ">(" ++
(if null xs then ""
else pr (head xs) ++
concatMap ((:) ',' . pr) (tail xs)) ++ ")"
NumSMin x -> "min " ++ pr x
NumSMax x -> "max " ++ pr x
NumSSize x -> "|" ++ pr x ++ "|"
NumSizeOf x -> "sizeof " ++ pr x ++ ")"
BlnNot x -> "¬" ++ pr x
LtlNext x -> "X " ++ pr x
LtlGlobally x -> "G " ++ pr x
LtlFinally x -> "F " ++ pr x
NumPlus x y -> pr x ++ " + " ++ pr y
NumMinus x y -> pr x ++ " - " ++ pr y
NumMul x y -> pr x ++ " * " ++ pr y
NumDiv x y -> pr x ++ " / " ++ pr y
NumMod x y -> pr x ++ " % " ++ pr y
SetCup (expr -> SetExplicit []) x -> pr x
SetCup x (expr -> SetExplicit []) -> pr x
SetCup x y -> pr x ++ " ∪ " ++ pr y
SetCap (expr -> SetExplicit []) x -> pr x
SetCap x (expr -> SetExplicit []) -> pr x
SetCap x y -> pr x ++ " ∩ " ++ pr y
SetMinus x y -> pr x ++ " ∖ " ++ pr y
BlnEQ x y -> pr x ++ " = " ++ pr y
BlnNEQ x y -> pr x ++ " ≠ " ++ pr y
BlnGE x y -> pr x ++ " > " ++ pr y
BlnGEQ x y -> pr x ++ " ≥ " ++ pr y
BlnLE x y -> pr x ++ " < " ++ pr y
BlnLEQ x y -> pr x ++ " < " ++ pr y
BlnElem x y -> pr x ++ " ≤ " ++ pr y
BlnOr x y -> pr x ++ " ∨ " ++ pr y
BlnAnd x y -> pr x ++ " ∧ " ++ pr y
BlnImpl x y -> pr x ++ " → " ++ pr y
BlnEquiv x y -> pr x ++ " ↔ " ++ pr y
LtlRNext x y -> "X [ " ++ pr x ++ " ] " ++ pr y
LtlRGlobally x y -> "G [ " ++ pr x ++ " ] " ++ pr y
LtlRFinally x y -> "F [ " ++ pr x ++ " ] " ++ pr y
LtlUntil x y -> pr x ++ " U " ++ pr y
LtlWeak x y -> pr x ++ " W " ++ pr y
LtlRelease x y -> pr x ++ " R " ++ pr y
Colon x y -> pr x ++ " : " ++ pr y
Pattern x y -> pr x ++ " ~ " ++ pr y
SetRange x y z -> "[ " ++ pr x ++ ", " ++ pr y ++ " .. " ++ pr z ++ " ]"
SetExplicit [] -> "∅"
SetExplicit [x] -> "{ " ++ pr x ++ " }"
SetExplicit (x:xr) -> "{ " ++ pr x ++ concatMap ((',':) . (' ':) . pr) xr ++ "}"
NumRPlus xs x -> "Σ [ " ++ concatMap (flip (++) " " . pr) xs ++ "] " ++ pr x
NumRMul xs x -> "Π [" ++ concatMap (flip (++) " " . pr) xs ++ "] " ++ pr x
SetRCup xs x -> "⋃ [" ++ concatMap (flip (++) " " . pr) xs ++ "] " ++ pr x
SetRCap xs x -> "⋂ [" ++ concatMap (flip (++) " " . pr) xs ++ "] " ++ pr x
BlnROr xs x -> "⋁ [" ++ concatMap (flip (++) " " . pr) xs ++ "] " ++ pr x
BlnRAnd xs x -> "⋀ [ " ++ concatMap (flip (++) " " . pr) xs ++ "] " ++ pr x
-----------------------------------------------------------------------------