[ { "path": ".github/workflows/main.yml", "content": "# This is the smlpkg main workflow for building and testing smlpkg\n# on various architectures. The workflow contains two jobs called\n# \"build-test-ubuntu\" and \"build-test-macos\". It is triggered on\n# push or pull request events but only for the master branch.\n\nname: CI\n\non:\n\n push:\n branches: [ master ]\n\n pull_request:\n branches: [ master ]\n\n # Allows you to run this workflow manually from the Actions tab\n workflow_dispatch:\n\njobs:\n\n build-test-linux:\n\n runs-on: ubuntu-latest\n\n steps:\n\n - uses: actions/checkout@v3\n\n - name: Install dependencies\n run: |\n sudo apt-get -qq update\n sudo apt-get install -y make\n\n - uses: diku-dk/install-mlkit@v1\n with:\n version: 'latest'\n\n - name: Build\n run: |\n MLCOMP=mlkit make clean all bin_dist\n\n - name: Run tests\n run: |\n MLCOMP=mlkit make test\n\n\n build-test-macos:\n\n runs-on: macos-latest\n\n steps:\n\n - uses: actions/checkout@v3\n\n - name: Install dependencies\n run: |\n brew install make\n brew install mlton\n\n - name: Build\n run: |\n MLCOMP=mlton make clean all bin_dist\n\n - name: Run tests\n run: |\n MLCOMP=mlton make test\n" }, { "path": ".github/workflows/release.yml", "content": "name: Release\n\non:\n push:\n tags:\n - 'v*' # Push events to matching v*, i.e. v1.0, v20.15.10\n\njobs:\n build-test-release-linux:\n name: Build, test, and upload release binaries (linux)\n if: github.event.base_ref == 'refs/heads/master'\n runs-on: ubuntu-24.04\n\n steps:\n - uses: actions/checkout@v2\n\n - name: Install dependencies\n run: |\n sudo apt-get -qq update\n sudo apt-get install -y mlton make\n\n - name: Build\n run: |\n MLCOMP=mlton make clean all bin_dist\n\n - name: Run tests\n run: |\n MLCOMP=mlton make test\n\n - name: Upload binaries to release\n uses: svenstaro/upload-release-action@v2\n with:\n repo_token: ${{ secrets.GITHUB_TOKEN }}\n file: smlpkg-bin-dist-linux.tgz\n tag: ${{ github.ref }}\n overwrite: true\n\n build-test-release-macos:\n name: Build, test, and upload release binaries (macos)\n if: github.event.base_ref == 'refs/heads/master'\n runs-on: macos-latest\n\n steps:\n - uses: actions/checkout@v2\n\n - name: Install dependencies\n run: |\n brew install make\n brew install mlton\n\n - name: Build\n run: |\n MLCOMP=mlton make clean all bin_dist\n\n - name: Run tests\n run: |\n MLCOMP=mlton make test\n\n - name: Upload binaries to release\n uses: svenstaro/upload-release-action@v2\n with:\n repo_token: ${{ secrets.GITHUB_TOKEN }}\n file: smlpkg-bin-dist-darwin.tgz\n tag: ${{ github.ref }}\n overwrite: true" }, { "path": ".gitignore", "content": "bin" }, { "path": "LICENSE", "content": "MIT License\n\nCopyright (c) 2020 Martin Elsman\n\nPermission is hereby granted, free of charge, to any person obtaining a copy\nof this software and associated documentation files (the \"Software\"), to deal\nin the Software without restriction, including without limitation the rights\nto use, copy, modify, merge, publish, distribute, sublicense, and/or sell\ncopies of the Software, and to permit persons to whom the Software is\nfurnished to do so, subject to the following conditions:\n\nThe above copyright notice and this permission notice shall be included in all\ncopies or substantial portions of the Software.\n\nTHE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR\nIMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,\nFITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE\nAUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER\nLIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,\nOUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE\nSOFTWARE.\n" }, { "path": "Makefile", "content": "prefix ?= .\nINSTALLDIR ?= $(prefix)/bin\nINSTALL ?= install\nOS=$(shell uname -s | tr '[:upper:]' '[:lower:]')\n\n.PHONY: all\nall: src/smlpkg\n\n.PHONY:\ninstall: src/smlpkg\n\tmkdir -p $(INSTALLDIR)\n\t$(INSTALL) $< $(INSTALLDIR)/\n\n.PHONY: test\ntest:\n\t$(MAKE) -C src test\n\t$(MAKE) -C src/test test\n\t$(MAKE) -C pkgtests test\n\n.PHONY: clean\nclean:\n\t$(MAKE) -C src clean\n\trm -rf *~ .*~ bin smlpkg-bin-*\n\nsrc/smlpkg:\n\t$(MAKE) -C src all\n\n# -----------------------------------------------------\n# Target for building binary distribution for smlpkg\n# -----------------------------------------------------\n\nBIN_DIST_DIR=smlpkg-bin-dist-$(OS)\n.PHONY: bin_dist\nbin_dist: src/smlpkg\n\trm -rf smlpkg-bin-dist-*\n\tmkdir $(BIN_DIST_DIR)\n\t$(MAKE) install INSTALLDIR=$(BIN_DIST_DIR)/bin/\n\t$(INSTALL) LICENSE $(BIN_DIST_DIR)/\n\techo 'Binary package for smlpkg.' > $(BIN_DIST_DIR)/README\n\techo 'The sources are available at http://github.com/diku-dk/smlpkg' >> $(BIN_DIST_DIR)/README\n\techo 'PREFIX?=/usr/local' > $(BIN_DIST_DIR)/Makefile\n\techo 'INSTALL?=install' >> $(BIN_DIST_DIR)/Makefile\n\techo '.PHONY: install' >> $(BIN_DIST_DIR)/Makefile\n\techo 'install:' >> $(BIN_DIST_DIR)/Makefile\n\techo \"\\t\"'$$(INSTALL) bin/smlpkg $$(PREFIX)/bin/' >> $(BIN_DIST_DIR)/Makefile\n\ttar czvf $(BIN_DIST_DIR).tgz $(BIN_DIST_DIR)\n" }, { "path": "README.md", "content": "# smlpkg [![CI](https://github.com/diku-dk/smlpkg/workflows/CI/badge.svg)](https://github.com/diku-dk/smlpkg/actions)\n\nThis program constitutes a generic package manager for Standard ML\nlibraries and programs. The package manager assumes nothing and knows\nnothing about the Standard ML compilers used and is thus quite\ngeneric.\n\nThe package manager is centered around the notion of [semantic versioning](https://semver.org/) and supports packages that, for instance, are\nhosted on [GitHub](https://github.com/) and\n[GitLab](https://about.gitlab.com/).\n\nThe package manager takes care of downloading and upgrading dependent\npackages and works well with the use of MLB files supported by\nStandard ML compilers such as [MLton](http://mlton.org/),\n[MLKit](http://elsman.com/mlkit/), and\n[SMLtoJs](http://www.smlserver.org/smltojs/).\n\n# Usage\n\n## Adding a package\n\n```\n$ smlpkg add github.com/diku-dk/sml-random\n```\n\nThis command modifies only `sml.pkg` and creates it if it does not already exist.\n\n## Downloading required packages\n\n```\n$ smlpkg sync\n```\n\nThis command populates the `lib` directory based on the packages listed in `sml.pkg`.\n\n## Creating a new package\n\n```\n$ smlpkg init github.com/foo/bar\n```\n\nThis command creates a file `sml.pkg` and initiates it with the given\npackage name (`foo` should be a github user name or an organisation\nname and `bar` should be a repository name). You can now add code in the\ndirectory `lib/github.com/foo/bar/`.\n\n## Releasing a package\n\n```\n$ git tag vX.Y.Z\n$ git push --tags\n```\n\nRemember to follow [semantic versioning](https://semver.org). Once a\npackage has been released, other packages can safely add the package\nto their own source code tree using `smlpkg add` (see above).\n\nThe lists below constitute some available packages. The lists are divided into\npackages that are generic (should work with any Standard ML compiler that\nsupports basis files) and packages that are supported only for particular\ncompilers (e.g., MLKit, Mlton, and `polymlb`).\n\n## Generic packages\n\n* [![CI](https://github.com/diku-dk/futhark-data-sml/workflows/CI/badge.svg)](https://github.com/diku-dk/futhark-data-sml/actions) [github.com/diku-dk/futhark-data-sml](https://github.com/diku-dk/futhark-data-sml)\n* [![CI](https://github.com/diku-dk/futhark-server-sml/workflows/CI/badge.svg)](https://github.com/diku-dk/futhark-server-sml/actions) [github.com/diku-dk/futhark-server-sml](https://github.com/diku-dk/futhark-server-sml)\n* [![CI](https://github.com/diku-dk/sml-aplparse/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-aplparse/actions)\n [github.com/diku-dk/sml-aplparse](https://github.com/diku-dk/sml-aplparse)\n* [![CI](https://github.com/diku-dk/sml-base64/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-base64/actions)\n [github.com/diku-dk/sml-base64](https://github.com/diku-dk/sml-base64)\n* [![CI](https://github.com/diku-dk/sml-complex/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-complex/actions)\n [github.com/diku-dk/sml-complex](https://github.com/diku-dk/sml-complex)\n* [![CI](https://github.com/diku-dk/sml-cstring/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-cstring/actions)\n [github.com/diku-dk/sml-cstring](https://github.com/diku-dk/sml-cstring)\n* [![CI](https://github.com/diku-dk/sml-hashtable/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-hashtable/actions)\n [github.com/diku-dk/sml-hashtable](https://github.com/diku-dk/sml-hashtable)\n* [![CI](https://github.com/diku-dk/sml-http/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-http/actions)\n [github.com/diku-dk/sml-http](https://github.com/diku-dk/sml-http)\n* [![CI](https://github.com/diku-dk/sml-json/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-json/actions)\n [github.com/diku-dk/sml-json](https://github.com/diku-dk/sml-json)\n* [![CI](https://github.com/diku-dk/sml-matrix/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-matrix/actions)\n [github.com/diku-dk/sml-matrix](https://github.com/diku-dk/sml-matrix)\n* [![CI](https://github.com/diku-dk/sml-md5/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-md5/actions)\n [github.com/diku-dk/sml-md5](https://github.com/diku-dk/sml-md5)\n* [![CI](https://github.com/diku-dk/sml-getopt/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-getopt/actions)\n [github.com/diku-dk/sml-getopt](https://github.com/diku-dk/sml-getopt)\n* [![CI](https://github.com/diku-dk/sml-parse/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-parse/actions)\n [github.com/diku-dk/sml-parse](https://github.com/diku-dk/sml-parse)\n* [![CI](https://github.com/diku-dk/sml-pickle/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-pickle/actions)\n [github.com/diku-dk/sml-pickle](https://github.com/diku-dk/sml-pickle)\n* [![CI](https://github.com/diku-dk/sml-pretty/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-pretty/actions)\n [github.com/diku-dk/sml-pretty](https://github.com/diku-dk/sml-pretty)\n* [![CI](https://github.com/diku-dk/sml-regexp/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-regexp/actions)\n [github.com/diku-dk/sml-regexp](https://github.com/diku-dk/sml-regexp)\n* [![CI](https://github.com/diku-dk/sml-random/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-random/actions)\n [github.com/diku-dk/sml-random](https://github.com/diku-dk/sml-random)\n* [![CI](https://github.com/diku-dk/sml-server/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-server/actions)\n [github.com/diku-dk/sml-server](https://github.com/diku-dk/sml-server)\n* [![CI](https://github.com/diku-dk/sml-setmap/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-setmap/actions)\n [github.com/diku-dk/sml-setmap](https://github.com/diku-dk/sml-setmap)\n* [![CI](https://github.com/diku-dk/sml-sort/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-sort/actions)\n [github.com/diku-dk/sml-sort](https://github.com/diku-dk/sml-sort)\n* [![CI](https://github.com/diku-dk/sml-sha256/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-sha256/actions)\n [github.com/diku-dk/sml-sha256](https://github.com/diku-dk/sml-sha256)\n* [![CI](https://github.com/diku-dk/sml-sobol/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-sobol/actions)\n [github.com/diku-dk/sml-sobol](https://github.com/diku-dk/sml-sobol)\n* [![CI](https://github.com/diku-dk/sml-unicode/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-unicode/actions)\n [github.com/diku-dk/sml-unicode](https://github.com/diku-dk/sml-unicode)\n* [![CI](https://github.com/diku-dk/sml-uref/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-uref/actions)\n [github.com/diku-dk/sml-uref](https://github.com/diku-dk/sml-uref)\n* [github.com/pzel/sml-either](https://github.com/pzel/sml-either)\n* [github.com/shwestrick/sml-audio](https://github.com/shwestrick/sml-audio)\n* [github.com/shwestrick/sml-uri](https://github.com/shwestrick/sml-uri)\n* [github.com/shwestrick/sml-parseq](https://github.com/shwestrick/sml-parseq)\n\n## MLKit packages\n\n* [![CI](https://github.com/melsman/mlkit-postgresql/workflows/CI/badge.svg)](https://github.com/melsman/mlkit-postgresql/actions)\n [github.com/melsman/mlkit-postgresql](https://github.com/melsman/mlkit-postgresql)\n* [![CI](https://github.com/melsman/mlkit-ssl-socket/workflows/CI/badge.svg)](https://github.com/melsman/mlkit-ssl-socket/actions)\n [github.com/melsman/mlkit-ssl-socket](https://github.com/melsman/mlkit-ssl-socket)\n* [![CI](https://github.com/diku-dk/sml-tigr/workflows/CI/badge.svg)](https://github.com/diku-dk/sml-tigr/actions)\n [github.com/diku-dk/sml-tigr](https://github.com/diku-dk/sml-tigr)\n\n## Polymlb packages\n\n* [github.com/pzel/assert-polyml](https://github.com/pzel/assert-polyml)\n* [github.com/pzel/sqlite3-polyml](https://github.com/pzel/sqlite3-polyml)\n\n## Design details\n\nSee this [blog post on the design of the Futhark package\nmanager](https://futhark-lang.org/blog/2018-08-03-the-present-futhark-package-manager.html).\n\n# Compilation\n\nTo compile the package manager, you need a Standard ML compiler such\nas [MLton](http://mlton.org/) or [MLKit](http://elsman.com/mlkit/).\n\n## Compilation using MLKit on macOS\n\n```\n$ brew install mlkit\n$ make all\n```\n\n## Compilation using MLton\n\n```\n$ MLCOMP=mlton make clean all\n```\n\n# License\n\nThis software is distributed under the [MIT LICENSE](LICENSE).\n\nThe package manager is almost a complete port of the Futhark\npackage manager, designed, and implemented in Haskell by Troels\nHenriksen.\n" }, { "path": "default.nix", "content": "{ pkgs ? import {},\n}:\n\npkgs.stdenv.mkDerivation rec {\n name = \"smlpkg\";\n\n src = ./.;\n\n nativeBuildInputs = [ pkgs.mlton ];\n\n checkInputs = [ pkgs.unzip ];\n\n enableParallelBuilding = true;\n\n doCheck = true;\n\n # Set as an environment variable in all the phase scripts.\n MLCOMP = \"mlton\";\n\n buildPhase = ''\n make all\n '';\n\n installPhase = ''\n make install prefix=$out\n '';\n\n # We cannot run the pkgtests, as Nix does not allow network\n # connections.\n checkPhase = ''\n make -C src test\n '';\n\n}\n" }, { "path": "pkgtests/.gitignore", "content": "lib\nfuthark.pkg\n" }, { "path": "pkgtests/Makefile", "content": ".PHONY: test\ntest:\n\t./test.sh\n\n.PHONY: clean\nclean:\n\trm -rf lib futhark.pkg *~\n" }, { "path": "pkgtests/README.md", "content": "# futhark-pkg tests\n\nThis directory contains a shell script (sorry) for testing\nfuthark-pkg. This is done by serially performing package management\noperations, and after each operation comparing the resulting `lib`\ndirectory against an expected `lib` directory.\n\nIt is distressingly awkward to write this using one of the normal\nHaskell test frameworks.\n\nThe tests here are somewhat unstable, in that they depend on certain\nremote Git repositories to have specific contents. If they change,\nyou have to change this test, too.\n" }, { "path": "pkgtests/futhark.pkg.0", "content": "package github.com/sturluson/testpkg\n\nrequire {\n}\n" }, { "path": "pkgtests/futhark.pkg.1", "content": "package github.com/sturluson/testpkg\n\nrequire {\n github.com/athas/fut-foo 0.1.0 #d285563c25c5152b1ae80fc64de64ff2775fa733\n}\n" }, { "path": "pkgtests/futhark.pkg.10", "content": "package github.com/sturluson/testpkg\n\nrequire {\n github.com/athas/fut-baz 0.2.0 #44da85224224d37803976c1d30cedb1d2cd20b74\n github.com/athas/fut-foo@2 2.0.0 #9459117fa75aea8fffc677294d25f273e894d19f\n}\n" }, { "path": "pkgtests/futhark.pkg.11", "content": "package github.com/sturluson/testpkg\n\nrequire {\n github.com/athas/fut-baz 0.2.0 #44da85224224d37803976c1d30cedb1d2cd20b74\n github.com/athas/fut-foo@2 2.0.0 #9459117fa75aea8fffc677294d25f273e894d19f\n github.com/athas/fut-quux 0.0.0-20180801102532+b70028521e4dbcc286834b32ce82c1d2721a6209\n}\n" }, { "path": "pkgtests/futhark.pkg.12", "content": "package github.com/sturluson/testpkg\n\nrequire {\n github.com/athas/fut-baz 0.2.0 #44da85224224d37803976c1d30cedb1d2cd20b74\n github.com/athas/fut-foo@2 2.0.0 #9459117fa75aea8fffc677294d25f273e894d19f\n github.com/athas/fut-quux 0.0.0-20180801102532+b70028521e4dbcc286834b32ce82c1d2721a6209\n}\n" }, { "path": "pkgtests/futhark.pkg.13", "content": "package github.com/sturluson/testpkg\n\nrequire {\n github.com/athas/fut-baz 0.2.0 #44da85224224d37803976c1d30cedb1d2cd20b74\n github.com/athas/fut-foo@2 2.0.0 #9459117fa75aea8fffc677294d25f273e894d19f\n github.com/athas/fut-quux 0.0.0-20180801102533+dd5168df1b8a20cb0547a88afd4e4a6cc098e0f1\n}\n" }, { "path": "pkgtests/futhark.pkg.14", "content": "package github.com/sturluson/testpkg\n\nrequire {\n github.com/athas/fut-baz 0.2.0 #44da85224224d37803976c1d30cedb1d2cd20b74\n github.com/athas/fut-foo@2 2.0.0 #9459117fa75aea8fffc677294d25f273e894d19f\n github.com/athas/fut-quux 0.0.0-20180801102533+dd5168df1b8a20cb0547a88afd4e4a6cc098e0f1\n}\n" }, { "path": "pkgtests/futhark.pkg.15", "content": "package github.com/sturluson/testpkg\n\nrequire {\n github.com/athas/fut-baz 0.2.0 #44da85224224d37803976c1d30cedb1d2cd20b74\n github.com/athas/fut-foo@2 2.0.0 #9459117fa75aea8fffc677294d25f273e894d19f\n github.com/athas/fut-quux 0.0.0-20180801102533+dd5168df1b8a20cb0547a88afd4e4a6cc098e0f1\n gitlab.com/athas/fut-gitlab 1.0.1 #631578b71d68381dd7461fc1d0c669cf84d0d5fe\n}\n" }, { "path": "pkgtests/futhark.pkg.16", "content": "package github.com/sturluson/testpkg\n\nrequire {\n github.com/athas/fut-baz 0.2.0 #44da85224224d37803976c1d30cedb1d2cd20b74\n github.com/athas/fut-foo@2 2.0.0 #9459117fa75aea8fffc677294d25f273e894d19f\n github.com/athas/fut-quux 0.0.0-20180801102533+dd5168df1b8a20cb0547a88afd4e4a6cc098e0f1\n gitlab.com/athas/fut-gitlab 1.0.1 #631578b71d68381dd7461fc1d0c669cf84d0d5fe\n}\n" }, { "path": "pkgtests/futhark.pkg.17", "content": "package github.com/sturluson/testpkg\n\nrequire {\n github.com/athas/fut-baz 0.2.0 #44da85224224d37803976c1d30cedb1d2cd20b74\n github.com/athas/fut-foo@2 2.0.0 #9459117fa75aea8fffc677294d25f273e894d19f\n github.com/athas/fut-quux 0.0.0-20180801102533+dd5168df1b8a20cb0547a88afd4e4a6cc098e0f1\n gitlab.com/athas/fut-gitlab 0.0.0-20180922095419+44bc83247e7b4995dd0c65acf3a72b70d6fe3efe\n}\n" }, { "path": "pkgtests/futhark.pkg.18", "content": "package github.com/sturluson/testpkg\n\nrequire {\n github.com/athas/fut-baz 0.2.0 #44da85224224d37803976c1d30cedb1d2cd20b74\n github.com/athas/fut-foo@2 2.0.0 #9459117fa75aea8fffc677294d25f273e894d19f\n github.com/athas/fut-quux 0.0.0-20180801102533+dd5168df1b8a20cb0547a88afd4e4a6cc098e0f1\n gitlab.com/athas/fut-gitlab 0.0.0-20180922095419+44bc83247e7b4995dd0c65acf3a72b70d6fe3efe\n}\n" }, { "path": "pkgtests/futhark.pkg.2", "content": "package github.com/sturluson/testpkg\n\nrequire {\n github.com/athas/fut-foo 0.1.0 #d285563c25c5152b1ae80fc64de64ff2775fa733\n}\n" }, { "path": "pkgtests/futhark.pkg.3", "content": "package github.com/sturluson/testpkg\n\nrequire {\n github.com/athas/fut-foo 0.1.0 #d285563c25c5152b1ae80fc64de64ff2775fa733\n github.com/athas/fut-baz 0.1.0 #6d26e7059eb138f95d4d9747051fc0bb6a4eb85c\n}\n" }, { "path": "pkgtests/futhark.pkg.4", "content": "package github.com/sturluson/testpkg\n\nrequire {\n github.com/athas/fut-foo 0.1.0 #d285563c25c5152b1ae80fc64de64ff2775fa733\n github.com/athas/fut-baz 0.1.0 #6d26e7059eb138f95d4d9747051fc0bb6a4eb85c\n}\n" }, { "path": "pkgtests/futhark.pkg.5", "content": "package github.com/sturluson/testpkg\n\nrequire {\n github.com/athas/fut-foo 0.2.0 #87d372c689131f33bef1b013ac2421fb5e75642b\n github.com/athas/fut-baz 0.2.0 #44da85224224d37803976c1d30cedb1d2cd20b74\n}\n" }, { "path": "pkgtests/futhark.pkg.6", "content": "package github.com/sturluson/testpkg\n\nrequire {\n github.com/athas/fut-foo 0.2.0 #87d372c689131f33bef1b013ac2421fb5e75642b\n github.com/athas/fut-baz 0.2.0 #44da85224224d37803976c1d30cedb1d2cd20b74\n}\n" }, { "path": "pkgtests/futhark.pkg.7", "content": "package github.com/sturluson/testpkg\n\nrequire {\n github.com/athas/fut-baz 0.2.0 #44da85224224d37803976c1d30cedb1d2cd20b74\n}\n" }, { "path": "pkgtests/futhark.pkg.8", "content": "package github.com/sturluson/testpkg\n\nrequire {\n github.com/athas/fut-baz 0.2.0 #44da85224224d37803976c1d30cedb1d2cd20b74\n}\n" }, { "path": "pkgtests/futhark.pkg.9", "content": "package github.com/sturluson/testpkg\n\nrequire {\n github.com/athas/fut-baz 0.2.0 #44da85224224d37803976c1d30cedb1d2cd20b74\n github.com/athas/fut-foo@2 2.0.0 #9459117fa75aea8fffc677294d25f273e894d19f\n}\n" }, { "path": "pkgtests/lib.10/github.com/athas/fut-bar/bar.fut", "content": "let bar = (0, 1, 0)\n" }, { "path": "pkgtests/lib.10/github.com/athas/fut-baz/baz.fut", "content": "module foo_mod = import \"../fut-foo/foo\" -- Naughty!\nmodule bar_mod = import \"../fut-bar/bar\" -- Naughty!\n\nlet baz = (0, 1, 1)\nlet foo = foo_mod.foo\nlet bar = bar_mod.bar\n" }, { "path": "pkgtests/lib.10/github.com/athas/fut-foo/foo.fut", "content": "let foo = (0, 1, 0)\n" }, { "path": "pkgtests/lib.10/github.com/athas/fut-foo@2/foo.fut", "content": "module fut_baz = import \"../fut-baz/baz\"\n\nlet foo = (0, 2, 0)\nlet baz = fut_baz.baz\n" }, { "path": "pkgtests/lib.11/github.com/athas/fut-bar/bar.fut", "content": "let bar = (0, 1, 0)\n" }, { "path": "pkgtests/lib.11/github.com/athas/fut-baz/baz.fut", "content": "module foo_mod = import \"../fut-foo/foo\" -- Naughty!\nmodule bar_mod = import \"../fut-bar/bar\" -- Naughty!\n\nlet baz = (0, 1, 1)\nlet foo = foo_mod.foo\nlet bar = bar_mod.bar\n" }, { "path": "pkgtests/lib.11/github.com/athas/fut-foo/foo.fut", "content": "let foo = (0, 1, 0)\n" }, { "path": "pkgtests/lib.11/github.com/athas/fut-foo@2/foo.fut", "content": "module fut_baz = import \"../fut-baz/baz\"\n\nlet foo = (0, 2, 0)\nlet baz = fut_baz.baz\n" }, { "path": "pkgtests/lib.12/github.com/athas/fut-bar/bar.fut", "content": "let bar = (0, 1, 0)\n" }, { "path": "pkgtests/lib.12/github.com/athas/fut-baz/baz.fut", "content": "module foo_mod = import \"../fut-foo/foo\" -- Naughty!\nmodule bar_mod = import \"../fut-bar/bar\" -- Naughty!\n\nlet baz = (0, 1, 1)\nlet foo = foo_mod.foo\nlet bar = bar_mod.bar\n" }, { "path": "pkgtests/lib.12/github.com/athas/fut-foo/foo.fut", "content": "let foo = (0, 1, 0)\n" }, { "path": "pkgtests/lib.12/github.com/athas/fut-foo@2/foo.fut", "content": "module fut_baz = import \"../fut-baz/baz\"\n\nlet foo = (0, 2, 0)\nlet baz = fut_baz.baz\n" }, { "path": "pkgtests/lib.12/github.com/athas/fut-quux/quux.fut", "content": "let quux = \"123\"\n" }, { "path": "pkgtests/lib.13/github.com/athas/fut-bar/bar.fut", "content": "let bar = (0, 1, 0)\n" }, { "path": "pkgtests/lib.13/github.com/athas/fut-baz/baz.fut", "content": "module foo_mod = import \"../fut-foo/foo\" -- Naughty!\nmodule bar_mod = import \"../fut-bar/bar\" -- Naughty!\n\nlet baz = (0, 1, 1)\nlet foo = foo_mod.foo\nlet bar = bar_mod.bar\n" }, { "path": "pkgtests/lib.13/github.com/athas/fut-foo/foo.fut", "content": "let foo = (0, 1, 0)\n" }, { "path": "pkgtests/lib.13/github.com/athas/fut-foo@2/foo.fut", "content": "module fut_baz = import \"../fut-baz/baz\"\n\nlet foo = (0, 2, 0)\nlet baz = fut_baz.baz\n" }, { "path": "pkgtests/lib.13/github.com/athas/fut-quux/quux.fut", "content": "let quux = \"123\"\n" }, { "path": "pkgtests/lib.14/github.com/athas/fut-bar/bar.fut", "content": "let bar = (0, 1, 0)\n" }, { "path": "pkgtests/lib.14/github.com/athas/fut-baz/baz.fut", "content": "module foo_mod = import \"../fut-foo/foo\" -- Naughty!\nmodule bar_mod = import \"../fut-bar/bar\" -- Naughty!\n\nlet baz = (0, 1, 1)\nlet foo = foo_mod.foo\nlet bar = bar_mod.bar\n" }, { "path": "pkgtests/lib.14/github.com/athas/fut-foo/foo.fut", "content": "let foo = (0, 1, 0)\n" }, { "path": "pkgtests/lib.14/github.com/athas/fut-foo@2/foo.fut", "content": "module fut_baz = import \"../fut-baz/baz\"\n\nlet foo = (0, 2, 0)\nlet baz = fut_baz.baz\n" }, { "path": "pkgtests/lib.14/github.com/athas/fut-quux/quux.fut", "content": "-- This is not a version number, but this is also not a released\n-- version!\nlet quux = \"123\"\n" }, { "path": "pkgtests/lib.15/github.com/athas/fut-bar/bar.fut", "content": "let bar = (0, 1, 0)\n" }, { "path": "pkgtests/lib.15/github.com/athas/fut-baz/baz.fut", "content": "module foo_mod = import \"../fut-foo/foo\" -- Naughty!\nmodule bar_mod = import \"../fut-bar/bar\" -- Naughty!\n\nlet baz = (0, 1, 1)\nlet foo = foo_mod.foo\nlet bar = bar_mod.bar\n" }, { "path": "pkgtests/lib.15/github.com/athas/fut-foo/foo.fut", "content": "let foo = (0, 1, 0)\n" }, { "path": "pkgtests/lib.15/github.com/athas/fut-foo@2/foo.fut", "content": "module fut_baz = import \"../fut-baz/baz\"\n\nlet foo = (0, 2, 0)\nlet baz = fut_baz.baz\n" }, { "path": "pkgtests/lib.15/github.com/athas/fut-quux/quux.fut", "content": "-- This is not a version number, but this is also not a released\n-- version!\nlet quux = \"123\"\n" }, { "path": "pkgtests/lib.16/github.com/athas/fut-bar/bar.fut", "content": "let bar = (0, 1, 0)\n" }, { "path": "pkgtests/lib.16/github.com/athas/fut-baz/baz.fut", "content": "module foo_mod = import \"../fut-foo/foo\" -- Naughty!\nmodule bar_mod = import \"../fut-bar/bar\" -- Naughty!\n\nlet baz = (0, 1, 1)\nlet foo = foo_mod.foo\nlet bar = bar_mod.bar\n" }, { "path": "pkgtests/lib.16/github.com/athas/fut-foo/foo.fut", "content": "let foo = (0, 1, 0)\n" }, { "path": "pkgtests/lib.16/github.com/athas/fut-foo@2/foo.fut", "content": "module fut_baz = import \"../fut-baz/baz\"\n\nlet foo = (0, 2, 0)\nlet baz = fut_baz.baz\n" }, { "path": "pkgtests/lib.16/github.com/athas/fut-quux/quux.fut", "content": "-- This is not a version number, but this is also not a released\n-- version!\nlet quux = \"123\"\n" }, { "path": "pkgtests/lib.16/gitlab.com/athas/fut-gitlab/gitlab.fut", "content": "let gitlab = (1, 0, 1)\n" }, { "path": "pkgtests/lib.17/github.com/athas/fut-bar/bar.fut", "content": "let bar = (0, 1, 0)\n" }, { "path": "pkgtests/lib.17/github.com/athas/fut-baz/baz.fut", "content": "module foo_mod = import \"../fut-foo/foo\" -- Naughty!\nmodule bar_mod = import \"../fut-bar/bar\" -- Naughty!\n\nlet baz = (0, 1, 1)\nlet foo = foo_mod.foo\nlet bar = bar_mod.bar\n" }, { "path": "pkgtests/lib.17/github.com/athas/fut-foo/foo.fut", "content": "let foo = (0, 1, 0)\n" }, { "path": "pkgtests/lib.17/github.com/athas/fut-foo@2/foo.fut", "content": "module fut_baz = import \"../fut-baz/baz\"\n\nlet foo = (0, 2, 0)\nlet baz = fut_baz.baz\n" }, { "path": "pkgtests/lib.17/github.com/athas/fut-quux/quux.fut", "content": "-- This is not a version number, but this is also not a released\n-- version!\nlet quux = \"123\"\n" }, { "path": "pkgtests/lib.18/github.com/athas/fut-bar/bar.fut", "content": "let bar = (0, 1, 0)\n" }, { "path": "pkgtests/lib.18/github.com/athas/fut-baz/baz.fut", "content": "module foo_mod = import \"../fut-foo/foo\" -- Naughty!\nmodule bar_mod = import \"../fut-bar/bar\" -- Naughty!\n\nlet baz = (0, 1, 1)\nlet foo = foo_mod.foo\nlet bar = bar_mod.bar\n" }, { "path": "pkgtests/lib.18/github.com/athas/fut-foo/foo.fut", "content": "let foo = (0, 1, 0)\n" }, { "path": "pkgtests/lib.18/github.com/athas/fut-foo@2/foo.fut", "content": "module fut_baz = import \"../fut-baz/baz\"\n\nlet foo = (0, 2, 0)\nlet baz = fut_baz.baz\n" }, { "path": "pkgtests/lib.18/github.com/athas/fut-quux/quux.fut", "content": "-- This is not a version number, but this is also not a released\n-- version!\nlet quux = \"123\"\n" }, { "path": "pkgtests/lib.18/gitlab.com/athas/fut-gitlab/gitlab.fut", "content": "-- Unreleased version.\nlet gitlab = (1, 0, 1)\n" }, { "path": "pkgtests/lib.2/github.com/athas/fut-foo/foo.fut", "content": "let foo = (0, 1, 0)\n" }, { "path": "pkgtests/lib.3/github.com/athas/fut-foo/foo.fut", "content": "let foo = (0, 1, 0)\n" }, { "path": "pkgtests/lib.4/github.com/athas/fut-baz/baz.fut", "content": "module foo_mod = import \"../fut-foo/foo\" -- Naughty!\n\nlet baz = (0, 1, 0)\nlet foo = foo_mod.foo\n" }, { "path": "pkgtests/lib.4/github.com/athas/fut-foo/foo.fut", "content": "let foo = (0, 1, 0)\n" }, { "path": "pkgtests/lib.5/github.com/athas/fut-baz/baz.fut", "content": "module foo_mod = import \"../fut-foo/foo\" -- Naughty!\n\nlet baz = (0, 1, 0)\nlet foo = foo_mod.foo\n" }, { "path": "pkgtests/lib.5/github.com/athas/fut-foo/foo.fut", "content": "let foo = (0, 1, 0)\n" }, { "path": "pkgtests/lib.6/github.com/athas/fut-bar/bar.fut", "content": "let bar = (0, 1, 0)\n" }, { "path": "pkgtests/lib.6/github.com/athas/fut-baz/baz.fut", "content": "module foo_mod = import \"../fut-foo/foo\" -- Naughty!\nmodule bar_mod = import \"../fut-bar/bar\" -- Naughty!\n\nlet baz = (0, 1, 1)\nlet foo = foo_mod.foo\nlet bar = bar_mod.bar\n" }, { "path": "pkgtests/lib.6/github.com/athas/fut-foo/foo.fut", "content": "module fut_bar = import \"../../../github.com/athas/fut-bar/bar\"\n\nlet foo = (0, 2, 0)\nlet bar = fut_bar.bar\n" }, { "path": "pkgtests/lib.7/github.com/athas/fut-bar/bar.fut", "content": "let bar = (0, 1, 0)\n" }, { "path": "pkgtests/lib.7/github.com/athas/fut-baz/baz.fut", "content": "module foo_mod = import \"../fut-foo/foo\" -- Naughty!\nmodule bar_mod = import \"../fut-bar/bar\" -- Naughty!\n\nlet baz = (0, 1, 1)\nlet foo = foo_mod.foo\nlet bar = bar_mod.bar\n" }, { "path": "pkgtests/lib.7/github.com/athas/fut-foo/foo.fut", "content": "module fut_bar = import \"../../../github.com/athas/fut-bar/bar\"\n\nlet foo = (0, 2, 0)\nlet bar = fut_bar.bar\n" }, { "path": "pkgtests/lib.8/github.com/athas/fut-bar/bar.fut", "content": "let bar = (0, 1, 0)\n" }, { "path": "pkgtests/lib.8/github.com/athas/fut-baz/baz.fut", "content": "module foo_mod = import \"../fut-foo/foo\" -- Naughty!\nmodule bar_mod = import \"../fut-bar/bar\" -- Naughty!\n\nlet baz = (0, 1, 1)\nlet foo = foo_mod.foo\nlet bar = bar_mod.bar\n" }, { "path": "pkgtests/lib.8/github.com/athas/fut-foo/foo.fut", "content": "let foo = (0, 1, 0)\n" }, { "path": "pkgtests/lib.9/github.com/athas/fut-bar/bar.fut", "content": "let bar = (0, 1, 0)\n" }, { "path": "pkgtests/lib.9/github.com/athas/fut-baz/baz.fut", "content": "module foo_mod = import \"../fut-foo/foo\" -- Naughty!\nmodule bar_mod = import \"../fut-bar/bar\" -- Naughty!\n\nlet baz = (0, 1, 1)\nlet foo = foo_mod.foo\nlet bar = bar_mod.bar\n" }, { "path": "pkgtests/lib.9/github.com/athas/fut-foo/foo.fut", "content": "let foo = (0, 1, 0)\n" }, { "path": "pkgtests/test.sh", "content": "#!/bin/sh\n#\n# You must be in the directory when running this script. It does not\n# try to be clever.\n\nset -e # Die on error.\n\nFUTPKG=\"../src/futpkg\"\n#FUTPKG=\"../src/futpkg -v\"\n#FUTPKG=\"futhark pkg\"\n\nlastrun=\"\"\n\nexpects () {\n # Hack to correctly handle empty directories, which are otherwise\n # not committed to Git.\n if ! diff -urN $1 $2; then\n echo \"After command '$lastrun', $1 does not match $2\"\n exit 1\n fi\n}\n\ni=0\n\nsucceed () {\n lastrun=\"$@\"\n echo '$' \"$@\"\n if ! \"$@\"; then\n echo \"Command '$lastrun' failed unexpectedly.\"\n exit 1\n fi\n expects futhark.pkg futhark.pkg.$i\n expects lib lib.$i\n i=$(($i+1))\n}\n\nfail () {\n lastrun=\"$@\"\n echo '$' \"$@\"\n if \"$@\"; then\n echo \"Command '$lastrun' succeeded unexpectedly.\"\n exit 1\n fi\n}\n\n# Clean up after previous test runs.\nrm -rf futhark.pkg lib\n\nsucceed $FUTPKG init github.com/sturluson/testpkg\n\nsucceed $FUTPKG add github.com/athas/fut-foo 0.1.0\n\nsucceed $FUTPKG sync\n\nsucceed $FUTPKG add github.com/athas/fut-baz 0.1.0\n\nsucceed $FUTPKG sync\n\nsucceed $FUTPKG upgrade\n\nsucceed $FUTPKG sync\n\nsucceed $FUTPKG remove github.com/athas/fut-foo\n\nsucceed $FUTPKG sync\n\nsucceed $FUTPKG add github.com/athas/fut-foo@2 2.0.0\n\nsucceed $FUTPKG sync\n\nsucceed $FUTPKG add github.com/athas/fut-quux 0.0.0-20180801102532+b70028521e4dbcc286834b32ce82c1d2721a6209\n\nsucceed $FUTPKG sync\n\nsucceed $FUTPKG add github.com/athas/fut-quux 0.0.0-20180801102533+dd5168df1b8a20cb0547a88afd4e4a6cc098e0f1\n\nsucceed $FUTPKG sync\n\nsucceed $FUTPKG add gitlab.com/athas/fut-gitlab\n\nsucceed $FUTPKG sync\n" }, { "path": "src/.gitignore", "content": "MLB\n*~\nsmlpkg\nfutpkg\nversion.gen.sml" }, { "path": "src/Makefile", "content": "PKGVERSION=$(shell cat ../version.txt)\n\nMLCOMP ?= mlkit\n\nSMLFILES=$(shell find . -name '*.sml') $(shell find . -name '*.sig') $(shell find . -name '*.mlb')\n\nGITVERSION=$(shell git describe --abbrev --dirty --always --tags)\n\n.PHONY: all\nall: smlpkg futpkg\n\nsmlpkg: smlpkg.mlb $(SMLFILES) version.gen.sml\n\t$(MLCOMP) -output $@ $<\n\nfutpkg: futpkg.mlb $(SMLFILES)\n\t$(MLCOMP) -output $@ $<\n\n.PHONY: test\ntest:\n\t$(MAKE) -C semver test\n\t$(MAKE) -C manifest test\n\t$(MAKE) -C solve test\n\t$(MAKE) -C util test\n\n.PHONY: remotetest\nremotetest:\n\t$(MAKE) -C test test\n\nversion.gen.sml: Makefile ../version.txt\n\techo 'structure Version = struct' > $@\n\techo \" val version = \\\"$(PKGVERSION)\\\"\" >> $@\n\techo \" val gitversion = \\\"$(GITVERSION)\\\"\" >> $@\n\techo \"end\" >> $@\n\n.PHONY: clean\nclean:\n\trm -rf *~ MLB run pkg.exe smlpkg version.gen.sml\n\t$(MAKE) -C semver clean\n\t$(MAKE) -C manifest clean\n\t$(MAKE) -C solve clean\n\t$(MAKE) -C parsecomb clean\n\t$(MAKE) -C util clean\n\t$(MAKE) -C test clean\n" }, { "path": "src/futpkg.mlb", "content": "pkg.mlb\nfutpkg.sml\n" }, { "path": "src/futpkg.sml", "content": "\nval () = Pkg.main \"futhark.pkg\"\n" }, { "path": "src/manifest/.gitignore", "content": "MLB\n*.exe" }, { "path": "src/manifest/Makefile", "content": "MLCOMP ?= mlkit\n\n.PHONY: test\ntest:\n\t$(MLCOMP) -output test.exe test.mlb\n\t./test.exe\n\n.PHONY: clean\nclean:\n\trm -rf *~ MLB run *.exe\n" }, { "path": "src/manifest/lex.sig", "content": "signature LEX = sig\n type reg = Region.reg\n type loc = Region.loc\n type filename = string\n\n datatype token = Symb of char\n | Id of string\n\n val pr_token : token -> string\n\n val lex : filename -> string -> (token * reg) list\nend\n" }, { "path": "src/manifest/lex.sml", "content": "structure Lex :> LEX =\nstruct\nstructure R = Region\ntype reg = R.reg\ntype loc = R.loc\ntype filename = R.filename\ndatatype token = Symb of char\n | Id of string\n\nfun pr_token (Symb c) = \"'\" ^ String.str c ^ \"'\"\n | pr_token (Id s) = \"'\" ^ s ^ \"'\"\n\nfun loc0 (f:filename) : loc = (1,0,f) (* line 1, char 0 *)\n\ndatatype state = StartS\n | IdS of string * loc * loc\n\nfun isSymb c = CharVector.exists (fn c' => c'=c) \"{}/#\"\n\nfun lexError (loc:loc) (s:string) : 'a =\n let val msg = \"Lexical error at location \" ^ R.ppLoc loc ^ \": \" ^ s\n in raise Fail msg\n end\n\ntype lexstate = (token * reg) list * state * loc\n\nfun process (c:char,(tokens,state,loc):lexstate) : lexstate =\n let fun next' c loc = if c = #\"\\n\" then R.newline loc else R.next loc\n fun proc (tokens,state,loc) =\n case state of\n StartS =>\n if Char.isSpace c then (tokens, state, next' c loc)\n else if isSymb c then ((Symb c,(loc,loc))::tokens, StartS, R.next loc)\n else if Char.isPrint c then (tokens, IdS(String.str c,loc,loc), R.next loc)\n else lexError loc \"expecting printable character\"\n | IdS(s,l0,l1) =>\n if Char.isSpace c then ((Id s,(l0,l1))::tokens, StartS, next' c loc)\n else if isSymb c then ((Symb c,(loc,loc))::(Id s,(l0,l1))::tokens, StartS, R.next loc)\n else if Char.isPrint c then (tokens, IdS(s ^ String.str c,l0,loc), R.next loc)\n else lexError loc \"expecting printable character\"\n in proc(tokens,state,loc)\n end\n\nfun lex (filename: filename) (s:string) : (token * reg) list =\n let val s = s^\" \" (* pad some whitespace to keep the lexer happy *)\n val (tokens,state,_) = CharVector.foldl process (nil,StartS,R.loc0 filename) s\n in rev tokens\n end\n\nend\n" }, { "path": "src/manifest/manifest.mlb", "content": "local\n $(SML_LIB)/basis/basis.mlb\n ../parsecomb/parsecomb.mlb\n lex.sig\n lex.sml\nin\n ../semver/semver.mlb\n manifest.sig\n manifest.sml\nend\n" }, { "path": "src/manifest/manifest.sig", "content": "signature MANIFEST = sig\n type t\n type pkgpath = {host:string,owner:string,repo:string}\n type semver = SemVer.t\n type hash = string\n type filename = string\n\n type required = pkgpath * semver * hash option\n\n val pkgpathToString : pkgpath -> string\n val pkgpathFromString : string -> pkgpath option\n\n val package : t -> pkgpath option\n val requires : t -> required list\n\n val toString : t -> string (* for saving *)\n val fromString : filename -> string -> t (* may raise Fail *)\n val fromFile : filename -> t (* may raise Fail *)\n\n val empty : pkgpath option -> t\n\n val add_required : required -> t -> t\n val del_required : pkgpath -> t -> t\n val get_required : t -> pkgpath -> required option\n val replace_requires : t -> required list -> t\n\n val pkg_dir : t -> string option (* directory containing package files *)\n\n val smlpkg_filename : unit -> string\n val set_smlpkg_filename : string -> unit\n\n val isCommitVersion : semver -> string option (* returns the build id *)\n val commitVersion : string -> string -> semver option\n\nend\n" }, { "path": "src/manifest/manifest.sml", "content": "structure Manifest :> MANIFEST = struct\n\nstructure R = Region\nstructure L = Lex\nstructure P = ParseComb(type token = L.token\n val pr_token = L.pr_token)\n\n(* The standard name of package files ; we allow for this standard to change so\n that we kan use the package manager as a replacement of futhark pkg - mainly\n for testing... *)\nlocal\n val filename = ref \"sml.pkg\"\nin\n fun smlpkg_filename () = !filename\n fun set_smlpkg_filename s = filename := s\nend\n\ntype pkgpath = {host:string,owner:string,repo:string}\n\nfun pkgpathToString (p:pkgpath) : string =\n #host p ^ \"/\" ^ #owner p ^ \"/\" ^ #repo p\n\nfun pkgpathFromString (p:string) : pkgpath option =\n case String.fields (fn c => c = #\"/\") p of\n [host,owner,repo] => SOME {host=host,owner=owner,repo=repo}\n | _ => NONE\n\ntype semver = SemVer.t\ntype hash = string\ntype filename = string\ntype reg = R.reg\n\ntype required = pkgpath * semver * hash option\n\ntype t = {package: pkgpath option,\n requires: required list}\n\nfun package (m: t) : pkgpath option = #package m\nfun requires (m: t) : required list = #requires m\n\n\nfun toString (m: t) : string =\n let fun pr_require (p,v,hopt) =\n \" \" ^ pkgpathToString p ^ \" \" ^ SemVer.toString v ^\n (case hopt of SOME h => \" #\" ^ h | NONE => \"\") ^ \"\\n\"\n in (case #package m of\n SOME p => \"package \" ^ pkgpathToString p ^ \"\\n\\n\"\n | NONE => \"\") ^\n (\"require {\\n\") ^\n (String.concat (map pr_require (#requires m))) ^\n (\"}\\n\")\n end\n\nfun empty (p: pkgpath option) : t =\n {package=p, requires=nil}\n\nlocal\n open P infix >>> ->> >>- ?? ??? || oo oor\nin\n(* p_id : string p *)\nfun p_id nil = NO (R.botloc, fn () => \"expecting identifier but found end-of-file\")\n | p_id ((L.Id id,r)::ts) = OK(id,r,ts)\n | p_id ((t,r:reg)::_) = NO (#1 r, fn () => (\"expecting identifier but found token \" ^ L.pr_token t))\n\n(* p_symb : token p *)\nfun p_symb nil = NO (R.botloc,fn () => \"reached end-of-file\")\n | p_symb ((t,r:reg)::ts) =\n case t of\n L.Symb _ => OK(t,r,ts)\n | _ => NO (#1 r,\n fn () => (\"expecting symbol but found token \" ^\n L.pr_token t))\n\nval p_pkgpath : pkgpath p =\n ((p_id >>- eat (L.Symb #\"/\")) >>>\n (p_id >>- eat (L.Symb #\"/\")) >>> p_id) oo\n (fn ((a,b),c) => {host=a,owner=b,repo=c})\n\nval p_hash : string p = eat (L.Symb #\"#\") ->> p_id\n\nfun p_semver nil = NO (R.botloc, fn () => \"expecting semantic version but found end-of-file\")\n | p_semver ((L.Id id,r)::ts) =\n (case SemVer.fromString id of\n SOME v => OK(v,r,ts)\n | NONE => NO (#1 r, fn () => \"expecting semantic version\"))\n | p_semver ((t,r:reg)::_) = NO (#1 r, fn () => (\"expecting semantic version but found token \" ^ L.pr_token t))\n\nval p_req : required p =\n ((p_pkgpath >>> p_semver) oo (fn (a,b) => (a,b,NONE)) ?? p_hash) (fn ((a,b,_),c) => (a,b,SOME c))\n\nval rec p_reqs : required list p =\n fn ts =>\n ((eat (L.Symb #\"}\") oo (fn () => nil))\n || ((p_req oo (fn a => [a]) ?? p_reqs) (op @))\n ) ts\n\nval p_require : required list p =\n eat (L.Id \"require\") ->> eat (L.Symb #\"{\") ->> p_reqs\n\nval p : t p =\n ((((eat (L.Id \"package\") ->> p_pkgpath) oo SOME) >>> p_require)\n || (p_require oo (fn r => (NONE,r))))\n oo (fn (p,rs) => {package=p,requires=rs})\n\nfun parse (ts:(token*reg) list) : t =\n case p ts of\n OK (v,_,_) => v\n | NO (loc,f) => raise Fail (\"parse error at location \"\n ^ R.ppLoc loc ^ \": \" ^ f())\nend\n\nfun fromString (filename:string) (content:string) : t =\n let val ts = L.lex filename content\n in parse ts\n end\n\nfun readAll (filename:string) : string = (* may raise Fail *)\n let val is = TextIO.openIn filename\n in (TextIO.inputAll is handle _ => (TextIO.closeIn is;\n raise Fail (\"failed to read file '\" ^ filename ^ \"'\")))\n before TextIO.closeIn is\n end\n\nfun fromFile (filename:string) : t =\n fromString filename (readAll filename)\n\nfun add_required (r:required) (t:t) : t =\n {package= #package t,\n requires= #requires t @ [r]}\n\nfun del_required (pkgpath:pkgpath) (t:t) : t =\n {package= #package t,\n requires= List.filter (fn r => #1 r <> pkgpath) (#requires t)}\n\nfun get_required (t:t) (pkgpath:pkgpath) : required option =\n List.find (fn r => #1 r = pkgpath) (#requires t)\n\nfun replace_requires (t:t) (rs:required list) : t =\n {package= #package t,\n requires=rs}\n\nfun pkg_dir (t:t) : string option =\n case #package t of\n SOME p => SOME (\"lib/\" ^ pkgpathToString p)\n | NONE => NONE\n\n(* Versions of the form (0,0,0)-timestamp+hash are treated\n specially, as a reference to the commit identified uniquely with\n 'hash' (typically the Git commit ID). This function detects such\n versions. *)\n\nfun isCommitVersion (v:semver) : string option =\n case (SemVer.major v, SemVer.minor v, SemVer.patch v) of\n (0,0,0) => SOME (SemVer.idsToString (SemVer.build v))\n | _ => NONE\n\n(* @commitVersion timestamp commit@ constructs a commit version. *)\n\nfun commitVersion (time:string) (commit:string) : semver option =\n SemVer.fromString (\"0.0.0-\" ^ time ^ \"+\" ^ commit)\n\nend\n" }, { "path": "src/manifest/test.mlb", "content": "local $(SML_LIB)/basis/basis.mlb\n manifest.mlb\nin test.sml\nend\n" }, { "path": "src/manifest/test.sml", "content": "\nopen Manifest\n\nfun test s f =\n (if f() then print (\"OK : \" ^ s ^ \"\\n\")\n else print (\"ERR: \" ^ s ^ \"\\n\"))\n handle Fail e => print (\"EXN: \" ^ s ^ \" raised Fail \\\"\" ^ e ^ \"\\\"\\n\")\n\nval m = \"require {}\"\n\nval () = test \"empty-m\" (fn () => null(requires(fromString \"str\" m)))\n\nval mp = \"package github.com/owner/repo require {}\"\nval () = test \"empty-mp\" (fn () => null(requires(fromString \"str\" mp)))\nval () = test \"empty-mp-host\" (fn () => SOME \"github.com\" = Option.map #host (package(fromString \"str\" mp)))\nval () = test \"empty-mp-owner\" (fn () => SOME \"owner\" = Option.map #owner (package(fromString \"str\" mp)))\nval () = test \"empty-mp-repo\" (fn () => SOME \"repo\" = Option.map #repo (package(fromString \"str\" mp)))\n\nval mr1 = \"require { github.com/owner/repo 1.2.3 #asdefsde }\"\nval () = test \"empty-mr1-len\" (fn () => 1 = length(requires(fromString \"str\" mr1)))\nval () = test \"empty-mr1\" (fn () => SOME \"asdefsde\" = #3(List.hd(requires(fromString \"str\" mr1))))\n\nval mr2 = \"require { github.com/owner/repo 1.2.3 #asdefsde github.com/owner2/repo8 43.3.2-alpha #523424abcd }\"\nval () = test \"empty-mr2\" (fn () => 2 = length(requires(fromString \"str\" mr2)))\nval () = test \"empty-mr2-version\" (fn () => \"1.2.3\" = SemVer.toString(#2(List.hd(requires(fromString \"str\" mr2)))))\n" }, { "path": "src/parsecomb/.gitignore", "content": "MLB\n*.exe" }, { "path": "src/parsecomb/Makefile", "content": ".PHONY: clean\nclean:\n\trm -rf MLB run *~\n" }, { "path": "src/parsecomb/PARSE_COMB.sig", "content": "(** Simple parser combinator library that keeps track of position information. *)\nsignature PARSE_COMB = sig\n type token\n datatype ('a,'b) either = OK of 'a | NO of 'b\n type locerr = Region.loc * (unit -> string)\n type 'a p = (token*Region.reg)list -> ('a * Region.reg * (token*Region.reg)list, locerr) either\n \n val >>> : 'a p * 'b p -> ('a*'b)p\n val ->> : unit p * 'b p -> 'b p\n val >>- : 'a p * unit p -> 'a p\n val ?? : 'a p * 'b p -> ('a*'b -> 'a) -> 'a p\n val ??? : 'a p * 'b p -> ('a*'b*Region.reg -> 'a) -> 'a p\n val || : 'a p * 'a p -> 'a p\n val oo : 'a p * ('a -> 'b) -> 'b p\n val ign : 'a p -> unit p\n val eat : token -> unit p\n val oor : 'a p * ('a*Region.reg -> 'b) -> 'b p\nend\n\n(**\n[token] type of tokens.\n\n['a p] type of parsers that parse values of type 'a.\n\na >>> b\n Sequence parsers a and b\n\na ->> b\n Sequence parsers a and b, discard result of a\n\na >>- b\n Sequence parsers a and b, discard result of b\n\n(a ?? b) f\n parse a and maybe continue with b, if both succeeds, combine with f\n\n(a ??? b) f\n same as ??, but giving region information to f\n\na || b\n alternatives\n\np oo f\n fmap f p\n\nign p\n discard the result of a parser p\n\neat t ts\n \"eat\" one token t from list ts\n\np oor f\n fmap f p, giving region info to f\n*)\n" }, { "path": "src/parsecomb/ParseComb.sml", "content": "functor ParseComb(eqtype token\n val pr_token : token -> string) : PARSE_COMB = struct\ntype loc = Region.loc\ntype reg = Region.reg\n\ntype token = token\n\n(* keep track of the max location - the longest parse *)\ndatatype ('a,'b) either = OK of 'a | NO of 'b\n\ntype locerr = loc * (unit -> string)\nfun maxLocerr (l1:locerr) l2 =\n if Region.lt (#1 l1) (#1 l2) then l2\n else l1\n\ntype 'a p = (token*reg)list -> ('a * reg * (token*reg)list, locerr) either\n\ninfix >>> ->> >>- ?? ??? || oo oor\nfun p1 >>> p2 = fn ts =>\n case p1 ts of\n OK(v1,r1,ts) =>\n (case p2 ts of\n OK(v2,r2,ts) => OK((v1,v2), Region.plus \">>>\" r1 r2, ts)\n | NO l => NO (maxLocerr l (#2 r1,fn()=>\"\")))\n | NO l => NO l\n\nfun p1 ->> p2 = fn ts =>\n case p1 ts of\n OK((),r1,ts) =>\n (case p2 ts of\n OK(v2,r2,ts) => OK(v2, Region.plus \"->>\" r1 r2, ts)\n | NO l => NO (maxLocerr l (#2 r1,fn()=>\"\")))\n | NO l => NO l\n\nfun p1 >>- p2 = fn ts =>\n case p1 ts of\n OK(v,r1,ts) =>\n (case p2 ts of\n OK((),r2,ts) => OK(v, Region.plus \">>-\" r1 r2, ts)\n | NO l => NO (maxLocerr l (#2 r1,fn()=>\"\")))\n | NO l => NO l\n\nfun p1 ?? p2 = fn f => fn ts =>\n case p1 ts of\n OK(v1,r1,ts) =>\n (case p2 ts of\n OK(v2,r2,ts) => OK(f(v1,v2), Region.plus \"??\" r1 r2, ts)\n | _ => OK(v1,r1,ts))\n | NO l => NO l\n\nfun p1 ??? p2 = fn f => fn ts =>\n case p1 ts of\n OK(v1,r1,ts) =>\n (case p2 ts of\n OK(v2,r2,ts) => \n let val r = Region.plus \"???\" r1 r2\n in OK(f(v1,v2,r), r, ts)\n end\n | NO l => OK(v1,r1,ts))\n | NO l => NO l\n\nfun p1 || p2 = fn ts =>\n case p1 ts of\n OK(v,r,ts) => OK(v,r,ts)\n | NO l1 => case p2 ts of\n OK(v,r,ts) => OK(v,r,ts)\n | NO l2 => NO (maxLocerr l1 l2)\n\nfun ign p ts =\n case p ts of\n OK (_,r,ts) => OK ((),r,ts)\n | NO l => NO l\n\nfun p oo f = fn ts =>\n case p ts of\n OK(v,r,ts) => OK(f v,r,ts)\n | NO l => NO l\n\nfun p oor f = fn ts =>\n case p ts of\n OK(v,r,ts) => OK(f(v,r),r,ts)\n | NO l => NO l\n\nfun eat t ts =\n case ts of\n nil => NO (Region.botloc,fn() => (\"expecting token \" ^ pr_token t ^ \n \" but reached end-of-file\"))\n | (t',r:Region.reg)::ts' => if t=t' then OK ((),r,ts')\n else NO (#1 r,fn()=> (\"expecting token \" ^ pr_token t ^ \n \" but found token \" ^ pr_token t'))\nend\n" }, { "path": "src/parsecomb/REGION.sig", "content": "signature REGION = sig\n type filename = string\n type loc = int * int * filename\n type reg = loc * loc\n\n val botloc : loc\n val loc0 : filename -> loc (* line 1, char 1 *)\n val newline : loc -> loc\n val next : loc -> loc\n val lt : loc -> loc -> bool\n val wf : reg -> bool \n val ppLoc : loc -> string \n val pp : reg -> string\n val plus : string -> reg -> reg -> reg\nend\n\n\n(* \n\nbotloc\n end of file\n\nloc0 f\n line 1, char 1 of file f\n\nnewline\n first char on next line\n\nnext\n next char on current line\n\nlt a b\n is location a strictly before location b in the file\n\nwf r\n well formed\n\nppLoc\n pretty print location\n\npp\n pretty print region\n\nplus\n merge regions (string only used for error reporting)\n\n*)\n" }, { "path": "src/parsecomb/Region.sml", "content": "structure Region :> REGION = struct\n type filename = string\n type loc = int * int * filename\n type reg = loc * loc\n val botloc = (0,0,\"\")\n fun loc0 f = (1,0,f)\n fun newline l = \n if l = botloc then\n raise Fail \"Region.newline: botloc is not a real location\"\n else (#1 l + 1,0,#3 l)\n fun next l =\n if l = botloc then\n raise Fail \"Region.next: botloc is not a real location\"\n else (#1 l, #2 l + 1, #3 l)\n\n fun lt (l1:loc) (l2:loc) =\n if l2 = botloc then false\n else l1 = botloc orelse\n #1 l1 < #1 l2 orelse (#1 l1 = #1 l2 andalso #2 l1 < #2 l2)\n fun wf (r:reg) =\n #3 (#1 r) <> #3 (#2 r) orelse\n #1 r = #2 r orelse lt (#1 r) (#2 r)\n fun ppLoc0 (a,b,_) = Int.toString a ^ \".\" ^ Int.toString b\n fun ppLoc (l:loc) = #3 l ^ \":\" ^ ppLoc0 l\n fun pp (a,b) =\n if a = b then ppLoc a\n else if #3 a = #3 b then #3 a ^ \":\" ^ ppLoc0 a ^ \"-\" ^ ppLoc0 b\n else ppLoc a ^ \"-\" ^ ppLoc b\n fun plus s r1 r2 =\n if wf r1 andalso wf r2 andalso (lt (#2 r1) (#1 r2) orelse #3 (#2 r1) <> #3 (#1 r2)) then\n (#1 r1, #2 r2)\n else raise Fail (\"Region \" ^ pp r1 ^ \" cannot be merged with region \" ^ pp r2 ^ \" at \" ^ s)\nend\n" }, { "path": "src/parsecomb/parsecomb.mlb", "content": "local $(SML_LIB)/basis/basis.mlb\nin REGION.sig\n Region.sml\n PARSE_COMB.sig\n ParseComb.sml\nend\n" }, { "path": "src/pkg.mlb", "content": "local $(SML_LIB)/basis/basis.mlb\n semver/semver.mlb\n manifest/manifest.mlb\n util/util.mlb\n pkginfo.sig\n pkginfo.sml\n solve/solve.sig\n solve/solve.sml\n version.gen.sml\nin\n pkg.sml\nend\n" }, { "path": "src/pkg.sml", "content": "structure Pkg:\nsig\n val main: string -> unit\nend =\nstruct\n\n structure Solve = Solve(PkgInfo)\n\n (* Some utilities *)\n fun println s =\n print (s ^ \"\\n\")\n\n fun log s =\n if ! PkgInfo.verboseFlag then println (\"[\" ^ s ^ \"]\") else ()\n\n fun isPrefixList (nil, _) = true\n | isPrefixList (x :: xs, y :: ys) =\n x = y andalso isPrefixList (xs, ys)\n | isPrefixList _ = false\n\n fun isInPkgDir (from_dir: string) (f: string) : bool =\n isPrefixList (System.splitPath from_dir, System.splitPath f)\n\n fun is_in e l =\n List.exists (fn x => x = e) l\n\n structure M = FinMapEq\n type filepath = string\n type pkgpath = Manifest.pkgpath\n type required = Manifest.required\n type buildlist = Solve.buildlist\n type semver = SemVer.t\n\n infix \n val op = System.\n\n val smlpkg_filename = Manifest.smlpkg_filename\n\n (* Installing packages *)\n\n fun installInDir (bl: buildlist) (dir: filepath) : unit =\n let\n fun install (p, v) =\n let\n val info = PkgInfo.lookupPackageRev p v\n val repo_url = PkgInfo.pkgRevRepoUrl info\n val refe = PkgInfo.pkgRevRef info\n val () = log (\"cloning \" ^ repo_url ^ \" @ \" ^ refe)\n val m = PkgInfo.pkgRevGetManifest info\n (* Compute the directory in the repository that contains the\n package files. *)\n val from_dir =\n case Manifest.pkg_dir m of\n SOME d => d\n | NONE =>\n raise Fail\n (smlpkg_filename () ^ \" for \" ^ Manifest.pkgpathToString p\n ^ \"-\" ^ SemVer.toString v\n ^ \" does not define a package path.\")\n (* The directory in the local file system that will contain the\n package files. *)\n val pdir = dir Manifest.pkgpathToString p\n (* Remove any existing directory for this package. *)\n val () = System.removePathForcibly pdir\n (* Get the cached bare repository *)\n val bare_repo = PkgInfo.getCachedRepo repo_url\n (* Extract files from the bare repository to a temporary location *)\n val tmpdir = OS.FileSys.tmpName () ^ \"-smlpkg-install\"\n val () = log\n (\"extracting \" ^ refe ^ \" to temporary directory \" ^ tmpdir)\n val () =\n if System.doesDirExist tmpdir then () else OS.FileSys.mkDir tmpdir\n (* Perform extraction, copying, and cleanup, ensuring tmpdir is removed on failure. *)\n in\n (* Use git archive to extract the specific ref *)\n\n let\n val archive_cmd =\n \"git --git-dir=\" ^ System.shellEscape bare_repo ^ \" archive \"\n ^ System.shellEscape refe ^ \" | tar -x -C \"\n ^ System.shellEscape tmpdir\n val (status, out, err) = System.command archive_cmd\n val () =\n if OS.Process.isSuccess status then\n ()\n else\n raise Fail\n (\"Failed to extract \" ^ refe ^ \" from \" ^ repo_url ^ \": \"\n ^ err)\n (* Copy the package directory to the target location *)\n val src = tmpdir from_dir\n val () = log (\"copying \" ^ src ^ \" to \" ^ pdir)\n val () = System.createDirectoryIfMissing true pdir\n (* Use cp -r to copy all files *)\n val copy_cmd =\n \"cp -r \" ^ System.shellEscape (src ^ \"/.\") ^ \" \"\n ^ System.shellEscape pdir ^ \"/\"\n val (status3, out3, err3) = System.command copy_cmd\n val () =\n if OS.Process.isSuccess status3 then ()\n else raise Fail (\"Failed to copy package files: \" ^ err3)\n (* Clean up temporary directory on success *)\n val () = log (\"removing temporary directory \" ^ tmpdir)\n val () = System.removePathForcibly tmpdir\n in\n ()\n end\n handle e =>\n ( log (\"removing temporary directory \" ^ tmpdir)\n ; System.removePathForcibly tmpdir\n ; raise e\n )\n end\n val list = M.toList bl\n in\n List.app install list;\n log (Int.toString (length list) ^ \" packages installed\")\n end\n\n val (libDir: filepath, libNewDir: filepath, libOldDir: filepath) =\n (\"lib\", \"lib~new\", \"lib~old\")\n\n (*\n Install the packages listed in the build list in the 'lib'\n directory of the current working directory. Since we are touching\n the file system, we are going to be very paranoid. In particular,\n we want to avoid corrupting the 'lib' directory if something fails\n along the way.\n \n The procedure is as follows:\n \n 1) Create a directory 'lib~new'. Delete an existing 'lib~new' if\n necessary.\n \n 2) Populate 'lib~new' based on the build list.\n \n 3) Rename 'lib' to 'lib~old'. Delete an existing 'lib~old' if\n necessary.\n \n 4) Rename 'lib~new' to 'lib'\n \n 5) If the current package has package path 'p', move 'lib~old/p' to\n 'lib~new/p'.\n \n 6) Delete 'lib~old'.\n \n Since POSIX at least guarantees atomic renames, the only place this\n can fail is between steps 3, 4, and 5. In that case, at least the\n 'lib~old' will still exist and can be put back by the user.\n *)\n\n fun installBuildList (p: pkgpath option) (bl: buildlist) : unit =\n let\n val libdir_exists = System.doesDirExist libDir\n\n val () = System.removePathForcibly libNewDir (* 1 *)\n val () = System.createDirectoryIfMissing false libNewDir\n\n val () = installInDir bl libNewDir (* 2 *)\n\n val () =\n if libdir_exists then (* 3 *)\n ( System.removePathForcibly libOldDir\n ; System.renameDirectory libDir libOldDir\n )\n else\n ()\n\n val () = System.renameDirectory libNewDir libDir (* 4 *)\n\n val () =\n case Option.map Manifest.pkgpathToString p of (* 5 *)\n SOME pfp =>\n if libdir_exists then\n let\n val pkgdir_exists = System.doesDirExist (libOldDir pfp)\n in\n if pkgdir_exists then\n (* Ensure the parent directories exist so that we can move the\n package directory directly. *)\n ( System.createDirectoryIfMissing true\n (System.takeDirectory (libDir pfp))\n ; System.renameDirectory (libOldDir pfp) (libDir pfp)\n )\n else\n ()\n end\n else\n ()\n | NONE => ()\n\n val () =\n if libdir_exists then (* 6 *) System.removePathForcibly libOldDir\n else ()\n in\n ()\n end\n\n fun getPkgManifest () : Manifest.t =\n let\n val smlpkg = smlpkg_filename ()\n in\n if System.doesDirExist smlpkg then\n raise Fail\n (smlpkg ^ \" exists, but it is a directory! What in Odin's beard...\")\n else if System.doesFileExist smlpkg then\n Manifest.fromFile smlpkg\n else\n ( log (smlpkg ^ \" not found - pretending it's empty.\")\n ; Manifest.empty NONE\n )\n end\n\n fun putPkgManifest (m: Manifest.t) : unit =\n System.writeFile (smlpkg_filename ()) (Manifest.toString m)\n\n (* The Command-line interface *)\n\n fun usageMsg s =\n let\n val prog = OS.Path.file (CommandLine.name ())\n in\n print (\"Usage: \" ^ prog ^ \" [--version] [--verbose] [--help] \" ^ s ^ \"\\n\");\n OS.Process.exit (OS.Process.failure)\n end\n\n fun doFmt args =\n case args of\n [] =>\n let\n val smlpkg = smlpkg_filename ()\n val m = Manifest.fromFile smlpkg\n in\n System.writeFile smlpkg (Manifest.toString m)\n end\n | _ => raise Fail \"command 'fmt' expects zero arguments.\"\n\n fun doCheck args =\n case args of\n [] =>\n let\n val m = getPkgManifest ()\n val bl = Solve.solveDeps (Solve.pkgRevDeps m)\n val () = println \"Dependencies chosen:\"\n val () = println (Solve.buildListToString bl)\n in\n case Manifest.package m of\n NONE => ()\n | SOME pkgpath =>\n let\n val pdir = \"lib\" Manifest.pkgpathToString pkgpath\n val pdir_exists = OS.FileSys.isDir pdir\n in\n if pdir_exists then ()\n else raise Fail (\"the directory \" ^ pdir ^ \" does not exist.\")\n end\n end\n | _ => raise Fail \"command 'check' expects zero arguments.\"\n\n fun doSync args =\n case args of\n [] =>\n let\n val m = getPkgManifest ()\n val bl = Solve.solveDeps (Solve.pkgRevDeps m)\n in\n installBuildList (Manifest.package m) bl\n end\n | _ => raise Fail \"command 'sync' expects zero arguments.\"\n\n fun pkgpathParse (s: string) : pkgpath =\n case Manifest.pkgpathFromString s of\n SOME p => p\n | NONE => raise Fail (\"invalid package path '\" ^ s ^ \"'.\")\n\n fun semverParse (s: string) : semver =\n case SemVer.fromString s of\n SOME v => v\n | NONE => raise Fail (\"invalid semantic version '\" ^ s ^ \"'.\")\n\n fun doAdd' (p: pkgpath) (v: semver) : unit =\n let\n val m = getPkgManifest ()\n\n (* See if this package (and its dependencies) even exists. We\n do this by running the solver with the dependencies already\n in the manifest, plus this new one. The Monoid instance\n for PkgRevDeps is left-biased, so we are careful to use the\n new version for this package. *)\n\n val () = ignore (Solve.solveDeps\n (M.add (p, (v, NONE)) (Solve.pkgRevDeps m)))\n\n (* We either replace any existing occurence of package 'p', or\n we add a new one. *)\n val p_info = PkgInfo.lookupPackageRev p v\n val hash_opt =\n case (SemVer.major v, SemVer.minor v, SemVer.patch v) of\n (* We do not perform hash-pinning for\n (0,0,0)-versions, because these already embed a\n specific revision ID into their version number. *)\n (0, 0, 0) => NONE\n | _ => SOME (PkgInfo.pkgRevCommit p_info)\n val req = (p, v, hash_opt)\n val prev_r = Manifest.get_required m p\n val m =\n case prev_r of\n SOME _ =>\n let val m = Manifest.del_required p m\n in Manifest.add_required req m\n end\n | NONE => Manifest.add_required req m\n val () =\n case prev_r of\n SOME prev_r' =>\n if #2 prev_r' = v then\n println\n (\"Package already at version \" ^ SemVer.toString v\n ^ \"; nothing to do.\")\n else\n println\n (\"Replaced \" ^ Manifest.pkgpathToString p ^ \" \"\n ^ SemVer.toString (#2 prev_r') ^ \" => \" ^ SemVer.toString v\n ^ \".\")\n | NONE =>\n println\n (\"Added new required package \" ^ Manifest.pkgpathToString p ^ \" \"\n ^ SemVer.toString v ^ \".\")\n in\n putPkgManifest m;\n println\n (\"Remember to run '\" ^ OS.Path.file (CommandLine.name ()) ^ \" sync'.\")\n end\n\n fun doAdd args : unit =\n case args of\n [p, v] => doAdd' (pkgpathParse p) (semverParse v)\n | [p] => doAdd' (pkgpathParse p) (PkgInfo.lookupNewestRev (pkgpathParse p))\n | _ => raise Fail \"command 'add' expects one or two arguments.\"\n\n fun doRemove args : unit =\n case args of\n [p as ps] =>\n let\n val m = getPkgManifest ()\n val p = pkgpathParse p\n in\n case Manifest.get_required m p of\n SOME r =>\n let\n val m = Manifest.del_required p m\n in\n putPkgManifest m;\n println (\"Removed \" ^ ps ^ \" \" ^ SemVer.toString (#2 r) ^ \".\")\n end\n | NONE =>\n raise Fail\n (\"no package \" ^ ps ^ \" found in \" ^ smlpkg_filename () ^ \".\")\n end\n | _ => raise Fail \"command 'remove' expects one argument.\"\n\n fun doInit args =\n case args of\n [p as ps] =>\n let\n val smlpkg = smlpkg_filename ()\n val () = log \"checking for package file\"\n val () =\n if System.doesFileExist smlpkg then\n raise Fail (smlpkg ^ \" already exists.\")\n else\n ()\n val p = pkgpathParse p\n val () = log \"creating directory 'lib'\"\n val () = System.createDirectoryIfMissing true (\"lib\" ps)\n val () = println (\"Created directory 'lib/\" ^ ps ^ \"'.\")\n val m = Manifest.empty (SOME p)\n in\n putPkgManifest m;\n println (\"Wrote \" ^ smlpkg_filename () ^ \".\")\n end\n | _ => raise Fail \"command 'init' expects one argument.\"\n\n fun doUpgrade args : unit =\n case args of\n [] =>\n let\n fun upgrade (req: required) : required =\n let\n val v = PkgInfo.lookupNewestRev (#1 req)\n val h = PkgInfo.pkgRevCommit (PkgInfo.lookupPackageRev (#1 req) v)\n in\n if v <> (#2 req) then\n ( println\n (\"Upgraded \" ^ Manifest.pkgpathToString (#1 req) ^ \" \"\n ^ SemVer.toString (#2 req) ^ \" => \" ^ SemVer.toString v\n ^ \".\")\n ; (#1 req, v, SOME h)\n )\n else\n req\n end\n val m = getPkgManifest ()\n val rs0 = Manifest.requires m\n val rs = List.map upgrade rs0\n val m = Manifest.replace_requires m rs\n in\n putPkgManifest m;\n (if rs = rs0 then\n println (\"Nothing to upgrade.\")\n else\n println\n (\"Remember to run '\" ^ OS.Path.file (CommandLine.name ())\n ^ \" sync'.\"))\n end\n | _ => raise Fail \"command 'upgrade' expects zero arguments.\"\n\n\n fun doVersions args : unit =\n case args of\n [p] =>\n let\n val p = pkgpathParse p\n val pinfo = PkgInfo.lookupPackage p\n val versions = PkgInfo.pkgVersions pinfo\n in\n List.app (println o SemVer.toString) (M.keys versions)\n end\n | _ => raise Fail \"command 'versions' expects one argument.\"\n\n fun print_prog_version () =\n let val prog = OS.Path.file (CommandLine.name ())\n in println (prog ^ \" \" ^ Version.version ^ \" (\" ^ Version.gitversion ^ \")\")\n end\n\n fun eatFlags args =\n case args of\n arg :: args' =>\n if arg = \"-v\" orelse arg = \"--verbose\" then\n (PkgInfo.verboseFlag := true; eatFlags args')\n else if arg = \"-V\" orelse arg = \"--version\" then\n (print_prog_version (); OS.Process.exit OS.Process.success)\n else\n args\n | nil => args\n\n fun main (pkg_filename: string) : unit =\n let\n val () = Manifest.set_smlpkg_filename pkg_filename\n val smlpkg = smlpkg_filename ()\n val commands =\n [ (\"add\", (doAdd, \"Add another required package to \" ^ smlpkg ^ \".\"))\n , (\"check\", (doCheck, \"Check that \" ^ smlpkg ^ \" is satisfiable.\"))\n , (\"init\", (doInit, \"Create a new \" ^ smlpkg ^ \" and a lib/ skeleton.\"))\n , (\"fmt\", (doFmt, \"Reformat \" ^ smlpkg ^ \".\"))\n , (\"sync\", (doSync, \"Populate lib/ as specified by \" ^ smlpkg ^ \".\"))\n , ( \"remove\"\n , (doRemove, \"Remove a required package from \" ^ smlpkg ^ \".\")\n )\n , (\"upgrade\", (doUpgrade, \"Upgrade all packages to newest versions.\"))\n , (\"versions\", (doVersions, \"List available versions for a package.\"))\n ]\n\n fun look s l =\n Option.map #2 (List.find (fn (k, v) => s = k) l)\n\n fun doUsage () =\n let\n val k = List.foldl Int.max 0 (map (size o #1) commands) + 3\n val msg = String.concatWith \"\\n\"\n ([\" ...:\", \"\", \"Commands:\"]\n @\n map\n (fn (cmd, (_, desc)) =>\n \" \" ^ StringCvt.padRight #\" \" k cmd ^ desc) commands)\n in\n usageMsg msg\n end\n\n fun simpleUsage () =\n usageMsg\n (\"options... <\" ^ String.concatWith \"|\" (map #1 commands) ^ \">\")\n in\n ( case eatFlags (CommandLine.arguments ()) of\n [] => doUsage ()\n | cmd :: args =>\n case look cmd commands of\n SOME (doCmd, doc) =>\n (doCmd args\n handle Fail s =>\n ( println (\"Error: \" ^ s)\n ; PkgInfo.cleanupCache ()\n ; simpleUsage ()\n ))\n | NONE => doUsage ()\n ; PkgInfo.cleanupCache ()\n )\n handle e => (PkgInfo.cleanupCache (); raise e)\n end\n\nend\n" }, { "path": "src/pkginfo.sig", "content": "signature PKG_INFO = sig\n\n type pkgpath = Manifest.pkgpath\n type semver = SemVer.t\n\n type pkg_revinfo\n val pkgRevRepoUrl : pkg_revinfo -> string\n val pkgRevRef : pkg_revinfo -> string\n val pkgRevCommit : pkg_revinfo -> string\n val pkgRevGetManifest : pkg_revinfo -> Manifest.t (* cached access *)\n val pkgRevTime : pkg_revinfo -> Time.time\n\n type pkg_info\n val pkgInfo : pkgpath -> pkg_info (* raw - no caching *)\n val pkgVersions : pkg_info -> (semver,pkg_revinfo) FinMapEq.t\n\n (* Package registry - cached access *)\n val lookupPackage : pkgpath -> pkg_info\n val lookupPackageCommit : pkgpath -> string option -> semver * pkg_revinfo\n val lookupPackageRev : pkgpath -> semver -> pkg_revinfo\n val lookupNewestRev : pkgpath -> semver\n\n (* Cache management *)\n val getCachedRepo : string -> string (* Get cached repository for URL *)\n val cleanupCache : unit -> unit (* Clean up temporary cache directory *)\n\n val verboseFlag : bool ref\nend\n" }, { "path": "src/pkginfo.sml", "content": "structure PkgInfo :> PKG_INFO =\nstruct\n\n structure M = FinMapEq\n\n fun println s =\n print (s ^ \"\\n\")\n\n val verboseFlag = ref false\n fun log s =\n if !verboseFlag then println (\"[\" ^ s ^ \"]\") else ()\n\n type pkgpath = Manifest.pkgpath\n type semver = SemVer.t\n\n type pkg_revinfo =\n { pkgRevRepoUrl: string\n , (* git repository URL *) pkgRevRef: string\n , (* git ref (tag or commit) *) pkgRevCommit: string\n , (* commit id for verification *) pkgRevGetManifest: unit -> Manifest.t\n , pkgRevTime: Time.time\n }\n\n fun pkgRevRepoUrl (r: pkg_revinfo) : string = #pkgRevRepoUrl r\n fun pkgRevRef (r: pkg_revinfo) : string = #pkgRevRef r\n fun pkgRevCommit (r: pkg_revinfo) : string = #pkgRevCommit r\n fun pkgRevGetManifest (r: pkg_revinfo) : Manifest.t = #pkgRevGetManifest r ()\n fun pkgRevTime (r: pkg_revinfo) : Time.time = #pkgRevTime r\n\n type pkg_info =\n { pkgVersions: (semver, pkg_revinfo) M.t\n , pkgLookupCommit: string option -> pkg_revinfo\n }\n\n fun pkgVersions (pinfo: pkg_info) : (semver, pkg_revinfo) M.t =\n #pkgVersions pinfo\n\n fun lookupPkgRev (v: semver) (pi: pkg_info) : pkg_revinfo option =\n M.lookup (pkgVersions pi) v\n\n fun majorRevOfPkg (p: pkgpath) : pkgpath * int list =\n let\n fun mk r = {host = #host p, owner = #owner p, repo = r}\n in\n case String.fields (fn c => c = #\"@\") (#repo p) of\n [r, v] =>\n (case Int.fromString v of\n SOME i =>\n if Int.toString i = v then (mk r, [i])\n else raise Fail \"majorRevOfPkg: expecting integer\"\n | NONE => (mk r, [0, 1]))\n | _ => (p, [0, 1])\n end\n\n (* Utilities *)\n fun gitCmd (opts: string list) : string = (* may raise Fail and print errors on stderr *)\n let\n val cmd = String.concatWith \" \" (\"git\" :: opts)\n (*\n val () = (* Avoid Git asking for credentials. We prefer failure. *)\n setEnv \"GIT_TERMINAL_PROMPT\" \"0\"\n *)\n val (status, out, err) = System.command cmd\n in\n if OS.Process.isSuccess status then\n out\n else\n ( TextIO.output (TextIO.stdErr, err)\n ; raise Fail (\"Failed to execute git command '\" ^ cmd ^ \"'\")\n )\n end\n\n (* Shared temporary directory for all repository clones during this execution *)\n val cacheDir: string option ref = ref NONE\n\n fun getCacheDir () : string =\n case !cacheDir of\n SOME dir => dir\n | NONE =>\n let\n val dir = OS.FileSys.tmpName () ^ \"-smlpkg-cache\"\n val () = if System.doesDirExist dir then () else OS.FileSys.mkDir dir\n val () = log (\"created cache directory \" ^ dir)\n val () = cacheDir := SOME dir\n in\n dir\n end\n\n (* Convert repository URL to a safe directory name *)\n fun repoUrlToDir (repo_url: string) : string =\n let\n fun sanitize #\"/\" = #\"-\"\n | sanitize #\":\" = #\"-\"\n | sanitize #\"@\" = #\"-\"\n | sanitize #\".\" = #\"-\"\n | sanitize c = c\n in\n String.map sanitize repo_url\n end\n\n (* Clone a git repository to the cache directory and return the path.\n If the repository already exists in the cache, reuse it. *)\n fun cloneRepo (repo_url: string) : string =\n let\n infix \n val op = System.\n val cache_dir = getCacheDir ()\n val repo_name = repoUrlToDir repo_url\n val repo_dir = cache_dir repo_name\n in\n if System.doesDirExist repo_dir then\n (log (\"reusing cached repository \" ^ repo_dir); repo_dir)\n else\n ( log (\"cloning repository \" ^ repo_url ^ \" to \" ^ repo_dir)\n ; let\n val cmd =\n \"git clone --bare \" ^ System.shellEscape repo_url ^ \" \"\n ^ System.shellEscape repo_dir\n val (status, out, err) = System.command cmd\n val () =\n if OS.Process.isSuccess status then ()\n else raise Fail (\"Failed to clone \" ^ repo_url ^ \": \" ^ err)\n in\n repo_dir\n end\n )\n end\n\n (* Get the manifest from a git repository at a specific ref *)\n fun getManifestFromRepo (repo_dir: string) (refe: string) : Manifest.t =\n let\n val () = log (\"reading manifest from \" ^ repo_dir ^ \" at \" ^ refe)\n val manifest_file = Manifest.smlpkg_filename ()\n val cmd =\n \"git \" ^ \"--git-dir=\" ^ System.shellEscape repo_dir ^ \" show \"\n ^ System.shellEscape (refe ^ \":\" ^ manifest_file)\n val (status, out, err) = System.command cmd\n val () =\n if OS.Process.isSuccess status then\n ()\n else\n raise Fail\n (\"Failed to read \" ^ manifest_file ^ \" at \" ^ refe ^ \": \" ^ err)\n val path = repo_dir ^ \"/\" ^ refe ^ \"/\" ^ manifest_file\n in\n Manifest.fromString path out\n end\n\n (* Manifest cache to avoid reading the same manifest multiple times *)\n val cache =\n let\n val m: (string * Manifest.t) list ref = ref nil\n in\n fn f =>\n fn repo_dir =>\n fn refe =>\n fn () =>\n let\n val s = repo_dir ^ \"@\" ^ refe\n in\n case List.find (fn (k, _) => k = s) (!m) of\n SOME (_, v) => v\n | NONE =>\n let val v = f repo_dir refe\n in m := (s, v) :: !m; v\n end\n end\n end\n\n (* Create a pkg_revinfo for a specific git ref *)\n fun mkRevInfo (repo_url: string) (repo_dir: string) (refe: string)\n (hash: string) : pkg_revinfo =\n let\n val mc = cache getManifestFromRepo repo_dir refe\n val time = Time.now ()\n val () = log (\"rev info: \" ^ repo_url ^ \" @ \" ^ refe ^ \" (\" ^ hash ^ \")\")\n in\n { pkgRevRepoUrl = repo_url\n , pkgRevRef = refe\n , pkgRevCommit = hash\n , pkgRevGetManifest = mc\n , pkgRevTime = time\n }\n end\n\n (* Get package info from a git repository *)\n fun gitPkgInfo (repo_url: string) (versions: int list) : pkg_info =\n let\n val () = log (\"retrieving list of tags from \" ^ repo_url)\n (* Escape the repository URL before passing it to shell-based helpers *)\n val safe_repo_url = System.shellEscape repo_url\n val remote_lines = gitCmd [\"ls-remote\", safe_repo_url]\n val remote_lines = String.tokens (fn c => c = #\"\\n\") remote_lines\n\n (* Clone the repository once for reading manifests *)\n val repo_dir = cloneRepo repo_url\n\n fun isHeadRef (l: string) : string option =\n case String.tokens Char.isSpace l of\n [hash, \"HEAD\"] => SOME hash\n | _ => NONE\n\n fun revInfo l : (semver * pkg_revinfo) option =\n case String.tokens Char.isSpace l of\n [hash, refe] =>\n (case String.fields (fn s => s = #\"/\") refe of\n [\"refs\", \"tags\", t] =>\n if String.isPrefix \"v\" t then\n (case SemVer.fromString (String.extract (t, 1, NONE)) of\n SOME v =>\n let\n val m = SemVer.major v\n in\n if List.exists (fn i => i = m) versions then\n let val pinfo = mkRevInfo repo_url repo_dir t hash\n in SOME (v, pinfo)\n end\n else\n NONE\n end\n | NONE => NONE)\n else\n NONE\n | _ => NONE)\n | _ => NONE\n in\n case List.mapPartial isHeadRef remote_lines of\n head_ref :: _ =>\n let\n fun def (opt: string option) : string =\n Option.getOpt (opt, head_ref)\n val rev_info = M.fromList_eq (List.mapPartial revInfo remote_lines)\n fun lookupCommit (r: string option) =\n mkRevInfo repo_url repo_dir (def r) (def r)\n in\n {pkgVersions = rev_info, pkgLookupCommit = lookupCommit}\n end\n | _ => raise Fail (\"Cannot find HEAD ref for \" ^ repo_url)\n end\n\n (* Retrieve information about a package based on its package path.\n This uses Semantic Import Versioning when interacting with\n repositories. For example, a package @github.com/user/repo@ will\n match version 0.* or 1.* tags only, a package\n @github.com/user/repo/v2@ will match 2.* tags, and so forth..\n *)\n\n (* Construct repository URL from package path *)\n fun pkgpathToRepoUrl (p: pkgpath) : string =\n let\n val (p', _) = majorRevOfPkg p\n val base = \"https://\" ^ #host p ^ \"/\" ^ #owner p ^ \"/\" ^ #repo p'\n in\n case #host p of\n \"gitlab.com\" => base ^ \".git\"\n | _ => base (* Works for github.com and most other git hosts *)\n end\n\n (* Raw access - limited caching *)\n\n fun pkgInfo (p: pkgpath) : pkg_info =\n let\n val repo_url = pkgpathToRepoUrl p\n val (_, vs) = majorRevOfPkg p\n in\n gitPkgInfo repo_url vs\n end\n\n (* Cached access *)\n\n local val registry: (pkgpath, pkg_info) M.t ref = ref (M.empty_eq ())\n in\n fun lookupPackage (p: pkgpath) : pkg_info =\n case M.lookup (!registry) p of\n SOME i => i\n | NONE =>\n let val i = pkgInfo p\n in registry := M.add (p, i) (!registry); i\n end\n\n fun lookupPackageCommit (p: pkgpath) (refe: string option) :\n semver * pkg_revinfo =\n let\n val pinfo = lookupPackage p\n val rev_info = #pkgLookupCommit pinfo refe\n val timestamp = Date.fmt \"%Y%m%d%H%M%S\"\n (Date.fromTimeLocal (pkgRevTime rev_info))\n val v =\n case Manifest.commitVersion timestamp (pkgRevCommit rev_info) of\n NONE => raise Fail \"impossible: failed to form valid commit version\"\n | SOME v => v\n val pinfo' =\n { pkgLookupCommit = #pkgLookupCommit pinfo\n , pkgVersions = M.add (v, rev_info) (pkgVersions pinfo)\n }\n val () = registry := M.add (p, pinfo') (!registry)\n in\n (v, rev_info)\n end\n\n (* Look up information about a specific version of a package. *)\n fun lookupPackageRev (p: pkgpath) (v: semver) : pkg_revinfo =\n case Manifest.isCommitVersion v of\n SOME commit => #2 (lookupPackageCommit p (SOME commit))\n | NONE =>\n let\n val pinfo = lookupPackage p\n in\n case lookupPkgRev v pinfo of\n NONE =>\n let\n val versions =\n case M.keys (pkgVersions pinfo) of\n [] =>\n (\"Package \" ^ Manifest.pkgpathToString p\n ^ \" has no versions. Invalid package path?\")\n | ks =>\n (\"Known versions: \"\n ^ String.concatWith \", \" (map SemVer.toString ks))\n val (_, vs) = majorRevOfPkg p\n val major =\n if List.exists (fn x => x = SemVer.major v) vs then\n \"\"\n else\n (\"\\nFor major version \" ^ Int.toString (SemVer.major v)\n ^ \", use package path \" ^ Manifest.pkgpathToString p\n ^ \"@\" ^ Int.toString (SemVer.major v))\n in\n raise Fail\n (\"package \" ^ Manifest.pkgpathToString p\n ^ \" does not have a version \" ^ SemVer.toString v ^ \".\\n\"\n ^ versions ^ major)\n end\n | SOME v' => v'\n end\n\n (* Find the newest version of a package. *)\n fun lookupNewestRev (p: pkgpath) : semver =\n let\n val pinfo = lookupPackage p\n in\n case M.keys (pkgVersions pinfo) of\n [] =>\n ( log\n (\"package \" ^ Manifest.pkgpathToString p\n ^ \" has no released versions. Using HEAD.\")\n ; #1 (lookupPackageCommit p NONE)\n )\n | v :: vs =>\n let\n fun max (v1, v2) =\n if SemVer.< (v1, v2) then v2 else v1\n in\n log \"finding newest version of packages\";\n List.foldl max v\n vs (* memo: what about versions of\n * equal priority - should we use\n * foldr? *)\n end\n end\n end\n\n (* Cache management functions *)\n fun getCachedRepo (repo_url: string) : string = cloneRepo repo_url\n\n fun cleanupCache () : unit =\n case !cacheDir of\n NONE => ()\n | SOME dir =>\n ( log (\"cleaning up cache directory \" ^ dir)\n ; System.removePathForcibly dir\n ; cacheDir := NONE\n )\nend\n" }, { "path": "src/semver/.gitignore", "content": "MLB\n*.exe" }, { "path": "src/semver/Makefile", "content": "MLCOMP ?= mlkit\n\n.PHONY: test\ntest:\n\t$(MLCOMP) -output test.exe test.mlb\n\t./test.exe\n\n.PHONY: clean\nclean:\n\trm -rf *~ MLB run *.exe\n" }, { "path": "src/semver/semver.mlb", "content": "local $(SML_LIB)/basis/basis.mlb\nin semver.sig\n semver.sml\nend\n" }, { "path": "src/semver/semver.sig", "content": "(* Semantic versioning; see https://semver.org/ *)\n\nsignature SEMVER = sig\n\n datatype id = NUMID of IntInf.int | ALPHAID of string\n val idToString : id -> string\n val idsToString : id list -> string\n\n eqtype t\n val fromString : string -> t option\n val toString : t -> string\n\n val < : t * t -> bool\n\n val major : t -> int\n val minor : t -> int\n val patch : t -> int\n val prerel : t -> id list\n val build : t -> id list\nend\n" }, { "path": "src/semver/semver.sml", "content": "(* Semantic versioning; see https://semver.org/ *)\n\nstructure SemVer :> SEMVER = struct\n\ndatatype id = NUMID of IntInf.int | ALPHAID of string\n\ntype t = {major : int,\n minor : int,\n patch : int,\n prerel : id list,\n build : id list}\n\nfun idToString (NUMID i) = IntInf.toString i\n | idToString (ALPHAID s) = s\n\nfun idsToString ids =\n String.concatWith \".\" (map idToString ids)\n\nfun toString ({major,minor,patch,prerel,build}:t) : string =\n Int.toString major ^ \".\" ^\n Int.toString minor ^ \".\" ^\n Int.toString patch ^\n (case prerel of\n nil => \"\"\n | ids => \"-\" ^ idsToString ids) ^\n (case build of\n nil => \"\"\n | ids => \"+\" ^ idsToString ids)\n\nfun fromString (s: string) : t option =\n let fun parseAlphaId s : id =\n if String.size s > 0 andalso\n CharVector.all (fn c => c = #\"-\" orelse Char.isDigit c orelse Char.isLower c\n orelse Char.isUpper c) s\n then ALPHAID s\n else raise Fail (\"expecting alpha-id - got \" ^ s)\n fun parseId s : id =\n case IntInf.fromString s of\n SOME n => if n > 0 andalso IntInf.toString n = s then NUMID n\n else parseAlphaId s\n | NONE => parseAlphaId s\n fun parseIds (s:string) : id list =\n if s = \"\" then nil\n else map parseId (String.fields (fn c => c = #\".\") s)\n val (prebuild : string, build : id list) =\n case String.fields (fn c => c = #\"+\") s of\n [a,b] => (a,parseIds b)\n | [a] => (a,nil)\n | _ => raise Fail \"expecting at most one +\"\n val (pre : string, prerel : id list) =\n case String.fields (fn c => c = #\"-\") prebuild of\n pre::rest => (pre,parseIds (String.concatWith \"-\" rest))\n | _ => raise Fail \"impossible\"\n val (major,minor,patch) =\n case map Int.fromString (String.fields (fn c => c = #\".\") pre) of\n [SOME ma,SOME mi,SOME pa] =>\n if ma >= 0 andalso mi >= 0 andalso pa >= 0 andalso\n Int.toString ma ^ \".\" ^ Int.toString mi ^ \".\" ^ Int.toString pa = pre\n then (ma,mi,pa)\n else raise Fail \"misformed major.minor.patch specification\"\n | _ => raise Fail \"too many dots\"\n in SOME {major=major,\n minor=minor,\n patch=patch,\n prerel=prerel,\n build=build}\n end handle Fail _ => NONE\n\nfun major (t:t) : int = #major t\nfun minor (t:t) : int = #minor t\nfun patch (t:t) : int = #patch t\nfun prerel (t:t) : id list = #prerel t\nfun build (t:t) : id list = #build t\n\nfun idLt (id1:id, id2:id) : bool =\n case (id1, id2) of\n (NUMID id1, NUMID id2) => id1 < id2\n | (NUMID _, _) => true\n | (_, NUMID _) => false\n | (ALPHAID s1, ALPHAID s2) => s1 < s2\n\nfun idsLt (nil, _) = false\n | idsLt (_, nil) = true\n | idsLt (ids1: id list, ids2: id list) : bool =\n let fun lt (ids1,ids2) =\n case (ids1,ids2) of\n (nil, nil) => false\n | (nil, _) => true\n | (id1::ids1,id2::ids2) =>\n idLt(id1,id2) orelse\n (id1 = id2 andalso lt(ids1,ids2))\n | _ => false\n in lt (ids1,ids2)\n end\n\nval op < : t * t -> bool =\n fn (t1,t2) =>\n major t1 < major t2 orelse\n (major t1 = major t2 andalso\n (minor t1 < minor t2 orelse\n (minor t1 = minor t2 andalso\n (patch t1 < patch t2 orelse\n (patch t1 = patch t2 andalso\n (idsLt(prerel t1, prerel t2)))))))\nend\n" }, { "path": "src/semver/test.mlb", "content": "local $(SML_LIB)/basis/basis.mlb\n semver.mlb\nin test.sml\nend\n" }, { "path": "src/semver/test.sml", "content": "\nopen SemVer\n\nfun test s b =\n if b then print (\"OK : \" ^ s ^ \"\\n\")\n else print (\"ERR: \" ^ s ^ \"\\n\")\n\nfun testf s f =\n (if f() then print (\"OK : \" ^ s ^ \"\\n\")\n else print (\"ERR: \" ^ s ^ \"\\n\"))\n handle Fail e => print (\"EXN: \" ^ s ^ \" raised Fail \\\"\" ^ e ^ \"\\\"\\n\")\n | Overflow => print (\"EXN: \" ^ s ^ \" raised Overflow\\n\")\n\nfun test_major_minor_patch s (z,a,b) =\n let val () = test (\"major0\" ^ s) (Option.map major (fromString z) = SOME 0)\n val () = test (\"major1\" ^ s) (Option.map major (fromString a) = SOME 3)\n val () = test (\"major2\" ^ s) (Option.map major (fromString b) = SOME 10)\n val () = test (\"minor0\" ^ s) (Option.map minor (fromString z) = SOME 0)\n val () = test (\"minor1\" ^ s) (Option.map minor (fromString a) = SOME 2)\n val () = test (\"minor2\" ^ s) (Option.map minor (fromString b) = SOME 40)\n val () = test (\"patch0\" ^ s) (Option.map patch (fromString z) = SOME 0)\n val () = test (\"patch1\" ^ s) (Option.map patch (fromString a) = SOME 1)\n val () = test (\"patch2\" ^ s) (Option.map patch (fromString b) = SOME 121)\n val () = test (\"patch0\" ^ s) (Option.map patch (fromString z) = SOME 0)\n val () = test (\"patch1\" ^ s) (Option.map patch (fromString a) = SOME 1)\n val () = test (\"patch2\" ^ s) (Option.map patch (fromString b) = SOME 121)\n in ()\n end\n\nval z = \"0.0.0\"\nval a = \"3.2.1\"\nval b = \"10.40.121\"\n\nval zp = \"0.0.0-a2\"\nval ap = \"3.2.1-23.a23\"\nval bp = \"10.40.121-yt.43.re-s\"\n\nval zpb = \"0.0.0-a2+dfd34\"\nval apb = \"3.2.1-23.a23+23.23.4f\"\nval bpb = \"10.40.121-yt.43.re-s+er23.34\"\n\nval zb = \"0.0.0+dfd34\"\nval ab = \"3.2.1+23.23.4f\"\nval bb = \"10.40.121+er23.34\"\n\nval () = test_major_minor_patch \"\" (z,a,b)\nval () = test_major_minor_patch \"p\" (zp,ap,bp)\nval () = test_major_minor_patch \"b\" (zb,ab,bb)\nval () = test_major_minor_patch \"pb\" (zpb,apb,bpb)\n\nfun test_toString s (z,a,b) =\n let val () = test (\"toString.z\"^s) (Option.map toString (fromString z) = SOME z)\n val () = test (\"toString.a\"^s) (Option.map toString (fromString a) = SOME a)\n val () = test (\"toString.b\"^s) (Option.map toString (fromString b) = SOME b)\n in ()\n end\n\nval () = test_toString \"\" (z,a,b)\nval () = test_toString \"p\" (zp,ap,bp)\nval () = test_toString \"pb\" (zpb,apb,bpb)\nval () = test_toString \"b\" (zb,ab,bb)\n\nfun test_prerel_empty s (z,a,b) =\n let val () = test (\"prerel0\"^s) (Option.map prerel (fromString z) = SOME [])\n val () = test (\"prerel1\"^s) (Option.map prerel (fromString a) = SOME [])\n val () = test (\"prerel2\"^s) (Option.map prerel (fromString b) = SOME [])\n in ()\n end\n\nval () = test_prerel_empty \"\" (z,a,b)\nval () = test_prerel_empty \"b\" (zb,ab,bb)\n\nfun test_prerel s (zp,ap,bp) =\n let val () = test (\"prerel0p\" ^ s) (Option.map prerel (fromString zp) = SOME [ALPHAID \"a2\"])\n val () = test (\"prerel1p\" ^ s) (Option.map prerel (fromString ap) = SOME [NUMID 23,ALPHAID\"a23\"])\n val () = test (\"prerel2p\" ^ s) (Option.map prerel (fromString bp) = SOME [ALPHAID\"yt\",NUMID 43,ALPHAID\"re-s\"])\n in ()\n end\n\nval () = test_prerel \"\" (zp,ap,bp)\nval () = test_prerel \"b\" (zpb,apb,bpb)\n\nfun lt (s1,s2) =\n case (fromString s1, fromString s2) of\n (SOME a, SOME b) => a < b\n | _ => false\n\nfun notlt (s1,s2) =\n case (fromString s1, fromString s2) of\n (SOME a, SOME b) => not(a < b)\n | _ => false\n\nval () = test \"lt_major0\" (lt(\"0.1.0\",\"1.2.0\") andalso notlt(\"1.2.0\",\"0.1.0\"))\nval () = test \"lt_major1\" (lt(\"9.1.0\",\"10.2.0\") andalso notlt(\"10.2.0\",\"9.1.0\"))\nval () = test \"lt_major2\" (notlt(\"1.2.0\",\"1.2.0\"))\nval () = test \"lt_major3\" (notlt(\"20.2.0\",\"3.2.0\") andalso lt(\"3.2.0\",\"20.2.0\"))\n\nval () = test \"lt_minor0\" (lt(\"1.1.0\",\"1.2.0\") andalso notlt(\"1.2.0\",\"1.1.0\"))\nval () = test \"lt_minor1\" (lt(\"10.9.0\",\"10.12.0\") andalso notlt(\"10.12.0\",\"10.9.0\"))\nval () = test \"lt_minor2\" (notlt(\"1.2.0\",\"1.1.0\") andalso lt(\"1.1.0\",\"1.2.0\"))\nval () = test \"lt_minor3\" (notlt(\"2.20.0\",\"2.8.0\") andalso lt(\"2.8.0\",\"2.20.0\"))\n\nval () = test \"lt_patch0\" (lt(\"1.1.0\",\"1.1.2\") andalso notlt(\"1.1.2\",\"1.1.0\"))\nval () = test \"lt_patch1\" (lt(\"10.9.2\",\"10.9.12\") andalso notlt(\"10.9.12\",\"10.9.2\"))\nval () = test \"lt_patch2\" (notlt(\"1.1.2\",\"1.1.2\"))\nval () = test \"lt_patch3\" (notlt(\"10.9.12\",\"10.9.8\") andalso lt(\"10.9.8\",\"10.9.12\"))\n\nval () = test \"lt1\" (lt(\"1.0.0\",\"2.0.0\") andalso lt(\"2.0.0\",\"2.1.0\")\n andalso lt(\"2.1.0\",\"2.1.1\"))\n\nval () = test \"lt2\" (lt(\"1.0.0-alpha\",\"1.0.0\") andalso notlt(\"1.0.0\",\"1.0.0-alpha\"))\n\nval () = test \"lt3\" (lt(\"1.0.0-alpha\",\"1.0.0-alpha.1\") andalso notlt(\"1.0.0-alpha.1\",\"1.0.0-alpha\"))\n\nval () = test \"lt4\" (lt(\"1.0.0-alpha.1\",\"1.0.0-alpha.beta\") andalso notlt(\"1.0.0-alpha.beta\",\"1.0.0-alpha.1\"))\nval () = test \"lt5\" (lt(\"1.0.0-alpha.beta\",\"1.0.0-beta\"))\nval () = test \"lt6\" (lt(\"1.0.0-beta\",\"1.0.0-beta.2\"))\nval () = test \"lt7\" (lt(\"1.0.0-beta.2\",\"1.0.0-beta.11\"))\nval () = test \"lt8\" (lt(\"1.0.0-beta.11\",\"1.0.0-rc.1\"))\nval () = test \"lt9\" (lt(\"1.0.0-rc.1\",\"1.0.0\"))\n\nfun testerr s v = test s (fromString s = NONE)\n\nval () = testerr \"majorerr1\" \"0a.1.2\"\nval () = testerr \"majorerr2\" \"a0.1.2\"\n\nval () = testerr \"minorerr1\" \"0.1a.2\"\nval () = testerr \"minorerr2\" \"0.a1.2\"\n\nval () = testerr \"patcherr1\" \"0.1.2a\"\nval () = testerr \"patcherr2\" \"0.1.a2\"\n\nval () = testerr \"prerelerr1\" \"0.1.2-s*\"\nval () = testerr \"prerelerr2\" \"0.1.2-*s\"\n\nval () = testerr \"prerelerr1\" \"0.1.2-ssd+*l\"\nval () = testerr \"prerelerr2\" \"0.1.2-ssd+s*\"\n\nval () = testf \"ovf\" (fn () =>\n let val t = fromString \"0.0.0-20180801102532+b70028521e4dbcc286834b32ce82c1d2721a6209\"\n in Option.map major t = SOME 0\n end)\n" }, { "path": "src/smlpkg.mlb", "content": "pkg.mlb\nsmlpkg.sml\n" }, { "path": "src/smlpkg.sml", "content": "\nval () = Pkg.main \"sml.pkg\"\n" }, { "path": "src/solve/.gitignore", "content": "MLB\n*.exe" }, { "path": "src/solve/Makefile", "content": "MLCOMP ?= mlkit\n\n.PHONY: test\ntest:\n\t$(MLCOMP) -output test.exe test.mlb\n\t./test.exe\n\n.PHONY: clean\nclean:\n\trm -rf *~ MLB run *.exe\n" }, { "path": "src/solve/solve.sig", "content": "signature SOLVE = sig\n\n type pkgpath = Manifest.pkgpath\n type semver = SemVer.t\n type buildlist = (pkgpath,semver) FinMapEq.t\n type hash = string\n\n type pkg_rev_deps = (pkgpath,(semver*hash option)) FinMapEq.t\n\n val pkgRevDeps : Manifest.t -> pkg_rev_deps\n val solveDeps : pkg_rev_deps -> buildlist\n\n val buildListToString : buildlist -> string\nend\n" }, { "path": "src/solve/solve.sml", "content": "functor Solve (PI :\n sig\n type pkg_revinfo\n val lookupPackageRev : Manifest.pkgpath -> SemVer.t -> pkg_revinfo\n val pkgRevGetManifest : pkg_revinfo -> Manifest.t\n val pkgRevCommit : pkg_revinfo -> string\n end) : SOLVE =\nstruct\n\nstructure M = FinMapEq\ntype pkgpath = Manifest.pkgpath\ntype semver = SemVer.t\ntype hash = string\ntype pkg_rev_deps = (pkgpath,(semver*hash option))M.t\ntype buildlist = (pkgpath,semver) M.t\n\nfun fail s = raise Fail s\n\nfun insert (nil,y) = [y]\n | insert (x::xs,y) = if x=y then x::xs else x::insert(xs,y)\nfun merge (xs,nil) = xs\n | merge (xs,y::ys) = merge(insert(xs,y),ys)\n\nfun solve (ps:pkgpath list) (d: pkg_rev_deps) : pkg_rev_deps =\n case ps of\n nil => d\n | p::ps =>\n case M.lookup d p of\n SOME (v,hopt) =>\n let val m = PI.pkgRevGetManifest (PI.lookupPackageRev p v)\n val rs = List.filter (fn (p,v,hopt) =>\n case M.lookup d p of\n SOME (v',hopt') => SemVer.<(v',v)\n | NONE => true)\n (Manifest.requires m)\n val d = List.foldl (fn ((p,v,hopt),d) => M.add (p,(v,hopt)) d) d rs\n in solve (merge(ps,map #1 rs)) d\n end\n | NONE =>\n fail \"solve internal error - missing pkgpath in dependency map.\"\n\nfun prune (ps:pkgpath list) (d:pkg_rev_deps) (bl:buildlist) : buildlist =\n case ps of\n nil => bl\n | p::ps =>\n case M.lookup d p of\n SOME (v,hopt) =>\n let val ri = PI.lookupPackageRev p v\n val () = case hopt of\n SOME h =>\n if h = PI.pkgRevCommit ri then ()\n else fail (\"Package \" ^ Manifest.pkgpathToString p ^\n \" \" ^ SemVer.toString v ^\n \" has commit hash \" ^ PI.pkgRevCommit ri ^\n \", but expected \" ^ h ^ \" from package manifest.\")\n | NONE => ()\n val m = PI.pkgRevGetManifest ri\n val ps' = List.filter (fn p => case M.lookup bl p of\n SOME _ => false\n | NONE => true)\n (map #1 (Manifest.requires m))\n in prune (merge(ps',ps)) d (M.add (p,v) bl)\n end\n | NONE =>\n fail \"prune internal error - missing pkgpath in dependency map.\"\n\nfun solveDeps (d: pkg_rev_deps) : buildlist =\n let val roots = M.keys d\n val d = solve roots d (* gradually solve dependencies *)\n in prune roots d (M.empty_eq()) (* prune packages that are no longer\n * in the transitive dependencies *)\n end\n\nfun pkgRevDeps (m:Manifest.t) : pkg_rev_deps =\n List.foldr (fn ((p,v,h),t) => M.add (p,(v,h)) t)\n (M.empty_eq()) (Manifest.requires m)\n\nfun buildListToString (bl: buildlist) : string =\n M.toString (Manifest.pkgpathToString, SemVer.toString) bl\n\n\nend\n" }, { "path": "src/solve/test.mlb", "content": "local $(SML_LIB)/basis/basis.mlb\n ../semver/semver.mlb\n ../manifest/manifest.mlb\n ../util/util.mlb\n solve.sig\n solve.sml\nin test.sml\nend\n" }, { "path": "src/solve/test.sml", "content": "\nfun println s = print (s ^ \"\\n\")\n\nval () = println \"Testing Solve\"\n\nfun test s f =\n (if f() then print (\"OK : \" ^ s ^ \"\\n\")\n else print (\"ERR: \" ^ s ^ \"\\n\"))\n handle Fail e => print (\"EXN: \" ^ s ^ \" raised Fail \\\"\" ^ e ^ \"\\\"\\n\")\n\nfun no_version p v =\n raise Fail (\"cannot find version \" ^ v ^ \" for package \" ^ p ^ \".\")\n\n(* m_repo10_0_1_X : leaf package with no requirements *)\nval m_repo10_0_1_0 =\n Manifest.fromString \"m_repo10_0_1_0.pkg\"\n \"package github.com/owner1/repo10 require {}\"\n\nval m_repo10_0_1_1 =\n Manifest.fromString \"m_repo10_0_1_1.pkg\"\n \"package github.com/owner1/repo10 require {}\"\n\n(* m_repo20_0_2_0 : package with repo10_0_1_0 requirement *)\nval m_repo20_0_2_0 =\n Manifest.fromString \"m_repo20_0_2_0.pkg\"\n \"package github.com/owner2/repo20 require { github.com/owner1/repo10 0.1.0 }\"\n\n(* m_repo20_0_2_1 : package with repo10_0_1_1 requirement *)\nval m_repo20_0_2_1 =\n Manifest.fromString \"m_repo20_0_2_1.pkg\"\n \"package github.com/owner2/repo20 require { github.com/owner1/repo10 0.1.1 }\"\n\n(* m_repo30_0_3_0 : package with repo20_0_2_0 requirement and repo10_0_1_0 requirement *)\nval m_repo30_0_3_0 =\n Manifest.fromString \"m_repo30_0_3_0.pkg\"\n \"package github.com/owner3/repo30 require { github.com/owner1/repo10 0.1.0 github.com/owner2/repo20 0.2.0 }\"\n\n(* m_repo30_0_3_1 : package with repo20_0_2_1 requirement and repo10_0_1_0 requirement *)\nval m_repo30_0_3_1 =\n Manifest.fromString \"m_repo30_0_3_1.pkg\"\n \"package github.com/owner3/repo30 require { github.com/owner1/repo10 0.1.0 github.com/owner2/repo20 0.2.1 }\"\n\nstructure PkgInfoMock = struct\ntype pkg_revinfo = Manifest.t * string\n\nfun lookupPackageRev p v =\n case Manifest.pkgpathToString p of\n p as \"github.com/owner1/repo10\" =>\n (case SemVer.toString v of\n \"0.1.0\" => (m_repo10_0_1_0, \"m_repo10_0_1_0\")\n | \"0.1.1\" => (m_repo10_0_1_1, \"m_repo10_0_1_1\")\n | v => no_version p v)\n | p as \"github.com/owner2/repo20\" =>\n (case SemVer.toString v of\n \"0.2.0\" => (m_repo20_0_2_0, \"m_repo20_0_2_0\")\n | \"0.2.1\" => (m_repo20_0_2_1, \"m_repo20_0_2_1\")\n | v => no_version p v)\n | p as \"github.com/owner3/repo30\" =>\n (case SemVer.toString v of\n \"0.3.0\" => (m_repo30_0_3_0, \"m_repo30_0_3_0\")\n | \"0.3.1\" => (m_repo30_0_3_1, \"m_repo30_0_3_1\")\n | v => no_version p v)\n | p => raise Fail (\"no package \" ^ p)\n\nfun pkgRevGetManifest (pr:pkg_revinfo) : Manifest.t = #1 pr\nfun pkgRevCommit (pr:pkg_revinfo) : string = #2 pr\nend\n\nstructure Solve = Solve (PkgInfoMock)\n\nfun solveManifest (m:Manifest.t) : string =\n let val d = Solve.pkgRevDeps m\n val bl = Solve.solveDeps d\n in Solve.buildListToString bl\n end\n\nval () = test \"solve1\" (fn () => solveManifest m_repo10_0_1_0 = \"{}\")\n\nval () = test \"solve2\" (fn () =>\n let val res = solveManifest m_repo20_0_2_0\n val () = println (\" result = \" ^ res)\n in res = \"{github.com/owner1/repo10:0.1.0}\"\n end)\n\nval () = test \"solve3\" (fn () =>\n let val res = solveManifest m_repo20_0_2_1\n val () = println (\" result = \" ^ res)\n in res = \"{github.com/owner1/repo10:0.1.1}\"\n end)\n\nval () = test \"solve4\" (fn () =>\n let val res = solveManifest m_repo30_0_3_0\n val () = println (\" result = \" ^ res)\n in res = \"{github.com/owner2/repo20:0.2.0,github.com/owner1/repo10:0.1.0}\"\n end)\n\nval () = test \"solve5\" (fn () =>\n let val res = solveManifest m_repo30_0_3_1\n val () = println (\" result = \" ^ res)\n in res = \"{github.com/owner2/repo20:0.2.1,github.com/owner1/repo10:0.1.1}\"\n end)\n" }, { "path": "src/test/.gitignore", "content": "*.out\n*.res\n*~\nMLB" }, { "path": "src/test/Makefile", "content": "\n.PHONY: test\ntest: test1.res test2.res test3.res\n\tcat $^\n\n# -------------------------------\n# The test cases\n# -------------------------------\n\n# test1 - result to be compared with futhark.pkg.test1.ok\nfuthark.pkg.test1.out: ../futpkg\n\t$(MAKE) smallclean\n\t../futpkg -v init github.com/melsman/test\n\t../futpkg -v add github.com/melsman/segmented 0.1.0\n\tmv futhark.pkg $@\n\n# test2\nfuthark.pkg.test2.out: ../futpkg\n\t$(MAKE) smallclean\n\t../futpkg -v init github.com/melsman/test\n\t../futpkg -v add github.com/melsman/segmented 0.1.0\n\t../futpkg -v add github.com/athas/fut-baz 0.2.0\n\t../futpkg -v fmt\n\tmv futhark.pkg $@\n\n# test3\nfuthark.pkg.test3.out: ../futpkg\n\t$(MAKE) smallclean\n\t../futpkg -v init github.com/melsman/test\n\t../futpkg -v add github.com/melsman/segmented 0.1.0\n\t../futpkg -v add github.com/athas/fut-baz 0.2.0\n\t../futpkg -v remove github.com/melsman/segmented\n\tmv futhark.pkg $@\n\n# -------------------------------\n# The generic test tooling\n# -------------------------------\n\n%.res: futhark.pkg.%.out\n\t@(diff -aq $< futhark.pkg.$*.ok > /dev/null 2>&1; \\\n if [ $$? -eq 0 ]; then \\\n echo \"OK: $*\" > $@ \\\n ; else \\\n if [ -e $<.ok ]; then \\\n echo \"ERR: $* - file $< differs from futhark.pkg.$*.ok\"; \\\n echo \"ERR: $* - file $< differs from futhark.pkg.$*.ok\" > $@ \\\n ; else \\\n echo \"ERR: $* - file futhark.pkg.$*.ok does not exist\"; \\\n echo \"ERR: $* - file futhark.pkg.$*.ok does not exist\" > $@ \\\n ; fi \\\n ; exit 1 \\\n ;fi)\n\n../futpkg:\n\t$(MAKE) -C .. all\n\n.PHONY: smallclean\nsmallclean:\n\trm -rf *~ lib futhark.pkg sml.pkg\n\n.PHONY: clean\nclean:\n\trm -rf *~ lib futhark.pkg sml.pkg *.res *.out\n" }, { "path": "src/test/futhark.pkg.test1.ok", "content": "package github.com/melsman/test\n\nrequire {\n github.com/melsman/segmented 0.1.0 #2f06da7b048cc45cad89a0829012a63ab639d361\n}\n" }, { "path": "src/test/futhark.pkg.test2.ok", "content": "package github.com/melsman/test\n\nrequire {\n github.com/melsman/segmented 0.1.0 #2f06da7b048cc45cad89a0829012a63ab639d361\n github.com/athas/fut-baz 0.2.0 #44da85224224d37803976c1d30cedb1d2cd20b74\n}\n" }, { "path": "src/test/futhark.pkg.test3.ok", "content": "package github.com/melsman/test\n\nrequire {\n github.com/athas/fut-baz 0.2.0 #44da85224224d37803976c1d30cedb1d2cd20b74\n}\n" }, { "path": "src/util/.gitignore", "content": "MLB\n*.exe" }, { "path": "src/util/Makefile", "content": "MLCOMP ?= mlkit\n\n.PHONY: test\ntest:\n\t$(MLCOMP) -output test.exe test.mlb\n\t./test.exe\n\n.PHONY: clean\nclean:\n\trm -rf *~ MLB run *.exe\n" }, { "path": "src/util/finmapeq.sig", "content": "signature FINMAP_EQ = sig\n type ('a,'b) t\n val empty : ('a*'a -> bool) -> ('a,'b)t\n val empty_eq : unit -> (''a,'b)t\n val lookup : ('a,'b)t -> 'a -> 'b option\n val add : 'a*'b -> ('a,'b)t -> ('a,'b)t\n val fold : ('b*'c -> 'c) -> 'c -> ('a,'b)t -> 'c\n val Fold : (('a*'b)*'c -> 'c) -> 'c -> ('a,'b)t -> 'c\n val toString : ('a -> string) * ('b -> string) -> ('a,'b)t -> string\n\n val fromList : ('a*'a->bool) -> ('a*'b)list -> ('a,'b)t\n val fromList_eq : (''a*'b)list -> (''a,'b)t\n\n val keys : ('a,'b)t -> 'a list\n\n val toList : ('a,'b)t -> ('a*'b)list\nend\n" }, { "path": "src/util/finmapeq.sml", "content": "structure FinMapEq :> FINMAP_EQ = struct\n type ('a,'b) t = {m: ('a*'b) list, eq: 'a*'a->bool}\n\n fun empty (eq: 'a * 'a -> bool) : ('a,'b)t = {m=nil,eq=eq}\n\n fun empty_eq () : (''a,'b)t = empty (op =)\n\n fun lookup (t: ('a,'b)t) (k:'a) : 'b option =\n Option.map (#2) (List.find (fn (q,_) => #eq t(k,q)) (#m t))\n\n fun rem (k:'a) (t:('a,'b)t) : ('a,'b)t =\n {eq= #eq t, m=List.filter (fn (q,_) => not(#eq t(q,k))) (#m t)}\n\n fun add (k,v) (t:('a,'b)t) : ('a,'b)t =\n let val t = rem k t\n in {eq= #eq t, m= (k,v) :: (#m t)}\n end\n\n fun fold (f : 'b*'c -> 'c) (acc:'c) (t:('a,'b)t) : 'c =\n List.foldr (fn ((_,v),a) => f(v,a)) acc (#m t)\n\n fun Fold (f : ('a*'b)*'c -> 'c) (acc:'c) (t:('a,'b)t) : 'c =\n List.foldr (fn (p,a) => f(p,a)) acc (#m t)\n\n fun toString (pd: 'a -> string, pr :'b -> string) (t:('a,'b)t) :string =\n \"{\" ^\n String.concatWith \",\" (Fold (fn ((a,b),c) => (pd a ^ \":\" ^ pr b) :: c) nil t) ^\n \"}\"\n\n fun fromList (eq:'a*'a->bool) (l:('a*'b)list) : ('a,'b)t =\n List.foldr (fn ((a,b),m) => add (a,b) m) (empty eq) l\n\n fun fromList_eq (l:(''a*'b)list) : (''a,'b)t =\n fromList (op =) l\n\n fun keys (t:('a,'b)t) : 'a list =\n List.map #1 (#m t)\n\n fun toList (t:('a,'b)t) : ('a*'b)list = #m t\nend\n" }, { "path": "src/util/system.sig", "content": "\nsignature SYSTEM = sig\n\n type path = string\n type filepath = path\n type dirpath = path\n\n val readFile : filepath -> string\n val writeFile : filepath -> string -> unit\n\n val readFileBin : filepath -> Word8Vector.vector\n val writeFileBin : filepath -> Word8Vector.vector -> unit\n\n val command : string -> OS.Process.status * string * string\n val shellEscape : string -> string\n\n val splitPath : path -> string list\n val createDirectoryIfMissing : bool -> dirpath -> unit\n val hasTrailingPathSeparator : path -> bool\n\n val makeRelative : dirpath -> path -> string (* for relative paths only *)\n\n val doesFileExist : path -> bool (* also returns true if path is a directory *)\n val doesDirExist : dirpath -> bool\n\n val removePathForcibly : path -> unit\n val renameDirectory : dirpath -> dirpath -> unit\n val takeDirectory : path -> dirpath\n\n val : dirpath * path -> path\nend\n" }, { "path": "src/util/system.sml", "content": "structure System :> SYSTEM = struct\n\nstructure FS = OS.FileSys\nstructure P = OS.Process\n\ntype path = string\ntype filepath = path\ntype dirpath = path\n\n(* Text-based file operations *)\nfun readFile (f:filepath) : string = (* may raise Fail *)\n let val is = TextIO.openIn f\n in (TextIO.inputAll is handle _ => (TextIO.closeIn is;\n raise Fail (\"failed to read file '\" ^ f ^ \"'\")))\n before TextIO.closeIn is\n end\n\nfun writeFile (f:filepath) (s: string) : unit =\n let val os = TextIO.openOut f\n in (TextIO.output(os,s); TextIO.closeOut os)\n handle X => (TextIO.closeOut os; raise X)\n end\n\n(* Binary file operations *)\n\nfun readFileBin (f:filepath) : Word8Vector.vector = (* may raise Fail *)\n let val is = BinIO.openIn f\n in (BinIO.inputAll is handle _ => (BinIO.closeIn is;\n raise Fail (\"failed to read file '\" ^ f ^ \"'\")))\n before BinIO.closeIn is\n end\n\nfun writeFileBin (f:filepath) (s: Word8Vector.vector) : unit =\n let val os = BinIO.openOut f\n in (BinIO.output(os,s); BinIO.closeOut os)\n handle X => (BinIO.closeOut os; raise X)\n end\n\n(* Command execution *)\n\n(* Escape a string for safe use in shell commands *)\nfun shellEscape (s: string) : string =\n \"'\" ^ String.translate (fn #\"'\" => \"'\\\"'\\\"'\" | c => String.str c) s ^ \"'\"\n\nfun command (cmd: string) : P.status * string * string =\n let val stdoutFile = FS.tmpName()\n val stderrFile = FS.tmpName()\n fun cleanup () = (FS.remove stdoutFile; FS.remove stderrFile)\n in let val s = P.system(cmd ^ \" > \" ^ stdoutFile ^ \" 2> \" ^ stderrFile)\n val out = readFile stdoutFile\n val err = readFile stderrFile\n in (s, out, err) before cleanup()\n end handle X => (cleanup(); raise X)\n end\n\n(* Operations on files, directories, and paths *)\n\nfun splitPath (p:string) : string list =\n String.fields (fn c => c = #\"/\") p\n\nfun hasTrailingPathSeparator (p:string) : bool =\n size p > 0 andalso String.sub(p,size p - 1) = #\"/\"\n\ninfix \nfun x y = if x = \"\" then y else x ^ \"/\" ^ y\n\nfun doesFileExist (p:path) : bool =\n OS.FileSys.access(p,[])\n\nfun doesDirExist (p:dirpath) : bool =\n OS.FileSys.access(p,[]) andalso OS.FileSys.isDir p\n\nfun createDirectoryIfMissing (also_parents:bool) (p:string) : unit =\n let fun check d =\n case d of\n \"..\" => raise Fail \"no support for '..' in dirs\"\n | \".\" => raise Fail \"no support for '.' in dirs\"\n | \"\" => raise Fail \"no support for '' in dirs\"\n | _ => ()\n val dirs = splitPath p\n val () = List.app check dirs\n fun loop pre nil = ()\n | loop pre (x::xs) =\n let val d = pre x\n in if doesDirExist d then loop d xs\n else if null xs orelse also_parents then\n ( (if doesFileExist d then\n raise Fail (\"cannot create directory \" ^ d ^\n \" as a file exists with that name.\")\n else OS.FileSys.mkDir d)\n ; loop d xs)\n else raise Fail (\"parent directory \" ^ d ^ \" of \" ^ p ^ \" does not exist.\")\n end\n in loop \"\" dirs\n end\n\nfun isRelative p =\n if size p > 0 then\n String.sub(p,0) <> #\"/\"\n else raise Fail \"isRelative expects non-empty path\"\n\nfun isAbsolute p =\n if size p > 0 then\n String.sub(p,0) = #\"/\"\n else raise Fail \"isAbsolute expects non-empty path\"\n\nfun makeRelative (f:dirpath) (p:path) : string =\n case (isRelative f, isRelative p) of\n (true, true) =>\n let fun loop (x::xs,y::ys) =\n if x = y then loop (xs,ys)\n else raise Fail (\"makeRelative failed as \" ^ f ^ \" is not a subpath of \" ^ p)\n | loop (nil,ys) = String.concatWith \"/\" ys\n | loop _ = raise Fail (\"makeRelative failed as \" ^ f ^ \" is not a subpath of \" ^ p)\n in loop(splitPath f, splitPath p)\n end\n | _ => raise Fail \"makeRelative assumes relative directories as arguments\"\n\nfun removePathForcibly (p:path) : unit =\n if doesDirExist p then\n let fun loop d = case OS.FileSys.readDir d of\n SOME p' => ( removePathForcibly (p p')\n ; loop d )\n | NONE => OS.FileSys.closeDir d\n in loop (OS.FileSys.openDir p)\n ; OS.FileSys.rmDir p\n end\n else if doesFileExist p then OS.FileSys.remove p\n else ()\n\nfun renameDirectory (old:dirpath) (new:dirpath) : unit =\n if doesFileExist new then\n raise Fail (\"cannot rename directory as target directory '\" ^\n new ^ \"' already exists\")\n else if doesDirExist old then\n OS.FileSys.rename{old=old,new=new}\n else raise Fail (\"'\" ^ old ^ \"' is not a directory.\")\n\nfun takeDirectory (p:path) : dirpath = OS.Path.dir p\n\nend\n" }, { "path": "src/util/test.mlb", "content": "local $(SML_LIB)/basis/basis.mlb\n util.mlb\nin test.sml\n test_system.sml\nend\n" }, { "path": "src/util/test.sml", "content": "fun println s = print (s ^ \"\\n\")\n\nval () = println \"Testing FinMapEq\"\n\nfun test s b =\n println(if b then (\"OK : \" ^ s)\n else (\"ERR: \" ^ s))\n\nopen FinMapEq\n\nval m : (int,string)t = empty_eq()\n\nval m1 = add (5, \"five\") m\nval m2 = add (8, \"eight\") m1\n\nval toS : (int,string)t -> string = toString (Int.toString,fn s=>s)\n\nval () = test \"empty-toString\" (toS m = \"{}\")\nval () = test \"add1-toString\" (toS m1 = \"{5:five}\")\nval () = test \"add2-toString\" (toS m2 = \"{8:eight,5:five}\")\n" }, { "path": "src/util/test_system.sml", "content": "fun println s = print (s ^ \"\\n\")\n\nval () = println \"Testing System\"\n\nfun test s b =\n println(if b then (\"OK : \" ^ s)\n else (\"ERR: \" ^ s))\n\nopen System\n\nval cmd = \"cat testfile.txt\"\nval (status,out,err) = command cmd\n\nval () = test \"system.ok.out\" (out = \"Hi there\\n\")\nval () = test \"system.ok.err\" (err = \"\")\nval () = test \"system.ok.status\" (OS.Process.isSuccess status)\n\nval cmd_err = \"cat doesnotexist.txt\"\nval (status_err,out_err,err_err) = command cmd_err\n\nval () = test \"system.err.out\" (out_err = \"\")\nval () = test \"system.err.err\" (err_err = \"cat: doesnotexist.txt: No such file or directory\\n\")\nval () = test \"system.err.status\" (not(OS.Process.isSuccess status_err))\n" }, { "path": "src/util/testfile.txt", "content": "Hi there\n" }, { "path": "src/util/util.mlb", "content": "local $(SML_LIB)/basis/basis.mlb\nin finmapeq.sig\n finmapeq.sml\n system.sig\n system.sml\nend\n" }, { "path": "version.txt", "content": "v0.1.7\n" } ]