1a38107941725211e7c3f051f7a8f5e12199f03acmaeder

18328fcbfe4296582227d42fdcf363f5a0fb8921Martin Kühl{- HetCATS/HasCASL/OpDecl.hs

e9458b1a7a19a63aa4c179f9ab20f4d50681c168Jens Elkner $Id$

a530dde7009b0a808300c420def741354a4d13d2Martin Kühl Authors: Christian Maeder

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühl Year: 2003

98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu Prodescu

18328fcbfe4296582227d42fdcf363f5a0fb8921Martin Kühl analyse op decls

18328fcbfe4296582227d42fdcf363f5a0fb8921Martin Kühl-}

18328fcbfe4296582227d42fdcf363f5a0fb8921Martin Kühl

18328fcbfe4296582227d42fdcf363f5a0fb8921Martin Kühlmodule HasCASL.OpDecl where

18328fcbfe4296582227d42fdcf363f5a0fb8921Martin Kühl

18328fcbfe4296582227d42fdcf363f5a0fb8921Martin Kühlimport HasCASL.As

18328fcbfe4296582227d42fdcf363f5a0fb8921Martin Kühlimport HasCASL.ClassAna

18328fcbfe4296582227d42fdcf363f5a0fb8921Martin Kühlimport HasCASL.ClassDecl

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühlimport HasCASL.TypeAna

3c8734f5b76d06ed1eae114c67e77066acb6a40bMartin Kühlimport HasCASL.TypeDecl

d021fa76efedeeb63529a82dd1cfd81911f4d03eChristian Maederimport Common.Id

3c8734f5b76d06ed1eae114c67e77066acb6a40bMartin Kühlimport HasCASL.Le

d021fa76efedeeb63529a82dd1cfd81911f4d03eChristian Maederimport Common.Lib.State

3c8734f5b76d06ed1eae114c67e77066acb6a40bMartin Kühlimport Common.Lib.Parsec.Pos

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühlimport qualified Common.Lib.Map as Map

6d498b6f56ed9f71cced898b6c42fb48f6e60583Adrián Riescoimport Common.Result

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühlimport Data.List

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühlimport Data.Maybe

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühlimport HasCASL.Unify

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühlimport HasCASL.MixAna

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühl

3c8734f5b76d06ed1eae114c67e77066acb6a40bMartin KühlposOfOpId :: OpId -> Pos

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin KühlposOfOpId (OpId i _ _) = posOfId i

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühl

3c8734f5b76d06ed1eae114c67e77066acb6a40bMartin KühlanaOpItem :: OpItem -> State Env ()

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin KühlanaOpItem (OpDecl is sc attr _) =

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühl mapM_ (anaOpId sc attr) is

3c8734f5b76d06ed1eae114c67e77066acb6a40bMartin Kühl

3c8734f5b76d06ed1eae114c67e77066acb6a40bMartin KühlanaOpItem (OpDefn o pats sc partial trm ps) =

3c8734f5b76d06ed1eae114c67e77066acb6a40bMartin Kühl do let newTrm = if null pats then trm else

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühl LambdaTerm pats partial trm ps

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühl (i, newSc) <- getUninstOpId sc o

3c8734f5b76d06ed1eae114c67e77066acb6a40bMartin Kühl Result ds mt <- resolveTerm newTrm

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühl appendDiags ds

0e9a56585859610db38a1f900d87ee8680ced4d0Martin Kühl case mt of

0e9a56585859610db38a1f900d87ee8680ced4d0Martin Kühl Just t -> addOpId i newSc [] $ Definition t

0e9a56585859610db38a1f900d87ee8680ced4d0Martin Kühl _ -> return ()

6f6549c13f912de12345850e4eb248ec358c1b43Adrián Riesco

6f6549c13f912de12345850e4eb248ec358c1b43Adrián RiescogetUninstOpId :: TypeScheme -> OpId -> State Env (UninstOpId, TypeScheme)

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin KühlgetUninstOpId (TypeScheme tvs q ps) (OpId i args _) =

18328fcbfe4296582227d42fdcf363f5a0fb8921Martin Kühl do let newArgs = args ++ tvs

3f9cd04710597ee787032a371f33861640ab2abeAdrián Riesco sc = TypeScheme newArgs q ps

521e1648b2c66064c41e9ac47bcd510356ed2355Adrián Riesco appendDiags $ checkDifferentTypeArgs newArgs

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühl (k, newSc) <- anaTypeScheme sc

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühl checkKindsS (posOfId i) k star

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühl return (i, newSc)

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühl

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühl

521e1648b2c66064c41e9ac47bcd510356ed2355Adrián RiescoanaOpId :: TypeScheme -> [OpAttr] -> OpId -> State Env ()

