------------------------------------------------------------------------------ |-- Module : Language.CSPM.AST-- Copyright : (c) Fontaine 2008-- License : BSD-- -- Maintainer : Fontaine@cs.uni-duesseldorf.de-- Stability : experimental-- Portability : GHC-only---- This Module defines an Abstract Syntax Tree for CSPM.-- This is the AST that is computed by the parser.-- For historycal reasons, it is rather unstructured{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}moduleLanguage.CSPM.ASTwhereimportLanguage.CSPM.TokenimportLanguage.CSPM.SrcLoc(SrcLoc(..))importData.Typeable(Typeable)importData.Generics.Basics(Data)importData.Generics.Instances()importData.IntMap(IntMap)importData.Map(Map)importData.Array.IArraytypeAstAnnotationx=IntMapxtypeBindings=MapStringUniqueIdenttypeFreeNames=IntMapUniqueIdentnewtypeNodeId=NodeId{unNodeId::Int}deriving(Show,Eq,Ord,Enum,Ix,Typeable,Data)mkNodeId::Int->NodeIdmkNodeId=NodeIddataLabeledt=Labeled{nodeId::NodeId,srcLoc::SrcLoc,unLabel::t}deriving(Typeable,Data,Show)instanceEq(Labeledt)where(==)ab=(nodeIda)==(nodeIdb)instanceOrd(Labeledt)wherecompareab=compare(nodeIda)(nodeIdb)-- | wrap a node with a dummyLabel-- | todo: redo we need a specal case in DataConstructor Labeled-- | also rename to unLabeledlabeled::t->Labeledtlabeledt=Labeled{--error use hashfunction here nodeId=NodeId(-1)--error "unknown nodeId",unLabel=t,srcLoc=NoLocation}setNode::Labeledt->y->LabeledysetNodeln=l{unLabel=n}typeLIdent=LabeledIdentdataIdent=Ident{unIdent::String}|UIdent{unUIdent::UniqueIdent}deriving(Show,Eq,Ord,Typeable,Data)identId::LIdent->IntidentId=uniqueIdentId.unUIdent.unLabeldataUniqueIdent=UniqueIdent{uniqueIdentId::Int,bindingSide::NodeId,bindingLoc::SrcLoc,idType::IDType,realName::String,newName::String,prologMode::PrologMode,bindType::BindType}deriving(Show,Eq,Ord,Typeable,Data)dataIDType=VarID|ChannelID|NameTypeID|FunIDInt|ConstrIDString|DataTypeID|TransparentIDderiving(Show,Eq,Ord,Typeable,Data){- actually BindType and PrologMode are semantically aquivalent -}dataBindType=LetBound|NotLetBoundderiving(Show,Eq,Ord,Typeable,Data)isLetBound::BindType->BoolisLetBoundx=x==LetBounddataPrologMode=PrologGround|PrologVariablederiving(Show,Eq,Ord,Typeable,Data)typeLModule=LabeledModuledataModule=Module{moduleDecls::[LDecl],moduleTokens::Maybe[Token]}deriving(Show,Eq,Ord,Typeable,Data){-
LProc is just a typealias for better readablility
todo : maybe use a real type
-}typeLProc=LExp-- expressionstypeLExp=LabeledExpdataExp=VarLIdent|IntExpInteger|SetEnum[LExp]|ListEnum[LExp]|SetOpenLExp|ListOpenLExp|SetClose(LExp,LExp)|ListClose(LExp,LExp)|SetComprehension([LExp],[LCompGen])|ListComprehension([LExp],[LCompGen])|ClosureComprehension([LExp],[LCompGen])|Let[LDecl]LExp|IfteLExpLExpLExp|CallFunctionLExp[[LExp]]|CallBuiltInLBuiltIn[[LExp]]|Lambda[LPattern]LExp|Stop|Skip|CTrue|CFalse|Events|BoolSet|IntSet|TupleExp[LExp]|ParensLExp|AndExpLExpLExp|OrExpLExpLExp|NotExpLExp|NegExpLExp|Fun1LBuiltInLExp|Fun2LBuiltInLExpLExp|DotTuple[LExp]|Closure[LExp]|ProcSharingLExpLProcLProc|ProcAParallelLExpLExpLProcLProc|ProcLinkParallelLLinkListLProcLProc|ProcRenaming[LRename]LProc|ProcRenamingComprehension[LRename][LCompGen]LProc|ProcRepSequenceLCompGenListLProc|ProcRepInternalChoiceLCompGenListLProc|ProcRepInterleaveLCompGenListLProc|ProcRepChoiceLCompGenListLProc|ProcRepAParallelLCompGenListLExpLProc|ProcRepLinkParallelLCompGenListLLinkListLProc|ProcRepSharingLCompGenListLExpLProc|PrefixExpLExp[LCommField]LProc-- only used in later stages|LetI[LDecl]FreeNamesLExp-- freenames of all localBound names|PrefixChanFreeNamesLExpLProc-- | PrefixI FreeNames LCommField LProc|LambdaIFreeNames[LPattern]LExp|ExprWithFreeNamesFreeNamesLExpderiving(Show,Eq,Ord,Typeable,Data)typeLCompGenList=Labeled[LCompGen]typeLCommField=LabeledCommFielddataCommField=InCommLPattern|InCommGuardedLPatternLExp|OutCommLExpderiving(Show,Eq,Ord,Typeable,Data)typeLLinkList=LabeledLinkListdataLinkList=LinkList[LLink]|LinkListComprehension[LCompGen][LLink]deriving(Show,Eq,Ord,Typeable,Data)typeLLink=LabeledLinkdataLink=LinkLExpLExpderiving(Show,Eq,Ord,Typeable,Data)typeLRename=LabeledRenamedataRename=RenameLExpLExpderiving(Show,Eq,Ord,Typeable,Data)typeLBuiltIn=LabeledBuiltIndataBuiltIn=BuiltInConstderiving(Show,Eq,Ord,Typeable,Data)lBuiltInToConst::LBuiltIn->ConstlBuiltInToConst=h.unLabelwhereh(BuiltInc)=c--generators inside a comprehension-expressiontypeLCompGen=LabeledCompGendataCompGen=GeneratorLPatternLExp|GuardLExpderiving(Show,Eq,Ord,Typeable,Data)typeLPattern=LabeledPatterndataPattern=IntPatInteger|TruePat|FalsePat|WildCard|ConstrPatLIdent|Also[LPattern]|Append[LPattern]|DotPat[LPattern]|SingleSetPatLPattern|EmptySetPat|ListEnumPat[LPattern]|TuplePat[LPattern]-- this the result of pattern-match-compilation|VarPatLIdent|Selectors{--origPat :: LPattern-- fixme this creates an infinite tree with SYB everywehre'selectors::ArrayIntSelector,idents::ArrayInt(MaybeLIdent)}|SelectorSelector(MaybeLIdent)deriving(Show,Eq,Ord,Typeable,Data){- a Selector is a path in a Pattern/Expression -}dataSelector=IntSelInteger|TrueSel|FalseSel|SelectThis|ConstSelUniqueIdent|DotSelIntIntSelector|SingleSetSelSelector|EmptySetSel|TupleLengthSelIntSelector|TupleIthSelIntSelector|ListLengthSelIntSelector|ListIthSelIntSelector|HeadSelSelector|HeadNSelIntSelector|PrefixSelIntIntSelector|TailSelSelector|SliceSelIntIntSelector|SuffixSelIntIntSelectorderiving(Show,Eq,Ord,Typeable,Data)typeLDecl=LabeledDecldataDecl=PatBindLPatternLExp|FunBindLIdent[FunCase]|AssertRefLExpStringLExp|AssertBoolLExp|Transparent[LIdent]|SubTypeLIdent[LConstructor]|DataTypeLIdent[LConstructor]|NameTypeLIdentLTypeDef|Channel[LIdent](MaybeLTypeDef)|PrintLExp-- | FunBindI LIdent FreeNames [FunCase]deriving(Show,Eq,Ord,Typeable,Data){-
We want to use 1) type FunArgs = [LPattern]
it is not clear why we used 2) type FunArgs = [[LPattern]]
If 1) works in the interpreter, we will refactor
Renaming , and prolog-interface to 1)
For now we just patch the AST Just before PatternCompilation
-}typeFunArgs=[[LPattern]]-- CSPM confusion of currying/tuplesdataFunCase=FunCaseFunArgsLExp-- osolete version|FunCaseI[LPattern]LExp-- newVersion for interpreterderiving(Show,Eq,Ord,Typeable,Data)typeLTypeDef=LabeledTypeDefdataTypeDef=TypeTuple[LExp]|TypeDot[LExp]deriving(Show,Eq,Ord,Typeable,Data)typeLConstructor=LabeledConstructordataConstructor=ConstructorLIdent(MaybeLTypeDef)deriving(Show,Eq,Ord,Typeable,Data){-
some helper functions
-}{- does not make sense if nodId should be unique -}instanceFunctorLabeledwherefmapfx=x{unLabel=f$unLabelx}withLabel::(NodeId->a->b)->Labeleda->LabeledbwithLabelfx=x{unLabel=f(nodeIdx)(unLabelx)}mkLabeledNode::(NodeIdSupplym)=>SrcLoc->t->m(Labeledt)mkLabeledNodelocnode=doi<-getNewNodeIdreturn$Labeled{nodeId=i,srcLoc=loc,unLabel=node}{-
-- user must supply a unique NodeId
unsafeMkLabeledNode :: NodeId -> SrcLoc -> t -> Labeled t
unsafeMkLabeledNode i loc node
= Labeled {
nodeId = i
,srcLoc = loc
,unLabel = node }
-}class(Monadm)=>NodeIdSupplymwheregetNewNodeId::mNodeIddataConst=F_true|F_false|F_not|F_and|F_or|F_union|F_inter|F_diff|F_Union|F_Inter|F_member|F_card|F_empty|F_set|F_Set|F_Seq|F_null|F_head|F_tail|F_concat-- fix confusing F_Concat|F_elem|F_length|F_STOP|F_SKIP|F_Events|F_Int|F_Bool|F_CHAOS|F_Concat-- fix confusing F_concat|F_Len2|F_Mult|F_Div|F_Mod|F_Add|F_Sub|F_Eq|F_NEq|F_GE|F_LE|F_LT|F_GT|F_Guard|F_Sequential|F_Interrupt|F_ExtChoice|F_Timeout|F_IntChoice|F_Interleave|F_Hidingderiving(Show,Eq,Ord,Typeable,Data)