TypeDecl.hs revision 2329a87b052e8aef57e419ed533751710a6be648
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzModule : $Header$
e9458b1a7a19a63aa4c179f9ab20f4d50681c168Jens ElknerCopyright : (c) Christian Maeder and Uni Bremen 2002-2005
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzMaintainer : maeder@tzi.de
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzStability : provisional
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzPortability : portable
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulzanalyse type declarations
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulzimport qualified Common.Lib.Map as Map
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulztoTypePattern :: (Id, [TypeArg]) -> TypePattern
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulztoTypePattern (i, tArgs) = TypePattern i tArgs nullRange
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzanaFormula :: GlobalAnnos -> Annoted Term
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz -> State Env (Maybe (Annoted Term, Annoted Term))
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzanaFormula ga at =
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz do rt <- resolve ga $ item at
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz Nothing -> return Nothing
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz mt <- typeCheck (Just unitType) t
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz return $ case mt of
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz Nothing -> Nothing
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz Just e -> Just (at { item = t }, at { item = e })
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzanaVars :: TypeEnv -> Vars -> Type -> Result [VarDecl]
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzanaVars _ (Var v) t = return [VarDecl v t Other nullRange]
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzanaVars te (VarTuple vs _) t =
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz let (topTy, ts) = getTypeAppl t
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz n = length ts
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz in if n > 1 && lesserType te topTy (toType $ productId n) then
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz if n == length vs then
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz let lrs = zipWith (anaVars te) vs ts
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz lms = map maybeResult lrs in
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz if all isJust lms then
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz return $ concatMap fromJust lms
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz else Result (concatMap diags lrs) Nothing
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz else mkError "wrong arity" topTy
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz else mkError "product type expected" topTy
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzmapAnMaybe :: (Monad m) => (a -> m (Maybe b)) -> [Annoted a] -> m [Annoted b]
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzmapAnMaybe f al =
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz do il <- mapAnM f al
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz return $ map ( \ a -> replaceAnnoted (fromJust $ item a) a) $
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz filter (isJust . item) il
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzanaTypeItems :: GlobalAnnos -> GenKind -> Instance -> [Annoted TypeItem]
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz -> State Env [Annoted TypeItem]
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzanaTypeItems ga gk inst l = do
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz ul <- mapAnMaybe ana1TypeItem l
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz tys <- mapM ( \ (Datatype d) -> dataPatToType d) $
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz filter ( \ t -> case t of
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz Datatype _ -> True
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz _ -> False) $ map item ul
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz rl <- mapAnMaybe (anaTypeItem ga gk inst tys) ul
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederaddDataSen :: [DataPat] -> State Env ()
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederaddDataSen tys = do
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder tm <- gets typeMap
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder let tis = map ( \ (DataPat i _ _ _) -> i) tys
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder ds = foldr ( \ i dl -> case Map.lookup i tm of
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder Just ti -> case typeDefn ti of
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder DatatypeDefn dd -> dd : dl
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder _ -> dl) [] tis
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder sen = NamedSen ("ga_" ++ showSepList (showString "_") showId tis "")
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder True True $ DatatypeSen ds
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder if null tys then return () else appendSentences [sen]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroederana1TypeItem :: TypeItem -> State Env (Maybe TypeItem)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroederana1TypeItem (Datatype d) =
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder do md <- ana1Datatype d
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder return $ fmap Datatype md
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroederana1TypeItem t = return $ Just t
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder-- | analyse a 'TypeItem'
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederanaTypeItem :: GlobalAnnos -> GenKind -> Instance -> [DataPat] -> TypeItem
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder -> State Env (Maybe TypeItem)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederanaTypeItem _ _ inst _ (TypeDecl pats kind ps) =
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder do cm <- gets classMap
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz let Result cs (Just rrk) = anaKindM kind cm
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz Result ds (Just is) = convertTypePatterns pats
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz addDiags $ cs ++ ds
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz let (rk, ak) = if null cs then (rrk, kind) else (rStar, universe)
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz mis <- mapM (addTypePattern NoTypeDefn inst (rk, [ak])) is
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz let newPats = map toTypePattern $ catMaybes mis
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz return $ if null newPats then Nothing else
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz Just $ TypeDecl newPats ak ps
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzanaTypeItem _ _ inst _ (SubtypeDecl pats t ps) =
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz do let Result ds (Just is) = convertTypePatterns pats
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz let Result es mp = anaTypeM (Nothing, t) te
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz Nothing -> do
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz mis <- mapM (addTypePattern NoTypeDefn inst
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz (rStar, [universe])) is
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz let nis = catMaybes mis
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz newPats = map toTypePattern nis
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz if null newPats then return Nothing else case t of
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz TypeToken tt -> do
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz let tid = simpleIdToId tt
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz newT = TypeName tid rStar 0
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz addTypeId False NoTypeDefn inst rStar universe tid
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz mapM_ (addSuperType newT universe) nis
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz return $ Just $ SubtypeDecl newPats newT ps
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz return $ Just $ TypeDecl newPats universe ps
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz Just (ak@(rk, _), newT) -> do
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder mis <- mapM (addTypePattern NoTypeDefn inst ak) is
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz let nis = catMaybes mis
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz mapM_ (addSuperType newT $ rawToKind rk) nis
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz return $ if null nis then Nothing else
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz Just $ SubtypeDecl (map toTypePattern nis) newT ps
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzanaTypeItem _ _ inst _ (IsoDecl pats ps) =
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz do let Result ds (Just is) = convertTypePatterns pats
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz mis <- mapM (addTypePattern NoTypeDefn inst (rStar, [universe])) is
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz let nis = catMaybes mis
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz mapM_ ( \ i -> mapM_ (addSuperType (TypeName i rStar 0)
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz universe) nis) $ map fst nis
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz return $ if null nis then Nothing else
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz Just $ IsoDecl (map toTypePattern nis) ps
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzanaTypeItem ga _ inst _ (SubtypeDefn pat v t f ps) =
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz do let Result ds m = convertTypePattern pat
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz Nothing -> return Nothing
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz Just (i, tArgs) -> do
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz tvs <- gets localTypeVars
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz newAs <- mapM anaddTypeVarDecl tArgs
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz mt <- anaStarType t
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz let nAs = catMaybes newAs
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz newPat = TypePattern i nAs nullRange
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz Nothing -> do
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz putLocalTypeVars tvs
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz return Nothing
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz Just ty -> do
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz-- newPty <- generalizeT $ TypeScheme nAs ty nullRange
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz let fullKind = typeArgsListToKind nAs universe
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz rk <- anaKind fullKind
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz let Result es mvds = anaVars e v $ monoType ty
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz putLocalTypeVars tvs
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz return Nothing
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz if cyclicType i ty then do
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz addDiags [mkDiag Error
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz "illegal recursive subtype definition" ty]
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz putLocalTypeVars tvs
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz return Nothing
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz else case mvds of
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Nothing -> altAct
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Just vds -> do
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz checkUniqueVars vds
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz vs <- gets localVars
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz mapM_ (addLocalVar True) vds
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz mf <- anaFormula ga f
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz putLocalVars vs
f54cad0338da90c6789bb9baae1caec50d994b3aEwaryst Schulz Nothing -> altAct
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Just (newF, _) -> do
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz addTypeId True NoTypeDefn
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz -- (Supertype v newPty $ item newF)
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz inst rk fullKind i
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz -- add a corresponding equation
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz addSuperType ty universe (i, nAs)
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz putLocalTypeVars tvs
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz return $ Just $ SubtypeDefn newPat v ty
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzanaTypeItem _ _ inst _ (AliasType pat mk sc ps) =
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz do let Result ds m = convertTypePattern pat
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz Nothing -> return Nothing
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz Just (i, tArgs) -> do
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz tvs <- gets localTypeVars -- save variables
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz newAs <- mapM anaddTypeVarDecl tArgs
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz (ik, mt) <- anaPseudoType mk sc
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz let nAs = catMaybes newAs
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Nothing -> do putLocalTypeVars tvs
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder Just (TypeScheme args ty qs) ->
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz if cyclicType i ty then
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz do addDiags [mkDiag Error
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz "illegal recursive type synonym" ty]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder putLocalTypeVars tvs
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz return Nothing
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz let allArgs = nAs++args
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz fullKind = typeArgsListToKind nAs ik
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz allSc = TypeScheme allArgs ty qs
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz rk <- anaKind fullKind
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz newPty <- generalizeT allSc
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz putLocalTypeVars tvs
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz b <- addTypeId True (AliasTypeDefn newPty)
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz inst rk fullKind i
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz return $ if b then Just $ AliasType
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder (TypePattern i [] nullRange)
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz (Just fullKind) newPty ps
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzanaTypeItem _ gk inst tys (Datatype d) =
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz do mD <- anaDatatype gk inst tys d
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Nothing -> return Nothing
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Just newD -> return $ Just $ Datatype newD
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulzana1Datatype :: DatatypeDecl -> State Env (Maybe DatatypeDecl)
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulzana1Datatype (DatatypeDecl pat kind alts derivs ps) =
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz do cm <- gets classMap
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz let Result cs (Just rk) = anaKindM kind cm
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz k = if null cs then kind else universe
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz addDiags $ checkKinds pat rStar rk ++ cs
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz let rms = map ( \ c -> anaKindM (ClassKind c) cm) derivs
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz mcs = map maybeResult rms
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz jcs = catMaybes mcs
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz newDerivs = map fst $ filter (isJust . snd) $ zip derivs mcs
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Result ds m = convertTypePattern pat
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz addDiags (ds ++ concatMap diags rms)
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz addDiags $ concatMap (checkKinds pat rStar) jcs
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Nothing -> return Nothing
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Just (i, tArgs) -> do
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz tvs <- gets localTypeVars
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder newAs <- mapM anaddTypeVarDecl tArgs
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder putLocalTypeVars tvs
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz let nAs = catMaybes newAs
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz fullKind = typeArgsListToKind nAs k
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder addDiags $ checkUniqueTypevars nAs
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder frk <- anaKind fullKind
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz b <- addTypeId False PreDatatype Plain frk fullKind i
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz return $ if b then Just $ DatatypeDecl
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz (TypePattern i nAs nullRange) k alts newDerivs ps
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzdataPatToType :: DatatypeDecl -> State Env DataPat
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzdataPatToType (DatatypeDecl (TypePattern i nAs _) k _ _ _) = do
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz rk <- anaKind k
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz return $ DataPat i nAs rk $ patToType i nAs rk
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzdataPatToType _ = error "dataPatToType"
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzaddDataSubtype :: DataPat -> Kind -> Type -> State Env ()
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzaddDataSubtype (DataPat _ nAs _ rt) k st =
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder TypeName i _ _ -> addSuperType rt k (i, nAs)
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz _ -> addDiags [mkDiag Warning "data subtype ignored" st]
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz-- | analyse a 'DatatypeDecl'
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzanaDatatype :: GenKind -> Instance -> [DataPat]
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz -> DatatypeDecl -> State Env (Maybe DatatypeDecl)
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzanaDatatype genKind inst tys
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz d@(DatatypeDecl (TypePattern i nAs _) k alts _ _) =
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz do dt@(DataPat _ _ rk rt) <- dataPatToType d
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz let fullKind = typeArgsListToKind nAs k
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz frk <- anaKind fullKind
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder tvs <- gets localTypeVars
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz mapM_ (addTypeVarDecl False) nAs
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder mNewAlts <- fromResult $ anaAlts tys dt (map item alts)
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz case mNewAlts of
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Nothing -> do
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz putLocalTypeVars tvs
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz return Nothing
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Just newAlts -> do
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder mapM_ (addDataSubtype dt fullKind) $ foldr
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz ( \ (Construct mc ts _ _) l -> case mc of
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz Nothing -> ts ++ l
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz Just _ -> l) [] newAlts
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz let srt = generalize nAs rt
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz mapM_ ( \ (Construct mc tc p sels) -> case mc of
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz Nothing -> return ()
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz let sc = TypeScheme nAs
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz (getFunType srt p tc) nullRange
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder addOpId c sc [] (ConstructData i)
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz mapM_ ( \ (Select ms ts pa) -> case ms of
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz let selSc = TypeScheme nAs
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz (getSelType srt pa ts) nullRange
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder addOpId s selSc []
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz $ SelectData [ConstrInfo c sc] i
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz Nothing -> return False) $ concat sels) newAlts
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz let de = DataEntry Map.empty i genKind (genTypeArgs nAs) rk newAlts
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz addTypeId True (DatatypeDefn de) inst frk fullKind i
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz appendSentences $ makeDataSelEqs de srt
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz putLocalTypeVars tvs
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz return $ Just d
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzanaDatatype _ _ _ _ = error "anaDatatype (not preprocessed)"
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz-- | analyse a pseudo type (represented as a 'TypeScheme')
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzanaPseudoType :: Maybe Kind -> TypeScheme -> State Env (Kind, Maybe TypeScheme)
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzanaPseudoType mk (TypeScheme tArgs ty p) =
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz do cm <- gets classMap
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz let k = case mk of
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Nothing -> Nothing
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Just j -> let Result cs _ = anaKindM j cm
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz in Just $ if null cs then j else universe
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz nAs <- mapM anaddTypeVarDecl tArgs
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz let ntArgs = catMaybes nAs
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz mp <- anaType (Nothing, ty)
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Nothing -> return ( universe, Nothing)
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Just ((_, sks), newTy) -> case sks of
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz let newK = typeArgsListToKind ntArgs sk
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz irk <- anaKind newK
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Nothing -> return ()
dde363c92873e122a139e2db23862dfd7d265b73Ewaryst Schulz Just j -> do grk <- anaKind j
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz addDiags $ checkKinds ty grk irk
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder return (newK, Just $ TypeScheme ntArgs newTy p)
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz _ -> return ( universe, Nothing)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder-- | add a type pattern
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzaddTypePattern :: TypeDefn -> Instance -> (RawKind, [Kind])
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz -> (Id, [TypeArg]) -> State Env (Maybe (Id, [TypeArg]))
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzaddTypePattern defn inst (_, ks) (i, tArgs) =
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz nonUniqueKind ks i $ \ kind -> do
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder tvs <- gets localTypeVars
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz newAs <- mapM anaddTypeVarDecl tArgs
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz let nAs = catMaybes newAs
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder fullKind = typeArgsListToKind nAs kind
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz putLocalTypeVars tvs
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz addDiags $ checkUniqueTypevars nAs
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder frk <- anaKind fullKind
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz b <- addTypeId True defn inst frk fullKind i
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz return $ if b then Just (i, nAs) else Nothing
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz-- | convert type patterns
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzconvertTypePatterns :: [TypePattern] -> Result [(Id, [TypeArg])]
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzconvertTypePatterns [] = Result [] $ Just []
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzconvertTypePatterns (s:r) =
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz let Result d m = convertTypePattern s
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz Result ds (Just l) = convertTypePatterns r
e9f0cd6ee7be0336cfd071df0451d6282cf55d75Ewaryst Schulz Nothing -> Result (d++ds) $ Just l
e9f0cd6ee7be0336cfd071df0451d6282cf55d75Ewaryst Schulz Just i -> Result (d++ds) $ Just (i:l)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederillegalTypePattern, illegalTypePatternArg, illegalTypeId
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz :: TypePattern -> Result a
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzillegalTypePattern tp = mkError "illegal type pattern" tp
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzillegalTypePatternArg tp = mkError "illegal type pattern argument" tp
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzillegalTypeId tp = mkError "illegal type pattern identifier" tp
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder-- | convert a 'TypePattern'
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederconvertTypePattern :: TypePattern -> Result (Id, [TypeArg])
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzconvertTypePattern (TypePattern t as _) = return (t, as)
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzconvertTypePattern tp@(TypePatternToken t) =
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz if isPlace t then illegalTypePattern tp
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz else return (simpleIdToId t, [])
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzconvertTypePattern tp@(MixfixTypePattern
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder [ra, ri@(TypePatternToken inTok), rb]) =
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz if head (tokStr inTok) `elem` signChars
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz then let inId = Id [Token place $ getRange ra, inTok,
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder Token place $ getRange rb] [] nullRange in
e9f0cd6ee7be0336cfd071df0451d6282cf55d75Ewaryst Schulz case (ra, rb) of
e9f0cd6ee7be0336cfd071df0451d6282cf55d75Ewaryst Schulz (TypePatternToken (Token "__" _),
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz TypePatternToken (Token "__" _)) -> return (inId, [])
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder _ -> do a <- convertToTypeArg ra
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz b <- convertToTypeArg rb
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz return (inId, [a, b])
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder else case ra of
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz TypePatternToken t1 -> do
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz a <- convertToTypeArg ri
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder b <- convertToTypeArg rb
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder return (simpleIdToId t1, [a, b])
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder _ -> illegalTypePattern tp
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzconvertTypePattern tp@(MixfixTypePattern (TypePatternToken t1 : rp)) =
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz if isPlace t1 then
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz [TypePatternToken inId, TypePatternToken t2] ->
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz if isPlace t2 && head (tokStr inId) `elem` signChars
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz then return (Id [t1,inId,t2] [] nullRange, [])
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder else illegalTypePattern tp
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz _ -> illegalTypePattern tp
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz else case rp of
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz [BracketTypePattern Squares as@(_:_) ps] -> do
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder is <- mapM convertToId as
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz return (Id [t1] is ps, [])
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz _ -> do as <- mapM convertToTypeArg rp
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz return (simpleIdToId t1, as)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederconvertTypePattern (BracketTypePattern bk [ap] ps) =
e9f0cd6ee7be0336cfd071df0451d6282cf55d75Ewaryst Schulz Parens -> convertTypePattern ap
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder _ -> let (o, c) = getBrackets bk
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz tid = Id [Token o ps, Token place $ getRange ap,
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz Token c ps] [] nullRange in
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz TypePatternToken t -> if isPlace t then
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz return (tid, [])
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder else return (tid, [TypeArg (simpleIdToId t) InVar MissingKind
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder rStar 0 Other nullRange])
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder _ -> do a <- convertToTypeArg ap
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz return (tid, [a])
e9f0cd6ee7be0336cfd071df0451d6282cf55d75Ewaryst SchulzconvertTypePattern tp = illegalTypePattern tp
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederconvertToTypeArg :: TypePattern -> Result TypeArg
e9f0cd6ee7be0336cfd071df0451d6282cf55d75Ewaryst SchulzconvertToTypeArg tp@(TypePatternToken t) =
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder if isPlace t then illegalTypePatternArg tp
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder else return $ TypeArg (simpleIdToId t) InVar MissingKind
e9f0cd6ee7be0336cfd071df0451d6282cf55d75Ewaryst Schulz rStar 0 Other nullRange
e9f0cd6ee7be0336cfd071df0451d6282cf55d75Ewaryst SchulzconvertToTypeArg (TypePatternArg a _) = return a
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzconvertToTypeArg (BracketTypePattern Parens [tp] _) = convertToTypeArg tp
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederconvertToTypeArg tp = illegalTypePatternArg tp
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzconvertToId :: TypePattern -> Result Id
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederconvertToId tp@(TypePatternToken t) =
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz if isPlace t then illegalTypeId tp
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz else return $ Id [t] [] nullRange
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzconvertToId (MixfixTypePattern []) = error "convertToId: MixfixTypePattern []"
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst SchulzconvertToId (MixfixTypePattern (hd:tps)) =
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz if null tps then convertToId hd
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz let (toks, comps) = break ( \ p ->
a3b8d685ae08bf3f83a6c2930e872183c487c844Ewaryst Schulz case p of BracketTypePattern Squares (_:_) _ -> True
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz _ -> False) tps
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz ts <- mapM convertToToks (hd:toks)
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz (is, ps) <- if null comps then return ([], nullRange)
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz else convertToIds $ head comps
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz pls <- if null comps then return []
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz else mapM convertToPlace $ tail comps
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz return $ Id (concat ts ++ pls) is ps
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzconvertToId tp = do
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz ts <- convertToToks tp
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz return $ Id ts [] nullRange
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst SchulzconvertToIds :: TypePattern -> Result ([Id], Range)
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst SchulzconvertToIds (BracketTypePattern Squares tps@(_:_) ps) = do
7594b91154e299c9bcecd2bd62698705b55f99e8Ewaryst Schulz is <- mapM convertToId tps
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz return (is, ps)
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzconvertToIds tp = illegalTypeId tp
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzconvertToToks :: TypePattern -> Result [Token]
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzconvertToToks (TypePatternToken t) = return [t]
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst SchulzconvertToToks (BracketTypePattern bk [tp] ps) = case bk of
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz Parens -> illegalTypeId tp
67f09e0fddea50c48620c011b6d001cffe565de6Ewaryst Schulz _ -> do let [o,c] = mkBracketToken bk ps
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz ts <- convertToToks tp
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz return (o : ts ++ [c])
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzconvertToToks(MixfixTypePattern tps) = do
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz ts <- mapM convertToToks tps
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz return $ concat ts
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzconvertToToks tp = illegalTypeId tp
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzconvertToPlace :: TypePattern -> Result Token
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzconvertToPlace tp@(TypePatternToken t) =
dde363c92873e122a139e2db23862dfd7d265b73Ewaryst Schulz if isPlace t then return t
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst Schulz else illegalTypeId tp
6c3ce177a0ad551edaae7daa17772b12f77a86daEwaryst SchulzconvertToPlace tp = illegalTypeId tp