Commit 9f135e47 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Fix warnings in genprimopcode

parent 9d013869
...@@ -189,6 +189,7 @@ gen_hs_source (Info defaults entries) = ...@@ -189,6 +189,7 @@ gen_hs_source (Info defaults entries) =
escape = concatMap (\c -> if c `elem` special then '\\':c:[] else c:[]) escape = concatMap (\c -> if c `elem` special then '\\':c:[] else c:[])
where special = "/'`\"@<" where special = "/'`\"@<"
pprTy :: Ty -> String
pprTy = pty pprTy = pty
where where
pty (TyF t1 t2) = pbty t1 ++ " -> " ++ pty t2 pty (TyF t1 t2) = pbty t1 ++ " -> " ++ pty t2
...@@ -253,14 +254,14 @@ gen_ext_core_source entries = ...@@ -253,14 +254,14 @@ gen_ext_core_source entries =
-- ext-core's Prims module again. -- ext-core's Prims module again.
tcKind "Any" _ = "Klifted" tcKind "Any" _ = "Klifted"
tcKind tc [] | last tc == '#' = "Kunlifted" tcKind tc [] | last tc == '#' = "Kunlifted"
tcKind tc [] | otherwise = "Klifted" tcKind _ [] | otherwise = "Klifted"
-- assumes that all type arguments are lifted (are they?) -- assumes that all type arguments are lifted (are they?)
tcKind tc (v:as) = "(Karrow Klifted " ++ tcKind tc as tcKind tc (_v:as) = "(Karrow Klifted " ++ tcKind tc as
++ ")" ++ ")"
valEnt (PseudoOpSpec {name=n, ty=t}) = valEntry n t valEnt (PseudoOpSpec {name=n, ty=t}) = valEntry n t
valEnt (PrimOpSpec {name=n, ty=t}) = valEntry n t valEnt (PrimOpSpec {name=n, ty=t}) = valEntry n t
valEnt _ = "" valEnt _ = ""
valEntry name ty = parens name (mkForallTy (freeTvars ty) (pty ty)) valEntry name' ty' = parens name' (mkForallTy (freeTvars ty') (pty ty'))
where pty (TyF t1 t2) = mkFunTy (pty t1) (pty t2) where pty (TyF t1 t2) = mkFunTy (pty t1) (pty t2)
pty (TyApp tc ts) = mkTconApp (mkTcon tc) (map pty ts) pty (TyApp tc ts) = mkTconApp (mkTcon tc) (map pty ts)
pty (TyUTup ts) = mkUtupleTy (map pty ts) pty (TyUTup ts) = mkUtupleTy (map pty ts)
...@@ -275,7 +276,7 @@ gen_ext_core_source entries = ...@@ -275,7 +276,7 @@ gen_ext_core_source entries =
mkForallTy [] t = t mkForallTy [] t = t
mkForallTy vs t = foldr mkForallTy vs t = foldr
(\ v s -> "Tforall " ++ (\ v s -> "Tforall " ++
(paren (quot v ++ ", " ++ vKind v)) ++ " " (paren (quote v ++ ", " ++ vKind v)) ++ " "
++ paren s) t vs ++ paren s) t vs
-- hack alert! -- hack alert!
...@@ -292,7 +293,7 @@ gen_ext_core_source entries = ...@@ -292,7 +293,7 @@ gen_ext_core_source entries =
tcUTuple n = paren $ "Tcon " ++ paren (qualify False $ "Z" tcUTuple n = paren $ "Tcon " ++ paren (qualify False $ "Z"
++ show n ++ "H") ++ show n ++ "H")
tyEnt (PrimTypeSpec {ty=(TyApp tc args)}) = " " ++ paren ("Tcon " ++ tyEnt (PrimTypeSpec {ty=(TyApp tc _args)}) = " " ++ paren ("Tcon " ++
(paren (qualify True tc))) (paren (qualify True tc)))
tyEnt _ = "" tyEnt _ = ""
...@@ -312,13 +313,13 @@ gen_ext_core_source entries = ...@@ -312,13 +313,13 @@ gen_ext_core_source entries =
stringLitTys = prefixes ["Addr"] stringLitTys = prefixes ["Addr"]
prefixes ps = filter (\ t -> prefixes ps = filter (\ t ->
case t of case t of
(PrimTypeSpec {ty=(TyApp tc args)}) -> (PrimTypeSpec {ty=(TyApp tc _args)}) ->
any (\ p -> p `isPrefixOf` tc) ps any (\ p -> p `isPrefixOf` tc) ps
_ -> False) _ -> False)
parens n ty = " (zEncodeString \"" ++ n ++ "\", " ++ ty ++ ")" parens n ty' = " (zEncodeString \"" ++ n ++ "\", " ++ ty' ++ ")"
paren s = "(" ++ s ++ ")" paren s = "(" ++ s ++ ")"
quot s = "\"" ++ s ++ "\"" quote s = "\"" ++ s ++ "\""
gen_latex_doc :: Info -> String gen_latex_doc :: Info -> String
gen_latex_doc (Info defaults entries) gen_latex_doc (Info defaults entries)
......
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