From 291750ef1a82e4e90d1b767d1562b4adfbb7a345 Mon Sep 17 00:00:00 2001 From: gnumonik Date: Wed, 22 May 2024 20:52:38 -0400 Subject: [PATCH] Fixed a few bugs resulting from mandatory kind annotations for TyVars & small mistakes in the CST conversion rewrite --- src/Language/PureScript/CST/Convert.hs | 80 +++++++++++++++--- src/Language/PureScript/CST/Types.hs | 7 +- src/Language/PureScript/CoreFn/Pretty.hs | 3 - .../PureScript/CoreFn/Pretty/Types.hs | 23 +++-- src/Language/PureScript/Errors.hs | 11 +-- src/Language/PureScript/Pretty/Types.hs | 5 +- src/Language/PureScript/Sugar/Names.hs | 1 + src/Language/PureScript/TypeChecker/Kinds.hs | 19 +++-- src/Language/PureScript/TypeChecker/Unify.hs | 2 +- .../passing/2018/output/A/index.cfn.pretty | 4 +- .../passing/2018/output/B/index.cfn.pretty | 4 +- .../passing/2138/output/Lib/index.cfn.pretty | 4 +- .../passing/2609/output/Eg/index.cfn.pretty | 2 +- tests/purus/passing/4035/Other.purs | 5 +- .../passing/4035/output/Other/externs.cbor | Bin 0 -> 697 bytes .../purus/passing/4035/output/Other/index.cfn | 1 + .../4035/output/Other/index.cfn.pretty | 11 +++ tests/purus/passing/4101/Lib.purs | 4 +- .../passing/4101/output/Lib/externs.cbor | Bin 3417 -> 2985 bytes tests/purus/passing/4101/output/Lib/index.cfn | 2 +- .../passing/4101/output/Lib/index.cfn.pretty | 6 +- tests/purus/passing/4105/Lib.purs | 4 +- .../passing/4105/output/Lib/externs.cbor | Bin 2336 -> 2591 bytes tests/purus/passing/4200/Lib.purs | 8 +- .../passing/4200/output/Lib/externs.cbor | Bin 1791 -> 1480 bytes tests/purus/passing/4200/output/Lib/index.cfn | 2 +- .../passing/4200/output/Lib/index.cfn.pretty | 2 +- tests/purus/passing/4310/Lib.purs | 8 +- .../passing/4310/output/Lib/externs.cbor | Bin 5733 -> 6223 bytes tests/purus/passing/4310/output/Lib/index.cfn | 2 +- .../passing/4310/output/Lib/index.cfn.pretty | 54 +++++------- tests/purus/passing/ClassRefSyntax/Lib.purs | 2 +- .../ClassRefSyntax/output/Lib/externs.cbor | Bin 2961 -> 3767 bytes .../ClassRefSyntax/output/Lib/index.cfn | 2 +- .../output/Lib/index.cfn.pretty | 14 +-- tests/purus/passing/Coercible/Lib.purs | 5 +- tests/purus/passing/Coercible/Lib2.purs | 4 +- .../output/Coercible.Lib/externs.cbor | Bin 2426 -> 3090 bytes .../Coercible/output/Coercible.Lib/index.cfn | 2 +- .../output/Coercible.Lib/index.cfn.pretty | 8 +- .../output/Coercible.Lib2/externs.cbor | Bin 867 -> 1268 bytes .../Coercible/output/Coercible.Lib2/index.cfn | 2 +- .../output/Coercible.Lib2/index.cfn.pretty | 4 +- .../passing/DctorOperatorAlias/List.purs | 2 +- .../output/List/externs.cbor | Bin 1533 -> 2212 bytes .../DctorOperatorAlias/output/List/index.cfn | 2 +- .../output/List/index.cfn.pretty | 4 +- .../output/Foo/index.cfn.pretty | 4 +- .../ExportExplicit/output/M1/index.cfn.pretty | 14 +-- .../output/M1/index.cfn.pretty | 8 +- tests/purus/passing/ForeignKind/Lib.purs | 21 +++-- .../output/ForeignKinds.Lib/externs.cbor | Bin 10939 -> 10443 bytes .../output/ForeignKinds.Lib/index.cfn | 2 +- .../output/ForeignKinds.Lib/index.cfn.pretty | 70 +++++++-------- .../passing/Import/output/M1/externs.cbor | Bin 1033 -> 0 bytes .../purus/passing/Import/output/M1/index.cfn | 1 - .../passing/Import/output/M1/index.cfn.pretty | 18 ---- .../passing/Import/output/M2/externs.cbor | Bin 351 -> 0 bytes .../purus/passing/Import/output/M2/index.cfn | 1 - .../passing/Import/output/M2/index.cfn.pretty | 14 --- 60 files changed, 260 insertions(+), 218 deletions(-) create mode 100644 tests/purus/passing/4035/output/Other/externs.cbor create mode 100644 tests/purus/passing/4035/output/Other/index.cfn create mode 100644 tests/purus/passing/4035/output/Other/index.cfn.pretty delete mode 100644 tests/purus/passing/Import/output/M1/externs.cbor delete mode 100644 tests/purus/passing/Import/output/M1/index.cfn delete mode 100644 tests/purus/passing/Import/output/M1/index.cfn.pretty delete mode 100644 tests/purus/passing/Import/output/M2/externs.cbor delete mode 100644 tests/purus/passing/Import/output/M2/index.cfn delete mode 100644 tests/purus/passing/Import/output/M2/index.cfn.pretty diff --git a/src/Language/PureScript/CST/Convert.hs b/src/Language/PureScript/CST/Convert.hs index f847ca36f..1fa9f4157 100644 --- a/src/Language/PureScript/CST/Convert.hs +++ b/src/Language/PureScript/CST/Convert.hs @@ -19,9 +19,9 @@ module Language.PureScript.CST.Convert import Prelude hiding (take) import Control.Monad.State -import Data.Bifunctor (bimap, first) +import Data.Bifunctor (bimap, first, second) import Data.Char (toLower) -import Data.Foldable (foldl', foldrM, toList) +import Data.Foldable (foldl', foldrM, toList, traverse_) import Data.Functor (($>)) import Data.List.NonEmpty qualified as NE import Data.Maybe (isJust, fromJust, mapMaybe) @@ -43,7 +43,9 @@ import Language.PureScript.CST.Positions import Language.PureScript.CST.Print (printToken) import Language.PureScript.CST.Types import Data.Bitraversable (Bitraversable(..)) +import Language.PureScript.Names (runProperName, coerceProperName) +import Debug.Trace (trace) type ConvertM a = State (Map Text T.SourceType) a @@ -60,11 +62,43 @@ tvKind nm = do bindTv :: Text -> T.SourceType -> ConvertM () bindTv nm ty = modify' (M.insert nm ty) -reset :: ConvertM () -reset = modify' (\_ -> M.empty) - +{- Our new way of handling kinds introduces an annoying problem: + We need to have the kinds of tyvars bound the decl kind signature or + type signature in scope when we convert the declaration. +-} +groupSignaturesAndDeclarations :: Show a => [Declaration a] -> [[Declaration a]] +groupSignaturesAndDeclarations decls = trace ("DECLARATIONS (grouping): " <> concatMap ((<> "\n\n") . show) decls) + $ foldr (go kindSigs typeSigs) [] decls' + where + -- I think this minimizes the # of traversals? + ((kindSigs,typeSigs),decls') = foldr (\x acc -> case x of + ksig@(DeclKindSignature _ _ (Labeled (nameValue -> nm) _ ty)) -> first (first $ M.insert nm ksig) acc + tsig@(DeclSignature _ (Labeled (nameValue -> nm) _ _)) -> first (second (M.insert nm tsig)) acc + other -> second (other:) acc + ) ((M.empty,M.empty),[]) decls + + go ksigs tsigs x acc = case x of + dataDecl@(DeclData _ (DataHead _ (nameValue -> nm) _ ) _) -> case M.lookup nm ksigs of + Just sigDecl -> [sigDecl,dataDecl] : acc + Nothing -> [dataDecl] : acc + tyDecl@(DeclType _ (DataHead _ (nameValue -> nm) _) _ _) -> case M.lookup nm ksigs of + Just sigDecl -> [sigDecl,tyDecl] : acc + Nothing -> [tyDecl] : acc + newtypeDecl@(DeclNewtype _ (DataHead _ (nameValue -> nm) _) _ _ _) -> case M.lookup nm ksigs of + Just sigDecl -> [sigDecl,newtypeDecl] : acc + Nothing -> [newtypeDecl] : acc + classDecl@(DeclClass _ (clsName -> nm) _) -> case M.lookup (coerceProperName $ nameValue nm) ksigs of + Just sigDecl -> [sigDecl,classDecl] : acc + Nothing -> [classDecl] : acc + valDecl@(DeclValue _ (valName -> nm)) -> case M.lookup (nameValue nm) tsigs of + Just sigDecl -> [sigDecl,valDecl] : acc + Nothing -> [valDecl] : acc + -- I don't think anything else can have a type/kind sig but I could be wrong... + other -> [other] : acc + + comment :: Comment a -> Maybe C.Comment comment = \case Comment t @@ -177,7 +211,14 @@ convertType' withinVta fileName = go annRec = sourceAnn fileName a a T.TypeApp ann (Env.tyRecord $> annRec) <$> goRow row b TypeForall _ kw bindings _ ty -> do + -- TODO: Refactor this (if it works) let + doBind (TypeVarKinded (Wrapped _ (Labeled (v, a) _ b) _)) = do + let nm = getIdent (nameValue a) + b' <- go b + bindTv nm b' + doBind (TypeVarName (v,a)) = internalError $ "Error: Universally quantified type variable without kind annotation: " <> (Text.unpack . getIdent . nameValue $ a) <> "\nat: " <> show v + mkForAll a b v t = do let ann' = widenLeft (tokAnn $ nameTok a) $ T.getAnnForType t T.ForAll ann' (maybe T.TypeVarInvisible (const T.TypeVarVisible) v) (getIdent $ nameValue a) b t Nothing @@ -188,7 +229,8 @@ convertType' withinVta fileName = go bindTv nm b' pure $ mkForAll a b' v t -- TODO: Fix this better - k (TypeVarName (v, a)) t = internalError "forall w/o kind annotation" -- mkForAll a Nothing v + k (TypeVarName (v, a)) t = internalError $ "Error: Universally quantified type variable without kind annotation: " <> (Text.unpack . getIdent . nameValue $ a) <> "\nat: " <> show v + traverse_ doBind bindings inner <- go ty ty' <- foldrM k inner bindings let ann = widenLeft (tokAnn kw) $ T.getAnnForType ty' @@ -543,6 +585,7 @@ convertBinder fileName = go convertDeclaration :: String -> Declaration a -> ConvertM [AST.Declaration] convertDeclaration fileName decl = case decl of DeclData _ (DataHead _ a vars) bd -> do + vars' <- traverse goTypeVar vars let ctrs :: SourceToken -> DataCtor a -> [(SourceToken, DataCtor a)] -> ConvertM [AST.DataConstructorDeclaration] ctrs st (DataCtor _ name fields) tl = do @@ -554,7 +597,7 @@ convertDeclaration fileName decl = case decl of rest <- ctrs st' ctor tl' pure $ AST.DataConstructorDeclaration (sourceAnnCommented fileName st (nameTok name)) (nameValue name) (zip ctrFields $ fields') : rest - vars' <- traverse goTypeVar vars + ctorDecls <- maybe (pure []) (\(st, Separated hd tl) -> ctrs st hd tl) bd pure [AST.DataDeclaration ann Env.Data (nameValue a) vars' ctorDecls] DeclType _ (DataHead _ a vars) _ bd -> do @@ -565,9 +608,9 @@ convertDeclaration fileName decl = case decl of vars' bd' DeclNewtype _ (DataHead _ a vars) st x ys -> do + vars' <- traverse goTypeVar vars ys' <- convertType fileName ys let ctrs = [AST.DataConstructorDeclaration (sourceAnnCommented fileName st (snd $ declRange decl)) (nameValue x) [(head ctrFields, ys')]] - vars' <- traverse goTypeVar vars pure [AST.DataDeclaration ann Env.Newtype (nameValue a) vars' ctrs] DeclClass _ (ClassHead _ sup name vars fdeps) bd -> do let @@ -622,6 +665,9 @@ convertDeclaration fileName decl = case decl of args' instTy] DeclKindSignature _ kw (Labeled name _ ty) -> do + let nm = runProperName (nameValue name) + ty' <- convertType fileName ty + bindTv nm ty' let kindFor = case tokValue kw of TokLowerName [] "data" -> AST.DataSig @@ -629,7 +675,7 @@ convertDeclaration fileName decl = case decl of TokLowerName [] "type" -> AST.TypeSynonymSig TokLowerName [] "class" -> AST.ClassSig tok -> internalError $ "Invalid kind signature keyword " <> Text.unpack (printToken tok) - pure . AST.KindDeclaration ann kindFor (nameValue name) <$> convertType fileName ty + pure $ [AST.KindDeclaration ann kindFor (nameValue name) ty'] DeclSignature _ lbl -> pure <$> convertSignature fileName lbl DeclValue _ fields -> @@ -716,8 +762,15 @@ convertDeclaration fileName decl = case decl of TypeUnaryRow{} -> "Row" goTypeVar = \case - TypeVarKinded (Wrapped _ (Labeled (_, x) _ y) _) -> (getIdent $ nameValue x,) <$> convertType fileName y - TypeVarName (_, x) -> error $ "Missing kind annotation for type variable: " <> Text.unpack (getIdent $ nameValue x) -- , Nothing) + TypeVarKinded (Wrapped _ (Labeled (_, x) _ y) _) -> do + let nm = getIdent (nameValue x) + k <- convertType fileName y + bindTv nm k + pure (nm,k) + TypeVarName (_, x) -> do + let nm = getIdent (nameValue x) + ki <- tvKind nm + pure (nm,ki) goInstanceBinding = \case InstanceBindingSignature _ lbl -> @@ -806,12 +859,13 @@ convertExport fileName export = case export of where ann = sourceSpan fileName . toSourceRange $ exportRange export -convertModule :: String -> Module a -> AST.Module +convertModule :: Show a => String -> Module a -> AST.Module convertModule fileName module'@(Module _ _ modName exps _ imps decls _) = do let + groupedDecls = groupSignaturesAndDeclarations decls ann = uncurry (sourceAnnCommented fileName) $ moduleRange module' imps' = importCtr . runConvert . convertImportDecl fileName <$> imps - decls' = concatMap (runConvert . convertDeclaration fileName) decls + decls' = concatMap (concat . runConvert . traverse (convertDeclaration fileName)) groupedDecls exps' = map (runConvert . convertExport fileName) . toList . wrpValue <$> exps uncurry AST.Module ann (nameValue modName) (imps' <> decls') exps' where diff --git a/src/Language/PureScript/CST/Types.hs b/src/Language/PureScript/CST/Types.hs index a89532f1f..a36ff405e 100644 --- a/src/Language/PureScript/CST/Types.hs +++ b/src/Language/PureScript/CST/Types.hs @@ -193,14 +193,15 @@ data DataMembers a deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic) data Declaration a - = DeclData a (DataHead a) (Maybe (SourceToken, Separated (DataCtor a))) + = + DeclKindSignature a SourceToken (Labeled (Name (N.ProperName 'N.TypeName)) (Type a)) + | DeclSignature a (Labeled (Name Ident) (Type a)) + | DeclData a (DataHead a) (Maybe (SourceToken, Separated (DataCtor a))) | DeclType a (DataHead a) SourceToken (Type a) | DeclNewtype a (DataHead a) SourceToken (Name (N.ProperName 'N.ConstructorName)) (Type a) | DeclClass a (ClassHead a) (Maybe (SourceToken, NonEmpty (Labeled (Name Ident) (Type a)))) | DeclInstanceChain a (Separated (Instance a)) | DeclDerive a SourceToken (Maybe SourceToken) (InstanceHead a) - | DeclKindSignature a SourceToken (Labeled (Name (N.ProperName 'N.TypeName)) (Type a)) - | DeclSignature a (Labeled (Name Ident) (Type a)) | DeclValue a (ValueBindingFields a) | DeclFixity a FixityFields | DeclForeign a SourceToken SourceToken (Foreign a) diff --git a/src/Language/PureScript/CoreFn/Pretty.hs b/src/Language/PureScript/CoreFn/Pretty.hs index 7a4516059..49ecaaa9c 100644 --- a/src/Language/PureScript/CoreFn/Pretty.hs +++ b/src/Language/PureScript/CoreFn/Pretty.hs @@ -71,9 +71,6 @@ renderExpr = smartRender . asDynamic prettyValue renderExprStr :: Expr a -> String renderExprStr = T.unpack . renderExpr -prettyTypeStr :: forall a. Show a => Type a -> String -prettyTypeStr = T.unpack . smartRender . asOneLine prettyType - {- TYPES (move later) -} diff --git a/src/Language/PureScript/CoreFn/Pretty/Types.hs b/src/Language/PureScript/CoreFn/Pretty/Types.hs index 709c82dfb..9f0402279 100644 --- a/src/Language/PureScript/CoreFn/Pretty/Types.hs +++ b/src/Language/PureScript/CoreFn/Pretty/Types.hs @@ -1,4 +1,4 @@ -module Language.PureScript.CoreFn.Pretty.Types (prettyType) where +module Language.PureScript.CoreFn.Pretty.Types (prettyType, prettyTypeStr, prettyTypeTxt) where import Prelude hiding ((<>)) @@ -9,7 +9,7 @@ import Control.Monad.Reader ( MonadReader(ask), Reader ) import Language.PureScript.Environment ( tyRecord, tyFunction, pattern ArrayT ) import Language.PureScript.Names (OpName(..), ProperName(..), disqualify, showQualified) -import Language.PureScript.Types (Type (..), WildcardData (..), TypeVarVisibility (..), eqType) +import Language.PureScript.Types (Type (..), WildcardData (..), TypeVarVisibility (..), eqType, Constraint (..)) import Language.PureScript.PSString (prettyPrintString) import Prettyprinter @@ -20,7 +20,7 @@ import Prettyprinter hcat, group, Doc, - Pretty(pretty) ) + Pretty(pretty), hsep ) import Language.PureScript.CoreFn.Pretty.Common ( Printer, LineFormat, @@ -62,7 +62,7 @@ prettyType t = group <$> case t of HoleWildcard txt -> pure $ "?" <> pretty txt _ -> pure "_" - TypeConstructor _ qPropName -> pure . pretty . runProperName . disqualify $ qPropName + TypeConstructor _ qPropName -> pure . pretty . showQualified runProperName $ qPropName TypeOp _ opName -> pure . pretty $ showQualified runOpName opName @@ -76,7 +76,11 @@ prettyType t = group <$> case t of ForAll _ vis var mKind inner' _ -> case stripQuantifiers inner' of (quantified,inner) -> goForall ([(vis,var,mKind)] <> quantified) inner - ConstrainedType _ _ _ -> error "TODO: ConstrainedType (shouldn't ever appear in Purus CoreFn)" + ConstrainedType _ cstrnt innertype -> do + cstrnt' <- prettyConstraint cstrnt + inner' <- prettyType innertype + pure . group $ cstrnt' <+> "=>" <+> inner' + Skolem _ var _ i _ -> pure $ pretty var <> "#" <> pretty i @@ -151,6 +155,12 @@ prettyType t = group <$> case t of pure $ Left ([],parens (pretty txt <::> k')) other -> Right . pure <$> prettyType other -- error $ "Malformed row fields: \n" <> prettyTypeStr other +prettyConstraint :: forall a ann. Show a => Constraint a -> Printer ann +prettyConstraint Constraint{..} = do + let classNm = pretty $ showQualified runProperName constraintClass + argTypes <- hsep <$> traverse prettyType constraintArgs + pure . group $ classNm <+> argTypes + -- TODO For debugging, remove later smartRender :: Doc ann -> Text @@ -158,3 +168,6 @@ smartRender = renderStrict . layoutPretty defaultLayoutOptions prettyTypeStr :: forall a. Show a => Type a -> String prettyTypeStr = T.unpack . smartRender . asOneLine prettyType + +prettyTypeTxt :: forall a. Show a => Type a -> Text +prettyTypeTxt = smartRender . asOneLine prettyType diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs index bb6f78701..09faf7d0c 100644 --- a/src/Language/PureScript/Errors.hs +++ b/src/Language/PureScript/Errors.hs @@ -53,6 +53,7 @@ import System.Console.ANSI qualified as ANSI import System.FilePath (makeRelative) import Text.PrettyPrint.Boxes qualified as Box import Witherable (wither) +import Language.PureScript.CoreFn.Pretty.Types ( prettyTypeStr ) -- | A type of error messages data SimpleErrorMessage @@ -1610,7 +1611,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath fileCon -- If both rows are not empty, print them as diffs -- If verbose print all rows else only print unique rows - printRows :: Type a -> Type a -> (Box.Box, Box.Box) + printRows :: Show a => Type a -> Type a -> (Box.Box, Box.Box) printRows r1 r2 = case (full, r1, r2) of (True, _ , _) -> (printRow typeAsBox r1, printRow typeAsBox r2) @@ -1689,10 +1690,10 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath fileCon prettyDepth | full = 1000 | otherwise = 3 - prettyType :: Type a -> Box.Box - prettyType = prettyTypeWithDepth prettyDepth + prettyType :: SourceType -> Box.Box + prettyType = Box.text . prettyTypeStr - prettyTypeWithDepth :: Int -> Type a -> Box.Box + prettyTypeWithDepth :: Show a => Int -> Type a -> Box.Box prettyTypeWithDepth depth | full = typeAsBox depth | otherwise = typeAsBox depth . eraseKindApps @@ -1986,7 +1987,7 @@ renderBox = unlines where whiteSpace = all isSpace -toTypelevelString :: Type a -> Maybe Box.Box +toTypelevelString :: Show a => Type a -> Maybe Box.Box toTypelevelString (TypeLevelString _ s) = Just . Box.text $ decodeStringWithReplacement s toTypelevelString (TypeApp _ (TypeConstructor _ C.Text) x) = diff --git a/src/Language/PureScript/Pretty/Types.hs b/src/Language/PureScript/Pretty/Types.hs index 57720bd8f..4ef25b5c1 100644 --- a/src/Language/PureScript/Pretty/Types.hs +++ b/src/Language/PureScript/Pretty/Types.hs @@ -36,6 +36,7 @@ import Language.PureScript.PSString (PSString, prettyPrintString, decodeString) import Language.PureScript.Label (Label(..)) import Text.PrettyPrint.Boxes (Box(..), hcat, hsep, left, moveRight, nullBox, render, text, top, vcat, (<>)) +import Language.PureScript.CoreFn.Pretty.Types (prettyTypeStr) data PrettyPrintType @@ -253,8 +254,8 @@ prettyPrintTypeAtom maxDepth = render . typeAtomAsBox maxDepth typeAsBox' :: PrettyPrintType -> Box typeAsBox' = typeAsBoxImpl defaultOptions -typeAsBox :: Int -> Type a -> Box -typeAsBox maxDepth = typeAsBox' . convertPrettyPrintType maxDepth +typeAsBox :: Show a => Int -> Type a -> Box +typeAsBox maxDepth = text . prettyTypeStr -- typeAsBox' . convertPrettyPrintType maxDepth typeDiffAsBox' :: PrettyPrintType -> Box typeDiffAsBox' = typeAsBoxImpl diffOptions diff --git a/src/Language/PureScript/Sugar/Names.hs b/src/Language/PureScript/Sugar/Names.hs index 43deb7780..753f7288c 100644 --- a/src/Language/PureScript/Sugar/Names.hs +++ b/src/Language/PureScript/Sugar/Names.hs @@ -356,6 +356,7 @@ renameInModule imports (Module modSS coms mn decls exps) = updateType (TypeOp ann@(ss, _) name) = TypeOp ann <$> updateTypeOpName name ss updateType (TypeConstructor ann@(ss, _) name) = TypeConstructor ann <$> updateTypeName name ss updateType (ConstrainedType ann c t) = ConstrainedType ann <$> updateInConstraint c <*> pure t + updateType (TypeVar ann nm ki) = TypeVar ann nm <$> updateType ki updateType t = return t updateInConstraint :: SourceConstraint -> m SourceConstraint updateInConstraint (Constraint ann@(ss, _) name ks ts info) = diff --git a/src/Language/PureScript/TypeChecker/Kinds.hs b/src/Language/PureScript/TypeChecker/Kinds.hs index e9f48eb01..3bc62a8bf 100644 --- a/src/Language/PureScript/TypeChecker/Kinds.hs +++ b/src/Language/PureScript/TypeChecker/Kinds.hs @@ -58,6 +58,7 @@ import Language.PureScript.Types import Language.PureScript.Pretty.Types (prettyPrintType) import Language.PureScript.CST.Types (Comment) + -- TODO/REVIEW/HACK: ----------------------------------- -- NO CLUE IF THE CHANGES I MADE HERE ARE CORRECT generalizeUnknowns :: [(Unknown, SourceType)] -> SourceType -> SourceType @@ -190,10 +191,10 @@ inferKind = \tyToInfer -> pure (ty, E.kindSymbol $> ann) ty@(TypeLevelInt ann _) -> pure (ty, E.tyInt $> ann) - ty@(TypeVar ann v ki) -> do - moduleName <- unsafeCheckCurrentModule - kind <- apply =<< lookupTypeVariable moduleName (Qualified ByNullSourcePos $ ProperName v) - pure (ty, kind $> ann) + ty@(TypeVar ann v kx) -> do + -- moduleName <- unsafeCheckCurrentModule + -- kind <- apply =<< lookupTypeVariable moduleName (Qualified ByNullSourcePos $ ProperName v) + pure (ty, kx $> ann) ty@(Skolem ann _ mbK _ _) -> do kind <- apply $ mbK pure (ty, kind $> ann) @@ -218,7 +219,7 @@ inferKind = \tyToInfer -> KindApp ann t1 t2 -> do (t1', kind) <- bitraverse pure apply =<< go t1 case kind of - ForAll _ _ arg (argKind) resKind _ -> do + ForAll _ _ arg argKind resKind _ -> do t2' <- checkKind t2 argKind pure (KindApp ann t1' t2', replaceTypeVars arg t2' resKind) _ -> @@ -529,10 +530,10 @@ elaborateKind = \case throwError . errorMessage' (fst ann) . UnknownName . fmap TyName $ v Just (kind, _) -> ($> ann) <$> apply kind - TypeVar ann a ki -> do - moduleName <- unsafeCheckCurrentModule - kind <- apply =<< lookupTypeVariable moduleName (Qualified ByNullSourcePos $ ProperName a) - unifyKinds ki kind -- TODO/REVIEW/HACK: I DO NOT KNOW WHETHER THIS IS WHAT WE WANT + TypeVar ann a kind -> do + -- moduleName <- unsafeCheckCurrentModule + -- kind <- apply =<< lookupTypeVariable moduleName (Qualified ByNullSourcePos $ ProperName a) + -- unifyKinds ki kind -- TODO/REVIEW/HACK: I DO NOT KNOW WHETHER THIS IS WHAT WE WANT pure (kind $> ann) (Skolem ann _ mbK _ _) -> do kind <- apply $ mbK diff --git a/src/Language/PureScript/TypeChecker/Unify.hs b/src/Language/PureScript/TypeChecker/Unify.hs index d3194f09a..958673e15 100644 --- a/src/Language/PureScript/TypeChecker/Unify.hs +++ b/src/Language/PureScript/TypeChecker/Unify.hs @@ -128,7 +128,7 @@ unifyTypes t1 t2 = do sk `unifyTypes` ty2 unifyTypes' ForAll{} _ = internalError "unifyTypes: unspecified skolem scope" unifyTypes' ty f@ForAll{} = f `unifyTypes` ty - unifyTypes' (TypeVar _ v1 k1) (TypeVar _ v2 k2) | v1 == v2 = unifyTypes k1 k2 -- REVIEW/HACK: Not sure if this is right... + unifyTypes' (TypeVar _ v1 k1) (TypeVar _ v2 k2) | v1 == v2 = pure () -- unifyTypes k1 k2 -- REVIEW/HACK: Not sure if this is right... unifyTypes' ty1@(TypeConstructor _ c1) ty2@(TypeConstructor _ c2) = guardWith (errorMessage (TypesDoNotUnify ty1 ty2)) (c1 == c2) unifyTypes' (TypeLevelString _ s1) (TypeLevelString _ s2) | s1 == s2 = return () diff --git a/tests/purus/passing/2018/output/A/index.cfn.pretty b/tests/purus/passing/2018/output/A/index.cfn.pretty index 9463be026..1f933641e 100644 --- a/tests/purus/passing/2018/output/A/index.cfn.pretty +++ b/tests/purus/passing/2018/output/A/index.cfn.pretty @@ -10,5 +10,5 @@ Re-Exports: Foreign: Declarations: -foo :: Foo -> Foo -foo = \(x: Foo) -> (x: Foo) \ No newline at end of file +foo :: B.Foo -> B.Foo +foo = \(x: B.Foo) -> (x: B.Foo) \ No newline at end of file diff --git a/tests/purus/passing/2018/output/B/index.cfn.pretty b/tests/purus/passing/2018/output/B/index.cfn.pretty index f3e6efc59..1f3a59e7c 100644 --- a/tests/purus/passing/2018/output/B/index.cfn.pretty +++ b/tests/purus/passing/2018/output/B/index.cfn.pretty @@ -10,8 +10,8 @@ Re-Exports: Foreign: Declarations: -X :: Foo +X :: B.Foo X = X -Y :: Foo +Y :: B.Foo Y = Y \ No newline at end of file diff --git a/tests/purus/passing/2138/output/Lib/index.cfn.pretty b/tests/purus/passing/2138/output/Lib/index.cfn.pretty index 38396b22f..f97021a49 100644 --- a/tests/purus/passing/2138/output/Lib/index.cfn.pretty +++ b/tests/purus/passing/2138/output/Lib/index.cfn.pretty @@ -10,8 +10,8 @@ Re-Exports: Foreign: Declarations: -B :: A +B :: Lib.A B = B -C :: A +C :: Lib.A C = C \ No newline at end of file diff --git a/tests/purus/passing/2609/output/Eg/index.cfn.pretty b/tests/purus/passing/2609/output/Eg/index.cfn.pretty index e610aa7e0..4828e6381 100644 --- a/tests/purus/passing/2609/output/Eg/index.cfn.pretty +++ b/tests/purus/passing/2609/output/Eg/index.cfn.pretty @@ -10,5 +10,5 @@ Re-Exports: Foreign: Declarations: -Bar' :: Int -> Int -> Foo' +Bar' :: Prim.Int -> Prim.Int -> Eg.Foo' Bar' = Bar' \ No newline at end of file diff --git a/tests/purus/passing/4035/Other.purs b/tests/purus/passing/4035/Other.purs index 2cf1990c5..20b560f36 100644 --- a/tests/purus/passing/4035/Other.purs +++ b/tests/purus/passing/4035/Other.purs @@ -1,4 +1,5 @@ module Other where -type Id :: forall (k :: Type). (k :: Type) -> (k :: Type) -type Id a = (a :: Type) + +type Id :: Type -> Type +type Id (a :: Prim.Type) = a diff --git a/tests/purus/passing/4035/output/Other/externs.cbor b/tests/purus/passing/4035/output/Other/externs.cbor new file mode 100644 index 0000000000000000000000000000000000000000..6249a05caf64ebf908391280a5a5e077dad75101 GIT binary patch literal 697 zcmeBVNH@?kG}SXSPW3OzNG+P*!qmc0p}p^}&kt zfD*;c42+D;46G8eO$SWBzYw z0O|m1ZeedC+ENytW(F1si3W1?G_#Umk08(<;f7|0CPuJtniw+NO7oISGV}9DG6v*a z0c2xRLMjVVNisqN;$tMIfX!%RY+(ck-~6V;L{bc7C6BC literal 0 HcmV?d00001 diff --git a/tests/purus/passing/4035/output/Other/index.cfn b/tests/purus/passing/4035/output/Other/index.cfn new file mode 100644 index 000000000..6c39aff2b --- /dev/null +++ b/tests/purus/passing/4035/output/Other/index.cfn @@ -0,0 +1 @@ +{"builtWith":"0.0.1","comments":[],"dataTypes":{},"decls":[],"exports":[],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[5,29],"start":[1,1]}},"moduleName":["Builtin"]},{"annotation":{"meta":null,"sourceSpan":{"end":[5,29],"start":[1,1]}},"moduleName":["Prim"]}],"moduleName":["Other"],"modulePath":"tests/purus/passing/4035/Other.purs","reExports":{},"sourceSpan":{"end":[5,29],"start":[1,1]}} \ No newline at end of file diff --git a/tests/purus/passing/4035/output/Other/index.cfn.pretty b/tests/purus/passing/4035/output/Other/index.cfn.pretty new file mode 100644 index 000000000..86bd3cdf3 --- /dev/null +++ b/tests/purus/passing/4035/output/Other/index.cfn.pretty @@ -0,0 +1,11 @@ +Other (tests/purus/passing/4035/Other.purs) +Imported Modules: + Builtin, + Prim +Exports: + +Re-Exports: + +Foreign: + +Declarations: diff --git a/tests/purus/passing/4101/Lib.purs b/tests/purus/passing/4101/Lib.purs index fc5f850e7..b5bab0749 100644 --- a/tests/purus/passing/4101/Lib.purs +++ b/tests/purus/passing/4101/Lib.purs @@ -1,7 +1,7 @@ module Lib where -newtype Const :: forall k. Type -> k -> Type -newtype Const a b = Const a +-- newtype Const :: forall (j :: Type) (k :: j). Type -> k -> Type +newtype Const (a :: Prim.Type) (b :: Prim.Type) = Const a data Unit = Unit diff --git a/tests/purus/passing/4101/output/Lib/externs.cbor b/tests/purus/passing/4101/output/Lib/externs.cbor index c026e2ce4edb17831053bac413f43a1e64226efb..dbf26f2dd5a688c240ee71e4b0bbbd3b459546e2 100644 GIT binary patch literal 2985 zcmdT`O;5r=5S68U9yl~BtV_Nu34I{=dLe(2=dN~;@BV*;-IipAT8`M2~@HAPA2Txb7)pyJn zi;!hcAU$BIEQ8Mb*q|e)M-WgZe5O#YQfuu<6x*09RswnO0YH4_9tXg+(ARYW-X*MZ z&DVQ`G|K?2o|McXHYZK z<)WBM?~jPj0L@Gn;1+hT&PQUN6a9%0+>b!&<5a92|J0giGXF&_gWhU`e`x^x($Rhv% literal 3417 zcmdT{OK;Oa5FV#RBnLROheVh~{O{E8u!R4U;sPTxM4pezPQr z;^pMcY&x6Zkug3_Bm{wk!7zvL@FGr9QJPidtzmH*N2Guj{_^4B@zJLf!8;f}dXI8d zS-|4sRrF1Opx<9xUcmAoi_X(1#&>2}agGuu-XDY9F=Jah61GOKxCq!v$a~IWqvuNQ z1(%Qqe*(DUwtIFJPq;yxYJ$fWz zd$h+HtE$_c(I5h|`geRI%bz6xs1FzLcaprWwqweP+>L*&En%y9YvHB?X00l<%(S2&>s}kp3*U7neti99d|tTabos&ecONkAxT;F@@$6MEEUFSvTFhNW@H4K`P4wl zdCdLiaXR-%9j8yT-;f$aQbBD|!H^eRq^i0V?BHMaU#WUHE=c?rj!PK a3h?e%iY__YrKl8qtgesa#R=~9U!yx@I#E{u diff --git a/tests/purus/passing/4101/output/Lib/index.cfn b/tests/purus/passing/4101/output/Lib/index.cfn index e8a14084e..c183613e5 100644 --- a/tests/purus/passing/4101/output/Lib/index.cfn +++ b/tests/purus/passing/4101/output/Lib/index.cfn @@ -1 +1 @@ -{"builtWith":"0.0.1","comments":[],"dataTypes":{"Const":["newtype",[["a",null],["b",null]],[{"dataCtorAnn":[{"end":[4,28],"name":"tests/purus/passing/4101/Lib.purs","start":[4,19]},[]],"dataCtorFields":[[{"Ident":"value0"},{"annotation":[{"end":[4,28],"name":"tests/purus/passing/4101/Lib.purs","start":[4,27]},[]],"contents":"a","tag":"TypeVar"}]],"dataCtorName":"Const"}]],"Unit":["data",[],[{"dataCtorAnn":[{"end":[6,17],"name":"tests/purus/passing/4101/Lib.purs","start":[6,11]},[]],"dataCtorFields":[],"dataCtorName":"Unit"}]]},"decls":[{"annotation":{"meta":null,"sourceSpan":{"end":[6,17],"start":[6,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[6,17],"start":[6,1]}},"constructorName":"Unit","fieldNames":[],"kind":"Constructor","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"Unit"],"tag":"TypeConstructor"},"typeName":"Unit"},"identifier":"Unit"},{"annotation":{"meta":null,"sourceSpan":{"end":[4,28],"start":[4,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[4,28],"start":[4,1]}},"argument":"x","body":{"annotation":{"meta":null,"sourceSpan":{"end":[4,28],"start":[4,1]}},"kind":"Var","type":{"annotation":[{"end":[4,28],"name":"tests/purus/passing/4101/Lib.purs","start":[4,27]},[]],"contents":"a","tag":"TypeVar"},"value":{"identifier":"x","sourcePos":[0,0]}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":null,"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[4,28],"name":"tests/purus/passing/4101/Lib.purs","start":[4,27]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[4,28],"name":"tests/purus/passing/4101/Lib.purs","start":[4,27]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"}},"identifier":"Const"}],"exports":["Const","Unit"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[9,23],"start":[1,1]}},"moduleName":["Builtin"]},{"annotation":{"meta":null,"sourceSpan":{"end":[9,23],"start":[1,1]}},"moduleName":["Prim"]}],"moduleName":["Lib"],"modulePath":"tests/purus/passing/4101/Lib.purs","reExports":{},"sourceSpan":{"end":[9,23],"start":[1,1]}} \ No newline at end of file +{"builtWith":"0.0.1","comments":[],"dataTypes":{"Const":["newtype",[["a",{"annotation":[{"end":[4,30],"name":"tests/purus/passing/4101/Lib.purs","start":[4,21]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}],["b",{"annotation":[{"end":[4,47],"name":"tests/purus/passing/4101/Lib.purs","start":[4,38]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}]],[{"dataCtorAnn":[{"end":[4,58],"name":"tests/purus/passing/4101/Lib.purs","start":[4,49]},[]],"dataCtorFields":[[{"Ident":"value0"},{"annotation":[{"end":[4,58],"name":"tests/purus/passing/4101/Lib.purs","start":[4,57]},[]],"contents":{"kind":{"annotation":[{"end":[4,30],"name":"tests/purus/passing/4101/Lib.purs","start":[4,21]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}]],"dataCtorName":"Const"}]],"Unit":["data",[],[{"dataCtorAnn":[{"end":[6,17],"name":"tests/purus/passing/4101/Lib.purs","start":[6,11]},[]],"dataCtorFields":[],"dataCtorName":"Unit"}]]},"decls":[{"annotation":{"meta":null,"sourceSpan":{"end":[6,17],"start":[6,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[6,17],"start":[6,1]}},"constructorName":"Unit","fieldNames":[],"kind":"Constructor","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"Unit"],"tag":"TypeConstructor"},"typeName":"Unit"},"identifier":"Unit"},{"annotation":{"meta":null,"sourceSpan":{"end":[4,58],"start":[4,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[4,58],"start":[4,1]}},"argument":"x","body":{"annotation":{"meta":null,"sourceSpan":{"end":[4,58],"start":[4,1]}},"kind":"Var","type":{"annotation":[{"end":[4,58],"name":"tests/purus/passing/4101/Lib.purs","start":[4,57]},[]],"contents":{"kind":{"annotation":[{"end":[4,30],"name":"tests/purus/passing/4101/Lib.purs","start":[4,21]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"},"value":{"identifier":"x","sourcePos":[0,0]}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":{"annotation":[{"end":[4,30],"name":"tests/purus/passing/4101/Lib.purs","start":[4,21]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[4,58],"name":"tests/purus/passing/4101/Lib.purs","start":[4,57]},[]],"contents":{"kind":{"annotation":[{"end":[4,30],"name":"tests/purus/passing/4101/Lib.purs","start":[4,21]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[4,58],"name":"tests/purus/passing/4101/Lib.purs","start":[4,57]},[]],"contents":{"kind":{"annotation":[{"end":[4,30],"name":"tests/purus/passing/4101/Lib.purs","start":[4,21]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"}},"identifier":"Const"}],"exports":["Const","Unit"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[9,23],"start":[1,1]}},"moduleName":["Builtin"]},{"annotation":{"meta":null,"sourceSpan":{"end":[9,23],"start":[1,1]}},"moduleName":["Prim"]}],"moduleName":["Lib"],"modulePath":"tests/purus/passing/4101/Lib.purs","reExports":{},"sourceSpan":{"end":[9,23],"start":[1,1]}} \ No newline at end of file diff --git a/tests/purus/passing/4101/output/Lib/index.cfn.pretty b/tests/purus/passing/4101/output/Lib/index.cfn.pretty index e0001ad97..2f1439c77 100644 --- a/tests/purus/passing/4101/output/Lib/index.cfn.pretty +++ b/tests/purus/passing/4101/output/Lib/index.cfn.pretty @@ -10,8 +10,8 @@ Re-Exports: Foreign: Declarations: -Unit :: Unit +Unit :: Lib.Unit Unit = Unit -Const :: forall a. a -> a -Const = \(x: a) -> (x: a) \ No newline at end of file +Const :: forall (a :: Prim.Type). (a :: Prim.Type) -> (a :: Prim.Type) +Const = \(x: (a :: Prim.Type)) -> (x: (a :: Prim.Type)) \ No newline at end of file diff --git a/tests/purus/passing/4105/Lib.purs b/tests/purus/passing/4105/Lib.purs index 89ccc3043..4f29753ff 100644 --- a/tests/purus/passing/4105/Lib.purs +++ b/tests/purus/passing/4105/Lib.purs @@ -1,5 +1,5 @@ module Lib where -type Template col = { bio :: col String } -type Identity a = a +type Template (col :: Prim.Type -> Prim.Type) = { bio :: col String } +type Identity (a :: Prim.Type) = a type Patch = Template Identity diff --git a/tests/purus/passing/4105/output/Lib/externs.cbor b/tests/purus/passing/4105/output/Lib/externs.cbor index cfb270a3650d2cf68068fbfff2761687c983fbfb..9af3cc5f90914a1d1b9c8a68252f7efeaf8ce66c 100644 GIT binary patch literal 2591 zcmeHJ%TB^T6rBo07wS%(m590(sK~}d7e+};ToC00C~biz(2{nV$Zq;@;aBui>vY+&qbdMHsa~-t+F-fR1rXqES}j9F7(z}U?h7nDDU=uqBVSdm z*As|30`5)GU|nEpGWnAm8RKyRH4y72mor*K29gUJb56nR Ge)k9cd`u?* delta 437 zcmbO)vOs7<0VBJFTr&f+gvR6mRvkFofLWIfDr~?gI{5>mHoJrpM42L!4XY@SDK;6w z`p+&gc|Q{$W8>sNR-j694Sd6F%LX!9LTj=CvkugjWEQ*01&pkW8k1MBSaL#)ZfItl z9LT1{4dy8}Bq!(ROg3cJVS_rckoXp6q!Og z=K~FDVQgZ^@Jva~E6FUWoZpm~*a%U?16TAPBEZQa3^65f@?DN|Of4KBqnKF5Cns_m aPQJz|1@x8HHz?0o@IFe diff --git a/tests/purus/passing/4200/Lib.purs b/tests/purus/passing/4200/Lib.purs index 645940a23..11c30819a 100644 --- a/tests/purus/passing/4200/Lib.purs +++ b/tests/purus/passing/4200/Lib.purs @@ -1,7 +1,7 @@ module Lib where -data T :: forall m. m -> Type -data T msg = E +data T :: Type -> Type +data T (msg :: Type) = E -type TAlias :: forall k. k -> Type -type TAlias msg = T msg +type TAlias :: Type -> Type +type TAlias (msg :: Type) = T msg diff --git a/tests/purus/passing/4200/output/Lib/externs.cbor b/tests/purus/passing/4200/output/Lib/externs.cbor index d0ee9d943f834534ab58f0a285105ad304ee7415..447aab50899c1eaf2568ba81f3376630f345f3f5 100644 GIT binary patch literal 1480 zcmb_cNlwE+5NszQ7UBS6Q3i=c@PH(24*&^H9600wgd~`e5))-?32w6q#4G$%)9x%d z%4G)S;IYSccU5(j<_Ds7^Wvs?an*a|FPW`a_&7@jA`z`|I!STu3c=&3b$!`xxA2!H zz7__8z(B~(HFP^F!}UJ*FMaLY4tZB7nP(RIPZK^;py5W9>-l~RzYWpi(R3*=JVY$q|D#cxq72lgUsAmHJ#U&N21&sXq>q_KHTby-~ zTZ%%kgufPaiTTqo%c*;G>NvPMJMswIyu#g_`T=4zWXb1$q>W%#9rj?s*i>qX2jxu# xHdst9(|&G*s4ZlNWpUIrcefy9$8n_bx0S01})yaOejR+7hBRp=uHdZgy;e_=>ya27%qfVt1?h$iz{|*&vL4T7v;?h&)4E5%JN$H~rsqE1x|w0KkV(sJk)c zf@&eYE|XJrmGDblX*w)Rbh;9;nvzMvyjBB9h!81z24!98*M_~tz;@5DHpT|EVY|nO zYmwFD>s#GM|6u4E5Pg^aMzltKlw^;HH#UiVQtWV5B&jyH7RkypLq{!<5&Gge+v?aR q%6D1^{T!jcV};mJruboAy>Rlhl=listbJ}dB?c7~n%6;je|-bUI77?; diff --git a/tests/purus/passing/4200/output/Lib/index.cfn b/tests/purus/passing/4200/output/Lib/index.cfn index ee1a0ebe2..1e4b01e2b 100644 --- a/tests/purus/passing/4200/output/Lib/index.cfn +++ b/tests/purus/passing/4200/output/Lib/index.cfn @@ -1 +1 @@ -{"builtWith":"0.0.1","comments":[],"dataTypes":{"T":["data",[["msg",null]],[{"dataCtorAnn":[{"end":[4,15],"name":"tests/purus/passing/4200/Lib.purs","start":[4,12]},[]],"dataCtorFields":[],"dataCtorName":"E"}]]},"decls":[{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[4,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[4,1]}},"constructorName":"E","fieldNames":[],"kind":"Constructor","type":{"annotation":[{"end":[3,30],"name":"tests/purus/passing/4200/Lib.purs","start":[3,11]},[]],"contents":{"identifier":"m","kind":{"annotation":[{"end":[3,25],"name":"tests/purus/passing/4200/Lib.purs","start":[3,23]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"msg","kind":{"annotation":[{"end":[3,22],"name":"tests/purus/passing/4200/Lib.purs","start":[3,21]},[]],"contents":"m","tag":"TypeVar"},"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"T"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":"m","tag":"TypeVar"}],"tag":"KindApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":"msg","tag":"TypeVar"}],"tag":"TypeApp"},"visibility":"TypeVarVisible"},"tag":"ForAll"},"visibility":"TypeVarInvisible"},"tag":"ForAll"},"typeName":"T"},"identifier":"E"}],"exports":["E"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[7,24],"start":[1,1]}},"moduleName":["Builtin"]},{"annotation":{"meta":null,"sourceSpan":{"end":[7,24],"start":[1,1]}},"moduleName":["Prim"]}],"moduleName":["Lib"],"modulePath":"tests/purus/passing/4200/Lib.purs","reExports":{},"sourceSpan":{"end":[7,24],"start":[1,1]}} \ No newline at end of file +{"builtWith":"0.0.1","comments":[],"dataTypes":{"T":["data",[["msg",{"annotation":[{"end":[4,20],"name":"tests/purus/passing/4200/Lib.purs","start":[4,16]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}]],[{"dataCtorAnn":[{"end":[4,25],"name":"tests/purus/passing/4200/Lib.purs","start":[4,22]},[]],"dataCtorFields":[],"dataCtorName":"E"}]]},"decls":[{"annotation":{"meta":null,"sourceSpan":{"end":[4,25],"start":[4,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[4,25],"start":[4,1]}},"constructorName":"E","fieldNames":[],"kind":"Constructor","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"msg","kind":{"annotation":[{"end":[4,20],"name":"tests/purus/passing/4200/Lib.purs","start":[4,16]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"T"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"kind":{"annotation":[{"end":[4,20],"name":"tests/purus/passing/4200/Lib.purs","start":[4,16]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"msg"},"tag":"TypeVar"}],"tag":"TypeApp"},"visibility":"TypeVarVisible"},"tag":"ForAll"},"typeName":"T"},"identifier":"E"}],"exports":["E"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[7,34],"start":[1,1]}},"moduleName":["Builtin"]},{"annotation":{"meta":null,"sourceSpan":{"end":[7,34],"start":[1,1]}},"moduleName":["Prim"]}],"moduleName":["Lib"],"modulePath":"tests/purus/passing/4200/Lib.purs","reExports":{},"sourceSpan":{"end":[7,34],"start":[1,1]}} \ No newline at end of file diff --git a/tests/purus/passing/4200/output/Lib/index.cfn.pretty b/tests/purus/passing/4200/output/Lib/index.cfn.pretty index c428541be..2e8eadad0 100644 --- a/tests/purus/passing/4200/output/Lib/index.cfn.pretty +++ b/tests/purus/passing/4200/output/Lib/index.cfn.pretty @@ -9,5 +9,5 @@ Re-Exports: Foreign: Declarations: -E :: forall (m :: Type) (@msg :: m). T@m msg +E :: forall (@msg :: Prim.Type). Lib.T (msg :: Prim.Type) E = E \ No newline at end of file diff --git a/tests/purus/passing/4310/Lib.purs b/tests/purus/passing/4310/Lib.purs index 2c5b87070..4700555f6 100644 --- a/tests/purus/passing/4310/Lib.purs +++ b/tests/purus/passing/4310/Lib.purs @@ -1,6 +1,8 @@ module Lib where -data Tuple a b = Tuple a b +import Prim (Type, String, Int) + +data Tuple (a :: Prim.Type) (b :: Prim.Type) = Tuple a b infixr 6 Tuple as /\ infixr 6 type Tuple as /\ @@ -10,11 +12,13 @@ mappend _ _ = "mappend" infixr 5 mappend as <> -class Test a where +class Test (a :: Prim.Type) where runTest :: a -> String instance Test Int where runTest _ = "4" +{- TODO/FIXME: Disabled while I figure out what to do here instance (Test a, Test b) => Test (a /\ b) where runTest (a /\ b) = runTest a <> runTest b +-} diff --git a/tests/purus/passing/4310/output/Lib/externs.cbor b/tests/purus/passing/4310/output/Lib/externs.cbor index 0c4ee2c6eb47bc6104f747fa2a55305c2ad52002..906cdebe342fa656b68dbba6854d389ff71bd6cb 100644 GIT binary patch literal 6223 zcmeHMOK;Oa5FWQRkEoC+1++j>K_E`3X;hw4#Q_i!5(fl1a;O`-!O*&q9|&&t+HHmS z5&o0h&F)ib9LKaqy@#9qjUM@Aoji6zP?Qi>x)?^bXAQ{b(SoF*G4RHFMi662uaa;{a)h1U z$55HUMmofOZ9FzCUEaa1=OIWss53Ct2)=BM49l=J*U-r*0Q85zO;hv6aswraBhcU3 z=6(PH`y0XNg=g-$rbV9c%j_Gh#KH+$yd1(J$*ey3J~jeh-0ljoLpLz&esFEV7#UNv zN^RFL3~6kB;wSMT1j;!KG|7M!N=~eBuF!WXc}MZh-cf9_JWaLbEF%mrNPBz{N3hM& z^#jnfP$iFqRzSNOLL1%msS7Lt8DvqbGUyRhZVQK5ru{flD({={An~K~qEU26wmazh z3>M-@bvk5@ZW*XguRUw%ng!Fe0ljLZD z#~$R1bFM017vjl5o5&tpDFxjoZtKaIQ(gx7CKFC;!oTvnNybbdJaIb(a3(}DF)_#1 zT}P|QA)6qT?-P-|`&HZXj17L#PnZtM6cYS#rCWE;0ctk;<81NlPz@dt-QD>xY*rTL&gNi;;~yWT62vkb~SrJacE= z%%9F|I*u^1saE z(>amK!-CtBdaeOxQ#GgSWJ61im$Gd+#xgBvT`gygV}711+~uFu+}Ubw;`_gTs&xNP uNy7wIal%VfyLjF0wnOMv)Gj?pO#(l_LbATAkb{irXU;@L2@R3{L*O^z7|=if literal 5733 zcmeHLNpI6Y6dpGX1ZdMh08Lp0NCgRmnns0N#Q_i!5(fl1_RvY}1VigaUJ%?ow%ZEv zBm5`1n>XX#NtBtSaDhWpkH>G`_PuR>pwZ5D_xW~rckoW{hkh+U-yYbSWm}!GV><9l zEK4^=ooBncNkD1M6kRoNr@oqbE2GLyS`W~dy^&^UCb2aYjzNh1fzg?V-WoPlf|=h8**Bei zszhOc)c2--L=olxv!xrL(Mv}^v~>ga(#I$~K~%ZmA!c3VDGV5%l6r~l)nSimmFzKr z67x)@P5le#%JFh`$qUdys*+0)A=Iyz-Z2JTU=OLi?_({vT-rWGrDZM-H=Y~%N@<^v z$PF&SD^j95@I}Bz~h=*Q1jCp#~9f9vB6~*JA?_k;SwUjw;k(NU_AV2 zn-JyHLl91>tHrHVgKSX4wWjYXLSY|%C5Mi-lRk7K zUICI?!8r<{qp{|r27V-wUQ!CKh8Pb>ij5o7lQGLKVuvt6OBp>$tP;B3l-4z&kkA$1 zWlZiZt1V}Ir+7-Du8b)6V|@#`EVUT~f7}PL^nH-E3iFYgG!1!F3OlelQIdILoe~WR zkI%1;4a+u(ZrI*RNKwSfr_Q>!t=Ia%7Wex)lu)^bBc%{Gc1AI)gbION+D2(@Qu5lg z45Oqlv6Fb@G?Xp~L3R$7Wfat4^< zCLnh)h4~|2O;+|~c31{h6%bXHvok=JWrQjIqwu`ul|PKa`5ujXq8ypkHi)n;NL8T{ zL}#l>ISakCLth52ygAP;DxR@g8$N24db|PL z#6;Ako{&FV3QTF!FLtJgnB3wp%!rHFjxXnmjTx`O9_cTCNaR-Q?X)lvGDT6&iRnV@ z1ia;=Hhw5IY_{=ZM)bsmVUvdZ8cB@V6(GCHty+Lla?vDq0<@QK0=tTmU<;E;8|LW> ce5LrZnVg*g8oQAoP}{SC3SF*{zR4}|Z+p5Z&;S4c diff --git a/tests/purus/passing/4310/output/Lib/index.cfn b/tests/purus/passing/4310/output/Lib/index.cfn index a4b511219..8f345b0a8 100644 --- a/tests/purus/passing/4310/output/Lib/index.cfn +++ b/tests/purus/passing/4310/output/Lib/index.cfn @@ -1 +1 @@ -{"builtWith":"0.0.1","comments":[],"dataTypes":{"Test$Dict":["newtype",[["a",null]],[{"dataCtorAnn":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[13,1]},[]],"dataCtorFields":[[{"Ident":"dict"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["runTest",{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,18],"name":"tests/purus/passing/4310/Lib.purs","start":[14,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[14,15],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"RCons"}],"tag":"TypeApp"}]],"dataCtorName":"Test$Dict"}]],"Tuple":["data",[["a",null],["b",null]],[{"dataCtorAnn":[{"end":[3,23],"name":"tests/purus/passing/4310/Lib.purs","start":[3,16]},[]],"dataCtorFields":[[{"Ident":"value0"},{"annotation":[{"end":[3,25],"name":"tests/purus/passing/4310/Lib.purs","start":[3,24]},[]],"contents":"a","tag":"TypeVar"}],[{"Ident":"value1"},{"annotation":[{"end":[3,27],"name":"tests/purus/passing/4310/Lib.purs","start":[3,26]},[]],"contents":"b","tag":"TypeVar"}]],"dataCtorName":"Tuple"}]]},"decls":[{"annotation":{"meta":null,"sourceSpan":{"end":[3,27],"start":[3,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[3,27],"start":[3,1]}},"constructorName":"Tuple","fieldNames":["value0","value1"],"kind":"Constructor","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"b","kind":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[3,25],"name":"tests/purus/passing/4310/Lib.purs","start":[3,24]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[3,27],"name":"tests/purus/passing/4310/Lib.purs","start":[3,26]},[]],"contents":"b","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"Tuple"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":"b","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"}],"tag":"TypeApp"},"visibility":"TypeVarVisible"},"tag":"ForAll"},"visibility":"TypeVarVisible"},"tag":"ForAll"},"typeName":"Tuple"},"identifier":"Tuple"},{"annotation":{"meta":{"metaType":"IsTypeClassConstructor"},"sourceSpan":{"end":[14,25],"start":[13,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[14,25],"start":[13,1]}},"argument":"x","body":{"annotation":{"meta":null,"sourceSpan":{"end":[14,25],"start":[13,1]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["runTest",{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,18],"name":"tests/purus/passing/4310/Lib.purs","start":[14,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[14,15],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"RCons"}],"tag":"TypeApp"},"value":{"identifier":"x","sourcePos":[0,0]}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":null,"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["runTest",{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,18],"name":"tests/purus/passing/4310/Lib.purs","start":[14,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[14,15],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"RCons"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["runTest",{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,18],"name":"tests/purus/passing/4310/Lib.purs","start":[14,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[14,15],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"RCons"}],"tag":"TypeApp"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"}},"identifier":"Test$Dict"},{"annotation":{"meta":null,"sourceSpan":{"end":[17,18],"start":[16,1]}},"bindType":"NonRec","expression":{"abstraction":{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[17,18],"start":[16,1]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["runTest",{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,18],"name":"tests/purus/passing/4310/Lib.purs","start":[14,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[16,18],"name":"tests/purus/passing/4310/Lib.purs","start":[16,15]},[]],"contents":[["Prim"],"Int"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"},{"annotation":[{"end":[14,18],"name":"tests/purus/passing/4310/Lib.purs","start":[14,16]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}],"tag":"KindApp"}],"tag":"RCons"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"Test$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[16,18],"name":"tests/purus/passing/4310/Lib.purs","start":[16,15]},[]],"contents":[["Prim"],"Int"],"tag":"TypeConstructor"}],"tag":"TypeApp"}],"tag":"TypeApp"},"value":{"identifier":"Test$Dict","moduleName":["Lib"]}},"annotation":{"meta":null,"sourceSpan":{"end":[17,18],"start":[16,1]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[17,18],"start":[16,1]}},"kind":"Literal","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["runTest",{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,18],"name":"tests/purus/passing/4310/Lib.purs","start":[14,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[16,18],"name":"tests/purus/passing/4310/Lib.purs","start":[16,15]},[]],"contents":[["Prim"],"Int"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"},{"annotation":[{"end":[14,18],"name":"tests/purus/passing/4310/Lib.purs","start":[14,16]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}],"tag":"KindApp"}],"tag":"RCons"}],"tag":"TypeApp"},"value":{"literalType":"ObjectLiteral","value":[["runTest",{"annotation":{"meta":null,"sourceSpan":{"end":[17,18],"start":[17,3]}},"argument":"v","body":{"annotation":{"meta":null,"sourceSpan":{"end":[17,18],"start":[17,15]}},"kind":"Literal","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"},"value":{"literalType":"StringLiteral","value":"4"}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[16,18],"name":"tests/purus/passing/4310/Lib.purs","start":[16,15]},[]],"contents":[["Prim"],"Int"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"}}]]}},"kind":"App"},"identifier":"testInt"},{"annotation":{"meta":null,"sourceSpan":{"end":[14,25],"start":[14,3]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[14,25],"start":[14,3]}},"argument":"dict","body":{"annotation":{"meta":null,"sourceSpan":{"end":[14,25],"start":[14,3]}},"caseAlternatives":[{"binders":[{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[14,25],"start":[14,3]}},"binderType":"ConstructorBinder","binders":[{"annotation":{"meta":null,"sourceSpan":{"end":[14,25],"start":[14,3]}},"binderType":"VarBinder","identifier":"v"}],"constructorName":{"identifier":"Test$Dict","moduleName":["Lib"]},"typeName":{"identifier":"Test$Dict","moduleName":["Lib"]}}],"expression":{"annotation":{"meta":null,"sourceSpan":{"end":[14,25],"start":[14,3]}},"expression":{"annotation":{"meta":null,"sourceSpan":{"end":[14,25],"start":[14,3]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["runTest",{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,18],"name":"tests/purus/passing/4310/Lib.purs","start":[14,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"},{"annotation":[{"end":[14,18],"name":"tests/purus/passing/4310/Lib.purs","start":[14,16]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}],"tag":"KindApp"}],"tag":"RCons"}],"tag":"TypeApp"},"value":{"identifier":"v","sourcePos":[14,3]}},"fieldName":"runTest","kind":"Accessor","type":{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,18],"name":"tests/purus/passing/4310/Lib.purs","start":[14,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[14,15],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"}},"isGuarded":false}],"caseExpressions":[{"annotation":{"meta":null,"sourceSpan":{"end":[14,25],"start":[14,3]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"Test$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},"value":{"identifier":"dict","sourcePos":[0,0]}}],"kind":"Case","type":{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,18],"name":"tests/purus/passing/4310/Lib.purs","start":[14,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[14,15],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":1,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"Test$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,18],"name":"tests/purus/passing/4310/Lib.purs","start":[14,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[14,15],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"}],"tag":"TypeApp"},"visibility":"TypeVarVisible"},"tag":"ForAll"}},"identifier":"runTest"},{"annotation":{"meta":null,"sourceSpan":{"end":[8,38],"start":[8,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[9,24],"start":[9,1]}},"argument":"v","body":{"annotation":{"meta":null,"sourceSpan":{"end":[9,24],"start":[9,1]}},"argument":"v1","body":{"annotation":{"meta":null,"sourceSpan":{"end":[9,24],"start":[9,15]}},"kind":"Literal","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"},"value":{"literalType":"StringLiteral","value":"mappend"}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[8,28],"name":"tests/purus/passing/4310/Lib.purs","start":[8,22]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[8,38],"name":"tests/purus/passing/4310/Lib.purs","start":[8,32]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[8,18],"name":"tests/purus/passing/4310/Lib.purs","start":[8,12]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[8,38],"name":"tests/purus/passing/4310/Lib.purs","start":[8,22]},[]],"contents":[{"annotation":[{"end":[8,38],"name":"tests/purus/passing/4310/Lib.purs","start":[8,22]},[]],"contents":[{"annotation":[{"end":[8,31],"name":"tests/purus/passing/4310/Lib.purs","start":[8,29]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[8,28],"name":"tests/purus/passing/4310/Lib.purs","start":[8,22]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[8,38],"name":"tests/purus/passing/4310/Lib.purs","start":[8,32]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"}],"tag":"TypeApp"}},"identifier":"mappend"},{"annotation":{"meta":null,"sourceSpan":{"end":[20,44],"start":[19,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"argument":"dictTest","body":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"argument":"dictTest1","body":{"abstraction":{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[20,44],"start":[19,1]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["runTest",{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,18],"name":"tests/purus/passing/4310/Lib.purs","start":[14,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[20,44],"name":"tests/purus/passing/4310/Lib.purs","start":[19,1]},[]],"contents":[["Lib"],"Tuple"],"tag":"TypeConstructor"},{"annotation":[{"end":[19,37],"name":"tests/purus/passing/4310/Lib.purs","start":[19,36]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[19,42],"name":"tests/purus/passing/4310/Lib.purs","start":[19,41]},[]],"contents":"b","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"},{"annotation":[{"end":[14,18],"name":"tests/purus/passing/4310/Lib.purs","start":[14,16]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}],"tag":"KindApp"}],"tag":"RCons"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"Test$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[20,44],"name":"tests/purus/passing/4310/Lib.purs","start":[19,1]},[]],"contents":[["Lib"],"Tuple"],"tag":"TypeConstructor"},{"annotation":[{"end":[19,37],"name":"tests/purus/passing/4310/Lib.purs","start":[19,36]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[19,42],"name":"tests/purus/passing/4310/Lib.purs","start":[19,41]},[]],"contents":"b","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"}],"tag":"TypeApp"},"value":{"identifier":"Test$Dict","moduleName":["Lib"]}},"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"kind":"Literal","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["runTest",{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,18],"name":"tests/purus/passing/4310/Lib.purs","start":[14,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[20,44],"name":"tests/purus/passing/4310/Lib.purs","start":[19,1]},[]],"contents":[["Lib"],"Tuple"],"tag":"TypeConstructor"},{"annotation":[{"end":[19,37],"name":"tests/purus/passing/4310/Lib.purs","start":[19,36]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[19,42],"name":"tests/purus/passing/4310/Lib.purs","start":[19,41]},[]],"contents":"b","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"},{"annotation":[{"end":[14,18],"name":"tests/purus/passing/4310/Lib.purs","start":[14,16]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}],"tag":"KindApp"}],"tag":"RCons"}],"tag":"TypeApp"},"value":{"literalType":"ObjectLiteral","value":[["runTest",{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"argument":"v","body":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"caseAlternatives":[{"binders":[{"annotation":{"meta":{"constructorType":"ProductType","identifiers":["value0","value1"],"metaType":"IsConstructor"},"sourceSpan":{"end":[20,16],"start":[20,14]}},"binderType":"ConstructorBinder","binders":[{"annotation":{"meta":null,"sourceSpan":{"end":[20,13],"start":[20,12]}},"binderType":"VarBinder","identifier":"a"},{"annotation":{"meta":null,"sourceSpan":{"end":[20,18],"start":[20,17]}},"binderType":"VarBinder","identifier":"b"}],"constructorName":{"identifier":"Tuple","moduleName":["Lib"]},"typeName":{"identifier":"Tuple","moduleName":["Lib"]}}],"expression":{"abstraction":{"abstraction":{"annotation":{"meta":null,"sourceSpan":{"end":[20,34],"start":[20,32]}},"kind":"Var","type":{"annotation":[{"end":[8,38],"name":"tests/purus/passing/4310/Lib.purs","start":[8,12]},[]],"contents":[{"annotation":[{"end":[8,38],"name":"tests/purus/passing/4310/Lib.purs","start":[8,12]},[]],"contents":[{"annotation":[{"end":[8,21],"name":"tests/purus/passing/4310/Lib.purs","start":[8,19]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[8,18],"name":"tests/purus/passing/4310/Lib.purs","start":[8,12]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[8,38],"name":"tests/purus/passing/4310/Lib.purs","start":[8,22]},[]],"contents":[{"annotation":[{"end":[8,38],"name":"tests/purus/passing/4310/Lib.purs","start":[8,22]},[]],"contents":[{"annotation":[{"end":[8,31],"name":"tests/purus/passing/4310/Lib.purs","start":[8,29]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[8,28],"name":"tests/purus/passing/4310/Lib.purs","start":[8,22]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[8,38],"name":"tests/purus/passing/4310/Lib.purs","start":[8,32]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"}],"tag":"TypeApp"},"value":{"identifier":"mappend","moduleName":["Lib"]}},"annotation":{"meta":null,"sourceSpan":{"end":[20,44],"start":[20,22]}},"argument":{"abstraction":{"abstraction":{"annotation":{"meta":null,"sourceSpan":{"end":[20,29],"start":[20,22]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":1,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"Test$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,18],"name":"tests/purus/passing/4310/Lib.purs","start":[14,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[14,15],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"}],"tag":"TypeApp"},"visibility":"TypeVarVisible"},"tag":"ForAll"},"value":{"identifier":"runTest","moduleName":["Lib"]}},"annotation":{"meta":null,"sourceSpan":{"end":[20,31],"start":[20,22]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"Test$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[19,17],"name":"tests/purus/passing/4310/Lib.purs","start":[19,16]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},"value":{"identifier":"dictTest","sourcePos":[0,0]}},"kind":"App"},"annotation":{"meta":null,"sourceSpan":{"end":[20,31],"start":[20,22]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[20,31],"start":[20,30]}},"kind":"Var","type":{"annotation":[{"end":[19,37],"name":"tests/purus/passing/4310/Lib.purs","start":[19,36]},[]],"contents":"a","tag":"TypeVar"},"value":{"identifier":"a","sourcePos":[20,12]}},"kind":"App"},"kind":"App"},"annotation":{"meta":null,"sourceSpan":{"end":[20,44],"start":[20,22]}},"argument":{"abstraction":{"abstraction":{"annotation":{"meta":null,"sourceSpan":{"end":[20,42],"start":[20,35]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":1,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"Test$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":[{"annotation":[{"end":[14,18],"name":"tests/purus/passing/4310/Lib.purs","start":[14,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[14,15],"name":"tests/purus/passing/4310/Lib.purs","start":[14,14]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"}],"tag":"TypeApp"},"visibility":"TypeVarVisible"},"tag":"ForAll"},"value":{"identifier":"runTest","moduleName":["Lib"]}},"annotation":{"meta":null,"sourceSpan":{"end":[20,44],"start":[20,35]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"Test$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[19,25],"name":"tests/purus/passing/4310/Lib.purs","start":[19,24]},[]],"contents":"b","tag":"TypeVar"}],"tag":"TypeApp"},"value":{"identifier":"dictTest1","sourcePos":[0,0]}},"kind":"App"},"annotation":{"meta":null,"sourceSpan":{"end":[20,44],"start":[20,35]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[20,44],"start":[20,43]}},"kind":"Var","type":{"annotation":[{"end":[19,42],"name":"tests/purus/passing/4310/Lib.purs","start":[19,41]},[]],"contents":"b","tag":"TypeVar"},"value":{"identifier":"b","sourcePos":[20,17]}},"kind":"App"},"kind":"App"},"isGuarded":false}],"caseExpressions":[{"annotation":{"meta":null,"sourceSpan":{"end":[20,44],"start":[20,3]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[20,44],"name":"tests/purus/passing/4310/Lib.purs","start":[19,1]},[]],"contents":[["Lib"],"Tuple"],"tag":"TypeConstructor"},{"annotation":[{"end":[19,37],"name":"tests/purus/passing/4310/Lib.purs","start":[19,36]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[19,42],"name":"tests/purus/passing/4310/Lib.purs","start":[19,41]},[]],"contents":"b","tag":"TypeVar"}],"tag":"TypeApp"},"value":{"identifier":"v","sourcePos":[0,0]}}],"kind":"Case","type":{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[20,44],"name":"tests/purus/passing/4310/Lib.purs","start":[19,1]},[]],"contents":[["Lib"],"Tuple"],"tag":"TypeConstructor"},{"annotation":[{"end":[19,37],"name":"tests/purus/passing/4310/Lib.purs","start":[19,36]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[19,42],"name":"tests/purus/passing/4310/Lib.purs","start":[19,41]},[]],"contents":"b","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[14,25],"name":"tests/purus/passing/4310/Lib.purs","start":[14,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"}}]]}},"kind":"App"},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"Test$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[19,25],"name":"tests/purus/passing/4310/Lib.purs","start":[19,24]},[]],"contents":"b","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"Test$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[20,44],"name":"tests/purus/passing/4310/Lib.purs","start":[19,1]},[]],"contents":[["Lib"],"Tuple"],"tag":"TypeConstructor"},{"annotation":[{"end":[19,37],"name":"tests/purus/passing/4310/Lib.purs","start":[19,36]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[19,42],"name":"tests/purus/passing/4310/Lib.purs","start":[19,41]},[]],"contents":"b","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"}],"tag":"TypeApp"}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":{"annotation":[{"end":[19,17],"name":"tests/purus/passing/4310/Lib.purs","start":[19,11]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":3,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"b","kind":{"annotation":[{"end":[19,25],"name":"tests/purus/passing/4310/Lib.purs","start":[19,19]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":2,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"Test$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[19,17],"name":"tests/purus/passing/4310/Lib.purs","start":[19,16]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"Test$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[19,25],"name":"tests/purus/passing/4310/Lib.purs","start":[19,24]},[]],"contents":"b","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"Test$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[20,44],"name":"tests/purus/passing/4310/Lib.purs","start":[19,1]},[]],"contents":[["Lib"],"Tuple"],"tag":"TypeConstructor"},{"annotation":[{"end":[19,37],"name":"tests/purus/passing/4310/Lib.purs","start":[19,36]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[19,42],"name":"tests/purus/passing/4310/Lib.purs","start":[19,41]},[]],"contents":"b","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"}],"tag":"TypeApp"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"},"visibility":"TypeVarInvisible"},"tag":"ForAll"}},"identifier":"test/\\"}],"exports":["runTest","Tuple","mappend","testInt","test/\\"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[20,44],"start":[1,1]}},"moduleName":["Builtin"]},{"annotation":{"meta":null,"sourceSpan":{"end":[20,44],"start":[1,1]}},"moduleName":["Lib"]},{"annotation":{"meta":null,"sourceSpan":{"end":[20,44],"start":[1,1]}},"moduleName":["Prim"]}],"moduleName":["Lib"],"modulePath":"tests/purus/passing/4310/Lib.purs","reExports":{},"sourceSpan":{"end":[20,44],"start":[1,1]}} \ No newline at end of file +{"builtWith":"0.0.1","comments":[],"dataTypes":{"Test$Dict":["newtype",[["a",{"annotation":[{"end":[15,27],"name":"tests/purus/passing/4310/Lib.purs","start":[15,18]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}]],[{"dataCtorAnn":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[15,1]},[]],"dataCtorFields":[[{"Ident":"dict"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["runTest",{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":[{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":[{"annotation":[{"end":[16,18],"name":"tests/purus/passing/4310/Lib.purs","start":[16,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[16,15],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":{"kind":{"annotation":[{"end":[15,27],"name":"tests/purus/passing/4310/Lib.purs","start":[15,18]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"RCons"}],"tag":"TypeApp"}]],"dataCtorName":"Test$Dict"}]],"Tuple":["data",[["a",{"annotation":[{"end":[5,27],"name":"tests/purus/passing/4310/Lib.purs","start":[5,18]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}],["b",{"annotation":[{"end":[5,44],"name":"tests/purus/passing/4310/Lib.purs","start":[5,35]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}]],[{"dataCtorAnn":[{"end":[5,53],"name":"tests/purus/passing/4310/Lib.purs","start":[5,46]},[]],"dataCtorFields":[[{"Ident":"value0"},{"annotation":[{"end":[5,55],"name":"tests/purus/passing/4310/Lib.purs","start":[5,54]},[]],"contents":{"kind":{"annotation":[{"end":[5,27],"name":"tests/purus/passing/4310/Lib.purs","start":[5,18]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],[{"Ident":"value1"},{"annotation":[{"end":[5,57],"name":"tests/purus/passing/4310/Lib.purs","start":[5,56]},[]],"contents":{"kind":{"annotation":[{"end":[5,44],"name":"tests/purus/passing/4310/Lib.purs","start":[5,35]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"b"},"tag":"TypeVar"}]],"dataCtorName":"Tuple"}]]},"decls":[{"annotation":{"meta":null,"sourceSpan":{"end":[5,57],"start":[5,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[5,57],"start":[5,1]}},"constructorName":"Tuple","fieldNames":["value0","value1"],"kind":"Constructor","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":{"annotation":[{"end":[5,27],"name":"tests/purus/passing/4310/Lib.purs","start":[5,18]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"b","kind":{"annotation":[{"end":[5,44],"name":"tests/purus/passing/4310/Lib.purs","start":[5,35]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[5,55],"name":"tests/purus/passing/4310/Lib.purs","start":[5,54]},[]],"contents":{"kind":{"annotation":[{"end":[5,27],"name":"tests/purus/passing/4310/Lib.purs","start":[5,18]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[5,57],"name":"tests/purus/passing/4310/Lib.purs","start":[5,56]},[]],"contents":{"kind":{"annotation":[{"end":[5,44],"name":"tests/purus/passing/4310/Lib.purs","start":[5,35]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"b"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"Tuple"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"kind":{"annotation":[{"end":[5,27],"name":"tests/purus/passing/4310/Lib.purs","start":[5,18]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"kind":{"annotation":[{"end":[5,44],"name":"tests/purus/passing/4310/Lib.purs","start":[5,35]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"b"},"tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"}],"tag":"TypeApp"},"visibility":"TypeVarVisible"},"tag":"ForAll"},"visibility":"TypeVarVisible"},"tag":"ForAll"},"typeName":"Tuple"},"identifier":"Tuple"},{"annotation":{"meta":{"metaType":"IsTypeClassConstructor"},"sourceSpan":{"end":[16,25],"start":[15,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[16,25],"start":[15,1]}},"argument":"x","body":{"annotation":{"meta":null,"sourceSpan":{"end":[16,25],"start":[15,1]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["runTest",{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":[{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":[{"annotation":[{"end":[16,18],"name":"tests/purus/passing/4310/Lib.purs","start":[16,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[16,15],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":{"kind":{"annotation":[{"end":[15,27],"name":"tests/purus/passing/4310/Lib.purs","start":[15,18]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"RCons"}],"tag":"TypeApp"},"value":{"identifier":"x","sourcePos":[0,0]}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":{"annotation":[{"end":[15,27],"name":"tests/purus/passing/4310/Lib.purs","start":[15,18]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["runTest",{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":[{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":[{"annotation":[{"end":[16,18],"name":"tests/purus/passing/4310/Lib.purs","start":[16,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[16,15],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":{"kind":{"annotation":[{"end":[15,27],"name":"tests/purus/passing/4310/Lib.purs","start":[15,18]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"RCons"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["runTest",{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":[{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":[{"annotation":[{"end":[16,18],"name":"tests/purus/passing/4310/Lib.purs","start":[16,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[16,15],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":{"kind":{"annotation":[{"end":[15,27],"name":"tests/purus/passing/4310/Lib.purs","start":[15,18]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"RCons"}],"tag":"TypeApp"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"}},"identifier":"Test$Dict"},{"annotation":{"meta":null,"sourceSpan":{"end":[19,18],"start":[18,1]}},"bindType":"NonRec","expression":{"abstraction":{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[19,18],"start":[18,1]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["runTest",{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":[{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":[{"annotation":[{"end":[16,18],"name":"tests/purus/passing/4310/Lib.purs","start":[16,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[18,18],"name":"tests/purus/passing/4310/Lib.purs","start":[18,15]},[]],"contents":[["Prim"],"Int"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"},{"annotation":[{"end":[16,18],"name":"tests/purus/passing/4310/Lib.purs","start":[16,16]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}],"tag":"KindApp"}],"tag":"RCons"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"Test$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[18,18],"name":"tests/purus/passing/4310/Lib.purs","start":[18,15]},[]],"contents":[["Prim"],"Int"],"tag":"TypeConstructor"}],"tag":"TypeApp"}],"tag":"TypeApp"},"value":{"identifier":"Test$Dict","moduleName":["Lib"]}},"annotation":{"meta":null,"sourceSpan":{"end":[19,18],"start":[18,1]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[19,18],"start":[18,1]}},"kind":"Literal","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["runTest",{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":[{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":[{"annotation":[{"end":[16,18],"name":"tests/purus/passing/4310/Lib.purs","start":[16,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[18,18],"name":"tests/purus/passing/4310/Lib.purs","start":[18,15]},[]],"contents":[["Prim"],"Int"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"},{"annotation":[{"end":[16,18],"name":"tests/purus/passing/4310/Lib.purs","start":[16,16]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}],"tag":"KindApp"}],"tag":"RCons"}],"tag":"TypeApp"},"value":{"literalType":"ObjectLiteral","value":[["runTest",{"annotation":{"meta":null,"sourceSpan":{"end":[19,18],"start":[19,3]}},"argument":"v","body":{"annotation":{"meta":null,"sourceSpan":{"end":[19,18],"start":[19,15]}},"kind":"Literal","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"},"value":{"literalType":"StringLiteral","value":"4"}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[18,18],"name":"tests/purus/passing/4310/Lib.purs","start":[18,15]},[]],"contents":[["Prim"],"Int"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"}}]]}},"kind":"App"},"identifier":"testInt"},{"annotation":{"meta":null,"sourceSpan":{"end":[16,25],"start":[16,3]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[16,25],"start":[16,3]}},"argument":"dict","body":{"annotation":{"meta":null,"sourceSpan":{"end":[16,25],"start":[16,3]}},"caseAlternatives":[{"binders":[{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[16,25],"start":[16,3]}},"binderType":"ConstructorBinder","binders":[{"annotation":{"meta":null,"sourceSpan":{"end":[16,25],"start":[16,3]}},"binderType":"VarBinder","identifier":"v"}],"constructorName":{"identifier":"Test$Dict","moduleName":["Lib"]},"typeName":{"identifier":"Test$Dict","moduleName":["Lib"]}}],"expression":{"annotation":{"meta":null,"sourceSpan":{"end":[16,25],"start":[16,3]}},"expression":{"annotation":{"meta":null,"sourceSpan":{"end":[16,25],"start":[16,3]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["runTest",{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":[{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":[{"annotation":[{"end":[16,18],"name":"tests/purus/passing/4310/Lib.purs","start":[16,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"kind":{"annotation":[{"end":[15,27],"name":"tests/purus/passing/4310/Lib.purs","start":[15,18]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"},{"annotation":[{"end":[16,18],"name":"tests/purus/passing/4310/Lib.purs","start":[16,16]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}],"tag":"KindApp"}],"tag":"RCons"}],"tag":"TypeApp"},"value":{"identifier":"v","sourcePos":[16,3]}},"fieldName":"runTest","kind":"Accessor","type":{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":[{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":[{"annotation":[{"end":[16,18],"name":"tests/purus/passing/4310/Lib.purs","start":[16,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[16,15],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":{"kind":{"annotation":[{"end":[15,27],"name":"tests/purus/passing/4310/Lib.purs","start":[15,18]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"}},"isGuarded":false}],"caseExpressions":[{"annotation":{"meta":null,"sourceSpan":{"end":[16,25],"start":[16,3]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"Test$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"kind":{"annotation":[{"end":[15,27],"name":"tests/purus/passing/4310/Lib.purs","start":[15,18]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},"value":{"identifier":"dict","sourcePos":[0,0]}}],"kind":"Case","type":{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":[{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":[{"annotation":[{"end":[16,18],"name":"tests/purus/passing/4310/Lib.purs","start":[16,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[16,15],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":{"kind":{"annotation":[{"end":[15,27],"name":"tests/purus/passing/4310/Lib.purs","start":[15,18]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":{"annotation":[{"end":[15,27],"name":"tests/purus/passing/4310/Lib.purs","start":[15,18]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":1,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"Test$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"kind":{"annotation":[{"end":[15,27],"name":"tests/purus/passing/4310/Lib.purs","start":[15,18]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":[{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":[{"annotation":[{"end":[16,18],"name":"tests/purus/passing/4310/Lib.purs","start":[16,16]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[16,15],"name":"tests/purus/passing/4310/Lib.purs","start":[16,14]},[]],"contents":{"kind":{"annotation":[{"end":[15,27],"name":"tests/purus/passing/4310/Lib.purs","start":[15,18]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[16,25],"name":"tests/purus/passing/4310/Lib.purs","start":[16,19]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"}],"tag":"TypeApp"},"visibility":"TypeVarVisible"},"tag":"ForAll"}},"identifier":"runTest"},{"annotation":{"meta":null,"sourceSpan":{"end":[10,38],"start":[10,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[11,24],"start":[11,1]}},"argument":"v","body":{"annotation":{"meta":null,"sourceSpan":{"end":[11,24],"start":[11,1]}},"argument":"v1","body":{"annotation":{"meta":null,"sourceSpan":{"end":[11,24],"start":[11,15]}},"kind":"Literal","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"},"value":{"literalType":"StringLiteral","value":"mappend"}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[10,28],"name":"tests/purus/passing/4310/Lib.purs","start":[10,22]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[10,38],"name":"tests/purus/passing/4310/Lib.purs","start":[10,32]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[10,18],"name":"tests/purus/passing/4310/Lib.purs","start":[10,12]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[10,38],"name":"tests/purus/passing/4310/Lib.purs","start":[10,22]},[]],"contents":[{"annotation":[{"end":[10,38],"name":"tests/purus/passing/4310/Lib.purs","start":[10,22]},[]],"contents":[{"annotation":[{"end":[10,31],"name":"tests/purus/passing/4310/Lib.purs","start":[10,29]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[10,28],"name":"tests/purus/passing/4310/Lib.purs","start":[10,22]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[10,38],"name":"tests/purus/passing/4310/Lib.purs","start":[10,32]},[]],"contents":[["Prim"],"String"],"tag":"TypeConstructor"}],"tag":"TypeApp"}],"tag":"TypeApp"}},"identifier":"mappend"}],"exports":["runTest","Tuple","mappend","testInt"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[19,18],"start":[1,1]}},"moduleName":["Builtin"]},{"annotation":{"meta":null,"sourceSpan":{"end":[19,18],"start":[1,1]}},"moduleName":["Lib"]},{"annotation":{"meta":null,"sourceSpan":{"end":[3,32],"start":[3,1]}},"moduleName":["Prim"]}],"moduleName":["Lib"],"modulePath":"tests/purus/passing/4310/Lib.purs","reExports":{},"sourceSpan":{"end":[19,18],"start":[1,1]}} \ No newline at end of file diff --git a/tests/purus/passing/4310/output/Lib/index.cfn.pretty b/tests/purus/passing/4310/output/Lib/index.cfn.pretty index d807163ae..bfd8f93bb 100644 --- a/tests/purus/passing/4310/output/Lib/index.cfn.pretty +++ b/tests/purus/passing/4310/output/Lib/index.cfn.pretty @@ -7,48 +7,36 @@ Exports: runTest, Tuple, mappend, - testInt, - test/\ + testInt Re-Exports: Foreign: Declarations: -Tuple :: forall (@a :: Type) (@b :: Type). a -> b -> (Tuple a b) +Tuple :: forall (@a :: Prim.Type) (@b :: Prim.Type). (a :: Prim.Type) -> (b :: Prim.Type) -> (Lib.Tuple (a :: Prim.Type) (b :: Prim.Type)) Tuple = Tuple -Test$Dict :: forall a. { runTest :: a -> String } -> { runTest :: a -> String } -Test$Dict = \(x: { runTest :: a -> String }) -> (x: { runTest :: a -> String }) +Test$Dict :: forall (a :: Prim.Type). { runTest :: (a :: Prim.Type) -> Prim.String } -> { runTest :: (a :: Prim.Type) -> Prim.String } +Test$Dict = + \(x: { runTest :: (a :: Prim.Type) -> Prim.String }) -> + (x: { runTest :: (a :: Prim.Type) -> Prim.String }) -testInt :: Test$Dict Int +testInt :: Lib.Test$Dict Prim.Int testInt = - (Test$Dict: { runTest :: Int -> String } -> Test$Dict Int) - ({ runTest: \(v: Int) -> ("4": String) }: { runTest :: Int -> String }) + (Test$Dict: { runTest :: Prim.Int -> Prim.String } -> + Lib.Test$Dict Prim.Int) + ({ runTest: \(v: Prim.Int) -> ("4": Prim.String) }: { + runTest :: Prim.Int -> + Prim.String + }) -runTest :: forall (@a :: Type). Test$Dict a -> a -> String +runTest :: forall (@a :: Prim.Type). Lib.Test$Dict (a :: Prim.Type) -> (a :: Prim.Type) -> Prim.String runTest = - \(dict: Test$Dict a) -> - case (dict: Test$Dict a) of - Test$Dict v -> (v: { runTest :: a -> String }).runTest + \(dict: Lib.Test$Dict (a :: Prim.Type)) -> + case (dict: Lib.Test$Dict (a :: Prim.Type)) of + Test$Dict v -> + (v: { runTest :: (a :: Prim.Type) -> Prim.String }) + .runTest -mappend :: String -> String -> String -mappend = \(v: String) -> \(v1: String) -> ("mappend": String) - -test/\ :: forall (a :: Type) (b :: Type). Test$Dict a -> Test$Dict b -> Test$Dict (Tuple a b) -test/\ = - \(dictTest: Test$Dict a) -> - \(dictTest1: Test$Dict b) -> - (Test$Dict: { runTest :: (Tuple a b) -> String } -> - Test$Dict (Tuple a b)) - ({ - runTest: \(v: (Tuple a b)) -> - case (v: (Tuple a b)) of - Tuple a b -> - (mappend: String -> String -> String) - ((runTest: forall (@a :: Type). Test$Dict a -> a -> String) - (dictTest: Test$Dict a) - (a: a)) - ((runTest: forall (@a :: Type). Test$Dict a -> a -> String) - (dictTest1: Test$Dict b) - (b: b)) - }: { runTest :: (Tuple a b) -> String }) \ No newline at end of file +mappend :: Prim.String -> Prim.String -> Prim.String +mappend = \(v: Prim.String) -> \(v1: Prim.String) -> ("mappend": Prim.String) \ No newline at end of file diff --git a/tests/purus/passing/ClassRefSyntax/Lib.purs b/tests/purus/passing/ClassRefSyntax/Lib.purs index c9eca67a7..b044a4698 100644 --- a/tests/purus/passing/ClassRefSyntax/Lib.purs +++ b/tests/purus/passing/ClassRefSyntax/Lib.purs @@ -1,5 +1,5 @@ module Lib (class X, go) where -class X a where +class X (a :: Prim.Type) where go :: a -> a diff --git a/tests/purus/passing/ClassRefSyntax/output/Lib/externs.cbor b/tests/purus/passing/ClassRefSyntax/output/Lib/externs.cbor index bcd1359ddcef855d6d2d934f935de42ac75fd974..0fe614aef04ba14ce50d870b255b8a0dddf0daa7 100644 GIT binary patch literal 3767 zcmeHK%TB^T6uqSw1x2@ffIAbA7=J*FD;EY`u(VL9HP8~;Ca`N~D#WjtpL9RYOtrL< zCUhvSx@bF-dEDo@_w*Bt>sIHs)wvlyngfC%gvFIRa$Ki9^X49VYmQ@DM!P#I{z zaYV?@X*BMQhW1?lXr%HCvEY)X(X^>dY^ya6Dyi819F_4*^^{3%BvU$$ZKyEoa%P#( zr0y3RB`HPDg*OXUF7QsqxlfEM5vk33v8eJ10$pbvpRTK%yAV|D{i202HdQtq znF^dm>ZHJXh^E6x?-y1Pum~Tz{MS?6Wd*6}1~giq(Qr-<4uu%H4-47@1~U1xU4Tjg S1zDg95b%GXoTM`P-TVfmg!}IR delta 289 zcmdlkJ5hXtCF5j2cA?4lIanvpV3OLL%_xd2pw8Ub%sTlYoAG3Sc0rJ$&D_kgj7-gp zKrwSRu7<=!Fw>ZWubF{`AIP0t&5=2IF{?J3K9S9uYz_qU%@Ay6Y-(XhXl7tw0AY}6 z1)L&iCb3SwzgN~R#pH2 diff --git a/tests/purus/passing/ClassRefSyntax/output/Lib/index.cfn b/tests/purus/passing/ClassRefSyntax/output/Lib/index.cfn index 3b51f011a..c68d6bfdb 100644 --- a/tests/purus/passing/ClassRefSyntax/output/Lib/index.cfn +++ b/tests/purus/passing/ClassRefSyntax/output/Lib/index.cfn @@ -1 +1 @@ -{"builtWith":"0.0.1","comments":[],"dataTypes":{"X$Dict":["newtype",[["a",null]],[{"dataCtorAnn":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,1]},[]],"dataCtorFields":[[{"Ident":"dict"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["go",{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,13],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,11]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[4,10],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,14]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"RCons"}],"tag":"TypeApp"}]],"dataCtorName":"X$Dict"}]]},"decls":[{"annotation":{"meta":{"metaType":"IsTypeClassConstructor"},"sourceSpan":{"end":[4,15],"start":[3,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[4,15],"start":[3,1]}},"argument":"x","body":{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[3,1]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["go",{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,13],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,11]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[4,10],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,14]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"RCons"}],"tag":"TypeApp"},"value":{"identifier":"x","sourcePos":[0,0]}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":null,"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["go",{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,13],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,11]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[4,10],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,14]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"RCons"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["go",{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,13],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,11]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[4,10],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,14]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"RCons"}],"tag":"TypeApp"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"}},"identifier":"X$Dict"},{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[4,3]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[4,3]}},"argument":"dict","body":{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[4,3]}},"caseAlternatives":[{"binders":[{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[4,15],"start":[4,3]}},"binderType":"ConstructorBinder","binders":[{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[4,3]}},"binderType":"VarBinder","identifier":"v"}],"constructorName":{"identifier":"X$Dict","moduleName":["Lib"]},"typeName":{"identifier":"X$Dict","moduleName":["Lib"]}}],"expression":{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[4,3]}},"expression":{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[4,3]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["go",{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,13],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,11]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"},{"annotation":[{"end":[4,13],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,11]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}],"tag":"KindApp"}],"tag":"RCons"}],"tag":"TypeApp"},"value":{"identifier":"v","sourcePos":[4,3]}},"fieldName":"go","kind":"Accessor","type":{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,13],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,11]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[4,10],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,14]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"}},"isGuarded":false}],"caseExpressions":[{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[4,3]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"X$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},"value":{"identifier":"dict","sourcePos":[0,0]}}],"kind":"Case","type":{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,13],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,11]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[4,10],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,14]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":0,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"X$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,13],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,11]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[4,10],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,14]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},"visibility":"TypeVarVisible"},"tag":"ForAll"}},"identifier":"go"}],"exports":["go"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[1,1]}},"moduleName":["Builtin"]},{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[1,1]}},"moduleName":["Lib"]},{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[1,1]}},"moduleName":["Prim"]}],"moduleName":["Lib"],"modulePath":"tests/purus/passing/ClassRefSyntax/Lib.purs","reExports":{},"sourceSpan":{"end":[4,15],"start":[1,1]}} \ No newline at end of file +{"builtWith":"0.0.1","comments":[],"dataTypes":{"X$Dict":["newtype",[["a",{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}]],[{"dataCtorAnn":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,1]},[]],"dataCtorFields":[[{"Ident":"dict"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["go",{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,13],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,11]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[4,10],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":{"kind":{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,14]},[]],"contents":{"kind":{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"RCons"}],"tag":"TypeApp"}]],"dataCtorName":"X$Dict"}]]},"decls":[{"annotation":{"meta":{"metaType":"IsTypeClassConstructor"},"sourceSpan":{"end":[4,15],"start":[3,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[4,15],"start":[3,1]}},"argument":"x","body":{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[3,1]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["go",{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,13],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,11]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[4,10],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":{"kind":{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,14]},[]],"contents":{"kind":{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"RCons"}],"tag":"TypeApp"},"value":{"identifier":"x","sourcePos":[0,0]}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["go",{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,13],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,11]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[4,10],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":{"kind":{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,14]},[]],"contents":{"kind":{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"RCons"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["go",{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,13],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,11]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[4,10],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":{"kind":{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,14]},[]],"contents":{"kind":{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"RCons"}],"tag":"TypeApp"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"}},"identifier":"X$Dict"},{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[4,3]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[4,3]}},"argument":"dict","body":{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[4,3]}},"caseAlternatives":[{"binders":[{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[4,15],"start":[4,3]}},"binderType":"ConstructorBinder","binders":[{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[4,3]}},"binderType":"VarBinder","identifier":"v"}],"constructorName":{"identifier":"X$Dict","moduleName":["Lib"]},"typeName":{"identifier":"X$Dict","moduleName":["Lib"]}}],"expression":{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[4,3]}},"expression":{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[4,3]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":["go",{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,13],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,11]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"kind":{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"kind":{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"},{"annotation":[{"end":[4,13],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,11]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}],"tag":"KindApp"}],"tag":"RCons"}],"tag":"TypeApp"},"value":{"identifier":"v","sourcePos":[4,3]}},"fieldName":"go","kind":"Accessor","type":{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,13],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,11]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[4,10],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":{"kind":{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,14]},[]],"contents":{"kind":{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"}},"isGuarded":false}],"caseExpressions":[{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[4,3]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"X$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"kind":{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},"value":{"identifier":"dict","sourcePos":[0,0]}}],"kind":"Case","type":{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,13],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,11]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[4,10],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":{"kind":{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,14]},[]],"contents":{"kind":{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":0,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Lib"],"X$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"kind":{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":[{"annotation":[{"end":[4,13],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,11]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[4,10],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,9]},[]],"contents":{"kind":{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[4,15],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[4,14]},[]],"contents":{"kind":{"annotation":[{"end":[3,24],"name":"tests/purus/passing/ClassRefSyntax/Lib.purs","start":[3,15]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},"visibility":"TypeVarVisible"},"tag":"ForAll"}},"identifier":"go"}],"exports":["go"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[1,1]}},"moduleName":["Builtin"]},{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[1,1]}},"moduleName":["Lib"]},{"annotation":{"meta":null,"sourceSpan":{"end":[4,15],"start":[1,1]}},"moduleName":["Prim"]}],"moduleName":["Lib"],"modulePath":"tests/purus/passing/ClassRefSyntax/Lib.purs","reExports":{},"sourceSpan":{"end":[4,15],"start":[1,1]}} \ No newline at end of file diff --git a/tests/purus/passing/ClassRefSyntax/output/Lib/index.cfn.pretty b/tests/purus/passing/ClassRefSyntax/output/Lib/index.cfn.pretty index d3c4dc809..adabfb3de 100644 --- a/tests/purus/passing/ClassRefSyntax/output/Lib/index.cfn.pretty +++ b/tests/purus/passing/ClassRefSyntax/output/Lib/index.cfn.pretty @@ -10,11 +10,13 @@ Re-Exports: Foreign: Declarations: -X$Dict :: forall a. { go :: a -> a } -> { go :: a -> a } -X$Dict = \(x: { go :: a -> a }) -> (x: { go :: a -> a }) +X$Dict :: forall (a :: Prim.Type). { go :: (a :: Prim.Type) -> (a :: Prim.Type) } -> { go :: (a :: Prim.Type) -> (a :: Prim.Type) } +X$Dict = + \(x: { go :: (a :: Prim.Type) -> (a :: Prim.Type) }) -> + (x: { go :: (a :: Prim.Type) -> (a :: Prim.Type) }) -go :: forall (@a :: Type). X$Dict a -> a -> a +go :: forall (@a :: Prim.Type). Lib.X$Dict (a :: Prim.Type) -> (a :: Prim.Type) -> (a :: Prim.Type) go = - \(dict: X$Dict a) -> - case (dict: X$Dict a) of - X$Dict v -> (v: { go :: a -> a }).go \ No newline at end of file + \(dict: Lib.X$Dict (a :: Prim.Type)) -> + case (dict: Lib.X$Dict (a :: Prim.Type)) of + X$Dict v -> (v: { go :: (a :: Prim.Type) -> (a :: Prim.Type) }).go \ No newline at end of file diff --git a/tests/purus/passing/Coercible/Lib.purs b/tests/purus/passing/Coercible/Lib.purs index cca268cfb..84dc65018 100644 --- a/tests/purus/passing/Coercible/Lib.purs +++ b/tests/purus/passing/Coercible/Lib.purs @@ -5,8 +5,9 @@ module Coercible.Lib ) where import Coercible.Lib2 +import Prim (Type) -newtype NTLib1 a = NTLib1 a +newtype NTLib1 (a :: Type) = NTLib1 a -newtype NTLib3 a b = NTLib3 a +newtype NTLib3 (a :: Type) (b :: Type) = NTLib3 a type role NTLib3 representational representational diff --git a/tests/purus/passing/Coercible/Lib2.purs b/tests/purus/passing/Coercible/Lib2.purs index 3fdef618d..547964773 100644 --- a/tests/purus/passing/Coercible/Lib2.purs +++ b/tests/purus/passing/Coercible/Lib2.purs @@ -1,3 +1,5 @@ module Coercible.Lib2 where -newtype NTLib2 a = NTLib2 a +import Prim (Type) + +newtype NTLib2 (a :: Type) = NTLib2 a diff --git a/tests/purus/passing/Coercible/output/Coercible.Lib/externs.cbor b/tests/purus/passing/Coercible/output/Coercible.Lib/externs.cbor index dd75611f3594d503ac27384018c9d8c3c8c1d7ff..f6c084aee8f134ab76dc2103172a8b348fd82e00 100644 GIT binary patch literal 3090 zcmd^B(N4lJ6ul)ukW3$ZFbj_+@;DfcKcIb9+zr38Ri>Us*Pu+)Um1!0V4)>(1*Ztj6HAwQz$)(4K|!P&}O= z@cdC*&TET#mKX~tAVlHB#1x1xhf|ntq01_JpvLfY-%G(rBAc8ZsUTIV6e?y@CmTCw zWAlUJ!Z{M=JYg_=n0pffBzrR$U5DOy;rZgrs>z@b3W4Z*U5pYnHuX~q^|Kg;y|hptW1C^gO(XB@g6o>w+jEKx&LwqbTvD|@v}u|VXq!z(?0*x#d65dxihjr1%H$@9I(^ksP)2>jC$Xwe8m7HG%gQBI7Tmf|;@l_k;XYZm w<2JH3aSH}k=<2s%{pl!BE_8Q9u-lRGp^jXZydti))QNw$-0OweEC0iP0U==x9smFU literal 2426 zcmb_e-A=+V6h2#mNbms`|1P~8%*Gec#4BUG@Bu6^aRCNl%;;UaE*hU=k6OFpRw$Cu z!3EH+=bWDNo$q|(2ZmkOyKy}V*M7{vj(SgXhngUvZoQwK9e=t+1mO&yo_Xj9F&+ zJ7-I{Fy{QrF5^(ETzYOC@%0=65FGxXGyNc?&)|H|xQv#=Q#+c;e`i{r3 z-{p#qNW!tZw6p~s+s-AS79Lf#(vY%6=$dY_4d#Wc&{(xA9~y<-iiu=;%>-+@9kMPn z8Ws(~qwN%zfCw$zb+{SsQNx*5X{>1jGS!B*bFt*^x;7xC4a;Frjo*djHRNQ|We-dw zt5nL`c6;L#*$qjdP}J_yx5w*4v^i7%D;Lt0YotHG`hy-3uUMsSLf&@QfxrJszcs-Z A8UO$Q diff --git a/tests/purus/passing/Coercible/output/Coercible.Lib/index.cfn b/tests/purus/passing/Coercible/output/Coercible.Lib/index.cfn index 9b3e64770..a9713cebb 100644 --- a/tests/purus/passing/Coercible/output/Coercible.Lib/index.cfn +++ b/tests/purus/passing/Coercible/output/Coercible.Lib/index.cfn @@ -1 +1 @@ -{"builtWith":"0.0.1","comments":[],"dataTypes":{"NTLib1":["newtype",[["a",null]],[{"dataCtorAnn":[{"end":[9,28],"name":"tests/purus/passing/Coercible/Lib.purs","start":[9,18]},[]],"dataCtorFields":[[{"Ident":"value0"},{"annotation":[{"end":[9,28],"name":"tests/purus/passing/Coercible/Lib.purs","start":[9,27]},[]],"contents":"a","tag":"TypeVar"}]],"dataCtorName":"NTLib1"}]]},"decls":[{"annotation":{"meta":null,"sourceSpan":{"end":[11,30],"start":[11,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[11,30],"start":[11,1]}},"argument":"x","body":{"annotation":{"meta":null,"sourceSpan":{"end":[11,30],"start":[11,1]}},"kind":"Var","type":{"annotation":[{"end":[11,30],"name":"tests/purus/passing/Coercible/Lib.purs","start":[11,29]},[]],"contents":"a","tag":"TypeVar"},"value":{"identifier":"x","sourcePos":[0,0]}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":null,"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[11,30],"name":"tests/purus/passing/Coercible/Lib.purs","start":[11,29]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[11,30],"name":"tests/purus/passing/Coercible/Lib.purs","start":[11,29]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"}},"identifier":"NTLib3"},{"annotation":{"meta":null,"sourceSpan":{"end":[9,28],"start":[9,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[9,28],"start":[9,1]}},"argument":"x","body":{"annotation":{"meta":null,"sourceSpan":{"end":[9,28],"start":[9,1]}},"kind":"Var","type":{"annotation":[{"end":[9,28],"name":"tests/purus/passing/Coercible/Lib.purs","start":[9,27]},[]],"contents":"a","tag":"TypeVar"},"value":{"identifier":"x","sourcePos":[0,0]}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":null,"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[9,28],"name":"tests/purus/passing/Coercible/Lib.purs","start":[9,27]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[9,28],"name":"tests/purus/passing/Coercible/Lib.purs","start":[9,27]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"}},"identifier":"NTLib1"}],"exports":["NTLib1","NTLib3"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[12,51],"start":[1,1]}},"moduleName":["Builtin"]},{"annotation":{"meta":null,"sourceSpan":{"end":[7,22],"start":[7,1]}},"moduleName":["Coercible","Lib2"]},{"annotation":{"meta":null,"sourceSpan":{"end":[12,51],"start":[1,1]}},"moduleName":["Prim"]}],"moduleName":["Coercible","Lib"],"modulePath":"tests/purus/passing/Coercible/Lib.purs","reExports":{"Coercible.Lib2":["NTLib2"]},"sourceSpan":{"end":[12,51],"start":[1,1]}} \ No newline at end of file +{"builtWith":"0.0.1","comments":[],"dataTypes":{"NTLib1":["newtype",[["a",{"annotation":[{"end":[10,26],"name":"tests/purus/passing/Coercible/Lib.purs","start":[10,22]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}]],[{"dataCtorAnn":[{"end":[10,38],"name":"tests/purus/passing/Coercible/Lib.purs","start":[10,28]},[]],"dataCtorFields":[[{"Ident":"value0"},{"annotation":[{"end":[10,38],"name":"tests/purus/passing/Coercible/Lib.purs","start":[10,37]},[]],"contents":{"kind":{"annotation":[{"end":[10,26],"name":"tests/purus/passing/Coercible/Lib.purs","start":[10,22]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}]],"dataCtorName":"NTLib1"}]]},"decls":[{"annotation":{"meta":null,"sourceSpan":{"end":[12,50],"start":[12,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[12,50],"start":[12,1]}},"argument":"x","body":{"annotation":{"meta":null,"sourceSpan":{"end":[12,50],"start":[12,1]}},"kind":"Var","type":{"annotation":[{"end":[12,50],"name":"tests/purus/passing/Coercible/Lib.purs","start":[12,49]},[]],"contents":{"kind":{"annotation":[{"end":[12,26],"name":"tests/purus/passing/Coercible/Lib.purs","start":[12,22]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"},"value":{"identifier":"x","sourcePos":[0,0]}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":{"annotation":[{"end":[12,26],"name":"tests/purus/passing/Coercible/Lib.purs","start":[12,22]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[12,50],"name":"tests/purus/passing/Coercible/Lib.purs","start":[12,49]},[]],"contents":{"kind":{"annotation":[{"end":[12,26],"name":"tests/purus/passing/Coercible/Lib.purs","start":[12,22]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[12,50],"name":"tests/purus/passing/Coercible/Lib.purs","start":[12,49]},[]],"contents":{"kind":{"annotation":[{"end":[12,26],"name":"tests/purus/passing/Coercible/Lib.purs","start":[12,22]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"}},"identifier":"NTLib3"},{"annotation":{"meta":null,"sourceSpan":{"end":[10,38],"start":[10,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[10,38],"start":[10,1]}},"argument":"x","body":{"annotation":{"meta":null,"sourceSpan":{"end":[10,38],"start":[10,1]}},"kind":"Var","type":{"annotation":[{"end":[10,38],"name":"tests/purus/passing/Coercible/Lib.purs","start":[10,37]},[]],"contents":{"kind":{"annotation":[{"end":[10,26],"name":"tests/purus/passing/Coercible/Lib.purs","start":[10,22]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"},"value":{"identifier":"x","sourcePos":[0,0]}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":{"annotation":[{"end":[10,26],"name":"tests/purus/passing/Coercible/Lib.purs","start":[10,22]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[10,38],"name":"tests/purus/passing/Coercible/Lib.purs","start":[10,37]},[]],"contents":{"kind":{"annotation":[{"end":[10,26],"name":"tests/purus/passing/Coercible/Lib.purs","start":[10,22]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[10,38],"name":"tests/purus/passing/Coercible/Lib.purs","start":[10,37]},[]],"contents":{"kind":{"annotation":[{"end":[10,26],"name":"tests/purus/passing/Coercible/Lib.purs","start":[10,22]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"}},"identifier":"NTLib1"}],"exports":["NTLib1","NTLib3"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[13,51],"start":[1,1]}},"moduleName":["Builtin"]},{"annotation":{"meta":null,"sourceSpan":{"end":[7,22],"start":[7,1]}},"moduleName":["Coercible","Lib2"]},{"annotation":{"meta":null,"sourceSpan":{"end":[8,19],"start":[8,1]}},"moduleName":["Prim"]}],"moduleName":["Coercible","Lib"],"modulePath":"tests/purus/passing/Coercible/Lib.purs","reExports":{"Coercible.Lib2":["NTLib2"]},"sourceSpan":{"end":[13,51],"start":[1,1]}} \ No newline at end of file diff --git a/tests/purus/passing/Coercible/output/Coercible.Lib/index.cfn.pretty b/tests/purus/passing/Coercible/output/Coercible.Lib/index.cfn.pretty index 4337bdc29..a230e52b2 100644 --- a/tests/purus/passing/Coercible/output/Coercible.Lib/index.cfn.pretty +++ b/tests/purus/passing/Coercible/output/Coercible.Lib/index.cfn.pretty @@ -11,8 +11,8 @@ Re-Exports: Foreign: Declarations: -NTLib3 :: forall a. a -> a -NTLib3 = \(x: a) -> (x: a) +NTLib3 :: forall (a :: Prim.Type). (a :: Prim.Type) -> (a :: Prim.Type) +NTLib3 = \(x: (a :: Prim.Type)) -> (x: (a :: Prim.Type)) -NTLib1 :: forall a. a -> a -NTLib1 = \(x: a) -> (x: a) \ No newline at end of file +NTLib1 :: forall (a :: Prim.Type). (a :: Prim.Type) -> (a :: Prim.Type) +NTLib1 = \(x: (a :: Prim.Type)) -> (x: (a :: Prim.Type)) \ No newline at end of file diff --git a/tests/purus/passing/Coercible/output/Coercible.Lib2/externs.cbor b/tests/purus/passing/Coercible/output/Coercible.Lib2/externs.cbor index 959ccddcb58af2d1029c3b7485269f7fad28a0d9..f311f76f6386a2a4bfc8c0f2c7dfd2b1945a9499 100644 GIT binary patch literal 1268 zcmd5+y-ve05I(nx5DNnXs@Q=oX+gXINK6PZ^Z`iQ5G)0^iem(u{{-SG{HVq@#X&^~ zrOJS!#25Q~-*?~H_YUPaot&qWGjh2s>N%cOMS6{Ar$!GnJfAcLZD_V)HFMvbQcTJ$ zI%eK6b&FI1LJE@6v4s1Zsh<`mn${W(i`yDM3J_t`P+l-xHJG@WFLUi9QCH~Uo`T`N zgvIn_RS0g~!yRJ8*E_OPD#>RmeA|60*$z*EL_r=24_A!L8@wc)V;%T19P)3mf-E7< zodN*={#e!^kWqQw7o0%W$XEcQQAb5aN8vQ_{uo*NI*5b>issv{qt*%|pg+iPe%jC* ozrR-`7XKf}_BZK`z7d5D3<@|0Js7+c%vVy}DD2O-|6DgXcg delta 190 zcmeyu`Iv2jFEg`*%)|f<*_42y%-lwXh8Bi&r_#)vlFYnDhDI23;#GStX2xa)pxTBO z_Q`@wdK@tB`>0+Zbqre^~|D^A2aGOHcqZ$mYN*IB*N6p2-3mLEFldsAu)0C qOD1io0%;bJ$=S?C*c2(SSP3>WHnlJ$G&3+TfN%p)>t+@^kedO+LoojU diff --git a/tests/purus/passing/Coercible/output/Coercible.Lib2/index.cfn b/tests/purus/passing/Coercible/output/Coercible.Lib2/index.cfn index f0a8e978d..ace035046 100644 --- a/tests/purus/passing/Coercible/output/Coercible.Lib2/index.cfn +++ b/tests/purus/passing/Coercible/output/Coercible.Lib2/index.cfn @@ -1 +1 @@ -{"builtWith":"0.0.1","comments":[],"dataTypes":{"NTLib2":["newtype",[["a",null]],[{"dataCtorAnn":[{"end":[3,28],"name":"tests/purus/passing/Coercible/Lib2.purs","start":[3,18]},[]],"dataCtorFields":[[{"Ident":"value0"},{"annotation":[{"end":[3,28],"name":"tests/purus/passing/Coercible/Lib2.purs","start":[3,27]},[]],"contents":"a","tag":"TypeVar"}]],"dataCtorName":"NTLib2"}]]},"decls":[{"annotation":{"meta":null,"sourceSpan":{"end":[3,28],"start":[3,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[3,28],"start":[3,1]}},"argument":"x","body":{"annotation":{"meta":null,"sourceSpan":{"end":[3,28],"start":[3,1]}},"kind":"Var","type":{"annotation":[{"end":[3,28],"name":"tests/purus/passing/Coercible/Lib2.purs","start":[3,27]},[]],"contents":"a","tag":"TypeVar"},"value":{"identifier":"x","sourcePos":[0,0]}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":null,"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[3,28],"name":"tests/purus/passing/Coercible/Lib2.purs","start":[3,27]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[3,28],"name":"tests/purus/passing/Coercible/Lib2.purs","start":[3,27]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"}},"identifier":"NTLib2"}],"exports":["NTLib2"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[3,28],"start":[1,1]}},"moduleName":["Builtin"]},{"annotation":{"meta":null,"sourceSpan":{"end":[3,28],"start":[1,1]}},"moduleName":["Prim"]}],"moduleName":["Coercible","Lib2"],"modulePath":"tests/purus/passing/Coercible/Lib2.purs","reExports":{},"sourceSpan":{"end":[3,28],"start":[1,1]}} \ No newline at end of file +{"builtWith":"0.0.1","comments":[],"dataTypes":{"NTLib2":["newtype",[["a",{"annotation":[{"end":[5,26],"name":"tests/purus/passing/Coercible/Lib2.purs","start":[5,22]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}]],[{"dataCtorAnn":[{"end":[5,38],"name":"tests/purus/passing/Coercible/Lib2.purs","start":[5,28]},[]],"dataCtorFields":[[{"Ident":"value0"},{"annotation":[{"end":[5,38],"name":"tests/purus/passing/Coercible/Lib2.purs","start":[5,37]},[]],"contents":{"kind":{"annotation":[{"end":[5,26],"name":"tests/purus/passing/Coercible/Lib2.purs","start":[5,22]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}]],"dataCtorName":"NTLib2"}]]},"decls":[{"annotation":{"meta":null,"sourceSpan":{"end":[5,38],"start":[5,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[5,38],"start":[5,1]}},"argument":"x","body":{"annotation":{"meta":null,"sourceSpan":{"end":[5,38],"start":[5,1]}},"kind":"Var","type":{"annotation":[{"end":[5,38],"name":"tests/purus/passing/Coercible/Lib2.purs","start":[5,37]},[]],"contents":{"kind":{"annotation":[{"end":[5,26],"name":"tests/purus/passing/Coercible/Lib2.purs","start":[5,22]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"},"value":{"identifier":"x","sourcePos":[0,0]}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"a","kind":{"annotation":[{"end":[5,26],"name":"tests/purus/passing/Coercible/Lib2.purs","start":[5,22]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[5,38],"name":"tests/purus/passing/Coercible/Lib2.purs","start":[5,37]},[]],"contents":{"kind":{"annotation":[{"end":[5,26],"name":"tests/purus/passing/Coercible/Lib2.purs","start":[5,22]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[5,38],"name":"tests/purus/passing/Coercible/Lib2.purs","start":[5,37]},[]],"contents":{"kind":{"annotation":[{"end":[5,26],"name":"tests/purus/passing/Coercible/Lib2.purs","start":[5,22]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"var":"a"},"tag":"TypeVar"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"}},"identifier":"NTLib2"}],"exports":["NTLib2"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[5,38],"start":[1,1]}},"moduleName":["Builtin"]},{"annotation":{"meta":null,"sourceSpan":{"end":[3,19],"start":[3,1]}},"moduleName":["Prim"]}],"moduleName":["Coercible","Lib2"],"modulePath":"tests/purus/passing/Coercible/Lib2.purs","reExports":{},"sourceSpan":{"end":[5,38],"start":[1,1]}} \ No newline at end of file diff --git a/tests/purus/passing/Coercible/output/Coercible.Lib2/index.cfn.pretty b/tests/purus/passing/Coercible/output/Coercible.Lib2/index.cfn.pretty index 669656a21..0d054e502 100644 --- a/tests/purus/passing/Coercible/output/Coercible.Lib2/index.cfn.pretty +++ b/tests/purus/passing/Coercible/output/Coercible.Lib2/index.cfn.pretty @@ -9,5 +9,5 @@ Re-Exports: Foreign: Declarations: -NTLib2 :: forall a. a -> a -NTLib2 = \(x: a) -> (x: a) \ No newline at end of file +NTLib2 :: forall (a :: Prim.Type). (a :: Prim.Type) -> (a :: Prim.Type) +NTLib2 = \(x: (a :: Prim.Type)) -> (x: (a :: Prim.Type)) \ No newline at end of file diff --git a/tests/purus/passing/DctorOperatorAlias/List.purs b/tests/purus/passing/DctorOperatorAlias/List.purs index a428343a2..58071d274 100644 --- a/tests/purus/passing/DctorOperatorAlias/List.purs +++ b/tests/purus/passing/DctorOperatorAlias/List.purs @@ -1,5 +1,5 @@ module List where -data List a = Cons a (List a) | Nil +data List (a :: Type) = Cons a (List a) | Nil infixr 6 Cons as : diff --git a/tests/purus/passing/DctorOperatorAlias/output/List/externs.cbor b/tests/purus/passing/DctorOperatorAlias/output/List/externs.cbor index e8d88fd040ab152c2863786533c606ed3ad30f4a..efbf9cb834491a6892d3a7207be82280e1ea4d63 100644 GIT binary patch literal 2212 zcmdT`yH3L}6uoIFh!G*AP9PT8(pHG28xJudVBiC=noul-w2Bi1n_qzV3V*7x-Grjj z0XY$mA+aqd=bn4dJ#pS(+z$tb;ou-T$0S#>CE>B3$0R4cX^|D?jtIf&xOY0rC)wpR z&X5_85{yXCz7d+Ih=3pv(AnhRP?$24lSxWAj4p7Z#Y#O;G}KB$bd}+I2F#5gODbV} zT;L?fsoAThT0H{`Rym-d03JA2JSbUdYS2oma*g|OYnz1I-H_G>5S^L~T!OYX9PZAF zbd=*s>JPeM(%Pb*Fr(|IY3%TB1OV9U%eDjtN+8s9SQco-OVyMNd<)gxwp#7b<_Y?% z-`%yG_UW?9T3=QD>7Vr8EI{)~Ya@yEHPtVzQXE$K>2=+RG;b6J&4+h2pNCjjF01E) zIsR-T)k@0yL-vn5@f+GNdTCzc<~x&`bMN*6B}Lq?CIjaY>y}@%$TCm-XkDoGJ7i~n F74N(&^O67n delta 226 zcmZ1?_?LTwJtL#aWCunEAlV2e@3V+bzQ`gqS&2!9u@TIg$t1+sJb59rC5K2e1G8vD zV&Y^+Mk_XPAV)%Was#shSk{VD1}p%QHeu0+>a}9#n%v83gRZ}WwHlxPeQbJy&5TVg n3<=E)3=AL)GS!#e62(-m$!FQ*MKIJgH2j|&$YeHo9tRr$I List a -> List a +Cons :: forall (@a :: Prim.Type). (a :: Prim.Type) -> List.List (a :: Prim.Type) -> List.List (a :: Prim.Type) Cons = Cons -Nil :: forall (@a :: Type). List a +Nil :: forall (@a :: Prim.Type). List.List (a :: Prim.Type) Nil = Nil \ No newline at end of file diff --git a/tests/purus/passing/ExplicitImportReExport/output/Foo/index.cfn.pretty b/tests/purus/passing/ExplicitImportReExport/output/Foo/index.cfn.pretty index 130659647..ee44258d1 100644 --- a/tests/purus/passing/ExplicitImportReExport/output/Foo/index.cfn.pretty +++ b/tests/purus/passing/ExplicitImportReExport/output/Foo/index.cfn.pretty @@ -9,5 +9,5 @@ Re-Exports: Foreign: Declarations: -foo :: Int -foo = (3: Int) \ No newline at end of file +foo :: Prim.Int +foo = (3: Prim.Int) \ No newline at end of file diff --git a/tests/purus/passing/ExportExplicit/output/M1/index.cfn.pretty b/tests/purus/passing/ExportExplicit/output/M1/index.cfn.pretty index a3ab16bed..311278eab 100644 --- a/tests/purus/passing/ExportExplicit/output/M1/index.cfn.pretty +++ b/tests/purus/passing/ExportExplicit/output/M1/index.cfn.pretty @@ -12,17 +12,17 @@ Re-Exports: Foreign: Declarations: -Z :: Z +Z :: M1.Z Z = Z -X :: X +X :: M1.X X = X -Y :: X +Y :: M1.X Y = Y -foo :: Int -foo = (0: Int) +foo :: Prim.Int +foo = (0: Prim.Int) -bar :: Int -bar = (1: Int) \ No newline at end of file +bar :: Prim.Int +bar = (1: Prim.Int) \ No newline at end of file diff --git a/tests/purus/passing/ExportExplicit2/output/M1/index.cfn.pretty b/tests/purus/passing/ExportExplicit2/output/M1/index.cfn.pretty index 583f99c2c..1ac7ac39d 100644 --- a/tests/purus/passing/ExportExplicit2/output/M1/index.cfn.pretty +++ b/tests/purus/passing/ExportExplicit2/output/M1/index.cfn.pretty @@ -10,8 +10,8 @@ Re-Exports: Foreign: Declarations: -foo :: Int -foo = (0: Int) +foo :: Prim.Int +foo = (0: Prim.Int) -bar :: Int -bar = (foo: Int) \ No newline at end of file +bar :: Prim.Int +bar = (foo: Prim.Int) \ No newline at end of file diff --git a/tests/purus/passing/ForeignKind/Lib.purs b/tests/purus/passing/ForeignKind/Lib.purs index d28a9a5cc..d25ea6120 100644 --- a/tests/purus/passing/ForeignKind/Lib.purs +++ b/tests/purus/passing/ForeignKind/Lib.purs @@ -1,4 +1,4 @@ -module ForeignKinds.Lib (Nat, Kinded, Zero, Succ, N0, N1, N2, N3, NatProxy(..), class AddNat, addNat, proxy1, proxy2) where +module ForeignKinds.Lib where -- (Nat, Kinded, Zero, Succ, N0, N1, N2, N3, NatProxy(..), class AddNat, addNat, proxy1, proxy2) where -- declaration @@ -15,12 +15,12 @@ data NatProxy (t :: Nat) = NatProxy -- use in type sig -succProxy :: forall n. NatProxy n -> NatProxy (Succ n) +succProxy :: forall (n :: Nat). NatProxy n -> NatProxy (Succ n) succProxy _ = NatProxy -- use in alias -type Kinded f = f :: Nat +type Kinded (f :: Nat) = f :: Nat type KindedZero = Kinded Zero @@ -45,16 +45,21 @@ proxy3 = NatProxy -- use in class +-- TODO: Don't require annotations in fundep class AddNat (l :: Nat) (r :: Nat) (o :: Nat) | l -> r o +{- instance addNatZero - :: AddNat Zero r r + :: AddNat Zero (r :: Nat) (r :: Nat) + +-- TODO: Bind kinds instance addNatSucc - :: AddNat l r o - => AddNat (Succ l) r (Succ o) + :: AddNat ((l) :: Nat) ((r) :: Nat) ((o) :: Nat) + => AddNat (Succ ((l) :: Nat)) ((r) :: Nat) (Succ ((o) :: Nat)) -- use of class -addNat :: forall l r o. AddNat l r o => NatProxy l -> NatProxy r -> NatProxy o -addNat _ _ = NatProxy +--addNat :: forall (l :: Nat) (r :: Nat) (o :: Nat). AddNat l r o => NatProxy l -> NatProxy r -> NatProxy o +--addNat _ _ = NatProxy +-} diff --git a/tests/purus/passing/ForeignKind/output/ForeignKinds.Lib/externs.cbor b/tests/purus/passing/ForeignKind/output/ForeignKinds.Lib/externs.cbor index 9b4509b67fed6684bc1809df2a5684cb551f32e0..e7c455cb20efee9acd514ae9a1876c2de60c70c8 100644 GIT binary patch literal 10443 zcmeHN-ESL35Z^N(nt%dwDcO+PKuFcl6enj3p+4}9`T~k7;EAU=K0CeA+L1q`_U*nz z#b0rMCC|squ6;hAeIK*eMXidWCSBPx^PAty&g|aY-|X_VWq#Q*J6HEdN@K3 z)*t=xsFH%;X1!h&1rNc42jkJxXKv`RcoF$;s8V820FltBPRjse)3>Vl^+>9y%J0S5 zX%!R~XJ$3=b~W*i>!?R^aD{nsT2+BrRYAL|f{xErvw85nWx)=K!hl&1#`Y7Jx#DlU zbOLty!_0m>wTJN8;=hsOfP}0M{##za&V9xh{&Rfh8A64}tlytq^#kTI2eiNvlU011 zQjE5E!)IIk6QOvmwn+$HO&Y*r5xfm>C5_h24?C?W6`wKy`XR+WiQ`NcOxqPT=s3||wZzg*M(+96%070P9!MfV5^Stjj}6JTOfO>vq#lS4 zG!>668@*tLQc~(WKCAQZ9M|a5cXOTZqjWPbrO3Oijs*uHsY{acv(E3L&6aRv-V)-C zri$a(QNSU5|2&J()#M_@ncqPVkDZq%%qKF;3M2{1uZl^c_SZVUhnT)q37nApIt!B} z`aMRoCn;&i^LH^e)I9LnA6KHL2;i!{8_(N*$~KqueN zQ|cOl5qlka-2vT7A@B%H(4xJ&K(2y^e~exqsNy zT#u#X^{mYjpJ(Zs%apXG(bcc^IDUMZ=LQ3jL3cVeH&e8u#nmae-Whxh*KIT&g5rFgf@|#+U?zQ|h zF;`H(8gugl$Z~Txt99b#I0YlM)Po8ynlN$AziHxwmn9$n4K8@T1-QP*<13qyM?a2+ zlj*o?52s!YCI$E-rUie>sng+4c2Ckxx{jJKF~IS(!VxnTr5}x!qAy}>P&yG`LuN{E zhS!msN*i)9kTqc5^jKjF6c;4Lxmj c)YDc)@wFhIg)9n%~Q2bdPzh;BJqXTLau<6(ib4DfG3{1^*XNGU`K0PYTx#z zR)`FWK1Upp^GZr){Y_6M#0pnrHiG=}g~>-Rg|_F>@BLwNE4{@Zt0F6S`*aLZ=R6K!Cb zWb;#m(9%j?X{Hl=Qx-$y?XEIT zT3I0XoE-3}1pOw^v1V$gD2hmH%D9$!(P7K{?mSBEyii@o2ooZ!U|hitR`{1D-BNi_ zEBqez`5+j=^q})cFqa|%#9c`X&a#M5w(}#4d8jQc8OlBI+n>RTd;9u4Wo2N4cXQ$H zML0_AWp(Fw5c{1(*vsmX#ijc-!l+|_i8(?T?hPC+;F%o^AdqCTqVBqgOcoO{Ss^ef z-BXy10Y+r9h)fpeFjW~9v=a0H;H3?iAf>{*2nfLl zHM2p*cMul8|H0w_D{2ZCRf;*^*0 zRHDScQ_n&drpnVdV7iD*lsFKtATx<4!&T%a)r1@$3FKf2J5yi6k_4@lcQk|II*ID& zyhn1LfHr^i4d$j%;^cq&d#l+qbobM#RoVW0su`Urg)p92?t}eXaDowRUtaVxQt@&} znQ3~ttIQM*sTpcUt23!L5?d@H973JVZ_WTeqb>`^Qn)lb3x8pRzv!88?g(dAI;`5> z`;XvoO)lebxRy~E+S#QNJG(@J$FmL_!Le>G?|J_@*MKQ`DlB4MY1L}r{LQeH0 z8gSheeBCoOIs4T@liwHC4@^y_3Po!;O9cdbrq=Tam3)JLDEXO2u zr0oxxsPm&3=P}GZiaJ00>QES#w!dXEsuLdKOer3!nmsHg?^tw(eiKv5 zvrNlY8cih!XREW{NlB~`zAAuwIdv}UtAM;7dF_N6k+eTT?dvfwI%qutU{R6Rc`-_U zKdjVev7};yu-wFuC~pLn1G2u36mF0z{5o!@>IG7bQTG|%p)e7r4wVbOE#heh_Z-$p zeKS`380>42ah_r;R>N#mTP4X|w diff --git a/tests/purus/passing/ForeignKind/output/ForeignKinds.Lib/index.cfn b/tests/purus/passing/ForeignKind/output/ForeignKinds.Lib/index.cfn index d6dd9fb46..50ebe278b 100644 --- a/tests/purus/passing/ForeignKind/output/ForeignKinds.Lib/index.cfn +++ b/tests/purus/passing/ForeignKind/output/ForeignKinds.Lib/index.cfn @@ -1 +1 @@ -{"builtWith":"0.0.1","comments":[],"dataTypes":{"AddNat$Dict":["newtype",[["l",{"annotation":[{"end":[48,23],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[48,20]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"}],["r",{"annotation":[{"end":[48,34],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[48,31]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"}],["o",{"annotation":[{"end":[48,45],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[48,42]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"}]],[{"dataCtorAnn":[{"end":[48,57],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[48,1]},[{"LineComment":" use in class"}]],"dataCtorFields":[[{"Ident":"dict"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"TypeApp"}]],"dataCtorName":"AddNat$Dict"}]],"Nat":["data",[],[]],"NatProxy":["data",[["t",{"annotation":[{"end":[14,24],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[14,21]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"}]],[{"dataCtorAnn":[{"end":[14,36],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[14,26]},[]],"dataCtorFields":[],"dataCtorName":"NatProxy"}]]},"decls":[{"annotation":{"meta":null,"sourceSpan":{"end":[14,36],"start":[14,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[14,36],"start":[14,1]}},"constructorName":"NatProxy","fieldNames":[],"kind":"Constructor","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"t","kind":{"annotation":[{"end":[14,24],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[14,21]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"},"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":"t","tag":"TypeVar"}],"tag":"TypeApp"},"visibility":"TypeVarVisible"},"tag":"ForAll"},"typeName":"NatProxy"},"identifier":"NatProxy"},{"annotation":{"meta":{"metaType":"IsTypeClassConstructor"},"sourceSpan":{"end":[48,57],"start":[48,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[48,57],"start":[48,1]}},"argument":"x","body":{"annotation":{"meta":null,"sourceSpan":{"end":[48,57],"start":[48,1]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"TypeApp"},"value":{"identifier":"x","sourcePos":[0,0]}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"TypeApp"}],"tag":"TypeApp"}},"identifier":"AddNat$Dict"},{"annotation":{"meta":null,"sourceSpan":{"end":[18,55],"start":[18,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[19,23],"start":[19,1]}},"argument":"v","body":{"annotation":{"meta":{"constructorType":"ProductType","identifiers":[],"metaType":"IsConstructor"},"sourceSpan":{"end":[19,23],"start":[19,15]}},"kind":"Var","type":{"annotation":[{"end":[18,55],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,38]},[]],"contents":[{"annotation":[{"end":[18,46],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,38]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[18,54],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,48]},[]],"contents":[{"annotation":[{"end":[18,52],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,48]},[]],"contents":[["ForeignKinds","Lib"],"Succ"],"tag":"TypeConstructor"},{"annotation":[{"end":[18,54],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,53]},[]],"contents":"n","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},"value":{"identifier":"NatProxy","moduleName":["ForeignKinds","Lib"]}},"kind":"Abs","type":{"annotation":[{"end":[18,55],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,14]},[]],"contents":{"identifier":"n","kind":{"annotation":[{"end":[18,32],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,24]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"},"skolem":0,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[18,34],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,24]},[]],"contents":[{"annotation":[{"end":[18,32],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,24]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[18,34],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,33]},[]],"contents":"n","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[18,55],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,38]},[]],"contents":[{"annotation":[{"end":[18,46],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,38]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[18,54],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,48]},[]],"contents":[{"annotation":[{"end":[18,52],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,48]},[]],"contents":[["ForeignKinds","Lib"],"Succ"],"tag":"TypeConstructor"},{"annotation":[{"end":[18,54],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,53]},[]],"contents":"n","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"}},"identifier":"succProxy"},{"annotation":{"meta":null,"sourceSpan":{"end":[43,22],"start":[43,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"constructorType":"ProductType","identifiers":[],"metaType":"IsConstructor"},"sourceSpan":{"end":[44,18],"start":[44,10]}},"kind":"Var","type":{"annotation":[{"end":[43,22],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[43,11]},[]],"contents":[{"annotation":[{"end":[43,19],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[43,11]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[30,18],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[30,11]},[]],"contents":[{"annotation":[{"end":[30,15],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[30,11]},[]],"contents":[["ForeignKinds","Lib"],"Succ"],"tag":"TypeConstructor"},{"annotation":[{"end":[29,18],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[29,11]},[]],"contents":[{"annotation":[{"end":[29,15],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[29,11]},[]],"contents":[["ForeignKinds","Lib"],"Succ"],"tag":"TypeConstructor"},{"annotation":[{"end":[28,18],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[28,11]},[]],"contents":[{"annotation":[{"end":[28,15],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[28,11]},[]],"contents":[["ForeignKinds","Lib"],"Succ"],"tag":"TypeConstructor"},{"annotation":[{"end":[27,15],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[27,11]},[]],"contents":[["ForeignKinds","Lib"],"Zero"],"tag":"TypeConstructor"}],"tag":"TypeApp"}],"tag":"TypeApp"}],"tag":"TypeApp"}],"tag":"TypeApp"},"value":{"identifier":"NatProxy","moduleName":["ForeignKinds","Lib"]}},"identifier":"proxy3"},{"annotation":{"meta":null,"sourceSpan":{"end":[40,22],"start":[40,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"constructorType":"ProductType","identifiers":[],"metaType":"IsConstructor"},"sourceSpan":{"end":[41,18],"start":[41,10]}},"kind":"Var","type":{"annotation":[{"end":[40,22],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[40,11]},[]],"contents":[{"annotation":[{"end":[40,19],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[40,11]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[29,18],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[29,11]},[]],"contents":[{"annotation":[{"end":[29,15],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[29,11]},[]],"contents":[["ForeignKinds","Lib"],"Succ"],"tag":"TypeConstructor"},{"annotation":[{"end":[28,18],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[28,11]},[]],"contents":[{"annotation":[{"end":[28,15],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[28,11]},[]],"contents":[["ForeignKinds","Lib"],"Succ"],"tag":"TypeConstructor"},{"annotation":[{"end":[27,15],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[27,11]},[]],"contents":[["ForeignKinds","Lib"],"Zero"],"tag":"TypeConstructor"}],"tag":"TypeApp"}],"tag":"TypeApp"}],"tag":"TypeApp"},"value":{"identifier":"NatProxy","moduleName":["ForeignKinds","Lib"]}},"identifier":"proxy2"},{"annotation":{"meta":null,"sourceSpan":{"end":[37,22],"start":[37,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"constructorType":"ProductType","identifiers":[],"metaType":"IsConstructor"},"sourceSpan":{"end":[38,18],"start":[38,10]}},"kind":"Var","type":{"annotation":[{"end":[37,22],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[37,11]},[]],"contents":[{"annotation":[{"end":[37,19],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[37,11]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[28,18],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[28,11]},[]],"contents":[{"annotation":[{"end":[28,15],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[28,11]},[]],"contents":[["ForeignKinds","Lib"],"Succ"],"tag":"TypeConstructor"},{"annotation":[{"end":[27,15],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[27,11]},[]],"contents":[["ForeignKinds","Lib"],"Zero"],"tag":"TypeConstructor"}],"tag":"TypeApp"}],"tag":"TypeApp"},"value":{"identifier":"NatProxy","moduleName":["ForeignKinds","Lib"]}},"identifier":"proxy1"},{"annotation":{"meta":null,"sourceSpan":{"end":[34,22],"start":[34,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"constructorType":"ProductType","identifiers":[],"metaType":"IsConstructor"},"sourceSpan":{"end":[35,18],"start":[35,10]}},"kind":"Var","type":{"annotation":[{"end":[34,22],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[34,11]},[]],"contents":[{"annotation":[{"end":[34,19],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[34,11]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[27,15],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[27,11]},[]],"contents":[["ForeignKinds","Lib"],"Zero"],"tag":"TypeConstructor"}],"tag":"TypeApp"},"value":{"identifier":"NatProxy","moduleName":["ForeignKinds","Lib"]}},"identifier":"proxy0"},{"annotation":{"meta":null,"sourceSpan":{"end":[51,21],"start":[50,1]}},"bindType":"NonRec","expression":{"abstraction":{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[51,21],"start":[50,1]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}],"tag":"KindApp"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["ForeignKinds","Lib"],"AddNat$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[51,17],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[51,13]},[]],"contents":[["ForeignKinds","Lib"],"Zero"],"tag":"TypeConstructor"}],"tag":"TypeApp"},{"annotation":[{"end":[51,19],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[51,18]},[]],"contents":"r","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[51,19],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[51,18]},[]],"contents":"r","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},"value":{"identifier":"AddNat$Dict","moduleName":["ForeignKinds","Lib"]}},"annotation":{"meta":null,"sourceSpan":{"end":[51,21],"start":[50,1]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[51,21],"start":[50,1]}},"kind":"Literal","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}],"tag":"KindApp"}],"tag":"TypeApp"},"value":{"literalType":"ObjectLiteral","value":[]}},"kind":"App"},"identifier":"addNatZero"},{"annotation":{"meta":null,"sourceSpan":{"end":[55,32],"start":[53,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"argument":"$__unused","body":{"abstraction":{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[55,32],"start":[53,1]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}],"tag":"KindApp"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["ForeignKinds","Lib"],"AddNat$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[55,20],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[55,14]},[]],"contents":[{"annotation":[{"end":[55,18],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[55,14]},[]],"contents":[["ForeignKinds","Lib"],"Succ"],"tag":"TypeConstructor"},{"annotation":[{"end":[55,20],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[55,19]},[]],"contents":"l","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[55,23],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[55,22]},[]],"contents":"r","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[55,31],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[55,25]},[]],"contents":[{"annotation":[{"end":[55,29],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[55,25]},[]],"contents":[["ForeignKinds","Lib"],"Succ"],"tag":"TypeConstructor"},{"annotation":[{"end":[55,31],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[55,30]},[]],"contents":"o","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"}],"tag":"TypeApp"},"value":{"identifier":"AddNat$Dict","moduleName":["ForeignKinds","Lib"]}},"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"kind":"Literal","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"}],"tag":"KindApp"}],"tag":"TypeApp"},"value":{"literalType":"ObjectLiteral","value":[]}},"kind":"App"},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"l","kind":{"annotation":[{"end":[54,18],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[54,6]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"},"skolem":14,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"r","kind":{"annotation":[{"end":[54,18],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[54,6]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"},"skolem":13,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"o","kind":{"annotation":[{"end":[54,18],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[54,6]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"},"skolem":12,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["ForeignKinds","Lib"],"AddNat$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[54,14],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[54,13]},[]],"contents":"l","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[54,16],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[54,15]},[]],"contents":"r","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[54,18],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[54,17]},[]],"contents":"o","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["ForeignKinds","Lib"],"AddNat$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[55,20],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[55,14]},[]],"contents":[{"annotation":[{"end":[55,18],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[55,14]},[]],"contents":[["ForeignKinds","Lib"],"Succ"],"tag":"TypeConstructor"},{"annotation":[{"end":[55,20],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[55,19]},[]],"contents":"l","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[55,23],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[55,22]},[]],"contents":"r","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[55,31],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[55,25]},[]],"contents":[{"annotation":[{"end":[55,29],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[55,25]},[]],"contents":[["ForeignKinds","Lib"],"Succ"],"tag":"TypeConstructor"},{"annotation":[{"end":[55,31],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[55,30]},[]],"contents":"o","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"},"visibility":"TypeVarInvisible"},"tag":"ForAll"},"visibility":"TypeVarInvisible"},"tag":"ForAll"}},"identifier":"addNatSucc"},{"annotation":{"meta":null,"sourceSpan":{"end":[59,79],"start":[59,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"argument":"$__unused","body":{"annotation":{"meta":null,"sourceSpan":{"end":[60,22],"start":[60,1]}},"argument":"v","body":{"annotation":{"meta":null,"sourceSpan":{"end":[60,22],"start":[60,1]}},"argument":"v1","body":{"annotation":{"meta":{"constructorType":"ProductType","identifiers":[],"metaType":"IsConstructor"},"sourceSpan":{"end":[60,22],"start":[60,14]}},"kind":"Var","type":{"annotation":[{"end":[59,79],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,69]},[]],"contents":[{"annotation":[{"end":[59,77],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,69]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[59,79],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,78]},[]],"contents":"o","tag":"TypeVar"}],"tag":"TypeApp"},"value":{"identifier":"NatProxy","moduleName":["ForeignKinds","Lib"]}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[59,65],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,55]},[]],"contents":[{"annotation":[{"end":[59,63],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,55]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[59,65],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,64]},[]],"contents":"r","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[59,79],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,69]},[]],"contents":[{"annotation":[{"end":[59,77],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,69]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[59,79],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,78]},[]],"contents":"o","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[59,51],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,41]},[]],"contents":[{"annotation":[{"end":[59,49],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,41]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[59,51],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,50]},[]],"contents":"l","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[59,79],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,55]},[]],"contents":[{"annotation":[{"end":[59,79],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,55]},[]],"contents":[{"annotation":[{"end":[59,68],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,66]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[59,65],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,55]},[]],"contents":[{"annotation":[{"end":[59,63],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,55]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[59,65],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,64]},[]],"contents":"r","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[59,79],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,69]},[]],"contents":[{"annotation":[{"end":[59,77],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,69]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[59,79],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,78]},[]],"contents":"o","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"}],"tag":"TypeApp"}},"kind":"Abs","type":{"annotation":[{"end":[59,79],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,11]},[]],"contents":{"identifier":"l","kind":{"annotation":[{"end":[59,37],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,25]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"},"skolem":23,"type":{"annotation":[{"end":[59,79],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,20]},[]],"contents":{"identifier":"r","kind":{"annotation":[{"end":[59,37],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,25]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"},"skolem":22,"type":{"annotation":[{"end":[59,79],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,22]},[]],"contents":{"identifier":"o","kind":{"annotation":[{"end":[59,37],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,25]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"},"skolem":21,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["ForeignKinds","Lib"],"AddNat$Dict"],"tag":"TypeConstructor"},{"annotation":[{"end":[59,33],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,32]},[]],"contents":"l","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[59,35],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,34]},[]],"contents":"r","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[59,37],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,36]},[]],"contents":"o","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[59,79],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,41]},[]],"contents":[{"annotation":[{"end":[59,79],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,41]},[]],"contents":[{"annotation":[{"end":[59,54],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,52]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[59,51],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,41]},[]],"contents":[{"annotation":[{"end":[59,49],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,41]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[59,51],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,50]},[]],"contents":"l","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[59,79],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,55]},[]],"contents":[{"annotation":[{"end":[59,79],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,55]},[]],"contents":[{"annotation":[{"end":[59,68],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,66]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[59,65],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,55]},[]],"contents":[{"annotation":[{"end":[59,63],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,55]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[59,65],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,64]},[]],"contents":"r","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[59,79],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,69]},[]],"contents":[{"annotation":[{"end":[59,77],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,69]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[59,79],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[59,78]},[]],"contents":"o","tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"}],"tag":"TypeApp"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"},"visibility":"TypeVarInvisible"},"tag":"ForAll"},"visibility":"TypeVarInvisible"},"tag":"ForAll"}},"identifier":"addNat"}],"exports":["NatProxy","addNat","proxy1","proxy2","addNatZero","addNatSucc"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[60,22],"start":[1,1]}},"moduleName":["Builtin"]},{"annotation":{"meta":null,"sourceSpan":{"end":[60,22],"start":[1,1]}},"moduleName":["ForeignKinds","Lib"]},{"annotation":{"meta":null,"sourceSpan":{"end":[60,22],"start":[1,1]}},"moduleName":["Prim"]}],"moduleName":["ForeignKinds","Lib"],"modulePath":"tests/purus/passing/ForeignKind/Lib.purs","reExports":{},"sourceSpan":{"end":[60,22],"start":[1,1]}} \ No newline at end of file +{"builtWith":"0.0.1","comments":[],"dataTypes":{"AddNat$Dict":["newtype",[["l",{"annotation":[{"end":[49,23],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[49,20]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"}],["r",{"annotation":[{"end":[49,34],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[49,31]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"}],["o",{"annotation":[{"end":[49,45],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[49,42]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"}]],[{"dataCtorAnn":[{"end":[49,57],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[49,1]},[{"LineComment":" use in class"},{"LineComment":" TODO: Don't require annotations in fundep"}]],"dataCtorFields":[[{"Ident":"dict"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"TypeApp"}]],"dataCtorName":"AddNat$Dict"}]],"Nat":["data",[],[]],"NatProxy":["data",[["t",{"annotation":[{"end":[14,24],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[14,21]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"}]],[{"dataCtorAnn":[{"end":[14,36],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[14,26]},[]],"dataCtorFields":[],"dataCtorName":"NatProxy"}]]},"decls":[{"annotation":{"meta":null,"sourceSpan":{"end":[14,36],"start":[14,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[14,36],"start":[14,1]}},"constructorName":"NatProxy","fieldNames":[],"kind":"Constructor","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"t","kind":{"annotation":[{"end":[14,24],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[14,21]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"},"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"kind":{"annotation":[{"end":[14,24],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[14,21]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"},"var":"t"},"tag":"TypeVar"}],"tag":"TypeApp"},"visibility":"TypeVarVisible"},"tag":"ForAll"},"typeName":"NatProxy"},"identifier":"NatProxy"},{"annotation":{"meta":{"metaType":"IsTypeClassConstructor"},"sourceSpan":{"end":[49,57],"start":[49,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"metaType":"IsNewtype"},"sourceSpan":{"end":[49,57],"start":[49,1]}},"argument":"x","body":{"annotation":{"meta":null,"sourceSpan":{"end":[49,57],"start":[49,1]}},"kind":"Var","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"TypeApp"},"value":{"identifier":"x","sourcePos":[0,0]}},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Record"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"tag":"REmpty"}],"tag":"TypeApp"}],"tag":"TypeApp"}},"identifier":"AddNat$Dict"},{"annotation":{"meta":null,"sourceSpan":{"end":[18,64],"start":[18,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[19,23],"start":[19,1]}},"argument":"v","body":{"annotation":{"meta":{"constructorType":"ProductType","identifiers":[],"metaType":"IsConstructor"},"sourceSpan":{"end":[19,23],"start":[19,15]}},"kind":"Var","type":{"annotation":[{"end":[18,64],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,47]},[]],"contents":[{"annotation":[{"end":[18,55],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,47]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[18,63],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,57]},[]],"contents":[{"annotation":[{"end":[18,61],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,57]},[]],"contents":[["ForeignKinds","Lib"],"Succ"],"tag":"TypeConstructor"},{"annotation":[{"end":[18,63],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,62]},[]],"contents":{"kind":{"annotation":[{"end":[18,30],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,27]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"},"var":"n"},"tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},"value":{"identifier":"NatProxy","moduleName":["ForeignKinds","Lib"]}},"kind":"Abs","type":{"annotation":[{"end":[18,64],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,14]},[]],"contents":{"identifier":"n","kind":{"annotation":[{"end":[18,30],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,27]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"},"skolem":0,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[18,43],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,33]},[]],"contents":[{"annotation":[{"end":[18,41],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,33]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[18,43],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,42]},[]],"contents":{"kind":{"annotation":[{"end":[18,30],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,27]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"},"var":"n"},"tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"},{"annotation":[{"end":[18,64],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,47]},[]],"contents":[{"annotation":[{"end":[18,55],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,47]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[18,63],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,57]},[]],"contents":[{"annotation":[{"end":[18,61],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,57]},[]],"contents":[["ForeignKinds","Lib"],"Succ"],"tag":"TypeConstructor"},{"annotation":[{"end":[18,63],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,62]},[]],"contents":{"kind":{"annotation":[{"end":[18,30],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[18,27]},[]],"contents":[["ForeignKinds","Lib"],"Nat"],"tag":"TypeConstructor"},"var":"n"},"tag":"TypeVar"}],"tag":"TypeApp"}],"tag":"TypeApp"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"}},"identifier":"succProxy"},{"annotation":{"meta":null,"sourceSpan":{"end":[43,22],"start":[43,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"constructorType":"ProductType","identifiers":[],"metaType":"IsConstructor"},"sourceSpan":{"end":[44,18],"start":[44,10]}},"kind":"Var","type":{"annotation":[{"end":[43,22],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[43,11]},[]],"contents":[{"annotation":[{"end":[43,19],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[43,11]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[30,18],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[30,11]},[]],"contents":[{"annotation":[{"end":[30,15],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[30,11]},[]],"contents":[["ForeignKinds","Lib"],"Succ"],"tag":"TypeConstructor"},{"annotation":[{"end":[29,18],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[29,11]},[]],"contents":[{"annotation":[{"end":[29,15],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[29,11]},[]],"contents":[["ForeignKinds","Lib"],"Succ"],"tag":"TypeConstructor"},{"annotation":[{"end":[28,18],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[28,11]},[]],"contents":[{"annotation":[{"end":[28,15],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[28,11]},[]],"contents":[["ForeignKinds","Lib"],"Succ"],"tag":"TypeConstructor"},{"annotation":[{"end":[27,15],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[27,11]},[]],"contents":[["ForeignKinds","Lib"],"Zero"],"tag":"TypeConstructor"}],"tag":"TypeApp"}],"tag":"TypeApp"}],"tag":"TypeApp"}],"tag":"TypeApp"},"value":{"identifier":"NatProxy","moduleName":["ForeignKinds","Lib"]}},"identifier":"proxy3"},{"annotation":{"meta":null,"sourceSpan":{"end":[40,22],"start":[40,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"constructorType":"ProductType","identifiers":[],"metaType":"IsConstructor"},"sourceSpan":{"end":[41,18],"start":[41,10]}},"kind":"Var","type":{"annotation":[{"end":[40,22],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[40,11]},[]],"contents":[{"annotation":[{"end":[40,19],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[40,11]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[29,18],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[29,11]},[]],"contents":[{"annotation":[{"end":[29,15],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[29,11]},[]],"contents":[["ForeignKinds","Lib"],"Succ"],"tag":"TypeConstructor"},{"annotation":[{"end":[28,18],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[28,11]},[]],"contents":[{"annotation":[{"end":[28,15],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[28,11]},[]],"contents":[["ForeignKinds","Lib"],"Succ"],"tag":"TypeConstructor"},{"annotation":[{"end":[27,15],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[27,11]},[]],"contents":[["ForeignKinds","Lib"],"Zero"],"tag":"TypeConstructor"}],"tag":"TypeApp"}],"tag":"TypeApp"}],"tag":"TypeApp"},"value":{"identifier":"NatProxy","moduleName":["ForeignKinds","Lib"]}},"identifier":"proxy2"},{"annotation":{"meta":null,"sourceSpan":{"end":[37,22],"start":[37,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"constructorType":"ProductType","identifiers":[],"metaType":"IsConstructor"},"sourceSpan":{"end":[38,18],"start":[38,10]}},"kind":"Var","type":{"annotation":[{"end":[37,22],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[37,11]},[]],"contents":[{"annotation":[{"end":[37,19],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[37,11]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[28,18],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[28,11]},[]],"contents":[{"annotation":[{"end":[28,15],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[28,11]},[]],"contents":[["ForeignKinds","Lib"],"Succ"],"tag":"TypeConstructor"},{"annotation":[{"end":[27,15],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[27,11]},[]],"contents":[["ForeignKinds","Lib"],"Zero"],"tag":"TypeConstructor"}],"tag":"TypeApp"}],"tag":"TypeApp"},"value":{"identifier":"NatProxy","moduleName":["ForeignKinds","Lib"]}},"identifier":"proxy1"},{"annotation":{"meta":null,"sourceSpan":{"end":[34,22],"start":[34,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":{"constructorType":"ProductType","identifiers":[],"metaType":"IsConstructor"},"sourceSpan":{"end":[35,18],"start":[35,10]}},"kind":"Var","type":{"annotation":[{"end":[34,22],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[34,11]},[]],"contents":[{"annotation":[{"end":[34,19],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[34,11]},[]],"contents":[["ForeignKinds","Lib"],"NatProxy"],"tag":"TypeConstructor"},{"annotation":[{"end":[27,15],"name":"tests/purus/passing/ForeignKind/Lib.purs","start":[27,11]},[]],"contents":[["ForeignKinds","Lib"],"Zero"],"tag":"TypeConstructor"}],"tag":"TypeApp"},"value":{"identifier":"NatProxy","moduleName":["ForeignKinds","Lib"]}},"identifier":"proxy0"}],"exports":["NatProxy","succProxy","proxy0","proxy1","proxy2","proxy3"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[49,57],"start":[1,1]}},"moduleName":["Builtin"]},{"annotation":{"meta":null,"sourceSpan":{"end":[49,57],"start":[1,1]}},"moduleName":["ForeignKinds","Lib"]},{"annotation":{"meta":null,"sourceSpan":{"end":[49,57],"start":[1,1]}},"moduleName":["Prim"]}],"moduleName":["ForeignKinds","Lib"],"modulePath":"tests/purus/passing/ForeignKind/Lib.purs","reExports":{},"sourceSpan":{"end":[49,57],"start":[1,1]}} \ No newline at end of file diff --git a/tests/purus/passing/ForeignKind/output/ForeignKinds.Lib/index.cfn.pretty b/tests/purus/passing/ForeignKind/output/ForeignKinds.Lib/index.cfn.pretty index a864242b8..85bccb563 100644 --- a/tests/purus/passing/ForeignKind/output/ForeignKinds.Lib/index.cfn.pretty +++ b/tests/purus/passing/ForeignKind/output/ForeignKinds.Lib/index.cfn.pretty @@ -5,51 +5,43 @@ Imported Modules: Prim Exports: NatProxy, - addNat, + succProxy, + proxy0, proxy1, proxy2, - addNatZero, - addNatSucc + proxy3 Re-Exports: Foreign: Declarations: -NatProxy :: forall (@t :: Nat). NatProxy t +NatProxy :: forall (@t :: ForeignKinds.Lib.Nat). ForeignKinds.Lib.NatProxy (t :: ForeignKinds.Lib.Nat) NatProxy = NatProxy -AddNat$Dict :: Record {} -> Record {} -AddNat$Dict = \(x: Record {}) -> (x: Record {}) - -succProxy :: forall (n :: Nat). NatProxy n -> NatProxy Succ n -succProxy = \(v: NatProxy n) -> (NatProxy: NatProxy Succ n) - -proxy3 :: NatProxy Succ Succ Succ Zero -proxy3 = (NatProxy: NatProxy Succ Succ Succ Zero) - -proxy2 :: NatProxy Succ Succ Zero -proxy2 = (NatProxy: NatProxy Succ Succ Zero) - -proxy1 :: NatProxy Succ Zero -proxy1 = (NatProxy: NatProxy Succ Zero) - -proxy0 :: NatProxy Zero -proxy0 = (NatProxy: NatProxy Zero) - -addNatZero :: ((AddNat$Dict Zero r) r) -addNatZero = - (AddNat$Dict: Record {}@Type -> ((AddNat$Dict Zero r) r)) - ({ }: Record {}@Type) - -addNatSucc :: forall (l :: Nat) (r :: Nat) (o :: Nat). ((AddNat$Dict l r) o) -> ((AddNat$Dict Succ l r) Succ o) -addNatSucc = - \($__unused: ((AddNat$Dict l r) o)) -> - (AddNat$Dict: Record {}@Type -> ((AddNat$Dict Succ l r) Succ o)) - ({ }: Record {}@Type) - -addNat :: forall (l :: Nat) (r :: Nat) (o :: Nat). ((AddNat$Dict l r) o) -> NatProxy l -> NatProxy r -> NatProxy o -addNat = - \($__unused: ((AddNat$Dict l r) o)) -> - \(v: NatProxy l) -> - \(v1: NatProxy r) -> - (NatProxy: NatProxy o) \ No newline at end of file +AddNat$Dict :: Prim.Record {} -> Prim.Record {} +AddNat$Dict = \(x: Prim.Record {}) -> (x: Prim.Record {}) + +succProxy :: forall (n :: ForeignKinds.Lib.Nat). ForeignKinds.Lib.NatProxy (n :: ForeignKinds.Lib.Nat) -> ForeignKinds.Lib.NatProxy ForeignKinds.Lib.Succ (n :: ForeignKinds.Lib.Nat) +succProxy = + \(v: ForeignKinds.Lib.NatProxy (n :: ForeignKinds.Lib.Nat)) -> + (NatProxy: ForeignKinds.Lib.NatProxy + ForeignKinds.Lib.Succ (n :: ForeignKinds.Lib.Nat)) + +proxy3 :: ForeignKinds.Lib.NatProxy ForeignKinds.Lib.Succ ForeignKinds.Lib.Succ ForeignKinds.Lib.Succ ForeignKinds.Lib.Zero +proxy3 = + (NatProxy: ForeignKinds.Lib.NatProxy + ForeignKinds.Lib.Succ + ForeignKinds.Lib.Succ ForeignKinds.Lib.Succ ForeignKinds.Lib.Zero) + +proxy2 :: ForeignKinds.Lib.NatProxy ForeignKinds.Lib.Succ ForeignKinds.Lib.Succ ForeignKinds.Lib.Zero +proxy2 = + (NatProxy: ForeignKinds.Lib.NatProxy + ForeignKinds.Lib.Succ ForeignKinds.Lib.Succ ForeignKinds.Lib.Zero) + +proxy1 :: ForeignKinds.Lib.NatProxy ForeignKinds.Lib.Succ ForeignKinds.Lib.Zero +proxy1 = + (NatProxy: ForeignKinds.Lib.NatProxy + ForeignKinds.Lib.Succ ForeignKinds.Lib.Zero) + +proxy0 :: ForeignKinds.Lib.NatProxy ForeignKinds.Lib.Zero +proxy0 = (NatProxy: ForeignKinds.Lib.NatProxy ForeignKinds.Lib.Zero) \ No newline at end of file diff --git a/tests/purus/passing/Import/output/M1/externs.cbor b/tests/purus/passing/Import/output/M1/externs.cbor deleted file mode 100644 index d45eb454a2a964514393d2e8fd62e4138d7d0f3b..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 1033 zcmeBVNH@?kG}SXSPVzOJ-^|>?P@zFDjjEv0;Y@AIDNtr36Yf4Vb&;LKag&`%NC^NT_p%F~OxeYB0=}x7YIVG8SKsgxm ze?tS%d0-3MIh%-eCNq081G9KTBV%G>V>2u9+Ju4HL>rnJni#=uYhp+VsVqosVJF@M zL9oT7>!8S$8E&O{$t9WjdCiQZxm2hjF_9EKVqo6^1GR~P0Te5s7#)okNY-G+NIU}) ME&qwlBao~N0M1Zg-~a#s diff --git a/tests/purus/passing/Import/output/M1/index.cfn b/tests/purus/passing/Import/output/M1/index.cfn deleted file mode 100644 index 8d2e3a33e..000000000 --- a/tests/purus/passing/Import/output/M1/index.cfn +++ /dev/null @@ -1 +0,0 @@ -{"builtWith":"0.0.1","comments":[],"dataTypes":{},"decls":[{"annotation":{"meta":null,"sourceSpan":{"end":[3,23],"start":[3,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[4,8],"start":[4,7]}},"argument":"x","body":{"annotation":{"meta":null,"sourceSpan":{"end":[4,13],"start":[4,12]}},"kind":"Var","type":{"annotation":[{"end":[3,18],"name":"tests/purus/passing/Import/M1.purs","start":[3,17]},[]],"contents":"a","tag":"TypeVar"},"value":{"identifier":"x","sourcePos":[4,7]}},"kind":"Abs","type":{"annotation":[{"end":[3,23],"name":"tests/purus/passing/Import/M1.purs","start":[3,7]},[]],"contents":{"identifier":"a","kind":{"annotation":[{"end":[3,21],"name":"tests/purus/passing/Import/M1.purs","start":[3,19]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":0,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[3,18],"name":"tests/purus/passing/Import/M1.purs","start":[3,17]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[3,23],"name":"tests/purus/passing/Import/M1.purs","start":[3,22]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"}},"identifier":"id"},{"annotation":{"meta":null,"sourceSpan":{"end":[6,9],"start":[6,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[6,9],"start":[6,7]}},"kind":"Var","type":{"annotation":[{"end":[3,23],"name":"tests/purus/passing/Import/M1.purs","start":[3,7]},[]],"contents":{"identifier":"a","kind":{"annotation":[{"end":[3,21],"name":"tests/purus/passing/Import/M1.purs","start":[3,19]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":0,"type":{"annotation":[{"end":[3,23],"name":"tests/purus/passing/Import/M1.purs","start":[3,17]},[]],"contents":[{"annotation":[{"end":[3,23],"name":"tests/purus/passing/Import/M1.purs","start":[3,17]},[]],"contents":[{"annotation":[{"end":[3,21],"name":"tests/purus/passing/Import/M1.purs","start":[3,19]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[3,18],"name":"tests/purus/passing/Import/M1.purs","start":[3,17]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[3,23],"name":"tests/purus/passing/Import/M1.purs","start":[3,22]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"},"value":{"identifier":"id","moduleName":["M1"]}},"identifier":"foo"}],"exports":["id","foo"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[6,9],"start":[1,1]}},"moduleName":["Builtin"]},{"annotation":{"meta":null,"sourceSpan":{"end":[6,9],"start":[1,1]}},"moduleName":["M1"]},{"annotation":{"meta":null,"sourceSpan":{"end":[6,9],"start":[1,1]}},"moduleName":["Prim"]}],"moduleName":["M1"],"modulePath":"tests/purus/passing/Import/M1.purs","reExports":{},"sourceSpan":{"end":[6,9],"start":[1,1]}} \ No newline at end of file diff --git a/tests/purus/passing/Import/output/M1/index.cfn.pretty b/tests/purus/passing/Import/output/M1/index.cfn.pretty deleted file mode 100644 index e05de109c..000000000 --- a/tests/purus/passing/Import/output/M1/index.cfn.pretty +++ /dev/null @@ -1,18 +0,0 @@ -M1 (tests/purus/passing/Import/M1.purs) -Imported Modules: - Builtin, - M1, - Prim -Exports: - id, - foo -Re-Exports: - -Foreign: - -Declarations: -id :: forall (a :: Type). a -> a -id = \(x: a) -> (x: a) - -foo :: forall (a :: Type). a -> a -foo = (id: forall (a :: Type). a -> a) \ No newline at end of file diff --git a/tests/purus/passing/Import/output/M2/externs.cbor b/tests/purus/passing/Import/output/M2/externs.cbor deleted file mode 100644 index bbb97f95a9c0db9ba76246fa3b9e12648d354539..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 351 zcmeBVNH@?kG}SXSPVzOH-^|>?P@zh z;>FDjjEv0;tRhVeDY=Q6dH?6PFr)+&W#%?AG=gb3x1oh0-KjJ)rzA5ECh%}XxH%+G6PL@@wpC2md0o_Qq=|49oV00*UR#{d8T diff --git a/tests/purus/passing/Import/output/M2/index.cfn b/tests/purus/passing/Import/output/M2/index.cfn deleted file mode 100644 index b861b2e09..000000000 --- a/tests/purus/passing/Import/output/M2/index.cfn +++ /dev/null @@ -1 +0,0 @@ -{"builtWith":"0.0.1","comments":[],"dataTypes":{},"decls":[{"annotation":{"meta":null,"sourceSpan":{"end":[5,20],"start":[5,1]}},"bindType":"NonRec","expression":{"annotation":{"meta":null,"sourceSpan":{"end":[0,0],"start":[0,0]}},"argument":"v","body":{"abstraction":{"annotation":{"meta":{"metaType":"IsForeign"},"sourceSpan":{"end":[5,17],"start":[5,14]}},"kind":"Var","type":{"annotation":[{"end":[3,23],"name":"tests/purus/passing/Import/M1.purs","start":[3,7]},[]],"contents":{"identifier":"a","kind":{"annotation":[{"end":[3,21],"name":"tests/purus/passing/Import/M1.purs","start":[3,19]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":0,"type":{"annotation":[{"end":[3,23],"name":"tests/purus/passing/Import/M1.purs","start":[3,17]},[]],"contents":[{"annotation":[{"end":[3,23],"name":"tests/purus/passing/Import/M1.purs","start":[3,17]},[]],"contents":[{"annotation":[{"end":[3,21],"name":"tests/purus/passing/Import/M1.purs","start":[3,19]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[3,18],"name":"tests/purus/passing/Import/M1.purs","start":[3,17]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[3,23],"name":"tests/purus/passing/Import/M1.purs","start":[3,22]},[]],"contents":"a","tag":"TypeVar"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"},"value":{"identifier":"foo","moduleName":["M1"]}},"annotation":{"meta":null,"sourceSpan":{"end":[5,20],"start":[5,14]}},"argument":{"annotation":{"meta":null,"sourceSpan":{"end":[5,20],"start":[5,18]}},"kind":"Literal","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Int"],"tag":"TypeConstructor"},"value":{"literalType":"IntLiteral","value":42}},"kind":"App"},"kind":"Abs","type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":{"identifier":"t1","kind":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Type"],"tag":"TypeConstructor"},"skolem":null,"type":{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Function"],"tag":"TypeConstructor"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":"t1","tag":"TypeVar"}],"tag":"TypeApp"},{"annotation":[{"end":[0,0],"name":"","start":[0,0]},[]],"contents":[["Prim"],"Int"],"tag":"TypeConstructor"}],"tag":"TypeApp"},"visibility":"TypeVarInvisible"},"tag":"ForAll"}},"identifier":"main"}],"exports":["main"],"foreign":[],"imports":[{"annotation":{"meta":null,"sourceSpan":{"end":[5,20],"start":[1,1]}},"moduleName":["Builtin"]},{"annotation":{"meta":null,"sourceSpan":{"end":[5,20],"start":[1,1]}},"moduleName":["M1"]},{"annotation":{"meta":null,"sourceSpan":{"end":[5,20],"start":[1,1]}},"moduleName":["Prim"]}],"moduleName":["M2"],"modulePath":"tests/purus/passing/Import/M2.purs","reExports":{},"sourceSpan":{"end":[5,20],"start":[1,1]}} \ No newline at end of file diff --git a/tests/purus/passing/Import/output/M2/index.cfn.pretty b/tests/purus/passing/Import/output/M2/index.cfn.pretty deleted file mode 100644 index ef851f528..000000000 --- a/tests/purus/passing/Import/output/M2/index.cfn.pretty +++ /dev/null @@ -1,14 +0,0 @@ -M2 (tests/purus/passing/Import/M2.purs) -Imported Modules: - Builtin, - M1, - Prim -Exports: - main -Re-Exports: - -Foreign: - -Declarations: -main :: forall (t1 :: Type). t1 -> Int -main = \(v: t1) -> (foo: forall (a :: Type). a -> a) (42: Int) \ No newline at end of file