├── .gitignore ├── BUILD ├── Error.hs ├── Lexer.hs ├── Main.hs ├── Parser.hs ├── README.md ├── Syntax.hs ├── Typecheck.hs ├── WORKSPACE └── examples ├── .DS_Store └── typed_expressions.fun /.gitignore: -------------------------------------------------------------------------------- 1 | *.hi 2 | *.o 3 | Main 4 | .DS_Store 5 | -------------------------------------------------------------------------------- /BUILD: -------------------------------------------------------------------------------- 1 | package(default_visibility = ["//visibility:public"]) 2 | 3 | load( 4 | "@io_tweag_rules_haskell//haskell:haskell.bzl", 5 | "haskell_binary", 6 | "haskell_library", 7 | "haskell_toolchain", 8 | ) 9 | 10 | haskell_toolchain( 11 | name = "ghc", 12 | version = "8.2.2", 13 | tools = "@ghc//:bin", 14 | ) 15 | 16 | haskell_binary( 17 | name = "subtyping", 18 | srcs = glob(['*.hs']), 19 | prebuilt_dependencies = [ 20 | "base", 21 | "parsec", 22 | "containers", 23 | "mtl", 24 | "haskeline" 25 | ], 26 | ) 27 | -------------------------------------------------------------------------------- /Error.hs: -------------------------------------------------------------------------------- 1 | module Error where 2 | 3 | import Syntax (Ty, prettyTy) 4 | 5 | errorUnknownType :: String -> a 6 | errorUnknownType tyName = error $ "Unknown type: " ++ tyName 7 | 8 | errorTypeMismatch :: Ty -> Ty -> a 9 | errorTypeMismatch expected actual = error $ mismatchMsg expected actual 10 | 11 | mismatchMsg :: Ty -> Ty -> String 12 | mismatchMsg expected actual = "Type mismatch: expected " ++ prettyTy expected ++ ", got " ++ prettyTy actual 13 | -------------------------------------------------------------------------------- /Lexer.hs: -------------------------------------------------------------------------------- 1 | module Lexer where 2 | 3 | import Text.Parsec.String (Parser) 4 | import Text.Parsec.Language (emptyDef) 5 | import qualified Text.Parsec.Token as Tok 6 | 7 | opNames :: [String] 8 | opNames = ["+", "*", "-", "/", "==", ">=", "<=", "::", ">", "<", ".", "->"] 9 | 10 | lexer :: Tok.TokenParser () 11 | lexer = Tok.makeTokenParser style 12 | where 13 | style = emptyDef { 14 | Tok.commentLine = "#", 15 | Tok.reservedOpNames = opNames, 16 | Tok.reservedNames = ["let", "in", "fn", "fun", "=", "if", "else", "then", "=>", "{", "}", ","] 17 | } 18 | 19 | integer :: Parser Integer 20 | integer = Tok.integer lexer 21 | 22 | parens :: Parser a -> Parser a 23 | parens = Tok.parens lexer 24 | 25 | identifier :: Parser String 26 | identifier = Tok.identifier lexer 27 | 28 | reserved :: String -> Parser () 29 | reserved = Tok.reserved lexer 30 | 31 | reservedOp :: String -> Parser () 32 | reservedOp = Tok.reservedOp lexer 33 | 34 | whiteSpace :: Parser () 35 | whiteSpace = Tok.whiteSpace lexer 36 | -------------------------------------------------------------------------------- /Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Control.Monad.Trans 4 | import System.Console.Haskeline 5 | import System.Environment 6 | 7 | import Syntax (prettyTy) 8 | import Parser (parseExpr) 9 | import Typecheck (typecheckExpr) 10 | 11 | ansiGreen :: String 12 | ansiGreen = "\x1b[32m" 13 | 14 | ansiRed :: String 15 | ansiRed = "\x1b[31m" 16 | 17 | ansiReset :: String 18 | ansiReset = "\x1b[0m" 19 | 20 | process :: String -> IO () 21 | process line = case parseExpr line of 22 | Left err -> print err 23 | Right ex -> do 24 | putStrLn $ "[Expr]: " ++ line 25 | putStrLn $ "[Typecheck] " ++ res 26 | -- putStrLn $ "[AST]: " ++ show ex 27 | putStrLn "" 28 | where res = case typecheckExpr ex of 29 | Left err -> "[" ++ ansiRed ++ "FAIL" ++ ansiReset ++ "]: " ++ err 30 | Right ty -> "[" ++ ansiGreen ++ "OK" ++ ansiReset ++ "]: " ++ prettyTy ty 31 | 32 | -- https://hackage.haskell.org/package/haskeline-0.7.3.1/docs/System-Console-Haskeline.html 33 | runRepl :: IO () 34 | runRepl = runInputT defaultSettings loop 35 | where 36 | loop = do 37 | minput <- getInputLine "> " 38 | case minput of 39 | Nothing -> outputStrLn "Goodbye." 40 | Just input -> liftIO (process input) >> loop 41 | 42 | loadFile :: String -> IO () 43 | loadFile filePath = do 44 | src <- readFile filePath 45 | mapM_ process [line | line <- lines src, line /= ""] 46 | 47 | main :: IO () 48 | main = do 49 | args <- getArgs 50 | case args of 51 | [] -> runRepl 52 | (x:_) -> loadFile x 53 | -------------------------------------------------------------------------------- /Parser.hs: -------------------------------------------------------------------------------- 1 | -- Some function signatures are too cryptic, so we're leaving them out. 2 | {-# OPTIONS_GHC -fno-warn-missing-signatures #-} 3 | 4 | module Parser where 5 | 6 | import Prelude hiding (GT, LT) 7 | import Text.Parsec 8 | import Text.Parsec.String (Parser) 9 | import qualified Text.Parsec.Expr as Exp 10 | 11 | import Lexer 12 | import Syntax 13 | import Error 14 | 15 | basicType :: Parser Ty 16 | basicType = do 17 | tyName <- identifier 18 | case tyName of 19 | "Int" -> return IntTy 20 | "Bool" -> return BoolTy 21 | _ -> errorUnknownType tyName 22 | 23 | rcdType :: Parser Ty 24 | rcdType = do 25 | reserved "{" 26 | fields <- sepBy rcdFieldType (spaces *> char ',' <* spaces) 27 | reserved "}" 28 | return $ RcdTy fields 29 | 30 | rcdFieldType = do 31 | lbl <- identifier 32 | reserved ":" 33 | ty <- typeParsers 34 | return (lbl, ty) 35 | 36 | basicTypes = basicType <|> rcdType 37 | 38 | fnType :: Parser Ty 39 | fnType = do 40 | ty1 <- try basicTypes <|> parens fnType 41 | reserved "->" 42 | ty2 <- try basicTypes <|> parens fnType 43 | return $ ArrowTy ty1 ty2 44 | 45 | typeParsers :: Parser Ty 46 | typeParsers = basicTypes <|> fnType 47 | 48 | exprType :: Parser Ty 49 | exprType = do 50 | reserved "::" 51 | typeParsers 52 | 53 | intExpr :: Parser Expr 54 | intExpr = do 55 | n <- integer 56 | return $ I (fromInteger n) IntTy -- n is an Integer, we want Int 57 | 58 | varExpr :: Parser Expr 59 | varExpr = do 60 | var <- identifier 61 | case var of 62 | "true" -> return $ B True BoolTy 63 | "false" -> return $ B False BoolTy 64 | v -> return $ Var v 65 | 66 | -- Anonymous function 67 | -- e.g. fn x => x + 1 68 | fnExpr :: Parser Expr 69 | fnExpr = do 70 | reserved "fn" 71 | var <- identifier 72 | reserved "::" 73 | ty <- parens fnType 74 | reserved "=>" 75 | body <- expr 76 | return $ Fn var body ty 77 | 78 | -- Records 79 | -- Nested records are permitted 80 | -- e.g. { a = 2, foo = true, c = 4 + 2, d = { bar = false } } 81 | rcdExpr :: Parser Expr 82 | rcdExpr = do 83 | reserved "{" 84 | fields <- sepBy rcdField (spaces *> char ',' <* spaces) 85 | reserved "}" 86 | ty <- exprType 87 | return $ Rcd fields ty 88 | 89 | rcdField = do 90 | lbl <- identifier 91 | reserved "=" 92 | value <- expr 93 | return (lbl, value) 94 | 95 | expr :: Parser Expr 96 | expr = Exp.buildExpressionParser opTable exprParsers 97 | 98 | -- The table of operations on expressions. 99 | -- 100 | -- Parsec uses this table to take care of associativity and precedence automatically. 101 | -- The table is ordered by descending precedence, where operators in the same row having the same precedence. 102 | opTable = [[Exp.Infix spacef Exp.AssocLeft], 103 | [projectionOp "." Exp.AssocLeft]] 104 | where 105 | projectionOp s = Exp.Infix $ reservedOp s >> return RcdProj 106 | -- Treat spaces as a binary operator for function application 107 | -- http://stackoverflow.com/questions/22904287/parsing-functional-application-with-parsec 108 | spacef = whiteSpace 109 | *> notFollowedBy (choice . map reservedOp $ opNames) 110 | >> return FApp 111 | 112 | exprParsers = varExpr 113 | <|> fnExpr 114 | <|> rcdExpr 115 | <|> intExpr 116 | <|> parens expr 117 | 118 | parseExpr :: String -> Either ParseError Expr 119 | parseExpr = parse expr "" 120 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # FunSub: A toy language with structural subtyping 2 | 3 | The purpose of this toy language is to provide a concrete realisation of subtyping concepts. 4 | 5 | It is the accompaniment code of my technical report on Subtyping: [Subtyping: Overview and Implementation](http://jin.crypt.sg/files/subtyping.pdf) 6 | 7 | The typechecker checks well-typedness of subtyping in records (depth, width, permutation) and functions (contravariant in arg, covariant in retval). 8 | 9 | ### Running 10 | 11 | Assuming Haskell is installed and the user is in the project directory, running the following command will invoke the typechecker: 12 | 13 | ```sh 14 | $ runhaskell Main.hs examples/typed_expressions.fun 15 | ``` 16 | 17 | This produces an output similar to the following: 18 | 19 | ``` 20 | .. 21 | [Expression]: (fn x :: (Int -> Int) => 2) 22 | [Typecheck][OK]: (Int -> Int) 23 | 24 | [Expression]: (fn x :: (Int -> Int) => true) 25 | [Typecheck][FAIL]: Type mismatch: expected Int, got Bool 26 | .. 27 | ``` 28 | 29 | This project can also be built with [Bazel](https://bazel.build) and the [Haskell rules](https://haskell.build) 30 | 31 | Ensure that `bazel` and `nix` are installed. 32 | 33 | ``` 34 | $ bazel build //:subtyping 35 | $ ./bazel-bin/subtyping examples/typed_expressions.fun 36 | ``` 37 | 38 | 39 | ### Architecture 40 | 41 | The components of the language comprises of a REPL/reader, lexer, parser and typechecker. Some examples of FunSub expressions are stored in the `examples/` folder. 42 | 43 | `Main.hs` is the entry point that takes in the filename for a file containing `FunSub` expressions. The lexer (`Lexer.hs`) defines reserved tokens and lexemes, and the parser (`Parser.hs`) uses `Parsec` on the tokens to generate an abstract syntax tree (AST) defined in `Syntax.hs`. Lastly, the AST is checked for well-typedness with rules defined in the typechecker (`Typecheck.hs`). 44 | 45 | ### Example 46 | 47 | The following is a valid expression in the `FunSub` syntax: 48 | 49 | ```fun 50 | (fn x :: ({ a: Int, b: Int } -> { a: Int }) => x) 51 | { a = 2, b = 2, c = true } :: { a: Int, b: Int, c: Bool } 52 | ``` 53 | 54 | In type systems without subtyping, this function application will not 55 | typecheck because the record argument type does not match the parameter type, and the parameter type does not match the function body type even though it is an identity function. However in our subtyping 56 | implementation, we are able to use concepts such as *variance* , *width* and *depth* record subtyping to make this expression well-typed. 57 | 58 | ### Implementation: Typechecker 59 | 60 | The two main functions of the typechecker are `typecheck` and `isSubtype`. Their type signatures are defined as follows: 61 | 62 | ```hs 63 | -- Typecheck.hs 64 | newtype TypeEnv = TypeEnv (Map String Ty) 65 | 66 | isSubtype :: Ty -> Ty -> Bool 67 | typecheck :: TypeEnv -> Expr -> Either String Ty 68 | ``` 69 | 70 | `isSubtype` takes in two types and recursively determines if the first 71 | type is a subtype of the second. 72 | 73 | `typecheck` takes in a type environment (a mapping of variables to 74 | types) and an AST, and recursively determines if the expression is 75 | well-typed. If it is ill-typed, an error message describing the issue is bubbled up and handled in `Main.hs`. If it is well-typed, the exact type is returned to the caller. 76 | -------------------------------------------------------------------------------- /Syntax.hs: -------------------------------------------------------------------------------- 1 | module Syntax where 2 | 3 | import Data.List (intercalate) 4 | 5 | data Ty = IntTy 6 | | BoolTy 7 | | ArrowTy Ty Ty 8 | | RcdTy [(String, Ty)] 9 | deriving (Show, Eq) 10 | 11 | data Expr = I Int Ty 12 | | B Bool Ty 13 | | Var String 14 | | Fn String Expr Ty 15 | | FApp Expr Expr 16 | | Rcd [(String, Expr)] Ty 17 | | RcdProj Expr Expr 18 | deriving (Show, Eq) 19 | 20 | prettyTy :: Ty -> String 21 | prettyTy (RcdTy xs) = "{ " ++ prettyRcds xs ++ " }" 22 | where prettyRcds = intercalate ", " . map (\(lbl, ty) -> lbl ++ ": " ++ prettyTy ty) 23 | prettyTy (ArrowTy x1 x2) = "(" ++ prettyTy x1 ++ " -> " ++ prettyTy x2 ++ ")" 24 | prettyTy IntTy = "Int" 25 | prettyTy BoolTy = "Bool" 26 | -------------------------------------------------------------------------------- /Typecheck.hs: -------------------------------------------------------------------------------- 1 | module Typecheck ( 2 | typecheckExpr 3 | ) where 4 | 5 | import Error 6 | import Syntax 7 | import Data.Map (Map) 8 | import qualified Data.Map as Map 9 | 10 | -- A type environment TypeEnv is a mapping from a program variable to a type. 11 | newtype TypeEnv = TypeEnv (Map String Ty) deriving Show 12 | 13 | emptyEnv :: TypeEnv 14 | emptyEnv = TypeEnv Map.empty 15 | 16 | bindType :: String -> Ty -> TypeEnv -> TypeEnv 17 | bindType label t (TypeEnv env) = TypeEnv $ Map.insert label t env 18 | 19 | getType :: String -> TypeEnv -> Maybe Ty 20 | getType label (TypeEnv env) = Map.lookup label env 21 | 22 | -- A function to check if one type is a subtype of the other. 23 | isSubtype :: Ty -> Ty -> Bool 24 | isSubtype (ArrowTy a b) (ArrowTy x y) = isSubtype x a && isSubtype b y -- Function subtyping 25 | isSubtype (RcdTy xs) (RcdTy ys) = all sub ys -- Record subtyping 26 | where sub (lbl, ty) = case lookup lbl xs of 27 | Just ty2 -> isSubtype ty2 ty 28 | Nothing -> False 29 | isSubtype ty1 ty2 = ty1 == ty2 30 | 31 | typecheck :: TypeEnv -> Expr -> Either String Ty 32 | typecheck _ (I _ IntTy) = Right IntTy 33 | typecheck _ (B _ BoolTy) = Right BoolTy 34 | typecheck env (Var v) = case getType v env of 35 | Just ty -> Right ty 36 | Nothing -> Left $ v ++ " is not defined" 37 | typecheck env (Fn arg body ty@(ArrowTy ty1 ty2)) = 38 | case typecheck newEnv body of 39 | Left err -> Left err 40 | Right bodyTy -> if isSubtype (ArrowTy ty1 bodyTy) ty 41 | then Right ty 42 | else Left $ mismatchMsg ty2 bodyTy 43 | where newEnv = bindType arg ty1 env 44 | typecheck _ (Fn _ _ t) = Left $ "Expected Arrow type, got " ++ prettyTy t 45 | typecheck env (Rcd xs (RcdTy ty)) = 46 | if all check ty then Right (RcdTy ty) else Left "Incorrect record type" 47 | where check (lbl, t1) = case lookup lbl xs of 48 | Just e -> case typecheck env e of 49 | Left _ -> False 50 | Right t2 -> isSubtype t2 t1 51 | Nothing -> False 52 | typecheck env (RcdProj rcd (Var lbl)) = 53 | case typecheck env rcd of 54 | Left err -> Left err 55 | Right (RcdTy fieldTys) -> check $ lookup lbl fieldTys 56 | where 57 | check (Just ty) = Right ty 58 | check Nothing = Left $ "Unable to lookup field " ++ lbl ++ " in " ++ prettyTy (RcdTy fieldTys) 59 | Right t -> Left $ "Expected Record type, got " ++ prettyTy t 60 | typecheck env (FApp fn arg) = 61 | case typecheck env fn of 62 | Left err -> Left err 63 | Right (ArrowTy t1 t2) -> 64 | case typecheck env arg of 65 | Left err -> Left err 66 | Right argType -> 67 | if isSubtype argType t1 68 | then Right t2 69 | else Left $ "Invalid argument of type " ++ prettyTy argType 70 | ++ " is not a subtype of the parameter type " ++ prettyTy t1 71 | Right t -> Left $ "Expected Arrow type, got " ++ prettyTy t 72 | typecheck _ e = Left $ "Error: Unknown type for " ++ show e 73 | 74 | typecheckExpr :: Expr -> Either String Ty 75 | typecheckExpr = typecheck emptyEnv 76 | -------------------------------------------------------------------------------- /WORKSPACE: -------------------------------------------------------------------------------- 1 | workspace(name = "subtyping") 2 | 3 | http_archive( 4 | name = "io_tweag_rules_haskell", 5 | strip_prefix = "rules_haskell-d867758114020f7eeaa83ffbda6393e131ed1462", 6 | urls = ["https://github.com/tweag/rules_haskell/archive/d867758114020f7eeaa83ffbda6393e131ed1462.tar.gz"] 7 | ) 8 | 9 | load("@io_tweag_rules_haskell//haskell:repositories.bzl", "haskell_repositories") 10 | haskell_repositories() 11 | 12 | http_archive( 13 | name = "io_tweag_rules_nixpkgs", 14 | strip_prefix = "rules_nixpkgs-0.2", 15 | urls = ["https://github.com/tweag/rules_nixpkgs/archive/v0.2.tar.gz"], 16 | ) 17 | 18 | load("@io_tweag_rules_nixpkgs//nixpkgs:nixpkgs.bzl", "nixpkgs_package") 19 | 20 | nixpkgs_package( 21 | name = "ghc", 22 | nix_file_content = """ 23 | let pkgs = import {}; in 24 | pkgs.haskell.packages.ghc822.ghcWithPackages (p: with p; 25 | [containers parsec mtl haskeline] 26 | ) 27 | """, 28 | ) 29 | 30 | register_toolchains("//:ghc") 31 | -------------------------------------------------------------------------------- /examples/.DS_Store: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jin/subtyping/952147aed90f83d32c3e7dfe508e124a09f59178/examples/.DS_Store -------------------------------------------------------------------------------- /examples/typed_expressions.fun: -------------------------------------------------------------------------------- 1 | 1 2 | -1 3 | 1 4 | a 5 | true 6 | false 7 | { a = 2, b = 3 } :: { a: Int, b: Int } 8 | { a = 2, b = true } :: { a: Int, b: Int } 9 | { a = 2, b = 3 } :: { } 10 | { a = 2, b = 3 } :: { a: Int } 11 | { a = 2, b = 3 } :: { a: Int, b: Int, c: Int } 12 | { a = { d = 4 } :: { d : Int }, b = 3, c = 4 } :: { a : { d : Int }, b : Int, c : Int } 13 | { a = { d = 4 } :: { d : Int }, b = 3, c = 4 } :: { a : { d : Int } } 14 | { a = { d = 4 } :: { d : Int }, b = 3, c = 4 } :: { a : { c : Int } } 15 | (fn x :: (Int -> Int) => x) 16 | (fn x :: (Int -> Int) => y) 17 | (fn x :: (Int -> Int) => 2) 18 | (fn x :: (Int -> Int) => true) 19 | (fn x :: ({ a: Bool } -> Int) => x.a) 20 | (fn x :: ({ a: Int } -> Int) => x.b) 21 | (fn x :: ({ a: Int, b: Int } -> { a: Int }) => x) 22 | (fn x :: ({ a: Int } -> { a: Int, b: Int }) => x) 23 | (fn x :: ({ a: Int } -> Int) => x) { a = 2 } :: { a: Int } 24 | (fn x :: ({ a: Int } -> Int) => x.a) { a = 2 } :: { a: Int } 25 | (fn x :: ({ a: Bool } -> Bool) => x.a) { a = 2 } :: { a: Int } 26 | (fn x :: ({ a: Int, b: Int } -> { a: Int }) => x) { a = 2, b = 2, c = true } :: { a: Int, b: Int, c: Bool } 27 | (fn x :: ({ a: Int } -> Int) => x.a) { a = 2 } :: { a : Int } 28 | (fn x :: ({ a: Int } -> Bool) => x.a) { a = 2 } :: { a : Int } 29 | (fn x :: ({ a: Int } -> { a: Int, b: Int }) => { a = x.a, b = 3 } :: { a: Int, b: Int }) { a = 2 } :: { a : Int } 30 | (fn x :: ({ a: { c : Int} } -> Int) => x.a.c) { a = { c = 4 } :: { c : Int }, b = 3 } :: { a: { c : Int }, b: Int } 31 | (fn x :: ({ a: Int, b: Int } -> Int) => x.b) { a = 2 } :: { a: Int } 32 | (fn x :: ({ a: { b: Int, c: Int } } -> Int) => x.a.b) { a = { b = 2, c = 3 } :: { b: Int, c : Int } } :: { a: { b: Int, c: Int } } 33 | (fn x :: ({ a: { b: Int } } -> Int) => x.a.b) { a = { b = 2, c = 3 } :: { b: Int, c : Int } } :: { a: { b: Int, c: Int } } 34 | (fn x :: ({ a: { b: Int, c: Int } } -> Int) => x.a.b) { a = { c = 3 } :: { c : Int } } :: { a: { c: Int } } 35 | (fn x :: ({ a: { b: Int, c: Int } } -> { a: Int } ) => { a = x.a.c, b = x.a.b } :: { a: Int, b: Int }) { a = { b = 3, c = 3 } :: { b: Int, c: Int } } :: { a: { b: Int, c: Int } } 36 | (fn x :: ((Int -> Int) -> (Int -> Int)) => 2) 37 | (fn x :: ((Int -> Int) -> (Int -> Int)) => fn x :: (Int -> Int) => 2) 38 | (fn x :: ((Int -> Int) -> Int) => x 2) (fn y :: (Int -> Int) => y) 39 | (fn x :: ((Int -> Int) -> Int) => x 2) (fn y :: ({ a: Int } -> { a: Int }) => y) 40 | (fn x :: (({ a: Int } -> { a: Int }) -> { a: Int }) => x { a = 2 } :: { a: Int }) (fn y :: ({ a: Int, b: Int } -> { a: Int }) => y) 41 | (fn x :: (({ a: Int } -> { a: Int, b: Int }) -> { a: Int }) => x { a = 2 } :: { a: Int }) (fn y :: ({ a: Int } -> { a: Int }) => y) 42 | (fn x :: (({ a: Int } -> { a: Int }) -> { a: Int }) => x { a = 2 } :: { a: Int }) (fn y :: ({ a: Int } -> { a: Int, b: Int }) => { a = y.a, b = 2 } :: { a: Int, b: Int }) 43 | (fn x :: (({ a: Int, b: Int } -> { a: Int }) -> { a: Int }) => x { a = 2, b = 2 } :: { a: Int, b: Int }) (fn y :: ({ a: Int } -> { a: Int }) => { a = y.a } :: { a: Int }) 44 | (fn x :: (({ a: Int, c: Int } -> { a: Int }) -> { a: Int }) => x { a = 2, b = 2 } :: { a: Int, b: Int }) (fn y :: ({ a: Int } -> { a: Int }) => { a = y.a } :: { a: Int }) 45 | (fn x :: (({ a: Int } -> { a: Int }) -> { a: Int }) => x { a = 2 } :: { a: Int }) (fn y :: ({ a: Int } -> { a: Int }) => y) 46 | (fn x :: (({ a: Int } -> { a: Int }) -> ({ a: Int } -> { a: Int })) => x) (fn y :: ({ a: Int, b: Int } -> { a: Int }) => y) 47 | (fn x :: (({ a: Int, b: Int } -> { a: Int }) -> ({ a: Int, b: Int } -> { a: Int })) => x) (fn y :: ({ a: Int, b: Int } -> { a: Int, b: Int }) => y) 48 | (fn x :: (({ a: Int, b: Int } -> { a: Int }) -> ({ a: Int, b: Int } -> { a: Int })) => x) (fn y :: ({ a: Int } -> { a: Int, b: Int }) => { a = y.a, b = 2 } :: { a: Int, b: Int }) 49 | --------------------------------------------------------------------------------