OpDecl.hs revision e8ffec0fa3d3061061bdc16e44247b9cf96b050f
97018cf5fa25b494adffd7e9b4e87320dae6bf47Christian Maeder Authors: Christian Maeder
bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian Maeder analyse op decls
bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian Maederimport FiniteMap
bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian Maederimport HasCASL.PrintAs(showPretty)
5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian MaedermissingAna :: PrettyPrint a => a -> [Pos] -> State Env ()
33a5d53a412ba0a4e5847f7538d6da2e22bd116cChristian MaedermissingAna t ps = appendDiags [Diag FatalError
715ffaf874309df081d1e1cd8e05073fc1227729Christian Maeder ("no analysis yet for: " ++ showPretty t "")
e774ab5733a1d673b123b0e63b14dd533e6fd4fcChristian Maeder $ if null ps then nullPos else head ps]
62ecb1e7f8fd9573eea8369657de12c7bf9f4f25Christian MaederposOfOpId :: OpId -> Pos
62ecb1e7f8fd9573eea8369657de12c7bf9f4f25Christian MaederposOfOpId (OpId i _) = posOfId i
62ecb1e7f8fd9573eea8369657de12c7bf9f4f25Christian MaederanaOpItem :: OpItem -> State Env ()
62ecb1e7f8fd9573eea8369657de12c7bf9f4f25Christian MaederanaOpItem (OpDecl is sc attr _) =
62ecb1e7f8fd9573eea8369657de12c7bf9f4f25Christian Maeder mapM_ (anaOpId sc attr) is
62ecb1e7f8fd9573eea8369657de12c7bf9f4f25Christian MaederanaOpItem (OpDefn i _ _ _ _ _) = missingAna i [posOfOpId i]
62ecb1e7f8fd9573eea8369657de12c7bf9f4f25Christian MaederanaOpId :: TypeScheme -> [OpAttr] -> OpId -> State Env ()
62ecb1e7f8fd9573eea8369657de12c7bf9f4f25Christian MaederanaOpId (TypeScheme tvs q ps) attrs (OpId i args) =
62ecb1e7f8fd9573eea8369657de12c7bf9f4f25Christian Maeder do let newArgs = args ++ tvs
62ecb1e7f8fd9573eea8369657de12c7bf9f4f25Christian Maeder sc = TypeScheme newArgs q ps
717686b54b9650402e2ebfbaadf433eab8ba5171Christian Maeder appendDiags $ checkDifferentTypeArgs newArgs
717686b54b9650402e2ebfbaadf433eab8ba5171Christian Maeder (mk, newSc) <- anaTypeScheme Nothing sc
62ecb1e7f8fd9573eea8369657de12c7bf9f4f25Christian Maeder Nothing -> return () -- induced error
717686b54b9650402e2ebfbaadf433eab8ba5171Christian Maeder Just k -> if eqKind Compatible k star then
717686b54b9650402e2ebfbaadf433eab8ba5171Christian Maeder addOpId i newSc attrs
717686b54b9650402e2ebfbaadf433eab8ba5171Christian Maeder else addDiag $ mkDiag Error
62ecb1e7f8fd9573eea8369657de12c7bf9f4f25Christian Maeder ("wrong kind '" ++ showPretty k
62ecb1e7f8fd9573eea8369657de12c7bf9f4f25Christian Maeder "' of type for operation") i
62ecb1e7f8fd9573eea8369657de12c7bf9f4f25Christian MaedercheckDifferentTypeArgs :: [TypeArgs] -> [Diagnosis]
62ecb1e7f8fd9573eea8369657de12c7bf9f4f25Christian MaedercheckDifferentTypeArgs l =
62ecb1e7f8fd9573eea8369657de12c7bf9f4f25Christian Maeder let v :: [Id] = concatMap (\ (TypeArgs tas _)
717686b54b9650402e2ebfbaadf433eab8ba5171Christian Maeder -> map (\ (TypeArg i _ _ _) -> i) tas) l
b645cf3dc1e449038ed291bbd11fcc6e02b2fc7fChristian Maeder vd = filter ( not . null . tail) $ group $ sort v
ebcaad207cafc89eeb49d431f40de2ef4c48411cChristian Maeder in map ( \ vs -> mkDiag Error ("duplicate ids at '" ++
b645cf3dc1e449038ed291bbd11fcc6e02b2fc7fChristian Maeder showSepList (showString " ") shortPosShow
715ffaf874309df081d1e1cd8e05073fc1227729Christian Maeder (map posOfId (tail vs)) "'"
715ffaf874309df081d1e1cd8e05073fc1227729Christian Maeder ++ " for") (head vs)) vd
715ffaf874309df081d1e1cd8e05073fc1227729Christian MaedershortPosShow :: Pos -> ShowS
715ffaf874309df081d1e1cd8e05073fc1227729Christian MaedershortPosShow p = showParen True (shows (sourceLine p) . showString "," .
715ffaf874309df081d1e1cd8e05073fc1227729Christian Maeder shows (sourceColumn p))
715ffaf874309df081d1e1cd8e05073fc1227729Christian MaederaddOpId :: UninstOpId -> TypeScheme -> [OpAttr] -> State Env ()
715ffaf874309df081d1e1cd8e05073fc1227729Christian MaederaddOpId i sc attrs = missingAna i [posOfId i]