From 0cef3aef2b443ae02742d5543a403df66037c30f Mon Sep 17 00:00:00 2001 From: Tim Chevalier Date: Mon, 14 Apr 2008 02:54:07 +0000 Subject: [PATCH] Extra info in genprimopcode --make-ext-core-source The ext-core typechecker needs to know what types are valid for various kinds of literals, so I changed genprimopcode to dump out that information as well with --make-ext-core-source. --- utils/genprimopcode/Main.hs | 53 +++++++++++++++++++++++++++++++++++-------- 1 file changed, 43 insertions(+), 10 deletions(-) diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index 8cfbed3..e923755 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -190,7 +190,8 @@ gen_ext_core_source entries = ++ "-- This module is automatically generated by the GHC utility\n" ++ "-- \"genprimopcode\". Do not edit!\n" ++ "-----------------------------------------------------------------------\n" - ++ "module PrimEnv(primTcs, primVals) where\nimport Core\nimport Encoding\n\n" + ++ "module PrimEnv(primTcs, primVals, intLitTypes, ratLitTypes,\n" + ++ " charLitTypes, stringLitTypes) where\nimport Core\nimport Encoding\n\n" ++ "primTcs :: [(Tcon, Kind)]\n" ++ "primTcs = [\n" ++ printList tcEnt entries @@ -198,7 +199,24 @@ gen_ext_core_source entries = ++ "primVals :: [(Var, Ty)]\n" ++ "primVals = [\n" ++ printList valEnt entries + ++ "]\n" + ++ "intLitTypes :: [Ty]\n" + ++ "intLitTypes = [\n" + ++ printList tyEnt (intLitTys entries) + ++ "]\n" + ++ "ratLitTypes :: [Ty]\n" + ++ "ratLitTypes = [\n" + ++ printList tyEnt (ratLitTys entries) + ++ "]\n" + ++ "charLitTypes :: [Ty]\n" + ++ "charLitTypes = [\n" + ++ printList tyEnt (charLitTys entries) + ++ "]\n" + ++ "stringLitTypes :: [Ty]\n" + ++ "stringLitTypes = [\n" + ++ printList tyEnt (stringLitTys entries) ++ "]\n\n" + where printList f = concat . intersperse ",\n" . filter (not . null) . map f tcEnt (PrimTypeSpec {ty=t}) = case t of @@ -253,20 +271,35 @@ gen_ext_core_source entries = tapp s nextArg = paren $ "Tapp " ++ s ++ " " ++ paren nextArg tcUTuple n = paren $ "Tcon " ++ paren (qualify False $ "Z" ++ show n ++ "H") - -- more hacks. might be better to do this on the ext-core side, - -- as per earlier comment - qualify _ tc | tc == "ByteArr#" = qualify True "ByteArray#" - qualify _ tc | tc == "MutArr#" = qualify True "MutableArray#" - qualify _ tc | tc == "MutByteArr#" = + + tyEnt (PrimTypeSpec {ty=(TyApp tc args)}) = " " ++ paren ("Tcon " ++ + (paren (qualify True tc))) + tyEnt _ = "" + + -- more hacks. might be better to do this on the ext-core side, + -- as per earlier comment + qualify _ tc | tc == "ByteArr#" = qualify True "ByteArray#" + qualify _ tc | tc == "MutArr#" = qualify True "MutableArray#" + qualify _ tc | tc == "MutByteArr#" = qualify True "MutableByteArray#" - qualify _ tc | tc == "Bool" = "Just boolMname" ++ ", " + qualify _ tc | tc == "Bool" = "Just boolMname" ++ ", " ++ ze True tc - qualify _ tc | tc == "()" = "Just baseMname" ++ ", " + qualify _ tc | tc == "()" = "Just baseMname" ++ ", " ++ ze True tc - qualify enc tc = "Just primMname" ++ ", " ++ (ze enc tc) - ze enc tc = (if enc then "zEncodeString " else "") + qualify enc tc = "Just primMname" ++ ", " ++ (ze enc tc) + ze enc tc = (if enc then "zEncodeString " else "") ++ "\"" ++ tc ++ "\"" + intLitTys = prefixes ["Int", "Word", "Addr", "Char"] + ratLitTys = prefixes ["Float", "Double"] + charLitTys = prefixes ["Char"] + stringLitTys = prefixes ["Addr"] + prefixes ps = filter (\ t -> + case t of + (PrimTypeSpec {ty=(TyApp tc args)}) -> + any (\ p -> p `isPrefixOf` tc) ps + _ -> False) + parens n ty = " (zEncodeString \"" ++ n ++ "\", " ++ ty ++ ")" paren s = "(" ++ s ++ ")" quot s = "\"" ++ s ++ "\"" -- 1.7.10.4