├── .gitattributes ├── .gitignore ├── .hlint.yaml ├── .hspec ├── .stylish-haskell.yaml ├── .travis.yml ├── .yamllint ├── Justfile ├── README.md ├── TODO.md ├── appveyor.yml ├── ats-format ├── CHANGELOG.md ├── LICENSE ├── README.md ├── Setup.hs ├── TODO.md ├── ats-format.cabal ├── atsfmt.png ├── atsfmt2.png ├── man │ ├── MANPAGE.md │ └── atsfmt.1 └── src │ └── Main.hs ├── ats-pkg ├── CHANGELOG.md ├── CONTRIBUTING.md ├── EXAMPLES.md ├── LICENSE ├── PACKAGES.md ├── README.md ├── TODO.md ├── app │ ├── Language │ │ └── ATS │ │ │ └── Package │ │ │ ├── Dhall.hs │ │ │ └── Upgrade.hs │ └── Main.hs ├── ats-pkg.cabal ├── dhall │ ├── .ctags │ ├── atslib.dhall │ ├── atspkg-prelude.dhall │ └── config.dhall ├── docs │ ├── manual.pdf │ └── manual.tex ├── internal │ ├── Quaalude.cpphs │ └── System │ │ └── Process │ │ └── Ext.hs ├── man │ ├── MANPAGE.md │ └── atspkg.1 ├── pkgs │ ├── README.md │ └── pkg-set.dhall ├── src │ ├── Distribution │ │ ├── ATS.hs │ │ └── ATS │ │ │ ├── Build.hs │ │ │ └── Version.hs │ └── Language │ │ └── ATS │ │ ├── Package.hs │ │ └── Package │ │ ├── Build.hs │ │ ├── Build │ │ └── C.hs │ │ ├── Compiler.hs │ │ ├── Config.hs │ │ ├── Debian.hs │ │ ├── Dependency.hs │ │ ├── Error.hs │ │ ├── PackageSet.hs │ │ └── Type.hs └── test │ └── data │ └── hello-world │ ├── atspkg.dhall │ └── src │ └── hello-world.dats ├── bash ├── install.sh ├── manpages ├── prof-install └── upload ├── cabal.project ├── dependency ├── CHANGELOG.md ├── LICENSE ├── README.md ├── TODO.md ├── bench │ └── Bench.hs ├── dependency.cabal ├── src │ └── Data │ │ ├── Dependency.hs │ │ └── Dependency │ │ ├── Error.hs │ │ ├── Sort.hs │ │ └── Type.hs └── test │ └── Spec.hs ├── hs2ats ├── CHANGELOG.md ├── LICENSE ├── README.md ├── TODO.md ├── app │ └── Main.hs ├── bench │ └── Bench.hs ├── hs2ats.cabal ├── src │ └── Language │ │ └── ATS │ │ ├── Generate.hs │ │ └── Generate │ │ └── Error.hs └── test │ ├── Spec.hs │ └── data │ ├── HigherOrder.hs │ ├── HigherOrder.out │ ├── Newtype.hs │ ├── Newtype.out │ ├── Option.hs │ ├── Option.out │ ├── Pair.hs │ ├── Pair.out │ ├── SumType.hs │ └── SumType.out ├── language-ats ├── CHANGELOG.md ├── LICENSE ├── README.md ├── TODO.md ├── bench │ └── Bench.hs ├── language-ats.cabal ├── src │ └── Language │ │ ├── ATS.hs │ │ └── ATS │ │ ├── Lexer.x │ │ ├── Parser.y │ │ ├── PrettyPrint.hs │ │ ├── Rewrite.hs │ │ ├── Types.hs │ │ └── Types │ │ └── Lens.hs └── test │ ├── Spec.hs │ └── data │ ├── array-literal.dats │ ├── array-literal.out │ ├── array.dats │ ├── array.out │ ├── arrptr.dats │ ├── arrptr.out │ ├── ats-generic.dats │ ├── ats-generic.out │ ├── cli.dats │ ├── cli.out │ ├── cloref.dats │ ├── cloref.out │ ├── combinatorics.dats │ ├── combinatorics.out │ ├── concurrency.dats │ ├── concurrency.out │ ├── crc32.dats │ ├── crc32.out │ ├── dhall-ats.dats │ ├── dhall-ats.out │ ├── dirwalk.dats │ ├── dirwalk.out │ ├── dlist.out │ ├── dlist.sats │ ├── either.out │ ├── either.sats │ ├── fact.dats │ ├── fact.out │ ├── factorial.dats │ ├── factorial.out │ ├── fast-combinatorics.dats │ ├── fast-combinatorics.out │ ├── fastcount.dats │ ├── fastcount.out │ ├── fib-thm.dats │ ├── fib-thm.out │ ├── fib.dats │ ├── fib.out │ ├── filecount.dats │ ├── filecount.out │ ├── filetype.out │ ├── filetype.sats │ ├── finger-tree.out │ ├── finger-tree.sats │ ├── futhark-types.out │ ├── futhark-types.sats │ ├── gmp-import.dats │ ├── gmp-import.out │ ├── gmp.out │ ├── gmp.sats │ ├── haskell.dats │ ├── haskell.out │ ├── ifact2.dats │ ├── ifact2.out │ ├── integer_ptr.out │ ├── left-pad.dats │ ├── left-pad.out │ ├── levenshtein.dats │ ├── levenshtein.out │ ├── levenshtein2.dats │ ├── levenshtein2.out │ ├── levenshtein3.dats │ ├── levenshtein3.out │ ├── list_append.dats │ ├── list_append.out │ ├── memchr.out │ ├── memchr.sats │ ├── mydepies.hats │ ├── mydepies.out │ ├── mylibies.hats │ ├── mylibies.out │ ├── number-theory.dats │ ├── number-theory.out │ ├── numerics.dats │ ├── numerics.out │ ├── polyglot.dats │ ├── polyglot.out │ ├── prf_sqrt2.dats │ ├── prf_sqrt2.out │ ├── recursion.dats │ ├── recursion.out │ ├── spec.dats │ ├── spec.out │ ├── stack-array.dats │ ├── stack-array.out │ ├── stdlib │ ├── DATS │ │ ├── bool.dats │ │ ├── bool.out │ │ ├── integer_fixed.dats │ │ ├── integer_fixed.out │ │ ├── integer_long.dats │ │ ├── integer_long.out │ │ ├── integer_ptr.dats │ │ ├── integer_ptr.out │ │ ├── integer_short.dats │ │ ├── integer_short.out │ │ ├── integer_size.dats │ │ └── integer_size.out │ ├── arith_prf.out │ ├── arith_prf.sats │ ├── array.out │ ├── array.sats │ ├── arrayref.out │ ├── arrayref.sats │ ├── basics_dyn.out │ ├── basics_dyn.sats │ ├── basics_gen.out │ ├── basics_gen.sats │ ├── bool.out │ ├── checkast.out │ ├── checkast.sats │ ├── filebas.out │ ├── filebas.sats │ ├── gnumber.out │ ├── gnumber.sats │ ├── gorder.out │ ├── gorder.sats │ ├── integer_fixed.out │ ├── integer_fixed.sats │ ├── integer_long.out │ ├── integer_long.sats │ ├── integer_ptr.out │ ├── integer_ptr.sats │ ├── integer_short.out │ ├── integer_short.sats │ ├── integer_size.out │ ├── integer_size.sats │ ├── intrange.out │ ├── intrange.sats │ ├── option_vt.out │ ├── option_vt.sats │ ├── unsafe.out │ └── unsafe.sats │ ├── str.dats │ ├── str.out │ ├── toml-parse.dats │ ├── toml-parse.out │ ├── types.out │ ├── types.sats │ ├── wc.dats │ ├── wc.out │ ├── wc2.dats │ └── wc2.out ├── shake-ats ├── CHANGELOG.md ├── LICENSE ├── README.md ├── shake-ats.cabal └── src │ └── Development │ └── Shake │ ├── ATS.hs │ └── ATS │ ├── Environment.hs │ ├── Generate.hs │ ├── Rules.hs │ └── Type.hs ├── shake-c ├── CHANGELOG.md ├── LICENSE ├── README.md ├── shake-c.cabal └── src │ └── Development │ └── Shake │ └── C.hs └── shake-cabal ├── CHANGELOG.md ├── LICENSE ├── README.md ├── shake-cabal.cabal └── src └── Development └── Shake ├── Cabal.hs └── Cabal └── Oracles.hs /.gitattributes: -------------------------------------------------------------------------------- 1 | language-ats/test/data/* linguist-vendored 2 | hs2ats/test/data/* linguist-vendored 3 | *.y linguist-language=Happy 4 | *.x linguist-language=Alex 5 | *.cpphs linguist-language=Haskell 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.swp 2 | .ghc* 3 | *.c 4 | _darcs 5 | .stack-work 6 | tags 7 | dist 8 | manual.out 9 | *.toc 10 | *.aux 11 | *.log 12 | tags 13 | dist 14 | dist-* 15 | doc 16 | *.o 17 | *.hi 18 | *.chi 19 | *.chs.h 20 | *.dyn_o 21 | *.dyn_hi 22 | .cabal-sandbox/ 23 | cabal.sandbox.config 24 | *.prof 25 | *.aux 26 | *.hp 27 | *.tix 28 | *.eventlog 29 | .stack-work/ 30 | .HTF/ 31 | cbits/ 32 | -------------------------------------------------------------------------------- /.hlint.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | - ignore: {name: Avoid lambda, within: [Language.ATS.Types.Lens]} 3 | - ignore: {name: Unused LANGUAGE pragma, within: [Language.ATS.PrettyPrint]} 4 | - ignore: {name: Use foldr, within: [Language.ATS.Generate]} 5 | - ignore: {name: Use section} 6 | 7 | - fixity: infixr 8 .* 8 | - fixity: infixr 3 *** 9 | - fixity: infixr 3 &&& 10 | - fixity: infixr 1 <=< 11 | -------------------------------------------------------------------------------- /.hspec: -------------------------------------------------------------------------------- 1 | --fail-fast 2 | --failure-report .hspec-failures 3 | --rerun 4 | --rerun-all-on-success 5 | -------------------------------------------------------------------------------- /.stylish-haskell.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | steps: 3 | - simple_align: 4 | cases: true 5 | top_level_patterns: true 6 | records: true 7 | - imports: 8 | align: global 9 | list_align: after_alias 10 | pad_module_names: true 11 | long_list_align: inline 12 | empty_list_align: inherit 13 | list_padding: 4 14 | separate_lists: true 15 | space_surround: false 16 | - language_pragmas: 17 | style: vertical 18 | align: true 19 | remove_redundant: false 20 | 21 | - trailing_whitespace: {} 22 | columns: 160 23 | newline: native 24 | language_extensions: [CPP, FlexibleContexts] 25 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | --- 2 | sudo: true 3 | language: c 4 | addons: 5 | apt: 6 | packages: 7 | - libgmp3-dev 8 | - xz-utils 9 | - liblzma-dev 10 | matrix: 11 | include: 12 | 13 | - env: TARGET=x86_64-unknown-linux GHC=8.8.1 14 | addons: 15 | apt: 16 | update: true 17 | sources: 18 | - hvr-ghc 19 | packages: 20 | - ghc-8.8.1 21 | - cabal-install-3.0 22 | 23 | - env: TARGET=x86_64-unknown-linux GHC=8.6.5 24 | addons: 25 | apt: 26 | update: true 27 | sources: 28 | - hvr-ghc 29 | packages: 30 | - ghc-8.6.5 31 | - cabal-install-3.0 32 | 33 | - env: TARGET=x86_64-unknown-linux GHC=8.4.4 34 | addons: 35 | apt: 36 | update: true 37 | sources: 38 | - hvr-ghc 39 | packages: 40 | - ghc-8.4.4 41 | - cabal-install-3.0 42 | 43 | # OS X 44 | - env: TARGET=x86_64-apple-darwin GHC=8.8.1 45 | os: osx 46 | 47 | before_install: 48 | - | 49 | if [ `uname` = "Darwin" ] 50 | then 51 | brew install xz 52 | brew install cabal-install 53 | brew install wget 54 | cabal update 55 | else 56 | export PATH=/opt/ghc/bin:$PATH 57 | cabal update 58 | fi 59 | 60 | script: 61 | - | 62 | wget https://www.libarchive.org/downloads/libarchive-3.4.2.tar.gz 63 | tar xvf libarchive-3.4.2.tar.gz 64 | cd libarchive-3.4.2 65 | ./configure 66 | make -j 67 | sudo make install 68 | cd .. 69 | - curl -sL https://raw.github.com/ndmitchell/hlint/master/misc/travis.sh | sh -s ats-format ats-pkg dependency hs2ats language-ats shake-ats shake-c shake-cabal 70 | - cabal update 71 | - travis_wait 40 cabal build all 72 | - | 73 | if [ `uname` = "Darwin" ] 74 | then 75 | export BINPATH1="$(find dist-newstyle/ -name atspkg -perm 755 | tail -n1)" 76 | export BINPATH2="$(find dist-newstyle/ -name atsfmt -perm 755 | tail -n1)" 77 | export BINPATH3="$(find dist-newstyle/ -name hs2ats -perm 755 | tail -n1)" 78 | else 79 | export BINPATH1="$(find dist-newstyle/ -name atspkg -executable | tail -n1)" 80 | export BINPATH2="$(find dist-newstyle/ -name atsfmt -executable | tail -n1)" 81 | export BINPATH3="$(find dist-newstyle/ -name hs2ats -executable | tail -n1)" 82 | fi 83 | - echo $BINPATH1 84 | - echo $BINPATH2 85 | - echo $BINPATH3 86 | - mv $BINPATH1 atspkg-$TARGET 87 | - mv $BINPATH2 atsfmt-$TARGET 88 | - mv $BINPATH3 hs2ats-$TARGET 89 | - strip atspkg-$TARGET 90 | - strip atsfmt-$TARGET 91 | - strip hs2ats-$TARGET 92 | - du -h atspkg-$TARGET 93 | - cd ats-pkg/test/data/hello-world 94 | - ../../../../atspkg-$TARGET clean 95 | - ../../../../atspkg-$TARGET nuke 96 | - ../../../../atspkg-$TARGET run -vvv 97 | - cd - 98 | 99 | deploy: 100 | api_key: 101 | secure: "IZLQxO3HtTM2nqowxVOY3MhRhGZTElXUn0jpyPBkbrxLzk8Ykac15lSAGOs4MYo/GdKof8YYr2fHGChv7/PkF/HYSLFcDrY0UzpCP8QqANWjKbakQmVqU+YTtas3cq/Gk1l2tY9MGDNfMB7jk92Nh6BsA1TxReyziVPCDJv+z4UYZqQGhBxYQlVqHlcxYpS0p5gmXTFC8+io/ArGzC4jHqaZ+LmrzVMiXdDeQnVIOtQHbwWLwPb6mXBA8W5qC/IAgivb+w9aH86GUgML2t16b2/pCHQANigaeDTAseaU2PUv2fJTqexBfrAH34FJ+TQxROi8JpXu2/SVDuironTOPhUSnVd3aYNd64lOB80UmCxIWxYcYVA7olr6Qth1ZfKI0ks64sXJ7XlLDykCPqSTdnuiCEsqlHll+2ZA2uEHKuwRxMht/ZxKnW6a6GidaRp2cImBe7sMBQyiLYzf6+ZJQyy7H5beV9FsiTAyA4oxEGtl+220i0kwz6CV4+WXeoO7yv4TAKVfIEMjvHANV/kWEztuwcs3kIJzXJd1J/TdAneOHOCKGbnqDSDNeY48upwaPCQOnNA+RK4PYiA0YJ5zoq8hamtaMVzciGWMX3rFux9qC4wjgcTafFwyF3MSuF/TitAZI/xAtCOnCsZspuaBXI1nuoLoF61oixvD9xMeyNo=" 102 | file: 103 | - atspkg-$TARGET 104 | - atsfmt-$TARGET 105 | - hs2ats-$TARGET 106 | on: 107 | tags: true 108 | provider: releases 109 | skip_cleanup: true 110 | 111 | branches: 112 | only: 113 | - /\d+\.\d+\.\d+\.\d+.*$/ 114 | - master 115 | -------------------------------------------------------------------------------- /.yamllint: -------------------------------------------------------------------------------- 1 | --- 2 | rules: 3 | braces: 4 | min-spaces-inside: 0 5 | max-spaces-inside: 0 6 | min-spaces-inside-empty: -1 7 | max-spaces-inside-empty: -1 8 | brackets: 9 | min-spaces-inside: 0 10 | max-spaces-inside: 0 11 | min-spaces-inside-empty: -1 12 | max-spaces-inside-empty: -1 13 | colons: 14 | max-spaces-before: 0 15 | max-spaces-after: 1 16 | commas: 17 | max-spaces-before: 0 18 | min-spaces-after: 1 19 | max-spaces-after: 1 20 | comments: 21 | level: warning 22 | require-starting-space: true 23 | min-spaces-from-content: 2 24 | comments-indentation: 25 | level: warning 26 | document-end: disable 27 | document-start: 28 | level: warning 29 | present: true 30 | empty-lines: 31 | max: 2 32 | max-start: 0 33 | max-end: 0 34 | hyphens: 35 | max-spaces-after: 1 36 | indentation: 37 | spaces: consistent 38 | indent-sequences: false 39 | check-multi-line-strings: false 40 | key-duplicates: enable 41 | line-length: disable 42 | new-line-at-end-of-file: enable 43 | new-lines: 44 | type: unix 45 | trailing-spaces: enable 46 | truthy: disable 47 | -------------------------------------------------------------------------------- /Justfile: -------------------------------------------------------------------------------- 1 | latex: 2 | cd ats-pkg/docs && pdflatex manual.tex && pdflatex manual.tex 3 | 4 | darcs: 5 | darcs optimize clean 6 | darcs optimize pristine 7 | darcs optimize cache 8 | 9 | 10 | approve FILE: 11 | @cabal run atsfmt -w ghc-8.6.5 -- language-ats/test/data/{{ FILE }} -o > language-ats/test/data/$(echo {{ FILE }} | sed 's/\(dats\|hats\|sats\)/out/') 12 | sed -i '$d' language-ats/test/data/$(echo {{ FILE }} | sed 's/\(dats\|hats\|sats\)/out/') 13 | 14 | clean: 15 | sn c . 16 | rm -rf tags ats-pkg/docs/manual.out 17 | 18 | diff FILE: 19 | @diff <(cabal run atsfmt -w ghc-8.8.3 -- language-ats/test/data/{{ FILE }} -o) language-ats/test/data/$(echo {{ FILE }} | sed 's/\(dats\|hats\|sats\)/out/') | perl -pe 's/\e\[?.*?[\@-~]//g' 20 | 21 | manpages: 22 | pandoc ats-format/man/MANPAGE.md -s -t man -o ats-format/man/atsfmt.1 23 | pandoc ats-pkg/man/MANPAGE.md -s -t man -o ats-pkg/man/atspkg.1 24 | 25 | debian: 26 | PATH=/usr/bin:$PATH cabal-debian --maintainer "Vanessa McHale " 27 | 28 | poly: 29 | @poly -e data 30 | 31 | dhall-check: 32 | atspkg check-set ats-pkg/pkgs/pkg-set.dhall 33 | cat ats-pkg/dhall/atslib.dhall | dhall 34 | cat ats-pkg/dhall/config.dhall | dhall 35 | cat ats-pkg/dhall/atspkg-prelude.dhall | dhall 36 | 37 | ci: install 38 | @cabal new-test all 39 | shellcheck -e SC2016 bash/install.sh 40 | shellcheck bash/upload 41 | yamllint .stylish-haskell.yaml 42 | yamllint .hlint.yaml 43 | yamllint .yamllint 44 | yamllint .travis.yml 45 | yamllint appveyor.yml 46 | tomlcheck --file ats-format/.atsfmt.toml 47 | hlint ats-pkg language-ats ats-format shake-cabal shake-c 48 | 49 | profile: 50 | @cabal new-build all -p --enable-profiling 51 | @cp $(fd 'atsfmt$' -IH dist-newstyle | tail -n1) ~/.local/bin 52 | @cp -f $(fd 'atspkg$' -t x -IH dist-newstyle | tail -n1) ~/.local/bin 53 | 54 | install: 55 | @cabal new-build all 56 | @cp -f $(fd 'atspkg$' -t x -IH dist-newstyle | tail -n1) ~/.local/bin 57 | @strip $(fd 'atsfmt$' -IH dist-newstyle | tail -n1) 58 | @cp ats-format/man/atsfmt.1 ~/.local/share/man/man1 59 | @cp $(fd 'atsfmt$' -IH dist-newstyle | tail -n1) ~/.local/bin 60 | 61 | size: 62 | @sn d $(fd 'atsfmt$' -IH dist-newstyle | tail -n1) $(fd 'atspkg$' -IH dist-newstyle | tail -n1) 63 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ATS 2 | 3 | This is a collection of several Haskell packages for use with the 4 | [ATS](http://ats-lang.org/) language. 5 | 6 | ## Goals 7 | 8 | The following are goals of the libraries and tools contained herein: 9 | 10 | * Make handling ATS code in Haskell easy 11 | 12 | * Make building ATS easy 13 | 14 | * Make dependency resolution for ATS packages easy 15 | 16 | * Make building Haskell with ATS dependencies easy 17 | 18 | * Make building ATS with Haskell dependencies easy 19 | 20 | As of writing, building ATS code in Haskell is quite smooth, package management 21 | is unfortunately maladroit, and handling ATS code in Haskell is mostly 22 | manageable. 23 | 24 | ## Tools 25 | 26 | * [ats-pkg](ats-pkg/README.md): package management 27 | * [ats-format](ats-format/README.md): automated formatter 28 | * [hs2ats](hs2ats/README.md): convert Haskell types to ATS types 29 | * [language-ats](language-ats/README.md): Haskell parser & pretty-printer for ATS 30 | 31 | More to come! 32 | 33 | ## Contents 34 | 35 | ``` 36 | ------------------------------------------------------------------------------- 37 | Language Files Lines Code Comments Blanks 38 | ------------------------------------------------------------------------------- 39 | Alex 1 641 567 12 62 40 | Bash 1 8 6 0 2 41 | Cabal 8 704 650 0 54 42 | Cabal Project 1 34 26 1 7 43 | Dash 1 54 38 0 16 44 | Dhall 4 574 499 3 72 45 | Happy 1 1039 886 34 119 46 | Haskell 45 5170 4269 185 716 47 | Justfile 1 62 49 0 13 48 | Markdown 28 982 694 0 288 49 | Nix 2 24 23 0 1 50 | TeX 1 66 46 0 20 51 | TOML 1 3 3 0 0 52 | YAML 4 198 181 0 17 53 | ------------------------------------------------------------------------------- 54 | Total 99 9559 7937 235 1387 55 | ------------------------------------------------------------------------------- 56 | ``` 57 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | - [ ] releases for `hs2ats` & script to install them 2 | - [ ] Profiled builds? 3 | -------------------------------------------------------------------------------- /appveyor.yml: -------------------------------------------------------------------------------- 1 | --- 2 | 3 | build: off 4 | 5 | before_test: 6 | - choco install 7zip 7 | - choco install ghc 8 | - choco install cabal 9 | 10 | test_script: 11 | - refreshenv 12 | - cabal new-update 13 | - cabal new-build all 14 | - ps: $directory = Get-ChildItem . -name -recurse atspkg.exe 15 | - ps: Copy-Item $directory atspkg-x86_64-pc-windows.exe 16 | - ps: Push-AppveyorArtifact atspkg-x86_64-pc-windows.exe 17 | 18 | deploy: 19 | artifacts: atspkg-x86_64-pc-windows.exe 20 | provider: GitHub 21 | on: 22 | appveyor_repo_tag: true 23 | auth_token: 24 | secure: cNzi4ZEE4PIrKxBJXEDPHkqrHI4fdSJtIQZ8n7qbYJwBtsx8TkBxduK8eIr6fzdY 25 | 26 | branches: 27 | only: 28 | - master 29 | - /\d+\.\d+\.\d+\.\d+.*$/ 30 | -------------------------------------------------------------------------------- /ats-format/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # ats-format 2 | 3 | ## 0.22.2.36 4 | 5 | * Don't use `TemplateHaskell` 6 | 7 | ## 0.2.2.35 8 | 9 | * Typo correction in manpages 10 | 11 | ## 0.2.2.34 12 | 13 | * Bugfix in new setup 14 | 15 | ## 0.2.2.33 16 | 17 | * Use new `cli-setup` API 18 | 19 | ## 0.2.2.32 20 | 21 | * Depend on [toml-parser](http://hackage.haskell.org/package/toml-parser) for 22 | TOML parsing. 23 | 24 | ## 0.2.2.31 25 | 26 | * Remove `static` and `profiling` flags; use `--enable-executable-static` from 27 | `cabal-install` instead. 28 | 29 | ## 0.2.2.30 30 | 31 | * Fix typo in command-line parser 32 | -------------------------------------------------------------------------------- /ats-format/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Vanessa McHale (c) 2017-2019 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 | -------------------------------------------------------------------------------- /ats-format/README.md: -------------------------------------------------------------------------------- 1 | # ats-formatter 2 | 3 | [![Build Status](https://travis-ci.org/vmchale/ats-format.svg?branch=master)](https://travis-ci.org/vmchale/ats-format) 4 | 5 | Screenshot of sample results 6 | Screenshot of sample results 7 | 8 | This is a code formatter for [ATS](http://www.ats-lang.org/). It is 9 | a work-in-progress. 10 | 11 | If you find something that's not listed in `TODO.md` feel free to open 12 | an issue. Code samples that were formatted into something ugly are also welcome. 13 | 14 | ## Configuration 15 | 16 | `atsfmt` is configured with the `.atsfmt.toml` file. You can generate a default 17 | configuration with 18 | 19 | ```bash 20 | $ atsfmt --default-config 21 | ``` 22 | 23 | ### Vim 24 | 25 | You can use [this](https://github.com/vmchale/ats-vim) plugin to enable 26 | automatic formatting on write. 27 | 28 | ## Installation 29 | 30 | ### Binary Releases 31 | 32 | The [releases](https://github.com/vmchale/ats-format/releases) page has binary 33 | releases for common platforms. 34 | 35 | ### Compilation from Source 36 | 37 | To install, first install [GHC](https://www.haskell.org/ghc/download.html), then 38 | [cabal](https://www.haskell.org/cabal/download.html). Then 39 | 40 | ```bash 41 | $ cabal update 42 | $ cabal new-install ats-format --happy-options='-gcsa' -O2 43 | ``` 44 | 45 | ## License 46 | 47 | All code except `test/data/left-pad.dats` is licensed under the BSD3 license. 48 | -------------------------------------------------------------------------------- /ats-format/Setup.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wall #-} 2 | 3 | import Data.Foldable (sequence_) 4 | import Distribution.CommandLine 5 | import Distribution.Simple 6 | import System.FilePath 7 | 8 | main :: IO () 9 | main = sequence_ [ writeManpages ("man" "atsfmt.1") "atsfmt.1" 10 | , writeBashCompletions "atsfmt" 11 | , setManpathBash 12 | , setManpathFish 13 | , setManpathZsh 14 | , defaultMain 15 | ] 16 | -------------------------------------------------------------------------------- /ats-format/TODO.md: -------------------------------------------------------------------------------- 1 | - [ ] Apparently return types are optional?? 2 | -------------------------------------------------------------------------------- /ats-format/ats-format.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.18 2 | name: ats-format 3 | version: 0.2.0.36 4 | license: BSD3 5 | license-file: LICENSE 6 | copyright: Copyright: (c) 2017-2019 Vanessa McHale 7 | maintainer: vamchale@gmail.com 8 | author: Vanessa McHale 9 | synopsis: A source-code formatter for ATS 10 | description: 11 | An opinionated source-code formatter for [ATS](http://www.ats-lang.org/). 12 | 13 | category: Parser, Language, ATS, Development 14 | build-type: Custom 15 | extra-source-files: man/atsfmt.1 16 | extra-doc-files: 17 | README.md 18 | CHANGELOG.md 19 | 20 | source-repository head 21 | type: darcs 22 | location: https://hub.darcs.net/vmchale/ats 23 | 24 | custom-setup 25 | setup-depends: 26 | base -any, 27 | Cabal -any, 28 | cli-setup >=0.2.1.0, 29 | filepath -any 30 | 31 | flag development 32 | description: Enable `-Werror` 33 | default: False 34 | manual: True 35 | 36 | executable atsfmt 37 | main-is: Main.hs 38 | hs-source-dirs: src 39 | other-modules: Paths_ats_format 40 | default-language: Haskell2010 41 | other-extensions: OverloadedStrings 42 | ghc-options: -Wall -rtsopts -with-rtsopts=-A9M 43 | build-depends: 44 | base >=4.9 && <5, 45 | language-ats >=1.7.4.0, 46 | optparse-applicative -any, 47 | text -any, 48 | ansi-wl-pprint -any, 49 | directory -any, 50 | process -any, 51 | toml-parser -any 52 | 53 | if flag(development) 54 | ghc-options: -Werror 55 | 56 | if impl(ghc >=8.0) 57 | ghc-options: -Wincomplete-uni-patterns -Wincomplete-record-updates 58 | -------------------------------------------------------------------------------- /ats-format/atsfmt.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vmchale/atspkg/26cdd1ed1130a31e4bb4985fc54e50240228f7df/ats-format/atsfmt.png -------------------------------------------------------------------------------- /ats-format/atsfmt2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vmchale/atspkg/26cdd1ed1130a31e4bb4985fc54e50240228f7df/ats-format/atsfmt2.png -------------------------------------------------------------------------------- /ats-format/man/MANPAGE.md: -------------------------------------------------------------------------------- 1 | % atsfmt (1) 2 | % Vanessa McHale 3 | 4 | # NAME 5 | 6 | atsfmt - a source code formatter for ATS 7 | 8 | # SYNOPSIS 9 | 10 | atsfmt \ 11 | 12 | atsfmt -i \ 13 | 14 | atsfmt -\-default-config 15 | 16 | cat file.dats | atsfmt 17 | 18 | atsfmt -\-default-config 19 | 20 | # DESCRIPTION 21 | 22 | **atsfmt** is an opinionated formatter for that ATS2 language. 23 | 24 | # OPTIONS 25 | 26 | **-h** **-\-help** 27 | : Display help 28 | 29 | **-V** **-\-version** 30 | : Display version information 31 | 32 | **-o** **-\-no-config** 33 | : Ignore configuration files in scope 34 | 35 | **-i** 36 | : Modify a file in-place. 37 | 38 | **-\-default-config** 39 | : Generate a default configuration file in the current directory 40 | 41 | # CONFIGURATION 42 | 43 | **atsfmt** is configured using a TOML file, by default .atsfmt.toml. You can 44 | generate a default configuration with 45 | 46 | ``` 47 | atsfmt --default-config 48 | ``` 49 | 50 | To make **atsfmt** call clang-format on embedded C code, add the following to 51 | your .atsfmt.toml 52 | 53 | ``` 54 | clang-format = true 55 | ``` 56 | 57 | You can also set ribbon width and line width in the file, viz. 58 | 59 | ``` 60 | ribbon = 0.6 61 | width = 120 62 | ``` 63 | 64 | Ribbon width is the width of a line excluding indentation. 65 | In this example, the maximum column number will be 120 and the maximum ribbon 66 | width will be 0.6 * 120 = 72 characters. 67 | 68 | # EDITOR INTEGRATION 69 | 70 | Editor integration is available with the ATS vim plugin at: 71 | 72 | https://github.com/vmchale/ats-vim 73 | 74 | # COPYRIGHT 75 | 76 | Copyright 2017-2019. Vanessa McHale. All Rights Reserved. 77 | -------------------------------------------------------------------------------- /ats-format/man/atsfmt.1: -------------------------------------------------------------------------------- 1 | .\" Automatically generated by Pandoc 2.10.1 2 | .\" 3 | .TH "atsfmt (1)" "" "" "" "" 4 | .hy 5 | .SH NAME 6 | .PP 7 | atsfmt - a source code formatter for ATS 8 | .SH SYNOPSIS 9 | .PP 10 | atsfmt 11 | .PP 12 | atsfmt -i 13 | .PP 14 | atsfmt --default-config 15 | .PP 16 | cat file.dats | atsfmt 17 | .PP 18 | atsfmt --default-config 19 | .SH DESCRIPTION 20 | .PP 21 | \f[B]atsfmt\f[R] is an opinionated formatter for that ATS2 language. 22 | .SH OPTIONS 23 | .TP 24 | \f[B]-h\f[R] \f[B]--help\f[R] 25 | Display help 26 | .TP 27 | \f[B]-V\f[R] \f[B]--version\f[R] 28 | Display version information 29 | .TP 30 | \f[B]-o\f[R] \f[B]--no-config\f[R] 31 | Ignore configuration files in scope 32 | .TP 33 | \f[B]-i\f[R] 34 | Modify a file in-place. 35 | .TP 36 | \f[B]--default-config\f[R] 37 | Generate a default configuration file in the current directory 38 | .SH CONFIGURATION 39 | .PP 40 | \f[B]atsfmt\f[R] is configured using a TOML file, by default 41 | \&.atsfmt.toml. 42 | You can generate a default configuration with 43 | .IP 44 | .nf 45 | \f[C] 46 | atsfmt --default-config 47 | \f[R] 48 | .fi 49 | .PP 50 | To make \f[B]atsfmt\f[R] call clang-format on embedded C code, add the 51 | following to your .atsfmt.toml 52 | .IP 53 | .nf 54 | \f[C] 55 | clang-format = true 56 | \f[R] 57 | .fi 58 | .PP 59 | You can also set ribbon width and line width in the file, viz. 60 | .IP 61 | .nf 62 | \f[C] 63 | ribbon = 0.6 64 | width = 120 65 | \f[R] 66 | .fi 67 | .PP 68 | Ribbon width is the width of a line excluding indentation. 69 | In this example, the maximum column number will be 120 and the maximum 70 | ribbon width will be 0.6 * 120 = 72 characters. 71 | .SH EDITOR INTEGRATION 72 | .PP 73 | Editor integration is available with the ATS vim plugin at: 74 | .PP 75 | https://github.com/vmchale/ats-vim 76 | .SH COPYRIGHT 77 | .PP 78 | Copyright 2017-2019. 79 | Vanessa McHale. 80 | All Rights Reserved. 81 | .SH AUTHORS 82 | Vanessa McHale. 83 | -------------------------------------------------------------------------------- /ats-pkg/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # ats-pkg 2 | 3 | ## 3.5.0.2 4 | 5 | * Compat with Dhall >= 1.35.0 6 | 7 | ## 3.5.0.1 8 | 9 | * Bump config files 10 | 11 | ## 3.5.0.0 12 | 13 | * Remove `packageCompiler` 14 | 15 | ## 3.4.0.8 16 | 17 | * Drop `.bz2` decompression; support GHC 8.8.1 18 | 19 | ## 3.4.0.5 20 | 21 | * Pin Dhall package 22 | * More sensible verbosity flag 23 | 24 | ## 3.4.0.3 25 | 26 | * Support shake 0.18.4 27 | 28 | ## 3.4.0.1 29 | 30 | * Install manpages to `/usr/local/share/man/man1` on Mac 31 | * Disable optimizations when running `--debug` 32 | 33 | ## 3.4.0.0 34 | 35 | * Add `--debug` flag to `test` and `build` subcommands 36 | 37 | ## 3.3.0.6 38 | 39 | * Only run `./autogen.sh` when installing the compiler if 40 | `automake`/`autoconf` exist 41 | 42 | ## 3.3.0.5 43 | 44 | * Only run `cmake` when it exists 45 | 46 | ## 3.3.0.4 47 | 48 | * Fixes for Mac 49 | 50 | ## 3.3.0.3 51 | 52 | * Update manpages 53 | 54 | ## 3.3.0.1 55 | 56 | * Add `bench` subcommand to CLI 57 | 58 | ## 3.3.0.0 59 | 60 | * Add `bench` field to `Pkg` type 61 | 62 | ## 3.2.6.4 63 | 64 | * Upgrade to latest `dhall` 65 | 66 | ## 3.2.6.3 67 | 68 | * Better `clean` command 69 | 70 | ## 3.2.6.1 71 | 72 | * Display `language-ats` version when `--version` flag is passed 73 | 74 | ## 3.2.6.0 75 | 76 | * Add `license` and `changelog` field to `Debian` type 77 | * `lintian` doesn't object to debianizations anymore 78 | 79 | ## 3.2.5.14 80 | 81 | * Update for new Dhall library 82 | 83 | ## 3.2.5.13 84 | 85 | * Use new compiler in `atslib.dhall` 86 | 87 | ## 3.2.5.12 88 | 89 | * Use old Dhall prelude 90 | 91 | ## 3.2.5.11 92 | 93 | * Set UTF8 encoding in all cases 94 | 95 | ## 3.2.5.10 96 | 97 | * Use better URL 98 | 99 | ## 3.2.5.6 100 | 101 | * Use `libarchive` instead of `tar` 102 | * Change URL for compilers 103 | * Remove hidden `pack` command 104 | * Remove `packageCompiler` function 105 | * Update latest Dhall libraries 106 | 107 | ## 3.2.4.6 108 | 109 | * Bump Dhall libraries again 110 | 111 | ## 3.2.4.5 112 | 113 | * Bump Dhall libraries for new default compiler 114 | 115 | ## 3.2.4.4 116 | 117 | * Fix bug where `gc` version could not be constrained 118 | * Slightly improved behavior around C package versioning (allow package 119 | reinstalls) 120 | 121 | ## 3.2.4.2 122 | 123 | * Update `.dhall` files 124 | 125 | ## 3.2.4.0 126 | 127 | * Update to use `cpphs` again 128 | 129 | ## 3.2.3.0 130 | 131 | * Update to not use `cpphs` 132 | 133 | ## 3.2.2.4 134 | 135 | * Fix `dhall/atslib.dhall` file that is embedded into the binary 136 | 137 | ## 3.3.2.0 138 | 139 | * Update `Debian` type and adjust prelude accordingly 140 | * Allow Debian packages built to include header files and libraries. 141 | * Bug fixes related to Debian packaging. 142 | 143 | ## 3.2.1.8 144 | 145 | * Update Dhall prelude 146 | 147 | ## 3.2.1.2 148 | 149 | Bug Fixes: 150 | 151 | * Don't default to 4 processors 152 | * Use `getAppUserDirectory` for better portability 153 | 154 | Breaking Changes: 155 | 156 | * Only build C sources when sensible to do so 157 | -------------------------------------------------------------------------------- /ats-pkg/CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing to ATSPackage 2 | 3 | I emphatically welcome bug reports, issues you may encounter, documentation, and 4 | pull requests. I also emphatically welcome feature requests, though they will be 5 | implemented as I have time :) 6 | 7 | ## Getting started 8 | 9 | If you'd like ideas for ways to contribute, check the open issues or the 10 | `TODO.md` file. Feel free to 11 | open a PR or an issue if you want guidance on how to implement something. If 12 | you're new to Haskell, I can provide help. 13 | 14 | ## Rules etc. 15 | We follow the [rust standards of 16 | conduct](https://www.rust-lang.org/en-US/conduct.html), with the addendum that 17 | we are committed to providing a friendly, safe and welcoming environment 18 | regardless of sex worker status or previous sex worker status. 19 | 20 | In addition, please be aware that not everyone speaks English as a first 21 | language. 22 | -------------------------------------------------------------------------------- /ats-pkg/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Vanessa McHale (c) 2017-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 | -------------------------------------------------------------------------------- /ats-pkg/PACKAGES.md: -------------------------------------------------------------------------------- 1 | # Making Your Own Packages 2 | 3 | ## Specifying NPM Packages 4 | 5 | As many packages are already on 6 | [NPM](https://www.npmjs.com/search?q=atscntrb-&page=1&ranking=optimal), the 7 | `atspkg` Dhall 8 | [prelude](https://github.com/vmchale/atspkg/blob/master/ats-pkg/dhall/atspkg-prelude.dhall) 9 | provides a convenience function `makeNpmPkg`. You can use it like so: 10 | 11 | ```dhall 12 | let prelude = https://raw.githubusercontent.com/vmchale/atspkg/master/ats-pkg/dhall/atspkg-prelude.dhall 13 | in 14 | 15 | let intinf = 16 | λ(x : List Integer) → 17 | prelude.makeNpmPkg { x = x, name = "atscntrb-hx-intinf", unpackDir = "atscntrb-hx-intinf" } 18 | // { libDeps = prelude.mapPlainDeps [ "atscntrb-libgmp" ] } 19 | in intinf 20 | ``` 21 | 22 | Note also the use of `mapPlainDeps` - this simply says that we should depend on 23 | a package named `atscntrb-libgmp` but that we should not enforce any version 24 | constraints. 25 | 26 | ## Specifying Other Packages 27 | 28 | As `atspkg` simply needs a URL to make a package, you can create a packages 29 | hosted on github. In this example, we tag the repo to 30 | create tarballs for each version. 31 | 32 | ``` 33 | let prelude = https://raw.githubusercontent.com/vmchale/atspkg/master/ats-pkg/dhall/atspkg-prelude.dhall 34 | 35 | in λ(x : List Integer) → 36 | prelude.makePkgDescr 37 | { x = x 38 | , name = "either" 39 | , githubUsername = "vmchale" 40 | , description = "Generic sum types and utilities for working with them." 41 | } 42 | ``` 43 | 44 | ## Making Package Sets 45 | 46 | A package set is simply a list of packages in Dhall. 47 | The default package set is 48 | [`pkg-set.dhall`](https://github.com/vmchale/atspkg/blob/master/ats-pkg/pkgs/pkg-set.dhall), 49 | however, the user may select a custom package set if desired, but editing their 50 | `$HOME/.config/atspkg/config.dhall`. 51 | 52 | ```dhall 53 | let version = "master" 54 | in 55 | 56 | let cfg = 57 | { defaultPkgs = "https://raw.githubusercontent.com/vmchale/atspkg/${version}/ats-pkg/pkgs/pkg-set.dhall" 58 | , path = ([] : Optional Text) 59 | , githubUsername = "vmchale" 60 | , filterErrors = False 61 | } 62 | in cfg 63 | ``` 64 | 65 | The `deaultPkgs` field can take a filepath or a URL, so long as it is 66 | a valid Dhall expression. As it is a Dhall expression, users can also 67 | concatenate package sets from multiple sources if so desired. 68 | -------------------------------------------------------------------------------- /ats-pkg/TODO.md: -------------------------------------------------------------------------------- 1 | # Upstream 2 | - [ ] Investigate segfault in `atspkg setup`? 3 | # Features 4 | - [ ] `fetching...` should include version number. 5 | - [ ] shell completions should list targets (?) 6 | - [ ] custom build scripts in ATS (`setup.dats`) 7 | - [ ] Set number of threads manually 8 | - [ ] Initialize projects 9 | - [ ] Post-process Haskell documentation to link to ATS source? 10 | - [ ] Possibly pass `--disable-threads` to configure? 11 | - [ ] Detect `make` vs. `gmake` for BSDs 12 | - [ ] Name cross-compiled libraries appropriately 13 | # Libraries 14 | - [ ] `shake-ats` should allow builds with `patscc` some other way 15 | - [ ] Set target triple in `shake-ext`? 16 | - [ ] Release resolved Dhall library 17 | # Deficiencies 18 | - [ ] Use `discrimination` to get efficient linear sorts? 19 | - [ ] Cross-compiler should not rebuild full compiler, only static library 20 | - [ ] and even then only if necessary 21 | - [ ] Installations should be installed locally based on configuration 22 | - [ ] calculus of compatibility? algebra of compatibility? 23 | - [ ] `atspkg` should be able to build `atslib` and thus work for 24 | cross-compilation. 25 | - [ ] `triple` should be a configuration option 26 | - [ ] Make cross builds work for `Distribution.ATS` 27 | - [ ] Make `dpkg` stuff pass `lintian` 28 | # Generalizations 29 | - [ ] Make a `generic-package` library for `.a`, `.so`, and binary builds. 30 | # Bugs 31 | - [ ] Don't try to build test suite dependencies when doing a cross build 32 | - [ ] We should be able to build `.so` and `.a` files from one source file. 33 | - [ ] make paths portable for windows 34 | - [ ] We shouldn't include `ccomp/lib` when doing a cross build. 35 | - [ ] Always try to build `libats` with the right compiler version 36 | - [ ] Generated code causes lint check failure? 37 | # Documentation 38 | - [ ] Tutorial 39 | - [ ] User manual 40 | - [ ] Document how to pin Dhall versions 41 | # Code Quality 42 | - [ ] Test suite 43 | - [ ] Generate a `hpc` report 44 | -------------------------------------------------------------------------------- /ats-pkg/app/Language/ATS/Package/Dhall.hs: -------------------------------------------------------------------------------- 1 | module Language.ATS.Package.Dhall ( checkPkgSet 2 | , checkPkg 3 | ) where 4 | 5 | import Data.Dependency 6 | import qualified Data.Text as T 7 | import Language.ATS.Package 8 | import Quaalude 9 | 10 | -- | Check a @pkg.dhall@ file. 11 | checkPkg :: FilePath 12 | -> Bool 13 | -> IO (Version -> ATSDependency) 14 | checkPkg = checkDhall 15 | 16 | checkDhall :: FromDhall a 17 | => FilePath 18 | -> Bool 19 | -> IO a 20 | checkDhall path d = 21 | bool id detailed d $ 22 | input auto (T.pack ('.' : pathSeparator : path)) 23 | 24 | checkPkgSet :: FilePath -- ^ Path to @.dhall@ file defining a package set. 25 | -> Bool -- ^ Whether to print detailed error messages. 26 | -> IO ATSPackageSet 27 | checkPkgSet = checkDhall 28 | -------------------------------------------------------------------------------- /ats-pkg/app/Language/ATS/Package/Upgrade.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Language.ATS.Package.Upgrade ( upgradeBin 4 | ) where 5 | 6 | import qualified Data.ByteString.Lazy.Char8 as BSL 7 | import Data.Char (isDigit) 8 | import Quaalude 9 | import System.Info 10 | 11 | manufacturer :: String 12 | manufacturer = case os of 13 | "darwin" -> "apple" 14 | _ -> "unknown" 15 | 16 | targetArch :: String 17 | targetArch = g [arch, manufacturer, os] 18 | where g = fold . intersperse "-" 19 | 20 | atspkgPath :: IO String 21 | atspkgPath = do 22 | home <- getEnv "HOME" 23 | pure $ home ".local" "bin" "atspkg" 24 | 25 | upgradeBin :: String -> String -> IO () 26 | upgradeBin user proj = do 27 | 28 | let inner = user proj 29 | 30 | putStrLn "Finding latest release..." 31 | manager <- newManager tlsManagerSettings 32 | initialRequest <- parseRequest ("https://github.com/" ++ inner ++ "/releases/latest") 33 | response <- responseBody <$> httpLbs (initialRequest { method = "GET", redirectCount = 0 }) manager 34 | 35 | putStrLn "Downloading latest release..." 36 | let strVersion = BSL.takeWhile (/='"') . BSL.dropWhile (not . isDigit) . BSL.dropWhile (/='"') $ response 37 | binRequest = "https://github.com/" <> inner <> "/releases/download/" <> BSL.unpack strVersion <> "/atspkg-" <> targetArch 38 | followupRequest <- parseRequest binRequest 39 | binBytes <- responseBody <$> httpLbs (followupRequest { method = "GET" }) manager 40 | 41 | atsPath <- atspkgPath 42 | createDirectoryIfMissing True (takeDirectory atsPath) 43 | BSL.writeFile (atsPath ++ "-new") binBytes 44 | renameFile (atsPath ++ "-new") atsPath 45 | makeExecutable atsPath 46 | -------------------------------------------------------------------------------- /ats-pkg/dhall/.ctags: -------------------------------------------------------------------------------- 1 | --langdef=DHALL 2 | --langmap=DHALL:.dhall 3 | --regex-DHALL=/^let *([[:lower:]][[:alnum:]_]+)/\1/f,function/ 4 | --regex-DHALL=/^let *([[:upper:]][[:alnum:]_]+)/\1/t,type/ 5 | -------------------------------------------------------------------------------- /ats-pkg/dhall/atslib.dhall: -------------------------------------------------------------------------------- 1 | {- Dhall prelude imports -} 2 | let map = 3 | https://prelude.dhall-lang.org/v21.1.0/List/map.dhall 4 | sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 5 | 6 | let concat = 7 | https://prelude.dhall-lang.org/v21.1.0/List/concat.dhall 8 | sha256:54e43278be13276e03bd1afa89e562e94a0a006377ebea7db14c7562b0de292b 9 | 10 | let prelude = 11 | https://raw.githubusercontent.com/vmchale/atspkg/master/ats-pkg/dhall/atspkg-prelude.dhall 12 | sha256:69bdde38a8cc01c91a1808ca3f45c29fe754c9ac96e91e6abd785508466399b4 13 | 14 | let mapDir = 15 | λ(rec : { dir : Text, xs : List Text }) → 16 | map Text Text (λ(x : Text) → "${rec.dir}/DATS/${x}.dats") rec.xs 17 | 18 | let mapPre = λ(xs : List Text) → mapDir { dir = "prelude", xs } 19 | 20 | let mapC = λ(xs : List Text) → mapDir { dir = "libats/libc", xs } 21 | 22 | let mapML = λ(xs : List Text) → mapDir { dir = "libats/ML", xs } 23 | 24 | let atslib = 25 | λ(compilerVersion : List Natural) → 26 | λ(libVersion : List Natural) → 27 | prelude.default 28 | ⫽ { libraries = 29 | [ prelude.staticLib 30 | ⫽ { libTarget = "target/libatslib.a" 31 | , name = "atslib" 32 | , src = 33 | concat 34 | Text 35 | [ mapPre 36 | [ "bool" 37 | , "integer" 38 | , "basics" 39 | , "pointer" 40 | , "integer_long" 41 | , "integer_short" 42 | , "integer_size" 43 | , "char" 44 | , "float" 45 | , "string" 46 | , "strptr" 47 | , "integer_ptr" 48 | , "integer_fixed" 49 | , "filebas" 50 | ] 51 | , mapC 52 | [ "math" 53 | , "float" 54 | , "errno" 55 | , "fcntl" 56 | , "dirent" 57 | , "stdio" 58 | , "stdlib" 59 | , "string" 60 | , "strings" 61 | , "time" 62 | , "unistd" 63 | ] 64 | , mapML 65 | [ "list0" 66 | , "option0" 67 | , "array0" 68 | , "matrix0" 69 | , "string" 70 | , "strarr" 71 | , "gvalue" 72 | , "dynarray" 73 | , "hashtblref" 74 | , "filebas" 75 | , "filebas_dirent" 76 | ] 77 | ] 78 | , includes = [] : List Text 79 | } 80 | ] 81 | , cflags = [ "-fPIC" ] 82 | , compiler = compilerVersion 83 | , version = libVersion 84 | } 85 | 86 | in atslib [ 0, 3, 13 ] [ 0, 3, 13 ] 87 | -------------------------------------------------------------------------------- /ats-pkg/dhall/config.dhall: -------------------------------------------------------------------------------- 1 | let commit = "137c57c95135591c6627fffcc1ba75864b4c0918" 2 | 3 | let hash = 4 | "sha256:fa901519fa579dbb5ee187bc2c43c20b3c1f8ad2ff9129f393f1066a174b413d" 5 | 6 | in { defaultPkgs = 7 | "https://raw.githubusercontent.com/vmchale/atspkg/${commit}/ats-pkg/pkgs/pkg-set.dhall ${hash}" 8 | , path = None Text 9 | , githubUsername = "" 10 | , filterErrors = False 11 | } 12 | -------------------------------------------------------------------------------- /ats-pkg/docs/manual.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vmchale/atspkg/26cdd1ed1130a31e4bb4985fc54e50240228f7df/ats-pkg/docs/manual.pdf -------------------------------------------------------------------------------- /ats-pkg/docs/manual.tex: -------------------------------------------------------------------------------- 1 | \documentclass{article} 2 | 3 | \usepackage{amsmath} 4 | \usepackage{appendix} 5 | \usepackage{hyperref} 6 | \usepackage{siunitx} 7 | 8 | \usepackage[english]{babel} 9 | 10 | \begin{document} 11 | 12 | \title{ATSPackage user manual} 13 | \author{Vanessa McHale} 14 | \maketitle 15 | 16 | \tableofcontents 17 | 18 | \section{Introduction} 19 | 20 | ATSpackage is a build tool for ATS written in Haskell. There are three 21 | things it accomplishes: 22 | 23 | \begin{enumerate} 24 | \item Distributed builds. ATSPackage allows users depend on libraries that are 25 | hosted elsewhere. 26 | \item Simplified builds. As ATSPackage contains scripts to download the 27 | compiler, builds are easier for potential contributors. 28 | \item Haskell integration. ATSPackage has first-class support for building ATS 29 | code that depends on Haskell libraries and ATS code that depends on Haskell 30 | libraries. 31 | \end{enumerate} 32 | 33 | With that in mind, it is worthwhile to enumerate some things that it does 34 | \textit{not} accomplish: 35 | 36 | \begin{enumerate} 37 | \item Full flexibility of C. As ATSPackage is intended to simplify builds, it 38 | does not expose everything. This will likely not cause problems, provided 39 | that the libraries dependend on are written in C, ATS, or Haskell. 40 | \end{enumerate} 41 | 42 | \section{Package Resolution} 43 | 44 | As ATS is a statically typed language, some form of dependency resolution is 45 | necessary if we'd like to be able to share data structures between packages. 46 | 47 | \section{Builds} 48 | 49 | ATSPackage supports three build types: binary, dynamic library, and static 50 | library. 51 | 52 | \subsection{Binary Builds} 53 | 54 | ATSPackage allows 55 | 56 | \subsection{Binary Builds with Haskell Dependencies} 57 | 58 | ATSPackage allows binary builds with Haskell dependencies by allowing a package 59 | to depend on an object file generated by GHC. The object file can be generated 60 | by cabal, allowing full use of the Haskell ecosystem. 61 | 62 | ATSPackage can also generate data types for ATS based on Haskell types. You can 63 | use this to eliminate some of the work involved in writing FFI bindings, and 64 | particularly to avoid ATS' lack of generics. 65 | 66 | \end{document} 67 | -------------------------------------------------------------------------------- /ats-pkg/internal/System/Process/Ext.hs: -------------------------------------------------------------------------------- 1 | module System.Process.Ext ( silentCreateProcess 2 | ) where 3 | 4 | import Control.Monad 5 | import Development.Shake 6 | import System.Exit 7 | import System.Process 8 | 9 | verbosityErr :: Verbosity -> StdStream 10 | verbosityErr v | v >= Verbose = Inherit 11 | verbosityErr _ = CreatePipe 12 | 13 | handleExit :: ExitCode -> IO () 14 | handleExit ExitSuccess = mempty 15 | handleExit x = exitWith x 16 | 17 | silentCreateProcess :: Verbosity -> CreateProcess -> IO () 18 | silentCreateProcess v proc' | v >= Verbose = do 19 | (_, _, _, r) <- createProcess (proc' { std_err = verbosityErr v, std_out = Inherit }) 20 | handleExit =<< waitForProcess r 21 | silentCreateProcess v proc' = void $ readCreateProcess (proc' { std_err = verbosityErr v }) "" 22 | -------------------------------------------------------------------------------- /ats-pkg/man/MANPAGE.md: -------------------------------------------------------------------------------- 1 | % atspkg (1) 2 | % Vanessa McHale 3 | 4 | # NAME 5 | 6 | atspkg - a build tool for ATS 7 | 8 | # DESCRIPTION 9 | 10 | **atspkg** is a build tool for the ATS2 language, written in Haskell. 11 | 12 | # SYNOPSIS 13 | 14 | atspkg build 15 | 16 | atspkg install 17 | 18 | atspkg clean 19 | 20 | atspkg test 21 | 22 | # SUBCOMMANDS 23 | 24 | **build** - Build all binary targets listed in atspkg.dhall 25 | 26 | **test** - Run all tests listed in atspkg.dhall 27 | 28 | **bench** - Rull all benchmarks listed in atspkg.dhall 29 | 30 | **clean** - Clean current project directory 31 | 32 | **nuke** - Remove all local files installed by **atspkg** 33 | 34 | **remote** - Download a tarball from the given URL and try to build its binary 35 | targets 36 | 37 | **install** - Install binary targets to $HOME/.local/bin and relevant manpages 38 | to $HOME/.local/share/man/man1 39 | 40 | **upgrade** - Download the latest binary release of **atspkg**, if available 41 | 42 | **valgrind** - Run **valgrind** on the generated binary 43 | 44 | **run** - Run the generated binary 45 | 46 | **check** - Check a pkg.dhall file to make sure it is well-typed. 47 | 48 | **check-set** - Check a package set to make sure it is well-typed. 49 | 50 | **list** - List all available packages in current package set. 51 | 52 | **setup** - Set up manpages and shell completions. 53 | 54 | # OPTIONS 55 | 56 | **-h** **-\-help** 57 | : Display help 58 | 59 | **-V** **-\-version** 60 | : Display version information 61 | 62 | **-\-pkg-args** 63 | : Arguments to be passed to atspkg.dhall 64 | 65 | **-r**, **-\-rebuild** 66 | : Rebuild all binary targets. 67 | 68 | **-l**, **-\-no-lint** 69 | : Disable the build system linter 70 | 71 | **-t**, **-\-target** 72 | : Set the compilation target using its triple. 73 | 74 | **-v**, **-\-verbose** 75 | : Turn up the verbosity 76 | 77 | **-\-debug** 78 | : Disable binary stripping and pass -g to the C compiler 79 | 80 | # CONFIGURATION 81 | 82 | **atspkg** is configured with Dhall, in an atspkg.dhall file. **atspkg** can be 83 | configured to produce binary targets, static library targets, shared object 84 | files, or plain C targets. Artifacts can be linked against Haskell libraries if 85 | desired. 86 | 87 | There is also a file $HOME/.config/atspkg/config.dhall which can be used to 88 | configure all builds. 89 | 90 | ## TEMPLATES 91 | 92 | There are several templates available for **pi** (see 93 | https://crates.io/crates/project_init for more details). Several examples: 94 | 95 | ``` 96 | pi new ats project 97 | ``` 98 | 99 | ``` 100 | pi git vmchale/haskell-ats ambitious-project 101 | ``` 102 | 103 | ``` 104 | pi git vmchale/ats-haskell weird-project 105 | ``` 106 | 107 | # BUGS 108 | 109 | Please report any bugs you may come across to 110 | https://github.com/vmchale/atspkg/issues. 111 | 112 | # COPYRIGHT 113 | 114 | Copyright 2018-2020. Vanessa McHale. All Rights Reserved. 115 | -------------------------------------------------------------------------------- /ats-pkg/man/atspkg.1: -------------------------------------------------------------------------------- 1 | .\" Automatically generated by Pandoc 2.10.1 2 | .\" 3 | .TH "atspkg (1)" "" "" "" "" 4 | .hy 5 | .SH NAME 6 | .PP 7 | atspkg - a build tool for ATS 8 | .SH DESCRIPTION 9 | .PP 10 | \f[B]atspkg\f[R] is a build tool for the ATS2 language, written in 11 | Haskell. 12 | .SH SYNOPSIS 13 | .PP 14 | atspkg build 15 | .PP 16 | atspkg install 17 | .PP 18 | atspkg clean 19 | .PP 20 | atspkg test 21 | .SH SUBCOMMANDS 22 | .PP 23 | \f[B]build\f[R] - Build all binary targets listed in atspkg.dhall 24 | .PP 25 | \f[B]test\f[R] - Run all tests listed in atspkg.dhall 26 | .PP 27 | \f[B]bench\f[R] - Rull all benchmarks listed in atspkg.dhall 28 | .PP 29 | \f[B]clean\f[R] - Clean current project directory 30 | .PP 31 | \f[B]nuke\f[R] - Remove all local files installed by \f[B]atspkg\f[R] 32 | .PP 33 | \f[B]remote\f[R] - Download a tarball from the given URL and try to 34 | build its binary targets 35 | .PP 36 | \f[B]install\f[R] - Install binary targets to $HOME/.local/bin and 37 | relevant manpages to $HOME/.local/share/man/man1 38 | .PP 39 | \f[B]upgrade\f[R] - Download the latest binary release of 40 | \f[B]atspkg\f[R], if available 41 | .PP 42 | \f[B]valgrind\f[R] - Run \f[B]valgrind\f[R] on the generated binary 43 | .PP 44 | \f[B]run\f[R] - Run the generated binary 45 | .PP 46 | \f[B]check\f[R] - Check a pkg.dhall file to make sure it is well-typed. 47 | .PP 48 | \f[B]check-set\f[R] - Check a package set to make sure it is well-typed. 49 | .PP 50 | \f[B]list\f[R] - List all available packages in current package set. 51 | .PP 52 | \f[B]setup\f[R] - Set up manpages and shell completions. 53 | .SH OPTIONS 54 | .TP 55 | \f[B]-h\f[R] \f[B]--help\f[R] 56 | Display help 57 | .TP 58 | \f[B]-V\f[R] \f[B]--version\f[R] 59 | Display version information 60 | .TP 61 | \f[B]--pkg-args\f[R] 62 | Arguments to be passed to atspkg.dhall 63 | .TP 64 | \f[B]-r\f[R], \f[B]--rebuild\f[R] 65 | Rebuild all binary targets. 66 | .TP 67 | \f[B]-l\f[R], \f[B]--no-lint\f[R] 68 | Disable the build system linter 69 | .TP 70 | \f[B]-t\f[R], \f[B]--target\f[R] 71 | Set the compilation target using its triple. 72 | .TP 73 | \f[B]-v\f[R], \f[B]--verbose\f[R] 74 | Turn up the verbosity 75 | .TP 76 | \f[B]--debug\f[R] 77 | Disable binary stripping and pass -g to the C compiler 78 | .SH CONFIGURATION 79 | .PP 80 | \f[B]atspkg\f[R] is configured with Dhall, in an atspkg.dhall file. 81 | \f[B]atspkg\f[R] can be configured to produce binary targets, static 82 | library targets, shared object files, or plain C targets. 83 | Artifacts can be linked against Haskell libraries if desired. 84 | .PP 85 | There is also a file $HOME/.config/atspkg/config.dhall which can be used 86 | to configure all builds. 87 | .SS TEMPLATES 88 | .PP 89 | There are several templates available for \f[B]pi\f[R] (see 90 | https://crates.io/crates/project_init for more details). 91 | Several examples: 92 | .IP 93 | .nf 94 | \f[C] 95 | pi new ats project 96 | \f[R] 97 | .fi 98 | .IP 99 | .nf 100 | \f[C] 101 | pi git vmchale/haskell-ats ambitious-project 102 | \f[R] 103 | .fi 104 | .IP 105 | .nf 106 | \f[C] 107 | pi git vmchale/ats-haskell weird-project 108 | \f[R] 109 | .fi 110 | .SH BUGS 111 | .PP 112 | Please report any bugs you may come across to 113 | https://github.com/vmchale/atspkg/issues. 114 | .SH COPYRIGHT 115 | .PP 116 | Copyright 2018-2020. 117 | Vanessa McHale. 118 | All Rights Reserved. 119 | .SH AUTHORS 120 | Vanessa McHale. 121 | -------------------------------------------------------------------------------- /ats-pkg/pkgs/README.md: -------------------------------------------------------------------------------- 1 | # Packages 2 | 3 | This directory contains several package definitions I use to write ATS. 4 | 5 | ## Writing Your Own Packages 6 | 7 | Here are the contents of `atscntrb-hx-libpcre.dhall`. As you can see, defining 8 | a package is relatively simple: all it requires is a tarball and version 9 | information. 10 | 11 | ``` 12 | let prelude = https://raw.githubusercontent.com/vmchale/atspkg/master/dhall/atspkg-prelude.dhall 13 | 14 | in prelude.dep // 15 | { libName = "atscntrb-hx-libpcre" 16 | , dir = "${prelude.patsHome}/atscntrb-hx-libpcre" 17 | , url = "https://registry.npmjs.org/atscntrb-hx-libpcre/-/atscntrb-hx-libpcre-1.0.2.tgz" 18 | , libVersion = [0,1,2] 19 | } 20 | ``` 21 | 22 | ## Using Packages 23 | 24 | To use a package, simply call it by its name and ensure the package is listed in 25 | the package set you are using. 26 | 27 | As a minimal example: 28 | 29 | ``` 30 | let prelude = https://raw.githubusercontent.com/vmchale/atspkg/master/dhall/prelude.dhall 31 | 32 | in prelude.default // 33 | { bin = 34 | [ prelude.bin // 35 | { src = "src/project.dats" 36 | , target = "target/project" 37 | } 38 | ] 39 | , dependencies = prelude.mapPlainDeps [ "ats-concurrency" ] 40 | } 41 | ``` 42 | 43 | ATS Dependencies are for a whole project; you cannot yet set dependencies on 44 | a per-binary basis. 45 | -------------------------------------------------------------------------------- /ats-pkg/src/Distribution/ATS.hs: -------------------------------------------------------------------------------- 1 | module Distribution.ATS ( -- * Cabal helper functions 2 | cabalHooks 3 | , atsPolyglotBuild 4 | ) where 5 | 6 | import Distribution.ATS.Build 7 | -------------------------------------------------------------------------------- /ats-pkg/src/Distribution/ATS/Build.hs: -------------------------------------------------------------------------------- 1 | -- | Integration with @Cabal@. 2 | module Distribution.ATS.Build ( cabalHooks 3 | , atsPolyglotBuild 4 | ) where 5 | 6 | -- TODO use confHook to set extra-libraries and extra-lib-dirs ourselves? 7 | import Control.Concurrent.ParallelIO.Global 8 | import Distribution.PackageDescription 9 | import Distribution.Simple 10 | import Distribution.Simple.LocalBuildInfo 11 | import Language.ATS.Package.Build 12 | import Quaalude 13 | 14 | -- | Use this in place of 'defaultMain' for a simple build. 15 | atsPolyglotBuild :: IO () 16 | atsPolyglotBuild = 17 | defaultMainWithHooks cabalHooks *> 18 | stopGlobalPool 19 | 20 | configureCabal :: IO LocalBuildInfo -> IO LocalBuildInfo 21 | configureCabal = (<*>) $ do 22 | -- TODO get host triple from Platform of LocalBuildInfo 23 | build 1 False mempty 24 | libDir <- (<> [pathSeparator]) <$> getCurrentDirectory 25 | pure (modifyConf libDir) 26 | 27 | modifyBuildInfo :: String -> BuildInfo -> BuildInfo 28 | modifyBuildInfo libDir bi = let olds = extraLibDirs bi 29 | in bi { extraLibDirs = (libDir <>) <$> olds } 30 | 31 | modifyConf :: FilePath -- ^ New library directory (absolute) 32 | -> LocalBuildInfo 33 | -> LocalBuildInfo 34 | modifyConf libDir bi = let old = localPkgDescr bi 35 | in bi { localPkgDescr = modifyPkgDescr libDir old } 36 | 37 | modifyPkgDescr :: String -> PackageDescription -> PackageDescription 38 | modifyPkgDescr libDir pd = let old = library pd 39 | in pd { library = fmap (modifyLibrary libDir) old } 40 | 41 | modifyLibrary :: String -> Library -> Library 42 | modifyLibrary libDir lib = let old = libBuildInfo lib 43 | in lib { libBuildInfo = modifyBuildInfo libDir old } 44 | 45 | -- | Write a dummy file that will allow packaging to work. 46 | writeDummyFile :: IO () 47 | writeDummyFile = 48 | createDirectoryIfMissing True ("dist-newstyle" "lib") *> 49 | writeFile ("dist-newstyle" "lib" "empty") "" 50 | 51 | -- | This uses the users hooks as is @simpleUserHooks@, modified to build the 52 | -- ATS library. 53 | cabalHooks :: UserHooks 54 | cabalHooks = let defConf = confHook simpleUserHooks 55 | in simpleUserHooks { preConf = (writeDummyFile *>) .* preConf simpleUserHooks 56 | , confHook = configureCabal .* defConf } 57 | -- FIXME registration + installation/copy hooks 58 | -- ideally in a library of its own for C builds 59 | -------------------------------------------------------------------------------- /ats-pkg/src/Distribution/ATS/Version.hs: -------------------------------------------------------------------------------- 1 | module Distribution.ATS.Version ( atspkgVersion 2 | ) where 3 | 4 | import qualified Data.Version as V 5 | import qualified Paths_ats_pkg as P 6 | 7 | atspkgVersion :: V.Version 8 | atspkgVersion = P.version 9 | -------------------------------------------------------------------------------- /ats-pkg/src/Language/ATS/Package.hs: -------------------------------------------------------------------------------- 1 | module Language.ATS.Package ( buildAll 2 | , check 3 | , mkPkg 4 | , cleanAll 5 | , buildHelper 6 | -- * Ecosystem functionality 7 | , displayList 8 | , atspkgVersion 9 | -- * Types 10 | , Version (..) 11 | , Pkg (..) 12 | , Bin (..) 13 | , Lib (..) 14 | , Src (..) 15 | , ATSConstraint (..) 16 | , ATSDependency (..) 17 | , TargetPair (..) 18 | , ForeignCabal (..) 19 | , ATSPackageSet (..) 20 | , LibDep 21 | , DepSelector 22 | , PackageError (..) 23 | , Debian (..) 24 | -- * Lenses 25 | , dirLens 26 | ) where 27 | 28 | import Distribution.ATS.Version 29 | import Language.ATS.Package.Build 30 | import Language.ATS.Package.Compiler 31 | import Language.ATS.Package.Debian 32 | import Language.ATS.Package.Dependency 33 | import Language.ATS.Package.Error 34 | import Language.ATS.Package.PackageSet 35 | import Language.ATS.Package.Type 36 | -------------------------------------------------------------------------------- /ats-pkg/src/Language/ATS/Package/Build/C.hs: -------------------------------------------------------------------------------- 1 | module Language.ATS.Package.Build.C ( clibSetup 2 | , cpkgHome 3 | , allSubdirs 4 | ) where 5 | 6 | import Development.Shake.ATS 7 | import Development.Shake.C 8 | import qualified Development.Shake.Check as Check 9 | import GHC.Conc 10 | import Quaalude 11 | 12 | cpkgHome :: CCompiler -> IO FilePath 13 | cpkgHome cc' = getAppUserDataDirectory ("atspkg" ccToDir cc') 14 | 15 | allSubdirs :: FilePath -> IO [FilePath] 16 | allSubdirs [] = pure mempty 17 | allSubdirs d = do 18 | d' <- listDirectory d 19 | let d'' = (d ) <$> d' 20 | ds <- filterM doesDirectoryExist d'' 21 | ds' <- traverse allSubdirs ds 22 | pure $ join (ds : ds') 23 | 24 | ccForConfig :: CCompiler -> String 25 | ccForConfig = g . ccToString 26 | where g "icc" = "cc" 27 | g x = x 28 | 29 | makeExecutable' :: FilePath -> [FilePath] -> IO () 30 | makeExecutable' file dirs = do 31 | p <- findFile dirs file 32 | fold (makeExecutable <$> p) 33 | 34 | clibSetup :: Verbosity -- ^ Shake verbosity level 35 | -> CCompiler -- ^ C compiler 36 | -> String -- ^ Library name 37 | -> FilePath -- ^ Filepath to unpack to 38 | -> IO () 39 | clibSetup v cc' lib' p = do 40 | 41 | -- Find configure script and make it executable 42 | subdirs <- allSubdirs p 43 | configurePath <- findFile (p:subdirs) "configure" 44 | cmakeLists <- findFile (p:subdirs) "CMakeLists.txt" 45 | fold (makeExecutable <$> configurePath) 46 | makeExecutable' "install-sh" (p:subdirs) 47 | 48 | -- Set environment variables for configure script 49 | h <- cpkgHome cc' 50 | let procEnv = Just [("CC", ccForConfig cc'), ("CFLAGS" :: String, "-I" <> h "include -Wno-error -O2"), ("PATH", "/usr/bin:/bin")] 51 | 52 | biaxe [fold (configure v h <$> configurePath <*> pure procEnv), cmake v h cmakeLists, make v, install v] lib' p 53 | 54 | cmake :: Verbosity -> FilePath -> Maybe FilePath -> String -> FilePath -> IO () 55 | cmake _ _ Nothing _ _ = mempty 56 | cmake v prefixPath (Just cfgLists) _ _ = do 57 | let p = takeDirectory cfgLists 58 | cmakeB <- Check.cmake 59 | when cmakeB $ 60 | silentCreateProcess v ((proc "cmake" ["-DCMAKE_INSTALL_PREFIX:PATH=" ++ prefixPath, p]) { cwd = Just p }) 61 | 62 | configure :: Verbosity -> FilePath -> FilePath -> Maybe [(String, String)] -> String -> FilePath -> IO () 63 | configure v prefixPath configurePath procEnv lib' p = 64 | putStrLn ("configuring " ++ lib' ++ "...") *> 65 | silentCreateProcess v ((proc configurePath ["--prefix", prefixPath, "--host", host]) { cwd = Just p, env = procEnv }) 66 | 67 | findMakefile :: FilePath -> IO FilePath 68 | findMakefile p = do 69 | subdirs <- allSubdirs p 70 | mp <- findFile (p:subdirs) "Makefile" 71 | pure $ maybe p takeDirectory mp 72 | 73 | make :: Verbosity -> String -> FilePath -> IO () 74 | make v lib' p = do 75 | putStrLn ("building " ++ lib' ++ "...") 76 | p' <- findMakefile p 77 | cpus <- getNumCapabilities 78 | silentCreateProcess v ((proc makeExe ["-j" ++ show cpus]) { cwd = Just p' }) 79 | 80 | install :: Verbosity -> String -> FilePath -> IO () 81 | install v lib' p = do 82 | putStrLn ("installing " ++ lib' ++ "...") 83 | p' <- findMakefile p 84 | silentCreateProcess v ((proc makeExe ["install"]) { cwd = Just p' }) 85 | -------------------------------------------------------------------------------- /ats-pkg/src/Language/ATS/Package/Config.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE TemplateHaskell #-} 4 | 5 | module Language.ATS.Package.Config ( UserConfig (..) 6 | , mkUserConfig 7 | , cfgBin 8 | ) where 9 | 10 | import qualified Data.ByteString.Lazy as BSL 11 | import Data.FileEmbed 12 | import qualified Data.Text as T 13 | import Quaalude 14 | 15 | data UserConfig = UserConfig { defaultPkgs :: Text 16 | , path :: Maybe Text 17 | , githubUsername :: Text 18 | , filterErrors :: Bool 19 | } deriving (Generic, FromDhall, Binary) 20 | 21 | cfgFile :: String 22 | cfgFile = $(embedStringFile ("dhall" "config.dhall")) 23 | 24 | defaultFileConfig :: IO () 25 | defaultFileConfig = do 26 | dir <- getXdgDirectory XdgConfig "atspkg" 27 | createDirectoryIfMissing True dir 28 | writeFile (dir "config.dhall") cfgFile 29 | 30 | cfgBin :: (MonadIO m) => m FilePath 31 | cfgBin = liftIO $ getAppUserDataDirectory ("atspkg" "config") 32 | 33 | mkUserConfig :: Rules () 34 | mkUserConfig = do 35 | 36 | cfgBin' <- cfgBin 37 | 38 | join (unless 39 | <$> liftIO (doesFileExist cfgBin') 40 | <*> pure (g cfgBin')) 41 | 42 | where g cfgBin' = do 43 | 44 | cfg <- liftIO (getXdgDirectory XdgConfig ("atspkg" "config.dhall")) 45 | 46 | want [cfgBin'] 47 | 48 | readUserConfig cfg 49 | 50 | cfgBin' %> \_ -> do 51 | need [cfg] 52 | cfgContents <- liftIO $ input auto (T.pack cfg) 53 | liftIO $ BSL.writeFile cfgBin' (encode (cfgContents :: UserConfig)) 54 | 55 | readUserConfig :: FilePath -> Rules () 56 | readUserConfig cfg = do 57 | 58 | want [cfg] 59 | 60 | e <- liftIO $ doesFileExist cfg 61 | 62 | cfg %> \_ -> unless e $ 63 | liftIO defaultFileConfig 64 | -------------------------------------------------------------------------------- /ats-pkg/src/Language/ATS/Package/Error.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Language.ATS.Package.Error ( -- * Helper functions 4 | unrecognized 5 | , resolutionFailed 6 | -- * Types 7 | , PackageError (..) 8 | ) where 9 | 10 | import Data.Dependency 11 | import Quaalude 12 | import System.Exit 13 | 14 | unrecognized :: String -> IO a 15 | unrecognized = printErr . Unrecognized 16 | 17 | resolutionFailed :: ResolveError -> IO a 18 | resolutionFailed = printErr . DepErr 19 | 20 | data PackageError = Unrecognized String 21 | | DepErr ResolveError 22 | 23 | instance Pretty PackageError where 24 | pretty (Unrecognized t) = dullred "Error:" <+> "Unrecognized archive format when unpacking" <#> hang 2 (text t) <> linebreak 25 | pretty (DepErr d) = pretty d 26 | 27 | -- TODO monaderror? 28 | printErr :: PackageError -> IO a 29 | printErr e = putDoc (pretty e) *> exitFailure 30 | -------------------------------------------------------------------------------- /ats-pkg/test/data/hello-world/atspkg.dhall: -------------------------------------------------------------------------------- 1 | let prelude = https://raw.githubusercontent.com/vmchale/atspkg/master/ats-pkg/dhall/atspkg-prelude.dhall 2 | 3 | in prelude.default ⫽ 4 | { bin = 5 | [ prelude.bin ⫽ 6 | { src = "src/hello-world.dats" 7 | , target = "target/hello-world" 8 | } 9 | ] 10 | , atsLib = False 11 | } 12 | -------------------------------------------------------------------------------- /ats-pkg/test/data/hello-world/src/hello-world.dats: -------------------------------------------------------------------------------- 1 | implement main0 () = 2 | println!("Hello, World!") 3 | 4 | -------------------------------------------------------------------------------- /bash/install.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | 3 | set -e 4 | set pipefail 5 | 6 | getTarget() { 7 | if [ "$(uname)" = "Darwin" ] 8 | then 9 | echo "atspkg-$(uname -m)-apple-darwin" 10 | else 11 | echo "atspkg-$(uname -m)-unknown-linux" 12 | fi 13 | } 14 | 15 | addBin() { 16 | 17 | printf 'export PATH=$HOME/.local/bin:$PATH' >> "$HOME"/.bashrc 18 | export PATH=$HOME/.local/bin:$PATH 19 | 20 | } 21 | 22 | main() { 23 | 24 | 25 | mkdir -p "$HOME/.local/bin" 26 | mkdir -p "$HOME/.local/share/man/man1/" 27 | 28 | latest="$(curl -Ls -o /dev/null -w %\{url_effective\} https://github.com/vmchale/atspkg/releases/latest | cut -d'"' -f2 | rev | cut -d'/' -f1 | rev)" 29 | binname=$(getTarget) 30 | 31 | url="https://github.com/vmchale/atspkg/releases/download/$latest/$binname" 32 | man_url="https://github.com/vmchale/atspkg/releases/download/$latest/atspkg.1" 33 | 34 | man_dest=$HOME/.local/share/man/man1/atspkg.1 35 | dest=$HOME/.local/bin/atspkg 36 | 37 | if command -v wget > /dev/null ; then 38 | wget "$url" -O "$dest" 39 | wget "$man_url" -O "$man_dest" 40 | else 41 | curl -L "$url" -o "$dest" 42 | curl -L "$man_url" -o "$man_dest" 43 | fi 44 | 45 | chmod +x "$dest" 46 | 47 | case :$PATH: in 48 | *:$HOME/.local/bin:*) ;; 49 | *) addBin ;; 50 | esac 51 | 52 | } 53 | 54 | main 55 | -------------------------------------------------------------------------------- /bash/manpages: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | pandoc ats-format/man/MANPAGE.md -s -t man -o ats-format/man/atsfmt.1 4 | pandoc ats-pkg/man/MANPAGE.md -s -t man -o ats-pkg/man/atspkg.1 5 | -------------------------------------------------------------------------------- /bash/prof-install: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -e 4 | 5 | cabal build exe:atsfmt -w ghc-8.8.2 --enable-profiling 6 | cp "$(fd -t x '^atsfmt$' -I)" ~/.local/bin/atsfmt-prof 7 | -------------------------------------------------------------------------------- /bash/upload: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | version="$(grep -P -o '\d+\.\d+\.\d+\.\d+' "ats-pkg/ats-pkg.cabal" | head -n1)" 4 | token=$(cat "$HOME"/.git-token) 5 | 6 | # TODO: static release 7 | # /opt/ghc/bin/cabal-3.0 new-build -w ghc-8.4.4 --enable-executable-static 8 | 9 | github-release release -s "$token" -u vmchale -r atspkg -t "$version" 10 | github-release upload --replace -s "$token" -u vmchale -r atspkg -n atspkg.1 -f ats-pkg/man/atspkg.1 -t "$version" 11 | github-release upload --replace -s "$token" -u vmchale -r atspkg -n atsfmt.1 -f ats-format/man/atsfmt.1 -t "$version" 12 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: language-ats 2 | , ats-pkg 3 | , ats-format 4 | , shake-ats 5 | , dependency 6 | , hs2ats 7 | , shake-cabal 8 | , shake-c 9 | 10 | constraints: 11 | ats-format -development -static -profile, 12 | ats-pkg -development -eventlog -profile, 13 | shake-ext -development, 14 | language-ats +development, 15 | shake-ats -development, 16 | ats-setup +development, 17 | hs2ats +development, 18 | shake-cabal -development, 19 | shake-c -development, 20 | zlib -pkg-config +bundled-c-zlib, 21 | libarchive +static 22 | 23 | executable-stripping: true 24 | 25 | optimization: 2 26 | 27 | program-options 28 | happy-options: -gcsa 29 | alex-options: -g 30 | 31 | max-backjumps: 120000 32 | -------------------------------------------------------------------------------- /dependency/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # dependency 2 | 3 | ## 1.2.0.3 4 | 5 | * Fewer dependencies 6 | -------------------------------------------------------------------------------- /dependency/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Vanessa McHale (c) 2018 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 | -------------------------------------------------------------------------------- /dependency/README.md: -------------------------------------------------------------------------------- 1 | # dependency 2 | 3 | A (not fully working) library for dependency resolution. 4 | -------------------------------------------------------------------------------- /dependency/TODO.md: -------------------------------------------------------------------------------- 1 | # Performance 2 | - [ ] Tweak vs. benchmarks a bit 3 | # Bugs 4 | - [ ] Should check for circular dependencies 5 | # Code maintenance 6 | - [ ] Make test suite more thorough 7 | - [ ] look at https://github.com/snowleopard/alga ? 8 | -------------------------------------------------------------------------------- /dependency/bench/Bench.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TupleSections #-} 2 | 3 | module Main where 4 | 5 | import Control.Arrow 6 | import Criterion.Main 7 | import Data.Dependency 8 | import qualified Data.Map as M 9 | import qualified Data.Set as S 10 | 11 | free :: Dependency 12 | free = Dependency "free" mempty defV 13 | 14 | comonad :: Dependency 15 | comonad = Dependency "comonad" mempty defV 16 | 17 | lens :: Dependency 18 | lens = Dependency "lens" ((,mempty) <$> ["free", "comonad"]) defV 19 | 20 | defV :: Version 21 | defV = Version [0,1,0] 22 | 23 | microlens :: Dependency 24 | microlens = Dependency "microlens" mempty defV 25 | 26 | bifunctors :: Dependency 27 | bifunctors = Dependency "bifunctors" ((,mempty) <$> ["comonad"]) defV 28 | 29 | deps :: [Dependency] 30 | deps = [free, lens, comonad] 31 | 32 | mapSingles :: [(d, b)] -> [(d, S.Set b)] 33 | mapSingles = fmap (second S.singleton) 34 | 35 | set :: PackageSet Dependency 36 | set = PackageSet $ M.fromList (mapSingles [("lens", lens), ("comonad", comonad), ("free", free)]) 37 | 38 | main :: IO () 39 | main = 40 | defaultMain [ bgroup "resolveDependencies" 41 | [ bench "3" $ nf (resolveDependencies set) [lens] 42 | , bench "6" $ nf (resolveDependencies set) [lens, microlens, bifunctors] ] 43 | ] 44 | -------------------------------------------------------------------------------- /dependency/dependency.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.18 2 | name: dependency 3 | version: 1.2.0.3 4 | license: BSD3 5 | license-file: LICENSE 6 | copyright: Copyright: (c) 2018 Vanessa McHale 7 | maintainer: vamchale@gmail.com 8 | author: Vanessa McHale 9 | synopsis: Dependency resolution for package management 10 | description: 11 | A library for resolving dependencies; uses a topological sort to construct a build plan and then allows choice between all compatible plans. 12 | 13 | category: Development, Build 14 | build-type: Simple 15 | extra-doc-files: 16 | README.md 17 | CHANGELOG.md 18 | 19 | source-repository head 20 | type: darcs 21 | location: https://hub.darcs.net/vmchale/ats 22 | 23 | library 24 | exposed-modules: Data.Dependency 25 | hs-source-dirs: src 26 | other-modules: 27 | Data.Dependency.Type 28 | Data.Dependency.Error 29 | Data.Dependency.Sort 30 | 31 | default-language: Haskell2010 32 | other-extensions: 33 | DeriveAnyClass DeriveGeneric OverloadedStrings DeriveFoldable 34 | DeriveFunctor TupleSections 35 | 36 | ghc-options: 37 | -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates 38 | -Wcompat 39 | 40 | build-depends: 41 | base >=4.9 && <5, 42 | ansi-wl-pprint -any, 43 | containers >=0.5.9, 44 | microlens >=0.3.5.0, 45 | binary >=0.7.3.0, 46 | deepseq -any 47 | 48 | test-suite dependency-test 49 | type: exitcode-stdio-1.0 50 | main-is: Spec.hs 51 | hs-source-dirs: test 52 | default-language: Haskell2010 53 | other-extensions: TupleSections 54 | ghc-options: 55 | -threaded -rtsopts -with-rtsopts=-N -Wall -Wincomplete-uni-patterns 56 | -Wincomplete-record-updates -Wcompat 57 | 58 | build-depends: 59 | base -any, 60 | dependency -any, 61 | hspec -any, 62 | containers -any 63 | 64 | benchmark dependency-bench 65 | type: exitcode-stdio-1.0 66 | main-is: Bench.hs 67 | hs-source-dirs: bench 68 | default-language: Haskell2010 69 | other-extensions: TupleSections 70 | ghc-options: 71 | -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates 72 | -Wcompat 73 | 74 | build-depends: 75 | base -any, 76 | dependency -any, 77 | containers -any, 78 | criterion -any 79 | -------------------------------------------------------------------------------- /dependency/src/Data/Dependency/Error.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | 5 | module Data.Dependency.Error ( ResolveError (..) 6 | , DepM 7 | ) where 8 | 9 | import Control.DeepSeq 10 | import Data.Foldable (fold) 11 | import GHC.Generics (Generic) 12 | import Text.PrettyPrint.ANSI.Leijen 13 | 14 | type DepM = Either ResolveError 15 | 16 | -- | An error that can occur during package resolution. 17 | data ResolveError = InternalError 18 | | NotPresent String 19 | | Conflicts [String] String 20 | | CircularDependencies String String 21 | deriving (Show, Eq, NFData, Generic) 22 | 23 | instance Pretty ResolveError where 24 | pretty InternalError = red "Error:" <+> "the" <+> squotes "dependency" <+> "package enountered an internal error. Please report this as a bug:\n" <> hang 2 "https://hub.darcs.net/vmchale/ats/issues" 25 | pretty (NotPresent s) = red "Error:" <+> "the package" <+> squotes (text s) <+> "could not be found.\n" 26 | pretty (Conflicts ss s) = red "Error:" <+> "the package" <+> squotes (text s) <+> "conflicts with already in-scope packages: " <+> fold (punctuate ", " (fmap (squotes . text) ss)) 27 | pretty (CircularDependencies s s') = red "Error:" <+> "package" <+> squotes (text s) <+> "and package" <+> squotes (text s') <+> "form a cycle of dependencies" 28 | -------------------------------------------------------------------------------- /dependency/src/Data/Dependency/Sort.hs: -------------------------------------------------------------------------------- 1 | module Data.Dependency.Sort ( sortDeps 2 | ) where 3 | 4 | import Data.Dependency.Type 5 | import Data.Graph 6 | import Lens.Micro 7 | import Lens.Micro.Extras 8 | 9 | asGraph :: [Dependency] -> (Graph, Vertex -> Dependency) 10 | asGraph ds = (f triple, keys) 11 | where triple = graphFromEdges (zip3 ds (_libName <$> ds) (fmap fst . _libDependencies <$> ds)) 12 | f = view _1 13 | s = view _2 14 | keys = view _1 . s triple 15 | 16 | -- | Topologically sort dependencies 17 | sortDeps :: [Dependency] -> [Dependency] 18 | sortDeps ds = fmap find . topSort $ g 19 | where (g, find) = asGraph ds 20 | -------------------------------------------------------------------------------- /dependency/src/Data/Dependency/Type.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveFoldable #-} 3 | {-# LANGUAGE DeriveFunctor #-} 4 | {-# LANGUAGE DeriveGeneric #-} 5 | 6 | module Data.Dependency.Type ( Dependency (..) 7 | , Version (..) 8 | , Constraint (..) 9 | , PackageSet (..) 10 | -- * Helper functions 11 | , check 12 | ) where 13 | 14 | import Control.DeepSeq (NFData) 15 | import Data.Binary 16 | import Data.List (intercalate) 17 | import qualified Data.Map as M 18 | import Data.Semigroup 19 | import qualified Data.Set as S 20 | import GHC.Generics (Generic) 21 | import GHC.Natural (Natural) 22 | 23 | -- | A package set is simply a map between package names and a set of packages. 24 | newtype PackageSet a = PackageSet { _packageSet :: M.Map String (S.Set a) } 25 | deriving (Eq, Ord, Foldable, Generic, Binary) 26 | 27 | newtype Version = Version [Natural] 28 | deriving (Eq, Generic, NFData, Binary) 29 | 30 | instance Show Version where 31 | show (Version is) = intercalate "." (show <$> is) 32 | 33 | instance Ord Version where 34 | (Version []) <= _ = True 35 | _ <= (Version []) = False 36 | (Version (x:xs)) <= (Version (y:ys)) 37 | | x == y = Version xs <= Version ys 38 | | otherwise = x <= y 39 | 40 | -- | Monoid/functor for representing constraints. 41 | data Constraint a = LessThanEq a 42 | | GreaterThanEq a 43 | | Eq a 44 | | Bounded (Constraint a) (Constraint a) 45 | | None 46 | deriving (Show, Eq, Ord, Functor, Generic, NFData) 47 | 48 | instance Semigroup (Constraint a) where 49 | (<>) None x = x 50 | (<>) x None = x 51 | (<>) x y = Bounded x y 52 | 53 | instance Monoid (Constraint a) where 54 | mempty = None 55 | mappend = (<>) 56 | 57 | -- | A generic dependency, consisting of a package name and version, as well as 58 | -- dependency names and their constraints. 59 | data Dependency = Dependency { _libName :: String 60 | , _libDependencies :: [(String, Constraint Version)] 61 | , _libVersion :: Version 62 | } 63 | deriving (Show, Eq, Ord, Generic, NFData) 64 | 65 | -- | Check a given dependency is compatible with in-scope dependencies. 66 | check :: Dependency -> [Dependency] -> Bool 67 | check (Dependency ln _ v) ds = and [ g ds' | (Dependency _ ds' _) <- ds ] 68 | where g = all ((`satisfies` v) . snd) . filter ((== ln) . fst) 69 | 70 | satisfies :: (Ord a) => Constraint a -> a -> Bool 71 | satisfies (LessThanEq x) y = x >= y 72 | satisfies (GreaterThanEq x) y = x <= y 73 | satisfies (Eq x) y = x == y 74 | satisfies (Bounded x y) z = satisfies x z && satisfies y z 75 | satisfies None _ = True 76 | -------------------------------------------------------------------------------- /dependency/test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TupleSections #-} 2 | -- vim: syntax=hspec 3 | 4 | import Control.Arrow 5 | import Data.Dependency 6 | import qualified Data.Map as M 7 | import qualified Data.Set as S 8 | import Test.Hspec 9 | 10 | free :: Dependency 11 | free = Dependency "free" mempty defV 12 | 13 | comonad :: Dependency 14 | comonad = Dependency "comonad" mempty defV 15 | 16 | newLens :: Dependency 17 | newLens = Dependency "lens" ((,mempty) <$> ["free", "comonad"]) (Version [0,2,0]) 18 | 19 | lens :: Dependency 20 | lens = Dependency "lens" ((,mempty) <$> ["free", "comonad"]) defV 21 | 22 | defV :: Version 23 | defV = Version [0,1,0] 24 | 25 | specNew :: Dependency 26 | specNew = Dependency "spec" mempty (Version [0,2,0]) 27 | 28 | specOld :: Dependency 29 | specOld = Dependency "spec" ((,LessThanEq (Version [0,1,0])) <$> ["spec"]) (Version [0,1,0]) 30 | 31 | ghcMod :: Dependency 32 | ghcMod = Dependency "ghc-mod" [("lens", LessThanEq defV)] defV 33 | 34 | mapSingles :: [(d, b)] -> [(d, S.Set b)] 35 | mapSingles = fmap (second S.singleton) 36 | 37 | set' :: PackageSet Dependency 38 | set' = PackageSet $ 39 | M.singleton "spec" (S.fromList [specOld, specNew]) 40 | 41 | set :: PackageSet Dependency 42 | set = PackageSet $ 43 | M.fromList (("lens", S.fromList [lens, newLens]) : 44 | mapSingles [("ghc-mod", ghcMod), ("comonad", comonad), ("free", free)]) 45 | 46 | main :: IO () 47 | main = hspec $ parallel $ 48 | describe "resolveDependencies" $ do 49 | it "correctly resolves dependencies in a package set" $ 50 | resolveDependencies set [newLens] `shouldBe` Right [[free, comonad], [newLens]] 51 | it "correctly resolves dependencies in a package set" $ 52 | resolveDependencies set [ghcMod] `shouldBe` Right [[free, comonad], [lens], [ghcMod]] 53 | it "correctly resolves dependencies in a package set" $ 54 | resolveDependencies set' [specOld] `shouldBe` Right [[specOld]] 55 | -------------------------------------------------------------------------------- /hs2ats/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # hs2ats 2 | 3 | ## 0.5.0.1 4 | 5 | * Remove `composition-prelude` dependency 6 | 7 | ## 0.5.0.0 8 | 9 | * Re-add `cpphs` dependency 10 | 11 | ## 0.4.0.0 12 | 13 | * Stop depending on `cpphs` 14 | 15 | ## 0.3.0.4 16 | 17 | * Allow newer `language-ats` 18 | -------------------------------------------------------------------------------- /hs2ats/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Vanessa McHale (c) 2018-2019 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 | -------------------------------------------------------------------------------- /hs2ats/README.md: -------------------------------------------------------------------------------- 1 | # hs2ats 2 | 3 | This is a tool to convert Haskell types to ATS types. 4 | 5 | Example use: 6 | 7 | ``` 8 | hs2ats --src DataTypes.hs --target generated_types.sats 9 | ``` 10 | 11 | Note that `hs2ats` does not preserve strictness semantics. 12 | 13 | ## Installation 14 | 15 | Install [cabal](https://www.haskell.org/cabal/download.html). Then: 16 | 17 | ``` 18 | cabal new-install hs2ats 19 | ``` 20 | -------------------------------------------------------------------------------- /hs2ats/TODO.md: -------------------------------------------------------------------------------- 1 | # Deficiencies 2 | - [ ] Error reporting is poor. 3 | - [ ] Support Happy/Alex? 4 | -------------------------------------------------------------------------------- /hs2ats/app/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE TypeOperators #-} 6 | 7 | module Main where 8 | 9 | import Data.Function ((&)) 10 | import Language.ATS.Generate 11 | import Options.Generic 12 | 13 | data Program = Program { src :: FilePath "Haskell source file" 14 | , target :: FilePath "ATS target" 15 | , cpphs :: Bool "Use cpphs as a preprocessor" 16 | } deriving (Generic, ParseRecord) 17 | 18 | main :: IO () 19 | main = do 20 | x <- getRecord "Generate ATS types for Haskell source code" :: IO Program 21 | let go = (x &) . (unHelpful .) 22 | genATSTypes (go src) (go target) (go cpphs) 23 | -------------------------------------------------------------------------------- /hs2ats/bench/Bench.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Criterion.Main 4 | import Language.ATS.Generate 5 | 6 | main :: IO () 7 | main = 8 | defaultMain [ env file $ \f -> 9 | bgroup "generateATS" 10 | [ bench "test/data/HigherOrder.hs" $ nf generateATS f ] 11 | ] 12 | where file = readFile "test/data/HigherOrder.hs" 13 | -------------------------------------------------------------------------------- /hs2ats/hs2ats.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.18 2 | name: hs2ats 3 | version: 0.5.0.1 4 | license: BSD3 5 | license-file: LICENSE 6 | copyright: Copyright: (c) 2018-2019 Vanessa McHale 7 | maintainer: vamchale@gmail.com 8 | author: Vanessa McHale 9 | synopsis: Create ATS types from Haskell types 10 | description: 11 | This package enables scanning Haskell source files for data types and then generating [ATS](http://www.ats-lang.org/) types from them. 12 | 13 | category: Language, Haskell, ATS 14 | build-type: Simple 15 | extra-source-files: 16 | test/data/*.hs 17 | test/data/*.out 18 | 19 | extra-doc-files: 20 | CHANGELOG.md 21 | README.md 22 | 23 | flag development 24 | description: Enable `-Werror` 25 | default: False 26 | manual: True 27 | 28 | library 29 | exposed-modules: Language.ATS.Generate 30 | hs-source-dirs: src 31 | other-modules: Language.ATS.Generate.Error 32 | default-language: Haskell2010 33 | other-extensions: 34 | DeriveAnyClass DeriveGeneric OverloadedStrings StandaloneDeriving 35 | PatternSynonyms 36 | 37 | ghc-options: -Wall 38 | build-depends: 39 | base >=4.7 && <5, 40 | haskell-src-exts >=1.18.0, 41 | language-ats >=1.5.0.0, 42 | casing -any, 43 | microlens -any, 44 | ansi-wl-pprint -any, 45 | deepseq -any, 46 | cpphs -any 47 | 48 | if flag(development) 49 | ghc-options: -Werror 50 | 51 | if impl(ghc >=8.0) 52 | ghc-options: -Wincomplete-uni-patterns -Wincomplete-record-updates 53 | 54 | executable hs2ats 55 | main-is: Main.hs 56 | hs-source-dirs: app 57 | default-language: Haskell2010 58 | other-extensions: 59 | DataKinds DeriveAnyClass DeriveGeneric OverloadedStrings 60 | TypeOperators 61 | 62 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 63 | build-depends: 64 | base -any, 65 | optparse-generic -any, 66 | hs2ats -any 67 | 68 | if flag(development) 69 | ghc-options: -Werror 70 | 71 | if impl(ghc >=8.0) 72 | ghc-options: -Wincomplete-uni-patterns -Wincomplete-record-updates 73 | 74 | test-suite hs2ats-test 75 | type: exitcode-stdio-1.0 76 | main-is: Spec.hs 77 | hs-source-dirs: test 78 | default-language: Haskell2010 79 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 80 | build-depends: 81 | base -any, 82 | hs2ats -any, 83 | hspec -any, 84 | hspec-dirstream -any, 85 | system-filepath -any 86 | 87 | if flag(development) 88 | ghc-options: -Werror 89 | 90 | if impl(ghc >=8.0) 91 | ghc-options: -Wincomplete-uni-patterns -Wincomplete-record-updates 92 | 93 | benchmark hs2ats-bench 94 | type: exitcode-stdio-1.0 95 | main-is: Bench.hs 96 | hs-source-dirs: bench 97 | default-language: Haskell2010 98 | ghc-options: -Wall 99 | build-depends: 100 | base -any, 101 | hs2ats -any, 102 | criterion -any 103 | 104 | if flag(development) 105 | ghc-options: -Werror 106 | 107 | if impl(ghc >=8.0) 108 | ghc-options: -Wincomplete-uni-patterns -Wincomplete-record-updates 109 | -------------------------------------------------------------------------------- /hs2ats/src/Language/ATS/Generate/Error.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-orphans #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE StandaloneDeriving #-} 6 | 7 | module Language.ATS.Generate.Error ( -- * Types 8 | GenerateError (..) 9 | , ErrM 10 | -- * Functions 11 | , displayErr 12 | -- * Helper functions 13 | , unsupported 14 | , syntaxError 15 | , malformed 16 | ) where 17 | 18 | import Control.DeepSeq (NFData) 19 | import GHC.Generics (Generic) 20 | import Language.Haskell.Exts hiding (Pretty, loc) 21 | import System.IO (stderr) 22 | import Text.PrettyPrint.ANSI.Leijen 23 | 24 | deriving instance NFData SrcLoc 25 | 26 | displayErr :: GenerateError -> IO () 27 | displayErr = hPutDoc stderr . pretty 28 | 29 | type ErrM a = Either GenerateError a 30 | 31 | syntaxError :: SrcLoc -> String -> ErrM a 32 | syntaxError = (Left .) . HaskellSyntaxError 33 | 34 | unsupported :: String -> ErrM a 35 | unsupported = Left . Unsupported 36 | 37 | malformed :: String -> ErrM a 38 | malformed = Left . Malformed 39 | 40 | data GenerateError = Unsupported String 41 | | HaskellSyntaxError SrcLoc String 42 | | Internal String 43 | | Malformed String 44 | deriving (Eq, Show, Generic, NFData) 45 | 46 | instance Pretty GenerateError where 47 | pretty (Unsupported s) = dullyellow "Warning:" <+> "skipping unsupported construct" <$$> indent 2 (squotes (text s)) <> linebreak 48 | pretty (HaskellSyntaxError loc s) = dullred "Error:" <+> "failed to parse" <+> text (show loc) <> colon <$$> indent 2 (text s) <> linebreak 49 | pretty (Internal s) = dullred "Error:" <+> "internal error: " <$$> indent 2 (text s) <> linebreak 50 | pretty (Malformed s) = dullred "Error:" <+> "incompatible type" <$$> indent 2 (squotes (text s)) <> linebreak 51 | -------------------------------------------------------------------------------- /hs2ats/test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | import qualified Filesystem.Path.CurrentOS as F 4 | import Language.ATS.Generate 5 | import Test.Hspec 6 | import Test.Hspec.Dirstream 7 | 8 | -- process test/data/Pair.out w/ patscc -dd 9 | 10 | isATS :: F.FilePath -> Bool 11 | isATS x = (extension x `elem`) (pure <$> ["hs", "hsig", "hs-boot", "x", "y"]) 12 | 13 | main :: IO () 14 | main = hspec $ 15 | describe "generateATS" $ parallel $ 16 | testFiles "test/data" isATS (fmap fst . generateATS "") 17 | -------------------------------------------------------------------------------- /hs2ats/test/data/HigherOrder.hs: -------------------------------------------------------------------------------- 1 | data GenericSum a b = GenericL a 2 | | GenericR b 3 | 4 | newtype GenericSumInt = GenericSumInt (GenericSum String Int) 5 | -------------------------------------------------------------------------------- /hs2ats/test/data/HigherOrder.out: -------------------------------------------------------------------------------- 1 | datavtype generic_sum(a: vt@ype, b: vt@ype) = 2 | | Generic_l of a 3 | | Generic_r of b 4 | 5 | vtypedef generic_sum_int = generic_sum(Strptr1, int) 6 | -------------------------------------------------------------------------------- /hs2ats/test/data/Newtype.hs: -------------------------------------------------------------------------------- 1 | module Newtype where 2 | 3 | newtype IntType = IntType Int 4 | -------------------------------------------------------------------------------- /hs2ats/test/data/Newtype.out: -------------------------------------------------------------------------------- 1 | vtypedef int_type = int 2 | -------------------------------------------------------------------------------- /hs2ats/test/data/Option.hs: -------------------------------------------------------------------------------- 1 | module Option where 2 | 3 | data Option a = Some a 4 | | None 5 | -------------------------------------------------------------------------------- /hs2ats/test/data/Option.out: -------------------------------------------------------------------------------- 1 | datavtype option(a: vt@ype) = 2 | | Some of a 3 | | None 4 | -------------------------------------------------------------------------------- /hs2ats/test/data/Pair.hs: -------------------------------------------------------------------------------- 1 | module Pair where 2 | 3 | data Pair = Pair { first :: Int, second :: Int } 4 | -------------------------------------------------------------------------------- /hs2ats/test/data/Pair.out: -------------------------------------------------------------------------------- 1 | vtypedef pair = @{ first = int, second = int } 2 | -------------------------------------------------------------------------------- /hs2ats/test/data/SumType.hs: -------------------------------------------------------------------------------- 1 | module SumType where 2 | 3 | data Num = FloatNum Float 4 | | IntNum Int 5 | -------------------------------------------------------------------------------- /hs2ats/test/data/SumType.out: -------------------------------------------------------------------------------- 1 | datavtype num = 2 | | Float_num of float 3 | | Int_num of int 4 | -------------------------------------------------------------------------------- /language-ats/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # language-ats 2 | 3 | # 1.7.10.3 4 | 5 | * Fix bug whereby `&$GMP.mpz >> _` was parsed incorrectly. 6 | 7 | # 1.7.10.2 8 | 9 | * Add `Exception` instance for parse errors 10 | * Work with `cloref` arrows 11 | 12 | # 1.7.10.1 13 | 14 | * Fix bug where left shift was printed as right shift 15 | 16 | # 1.7.10.0 17 | 18 | * Add support for left/right shift operators in expressions 19 | * Add support for array literals 20 | * Fix bug in `absvt@ype` and `abst@ype` pretty-printing 21 | 22 | # 1.7.9.0 23 | 24 | * Support float literals as something other than double literals 25 | 26 | # 1.7.8.0 27 | 28 | * Add support for unsigned hexadecimal literals 29 | 30 | ## 1.7.7.2 31 | 32 | * Fix error when parsing `absvt@ype` declarations 33 | 34 | ## 1.7.7.1 35 | 36 | * Use `these-skinny` 37 | 38 | ## 1.7.7.0 39 | 40 | * Improved parse errors 41 | * Add `getDependenciesC` 42 | 43 | ## 1.7.6.2 44 | 45 | * Fix bug in handling of char literals 46 | 47 | ## 1.7.6.1 48 | 49 | * Bugfix in pretty-printer/lexer 50 | 51 | ## 1.7.6.0 52 | 53 | * Use `Natural`/`Integer` for literals 54 | 55 | ## 1.7.5.0 56 | 57 | * Fix `StaticExpression` to allow calls with dynamic components 58 | 59 | ## 1.7.4.1 60 | 61 | * Improve pretty-printer 62 | 63 | ## 1.7.4.0 64 | 65 | * Add `languageATSVersion` 66 | 67 | ## 1.7.3.1 68 | 69 | * Fix bug in parse order for `symintr` declarations 70 | 71 | ## 1.7.3.0 72 | 73 | * Update `PrVal` to include a field for universal quantifiers 74 | 75 | ## 1.7.2.0 76 | 77 | * Update `termetric` field type to allow empty termetrics 78 | 79 | ## 1.7.1.2 80 | 81 | * Add `cross` flag to cabal file 82 | 83 | ## 1.7.1.1 84 | 85 | * Bugfix in how `val`s were handled 86 | 87 | ## 1.7.1.0 88 | 89 | * Fix a bug in how `val`s were handled in `SATS` files 90 | 91 | ## 1.7.0.6 92 | 93 | * Fix bug by introducing immorality 94 | 95 | ## 1.7.0.5 96 | 97 | * Faster build times 98 | 99 | ## 1.7.0.4 100 | 101 | * Allow `datatype`, `datavtype`, and `dataview` to work with `and`. 102 | * Remove spurious dependency on `cpphs` 103 | * Prettier errors when parsing records 104 | 105 | ## 1.7.0.3 106 | 107 | * Bump `recursion` version bounds 108 | 109 | ## 1.7.0.2 110 | 111 | Bug fixes: 112 | 113 | * Support `llam@` keyword 114 | 115 | Enhancements: 116 | 117 | * Use `recursion` library to incur fewer dependencies 118 | 119 | ## 1.7.0.0 120 | 121 | Bug Fixes: 122 | 123 | * Now accepts proof-level lambdas. 124 | * Include all test data 125 | 126 | Breaking Changes: 127 | 128 | * `PrVar` and `PrVal` now take a `StaticExpression` 129 | * `PrFun`, `PrFn`, and `Praxi` now take a `StaticExpression` 130 | * Add a rewrite phase for `StaticExpression`s 131 | 132 | ## 1.6.0.0 133 | 134 | Breaking Changes: 135 | 136 | * Remove types for `RecordValues` and instead rely on typed expressions. 137 | * Remove `Wildcard` constructor and instead treat `_` as a name 138 | * Remove `ParenType` and instead use tuples 139 | 140 | Enhancements: 141 | 142 | * Better Error messages 143 | * Add support for boxed records 144 | * Add support for proof expressions introducing witnesses (`[ m | () ]`) 145 | 146 | Bug Fixes: 147 | 148 | * Fix bug with formatting for type arguments 149 | * Fix formatting for `val ... and ...` declarations 150 | * Fix parse error on expressions like `list_vt_cons(x, _)` 151 | * Add support for patterns using binary operators. 152 | -------------------------------------------------------------------------------- /language-ats/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 | -------------------------------------------------------------------------------- /language-ats/README.md: -------------------------------------------------------------------------------- 1 | # language-ats 2 | 3 | This is a package similar to 4 | [language-c](http://hackage.haskell.org/package/language-c) or 5 | [haskell-src-exts](http://hackage.haskell.org/package/haskell-src-exts) that 6 | provides a parser and pretty-printer for [ATS](http://ats-lang.org/). 7 | 8 | The parser is slightly buggy but it can handle almost all of the language; see 9 | the `test/data` directory for examples of what it can handle. 10 | 11 | The pretty-printer works quite well; you can safely use it for code generation. 12 | -------------------------------------------------------------------------------- /language-ats/TODO.md: -------------------------------------------------------------------------------- 1 | # Bugs 2 | - [ ] Fix comments/annotations 3 | - [ ] I don't really have a good plan for this aside from parsing position and 4 | comments by default (instead of just position) 5 | - [ ] Ideally, we'd annotate things, but there is also the possibility of 6 | using a state monad (?) 7 | - [ ] `as` syntax 8 | - [ ] Handle `stadef mytkind = $extkind"atslib_linmap_avltree"` 9 | - [ ] Sort annotations for viewtypes etc. 10 | - [ ] `$tup(x, y)` syntax? 11 | - [ ] `stadef x: bool = z` 12 | - [ ] `language-xats` library: https://github.com/githwxi/ATS-Xanadu/tree/master/srcgen/xats/SATS 13 | - [ ] Fix problem with macro blocks being indented wrong 14 | - [ ] handle `absprop someprop` and `absprop some_prop(prop, prop+)` 15 | - [ ] Parse `fix` keyword correctly. 16 | - [ ] Lambdas in static functions 17 | - [ ] Handle `extern prval {A:prop}{B:prop} EMPTY_FUNCTOR {n:nat} : BASE_FUNCTOR_PROP(A, FUNCTOR_PROP(A, n))` correctly 18 | - [ ] Handle curried args to functions 19 | # Deficiencies 20 | - [ ] Error messages 21 | - [ ] Add test suite for messages 22 | - [ ] Treat `;` as a binary operator 23 | # Performance 24 | - [ ] `ByteString` lexer? 25 | - [ ] Get rid of `identifierSpace` 26 | - [ ] Literals, etc. should only be lexed when in the appropriate state 27 | -------------------------------------------------------------------------------- /language-ats/bench/Bench.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Criterion.Main 4 | import Language.ATS 5 | 6 | main :: IO () 7 | main = 8 | defaultMain [ env envFiles $ \ ~(l, m) -> 9 | bgroup "format" 10 | [ bench "lexATS (large)" $ nf lexATS l 11 | , bench "parse (large)" $ nf parse l 12 | , bench "fmap printATS . parse (large)" $ nf (fmap printATS . parse) l 13 | , bench "lexATS (medium)" $ nf lexATS m 14 | , bench "parse (medium)" $ nf parse m 15 | , bench "fmap printATS . parse (medium)" $ nf (fmap printATS . parse) m 16 | ] 17 | ] 18 | where large = readFile "test/data/polyglot.dats" 19 | medium = readFile "test/data/concurrency.dats" 20 | envFiles = (,) <$> large <*> medium 21 | -------------------------------------------------------------------------------- /language-ats/test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- vim: syntax=hspec 3 | 4 | import Data.Foldable 5 | import qualified Filesystem.Path.CurrentOS as F 6 | import Language.ATS 7 | import Test.Hspec 8 | import Test.Hspec.Dirstream 9 | 10 | isATS :: F.FilePath -> Bool 11 | isATS x = (extension x `elem`) (pure <$> ["ats", "dats", "sats", "hats", "cats"]) 12 | 13 | main :: IO () 14 | main = hspec $ 15 | describe "pretty-print" $ parallel $ 16 | traverse_ (\x -> testFiles x isATS (fmap printATS . parse)) 17 | ["test/data", "test/data/stdlib", "test/data/stdlib/DATS"] 18 | -------------------------------------------------------------------------------- /language-ats/test/data/arrptr.dats: -------------------------------------------------------------------------------- 1 | #include "share/atspre_staload.hats" 2 | 3 | staload "SATS/futhark.sats" 4 | staload "SATS/futhark-arr.sats" 5 | staload "SATS/futhark-stats.sats" 6 | staload "SATS/futhark-linalg.sats" 7 | 8 | implement main0 () = 9 | { 10 | val arr0 = $arrpsz{float}(1.0f, 2.0f, 3.0f) 11 | var arr1 = $arrpsz{float}(1.0f, 2.0f, 3.0f) 12 | val ctx_cfg = futhark_context_config_new() 13 | val ctx = futhark_context_new(ctx_cfg) 14 | val fut_arr0 = futhark_new_f32_1d(ctx, arr0, 3) 15 | val fut_arr1 = futhark_new_f32_1d(ctx, arr1, 3) 16 | var ret: float 17 | val _ = futhark_entry_mean_f32(ctx, ret, fut_arr0) 18 | val () = println!(ret) 19 | val _ = futhark_entry_dotprod_f32(ctx, ret, fut_arr0, fut_arr1) 20 | val () = println!(ret) 21 | val _ = futhark_free_f32_1d(ctx, fut_arr0) 22 | val _ = futhark_free_f32_1d(ctx, fut_arr1) 23 | val () = futhark_context_free(ctx) 24 | val () = futhark_context_config_free(ctx_cfg) 25 | val () = arrayptr_free(arr0) 26 | val () = arrayptr_free(arr1) 27 | } 28 | 29 | -------------------------------------------------------------------------------- /language-ats/test/data/arrptr.out: -------------------------------------------------------------------------------- 1 | #include "share/atspre_staload.hats" 2 | 3 | staload "SATS/futhark.sats" 4 | staload "SATS/futhark-arr.sats" 5 | staload "SATS/futhark-stats.sats" 6 | staload "SATS/futhark-linalg.sats" 7 | 8 | implement main0 () = 9 | { 10 | val arr0 = $arrpsz{float}(1.0f, 2.0f, 3.0f) 11 | var arr1 = $arrpsz{float}(1.0f, 2.0f, 3.0f) 12 | val ctx_cfg = futhark_context_config_new() 13 | val ctx = futhark_context_new(ctx_cfg) 14 | val fut_arr0 = futhark_new_f32_1d(ctx, arr0, 3) 15 | val fut_arr1 = futhark_new_f32_1d(ctx, arr1, 3) 16 | var ret: float 17 | val _ = futhark_entry_mean_f32(ctx, ret, fut_arr0) 18 | val () = println!(ret) 19 | val _ = futhark_entry_dotprod_f32(ctx, ret, fut_arr0, fut_arr1) 20 | val () = println!(ret) 21 | val _ = futhark_free_f32_1d(ctx, fut_arr0) 22 | val _ = futhark_free_f32_1d(ctx, fut_arr1) 23 | val () = futhark_context_free(ctx) 24 | val () = futhark_context_config_free(ctx_cfg) 25 | val () = arrayptr_free(arr0) 26 | val () = arrayptr_free(arr1) 27 | } 28 | -------------------------------------------------------------------------------- /language-ats/test/data/ats-generic.dats: -------------------------------------------------------------------------------- 1 | #include "share/atspre_staload.hats" 2 | 3 | #define ATS_MAINATSFLAG 1 4 | 5 | staload UN = "prelude/SATS/unsafe.sats" 6 | 7 | vtypedef boring_type = @{ first = int, second = int } 8 | 9 | val return_boring_type: boring_type = @{ first = 12, second = 13 } 10 | 11 | extern 12 | val pass_boring_type : boring_type = 13 | "mac#" 14 | 15 | implement pass_boring_type = 16 | return_boring_type 17 | -------------------------------------------------------------------------------- /language-ats/test/data/ats-generic.out: -------------------------------------------------------------------------------- 1 | #include "share/atspre_staload.hats" 2 | 3 | #define ATS_MAINATSFLAG 1 4 | 5 | staload UN = "prelude/SATS/unsafe.sats" 6 | 7 | vtypedef boring_type = @{ first = int, second = int } 8 | 9 | val return_boring_type: boring_type = @{ first = 12, second = 13 } 10 | 11 | extern 12 | val pass_boring_type: boring_type = "mac#" 13 | 14 | implement pass_boring_type = 15 | return_boring_type 16 | -------------------------------------------------------------------------------- /language-ats/test/data/cloref.dats: -------------------------------------------------------------------------------- 1 | staload "SATS/dlist.sats" 2 | 3 | implement empty = 4 | @{ f = lam x = x } 5 | 6 | implement to_list (x) = 7 | x.f(list_nil()) 8 | -------------------------------------------------------------------------------- /language-ats/test/data/cloref.out: -------------------------------------------------------------------------------- 1 | staload "SATS/dlist.sats" 2 | 3 | implement empty = 4 | @{ f = lam x = x } 5 | 6 | implement to_list (x) = 7 | x.f(list_nil()) 8 | -------------------------------------------------------------------------------- /language-ats/test/data/combinatorics.dats: -------------------------------------------------------------------------------- 1 | #define ATS_MAINATSFLAG 1 2 | 3 | #include "share/atspre_staload.hats" 4 | 5 | staload "contrib/atscntrb-hx-intinf/SATS/intinf_t.sats" 6 | staload "libats/libc/SATS/math.sats" 7 | staload "contrib/atscntrb-hx-intinf/SATS/intinf.sats" 8 | staload UN = "prelude/SATS/unsafe.sats" 9 | 10 | fnx fact {n : nat} .. (k : int(n)) : [ n : nat | n > 0 ] intinf(n) = 11 | case+ k of 12 | | 0 => int2intinf(1) 13 | | 1 => int2intinf(1) 14 | | k =>> $UN.cast(fact(k - 1) * k) 15 | 16 | // double factorial http://mathworld.wolfram.com/DoubleFactorial.html 17 | fnx dfact {n : nat} .. (k : int(n)) : Intinf = 18 | case+ k of 19 | | 0 => int2intinf(1) 20 | | 1 => int2intinf(1) 21 | | k =>> k * dfact(k - 2) 22 | 23 | // Number of permutations on n objects using k at a time. 24 | fn permutatsions {n : nat}{ k : nat | k <= n } (n : int(n), k : int(k)) : Intinf = 25 | ndiv(fact(n), fact(n - k)) 26 | 27 | // Number of permutations on n objects using k at a time. 28 | fn choose {n : nat}{ m : nat | m <= n } (n : int(n), k : int(m)) : Intinf = 29 | let 30 | fun numerator_loop { m : nat | m > 1 } .. (i : int(m)) : [ n : nat | n > 0 ] intinf(n) = 31 | case+ i of 32 | | 1 => int2intinf(n) 33 | | 2 => $UN.cast(int2intinf(n - 1) * n) 34 | | i =>> $UN.cast((n + 1 - i) * numerator_loop(i - 1)) 35 | in 36 | case+ k of 37 | | 0 => int2intinf(1) 38 | | 1 => int2intinf(n) 39 | | k =>> ndiv(numerator_loop(k), fact(k)) 40 | end 41 | -------------------------------------------------------------------------------- /language-ats/test/data/combinatorics.out: -------------------------------------------------------------------------------- 1 | #define ATS_MAINATSFLAG 1 2 | 3 | #include "share/atspre_staload.hats" 4 | 5 | staload "contrib/atscntrb-hx-intinf/SATS/intinf_t.sats" 6 | staload "libats/libc/SATS/math.sats" 7 | staload "contrib/atscntrb-hx-intinf/SATS/intinf.sats" 8 | staload UN = "prelude/SATS/unsafe.sats" 9 | 10 | fnx fact {n:nat} .. (k : int(n)) : [ n : nat | n > 0 ] intinf(n) = 11 | case+ k of 12 | | 0 => int2intinf(1) 13 | | 1 => int2intinf(1) 14 | | k =>> $UN.cast(fact(k - 1) * k) 15 | 16 | // double factorial http://mathworld.wolfram.com/DoubleFactorial.html 17 | fnx dfact {n:nat} .. (k : int(n)) : Intinf = 18 | case+ k of 19 | | 0 => int2intinf(1) 20 | | 1 => int2intinf(1) 21 | | k =>> k * dfact(k - 2) 22 | 23 | // Number of permutations on n objects using k at a time. 24 | fn permutatsions {n:nat}{ k : nat | k <= n }(n : int(n), k : int(k)) : 25 | Intinf = 26 | ndiv(fact(n), fact(n - k)) 27 | 28 | // Number of permutations on n objects using k at a time. 29 | fn choose {n:nat}{ m : nat | m <= n }(n : int(n), k : int(m)) : Intinf = 30 | let 31 | fun numerator_loop { m : nat | m > 1 } .. (i : int(m)) : 32 | [ n : nat | n > 0 ] intinf(n) = 33 | case+ i of 34 | | 1 => int2intinf(n) 35 | | 2 => $UN.cast(int2intinf(n - 1) * n) 36 | | i =>> $UN.cast((n + 1 - i) * numerator_loop(i - 1)) 37 | in 38 | case+ k of 39 | | 0 => int2intinf(1) 40 | | 1 => int2intinf(n) 41 | | k =>> ndiv(numerator_loop(k), fact(k)) 42 | end 43 | -------------------------------------------------------------------------------- /language-ats/test/data/crc32.dats: -------------------------------------------------------------------------------- 1 | staload UN = "prelude/SATS/unsafe.sats" 2 | 3 | fn byteview_read_as_uint8 {l0:addr}{m:nat}{ l1 : addr | l1 <= l0+m }(pf : !bytes_v(l0, m) | p : ptr(l1)) : uint8 = 4 | $UN.ptr0_get(p) 5 | 6 | extern 7 | castfn uint2uint8(uint32) : uint8 8 | 9 | extern 10 | castfn uint2uint32(uint) : uint32 11 | 12 | // from here: https://docs.microsoft.com/en-us/openspecs/office_protocols/ms-abs/06966aa2-70da-4bf9-8448-3355f277cd77?redirectedfrom=MSDN 13 | fn crc32 {l:addr}{m:nat}(pf : !bytes_v(l, m) | p : ptr(l), l : size_t(m)) : uint32 = 14 | let 15 | var crc32_start: uint32 = uint2uint32(0xFFFFFFFFu) 16 | var i: size_t 17 | val () = for* { i : nat | i <= m } .. (i : size_t(i)) => 18 | (i := i2sz(0) ; i < l ; i := i + 1) 19 | let 20 | var current_byte = $UN.ptr0_get(add_ptr_bsz(p, i)) 21 | var crc_trunc = uint2uint8(crc32_start) 22 | var ix = g0uint_lxor_uint8(crc_trunc, current_byte) 23 | var crc_shift = crc32_start >> 8 24 | in end 25 | in 26 | g0uint_lxor_uint32(crc32_start, uint2uint32(0xFFFFFFFFu)) 27 | end 28 | -------------------------------------------------------------------------------- /language-ats/test/data/crc32.out: -------------------------------------------------------------------------------- 1 | staload UN = "prelude/SATS/unsafe.sats" 2 | 3 | fn byteview_read_as_uint8 4 | {l0:addr}{m:nat}{ l1 : addr | l1 <= l0+m }(pf : !bytes_v(l0, m) 5 | | p : ptr(l1)) : uint8 = 6 | $UN.ptr0_get(p) 7 | 8 | extern 9 | castfn uint2uint8(uint32) : uint8 10 | 11 | extern 12 | castfn uint2uint32(uint) : uint32 13 | 14 | // from here: https://docs.microsoft.com/en-us/openspecs/office_protocols/ms-abs/06966aa2-70da-4bf9-8448-3355f277cd77?redirectedfrom=MSDN 15 | fn crc32 {l:addr}{m:nat}(pf : !bytes_v(l, m) 16 | | p : ptr(l), l : size_t(m)) : uint32 = 17 | let 18 | var crc32_start: uint32 = uint2uint32(0xFFFFFFFFu) 19 | var i: size_t 20 | val () = for* { i : nat | i <= m } .. (i : size_t(i)) => 21 | (i := i2sz(0) ; i < l ; i := i + 1) 22 | let 23 | var current_byte = $UN.ptr0_get(add_ptr_bsz(p, i)) 24 | var crc_trunc = uint2uint8(crc32_start) 25 | var ix = g0uint_lxor_uint8(crc_trunc, current_byte) 26 | var crc_shift = crc32_start >> 8 27 | in end 28 | in 29 | g0uint_lxor_uint32(crc32_start, uint2uint32(0xFFFFFFFFu)) 30 | end 31 | -------------------------------------------------------------------------------- /language-ats/test/data/dhall-ats.dats: -------------------------------------------------------------------------------- 1 | #include ".atspkg/contrib/hs-bind-0.3.6/runtime.dats" 2 | #include "share/atspre_staload.hats" 3 | 4 | staload UN = "prelude/SATS/unsafe.sats" 5 | staload "src/gen.sats" 6 | 7 | fun free_option(x : option(int)) : void = 8 | case+ x of 9 | | ~Some (_) => () 10 | | ~None() => () 11 | 12 | fun print_pair(x : pair(int, int)) : void = 13 | let 14 | val f = x.first 15 | val s = x.second 16 | in 17 | println!("Pair { first = ", f, ", second = ", s, " }") 18 | end 19 | 20 | fun print_option_int(x : !option(int)) : void = 21 | case+ x of 22 | | Some (n) => (print("Some") ; println!(n)) 23 | | None() => println!("None") 24 | 25 | extern 26 | fun hs_pass() : ptr = 27 | "mac#pass_val" 28 | 29 | extern 30 | fun hs_read() : ptr = 31 | "mac#read_dhall" 32 | 33 | implement main0 (argc, argv) = 34 | { 35 | val _ = hs_init(argc, argv) 36 | var x = $UN.ptr0_get(hs_read()) 37 | val y = $UN.ptr0_get(hs_pass()) 38 | val _ = print_pair(y) 39 | val _ = print_option_int(x) 40 | val _ = free_option(x) 41 | val _ = hs_exit() 42 | } 43 | -------------------------------------------------------------------------------- /language-ats/test/data/dhall-ats.out: -------------------------------------------------------------------------------- 1 | #include ".atspkg/contrib/hs-bind-0.3.6/runtime.dats" 2 | #include "share/atspre_staload.hats" 3 | 4 | staload UN = "prelude/SATS/unsafe.sats" 5 | staload "src/gen.sats" 6 | 7 | fun free_option(x : option(int)) : void = 8 | case+ x of 9 | | ~Some (_) => () 10 | | ~None() => () 11 | 12 | fun print_pair(x : pair(int, int)) : void = 13 | let 14 | val f = x.first 15 | val s = x.second 16 | in 17 | println!("Pair { first = ", f, ", second = ", s, " }") 18 | end 19 | 20 | fun print_option_int(x : !option(int)) : void = 21 | case+ x of 22 | | Some (n) => (print("Some") ; println!(n)) 23 | | None() => println!("None") 24 | 25 | extern 26 | fun hs_pass() : ptr = 27 | "mac#pass_val" 28 | 29 | extern 30 | fun hs_read() : ptr = 31 | "mac#read_dhall" 32 | 33 | implement main0 (argc, argv) = 34 | { 35 | val _ = hs_init(argc, argv) 36 | var x = $UN.ptr0_get(hs_read()) 37 | val y = $UN.ptr0_get(hs_pass()) 38 | val _ = print_pair(y) 39 | val _ = print_option_int(x) 40 | val _ = free_option(x) 41 | val _ = hs_exit() 42 | } 43 | -------------------------------------------------------------------------------- /language-ats/test/data/dirwalk.dats: -------------------------------------------------------------------------------- 1 | %{^ 2 | #ifdef ATS_MEMALLOC_GCBDW 3 | #undef GC_H 4 | #define GC_THREADS 5 | #endif 6 | %} 7 | 8 | #include "prelude/DATS/filebas.dats" 9 | #include "share/atspre_staload.hats" 10 | #include "share/atspre_staload_libats_ML.hats" 11 | #include "libats/libc/DATS/dirent.dats" 12 | #include "libats/ML/DATS/filebas_dirent.dats" 13 | #include "libats/DATS/athread_posix.dats" 14 | #include "$PATSHOMELOCS/atscntrb-bucs320-divideconquerpar/mylibies.hats" 15 | #include "$PATSHOMELOCS/atscntrb-bucs320-divideconquerpar/mydepies.hats" 16 | 17 | #staload $DivideConquer 18 | #staload $DivideConquerPar 19 | #staload FWS = $FWORKSHOP_chanlst 20 | 21 | assume input_t0ype = string 22 | assume output_t0ype = int 23 | 24 | typedef fworkshop = $FWS.fworkshop 25 | 26 | fun as_char(s : string) : charNZ = 27 | $UN.ptr0_get(string2ptr(s)) 28 | 29 | fun dir_skipped(dir : string) : bool = 30 | case+ dir of 31 | | "." => true 32 | | ".." => true 33 | | _ when length(dir) > 0 => as_char(dir) = '.' 34 | | _ => false 35 | 36 | fun DirWalk(fws : fworkshop, fname : string, fopr : cfun(string, int)) : 37 | int = 38 | let 39 | val () = $tempenver(fws) 40 | val () = $tempenver(fopr) 41 | 42 | implement DivideConquer$base_test<> (fname) = 43 | (test_file_isdir(fname) = 0) 44 | 45 | implement DivideConquer$base_solve<> (fname) = 46 | fopr(fname) 47 | 48 | implement DivideConquer$divide<> (dir) = 49 | (let 50 | var files = streamize_dirname_fname(dir) 51 | var files = stream_vt_filter_cloptr( files 52 | , lam (x) => ~dir_skipped(x) 53 | ) 54 | var files = stream_vt_map_cloptr( files 55 | , lam (file) => 56 | string_append3(dir, "/", file) 57 | ) 58 | in 59 | list0_of_list_vt(stream2list_vt(files)) 60 | end) 61 | 62 | implement DivideConquer$conquer$combine<> (_, rs) = 63 | (list0_foldleft(rs, 0, lam (res, r) => res + r)) 64 | 65 | implement DivideConquerPar$fworkshop<> () = 66 | FWORKSHOP_chanlst(fws) 67 | in 68 | DivideConquer$solve<>(fname) 69 | end 70 | 71 | fun wc_line(fname : string) : int = 72 | let 73 | fun lines(inp : FILEref) : int = 74 | let 75 | var stream = streamize_fileref_line(inp) 76 | var l = stream_vt_length(stream) 77 | in 78 | l 79 | end 80 | 81 | val opt = fileref_open_opt(fname, file_mode_r) 82 | in 83 | case+ opt of 84 | | ~None_vt() => (prerrln!("Cannot open the file: ", fname) ; 0) 85 | | ~Some_vt (inp) => let 86 | var nline = lines(inp) 87 | in 88 | (fileref_close(inp) ; nline) 89 | end 90 | end 91 | 92 | #define NCPU 4 93 | 94 | implement main0 (argc, argv) = 95 | { 96 | var fws = $FWS.fworkshop_create_exn() 97 | var added = $FWS.fworkshop_add_nworker(fws, NCPU) 98 | var root = (if argc >= 2 then 99 | argv[1] 100 | else 101 | ".") : string 102 | var nfile = DirWalk(fws, root, lam (fname) => let 103 | var nline = wc_line(fname) 104 | val _ = println!(fname, ": ", nline) 105 | in 106 | nline 107 | end) 108 | val () = println!("Total number of lines:\n ", nfile) 109 | } -------------------------------------------------------------------------------- /language-ats/test/data/dirwalk.out: -------------------------------------------------------------------------------- 1 | %{^ 2 | #ifdef ATS_MEMALLOC_GCBDW 3 | #undef GC_H 4 | #define GC_THREADS 5 | #endif 6 | %} 7 | 8 | #include "prelude/DATS/filebas.dats" 9 | #include "share/atspre_staload.hats" 10 | #include "share/atspre_staload_libats_ML.hats" 11 | #include "libats/libc/DATS/dirent.dats" 12 | #include "libats/ML/DATS/filebas_dirent.dats" 13 | #include "libats/DATS/athread_posix.dats" 14 | #include "$PATSHOMELOCS/atscntrb-bucs320-divideconquerpar/mylibies.hats" 15 | #include "$PATSHOMELOCS/atscntrb-bucs320-divideconquerpar/mydepies.hats" 16 | 17 | #staload $DivideConquer 18 | #staload $DivideConquerPar 19 | #staload FWS = $FWORKSHOP_chanlst 20 | 21 | assume input_t0ype = string 22 | assume output_t0ype = int 23 | 24 | typedef fworkshop = $FWS.fworkshop 25 | 26 | fun as_char(s : string) : charNZ = 27 | $UN.ptr0_get(string2ptr(s)) 28 | 29 | fun dir_skipped(dir : string) : bool = 30 | case+ dir of 31 | | "." => true 32 | | ".." => true 33 | | _ when length(dir) > 0 => as_char(dir) = '.' 34 | | _ => false 35 | 36 | fun DirWalk(fws : fworkshop, fname : string, fopr : cfun(string, int)) : 37 | int = 38 | let 39 | val () = $tempenver(fws) 40 | val () = $tempenver(fopr) 41 | 42 | implement DivideConquer$base_test<> (fname) = 43 | (test_file_isdir(fname) = 0) 44 | 45 | implement DivideConquer$base_solve<> (fname) = 46 | fopr(fname) 47 | 48 | implement DivideConquer$divide<> (dir) = 49 | (let 50 | var files = streamize_dirname_fname(dir) 51 | var files = stream_vt_filter_cloptr( files 52 | , lam (x) => ~dir_skipped(x) 53 | ) 54 | var files = stream_vt_map_cloptr( files 55 | , lam (file) => 56 | string_append3(dir, "/", file) 57 | ) 58 | in 59 | list0_of_list_vt(stream2list_vt(files)) 60 | end) 61 | 62 | implement DivideConquer$conquer$combine<> (_, rs) = 63 | (list0_foldleft(rs, 0, lam (res, r) => res + r)) 64 | 65 | implement DivideConquerPar$fworkshop<> () = 66 | FWORKSHOP_chanlst(fws) 67 | in 68 | DivideConquer$solve<>(fname) 69 | end 70 | 71 | fun wc_line(fname : string) : int = 72 | let 73 | fun lines(inp : FILEref) : int = 74 | let 75 | var stream = streamize_fileref_line(inp) 76 | var l = stream_vt_length(stream) 77 | in 78 | l 79 | end 80 | 81 | val opt = fileref_open_opt(fname, file_mode_r) 82 | in 83 | case+ opt of 84 | | ~None_vt() => (prerrln!("Cannot open the file: ", fname) ; 0) 85 | | ~Some_vt (inp) => let 86 | var nline = lines(inp) 87 | in 88 | (fileref_close(inp) ; nline) 89 | end 90 | end 91 | 92 | #define NCPU 4 93 | 94 | implement main0 (argc, argv) = 95 | { 96 | var fws = $FWS.fworkshop_create_exn() 97 | var added = $FWS.fworkshop_add_nworker(fws, NCPU) 98 | var root = (if argc >= 2 then 99 | argv[1] 100 | else 101 | ".") : string 102 | var nfile = DirWalk(fws, root, lam (fname) => let 103 | var nline = wc_line(fname) 104 | val _ = println!(fname, ": ", nline) 105 | in 106 | nline 107 | end) 108 | val () = println!("Total number of lines:\n ", nfile) 109 | } 110 | -------------------------------------------------------------------------------- /language-ats/test/data/dlist.out: -------------------------------------------------------------------------------- 1 | typedef dlist(a: t@ype+) = @{ f = List0(a) -> List0(a) } 2 | 3 | fn from_list {a:t@ype} (List0(a)) : dlist(a) 4 | 5 | fn to_list {a:t@ype} (dlist(a)) : List0(a) 6 | 7 | fn singleton {a:t@ype} (a) : dlist(a) 8 | 9 | val empty{a:t@ype}: dlist(a) 10 | -------------------------------------------------------------------------------- /language-ats/test/data/dlist.sats: -------------------------------------------------------------------------------- 1 | typedef dlist(a: t@ype+) = @{ f = List0(a) -> List0(a) } 2 | 3 | fn from_list {a:t@ype} (List0(a)) : dlist(a) 4 | 5 | fn to_list {a:t@ype} (dlist(a)) : List0(a) 6 | 7 | fn singleton {a:t@ype} (a) : dlist(a) 8 | 9 | val empty {a:t@ype} : dlist(a) 10 | -------------------------------------------------------------------------------- /language-ats/test/data/either.out: -------------------------------------------------------------------------------- 1 | #include "share/atspre_staload_libats_ML.hats" 2 | #include "libats/ML/SATS/SHARE/monad.hats" 3 | 4 | datatype either(a: t@ype, b: t@ype+) = 5 | | left of a 6 | | right of b 7 | 8 | fun {a:t@ype}{b:t@ype+} eq_either_either ( x : either(a, INV(b)) 9 | , y : either(a, b) 10 | ) : bool 11 | 12 | fun {a:t@ype}{b:t@ype+} neq_either_either ( x : either(a, INV(b)) 13 | , y : either(a, b) 14 | ) : bool 15 | 16 | overload = with eq_either_either 17 | overload != with neq_either_either 18 | 19 | fun lefts {a:t@ype}{b:t@ype+}{n:int} (x : list(either(a,b), n)) : 20 | [ m : int | m <= n ] list(a, m) 21 | 22 | fun rights {a:t@ype}{b:t@ype+}{n:int} (x : list(either(a,b), n)) : 23 | [ m : int | m <= n ] list(b, m) 24 | 25 | fun either_ {a:t@ype}{b:t@ype+}{c:t@ype} ( f : a -> c 26 | , g : b -> c 27 | , x : either(a, b) 28 | ) : c 29 | 30 | fun is_left {a:t@ype}{b:t@ype+} (x : either(a, b)) : bool 31 | 32 | fun is_right {a:t@ype}{b:t@ype+} (x : either(a, b)) : bool 33 | 34 | fun from_right {a:t@ype}{b:t@ype+} (x : b, y : either(a, b)) : b 35 | 36 | fun from_left {a:t@ype}{b:t@ype+} (x : a, y : either(a, b)) : a 37 | -------------------------------------------------------------------------------- /language-ats/test/data/either.sats: -------------------------------------------------------------------------------- 1 | #include "share/atspre_staload_libats_ML.hats" 2 | #include "libats/ML/SATS/SHARE/monad.hats" 3 | 4 | datatype either(a: t@ype, b: t@ype+) = 5 | | left of a 6 | | right of b 7 | 8 | fun {a:t@ype}{b:t@ype+} eq_either_either (x : either(a, INV(b)), y : either(a, b)) : bool 9 | 10 | fun {a:t@ype}{b:t@ype+} neq_either_either (x : either(a, INV(b)), y : either(a, b)) : bool 11 | 12 | overload = with eq_either_either 13 | 14 | overload != with neq_either_either 15 | 16 | fun lefts {a:t@ype}{b:t@ype+}{n:int} (x : list(either(a,b), n)) : 17 | [ m : int | m <= n ] list(a, m) 18 | 19 | fun rights {a:t@ype}{b:t@ype+}{n:int} (x : list(either(a,b), n)) : 20 | [ m : int | m <= n ] list(b, m) 21 | 22 | fun either_ {a:t@ype}{b:t@ype+}{c:t@ype} (f : a -> c, g : b -> c, x : either(a, b)) : c 23 | 24 | fun is_left {a:t@ype}{b:t@ype+} (x : either(a, b)) : bool 25 | 26 | fun is_right {a:t@ype}{b:t@ype+} (x : either(a, b)) : bool 27 | 28 | fun from_right {a:t@ype}{b:t@ype+} (x : b, y : either(a, b)) : b 29 | 30 | fun from_left {a:t@ype}{b:t@ype+} (x : a, y : either(a, b)) : a -------------------------------------------------------------------------------- /language-ats/test/data/fact.dats: -------------------------------------------------------------------------------- 1 | #include "share/atspre_staload.hats" 2 | #include "share/HATS/atslib_staload_libats_libc.hats" 3 | 4 | fnx fact_boring(n: int) : int = 5 | case+ n of 6 | | 0 => 1 7 | | n => n * fact_boring(n-1) 8 | 9 | (* fnx collatz{n:nat} *) 10 | (* (n: int(n)) : int = let *) 11 | (* fun loop{n:nat}{l:addr} .. *) 12 | (* (pf: !int @ l | n: int n, res: ptr l) : void = *) 13 | (* if n > 1 *) 14 | 15 | // TODO rewrite this for collatz? 16 | fnx fact{n:nat} 17 | (n: int (n)): int = let 18 | fun loop{n:nat}{l:addr} .. 19 | (pf: !int @ l | n: int n, res: ptr l): void = 20 | if n > 0 then let 21 | val () = !res := n * !res in loop (pf | n-1, res) 22 | end // end of [if] 23 | // end of [loop] 24 | var res: int with pf = 1 25 | val () = loop (pf | n, addr@res) // addr@res: the pointer to res 26 | in 27 | res 28 | end // end of [fact] 29 | 30 | implement main0 () = 31 | let val x = fact(30) in 32 | println!(tostring_int(x)) end 33 | -------------------------------------------------------------------------------- /language-ats/test/data/fact.out: -------------------------------------------------------------------------------- 1 | #include "share/atspre_staload.hats" 2 | #include "share/HATS/atslib_staload_libats_libc.hats" 3 | 4 | fnx fact_boring(n : int) : int = 5 | case+ n of 6 | | 0 => 1 7 | | n => n * fact_boring(n - 1) 8 | 9 | (* fnx collatz{n:nat} *) 10 | (* (n: int(n)) : int = let *) 11 | (* fun loop{n:nat}{l:addr} .. *) 12 | (* (pf: !int @ l | n: int n, res: ptr l) : void = *) 13 | (* if n > 1 *) 14 | // TODO rewrite this for collatz? 15 | fnx fact {n:nat}(n : int(n)) : int = 16 | let 17 | fun loop {n:nat}{l:addr} .. (pf : !int @ l 18 | | n : int(n), res : ptr(l)) : void = 19 | if n > 0 then 20 | let 21 | val () = !res := n * !res 22 | in 23 | loop(pf | n - 1, res) 24 | end 25 | 26 | // end of [if] 27 | // end of [loop] 28 | var res: int with pf = 1 29 | val () = loop(pf | n, addr@res) 30 | 31 | // addr@res: the pointer to res 32 | in 33 | res 34 | end 35 | 36 | // end of [fact] 37 | implement main0 () = 38 | let 39 | val x = fact(30) 40 | in 41 | println!(tostring_int(x)) 42 | end 43 | -------------------------------------------------------------------------------- /language-ats/test/data/factorial.dats: -------------------------------------------------------------------------------- 1 | fun factorial_recursion {n:nat} .. (n: int(n)) : int = 2 | // case 3 | case+ n of 4 | | 0 => 1 5 | | n =>> factorial_recursion(n-1) * n 6 | -------------------------------------------------------------------------------- /language-ats/test/data/factorial.out: -------------------------------------------------------------------------------- 1 | fun factorial_recursion {n:nat} .. (n : int(n)) : int = 2 | // case 3 | case+ n of 4 | | 0 => 1 5 | | n =>> factorial_recursion(n - 1) * n 6 | -------------------------------------------------------------------------------- /language-ats/test/data/fast-combinatorics.dats: -------------------------------------------------------------------------------- 1 | #define ATS_MAINATSFLAG 1 2 | 3 | #include "share/atspre_staload.hats" 4 | 5 | staload "libats/libc/SATS/math.sats" 6 | 7 | fnx fact {n : nat} .. (k : int(n)) :<> int = 8 | case+ k of 9 | | 0 => 1 10 | | k =>> fact(k - 1) * k 11 | 12 | fnx dfact {n : nat} .. (k : int(n)) :<> int = 13 | case+ k of 14 | | 0 => 1 15 | | 1 => 1 16 | | k =>> k * dfact(k - 2) 17 | 18 | // TODO make this more versatile? 19 | fn choose {n : nat}{ m : nat | m <= n } (n : int(n), k : int(m)) : int = 20 | let 21 | fun numerator_loop { m : nat | m > 1 } .. (i : int(m)) : int = 22 | case+ i of 23 | | 1 => n 24 | | 2 => (n - 1) * n 25 | | i =>> (n + 1 - i) * numerator_loop(i - 1) 26 | in 27 | case+ k of 28 | | 0 => 1 29 | | 1 => n 30 | | k =>> numerator_loop(k) / fact(k) 31 | end 32 | 33 | // FIXME 34 | fun bad(n : int) : [ m : nat ] int(m) = 35 | case+ n of 36 | | 0 => 0 37 | | n => 1 + bad(n - 1) 38 | 39 | fun is_prime(k : intGt(0)) : bool = 40 | case+ k of 41 | | 1 => false 42 | | k => 43 | begin 44 | let 45 | var pre_bound: int = g0float2int(sqrt_float(g0int2float_int_float(k))) 46 | var bound: [ m : nat ] int(m) = bad(pre_bound) 47 | 48 | fun loop {n : nat}{m : nat} .. (i : int(n), bound : int(m)) :<> bool = 49 | if i < bound then 50 | if k mod i = 0 then 51 | false 52 | else 53 | true && loop(i + 1, bound) 54 | else 55 | if i = bound then 56 | if k mod i = 0 then 57 | false 58 | else 59 | true 60 | else 61 | true 62 | in 63 | loop(2, bound) 64 | end 65 | end 66 | 67 | extern 68 | fun choose_ats {n : nat}{ m : nat | m <= n } : (int(n), int(m)) -> int = 69 | "mac#" 70 | 71 | extern 72 | fun double_factorial {n : nat} : int(n) -> int = 73 | "mac#" 74 | 75 | extern 76 | fun factorial_ats {n : nat} : int(n) -> int = 77 | "mac#" 78 | 79 | extern 80 | fun is_prime_ats { n : nat | n > 0 } : int(n) -> bool = 81 | "mac#" 82 | 83 | implement choose_ats (n, k) = 84 | choose(n, k) 85 | 86 | implement double_factorial (m) = 87 | dfact(m) 88 | 89 | implement is_prime_ats (n) = 90 | is_prime(n) 91 | 92 | implement factorial_ats (m) = 93 | fact(m) 94 | -------------------------------------------------------------------------------- /language-ats/test/data/fast-combinatorics.out: -------------------------------------------------------------------------------- 1 | #define ATS_MAINATSFLAG 1 2 | 3 | #include "share/atspre_staload.hats" 4 | 5 | staload "libats/libc/SATS/math.sats" 6 | 7 | fnx fact {n:nat} .. (k : int(n)) :<> int = 8 | case+ k of 9 | | 0 => 1 10 | | k =>> fact(k - 1) * k 11 | 12 | fnx dfact {n:nat} .. (k : int(n)) :<> int = 13 | case+ k of 14 | | 0 => 1 15 | | 1 => 1 16 | | k =>> k * dfact(k - 2) 17 | 18 | // TODO make this more versatile? 19 | fn choose {n:nat}{ m : nat | m <= n }(n : int(n), k : int(m)) : int = 20 | let 21 | fun numerator_loop { m : nat | m > 1 } .. (i : int(m)) : int = 22 | case+ i of 23 | | 1 => n 24 | | 2 => (n - 1) * n 25 | | i =>> (n + 1 - i) * numerator_loop(i - 1) 26 | in 27 | case+ k of 28 | | 0 => 1 29 | | 1 => n 30 | | k =>> numerator_loop(k) / fact(k) 31 | end 32 | 33 | // FIXME 34 | fun bad(n : int) : [m:nat] int(m) = 35 | case+ n of 36 | | 0 => 0 37 | | n => 1 + bad(n - 1) 38 | 39 | fun is_prime(k : intGt(0)) : bool = 40 | case+ k of 41 | | 1 => false 42 | | k => 43 | begin 44 | let 45 | var pre_bound: int = g0float2int(sqrt_float(g0int2float_int_float(k))) 46 | var bound: [m:nat] int(m) = bad(pre_bound) 47 | 48 | fun loop {n:nat}{m:nat} .. (i : int(n), bound : int(m)) :<> 49 | bool = 50 | if i < bound then 51 | if k % i = 0 then 52 | false 53 | else 54 | true && loop(i + 1, bound) 55 | else 56 | if i = bound then 57 | if k % i = 0 then 58 | false 59 | else 60 | true 61 | else 62 | true 63 | in 64 | loop(2, bound) 65 | end 66 | end 67 | 68 | extern 69 | fun choose_ats {n:nat}{ m : nat | m <= n } : (int(n), int(m)) -> int = 70 | "mac#" 71 | 72 | extern 73 | fun double_factorial {n:nat} : int(n) -> int = 74 | "mac#" 75 | 76 | extern 77 | fun factorial_ats {n:nat} : int(n) -> int = 78 | "mac#" 79 | 80 | extern 81 | fun is_prime_ats { n : nat | n > 0 } : int(n) -> bool = 82 | "mac#" 83 | 84 | implement choose_ats (n, k) = 85 | choose(n, k) 86 | 87 | implement double_factorial (m) = 88 | dfact(m) 89 | 90 | implement is_prime_ats (n) = 91 | is_prime(n) 92 | 93 | implement factorial_ats (m) = 94 | fact(m) 95 | -------------------------------------------------------------------------------- /language-ats/test/data/fastcount.dats: -------------------------------------------------------------------------------- 1 | (* 2 | ** 3 | ** A fast approach to counting newlines 4 | ** 5 | ** Author: Hongwei Xi (hwxi AT cs DOT bu DOT edu) 6 | ** Time: April 17, 2013 7 | ** 8 | *) 9 | #include "share/atspre_staload.hats" 10 | 11 | staload UN = "prelude/SATS/unsafe.sats" 12 | staload "libats/libc/SATS/stdio.sats" 13 | 14 | %{^ 15 | extern void *rawmemchr(const void *s, int c); 16 | #define atslib_rawmemchr rawmemchr 17 | %} 18 | 19 | extern 20 | fun rawmemchr {l:addr}{m:int}(pf : bytes_v(l, m) | p : ptr(l), c : int) : 21 | [ l2 : addr | l+m > l2 ] (bytes_v(l, l2-l),bytes_v(l2, l+m-l2) | ptr(l2)) = 22 | "mac#atslib_rawmemchr" 23 | 24 | (* ****** ****** *) 25 | #define BUFSZ (16*1024) 26 | 27 | (* ****** ****** *) 28 | extern 29 | fun freadc {l:addr} (pf : !bytes_v(l, BUFSZ) | inp : FILEref, p : ptr(l), c : char) : size_t 30 | 31 | implement freadc (pf | inp, p, c) = 32 | let 33 | var n = $extfcall(size_t, "fread", p, sizeof, BUFSZ - 1, inp) 34 | val () = $UN.ptr0_set(ptr_add(p, n), c) 35 | in 36 | n 37 | end 38 | 39 | (* ****** ****** *) 40 | extern 41 | fun wclbuf {l:addr}{n:int} (pf : !bytes_v(l, n) | p : ptr(l), pz : ptr, c : int, res : int) : 42 | int 43 | 44 | implement wclbuf (pf | p, pz, c, res) = 45 | let 46 | val (pf1, pf2 | p2) = rawmemchr(pf | p, c) 47 | in 48 | if p2 < pz then 49 | let 50 | prval (pf21, pf22) = array_v_uncons(pf2) 51 | var res = wclbuf(pf22 | ptr_succ(p2), pz, c, res + 1) 52 | prval () = pf2 := array_v_cons(pf21, pf22) 53 | prval () = pf := bytes_v_unsplit(pf1, pf2) 54 | in 55 | res 56 | end 57 | else 58 | let 59 | prval () = pf := bytes_v_unsplit(pf1, pf2) 60 | in 61 | res 62 | end 63 | end 64 | 65 | (* ****** ****** *) 66 | extern 67 | fun wclfil {l:addr} (pf : !bytes_v(l, BUFSZ) | inp : FILEref, p : ptr(l), c : int) : int 68 | 69 | implement wclfil {l} (pf | inp, p, c) = 70 | let 71 | fun loop(pf : !bytes_v(l, BUFSZ) | inp : FILEref, p : ptr(l), c : int, res : int) : int = 72 | let 73 | val n = freadc(pf | inp, p, $UN.cast{char}(c)) 74 | in 75 | if n > 0 then 76 | let 77 | var pz = ptr_add(p, n) 78 | var res = wclbuf(pf | p, pz, c, res) 79 | in 80 | loop(pf | inp, p, c, res) 81 | end 82 | else 83 | res 84 | end 85 | in 86 | loop(pf | inp, p, c, 0) 87 | end 88 | 89 | (* ****** ****** *) 90 | fun line_count(s : string) : int = 91 | let 92 | var inp: FILEref = fopen_ref_exn(s, file_mode_r) 93 | val (pfat, pfgc | p) = malloc_gc(g1i2u(BUFSZ)) 94 | prval () = pfat := b0ytes2bytes_v(pfat) 95 | var res = wclfil(pfat | inp, p, $UN.cast2int('\n')) 96 | val () = mfree_gc(pfat, pfgc | p) 97 | in 98 | res 99 | end -------------------------------------------------------------------------------- /language-ats/test/data/fastcount.out: -------------------------------------------------------------------------------- 1 | (* 2 | ** 3 | ** A fast approach to counting newlines 4 | ** 5 | ** Author: Hongwei Xi (hwxi AT cs DOT bu DOT edu) 6 | ** Time: April 17, 2013 7 | ** 8 | *) 9 | #include "share/atspre_staload.hats" 10 | 11 | staload UN = "prelude/SATS/unsafe.sats" 12 | staload "libats/libc/SATS/stdio.sats" 13 | 14 | %{^ 15 | extern void *rawmemchr(const void *s, int c); 16 | #define atslib_rawmemchr rawmemchr 17 | %} 18 | 19 | extern 20 | fun rawmemchr {l:addr}{m:int}(pf : bytes_v(l, m) | p : ptr(l), c : int) 21 | : [ l2 : addr | l+m > l2 ] ( bytes_v(l, l2-l) 22 | , bytes_v(l2, l+m-l2) 23 | | ptr(l2)) = 24 | "mac#atslib_rawmemchr" 25 | 26 | (* ****** ****** *) 27 | #define BUFSZ (16*1024) 28 | 29 | (* ****** ****** *) 30 | extern 31 | fun freadc {l:addr} (pf : !bytes_v(l, BUFSZ) 32 | | inp : FILEref, p : ptr(l), c : char) : size_t 33 | 34 | implement freadc (pf | inp, p, c) = 35 | let 36 | var n = $extfcall(size_t, "fread", p, sizeof, BUFSZ - 1, inp) 37 | val () = $UN.ptr0_set(ptr_add(p, n), c) 38 | in 39 | n 40 | end 41 | 42 | (* ****** ****** *) 43 | extern 44 | fun wclbuf {l:addr}{n:int} (pf : !bytes_v(l, n) 45 | | p : ptr(l), pz : ptr, c : int, res : int) : int 46 | 47 | implement wclbuf (pf | p, pz, c, res) = 48 | let 49 | val (pf1, pf2 | p2) = rawmemchr(pf | p, c) 50 | in 51 | if p2 < pz then 52 | let 53 | prval (pf21, pf22) = array_v_uncons(pf2) 54 | var res = wclbuf(pf22 | ptr_succ(p2), pz, c, res + 1) 55 | prval () = pf2 := array_v_cons(pf21,pf22) 56 | prval () = pf := bytes_v_unsplit(pf1,pf2) 57 | in 58 | res 59 | end 60 | else 61 | let 62 | prval () = pf := bytes_v_unsplit(pf1,pf2) 63 | in 64 | res 65 | end 66 | end 67 | 68 | (* ****** ****** *) 69 | extern 70 | fun wclfil {l:addr} (pf : !bytes_v(l, BUFSZ) 71 | | inp : FILEref, p : ptr(l), c : int) : int 72 | 73 | implement wclfil {l} (pf | inp, p, c) = 74 | let 75 | fun loop(pf : !bytes_v(l, BUFSZ) 76 | | inp : FILEref, p : ptr(l), c : int, res : int) : int = 77 | let 78 | val n = freadc(pf | inp, p, $UN.cast{char}(c)) 79 | in 80 | if n > 0 then 81 | let 82 | var pz = ptr_add(p, n) 83 | var res = wclbuf(pf | p, pz, c, res) 84 | in 85 | loop(pf | inp, p, c, res) 86 | end 87 | else 88 | res 89 | end 90 | in 91 | loop(pf | inp, p, c, 0) 92 | end 93 | 94 | (* ****** ****** *) 95 | fun line_count(s : string) : int = 96 | let 97 | var inp: FILEref = fopen_ref_exn(s, file_mode_r) 98 | val (pfat, pfgc | p) = malloc_gc(g1i2u(BUFSZ)) 99 | prval () = pfat := b0ytes2bytes_v(pfat) 100 | var res = wclfil(pfat | inp, p, $UN.cast2int('\n')) 101 | val () = mfree_gc(pfat, pfgc | p) 102 | in 103 | res 104 | end 105 | -------------------------------------------------------------------------------- /language-ats/test/data/fib-thm.dats: -------------------------------------------------------------------------------- 1 | // example from the book: http://ats-lang.sourceforge.net/EXAMPLE/EFFECTIVATS/PwTP-bool-vs-prop/main.html 2 | #include "share/atspre_staload.hats" 3 | 4 | staload "prelude/SATS/integer.sats" 5 | 6 | infixr (->) ->> 7 | 8 | stadef ->> (b1: bool, b2: bool) = ~b1 || b2 9 | 10 | dataprop fib_p(int, int) = 11 | | fib_p_bas0(0, 0) of () 12 | | fib_p_bas1(1, 1) of () 13 | | {n:nat}{ r0, r1 : int } fib_p_ind2(n + 2, r0 + r1) of (fib_p( n 14 | , r0 15 | ), fib_p(n + 1, r1)) 16 | 17 | stacst fib_b : (int, int) -> bool 18 | 19 | extern 20 | praxi fib_b_bas0() : [fib_b(0,0)] unit_p 21 | 22 | extern 23 | praxi fib_b_bas1() : [fib_b(1,1)] unit_p 24 | 25 | extern 26 | praxi fib_b_ind2 {n:nat}{ r0, r1 : int } : 27 | [fib_b(n,r0) && fib_b(n+1,r1) ->> fib_b(n+2,r0+r1)] unit_p 28 | 29 | fun f_fib_p {n:nat}(n : int(n)) : [r:int] (fib_p(n, r) | int(r)) = 30 | let 31 | fun loop { i : nat | i < n }{ r0, r1 : int }( pf0 : fib_p(i, r0) 32 | , pf1 : fib_p(i+1, r1) 33 | | i : int(i), r0 : int(r0), r1 : int(r1)) : 34 | [r:int] (fib_p(n, r) | int(r)) = 35 | if i + 1 < n then 36 | loop(pf1, fib_p_ind2(pf0, pf1) | i + 1, r1, r0 + r1) 37 | else 38 | (pf1 | r1) 39 | 40 | prval pf0 = fib_p_bas0() 41 | prval pf1 = fib_p_bas1() 42 | in 43 | if n >= 1 then 44 | loop(pf0, pf1 | 0, 0, 1) 45 | else 46 | (pf0 | 0) 47 | end 48 | 49 | implement main0 () = 50 | let 51 | val (_ | i) = f_fib_p(40) 52 | in 53 | println!(i) 54 | end 55 | 56 | -------------------------------------------------------------------------------- /language-ats/test/data/fib-thm.out: -------------------------------------------------------------------------------- 1 | // example from the book: http://ats-lang.sourceforge.net/EXAMPLE/EFFECTIVATS/PwTP-bool-vs-prop/main.html 2 | #include "share/atspre_staload.hats" 3 | 4 | staload "prelude/SATS/integer.sats" 5 | 6 | infixr (->) ->> 7 | 8 | stadef ->> (b1: bool, b2: bool) = ~b1 || b2 9 | 10 | dataprop fib_p(int, int) = 11 | | fib_p_bas0(0, 0) of () 12 | | fib_p_bas1(1, 1) of () 13 | | {n:nat}{ r0, r1 : int } fib_p_ind2(n + 2, r0 + r1) of (fib_p( n 14 | , r0 15 | ), fib_p(n + 1, r1)) 16 | 17 | stacst fib_b : (int, int) -> bool 18 | 19 | extern 20 | praxi fib_b_bas0() : [fib_b(0,0)] unit_p 21 | 22 | extern 23 | praxi fib_b_bas1() : [fib_b(1,1)] unit_p 24 | 25 | extern 26 | praxi fib_b_ind2 {n:nat}{ r0, r1 : int } : 27 | [fib_b(n,r0) && fib_b(n+1,r1) ->> fib_b(n+2,r0+r1)] unit_p 28 | 29 | fun f_fib_p {n:nat}(n : int(n)) : [r:int] (fib_p(n, r) | int(r)) = 30 | let 31 | fun loop { i : nat | i < n }{ r0, r1 : int }( pf0 : fib_p(i, r0) 32 | , pf1 : fib_p(i+1, r1) 33 | | i : int(i), r0 : int(r0), r1 : int(r1)) : 34 | [r:int] (fib_p(n, r) | int(r)) = 35 | if i + 1 < n then 36 | loop(pf1, fib_p_ind2(pf0, pf1) | i + 1, r1, r0 + r1) 37 | else 38 | (pf1 | r1) 39 | 40 | prval pf0 = fib_p_bas0() 41 | prval pf1 = fib_p_bas1() 42 | in 43 | if n >= 1 then 44 | loop(pf0, pf1 | 0, 0, 1) 45 | else 46 | (pf0 | 0) 47 | end 48 | 49 | implement main0 () = 50 | let 51 | val (_ | i) = f_fib_p(40) 52 | in 53 | println!(i) 54 | end 55 | -------------------------------------------------------------------------------- /language-ats/test/data/fib.dats: -------------------------------------------------------------------------------- 1 | #include "prelude/DATS/integer.dats" 2 | 3 | fnx fib { n : int | n >= 0 } .. (i : int(n)) : int = 4 | case+ i of 5 | | _ when i - 2 >= 0 => ( fib(i-1) + fib(i-2) ) 6 | | _ => 1 7 | -------------------------------------------------------------------------------- /language-ats/test/data/fib.out: -------------------------------------------------------------------------------- 1 | #include "prelude/DATS/integer.dats" 2 | 3 | fnx fib { n : int | n >= 0 } .. (i : int(n)) : int = 4 | case+ i of 5 | | _ when i - 2 >= 0 => (fib(i - 1) + fib(i - 2)) 6 | | _ => 1 7 | -------------------------------------------------------------------------------- /language-ats/test/data/filecount.dats: -------------------------------------------------------------------------------- 1 | #include "share/atspre_staload.hats" 2 | #include "libats/ML/DATS/filebas_dirent.dats" 3 | #include "libats/libc/DATS/dirent.dats" 4 | 5 | staload "libats/ML/DATS/string.dats" 6 | 7 | fun good_dir(next: string) : bool = case next of | "." => false | ".." => false | _ => true 8 | fnx step_stream(acc: int, s: string) : int = 9 | if test_file_isdir(s) != 0 then 10 | flow_stream(s, acc + 1) 11 | else 12 | acc + 1 13 | and flow_stream(s: string, init: int) : int = 14 | let 15 | var files = streamize_dirname_fname(s) 16 | var ffiles = stream_vt_filter_cloptr(files, lam x => good_dir(x)) 17 | in 18 | stream_vt_foldleft_cloptr(ffiles, init, lam (acc, next) => step_stream(acc, s + "/" + next)) 19 | end 20 | fun count_files(s: string) : void = 21 | let 22 | var n: int = step_stream(0, g1ofg0(s)) 23 | in 24 | println!(tostring_int(n)) 25 | end 26 | 27 | implement main0 (argc, argv) = 28 | if argc > 1 then 29 | count_files(argv[1]) 30 | else 31 | count_files(".") 32 | -------------------------------------------------------------------------------- /language-ats/test/data/filecount.out: -------------------------------------------------------------------------------- 1 | #include "share/atspre_staload.hats" 2 | #include "libats/ML/DATS/filebas_dirent.dats" 3 | #include "libats/libc/DATS/dirent.dats" 4 | 5 | staload "libats/ML/DATS/string.dats" 6 | 7 | fun good_dir(next : string) : bool = 8 | case next of 9 | | "." => false 10 | | ".." => false 11 | | _ => true 12 | 13 | fnx step_stream(acc : int, s : string) : int = 14 | if test_file_isdir(s) != 0 then 15 | flow_stream(s, acc + 1) 16 | else 17 | acc + 1 18 | and flow_stream(s : string, init : int) : int = 19 | let 20 | var files = streamize_dirname_fname(s) 21 | var ffiles = stream_vt_filter_cloptr(files, lam x => good_dir(x)) 22 | in 23 | stream_vt_foldleft_cloptr( ffiles 24 | , init 25 | , lam (acc, next) => 26 | step_stream(acc, s + "/" + next) 27 | ) 28 | end 29 | 30 | fun count_files(s : string) : void = 31 | let 32 | var n: int = step_stream(0, g1ofg0(s)) 33 | in 34 | println!(tostring_int(n)) 35 | end 36 | 37 | implement main0 (argc, argv) = 38 | if argc > 1 then 39 | count_files(argv[1]) 40 | else 41 | count_files(".") 42 | -------------------------------------------------------------------------------- /language-ats/test/data/finger-tree.out: -------------------------------------------------------------------------------- 1 | datatype list(a: t@ype+) = 2 | | cons of (a, list(a)) 3 | | nil 4 | 5 | fun concat {a:t@ype+} (list(a), list(a)) : list(a) 6 | 7 | typedef digit(a: t@ype+) = list(a) 8 | 9 | datatype node(a: t@ype) = 10 | | node2 of (a, a) 11 | | node3 of (a, a, a) 12 | 13 | datatype finger_tree(a: t@ype+) = 14 | | empty 15 | | single of (a) 16 | | deep of (digit(a), finger_tree(node(a)), digit(a)) 17 | 18 | symintr <| |> 19 | 20 | infixr 5 <| 21 | infixl 5 |> 22 | 23 | fun lcons {a:t@ype+} (a, finger_tree(a)) : finger_tree(a) 24 | 25 | fun rcons {a:t@ype+} (finger_tree(a), a) : finger_tree(a) 26 | 27 | overload <| with lcons 28 | overload |> with rcons 29 | -------------------------------------------------------------------------------- /language-ats/test/data/finger-tree.sats: -------------------------------------------------------------------------------- 1 | datatype list(a: t@ype+) = 2 | | cons of (a, list(a)) 3 | | nil 4 | 5 | fun concat {a:t@ype+} (list(a), list(a)) : list(a) 6 | 7 | typedef digit(a: t@ype+) = list(a) 8 | 9 | datatype node(a: t@ype) = 10 | | node2 of (a, a) 11 | | node3 of (a, a, a) 12 | 13 | datatype finger_tree(a: t@ype+) = 14 | | empty 15 | | single of (a) 16 | | deep of (digit(a), finger_tree(node(a)), digit(a)) 17 | 18 | symintr <| |> 19 | 20 | infixr 5 <| 21 | 22 | infixl 5 |> 23 | 24 | fun lcons {a:t@ype+} (a, finger_tree(a)) : finger_tree(a) 25 | 26 | fun rcons {a:t@ype+} (finger_tree(a), a) : finger_tree(a) 27 | 28 | overload <| with lcons 29 | 30 | overload |> with rcons 31 | -------------------------------------------------------------------------------- /language-ats/test/data/futhark-types.out: -------------------------------------------------------------------------------- 1 | // Futhark types 2 | // TODO: absvt@ype 3 | absvtype fut_ctx_cfg 4 | absvtype fut_ctx 5 | absvtype f32_arr_1d 6 | absvtype f64_arr_1d 7 | 8 | // OpenCL types 9 | absvtype cl_cmd_queue = $extype "cl_command_queue" 10 | absvtype cl_mem = $extype "cl_mem" 11 | 12 | // Pointer synonyms 13 | vtypedef futctxcfgptr = [l:addr] (fut_ctx_cfg @ l | ptr(l)) 14 | vtypedef futctxptr = [l:addr] (fut_ctx @ l | ptr(l)) 15 | vtypedef clcmdqptr = [l:addr] (cl_cmd_queue @ l | ptr(l)) 16 | 17 | absvt@ype f32_arrptr 18 | -------------------------------------------------------------------------------- /language-ats/test/data/futhark-types.sats: -------------------------------------------------------------------------------- 1 | // Futhark types 2 | // TODO: absvt@ype 3 | absvtype fut_ctx_cfg 4 | absvtype fut_ctx 5 | absvtype f32_arr_1d 6 | absvtype f64_arr_1d 7 | 8 | // OpenCL types 9 | absvtype cl_cmd_queue = $extype "cl_command_queue" 10 | absvtype cl_mem = $extype "cl_mem" 11 | 12 | // Pointer synonyms 13 | vtypedef futctxcfgptr = [l:addr] (fut_ctx_cfg @ l | ptr(l)) 14 | vtypedef futctxptr = [l:addr] (fut_ctx @ l | ptr(l)) 15 | vtypedef clcmdqptr = [l:addr] (cl_cmd_queue @ l | ptr(l)) 16 | absvt@ype f32_arrptr 17 | -------------------------------------------------------------------------------- /language-ats/test/data/gmp-import.dats: -------------------------------------------------------------------------------- 1 | extern 2 | fn mpz_primorial_ui(x : &$GMP.mpz >> _, n : ullint) : void = 3 | "mac#" 4 | -------------------------------------------------------------------------------- /language-ats/test/data/gmp-import.out: -------------------------------------------------------------------------------- 1 | extern 2 | fn mpz_primorial_ui(x : &$GMP.mpz >> _, n : ullint) : void = 3 | "mac#" 4 | -------------------------------------------------------------------------------- /language-ats/test/data/ifact2.dats: -------------------------------------------------------------------------------- 1 | fun 2 | ifact2 3 | {n:nat} .<>. 4 | ( 5 | n: int (n) 6 | ) :<> [r:int] (FACT(n, r) | int r) = let 7 | fun loop 8 | {i:nat|i <= n}{r:int} .. 9 | ( 10 | pf: FACT(i, r) 11 | | n: int n, i: int i, r: int r 12 | ) :<> [r:int] (FACT(n, r) | int r) = 13 | if n - i > 0 then let 14 | val (pfmul | r1) = imul2 (i+1, r) in loop (FACTind(pf, pfmul) | n, i+1, r1) 15 | end else (pf | r) // end of [if] 16 | // end of [loop] 17 | in 18 | loop (FACTbas() | n, 0, 1) 19 | end // end of [ifact2] 20 | -------------------------------------------------------------------------------- /language-ats/test/data/ifact2.out: -------------------------------------------------------------------------------- 1 | fun ifact2 {n:nat} .<>. (n : int(n)) :<> [r:int] (FACT(n, r) | int(r)) = 2 | let 3 | fun loop { i : nat | i <= n }{r:int} .. (pf : FACT(i, r) 4 | | n : int(n), i : int(i), r : int(r)) :<> 5 | [r:int] (FACT(n, r) | int(r)) = 6 | if n - i > 0 then 7 | let 8 | val (pfmul | r1) = imul2((i + 1, r)) 9 | in 10 | loop(FACTind(pf, pfmul) | n, i + 1, r1) 11 | end 12 | else 13 | (pf | r) 14 | 15 | // end of [if] 16 | // end of [loop] 17 | in 18 | loop(FACTbas() | n, 0, 1) 19 | end 20 | 21 | // end of [ifact2] 22 | -------------------------------------------------------------------------------- /language-ats/test/data/integer_ptr.out: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vmchale/atspkg/26cdd1ed1130a31e4bb4985fc54e50240228f7df/language-ats/test/data/integer_ptr.out -------------------------------------------------------------------------------- /language-ats/test/data/left-pad.dats: -------------------------------------------------------------------------------- 1 | #include "share/atspre_staload.hats" 2 | 3 | dataprop PAD(int,int,int) = 4 | | {p,l:nat} Yep(p,l,p-l) 5 | | {p,l:nat} Nope(p,l,0) 6 | 7 | extern fun left_pad 8 | {p,l:nat | p>0 && l>0} 9 | ( 10 | pad: ssize_t p, 11 | c: charNZ, 12 | s: strnptr l 13 | ): [cushion:nat] (PAD(p,l,cushion) | strnptr (cushion+l)) 14 | 15 | extern fun {t:t@ype} fill_list 16 | {n:nat} 17 | ( 18 | size:ssize_t n, 19 | c: t 20 | ): list_vt(t,n) 21 | 22 | implement {t}fill_list{n}(size,c) = 23 | let 24 | fun loop 25 | {i:nat | i <= n} 26 | .. 27 | ( 28 | size : ssize_t i, 29 | c: t, 30 | res: list_vt(t, n-i) 31 | ): list_vt(t,n) = 32 | if (size = i2ssz(0)) 33 | then res 34 | else loop(pred size, c, list_vt_cons(c,res)) 35 | in 36 | loop(size,c,list_vt_nil()) 37 | end 38 | 39 | implement left_pad{p,l}(pad,c,s) = 40 | let 41 | val size = strnptr_length(s) 42 | in 43 | if (pad > size) 44 | then 45 | let 46 | val padding = pad-size 47 | val char_list = fill_list(padding,c) 48 | val pad_string = string_make_list_vt(char_list) 49 | val res = strnptr_append(pad_string, s) 50 | in 51 | begin 52 | strnptr_free(pad_string); 53 | strnptr_free(s); 54 | (Yep{p,l} | res) 55 | end 56 | end 57 | else 58 | (Nope{p,l} | s) 59 | end 60 | 61 | implement main0(argc, argv) = 62 | let 63 | val args = listize_argc_argv(argc,argv) 64 | val _ = 65 | if list_vt_length(args) = 3 66 | then ( 67 | let 68 | val c = '0' 69 | val s = g1ofg0(args[1]) : [n:nat] string n 70 | val pad = g1ofg0(g0string2int(args[2])) 71 | in 72 | if length(s) > 0 && pad > 0 73 | then ( 74 | let 75 | prval _ = lemma_not_empty(s) where { 76 | extern praxi 77 | lemma_not_empty{n:int}(x:string(n)):[n > 0] void 78 | } 79 | prval _ = lemma_not_zero(pad) where { 80 | extern praxi 81 | lemma_not_zero{n:int}(x:int(n)):[n > 0] void 82 | } 83 | val (pf | res) = left_pad(i2ssz(pad),c, string1_copy(s)) 84 | in 85 | begin 86 | println! ("padding: ", res); 87 | strnptr_free(res); 88 | end 89 | end 90 | ) 91 | else 92 | print "Usage: left-pad \n" 93 | end 94 | ) 95 | else print "Usage: left-pad \n" 96 | in 97 | list_vt_free(args) 98 | end 99 | -------------------------------------------------------------------------------- /language-ats/test/data/left-pad.out: -------------------------------------------------------------------------------- 1 | #include "share/atspre_staload.hats" 2 | 3 | dataprop PAD(int, int, int) = 4 | | { p, l : nat } Yep(p, l, p - l) 5 | | { p, l : nat } Nope(p, l, 0) 6 | 7 | extern 8 | fun left_pad { p, l : nat | p > 0 && l > 0 } ( pad : ssize_t(p) 9 | , c : charNZ 10 | , s : strnptr(l) 11 | ) : [cushion:nat] (PAD(p, l, cushion) | strnptr(cushion+l)) 12 | 13 | extern 14 | fun {t:t@ype} fill_list {n:nat} (size : ssize_t(n), c : t) : 15 | list_vt(t, n) 16 | 17 | implement {t} fill_list {n} (size, c) = 18 | let 19 | fun loop { i : nat | i <= n } .. ( size : ssize_t(i) 20 | , c : t 21 | , res : list_vt(t, n-i) 22 | ) : list_vt(t, n) = 23 | if (size = i2ssz(0)) then 24 | res 25 | else 26 | loop(pred(size), c, list_vt_cons(c, res)) 27 | in 28 | loop(size, c, list_vt_nil()) 29 | end 30 | 31 | implement left_pad {p,l} (pad, c, s) = 32 | let 33 | val size = strnptr_length(s) 34 | in 35 | if (pad > size) then 36 | let 37 | val padding = pad - size 38 | val char_list = fill_list(padding, c) 39 | val pad_string = string_make_list_vt(char_list) 40 | val res = strnptr_append(pad_string, s) 41 | in 42 | (strnptr_free(pad_string) ; strnptr_free(s) ; (Yep{p,l} | res)) 43 | end 44 | else 45 | (Nope{p,l} | s) 46 | end 47 | 48 | implement main0 (argc, argv) = 49 | let 50 | val args = listize_argc_argv(argc, argv) 51 | val _ = if list_vt_length(args) = 3 then 52 | (let 53 | val c = '0' 54 | val s = g1ofg0(args[1]) : [n:nat] string(n) 55 | val pad = g1ofg0(g0string2int(args[2])) 56 | in 57 | if length(s) > 0 && pad > 0 then 58 | (let 59 | prval _ = lemma_not_empty(s) where 60 | { extern 61 | praxi lemma_not_empty {n:int} (x : string(n)) : [n > 0] void } 62 | prval _ = lemma_not_zero(pad) where 63 | { extern 64 | praxi lemma_not_zero {n:int} (x : int(n)) : [n > 0] void } 65 | val (pf | res) = left_pad(i2ssz(pad), c, string1_copy(s)) 66 | in 67 | (println!("padding: ", res) ; strnptr_free(res)) 68 | end) 69 | else 70 | print("Usage: left-pad \n") 71 | end) 72 | else 73 | print("Usage: left-pad \n") 74 | in 75 | list_vt_free(args) 76 | end 77 | -------------------------------------------------------------------------------- /language-ats/test/data/levenshtein.dats: -------------------------------------------------------------------------------- 1 | staload UN = "prelude/SATS/unsafe.sats" 2 | 3 | // Ported over from https://en.wikibooks.org/wiki/Algorithm_Implementation/Strings/Levenshtein_distance#C 4 | fn levenshtein {m:nat}{n:nat}(s1 : string(m), s2 : string(n)) : int = 5 | let 6 | val s1_l: size_t(m) = length(s1) 7 | val s2_l: size_t(n) = length(s2) 8 | val column: arrayref(int, m+1) = arrayref_make_elt(s1_l + 1, 0) 9 | var i: int = sz2i(s1_l) 10 | 11 | fun loop1 { i : nat | i <= m } .. (i : int(i)) : void = 12 | case+ i of 13 | | 0 => () 14 | | i =>> { 15 | val () = column[i] := i 16 | val () = loop1(i - 1) 17 | } 18 | 19 | val () = loop1(sz2i(s1_l)) 20 | 21 | val () = while* {i:nat} .. (i: int(i)) => (i > 0)(column[i] := i ; i := i - 1) 22 | val () = while(i > 0)(column[i] := i ; i := i - 1) 23 | val () = for* { i : nat | i <= m } .. (i : int(i)) => 24 | (i := sz2i(s1_l) ; i > 0 ; i := i - 1) 25 | (column[i] := i) 26 | 27 | fun loop2 { i : nat | i > 0 && i <= n+1 } .. (x : int(i)) : void = 28 | if x <= sz2i(s2_l) then 29 | { 30 | val () = column[0] := x 31 | val () = let 32 | fun inner_loop { j : nat | j > 0 && j <= m+1 } .. (y : int(j), last_diag : int) : 33 | void = 34 | if y <= sz2i(s1_l) then 35 | let 36 | var old_diag = column[y] 37 | 38 | fun min_3(x : int, y : int, z : int) : int = 39 | min(x, (min(y, z))) 40 | 41 | fun bool2int(c0 : char, c1 : char) : int = 42 | if c0 = c1 then 43 | 0 44 | else 45 | 1 46 | 47 | val () = column[y] := min_3( column[y] + 1 48 | , column[y - 1] + 1 49 | , last_diag + bool2int(s1[y - 1], s2[x - 1]) 50 | ) 51 | in 52 | inner_loop(y + 1, old_diag) 53 | end 54 | in 55 | inner_loop(1, x - 1) 56 | end 57 | val () = loop2(x + 1) 58 | } 59 | 60 | val () = loop2(1) 61 | in 62 | column[s1_l] 63 | end 64 | 65 | fn levenshtein_vt {m:nat}{n:nat}(s1 : !strnptr(m), s2 : !strnptr(n)) : int = 66 | let 67 | var p1 = strnptr2ptr(s1) 68 | var p2 = strnptr2ptr(s2) 69 | var s1 = $UN.ptr0_get(p1) 70 | var s2 = $UN.ptr0_get(p2) 71 | in 72 | levenshtein(s1, s2) 73 | end 74 | -------------------------------------------------------------------------------- /language-ats/test/data/levenshtein.out: -------------------------------------------------------------------------------- 1 | staload UN = "prelude/SATS/unsafe.sats" 2 | 3 | // Ported over from https://en.wikibooks.org/wiki/Algorithm_Implementation/Strings/Levenshtein_distance#C 4 | fn levenshtein {m:nat}{n:nat}(s1 : string(m), s2 : string(n)) : int = 5 | let 6 | val s1_l: size_t(m) = length(s1) 7 | val s2_l: size_t(n) = length(s2) 8 | val column: arrayref(int, m+1) = arrayref_make_elt(s1_l + 1, 0) 9 | var i: int = sz2i(s1_l) 10 | 11 | fun loop1 { i : nat | i <= m } .. (i : int(i)) : void = 12 | case+ i of 13 | | 0 => () 14 | | i =>> { 15 | val () = column[i] := i 16 | val () = loop1(i - 1) 17 | } 18 | 19 | val () = loop1(sz2i(s1_l)) 20 | val () = while* {i:nat} .. (i : int(i)) => 21 | (i > 0) 22 | (column[i] := i ; i := i - 1) 23 | val () = while(i > 0)(column[i] := i ; i := i - 1) 24 | val () = for* { i : nat | i <= m } .. (i : int(i)) => 25 | (i := sz2i(s1_l) ; i > 0 ; i := i - 1) 26 | (column[i] := i) 27 | 28 | fun loop2 { i : nat | i > 0 && i <= n+1 } .. (x : int(i)) : 29 | void = 30 | if x <= sz2i(s2_l) then 31 | { 32 | val () = column[0] := x 33 | val () = let 34 | fun inner_loop { j : nat | j > 0 && j <= m+1 } .. ( y : int(j) 35 | , last_diag : int 36 | ) : void = 37 | if y <= sz2i(s1_l) then 38 | let 39 | var old_diag = column[y] 40 | 41 | fun min_3(x : int, y : int, z : int) : int = 42 | min(x, (min(y, z))) 43 | 44 | fun bool2int(c0 : char, c1 : char) : int = 45 | if c0 = c1 then 46 | 0 47 | else 48 | 1 49 | 50 | val () = column[y] := min_3( column[y] + 1 51 | , column[y - 1] + 1 52 | , last_diag + bool2int(s1[y - 1], s2[x - 1]) 53 | ) 54 | in 55 | inner_loop(y + 1, old_diag) 56 | end 57 | in 58 | inner_loop(1, x - 1) 59 | end 60 | val () = loop2(x + 1) 61 | } 62 | 63 | val () = loop2(1) 64 | in 65 | column[s1_l] 66 | end 67 | 68 | fn levenshtein_vt {m:nat}{n:nat}(s1 : !strnptr(m), s2 : !strnptr(n)) : 69 | int = 70 | let 71 | var p1 = strnptr2ptr(s1) 72 | var p2 = strnptr2ptr(s2) 73 | var s1 = $UN.ptr0_get(p1) 74 | var s2 = $UN.ptr0_get(p2) 75 | in 76 | levenshtein(s1, s2) 77 | end 78 | -------------------------------------------------------------------------------- /language-ats/test/data/list_append.dats: -------------------------------------------------------------------------------- 1 | fun 2 | {a:t@ype} 3 | list_append 4 | {m,n:nat} ( 5 | xs: list (a, m) 6 | , ys: list (a, n) 7 | ) : list (a, m+n) = 8 | ( 9 | case+ xs of 10 | | list_cons 11 | (x, xs) => list_cons (x, list_append (xs, ys)) 12 | | list_nil ((*void*)) => ys 13 | ) // end of [list_append] 14 | 15 | fun 16 | {a:t@ype} 17 | list_append2 18 | {m,n:nat} ( 19 | xs: list (a, m) 20 | , ys: list (a, n) 21 | ) : list (a, m+n) = let 22 | // 23 | fun loop{m:nat} 24 | ( 25 | xs: list (a, m) 26 | , ys: list (a, n) 27 | , res: &ptr? >> list (a, m+n) 28 | ) : void = 29 | ( 30 | case+ xs of 31 | | list_cons 32 | (x, xs1) => let 33 | val () = res := list_cons{a}{0}(x, _) 34 | val+list_cons (_, res1) = res 35 | val () = loop (xs1, ys, res1) // of [xs1] and [ys] 36 | in 37 | fold@(res) 38 | end 39 | | list_nil ((*void*)) => res := ys 40 | ) 41 | // 42 | var res: ptr 43 | val () = loop (xs, ys, res) 44 | // 45 | in 46 | res 47 | end // end of [list_append2] 48 | -------------------------------------------------------------------------------- /language-ats/test/data/list_append.out: -------------------------------------------------------------------------------- 1 | fun {a:t@ype} list_append { m, n : nat }( xs : list(a, m) 2 | , ys : list(a, n) 3 | ) : list(a, m+n) = 4 | (case+ xs of 5 | | list_cons (x, xs) => list_cons((x, list_append(xs, ys))) 6 | | list_nil () => ys) 7 | 8 | // end of [list_append] 9 | fun {a:t@ype} list_append2 { m, n : nat }( xs : list(a, m) 10 | , ys : list(a, n) 11 | ) : list(a, m+n) = 12 | let 13 | // 14 | fun loop {m:nat}( xs : list(a, m) 15 | , ys : list(a, n) 16 | , res : &ptr? >> list(a, m+n) 17 | ) : void = 18 | (case+ xs of 19 | | list_cons (x, xs1) => let 20 | val () = res := list_cons{a}{0}(x, _) 21 | val+ list_cons (_, res1) = res 22 | val () = loop((xs1, ys, res1)) 23 | 24 | // of [xs1] and [ys] 25 | in 26 | fold@(res) 27 | end 28 | | list_nil () => res := ys) 29 | 30 | // 31 | var res: ptr 32 | val () = loop((xs, ys, res)) 33 | 34 | // 35 | in 36 | res 37 | end 38 | 39 | // end of [list_append2] 40 | -------------------------------------------------------------------------------- /language-ats/test/data/memchr.out: -------------------------------------------------------------------------------- 1 | // bad (?) idea: use rawmemchr + append lol 2 | fn memchr 3 | { l : addr | l != null }{m:nat}{ n : nat | n <= m }(bytes_v(l,m) 4 | | ptr(l), int, size_t(n)) : 5 | [ l0 : addr | l0 == null || l0 >= l && l0-l <= m ] ( bytes_v(l, l0-l) 6 | , bytes_v(l0, l+m-l0) 7 | | ptr(l0)) = 8 | "mac#" 9 | 10 | fn memchr2_rs 11 | { l : addr | l != null }{m:nat}{ n : nat | n <= m }(!bytes_v(l, m) 12 | | ptr(l), char, char, size_t(n)) : 13 | [ k : nat | k <= n || k == 18446744073709551615 ] size_t(k) = 14 | "ext#" 15 | 16 | fn memchr2 17 | { l : addr | l != null }{m:nat}{ n : nat | n <= m }(!bytes_v(l, m) 18 | | ptr(l), char, char, size_t(n)) : 19 | Option_vt([ k : nat | k <= n ] size_t(k)) = 20 | "ext#" 21 | 22 | fn memchr3_rs 23 | { l : addr | l != null }{m:nat}{ n : nat | n <= m }(!bytes_v(l, m) 24 | | ptr(l), char, char, char, size_t(n)) : 25 | [ k : nat | k <= n || k == 18446744073709551615 ] size_t(k) = 26 | "ext#" 27 | 28 | fn memchr3 29 | { l : addr | l != null }{m:nat}{ n : nat | n <= m }(!bytes_v(l, m) 30 | | ptr(l), char, char, char, size_t(n)) : 31 | Option_vt([ k : nat | k <= n ] size_t(k)) = 32 | "ext#" 33 | -------------------------------------------------------------------------------- /language-ats/test/data/memchr.sats: -------------------------------------------------------------------------------- 1 | // bad (?) idea: use rawmemchr + append lol 2 | fn memchr { l : addr | l != null }{m:nat}{ n : nat | n <= m }(bytes_v(l,m) | ptr(l), int, size_t(n)) : 3 | [ l0 : addr | l0 == null || l0 >= l && l0-l <= m ] (bytes_v(l, l0-l), bytes_v(l0, l+m-l0)| ptr(l0)) = 4 | "mac#" 5 | 6 | fn memchr2_rs { l : addr | l != null }{m:nat}{ n : nat | n <= m }(!bytes_v(l, m) | ptr(l), char, char, size_t(n)) : 7 | [ k : nat | k <= n || k == 18446744073709551615 ] size_t(k) = 8 | "ext#" 9 | 10 | fn memchr2 { l : addr | l != null }{m:nat}{ n : nat | n <= m }(!bytes_v(l, m) | ptr(l), char, char, size_t(n)) : 11 | Option_vt([ k : nat | k <= n ] size_t(k)) = 12 | "ext#" 13 | 14 | fn memchr3_rs { l : addr | l != null }{m:nat}{ n : nat | n <= m }(!bytes_v(l, m) | ptr(l), char, char, char, size_t(n)) 15 | : [ k : nat | k <= n || k == 18446744073709551615 ] size_t(k) = 16 | "ext#" 17 | fn memchr3 { l : addr | l != null }{m:nat}{ n : nat | n <= m }(!bytes_v(l, m) | ptr(l), char, char, char, size_t(n)) 18 | : Option_vt([ k : nat | k <= n ] size_t(k)) = 19 | "ext#" 20 | -------------------------------------------------------------------------------- /language-ats/test/data/mydepies.hats: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /language-ats/test/data/mydepies.out: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /language-ats/test/data/mylibies.hats: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | // 3 | // HX-2017-02-05: 4 | // 5 | // Generic 6 | // Divide-Conquer in parallel 7 | // 8 | (* ****** ****** *) 9 | // 10 | #staload 11 | DivideConquerPar = 12 | "./DATS/DivideConquerPar.dats" 13 | // 14 | (* ****** ****** *) 15 | 16 | (* end of [mylibies.hats] *) 17 | -------------------------------------------------------------------------------- /language-ats/test/data/mylibies.out: -------------------------------------------------------------------------------- 1 | (* ****** ****** *) 2 | // 3 | // HX-2017-02-05: 4 | // 5 | // Generic 6 | // Divide-Conquer in parallel 7 | // 8 | (* ****** ****** *) 9 | // 10 | #staload DivideConquerPar = "./DATS/DivideConquerPar.dats" 11 | 12 | // 13 | (* ****** ****** *) 14 | (* end of [mylibies.hats] *) 15 | -------------------------------------------------------------------------------- /language-ats/test/data/numerics.dats: -------------------------------------------------------------------------------- 1 | #define ATS_MAINATSFLAG 1 2 | 3 | #include "share/atspre_staload.hats" 4 | 5 | staload "libats/libc/SATS/math.sats" 6 | staload UN = "prelude/SATS/unsafe.sats" 7 | 8 | fun exp {n : nat} .. (x : int, n : int(n)) :<> int = 9 | case+ x of 10 | | 0 => 0 11 | | x => 12 | begin 13 | if n > 0 then 14 | let 15 | val n2 = half(n) 16 | val i2 = n % 2 17 | in 18 | if i2 = 0 then 19 | exp(x * x, n2) 20 | else 21 | x * exp(x * x, n2) 22 | end 23 | else 24 | 1 25 | end 26 | 27 | castfn lemma_bounded(i: int) : [n:nat] int(n) 28 | = $UN.cast(i) 29 | 30 | fun sqrt_bad(k : intGt(0)) : [ m : nat ] int(m) = 31 | let 32 | var pre_bound: int = g0float2int(sqrt_float(g0int2float_int_float(k))) 33 | var bound: [m:nat] int(m) = lemma_bounded(pre_bound) 34 | in 35 | bound 36 | end 37 | 38 | fn is_prime(k : intGt(0)) : bool = 39 | case+ k of 40 | | 1 => false 41 | | k => 42 | begin 43 | let 44 | fun loop {n : nat}{m : nat} .. (i : int(n), bound : int(m)) :<> bool = 45 | if i < bound then 46 | if k % i = 0 then 47 | false 48 | else 49 | loop(i + 1, bound) 50 | else 51 | if i = bound then 52 | if k % i = 0 then 53 | false 54 | else 55 | true 56 | else 57 | true 58 | in 59 | loop(2, sqrt_bad(k)) 60 | end 61 | end 62 | -------------------------------------------------------------------------------- /language-ats/test/data/numerics.out: -------------------------------------------------------------------------------- 1 | #define ATS_MAINATSFLAG 1 2 | 3 | #include "share/atspre_staload.hats" 4 | 5 | staload "libats/libc/SATS/math.sats" 6 | staload UN = "prelude/SATS/unsafe.sats" 7 | 8 | fun exp {n:nat} .. (x : int, n : int(n)) :<> int = 9 | case+ x of 10 | | 0 => 0 11 | | x => 12 | begin 13 | if n > 0 then 14 | let 15 | val n2 = half(n) 16 | val i2 = n % 2 17 | in 18 | if i2 = 0 then 19 | exp(x * x, n2) 20 | else 21 | x * exp(x * x, n2) 22 | end 23 | else 24 | 1 25 | end 26 | 27 | castfn lemma_bounded(i : int) : [n:nat] int(n) = 28 | $UN.cast(i) 29 | 30 | fun sqrt_bad(k : intGt(0)) : [m:nat] int(m) = 31 | let 32 | var pre_bound: int = g0float2int(sqrt_float(g0int2float_int_float(k))) 33 | var bound: [m:nat] int(m) = lemma_bounded(pre_bound) 34 | in 35 | bound 36 | end 37 | 38 | fn is_prime(k : intGt(0)) : bool = 39 | case+ k of 40 | | 1 => false 41 | | k => 42 | begin 43 | let 44 | fun loop {n:nat}{m:nat} .. (i : int(n), bound : int(m)) 45 | :<> bool = 46 | if i < bound then 47 | if k % i = 0 then 48 | false 49 | else 50 | loop(i + 1, bound) 51 | else 52 | if i = bound then 53 | if k % i = 0 then 54 | false 55 | else 56 | true 57 | else 58 | true 59 | in 60 | loop(2, sqrt_bad(k)) 61 | end 62 | end 63 | -------------------------------------------------------------------------------- /language-ats/test/data/prf_sqrt2.dats: -------------------------------------------------------------------------------- 1 | (* 2 | ** Some code used in the book INT2PROGINATS 3 | *) 4 | 5 | (* ****** ****** *) 6 | 7 | abstype 8 | MOD0(m: int, p: int) // m=p*q 9 | 10 | (* ****** ****** *) 11 | // 12 | extern 13 | prfun 14 | lemma_MOD0_intr 15 | {m,p,q:nat | m==p*q}(): MOD0(m, p) 16 | extern 17 | prfun 18 | lemma_MOD0_elim 19 | {m,p:int} 20 | (MOD0(m, p)): [q:nat] EQINT(m, p*q) 21 | // 22 | (* ****** ****** *) 23 | 24 | abstype PRIME(p:int) 25 | 26 | (* ****** ****** *) 27 | // 28 | extern 29 | prfun 30 | lemma_PRIME_param 31 | {p:int}(pf: PRIME(p)): [p >= 2] void 32 | // 33 | (* ****** ****** *) 34 | // 35 | extern 36 | prfun 37 | mylemma1{n,p:int} 38 | (MOD0(n*n, p), PRIME(p)): MOD0(n, p) 39 | // 40 | (* ****** ****** *) 41 | 42 | extern 43 | prfun 44 | mylemma_main 45 | {m,n,p:int | m*m==p*n*n}(PRIME(p)): [m2:nat | n*n==p*m2*m2] void 46 | 47 | (* ****** ****** *) 48 | 49 | extern 50 | prfun 51 | square_is_nat{m:int}(): [m*m>=0] void 52 | 53 | (* ****** ****** *) 54 | 55 | primplmnt 56 | mylemma_main 57 | {m,n,p}(pfprm) = let 58 | prval pfeq_mm_pnn = 59 | eqint_make{m*m,p*n*n}() 60 | prval () = square_is_nat{m}() 61 | prval () = square_is_nat{n}() 62 | prval () = lemma_PRIME_param(pfprm) 63 | prval 64 | pfmod1 = 65 | lemma_MOD0_intr{m*m,p,n*n}() 66 | prval 67 | pfmod2 = mylemma1{m,p}(pfmod1, pfprm) 68 | prval 69 | [m2:int] 70 | EQINT() = 71 | lemma_MOD0_elim(pfmod2) 72 | prval EQINT() = pfeq_mm_pnn 73 | prval () = 74 | __assert{p}{p*m2*m2,n*n}() where 75 | { 76 | extern prfun __assert{p:pos}{x,y:int | p*x==p*y}(): [x==y] void 77 | } 78 | in 79 | 0 80 | end // end of [mylemma_main] 81 | 82 | (* ****** ****** *) 83 | // 84 | extern 85 | prfun 86 | sqrt2_irrat 87 | {m,n:nat | 88 | n >= 1; m*m==2*n*n}((*void*)): [false] void 89 | // 90 | (* ****** ****** *) 91 | 92 | primplmnt 93 | sqrt2_irrat 94 | {m,n}((*void*)) = let 95 | prfun 96 | auxmain 97 | {m,n:nat | 98 | n >= 1; 99 | m*m==2*n*n} .. 100 | ( 101 | // argless 102 | ) : [false] void = let 103 | prval pfprm = 104 | __assert() where 105 | { 106 | extern praxi __assert(): PRIME(2) 107 | } 108 | prval 109 | [m2:int] () = mylemma_main{m,n,2}(pfprm) 110 | prval () = 111 | __assert() where { extern praxi __assert(): [m > n] void } 112 | prval () = 113 | __assert() where { extern praxi __assert(): [m2 >= 1] void } 114 | in 115 | auxmain{n,m2}() 116 | end 117 | in 118 | auxmain{m,n}() 119 | end // end of [sqrt2_irrat] 120 | 121 | (* ****** ****** *) 122 | 123 | implement main0 () = () 124 | 125 | (* ****** ****** *) 126 | 127 | (* end of [sqrt2_irrat.dats] *) 128 | -------------------------------------------------------------------------------- /language-ats/test/data/prf_sqrt2.out: -------------------------------------------------------------------------------- 1 | (* 2 | ** Some code used in the book INT2PROGINATS 3 | *) 4 | (* ****** ****** *) 5 | abstype MOD0(m: int, p: int) 6 | 7 | // m=p*q 8 | (* ****** ****** *) 9 | // 10 | extern 11 | prfun lemma_MOD0_intr { m, p, q : nat | m == p*q } () : MOD0(m, p) 12 | 13 | extern 14 | prfun lemma_MOD0_elim { m, p : int } (MOD0(m,p)) : [q:nat] EQINT(m, p*q) 15 | 16 | // 17 | (* ****** ****** *) 18 | abstype PRIME(p: int) 19 | 20 | (* ****** ****** *) 21 | // 22 | extern 23 | prfun lemma_PRIME_param {p:int} (pf : PRIME(p)) : [p >= 2] void 24 | 25 | // 26 | (* ****** ****** *) 27 | // 28 | extern 29 | prfun mylemma1 { n, p : int } (MOD0(n*n,p), PRIME(p)) : MOD0(n, p) 30 | 31 | // 32 | (* ****** ****** *) 33 | extern 34 | prfun mylemma_main { m, n, p : int | m*m == p*n*n } (PRIME(p)) : 35 | [ m2 : nat | n*n == p*m2*m2 ] void 36 | 37 | (* ****** ****** *) 38 | extern 39 | prfun square_is_nat {m:int} () : [m*m >= 0] void 40 | 41 | (* ****** ****** *) 42 | primplmnt mylemma_main {m,n,p} (pfprm) = 43 | let 44 | prval pfeq_mm_pnn = eqint_make{m*m,p*n*n}() 45 | prval () = square_is_nat{m}() 46 | prval () = square_is_nat{n}() 47 | prval () = lemma_PRIME_param(pfprm) 48 | prval pfmod1 = lemma_MOD0_intr{m*m,p,n*n}() 49 | prval pfmod2 = mylemma1{m,p}(pfmod1,pfprm) 50 | prval [m2:int]EQINT() = lemma_MOD0_elim(pfmod2) 51 | prval EQINT() = pfeq_mm_pnn 52 | prval () = __assert{p}{p*m2*m2,n*n}() where 53 | { extern 54 | prfun __assert {p:pos}{ x, y : int | p*x == p*y } () : [x == y] void } 55 | in 56 | 0 57 | end 58 | 59 | // end of [mylemma_main] 60 | (* ****** ****** *) 61 | // 62 | extern 63 | prfun sqrt2_irrat { m, n : nat | n >= 1; m*m == 2*n*n } () : 64 | [false] void 65 | 66 | // 67 | (* ****** ****** *) 68 | primplmnt sqrt2_irrat {m,n} () = 69 | let 70 | prfun auxmain { m, n : nat | n >= 1; m*m == 2*n*n } .. () : 71 | [false] void = 72 | let 73 | prval pfprm = __assert() where 74 | { extern 75 | praxi __assert() : PRIME(2) } 76 | prval [m2:int]() = mylemma_main{m,n,2}(pfprm) 77 | prval () = __assert() where 78 | { extern 79 | praxi __assert() : [m > n] void } 80 | prval () = __assert() where 81 | { extern 82 | praxi __assert() : [m2 >= 1] void } 83 | in 84 | auxmain{n,m2}() 85 | end 86 | in 87 | auxmain{m,n}() 88 | end 89 | 90 | // end of [sqrt2_irrat] 91 | (* ****** ****** *) 92 | implement main0 () = 93 | () 94 | 95 | (* ****** ****** *) 96 | (* end of [sqrt2_irrat.dats] *) 97 | -------------------------------------------------------------------------------- /language-ats/test/data/recursion.dats: -------------------------------------------------------------------------------- 1 | absprop FUNCTOR_PROP (A : prop, n : int) 2 | 3 | absprop BASE_FUNCTOR_PROP (A : prop, B : prop) 4 | 5 | dataprop LIST_PROP(A: prop, int) = 6 | | LIST_PROP_NIL(A, 0) of () 7 | | { n : nat | n > 0 } LIST_PROP_CONS(A, n) of (A, LIST_PROP(A, n - 1)) 8 | 9 | dataprop LISTF_PROP(A: prop, B: prop) = 10 | | LISTF_PROP_NIL(A, B) of () 11 | | LISTF_PROP_CONS(A, B) of (A, B) 12 | 13 | extern 14 | prfun MAP {A:prop}{B:prop}{C:prop} (F : B - C, X : BASE_FUNCTOR_PROP(A, B)) : BASE_FUNCTOR_PROP(A, C) 15 | 16 | propdef ALGEBRA (A : prop, B : prop) = BASE_FUNCTOR_PROP(A, B) - B 17 | 18 | extern 19 | prfun {A:prop} PROJECT {n:nat} (FUNCTOR_PROP(A,n)) : BASE_FUNCTOR_PROP(A, FUNCTOR_PROP(A,n-1)) 20 | 21 | extern 22 | prfn {A:prop}{B:prop} EMPTY_FUNCTOR {n:nat} : BASE_FUNCTOR_PROP(A, FUNCTOR_PROP(A,n)) 23 | 24 | assume FUNCTOR_PROP(A, n) = LIST_PROP(A, n) 25 | assume BASE_FUNCTOR_PROP(A, B) = LISTF_PROP(A, B) 26 | 27 | prfun {A:prop}{B:prop} CATA {n:nat} .. (F : ALGEBRA(A, B), A : FUNCTOR_PROP(A, n)) : B = 28 | sif n == 0 then 29 | F(LISTF_PROP_NIL) 30 | else 31 | F(MAP(lam A0 = CATA(F,A0),PROJECT(A))) 32 | 33 | primplmnt MAP (F, XS) = 34 | case+ XS of 35 | | LISTF_PROP_NIL() => LISTF_PROP_NIL() 36 | | LISTF_PROP_CONS (Y, YS) => LISTF_PROP_CONS(Y,F(YS)) 37 | 38 | primplmnt {A} PROJECT (A) = 39 | case+ A of 40 | | LIST_PROP_NIL() => LISTF_PROP_NIL() 41 | | LIST_PROP_CONS (B, BS) => LISTF_PROP_CONS(B,BS) 42 | -------------------------------------------------------------------------------- /language-ats/test/data/recursion.out: -------------------------------------------------------------------------------- 1 | absprop FUNCTOR_PROP (A : prop, n : int) 2 | 3 | absprop BASE_FUNCTOR_PROP (A : prop, B : prop) 4 | 5 | dataprop LIST_PROP(A: prop, int) = 6 | | LIST_PROP_NIL(A, 0) of () 7 | | { n : nat | n > 0 } LIST_PROP_CONS(A, n) of (A, LIST_PROP(A, n - 1)) 8 | 9 | dataprop LISTF_PROP(A: prop, B: prop) = 10 | | LISTF_PROP_NIL(A, B) of () 11 | | LISTF_PROP_CONS(A, B) of (A, B) 12 | 13 | extern 14 | prfun MAP {A:prop}{B:prop}{C:prop} ( F : B - C 15 | , X : BASE_FUNCTOR_PROP(A, B) 16 | ) : BASE_FUNCTOR_PROP(A, C) 17 | 18 | propdef ALGEBRA (A : prop, B : prop) = BASE_FUNCTOR_PROP(A, B) - B 19 | 20 | extern 21 | prfun {A:prop} PROJECT {n:nat} (FUNCTOR_PROP(A,n)) : 22 | BASE_FUNCTOR_PROP(A, FUNCTOR_PROP(A,n-1)) 23 | 24 | extern 25 | prfn {A:prop}{B:prop} EMPTY_FUNCTOR {n:nat} : 26 | BASE_FUNCTOR_PROP(A, FUNCTOR_PROP(A,n)) 27 | 28 | assume FUNCTOR_PROP(A, n) = LIST_PROP(A, n) 29 | assume BASE_FUNCTOR_PROP(A, B) = LISTF_PROP(A, B) 30 | 31 | prfun {A:prop}{B:prop} CATA {n:nat} .. ( F : ALGEBRA(A, B) 32 | , A : FUNCTOR_PROP(A, n) 33 | ) : B = 34 | sif n == 0 then 35 | F(LISTF_PROP_NIL) 36 | else 37 | F(MAP(lam A0 = CATA(F,A0),PROJECT(A))) 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 | -------------------------------------------------------------------------------- /language-ats/test/data/spec.dats: -------------------------------------------------------------------------------- 1 | #include "share/atspre_staload.hats" 2 | 3 | staload "SATS/futhark.sats" 4 | staload "SATS/futhark-arr.sats" 5 | staload "SATS/futhark-stats.sats" 6 | staload "SATS/futhark-linalg.sats" 7 | 8 | implement main0 () = 9 | { 10 | val arr0 = $arrpsz{float} (1.0f, 2.0f, 3.0f) 11 | var arr1 = $arrpsz{float} (1.0f, 2.0f, 3.0f) 12 | val ctx_cfg = futhark_context_config_new() 13 | val ctx = futhark_context_new(ctx_cfg) 14 | val fut_arr0 = futhark_new_f32_1d(ctx, arr0, 3) 15 | val fut_arr1 = futhark_new_f32_1d(ctx, arr1, 3) 16 | var ret: float 17 | val _ = futhark_entry_mean_f32(ctx, ret, fut_arr0) 18 | val () = println!(ret) 19 | val _ = futhark_entry_dotprod_f32(ctx, ret, fut_arr0, fut_arr1) 20 | val () = println!(ret) 21 | val _ = futhark_free_f32_1d(ctx, fut_arr0) 22 | val _ = futhark_free_f32_1d(ctx, fut_arr1) 23 | val () = futhark_context_free(ctx) 24 | val () = futhark_context_config_free(ctx_cfg) 25 | val () = arrayptr_free (arr0) 26 | val () = arrayptr_free (arr1) 27 | } 28 | -------------------------------------------------------------------------------- /language-ats/test/data/spec.out: -------------------------------------------------------------------------------- 1 | #include "share/atspre_staload.hats" 2 | 3 | staload "SATS/futhark.sats" 4 | staload "SATS/futhark-arr.sats" 5 | staload "SATS/futhark-stats.sats" 6 | staload "SATS/futhark-linalg.sats" 7 | 8 | implement main0 () = 9 | { 10 | val arr0 = $arrpsz{float}(1.0f, 2.0f, 3.0f) 11 | var arr1 = $arrpsz{float}(1.0f, 2.0f, 3.0f) 12 | val ctx_cfg = futhark_context_config_new() 13 | val ctx = futhark_context_new(ctx_cfg) 14 | val fut_arr0 = futhark_new_f32_1d(ctx, arr0, 3) 15 | val fut_arr1 = futhark_new_f32_1d(ctx, arr1, 3) 16 | var ret: float 17 | val _ = futhark_entry_mean_f32(ctx, ret, fut_arr0) 18 | val () = println!(ret) 19 | val _ = futhark_entry_dotprod_f32(ctx, ret, fut_arr0, fut_arr1) 20 | val () = println!(ret) 21 | val _ = futhark_free_f32_1d(ctx, fut_arr0) 22 | val _ = futhark_free_f32_1d(ctx, fut_arr1) 23 | val () = futhark_context_free(ctx) 24 | val () = futhark_context_config_free(ctx_cfg) 25 | val () = arrayptr_free(arr0) 26 | val () = arrayptr_free(arr1) 27 | } 28 | -------------------------------------------------------------------------------- /language-ats/test/data/stack-array.dats: -------------------------------------------------------------------------------- 1 | staload "SATS/futhark.sats" 2 | staload "SATS/futhark-arr.sats" 3 | staload "SATS/futhark-stats.sats" 4 | 5 | implement main0 () = 6 | { 7 | var arr = @[float](1.0f, 2.0f, 3.0f) 8 | val ctx_cfg = futhark_context_config_new() 9 | val ctx = futhark_context_new(ctx_cfg) 10 | val fut_arr = futhark_new_f32_1d(ctx, arr, 3) 11 | val _ = futhark_free_f32_1d(ctx, fut_arr) 12 | val () = futhark_context_free(ctx) 13 | val () = futhark_context_config_free(ctx_cfg) 14 | } 15 | -------------------------------------------------------------------------------- /language-ats/test/data/stack-array.out: -------------------------------------------------------------------------------- 1 | staload "SATS/futhark.sats" 2 | staload "SATS/futhark-arr.sats" 3 | staload "SATS/futhark-stats.sats" 4 | 5 | implement main0 () = 6 | { 7 | var arr = @[float](1.0f, 2.0f, 3.0f) 8 | val ctx_cfg = futhark_context_config_new() 9 | val ctx = futhark_context_new(ctx_cfg) 10 | val fut_arr = futhark_new_f32_1d(ctx, arr, 3) 11 | val _ = futhark_free_f32_1d(ctx, fut_arr) 12 | val () = futhark_context_free(ctx) 13 | val () = futhark_context_config_free(ctx_cfg) 14 | } 15 | -------------------------------------------------------------------------------- /language-ats/test/data/stdlib/DATS/bool.dats: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Applied Type System *) 4 | (* *) 5 | (***********************************************************************) 6 | 7 | (* 8 | ** ATS/Postiats - Unleashing the Potential of Types! 9 | ** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc. 10 | ** All rights reserved 11 | ** 12 | ** ATS is free software; you can redistribute it and/or modify it under 13 | ** the terms of the GNU GENERAL PUBLIC LICENSE (GPL) as published by the 14 | ** Free Software Foundation; either version 3, or (at your option) any 15 | ** later version. 16 | ** 17 | ** ATS is distributed in the hope that it will be useful, but WITHOUT ANY 18 | ** WARRANTY; without even the implied warranty of MERCHANTABILITY or 19 | ** FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 20 | ** for more details. 21 | ** 22 | ** You should have received a copy of the GNU General Public License 23 | ** along with ATS; see the file COPYING. If not, please write to the 24 | ** Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 25 | ** 02110-1301, USA. 26 | *) 27 | 28 | (* ****** ****** *) 29 | 30 | (* 31 | ** Source: 32 | ** $PATSHOME/prelude/DATS/CODEGEN/bool.atxt 33 | ** Time of generation: Thu Jan 11 11:00:12 2018 34 | *) 35 | 36 | (* ****** ****** *) 37 | 38 | (* Author: Hongwei Xi *) 39 | (* Authoremail: hwxi AT cs DOT bu DOT edu *) 40 | (* Start time: Feburary, 2012 *) 41 | 42 | (* ****** ****** *) 43 | 44 | #define ATS_DYNLOADFLAG 0 // no dynloading at run-time 45 | 46 | (* ****** ****** *) 47 | 48 | (* 49 | // 50 | // HX: see CATS/bool.cats 51 | // 52 | implement 53 | bool2string 54 | (b) = if b then "true" else "false" 55 | // end of [bool2string] 56 | *) 57 | 58 | (* ****** ****** *) 59 | 60 | (* 61 | // 62 | // HX: see CATS/bool.cats 63 | // 64 | implement 65 | fprint_bool (out, x) = 66 | fprint_string (out, bool2string (x)) 67 | // end of [fprint_bool] 68 | *) 69 | 70 | implement fprint_val = fprint_bool 71 | 72 | (* ****** ****** *) 73 | 74 | (* end of [bool.dats] *) 75 | -------------------------------------------------------------------------------- /language-ats/test/data/stdlib/DATS/bool.out: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Applied Type System *) 4 | (* *) 5 | (***********************************************************************) 6 | (* 7 | ** ATS/Postiats - Unleashing the Potential of Types! 8 | ** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc. 9 | ** All rights reserved 10 | ** 11 | ** ATS is free software; you can redistribute it and/or modify it under 12 | ** the terms of the GNU GENERAL PUBLIC LICENSE (GPL) as published by the 13 | ** Free Software Foundation; either version 3, or (at your option) any 14 | ** later version. 15 | ** 16 | ** ATS is distributed in the hope that it will be useful, but WITHOUT ANY 17 | ** WARRANTY; without even the implied warranty of MERCHANTABILITY or 18 | ** FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 19 | ** for more details. 20 | ** 21 | ** You should have received a copy of the GNU General Public License 22 | ** along with ATS; see the file COPYING. If not, please write to the 23 | ** Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 24 | ** 02110-1301, USA. 25 | *) 26 | (* ****** ****** *) 27 | (* 28 | ** Source: 29 | ** $PATSHOME/prelude/DATS/CODEGEN/bool.atxt 30 | ** Time of generation: Thu Jan 11 11:00:12 2018 31 | *) 32 | (* ****** ****** *) 33 | (* Author: Hongwei Xi *) 34 | (* Authoremail: hwxi AT cs DOT bu DOT edu *) 35 | (* Start time: Feburary, 2012 *) 36 | (* ****** ****** *) 37 | #define ATS_DYNLOADFLAG 0 // no dynloading at run-time 38 | 39 | (* ****** ****** *) 40 | (* 41 | // 42 | // HX: see CATS/bool.cats 43 | // 44 | implement 45 | bool2string 46 | (b) = if b then "true" else "false" 47 | // end of [bool2string] 48 | *) 49 | (* ****** ****** *) 50 | (* 51 | // 52 | // HX: see CATS/bool.cats 53 | // 54 | implement 55 | fprint_bool (out, x) = 56 | fprint_string (out, bool2string (x)) 57 | // end of [fprint_bool] 58 | *) 59 | implement fprint_val = 60 | fprint_bool 61 | 62 | (* ****** ****** *) 63 | (* end of [bool.dats] *) 64 | -------------------------------------------------------------------------------- /language-ats/test/data/stdlib/bool.out: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Applied Type System *) 4 | (* *) 5 | (***********************************************************************) 6 | (* 7 | ** ATS/Postiats - Unleashing the Potential of Types! 8 | ** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc. 9 | ** All rights reserved 10 | ** 11 | ** ATS is free software; you can redistribute it and/or modify it under 12 | ** the terms of the GNU GENERAL PUBLIC LICENSE (GPL) as published by the 13 | ** Free Software Foundation; either version 3, or (at your option) any 14 | ** later version. 15 | ** 16 | ** ATS is distributed in the hope that it will be useful, but WITHOUT ANY 17 | ** WARRANTY; without even the implied warranty of MERCHANTABILITY or 18 | ** FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 19 | ** for more details. 20 | ** 21 | ** You should have received a copy of the GNU General Public License 22 | ** along with ATS; see the file COPYING. If not, please write to the 23 | ** Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 24 | ** 02110-1301, USA. 25 | *) 26 | (* ****** ****** *) 27 | (* 28 | ** Source: 29 | ** $PATSHOME/prelude/DATS/CODEGEN/bool.atxt 30 | ** Time of generation: Thu Jan 11 11:00:12 2018 31 | *) 32 | (* ****** ****** *) 33 | (* Author: Hongwei Xi *) 34 | (* Authoremail: hwxi AT cs DOT bu DOT edu *) 35 | (* Start time: Feburary, 2012 *) 36 | (* ****** ****** *) 37 | #define ATS_DYNLOADFLAG 0 // no dynloading at run-time 38 | 39 | (* ****** ****** *) 40 | (* 41 | // 42 | // HX: see CATS/bool.cats 43 | // 44 | implement 45 | bool2string 46 | (b) = if b then "true" else "false" 47 | // end of [bool2string] 48 | *) 49 | (* ****** ****** *) 50 | (* 51 | // 52 | // HX: see CATS/bool.cats 53 | // 54 | implement 55 | fprint_bool (out, x) = 56 | fprint_string (out, bool2string (x)) 57 | // end of [fprint_bool] 58 | *) 59 | implement fprint_val = 60 | fprint_bool 61 | 62 | (* ****** ****** *) 63 | (* end of [bool.dats] *) 64 | -------------------------------------------------------------------------------- /language-ats/test/data/stdlib/intrange.sats: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Applied Type System *) 4 | (* *) 5 | (***********************************************************************) 6 | 7 | (* 8 | ** ATS/Postiats - Unleashing the Potential of Types! 9 | ** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc. 10 | ** All rights reserved 11 | ** 12 | ** ATS is free software; you can redistribute it and/or modify it under 13 | ** the terms of the GNU GENERAL PUBLIC LICENSE (GPL) as published by the 14 | ** Free Software Foundation; either version 3, or (at your option) any 15 | ** later version. 16 | ** 17 | ** ATS is distributed in the hope that it will be useful, but WITHOUT ANY 18 | ** WARRANTY; without even the implied warranty of MERCHANTABILITY or 19 | ** FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 20 | ** for more details. 21 | ** 22 | ** You should have received a copy of the GNU General Public License 23 | ** along with ATS; see the file COPYING. If not, please write to the 24 | ** Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 25 | ** 02110-1301, USA. 26 | *) 27 | (* ****** ****** *) 28 | 29 | (* Author: Hongwei Xi *) 30 | (* Authoremail: hwxi AT cs DOT bu DOT edu *) 31 | (* Start time: June, 2012 *) 32 | 33 | (* ****** ****** *) 34 | 35 | (* 36 | ** Source: 37 | ** $PATSHOME/prelude/SATS/CODEGEN/intrange.atxt 38 | ** Time of generation: Thu Jan 11 11:00:06 2018 39 | *) 40 | 41 | (* ****** ****** *) 42 | // 43 | // HX-2013-04: 44 | // intrange (l, r) is for integers i satisfying l <= i < r 45 | // 46 | (* ****** ****** *) 47 | // 48 | fun{} 49 | intrange_forall 50 | (l: int, r: int): bool 51 | fun{} 52 | intrange_forall$pred(i: int):<> bool 53 | // 54 | (* ****** ****** *) 55 | // 56 | fun{} 57 | intrange_foreach 58 | (l: int, r: int): (int) 59 | fun{env:vt0p} 60 | intrange_foreach_env 61 | (l: int, r: int, env: &(env) >> _): int 62 | // 63 | fun{env:vt0p} 64 | intrange_foreach$cont(i: int, env: &env): bool 65 | fun{env:vt0p} 66 | intrange_foreach$fwork(i: int, env: &(env) >> _): void 67 | // 68 | (* ****** ****** *) 69 | // 70 | fun{} 71 | intrange_rforeach 72 | (l: int, r: int): (int) 73 | fun{env:vt0p} 74 | intrange_rforeach_env 75 | (l: int, r: int, env: &(env) >> _): int 76 | // 77 | fun{env:vt0p} 78 | intrange_rforeach$cont(i: int, env: &env): bool 79 | fun{env:vt0p} 80 | intrange_rforeach$fwork(i: int, env: &(env) >> _): void 81 | // 82 | (* ****** ****** *) 83 | // 84 | fun{} 85 | intrange2_foreach 86 | (l1: int, r1: int, l2: int, r2: int): void 87 | // 88 | fun{env:vt0p} 89 | intrange2_foreach_env 90 | (l1: int, r1: int, l2: int, r2: int, env: &(env) >> _): void 91 | // 92 | fun{env:vt0p} 93 | intrange2_foreach$fwork (i: int, j: int, env: &env >> _): void 94 | // 95 | (* ****** ****** *) 96 | // 97 | fun{} 98 | streamize_intrange_l(m: int): stream_vt(int) 99 | fun{} 100 | streamize_intrange_0r(n: int): stream_vt(int) 101 | fun{} 102 | streamize_intrange_lr(m: int, n: int): stream_vt(int) 103 | // 104 | (* ****** ****** *) 105 | 106 | (* end of [intrange.sats] *) 107 | -------------------------------------------------------------------------------- /language-ats/test/data/stdlib/option_vt.out: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Applied Type System *) 4 | (* *) 5 | (***********************************************************************) 6 | (* 7 | ** ATS/Postiats - Unleashing the Potential of Types! 8 | ** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc. 9 | ** All rights reserved 10 | ** 11 | ** ATS is free software; you can redistribute it and/or modify it under 12 | ** the terms of the GNU GENERAL PUBLIC LICENSE (GPL) as published by the 13 | ** Free Software Foundation; either version 3, or (at your option) any 14 | ** later version. 15 | ** 16 | ** ATS is distributed in the hope that it will be useful, but WITHOUT ANY 17 | ** WARRANTY; without even the implied warranty of MERCHANTABILITY or 18 | ** FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 19 | ** for more details. 20 | ** 21 | ** You should have received a copy of the GNU General Public License 22 | ** along with ATS; see the file COPYING. If not, please write to the 23 | ** Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 24 | ** 02110-1301, USA. 25 | *) 26 | (* ****** ****** *) 27 | (* 28 | ** Source: 29 | ** $PATSHOME/prelude/SATS/CODEGEN/option_vt.atxt 30 | ** Time of generation: Thu Jan 11 11:00:08 2018 31 | *) 32 | (* ****** ****** *) 33 | (* Author: Hongwei Xi *) 34 | (* Authoremail: hwxi AT cs DOT bu DOT edu *) 35 | (* Start time: February, 2012 *) 36 | (* ****** ****** *) 37 | sortdef vt0p = vt@ype 38 | 39 | (* ****** ****** *) 40 | 41 | #if(0) 42 | // 43 | // HX: these decls are available in [basic_dyn.sats] 44 | // 45 | stadef option_vt = option_vt0ype_bool_vtype 46 | vtypedef Option_vt (a:vt0p) = [b:bool] option_vt (a, b) 47 | // 48 | #endif 49 | (* ****** ****** *) 50 | fun {a:vt0p} option_vt_some (x : a) : option_vt(a, true) 51 | 52 | fun {a:vt0p} option_vt_none () : option_vt(a, false) 53 | 54 | (* ****** ****** *) 55 | fun {a:vt0p} option_vt_make_opt {b:bool} ( b : bool(b) 56 | , x : &opt(INV(a), b) >> a? 57 | ) : option_vt(a, b) 58 | 59 | // end-of-fun 60 | (* ****** ****** *) 61 | fun option_vt_is_some {a:vt0p}{b:bool} (opt : !option_vt(INV(a), b)) :<> 62 | bool(b) 63 | 64 | // end of [option_vt_is_some] 65 | fun option_vt_is_none {a:vt0p}{b:bool} (opt : !option_vt(INV(a), b)) :<> 66 | bool(~b) 67 | 68 | // end of [option_vt_is_none] 69 | (* ****** ****** *) 70 | // 71 | fun {a:vt0p} option_vt_unsome (opt : option_vt(INV(a), true)) : 72 | (a) 73 | 74 | fun {a:vt0p} option_vt_unnone (opt : option_vt(INV(a), false)) : 75 | void 76 | 77 | // 78 | (* ****** ****** *) 79 | // 80 | fun {a:t0p} option_vt_free (opt : Option_vt(INV(a))) : void 81 | 82 | fun {a:t0p} option2bool_vt {b:bool} (opt : option_vt(INV(a), b)) : 83 | bool(b) 84 | 85 | // 86 | (* ****** ****** *) 87 | // 88 | fun {a:vt0p} fprint_option_vt {b:bool} ( out : FILEref 89 | , opt : !option_vt(INV(a), b) 90 | ) : void 91 | 92 | // 93 | overload fprint with fprint_option_vt 94 | 95 | // 96 | (* ****** ****** *) 97 | // 98 | // overloading for certain symbols 99 | // 100 | (* ****** ****** *) 101 | overload iseqz with option_vt_is_none 102 | overload isneqz with option_vt_is_some 103 | 104 | (* ****** ****** *) 105 | (* end of [option_vt.sats] *) 106 | -------------------------------------------------------------------------------- /language-ats/test/data/stdlib/option_vt.sats: -------------------------------------------------------------------------------- 1 | (***********************************************************************) 2 | (* *) 3 | (* Applied Type System *) 4 | (* *) 5 | (***********************************************************************) 6 | 7 | (* 8 | ** ATS/Postiats - Unleashing the Potential of Types! 9 | ** Copyright (C) 2010-2015 Hongwei Xi, ATS Trustful Software, Inc. 10 | ** All rights reserved 11 | ** 12 | ** ATS is free software; you can redistribute it and/or modify it under 13 | ** the terms of the GNU GENERAL PUBLIC LICENSE (GPL) as published by the 14 | ** Free Software Foundation; either version 3, or (at your option) any 15 | ** later version. 16 | ** 17 | ** ATS is distributed in the hope that it will be useful, but WITHOUT ANY 18 | ** WARRANTY; without even the implied warranty of MERCHANTABILITY or 19 | ** FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 20 | ** for more details. 21 | ** 22 | ** You should have received a copy of the GNU General Public License 23 | ** along with ATS; see the file COPYING. If not, please write to the 24 | ** Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 25 | ** 02110-1301, USA. 26 | *) 27 | 28 | (* ****** ****** *) 29 | 30 | (* 31 | ** Source: 32 | ** $PATSHOME/prelude/SATS/CODEGEN/option_vt.atxt 33 | ** Time of generation: Thu Jan 11 11:00:08 2018 34 | *) 35 | 36 | (* ****** ****** *) 37 | 38 | (* Author: Hongwei Xi *) 39 | (* Authoremail: hwxi AT cs DOT bu DOT edu *) 40 | (* Start time: February, 2012 *) 41 | 42 | (* ****** ****** *) 43 | 44 | sortdef vt0p = viewt@ype 45 | 46 | (* ****** ****** *) 47 | 48 | #if(0) 49 | // 50 | // HX: these decls are available in [basic_dyn.sats] 51 | // 52 | stadef option_vt = option_vt0ype_bool_vtype 53 | vtypedef Option_vt (a:vt0p) = [b:bool] option_vt (a, b) 54 | // 55 | #endif 56 | 57 | (* ****** ****** *) 58 | 59 | fun{a:vt0p} 60 | option_vt_some (x: a): option_vt (a, true) 61 | fun{a:vt0p} 62 | option_vt_none ((*void*)): option_vt (a, false) 63 | 64 | (* ****** ****** *) 65 | 66 | fun{ 67 | a:vt0p 68 | } option_vt_make_opt 69 | {b:bool} 70 | ( 71 | b: bool(b) 72 | , x: &opt (INV(a), b) >> a? 73 | ) : option_vt(a, b) // end-of-fun 74 | 75 | (* ****** ****** *) 76 | 77 | fun{} 78 | option_vt_is_some 79 | {a:vt0p}{b:bool} 80 | (opt: !option_vt(INV(a), b)):<> bool(b) 81 | // end of [option_vt_is_some] 82 | fun{} 83 | option_vt_is_none 84 | {a:vt0p}{b:bool} 85 | (opt: !option_vt(INV(a), b)):<> bool(~b) 86 | // end of [option_vt_is_none] 87 | 88 | (* ****** ****** *) 89 | // 90 | fun 91 | {a:vt0p} 92 | option_vt_unsome 93 | (opt: option_vt(INV(a), true)): (a) 94 | // 95 | fun 96 | {a:vt0p} 97 | option_vt_unnone 98 | (opt: option_vt(INV(a), false)): void 99 | // 100 | (* ****** ****** *) 101 | // 102 | fun{a:t0p} 103 | option_vt_free 104 | (opt: Option_vt(INV(a))): void 105 | fun{a:t0p} 106 | option2bool_vt 107 | {b:bool} 108 | (opt: option_vt(INV(a), b)): bool(b) 109 | // 110 | (* ****** ****** *) 111 | // 112 | fun{a:vt0p} 113 | fprint_option_vt{b:bool} 114 | (out: FILEref, opt: !option_vt(INV(a), b)): void 115 | // 116 | overload fprint with fprint_option_vt 117 | // 118 | (* ****** ****** *) 119 | // 120 | // overloading for certain symbols 121 | // 122 | (* ****** ****** *) 123 | 124 | overload iseqz with option_vt_is_none 125 | overload isneqz with option_vt_is_some 126 | 127 | (* ****** ****** *) 128 | 129 | (* end of [option_vt.sats] *) 130 | -------------------------------------------------------------------------------- /language-ats/test/data/str.dats: -------------------------------------------------------------------------------- 1 | abst@ype strlen(n: int) 2 | viewdef string_v(n:int, l:addr) = strlen(n) @ l 3 | vtypedef string_vt(n: int, l:addr) = (string_v(n, l) | ptr(l)) 4 | 5 | vtypedef String_vt = [n:nat][l:addr | l > null] string_vt(n, l) 6 | -------------------------------------------------------------------------------- /language-ats/test/data/str.out: -------------------------------------------------------------------------------- 1 | abst@ype strlen(n: int) 2 | 3 | viewdef string_v(n: int, l: addr) = strlen(n) @ l 4 | vtypedef string_vt(n: int, l: addr) = (string_v(n, l) | ptr(l)) 5 | vtypedef String_vt = [n:nat][ l : addr | l > null ] string_vt(n, l) 6 | -------------------------------------------------------------------------------- /language-ats/test/data/types.out: -------------------------------------------------------------------------------- 1 | datavtype null = 2 | | null 3 | 4 | datavtype token = 5 | | string_tok of string 6 | | int_tok of int 7 | | eq_tok 8 | | pound_tok 9 | | float_tok of float 10 | | bool_tok of bool 11 | 12 | datavtype error_state = 13 | | okay 14 | | error_state of string 15 | 16 | vtypedef cstream = stream_vt(char) 17 | vtypedef tstream = stream_vt(token) 18 | 19 | datavtype either(a: t@ype, b: t@ype+) = 20 | | left of a 21 | | right of b 22 | 23 | vtypedef parser(a: vt@ype+) = 24 | @{ modify = cstream - (cstream, a) } 25 | -------------------------------------------------------------------------------- /language-ats/test/data/types.sats: -------------------------------------------------------------------------------- 1 | datavtype null = 2 | | null 3 | 4 | datavtype token = 5 | | string_tok of string 6 | | int_tok of int 7 | | eq_tok 8 | | pound_tok 9 | | float_tok of float 10 | | bool_tok of bool 11 | 12 | datavtype error_state = 13 | | okay 14 | | error_state of string 15 | 16 | vtypedef cstream = stream_vt(char) 17 | vtypedef tstream = stream_vt(token) 18 | 19 | datavtype either(a : t@ype, b : t@ype+) = 20 | | left of a 21 | | right of b 22 | 23 | vtypedef parser(a : vt@ype+) = @{ modify = cstream - (cstream, a) } 24 | -------------------------------------------------------------------------------- /shake-ats/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # shake-ats 2 | 3 | * Use `traced` when writing files 4 | 5 | ## 1.10.4.1 6 | 7 | * Only track C dependencies that exist 8 | 9 | ## 1.10.4.0 10 | 11 | * Track C dependencies as well. 12 | 13 | ## 1.10.3.0 14 | 15 | * Don't copy files to `$PATSHOME` 16 | 17 | ## 1.10.2.3 18 | 19 | * `cleanATS` is now more precise 20 | 21 | ## 1.10.2.2 22 | 23 | * `genLinks` calls `traced` for better profiling 24 | 25 | ## 1.10.2.1 26 | 27 | * Use oracle to track `HsCompiler` in rules 28 | 29 | ## 1.10.2.0 30 | 31 | * `genATS` takes `cpphs` parameter again 32 | 33 | ## 1.10.1.0 34 | 35 | * `genATS` no longer takes `cpphs` parameter 36 | 37 | ## 1.10.0.0 38 | 39 | * Make `cabalForeign` take a `HsCompiler` instead of a `CCompiler`. 40 | 41 | ## 1.9.0.5 42 | 43 | * Bugfix for recent version of `shake-cabal` 44 | 45 | ## 1.9.0.4 46 | 47 | * Remove timestamp from generated `.c` files. 48 | 49 | ## 1.9.0.3 50 | 51 | * Use `getAppUserDirectory` for better portability 52 | -------------------------------------------------------------------------------- /shake-ats/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 | -------------------------------------------------------------------------------- /shake-ats/README.md: -------------------------------------------------------------------------------- 1 | # shake-ats 2 | 3 | ## Installation 4 | 5 | ## Configuration 6 | -------------------------------------------------------------------------------- /shake-ats/shake-ats.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.18 2 | name: shake-ats 3 | version: 1.10.4.2 4 | license: BSD3 5 | license-file: LICENSE 6 | copyright: Copyright: (c) 2018-2020 Vanessa McHale 7 | maintainer: vamchale@gmail.com 8 | author: Vanessa McHale 9 | tested-with: ghc ==8.4.4 ghc ==8.6.5 ghc ==8.8.4 ghc ==8.10.1 10 | synopsis: Utilities for building ATS projects with shake 11 | description: 12 | Various helper functions for building [ATS](http://www.ats-lang.org/) with the [shake](http://shakebuild.com/) library 13 | 14 | category: Development, Build, ATS, Shake 15 | build-type: Simple 16 | extra-doc-files: 17 | README.md 18 | CHANGELOG.md 19 | 20 | source-repository head 21 | type: git 22 | location: git@github.com:vmchale/atspkg.git 23 | subdir: shake-ats 24 | 25 | flag development 26 | description: Enable `-Werror` 27 | default: False 28 | manual: True 29 | 30 | library 31 | exposed-modules: Development.Shake.ATS 32 | hs-source-dirs: src 33 | other-modules: 34 | Development.Shake.ATS.Type 35 | Development.Shake.ATS.Rules 36 | Development.Shake.ATS.Environment 37 | Development.Shake.ATS.Generate 38 | 39 | default-language: Haskell2010 40 | other-extensions: RecordWildCards DeriveGeneric DeriveAnyClass 41 | ghc-options: -Wall 42 | build-depends: 43 | base >=4.9 && <5, 44 | language-ats >=1.7.7.0, 45 | shake-ext >=3.0.0.0, 46 | hs2ats >=0.5.0.0, 47 | directory -any, 48 | microlens -any, 49 | text -any, 50 | dependency -any, 51 | shake >=0.14, 52 | binary -any, 53 | shake-cabal -any, 54 | shake-c >=0.4.0.0, 55 | cdeps >=0.1.3.0 56 | 57 | if flag(development) 58 | ghc-options: -Werror 59 | 60 | if impl(ghc >=8.0) 61 | ghc-options: -Wincomplete-uni-patterns -Wincomplete-record-updates 62 | -------------------------------------------------------------------------------- /shake-ats/src/Development/Shake/ATS/Environment.hs: -------------------------------------------------------------------------------- 1 | module Development.Shake.ATS.Environment ( fixDir 2 | , pkgHome 3 | , ccToDir 4 | ) where 5 | 6 | import Control.Monad.IO.Class 7 | import qualified Data.Text.Lazy as TL 8 | import Development.Shake.C 9 | import Development.Shake.FilePath 10 | import System.Directory 11 | 12 | -- | Given a C compiler, return the appropriate directory for its globally 13 | -- installed artifacts. This is used to keep libraries built for different 14 | -- platforms separate. 15 | ccToDir :: CCompiler -> String 16 | ccToDir (GCC (Just s) _) = reverse (drop 1 $ reverse s) ++ [pathSeparator] 17 | ccToDir _ = "" 18 | 19 | -- | The directory @~/.atspkg@ 20 | pkgHome :: MonadIO m => CCompiler -> m String 21 | pkgHome cc' = liftIO $ getAppUserDataDirectory ("atspkg" ccToDir cc') 22 | 23 | fixDir :: FilePath -> String -> String 24 | fixDir p = 25 | TL.unpack 26 | . TL.replace (TL.pack "./") (TL.pack $ p ++ "/") 27 | . TL.replace (TL.pack "../") (TL.pack $ joinPath (init $ splitPath p) ++ "/") 28 | . TL.replace (TL.pack "$PATSHOMELOCS") (TL.pack ".atspkg/contrib") 29 | . TL.pack 30 | -------------------------------------------------------------------------------- /shake-ats/src/Development/Shake/ATS/Generate.hs: -------------------------------------------------------------------------------- 1 | module Development.Shake.ATS.Generate ( generateLinks 2 | ) where 3 | 4 | import Language.ATS 5 | import Lens.Micro 6 | 7 | generateLinks :: String -> Either ATSError String 8 | generateLinks = fmap (printATS . generateLinks') . parseM 9 | 10 | generateLinks' :: ATS a -> ATS a 11 | generateLinks' (ATS ds) = ATS (fmap g ds ++ [macDecl]) 12 | where g f@Func{} = Extern undefined (set (fun.preF.expression) expr f) 13 | g x = x 14 | expr = Just (StringLit "\"mac#\"") 15 | macDecl = Define "#define ATS_MAINATSFLAG 1" 16 | -------------------------------------------------------------------------------- /shake-c/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # shake-c 2 | 3 | ## 0.4.5.0 4 | 5 | * Add `suff` to `Clang` constructor 6 | 7 | ## 0.4.4.0 8 | 9 | * Add `Pgi` constructor 10 | 11 | ## 0.4.3.0 12 | 13 | * Add `preprocessA` and `preprocessR` 14 | * Add `TCC` constructor for `CCompiler` data type 15 | 16 | ## 0.4.2.0 17 | 18 | * Do not use oracles; they cause problems 19 | 20 | ## 0.4.1.0 21 | 22 | * Add `idOracle` 23 | * Exported rules now use oracles 24 | -------------------------------------------------------------------------------- /shake-c/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 | -------------------------------------------------------------------------------- /shake-c/README.md: -------------------------------------------------------------------------------- 1 | # shake-c 2 | 3 | Library for building C libraries and binaries using 4 | [shake](http://hackage.haskell.org/package/shake). 5 | -------------------------------------------------------------------------------- /shake-c/shake-c.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.18 2 | name: shake-c 3 | version: 0.4.5.0 4 | license: BSD3 5 | license-file: LICENSE 6 | copyright: Copyright: (c) 2018-2020 Vanessa McHale 7 | maintainer: vamchale@gmail.com 8 | author: Vanessa McHale 9 | bug-reports: https://hub.darcs.net/vmchale/ats/issues 10 | synopsis: Library for building C code with shake 11 | description: 12 | Facilities for building C libraries and binaries, and depending on C source files. Extends [shake](http://hackage.haskell.org/package/shake). 13 | 14 | category: Development, C 15 | build-type: Simple 16 | extra-doc-files: 17 | README.md 18 | CHANGELOG.md 19 | 20 | source-repository head 21 | type: darcs 22 | location: https://hub.darcs.net/vmchale/ats 23 | 24 | flag development 25 | description: Enable `-Werror` 26 | default: False 27 | manual: True 28 | 29 | library 30 | exposed-modules: Development.Shake.C 31 | hs-source-dirs: src 32 | default-language: Haskell2010 33 | other-extensions: 34 | DeriveAnyClass DeriveGeneric DeriveDataTypeable TypeFamilies 35 | 36 | ghc-options: -Wall 37 | build-depends: 38 | base >=4.3 && <5, 39 | shake >=0.14, 40 | cdeps -any, 41 | composition-prelude -any 42 | 43 | if flag(development) 44 | ghc-options: -Werror 45 | 46 | if impl(ghc >=8.0) 47 | ghc-options: 48 | -Wincomplete-uni-patterns -Wincomplete-record-updates 49 | -Wredundant-constraints -Wnoncanonical-monad-instances 50 | 51 | if impl(ghc >=8.4) 52 | ghc-options: -Wmissing-export-lists 53 | -------------------------------------------------------------------------------- /shake-cabal/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # shake-cabal 2 | 3 | ## 0.2.2.2 4 | 5 | * Cabal version `>3.6` 6 | 7 | ## 0.2.2.1 8 | 9 | * Support `shake` 0.18.4 10 | 11 | ## 0.2.2.0 12 | 13 | * Export `CabalVersion` so `cabalOracle` is usable 14 | 15 | ## 0.2.1.0 16 | 17 | * Add `hsOracle` and `cabalOracle` 18 | 19 | ## 0.2.0.0 20 | 21 | * More precise `HsCompiler` type 22 | 23 | ## 0.1.0.5 24 | 25 | * Slightly better behavior for `getCabalDepsA` and `getCabalDepsV` 26 | -------------------------------------------------------------------------------- /shake-cabal/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Vanessa McHale (c) 2018-2019 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 | -------------------------------------------------------------------------------- /shake-cabal/README.md: -------------------------------------------------------------------------------- 1 | # shake-cabal 2 | 3 | [![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/shake-cabal/badge)](https://matrix.hackage.haskell.org/package/shake-cabal) 4 | 5 | A library for using [shake](http://hackage.haskell.org/package/shake) with 6 | [cabal](https://www.haskell.org/cabal/download.html). 7 | -------------------------------------------------------------------------------- /shake-cabal/shake-cabal.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.18 2 | name: shake-cabal 3 | version: 0.2.2.2 4 | license: BSD3 5 | license-file: LICENSE 6 | copyright: Copyright: (c) 2018-2019, 2021 Vanessa McHale 7 | maintainer: vamchale@gmail.com 8 | author: Vanessa McHale 9 | bug-reports: https://github.com/vmchale/atspkg/issues 10 | synopsis: Shake library for use with cabal 11 | description: 12 | A library for using [shake](http://hackage.haskell.org/package/shake) alongside [cabal](https://www.haskell.org/cabal/). 13 | 14 | category: Development 15 | build-type: Simple 16 | extra-doc-files: 17 | README.md 18 | CHANGELOG.md 19 | 20 | source-repository head 21 | type: git 22 | location: git@github.com:vmchale/atspkg.git 23 | subdir: shake-cabal 24 | 25 | flag development 26 | description: Enable `-Werror` 27 | default: False 28 | manual: True 29 | 30 | library 31 | exposed-modules: Development.Shake.Cabal 32 | hs-source-dirs: src 33 | other-modules: Development.Shake.Cabal.Oracles 34 | default-language: Haskell2010 35 | other-extensions: 36 | DeriveAnyClass DeriveGeneric DeriveDataTypeable TypeFamilies 37 | 38 | ghc-options: -Wall 39 | build-depends: 40 | base >=4.8 && <5, 41 | shake >=0.18.4, 42 | Cabal >=3.6, 43 | directory -any, 44 | composition-prelude -any, 45 | filepath -any, 46 | deepseq -any, 47 | hashable -any, 48 | binary -any 49 | 50 | if flag(development) 51 | ghc-options: -Werror 52 | 53 | if impl(ghc >=8.0) 54 | ghc-options: 55 | -Wincomplete-uni-patterns -Wincomplete-record-updates 56 | -Wredundant-constraints -Wnoncanonical-monad-instances 57 | 58 | if impl(ghc >=8.4) 59 | ghc-options: -Wmissing-export-lists 60 | -------------------------------------------------------------------------------- /shake-cabal/src/Development/Shake/Cabal/Oracles.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveDataTypeable #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE TypeFamilies #-} 5 | 6 | -- this is in a separate module because the TypeFamilies extension apparently 7 | -- causes previously valid code to not typecheck... ok 8 | module Development.Shake.Cabal.Oracles ( hsOracle 9 | , cabalOracle 10 | , CabalOracle 11 | , HsCompiler (..) 12 | , CabalVersion (..) 13 | ) where 14 | 15 | import Control.DeepSeq (NFData) 16 | import Data.Binary (Binary) 17 | import Data.Hashable (Hashable) 18 | import Data.Typeable (Typeable) 19 | import Development.Shake 20 | import GHC.Generics (Generic) 21 | 22 | type CabalOracle = CabalVersion -> Action String 23 | 24 | -- | Use this for tracking 'HsCompiler' 25 | -- 26 | -- @since 0.2.1.0 27 | hsOracle :: (RuleResult q ~ a, q ~ a, ShakeValue q) => Rules (q -> Action a) 28 | hsOracle = addOracle pure 29 | 30 | -- | Use this to track the version of cabal globally available 31 | -- 32 | -- @since 0.2.1.0 33 | cabalOracle :: Rules CabalOracle 34 | cabalOracle = addOracle $ \CabalVersion -> do 35 | (Stdout out) <- command [] "cabal" [ "--numeric-version"] 36 | pure out 37 | 38 | data HsCompiler = GHC { _pref :: Maybe String -- ^ Target architecture 39 | , _suff :: Maybe String -- ^ Compiler version 40 | } 41 | | GHCJS { _suff :: Maybe String -- ^ Compiler version 42 | } 43 | deriving (Generic, Show, Eq, NFData, Hashable, Binary, Typeable) 44 | 45 | data CabalVersion = CabalVersion 46 | deriving (Generic, Show, Typeable, Eq, Hashable, Binary, NFData) 47 | 48 | type instance RuleResult HsCompiler = HsCompiler 49 | type instance RuleResult CabalVersion = String 50 | --------------------------------------------------------------------------------