TranslateAna.hs revision 4cb3813ac7109bc622190f6b4b24706ecd378751
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrseModule : $Header$
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrseCopyright : (c) Uni Bremen 2003
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrseLicence : similar to LGPL, see HetCATS/LICENCE.txt or LIZENZ.txt
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrseMaintainer : hets@tzi.de
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrseStability : experimental
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrsePortability : portable
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse Translation of the abstract syntax of HasCASL after the static analysis
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse to the abstract syntax of haskell.
d86ef5503dcbc38e87c0e03cd3e1f16458cb6323rse -- * Translation of an environment
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse translateAna
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse -- * Translation of a map of assumptions
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse , translateAssumps
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse , distinctOpIds
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse , translateTypeScheme
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse , translateType
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse , translateFunDef
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse -- ** Translation of terms
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse , translateTerm
d86ef5503dcbc38e87c0e03cd3e1f16458cb6323rse -- ** Translation of pattern
d86ef5503dcbc38e87c0e03cd3e1f16458cb6323rse , translatePattern
d86ef5503dcbc38e87c0e03cd3e1f16458cb6323rse -- * Translation of a map of types
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse , translateTypeMap
d86ef5503dcbc38e87c0e03cd3e1f16458cb6323rse , translateData
d86ef5503dcbc38e87c0e03cd3e1f16458cb6323rse , translateAltDefn
d86ef5503dcbc38e87c0e03cd3e1f16458cb6323rse , translateRecord
d86ef5503dcbc38e87c0e03cd3e1f16458cb6323rse -- * Testing
d86ef5503dcbc38e87c0e03cd3e1f16458cb6323rse , idToHaskell
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrseimport qualified Common.Lib.Map as Map hiding (map)
d86ef5503dcbc38e87c0e03cd3e1f16458cb6323rse-------------------------------------------------------------------------
d86ef5503dcbc38e87c0e03cd3e1f16458cb6323rse-- Translation of an HasCASL-Environement
d86ef5503dcbc38e87c0e03cd3e1f16458cb6323rse-------------------------------------------------------------------------
d86ef5503dcbc38e87c0e03cd3e1f16458cb6323rse-- | Converts an abstract syntax of HasCASL (after the static analysis)
d86ef5503dcbc38e87c0e03cd3e1f16458cb6323rse-- to the top datatype of the abstract syntax of haskell.
d86ef5503dcbc38e87c0e03cd3e1f16458cb6323rse-- Calls 'translateTypeMap' and 'translateAssumps'.
d86ef5503dcbc38e87c0e03cd3e1f16458cb6323rsetranslateAna :: Env -> [HsDecl]
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse--translateAna env = error (show env)
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrsetranslateAna env =
6ace32dacb8313226eb9019275d0e4fa45a15148rse ((translateTypeMap (typeMap env)) ++
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse (translateAssumps (assumps env) (typeMap env))) -- [HsDecl]
a943533fd4d91d114af622731a405407990c4fb1rse-------------------------------------------------------------------------
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse-- Translation of types
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse-------------------------------------------------------------------------
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse-- | Converts all HasCASL types to data or type declarations in haskell.
7933d4a963def02417113b6798d87a36395053b0rse-- Uses 'translateData'.
7933d4a963def02417113b6798d87a36395053b0rsetranslateTypeMap :: TypeMap -> [HsDecl]
7933d4a963def02417113b6798d87a36395053b0rsetranslateTypeMap m = concat $ map translateData (Map.assocs m)
7933d4a963def02417113b6798d87a36395053b0rse-- | Converts one type to a data or type declaration in haskell.
7933d4a963def02417113b6798d87a36395053b0rse-- Uses 'translateIdWithType'.
7933d4a963def02417113b6798d87a36395053b0rsetranslateData :: (TypeId, TypeInfo) -> [HsDecl]
7933d4a963def02417113b6798d87a36395053b0rsetranslateData (tid,info) =
7933d4a963def02417113b6798d87a36395053b0rse let hsname = (HsIdent (translateIdWithType UpperId tid))
d1bb6e2664788e0437acc18e877562c9a796d7cerse len = length $ superTypes info
7933d4a963def02417113b6798d87a36395053b0rse in case (typeDefn info) of
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse NoTypeDefn ->
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse if len == 0 || (len == 1 && isSameId tid (head $ superTypes info))then
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse [(HsDataDecl nullLoc
7933d4a963def02417113b6798d87a36395053b0rse [] -- empty HsContext
7933d4a963def02417113b6798d87a36395053b0rse [] -- [HsName] no type arguments
7933d4a963def02417113b6798d87a36395053b0rse [(HsConDecl nullLoc hsname [])]
7933d4a963def02417113b6798d87a36395053b0rse [(UnQual $ HsIdent "Show")] -- [HsQName] (deriving ...)
7933d4a963def02417113b6798d87a36395053b0rse else (map (typeSynonym hsname)(superTypes info))
7933d4a963def02417113b6798d87a36395053b0rse Supertype _vars _ty _form ->[]
7933d4a963def02417113b6798d87a36395053b0rse DatatypeDefn _ typeargs altDefns ->
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse [(HsDataDecl nullLoc
7933d4a963def02417113b6798d87a36395053b0rse [] -- empty HsContext
7933d4a963def02417113b6798d87a36395053b0rse (map getArg typeargs) -- type arguments
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse (map translateAltDefn altDefns) -- [HsConDecl]
7933d4a963def02417113b6798d87a36395053b0rse [(UnQual $ HsIdent "Show")] -- [HsQName] (deriving ...)
7933d4a963def02417113b6798d87a36395053b0rse AliasTypeDefn ts ->
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse [(HsTypeDecl nullLoc
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse (getAliasArgs ts)
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse (getAliasType ts)
7933d4a963def02417113b6798d87a36395053b0rse TypeVarDefn -> [] -- are ignored in haskell
7933d4a963def02417113b6798d87a36395053b0rse PreDatatype -> error "translateData: unexpected PreDatatype"
7933d4a963def02417113b6798d87a36395053b0rseisSameId :: TypeId -> Type -> Bool
7933d4a963def02417113b6798d87a36395053b0rseisSameId tid (TypeName tid2 _ _) = tid == tid2
7933d4a963def02417113b6798d87a36395053b0rseisSameId _tid _ty = False
7933d4a963def02417113b6798d87a36395053b0rsetypeSynonym :: HsName -> Type -> HsDecl
7933d4a963def02417113b6798d87a36395053b0rsetypeSynonym hsname ty =
7933d4a963def02417113b6798d87a36395053b0rse HsTypeDecl nullLoc hsname [] (translateType ty)
7933d4a963def02417113b6798d87a36395053b0rse-- | Translation of an alternative constructor for a datatype definition.
7933d4a963def02417113b6798d87a36395053b0rse-- Uses 'translateRecord'.
7933d4a963def02417113b6798d87a36395053b0rsetranslateAltDefn :: AltDefn -> HsConDecl
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrsetranslateAltDefn (Construct uid ts _ []) =
7933d4a963def02417113b6798d87a36395053b0rse HsConDecl nullLoc
7933d4a963def02417113b6798d87a36395053b0rse (HsIdent (translateIdWithType UpperId uid))
7933d4a963def02417113b6798d87a36395053b0rse (map getType ts)
7933d4a963def02417113b6798d87a36395053b0rsetranslateAltDefn (Construct uid _ts _ sel) =
7933d4a963def02417113b6798d87a36395053b0rse HsRecDecl nullLoc
7933d4a963def02417113b6798d87a36395053b0rse (HsIdent (translateIdWithType UpperId uid))
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse (map translateRecord sel)
7933d4a963def02417113b6798d87a36395053b0rse-- | Translation one field label.
7933d4a963def02417113b6798d87a36395053b0rsetranslateRecord :: Selector -> ([HsName], HsBangType)
7933d4a963def02417113b6798d87a36395053b0rsetranslateRecord (Select opid t _) =
7933d4a963def02417113b6798d87a36395053b0rse ([(HsIdent (translateIdWithType LowerId opid))],
7933d4a963def02417113b6798d87a36395053b0rse getType t)
7933d4a963def02417113b6798d87a36395053b0rsegetType :: Type -> HsBangType
7933d4a963def02417113b6798d87a36395053b0rsegetType t = HsBangedTy (translateType t)
7933d4a963def02417113b6798d87a36395053b0rsegetAliasArgs :: TypeScheme -> [HsName]
7933d4a963def02417113b6798d87a36395053b0rsegetAliasArgs (TypeScheme arglist (_plist :=> _t) _poslist) =
7933d4a963def02417113b6798d87a36395053b0rse map getArg arglist
7933d4a963def02417113b6798d87a36395053b0rsegetArg :: TypeArg -> HsName
7933d4a963def02417113b6798d87a36395053b0rsegetArg (TypeArg tid _ _ _) = (HsIdent (translateIdWithType LowerId tid))
7933d4a963def02417113b6798d87a36395053b0rse-- ist UpperId oder LowerId hier richtig?
7933d4a963def02417113b6798d87a36395053b0rsegetAliasType :: TypeScheme -> HsType
7933d4a963def02417113b6798d87a36395053b0rsegetAliasType (TypeScheme _arglist (_plist :=> t) _poslist) = translateType t
7933d4a963def02417113b6798d87a36395053b0rse-------------------------------------------------------------------------
7933d4a963def02417113b6798d87a36395053b0rse-- Translation of functions
7933d4a963def02417113b6798d87a36395053b0rse-------------------------------------------------------------------------
7933d4a963def02417113b6798d87a36395053b0rse-- | Converts functions in HasCASL to the coresponding haskell declarations.
7933d4a963def02417113b6798d87a36395053b0rsetranslateAssumps :: Assumps -> TypeMap -> [HsDecl]
7933d4a963def02417113b6798d87a36395053b0rsetranslateAssumps as tm =
7933d4a963def02417113b6798d87a36395053b0rse let distList = distinctOpIds $ Map.toList as
7933d4a963def02417113b6798d87a36395053b0rse distAs = Map.fromList distList
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse in concat $ map (translateAssump distAs tm) $ distList
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse-- | Converts one distinct named function in HasCASL to the corresponding
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse-- haskell declaration.
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse-- Generates a definition (Prelude.undefined) for functions that are not
7933d4a963def02417113b6798d87a36395053b0rse-- defined in HasCASL.
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrsetranslateAssump :: Assumps -> TypeMap -> (Id,OpInfos) -> [HsDecl]
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrsetranslateAssump as tm (i, opinf) =
7933d4a963def02417113b6798d87a36395053b0rse let fname = translateIdWithType LowerId i
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse res = HsTypeSig nullLoc
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse [(HsIdent fname)]
7933d4a963def02417113b6798d87a36395053b0rse (translateTypeScheme (opType $ head $ opInfos opinf))
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse in case (opDefn $ head $ opInfos opinf) of
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse NoOpDefn _ -> [res, (functionUndef fname)]
7933d4a963def02417113b6798d87a36395053b0rse ConstructData _ -> [] -- Implicitly introduced by the datatype definition.
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse SelectData _ _ -> [] -- Implicitly introduced by the datatype definition.
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse Definition _ term ->
7933d4a963def02417113b6798d87a36395053b0rse (translateFunDef as tm i (opType $ head $ opInfos opinf) term)
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse VarDefn -> []
7933d4a963def02417113b6798d87a36395053b0rse-- | Translation of the result type of a typescheme to a haskell type.
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse-- Uses 'translateType'.
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrsetranslateTypeScheme :: TypeScheme -> HsQualType
7933d4a963def02417113b6798d87a36395053b0rsetranslateTypeScheme (TypeScheme _arglist (_plist :=> t) _poslist) =
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse HsUnQualType (translateType t)
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse-- The context (in the _plist) is not yet used in HasCASL
7933d4a963def02417113b6798d87a36395053b0rse-- arglist ??
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse-- | Translation of types (e.g. product type, type application ...).
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrsetranslateType :: Type -> HsType
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrsetranslateType t =
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse let err = error ("unexpected type: " ++ show t) in
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse FunType t1 _arr t2 _poslist -> HsTyFun (translateType t1) (translateType t2)
7933d4a963def02417113b6798d87a36395053b0rse ProductType tlist _poslist -> HsTyTuple (map translateType tlist)
0839d91ee551a0e19ea9577bb00976b97308dfddmartin LazyType lt _poslist -> translateType lt
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse MixfixType _ -> err
7933d4a963def02417113b6798d87a36395053b0rse KindedType kt _kind _poslist -> translateType kt
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse BracketType _ _ _ -> err
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse TypeToken _ -> err
7933d4a963def02417113b6798d87a36395053b0rse TypeAppl t1 t2 -> HsTyApp (translateType t1) (translateType t2)
0839d91ee551a0e19ea9577bb00976b97308dfddmartin TypeName tid _kind n ->
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse if n > 0 then
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse HsTyVar (HsIdent (translateIdWithType LowerId tid))
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse HsTyCon (UnQual (HsIdent (translateIdWithType UpperId tid)))
7933d4a963def02417113b6798d87a36395053b0rse-- | Generates a type signature and a definition of a function in haskell
7933d4a963def02417113b6798d87a36395053b0rse-- from the corresponding information in HasCASL.
7933d4a963def02417113b6798d87a36395053b0rsetranslateFunDef :: Assumps -> TypeMap -> Id -> TypeScheme -> Term -> [HsDecl]
d1bb6e2664788e0437acc18e877562c9a796d7cersetranslateFunDef as tm i ts term =
417f504d4d11631c0d062be85347f82a26c88677aaron let fname = translateIdWithType LowerId i
7933d4a963def02417113b6798d87a36395053b0rse in [HsTypeSig nullLoc
7933d4a963def02417113b6798d87a36395053b0rse [(HsIdent fname)]
af5dd1c93d2185f7e37f8783c593b64fd35ea8a6wrowe (translateTypeScheme ts)] ++
af5dd1c93d2185f7e37f8783c593b64fd35ea8a6wrowe [HsFunBind [HsMatch nullLoc
af5dd1c93d2185f7e37f8783c593b64fd35ea8a6wrowe (UnQual (HsIdent fname)) --HsName
af5dd1c93d2185f7e37f8783c593b64fd35ea8a6wrowe (getPattern term) -- [HsPat]
b79b480213d7452db127eec054e52eb2b4fa6153wrowe (getRhs as tm term) -- HsRhs
af5dd1c93d2185f7e37f8783c593b64fd35ea8a6wrowe [] -- {-where-} [HsDecl]
7933d4a963def02417113b6798d87a36395053b0rsegetPattern :: Term -> [HsPat]
7933d4a963def02417113b6798d87a36395053b0rsegetPattern _t = []
7933d4a963def02417113b6798d87a36395053b0rsegetRhs :: Assumps -> TypeMap -> Term -> HsRhs
a943533fd4d91d114af622731a405407990c4fb1rsegetRhs as tm t = HsUnGuardedRhs (translateTerm as tm t)
a943533fd4d91d114af622731a405407990c4fb1rseisConstructId :: Id -> [(Id,OpInfos)] -> Bool
2e79bb3add3d91814269824f948945d45b2b3260dougmisConstructId _ [] = False
a943533fd4d91d114af622731a405407990c4fb1rseisConstructId i ((i1,info1):idInfoList) =
a943533fd4d91d114af622731a405407990c4fb1rse if i == i1 then
a943533fd4d91d114af622731a405407990c4fb1rse or $ map isConstructor $ opInfos info1
a943533fd4d91d114af622731a405407990c4fb1rse else isConstructId i idInfoList
a943533fd4d91d114af622731a405407990c4fb1rseisConstructor :: OpInfo -> Bool
a943533fd4d91d114af622731a405407990c4fb1rseisConstructor o = case opDefn o of
2e79bb3add3d91814269824f948945d45b2b3260dougm ConstructData _ -> True
2e79bb3add3d91814269824f948945d45b2b3260dougm-- | Converts a term in HasCASL to an expression in haskell
2e79bb3add3d91814269824f948945d45b2b3260dougmtranslateTerm :: Assumps -> TypeMap -> Term -> HsExp
2e79bb3add3d91814269824f948945d45b2b3260dougmtranslateTerm as tm t =
a943533fd4d91d114af622731a405407990c4fb1rse let err = error ("Unexpected term: " ++ show t) in
a943533fd4d91d114af622731a405407990c4fb1rse QualVar v ty _pos ->
a943533fd4d91d114af622731a405407990c4fb1rse HsParen (HsExpTypeSig
a943533fd4d91d114af622731a405407990c4fb1rse (HsVar (UnQual (HsIdent (translateIdWithType LowerId v))))
72d7c23997c59e4195fe3ebc8ef48895773be0bcdougm (HsUnQualType $ translateType ty))
a943533fd4d91d114af622731a405407990c4fb1rse QualOp _ (InstOpId uid _types _) ts _pos ->
a943533fd4d91d114af622731a405407990c4fb1rse -- The identifier 'uid' may have been renamed. To find its new name,
a943533fd4d91d114af622731a405407990c4fb1rse -- the typescheme 'ts' is tested for "Unifizierbarkeit" with the
a943533fd4d91d114af622731a405407990c4fb1rse -- typeschemes of the assumps. If an identifier is found, it is used
a943533fd4d91d114af622731a405407990c4fb1rse -- as HsVar or HsCon.
a943533fd4d91d114af622731a405407990c4fb1rse let oid = findUniqueId uid ts tm as
a943533fd4d91d114af622731a405407990c4fb1rse in case oid of
a943533fd4d91d114af622731a405407990c4fb1rse if isConstructId i $ Map.toList as then
a943533fd4d91d114af622731a405407990c4fb1rse (HsCon (UnQual (HsIdent (translateIdWithType UpperId i))))
a943533fd4d91d114af622731a405407990c4fb1rse else (HsVar (UnQual (HsIdent (translateIdWithType LowerId i))))
a943533fd4d91d114af622731a405407990c4fb1rse _ -> error("Problem with finding of unique id: " ++ show t)
a943533fd4d91d114af622731a405407990c4fb1rse ApplTerm t1 t2 _pos ->
a943533fd4d91d114af622731a405407990c4fb1rse HsApp(translateTerm as tm t1)(HsParen $ translateTerm as tm t2)
a943533fd4d91d114af622731a405407990c4fb1rse TupleTerm ts _pos -> HsTuple (map (translateTerm as tm) ts)
a943533fd4d91d114af622731a405407990c4fb1rse TypedTerm t1 tqual ty _pos ->
a943533fd4d91d114af622731a405407990c4fb1rse let res = (HsExpTypeSig nullLoc
6d7efb8c76b56eaebd6032096771c9e44b247f3fdougm (translateTerm as tm t1)
544b377f935dac2238b3af7a1b84f3e955adb627dougm (HsUnQualType $ translateType ty)) in
a943533fd4d91d114af622731a405407990c4fb1rse case tqual of
e822d7a17076adc11a72b647028aa9755a035cf5dougm OfType -> HsParen res
a943533fd4d91d114af622731a405407990c4fb1rse AsType -> HsParen res
a943533fd4d91d114af622731a405407990c4fb1rse -- Here a HsExpTypeSig (t1::ty) is sufficient because supertypes
a943533fd4d91d114af622731a405407990c4fb1rse -- in HasCASL are converted to typesynonymes in haskell.
a943533fd4d91d114af622731a405407990c4fb1rse InType -> error ("Translation of \"InType\" not possible: " ++ show t)
a943533fd4d91d114af622731a405407990c4fb1rse QuantifiedTerm _quant _vars _t1 _pos -> -- forall ...
d28d7091912b3d911bdbe18df2d37d315681054bdougm error ("Translation of \"QuantifiedTerm\" not possible" ++ show t)
a943533fd4d91d114af622731a405407990c4fb1rse LambdaTerm pats _part t1 _pos ->
931b4fd1cc9dd3da096c45f4bf7ddcc14e0985c1dougm HsLambda nullLoc
a943533fd4d91d114af622731a405407990c4fb1rse (map (translatePattern as tm) pats)
a943533fd4d91d114af622731a405407990c4fb1rse (translateTerm as tm t1)
a943533fd4d91d114af622731a405407990c4fb1rse CaseTerm t1 progeqs _pos ->
a943533fd4d91d114af622731a405407990c4fb1rse HsCase (translateTerm as tm t1)
a943533fd4d91d114af622731a405407990c4fb1rse (map(translateCaseProgEq as tm)progeqs)
a943533fd4d91d114af622731a405407990c4fb1rse LetTerm _ progeqs t1 _pos ->
a943533fd4d91d114af622731a405407990c4fb1rse HsLet (map (translateLetProgEq as tm) progeqs)
a943533fd4d91d114af622731a405407990c4fb1rse (translateTerm as tm t1)
a943533fd4d91d114af622731a405407990c4fb1rse _ -> err -- ResolvedMixTerm, TermToken, MixfixTerm, BracketTerm
7933d4a963def02417113b6798d87a36395053b0rse-- | Conversion of patterns form HasCASL to haskell.
caaa9b08da1d1cc30fe9160109b883561e574932dougmtranslatePattern :: Assumps -> TypeMap -> Pattern -> HsPat
caaa9b08da1d1cc30fe9160109b883561e574932dougmtranslatePattern as tm pat =
931b4fd1cc9dd3da096c45f4bf7ddcc14e0985c1dougm let err = error ("unexpected pattern: " ++ show pat) in
caaa9b08da1d1cc30fe9160109b883561e574932dougm case pat of
caaa9b08da1d1cc30fe9160109b883561e574932dougm PatternVar (VarDecl v _ty _sepki _pos)
caaa9b08da1d1cc30fe9160109b883561e574932dougm -> HsPVar $ HsIdent $ translateIdWithType LowerId v
caaa9b08da1d1cc30fe9160109b883561e574932dougm PatternConstr (InstOpId uid _t _p) ts _pos ->
caaa9b08da1d1cc30fe9160109b883561e574932dougm let oid = findUniqueId uid ts tm as
caaa9b08da1d1cc30fe9160109b883561e574932dougm in case oid of
caaa9b08da1d1cc30fe9160109b883561e574932dougm if isConstructId i $ Map.toList as then
caaa9b08da1d1cc30fe9160109b883561e574932dougm HsPApp (UnQual $ HsIdent $ translateIdWithType UpperId i) []
caaa9b08da1d1cc30fe9160109b883561e574932dougm else HsPApp (UnQual $ HsIdent $ translateIdWithType LowerId i) []
caaa9b08da1d1cc30fe9160109b883561e574932dougm _ -> error ("Proplem with finding of unique id: " ++ show pat)
caaa9b08da1d1cc30fe9160109b883561e574932dougm ApplPattern p1 p2 _pos ->
931b4fd1cc9dd3da096c45f4bf7ddcc14e0985c1dougm let tp = translatePattern as tm p1
caaa9b08da1d1cc30fe9160109b883561e574932dougm a = translatePattern as tm p2
caaa9b08da1d1cc30fe9160109b883561e574932dougm in case tp of
caaa9b08da1d1cc30fe9160109b883561e574932dougm HsPApp u os -> HsPApp u (os ++ [a])
caaa9b08da1d1cc30fe9160109b883561e574932dougm _ -> error ("problematic application pattern " ++ show pat)
caaa9b08da1d1cc30fe9160109b883561e574932dougm TuplePattern pats _pos ->
a943533fd4d91d114af622731a405407990c4fb1rse HsPTuple $ map (translatePattern as tm) pats
a943533fd4d91d114af622731a405407990c4fb1rse TypedPattern p _ty _pos -> translatePattern as tm p
a943533fd4d91d114af622731a405407990c4fb1rse --the type is implicit
a943533fd4d91d114af622731a405407990c4fb1rse --AsPattern pattern pattern pos -> HsPAsPat name pattern ??
a943533fd4d91d114af622731a405407990c4fb1rse AsPattern _p1 _p2 _pos -> error "AsPattern nyi"
7933d4a963def02417113b6798d87a36395053b0rse-- | Translation of a programm equation of a case term in HasCASL
a943533fd4d91d114af622731a405407990c4fb1rsetranslateCaseProgEq :: Assumps -> TypeMap -> ProgEq -> HsAlt
6b025bd5a034790b2bb31236092265e154d6a565dougmtranslateCaseProgEq as tm (ProgEq pat t _pos) =
c41079a4104442a06991bf7fd0b69b36c3774058wrowe HsAlt nullLoc
d572c96f3a1c0f6b712bf2522352b929872a607edougm (translatePattern as tm pat)
6b025bd5a034790b2bb31236092265e154d6a565dougm (HsUnGuardedAlt (translateTerm as tm t))
a943533fd4d91d114af622731a405407990c4fb1rse-- | Translation of a programm equation of a let term in HasCASL
a943533fd4d91d114af622731a405407990c4fb1rsetranslateLetProgEq ::Assumps -> TypeMap -> ProgEq -> HsDecl
a943533fd4d91d114af622731a405407990c4fb1rsetranslateLetProgEq as tm (ProgEq pat t _pos) =
a943533fd4d91d114af622731a405407990c4fb1rse HsPatBind nullLoc
a943533fd4d91d114af622731a405407990c4fb1rse (translatePattern as tm pat)
a943533fd4d91d114af622731a405407990c4fb1rse (HsUnGuardedRhs (translateTerm as tm t))
a943533fd4d91d114af622731a405407990c4fb1rse-------------------------------------------------------------------------
a943533fd4d91d114af622731a405407990c4fb1rse-- some stuff
a943533fd4d91d114af622731a405407990c4fb1rse-------------------------------------------------------------------------
a943533fd4d91d114af622731a405407990c4fb1rse-- The positions in the source code are not necessary during the translation,
a943533fd4d91d114af622731a405407990c4fb1rse-- therefore the same SrcLoc is used everywhere.
a943533fd4d91d114af622731a405407990c4fb1rsenullLoc :: SrcLoc
a943533fd4d91d114af622731a405407990c4fb1rsenullLoc = SrcLoc 1 0
a943533fd4d91d114af622731a405407990c4fb1rse-- For the definition of an undefined function.
a943533fd4d91d114af622731a405407990c4fb1rse-- Takes the name of the function as argument.
574f6ff9ee80ef4f772649c5c8319b764a8abe42jerenkrantzfunctionUndef :: String -> HsDecl
a943533fd4d91d114af622731a405407990c4fb1rsefunctionUndef s =
a943533fd4d91d114af622731a405407990c4fb1rse HsPatBind nullLoc
a943533fd4d91d114af622731a405407990c4fb1rse (HsPVar (HsIdent s))
a943533fd4d91d114af622731a405407990c4fb1rse (HsUnGuardedRhs (HsVar (UnQual (HsIdent "undefined"))))
574f6ff9ee80ef4f772649c5c8319b764a8abe42jerenkrantz-------------------------------------------------------------------------
13bac43a0f21d8c6401debc1baa76be984474074rbb-- | Function for the test of the translation of identifiers.
13bac43a0f21d8c6401debc1baa76be984474074rbbidToHaskell :: AParser WrapString
a943533fd4d91d114af622731a405407990c4fb1rseidToHaskell = fmap (WrapString . translateId) parseId