Commit ae57b05a authored by Björn Peemöller 's avatar Björn Peemöller
Browse files

The precendence in infix declarations is no longer optional in interfaces

parent 27ac926d
......@@ -99,7 +99,7 @@ interfaceCheck pEnv tcEnv tyEnv (Interface m _ ds) = reverse (errors s)
checkImport :: IDecl -> IC ()
checkImport (IInfixDecl p fix pr op) = checkPrecInfo check p op
where check (PrecInfo op' (OpPrec fix' pr')) =
op == op' && fix == fix' && (mkPrec pr) == pr'
op == op' && fix == fix' && pr == pr'
checkImport (HidingDataDecl p tc tvs)
= checkTypeInfo "hidden data type" check p tc
where check (DataType tc' n' _)
......
......@@ -75,7 +75,7 @@ iInfixDecl :: ModuleIdent -> OpPrecEnv -> QualIdent -> [IDecl] -> [IDecl]
iInfixDecl m pEnv op ds = case qualLookupP op pEnv of
[] -> ds
[PrecInfo _ (OpPrec fix pr)] ->
IInfixDecl NoPos fix (Just pr) (qualUnqualify m op) : ds
IInfixDecl NoPos fix pr (qualUnqualify m op) : ds
_ -> internalError "Exports.infixDecl"
typeDecl :: ModuleIdent -> TCEnv -> Export -> [IDecl] -> [IDecl]
......
......@@ -36,7 +36,6 @@ import Base.Types
-- environments
import Env.Interface
import Env.TypeConstructor (TCEnv, TypeInfo (..), qualLookupTC)
import Env.OpPrec (mkPrec)
import Env.Value (ValueEnv, ValueInfo (..), lookupValue, qualLookupValue)
-- other
......@@ -387,9 +386,9 @@ visitConstrIDecl mid tis (CS.ConOpDecl pos ids type1 ident type2)
--
visitOpIDecl :: CS.IDecl -> FlatState OpDecl
visitOpIDecl (CS.IInfixDecl _ fixi mprec op) = do
visitOpIDecl (CS.IInfixDecl _ fixi prec op) = do
op' <- visitQualIdent op
return $ Op op' (genFixity fixi) (mkPrec mprec)
return $ Op op' (genFixity fixi) prec
visitOpIDecl _ = internalError "GenFlatCurry.visitOpIDecl: no pattern match"
-------------------------------------------------------------------------------
......@@ -618,9 +617,9 @@ genOpDecls = fixities >>= mapM genOpDecl
--
genOpDecl :: CS.IDecl -> FlatState OpDecl
genOpDecl (CS.IInfixDecl _ fixity mprec qident) = do
genOpDecl (CS.IInfixDecl _ fix prec qident) = do
qname <- visitQualIdent qident
return $ Op qname (genFixity fixity) (mkPrec mprec)
return $ Op qname (genFixity fix) prec
genOpDecl _ = internalError "GenFlatCurry: no infix interface"
genFixity :: CS.Infix -> Fixity
......
......@@ -168,9 +168,8 @@ intfEnv bind (Interface m _ ds) = foldr (bind m) Map.empty ds
-- operator precedences
bindPrec :: ModuleIdent -> IDecl -> ExpPEnv -> ExpPEnv
bindPrec m (IInfixDecl _ fix mprec op) =
Map.insert (unqualify op) (PrecInfo (qualQualify m op)
(OpPrec fix (mkPrec mprec)))
bindPrec m (IInfixDecl _ fix prec op) =
Map.insert (unqualify op) (PrecInfo (qualQualify m op) (OpPrec fix prec))
bindPrec _ _ = id
bindTCHidden :: ModuleIdent -> IDecl -> ExpTCEnv -> ExpTCEnv
......
......@@ -21,6 +21,7 @@ import Curry.Syntax
import Base.Messages (internalError)
import Base.Types
import Env.OpPrec (mkPrec)
import Env.TypeConstructor (TCEnv, TypeInfo (..), qualLookupTC)
-- |A record containing data for a module 'm'
......@@ -63,8 +64,8 @@ genInfixDecls :: ModuleIdent -> [Decl] -> [IDecl]
genInfixDecls mident decls = concatMap genInfixDecl decls
where
genInfixDecl :: Decl -> [IDecl]
genInfixDecl (InfixDecl pos spec prec idents)
= map (IInfixDecl pos spec prec . qualifyWith mident) idents
genInfixDecl (InfixDecl pos spec mPrec idents)
= map (IInfixDecl pos spec (mkPrec mPrec) . qualifyWith mident) idents
genInfixDecl _ = []
-- ---------------------------------------------------------------------------
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment