├── .gitignore
├── Makefile
├── README.md
├── array.dats
├── ats-screenshot.png
├── filter_list.dats
├── minimal.dats
├── presentation.org
├── print_list.dats
├── proof_functions.dats
├── safe_malloc.dats
├── safe_swap.dats
├── swap.c
├── swap_from_ats.dats
└── swap_runner.dats


/.gitignore:
--------------------------------------------------------------------------------
 1 | minimal
 2 | minimal_dats.c
 3 | proof_functions
 4 | proof_functions_dats.c
 5 | safe_malloc
 6 | safe_malloc_dats.c
 7 | safe_swap
 8 | safe_swap_dats.c
 9 | swap_from_ats
10 | swap_from_ats_dats.c
11 | swap_runner
12 | swap_runner_dats.c
13 | filter_list
14 | filter_list_dats.c
15 | print_list
16 | print_list_dats.c
17 | presentation.html
18 | 


--------------------------------------------------------------------------------
/Makefile:
--------------------------------------------------------------------------------
 1 | PATSHOMEQ="$(PATSHOME)"
 2 | 
 3 | PATSCC=$(PATSHOMEQ)/bin/patscc
 4 | PATSOPT=$(PATSHOMEQ)/bin/patsopt
 5 | 
 6 | #PATSCCFLAGS=
 7 | #PATSCCFLAGS=-O2
 8 | #
 9 | # '-flto' enables link-time optimization such as inlining lib functions
10 | #
11 | PATSCCFLAGS=-O2 -flto
12 | 
13 | ######
14 | 
15 | cleanall::
16 | 
17 | minimal: minimal.dats ; \
18 |   $(PATSCC) -DATS_MEMALLOC_GCBDW $(PATSCCFLAGS) -o $@ $< -lgc || echo $@ ": ERROR!!!"
19 | swap_runner: swap_runner.dats ; \
20 |   $(PATSCC) $(PATSCCFLAGS) -o $@ $< || echo $@ ": ERROR!!!"
21 | swap_from_ats: swap_from_ats.dats ; \
22 |   $(PATSCC) $(PATSCCFLAGS) -o $@ $< || echo $@ ": ERROR!!!"
23 | safe_malloc: safe_malloc.dats ; \
24 |   $(PATSCC) $(PATSCCFLAGS) -o $@ $< || echo $@ ": ERROR!!!"
25 | safe_swap: safe_swap.dats ; \
26 |   $(PATSCC) $(PATSCCFLAGS) -o $@ $< || echo $@ ": ERROR!!!"
27 | proof_functions: proof_functions.dats ; \
28 |   $(PATSCC) $(PATSCCFLAGS) -o $@ $< || echo $@ ": ERROR!!!"
29 | array: array.dats ; \
30 |   $(PATSCC) -DATS_MEMALLOC_LIBC $(PATSCCFLAGS) -o $@ $< || echo $@ ": ERROR!!!"
31 | print_list: print_list.dats ; \
32 |   $(PATSCC) -DATS_MEMALLOC_LIBC $(PATSCCFLAGS) -o $@ $< || echo $@ ": ERROR!!!"
33 | filter_list: filter_list.dats ; \
34 |   $(PATSCC) -DATS_MEMALLOC_LIBC $(PATSCCFLAGS) -o $@ $< || echo $@ ": ERROR!!!"
35 | presentation.html: presentation.org ; \
36 |   pandoc $< -t slidy -s -o $@
37 | cleanall:: ; $(RMF) minimal
38 | 
39 | ######
40 | 
41 | #
42 | # You may find these rules useful
43 | #
44 | 
45 | # %_sats.o: %.sats ; $(PATSCC) $(PATSCCFLAGS) -c $< || echo $@ ": ERROR!!!"
46 | # %_dats.o: %.dats ; $(PATSCC) $(PATSCCFLAGS) -c $< || echo $@ ": ERROR!!!"
47 | 
48 | ######
49 | 
50 | RMF=rm -f
51 | 
52 | ######
53 | 
54 | clean:: ; $(RMF) *~
55 | clean:: ; $(RMF) *_?ats.o
56 | clean:: ; $(RMF) *_?ats.c
57 | clean:: ; $(RMF) safe_malloc
58 | clean:: ; $(RMF) safe_swap
59 | clean:: ; $(RMF) swap_runner
60 | clean:: ; $(RMF) swap_from_ats
61 | clean:: ; $(RMF) proof_functions
62 | clean:: ; $(RMF) array
63 | clean:: ; $(RMF) print_list
64 | clean:: ; $(RMF) filter_list
65 | clean:: ; $(RMF) minimal
66 | 
67 | cleanall:: clean
68 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | ATS presentation given at LambdaLounge on August 5, 2015.
2 | 


--------------------------------------------------------------------------------
/array.dats:
--------------------------------------------------------------------------------
 1 | #include "share/atspre_staload.hats"
 2 | implement main0 () = {
 3 |   local
 4 |     implement array_tabulate$fopr<int> (i) = sz2i(i)
 5 |   in
 6 |     val (pf, pfgc | p) = array_ptr_tabulate<int> (i2sz(10))
 7 |   end // end of [local]
 8 |   prval (pf1, pf2) = array_v_split{int}{..}{10}{1} (pf)
 9 |   val () = fprint_array_sep (stdout_ref, !p, i2sz(1), ",")
10 |   val () = fprint_newline (stdout_ref)
11 |   val p2 = ptr_add<int> (p, 1)
12 |   val (pf2 | p2) = viewptr_match (pf2 | p2)
13 |   val () = fprint_array_sep (stdout_ref, !p2, i2sz(9), ",")
14 |   val () = fprint_newline (stdout_ref)
15 |   val () = array_ptr_free (array_v_unsplit (pf1, pf2), pfgc | p)
16 | }
17 | 


