[ci skip] includes: detabify/dewhitespace RtsAPI.h

[ghc.git] / utils / genprimopcode / Main.hs

diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs
index d60081f..bb40917 100644 (file)
--- a/utils/genprimopcode/Main.hs
+++ b/utils/genprimopcode/Main.hs
@@ -118,7 +118,7 @@ main = getArgs >>= \args ->
        do s <- getContents
           case parse s of
              Left err -> error ("parse error at " ++ (show err))
-             Right p_o_specs@(Info _ entries)
+             Right p_o_specs@(Info _ _)
                 -> seq (sanityTop p_o_specs) (
                    case head args of
 
@@ -187,9 +187,6 @@ main = getArgs >>= \args ->
                       "--make-haskell-source" 
                          -> putStr (gen_hs_source p_o_specs)
 
-                      "--make-ext-core-source"
-                         -> putStr (gen_ext_core_source entries)
-
                       "--make-latex-doc"
                          -> putStr (gen_latex_doc p_o_specs)
 
@@ -215,7 +212,6 @@ known_args
        "--primop-vector-tycons",
        "--make-haskell-wrappers",
        "--make-haskell-source",
-       "--make-ext-core-source",
        "--make-latex-doc"
      ]
 
@@ -246,12 +242,13 @@ gen_hs_source (Info defaults entries) =
         ++ "-----------------------------------------------------------------------------\n"
         ++ "{-# LANGUAGE MagicHash, MultiParamTypeClasses, NoImplicitPrelude, UnboxedTuples #-}\n"
         ++ "module GHC.Prim (\n"
-        ++ unlines (map (("\t" ++) . hdr) entries')
+        ++ unlines (map (("        " ++) . hdr) entries')
         ++ ") where\n"
     ++ "\n"
     ++ "{-\n"
         ++ unlines (map opt defaults)
     ++ "-}\n"
+    ++ "import GHC.Types (Coercible)\n"
         ++ unlines (concatMap ent entries') ++ "\n\n\n"
      where entries' = concatMap desugarVectorSpec entries
 
@@ -268,8 +265,6 @@ gen_hs_source (Info defaults entries) =
            hdr (PseudoOpSpec { name = n })                       = wrapOp n ++ ","
            hdr (PrimTypeSpec { ty = TyApp (TyCon n) _ })         = wrapTy n ++ ","
            hdr (PrimTypeSpec {})                                 = error $ "Illegal type spec"
-           hdr (PrimClassSpec { cls = TyApp (TyCon n) _ })       = wrapTy n ++ ","
-           hdr (PrimClassSpec {})                                = error "Illegal class spec"
            hdr (PrimVecTypeSpec { ty = TyApp (VecTyCon n _) _ }) = wrapTy n ++ ","
            hdr (PrimVecTypeSpec {})                              = error $ "Illegal type spec"
 
@@ -277,7 +272,6 @@ gen_hs_source (Info defaults entries) =
            ent o@(PrimOpSpec {})      = spec o
            ent o@(PrimVecOpSpec {})   = spec o
            ent o@(PrimTypeSpec {})    = spec o
-           ent o@(PrimClassSpec {})   = spec o
            ent o@(PrimVecTypeSpec {}) = spec o
            ent o@(PseudoOpSpec {})    = spec o
 
@@ -301,8 +295,6 @@ gen_hs_source (Info defaults entries) =
                               wrapOp n ++ " = let x = x in x" ]
                         PrimTypeSpec { ty = t }   ->
                             [ "data " ++ pprTy t ]
-                        PrimClassSpec { cls = t }   ->
-                            [ "class " ++ pprTy t ]
                         PrimVecTypeSpec { ty = t }   ->
                             [ "data " ++ pprTy t ]
                         Section { } -> []
@@ -496,13 +488,6 @@ gen_latex_doc (Info defaults entries)
                  ++ d ++ "}{"
                  ++ mk_options o
                  ++ "}\n"
-           mk_entry (PrimClassSpec {cls=t,desc=d,opts=o}) =
-                 "\\primclassspec{"
-                 ++ latex_encode (mk_source_ty t) ++ "}{"
-                 ++ latex_encode (mk_core_ty t) ++ "}{"
-                 ++ d ++ "}{"
-                 ++ mk_options o
-                 ++ "}\n"
            mk_entry (PrimVecTypeSpec {}) =
                  ""
            mk_entry (PseudoOpSpec {name=n,ty=t,desc=d,opts=o}) =
@@ -750,7 +735,7 @@ gen_primop_vector_tys_exports (Info _ entries)
 
     mkVecTypes :: Entry -> String
     mkVecTypes i =
-        "\t" ++ ty_id ++ ", " ++ tycon_id ++ ","
+        "        " ++ ty_id ++ ", " ++ tycon_id ++ ","
       where
         ty_id    = prefix i ++ "PrimTy"
         tycon_id = prefix i ++ "PrimTyCon"
@@ -904,10 +889,13 @@ ppType (TyApp (TyCon "MutVar#") [x,y])          = "mkMutVarPrimTy " ++ ppType x
 ppType (TyApp (TyCon "MutableArray#") [x,y])    = "mkMutableArrayPrimTy " ++ ppType x
                                                    ++ " " ++ ppType y
 ppType (TyApp (TyCon "MutableArrayArray#") [x]) = "mkMutableArrayArrayPrimTy " ++ ppType x
+ppType (TyApp (TyCon "SmallMutableArray#") [x,y]) = "mkSmallMutableArrayPrimTy " ++ ppType x
+                                                    ++ " " ++ ppType y
 ppType (TyApp (TyCon "MutableByteArray#") [x])  = "mkMutableByteArrayPrimTy " 
                                                    ++ ppType x
 ppType (TyApp (TyCon "Array#") [x])             = "mkArrayPrimTy " ++ ppType x
 ppType (TyApp (TyCon "ArrayArray#") [])         = "mkArrayArrayPrimTy"
+ppType (TyApp (TyCon "SmallArray#") [x])        = "mkSmallArrayPrimTy " ++ ppType x
 
 
 ppType (TyApp (TyCon "Weak#")       [x]) = "mkWeakPrimTy " ++ ppType x