├── .atsfmt.toml ├── .ctags ├── .gitignore ├── .travis.yml ├── DATS ├── recursive.dats ├── recursive_list0.dats ├── recursive_list_prf.dats └── recursive_prf.dats ├── LICENSE ├── README.md ├── SATS ├── recursive.sats └── recursive_prf.sats ├── TODO.md ├── atspkg.dhall ├── docs └── paper.tex ├── pkg.dhall └── test ├── calc.dats └── recursion.dats /.atsfmt.toml: -------------------------------------------------------------------------------- 1 | ribbon = 1.0 # maximum ribbon fraction 2 | width = 120 # maximum width 3 | clang-format = false 4 | -------------------------------------------------------------------------------- /.ctags: -------------------------------------------------------------------------------- 1 | --langdef=ATS 2 | --langmap=ATS:.dats 3 | --langmap=ATS:+.sats 4 | --regex-ATS=/^fun *([[:lower:]][[:alnum:]_]+)[[:blank:]]*[\(\[\{)]/\1/f,function/ 5 | --regex-ATS=/^fn *([[:lower:]][[:alnum:]_]+)[[:blank:]]*[\(\[\{)]/\1/f,function/ 6 | --regex-ATS=/^prfun *([[:lower:]][[:alnum:]_]+)[[:blank:]]*[\(\[\{)]/\1/f,function/ 7 | --regex-ATS=/^prfn *([[:lower:]][[:alnum:]_]+)[[:blank:]]*[\(\[\{)]/\1/f,function/ 8 | --regex-ATS=/^fnx *([[:lower:]][[:alnum:]_]+)[[:blank:]]*[\(\[\{)]/\1/f,function/ 9 | --regex-ATS=/^and *([[:lower:]][[:alnum:]_]+)[[:blank:]]*[\(\[\{)]/\1/f,function/ 10 | --regex-ATS=/^praxi *([[:lower:]][[:alnum:]_]+)[[:blank:]]*[\(\[\{)]/\1/p,proof/ 11 | --regex-ATS=/^prval *([[:lower:]][[:alnum:]_]+)[[:blank:]]*[\(\[\{)]/\1/p,proof/ 12 | --regex-ATS=/^typedef *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,type/ 13 | --regex-ATS=/^datatype *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,type/ 14 | --regex-ATS=/^sortdef *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,type/ 15 | --regex-ATS=/^propdef *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,type/ 16 | --regex-ATS=/^viewtypedef *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,type/ 17 | --regex-ATS=/^vtypedef *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,type/ 18 | --regex-ATS=/^dataviewtype *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,type/ 19 | --regex-ATS=/^dataview *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,type/ 20 | --regex-ATS=/^datavtype *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,type/ 21 | --regex-ATS=/^dataprop *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,proof/ 22 | --regex-ATS=/^dataviewprop *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,proof/ 23 | --regex-ATS=/^absvtype *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,proof/ 24 | --regex-ATS=/^abstype *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,proof/ 25 | --regex-ATS=/^absprop *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,proof/ 26 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | tags 2 | .atspkg 3 | target 4 | *.c 5 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | --- 2 | language: c 3 | cache: 4 | directories: 5 | - $HOME/.atspkg 6 | install: 7 | - mkdir -p $HOME/.local/bin 8 | - curl -sSl https://raw.githubusercontent.com/vmchale/atspkg/master/bash/install.sh | sh -s 9 | - export PATH=$HOME/.local/bin:$PATH 10 | - atspkg -V 11 | script: 12 | - curl -sL https://raw.githubusercontent.com/vmchale/tomlcheck/master/sh/check | sh -s .atsfmt.toml 13 | - travis_wait 40 atspkg test -vv 14 | -------------------------------------------------------------------------------- /DATS/recursive.dats: -------------------------------------------------------------------------------- 1 | staload "SATS/recursive.sats" 2 | staload "$PATSHOMELOCS/either-0.2.5/either.sats" 3 | 4 | implement {a}{b} cata (f, x) = 5 | f(map(lam x0 => cata(f, x0), project(x))) 6 | 7 | implement {a}{b} ana (f, x) = 8 | embed(map(lam x0 => ana(f, x0), f(x))) 9 | 10 | implement {a}{b}{x} hylo (f, g, x) = 11 | f(map(lam x0 => hylo(f, g, x0), g(x))) 12 | 13 | implement {a}{b}{x} elgot (f, g, x) = 14 | either_(lam x0 => x0, lam x0 => f(map(lam y0 => elgot(f, g, y0), x0)), g(x)) 15 | -------------------------------------------------------------------------------- /DATS/recursive_list0.dats: -------------------------------------------------------------------------------- 1 | staload "SATS/recursive.sats" 2 | staload "libats/ML/SATS/basis.sats" 3 | 4 | datatype list0f(a: t@ype, x: t@ype+) = 5 | | list0_consf of (a, x) 6 | | list0_nilf of () 7 | 8 | absimpl base_functor_type(a: t@ype, x: t@ype) = list0f(a, x) 9 | absimpl recursive_functor_type(a: t@ype) = list0(a) 10 | 11 | implement {a} embed (x) = 12 | case+ x of 13 | | list0_consf (y, ys) => list0_cons(y, ys) 14 | | list0_nilf() => list0_nil() 15 | 16 | implement {a} project (x) = 17 | case+ x of 18 | | list0_cons (y, ys) => list0_consf(y, ys) 19 | | list0_nil() => list0_nilf() 20 | 21 | implement {x1}{x0}{a} map (f, x) = 22 | case+ x of 23 | | list0_consf (x, xs) => list0_consf(x, f(xs)) 24 | | list0_nilf() => list0_nilf() 25 | -------------------------------------------------------------------------------- /DATS/recursive_list_prf.dats: -------------------------------------------------------------------------------- 1 | dataprop LIST_PROP(A: prop, int) = 2 | | LIST_PROP_NIL(A, 0) of () 3 | | { n : nat | n > 0 } LIST_PROP_CONS(A, n) of (A, LIST_PROP(A, n - 1)) 4 | 5 | dataprop LISTF_PROP(A: prop, B: prop) = 6 | | LISTF_PROP_NIL(A, B) 7 | | LISTF_PROP_CONS(A, B) of (A, B) 8 | 9 | dataview list_v(a: view, int) = 10 | | list_v_nil(a, 0) of () 11 | | { n : nat | n > 0 } list_v_cons(a, n) of (a, list_v(a, n-1)) 12 | 13 | dataview list_vf(a: view, b: view) = 14 | | list_v_nilf(a, b) 15 | | list_v_consf(a, b) of (a, b) 16 | 17 | absimpl FUNCTOR_PROP(A, n) = LIST_PROP(A, n) 18 | absimpl BASE_FUNCTOR_PROP(A, B) = LISTF_PROP(A, B) 19 | 20 | primplmnt {a}{b} STOP = 21 | LISTF_PROP_NIL 22 | 23 | absimpl functor_v(a, n) = list_v(a, n) 24 | absimpl base_functor_v(a, n) = list_vf(a, n) 25 | 26 | primplmnt {a}{b} stop_v () = 27 | list_v_nilf() 28 | 29 | primplmnt map_v (f, xs) = 30 | case+ xs of 31 | | list_v_nilf() => list_v_nilf() 32 | | list_v_consf (y, ys) => list_v_consf(y,f(ys)) 33 | 34 | primplmnt {a} project_v (a) = 35 | case+ a of 36 | | list_v_nil() => list_v_nilf() 37 | | list_v_cons (b, bs) => list_v_consf(b,bs) 38 | 39 | primplmnt MAP (F, XS) = 40 | case+ XS of 41 | | LISTF_PROP_NIL() => LISTF_PROP_NIL() 42 | | LISTF_PROP_CONS (Y, YS) => LISTF_PROP_CONS(Y,F(YS)) 43 | 44 | primplmnt {A} PROJECT (A) = 45 | case+ A of 46 | | LIST_PROP_NIL() => LISTF_PROP_NIL() 47 | | LIST_PROP_CONS (B, BS) => LISTF_PROP_CONS(B,BS) 48 | -------------------------------------------------------------------------------- /DATS/recursive_prf.dats: -------------------------------------------------------------------------------- 1 | staload "SATS/recursive_prf.sats" 2 | 3 | // Proof-level catamorphism 4 | prfun {A:prop}{B:prop} CATA {n:nat} .. (F : ALGEBRA(A, B), A : FUNCTOR_PROP(A, n)) : B = 5 | sif n == 0 then 6 | F(STOP) 7 | else 8 | F(MAP(lam A0 = CATA(F,A0),PROJECT(A))) 9 | 10 | prfun {a:view}{b:view} cata_v {n:nat} .. (f : algebra_v(a, b), a : functor_v(a, n)) : b = 11 | sif n == 0 then 12 | let 13 | prval () = gfree_v(a) 14 | in 15 | f(stop_v()) 16 | end 17 | else 18 | f(map_v(lam a0 = cata_v(f,a0),project_v(a))) 19 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Vanessa McHale (c) 2018-2020 2 | 3 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 4 | 5 | 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 6 | 7 | 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. 8 | 9 | 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. 10 | 11 | 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. 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # recursion 2 | 3 | [![Build Status](https://travis-ci.org/vmchale/recursion.svg?branch=master)](https://travis-ci.org/vmchale/recusion) 4 | 5 | ## Example 6 | 7 | Sum a list of integers using a catamorphism: 8 | 9 | ```ats 10 | staload "SATS/recursive.sats" 11 | 12 | #include "DATS/recursive.dats" 13 | #include "DATS/recursive_list0.dats" 14 | 15 | fun sum(is : list0(int)) : int = 16 | let 17 | fn go(i : list0f(int, int)) : int = 18 | case+ i of 19 | | list0_consf (x, xs) => x + xs 20 | | list0_nilf() => 0 21 | in 22 | cata(lam x0 = go(x0), is) 23 | end 24 | ``` 25 | -------------------------------------------------------------------------------- /SATS/recursive.sats: -------------------------------------------------------------------------------- 1 | staload "$PATSHOMELOCS/either-0.2.5/either.sats" 2 | 3 | abstype recursive_functor_type(t@ype+) = ptr 4 | abstype base_functor_type(t@ype, t@ype+) = ptr 5 | 6 | typedef recursive_functor(a: t@ype) = recursive_functor_type(a) 7 | typedef base_functor(a: t@ype, x: t@ype) = base_functor_type(a, x) 8 | typedef algebra(a: t@ype, x: t@ype) = base_functor(a, x) - x 9 | typedef coalgebra(a: t@ype, x: t@ype) = x - base_functor(a, x) 10 | typedef elgot_coalgebra(a: t@ype, b: t@ype, x: t@ype) = x - either(b, base_functor(a,x)) 11 | 12 | // Projection 13 | fun {a:t@ype} project (recursive_functor(a)) : base_functor(a, recursive_functor(a)) 14 | 15 | // Embdedding 16 | fun {a:t@ype} embed (base_functor(a,recursive_functor(a))) : recursive_functor(a) 17 | 18 | // A catamorphism 19 | fun {a:t@ype}{b:t@ype} cata (algebra(a,b), recursive_functor(a)) : b 20 | 21 | // An anamorphism 22 | fun {a:t@ype}{b:t@ype} ana (coalgebra(b,a), a) : recursive_functor(b) 23 | 24 | // A hylomorphism 25 | fun {a:t@ype}{b:t@ype}{x:t@ype} hylo (algebra(x,b), coalgebra(x,a), a) : b 26 | 27 | // An Elgot algebra 28 | fun {a:t@ype}{b:t@ype}{x:t@ype} elgot (algebra(x,a), elgot_coalgebra(x,a,b), b) : a 29 | 30 | // Lift a function using a functor 31 | fun {a:t@ype}{x0:t@ype}{x1:t@ype} map (x0 - x1, base_functor(a,x0)) : base_functor(a, x1) 32 | -------------------------------------------------------------------------------- /SATS/recursive_prf.sats: -------------------------------------------------------------------------------- 1 | // Functorial proofs in ATS 2 | absprop FUNCTOR_PROP (A : prop, n : int) 3 | 4 | absprop BASE_FUNCTOR_PROP (A : prop, B : prop) 5 | 6 | absview functor_v(a: view, n: int) 7 | 8 | absview base_functor_v(a: view, b: view) 9 | 10 | prfn MAP {A:prop}{B:prop}{C:prop} (F : B - C, X : BASE_FUNCTOR_PROP(A, B)) : BASE_FUNCTOR_PROP(A, C) 11 | 12 | prfn map_v {a:view}{b:view}{c:view} (f : b - c, x : base_functor_v(a, b)) : base_functor_v(a, c) 13 | 14 | propdef ALGEBRA (A : prop, B : prop) = BASE_FUNCTOR_PROP(A, B) - B 15 | 16 | propdef COALGEBRA (A : prop, B : prop) = B - BASE_FUNCTOR_PROP(A, B) 17 | 18 | viewdef algebra_v(a: view, b: view) = base_functor_v(a, b) - b 19 | 20 | prfn {A:prop} PROJECT {n:nat} (FUNCTOR_PROP(A,n)) : BASE_FUNCTOR_PROP(A, FUNCTOR_PROP(A,n-1)) 21 | 22 | prfn {A:prop} EMBED {n:nat} (BASE_FUNCTOR_PROP(A,FUNCTOR_PROP(A,n))) : FUNCTOR_PROP(A, n-1) 23 | 24 | prval {A:prop}{B:prop} STOP : BASE_FUNCTOR_PROP(A, B) 25 | 26 | prfn {a:view}{b:view} stop_v () : base_functor_v(a, b) 27 | 28 | prfn {a:view} project_v {n:nat} (functor_v(a,n)) : base_functor_v(a, functor_v(a,n-1)) 29 | 30 | prfn {a:view} gfree_v (a) : void 31 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | - [ ] Make functors more sensible 2 | - [ ] Currently seems to be impossible so maybe suggest it for ATS Xanadu? 3 | - [ ] Work for viewtypes 4 | - [ ] freeing vs. non-freeing functions 5 | - [ ] Mendler-style catamorphisms? 6 | - [ ] Anamorphism and/or hylomorphism (calculating string length?) 7 | - [ ] Possibly useful for the obfuscated C contest (lol) 8 | - [ ] Proof-level recursion schemes? Possibly something w/ arrays. 9 | -------------------------------------------------------------------------------- /atspkg.dhall: -------------------------------------------------------------------------------- 1 | let prelude = 2 | https://raw.githubusercontent.com/vmchale/atspkg/master/ats-pkg/dhall/atspkg-prelude.dhall sha256:69bdde38a8cc01c91a1808ca3f45c29fe754c9ac96e91e6abd785508466399b4 3 | 4 | in prelude.default 5 | ⫽ { test = 6 | [ prelude.bin 7 | ⫽ { src = "test/recursion.dats" 8 | , target = "${prelude.atsProject}/recursion" 9 | , gcBin = True 10 | } 11 | , prelude.bin 12 | ⫽ { src = "test/calc.dats" 13 | , target = "${prelude.atsProject}/calc" 14 | , gcBin = True 15 | } 16 | ] 17 | , compiler = [ 0, 4, 2 ] 18 | , version = [ 0, 4, 2 ] 19 | , dependencies = prelude.mapPlainDeps [ "specats", "either" ] 20 | } 21 | -------------------------------------------------------------------------------- /docs/paper.tex: -------------------------------------------------------------------------------- 1 | \documentclass{article} 2 | \begin{document} 3 | 4 | \title{Proof-Level Recursion Schemes} 5 | \author{Vanessa McHale} 6 | \maketitle 7 | 8 | \begin{abstract} 9 | We present an implementation of proof-level recursion schemes in ATS. 10 | \end{abstract} 11 | 12 | \section{Introduction} 13 | 14 | Recursion schemes are a popular technique in functional programming. 15 | 16 | \section{Implementation} 17 | 18 | \end{document} 19 | -------------------------------------------------------------------------------- /pkg.dhall: -------------------------------------------------------------------------------- 1 | let prelude = 2 | https://raw.githubusercontent.com/vmchale/atspkg/master/ats-pkg/dhall/atspkg-prelude.dhall 3 | 4 | in λ(x : List Natural) → 5 | prelude.makePkg { x, name = "recursion", githubUsername = "vmchale" } 6 | ⫽ { description = Some "A package for recursion schemes in ATS" } 7 | -------------------------------------------------------------------------------- /test/calc.dats: -------------------------------------------------------------------------------- 1 | staload "SATS/recursive.sats" 2 | 3 | #include "share/atspre_staload.hats" 4 | #include "$PATSHOMELOCS/specats-0.4.0/mylibies.hats" 5 | #include "DATS/recursive.dats" 6 | 7 | datatype expression = 8 | | add of (expression, expression) 9 | | subtract of (expression, expression) 10 | | multiply of (expression, expression) 11 | | divide of (expression, expression) 12 | | value of int 13 | 14 | datatype expression_f(a: t@ype+) = 15 | | add_f of (a, a) 16 | | subtract_f of (a, a) 17 | | multiply_f of (a, a) 18 | | divide_f of (a, a) 19 | | value_f of int 20 | 21 | local 22 | absimpl recursive_functor_type(a) = expression 23 | absimpl base_functor_type(a, x) = expression_f(x) 24 | in 25 | implement {a} project (x) = 26 | case+ x of 27 | | add (e0, e1) => add_f(e0, e1) 28 | | subtract (e0, e1) => subtract_f(e0, e1) 29 | | multiply (e0, e1) => multiply_f(e0, e1) 30 | | divide (e0, e1) => divide_f(e0, e1) 31 | | value (i) => value_f(i) 32 | 33 | implement {a}{x0}{x1} map (f, x) = 34 | case+ x of 35 | | add_f (e0, e1) => add_f(f(e0), f(e1)) 36 | | subtract_f (e0, e1) => subtract_f(f(e0), f(e1)) 37 | | multiply_f (e0, e1) => multiply_f(f(e0), f(e1)) 38 | | divide_f (e0, e1) => divide_f(f(e0), f(e1)) 39 | | value_f (i) => value_f(i) 40 | 41 | fun calculate(x : expression) : int = 42 | let 43 | fn go(e : expression_f(int)) : int = 44 | case+ e of 45 | | add_f (e0, e1) => e0 + e1 46 | | subtract_f (e0, e1) => e0 - e1 47 | | multiply_f (e0, e1) => e0 * e1 48 | | divide_f (e0, e1) => e0 / e1 49 | | value_f (i) => i 50 | in 51 | cata(lam x0 = go(x0), x) 52 | end 53 | 54 | implement main0 () = 55 | { 56 | val expr = add(value(2), multiply(value(3), value(5))) 57 | val i = calculate(expr) 58 | var folded_check = eq_g0int_int(i, 17) 59 | var n0 = @{ test_name = "arithmetic", test_result = folded_check } 60 | var xs = n0 :: nil 61 | var total = list_vt_length(xs) 62 | val g = @{ group = "Catamorphisms", leaves = xs } : test_tree 63 | val _ = iterate_list(g, 0, total) 64 | } 65 | end 66 | -------------------------------------------------------------------------------- /test/recursion.dats: -------------------------------------------------------------------------------- 1 | staload "SATS/recursive.sats" 2 | staload "SATS/recursive_prf.sats" 3 | 4 | #include "share/atspre_staload.hats" 5 | #include "$PATSHOMELOCS/specats-0.4.0/mylibies.hats" 6 | #include "DATS/recursive.dats" 7 | #include "DATS/recursive_list0.dats" 8 | #include "DATS/recursive_prf.dats" 9 | #include "DATS/recursive_list_prf.dats" 10 | 11 | fun sum(is : list0(int)) : int = 12 | let 13 | fn go(i : list0f(int, int)) : int = 14 | case+ i of 15 | | list0_consf (x, xs) => x + xs 16 | | list0_nilf() => 0 17 | in 18 | cata(lam x0 = go(x0), is) 19 | end 20 | 21 | implement main0 () = 22 | { 23 | val folded: int = let 24 | var list = list0_cons(2, list0_cons(1, list0_nil())) 25 | in 26 | sum(list) 27 | end 28 | var folded_check = eq_g0int_int(folded, 3) 29 | var n0 = @{ test_name = "cata", test_result = folded_check } 30 | var xs = n0 :: nil 31 | var total = list_vt_length(xs) 32 | val g = @{ group = "Recursion schemes", leaves = xs } : test_tree 33 | val _ = iterate_list(g, 0, total) 34 | } 35 | --------------------------------------------------------------------------------