From: sewardj Date: Mon, 15 Jan 2001 17:05:47 +0000 (+0000) Subject: [project @ 2001-01-15 17:05:46 by sewardj] X-Git-Tag: Approximately_9120_patches~2905 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=6c9a37e31afc41d57417a3828877577d8d270266;p=ghc-hetmet.git [project @ 2001-01-15 17:05:46 by sewardj] More stuff to do with primop support in the interpreter. Also, track some changes to the libraries. --- diff --git a/ghc/compiler/ghci/ByteCodeGen.lhs b/ghc/compiler/ghci/ByteCodeGen.lhs index b9e0002..e85e20e 100644 --- a/ghc/compiler/ghci/ByteCodeGen.lhs +++ b/ghc/compiler/ghci/ByteCodeGen.lhs @@ -14,7 +14,8 @@ module ByteCodeGen ( UnlinkedBCO, UnlinkedBCOExpr, ItblEnv, ClosureEnv, HValue, import Outputable import Name ( Name, getName, mkSysLocalName ) -import Id ( Id, idType, isDataConId_maybe, mkVanillaId ) +import Id ( Id, idType, isDataConId_maybe, mkVanillaId, + isPrimOpId_maybe ) import OrdList ( OrdList, consOL, snocOL, appOL, unitOL, nilOL, toOL, concatOL, fromOL ) import FiniteMap ( FiniteMap, addListToFM, listToFM, @@ -23,6 +24,7 @@ import CoreSyn import PprCore ( pprCoreExpr ) import Literal ( Literal(..), literalPrimRep ) import PrimRep ( PrimRep(..) ) +import PrimOp ( PrimOp(..) ) import CoreFVs ( freeVars ) import Type ( typePrimRep ) import DataCon ( dataConTag, fIRST_TAG, dataConTyCon, dataConWrapId ) @@ -44,11 +46,10 @@ import ByteCodeLink ( UnlinkedBCO, UnlinkedBCOExpr, assembleBCO, import List ( intersperse, sortBy ) import Foreign ( Ptr(..), mallocBytes ) -import Addr ( addrToInt, writeCharOffAddr ) +import Addr ( Addr(..), addrToInt, writeCharOffAddr ) import CTypes ( CInt ) import PrelBase ( Int(..) ) -import PrelAddr ( Addr(..) ) import PrelGHC ( ByteArray# ) import IOExts ( unsafePerformIO ) import PrelIOBase ( IO(..) ) @@ -297,7 +298,7 @@ schemeE d s p (fvs, AnnLet binds b) -- ToDo: don't build thunks for things with no free variables buildThunk dd ([], size, id, off) - = PUSH_G (getName id) + = PUSH_G (Left (getName id)) `consOL` unitOL (MKAP (off+size-1) size) buildThunk dd ((fv:fvs), size, id, off) = case pushAtom True dd p' (AnnVar fv) of @@ -408,7 +409,7 @@ schemeT d s p app -- Handle case 1 | is_con_call && null args_r_to_l - = (PUSH_G (getName con) `consOL` mkSLIDE 1 (d-s)) + = (PUSH_G (Left (getName con)) `consOL` mkSLIDE 1 (d-s)) `snocOL` ENTER -- Cases 2 and 3 @@ -570,7 +571,13 @@ mkUnpackCode vars d p -- 6 stack has valid words 0 .. 5. pushAtom :: Bool -> Int -> BCEnv -> AnnExpr' Id VarSet -> (BCInstrList, Int) -pushAtom tagged d p (AnnVar v) +pushAtom tagged d p (AnnVar v) + | Just primop <- isPrimOpId_maybe v + = case primop of + CCallOp _ -> panic "pushAtom: byte code generator can't handle CCalls" + other -> (unitOL (PUSH_G (Right primop)), 1) + + | otherwise = let str = "\npushAtom " ++ showSDocDebug (ppr v) ++ " :: " ++ showSDocDebug (pprType (idType v)) ++ ", depth = " ++ show d @@ -586,7 +593,7 @@ pushAtom tagged d p (AnnVar v) result = case lookupBCEnv_maybe p v of Just d_v -> (toOL (nOfThem nwords (PUSH_L (d-d_v+sz_t-2))), nwords) - Nothing -> ASSERT(sz_t == 1) (unitOL (PUSH_G nm), nwords) + Nothing -> ASSERT(sz_t == 1) (unitOL (PUSH_G (Left nm)), nwords) nm = case isDataConId_maybe v of Just c -> getName c @@ -629,10 +636,10 @@ pushAtom False d p (AnnLit lit) let n = I# l -- CAREFUL! Chars are 32 bits in ghc 4.09+ in unsafePerformIO ( - do a@(Ptr addr) <- mallocBytes (n+1) - strncpy a ba (fromIntegral n) - writeCharOffAddr addr n '\0' - return addr + do (Ptr a#) <- mallocBytes (n+1) + strncpy (Ptr a#) ba (fromIntegral n) + writeCharOffAddr (A# a#) n '\0' + return (A# a#) ) _ -> panic "StgInterp.lit2expr: unhandled string constant type" diff --git a/ghc/compiler/ghci/ByteCodeInstr.lhs b/ghc/compiler/ghci/ByteCodeInstr.lhs index e6d0559..c66a872 100644 --- a/ghc/compiler/ghci/ByteCodeInstr.lhs +++ b/ghc/compiler/ghci/ByteCodeInstr.lhs @@ -17,6 +17,7 @@ import Literal ( Literal ) import PrimRep ( PrimRep ) import DataCon ( DataCon ) import VarSet ( VarSet ) +import PrimOp ( PrimOp ) \end{code} @@ -47,7 +48,7 @@ data BCInstr | PUSH_LL Int Int{-2 offsets-} | PUSH_LLL Int Int Int{-3 offsets-} -- Push a ptr - | PUSH_G Name + | PUSH_G (Either Name PrimOp) -- Push an alt continuation | PUSH_AS Name PrimRep -- push alts and BCO_ptr_ret_info -- PrimRep so we know which itbl @@ -96,7 +97,9 @@ instance Outputable BCInstr where ppr (PUSH_L offset) = text "PUSH_L " <+> int offset ppr (PUSH_LL o1 o2) = text "PUSH_LL " <+> int o1 <+> int o2 ppr (PUSH_LLL o1 o2 o3) = text "PUSH_LLL" <+> int o1 <+> int o2 <+> int o3 - ppr (PUSH_G nm) = text "PUSH_G " <+> ppr nm + ppr (PUSH_G (Left nm)) = text "PUSH_G " <+> ppr nm + ppr (PUSH_G (Right op)) = text "PUSH_G " <+> text "PrelPrimopWrappers." + <> ppr op ppr (PUSH_AS nm pk) = text "PUSH_AS " <+> ppr nm <+> ppr pk ppr (PUSH_UBX lit nw) = text "PUSH_UBX" <+> parens (int nw) <+> ppr lit ppr (PUSH_TAG n) = text "PUSH_TAG" <+> int n diff --git a/ghc/compiler/ghci/ByteCodeItbls.lhs b/ghc/compiler/ghci/ByteCodeItbls.lhs index 2a86518..a130dc3 100644 --- a/ghc/compiler/ghci/ByteCodeItbls.lhs +++ b/ghc/compiler/ghci/ByteCodeItbls.lhs @@ -4,7 +4,7 @@ \section[ByteCodeItbls]{Generate infotables for interpreter-made bytecodes} \begin{code} -module ByteCodeItbls ( ItblEnv, mkITbls ) where +module ByteCodeItbls ( ItblEnv, ItblPtr, mkITbls ) where #include "HsVersions.h" @@ -18,12 +18,11 @@ import ClosureInfo ( mkVirtHeapOffsets ) import FastString ( FastString(..) ) import Foreign ( Storable(..), Word8, Word16, Word32, Ptr(..), - malloc, castPtr, plusPtr ) + malloc, castPtr, plusPtr, Addr ) import Addr ( addrToInt ) import Bits ( Bits(..), shiftR ) import PrelBase ( Int(..) ) -import PrelAddr ( Addr(..) ) import PrelIOBase ( IO(..) ) \end{code} @@ -36,13 +35,9 @@ import PrelIOBase ( IO(..) ) \begin{code} -type ItblEnv = FiniteMap Name (Ptr StgInfoTable) - -#if __GLASGOW_HASKELL__ <= 408 -type ItblPtr = Addr -#else type ItblPtr = Ptr StgInfoTable -#endif +type ItblEnv = FiniteMap Name ItblPtr + -- Make info tables for the data decls in this module mkITbls :: [TyCon] -> IO ItblEnv diff --git a/ghc/compiler/ghci/ByteCodeLink.lhs b/ghc/compiler/ghci/ByteCodeLink.lhs index f1cee7c..549769b 100644 --- a/ghc/compiler/ghci/ByteCodeLink.lhs +++ b/ghc/compiler/ghci/ByteCodeLink.lhs @@ -13,11 +13,12 @@ module ByteCodeLink ( UnlinkedBCO, UnlinkedBCOExpr, assembleBCO, import Outputable import Name ( Name, getName, nameModule, toRdrName ) import RdrName ( rdrNameOcc, rdrNameModule ) -import OccName ( occNameString ) +import OccName ( occNameString, occNameUserString ) import FiniteMap ( FiniteMap, addListToFM, filterFM, addToFM, lookupFM, emptyFM ) import CoreSyn import Literal ( Literal(..) ) +import PrimOp ( PrimOp, primOpOcc ) import PrimRep ( PrimRep(..) ) import Util ( global ) import Constants ( wORD_SIZE ) @@ -25,7 +26,7 @@ import Module ( ModuleName, moduleName, moduleNameFS ) import Linker ( lookupSymbol ) import FastString ( FastString(..) ) import ByteCodeInstr ( BCInstr(..), ProtoBCO(..) ) -import ByteCodeItbls ( ItblEnv ) +import ByteCodeItbls ( ItblEnv, ItblPtr ) import Monad ( foldM ) @@ -36,10 +37,9 @@ import MArray ( castSTUArray, newIntArray, writeIntArray, newAddrArray, writeAddrArray ) import Foreign ( Word16, Ptr(..) ) -import Addr ( Word ) +import Addr ( Word, Addr ) import PrelBase ( Int(..) ) -import PrelAddr ( Addr(..) ) import PrelGHC ( BCO#, newBCO#, unsafeCoerce#, ByteArray#, Array#, addrToHValue#, mkApUpd0# ) import IOExts ( IORef, fixIO, readIORef, writeIORef ) @@ -77,10 +77,10 @@ linkSomeBCOs ie ce_in ul_bcos data UnlinkedBCO = UnlinkedBCO Name - (SizedSeq Word16) -- insns - (SizedSeq Word) -- literals - (SizedSeq Name) -- ptrs - (SizedSeq Name) -- itbl refs + (SizedSeq Word16) -- insns + (SizedSeq Word) -- literals + (SizedSeq (Either Name PrimOp)) -- ptrs + (SizedSeq Name) -- itbl refs nameOfUnlinkedBCO (UnlinkedBCO nm _ _ _ _) = nm @@ -146,7 +146,7 @@ assembleBCO (ProtoBCO nm instrs origin) do -- pass 2: generate the instruction, ptr and nonptr bits insns <- return emptySS :: IO (SizedSeq Word16) lits <- return emptySS :: IO (SizedSeq Word) - ptrs <- return emptySS :: IO (SizedSeq Name) + ptrs <- return emptySS :: IO (SizedSeq (Either Name PrimOp)) itbls <- return emptySS :: IO (SizedSeq Name) let init_asm_state = (insns,lits,ptrs,itbls) (final_insns, final_lits, final_ptrs, final_itbls) @@ -155,7 +155,8 @@ assembleBCO (ProtoBCO nm instrs origin) return (UnlinkedBCO nm final_insns final_lits final_ptrs final_itbls) -- instrs nonptrs ptrs itbls -type AsmState = (SizedSeq Word16, SizedSeq Word, SizedSeq Name, SizedSeq Name) +type AsmState = (SizedSeq Word16, SizedSeq Word, + SizedSeq (Either Name PrimOp), SizedSeq Name) data SizedSeq a = SizedSeq !Int [a] emptySS = SizedSeq 0 [] @@ -184,7 +185,7 @@ mkBits findLabel st proto_insns PUSH_LLL o1 o2 o3 -> instr4 st i_PUSH_LLL o1 o2 o3 PUSH_G nm -> do (p, st2) <- ptr st nm instr2 st2 i_PUSH_G p - PUSH_AS nm pk -> do (p, st2) <- ptr st nm + PUSH_AS nm pk -> do (p, st2) <- ptr st (Left nm) (np, st3) <- ctoi_itbl st2 pk instr3 st3 i_PUSH_AS p np PUSH_UBX lit nws -> do (np, st2) <- literal st lit @@ -279,9 +280,9 @@ mkBits findLabel st proto_insns = addr st ret_itbl_addr where ret_itbl_addr = case pk of - PtrRep -> stg_ctoi_ret_R1_info - IntRep -> stg_ctoi_ret_R1_info - CharRep -> stg_ctoi_ret_R1_info + PtrRep -> stg_ctoi_ret_R1p_info + IntRep -> stg_ctoi_ret_R1n_info + CharRep -> stg_ctoi_ret_R1n_info FloatRep -> stg_ctoi_ret_F1_info DoubleRep -> stg_ctoi_ret_D1_info _ -> pprPanic "mkBits.ctoi_itbl" (ppr pk) @@ -294,9 +295,10 @@ mkBits findLabel st proto_insns FloatRep -> stg_gc_f1_info DoubleRep -> stg_gc_d1_info -foreign label "stg_ctoi_ret_R1_info" stg_ctoi_ret_R1_info :: Addr -foreign label "stg_ctoi_ret_F1_info" stg_ctoi_ret_F1_info :: Addr -foreign label "stg_ctoi_ret_D1_info" stg_ctoi_ret_D1_info :: Addr +foreign label "stg_ctoi_ret_R1p_info" stg_ctoi_ret_R1p_info :: Addr +foreign label "stg_ctoi_ret_R1n_info" stg_ctoi_ret_R1n_info :: Addr +foreign label "stg_ctoi_ret_F1_info" stg_ctoi_ret_F1_info :: Addr +foreign label "stg_ctoi_ret_D1_info" stg_ctoi_ret_D1_info :: Addr foreign label "stg_gc_unbx_r1_info" stg_gc_unbx_r1_info :: Addr foreign label "stg_gc_f1_info" stg_gc_f1_info :: Addr @@ -432,7 +434,7 @@ linkBCO ie ce (UnlinkedBCO nm insnsSS literalsSS ptrsSS itblsSS) ptrs_parr = case ptrs_arr of Array lo hi parr -> parr itbls_arr = array (0, n_itbls-1) (indexify linked_itbls) - :: UArray Int Addr + :: UArray Int ItblPtr itbls_barr = case itbls_arr of UArray lo hi barr -> barr insns_arr | n_insns > 65535 @@ -452,9 +454,9 @@ linkBCO ie ce (UnlinkedBCO nm insnsSS literalsSS ptrsSS itblsSS) BCO bco# <- newBCO insns_barr literals_barr ptrs_parr itbls_barr - return (unsafeCoerce# bco#) - --case mkApUpd0# (unsafeCoerce# bco#) of - -- (# final_bco #) -> return final_bco + -- WAS: return (unsafeCoerce# bco#) + case mkApUpd0# (unsafeCoerce# bco#) of + (# final_bco #) -> return final_bco data BCO = BCO BCO# @@ -464,22 +466,29 @@ newBCO a b c d = IO (\s -> case newBCO# a b c d s of (# s1, bco #) -> (# s1, BCO bco #)) -lookupCE :: ClosureEnv -> Name -> IO HValue -lookupCE ce nm +lookupCE :: ClosureEnv -> Either Name PrimOp -> IO HValue +lookupCE ce (Right primop) + = do m <- lookupSymbol (primopToCLabel primop "closure") + case m of + Just (Ptr addr) -> case addrToHValue# addr of + (# hval #) -> do addCAF hval + return hval + Nothing -> pprPanic "ByteCodeGen.lookupCE(primop)" (ppr primop) +lookupCE ce (Left nm) = case lookupFM ce nm of Just aa -> return aa Nothing -> do m <- lookupSymbol (nameToCLabel nm "closure") case m of - Just (A# addr) -> case addrToHValue# addr of - (# hval #) -> do addCAF hval - return hval + Just (Ptr addr) -> case addrToHValue# addr of + (# hval #) -> do addCAF hval + return hval Nothing -> pprPanic "ByteCodeGen.lookupCE" (ppr nm) -lookupIE :: ItblEnv -> Name -> IO Addr +lookupIE :: ItblEnv -> Name -> IO (Ptr a) lookupIE ie con_nm = case lookupFM ie con_nm of - Just (Ptr a) -> return a + Just (Ptr a) -> return (Ptr a) Nothing -> do -- try looking up in the object files. m <- lookupSymbol (nameToCLabel con_nm "con_info") @@ -492,13 +501,19 @@ lookupIE ie con_nm Just addr -> return addr Nothing -> pprPanic "ByteCodeGen.lookupIE" (ppr con_nm) --- HACK!!! ToDo: cleaner +-- HACKS!!! ToDo: cleaner nameToCLabel :: Name -> String{-suffix-} -> String nameToCLabel n suffix = _UNPK_(moduleNameFS (rdrNameModule rn)) ++ '_':occNameString(rdrNameOcc rn) ++ '_':suffix where rn = toRdrName n +primopToCLabel :: PrimOp -> String{-suffix-} -> String +primopToCLabel primop suffix + = let str = "PrelPrimopWrappers_" ++ occNameString (primOpOcc primop) ++ '_':suffix + in trace ("primopToCLabel: " ++ str) + str + \end{code} %************************************************************************ diff --git a/ghc/compiler/ghci/Linker.lhs b/ghc/compiler/ghci/Linker.lhs index c876b0a..9404d42 100644 --- a/ghc/compiler/ghci/Linker.lhs +++ b/ghc/compiler/ghci/Linker.lhs @@ -8,11 +8,11 @@ module Linker ( loadObj, -- :: String -> IO () unloadObj, -- :: String -> IO () - lookupSymbol, -- :: String -> IO (Maybe Addr) + lookupSymbol, -- :: String -> IO (Maybe (Ptr a)) resolveObjs, -- :: IO () ) where -import Addr +import Foreign ( Ptr, nullPtr ) import PrelByteArr import PrelPack (packString) import Panic ( panic ) @@ -23,7 +23,7 @@ import Panic ( panic ) lookupSymbol str = do addr <- c_lookupSymbol (packString str) - if addr == nullAddr + if addr == nullPtr then return Nothing else return (Just addr) @@ -49,7 +49,7 @@ resolveObjs = do type PackedString = ByteArray Int foreign import "lookupSymbol" unsafe - c_lookupSymbol :: PackedString -> IO Addr + c_lookupSymbol :: PackedString -> IO (Ptr a) foreign import "loadObj" unsafe c_loadObj :: PackedString -> IO Int diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs index 0fcdea2..141fdb9 100644 --- a/ghc/compiler/nativeGen/StixPrim.lhs +++ b/ghc/compiler/nativeGen/StixPrim.lhs @@ -55,6 +55,7 @@ and modify our heap check accordingly. \begin{code} -- NB: ordering of clauses somewhere driven by -- the desire to getting sane patt-matching behavior + primCode [res] IntegerCmpOp args@[sa1,da1, sa2,da2] = gmpCompare res (sa1,da1, sa2,da2) diff --git a/ghc/compiler/utils/StringBuffer.lhs b/ghc/compiler/utils/StringBuffer.lhs index 3e9ebe7..f95f7a1 100644 --- a/ghc/compiler/utils/StringBuffer.lhs +++ b/ghc/compiler/utils/StringBuffer.lhs @@ -199,9 +199,9 @@ unsafeWriteBuffer s@(StringBuffer a _ _ _) i# ch# = stringToStringBuffer :: String -> IO StringBuffer stringToStringBuffer str = do let sz@(I# sz#) = length str + 1 - (Ptr a@(A# a#)) <- mallocBytes sz - fill_in str a - writeCharOffAddr a (sz-1) '\0' -- sentinel + (Ptr a#) <- mallocBytes sz + fill_in str (A# a#) + writeCharOffAddr (A# a#) (sz-1) '\0' -- sentinel return (StringBuffer a# sz# 0# 0#) where fill_in [] _ = return () @@ -210,7 +210,7 @@ stringToStringBuffer str = fill_in cs (a `plusAddr` 1) freeStringBuffer :: StringBuffer -> IO () -freeStringBuffer (StringBuffer a# _ _ _) = Foreign.free (Ptr (A# a#)) +freeStringBuffer (StringBuffer a# _ _ _) = Foreign.free (Ptr a#) #endif \end{code} diff --git a/ghc/lib/std/Makefile b/ghc/lib/std/Makefile index 075c706..9f11efc 100644 --- a/ghc/lib/std/Makefile +++ b/ghc/lib/std/Makefile @@ -66,10 +66,16 @@ SRC_MKDEPENDHS_OPTS += -I$(GHC_INCLUDE_DIR) #----------------------------------------------------------------------------- # Rules +PrelPrimopWrappers.hs: ../../compiler/prelude/primops.txt + rm -f PrelPrimopWrappers.hs + ../../utils/genprimopcode/genprimopcode --make-haskell-wrappers \ + < ../../compiler/prelude/primops.txt > PrelPrimopWrappers.hs + PrelGHC.$(way_)hi : PrelGHC.hi-boot cp $< $@ -boot :: PrelGHC.hi $(foreach way, $(WAYS), PrelGHC.$(way)_hi) +boot :: PrelPrimopWrappers.hs PrelGHC.hi $(foreach way, $(WAYS), PrelGHC.$(way)_hi) +all :: PrelPrimopWrappers.hs DLL_DESCRIPTION="GHC-compiled Haskell Prelude" @@ -83,7 +89,7 @@ ifeq "$(DLLized)" "YES" all :: PrelMain.dll_o endif -CLEAN_FILES += PrelGHC.hi $(foreach way, $(WAYS), PrelGHC.$(way)_hi) +CLEAN_FILES += PrelPrimopWrappers.hs PrelGHC.hi $(foreach way, $(WAYS), PrelGHC.$(way)_hi) # # If we're building the unregisterised way, it may well be for Hugs. diff --git a/ghc/utils/genprimopcode/Main.hs b/ghc/utils/genprimopcode/Main.hs index aaff9c1..18f5ffe 100644 --- a/ghc/utils/genprimopcode/Main.hs +++ b/ghc/utils/genprimopcode/Main.hs @@ -75,8 +75,8 @@ main = getArgs >>= \args -> "--primop-list" -> putStr (gen_primop_list p_o_specs) - "--c-bytecode-enum" - -> putStr (gen_enum_decl p_o_specs) + "--make-haskell-wrappers" + -> putStr (gen_wrappers p_o_specs) ) @@ -93,14 +93,37 @@ known_args "--primop-primop-info", "--primop-tag", "--primop-list", - - "--c-bytecode-enum" + "--make-haskell-wrappers" ] ------------------------------------------------------------------ -- Code generators ----------------------------------------------- ------------------------------------------------------------------ +gen_wrappers (Info defaults pos) + = "module PrelPrimopWrappers where\n" + ++ "import qualified PrelGHC\n" + ++ unlines (map f (filter (not.dodgy) pos)) + where + f spec = let args = map (\n -> "a" ++ show n) [1 .. arity (ty spec)] + src_name = wrap (name spec) + in "{-# NOINLINE " ++ src_name ++ " #-}\n" ++ + src_name ++ " " ++ unwords args + ++ " = (PrelGHC." ++ name spec ++ ") " ++ unwords args + wrap nm | isLower (head nm) = nm + | otherwise = "(" ++ nm ++ ")" + + dodgy spec + = name spec `elem` + [-- C code generator can't handle these + "seq#", + "tagToEnum#", + -- not interested in parallel support + "par#", "parGlobal#", "parLocal#", "parAt#", + "parAtAbs#", "parAtRel#", "parAtForNow#" + ] + + gen_primop_list (Info defaults pos) = unlines ( [ " [" ++ cons (head pos) ] @@ -116,11 +139,6 @@ gen_primop_tag (Info defaults pos) f i n = "tagOf_PrimOp " ++ cons i ++ " = _ILIT(" ++ show n ++ ") :: FastInt" -gen_enum_decl (Info defaults pos) - = let conss = map cons pos - in "enum PrimOp {\n " ++ head conss ++ "\n" - ++ unlines (map (" , "++) (tail conss)) ++ "};\n" - gen_data_decl (Info defaults pos) = let conss = map cons pos in "data PrimOp\n = " ++ head conss ++ "\n" @@ -256,6 +274,8 @@ tvsIn (TyApp tc tys) = concatMap tvsIn tys tvsIn (TyVar tv) = [tv] tvsIn (TyUTup tys) = concatMap tvsIn tys +arity = length . fst . flatTys + ------------------------------------------------------------------ -- Abstract syntax -----------------------------------------------