InstallBinaryTarget(hsp,$(INSTLIBDIR_GHC))
#endif /* DoInstall... */
-YaccRunWithExpectMsg(parser/hsparser,14,0)
+YaccRunWithExpectMsg(parser/hsparser,12,0)
UgenTarget(parser/constr)
UgenTarget(parser/binding)
-- They are eventually removed by the type checker.
| NegApp (HsExpr tyvar uvar id pat) -- negated expr
- id -- the negate id
+ (HsExpr tyvar uvar id pat) -- the negate id (in a HsVar)
| HsPar (HsExpr tyvar uvar id pat) -- parenthesised expr
* *
**********************************************************************/
-%token OCURLY CCURLY VCCURLY SEMI
-%token OBRACK CBRACK OPAREN CPAREN
-%token COMMA BQUOTE
+%token OCURLY CCURLY VCCURLY
+%token COMMA SEMI OBRACK CBRACK
+%token WILDCARD BQUOTE OPAREN CPAREN
/**********************************************************************
* *
**********************************************************************/
-%token DOTDOT DCOLON EQUAL
-%token LAMBDA VBAR RARROW
-%token LARROW MINUS
+%token DOTDOT DCOLON EQUAL LAMBDA
+%token VBAR RARROW LARROW
+%token AT LAZY DARROW
/**********************************************************************
/**********************************************************************
* *
* *
-* Valid symbols/identifiers which need to be recognised *
+* Special symbols/identifiers which need to be recognised *
* *
* *
**********************************************************************/
-%token WILDCARD AT LAZY BANG
+%token MINUS BANG
%token AS HIDING QUALIFIED
Operators must be left-associative at the same precedence for
precedence parsing to work.
*/
- /* 9 S/R conflicts on qop -> shift */
+ /* 8 S/R conflicts on qop -> shift */
oexp : oexp qop oexp %prec MINUS { $$ = mkinfixap($2,$1,$3); }
| dexp
;
| QUALIFIED { $$ = install_literal("qualified"); }
;
-/* DARROW BANG are valid varsyms */
+/* BANG are valid varsyms */
varsym_nominus : VARSYM
- | DARROW { $$ = install_literal("=>"); }
| BANG { $$ = install_literal("!"); }
;
U_negate nexp -> -- prefix negation
wlkExpr nexp `thenUgn` \ expr ->
- returnUgn (NegApp expr (Unqual SLIT("negate")) )
+ returnUgn (NegApp expr (HsVar (Qual SLIT("Prelude") SLIT("negate"))))
U_llist llist -> -- explicit list
wlkList rdExpr llist `thenUgn` \ exprs ->
\end{code}
ToDo: May want to arrange to return old interface for this module!
-ToDo: Builtin names which must be read.
ToDo: Deal with instances (instance version, this module on instance list ???)
\begin{code}
\begin{code}
{- TESTING:
-pprPIface (ParsedIface m ?? v mv usgs lcm exm ims lfx ltdm lvdm lids ldp)
+pprPIface (ParsedIface m ms v mv usgs lcm exm ims lfx ltdm lvdm lids ldp)
= ppAboves [
ppCat [ppPStr SLIT("interface"), ppPStr m, ppInt v,
case mv of { Nothing -> ppNil; Just n -> ppInt n }],
rnExpr (NegApp e n)
= rnExpr e `thenRn` \ (e', fvs_e) ->
- lookupValue n `thenRn` \ nname ->
- returnRn (NegApp e' nname, fvs_e `unionUniqSets` fv_set nname)
+ rnExpr n `thenRn` \ (n', fvs_n) ->
+ returnRn (NegApp e' n', fvs_e `unionUniqSets` fvs_n)
rnExpr (HsPar e)
= rnExpr e `thenRn` \ (e', fvs_e) ->
ppStr "merged with", ppPStr mod1]) $
ASSERT(mod1 == mod2)
ParsedIface mod1
- (True, unionBags files1 files2)
+ (True, unionBags files2 files1)
(panic "mergeIface: module version numbers")
(panic "mergeIface: source version numbers") -- Version numbers etc must be extracted from
(panic "mergeIface: usage version numbers") -- the merged file interfaces named above
import RnUtils ( RnEnv(..), extendLocalRnEnv,
lookupRnEnv, lookupGlobalRnEnv, lookupTcRnEnv,
unknownNameErr, badClassOpErr, qualNameErr,
- dupNamesErr, shadowedNameWarn, negateNameWarn
+ dupNamesErr, shadowedNameWarn
)
import Bag ( Bag, emptyBag, isEmptyBag, snocBag )
-> RnMonad x s [RnName]
newLocalNames str names_w_loc
- = mapRn (addWarnRn . negateNameWarn) negs `thenRn_`
- mapRn (addErrRn . qualNameErr str) quals `thenRn_`
+ = mapRn (addErrRn . qualNameErr str) quals `thenRn_`
mapRn (addErrRn . dupNamesErr str) dups `thenRn_`
mkLocalNames these
where
- negs = filter ((== Unqual SLIT("negate")).fst) names_w_loc
quals = filter (isQual.fst) names_w_loc
(these, dups) = removeDups cmp_fst names_w_loc
cmp_fst (a,_) (b,_) = cmp a b
) >>= \ (vals, tcs, unquals, fixes, errs, warns, _) ->
return (vals, tcs, imp_mods, unquals, fixes,
- errs, imp_warns `unionBags` warns)
+ imp_errs `unionBags` errs,
+ imp_warns `unionBags` warns)
where
the_imps = implicit_prel ++ src_imps
all_imps = implicit_qprel ++ the_imps
then [{- no "import Prelude" -}]
else [ImportDecl pRELUDE False Nothing Nothing prel_loc]
- prel_imps -- WDP: Just guessing on this defn... ToDo
- = [ imp | imp@(ImportDecl mod _ _ _ _) <- the_imps, fromPrelude mod ]
-
prel_loc = mkBuiltinSrcLoc
(uniq_imps, imp_dups) = removeDups cmp_mod the_imps
cmp_mod (ImportDecl m1 _ _ _ _) (ImportDecl m2 _ _ _ _) = cmpPString m1 m2
- qprel_imps = [ imp | imp@(ImportDecl mod True Nothing _ _) <- prel_imps ]
+ qprel_imps = [ imp | imp@(ImportDecl mod True Nothing _ _) <- src_imps,
+ fromPrelude mod ]
+
+ qual_mods = [ (qual_name mod as_mod, imp) | imp@(ImportDecl mod True as_mod _ _) <- src_imps ]
+ qual_name mod (Just as_mod) = as_mod
+ qual_name mod Nothing = mod
+
+ (_, qual_dups) = removeDups cmp_qual qual_mods
+ bad_qual_dups = filter (not . all_same_mod) qual_dups
+
+ cmp_qual (q1,_) (q2,_) = cmpPString q1 q2
+ all_same_mod ((q,ImportDecl mod _ _ _ _):rest)
+ = all has_same_mod rest
+ where
+ has_same_mod (q,ImportDecl mod2 _ _ _ _) = mod == mod2
+
imp_mods = [ mod | ImportDecl mod _ _ _ _ <- uniq_imps ]
+
imp_warns = listToBag (map dupImportWarn imp_dups)
`unionBags`
listToBag (map qualPreludeImportWarn qprel_imps)
+ imp_errs = listToBag (map dupQualImportErr bad_qual_dups)
doImports iface_cache i_info us []
= return (emptyBag, emptyBag, emptyBag, emptyBag, emptyBag, emptyBag, emptyBag)
(vals, tcs, ies_left) = do_builtin ies
-getOrigIEs (ParsedIface _ _ _ _ _ _ exps _ _ _ _ _ _) Nothing -- import all
+getOrigIEs (ParsedIface _ _ _ _ _ _ exps _ _ _ _ _ _) Nothing -- import all
= (map mkAllIE (eltsFM exps), [], emptyBag)
getOrigIEs (ParsedIface _ _ _ _ _ _ exps _ _ _ _ _ _) (Just (True, ies)) -- import hiding
= addShortWarnLocLine locn (\ sty ->
ppCat [ppStr "qualified import of prelude module", ppPStr m])
+dupQualImportErr ((q1,ImportDecl _ _ _ _ locn1):dup_quals) sty
+ = ppAboves (item1 : map dup_item dup_quals)
+ where
+ item1 = addShortErrLocLine locn1 (\ sty ->
+ ppCat [ppStr "multiple imports (from different modules) with same qualified name", ppPStr q1]) sty
+
+ dup_item (q,ImportDecl _ _ _ _ locn)
+ = addShortErrLocLine locn (\ sty ->
+ ppCat [ppStr "here was another import with qualified name", ppPStr q]) sty
+
unknownImpSpecErr ie imp_mod locn
= addShortErrLocLine locn (\ sty ->
ppBesides [ppStr "module ", ppPStr imp_mod, ppStr " does not export `", ppr sty (ie_name ie), ppStr "'"])
qualNameErr,
dupNamesErr,
shadowedNameWarn,
- multipleOccWarn,
- negateNameWarn
+ multipleOccWarn
) where
import Ubiq
multipleOccWarn (name, occs) sty
= ppBesides [ppStr "warning:multiple names used to refer to `", ppr sty name, ppStr "': ",
ppInterleave ppComma (map (ppr sty) occs)]
-
-negateNameWarn (name,locn)
- = addShortWarnLocLine locn ( \ sty ->
- ppBesides [ppStr "local binding of `negate' will be used for prefix `-'"])
\end{code}
tcExpr (HsPar expr) -- preserve parens so printing needn't guess where they go
= tcExpr expr
-tcExpr (NegApp expr n) = tcExpr (HsApp (HsVar n) expr)
+tcExpr (NegApp expr neg) = tcExpr (HsApp neg expr)
tcExpr (HsLam match)
= tcMatch match `thenTc` \ (match',lie,ty) ->
projects / ghc-hetmet.git / commitdiff