diff --git a/src/THIH.hs b/src/THIH.hs index d487648..077205a 100644 --- a/src/THIH.hs +++ b/src/THIH.hs @@ -295,67 +295,6 @@ data Scheme = Forall [Kind] (Qualified Type) deriving (Eq, Show) --------------------------------------------------------------------------------- --- Demo (remove later) - -demo :: IO () -demo = do - env <- - addClass - "Num" - [TypeVariable "n" StarKind] - [] - mempty {classEnvironmentDefaults = [tInteger]} - env' <- addInstance [] (IsIn "Num" [tInteger]) env - assumptions <- - typeCheckModule - env' - [ TypeSignature - "id" - (Forall - [StarKind] - (Qualified [] (makeArrow (GenericType 0) (GenericType 0)))) - ] - defaultSpecialTypes - [ BindGroup - [ ExplicitlyTypedBinding - "x" - (Forall - [StarKind] - (Qualified - [IsIn "Num" [(GenericType 0)]] - (makeArrow (GenericType 0) (GenericType 0)))) - [Alternative [VariablePattern "k"] (VariableExpression "k")] - ] - [ [ ImplicitlyTypedBinding - "x" - [Alternative [] (VariableExpression "x")] - , ImplicitlyTypedBinding - "func" - [Alternative [VariablePattern "k"] (VariableExpression "id")] - , ImplicitlyTypedBinding - "func2" - [ Alternative - [VariablePattern "k", VariablePattern "l"] - (VariableExpression "k") - ] - , ImplicitlyTypedBinding - "f" - [Alternative [] (LiteralExpression (StringLiteral "hi"))] - ] - , [ ImplicitlyTypedBinding - "g" - [Alternative [] (LiteralExpression (IntegerLiteral 5))] - ] - ] - ] - mapM_ (putStrLn . printTypeSignature defaultSpecialTypes) assumptions - where - tInteger :: Type - tInteger = ConstructorType (TypeConstructor "Integer" StarKind) - makeArrow :: Type -> Type -> Type - a `makeArrow` b = ApplicationType (ApplicationType (specialTypesFunction defaultSpecialTypes) a) b - -------------------------------------------------------------------------------- -- Printer