From: partain Date: Thu, 16 May 1996 09:48:49 +0000 (+0000) Subject: [project @ 1996-05-16 09:48:23 by partain] X-Git-Tag: Approximately_1000_patches_recorded~913 X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=f3998ec18fd0f3d56b377d41e2a2958aaf9460ec [project @ 1996-05-16 09:48:23 by partain] Sansom changes through 960515 --- diff --git a/ghc/compiler/Jmakefile b/ghc/compiler/Jmakefile index 373757f..58072a1 100644 --- a/ghc/compiler/Jmakefile +++ b/ghc/compiler/Jmakefile @@ -820,7 +820,7 @@ MakeDirectories(install, $(INSTLIBDIR_GHC)) InstallBinaryTarget(hsp,$(INSTLIBDIR_GHC)) #endif /* DoInstall... */ -YaccRunWithExpectMsg(parser/hsparser,14,0) +YaccRunWithExpectMsg(parser/hsparser,12,0) UgenTarget(parser/constr) UgenTarget(parser/binding) diff --git a/ghc/compiler/hsSyn/HsExpr.lhs b/ghc/compiler/hsSyn/HsExpr.lhs index 65fd71e..55709ca 100644 --- a/ghc/compiler/hsSyn/HsExpr.lhs +++ b/ghc/compiler/hsSyn/HsExpr.lhs @@ -60,7 +60,7 @@ data HsExpr tyvar uvar id pat -- 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 diff --git a/ghc/compiler/parser/hsparser.y b/ghc/compiler/parser/hsparser.y index e2e9915..50ba88f 100644 --- a/ghc/compiler/parser/hsparser.y +++ b/ghc/compiler/parser/hsparser.y @@ -124,9 +124,9 @@ BOOLEAN inpat; * * **********************************************************************/ -%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 /********************************************************************** @@ -137,9 +137,9 @@ BOOLEAN inpat; * * **********************************************************************/ -%token DOTDOT DCOLON EQUAL -%token LAMBDA VBAR RARROW -%token LARROW MINUS +%token DOTDOT DCOLON EQUAL LAMBDA +%token VBAR RARROW LARROW +%token AT LAZY DARROW /********************************************************************** @@ -165,12 +165,12 @@ BOOLEAN inpat; /********************************************************************** * * * * -* 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 @@ -909,7 +909,7 @@ exp : oexp DCOLON ctype { $$ = mkrestr($1,$3); } 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 ; @@ -1430,9 +1430,8 @@ varid : VARID | QUALIFIED { $$ = install_literal("qualified"); } ; -/* DARROW BANG are valid varsyms */ +/* BANG are valid varsyms */ varsym_nominus : VARSYM - | DARROW { $$ = install_literal("=>"); } | BANG { $$ = install_literal("!"); } ; diff --git a/ghc/compiler/reader/ReadPrefix.lhs b/ghc/compiler/reader/ReadPrefix.lhs index 0aa0e50..b35b926 100644 --- a/ghc/compiler/reader/ReadPrefix.lhs +++ b/ghc/compiler/reader/ReadPrefix.lhs @@ -307,7 +307,7 @@ wlkExpr expr 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 -> diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs index 1a96999..743c83d 100644 --- a/ghc/compiler/rename/Rename.lhs +++ b/ghc/compiler/rename/Rename.lhs @@ -65,7 +65,6 @@ renameModule :: UniqSupply \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} @@ -218,7 +217,7 @@ makeHiMap (Just f) \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 }], diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs index d00312c..9b4a61b 100644 --- a/ghc/compiler/rename/RnExpr.lhs +++ b/ghc/compiler/rename/RnExpr.lhs @@ -228,8 +228,8 @@ rnExpr (OpApp e1 op e2) 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) -> diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs index 299a1f3..76fe13c 100644 --- a/ghc/compiler/rename/RnIfaces.lhs +++ b/ghc/compiler/rename/RnIfaces.lhs @@ -211,7 +211,7 @@ mergeIfaces (ParsedIface mod1 (_, files1) _ _ _ _ _ _ fixes1 tdefs1 vdefs1 idefs 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 diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs index cde9eef..9b7bf0f 100644 --- a/ghc/compiler/rename/RnMonad.lhs +++ b/ghc/compiler/rename/RnMonad.lhs @@ -43,7 +43,7 @@ import RnHsSyn ( RnName, mkRnName, mkRnUnbound, mkRnImplicit, import RnUtils ( RnEnv(..), extendLocalRnEnv, lookupRnEnv, lookupGlobalRnEnv, lookupTcRnEnv, unknownNameErr, badClassOpErr, qualNameErr, - dupNamesErr, shadowedNameWarn, negateNameWarn + dupNamesErr, shadowedNameWarn ) import Bag ( Bag, emptyBag, isEmptyBag, snocBag ) @@ -292,12 +292,10 @@ newLocalNames :: String -- Documentation string -> 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 diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index 0f70372..10ea30a 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/ghc/compiler/rename/RnNames.lhs @@ -348,7 +348,8 @@ doImportDecls iface_cache g_info us src_imps ) >>= \ (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 @@ -364,21 +365,35 @@ doImportDecls iface_cache g_info us src_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) @@ -516,7 +531,7 @@ getBuiltins (((b_val_names,b_tc_names),_,_,_),_,_,_) mod maybe_spec (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 @@ -807,6 +822,16 @@ qualPreludeImportWarn (ImportDecl m _ _ _ locn) = 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 "'"]) diff --git a/ghc/compiler/rename/RnUtils.lhs b/ghc/compiler/rename/RnUtils.lhs index ba38151..1825928 100644 --- a/ghc/compiler/rename/RnUtils.lhs +++ b/ghc/compiler/rename/RnUtils.lhs @@ -19,8 +19,7 @@ module RnUtils ( qualNameErr, dupNamesErr, shadowedNameWarn, - multipleOccWarn, - negateNameWarn + multipleOccWarn ) where import Ubiq @@ -203,9 +202,5 @@ shadowedNameWarn locn shadow 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} diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs index 594653b..fa2ff93 100644 --- a/ghc/compiler/typecheck/TcExpr.lhs +++ b/ghc/compiler/typecheck/TcExpr.lhs @@ -169,7 +169,7 @@ tcExpr (HsLit lit@(HsString str)) 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) ->