├── AlgorithmW
├── AlgorithmW.fsproj
├── AlgorithmW.sln
├── AssemblyInfo.fs
├── Inference.fs
└── Program.fs
├── LICENSE.txt
└── README.md
/AlgorithmW/AlgorithmW.fsproj:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | Debug
5 | x86
6 | {97673FB8-FE16-4058-BC9B-BB77C6743879}
7 | Exe
8 | AlgorithmW
9 | AlgorithmW
10 |
11 |
12 | true
13 | full
14 | false
15 | bin\Debug
16 | DEBUG
17 | prompt
18 | false
19 | x86
20 | true
21 |
22 |
23 | true
24 | pdbonly
25 | true
26 | bin\Release
27 | prompt
28 | true
29 | true
30 | x86
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
--------------------------------------------------------------------------------
/AlgorithmW/AlgorithmW.sln:
--------------------------------------------------------------------------------
1 |
2 | Microsoft Visual Studio Solution File, Format Version 12.00
3 | # Visual Studio 2012
4 | Project("{f2a71f9b-5d33-465a-a702-920d77279786}") = "AlgorithmW", "AlgorithmW.fsproj", "{97673FB8-FE16-4058-BC9B-BB77C6743879}"
5 | EndProject
6 | Global
7 | GlobalSection(SolutionConfigurationPlatforms) = preSolution
8 | Debug|x86 = Debug|x86
9 | Release|x86 = Release|x86
10 | EndGlobalSection
11 | GlobalSection(ProjectConfigurationPlatforms) = postSolution
12 | {97673FB8-FE16-4058-BC9B-BB77C6743879}.Debug|x86.ActiveCfg = Debug|x86
13 | {97673FB8-FE16-4058-BC9B-BB77C6743879}.Debug|x86.Build.0 = Debug|x86
14 | {97673FB8-FE16-4058-BC9B-BB77C6743879}.Release|x86.ActiveCfg = Release|x86
15 | {97673FB8-FE16-4058-BC9B-BB77C6743879}.Release|x86.Build.0 = Release|x86
16 | EndGlobalSection
17 | GlobalSection(MonoDevelopProperties) = preSolution
18 | StartupItem = AlgorithmW.fsproj
19 | EndGlobalSection
20 | EndGlobal
21 |
--------------------------------------------------------------------------------
/AlgorithmW/AssemblyInfo.fs:
--------------------------------------------------------------------------------
1 | module AlgorithmW.AssemblyInfo
2 |
3 | open System.Reflection
4 | open System.Runtime.CompilerServices
5 |
6 | []
7 | []
8 | []
9 | []
10 | []
11 | []
12 | []
13 | []
14 | ()
15 | // The assembly version has the format {Major}.{Minor}.{Build}.{Revision}
16 | //[]
17 | //[]
18 |
19 |
--------------------------------------------------------------------------------
/AlgorithmW/Inference.fs:
--------------------------------------------------------------------------------
1 | module AlgorithmW.Inference
2 |
3 | type Lit =
4 | | LInt of int
5 | | LBool of bool
6 |
7 | type Exp =
8 | | EVar of string
9 | | ELit of Lit
10 | | EApp of Exp * Exp
11 | | EAbs of string * Exp
12 | | ELet of string * Exp * Exp
13 |
14 | type Type =
15 | | TVar of string
16 | | TInt
17 | | TBool
18 | | TFun of Type * Type
19 |
20 | type Scheme = Scheme of List * Type
21 |
22 | type Subst = Map
23 |
24 | exception TypeError of string * Type * Type
25 |
26 | type Types<'a> = {
27 | ftv : 'a -> Set;
28 | apply : Subst -> 'a -> 'a
29 | }
30 |
31 | let rec typeTypes : Types = {
32 | ftv = fun t ->
33 | match t with
34 | | TVar n -> Set.singleton n
35 | | TInt -> Set.empty
36 | | TBool -> Set.empty
37 | | TFun (t1, t2) -> Set.union (typeTypes.ftv t1) (typeTypes.ftv t2)
38 |
39 | apply = fun s t ->
40 | match t with
41 | | TVar n ->
42 | match Map.tryFind n s with
43 | | None -> t
44 | | Some t' -> t'
45 | | TInt -> TInt
46 | | TBool -> TBool
47 | | TFun (t1, t2) -> TFun (typeTypes.apply s t1, typeTypes.apply s t2)
48 | }
49 |
50 | let schemeTypes : Types = {
51 | ftv = fun (Scheme (vars, t)) -> Set.difference (typeTypes.ftv t) (Set.ofList vars)
52 |
53 | apply = fun s (Scheme (vars, t)) -> Scheme (vars, typeTypes.apply (List.foldBack Map.remove vars s) t)
54 | }
55 |
56 | let listTypes (types : Types<'a>) : Types> = {
57 | ftv = fun l -> List.foldBack Set.union (List.map types.ftv l) Set.empty
58 |
59 | apply = fun s l -> List.map (types.apply s) l
60 | }
61 |
62 | let nullSubst : Subst = Map.empty
63 | let composeSubst (s1 : Subst) (s2 : Subst) : Subst =
64 | let s2' : Subst = Map.map (fun _ t -> typeTypes.apply s1 t) s2
65 | List.fold (fun s (k, v) -> Map.add k v s) s1 (Map.toList s2')
66 |
67 | type TypeEnv = Map
68 |
69 | let typeEnvTypes : Types = {
70 | ftv = fun env -> (listTypes schemeTypes).ftv (List.map snd (Map.toList env))
71 | apply = fun s env -> Map.map (fun _ scheme -> schemeTypes.apply s scheme) env
72 | }
73 |
74 | let generalize env t =
75 | let vars = Set.toList (Set.difference (typeTypes.ftv t) (typeEnvTypes.ftv env))
76 | Scheme (vars, t)
77 |
78 | // A minor difference here is that we use effects instead of monads to generate the fresh type variables
79 | let instantiate newTyVar (Scheme (vars, t)) : Type =
80 | let nvars = List.map (fun _ -> newTyVar "a") vars
81 | let s = Map.ofList (List.zip vars nvars)
82 | typeTypes.apply s t
83 |
84 | // A minor difference here is that mgu is pure and doesn't need a monad
85 | let rec mgu t1 t2 =
86 | let varBind u t =
87 | if t = TVar u then nullSubst
88 | else if Set.contains u (typeTypes.ftv t) then raise (TypeError ("occurs check fails", TVar u, t))
89 | else Map.add u t Map.empty
90 | match (t1, t2) with
91 | | (TFun (l, r), TFun (l', r')) ->
92 | let s1 = mgu l l'
93 | let s2 = mgu r r'
94 | composeSubst s1 s2
95 | | (TVar u, t) | (t, TVar u) -> varBind u t
96 | | (TInt, TInt) -> nullSubst
97 | | (TBool, TBool) -> nullSubst
98 | | _ -> raise (TypeError ("types do not unify", t1, t2))
99 |
100 | // A minor difference her is that we use some local state instead of a state monad
101 | let typeInference env e =
102 | let tiSupply = ref 0
103 | let newTyVar prefix =
104 | let i = !tiSupply
105 | tiSupply := i + 1
106 | TVar (prefix + i.ToString())
107 | let rec ti env e =
108 | match e with
109 | | EVar n ->
110 | match Map.tryFind n env with
111 | | None -> failwith ("unbound variable" + n.ToString())
112 | | Some sigma -> (nullSubst, instantiate newTyVar sigma)
113 | | ELit (LBool _) -> (nullSubst, TBool)
114 | | ELit (LInt _) -> (nullSubst, TInt)
115 | | EAbs (n, e) ->
116 | let tv = newTyVar "a"
117 | let env' = Map.remove n env
118 | let env'' = Map.add n (Scheme ([], tv)) env'
119 | let (s1, t1) = ti env'' e
120 | (s1, TFun (typeTypes.apply s1 tv, t1))
121 | | EApp (e1, e2) ->
122 | let tv = newTyVar "a"
123 | let (s1, t1) = ti env e1
124 | let (s2, t2) = ti (typeEnvTypes.apply s1 env) e2
125 | let s3 = mgu (typeTypes.apply s2 t1) (TFun (t2, tv))
126 | (composeSubst (composeSubst s3 s2) s1, typeTypes.apply s3 tv)
127 | | ELet (x, e1, e2) ->
128 | let env' = Map.remove x env
129 | let (s1, t1) = ti env e1
130 | let t' = generalize (typeEnvTypes.apply s1 env) t1
131 | let env'' = Map.add x t' env'
132 | let (s2, t2) = ti (typeEnvTypes.apply s1 env'') e2
133 | (composeSubst s1 s2, t2)
134 | let (s, t) = ti env e
135 | typeTypes.apply s t
136 |
--------------------------------------------------------------------------------
/AlgorithmW/Program.fs:
--------------------------------------------------------------------------------
1 | module AlgorithmW.Program
2 | open System
3 | open AlgorithmW.Inference
4 |
5 | let e0 = ELet ("id", EAbs ("x", EVar "x"), EVar "id")
6 | let e1 = ELet ("id", EAbs ("x", EVar "x"), EApp (EVar "id", EVar "id"))
7 | let e2 = ELet ("id", EAbs ("x", ELet ("y", EVar "x", EVar "y")), EApp (EVar "id", EVar "id"))
8 | let e3 = ELet ("id", EAbs ("x", ELet ("y", EVar "x", EVar "y")), EApp (EApp (EVar "id", EVar "id"), ELit (LInt 2)))
9 | let e4 = ELet ("id", EAbs ("x", EApp (EVar "x", EVar "x")), EVar "id") // Supposed to fail
10 | let e5 = EAbs ("m", ELet ("y", EVar "m", ELet ("x", EApp (EVar "y", ELit (LBool true)), EVar "x")))
11 |
12 | let test e =
13 | try
14 | let t = typeInference Map.empty e
15 | printfn "%A : %A" e t
16 | with TypeError (m, t1, t2) ->
17 | printfn "%A ! %s: %A vs. %A" e m t1 t2
18 | printfn ""
19 |
20 |
21 | []
22 | let main argv =
23 | List.map test [e0; e1; e2; e3; e4; e5] |> ignore
24 | Console.ReadLine() |> ignore
25 | 0 // return an integer exit code
26 |
27 |
--------------------------------------------------------------------------------
/LICENSE.txt:
--------------------------------------------------------------------------------
1 | Copyright (c) 2006-2014, Martin Grabmüller
2 | Copyright (c) 2014, Joakim Ahnfelt-Rønne
3 | All rights reserved.
4 |
5 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
6 |
7 | 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
8 |
9 | 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
10 |
11 | 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
12 |
13 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
14 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | AlgorithmWStepByStep
2 | ====================
3 |
4 | **The type inference is in a single file [Inference.fs](/AlgorithmW/Inference.fs)** (less than 150 lines of code)
5 |
6 | Type inference for ML-like languages. A port to F# of "Algorithm W Step by Step" by Martin Grabmüller. If there are bugs, they're probably mine.
7 |
8 | I've kept the variable names from the article, to make it easier to follow this code while reading the article.
9 |
10 | The only major difference is that the F# port uses local state for the supply of fresh variables rather than a monad.
11 |
12 | Please see http://www.grabmueller.de/martin/www/pub/AlgorithmW.pdf for documentation.
13 |
14 |
15 | The problem in a nutshell
16 | -------------------------
17 |
18 | - When can we use the empty list `[]`?
19 | - When we expect a list with **some type of elements**.
20 |
21 | - What is the type of the function that appends two lists?
22 | - It takes a list with **some type of elements** and
23 | - another list with **that same type of elements**, and
24 | - returns a list with **that same type of elements**.
25 |
26 | - What is the type of the identity function `id x = x`?
27 | - It takes **any type of value** and
28 | - returns **that same type of value**.
29 |
30 | The solution
31 | ------------
32 |
33 | - To represent **"some type"**, we use *type variables*.
34 | - To represent **"that same type"**, we use *equality constraints* between types.
35 | - To represent **"any type"**, we use *type schemes*.
36 |
37 | Note that "some type" doesn't mean *existential type* in this document.
38 |
39 | The code
40 | --------
41 |
42 | The code contains an abstract syntax tree of a language with `lambda`-functions (`EAbs`/`EApp`), polymorphic `let`-bindings (`ELet`) and some literals for primitive types (`ELit`).
43 |
44 | The types are also represented as an abstract syntax tree, with type variables (`TVar`) and types for functions (`TFun`) and primitive types (`TInt`/`TBool`), and type variables.
45 |
46 | Since some functions can work with many different types (eg. they are *polymorphic*), we represent the types that can vary like that with type variables that are quantified with `forall`. This is often called a type scheme (`Scheme`). In standard Hindley-Milner, type schemes can only occur in the type environment (`TypeEnv`), which binds variables to type schemes.
47 |
48 | When solving constraints, the solution is a *substitution* (`Subst`) that binds type variables to types. For things that contain types, like type environments, type schemes and types themselves, we need to be able to `apply` this subsitution, replacing the bound type variables with the types they are bound to. For the next step, we also need to be able to find the free type variables (`ftv`). These operations are represented by the record called `Types`, which has instances for each of the type containers.
49 |
50 | Whenever we let-bind a variable, we `generalize` the type to introduce the *forall* for type variables that are not constrained, and thus can be quantified in a type scheme. Since we solve constraints as soon as we generate them, the only type variables that may be constrained in the future are those in the type environment. These won't be qantified with a *forall*.
51 |
52 | When we mention a variable, we immediately `instantiate` the type scheme it's bound to. This is simply done by replacing all the quantified variables with fresh type variables (`newTyVar`).
53 |
54 | To solve an equality constraint `t1 = t2`, we must find the most general unifier (`mgu`), which is a substitution that when applied to `t1` and `t2` makes the two types *syntactically* equal. When this is not possible, eg. `TInt = TBool`, we raise a `TypeError`.
55 |
56 | The type inference function recursively visits an expression, generating equality constraints that are immediately solved with `mgu`. The unification results in a substitution that is then returned, and finally applied to the resulting type. In order to generate fresh type variables (`newTyVar`), we simply increment a local mutable variable (`tiSupply`).
57 |
--------------------------------------------------------------------------------