1a38107941725211e7c3f051f7a8f5e12199f03acmaederanaOpId sc attrs o =

3f9cd04710597ee787032a371f33861640ab2abeAdrián Riesco do (i, newSc) <- getUninstOpId sc o

c71a28752b8269572ba1de2e2230bb97a4dde6eaMartin Kühl addOpId i newSc attrs NoOpDefn

18328fcbfe4296582227d42fdcf363f5a0fb8921Martin Kühl

6858f9c9c8b077b2b574a9f30753cf5fec8124d6Martin KühlanaTypeScheme :: TypeScheme -> State Env (Kind, TypeScheme)

c71a28752b8269572ba1de2e2230bb97a4dde6eaMartin KühlanaTypeScheme (TypeScheme tArgs (q :=> ty) p) =

18328fcbfe4296582227d42fdcf363f5a0fb8921Martin Kühl do tm <- gets typeMap -- save global variables

6d498b6f56ed9f71cced898b6c42fb48f6e60583Adrián Riesco mapM_ anaTypeVarDecl tArgs

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühl (ik, newTy) <- anaTypeS (star, ty)

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühl let newPty = TypeScheme tArgs (q :=> newTy) p

e368ae35ce99348be3de4181acd7a6f4ce03fe0cChristian Maeder putTypeMap tm -- forget local variables

d021fa76efedeeb63529a82dd1cfd81911f4d03eChristian Maeder return (ik, newPty)

d021fa76efedeeb63529a82dd1cfd81911f4d03eChristian Maeder

b92e4eba198fcbffab302375b6c3527a8492bc66Adrián RiescocheckDifferentTypeArgs :: [TypeArg] -> [Diagnosis]

3c8734f5b76d06ed1eae114c67e77066acb6a40bMartin KühlcheckDifferentTypeArgs l =

3c8734f5b76d06ed1eae114c67e77066acb6a40bMartin Kühl let v = map (\ (TypeArg i _ _ _) -> i) l

3c8734f5b76d06ed1eae114c67e77066acb6a40bMartin Kühl vd = filter ( not . null . tail) $ group $ sort v

6858f9c9c8b077b2b574a9f30753cf5fec8124d6Martin Kühl in map ( \ vs -> mkDiag Error ("duplicate ids at '" ++

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühl showSepList (showString " ") shortPosShow

6f6549c13f912de12345850e4eb248ec358c1b43Adrián Riesco (map posOfId (tail vs)) "'"

8d9ff304e4ec23e883f4ed22b95e054d80c7fd70Martin Kühl ++ " for") (head vs)) vd

973f776b7e2729a4d87a4f2a657d037129b6d700Martin Kühl

973f776b7e2729a4d87a4f2a657d037129b6d700Martin KühlshortPosShow :: Pos -> ShowS

b22baa863f0a8bd4ac32a3e5fa7b476fc5aa78fdMartin KühlshortPosShow p = showParen True (shows (sourceLine p) . showString "," .

93da827a79b9d7122ed9bb5636a62bae43565b21Adrián Riesco shows (sourceColumn p))

6d498b6f56ed9f71cced898b6c42fb48f6e60583Adrián Riesco

18328fcbfe4296582227d42fdcf363f5a0fb8921Martin KühladdOpId :: UninstOpId -> TypeScheme -> [OpAttr] -> OpDefn -> State Env ()

3c8734f5b76d06ed1eae114c67e77066acb6a40bMartin KühladdOpId i sc attrs defn =

d021fa76efedeeb63529a82dd1cfd81911f4d03eChristian Maeder do as <- gets assumps

3c8734f5b76d06ed1eae114c67e77066acb6a40bMartin Kühl let l = Map.findWithDefault [] i as

18328fcbfe4296582227d42fdcf363f5a0fb8921Martin Kühl if sc `elem` map opType l then

3c8734f5b76d06ed1eae114c67e77066acb6a40bMartin Kühl addDiag $ mkDiag Warning

6f6549c13f912de12345850e4eb248ec358c1b43Adrián Riesco "repeated value" i

3c8734f5b76d06ed1eae114c67e77066acb6a40bMartin Kühl else do bs <- mapM (unifiable sc) $ map opType l

3c8734f5b76d06ed1eae114c67e77066acb6a40bMartin Kühl if or bs then addDiag $ mkDiag Error

6d498b6f56ed9f71cced898b6c42fb48f6e60583Adrián Riesco "illegal overloading of" i

d021fa76efedeeb63529a82dd1cfd81911f4d03eChristian Maeder else putAssumps $ Map.insert i

d021fa76efedeeb63529a82dd1cfd81911f4d03eChristian Maeder (OpInfo sc attrs defn : l ) as

1a38107941725211e7c3f051f7a8f5e12199f03acmaeder