Commit f3998ec1 authored by partain's avatar partain

[project @ 1996-05-16 09:48:23 by partain]

Sansom changes through 960515
parent 5cf27e8f
......@@ -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)
......
......@@ -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
......
......@@ -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("!"); }
;
......
......@@ -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 ->
......
......@@ -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 }],
......
......@@ -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) ->
......
......@@ -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
......
......@@ -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
......
......@@ -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 "'"])
......
......@@ -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}
......@@ -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) ->
......
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