├── .gitmodules
├── README.md
└── inferencer.scm


/.gitmodules:
--------------------------------------------------------------------------------
1 | [submodule "mk"]
2 | 	path = mk
3 | 	url = https://github.com/webyrd/miniKanren-with-symbolic-constraints.git
4 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # Occurrence type inferencer in miniKanren
2 | 
3 | Or a start at one, at this point. From [miniKanren uncourse hangout #14](https://www.youtube.com/watch?v=KgWW3MZN7Nc) with Ambrose Bonnaire-Sergeant.
4 | 
5 | Should implement the inference rules from the paper [Logical Types for Untyped Languages](http://www.ccs.neu.edu/racket/pubs/icfp10-thf.pdf). The next step is to implement type update from Figure 9.
6 | 


--------------------------------------------------------------------------------
/inferencer.scm:
--------------------------------------------------------------------------------
  1 | (load "mk/mk.scm")
  2 | (load "mk/test-check.scm")
  3 | 
  4 | ; Type inferencer from miniKanren uncourse hangout #14, March 1, 2015.
  5 | 
  6 | ; Assuming that term is in the condition position
  7 | ; of an if-statement, what propositions do we learn about
  8 | ; the then and else branches?
  9 | (define (infer-props term then-prop else-prop)
 10 |   (conde
 11 |     [(== #f term)
 12 |      (== 'ff then-prop)
 13 |      (== 'tt else-prop)]
 14 |     [(conde
 15 |        [(== #t term)]
 16 |        [(numbero term)])
 17 |      (== 'tt then-prop)
 18 |      (== 'ff else-prop)]
 19 |     [(symbolo term)
 20 |      (== `(,term (not (val #f))) then-prop)
 21 |      (== `(,term (val #f)) else-prop)]))
 22 | 
 23 | ; Look up var in the proposition environment and find
 24 | ; type information res.
 25 | (define (lookupo var env res)
 26 |   (conde
 27 |     [(fresh (d)
 28 |        (== `((,var ,res) . ,d) env))]
 29 |     [(fresh (aa ad d)
 30 |        (=/= var aa)
 31 |        (== `((,aa ,ad) . ,d) env)
 32 |        (lookupo var d res))]))
 33 | 
 34 | ; Prove that var is compatible with type given the proposition environment
 35 | (define (proveo prop-env var type)
 36 |   (conde
 37 |     [(fresh (t1)
 38 |        (lookupo var prop-env t1)
 39 |        (subtypeo t1 type))]))
 40 | 
 41 | (define (booleano b)
 42 |   (conde
 43 |     [(== #t b)]
 44 |     [(== #f b)]))
 45 | 
 46 | ; Succeed if child-type is a subtype of parent-type,
 47 | ; like (var #f) is a subtype of 'bool.
 48 | (define (subtypeo child-type parent-type)
 49 |   (conde
 50 |     [(== child-type parent-type)]
 51 |     [(fresh (b)
 52 |        (== `(val ,b) child-type)
 53 |        (conde
 54 |          [(booleano b)
 55 |           (== 'bool parent-type)]
 56 |          [(numbero b)
 57 |           (== 'num parent-type)]))]
 58 |     [(fresh (t1 t2)
 59 |        (== `(U ,t1 ,t2) child-type)
 60 |        (subtypeo t1 parent-type)
 61 |        (subtypeo t2 parent-type))]))
 62 | 
 63 | ; Union type constructor. We might need to make this
 64 | ; smarter in the future.
 65 | (define (uniono t1 t2 union-type)
 66 |   (conde
 67 |     [(== t1 t2)
 68 |      (== t1 union-type)]
 69 |     [(=/= t1 t2)
 70 |      (== `(U ,t1 ,t2) union-type)]))
 71 | 
 72 | ; Given term and the proposition environment, infer the most
 73 | ; specific type for the term. If you want to check compatiblity
 74 | ; of the term's type with a given type, use the subtype relation
 75 | ; with the type argument of this relation.
 76 | (define (infer term prop-env type)
 77 |   (conde
 78 |     [(== #f term)
 79 |      (== '(val #f) type)]
 80 |     [(== #t term)
 81 |      (== '(val #t) type)]
 82 |     [(numbero term)
 83 |      (== `(val ,term) type)]
 84 |     [(fresh (condition then else then-prop
 85 |              else-prop cond-type t1 t2)
 86 |        (== `(if ,condition ,then ,else) term)
 87 |        (infer condition prop-env cond-type)
 88 |        (subtypeo cond-type 'bool)
 89 |        (infer-props condition then-prop else-prop)
 90 |        (infer then `(,then-prop . ,prop-env) t1)
 91 |        (infer else `(,else-prop . ,prop-env) t2)
 92 |        (uniono t1 t2 type))]
 93 |     [(fresh (arg argtype body prop-env^ res-type)
 94 |        (== `(lambda (,arg : ,argtype) ,body) term)
 95 |        (== `((,arg ,argtype) . ,prop-env) prop-env^)
 96 |        (infer body prop-env^ res-type)
 97 |        (subtypeo `(,argtype -> ,res-type) type))]
 98 |     [(fresh ()
 99 |        (symbolo term)
100 |        (proveo prop-env term type))]
101 |     [(fresh (expr expr-type)
102 |        (== `(inc ,expr) term)
103 |        (infer expr prop-env expr-type)
104 |        (subtypeo expr-type 'num)
105 |        (== 'num type))]))
106 | 
107 | (test "plain #t"
108 |   (run* (q)
109 |     (infer #t '() q))
110 |   '((val #t)))
111 | 
112 | (test "plain #f"
113 |   (run* (q)
114 |     (infer #f '() q))
115 |   '((val #f)))
116 | 
117 | (test "if, type #t"
118 |   (run* (q)
119 |     (infer `(if #t #t #t) '() q))
120 |   '((val #t)))
121 | 
122 | (test "another if, type #t"
123 |   (run* (q)
124 |     (infer `(if #f #t #t) '() q))
125 |   '((val #t)))
126 | 
127 | (test "if, union #t #f"
128 |   (run* (q)
129 |     (infer `(if #t #t #f) '() q))
130 |   '((U (val #t) (val #f))))
131 | 
132 | 
133 | (test "plain number"
134 |   (run* (q)
135 |     (infer 1 '() q))
136 |   '((val 1)))
137 | 
138 | (test "if, type (val 1)"
139 |   (run* (q)
140 |     (infer `(if #t 1 1) '() q))
141 |   '((val 1)))
142 | 
143 | (test "inference doens't include subtype"
144 |   (run* (q)
145 |     (infer 1 '() 'num))
146 |   '())
147 | 
148 | (test "inc should accept a number and return a number"
149 |   (run* (q)
150 |     (infer '(inc 1) '() q))
151 |   '(num))
152 | 
153 | (test "inc of boolean should fail"
154 |   (run* (q)
155 |     (infer '(inc #t) '() q))
156 |   '())
157 | 
158 | (test "function type"
159 |   (run* (q)
160 |     (infer '(lambda (arg : num) (inc arg)) '() q))
161 |   '((num -> num)))
162 | 
163 | (test "incorrect typing inside function definition should cause failure"
164 |   (run* (q)
165 |     (infer '(lambda (arg : num) (inc #f)) '() q))
166 |   '())
167 | 
168 | (test "should fail when argument used contrary to type declaration"
169 |   (run* (q)
170 |     (infer '(lambda (arg : (val #f)) (inc arg)) '() q))
171 |   '())
172 | 
173 | (test "should fail when one element of arg union type is incompatible with usage"
174 |   (run* (q)
175 |     (infer '(lambda (arg : (U (val #f) num)) (inc arg)) '() q))
176 |   '())
177 | 
178 | ; Not implemented yet.
179 | ;
180 | ; prop-env at if: (arg (U (val #f) num))
181 | ; prop-env at (inc arg): ((arg (U (val #f) num))
182 | ;                         (arg (not (val #f))))
183 | ;
184 | ; need to combine information from the two propositions to derive the proposition (arg num).
185 | ;
186 | ; This will involve writing a function env+ that takes a proposition environment and a proposition
187 | ; and returns a new proposition environment with the derived (positive) proposition. This is the proposition
188 | ; that the variable case will access.
189 | ; the `then` case then becomes
190 | ; (fresh ()
191 | ;   (env+ prop-env then-prop prop-env^)
192 | ;   (infer then prop-env^ t1)
193 | ; and similarly for the else branch.
194 | ;
195 | (test "should infer correct branch of union from if condition"
196 |   (run* (q)
197 |     (infer '(lambda (arg : (U (val #f) num))
198 |               (if arg (inc arg) 0)) '() q))
199 |   ; I'm not 100% certain of this expected output.
200 |   '(((U (val #f) num) -> (U num 0))))
201 | 
202 | 


--------------------------------------------------------------------------------