Merge remote-tracking branch 'origin/trunk' into kylegoetz-udp

This commit is contained in:
Kyle Goetz 2024-04-30 12:55:18 -05:00
commit 0bc69c31a8
160 changed files with 1931 additions and 1688 deletions

View File

@ -159,14 +159,15 @@ jobs:
distribution: "full"
variant: "CS"
version: ${{env.racket_version}}
- uses: awalsh128/cache-apt-pkgs-action@latest
if: runner.os == 'Linux'
with:
packages: libb2-dev
version: 1.0 # cache key version afaik
- name: install unison racket lib
if: steps.cache-racket-deps.outputs.cache-hit != 'true'
run: raco pkg install --auto scheme-libs/racket/unison.zip
- name: install libb2 (macos)
if: runner.os == 'macOS'
run: |
brew install libb2
ln -s "$(brew --prefix)"/lib/libb2.*.dylib \
"$(dirname "$(readlink -f "$(which raco)")")"/../lib/
- name: build unison-runtime
run: |
raco exe --embed-dlls --orig-exe scheme-libs/racket/unison-runtime.rkt

View File

@ -0,0 +1,116 @@
name: build jit binary
on:
workflow_call:
defaults:
run:
shell: bash
env:
jit_src: unison-jit-src/
jit_dist: unison-jit-dist/
racket_version: "8.7"
jobs:
build-jit-binary:
name: build jit binary
strategy:
fail-fast: false
matrix:
os: [ubuntu-20.04, macOS-12, windows-2019]
runs-on: ${{matrix.os}}
steps:
- name: set up environment
run: |
jit_src="$GITHUB_WORKSPACE/${{ env.jit_src }}" # scheme source
jit_exe="${jit_src}/unison-runtime" # initially built jit
jit_dist="${{ runner.temp }}/${{ env.jit_dist }}" # jit binary with libraries destination
jit_dist_exe="${jit_dist}/bin/unison-runtime" # jit binary itself
ucm="${{ runner.temp }}/unison"
if [[ ${{runner.os}} = "Windows" ]]; then
jit_src="${jit_src//\\//}"
jit_dist="${jit_dist//\\//}"
jit_exe="${jit_exe//\\//}.exe"
jit_dist_exe="${jit_dist//\\//}/unison-runtime.exe"
ucm="${ucm//\\//}.exe"
fi
echo "jit_src=$jit_src" >> $GITHUB_ENV
echo "jit_exe=$jit_exe" >> $GITHUB_ENV
echo "jit_dist=$jit_dist" >> $GITHUB_ENV
echo "jit_dist_exe=$jit_dist_exe" >> $GITHUB_ENV
echo "ucm=$ucm" >> $GITHUB_ENV
- name: get workflow files, for checking hashes
uses: actions/checkout@v4
with:
sparse-checkout: .github
- name: download jit source
uses: actions/download-artifact@v4
with:
name: jit-source
path: ${{ env.jit_src }}
- name: cache/restore jit binaries
id: cache-jit-binaries
uses: actions/cache/restore@v4
with:
path: ${{ env.jit_dist }}
key: jit-dist_${{matrix.os}}.racket_${{env.racket_version}}.jit-src_${{hashFiles(format('{0}/**.rkt',env.jit_src),format('{0}/**.ss',env.jit_src))}}.yaml_${{hashFiles('**/ci-build-jit-binary.yaml')}}
- name: cache racket dependencies
if: steps.cache-jit-binaries.outputs.cache-hit != 'true'
uses: actions/cache@v4
with:
path: |
~/.cache/racket
~/.local/share/racket
key: ${{ matrix.os }}.racket_${{env.racket_version}}.yaml_${{hashFiles('**/ci-build-jit-binary.yaml')}}
- name: install racket
if: steps.cache-jit-binaries.outputs.cache-hit != 'true'
uses: unisonweb/actions/racket/install@buildjet-cache
with:
version: ${{env.racket_version}}
- name: set up redistributables (macos)
if: runner.os == 'macOS' && steps.cache-jit-binaries.outputs.cache-hit != 'true'
run: |
brew install libb2
racket_lib_dir="$(dirname "$(readlink -f "$(which raco)")")/../lib"
ln -s "$(brew --prefix)"/lib/libb2.*.dylib "$racket_lib_dir/"
- name: build jit binary
if: steps.cache-jit-binaries.outputs.cache-hit != 'true'
shell: bash
run: |
if [[ ${{runner.os}} = "Windows" ]]; then
raco pkg install --auto --skip-installed --scope installation x509-lib
elif [[ ${{runner.os}} = "macOS" ]]; then
raco pkg install --auto --skip-installed --scope installation x509-lib
elif [[ ${{runner.os}} = "Linux" ]]; then
sudo raco pkg install --auto --skip-installed --scope installation x509-lib
fi
raco pkg install --auto --skip-installed "$jit_src"/unison
raco exe --embed-dlls "$jit_src"/unison-runtime.rkt
raco distribute -v "$jit_dist" "$jit_exe"
- name: cache/save jit binaries
if: steps.cache-jit-binaries.outputs.cache-hit != 'true'
uses: actions/cache/save@v4
with:
path: ${{ env.jit_dist }}
key: jit-dist_${{matrix.os}}.racket_${{env.racket_version}}.jit-src_${{hashFiles(format('{0}/**.rkt',env.jit_src),format('{0}/**.ss',env.jit_src))}}.yaml_${{hashFiles('**/ci-build-jit-binary.yaml')}}
- name: save jit binary
uses: actions/upload-artifact@v4
with:
name: jit-binary-${{ matrix.os }}
path: ${{ env.jit_dist }}/**
# - name: setup tmate session
# uses: mxschmitt/action-tmate@v3

129
.github/workflows/ci-test-jit.yaml vendored Normal file
View File

@ -0,0 +1,129 @@
name: test jit
on:
workflow_call:
env:
runtime_tests_version: "@unison/runtime-tests/main"
# for best results, this should match the path in ci.yaml too; but GH doesn't make it easy to share them.
runtime_tests_codebase: "~/.cache/unisonlanguage/runtime-tests.unison"
jit_src_rel: unison-jit-src
jit_dist_rel: unison-jit-dist
jit_test_results: jit-test-results
defaults:
run:
shell: bash
jobs:
run-jit-tests:
name: test jit
strategy:
fail-fast: false
matrix:
os:
- ubuntu-20.04
- macOS-12
# - windows-2019
runs-on: ${{matrix.os}}
steps:
- name: set up environment
run: |
jit_src="$GITHUB_WORKSPACE/${{ env.jit_src_rel }}" # scheme source, for hashing
jit_dist="$GITHUB_WORKSPACE/${{ env.jit_dist_rel }}" # jit binary with libraries destination
jit_dist_exe="${jit_dist}/bin/unison-runtime" # jit binary itself
jit_dist_rel_exe="${jit_dist_rel}/bin/unison-runtime" # jit binary itself
ucm="${{ runner.temp }}/unison"
if [[ ${{runner.os}} = "Windows" ]]; then
jit_src="${jit_src//\\//}"
jit_dist="${jit_dist//\\//}"
jit_dist_exe="${jit_dist//\\//}/unison-runtime.exe"
jit_dist_rel_exe="${jit_dist_rel//\\//}/unison-runtime.exe"
ucm="${ucm//\\//}.exe"
fi
echo "jit_src=$jit_src" >> $GITHUB_ENV
echo "jit_dist=$jit_dist" >> $GITHUB_ENV
echo "jit_dist_exe=$jit_dist_exe" >> $GITHUB_ENV
echo "jit_dist_rel_exe=$jit_dist_rel_exe" >> $GITHUB_ENV
echo "ucm=$ucm" >> $GITHUB_ENV
- uses: actions/checkout@v4
with:
sparse-checkout: |
.github
scripts/get-share-hash.sh
unison-src/builtin-tests/jit-tests.tpl.md
unison-src/transcripts-using-base/serialized-cases/case-00.v4.ser
- name: download jit binaries
uses: actions/download-artifact@v4
with:
name: jit-binary-${{ matrix.os }}
path: ${{ env.jit_dist }}
- name: look up hash for runtime tests
run: |
echo "runtime_tests_causalhash=$(scripts/get-share-hash.sh ${{ env.runtime_tests_version }})" >> $GITHUB_ENV
- name: cache jit test results
id: cache-jit-test-results
uses: actions/cache@v4
with:
path: ${{env.jit_test_results}}
key: jit-test-results.dist-exe_${{ hashFiles(env.jit_dist_rel_exe) }}.tests_${{ env.runtime_tests_causalhash }}.yaml_${{ hashFiles('**/ci-test-jit.yaml') }}
- name: install libb2 (linux)
uses: awalsh128/cache-apt-pkgs-action@latest
if: runner.os == 'Linux' && steps.cache-jit-test-results.outputs.cache-hit != 'true'
with:
packages: libb2-1
version: 1.0 # cache key version afaik
- name: cache testing codebase
id: cache-testing-codebase
if: steps.cache-jit-test-results.outputs.cache-hit != 'true'
uses: actions/cache@v4
with:
path: ${{ env.runtime_tests_codebase }}
key: runtime-tests-codebase-${{ matrix.os }}-${{env.runtime_tests_causalhash}}
restore-keys: runtime-tests-codebase-${{ matrix.os }}-
- name: download ucm
if: steps.cache-jit-test-results.outputs.cache-hit != 'true'
uses: actions/download-artifact@v4
with:
name: unison-${{ matrix.os }}
path: ${{ runner.temp }}
- name: set ucm & runtime permissions
if: steps.cache-jit-test-results.outputs.cache-hit != 'true'
run: |
chmod +x ${{ env.ucm }}
chmod +x ${{ env.jit_dist_exe }}
if [[ ${{runner.os}} = "Linux" ]]; then
chmod +x ${{env.jit_dist}}/lib/plt/*
fi
- name: jit integration test ${{ matrix.os }}
if: steps.cache-jit-test-results.outputs.cache-hit != 'true'
run: |
envsubst '${runtime_tests_version}' \
< unison-src/builtin-tests/jit-tests.tpl.md \
> unison-src/builtin-tests/jit-tests.md
${{ env.ucm }} transcript.fork --runtime-path ${{ env.jit_dist_exe }} -C ${{env.runtime_tests_codebase}} unison-src/builtin-tests/jit-tests.md
cat unison-src/builtin-tests/jit-tests.output.md
git diff --exit-code unison-src/builtin-tests/jit-tests.output.md
- name: mark jit tests as passing
if: steps.cache-jit-test-results.outputs.cache-hit != 'true'
run: |
echo "passing=true" >> "${{env.jit_test_results}}"
# - name: Setup tmate session
# uses: mxschmitt/action-tmate@v3
# if: ${{ failure() }}
# timeout-minutes: 15

View File

@ -9,7 +9,7 @@ At a high level, the CI process is:
Some version numbers that are used during CI:
- `ormolu_version: "0.5.0.1"`
- `racket_version: "8.7"`
- `jit_version: "@unison/internal/releases/0.0.14"`
- `jit_version: "@unison/internal/releases/0.0.15"`
Some cached directories:
- `ucm_local_bin` a temp path for caching a built `ucm`

View File

@ -18,20 +18,18 @@ on:
workflow_dispatch:
env:
ormolu_version: "0.5.2.0"
racket_version: "8.7"
ucm_local_bin: "ucm-local-bin"
jit_version: "@unison/internal/releases/0.0.14"
jit_src_scheme: "unison-jit-src/scheme-libs/racket"
jit_dist: "unison-jit-dist"
ormolu_version: 0.5.2.0
ucm_local_bin: ucm-local-bin
jit_version: "@unison/internal/releases/0.0.15"
jit_src_scheme: unison-jit-src/scheme-libs/racket
jit_dist: unison-jit-dist
jit_generator_os: ubuntu-20.04
runtime_tests_version: "@unison/runtime-tests/@aryairani/udp"
runtime_tests_codebase: "~/.cache/unisonlanguage/runtime-tests.unison"
# locations of some files that will indicate whether we need to re-run certain steps
transcript_test_results: "transcript-test-results"
interpreter_test_results: "interpreter-test-results"
jit_test_results: "jit-test-results"
transcript_test_results: transcript-test-results
interpreter_test_results: interpreter-test-results
jobs:
ormolu:
@ -354,38 +352,25 @@ jobs:
steps:
- name: set up environment
run: |
echo "jit_generated_src_scheme=${{ runner.temp }}/jit-generated-src" >> $GITHUB_ENV
echo "jit_src_scheme=${{ runner.temp }}/${{ env.jit_src_scheme }}" >> $GITHUB_ENV
echo "ucm=${{ runner.temp }}/unison" >> $GITHUB_ENV
- uses: actions/cache@v4
name: cache jit source
- name: download scheme-libs
uses: actions/checkout@v4
with:
path: ${{ env.jit_src_scheme }}
key: jit_src_scheme-racket_${{env.racket_version}}.jit_${{env.jit_version}}-${{hashFiles('**/scheme-libs/**')}}
- name: check source exists
id: jit_src_exists
if: steps.cache-jit-source.outputs.cache-hit != 'true'
run: |
files=(data-info boot-generated simple-wrappers builtin-generated compound-wrappers)
all_exist=true
for file in "${files[@]}"; do
if [[ ! -f "${{ env.jit_src_scheme }}/unison/$file.ss" ]]; then
echo "$file does not exist."
all_exist=false
# Uncomment the next line if you want to stop checking after the first missing file
# break
fi
done
if $all_exist; then
echo "files_exists=true" >> $GITHUB_OUTPUT
else
echo "files_exists=false" >> $GITHUB_OUTPUT
fi
sparse-checkout: |
scripts/get-share-hash.sh
scheme-libs
- name: look up hash for jit source generator
run: echo "jit_causalhash=$(scripts/get-share-hash.sh ${{env.jit_version}})" >> $GITHUB_ENV
- uses: actions/cache@v4
name: cache auto-generated jit source
id: cache-generated-source
with:
path: ${{ env.jit_generated_src_scheme }}
key: jit_generated_src_scheme-jit_${{env.jit_version}}-${{env.jit_causalhash}}
- name: create transcript
if: steps.jit_src_exists.outputs.files_exists == 'false'
if: steps.cache-generated-source.outputs.cache-hit != 'true'
uses: DamianReeves/write-file-action@v1.3
with:
path: ${{ runner.temp }}/setup-jit.md
@ -396,34 +381,31 @@ jobs:
jit-setup/main> pull ${{ env.jit_version }} lib.jit
```
```unison
go = generateSchemeBoot "${{ env.jit_src_scheme }}"
go = generateSchemeBoot "${{ env.jit_generated_src_scheme }}"
```
```ucm
jit-setup/main> run go
```
- name: download ucm artifact
if: steps.jit_src_exists.outputs.files_exists == 'false'
if: steps.cache-generated-source.outputs.cache-hit != 'true'
uses: actions/download-artifact@v4
with:
name: unison-${{ env.jit_generator_os }}
path: ${{ runner.temp }}
- name: set ucm permissions
if: steps.jit_src_exists.outputs.files_exists == 'false'
if: steps.cache-generated-source.outputs.cache-hit != 'true'
run: chmod +x ${{ env.ucm }}
- name: download scheme-libs
if: steps.jit_src_exists.outputs.files_exists == 'false'
uses: actions/checkout@v4
- name: generate source
if: steps.jit_src_exists.outputs.files_exists == 'false'
if: steps.cache-generated-source.outputs.cache-hit != 'true'
run: |
mkdir -p ${{ env.jit_generated_src_scheme }}
${{ env.ucm }} transcript ${{ runner.temp }}/setup-jit.md
- name: bundle source
run: |
mkdir -p ${{ env.jit_src_scheme }}
cp -R scheme-libs/racket/* ${{ env.jit_src_scheme }}
${{ env.ucm }} transcript ${{ runner.temp }}/setup-jit.md
cp -R "${{ env.jit_generated_src_scheme }}"/* ${{ env.jit_src_scheme }}
- name: save jit source
if: always()
uses: actions/upload-artifact@v4
@ -433,162 +415,11 @@ jobs:
if-no-files-found: error
build-jit-binary:
if: always() && needs.generate-jit-source.result == 'success'
name: build jit binary
needs: generate-jit-source
runs-on: ${{ matrix.os }}
strategy:
# Run each build to completion, regardless of if any have failed
fail-fast: false
matrix:
os:
# While iterating on this file, you can disable one or more of these to speed things up
- ubuntu-20.04
- macOS-12
- windows-2019
steps:
- name: set up environment
id: checks
run: |
jit_src_scheme="${{ runner.temp }}/${{ env.jit_src_scheme }}" # scheme source
jit_exe="${jit_src_scheme}/unison-runtime" # initially built jit
jit_dist="${{ runner.temp }}/${{ env.jit_dist }}" # jit binary with libraries destination
jit_dist_exe="${jit_dist}/bin/unison-runtime" # jit binary itself
ucm="${{ runner.temp }}/unison"
uses: ./.github/workflows/ci-build-jit-binary.yaml
if [[ ${{runner.os}} = "Windows" ]]; then
jit_src_scheme="${jit_src_scheme//\\//}"
jit_dist="${jit_dist//\\//}"
jit_exe="${jit_exe//\\//}.exe"
jit_dist_exe="${jit_dist//\\//}/unison-runtime.exe"
ucm="${ucm//\\//}.exe"
fi
echo "jit_src_scheme=$jit_src_scheme" >> $GITHUB_ENV
echo "jit_exe=$jit_exe" >> $GITHUB_ENV
echo "jit_dist=$jit_dist" >> $GITHUB_ENV
echo "jit_dist_exe=$jit_dist_exe" >> $GITHUB_ENV
echo "ucm=$ucm" >> $GITHUB_ENV
- name: cache jit binaries
id: cache-jit-binaries
uses: actions/cache@v4
with:
path: ${{ env.jit_dist }}
key: jit_dist-${{ matrix.os }}.racket_${{ env.racket_version }}.jit_${{ env.jit_version }}
- name: Cache Racket dependencies
if: steps.cache-jit-binaries.outputs.cache-hit != 'true'
uses: actions/cache@v4
with:
path: |
~/.cache/racket
~/.local/share/racket
key: ${{ matrix.os }}-racket-${{env.racket_version}}
- uses: Bogdanp/setup-racket@v1.11
if: steps.cache-jit-binaries.outputs.cache-hit != 'true'
with:
architecture: x64
distribution: full
variant: CS
version: ${{env.racket_version}}
- uses: actions/checkout@v4
with:
sparse-checkout: |
scripts/get-share-hash.sh
scheme-libs
unison-src/builtin-tests/jit-tests.tpl.md
unison-src/transcripts-using-base/serialized-cases/case-00.v4.ser
- name: look up hash for runtime tests
run: |
echo "runtime_tests_causalhash=$(scripts/get-share-hash.sh ${{env.runtime_tests_version}})" >> $GITHUB_ENV
- name: cache jit test results
id: cache-jit-test-results
uses: actions/cache@v4
with:
path: ${{env.jit_test_results}}
key: jit-test-results.${{ matrix.os }}.racket_${{ env.racket_version }}.jit_${{ env.jit_version }}.tests_${{env.runtime_tests_causalhash}}
- name: install libb2 (linux)
uses: awalsh128/cache-apt-pkgs-action@latest
if: |
runner.os == 'Linux'
&& steps.cache-jit-test-results.outputs.cache-hit != 'true'
# read this if a package isn't installing correctly
# https://github.com/awalsh128/cache-apt-pkgs-action#caveats
with:
packages: libb2-dev
version: 1.0 # cache key version afaik
- name: install libb2 (macos)
if: |
runner.os == 'macOS'
&& steps.cache-jit-test-results.outputs.cache-hit != 'true'
run: brew install libb2
- name: download jit source
if: steps.cache-jit-binaries.outputs.cache-hit != 'true'
uses: actions/download-artifact@v4
with:
name: jit-source
path: ${{ env.jit_src_scheme }}
- name: build jit binary
if: steps.cache-jit-binaries.outputs.cache-hit != 'true'
shell: bash
run: |
cp -R scheme-libs/racket/* "$jit_src_scheme"
raco pkg install --auto --skip-installed "$jit_src_scheme"/unison
raco exe --embed-dlls "$jit_src_scheme"/unison-runtime.rkt
raco distribute "$jit_dist" "$jit_exe"
- name: save jit binary
uses: actions/upload-artifact@v4
with:
name: jit-binary-${{ matrix.os }}
path: ${{ env.jit_dist }}/**
- name: cache testing codebase
id: cache-testing-codebase
if: steps.cache-jit-test-results.outputs.cache-hit != 'true'
uses: actions/cache@v4
with:
path: ${{ env.runtime_tests_codebase }}
key: runtime-tests-codebase-${{ matrix.os }}-${{env.runtime_tests_causalhash}}
restore-keys: runtime-tests-codebase-${{ matrix.os }}-
- name: download ucm
if: steps.cache-jit-test-results.outputs.cache-hit != 'true'
uses: actions/download-artifact@v4
with:
name: unison-${{ matrix.os }}
path: ${{ runner.temp }}
- name: set ucm permissions
if: steps.cache-jit-test-results.outputs.cache-hit != 'true'
run: chmod +x ${{ env.ucm }}
- name: jit integration test ${{ matrix.os }}
if: runner.os != 'Windows' && steps.cache-jit-test-results.outputs.cache-hit != 'true'
run: |
envsubst '${runtime_tests_version}' \
< unison-src/builtin-tests/jit-tests.tpl.md \
> unison-src/builtin-tests/jit-tests.md
${{ env.ucm }} transcript.fork --runtime-path ${{ env.jit_dist_exe }} -C ${{env.runtime_tests_codebase}} unison-src/builtin-tests/jit-tests.md
cat unison-src/builtin-tests/jit-tests.output.md
git diff --exit-code unison-src/builtin-tests/jit-tests.output.md
- name: mark jit tests as passing
if: runner.os != 'Windows' && steps.cache-jit-test-results.outputs.cache-hit != 'true'
run: |
echo "passing=true" >> "${{env.jit_test_results}}"
# - name: Setup tmate session
# uses: mxschmitt/action-tmate@v3
# if: ${{ failure() }}
# timeout-minutes: 15
test-jit:
name: test jit
needs: build-jit-binary
uses: ./.github/workflows/ci-test-jit.yaml

1
.gitignore vendored
View File

@ -11,6 +11,7 @@ interpreter-tests.md
# Stack
.stack-work
.stack-work-hls
# Cabal
dist-newstyle

View File

@ -26,6 +26,9 @@ e.g.
It's not clear to me when to use `$GITHUB_OUTPUT` vs `$GITHUB_ENV`, but I have been favoring `$GITHUB_ENV` because it requires fewer characters to access.
However, it seems a little wrong.
### `hashFiles()`
`hashFiles()` can only access files inside of and relative to `$GITHUB_WORKSPACE`.
### `if:`
Although the type rules don't totally make sense in Github Actions, `if:` takes a Boolean.

View File

@ -96,6 +96,7 @@
{
packages = nixpkgs-packages // {
haskell-nix = haskell-nix-flake.packages;
docker = import ./nix/docker.nix { inherit pkgs; haskell-nix = haskell-nix-flake.packages; };
build-tools = pkgs.symlinkJoin {
name = "build-tools";
paths = self.devShells."${system}".only-tools-nixpkgs.buildInputs;

10
nix/docker.nix Normal file
View File

@ -0,0 +1,10 @@
{ pkgs, haskell-nix }:
{
ucm = pkgs.dockerTools.buildLayeredImage {
name = "ucm";
tag = "latest";
contents = with pkgs; [ cacert fzf ];
config.Cmd = [ "${haskell-nix."unison-cli:exe:unison"}/bin/unison" ];
};
}

View File

@ -24,6 +24,7 @@ module Unison.Codebase.Path
prefix,
unprefix,
prefixName,
prefixName2,
unprefixName,
HQSplit,
Split,
@ -192,6 +193,11 @@ prefix (Absolute (Path prefix)) = \case
AbsolutePath' abs -> unabsolute abs
RelativePath' rel -> Path $ prefix <> toSeq (unrelative rel)
prefix2 :: Path -> Path' -> Path
prefix2 (Path prefix) = \case
AbsolutePath' abs -> unabsolute abs
RelativePath' rel -> Path $ prefix <> toSeq (unrelative rel)
-- | Finds the longest shared path prefix of two paths.
-- Returns (shared prefix, path to first location from shared prefix, path to second location from shared prefix)
--
@ -273,6 +279,9 @@ unprefixName prefix = toName . unprefix prefix . fromName'
prefixName :: Absolute -> Name -> Name
prefixName p n = fromMaybe n . toName . prefix p . fromName' $ n
prefixName2 :: Path -> Name -> Name
prefixName2 p n = fromMaybe n . toName . prefix2 p . fromName' $ n
singleton :: NameSegment -> Path
singleton n = fromList [n]

View File

@ -962,8 +962,8 @@ serializeGroupForRehash fops (Derived h _) sg =
f _ = Nothing
refrep = Map.fromList . mapMaybe f $ groupTermLinks sg
deserializeValue :: ByteString -> Either String Value
deserializeValue bs = runGetS (getVersion >>= getValue) bs
getVersionedValue :: MonadGet m => m Value
getVersionedValue = getVersion >>= getValue
where
getVersion =
getWord32be >>= \case
@ -973,6 +973,9 @@ deserializeValue bs = runGetS (getVersion >>= getValue) bs
| n <= 4 -> pure n
| otherwise -> fail $ "deserializeValue: unknown version: " ++ show n
deserializeValue :: ByteString -> Either String Value
deserializeValue bs = runGetS getVersionedValue bs
serializeValue :: Value -> ByteString
serializeValue v = runPutS (putVersion *> putValue v)
where

View File

@ -11,6 +11,7 @@
-- Checking is toggled using the `arraychecks` flag.
module Unison.Runtime.Array
( module EPA,
byteArrayToList,
readArray,
writeArray,
copyArray,
@ -54,6 +55,9 @@ import Data.Primitive.PrimArray as EPA hiding
)
import Data.Primitive.PrimArray qualified as PA
import Data.Primitive.Types
import Data.Word (Word8)
import GHC.Exts (toList)
#ifdef ARRAY_CHECK
import GHC.Stack
@ -376,3 +380,6 @@ indexPrimArray ::
a
indexPrimArray = checkIPArray "indexPrimArray" PA.indexPrimArray
{-# INLINE indexPrimArray #-}
byteArrayToList :: ByteArray -> [Word8]
byteArrayToList = toList

View File

@ -20,12 +20,18 @@ import Unison.Prelude
import Unison.Reference (Reference, pattern Builtin)
import Unison.Referent (pattern Ref)
import Unison.Runtime.ANF (maskTags)
import Unison.Runtime.Array
( Array
, ByteArray
, byteArrayToList
)
import Unison.Runtime.Foreign
( Foreign (..),
HashAlgorithm (..),
maybeUnwrapBuiltin,
maybeUnwrapForeign,
)
import Unison.Runtime.IOSource (iarrayFromListRef, ibarrayFromBytesRef)
import Unison.Runtime.MCode (CombIx (..))
import Unison.Runtime.Stack
( Closure (..),
@ -63,6 +69,8 @@ import Unison.Type
natRef,
termLinkRef,
typeLinkRef,
iarrayRef,
ibytearrayRef,
)
import Unison.Util.Bytes qualified as By
import Unison.Util.Pretty (indentN, lines, lit, syntaxToColor, wrap)
@ -155,6 +163,8 @@ decompile backref topTerms (DataC rf (maskTags -> ct) [] bs) =
apps' (con rf ct) <$> traverse (decompile backref topTerms) bs
decompile backref topTerms (PApV (CIx rf rt k) [] bs)
| rf == Builtin "jumpCont" = err Cont $ bug "<Continuation>"
| Builtin nm <- rf =
apps' (builtin () nm) <$> traverse (decompile backref topTerms) bs
| Just t <- topTerms rt k =
Term.etaReduceEtaVars . substitute t
<$> traverse (decompile backref topTerms) bs
@ -208,6 +218,15 @@ decompileForeign backref topTerms f
_ -> l
| Just l <- maybeUnwrapForeign typeLinkRef f =
pure $ typeLink () l
| Just (a :: Array Closure) <- maybeUnwrapForeign iarrayRef f =
app () (ref () iarrayFromListRef) . list () <$>
traverse (decompile backref topTerms) (toList a)
| Just (a :: ByteArray) <- maybeUnwrapForeign ibytearrayRef f =
pure $
app
()
(ref () ibarrayFromBytesRef)
(decompileBytes . By.fromWord8s $ byteArrayToList a)
| Just s <- unwrapSeq f =
list' () <$> traverse (decompile backref topTerms) s
decompileForeign _ _ (Wrap r _) =

View File

@ -486,6 +486,12 @@ pattern ConsoleTextUnderline ct <- Term.App' (Term.Constructor' (ConstructorRefe
pattern ConsoleTextInvert ct <- Term.App' (Term.Constructor' (ConstructorReference ConsoleTextRef ((==) consoleTextInvertId -> True))) ct
iarrayFromListRef :: R.Reference
iarrayFromListRef = termNamed "ImmutableArray.fromList"
ibarrayFromBytesRef :: R.Reference
ibarrayFromBytesRef = termNamed "ImmutableByteArray.fromBytes"
constructorNamed :: R.Reference -> Text -> DD.ConstructorId
constructorNamed ref name =
case runIdentity . getTypeDeclaration codeLookup $ R.unsafeId ref of
@ -986,6 +992,35 @@ syntax.docFormatConsole d =
Image alt _link None -> go alt
Special sf -> Pretty.lit (Left sf)
go d
ImmutableArray.fromList l = Scope.run do
sz = List.size l
dst = Scope.array sz
go i = cases
[] -> ()
x +: xs ->
MutableArray.write dst i x
go (i+1) xs
handle go 0 l with cases
{ r } -> ()
{ raise _ -> _ } -> ()
MutableArray.freeze! dst
ImmutableByteArray.fromBytes : Bytes -> ImmutableByteArray
ImmutableByteArray.fromBytes bs = Scope.run do
sz = Bytes.size bs
arr = Scope.bytearray sz
fill i =
match Bytes.at i bs with
Some b ->
MutableByteArray.write8 arr i b
fill (i + 1)
None -> ()
handle fill 0
with cases
{ _ } -> ()
{ raise _ -> _ } -> ()
MutableByteArray.freeze! arr
|]
type Note = Result.Note Symbol Ann

View File

@ -27,10 +27,11 @@ import Data.Binary.Get (runGetOrFail)
-- import Data.Bits (shiftL)
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BL
import Data.Bytes.Get (MonadGet)
import Data.Bytes.Get (MonadGet, getWord8, runGetS)
import Data.Bytes.Put (MonadPut, putWord32be, runPutL, runPutS)
import Data.Bytes.Serial
import Data.Foldable
import Data.Function (on)
import Data.IORef
import Data.List qualified as L
import Data.Map.Strict qualified as Map
@ -44,9 +45,11 @@ import Data.Set as Set
(\\),
)
import Data.Set qualified as Set
import Data.Text (isPrefixOf, unpack)
import Data.Text as Text (isPrefixOf, pack, unpack)
import GHC.IO.Exception (IOErrorType (NoSuchThing, OtherError, PermissionDenied), IOException (ioe_description, ioe_type))
import GHC.Stack (callStack)
import Network.Simple.TCP (Socket, acceptFork, listen, recv, send)
import Network.Socket (PortNumber, socketPort)
import System.Directory
( XdgDirectory (XdgCache),
createDirectoryIfMissing,
@ -85,6 +88,7 @@ import Unison.Runtime.ANF as ANF
import Unison.Runtime.ANF.Rehash as ANF (rehashGroups)
import Unison.Runtime.ANF.Serialize as ANF
( getGroup,
getVersionedValue,
putGroup,
serializeValue,
)
@ -460,7 +464,18 @@ nativeEval executable ctxVar cl ppe tm = catchInternalErrors $ do
(ctx, codes) <- loadDeps cl ppe ctx tyrs tmrs
(ctx, tcodes, base) <- prepareEvaluation ppe tm ctx
writeIORef ctxVar ctx
nativeEvalInContext executable ppe ctx (codes ++ tcodes) base
-- Note: port 0 mean choosing an arbitrary available port.
-- We then ask what port was actually chosen.
listen "127.0.0.1" "0" $ \(serv, _) ->
socketPort serv >>= \port ->
nativeEvalInContext
executable
ppe
ctx
serv
port
(L.nubBy ((==) `on` fst) $ tcodes ++ codes)
base
interpEval ::
ActiveThreads ->
@ -790,14 +805,46 @@ backReferenceTm ws frs irs dcm c i = do
bs <- Map.lookup r dcm
Map.lookup i bs
ucrProc :: FilePath -> [String] -> CreateProcess
ucrProc executable args =
ucrEvalProc :: FilePath -> [String] -> CreateProcess
ucrEvalProc executable args =
(proc executable args)
{ std_in = Inherit,
std_out = Inherit,
std_err = Inherit
}
ucrCompileProc :: FilePath -> [String] -> CreateProcess
ucrCompileProc executable args =
(proc executable args)
{ std_in = CreatePipe,
std_out = Inherit,
std_err = Inherit
}
receiveAll :: Socket -> IO ByteString
receiveAll sock = read []
where
read acc =
recv sock 4096 >>= \case
Just chunk -> read (chunk : acc)
Nothing -> pure . BS.concat $ reverse acc
data NativeResult
= Success Value
| Bug Text Value
| Error Text
deserializeNativeResponse :: ByteString -> NativeResult
deserializeNativeResponse =
run $
getWord8 >>= \case
0 -> Success <$> getVersionedValue
1 -> Bug <$> getText <*> getVersionedValue
2 -> Error <$> getText
_ -> pure $ Error "Unexpected result bytes tag"
where
run e bs = either (Error . pack) id (runGetS e bs)
-- Note: this currently does not support yielding values; instead it
-- just produces a result appropriate for unitary `run` commands. The
-- reason is that the executed code can cause output to occur, which
@ -813,37 +860,45 @@ nativeEvalInContext ::
FilePath ->
PrettyPrintEnv ->
EvalCtx ->
Socket ->
PortNumber ->
[(Reference, SuperGroup Symbol)] ->
Reference ->
IO (Either Error ([Error], Term Symbol))
nativeEvalInContext executable _ ctx codes base = do
nativeEvalInContext executable ppe ctx serv port codes base = do
ensureRuntimeExists executable
let cc = ccache ctx
crs <- readTVarIO $ combRefs cc
let bytes = serializeValue . compileValue base $ codes
decodeResult (Left msg) = pure . Left $ fromString msg
decodeResult (Right val) =
decodeResult (Error msg) = pure . Left $ text msg
decodeResult (Bug msg val) =
reifyValue cc val >>= \case
Left _ -> pure . Left $ "missing references from bug result"
Right cl ->
pure . Left . bugMsg ppe [] msg $ decompileCtx crs ctx cl
decodeResult (Success val) =
reifyValue cc val >>= \case
Left _ -> pure . Left $ "missing references from result"
Right cl -> case decompileCtx crs ctx cl of
(errs, dv) -> pure $ Right (listErrors errs, dv)
callout (Just pin) _ _ ph = do
BS.hPut pin . runPutS . putWord32be . fromIntegral $ BS.length bytes
BS.hPut pin bytes
UnliftIO.hClose pin
let unit = Data RF.unitRef 0 [] []
sunit = Data RF.pairRef 0 [] [unit, unit]
comm mv (sock, _) = do
send sock . runPutS . putWord32be . fromIntegral $ BS.length bytes
send sock bytes
UnliftIO.putMVar mv =<< receiveAll sock
callout _ _ _ ph = do
mv <- UnliftIO.newEmptyMVar
tid <- acceptFork serv $ comm mv
waitForProcess ph >>= \case
ExitSuccess -> decodeResult $ Right sunit
ExitFailure _ ->
ExitSuccess ->
decodeResult . deserializeNativeResponse
=<< UnliftIO.takeMVar mv
ExitFailure _ -> do
UnliftIO.killThread tid
pure . Left $ "native evaluation failed"
-- TODO: actualy receive output from subprocess
-- decodeResult . deserializeValue =<< BS.hGetContents pout
callout _ _ _ _ =
pure . Left $ "withCreateProcess didn't provide handles"
p = ucrProc executable []
p = ucrEvalProc executable ["-p", show port]
ucrError (e :: IOException) = pure $ Left (runtimeErrMsg (cmdspec p) (Right e))
withCreateProcess p callout
`UnliftIO.catch` ucrError
@ -872,7 +927,7 @@ nativeCompileCodes executable codes base path = do
throwIO $ PE callStack (runtimeErrMsg (cmdspec p) (Right e))
racoError (e :: IOException) =
throwIO $ PE callStack (racoErrMsg (makeRacoCmd RawCommand) (Right e))
p = ucrProc executable ["-G", srcPath]
p = ucrCompileProc executable ["-G", srcPath]
makeRacoCmd :: (FilePath -> [String] -> a) -> a
makeRacoCmd f = f "raco" ["exe", "-o", path, srcPath]
withCreateProcess p callout
@ -953,7 +1008,7 @@ bugMsg ::
Pretty ColorText
bugMsg ppe tr name (errs, tm)
| name == "blank expression" =
P.callout icon . P.lines $
P.callout icon . P.linesNonEmpty $
[ P.wrap
( "I encountered a"
<> P.red (P.text name)
@ -965,7 +1020,7 @@ bugMsg ppe tr name (errs, tm)
stackTrace ppe tr
]
| "pattern match failure" `isPrefixOf` name =
P.callout icon . P.lines $
P.callout icon . P.linesNonEmpty $
[ P.wrap
( "I've encountered a"
<> P.red (P.text name)
@ -980,7 +1035,7 @@ bugMsg ppe tr name (errs, tm)
stackTrace ppe tr
]
| name == "builtin.raise" =
P.callout icon . P.lines $
P.callout icon . P.linesNonEmpty $
[ P.wrap ("The program halted with an unhandled exception:"),
"",
P.indentN 2 $ pretty ppe tm,
@ -990,7 +1045,7 @@ bugMsg ppe tr name (errs, tm)
| name == "builtin.bug",
RF.TupleTerm' [Tm.Text' msg, x] <- tm,
"pattern match failure" `isPrefixOf` msg =
P.callout icon . P.lines $
P.callout icon . P.linesNonEmpty $
[ P.wrap
( "I've encountered a"
<> P.red (P.text msg)
@ -1005,7 +1060,7 @@ bugMsg ppe tr name (errs, tm)
stackTrace ppe tr
]
bugMsg ppe tr name (errs, tm) =
P.callout icon . P.lines $
P.callout icon . P.linesNonEmpty $
[ P.wrap
( "I've encountered a call to"
<> P.red (P.text name)
@ -1018,7 +1073,8 @@ bugMsg ppe tr name (errs, tm) =
]
stackTrace :: PrettyPrintEnv -> [(Reference, Int)] -> Pretty ColorText
stackTrace ppe tr = "Stack trace:\n" <> P.indentN 2 (P.lines $ f <$> tr)
stackTrace _ [] = mempty
stackTrace ppe tr = "\nStack trace:\n" <> P.indentN 2 (P.lines $ f <$> tr)
where
f (rf, n) = name <> count
where
@ -1165,10 +1221,11 @@ listErrors :: Set DecompError -> [Error]
listErrors = fmap (P.indentN 2 . renderDecompError) . toList
tabulateErrors :: Set DecompError -> Error
tabulateErrors errs | null errs = "\n"
tabulateErrors errs | null errs = mempty
tabulateErrors errs =
P.indentN 2 . P.lines $
P.wrap "The following errors occured while decompiling:"
""
: P.wrap "The following errors occured while decompiling:"
: (listErrors errs)
restoreCache :: StoredCache -> IO CCache

View File

@ -37,10 +37,10 @@
;
; - 4 bytes indicating how many bytes follow
; - the actual payload, with size matching the above
(define (grab-bytes)
(let* ([size-bytes (read-bytes 4)]
(define (grab-bytes port)
(let* ([size-bytes (read-bytes 4 port)]
[size (integer-bytes->integer size-bytes #f #t 0 4)])
(read-bytes size)))
(read-bytes size port)))
; Reads and decodes the input. First uses `grab-bytes` to read the
; payload, then uses unison functions to deserialize the `Value` that
@ -50,8 +50,8 @@
; definition should be executed. In unison types, it is:
;
; ([(Link.Term, Code)], Link.Term)
(define (decode-input)
(let ([bs (grab-bytes)])
(define (decode-input port)
(let ([bs (grab-bytes port)])
(match (builtin-Value.deserialize (bytes->chunked-bytes bs))
[(unison-data _ t (list q))
(= t ref-either-right:tag)
@ -61,15 +61,65 @@
[else
(raise "unexpected input")])))
(define (natural->bytes/variable n)
(let rec ([i n] [acc '()])
(cond
[(< i #x80) (list->bytes (reverse (cons i acc)))]
[else
(rec (arithmetic-shift i -7)
(cons (bitwise-and i #x7f) acc))])))
(define (write-string-bytes str port)
(define bs (string->bytes/utf-8 str))
(write-bytes (natural->bytes/variable (bytes-length bs)) port)
(write-bytes bs port))
(define (write-value-bytes val port)
(define qval (unison-quote (reflect-value val)))
(define bs (chunked-bytes->bytes (builtin-Value.serialize qval)))
(write-bytes bs port))
(define (encode-success result port)
(write-bytes #"\0" port)
(write-value-bytes result port)
(void))
(define (encode-error ex port)
(match ex
[(exn:bug msg val)
(write-bytes #"\1" port)
(write-string-bytes msg port)
(write-value-bytes val port)]
[else
(write-bytes #"\2" port)
(write-string-bytes (exception->string ex) port)])
(void))
(define (encode-exception fail port)
(write-bytes #"\1" port)
(write-string-bytes "builtin.raise" port)
(write-value-bytes fail port)
(void))
(define ((eval-exn-handler port) rq)
(request-case rq
[pure (result) (encode-success result port)]
[ref-exception:typelink
[0 (fail)
(control ref-exception:typelink k
(encode-exception fail port))]]))
; Implements the evaluation mode of operation. First decodes the
; input. Then uses the dynamic loading machinery to add the code to
; the runtime. Finally executes a specified main reference.
(define (do-evaluate)
(let-values ([(code main-ref) (decode-input)])
(define (do-evaluate in out)
(let-values ([(code main-ref) (decode-input in)])
(add-runtime-code 'unison-main code)
(handle [ref-exception:typelink] top-exn-handler
((termlink->proc main-ref))
(data 'unit 0))))
(with-handlers
([exn:bug? (lambda (e) (encode-error e out))])
(handle [ref-exception:typelink] (eval-exn-handler out)
((termlink->proc main-ref))))))
; Uses racket pretty printing machinery to instead generate a file
; containing the given code, and which executes the main definition on
@ -89,11 +139,12 @@
; Decodes input and writes a module to the specified file.
(define (do-generate srcf)
(define-values (icode main-ref) (decode-input))
(define-values (icode main-ref) (decode-input (current-input-port)))
(write-module srcf main-ref icode))
(define generate-to (make-parameter #f))
(define show-version (make-parameter #f))
(define use-port-num (make-parameter #f))
(define (handle-command-line)
(command-line
@ -102,14 +153,36 @@
["--version"
"display version"
(show-version #t)]
[("-p" "--port")
port-num
"runtime communication port"
(use-port-num port-num)]
[("-G" "--generate-file")
file
"generate code to <file>"
(generate-to file)]))
(generate-to file)]
#:args remaining
(list->vector remaining)))
(begin
(handle-command-line)
(let ([sub-args (handle-command-line)])
(current-command-line-arguments sub-args))
(cond
[(show-version) (displayln "unison-runtime version 0.0.11")]
[(generate-to) (do-generate (generate-to))]
[else (do-evaluate)]))
[(use-port-num)
(match (string->number (use-port-num))
[port
#:when (port-number? port)
(let-values ([(in out) (tcp-connect "localhost" port)])
(do-evaluate in out)
(close-output-port out)
(close-input-port in))]
[#f
(displayln "could not parse port number")
(exit 1)]
[port
(displayln "bad port number")
(exit 1)])]
[else
(do-evaluate (current-input-port) (open-output-bytes))]))

View File

@ -78,7 +78,7 @@
declare-function-link
declare-code
exn:bug?
(struct-out exn:bug)
exn:bug->exception
exception->string
raise-unison-exception
@ -568,7 +568,7 @@
(let ([disp (describe-value f)])
(raise
(make-exn:bug
(string->chunked-string "builtin.bug")
(string->chunked-string "unhandled top level exception")
disp))))]]))
(begin-encourage-inline

View File

@ -2,8 +2,14 @@
(require ffi/unsafe
ffi/unsafe/define
racket/exn
racket/runtime-path
(for-syntax racket/base)
openssl/libcrypto
unison/chunked-seq)
unison/chunked-seq
racket/bool
(only-in openssl/sha1 bytes->hex-string hex-string->bytes)
)
(provide (prefix-out unison-FOp-crypto.
(combine-out
@ -17,15 +23,16 @@
HashAlgorithm.Blake2b_256
HashAlgorithm.Blake2b_512
hashBytes
hmacBytes)))
hmacBytes
Ed25519.sign.impl
Ed25519.verify.impl
)))
(define libcrypto
(with-handlers [[exn:fail? exn->string]]
(ffi-lib "libcrypto" openssl-lib-versions)))
(define-runtime-path libb2-so '(so "libb2" ("1" #f)))
(define libb2
(with-handlers [[exn:fail? exn->string]]
(ffi-lib "libb2" '("" "1"))))
(ffi-lib libb2-so '("1" #f))))
(define _EVP-pointer (_cpointer 'EVP))
@ -68,7 +75,7 @@
_int ; key-len
_pointer ; input
_int ; input-len
_pointer ; md
_pointer ; output pointer
_pointer ; null
-> _pointer ; unused
))))
@ -99,6 +106,134 @@
(define HashAlgorithm.Blake2s_256 (lc-algo "EVP_blake2s256" 256))
(define HashAlgorithm.Blake2b_512 (lc-algo "EVP_blake2b512" 512))
(define _EVP_PKEY-pointer (_cpointer 'EVP_PKEY))
(define _EVP_MD_CTX-pointer (_cpointer 'EVP_MD_CTX))
(define EVP_MD_CTX_new
(if (string? libcrypto)
(lambda _ (raise (error 'libcrypto "EVP_MD_CTX_create\n~a" libcrypto)))
(get-ffi-obj "EVP_MD_CTX_new" libcrypto
(_fun -> _EVP_MD_CTX-pointer
))))
; EVP_PKEY_new_raw_private_key(int type, NULL, const unsigned char *key, size_t keylen);
(define EVP_PKEY_new_raw_private_key
(if (string? libcrypto)
(lambda _ (raise (error 'libcrypto "EVP_PKEY_new_raw_private_key\n~a" libcrypto)))
(get-ffi-obj "EVP_PKEY_new_raw_private_key" libcrypto
(_fun
_int ; type
_pointer ; engine (null)
_pointer ; key
_int ; key-len
-> _EVP_PKEY-pointer
))))
; EVP_DigestSignInit(hctx, NULL, EVP_sha256(), NULL, pkey)
(define EVP_DigestSignInit
(if (string? libcrypto)
(lambda _ (raise (error 'libcrypto "EVP_DigestSignInit\n~a" libcrypto)))
(get-ffi-obj "EVP_DigestSignInit" libcrypto
(_fun
_EVP_MD_CTX-pointer
_pointer ; (null)
_pointer ; (null)
_pointer ; (null)
_EVP_PKEY-pointer ; pkey
-> _int
))))
; EVP_DigestSign(hctx, output, output-len-ptr, input-data, input-data-len)
(define EVP_DigestSign
(if (string? libcrypto)
(lambda _ (raise (error 'libcrypto "EVP_DigestSign\n~a" libcrypto)))
(get-ffi-obj "EVP_DigestSign" libcrypto
(_fun
_EVP_MD_CTX-pointer
_pointer ; output
(_ptr o _int) ; output-len (null prolly)
_pointer ; input-data
_int ; input-data-len
-> _int
))))
; EVP_PKEY_new_raw_public_key(int type, NULL, const unsigned char *key, size_t keylen);
(define EVP_PKEY_new_raw_public_key
(if (string? libcrypto)
(lambda _ (raise (error 'libcrypto "EVP_PKEY_new_raw_public_key\n~a" libcrypto)))
(get-ffi-obj "EVP_PKEY_new_raw_public_key" libcrypto
(_fun
_int ; type
_pointer ; engine (null)
_pointer ; key
_int ; key-len
-> _EVP_PKEY-pointer
))))
; int EVP_DigestVerifyInit(EVP_MD_CTX *ctx, EVP_PKEY_CTX **pctx,
; const EVP_MD *type, ENGINE *e, EVP_PKEY *pkey);
(define EVP_DigestVerifyInit
(if (string? libcrypto)
(lambda _ (raise (error 'libcrypto "EVP_DigestVerifyInit\n~a" libcrypto)))
(get-ffi-obj "EVP_DigestVerifyInit" libcrypto
(_fun
_EVP_MD_CTX-pointer
_pointer ; (null)
_pointer ; (null)
_pointer ; (null)
_EVP_PKEY-pointer ; pkey
-> _int
))))
; int EVP_DigestVerify(EVP_MD_CTX *ctx, const unsigned char *sig,
; size_t siglen, const unsigned char *tbs, size_t tbslen);
(define EVP_DigestVerify
(if (string? libcrypto)
(lambda _ (raise (error 'libcrypto "EVP_DigestVerify\n~a" libcrypto)))
(get-ffi-obj "EVP_DigestVerify" libcrypto
(_fun
_EVP_MD_CTX-pointer
_pointer ; signature
_int ; signature-len
_pointer ; input-data
_int ; input-data-len
-> _int
))))
(define EVP_PKEY_ED25519 1087)
(define (evpSign-raw seed input)
(let* ([ctx (EVP_MD_CTX_new)]
[pkey (EVP_PKEY_new_raw_private_key EVP_PKEY_ED25519 #f seed (bytes-length seed))])
(if (false? pkey)
(raise (error "Invalid seed provided."))
(if (<= (EVP_DigestSignInit ctx #f #f #f pkey) 0)
(raise (error "Initializing signing failed"))
(let* ([output (make-bytes 64)])
(if (<= (EVP_DigestSign ctx output input (bytes-length input)) 0)
(raise (error "Running digest failed"))
output))))))
(define (evpVerify-raw public-key input signature)
(let* ([ctx (EVP_MD_CTX_new)]
[pkey (EVP_PKEY_new_raw_public_key EVP_PKEY_ED25519 #f public-key (bytes-length public-key))])
(if (false? pkey)
(raise (error "Invalid seed provided."))
(if (<= (EVP_DigestVerifyInit ctx #f #f #f pkey) 0)
(raise (error "Initializing Verify failed"))
(if (<= (EVP_DigestVerify ctx signature (bytes-length signature) input (bytes-length input)) 0)
#f
#t)))))
(define (Ed25519.sign.impl seed _ignored_pubkey input)
(bytes->chunked-bytes (evpSign-raw (chunked-bytes->bytes seed) (chunked-bytes->bytes input))))
(define (Ed25519.verify.impl public-key input signature)
(evpVerify-raw
(chunked-bytes->bytes public-key)
(chunked-bytes->bytes input)
(chunked-bytes->bytes signature)))
; This one isn't provided by libcrypto, for some reason
(define (HashAlgorithm.Blake2b_256) (cons 'blake2b 256))
@ -154,17 +289,17 @@
(hashBytes-raw kind full)))
(define (hmacBytes kind key input)
(let ([key (chunked-bytes->bytes key)]
[input (chunked-bytes->bytes input)])
(bytes->chunked-bytes
(case (car kind)
['blake2b (hmacBlake kind key input)]
[else
(let* ([bytes (/ (cdr kind) 8)]
[output (make-bytes bytes)]
[algo (car kind)])
(HMAC algo key (bytes-length key) input (bytes-length input) output #f)
output)]))))
(bytes->chunked-bytes (hmacBytes-raw kind (chunked-bytes->bytes key) (chunked-bytes->bytes input))))
(define (hmacBytes-raw kind key input)
(case (car kind)
['blake2b (hmacBlake kind key input)]
[else
(let* ([bytes (/ (cdr kind) 8)]
[output (make-bytes bytes)]
[algo (car kind)])
(HMAC algo key (bytes-length key) input (bytes-length input) output #f)
output)]))
; These will only be evaluated by `raco test`
@ -172,67 +307,83 @@
(require rackunit
(only-in openssl/sha1 bytes->hex-string hex-string->bytes))
(test-case "ed25519 sign"
(check-equal?
(bytes->hex-string
(evpSign-raw
(hex-string->bytes "0000000000000000000000000000000000000000000000000000000000000000") #""))
"8f895b3cafe2c9506039d0e2a66382568004674fe8d237785092e40d6aaf483e4fc60168705f31f101596138ce21aa357c0d32a064f423dc3ee4aa3abf53f803"))
(test-case "ed25519 verify"
(check-equal?
(evpVerify-raw
(hex-string->bytes "3b6a27bcceb6a42d62a3a8d02a6f0d73653215771de243a63ac048a18b59da29")
#""
(hex-string->bytes "8f895b3cafe2c9506039d0e2a66382568004674fe8d237785092e40d6aaf483e4fc60168705f31f101596138ce21aa357c0d32a064f423dc3ee4aa3abf53f803")
)
#t))
(test-case "sha1 hmac"
(check-equal?
(bytes->hex-string (hmacBytes (HashAlgorithm.Sha1) #"key" #"message"))
(bytes->hex-string (hmacBytes-raw (HashAlgorithm.Sha1) #"key" #"message"))
"2088df74d5f2146b48146caf4965377e9d0be3a4"))
(test-case "blake2b-256 hmac"
(check-equal?
(bytes->hex-string (hmacBytes (HashAlgorithm.Blake2b_256) #"key" #"message"))
(bytes->hex-string (hmacBytes-raw (HashAlgorithm.Blake2b_256) #"key" #"message"))
"442d98a3872d3f56220f89e2b23d0645610b37c33dd3315ef224d0e39ada6751"))
(test-case "blake2b-512 hmac"
(check-equal?
(bytes->hex-string (hmacBytes (HashAlgorithm.Blake2b_512) #"key" #"message"))
(bytes->hex-string (hmacBytes-raw (HashAlgorithm.Blake2b_512) #"key" #"message"))
"04e9ada930688cde75eec939782eed653073dd621d7643f813702976257cf037d325b50eedd417c01b6ad1f978fbe2980a93d27d854044e8626df6fa279d6680"))
(test-case "blake2s-256 hmac"
(check-equal?
(bytes->hex-string (hmacBytes (HashAlgorithm.Blake2s_256) #"key" #"message"))
(bytes->hex-string (hmacBytes-raw (HashAlgorithm.Blake2s_256) #"key" #"message"))
"bba8fa28708ae80d249e317318c95c859f3f77512be23910d5094d9110454d6f"))
(test-case "md5 basic"
(check-equal?
(bytes->hex-string (hashBytes (HashAlgorithm.Md5) #""))
(bytes->hex-string (hashBytes-raw (HashAlgorithm.Md5) #""))
"d41d8cd98f00b204e9800998ecf8427e"))
(test-case "sha1 basic"
(check-equal?
(bytes->hex-string (hashBytes (HashAlgorithm.Sha1) #""))
(bytes->hex-string (hashBytes-raw (HashAlgorithm.Sha1) #""))
"da39a3ee5e6b4b0d3255bfef95601890afd80709"))
(test-case "sha2-256 basic"
(check-equal?
(bytes->hex-string (hashBytes (HashAlgorithm.Sha2_256) #""))
(bytes->hex-string (hashBytes-raw (HashAlgorithm.Sha2_256) #""))
"e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"))
(test-case "sha2-512 basic"
(check-equal?
(bytes->hex-string (hashBytes (HashAlgorithm.Sha2_512) #""))
(bytes->hex-string (hashBytes-raw (HashAlgorithm.Sha2_512) #""))
"cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e"))
(test-case "sha3-256 basic"
(check-equal?
(bytes->hex-string (hashBytes (HashAlgorithm.Sha3_256) #""))
(bytes->hex-string (hashBytes-raw (HashAlgorithm.Sha3_256) #""))
"a7ffc6f8bf1ed76651c14756a061d662f580ff4de43b49fa82d80a4b80f8434a"))
(test-case "sha3-512 basic"
(check-equal?
(bytes->hex-string (hashBytes (HashAlgorithm.Sha3_512) #""))
(bytes->hex-string (hashBytes-raw (HashAlgorithm.Sha3_512) #""))
"a69f73cca23a9ac5c8b567dc185a756e97c982164fe25859e0d1dcc1475c80a615b2123af1f5f94c11e3e9402c3ac558f500199d95b6d3e301758586281dcd26"))
(test-case "blake2s_256 basic"
(check-equal?
(bytes->hex-string (hashBytes (HashAlgorithm.Blake2s_256) #""))
(bytes->hex-string (hashBytes-raw (HashAlgorithm.Blake2s_256) #""))
"69217a3079908094e11121d042354a7c1f55b6482ca1a51e1b250dfd1ed0eef9"))
(test-case "blake2b_256 basic"
(check-equal?
(bytes->hex-string (hashBytes (HashAlgorithm.Blake2b_256) #""))
(bytes->hex-string (hashBytes-raw (HashAlgorithm.Blake2b_256) #""))
"0e5751c026e543b2e8ab2eb06099daa1d1e5df47778f7787faab45cdf12fe3a8"))
(test-case "blake2b_512 basic"
(check-equal?
(bytes->hex-string (hashBytes (HashAlgorithm.Blake2b_512) #""))
(bytes->hex-string (hashBytes-raw (HashAlgorithm.Blake2b_512) #""))
"786a02f742015903c6c6fd852552d272912f4740e15847618a86e217f71f5419d25e1031afee585313896444934eb04b903a685b1448b755d56f701afe9be2ce")))

View File

@ -46,6 +46,7 @@
; some exports of internal machinery for use elsewhere
gen-code
reify-value
reflect-value
termlink->name
add-runtime-code

View File

@ -6,4 +6,4 @@ true \
&& stack exec transcripts \
&& stack exec unison transcript unison-src/transcripts-round-trip/main.md \
&& stack exec unison transcript unison-src/transcripts-manual/rewrites.md \
&& stack exec integration-tests
&& stack exec cli-integration-tests

View File

@ -967,7 +967,7 @@ loop e = do
-- stepAt updateBuiltins
-- checkTodo
MergeBuiltinsI -> do
MergeBuiltinsI opath -> do
Cli.Env {codebase} <- ask
description <- inputDescription input
-- these were added once, but maybe they've changed and need to be
@ -983,10 +983,13 @@ loop e = do
-- due to builtin terms; so we don't just reuse `uf` above.
let srcb = BranchUtil.fromNames Builtin.names
currentPath <- Cli.getCurrentPath
_ <- Cli.updateAtM description (currentPath `snoc` "builtin") \destb ->
let destPath = case opath of
Just path -> Path.resolve currentPath (Path.Relative path)
Nothing -> currentPath `snoc` "builtin"
_ <- Cli.updateAtM description destPath \destb ->
liftIO (Branch.merge'' (Codebase.lca codebase) Branch.RegularMerge srcb destb)
Cli.respond Success
MergeIOBuiltinsI -> do
MergeIOBuiltinsI opath -> do
Cli.Env {codebase} <- ask
description <- inputDescription input
-- these were added once, but maybe they've changed and need to be
@ -1007,7 +1010,10 @@ loop e = do
let names0 = Builtin.names <> UF.typecheckedToNames IOSource.typecheckedFile'
let srcb = BranchUtil.fromNames names0
currentPath <- Cli.getCurrentPath
_ <- Cli.updateAtM description (currentPath `snoc` "builtin") \destb ->
let destPath = case opath of
Just path -> Path.resolve currentPath (Path.Relative path)
Nothing -> currentPath `snoc` "builtin"
_ <- Cli.updateAtM description destPath \destb ->
liftIO (Branch.merge'' (Codebase.lca codebase) Branch.RegularMerge srcb destb)
Cli.respond Success
ListEditsI maybePath -> do
@ -1305,8 +1311,10 @@ inputDescription input =
IOTestI hq -> pure ("io.test " <> HQ.toText hq)
IOTestAllI -> pure "io.test.all"
UpdateBuiltinsI -> pure "builtins.update"
MergeBuiltinsI -> pure "builtins.merge"
MergeIOBuiltinsI -> pure "builtins.mergeio"
MergeBuiltinsI Nothing -> pure "builtins.merge"
MergeBuiltinsI (Just path) -> ("builtins.merge " <>) <$> p path
MergeIOBuiltinsI Nothing -> pure "builtins.mergeio"
MergeIOBuiltinsI (Just path) -> ("builtins.mergeio " <>) <$> p path
MakeStandaloneI out nm -> pure ("compile " <> Text.pack out <> " " <> HQ.toText nm)
ExecuteSchemeI nm args ->
pure $ "run.native " <> Text.unwords (nm : fmap Text.pack args)
@ -1395,6 +1403,8 @@ inputDescription input =
where
hp' :: Either SCH.ShortCausalHash Path' -> Cli Text
hp' = either (pure . Text.pack . show) p'
p :: Path -> Cli Text
p = fmap tShow . Cli.resolvePath
p' :: Path' -> Cli Text
p' = fmap tShow . Cli.resolvePath'
brp :: BranchRelativePath -> Cli Text
@ -1429,24 +1439,28 @@ handleFindI ::
Cli ()
handleFindI isVerbose fscope ws input = do
Cli.Env {codebase} <- ask
currentBranch0 <- Cli.getCurrentBranch0
(pped, names) <- case fscope of
FindLocal -> do
let names = Branch.toNames (Branch.withoutLib currentBranch0)
(pped, names, searchRoot, branch0) <- case fscope of
FindLocal p -> do
searchRoot <- Cli.resolvePath p
branch0 <- Cli.getBranch0At searchRoot
let names = Branch.toNames (Branch.withoutLib branch0)
-- Don't exclude anything from the pretty printer, since the type signatures we print for
-- results may contain things in lib.
pped <- Cli.currentPrettyPrintEnvDecl
pure (pped, names)
FindLocalAndDeps -> do
let names = Branch.toNames (Branch.withoutTransitiveLibs currentBranch0)
pure (pped, names, Just p, branch0)
FindLocalAndDeps p -> do
searchRoot <- Cli.resolvePath p
branch0 <- Cli.getBranch0At searchRoot
let names = Branch.toNames (Branch.withoutTransitiveLibs branch0)
-- Don't exclude anything from the pretty printer, since the type signatures we print for
-- results may contain things in lib.
pped <- Cli.currentPrettyPrintEnvDecl
pure (pped, names)
pure (pped, names, Just p, branch0)
FindGlobal -> do
globalNames <- Names.makeAbsolute . Branch.toNames <$> Cli.getRootBranch0
pped <- Cli.prettyPrintEnvDeclFromNames globalNames
pure (pped, globalNames)
currentBranch0 <- Cli.getCurrentBranch0
pure (pped, globalNames, Nothing, currentBranch0)
let suffixifiedPPE = PPED.suffixifiedPPE pped
let getResults :: Names -> Cli [SearchResult]
getResults names =
@ -1455,7 +1469,7 @@ handleFindI isVerbose fscope ws input = do
-- type query
":" : ws -> do
typ <- parseSearchType (show input) (unwords ws)
let keepNamed = Set.intersection (Branch.deepReferents currentBranch0)
let keepNamed = Set.intersection (Branch.deepReferents branch0)
(noExactTypeMatches, matches) <- do
Cli.runTransaction do
matches <- keepNamed <$> Codebase.termsOfType codebase typ
@ -1481,16 +1495,16 @@ handleFindI isVerbose fscope ws input = do
(mapMaybe (HQ.parseTextWith anythingBeforeHash . Text.pack) qs)
pure $ uniqueBy SR.toReferent srs
let respondResults results = do
Cli.setNumberedArgs $ fmap searchResultToHQString results
Cli.setNumberedArgs $ fmap (searchResultToHQString searchRoot) results
results' <- Cli.runTransaction (Backend.loadSearchResults codebase results)
Cli.respond $ ListOfDefinitions fscope suffixifiedPPE isVerbose results'
results <- getResults names
case (results, fscope) of
([], FindLocal) -> do
([], FindLocal {}) -> do
Cli.respond FindNoLocalMatches
-- We've already searched everything else, so now we search JUST the
-- names in lib.
let mayOnlyLibBranch = currentBranch0 & Branch.children %%~ \cs -> Map.singleton NameSegment.libSegment <$> Map.lookup NameSegment.libSegment cs
let mayOnlyLibBranch = branch0 & Branch.children %%~ \cs -> Map.singleton NameSegment.libSegment <$> Map.lookup NameSegment.libSegment cs
case mayOnlyLibBranch of
Nothing -> respondResults []
Just onlyLibBranch -> do
@ -1804,11 +1818,14 @@ confirmedCommand i = do
pure $ Just i == (loopState ^. #lastInput)
-- | restores the full hash to these search results, for _numberedArgs purposes
searchResultToHQString :: SearchResult -> String
searchResultToHQString = \case
SR.Tm' n r _ -> Text.unpack $ HQ.toText $ HQ.requalify n r
SR.Tp' n r _ -> Text.unpack $ HQ.toText $ HQ.requalify n (Referent.Ref r)
searchResultToHQString :: Maybe Path -> SearchResult -> String
searchResultToHQString oprefix = \case
SR.Tm' n r _ -> Text.unpack $ HQ.toText $ HQ.requalify (addPrefix <$> n) r
SR.Tp' n r _ -> Text.unpack $ HQ.toText $ HQ.requalify (addPrefix <$> n) (Referent.Ref r)
_ -> error "impossible match failure"
where
addPrefix :: Name -> Name
addPrefix = maybe id Path.prefixName2 oprefix
-- return `name` and `name.<everything>...`
_searchBranchPrefix :: Branch m -> Name -> [SearchResult]

View File

@ -8,7 +8,6 @@ where
import Control.Concurrent.STM (atomically, modifyTVar', newTVarIO, readTVar, readTVarIO)
import Control.Lens (over, view, (.~), (^.), _1, _2)
import Control.Monad.Reader (ask)
import Data.List.NonEmpty qualified as Nel
import Data.Set.NonEmpty qualified as Set.NonEmpty
import Data.Text as Text
import Data.These (These (..))
@ -18,7 +17,6 @@ import Text.Builder qualified
import U.Codebase.HashTags (CausalHash (..))
import U.Codebase.Sqlite.DbId
import U.Codebase.Sqlite.Operations qualified as Operations
import U.Codebase.Sqlite.Operations qualified as Ops
import U.Codebase.Sqlite.Project qualified as Sqlite (Project)
import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite (ProjectBranch)
import U.Codebase.Sqlite.Queries qualified as Queries
@ -32,7 +30,6 @@ import Unison.Codebase (PushGitBranchOpts (..))
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch (Branch (..))
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Editor.HandleInput.AuthLogin (ensureAuthenticatedWithCodeserver)
import Unison.Codebase.Editor.HandleInput.AuthLogin qualified as AuthLogin
import Unison.Codebase.Editor.Input
( GistInput (..),
@ -46,13 +43,11 @@ import Unison.Codebase.Editor.Output.PushPull (PushPull (Push))
import Unison.Codebase.Editor.RemoteRepo
( ReadGitRemoteNamespace (..),
ReadRemoteNamespace (..),
ShareUserHandle (..),
WriteGitRemoteNamespace (..),
WriteRemoteNamespace (..),
WriteShareRemoteNamespace (..),
writeToReadGit,
)
import Unison.Codebase.Path (Path)
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.PushBehavior (PushBehavior)
import Unison.Codebase.PushBehavior qualified as PushBehavior
@ -231,77 +226,8 @@ pushLooseCodeToGitLooseCode localPath gitRemotePath pushBehavior syncMode = do
-- Push a local namespace ("loose code") to a Share-hosted remote namespace ("loose code").
pushLooseCodeToShareLooseCode :: Path.Absolute -> WriteShareRemoteNamespace -> PushBehavior -> Cli ()
pushLooseCodeToShareLooseCode localPath remote@WriteShareRemoteNamespace {server, repo, path = remotePath} behavior = do
let codeserver = Codeserver.resolveCodeserver server
let baseURL = codeserverBaseURL codeserver
let sharePath = Share.Path (shareUserHandleToText repo Nel.:| pathToSegments remotePath)
_ <- ensureAuthenticatedWithCodeserver codeserver
localCausalHash <-
Cli.runTransaction (Ops.loadCausalHashAtPath Nothing (pathToSegments (Path.unabsolute localPath))) & onNothingM do
Cli.returnEarly (EmptyLooseCodePush (Path.absoluteToPath' localPath))
let checkAndSetPush :: Maybe Hash32 -> Cli (Maybe Int)
checkAndSetPush remoteHash =
if Just (Hash32.fromHash (unCausalHash localCausalHash)) == remoteHash
then pure Nothing
else do
let push =
Cli.with withEntitiesUploadedProgressCallback \(uploadedCallback, getNumUploaded) -> do
result <-
Share.checkAndSetPush
baseURL
sharePath
remoteHash
localCausalHash
uploadedCallback
numUploaded <- liftIO getNumUploaded
pure (result, numUploaded)
push >>= \case
(Left err, _) -> pushError ShareErrorCheckAndSetPush err
(Right (), numUploaded) -> pure (Just numUploaded)
case behavior of
PushBehavior.ForcePush -> do
maybeHashJwt <-
Share.getCausalHashByPath baseURL sharePath & onLeftM \err0 ->
(Cli.returnEarly . Output.ShareError) case err0 of
Share.SyncError err -> ShareErrorGetCausalHashByPath err
Share.TransportError err -> ShareErrorTransport err
maybeNumUploaded <- checkAndSetPush (Share.API.hashJWTHash <$> maybeHashJwt)
whenJust maybeNumUploaded (Cli.respond . Output.UploadedEntities)
Cli.respond (ViewOnShare (Left remote))
PushBehavior.RequireEmpty -> do
maybeNumUploaded <- checkAndSetPush Nothing
whenJust maybeNumUploaded (Cli.respond . Output.UploadedEntities)
Cli.respond (ViewOnShare (Left remote))
PushBehavior.RequireNonEmpty -> do
let push :: Cli (Either (Share.SyncError Share.FastForwardPushError) (), Int)
push =
Cli.with withEntitiesUploadedProgressCallback \(uploadedCallback, getNumUploaded) -> do
result <-
Share.fastForwardPush
baseURL
sharePath
localCausalHash
uploadedCallback
numUploaded <- liftIO getNumUploaded
pure (result, numUploaded)
push >>= \case
(Left err, _) -> pushError ShareErrorFastForwardPush err
(Right (), numUploaded) -> do
Cli.respond (UploadedEntities numUploaded)
Cli.respond (ViewOnShare (Left remote))
where
pathToSegments :: Path -> [Text]
pathToSegments =
coerce Path.toList
pushError :: (a -> Output.ShareError) -> Share.SyncError a -> Cli b
pushError f err0 = do
Cli.returnEarly case err0 of
Share.SyncError err -> Output.ShareError (f err)
Share.TransportError err -> Output.ShareError (ShareErrorTransport err)
pushLooseCodeToShareLooseCode _ _ _ = do
Cli.returnEarly LooseCodePushDeprecated
-- Push a local namespace ("loose code") to a remote project branch.
pushLooseCodeToProjectBranch :: Bool -> Path.Absolute -> ProjectAndBranch ProjectName ProjectBranchName -> Cli ()

View File

@ -35,7 +35,7 @@ import Data.These (These)
import U.Codebase.HashTags (CausalHash)
import Unison.Codebase.Branch.Merge qualified as Branch
import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace, WriteGitRepo, WriteRemoteNamespace)
import Unison.Codebase.Path (Path')
import Unison.Codebase.Path (Path, Path')
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.Path.Parse qualified as Path
import Unison.Codebase.PushBehavior (PushBehavior)
@ -202,8 +202,8 @@ data Input
| ShowDefinitionByPrefixI OutputLocation [HQ.HashQualified Name]
| ShowReflogI
| UpdateBuiltinsI
| MergeBuiltinsI
| MergeIOBuiltinsI
| MergeBuiltinsI (Maybe Path)
| MergeIOBuiltinsI (Maybe Path)
| ListDependenciesI (HQ.HashQualified Name)
| ListDependentsI (HQ.HashQualified Name)
| -- | List all external dependencies of a given namespace, or the current namespace if
@ -313,8 +313,8 @@ data OutputLocation
deriving (Eq, Show)
data FindScope
= FindLocal
| FindLocalAndDeps
= FindLocal Path
| FindLocalAndDeps Path
| FindGlobal
deriving stock (Eq, Show)

View File

@ -394,6 +394,7 @@ data Output
| UpdateIncompleteConstructorSet UpdateOrUpgrade Name (Map ConstructorId Name) (Maybe Int)
| UpgradeFailure !FilePath !NameSegment !NameSegment
| UpgradeSuccess !NameSegment !NameSegment
| LooseCodePushDeprecated
data UpdateOrUpgrade = UOUUpdate | UOUUpgrade
@ -622,6 +623,7 @@ isFailure o = case o of
ProjectHasNoReleases {} -> True
UpgradeFailure {} -> True
UpgradeSuccess {} -> False
LooseCodePushDeprecated -> True
isNumberedFailure :: NumberedOutput -> Bool
isNumberedFailure = \case

View File

@ -105,9 +105,14 @@ mergeBuiltins =
"builtins.merge"
[]
I.Hidden
[]
"Adds the builtins to `builtins.` in the current namespace (excluding `io` and misc)."
(const . pure $ Input.MergeBuiltinsI)
[("namespace", Optional, namespaceArg)]
"Adds the builtins (excluding `io` and misc) to the specified namespace. Defaults to `builtin.`"
\case
[] -> pure . Input.MergeBuiltinsI $ Nothing
[p] -> first P.text do
p <- Path.parsePath p
pure . Input.MergeBuiltinsI $ Just p
_ -> Left (I.help mergeBuiltins)
mergeIOBuiltins :: InputPattern
mergeIOBuiltins =
@ -115,16 +120,21 @@ mergeIOBuiltins =
"builtins.mergeio"
[]
I.Hidden
[]
"Adds all the builtins to `builtins.` in the current namespace, including `io` and misc."
(const . pure $ Input.MergeIOBuiltinsI)
[("namespace", Optional, namespaceArg)]
"Adds all the builtins, including `io` and misc., to the specified namespace. Defaults to `builtin.`"
\case
[] -> pure . Input.MergeIOBuiltinsI $ Nothing
[p] -> first P.text do
p <- Path.parsePath p
pure . Input.MergeIOBuiltinsI $ Just p
_ -> Left (I.help mergeBuiltins)
updateBuiltins :: InputPattern
updateBuiltins =
InputPattern
"builtins.update"
[]
I.Visible
I.Hidden
[]
( "Adds all the builtins that are missing from this namespace, "
<> "and deprecate the ones that don't exist in this version of Unison."
@ -531,7 +541,7 @@ sfind :: InputPattern
sfind =
InputPattern "rewrite.find" ["sfind"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg parse
where
parse [q] = Input.StructuredFindI Input.FindLocal <$> parseHashQualifiedName q
parse [q] = Input.StructuredFindI (Input.FindLocal Path.empty) <$> parseHashQualifiedName q
parse _ = Left "expected exactly one argument"
msg =
P.lines
@ -589,14 +599,68 @@ sfindReplace =
]
find :: InputPattern
find = find' "find" Input.FindLocal
find = find' "find" (Input.FindLocal Path.empty)
findAll :: InputPattern
findAll = find' "find.all" Input.FindLocalAndDeps
findAll = find' "find.all" (Input.FindLocalAndDeps Path.empty)
findGlobal :: InputPattern
findGlobal = find' "find.global" Input.FindGlobal
findIn, findInAll :: InputPattern
findIn = findIn' "find-in" Input.FindLocal
findInAll = findIn' "find-in.all" Input.FindLocalAndDeps
findIn' :: String -> (Path.Path -> Input.FindScope) -> InputPattern
findIn' cmd mkfscope =
InputPattern
cmd
[]
I.Visible
[("namespace", Required, namespaceArg), ("query", ZeroPlus, exactDefinitionArg)]
findHelp
\case
p : args -> first P.text do
p <- Path.parsePath p
pure (Input.FindI False (mkfscope p) args)
_ -> Left findHelp
findHelp :: P.Pretty CT.ColorText
findHelp =
( P.wrapColumn2
[ ("`find`", "lists all definitions in the current namespace."),
( "`find foo`",
"lists all definitions with a name similar to 'foo' in the current "
<> "namespace (excluding those under 'lib')."
),
( "`find foo bar`",
"lists all definitions with a name similar to 'foo' or 'bar' in the "
<> "current namespace (excluding those under 'lib')."
),
( "`find-in namespace`",
"lists all definitions in the specified subnamespace."
),
( "`find-in namespace foo bar`",
"lists all definitions with a name similar to 'foo' or 'bar' in the "
<> "specified subnamespace."
),
( "find.all foo",
"lists all definitions with a name similar to 'foo' in the current "
<> "namespace (including one level of 'lib')."
),
( "`find-in.all namespace`",
"lists all definitions in the specified subnamespace (including one level of its 'lib')."
),
( "`find-in.all namespace foo bar`",
"lists all definitions with a name similar to 'foo' or 'bar' in the "
<> "specified subnamespace (including one level of its 'lib')."
),
( "find.global foo",
"lists all definitions with a name similar to 'foo' in any namespace"
)
]
)
find' :: String -> Input.FindScope -> InputPattern
find' cmd fscope =
InputPattern
@ -604,25 +668,7 @@ find' cmd fscope =
[]
I.Visible
[("query", ZeroPlus, exactDefinitionArg)]
( P.wrapColumn2
[ ("`find`", "lists all definitions in the current namespace."),
( "`find foo`",
"lists all definitions with a name similar to 'foo' in the current "
<> "namespace (excluding those under 'lib')."
),
( "`find foo bar`",
"lists all definitions with a name similar to 'foo' or 'bar' in the "
<> "current namespace (excluding those under 'lib')."
),
( "find.all foo",
"lists all definitions with a name similar to 'foo' in the current "
<> "namespace (including one level of 'lib')."
),
( "find.global foo",
"lists all definitions with a name similar to 'foo' in any namespace"
)
]
)
findHelp
(pure . Input.FindI False fscope)
findShallow :: InputPattern
@ -656,7 +702,7 @@ findVerbose =
( "`find.verbose` searches for definitions like `find`, but includes hashes "
<> "and aliases in the results."
)
(pure . Input.FindI True Input.FindLocal)
(pure . Input.FindI True (Input.FindLocal Path.empty))
findVerboseAll :: InputPattern
findVerboseAll =
@ -668,7 +714,7 @@ findVerboseAll =
( "`find.all.verbose` searches for definitions like `find.all`, but includes hashes "
<> "and aliases in the results."
)
(pure . Input.FindI True Input.FindLocalAndDeps)
(pure . Input.FindI True (Input.FindLocalAndDeps Path.empty))
findPatch :: InputPattern
findPatch =
@ -968,11 +1014,11 @@ aliasMany =
up :: InputPattern
up =
InputPattern
"up"
"deprecated.up"
[]
I.Visible
I.Hidden
[]
(P.wrapColumn2 [(makeExample up [], "move current path up one level")])
(P.wrapColumn2 [(makeExample up [], "move current path up one level (deprecated)")])
( \case
[] -> Right Input.UpI
_ -> Left (I.help up)
@ -981,12 +1027,12 @@ up =
cd :: InputPattern
cd =
InputPattern
"namespace"
["cd", "j"]
"deprecated.cd"
["deprecated.namespace"]
I.Visible
[("namespace", Required, namespaceArg)]
( P.lines
[ "Moves your perspective to a different namespace.",
[ "Moves your perspective to a different namespace. Deprecated for now because too many important things depend on your perspective selection.",
"",
P.wrapColumn2
[ ( makeExample cd ["foo.bar"],
@ -1020,7 +1066,7 @@ back =
[]
( P.wrapColumn2
[ ( makeExample back [],
"undoes the last" <> makeExample' cd <> "command."
"undoes the last" <> makeExample' projectSwitch <> "command."
)
]
)
@ -1233,15 +1279,18 @@ resetRoot =
InputPattern
"reset-root"
[]
I.Visible
I.Hidden
[("namespace or hash to reset to", Required, namespaceArg)]
( P.wrapColumn2
[ ( makeExample resetRoot [".foo"],
"Reset the root namespace (along with its history) to that of the `.foo` namespace."
),
( makeExample resetRoot ["#9dndk3kbsk13nbpeu"],
"Reset the root namespace (along with its history) to that of the namespace with hash `#9dndk3kbsk13nbpeu`."
)
( P.lines
[ "Deprecated because it's incompatible with projects. ⚠️ Warning, this command can cause codebase corruption.",
P.wrapColumn2
[ ( makeExample resetRoot [".foo"],
"Reset the root namespace (along with its history) to that of the `.foo` namespace. Deprecated"
),
( makeExample resetRoot ["#9dndk3kbsk13nbpeu"],
"Reset the root namespace (along with its history) to that of the namespace with hash `#9dndk3kbsk13nbpeu`."
)
]
]
)
\case
@ -2982,7 +3031,9 @@ validInputs =
editNamespace,
execute,
find,
findIn,
findAll,
findInAll,
findGlobal,
findPatch,
findShallow,

View File

@ -971,8 +971,8 @@ notifyUser dir = \case
pure . P.warnCallout . P.lines $
[ "Are you sure you want to clear away everything?",
"You could use "
<> IP.makeExample' IP.cd
<> " to switch to a new namespace instead."
<> IP.makeExample' IP.projectCreate
<> " to switch to a new project instead."
]
DeleteBranchConfirmation _uniqueDeletions -> error "todo"
-- let
@ -2223,8 +2223,16 @@ notifyUser dir = \case
<> P.group (P.text (NameSegment.toEscapedText new) <> ",")
<> "and removed"
<> P.group (P.text (NameSegment.toEscapedText old) <> ".")
where
_nameChange _cmd _pastTenseCmd _oldName _newName _r = error "todo"
LooseCodePushDeprecated ->
pure . P.warnCallout $
P.lines $
[ P.wrap $ "Unison Share's projects are now the new preferred way to store code, and storing code outside of a project has been deprecated.",
"",
P.wrap $ "Learn how to convert existing code into a project using this guide: ",
"https://www.unison-lang.org/docs/tooling/projects-library-migration/",
"",
"Your non-project code is still available to pull from Share, and you can pull it into a local namespace using `pull myhandle.public`"
]
expectedEmptyPushDest :: WriteRemoteNamespace Void -> Pretty
expectedEmptyPushDest namespace =

View File

@ -5,7 +5,7 @@ Next, we'll download the jit project and generate a few Racket files from it.
```ucm
.> project.create-empty jit-setup
jit-setup/main> pull @unison/internal/releases/0.0.14 lib.jit
jit-setup/main> pull @unison/internal/releases/0.0.15 lib.jit
```
```unison

View File

@ -20,9 +20,9 @@ Next, we'll download the jit project and generate a few Racket files from it.
🎉 🥳 Happy coding!
jit-setup/main> pull @unison/internal/releases/0.0.14 lib.jit
jit-setup/main> pull @unison/internal/releases/0.0.15 lib.jit
Downloaded 15053 entities.
Downloaded 15060 entities.

View File

@ -2,7 +2,7 @@ This transcript executes very slowly, because the compiler has an
entire copy of base (and other stuff) within it.
```ucm:hide
.> builtins.mergeio
.> builtins.merge
.> pull.without-history unison.public.base.trunk base
```

View File

@ -10,9 +10,7 @@ transcripts which contain less boilerplate.
## Usage
```ucm:hide
.> builtins.merge
.> builtins.mergeio
.> cd builtin
.> load unison-src/transcripts-using-base/base.u
.> add
```
@ -55,4 +53,3 @@ testAutoClean _ =
.> add
.> io.test testAutoClean
```

File diff suppressed because it is too large Load Diff

View File

@ -1,13 +1,3 @@
```ucm:hide
.> builtins.merge
.> builtins.mergeio
.> cd builtin
.> load unison-src/transcripts-using-base/base.u
.> add
.> find
```
```unison
unique type EncDec = EncDec Text (Nat -> Bytes) (Bytes -> Optional (Nat, Bytes))

View File

@ -1,4 +1,3 @@
```unison
unique type EncDec = EncDec Text (Nat -> Bytes) (Bytes -> Optional (Nat, Bytes))

View File

@ -1,10 +1,6 @@
Test for code serialization operations.
```ucm:hide
.> builtins.merge
```
Define a function, serialize it, then deserialize it back to an actual
function. Also ask for its dependencies for display later.
@ -138,8 +134,8 @@ verified name link =
with handleTest ("verified " ++ name)
rejected : Text -> [(Link.Term,Code)] ->{io2.IO} Result
rejected name rco =
handle verify name rco
rejected name rco =
handle verify name rco
with expectFailure ("rejected " ++ name)
missed : Text -> Link.Term -> Result

View File

@ -134,8 +134,8 @@ verified name link =
with handleTest ("verified " ++ name)
rejected : Text -> [(Link.Term,Code)] ->{io2.IO} Result
rejected name rco =
handle verify name rco
rejected name rco =
handle verify name rco
with expectFailure ("rejected " ++ name)
missed : Text -> Link.Term -> Result

View File

@ -1,9 +1,5 @@
# Computable documents in Unison
```ucm:hide
.> builtins.mergeio
```
Unison documentation is written in Unison and has some neat features:
* The documentation type provides a rich vocabulary of elements that go beyond markdown, including asides, callouts, tooltips, and more.

View File

@ -6,10 +6,6 @@ Exception ability directly, and the last is code validation. I don't
have an easy way to test the last at the moment, but the other two are
tested here.
```ucm:hide
.> builtins.mergeio
```
```unison
test1 : '{IO, Exception} [Result]
test1 = do

View File

@ -53,7 +53,6 @@ test2 = do
"Cannot decode byte '\\xee': Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
(Any ())
Stack trace:
##raise
@ -67,7 +66,6 @@ test2 = do
Failure (typeLink RuntimeFailure) "builtin.bug" (Any "whoa")
Stack trace:
##raise

View File

@ -1,30 +0,0 @@
```ucm:hide
.> builtins.mergeio
```
Tests some capabilities for catching runtime exceptions.
```unison
catcher : '{IO} () ->{IO} Result
catcher act =
handle tryEval act with cases
{ raise _ -> _ } -> Ok "caught"
{ _ } -> Fail "nothing to catch"
tests _ =
[ catcher do
_ = 1/0
()
, catcher '(bug "testing")
, handle tryEval (do 1+1) with cases
{ raise _ -> _ } -> Fail "1+1 failed"
{ 2 } -> Ok "got the right answer"
{ _ } -> Fail "got the wrong answer"
]
```
```ucm
.> add
.> io.test tests
```

View File

@ -1,56 +0,0 @@
Tests some capabilities for catching runtime exceptions.
```unison
catcher : '{IO} () ->{IO} Result
catcher act =
handle tryEval act with cases
{ raise _ -> _ } -> Ok "caught"
{ _ } -> Fail "nothing to catch"
tests _ =
[ catcher do
_ = 1/0
()
, catcher '(bug "testing")
, handle tryEval (do 1+1) with cases
{ raise _ -> _ } -> Fail "1+1 failed"
{ 2 } -> Ok "got the right answer"
{ _ } -> Fail "got the wrong answer"
]
```
```ucm
Loading changes detected in scratch.u.
I found and typechecked these definitions in scratch.u. If you
do an `add` or `update`, here's how your codebase would
change:
⍟ These new definitions are ok to `add`:
catcher : '{IO} () ->{IO} Result
tests : ∀ _. _ ->{IO} [Result]
```
```ucm
.> add
⍟ I've added these definitions:
catcher : '{IO} () ->{IO} Result
tests : ∀ _. _ ->{IO} [Result]
.> io.test tests
New test results:
◉ tests caught
◉ tests caught
◉ tests got the right answer
✅ 3 test(s) passing
Tip: Use view tests to view the source of a test.
```

View File

@ -1,13 +1,9 @@
Tests a former error due to bad calling conventions on delay.impl
```ucm:hide
.> builtins.mergeio
```
```unison
timingApp2 : '{IO, Exception} ()
timingApp2 _ =
timingApp2 _ =
printLine "Hello"
delay 10
printLine "World"

View File

@ -3,7 +3,7 @@ Tests a former error due to bad calling conventions on delay.impl
```unison
timingApp2 : '{IO, Exception} ()
timingApp2 _ =
timingApp2 _ =
printLine "Hello"
delay 10
printLine "World"

View File

@ -1,7 +1,3 @@
```ucm:hide
.> builtins.mergeio
```
This file tests some obscure issues involved with abilities and over-applied
functions.
@ -15,7 +11,7 @@ Stream.map : (a -> b) -> '{Stream a} r -> '{Stream b} r
Stream.map f stream = handle !stream with Stream.map.handler f
Stream.map.handler : (a -> b) -> Request {Stream a} r -> '{Stream b} r
Stream.map.handler f = cases
Stream.map.handler f = cases
{Stream.emit a -> resume} -> 'let
Stream.emit (f a)
Stream.map f resume ()
@ -27,12 +23,12 @@ increment n = 1 + n
> Stream.toList (Stream.map increment (Stream.fromList [1,2,3]))
> let
s1 = do emit 10
s1 = do emit 10
emit 20
emit 30
emit 40
s2 = Stream.map (a -> a * 10) s1
Stream.toList s2
Stream.toList s2
```
```unison

View File

@ -11,7 +11,7 @@ Stream.map : (a -> b) -> '{Stream a} r -> '{Stream b} r
Stream.map f stream = handle !stream with Stream.map.handler f
Stream.map.handler : (a -> b) -> Request {Stream a} r -> '{Stream b} r
Stream.map.handler f = cases
Stream.map.handler f = cases
{Stream.emit a -> resume} -> 'let
Stream.emit (f a)
Stream.map f resume ()
@ -23,12 +23,12 @@ increment n = 1 + n
> Stream.toList (Stream.map increment (Stream.fromList [1,2,3]))
> let
s1 = do emit 10
s1 = do emit 10
emit 20
emit 30
emit 40
s2 = Stream.map (a -> a * 10) s1
Stream.toList s2
Stream.toList s2
```
```ucm
@ -57,7 +57,7 @@ increment n = 1 + n
[2, 3, 4]
22 | s1 = do emit 10
22 | s1 = do emit 10
[100, 200, 300, 400]

View File

@ -1,8 +1,3 @@
```ucm:hide
.> builtins.mergeio
```
```unison
arrayList v n = do
use ImmutableByteArray read8

View File

@ -1,4 +1,3 @@
```unison
arrayList v n = do
use ImmutableByteArray read8

View File

@ -1,7 +1,3 @@
```ucm:hide
.> builtins.merge
```
Test case for a variable capture problem during let floating. The
encloser wasn't accounting for variables bound by matches.
@ -17,20 +13,20 @@ x _ = ()
works x = x + 1
run : '{Issue t} () -> '{Stream Text} ()
run s =
run s =
go = cases
{ one x -> resume } ->
{ one x -> resume } ->
emit "one"
handle resume !x with go
{ two x -> resume } ->
{ two x -> resume } ->
emit "two"
handle resume !x with go
{ three x -> resume } ->
{ three x -> resume } ->
emit "three"
handle resume !x with go
{ _ } -> emit "done"
do handle !s with go
> Stream.toList <| run do
Issue.one do
Issue.two do

View File

@ -13,20 +13,20 @@ x _ = ()
works x = x + 1
run : '{Issue t} () -> '{Stream Text} ()
run s =
run s =
go = cases
{ one x -> resume } ->
{ one x -> resume } ->
emit "one"
handle resume !x with go
{ two x -> resume } ->
{ two x -> resume } ->
emit "two"
handle resume !x with go
{ three x -> resume } ->
{ three x -> resume } ->
emit "three"
handle resume !x with go
{ _ } -> emit "done"
do handle !s with go
> Stream.toList <| run do
Issue.one do
Issue.two do

View File

@ -1,10 +1,5 @@
# Hashing and HMAC builtins
```ucm:hide
.> builtins.merge
.> cd builtin
```
Unison has cryptographic builtins for hashing and computing [HMACs](https://en.wikipedia.org/wiki/HMAC) (hash-based message authentication codes). This transcript shows their usage and has some test cases.
```ucm
@ -48,8 +43,7 @@ ex5 = crypto.hmac Sha2_256 mysecret f |> hex
And here's the full API:
```ucm
.builtin.crypto> find
.> cd .
.> find-in builtin.crypto
```
Note that the universal versions of `hash` and `hmac` are currently unimplemented and will bomb at runtime:
@ -263,4 +257,3 @@ test> md5.tests.ex3 =
```ucm
.> test
```

View File

@ -120,18 +120,18 @@ ex5 = crypto.hmac Sha2_256 mysecret f |> hex
And here's the full API:
```ucm
.builtin.crypto> find
.> find-in builtin.crypto
1. type CryptoFailure
2. Ed25519.sign.impl : ##Bytes
-> ##Bytes
-> ##Bytes
-> #0o7mf021fo #r29dja8j9d ##Bytes
3. Ed25519.verify.impl : ##Bytes
-> ##Bytes
-> ##Bytes
-> #0o7mf021fo #r29dja8j9d ##Boolean
4. hash : HashAlgorithm -> a -> ##Bytes
2. Ed25519.sign.impl : Bytes
-> Bytes
-> Bytes
-> Either Failure Bytes
3. Ed25519.verify.impl : Bytes
-> Bytes
-> Bytes
-> Either Failure Boolean
4. hash : HashAlgorithm -> a -> Bytes
5. builtin type HashAlgorithm
6. HashAlgorithm.Blake2b_256 : HashAlgorithm
7. HashAlgorithm.Blake2b_512 : HashAlgorithm
@ -142,13 +142,11 @@ And here's the full API:
12. HashAlgorithm.Sha2_512 : HashAlgorithm
13. HashAlgorithm.Sha3_256 : HashAlgorithm
14. HashAlgorithm.Sha3_512 : HashAlgorithm
15. hashBytes : HashAlgorithm -> ##Bytes -> ##Bytes
16. hmac : HashAlgorithm -> ##Bytes -> a -> ##Bytes
17. hmacBytes : HashAlgorithm -> ##Bytes -> ##Bytes -> ##Bytes
15. hashBytes : HashAlgorithm -> Bytes -> Bytes
16. hmac : HashAlgorithm -> Bytes -> a -> Bytes
17. hmacBytes : HashAlgorithm -> Bytes -> Bytes -> Bytes
.> cd .
```
Note that the universal versions of `hash` and `hmac` are currently unimplemented and will bomb at runtime:

View File

@ -1,9 +1,5 @@
# namespace.dependencies command
```ucm:hide
.external> builtins.merge
```
```unison:hide
external.mynat = 1
mynamespace.dependsOnText = external.mynat Nat.+ 10

View File

@ -1,11 +1,3 @@
>
```ucm:hide
.> builtins.merge
.> cd builtin
.> load unison-src/transcripts-using-base/base.u
.> add
```
```unison
testNat: Nat -> Optional Int -> Optional Float -> {Stream Result}()

View File

@ -1,4 +1,3 @@
>
```unison
testNat: Nat -> Optional Int -> Optional Float -> {Stream Result}()
testNat n expectInt expectFloat =

View File

@ -1,7 +1,3 @@
```ucm:hide
.> builtins.mergeio
```
```unison
directory = "unison-src/transcripts-using-base/serialized-cases/"
@ -15,7 +11,7 @@ gen seed k =
c = 1442695040888963407
a = 6364136223846793005
(mod seed k, a * seed + c)
shuffle : Nat -> [a] -> [a]
shuffle =
pick acc seed = cases
@ -24,7 +20,7 @@ shuffle =
(k, seed) -> match (take k l, drop k l) with
(pre, x +: post) -> pick (acc :+ x) seed (pre ++ post)
(pre, []) -> pick acc seed pre
pick []
runTestCase : Text ->{Exception,IO} (Text, Test.Result)
@ -51,7 +47,7 @@ runTestCase name =
then Fail (name ++ " legacy mismatch")
else Ok name
(name, result)
serialTests : '{IO,Exception} [Test.Result]
serialTests = do
l = !availableCases

View File

@ -11,7 +11,7 @@ gen seed k =
c = 1442695040888963407
a = 6364136223846793005
(mod seed k, a * seed + c)
shuffle : Nat -> [a] -> [a]
shuffle =
pick acc seed = cases
@ -20,7 +20,7 @@ shuffle =
(k, seed) -> match (take k l, drop k l) with
(pre, x +: post) -> pick (acc :+ x) seed (pre ++ post)
(pre, []) -> pick acc seed pre
pick []
runTestCase : Text ->{Exception,IO} (Text, Test.Result)
@ -47,7 +47,7 @@ runTestCase name =
then Fail (name ++ " legacy mismatch")
else Ok name
(name, result)
serialTests : '{IO,Exception} [Test.Result]
serialTests = do
l = !availableCases

View File

@ -1,7 +1,3 @@
```ucm:hide
.> builtins.mergeio
```
```unison
structural type Tree a = Leaf | Node (Tree a) a (Tree a)
@ -9,9 +5,9 @@ foldMap : r -> (r -> r -> r) -> (a -> r) -> Tree a -> r
foldMap z m f =
walk = cases
Leaf -> z
Node l x r -> m (walk l) (m (f x) (walk r))
Node l x r -> m (walk l) (m (f x) (walk r))
walk
walk
tree0 : Tree Nat
tree0 =

View File

@ -5,9 +5,9 @@ foldMap : r -> (r -> r -> r) -> (a -> r) -> Tree a -> r
foldMap z m f =
walk = cases
Leaf -> z
Node l x r -> m (walk l) (m (f x) (walk r))
Node l x r -> m (walk l) (m (f x) (walk r))
walk
walk
tree0 : Tree Nat
tree0 =

View File

@ -1,7 +1,3 @@
```ucm:hide
.> builtins.mergeio
```
```unison
l1 = [1.0,2.0,3.0]
l2 = [+1,+2,+3]

View File

@ -1,7 +1,3 @@
```ucm:hide
.> builtins.mergeio
```
```unison
structural ability Exit a where
exit : a -> b

View File

@ -1,7 +1,3 @@
```ucm:hide
.> builtins.mergeio
```
```unison
structural ability DC r where
shift : ((a -> r) -> r) -> a

View File

@ -1,7 +1,3 @@
```ucm:hide
.> builtins.mergeio
```
```unison
mutual0 = cases

View File

@ -2,10 +2,6 @@
https://github.com/unisonweb/unison/issues/2195
```ucm:hide
.> builtins.merge
```
We add a simple definition.
```unison:hide

View File

@ -1,13 +1,5 @@
# Tests for TLS builtins
```ucm:hide
.> builtins.merge
.> builtins.mergeio
.> cd builtin
.> load unison-src/transcripts-using-base/base.u
.> add
```
```unison:hide
-- generated with:
-- openssl req -newkey rsa:2048 -subj '/CN=test.unison.cloud/O=Unison/C=US' -nodes -keyout key.pem -x509 -days 3650 -out cert.pem
@ -61,7 +53,7 @@ serverThread portVar toSend = 'let
cert = decodeCert (toUtf8 self_signed_cert_pem2)
-- assume there is exactly one key decoded from our Bytes
key = match (decodePrivateKey (toUtf8 self_signed_key_pem)) with
key = match (decodePrivateKey (toUtf8 self_signed_key_pem)) with
k +: _ -> k
[] -> bug "oh no"

View File

@ -80,7 +80,7 @@ serverThread portVar toSend = 'let
cert = decodeCert (toUtf8 self_signed_cert_pem2)
-- assume there is exactly one key decoded from our Bytes
key = match (decodePrivateKey (toUtf8 self_signed_key_pem)) with
key = match (decodePrivateKey (toUtf8 self_signed_key_pem)) with
k +: _ -> k
[] -> bug "oh no"

View File

@ -1,11 +1,5 @@
Test for new Text -> Bytes conversions explicitly using UTF-8 as the encoding
```ucm:hide
.> builtins.merge
.> builtins.mergeio
.> cd builtin
```
Unison has function for converting between `Text` and a UTF-8 `Bytes` encoding of the Text.
```ucm
@ -31,13 +25,13 @@ greek = "ΑΒΓΔΕ"
> toUtf8 greek
```
We can check that encoding and then decoding should give us back the same `Text` we started with
We can check that encoding and then decoding should give us back the same `Text` we started with
```unison
checkRoundTrip: Text -> [Result]
checkRoundTrip t =
checkRoundTrip t =
bytes = toUtf8 t
match fromUtf8.impl bytes with
match fromUtf8.impl bytes with
Left e -> [Result.Fail "could not decode"]
Right t' -> if t == t' then [Result.Ok "Passed"] else [Result.Fail ("Got: " ++ t' ++ " Expected: " ++ t)]

View File

@ -71,13 +71,13 @@ greek = "ΑΒΓΔΕ"
0xsce91ce92ce93ce94ce95
```
We can check that encoding and then decoding should give us back the same `Text` we started with
We can check that encoding and then decoding should give us back the same `Text` we started with
```unison
checkRoundTrip: Text -> [Result]
checkRoundTrip t =
checkRoundTrip t =
bytes = toUtf8 t
match fromUtf8.impl bytes with
match fromUtf8.impl bytes with
Left e -> [Result.Fail "could not decode"]
Right t' -> if t == t' then [Result.Ok "Passed"] else [Result.Fail ("Got: " ++ t' ++ " Expected: " ++ t)]

View File

@ -114,8 +114,7 @@ Let's try it!
```ucm
.> alias.many stuff.List.adjacentPairs stuff.List.all stuff.List.any stuff.List.chunk stuff.List.chunksOf stuff.List.dropWhile stuff.List.first stuff.List.init stuff.List.intersperse stuff.List.isEmpty stuff.List.last stuff.List.replicate stuff.List.splitAt stuff.List.tail stuff.List.takeWhile .mylib
.> cd .mylib
.mylib> find
.> find-in mylib
```
Thanks, `alias.many`!

View File

@ -46,33 +46,23 @@ Let's try it!
Tip: You can use `undo` or `reflog` to undo this change.
.> cd .mylib
.mylib> find
.> find-in mylib
1. stuff.List.adjacentPairs : [a] -> [(a, a)]
2. stuff.List.all : (a ->{g} ##Boolean)
-> [a]
->{g} ##Boolean
3. stuff.List.any : (a ->{g} ##Boolean)
-> [a]
->{g} ##Boolean
4. stuff.List.chunk : ##Nat -> [a] -> [[a]]
5. stuff.List.chunksOf : ##Nat -> [a] -> [[a]]
6. stuff.List.dropWhile : (a ->{g} ##Boolean)
-> [a]
->{g} [a]
7. stuff.List.first : [a] -> #nirp5os0q6 a
8. stuff.List.init : [a] -> #nirp5os0q6 [a]
2. stuff.List.all : (a ->{g} Boolean) -> [a] ->{g} Boolean
3. stuff.List.any : (a ->{g} Boolean) -> [a] ->{g} Boolean
4. stuff.List.chunk : Nat -> [a] -> [[a]]
5. stuff.List.chunksOf : Nat -> [a] -> [[a]]
6. stuff.List.dropWhile : (a ->{g} Boolean) -> [a] ->{g} [a]
7. stuff.List.first : [a] -> Optional a
8. stuff.List.init : [a] -> Optional [a]
9. stuff.List.intersperse : a -> [a] -> [a]
10. stuff.List.isEmpty : [a] -> ##Boolean
11. stuff.List.last : [a] -> #nirp5os0q6 a
12. stuff.List.replicate : ##Nat -> a -> [a]
13. stuff.List.splitAt : ##Nat -> [a] -> ([a], [a])
14. stuff.List.tail : [a] -> #nirp5os0q6 [a]
15. stuff.List.takeWhile : (a ->{𝕖} ##Boolean)
-> [a]
->{𝕖} [a]
10. stuff.List.isEmpty : [a] -> Boolean
11. stuff.List.last : [a] -> Optional a
12. stuff.List.replicate : Nat -> a -> [a]
13. stuff.List.splitAt : Nat -> [a] -> ([a], [a])
14. stuff.List.tail : [a] -> Optional [a]
15. stuff.List.takeWhile : (a ->{𝕖} Boolean) -> [a] ->{𝕖} [a]
```

View File

@ -2,7 +2,6 @@
```ucm:hide
.> builtins.mergeio
.> cd builtin
.> load unison-src/transcripts-using-base/base.u
.> add
```
@ -11,9 +10,9 @@ Any.unsafeExtract is a way to extract the value contained in an Any. This is uns
```unison
test> Any.unsafeExtract.works =
test> Any.unsafeExtract.works =
use Nat !=
checks [1 == Any.unsafeExtract (Any 1),
checks [1 == Any.unsafeExtract (Any 1),
not (1 == Any.unsafeExtract (Any 2)),
(Some 1) == Any.unsafeExtract (Any (Some 1))
]
@ -22,4 +21,3 @@ test> Any.unsafeExtract.works =
```ucm
.> add
```

View File

@ -3,9 +3,9 @@
Any.unsafeExtract is a way to extract the value contained in an Any. This is unsafe because it allows the programmer to coerce a value into any type, which would cause undefined behaviour if used to coerce a value to the wrong type.
```unison
test> Any.unsafeExtract.works =
test> Any.unsafeExtract.works =
use Nat !=
checks [1 == Any.unsafeExtract (Any 1),
checks [1 == Any.unsafeExtract (Any 1),
not (1 == Any.unsafeExtract (Any 2)),
(Some 1) == Any.unsafeExtract (Any (Some 1))
]
@ -26,7 +26,7 @@ test> Any.unsafeExtract.works =
Now evaluating any watch expressions (lines starting with
`>`)... Ctrl+C cancels.
3 | checks [1 == Any.unsafeExtract (Any 1),
3 | checks [1 == Any.unsafeExtract (Any 1),
✅ Passed Passed

View File

@ -2,7 +2,6 @@
```ucm:hide
.> builtins.mergeio
.> cd builtin
.> load unison-src/transcripts-using-base/base.u
.> add
```
@ -276,8 +275,8 @@ test> Text.tests.indexOf =
Text.indexOf needle8 haystack == None,
Text.indexOf needle9 haystack == Some 0,
]
test> Text.tests.indexOfEmoji =
test> Text.tests.indexOfEmoji =
haystack = "clap 👏 your 👏 hands 👏 if 👏 you 👏 love 👏 unison"
needle1 = "👏"
needle2 = "👏 "

View File

@ -257,8 +257,8 @@ test> Text.tests.indexOf =
Text.indexOf needle8 haystack == None,
Text.indexOf needle9 haystack == Some 0,
]
test> Text.tests.indexOfEmoji =
test> Text.tests.indexOfEmoji =
haystack = "clap 👏 your 👏 hands 👏 if 👏 you 👏 love 👏 unison"
needle1 = "👏"
needle2 = "👏 "

View File

@ -1,46 +0,0 @@
## Switching between namespaces / projects / branches / modules
Unison uses the same organizational element to represent directories, projects, sub-projects, forks, modules, etc.; currently called a "namespace".
Namespaces are trees that contain definitions of "types" and "terms", "patches", and other child namespaces.
We're still working out what a nice codebase layout might be (feel free to write up a blog post if you find one that works well for you), but in this example, we have these, along with their children (not shown):
> .libs.base
> .libs.megaparser.master
> .libs.megaparser.v1
> .libs.megaparser.v2
> .arya.base
> .arya.myproject
> .pullrequests.runarorama.base_3.base
> .pullrequests.runarorama.base_3.head
> .pullrequests.runarorama.base_3.merged
> .temp
```ucm:hide
.> builtins.merge
.> move.namespace builtin .arya.base
```
```ucm
.> cd arya.base
.arya.base> find Boolean
```
```ucm:hide
.arya.base> cd .arya.myproject
```
blah blah blah more stuff about project management and patches and the value of working from the appropriate namespace, and what that is in any given case
We can pop back to the previous namespace with the `back` command.
```ucm:hide
.arya.myproject> back
```
```ucm:hide
.arya.base> back
```
```ucm:error
.> back
```
😬 Right, ok.

View File

@ -1,40 +0,0 @@
## Switching between namespaces / projects / branches / modules
Unison uses the same organizational element to represent directories, projects, sub-projects, forks, modules, etc.; currently called a "namespace".
Namespaces are trees that contain definitions of "types" and "terms", "patches", and other child namespaces.
We're still working out what a nice codebase layout might be (feel free to write up a blog post if you find one that works well for you), but in this example, we have these, along with their children (not shown):
> .libs.base
> .libs.megaparser.master
> .libs.megaparser.v1
> .libs.megaparser.v2
> .arya.base
> .arya.myproject
> .pullrequests.runarorama.base_3.base
> .pullrequests.runarorama.base_3.head
> .pullrequests.runarorama.base_3.merged
> .temp
```ucm
.> cd arya.base
.arya.base> find Boolean
1. builtin type Boolean
2. Boolean.not : Boolean -> Boolean
```
blah blah blah more stuff about project management and patches and the value of working from the appropriate namespace, and what that is in any given case
We can pop back to the previous namespace with the `back` command.
```ucm
.> back
You're already at the very beginning! 🙂
```
😬 Right, ok.

View File

@ -78,7 +78,7 @@ Deleting the root namespace should require confirmation if not forced.
⚠️
Are you sure you want to clear away everything?
You could use `namespace` to switch to a new namespace instead.
You could use `project.create` to switch to a new project instead.
.> delete.namespace .

View File

@ -48,7 +48,6 @@ structural ability X a1 a2 where x : ()
.ns1> alias.term fromJust fromJust'
.ns1> alias.term helloWorld helloWorld2
.ns1> fork .ns1 .ns2
.ns1> cd .
```
Here's what we've done so far:

View File

@ -137,8 +137,6 @@ structural ability X a1 a2 where x : ()
Done.
.ns1> cd .
```
Here's what we've done so far:

View File

@ -3,8 +3,7 @@ If `foo#old` exists in old, and `foo#new` exists in new, you might think `upgrad
```ucm:hide
.> project.create-empty foo
foo/main> builtins.merge
foo/main> move.namespace builtin lib.builtin
foo/main> builtins.merge lib.builtin
```
```unison

View File

@ -1,5 +1,5 @@
```ucm:hide
.lib> builtins.mergeio
.> builtins.mergeio lib.builtin
```
```unison:hide

View File

@ -35,7 +35,7 @@ And for a limited time, you can get even more builtin goodies:
.foo> ls
1. builtin/ (641 terms, 92 types)
1. builtin/ (643 terms, 92 types)
```
More typically, you'd start out by pulling `base.

View File

@ -1,23 +1,44 @@
```unison
```ucm:hide
.> builtins.merge
.> move builtin lib.builtin
```
```unison:hide
foo = 1
lib.foo = 2
lib.bar = 3
cat.foo = 4
cat.lib.foo = 5
cat.lib.bar = 6
somewhere.bar = 7
```
```ucm
```ucm:hide
.> add
```
```ucm
.> find foo
.> view 1
.> find.all foo
.> view 1
```
```ucm
.somewhere> find.global foo
.> find-in cat foo
.> view 1
.> find-in.all cat foo
.> view 1
```
```ucm
.somewhere> find bar
.somewhere> find.global bar
```
```ucm
.> find bar
.> find-in somewhere bar
```
```ucm:error
@ -25,5 +46,5 @@ lib.bar = 3
```
```ucm:error
.> find.global nothere
.> find.global notHere
```

View File

@ -2,59 +2,84 @@
foo = 1
lib.foo = 2
lib.bar = 3
cat.foo = 4
cat.lib.foo = 5
cat.lib.bar = 6
somewhere.bar = 7
```
```ucm
Loading changes detected in scratch.u.
I found and typechecked these definitions in scratch.u. If you
do an `add` or `update`, here's how your codebase would
change:
⍟ These new definitions are ok to `add`:
foo : ##Nat
lib.bar : ##Nat
lib.foo : ##Nat
```
```ucm
.> add
⍟ I've added these definitions:
foo : ##Nat
lib.bar : ##Nat
lib.foo : ##Nat
```
```ucm
.> find foo
1. foo : ##Nat
1. cat.foo : Nat
2. foo : Nat
.> view 1
cat.foo : Nat
cat.foo = 4
.> find.all foo
1. cat.foo : Nat
2. cat.lib.foo : Nat
3. lib.foo : Nat
4. foo : Nat
.> view 1
cat.foo : Nat
cat.foo = 4
```
```ucm
☝️ The namespace .somewhere is empty.
.> find-in cat foo
.somewhere> find.global foo
1. foo : Nat
1. .foo : ##Nat
2. .lib.foo : ##Nat
.> view 1
cat.foo : Nat
cat.foo = 4
.> find-in.all cat foo
1. lib.foo : Nat
2. foo : Nat
.> view 1
cat.lib.foo : Nat
cat.lib.foo = 5
```
```ucm
.somewhere> find bar
1. bar : ##Nat
.somewhere> find.global bar
1. .cat.lib.bar : Nat
2. .lib.bar : Nat
3. .somewhere.bar : Nat
```
```ucm
.> find bar
☝️
1. somewhere.bar : Nat
I couldn't find matches in this namespace, searching in
'lib'...
1. lib.bar : ##Nat
.> find-in somewhere bar
1. bar : Nat
```
@ -76,7 +101,7 @@ lib.bar = 3
```
```ucm
.> find.global nothere
.> find.global notHere
😶

View File

@ -1,6 +1,6 @@
```ucm:hide
.> builtins.mergeio
.> builtins.merge
```
```unison:hide

View File

@ -1,7 +1,7 @@
```ucm:hide
.> builtins.mergeio
.> builtins.merge
```
```unison

View File

@ -54,33 +54,29 @@ myServer = unsafeRun! '(hello "127.0.0.1" "0")
do an `add` or `update`, here's how your codebase would
change:
⊡ Previously added definitions will be ignored: Exception
⍟ These new definitions are ok to `add`:
structural type Either a b
(also named builtin.Either)
bugFail : Failure -> r
hello : Text -> Text ->{IO, Exception} ()
myServer : '{IO} ()
putText : Handle -> Text ->{IO, Exception} ()
reraise : Either Failure b ->{Exception} b
(also named Exception.reraise)
socketSend : Socket -> Bytes ->{IO, Exception} ()
toException : Either Failure a ->{Exception} a
(also named Exception.reraise)
⍟ These names already exist. You can `update` them to your
new definition:
structural ability Exception
(also named builtin.Exception)
Exception.unsafeRun! : '{g, Exception} a -> '{g} a
bugFail : Failure -> r
closeSocket : Socket ->{IO, Exception} ()
hello : Text -> Text ->{IO, Exception} ()
myServer : '{IO} ()
putBytes : Handle
-> Bytes
->{IO, Exception} ()
putText : Handle -> Text ->{IO, Exception} ()
reraise : Either Failure b ->{Exception} b
serverSocket : Optional Text
-> Text
->{IO, Exception} Socket
socketSend : Socket
-> Bytes
->{IO, Exception} ()
toException : Either Failure a ->{Exception} a
```
```ucm
@ -93,7 +89,6 @@ myServer = unsafeRun! '(hello "127.0.0.1" "0")
Failure (typeLink IOFailure) "problem" (Any ())
Stack trace:
bug
#8ppr1tt4q2

View File

@ -51,3 +51,29 @@ Fold.Stream.fold =
res = Fold.Stream.fold (folds.all pred) (Stream.range 1 5)
!res Universal.== false
```
Tests some capabilities for catching runtime exceptions.
```unison
catcher : '{IO} () ->{IO} Result
catcher act =
handle tryEval act with cases
{ raise _ -> _ } -> Ok "caught"
{ _ } -> Fail "nothing to catch"
tests _ =
[ catcher do
_ = 1/0
()
, catcher '(bug "testing")
, handle tryEval (do 1+1) with cases
{ raise _ -> _ } -> Fail "1+1 failed"
{ 2 } -> Ok "got the right answer"
{ _ } -> Fail "got the wrong answer"
]
```
```ucm
.> add
.> io.test tests
```

View File

@ -85,3 +85,59 @@ Fold.Stream.fold =
true
```
Tests some capabilities for catching runtime exceptions.
```unison
catcher : '{IO} () ->{IO} Result
catcher act =
handle tryEval act with cases
{ raise _ -> _ } -> Ok "caught"
{ _ } -> Fail "nothing to catch"
tests _ =
[ catcher do
_ = 1/0
()
, catcher '(bug "testing")
, handle tryEval (do 1+1) with cases
{ raise _ -> _ } -> Fail "1+1 failed"
{ 2 } -> Ok "got the right answer"
{ _ } -> Fail "got the wrong answer"
]
```
```ucm
Loading changes detected in scratch.u.
I found and typechecked these definitions in scratch.u. If you
do an `add` or `update`, here's how your codebase would
change:
⍟ These new definitions are ok to `add`:
catcher : '{IO} () ->{IO} Result
tests : ∀ _. _ ->{IO} [Result]
```
```ucm
.> add
⍟ I've added these definitions:
catcher : '{IO} () ->{IO} Result
tests : ∀ _. _ ->{IO} [Result]
.> io.test tests
New test results:
◉ tests caught
◉ tests caught
◉ tests got the right answer
✅ 3 test(s) passing
Tip: Use view tests to view the source of a test.
```

View File

@ -4,4 +4,4 @@
```ucm
.> display List.map
```
```

View File

@ -1,19 +1,19 @@
```ucm:hide
.> builtins.mergeio
.> builtins.merge
```
```unison
```unison
lexicalScopeEx: [Text]
lexicalScopeEx =
lexicalScopeEx =
parent = "outer"
inner1 = let
inner1 = let
child1 = "child1"
inner2 : [Text]
inner2 = let
inner2 = let
child2 = "child2"
[parent, child1, child2]
inner2
inner1
```
```

View File

@ -1,11 +1,11 @@
```unison
lexicalScopeEx: [Text]
lexicalScopeEx =
lexicalScopeEx =
parent = "outer"
inner1 = let
inner1 = let
child1 = "child1"
inner2 : [Text]
inner2 = let
inner2 = let
child2 = "child2"
[parent, child1, child2]
inner2

View File

@ -5,10 +5,9 @@
Ensure closing token is emitted by closing brace in doc eval block.
```ucm
.> load ./unison-src/transcripts-using-base/fix2244.u
.> load ./unison-src/transcripts/fix2244.u
```
```ucm:hide
.> add
```

View File

@ -1,14 +1,14 @@
Ensure closing token is emitted by closing brace in doc eval block.
```ucm
.> load ./unison-src/transcripts-using-base/fix2244.u
.> load ./unison-src/transcripts/fix2244.u
Loading changes detected in
./unison-src/transcripts-using-base/fix2244.u.
./unison-src/transcripts/fix2244.u.
I found and typechecked these definitions in
./unison-src/transcripts-using-base/fix2244.u. If you do an
`add` or `update`, here's how your codebase would change:
./unison-src/transcripts/fix2244.u. If you do an `add` or
`update`, here's how your codebase would change:
⍟ These new definitions are ok to `add`:

View File

@ -3,7 +3,7 @@ Tests an issue where pattern matching matrices involving built-in
types was discarding default cases in some branches.
```ucm:hide
.> builtins.mergeio
.> builtins.merge
```
```unison

View File

@ -18,17 +18,17 @@ should be typed in the following way:
the ability that contains `e`.
```ucm
.> builtins.mergeio
.> builtins.merge
```
```unison
structural ability Stream a where
structural ability Stream a where
emit : a -> ()
Stream.uncons : '{Stream a, g} r ->{g} Either r (a, '{Stream a, g} r)
Stream.uncons s =
Stream.uncons s =
go : Request {Stream a,g} r -> Either r (a, '{Stream a,g} r)
go = cases
go = cases
{ r } -> Left r
{ Stream.emit a -> tl } -> Right (a, tl : '{Stream a,g} r)
handle !s with go

View File

@ -18,19 +18,19 @@ should be typed in the following way:
the ability that contains `e`.
```ucm
.> builtins.mergeio
.> builtins.merge
Done.
```
```unison
structural ability Stream a where
structural ability Stream a where
emit : a -> ()
Stream.uncons : '{Stream a, g} r ->{g} Either r (a, '{Stream a, g} r)
Stream.uncons s =
Stream.uncons s =
go : Request {Stream a,g} r -> Either r (a, '{Stream a,g} r)
go = cases
go = cases
{ r } -> Left r
{ Stream.emit a -> tl } -> Right (a, tl : '{Stream a,g} r)
handle !s with go

View File

@ -1,6 +1,6 @@
```ucm:hide
.> builtins.mergeio
.> builtins.merge
```
Array comparison was indexing out of bounds.

View File

@ -1,6 +1,6 @@
```ucm:hide
.> project.create-empty foo
foo/main> builtins.mergeio
foo/main> builtins.merge
```
```unison

View File

@ -0,0 +1,10 @@
```ucm:hide
.> builtins.merge
```
Just a simple test case to see whether partially applied
builtins decompile properly.
```unison
> (+) 2
```

View File

@ -0,0 +1,23 @@
Just a simple test case to see whether partially applied
builtins decompile properly.
```unison
> (+) 2
```
```ucm
Loading changes detected in scratch.u.
scratch.u changed.
Now evaluating any watch expressions (lines starting with
`>`)... Ctrl+C cancels.
1 | > (+) 2
(Nat.+) 2
```

Some files were not shown because too many files have changed in this diff Show More