OpDecl.hs revision 628310b42327ad76ce471caf0dde6563d6fa6307
bdc4fdc3b1e638eb2f5c0e08a577c9b1a042b506Kristina Sojakova Authors: Christian Maeder
bdc4fdc3b1e638eb2f5c0e08a577c9b1a042b506Kristina Sojakova analyse op decls
ea8e98e298f33f9362293f392c8fb192722b8904Eugen Kuksaimport HasCASL.PrintAs(showPretty)
ea8e98e298f33f9362293f392c8fb192722b8904Eugen Kuksaimport qualified Common.Lib.Map as Map
f20841e0b3d9311fd39f2615e43538214f720dd5Kristina SojakovamissingAna :: PrettyPrint a => a -> [Pos] -> State Env ()
f20841e0b3d9311fd39f2615e43538214f720dd5Kristina SojakovamissingAna t ps = appendDiags [Diag FatalError
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder ("no analysis yet for: " ++ showPretty t "")
f20841e0b3d9311fd39f2615e43538214f720dd5Kristina Sojakova $ if null ps then nullPos else head ps]
bdc4fdc3b1e638eb2f5c0e08a577c9b1a042b506Kristina SojakovaposOfOpId :: OpId -> Pos
109f89c82ec8769e9ec81bc967987b5deecdfd25Kristina SojakovaposOfOpId (OpId i _ _) = posOfId i
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederanaOpItem :: OpItem -> State Env ()
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederanaOpItem (OpDecl is sc attr _) =
109f89c82ec8769e9ec81bc967987b5deecdfd25Kristina Sojakova mapM_ (anaOpId sc attr) is
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederanaOpItem (OpDefn i _ _ _ _ _) = missingAna i [posOfOpId i]
3df50f2bdc19d6aa0d3ee0ecac5ad7ad785ddb45Kristina SojakovaanaOpId :: TypeScheme -> [OpAttr] -> OpId -> State Env ()
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederanaOpId (TypeScheme tvs q ps) attrs (OpId i args _) =
bdc4fdc3b1e638eb2f5c0e08a577c9b1a042b506Kristina Sojakova do let newArgs = args ++ tvs
bdc4fdc3b1e638eb2f5c0e08a577c9b1a042b506Kristina Sojakova sc = TypeScheme newArgs q ps
2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov appendDiags $ checkDifferentTypeArgs newArgs
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder (mk, newSc) <- anaTypeScheme sc
2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov Nothing -> return () -- induced error
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder Just k -> do checkKinds (posOfId i) k star
2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov addOpId i newSc attrs
2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovanaTypeScheme :: TypeScheme -> State Env (Maybe Kind, TypeScheme)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederanaTypeScheme (TypeScheme tArgs (q :=> ty) p) =
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder do tm <- getTypeMap -- save global variables
2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov mapM_ anaTypeVarDecl tArgs
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder (ik, newTy) <- anaType ty
2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov let newPty = TypeScheme tArgs (q :=> newTy) p
2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov putTypeMap tm -- forget local variables
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder return (ik, newPty)
2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovcheckDifferentTypeArgs :: [TypeArg] -> [Diagnosis]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedercheckDifferentTypeArgs l =
2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov let v = map (\ (TypeArg i _ _ _) -> i) l
2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov vd = filter ( not . null . tail) $ group $ sort v
f20841e0b3d9311fd39f2615e43538214f720dd5Kristina Sojakova in map ( \ vs -> mkDiag Error ("duplicate ids at '" ++
2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov showSepList (showString " ") shortPosShow
bdc4fdc3b1e638eb2f5c0e08a577c9b1a042b506Kristina Sojakova (map posOfId (tail vs)) "'"
f20841e0b3d9311fd39f2615e43538214f720dd5Kristina Sojakova ++ " for") (head vs)) vd
2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovshortPosShow :: Pos -> ShowS
2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovshortPosShow p = showParen True (shows (sourceLine p) . showString "," .
bdc4fdc3b1e638eb2f5c0e08a577c9b1a042b506Kristina Sojakova shows (sourceColumn p))
bdc4fdc3b1e638eb2f5c0e08a577c9b1a042b506Kristina SojakovaaddOpId :: UninstOpId -> TypeScheme -> [OpAttr] -> State Env ()
f20841e0b3d9311fd39f2615e43538214f720dd5Kristina SojakovaaddOpId i sc attrs = missingAna i [posOfId i]
109f89c82ec8769e9ec81bc967987b5deecdfd25Kristina Sojakovaunifiable :: TypeScheme -> TypeScheme -> State Env
3df50f2bdc19d6aa0d3ee0ecac5ad7ad785ddb45Kristina Sojakovaunifiable sc1 sc2 =
f20841e0b3d9311fd39f2615e43538214f720dd5Kristina Sojakova do t1 <- freshInst sc1
109f89c82ec8769e9ec81bc967987b5deecdfd25Kristina Sojakova t2 <- freshInst sc2
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederfreshInst (TypeScheme tArgs (q :=> t) _) =
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder do i <- getState
2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov setState (i + length tArgs)
2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov return $ subst (mkSubst tArgs i) t
2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatovtype Subst = Map.Map TypeId Type
2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovmkSubst :: [TypeArg] -> Integer -> Subst
2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovmkSubst (TypeArg v _ _ _:r) i =
2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov let tId = simpleIdToId $ mkSimpleId ("_var_" ++ show i)
2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov in Map.insert v (TypeName tId 0) $ mkSubst r (i+1)