--------------------------------------------------------------------------------
/ats-screenshot.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/deech/ATSPresentation/bb73c776140409d3cae286a5c0d400e98685ea0b/ats-screenshot.png


--------------------------------------------------------------------------------
/filter_list.dats:
--------------------------------------------------------------------------------
 1 | #include "share/atspre_staload.hats"
 2 | #include "prelude/DATS/pointer.dats"
 3 | #include "share/atspre_staload.hats"
 4 | 
 5 | fun {a:t@ype}
 6 |     list_vt_filter
 7 |      {n: int}
 8 |      (l: !list_vt (a, n), f: a -> bool)
 9 |         :[k: int | k <= n] list_vt (a , k) = let
10 | in
11 |   case+ l of
12 |   | @list_vt_nil () => (fold@ l; list_vt_nil)
13 |   | @list_vt_cons (x, xs) when f (x) =>
14 |        let
15 |          val rest = list_vt_filter(xs,f)
16 |          prval () = lemma_list_vt_param (rest)
17 |          val r = list_vt_cons (x, rest)
18 |        in
19 |          fold@ l;
20 |          r
21 |        end
22 |   | @list_vt_cons (x, xs) =>
23 |        let
24 |          val r = list_vt_filter (xs, f)
25 |        in
26 |          fold@ l;
27 |          r
28 |        end
29 | end
30 | 
31 | fun print_list (l: !List_vt (int)): void =
32 |   case+ l of
33 |     | @list_vt_cons (x, xs) => (
34 |           fprint(stdout_ref, x);
35 |           print_list(xs);
36 |           fold@ l
37 |         )
38 |     | list_vt_nil () => ()
39 | 
40 | implement main0() = {
41 |   val a = list_make_intrange(0,10)
42 |   val b = list_vt_filter(a, lam(x) => x mod 2 = 0)
43 |   val () = print_list(b)
44 |   val () = list_vt_free(a)
45 |   val () = list_vt_free(b)
46 | }


--------------------------------------------------------------------------------
/minimal.dats:
--------------------------------------------------------------------------------
1 | #include "share/atspre_define.hats"
2 | #include "share/atspre_staload.hats"
3 | 
4 | val greet = lam () => "hello world\n"
5 | implement main0 () = print(greet())
6 | 


--------------------------------------------------------------------------------
/presentation.org:
--------------------------------------------------------------------------------
  1 | #+Title: ATS
  2 | #+Author: Aditya Siram
  3 | #+EPRESENT_FRAME_LEVEL: 1
  4 | 
  5 | * ATS
  6 | - Is an ML (not standard)
  7 |   - ADTS, pattern-matching, modules etc.
  8 |   - Same power of abstraction
  9 | - Dependently typed
 10 | - Theorem prover
 11 |   - Inductive, only.
 12 | - Optional GC
 13 | 
 14 | * ATS
 15 | - Linear logic to manage resources
 16 |   - Prove it exists, consume proof, repeat
 17 |   - file handles, sockets, anything
 18 | - But especially memory
 19 |   - Prove pointer is initialized, dereference, repeat
 20 |   - Type checked pointer arithmetic
 21 | 
 22 | * ATS
 23 | - Designed to work without a runtime.
 24 |   - Verified embedded/systems programming
 25 | - All the advantages of C/C++
 26 | - Very easy interop
 27 |   - C -> ATS is trivial
 28 |   - ATS -> C is easier than C++ -> C!
 29 |   - Sneak it in!
 30 | 
 31 | * Performance
 32 | - Performs as well as C/C++
 33 | [[file:ats-screenshot.png]]
 34 | 
 35 | * Performance
 36 | - Run anywhere C runs ...
 37 | - No boxing == zero overhead when setting/getting
 38 | - Unfreed memory == type error
 39 | - Unauthorized reads == type error
 40 | - Unauthorized writes == type error
 41 | - Type error!
 42 | 
 43 | 
 44 | * Hello World
 45 | - Minimal
 46 | #+BEGIN_EXAMPLE
 47 | val greet = lam () => "hello world\n"
 48 | implement main0 () = print(greet())
 49 | #+END_EXAMPLE
 50 | 
 51 | * Swap
 52 | - A standard swap function
 53 | #+BEGIN_SRC
 54 | void swap(void *i, void *j, size_t size) {
 55 |   void* tmp = malloc(size);
 56 |   memcpy(tmp, j, size);
 57 |   memcpy(j, i, size);
 58 |   memcpy(i, tmp, size);
 59 |   free(tmp);
 60 | }
 61 | 
 62 | void main() {
 63 |   int a = 1, b = 2;
 64 |   swap(&a, &b, sizeof(int));
 65 |   printf("After . a: %d, b: %d\n", a, b);
 66 | }
 67 | #+END_SRC
 68 | 
 69 | * Swap From ATS
 70 | - Copy-paste in between =%{^= and =%}=
 71 | #+BEGIN_EXAMPLE
 72 |   %{^
 73 |     void swap(void *i, void *j, size_t size) {
 74 |       void* tmp = malloc(size);
 75 |       memcpy(tmp, j, size);
 76 |       memcpy(j, i, size);
 77 |       memcpy(i, tmp, size);
 78 |       free(tmp);
 79 |     }
 80 |     ...
 81 |   %}
 82 |   ...
 83 | #+END_EXAMPLE
 84 | 
 85 | * Swap From ATS
 86 | - Convert C's =main= function to a runner
 87 | #+BEGIN_EXAMPLE
 88 |   %{^
 89 |     void swap(void *i, void *j, size_t size) {
 90 |       void* tmp = malloc(size);
 91 |       memcpy(tmp, j, size); memcpy(j, i, size); memcpy(i, tmp, size);
 92 |       free(tmp);
 93 |     }
 94 | 
 95 |     void swap_runner() {
 96 |       int a = 1, b = 2;
 97 |       swap(&a, &b, sizeof(int));
 98 |       printf("After . a: %d, b: %d\n", a, b);
 99 |     }
100 |   %}
101 |   ...
102 | #+END_EXAMPLE
103 | 
104 | * Swap From ATS
105 | - Add an ATS wrapper. No runtime overhead.
106 | #+BEGIN_EXAMPLE
107 |   %{^
108 |     void swap(void *i, void *j, size_t size) {
109 |       void* tmp = malloc(size);
110 |       memcpy(tmp, j, size); memcpy(j, i, size); memcpy(i, tmp, size);
111 |       free(tmp);
112 |     }
113 | 
114 |     void swap_runner() {
115 |       int a = 1, b = 2;
116 |       swap(&a, &b, sizeof(int));
117 |       printf("After . a: %d, b: %d\n", a, b);
118 |     }
119 |   %}
120 | 
121 |   extern fun swap_runner():void = "mac#swap_runner"
122 |   ...
123 | #+END_EXAMPLE
124 | 
125 | * Swap From ATS
126 | - Call it.
127 | #+BEGIN_EXAMPLE
128 |   %{^
129 |     void swap(void *i, void *j, size_t size) {
130 |       void* tmp = malloc(size);
131 |       memcpy(tmp, j, size); memcpy(j, i, size); memcpy(i, tmp, size);
132 |       free(tmp);
133 |     }
134 | 
135 |     void swap_runner() {
136 |       int a = 1, b = 2;
137 |       swap(&a, &b, sizeof(int));
138 |       printf("After . a: %d, b: %d\n", a, b);
139 |     }
140 |   %}
141 | 
142 |   extern fun swap_runner():void = "ext#swap_runner"
143 | 
144 |   implement main0 () = swap_runner()
145 | #+END_EXAMPLE
146 | 
147 | * Swap From ATS
148 | #+BEGIN_EXAMPLE
149 |   %{^
150 |   #include ...
151 | 
152 |   void swap(void *i, void *j, size_t size) {
153 |     ...
154 |   }
155 | 
156 |   void swap_runner() {
157 |     int a = 1, b = 2;
158 |     swap(&a, &b, sizeof(int));
159 |     printf("After . a: %d, b: %d\n", a, b);
160 |   }
161 |   %}
162 | 
163 |   extern fun swap_runner():void = "ext#swap_runner"
164 | 
165 |   implement main0 () = swap_runner()
166 | #+END_EXAMPLE
167 | 
168 | - Results
169 | #+BEGIN_EXAMPLE
170 | After a: 2, b: 1
171 | #+END_EXAMPLE
172 | 
173 | * Swap In ATS
174 | - Import unsafe pointer ops.
175 | #+BEGIN_EXAMPLE
176 |   staload UN = "prelude/SATS/unsafe.sats"
177 | #+END_EXAMPLE
178 | 
179 | * Swap In ATS
180 | - Wrap C's =malloc=
181 | #+BEGIN_EXAMPLE
182 |   staload UN = "prelude/SATS/unsafe.sats"
183 |   extern fun malloc (s: size_t): ptr = "mac#malloc"
184 | #+END_EXAMPLE
185 | 
186 | * Swap In ATS
187 | - Wrap C's =free=
188 | #+BEGIN_EXAMPLE
189 |   staload UN = "prelude/SATS/unsafe.sats"
190 |   extern fun malloc (s: size_t): ptr = "mac#malloc"
191 |   extern fun free (p: ptr):void = "mac#free"
192 | #+END_EXAMPLE
193 | 
194 | * Swap In ATS
195 | - Wrap C's =memcpy=
196 | #+BEGIN_EXAMPLE
197 |   staload UN = "prelude/SATS/unsafe.sats"
198 |   extern fun malloc (s: size_t): ptr = "mac#malloc"
199 |   extern fun free (p: ptr):void = "mac#free"
200 |   extern fun memcpy(into: ptr, from: ptr, s: size_t): void = "mac#memcpy"
201 | #+END_EXAMPLE
202 | 
203 | * Swap In ATS
204 | - Swap in ATS
205 | #+BEGIN_EXAMPLE
206 |   staload UN = "prelude/SATS/unsafe.sats"
207 |   extern fun malloc (s: size_t): ptr = "mac#malloc"
208 |   extern fun free (p: ptr):void = "mac#free"
209 |   extern fun memcpy(into: ptr, from: ptr, s: size_t): void = "mac#memcpy"
210 |   fun swap(i: ptr, j: ptr, s: size_t): void = ...
211 | #+END_EXAMPLE
212 | 
213 | * Swap In ATS
214 | - Allocate =tmp= space.
215 | #+BEGIN_EXAMPLE
216 |   staload UN = "prelude/SATS/unsafe.sats"
217 |   extern fun malloc (s: size_t): ptr = "mac#malloc"
218 |   extern fun free (p: ptr):void = "mac#free"
219 |   extern fun memcpy(into: ptr, from: ptr, s: size_t): void = "mac#memcpy"
220 |   fun swap(i: ptr, j: ptr, s: size_t): void = let
221 |     val tmp = malloc(s)
222 |   in
223 | #+END_EXAMPLE
224 | 
225 | * Swap In ATS
226 | - Exactly the same as C version.
227 | #+BEGIN_EXAMPLE
228 |   staload UN = "prelude/SATS/unsafe.sats"
229 |   extern fun malloc (s: size_t): ptr = "mac#malloc"
230 |   extern fun free (p: ptr):void = "mac#free"
231 |   extern fun memcpy(into: ptr, from: ptr, s: size_t): void = "mac#memcpy"
232 |   fun swap(i: ptr, j: ptr, s: size_t): void = let
233 |     val tmp = malloc(s)
234 |   in
235 |      memcpy(tmp,j,s); memcpy(j,i,s); memcpy(i,tmp,s);
236 |      free(tmp);
237 |   end
238 | #+END_EXAMPLE
239 | 
240 | * Swap In ATS
241 | - Allocate
242 | #+BEGIN_EXAMPLE
243 |   implement main0 () = let
244 |     val i = malloc(sizeof<double>) // !!!!!!
245 |     val j = malloc(sizeof<int>)
246 |   in
247 |    ...
248 | #+END_EXAMPLE
249 | 
250 | * Swap In ATS
251 | - Initialize
252 | #+BEGIN_EXAMPLE
253 |   implement main0 () = let
254 |     val i = malloc(sizeof<double>) // !!!!!
255 |     val j = malloc(sizeof<int>)
256 |   in
257 |     $UN.ptr0_set<int>(i, 1);
258 |     $UN.ptr0_set<int>(j, 2);
259 |     ...
260 | #+END_EXAMPLE
261 | 
262 | * Swap In ATS
263 | - Swap
264 | #+BEGIN_EXAMPLE
265 |   implement main0 () = let
266 |     val i = malloc(sizeof<double>) // !!!!!
267 |     val j = malloc(sizeof<int>)
268 |   in
269 |     $UN.ptr0_set<int>(i, 1);
270 |     $UN.ptr0_set<int>(j, 2);
271 |     swap(i,j,int);
272 |     ...
273 | #+END_EXAMPLE
274 | 
275 | * Swap In ATS
276 | - Print
277 | #+BEGIN_EXAMPLE
278 |   implement main0 () = let
279 |     val i = malloc(sizeof<double>) // !!!!!
280 |     val j = malloc(sizeof<int>)
281 |   in
282 |     $UN.ptr0_set<int>(i, 1);
283 |     $UN.ptr0_set<int>(j, 2);
284 |     swap(i,j,int);
285 |     print($UN.ptr0_get<int>(i)); print("\n");
286 |     print($UN.ptr0_get<int>(j)); print("\n");
287 |     ...
288 | #+END_EXAMPLE
289 | 
290 | * Swap In ATS
291 | - Free
292 | #+BEGIN_EXAMPLE
293 |   implement main0 () = let
294 |     val i = malloc(sizeof<double>) // !!!!!
295 |     val j = malloc(sizeof<int>)
296 |   in
297 |     $UN.ptr0_set<int>(i, 1);
298 |     $UN.ptr0_set<int>(j, 2);
299 |     swap(i,j,int);
300 |     print($UN.ptr0_get<int>(i)); print("\n");
301 |     print($UN.ptr0_get<int>(j)); print("\n");
302 |     free(i)    // free(j) ?!!!!
303 | #+END_EXAMPLE
304 | 
305 | * Swap In ATS
306 | - Can totally mimic C
307 | - Including the bugs
308 | - Gradual migration
309 | 
310 | * A safer malloc/free
311 | #+BEGIN_EXAMPLE
312 |   extern fun malloc    extern fun malloc
313 |                          {a:t@ype}              <--
314 |     (s: size_t)     =>   (s:sizeof_t a)
315 |                            :[l:addr | l > null]
316 |       :ptr =                (a? @ l | ptr l) =
317 |     "mac#malloc"         "mac#malloc"
318 | #+END_EXAMPLE
319 | - For all types =a=, of *sort* =t@ype= (unboxed type)
320 | 
321 | * A safer malloc/free
322 | #+BEGIN_EXAMPLE
323 |   extern fun malloc    extern fun malloc
324 |                          {a:t@ype}
325 |     (s: size_t)     =>   (s:sizeof_t a)         <--
326 |                            :[l:addr | l > null]
327 |       :ptr =                (a? @ l | ptr l) =
328 |     "mac#malloc"         "mac#malloc"
329 | #+END_EXAMPLE
330 | - Given =sizeof_t= of *sort* =a=
331 | 
332 | * A safer malloc/free
333 | #+BEGIN_EXAMPLE
334 |   extern fun malloc    extern fun malloc
335 |                          {a:t@ype}
336 |     (s: size_t)     =>   (s:sizeof_t a)
337 |                            :[l:addr | l > null] <--
338 |       :ptr =                (a? @ l | ptr l) =  <--
339 |     "mac#malloc"         "mac#malloc"
340 | #+END_EXAMPLE
341 | - Returns
342 |   - proof that =a= (uninitialized) is at =l=
343 |   - pointer to some non-null address =l=
344 | 
345 | * A safer malloc/free
346 | #+BEGIN_EXAMPLE
347 |   extern fun free    extern fun free
348 |                        {a:t@ype}            <--
349 |                   =>   {l : addr| l > null} <--
350 |     (p: ptr)           (a @ l | ptr l)
351 |       :void =            :void =
352 |     "mac#free"         "mac#free"
353 | #+END_EXAMPLE
354 | - For all types =a=, of *sort* =t@ype= (unboxed)
355 | - For all non-null addresses, =l=
356 | 
357 | * A safer malloc/free
358 | #+BEGIN_EXAMPLE
359 |   extern fun free    extern fun free
360 |                        {a:t@ype}
361 |                   =>   {l : addr| l > null}
362 |     (p: ptr)           (a @ l | ptr l)      <--
363 |       :void =            :void =
364 |     "mac#free"         "mac#free"
365 | #+END_EXAMPLE
366 | - Given
367 |   - proof that =a= (initialized) is at some non-null =l=
368 |   - pointer to =l=
369 | 
370 | * A safer malloc/free
371 | #+BEGIN_EXAMPLE
372 |   extern fun free    extern fun free
373 |                        {a:t@ype}
374 |                   =>   {l : addr| l > null}
375 |     (p: ptr)           (a @ l | ptr l)
376 |       :void =            :void =            <--
377 |     "mac#free"         "mac#free"
378 | #+END_EXAMPLE
379 | - /Consumes/ proof, returns nothing
380 | 
381 | * A safer malloc/free
382 | - Example usage
383 | #+BEGIN_EXAMPLE
384 | implement main0 () = let
385 |   val (pf | a) = malloc (sizeof<int>)
386 | in
387 |   free(pf | a);
388 | end
389 | #+END_EXAMPLE
390 | - Allocate, retrive proof via pattern-matching
391 | - Free, using that proof
392 | 
393 | * A safer malloc/free
394 | - `a` is not freed. Unconsumed proof in scope.
395 | #+BEGIN_EXAMPLE
396 | implement main0 () = let
397 |   val (pf | a) = malloc (sizeof<int>)
398 | in
399 |   ()       // type error!
400 | end
401 | #+END_EXAMPLE
402 | 
403 | * A safer malloc/free
404 | - `free` not given proof that `a` is initialized
405 | #+BEGIN_EXAMPLE
406 | implement main0 () = let
407 |   val (pf | a) = malloc (sizeof<int>)
408 | in
409 |   free(a); // type error!
410 | end
411 | #+END_EXAMPLE
412 | 
413 | * A safer swap
414 | #+BEGIN_EXAMPLE
415 |   fun swap            extern fun swap
416 |                         {a:t@ype}
417 |                         {l1: addr | l1 > null}
418 |                   =>    {l2: addr | l2 > null}
419 |                         (a @ l1 , a @ l2 |
420 |       (i: ptr,             i:ptr l1,
421 |        j: ptr,             j:ptr l2,
422 |        s: size_t):         s:sizeof_t a):
423 |       void = ...          (a @ l1, a @ l2 | void) = ...
424 | #+END_EXAMPLE
425 | - Like =free=, expect with 2 proofs & pointers
426 | 
427 | * A safer swap
428 | - Allocate, retrieve proofs
429 | #+BEGIN_EXAMPLE
430 | implement main0 () = let
431 |   val (pfi | i) = malloc (sizeof<int>)
432 |   val (pfj | j) = malloc (sizeof<int>)
433 |   ...
434 | #+END_EXAMPLE
435 | 
436 | * A safer swap
437 | - Initialize, passing proofs to setter.
438 | #+BEGIN_EXAMPLE
439 | implement main0 () = let
440 |   val (pfi | i) = malloc (sizeof<int>)
441 |   val (pfj | j) = malloc (sizeof<int>)
442 |   val _ = ptr_set(pfi | i, 1)
443 |   val _ = ptr_set(pfj | j, 2)
444 |   ...
445 | #+END_EXAMPLE
446 | 
447 | * A safer swap
448 | - Swap, returns *new* proofs.
449 | #+BEGIN_EXAMPLE
450 | implement main0 () = let
451 |   val (pfi | i) = malloc (sizeof<int>)
452 |   val (pfj | j) = malloc (sizeof<int>)
453 |   val _ = ptr_set(pfi | i, 1)
454 |   val _ = ptr_set(pfj | j, 2)
455 |   val (pfi1,pfj1| ()) = swap(pfi, pfj | i, j, sizeof<int>)
456 | in
457 |   ...
458 | #+END_EXAMPLE
459 | 
460 | * A safer swap
461 | - Free, using new proofs.
462 | #+BEGIN_EXAMPLE
463 | implement main0 () = let
464 |   val (pfi | i) = malloc (sizeof<int>)
465 |   val (pfj | j) = malloc (sizeof<int>)
466 |   val _ = ptr_set(pfi | i, 1)
467 |   val _ = ptr_set(pfj | j, 2)
468 |   val (pfi1,pfj1| ()) = swap(pfi, pfj | i, j, sizeof<int>)
469 | in
470 |   ...
471 |   free(pfi1 | i);
472 |   free(pfj1 | j);
473 | end
474 | #+END_EXAMPLE
475 | * Printing a List
476 | - The runner
477 | #+BEGIN_EXAMPLE
478 | implement main0() = {
479 |   val a = list_make_intrange(0,10)
480 |   val () = print_list (a)
481 |   val () = list_vt_free (a)
482 | }
483 | #+END_EXAMPLE
484 | - The [0 .. 9] is allocated on the heap
485 | * First attempt
486 | - Pattern match on a non-empty list
487 | #+BEGIN_EXAMPLE
488 | fun print_list (l: List_vt (int)): void =
489 |   case+ l of
490 |   | list_vt_cons (x, xs) => (
491 | #+END_EXAMPLE
492 | * First attempt
493 | - Print and recurse
494 | #+BEGIN_EXAMPLE
495 | fun print_list (l: List_vt (int)): void =
496 |   case+ l of
497 |   | list_vt_cons (x, xs) => (
498 |      fprint(stdout_ref, x);
499 |      print_list(xs)
500 |     )
501 | #+END_EXAMPLE
502 | 
503 | * First attempt
504 | - If nil, do nothing
505 | #+BEGIN_EXAMPLE
506 | fun print_list (l: List_vt (int)): void =
507 |   case+ l of
508 |   | list_vt_cons (x, xs) => (
509 |      fprint(stdout_ref, x);
510 |      print_list(xs)
511 |     )
512 |   | list_vt_nil () => ()
513 | #+END_EXAMPLE
514 | 
515 | * First attempt
516 |  - Compiler error!
517 |  - Remember the list is a set of resources
518 |  - Pattern matching dereferences the head
519 |    - consumes the resource!
520 |  - Freeing fails!
521 |     #+BEGIN_EXAMPLE
522 |     val () = list_vt_free(a)
523 |     #+END_EXAMPLE
524 | 
525 | * Final Attempt
526 | - A very /special/ function, =fold@=
527 | - Pattern-matching unfolds the list
528 | - =fold@= unconsumes the proof.
529 | 
530 | * Final Attempt
531 | - This works.
532 | #+BEGIN_EXAMPLE
533 | fun print_list ...
534 |   case+ l of
535 |     | @list_vt_cons (x, xs) => (
536 |           .. // print and recurse
537 |           fold@ l
538 |         )
539 |     | list_vt_nil () => ()
540 | #+END_EXAMPLE
541 | 
542 | * Filter
543 | - Pattern match nil, note =fold@=
544 | #+BEGIN_EXAMPLE
545 |   case+ l of
546 |   | @list_vt_nil () => (fold@ l; list_vt_nil)
547 | #+END_EXAMPLE
548 | - Non-tail recursive, just the body for now
549 | -
550 | * Filter
551 | - Pattern match the =cons= case, note the =f(x)= guard
552 | #+BEGIN_EXAMPLE
553 |   case+ l of
554 |   | @list_vt_nil () => (fold@ l; list_vt_nil)
555 |   | @list_vt_cons (x, xs) when f (x) =>
556 | #+END_EXAMPLE
557 | 
558 | * Filter
559 | - Recurse on the rest of the list
560 | #+BEGIN_EXAMPLE
561 |   case+ l of
562 |   | @list_vt_nil () => (fold@ l; list_vt_nil)
563 |   | @list_vt_cons (x, xs) when f (x) => let
564 |          val rest = list_vt_filter(xs,f)
565 | #+END_EXAMPLE
566 | 
567 | * Filter
568 | - For some reason this lemma is needed, ¯\_(ツ)_/¯
569 | #+BEGIN_EXAMPLE
570 |   case+ l of
571 |   | @list_vt_nil () => (fold@ l; list_vt_nil)
572 |   | @list_vt_cons (x, xs) when f (x) => let
573 |          val rest = list_vt_filter(xs,f)
574 |          prval () = lemma_list_vt_param (rest)
575 | #+END_EXAMPLE
576 | 
577 | * Filter
578 | - Recreate the list
579 | #+BEGIN_EXAMPLE
580 |   case+ l of
581 |   | @list_vt_nil () => (fold@ l; list_vt_nil)
582 |   | @list_vt_cons (x, xs) when f (x) => let
583 |          val rest = list_vt_filter(xs,f)
584 |          prval () = lemma_list_vt_param (rest)
585 |          val r = list_vt_cons (x, rest)
586 |        in
587 |          fold@ l;
588 |          r
589 |        end
590 | #+END_EXAMPLE
591 | 
592 | * Filter
593 | - Re-inject the proof that =l= is untouched, return =r=
594 | #+BEGIN_EXAMPLE
595 |   case+ l of
596 |   | @list_vt_nil () => (fold@ l; list_vt_nil)
597 |   | @list_vt_cons (x, xs) when f (x) => let
598 |          val rest = list_vt_filter(xs,f)
599 |          prval () = lemma_list_vt_param (rest)
600 |          val r = list_vt_cons (x, rest)
601 |        in
602 |          fold@ l; r
603 |        end
604 | #+END_EXAMPLE
605 | 
606 | * Filter
607 | - Now type signature
608 | #+BEGIN_EXAMPLE
609 | fun {a:t@ype}                <--
610 |     list_vt_filter
611 |      {n: int}
612 |      (l: !list_vt (a, n),
613 |       f: a -> bool)
614 |         :[k: int | k <= n]
615 |          list_vt (a , k) = ...
616 | #+END_EXAMPLE
617 | - =a= is any unboxed type
618 |   - like =malloc=, =free=, etc
619 | 
620 | * Filter
621 | - Now type signature
622 | #+BEGIN_EXAMPLE
623 | fun {a:t@ype}
624 |     list_vt_filter
625 |      {n: int}                 <--
626 |      (l: !list_vt (a, n),
627 |       f: a -> bool)
628 |         :[k: int | k <= n]
629 |          list_vt (a , k) = ...
630 | #+END_EXAMPLE
631 | - any integer
632 | 
633 | * Filter
634 | - Now type signature
635 | #+BEGIN_EXAMPLE
636 | fun {a:t@ype}
637 |     list_vt_filter
638 |      {n: int}
639 |      (l: !list_vt (a, n),     <--
640 |       f: a -> bool)
641 |         :[k: int | k <= n]
642 |          list_vt (a , k) = ...
643 | #+END_EXAMPLE
644 | - =list_vt= is a viewtype
645 |   - Something of type =a=
646 |   - paired with pointer (unseen)
647 |   - Of length =n=
648 | * Filter
649 | - Now type signature
650 | #+BEGIN_EXAMPLE
651 | fun {a:t@ype}
652 |     list_vt_filter
653 |      {n: int}
654 |      (l: !list_vt (a, n),
655 |       f: a -> bool)          <--
656 |         :[k: int | k <= n]
657 |          list_vt (a , k) = ...
658 | #+END_EXAMPLE
659 | - The predicate function
660 | 
661 | * Filter
662 | - Now type signature
663 | #+BEGIN_EXAMPLE
664 | fun {a:t@ype}
665 |     list_vt_filter
666 |      {n: int}
667 |      (l: !list_vt (a, n),
668 |       f: a -> bool)
669 |         :[k: int | k <= n]  <--
670 |          list_vt (a , k) =  <--
671 | #+END_EXAMPLE
672 | - Returns a list
673 |   - *statically* proven to be <= n!
674 | 
675 | * Filter
676 | - The  =list_vt_cons= pattern-match:
677 |   - =list_vt_cons(x, xs)=
678 |   - subtracts n by one on every pattern-match
679 | - The solver can figure out the rest!
680 | * Resources
681 | - Chris Double's Blog: http://bluishcoder.co.nz/tags/ats/index.html
682 | - The ATS Book
683 |   - http://ats-lang.sourceforge.net/DOCUMENT/INT2PROGINATS/HTML/book1.html
684 | - ATS Google Group
685 |   - https://groups.google.com/forum/#!forum/ats-lang-users
686 | 


--------------------------------------------------------------------------------
/print_list.dats:
--------------------------------------------------------------------------------
 1 | #include "share/atspre_staload.hats"
 2 | #include "prelude/DATS/pointer.dats"
 3 | #include "share/atspre_staload.hats"
 4 | 
 5 | // fun print_list (l: List_vt (int)): void =
 6 | //   case+ l of
 7 | //   | list_vt_cons (x, xs) => (
 8 | //     fprint(stdout_ref, x);
 9 | //     print_list(xs)
10 | //   )
11 | //   | list_vt_nil () => ()
12 | 
13 | fun print_list (l: List_vt (int)): void =
14 |   case+ l of
15 |     | @list_vt_cons (x, xs) => (
16 |           fprint(stdout_ref, x);
17 |           print_list(xs);
18 |           fold@ l
19 |         )
20 |     | list_vt_nil () => ()
21 | 
22 | implement main0() = {
23 |   val a = list_make_intrange(0,10)
24 |   val () = print_list (a)
25 |   val () = list_vt_free (a)
26 | }


--------------------------------------------------------------------------------
/proof_functions.dats:
--------------------------------------------------------------------------------
 1 | #include "share/atspre_define.hats"
 2 | #include "share/atspre_staload.hats"
 3 | #include "prelude/DATS/pointer.dats"
 4 | 
 5 | %{^
 6 |   void my_ptr_set(int *i, int j) {
 7 |     *i = j;
 8 |   }
 9 |   int my_ptr_get(int *i) {
10 |     return *i;
11 |   }
12 | %}
13 | 
14 | extern fun malloc{a:t@ype}(s:sizeof_t a):
15 |                  [l:addr | l > null](a? @ l | ptr l) = "mac#malloc"
16 | extern fun free{a:t@ype}{l : addr| l > null}(a @ l | ptr l):
17 |                  void = "mac#free"
18 | 
19 | extern fun my_ptr_set
20 |  {l:addr | l > null}
21 |  (pf: int? @ l | p: ptr l, x: int)
22 |    :(int @ l | void) =
23 |  "mac#my_ptr_set"
24 | 
25 | extern fun my_ptr_get
26 |  {l:addr | l > null}
27 |  (pf : int @ l | p : ptr l)
28 |    :(int @ l | int) =
29 |  "mac#my_ptr_get"
30 | 
31 | implement main0 () = let
32 |   val (pf | i) = malloc(sizeof<int>)
33 |   val (pf1 | _) = my_ptr_set(pf | i, 10)
34 |   val (pf2 | ii) = my_ptr_get(pf1 | i)
35 | in
36 |   print(ii);
37 |   free(pf2 | i);
38 | end
39 | 


--------------------------------------------------------------------------------
/safe_malloc.dats:
--------------------------------------------------------------------------------
 1 | #include "share/atspre_define.hats"
 2 | #include "share/atspre_staload.hats"
 3 | #include "prelude/DATS/pointer.dats"
 4 | 
 5 | extern fun malloc{a:t@ype}(s:sizeof_t a):
 6 |                  [l:addr | l > null](a? @ l | ptr l) = "mac#malloc"
 7 | extern fun free{a:t@ype}{l : addr| l > null}(a @ l | ptr l):
 8 |                  void = "mac#free"
 9 | implement main0 () = let
10 |   val (pf | a) = malloc (sizeof<int>)
11 |   val _ = ptr_set(pf | a, 10)
12 |   val x = ptr_get(pf | a)
13 |   val y = x + 1
14 | in
15 |   free(pf | a);
16 | end


--------------------------------------------------------------------------------
/safe_swap.dats:
--------------------------------------------------------------------------------
 1 | #include "share/atspre_define.hats"
 2 | #include "share/atspre_staload.hats"
 3 | #include "prelude/DATS/pointer.dats"
 4 | 
 5 | %{^
 6 | #include <stdio.h>
 7 | #include <stdlib.h>
 8 | #include <string.h>
 9 | 
10 | void swap(void *i, void *j, size_t size) {
11 |   void* tmp = malloc(size);
12 |   memcpy(tmp, j, size);
13 |   memcpy(j, i, size);
14 |   memcpy(i, tmp, size);
15 |   free(tmp);
16 | }
17 | %}
18 | 
19 | extern fun malloc{a:t@ype}(s:sizeof_t a):
20 |                  [l:addr | l > null](a? @ l | ptr l) = "mac#malloc"
21 | extern fun free{a:t@ype}{l : addr| l > null}(a @ l | ptr l):
22 |                  void = "mac#free"
23 | extern fun swap
24 |   {a:t@ype}
25 |   {l1: addr | l1 > null}
26 |   {l2: addr | l2 > null}
27 |   (a @ l1 , a @ l2 | i : ptr l1, j : ptr l2, s: sizeof_t a):
28 |     (a @ l1, a @ l2 | void) = "mac#swap"
29 | 
30 | implement main0 () = let
31 |   val (pfi | i) = malloc (sizeof<int>)
32 |   val (pfj | j) = malloc (sizeof<int>)
33 |   val _ = ptr_set(pfi | i, 1)
34 |   val _ = ptr_set(pfj | j, 2)
35 |   val (pfi1,pfj1| ()) = swap(pfi, pfj | i, j, sizeof<int>)
36 | in
37 |   print(ptr_get<int>(pfi1 | i));
38 |   print(ptr_get<int>(pfj1 | j));
39 |   free(pfi1 | i);
40 |   free(pfj1 | j);
41 | end


--------------------------------------------------------------------------------
/swap.c:
--------------------------------------------------------------------------------
 1 | /**
 2 |    gcc swap.c -o swap
 3 |  */
 4 | 
 5 | #include <stdio.h>
 6 | #include <stdlib.h>
 7 | #include <string.h>
 8 | 
 9 | void swap(void *i, void *j, size_t size) {
10 |   void* tmp = malloc(size);
11 |   memcpy(tmp, j, size);
12 |   memcpy(j, i, size);
13 |   memcpy(i, tmp, size);
14 |   free(tmp);
15 | }
16 | 
17 | void main() {
18 |   int a = 1, b = 2;
19 |   swap(&a, &b, sizeof(int));
20 |   printf("After . a: %d, b: %d\n", a, b);
21 | }
22 | 


--------------------------------------------------------------------------------
/swap_from_ats.dats:
--------------------------------------------------------------------------------
 1 | #include "share/atspre_define.hats"
 2 | #include "share/atspre_staload.hats"
 3 | staload UN = "prelude/SATS/unsafe.sats"
 4 | 
 5 | extern fun malloc (s: size_t): ptr = "mac#malloc"
 6 | extern fun free (p: ptr):void = "mac#free"
 7 | extern fun memcpy(into: ptr, from: ptr, s: size_t): void = "mac#memcpy"
 8 | 
 9 | fun swap(i: ptr, j: ptr, s: size_t): void = let
10 |    val tmp = malloc(s)
11 | in
12 |    memcpy(tmp,j,s);
13 |    memcpy(j,i,s);
14 |    memcpy(i,tmp,s);
15 |    free(tmp);
16 | end
17 | 
18 | implement main0 () = let
19 |   val i = malloc(sizeof<double>)
20 |   val j = malloc(sizeof<int>)
21 | in
22 |   $UN.ptr0_set<int>(i, 1);
23 |   $UN.ptr0_set<int>(j, 2);
24 |   swap(i,j,sizeof<int>);
25 |   print($UN.ptr0_get<int> (i));
26 |   print("\n");
27 |   print($UN.ptr0_get<int> (j));
28 |   print("\n");
29 |   free(i);
30 |   // free(j);
31 | end


--------------------------------------------------------------------------------
/swap_runner.dats:
--------------------------------------------------------------------------------
 1 | #include "share/atspre_define.hats"
 2 | #include "share/atspre_staload.hats"
 3 | 
 4 | %{^
 5 | #include <stdio.h>
 6 | #include <stdlib.h>
 7 | #include <string.h>
 8 | 
 9 | void swap(void *i, void *j, size_t size) {
10 |   void* tmp = malloc(size);
11 |   memcpy(tmp, j, size);
12 |   memcpy(j, i, size);
13 |   memcpy(i, tmp, size);
14 |   free(tmp);
15 | }
16 | 
17 | void swap_runner() {
18 |   int a = 1, b = 2;
19 |   swap(&a, &b, sizeof(int));
20 |   printf("After . a: %d, b: %d\n", a, b);
21 | }
22 | %}
23 | 
24 | extern fun swap_runner():void = "mac#swap_runner"
25 | 
26 | implement main0 () = swap_runner()


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