diff --git a/.github/ISSUE_TEMPLATE/bug_report.md b/.github/ISSUE_TEMPLATE/bug_report.md index 17adbc9c3e..f57cddbd1d 100644 --- a/.github/ISSUE_TEMPLATE/bug_report.md +++ b/.github/ISSUE_TEMPLATE/bug_report.md @@ -8,33 +8,18 @@ assignees: '' --- **Describe and demonstrate the bug** -Please attach a [ucm transcript](https://www.unison-lang.org/docs/tooling/transcripts/) if possible, calling out the unexpected behavior in the text. e.g. +This should be written as a [ucm transcript](https://www.unison-lang.org/docs/tooling/transcripts/) if possible, calling out the unexpected behavior in the text. e.g. -Input: -```` -```unison:hide -a = 1 -``` -Here I typo the next command and `ucm` silently does nothing. I would have expected an error message: -```ucm -.> add b -``` -```` - -Output: -```` -```unison +``` unison :hide a = 1 ``` Here I typo the next command and `ucm` silently does nothing, I would have expected an error message: -```ucm -.> add b - +``` ucm +scratch/main> add b ``` -```` **Screenshots** If applicable, add screenshots to help explain your problem. diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index db53c80ac0..bd05781b39 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -13,7 +13,7 @@ on: required: true env: - racket_version: "8.7" + racket_version: "8.14" defaults: run: @@ -25,7 +25,7 @@ jobs: strategy: fail-fast: false matrix: - os: [ubuntu-20.04, macos-12, windows-2019] + os: [ubuntu-20.04, macos-13, macos-14, windows-2019] runs-on: ${{matrix.os}} steps: - uses: actions/checkout@v4 @@ -56,7 +56,7 @@ jobs: tries=5 for (( i = 0; i < $tries; i++ )); do stack build :unison \ - --flag unison-parser-typechecker:optimized \ + --ghc-options='-O2' \ --local-bin-path ucm-bin \ --copy-bins \ && break; @@ -91,7 +91,16 @@ jobs: runs-on: ${{matrix.os}} steps: - name: set up environment - run: echo "ucm=${{ runner.temp }}/unison" >> $GITHUB_ENV + run: | + echo "ucm=${{ runner.temp }}/unison" >> $GITHUB_ENV + case "$RUNNER_ARCH" in + X86) racket_arch=x86 ;; + X64) racket_arch=x64 ;; + ARM) racket_arch=arm32 ;; + ARM64) racket_arch=arm64 ;; + *) echo "Unsupported architecture: ${{runner.arch}}"; exit 1 ;; + esac + echo "racket_arch=$racket_arch" >> $GITHUB_ENV - name: download racket `unison` source uses: actions/checkout@v4 with: @@ -107,7 +116,7 @@ jobs: ${{ env.ucm }} transcript unison-src/transcripts-manual/gen-racket-libs.md - uses: Bogdanp/setup-racket@v1.11 with: - architecture: "x64" + architecture: ${{ env.racket_arch }} distribution: "full" variant: "CS" version: ${{env.racket_version}} @@ -132,7 +141,8 @@ jobs: matrix: os: - ubuntu-20.04 - - macos-12 + - macos-13 + - macos-14 - windows-2019 runs-on: ${{matrix.os}} steps: @@ -155,9 +165,19 @@ jobs: # This isn't right because unison.zip is going to include different dates each time. # Maybe we can unpack it and hash the contents. key: ${{ runner.os }}-racket-${{env.racket_version}}-${{hashFiles('scheme-libs/racket/unison.zip')}} + - name: set up environment + run: | + case "$RUNNER_ARCH" in + X86) racket_arch=x86 ;; + X64) racket_arch=x64 ;; + ARM) racket_arch=arm32 ;; + ARM64) racket_arch=arm64 ;; + *) echo "Unsupported architecture: ${{runner.arch}}"; exit 1 ;; + esac + echo "racket_arch=$racket_arch" >> $GITHUB_ENV - uses: Bogdanp/setup-racket@v1.11 with: - architecture: "x64" + architecture: ${{ env.racket_arch }} distribution: "full" variant: "CS" version: ${{env.racket_version}} @@ -191,12 +211,12 @@ jobs: strategy: fail-fast: false matrix: - os: [ubuntu-20.04, macos-12, windows-2019] + os: [ubuntu-20.04, macos-13, macos-14, windows-2019] steps: - name: set up environment run: | staging_dir="${RUNNER_TEMP//\\//}/ucm-staging" - artifact_os="$(echo $RUNNER_OS | tr '[:upper:]' '[:lower:]')" + artifact_os="$(echo "${RUNNER_OS}-${RUNNER_ARCH}" | tr '[:upper:]' '[:lower:]')" echo "staging_dir=$staging_dir" >> $GITHUB_ENV echo "artifact_os=$artifact_os" >> $GITHUB_ENV - name: download ucm @@ -246,7 +266,7 @@ jobs: file: ucm.cmd content: | @echo off - SET UCM_WEB_UI="%~dp0ui" + SET UCM_WEB_UI=%~dp0ui "%~dp0unison\unison.exe" --runtime-path "%~dp0runtime\unison-runtime.exe" %* - name: package everything together run: | diff --git a/.github/workflows/ci-build-jit-binary.yaml b/.github/workflows/ci-build-jit-binary.yaml index 5b3244e2f0..446d3c187a 100644 --- a/.github/workflows/ci-build-jit-binary.yaml +++ b/.github/workflows/ci-build-jit-binary.yaml @@ -10,7 +10,7 @@ defaults: env: jit_src: unison-jit-src/ jit_dist: unison-jit-dist/ - racket_version: "8.7" + racket_version: "8.14" jobs: build-jit-binary: @@ -18,7 +18,7 @@ jobs: strategy: fail-fast: false matrix: - os: [ubuntu-20.04, macOS-12, windows-2019] + os: [ubuntu-20.04, macOS-13, windows-2019] runs-on: ${{matrix.os}} steps: - name: set up environment @@ -54,7 +54,7 @@ jobs: with: name: jit-source path: ${{ env.jit_src }} - + - name: cache/restore jit binaries id: cache-jit-binaries uses: actions/cache/restore@v4 diff --git a/.github/workflows/ci-test-jit.yaml b/.github/workflows/ci-test-jit.yaml index 6162c535f2..6760304cfb 100644 --- a/.github/workflows/ci-test-jit.yaml +++ b/.github/workflows/ci-test-jit.yaml @@ -4,7 +4,7 @@ on: workflow_call: env: - runtime_tests_version: "@unison/runtime-tests/main" + runtime_tests_version: "@unison/runtime-tests/releases/0.0.1" # 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" @@ -24,7 +24,7 @@ jobs: matrix: os: - ubuntu-20.04 - - macOS-12 + - macOS-13 # - windows-2019 runs-on: ${{matrix.os}} steps: diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index ba690c2ca6..d162852e92 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -14,8 +14,8 @@ on: env: ## Some version numbers that are used during CI ormolu_version: 0.7.2.0 - jit_version: "@unison/internal/releases/0.0.18" - runtime_tests_version: "@unison/runtime-tests/main" + jit_version: "@unison/internal/releases/0.0.25" + runtime_tests_version: "@unison/runtime-tests/releases/0.0.1" ## Some cached directories # a temp path for caching a built `ucm` @@ -38,7 +38,6 @@ jobs: steps: - uses: actions/checkout@v4 - name: Get changed files - id: changed-files uses: tj-actions/changed-files@v44 with: # globs copied from default settings for run-ormolu @@ -72,7 +71,7 @@ jobs: os: # While iterating on this file, you can disable one or more of these to speed things up - ubuntu-20.04 - - macOS-12 + - macOS-13 - windows-2019 # - windows-2022 steps: @@ -97,7 +96,8 @@ jobs: uses: actions/cache@v4 with: path: ${{env.ucm_local_bin}} - key: ucm-${{ matrix.os }}-${{ hashFiles('**/stack.yaml', '**/package.yaml', '**/*.hs')}} + key: ucm-${{ matrix.os }}-${{ hashFiles('**/stack.yaml', '**/package.yaml', '**/*.hs', '**/unison-cli-integration/integrationtests/IntegrationTests/*')}} + # added the integration test dependencies here as if they were source, for simplicity - name: restore stack caches if: steps.cache-ucm-binaries.outputs.cache-hit != 'true' @@ -218,7 +218,7 @@ jobs: os: # While iterating on this file, you can disable one or more of these to speed things up - ubuntu-20.04 - - macOS-12 + - macos-13 - windows-2019 # - windows-2022 steps: @@ -244,7 +244,7 @@ jobs: uses: actions/cache@v4 with: path: ${{env.transcript_test_results}} - key: transcripts-results-${{ matrix.os }}-${{ hashFiles('**/stack.yaml', '**/package.yaml', '**/*.hs')}}-${{ hashFiles('**/unison-src/**/*.md') }} + key: transcripts-results-${{ matrix.os }}-${{ hashFiles('**/stack.yaml', '**/package.yaml', '**/*.hs')}}-${{ hashFiles('**/unison-src/**/*.md', '**/unison-src/**/*.u') }} - name: restore binaries uses: actions/cache/restore@v4 if: steps.cache-transcript-test-results.outputs.cache-hit != 'true' @@ -297,7 +297,7 @@ jobs: os: # While iterating on this file, you can disable one or more of these to speed things up - ubuntu-20.04 - - macOS-12 + - macos-13 # - windows-2019 # - windows-2022 steps: @@ -387,14 +387,14 @@ jobs: path: ${{ runner.temp }}/setup-jit.md write-mode: overwrite contents: | - ```ucm + ``` ucm scratch/main> project.create-empty jit-setup jit-setup/main> lib.install ${{ env.jit_version }} ``` - ```unison + ``` unison go = generateSchemeBoot "${{ env.jit_generated_src_scheme }}" ``` - ```ucm + ``` ucm jit-setup/main> run go ``` - name: download ucm artifact diff --git a/.github/workflows/nix-dev-cache.yaml b/.github/workflows/nix-dev-cache.yaml index 2ac6857c37..4fc2eb167e 100644 --- a/.github/workflows/nix-dev-cache.yaml +++ b/.github/workflows/nix-dev-cache.yaml @@ -1,14 +1,15 @@ name: Nix development cache on: - # Build on every pull request (and new PR commit) - pull_request: - # Build on new pushes to trunk (E.g. Merge commits) - # Without the branch filter, each commit on a branch with a PR is triggered twice. - # See: https://github.community/t/how-to-trigger-an-action-on-push-or-pull-request-but-not-both/16662 - push: - branches: - - trunk + workflow_dispatch: + # # Build on every pull request (and new PR commit) + # pull_request: + # # Build on new pushes to trunk (E.g. Merge commits) + # # Without the branch filter, each commit on a branch with a PR is triggered twice. + # # See: https://github.community/t/how-to-trigger-an-action-on-push-or-pull-request-but-not-both/16662 + # push: + # branches: + # - trunk jobs: nix: @@ -20,8 +21,8 @@ jobs: matrix: os: - ubuntu-20.04 - - macOS-12 - - macOS-14 + - macOS-13 + # - macOS-14 steps: - uses: actions/checkout@v4 - name: mount Nix store on larger partition @@ -45,4 +46,5 @@ jobs: - name: build all packages and development shells run: nix -L build --accept-flake-config --no-link --keep-going '.#all' - name: print disk free status + if: always() run: df -h diff --git a/.github/workflows/ormolu.yaml b/.github/workflows/ormolu.yaml index 6a7fe9f22b..b070db0e61 100644 --- a/.github/workflows/ormolu.yaml +++ b/.github/workflows/ormolu.yaml @@ -7,7 +7,7 @@ on: workflow_dispatch: env: - ormolu_version: "0.5.2.0" + ormolu_version: "0.7.2.0" jobs: ormolu: diff --git a/.github/workflows/update-transcripts.yaml b/.github/workflows/update-transcripts.yaml index 90c206d045..7b298656e9 100644 --- a/.github/workflows/update-transcripts.yaml +++ b/.github/workflows/update-transcripts.yaml @@ -12,7 +12,7 @@ jobs: strategy: matrix: os: - - macOS-12 + - macOS-13 steps: - uses: actions/checkout@v4 - uses: unisonweb/actions/stack/cache/restore@main diff --git a/.gitignore b/.gitignore index 0379b0b953..73abb61777 100644 --- a/.gitignore +++ b/.gitignore @@ -26,6 +26,8 @@ dist-newstyle *.prof *.prof.html *.profiterole.* +*.hp +*.ps /.direnv/ /.envrc diff --git a/.mergify.yml b/.mergify.yml index e20da83972..a22da3eed2 100644 --- a/.mergify.yml +++ b/.mergify.yml @@ -3,20 +3,20 @@ pull_request_rules: conditions: - check-success=check-contributor - check-success=build ucm (ubuntu-20.04) - - check-success=build ucm (macOS-12) + - check-success=build ucm (macos-13) - check-success=build ucm (windows-2019) - check-success=run transcripts (ubuntu-20.04) - - check-success=run transcripts (macOS-12) + - check-success=run transcripts (macos-13) - check-success=run transcripts (windows-2019) - check-success=run interpreter tests (ubuntu-20.04) - - check-success=run interpreter tests (macOS-12) + - check-success=run interpreter tests (macos-13) # - check-success=run interpreter tests (windows-2019) - check-success=generate jit source - check-success=build jit binary / build jit binary (ubuntu-20.04) - - check-success=build jit binary / build jit binary (macOS-12) + - check-success=build jit binary / build jit binary (macos-13) - check-success=build jit binary / build jit binary (windows-2019) - check-success=test jit / test jit (ubuntu-20.04) - - check-success=test jit / test jit (macOS-12) + - check-success=test jit / test jit (macos-13) # - check-success=test jit / test jit (windows-2019) - label=ready-to-merge - "#approved-reviews-by>=1" diff --git a/CONTRIBUTORS.markdown b/CONTRIBUTORS.markdown index 5649b15dd0..413ef3da70 100644 --- a/CONTRIBUTORS.markdown +++ b/CONTRIBUTORS.markdown @@ -87,3 +87,5 @@ The format for this list: name, GitHub handle * Dan Doel (@dolio) * Eric Torreborre (@etorreborre) * Eduard Nicodei (@neduard) +* Brian McKenna (@puffnfresh) +* Ruslan Simchuk (@SimaDovakin) diff --git a/CREDITS.md b/CREDITS.md index 321060f338..bd367b3aef 100644 --- a/CREDITS.md +++ b/CREDITS.md @@ -52,7 +52,6 @@ These are listed in alphabetical order. | [comonad-5.0.6](https://hackage.haskell.org/package/comonad-5.0.6) | [BSD3](https://hackage.haskell.org/package/comonad-5.0.6/src/LICENSE) | | [concurrent-supply-0.1.8](https://hackage.haskell.org/package/concurrent-supply-0.1.8) | [BSD3](https://hackage.haskell.org/package/concurrent-supply-0.1.8/src/LICENSE) | | [conduit-1.3.2](https://hackage.haskell.org/package/conduit-1.3.2) | [MIT](https://hackage.haskell.org/package/conduit-1.3.2/src/LICENSE) | -| [configurator-0.3.0.0](https://hackage.haskell.org/package/configurator-0.3.0.0) | [BSD3](https://hackage.haskell.org/package/configurator-0.3.0.0/src/LICENSE) | | [containers-0.6.2.1](https://hackage.haskell.org/package/containers-0.6.2.1) | [BSD3](https://hackage.haskell.org/package/containers-0.6.2.1/src/LICENSE) | | [contravariant-1.5.2](https://hackage.haskell.org/package/contravariant-1.5.2) | [BSD3](https://hackage.haskell.org/package/contravariant-1.5.2/src/LICENSE) | | [cryptohash-md5-0.11.100.1](https://hackage.haskell.org/package/cryptohash-md5-0.11.100.1) | [BSD3](https://hackage.haskell.org/package/cryptohash-md5-0.11.100.1/src/LICENSE) | diff --git a/codebase2/codebase-sqlite-hashing-v2/package.yaml b/codebase2/codebase-sqlite-hashing-v2/package.yaml index 9e32e8546b..9087faf399 100644 --- a/codebase2/codebase-sqlite-hashing-v2/package.yaml +++ b/codebase2/codebase-sqlite-hashing-v2/package.yaml @@ -6,10 +6,7 @@ ghc-options: -Wall dependencies: - base - - bytes - - bytestring - containers - - generic-lens - lens - text - unison-codebase @@ -19,11 +16,8 @@ dependencies: - unison-hash - unison-hashing-v2 - unison-prelude - - unison-sqlite - unison-syntax - - unison-util-base32hex - unison-util-term - - vector library: source-dirs: src diff --git a/codebase2/codebase-sqlite-hashing-v2/unison-codebase-sqlite-hashing-v2.cabal b/codebase2/codebase-sqlite-hashing-v2/unison-codebase-sqlite-hashing-v2.cabal index 67e88874b7..b71dddd506 100644 --- a/codebase2/codebase-sqlite-hashing-v2/unison-codebase-sqlite-hashing-v2.cabal +++ b/codebase2/codebase-sqlite-hashing-v2/unison-codebase-sqlite-hashing-v2.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -56,10 +56,7 @@ library ghc-options: -Wall build-depends: base - , bytes - , bytestring , containers - , generic-lens , lens , text , unison-codebase @@ -69,9 +66,6 @@ library , unison-hash , unison-hashing-v2 , unison-prelude - , unison-sqlite , unison-syntax - , unison-util-base32hex , unison-util-term - , vector default-language: Haskell2010 diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 389907dd3d..936dd91cdf 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -2862,32 +2862,45 @@ before x y = selectAncestorsOfY = ancestorSql y lca :: CausalHashId -> CausalHashId -> Transaction (Maybe CausalHashId) -lca x y = - queryStreamCol (ancestorSql x) \nextX -> - queryStreamCol (ancestorSql y) \nextY -> do - let getNext = (,) <$> nextX <*> nextY - loop2 seenX seenY = - getNext >>= \case - (Just px, Just py) -> - let seenX' = Set.insert px seenX - seenY' = Set.insert py seenY - in if Set.member px seenY' - then pure (Just px) - else - if Set.member py seenX' - then pure (Just py) - else loop2 seenX' seenY' - (Nothing, Nothing) -> pure Nothing - (Just px, Nothing) -> loop1 nextX seenY px - (Nothing, Just py) -> loop1 nextY seenX py - loop1 getNext matches v = - if Set.member v matches - then pure (Just v) - else - getNext >>= \case - Just v -> loop1 getNext matches v - Nothing -> pure Nothing - loop2 (Set.singleton x) (Set.singleton y) +lca alice bob = + queryMaybeCol + [sql| + WITH RECURSIVE history_one (causal_id) AS ( + SELECT :alice + UNION + SELECT causal_parent.parent_id + FROM history_one + JOIN causal_parent ON history_one.causal_id = causal_parent.causal_id + ), + history_two (causal_id) AS ( + SELECT :bob + UNION + SELECT causal_parent.parent_id + FROM history_two + JOIN causal_parent ON history_two.causal_id = causal_parent.causal_id + ), + common_ancestors (causal_id) AS ( + SELECT causal_id + FROM history_one + INTERSECT + SELECT causal_id + FROM history_two + ORDER BY causal_id DESC + ) + SELECT causal_id + FROM common_ancestors + WHERE NOT EXISTS ( + SELECT 1 + FROM causal_parent + WHERE causal_parent.parent_id = common_ancestors.causal_id + AND EXISTS ( + SELECT 1 + FROM common_ancestors c + WHERE c.causal_id = causal_parent.causal_id + ) + ) + LIMIT 1 + |] ancestorSql :: CausalHashId -> Sql ancestorSql h = @@ -3528,7 +3541,11 @@ getProjectReflog numEntries projectId = SELECT project_id, project_branch_id, time, from_root_causal_id, to_root_causal_id, reason FROM project_branch_reflog WHERE project_id = :projectId - ORDER BY time DESC + ORDER BY + time DESC, + -- Strictly for breaking ties in transcripts with the same time, + -- this will break ties in the correct order, sorting later inserted rows first. + ROWID DESC LIMIT :numEntries |] @@ -3540,7 +3557,11 @@ getProjectBranchReflog numEntries projectBranchId = SELECT project_id, project_branch_id, time, from_root_causal_id, to_root_causal_id, reason FROM project_branch_reflog WHERE project_branch_id = :projectBranchId - ORDER BY time DESC + ORDER BY + time DESC, + -- Strictly for breaking ties in transcripts with the same time, + -- this will break ties in the correct order, sorting later inserted rows first. + ROWID DESC LIMIT :numEntries |] @@ -3551,7 +3572,11 @@ getGlobalReflog numEntries = [sql| SELECT project_id, project_branch_id, time, from_root_causal_id, to_root_causal_id, reason FROM project_branch_reflog - ORDER BY time DESC + ORDER BY + time DESC, + -- Strictly for breaking ties in transcripts with the same time, + -- this will break ties in the correct order, sorting later inserted rows first. + ROWID DESC LIMIT :numEntries |] diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Sync22.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Sync22.hs deleted file mode 100644 index beb2591be2..0000000000 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Sync22.hs +++ /dev/null @@ -1,414 +0,0 @@ -{-# LANGUAGE ApplicativeDo #-} -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE ViewPatterns #-} - -module U.Codebase.Sqlite.Sync22 where - -import Control.Monad.Except (MonadError (throwError)) -import Control.Monad.Validate (ValidateT, runValidateT) -import Control.Monad.Validate qualified as Validate -import Data.Bitraversable (bitraverse) -import Data.Bytes.Get (runGetS) -import Data.Bytes.Put (runPutS) -import Data.List.Extra (nubOrd) -import Data.Set qualified as Set -import Data.Vector qualified as Vector -import U.Codebase.Reference qualified as Reference -import U.Codebase.Sqlite.Branch.Format qualified as BL -import U.Codebase.Sqlite.DbId -import U.Codebase.Sqlite.Decl.Format qualified as DeclFormat -import U.Codebase.Sqlite.HashHandle (HashHandle) -import U.Codebase.Sqlite.LocalIds qualified as L -import U.Codebase.Sqlite.ObjectType qualified as OT -import U.Codebase.Sqlite.Patch.Format qualified as PL -import U.Codebase.Sqlite.Queries qualified as Q -import U.Codebase.Sqlite.Reference qualified as Sqlite -import U.Codebase.Sqlite.Reference qualified as Sqlite.Reference -import U.Codebase.Sqlite.Referent qualified as Sqlite.Referent -import U.Codebase.Sqlite.Serialization qualified as S -import U.Codebase.Sqlite.Term.Format qualified as TL -import U.Codebase.Sqlite.Term.Format qualified as TermFormat -import U.Codebase.Sync (Sync (Sync), TrySyncResult) -import U.Codebase.Sync qualified as Sync -import U.Codebase.WatchKind qualified as WK -import Unison.Prelude -import Unison.Sqlite (Transaction) -import Unison.Util.Cache (Cache) -import Unison.Util.Cache qualified as Cache - -data Entity - = O ObjectId - | C CausalHashId - | W WK.WatchKind Sqlite.Reference.IdH - deriving (Eq, Ord, Show) - -data DecodeError - = ErrTermComponent - | ErrDeclComponent - | ErrBranchFormat - | ErrPatchFormat - | ErrWatchResult - deriving (Show) - -type ErrString = String - -data Error - = DecodeError DecodeError ByteString ErrString - | -- | hashes corresponding to a single object in source codebase - -- correspond to multiple objects in destination codebase - HashObjectCorrespondence ObjectId [HashId] [HashId] [ObjectId] - | SourceDbNotExist - deriving (Show) - -data Env m = Env - { runSrc :: forall a. Transaction a -> m a, - runDest :: forall a. Transaction a -> m a, - -- | there are three caches of this size - idCacheSize :: Word - } - -hoistEnv :: (forall x. m x -> n x) -> Env m -> Env n -hoistEnv f Env {runSrc, runDest, idCacheSize} = - Env - { runSrc = f . runSrc, - runDest = f . runDest, - idCacheSize - } - -debug :: Bool -debug = False - --- data Mappings -sync22 :: - ( MonadIO m, - MonadError Error m - ) => - HashHandle -> - Env m -> - IO (Sync m Entity) -sync22 hh Env {runSrc, runDest, idCacheSize = size} = do - tCache <- Cache.semispaceCache size - hCache <- Cache.semispaceCache size - oCache <- Cache.semispaceCache size - cCache <- Cache.semispaceCache size - pure $ Sync (trySync hh runSrc runDest tCache hCache oCache cCache) - -trySync :: - forall m. - (MonadIO m, MonadError Error m) => - HashHandle -> - (forall a. Transaction a -> m a) -> - (forall a. Transaction a -> m a) -> - Cache TextId TextId -> - Cache HashId HashId -> - Cache ObjectId ObjectId -> - Cache CausalHashId CausalHashId -> - Entity -> - m (TrySyncResult Entity) -trySync hh runSrc runDest tCache hCache oCache cCache = \case - -- for causals, we need to get the value_hash_id of the thingo - -- - maybe enqueue their parents - -- - enqueue the self_ and value_ hashes - -- - enqueue the namespace object, if present - C chId -> - isSyncedCausal chId >>= \case - Just {} -> pure Sync.PreviouslyDone - Nothing -> do - result <- runValidateT @(Set Entity) @m @() do - bhId <- lift . runSrc $ Q.expectCausalValueHashId chId - mayBoId <- lift . runSrc . Q.loadObjectIdForAnyHashId $ unBranchHashId bhId - traverse_ syncLocalObjectId mayBoId - - parents' :: [CausalHashId] <- findParents' chId - bhId' <- lift $ syncBranchHashId bhId - chId' <- lift $ syncCausalHashId chId - lift (runDest (Q.saveCausal hh chId' bhId' parents')) - - case result of - Left deps -> pure . Sync.Missing $ toList deps - Right () -> pure Sync.Done - - -- objects are the hairiest. obviously, if they - -- exist, we're done; otherwise we do some fancy stuff - O oId -> - isSyncedObject oId >>= \case - Just {} -> pure Sync.PreviouslyDone - Nothing -> do - (hId, objType, bytes) <- runSrc $ Q.expectObjectWithHashIdAndType oId - hId' <- syncHashLiteral hId - result <- runValidateT @(Set Entity) @m @ObjectId case objType of - OT.TermComponent -> do - -- split up the localIds (parsed), term, and type blobs - case flip runGetS bytes S.decomposeTermFormat of - Left s -> throwError $ DecodeError ErrTermComponent bytes s - Right - ( TermFormat.SyncTerm - ( TermFormat.SyncLocallyIndexedComponent - (Vector.unzip -> (localIds, bytes)) - ) - ) -> do - -- iterate through the local ids looking for missing deps; - -- then either enqueue the missing deps, or proceed to move the object - when debug $ traceM $ "LocalIds for Source " ++ show oId ++ ": " ++ show localIds - localIds' <- traverse syncLocalIds localIds - when debug $ traceM $ "LocalIds for Dest: " ++ show localIds' - -- reassemble and save the reindexed term - let bytes' = - runPutS - . S.recomposeTermFormat - . TermFormat.SyncTerm - . TermFormat.SyncLocallyIndexedComponent - $ Vector.zip localIds' bytes - lift do - oId' <- runDest $ Q.saveObject hh hId' objType bytes' - -- copy reference-specific stuff - for_ [0 .. length localIds - 1] \(fromIntegral -> idx) -> do - let ref = Reference.Id oId idx - refH = Reference.Id hId idx - ref' = Reference.Id oId' idx - -- sync watch results - for_ [WK.TestWatch] \wk -> - syncWatch wk refH - syncDependenciesIndex ref ref' - syncTypeIndex oId oId' - syncTypeMentionsIndex oId oId' - pure oId' - OT.DeclComponent -> do - -- split up the localIds (parsed), decl blobs - case flip runGetS bytes S.decomposeDeclFormat of - Left s -> throwError $ DecodeError ErrDeclComponent bytes s - Right - ( DeclFormat.SyncDecl - ( DeclFormat.SyncLocallyIndexedComponent - (Vector.unzip -> (localIds, declBytes)) - ) - ) -> do - -- iterate through the local ids looking for missing deps; - -- then either enqueue the missing deps, or proceed to move the object - localIds' <- traverse syncLocalIds localIds - -- reassemble and save the reindexed term - let bytes' = - runPutS - . S.recomposeDeclFormat - . DeclFormat.SyncDecl - . DeclFormat.SyncLocallyIndexedComponent - $ Vector.zip localIds' declBytes - lift do - oId' <- runDest $ Q.saveObject hh hId' objType bytes' - -- copy per-element-of-the-component stuff - for_ [0 .. length localIds - 1] \(fromIntegral -> idx) -> do - let ref = Reference.Id oId idx - ref' = Reference.Id oId' idx - syncDependenciesIndex ref ref' - syncTypeIndex oId oId' - syncTypeMentionsIndex oId oId' - pure oId' - OT.Namespace -> case flip runGetS bytes S.decomposeBranchFormat of - Right (BL.SyncFull ids body) -> do - ids' <- syncBranchLocalIds ids - let bytes' = runPutS $ S.recomposeBranchFormat (BL.SyncFull ids' body) - oId' <- lift . runDest $ Q.saveObject hh hId' objType bytes' - pure oId' - Right (BL.SyncDiff boId ids body) -> do - boId' <- syncBranchObjectId boId - ids' <- syncBranchLocalIds ids - let bytes' = runPutS $ S.recomposeBranchFormat (BL.SyncDiff boId' ids' body) - oId' <- lift . runDest $ Q.saveObject hh hId' objType bytes' - pure oId' - Left s -> throwError $ DecodeError ErrBranchFormat bytes s - OT.Patch -> case flip runGetS bytes S.decomposePatchFormat of - Right (PL.SyncFull ids body) -> do - ids' <- syncPatchLocalIds ids - let bytes' = runPutS $ S.recomposePatchFormat (PL.SyncFull ids' body) - oId' <- lift . runDest $ Q.saveObject hh hId' objType bytes' - pure oId' - Right (PL.SyncDiff poId ids body) -> do - poId' <- syncPatchObjectId poId - ids' <- syncPatchLocalIds ids - let bytes' = runPutS $ S.recomposePatchFormat (PL.SyncDiff poId' ids' body) - oId' <- lift . runDest $ Q.saveObject hh hId' objType bytes' - pure oId' - Left s -> throwError $ DecodeError ErrPatchFormat bytes s - case result of - Left deps -> pure . Sync.Missing $ toList deps - Right oId' -> do - syncSecondaryHashes oId oId' - when debug $ traceM $ "Source " ++ show (hId, oId) ++ " becomes Dest " ++ show (hId', oId') - Cache.insert oCache oId oId' - pure Sync.Done - W k r -> syncWatch k r - where - syncLocalObjectId :: ObjectId -> ValidateT (Set Entity) m ObjectId - syncLocalObjectId oId = - lift (isSyncedObject oId) >>= \case - Just oId' -> pure oId' - Nothing -> Validate.refute . Set.singleton $ O oId - - syncPatchObjectId :: PatchObjectId -> ValidateT (Set Entity) m PatchObjectId - syncPatchObjectId = fmap PatchObjectId . syncLocalObjectId . unPatchObjectId - - syncBranchObjectId :: BranchObjectId -> ValidateT (Set Entity) m BranchObjectId - syncBranchObjectId = fmap BranchObjectId . syncLocalObjectId . unBranchObjectId - - syncCausal :: CausalHashId -> ValidateT (Set Entity) m CausalHashId - syncCausal chId = - lift (isSyncedCausal chId) >>= \case - Just chId' -> pure chId' - Nothing -> Validate.refute . Set.singleton $ C chId - - syncDependenciesIndex :: Sqlite.Reference.Id -> Sqlite.Reference.Id -> m () - syncDependenciesIndex ref ref' = do - deps <- runSrc (Q.getDependenciesForDependent ref) - deps' <- for deps expectSyncedObjectReference - runDest (Q.addToDependentsIndex deps' ref') - - syncLocalIds :: L.LocalIds -> ValidateT (Set Entity) m L.LocalIds - syncLocalIds (L.LocalIds tIds oIds) = do - oIds' <- traverse syncLocalObjectId oIds - tIds' <- lift $ traverse syncTextLiteral tIds - pure $ L.LocalIds tIds' oIds' - - syncPatchLocalIds :: PL.PatchLocalIds -> ValidateT (Set Entity) m PL.PatchLocalIds - syncPatchLocalIds (PL.LocalIds tIds hIds oIds) = do - oIds' <- traverse syncLocalObjectId oIds - tIds' <- lift $ traverse syncTextLiteral tIds - hIds' <- lift $ traverse syncHashLiteral hIds - pure $ PL.LocalIds tIds' hIds' oIds' - - syncBranchLocalIds :: BL.BranchLocalIds -> ValidateT (Set Entity) m BL.BranchLocalIds - syncBranchLocalIds (BL.LocalIds tIds oIds poIds chboIds) = do - oIds' <- traverse syncLocalObjectId oIds - poIds' <- traverse (fmap PatchObjectId . syncLocalObjectId . unPatchObjectId) poIds - chboIds' <- traverse (bitraverse syncBranchObjectId syncCausal) chboIds - tIds' <- lift $ traverse syncTextLiteral tIds - pure $ BL.LocalIds tIds' oIds' poIds' chboIds' - - syncTypeIndex :: ObjectId -> ObjectId -> m () - syncTypeIndex oId oId' = do - rows <- runSrc (Q.getTypeReferencesForComponent oId) - -- defensively nubOrd to guard against syncing from codebases with duplicate rows in their type (mentions) indexes - -- alternatively, we could put a unique constraint on the whole 6-tuple of the index tables, and optimistically - -- insert with an `on conflict do nothing`. - for_ (nubOrd rows) \row -> do - row' <- syncTypeIndexRow oId' row - runDest (uncurry Q.addToTypeIndex row') - - syncTypeMentionsIndex :: ObjectId -> ObjectId -> m () - syncTypeMentionsIndex oId oId' = do - rows <- runSrc (Q.getTypeMentionsReferencesForComponent oId) - -- see "defensively nubOrd..." comment above in `syncTypeIndex` - for_ (nubOrd rows) \row -> do - row' <- syncTypeIndexRow oId' row - runDest (uncurry Q.addToTypeMentionsIndex row') - - syncTypeIndexRow :: - ObjectId -> - (Sqlite.Reference.ReferenceH, Sqlite.Referent.Id) -> - m (Sqlite.Reference.ReferenceH, Sqlite.Referent.Id) - syncTypeIndexRow oId' = bitraverse syncHashReference (pure . rewriteTypeIndexReferent oId') - - rewriteTypeIndexReferent :: ObjectId -> Sqlite.Referent.Id -> Sqlite.Referent.Id - rewriteTypeIndexReferent oId' = bimap (const oId') (const oId') - - syncTextLiteral :: TextId -> m TextId - syncTextLiteral = Cache.apply tCache \tId -> do - t <- runSrc $ Q.expectText tId - tId' <- runDest $ Q.saveText t - when debug $ traceM $ "Source " ++ show tId ++ " is Dest " ++ show tId' ++ " (" ++ show t ++ ")" - pure tId' - - syncHashLiteral :: HashId -> m HashId - syncHashLiteral = Cache.apply hCache \hId -> do - b32hex <- runSrc $ Q.expectHash32 hId - hId' <- runDest $ Q.saveHash b32hex - when debug $ traceM $ "Source " ++ show hId ++ " is Dest " ++ show hId' ++ " (" ++ show b32hex ++ ")" - pure hId' - - isSyncedObjectReference :: Sqlite.Reference -> m (Maybe Sqlite.Reference) - isSyncedObjectReference = \case - Reference.ReferenceBuiltin t -> - Just . Reference.ReferenceBuiltin <$> syncTextLiteral t - Reference.ReferenceDerived id -> - fmap Reference.ReferenceDerived <$> isSyncedObjectReferenceId id - - isSyncedObjectReferenceId :: Sqlite.Reference.Id -> m (Maybe Sqlite.Reference.Id) - isSyncedObjectReferenceId (Reference.Id oId idx) = - isSyncedObject oId <&> fmap (\oId' -> Reference.Id oId' idx) - - -- Assert that a reference's component is already synced, and return the corresponding reference. - expectSyncedObjectReference :: Sqlite.Reference -> m Sqlite.Reference - expectSyncedObjectReference ref = - isSyncedObjectReference ref <&> \case - Nothing -> error (reportBug "E452280" ("unsynced object reference " ++ show ref)) - Just ref' -> ref' - - syncHashReference :: Sqlite.ReferenceH -> m Sqlite.ReferenceH - syncHashReference = bitraverse syncTextLiteral syncHashLiteral - - syncCausalHashId :: CausalHashId -> m CausalHashId - syncCausalHashId = fmap CausalHashId . syncHashLiteral . unCausalHashId - - syncBranchHashId :: BranchHashId -> m BranchHashId - syncBranchHashId = fmap BranchHashId . syncHashLiteral . unBranchHashId - - findParents' :: CausalHashId -> ValidateT (Set Entity) m [CausalHashId] - findParents' chId = do - srcParents <- lift . runSrc $ Q.loadCausalParents chId - traverse syncCausal srcParents - - -- Sync any watches of the given kinds to the dest if and only if watches of those kinds - -- exist in the src. - syncWatch :: WK.WatchKind -> Sqlite.Reference.IdH -> m (TrySyncResult Entity) - syncWatch wk r | debug && trace ("Sync22.syncWatch " ++ show wk ++ " " ++ show r) False = undefined - syncWatch wk r = do - runSrc (Q.loadWatch wk r (Right :: ByteString -> Either Void ByteString)) >>= \case - Nothing -> pure Sync.Done - Just blob -> do - r' <- traverse syncHashLiteral r - doneKinds <- runDest (Q.loadWatchKindsByReference r') - if (elem wk doneKinds) - then pure Sync.PreviouslyDone - else do - TL.SyncWatchResult li body <- - either (throwError . DecodeError ErrWatchResult blob) pure $ runGetS S.decomposeWatchFormat blob - li' <- bitraverse syncTextLiteral syncHashLiteral li - when debug $ traceM $ "LocalIds for Source watch result " ++ show r ++ ": " ++ show li - when debug $ traceM $ "LocalIds for Dest watch result " ++ show r' ++ ": " ++ show li' - let blob' = runPutS $ S.recomposeWatchFormat (TL.SyncWatchResult li' body) - runDest (Q.saveWatch wk r' blob') - pure Sync.Done - - syncSecondaryHashes oId oId' = - runSrc (Q.hashIdWithVersionForObject oId) >>= traverse_ (go oId') - where - go oId' (hId, hashVersion) = do - hId' <- syncHashLiteral hId - runDest $ Q.saveHashObject hId' oId' hashVersion - - isSyncedObject :: ObjectId -> m (Maybe ObjectId) - isSyncedObject = Cache.applyDefined oCache \oId -> do - hIds <- toList <$> runSrc (Q.expectHashIdsForObject oId) - hIds' <- traverse syncHashLiteral hIds - ( nubOrd . catMaybes - <$> traverse (runDest . Q.loadObjectIdForAnyHashId) hIds' - ) - >>= \case - [oId'] -> do - when debug $ traceM $ "Source " ++ show oId ++ " is Dest " ++ show oId' - pure $ Just oId' - [] -> pure $ Nothing - oIds' -> throwError (HashObjectCorrespondence oId hIds hIds' oIds') - - isSyncedCausal :: CausalHashId -> m (Maybe CausalHashId) - isSyncedCausal = Cache.applyDefined cCache \chId -> do - let hId = unCausalHashId chId - hId' <- syncHashLiteral hId - ifM - (runDest $ Q.isCausalHash hId') - (pure . Just $ CausalHashId hId') - (pure Nothing) diff --git a/codebase2/codebase-sqlite/package.yaml b/codebase2/codebase-sqlite/package.yaml index 01c4c22544..67ca76b208 100644 --- a/codebase2/codebase-sqlite/package.yaml +++ b/codebase2/codebase-sqlite/package.yaml @@ -11,7 +11,6 @@ extra-source-files: - sql/* dependencies: - - Only - aeson - base - bytes @@ -20,17 +19,14 @@ dependencies: - extra - generic-lens - lens - - monad-validate - mtl - network-uri - network-uri-orphans-sqlite - nonempty-containers - - safe - text - time - transformers - unison-codebase - - unison-codebase-sync - unison-core - unison-core1 - unison-core-orphans-sqlite @@ -39,7 +35,6 @@ dependencies: - unison-prelude - unison-sqlite - unison-util-base32hex - - unison-util-cache - unison-util-file-embed - unison-util-serialization - unison-util-term @@ -47,7 +42,6 @@ dependencies: - uuid - uuid-orphans-sqlite - vector - - witch default-extensions: - ApplicativeDo diff --git a/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal b/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal index 86f7466997..beca90fa76 100644 --- a/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal +++ b/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal @@ -66,7 +66,6 @@ library U.Codebase.Sqlite.RemoteProjectBranch U.Codebase.Sqlite.Serialization U.Codebase.Sqlite.Symbol - U.Codebase.Sqlite.Sync22 U.Codebase.Sqlite.TempEntity U.Codebase.Sqlite.TempEntityType U.Codebase.Sqlite.Term.Format @@ -110,8 +109,7 @@ library TypeOperators ViewPatterns build-depends: - Only - , aeson + aeson , base , bytes , bytestring @@ -119,17 +117,14 @@ library , extra , generic-lens , lens - , monad-validate , mtl , network-uri , network-uri-orphans-sqlite , nonempty-containers - , safe , text , time , transformers , unison-codebase - , unison-codebase-sync , unison-core , unison-core-orphans-sqlite , unison-core1 @@ -138,7 +133,6 @@ library , unison-prelude , unison-sqlite , unison-util-base32hex - , unison-util-cache , unison-util-file-embed , unison-util-serialization , unison-util-term @@ -146,5 +140,4 @@ library , uuid , uuid-orphans-sqlite , vector - , witch default-language: Haskell2010 diff --git a/codebase2/codebase/U/Codebase/Decl.hs b/codebase2/codebase/U/Codebase/Decl.hs index 7a46ea9fc0..cf6ae66902 100644 --- a/codebase2/codebase/U/Codebase/Decl.hs +++ b/codebase2/codebase/U/Codebase/Decl.hs @@ -12,6 +12,7 @@ import U.Core.ABT qualified as ABT import U.Core.ABT.Var qualified as ABT import Unison.Hash (Hash) import Unison.Prelude +import Unison.Util.Recursion type ConstructorId = Word64 @@ -107,7 +108,7 @@ unhashComponent componentHash refToVar m = { declType, modifier, bound, - constructorTypes = ABT.cata alg <$> constructorTypes + constructorTypes = cata alg <$> constructorTypes } where rewriteTypeReference :: Reference.Id' (Maybe Hash) -> Either v Reference.Reference @@ -126,8 +127,8 @@ unhashComponent componentHash refToVar m = case Map.lookup (fromMaybe componentHash <$> rid) withGeneratedVars of Nothing -> error "unhashComponent: self-reference not found in component map" Just (v, _, _) -> Left v - alg :: () -> ABT.ABT (Type.F' TypeRef) v (HashableType v) -> HashableType v - alg () = \case + alg :: ABT.Term' (Type.F' TypeRef) v () (HashableType v) -> HashableType v + alg (ABT.Term' _ () abt) = case abt of ABT.Var v -> ABT.var () v ABT.Cycle body -> ABT.cycle () body ABT.Abs v body -> ABT.abs () v body diff --git a/codebase2/codebase/U/Codebase/Term.hs b/codebase2/codebase/U/Codebase/Term.hs index 57691ba6ec..07b938ae25 100644 --- a/codebase2/codebase/U/Codebase/Term.hs +++ b/codebase2/codebase/U/Codebase/Term.hs @@ -16,6 +16,7 @@ import U.Core.ABT qualified as ABT import U.Core.ABT.Var qualified as ABT import Unison.Hash (Hash) import Unison.Prelude +import Unison.Util.Recursion type ConstructorId = Word64 @@ -281,7 +282,7 @@ unhashComponent componentHash refToVar m = assignVar :: Reference.Id -> (trm, extra) -> StateT (Set v) Identity (v, trm, extra) assignVar r (trm, extra) = (,trm,extra) <$> ABT.freshenS (refToVar r) fillSelfReferences :: Term v -> HashableTerm v - fillSelfReferences = (ABT.cata alg) + fillSelfReferences = cata alg where rewriteTermReference :: Reference.Id' (Maybe Hash) -> Either v Reference.Reference rewriteTermReference rid@(Reference.Id mayH pos) = @@ -299,8 +300,8 @@ unhashComponent componentHash refToVar m = case Map.lookup (fromMaybe componentHash <$> rid) withGeneratedVars of Nothing -> error "unhashComponent: self-reference not found in component map" Just (v, _, _) -> Left v - alg :: () -> ABT.ABT (F v) v (HashableTerm v) -> HashableTerm v - alg () = \case + alg :: ABT.Term' (F v) v () (HashableTerm v) -> HashableTerm v + alg (ABT.Term' _ () abt) = case abt of ABT.Var v -> ABT.var () v ABT.Cycle body -> ABT.cycle () body ABT.Abs v body -> ABT.abs () v body diff --git a/codebase2/codebase/package.yaml b/codebase2/codebase/package.yaml index 1608bed83e..c9a1a2ab55 100644 --- a/codebase2/codebase/package.yaml +++ b/codebase2/codebase/package.yaml @@ -7,12 +7,11 @@ dependencies: - generic-lens - lens - mtl - - text - time - unison-core - unison-hash - unison-prelude - - unison-util-base32hex + - unison-util-recursion library: source-dirs: . diff --git a/codebase2/codebase/unison-codebase.cabal b/codebase2/codebase/unison-codebase.cabal index 4fcd1abb4d..5a7335649f 100644 --- a/codebase2/codebase/unison-codebase.cabal +++ b/codebase2/codebase/unison-codebase.cabal @@ -65,10 +65,9 @@ library , generic-lens , lens , mtl - , text , time , unison-core , unison-hash , unison-prelude - , unison-util-base32hex + , unison-util-recursion default-language: GHC2021 diff --git a/codebase2/core/U/Core/ABT.hs b/codebase2/core/U/Core/ABT.hs index 690202d366..2e22791fde 100644 --- a/codebase2/core/U/Core/ABT.hs +++ b/codebase2/core/U/Core/ABT.hs @@ -10,6 +10,7 @@ import Debug.RecoverRTTI qualified as RTTI import U.Core.ABT.Var (Var (freshIn)) import Unison.Debug qualified as Debug import Unison.Prelude +import Unison.Util.Recursion import Prelude hiding (abs, cycle) data ABT f v r @@ -24,6 +25,13 @@ data ABT f v r data Term f v a = Term {freeVars :: Set v, annotation :: a, out :: ABT f v (Term f v a)} deriving (Functor, Foldable, Generic, Traversable) +data Term' f v a x = Term' {freeVars' :: Set v, annotation' :: a, out' :: ABT f v x} + deriving (Functor) + +instance (Functor f) => Recursive (Term f v a) (Term' f v a) where + embed (Term' vs a abt) = Term vs a abt + project (Term vs a abt) = Term' vs a abt + instance (Foldable f, Functor f, forall a. (Eq a) => Eq (f a), Var v) => Eq (Term f v a) where -- alpha equivalence, works by renaming any aligned Abs ctors to use a common fresh variable t1 == t2 = go (out t1) (out t2) @@ -97,24 +105,6 @@ vmapM f (Term _ a out) = case out of Cycle r -> cycle a <$> vmapM f r Abs v body -> abs a <$> f v <*> vmapM f body -cata :: - (Functor f) => - (a -> ABT f v x -> x) -> - Term f v a -> - x -cata abtAlg = - let go (Term _fvs a out) = abtAlg a (fmap go out) - in go - -para :: - (Functor f) => - (a -> ABT f v (Term f v a, x) -> x) -> - Term f v a -> - x -para abtAlg = - let go (Term _fvs a out) = abtAlg a (fmap (\x -> (x, go x)) out) - in go - transform :: (Ord v, Foldable g, Functor g) => (forall a. f a -> g a) -> diff --git a/codebase2/core/Unison/NameSegment.hs b/codebase2/core/Unison/NameSegment.hs index 32771f75dc..924e2b8951 100644 --- a/codebase2/core/Unison/NameSegment.hs +++ b/codebase2/core/Unison/NameSegment.hs @@ -1,5 +1,6 @@ module Unison.NameSegment ( NameSegment, + toUnescapedText, -- * Sentinel name segments defaultPatchSegment, @@ -23,7 +24,7 @@ module Unison.NameSegment ) where -import Unison.NameSegment.Internal (NameSegment (NameSegment)) +import Unison.NameSegment.Internal (NameSegment (NameSegment, toUnescapedText)) ------------------------------------------------------------------------------------------------------------------------ -- special segment names diff --git a/codebase2/core/package.yaml b/codebase2/core/package.yaml index 05e2810a52..a090d9af99 100644 --- a/codebase2/core/package.yaml +++ b/codebase2/core/package.yaml @@ -17,8 +17,7 @@ dependencies: - text - unison-hash - unison-prelude - - unison-util-base32hex - - vector + - unison-util-recursion default-extensions: - ApplicativeDo diff --git a/codebase2/core/unison-core.cabal b/codebase2/core/unison-core.cabal index 9cea44a2ab..2045517a08 100644 --- a/codebase2/core/unison-core.cabal +++ b/codebase2/core/unison-core.cabal @@ -64,6 +64,5 @@ library , text , unison-hash , unison-prelude - , unison-util-base32hex - , vector + , unison-util-recursion default-language: Haskell2010 diff --git a/contrib/cabal.project b/contrib/cabal.project index d23809d841..759ea5add2 100644 --- a/contrib/cabal.project +++ b/contrib/cabal.project @@ -21,9 +21,10 @@ packages: lib/unison-util-base32hex lib/unison-util-bytes lib/unison-util-cache + lib/unison-util-file-embed + lib/unison-util-recursion lib/unison-util-relation lib/unison-util-rope - lib/unison-util-file-embed parser-typechecker unison-core @@ -36,11 +37,6 @@ packages: unison-syntax yaks/easytest -source-repository-package - type: git - location: https://github.com/unisonweb/configurator.git - tag: e47e9e9fe1f576f8c835183b9def52d73c01327a - source-repository-package type: git location: https://github.com/unisonweb/haskeline.git diff --git a/dev-ui-install.sh b/dev-ui-install.sh index a9f3d5d64d..0ade79bf2a 100755 --- a/dev-ui-install.sh +++ b/dev-ui-install.sh @@ -1,3 +1,6 @@ +#!/usr/bin/env sh +set -eu + echo "This script downloads the latest Unison Local UI release" echo "and puts it in the correct spot next to the unison" echo "executable built by stack." @@ -7,4 +10,4 @@ stack build curl -L https://github.com/unisonweb/unison-local-ui/releases/download/latest/unisonLocal.zip --output unisonLocal.zip parent_dir="$(dirname -- $(stack exec which unison))" mkdir -p "$parent_dir/ui" -unzip -o unisonLocal.zip -d "$parent_dir/ui" +unzip -q -o unisonLocal.zip -d "$parent_dir/ui" diff --git a/docs/repoformats/v2.markdown b/docs/repoformats/v2.markdown index e5e99f2fb3..5c9c5b74b2 100644 --- a/docs/repoformats/v2.markdown +++ b/docs/repoformats/v2.markdown @@ -126,7 +126,7 @@ In order to avoid fully rewriting the ABT to update `TextId` and `ObjectId` repl An example: -```unison +``` unison type Tree = Branch Tree Tree | INode (Optional ##Int) | BNode Boolean ``` This gives us a decl with two constructor types: diff --git a/editor-support/vim/syntax/unison.vim b/editor-support/vim/syntax/unison.vim index ec193723a7..3bd3b2ef68 100644 --- a/editor-support/vim/syntax/unison.vim +++ b/editor-support/vim/syntax/unison.vim @@ -48,7 +48,7 @@ syn match uSpecialCharError contained "\\&\|'''\+" syn region uString start=+"+ skip=+\\\\\|\\"+ end=+"+ contains=uSpecialChar syn match uCharacter "[^a-zA-Z0-9_']'\([^\\]\|\\[^']\+\|\\'\)'"lc=1 contains=uSpecialChar,uSpecialCharError syn match uCharacter "^'\([^\\]\|\\[^']\+\|\\'\)'" contains=uSpecialChar,uSpecialCharError -syn match uNumber "\<[0-9]\+\>\|\<0[xX][0-9a-fA-F]\+\>\|\<0[oO][0-7]\+\>" +syn match uNumber "\<[0-9]\+\>\|\<0[xX][0-9a-fA-F]\+\>\|\<0[oO][0-7]\+\>\|\<0[bB][01]\+\>" syn match uFloat "\<[0-9]\+\.[0-9]\+\([eE][-+]\=[0-9]\+\)\=\>" " Keyword definitions. These must be patterns instead of keywords @@ -83,7 +83,7 @@ syn region uDocDirective contained matchgroup=unisonDocDirective start="\(@ syn match uDebug "\<\(todo\|bug\|Debug.trace\)\>" -" things like +" things like " > my_func 1 3 " test> Function.tap.tests.t1 = check let " use Nat == + @@ -101,7 +101,7 @@ if version >= 508 || !exists("did_u_syntax_inits") else command -nargs=+ HiLink hi def link endif - + HiLink uWatch Debug HiLink uDocMono Delimiter HiLink unisonDocDirective Import diff --git a/hie.yaml b/hie.yaml index e3ebb06c22..6b28f83ee0 100644 --- a/hie.yaml +++ b/hie.yaml @@ -98,6 +98,11 @@ cradle: - path: "parser-typechecker/tests" component: "unison-parser-typechecker:test:parser-typechecker-tests" + - path: "unison-runtime/src" + component: "unison-runtime:lib" + + - path: "unison-runtime/tests" + component: "unison-runtime:test:runtime-tests" - path: "unison-cli/src" component: "unison-cli:lib" diff --git a/lib/unison-hash/package.yaml b/lib/unison-hash/package.yaml index 977e823288..8b6edc958c 100644 --- a/lib/unison-hash/package.yaml +++ b/lib/unison-hash/package.yaml @@ -2,15 +2,13 @@ name: unison-hash github: unisonweb/unison copyright: Copyright (C) 2013-2021 Unison Computing, PBC and contributors -ghc-options: -Wall -O0 -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures +ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures dependencies: - base - bytestring - - text - unison-prelude - unison-util-base32hex - - witch library: source-dirs: src diff --git a/lib/unison-hash/unison-hash.cabal b/lib/unison-hash/unison-hash.cabal index afdc6cc89d..cad79645b3 100644 --- a/lib/unison-hash/unison-hash.cabal +++ b/lib/unison-hash/unison-hash.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack @@ -49,12 +49,10 @@ library TypeApplications TypeFamilies ViewPatterns - ghc-options: -Wall -O0 -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures + ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures build-depends: base , bytestring - , text , unison-prelude , unison-util-base32hex - , witch default-language: Haskell2010 diff --git a/lib/unison-hashing/package.yaml b/lib/unison-hashing/package.yaml index 7ea56e16d3..6e8e67bb68 100644 --- a/lib/unison-hashing/package.yaml +++ b/lib/unison-hashing/package.yaml @@ -2,7 +2,7 @@ name: unison-hashing github: unisonweb/unison copyright: Copyright (C) 2013-2021 Unison Computing, PBC and contributors -ghc-options: -Wall -O0 -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures +ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures dependencies: - base diff --git a/lib/unison-hashing/unison-hashing.cabal b/lib/unison-hashing/unison-hashing.cabal index 21350f79ca..83cd62bcba 100644 --- a/lib/unison-hashing/unison-hashing.cabal +++ b/lib/unison-hashing/unison-hashing.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack @@ -48,7 +48,7 @@ library TypeApplications TypeFamilies ViewPatterns - ghc-options: -Wall -O0 -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures + ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures build-depends: base , unison-hash diff --git a/lib/unison-prelude/src/Unison/Debug.hs b/lib/unison-prelude/src/Unison/Debug.hs index 6bbcaa9cac..994b29c96f 100644 --- a/lib/unison-prelude/src/Unison/Debug.hs +++ b/lib/unison-prelude/src/Unison/Debug.hs @@ -36,6 +36,8 @@ data DebugFlag | -- | Useful for adding temporary debugging statements during development. -- Remove uses of Debug.Temp before merging to keep things clean for the next person :) Temp + | -- | Debugging the interpreter + Interpreter | -- | Shows Annotations when printing terms Annotations | -- | Debug endpoints of the local UI (or Share) server @@ -65,6 +67,7 @@ debugFlags = case (unsafePerformIO (lookupEnv "UNISON_DEBUG")) of "LSP" -> pure LSP "TIMING" -> pure Timing "TEMP" -> pure Temp + "INTERPRETER" -> pure Interpreter "ANNOTATIONS" -> pure Annotations "SERVER" -> pure Server "PATTERN_COVERAGE" -> pure PatternCoverage @@ -114,6 +117,10 @@ debugTemp :: Bool debugTemp = Temp `Set.member` debugFlags {-# NOINLINE debugTemp #-} +debugInterpreter :: Bool +debugInterpreter = Interpreter `Set.member` debugFlags +{-# NOINLINE debugInterpreter #-} + debugAnnotations :: Bool debugAnnotations = Annotations `Set.member` debugFlags {-# NOINLINE debugAnnotations #-} @@ -187,6 +194,7 @@ shouldDebug = \case LSP -> debugLSP Timing -> debugTiming Temp -> debugTemp + Interpreter -> debugInterpreter Annotations -> debugAnnotations Server -> debugServer PatternCoverage -> debugPatternCoverage diff --git a/lib/unison-prelude/src/Unison/Util/Set.hs b/lib/unison-prelude/src/Unison/Util/Set.hs index 50d2cff56a..4e3c6ef9b9 100644 --- a/lib/unison-prelude/src/Unison/Util/Set.hs +++ b/lib/unison-prelude/src/Unison/Util/Set.hs @@ -1,6 +1,7 @@ module Unison.Util.Set ( asSingleton, difference1, + intersects, mapMaybe, symmetricDifference, Unison.Util.Set.traverse, @@ -29,6 +30,11 @@ difference1 xs ys = where zs = Set.difference xs ys +-- | Get whether two sets intersect. +intersects :: (Ord a) => Set a -> Set a -> Bool +intersects xs ys = + not (Set.disjoint xs ys) + symmetricDifference :: (Ord a) => Set a -> Set a -> Set a symmetricDifference a b = (a `Set.difference` b) `Set.union` (b `Set.difference` a) diff --git a/lib/unison-pretty-printer/package.yaml b/lib/unison-pretty-printer/package.yaml index 0a190a10b2..7fcd9f7855 100644 --- a/lib/unison-pretty-printer/package.yaml +++ b/lib/unison-pretty-printer/package.yaml @@ -25,16 +25,7 @@ default-extensions: - TypeApplications - ViewPatterns -ghc-options: -Wall -O0 -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures - -flags: - optimized: - manual: true - default: true - -when: - - condition: flag(optimized) - ghc-options: -funbox-strict-fields -O2 +ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures library: when: @@ -51,7 +42,6 @@ library: - ListLike - ansi-terminal - text - - mtl - unliftio - pretty-simple - process @@ -67,7 +57,6 @@ executables: main: Main.hs dependencies: - base - - safe - text - unison-pretty-printer diff --git a/lib/unison-pretty-printer/unison-pretty-printer.cabal b/lib/unison-pretty-printer/unison-pretty-printer.cabal index edec571f55..6f6792f0e9 100644 --- a/lib/unison-pretty-printer/unison-pretty-printer.cabal +++ b/lib/unison-pretty-printer/unison-pretty-printer.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack @@ -17,10 +17,6 @@ source-repository head type: git location: https://github.com/unisonweb/unison -flag optimized - manual: True - default: True - library exposed-modules: Unison.PrettyTerminal @@ -54,14 +50,13 @@ library TupleSections TypeApplications ViewPatterns - ghc-options: -Wall -O0 -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures + ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures build-depends: ListLike , ansi-terminal , base , containers , extra - , mtl , pretty-simple , process , terminal-size @@ -71,8 +66,6 @@ library , unison-syntax , unliftio default-language: Haskell2010 - if flag(optimized) - ghc-options: -funbox-strict-fields -O2 executable prettyprintdemo main-is: Main.hs @@ -100,15 +93,12 @@ executable prettyprintdemo TupleSections TypeApplications ViewPatterns - ghc-options: -Wall -O0 -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures + ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures build-depends: base - , safe , text , unison-pretty-printer default-language: Haskell2010 - if flag(optimized) - ghc-options: -funbox-strict-fields -O2 test-suite pretty-printer-tests type: exitcode-stdio-1.0 @@ -141,7 +131,7 @@ test-suite pretty-printer-tests TupleSections TypeApplications ViewPatterns - ghc-options: -Wall -O0 -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0 + ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0 build-depends: base , code-page @@ -151,5 +141,3 @@ test-suite pretty-printer-tests , unison-pretty-printer , unison-syntax default-language: Haskell2010 - if flag(optimized) - ghc-options: -funbox-strict-fields -O2 diff --git a/lib/unison-sqlite/package.yaml b/lib/unison-sqlite/package.yaml index 1e7896b116..84d0201eab 100644 --- a/lib/unison-sqlite/package.yaml +++ b/lib/unison-sqlite/package.yaml @@ -7,6 +7,22 @@ library: - condition: false other-modules: Paths_unison_sqlite + dependencies: + - base + - direct-sqlite + - megaparsec + - pretty-simple + - random + - recover-rtti + - sqlite-simple + - template-haskell + - text + - text-builder + - transformers + - unison-prelude + - unison-util-cache + - unliftio + source-dirs: src exposed-modules: - Unison.Sqlite @@ -20,35 +36,13 @@ tests: - condition: false other-modules: Paths_unison_sqlite dependencies: + - base - code-page - easytest - unison-sqlite main: Main.hs source-dirs: test -dependencies: - - base - - containers - - direct-sqlite - - exceptions - - generic-lens - - lens - - megaparsec - - mtl - - neat-interpolation - - pretty-simple - - random - - recover-rtti - - sqlite-simple - - template-haskell - - text - - text-builder - - transformers - - unison-prelude - - unison-util-cache - - unliftio - - unliftio-core - ghc-options: -Wall diff --git a/lib/unison-sqlite/unison-sqlite.cabal b/lib/unison-sqlite/unison-sqlite.cabal index a228883ca9..d4569c8e6f 100644 --- a/lib/unison-sqlite/unison-sqlite.cabal +++ b/lib/unison-sqlite/unison-sqlite.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.0. +-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack @@ -64,14 +64,8 @@ library ghc-options: -Wall build-depends: base - , containers , direct-sqlite - , exceptions - , generic-lens - , lens , megaparsec - , mtl - , neat-interpolation , pretty-simple , random , recover-rtti @@ -83,7 +77,6 @@ library , unison-prelude , unison-util-cache , unliftio - , unliftio-core default-language: Haskell2010 test-suite tests @@ -127,26 +120,6 @@ test-suite tests build-depends: base , code-page - , containers - , direct-sqlite , easytest - , exceptions - , generic-lens - , lens - , megaparsec - , mtl - , neat-interpolation - , pretty-simple - , random - , recover-rtti - , sqlite-simple - , template-haskell - , text - , text-builder - , transformers - , unison-prelude , unison-sqlite - , unison-util-cache - , unliftio - , unliftio-core default-language: Haskell2010 diff --git a/lib/unison-util-base32hex/package.yaml b/lib/unison-util-base32hex/package.yaml index e179c0e37e..9ba9f24635 100644 --- a/lib/unison-util-base32hex/package.yaml +++ b/lib/unison-util-base32hex/package.yaml @@ -11,7 +11,6 @@ library: dependencies: - base - base32 - - bytestring - containers - unison-prelude - text diff --git a/lib/unison-util-base32hex/unison-util-base32hex.cabal b/lib/unison-util-base32hex/unison-util-base32hex.cabal index be0142debf..5d82fa8214 100644 --- a/lib/unison-util-base32hex/unison-util-base32hex.cabal +++ b/lib/unison-util-base32hex/unison-util-base32hex.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -48,7 +48,6 @@ library build-depends: base , base32 - , bytestring , containers , text , unison-prelude diff --git a/lib/unison-util-bytes/package.yaml b/lib/unison-util-bytes/package.yaml index 1836e6ce6b..50a5cca499 100644 --- a/lib/unison-util-bytes/package.yaml +++ b/lib/unison-util-bytes/package.yaml @@ -4,35 +4,38 @@ copyright: Copyright (C) 2013-2022 Unison Computing, PBC and contributors ghc-options: -Wall -dependencies: - - base - - basement - - bytestring - - bytestring-to-vector - - deepseq - - memory - - primitive - - stringsearch - - text - - vector - - unison-prelude - - unison-util-rope - - zlib - library: source-dirs: src when: - condition: false other-modules: Paths_unison_util_bytes + dependencies: + - base + - basement + - bytestring + - bytestring-to-vector + - deepseq + - memory + - primitive + - stringsearch + - text + - vector + - unison-prelude + - unison-util-rope + - zlib + tests: util-bytes-tests: when: - condition: false other-modules: Paths_unison_util_bytes dependencies: + - base + - bytestring - code-page - easytest + - unison-prelude - unison-util-bytes main: Main.hs source-dirs: test diff --git a/lib/unison-util-bytes/unison-util-bytes.cabal b/lib/unison-util-bytes/unison-util-bytes.cabal index 83df1a63e4..c8c6e38bf1 100644 --- a/lib/unison-util-bytes/unison-util-bytes.cabal +++ b/lib/unison-util-bytes/unison-util-bytes.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -105,19 +105,9 @@ test-suite util-bytes-tests ghc-options: -Wall build-depends: base - , basement , bytestring - , bytestring-to-vector , code-page - , deepseq , easytest - , memory - , primitive - , stringsearch - , text , unison-prelude , unison-util-bytes - , unison-util-rope - , vector - , zlib default-language: Haskell2010 diff --git a/lib/unison-util-cache/package.yaml b/lib/unison-util-cache/package.yaml index 0c8b57edf9..2cfd921a7a 100644 --- a/lib/unison-util-cache/package.yaml +++ b/lib/unison-util-cache/package.yaml @@ -6,8 +6,6 @@ ghc-options: -Wall dependencies: - base - - containers - - unliftio library: source-dirs: src @@ -15,6 +13,10 @@ library: - condition: false other-modules: Paths_unison_util_cache + dependencies: + - containers + - unliftio + tests: util-cache-tests: when: diff --git a/lib/unison-util-cache/unison-util-cache.cabal b/lib/unison-util-cache/unison-util-cache.cabal index fba24fbe7d..1baadefeab 100644 --- a/lib/unison-util-cache/unison-util-cache.cabal +++ b/lib/unison-util-cache/unison-util-cache.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -97,9 +97,7 @@ test-suite util-cache-tests async , base , code-page - , containers , easytest , stm , unison-util-cache - , unliftio default-language: Haskell2010 diff --git a/lib/unison-util-recursion/package.yaml b/lib/unison-util-recursion/package.yaml new file mode 100644 index 0000000000..21f83722ea --- /dev/null +++ b/lib/unison-util-recursion/package.yaml @@ -0,0 +1,46 @@ +name: unison-util-recursion +github: unisonweb/unison +copyright: Copyright (C) 2013-2022 Unison Computing, PBC and contributors + +ghc-options: -Wall + +dependencies: + - base + - free + +library: + source-dirs: src + when: + - condition: false + other-modules: Paths_unison_util_recursion + +default-extensions: + - ApplicativeDo + - BangPatterns + - BlockArguments + - DeriveAnyClass + - DeriveFoldable + - DeriveFunctor + - DeriveGeneric + - DeriveTraversable + - DerivingStrategies + - DerivingVia + - DoAndIfThenElse + - DuplicateRecordFields + - FlexibleContexts + - FlexibleInstances + - FunctionalDependencies + - GeneralizedNewtypeDeriving + - ImportQualifiedPost + - LambdaCase + - MultiParamTypeClasses + - NamedFieldPuns + - OverloadedStrings + - PatternSynonyms + - RankNTypes + - ScopedTypeVariables + - StandaloneDeriving + - TupleSections + - TypeApplications + - TypeFamilies + - ViewPatterns diff --git a/lib/unison-util-recursion/src/Unison/Util/Recursion.hs b/lib/unison-util-recursion/src/Unison/Util/Recursion.hs new file mode 100644 index 0000000000..3b0bb82dd8 --- /dev/null +++ b/lib/unison-util-recursion/src/Unison/Util/Recursion.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE UndecidableInstances #-} + +module Unison.Util.Recursion + ( Algebra, + Recursive (..), + cataM, + para, + Fix (..), + Cofree' (..), + ) +where + +import Control.Arrow ((&&&)) +import Control.Comonad.Cofree (Cofree ((:<))) +import Control.Monad ((<=<)) + +type Algebra f a = f a -> a + +class Recursive t f | t -> f where + cata :: (Algebra f a) -> t -> a + default cata :: (Functor f) => (f a -> a) -> t -> a + cata φ = φ . fmap (cata φ) . project + project :: t -> f t + default project :: (Functor f) => t -> f t + project = cata (fmap embed) + embed :: f t -> t + {-# MINIMAL embed, (cata | project) #-} + +cataM :: (Recursive t f, Traversable f, Monad m) => (f a -> m a) -> t -> m a +cataM φ = cata $ φ <=< sequenceA + +para :: (Recursive t f, Functor f) => (f (t, a) -> a) -> t -> a +para φ = snd . cata (embed . fmap fst &&& φ) + +newtype Fix f = Fix (f (Fix f)) + +deriving instance (forall a. (Show a) => Show (f a)) => Show (Fix f) + +deriving instance (forall a. (Eq a) => Eq (f a)) => Eq (Fix f) + +deriving instance (Eq (Fix f), forall a. (Ord a) => Ord (f a)) => Ord (Fix f) + +instance (Functor f) => Recursive (Fix f) f where + embed = Fix + project (Fix f) = f + +data Cofree' f a x = a :<< f x + deriving (Foldable, Functor, Traversable) + +-- | +-- +-- __NB__: `Cofree` from “free” is lazy, so this instance is technically partial. +instance (Functor f) => Recursive (Cofree f a) (Cofree' f a) where + embed (a :<< fco) = a :< fco + project (a :< fco) = a :<< fco diff --git a/lib/unison-util-recursion/unison-util-recursion.cabal b/lib/unison-util-recursion/unison-util-recursion.cabal new file mode 100644 index 0000000000..035b9f81d4 --- /dev/null +++ b/lib/unison-util-recursion/unison-util-recursion.cabal @@ -0,0 +1,57 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.36.0. +-- +-- see: https://github.com/sol/hpack + +name: unison-util-recursion +version: 0.0.0 +homepage: https://github.com/unisonweb/unison#readme +bug-reports: https://github.com/unisonweb/unison/issues +copyright: Copyright (C) 2013-2022 Unison Computing, PBC and contributors +build-type: Simple + +source-repository head + type: git + location: https://github.com/unisonweb/unison + +library + exposed-modules: + Unison.Util.Recursion + hs-source-dirs: + src + default-extensions: + ApplicativeDo + BangPatterns + BlockArguments + DeriveAnyClass + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveTraversable + DerivingStrategies + DerivingVia + DoAndIfThenElse + DuplicateRecordFields + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GeneralizedNewtypeDeriving + ImportQualifiedPost + LambdaCase + MultiParamTypeClasses + NamedFieldPuns + OverloadedStrings + PatternSynonyms + RankNTypes + ScopedTypeVariables + StandaloneDeriving + TupleSections + TypeApplications + TypeFamilies + ViewPatterns + ghc-options: -Wall + build-depends: + base + , free + default-language: Haskell2010 diff --git a/lib/unison-util-relation/package.yaml b/lib/unison-util-relation/package.yaml index 223acb5279..03bea64db6 100644 --- a/lib/unison-util-relation/package.yaml +++ b/lib/unison-util-relation/package.yaml @@ -8,12 +8,21 @@ library: - condition: false other-modules: Paths_unison_util_relation + dependencies: + - base + - containers + - deepseq + - extra + - nonempty-containers + - unison-prelude + tests: util-relation-tests: when: - condition: false other-modules: Paths_unison_util_relation dependencies: + - base - code-page - easytest - random @@ -35,14 +44,7 @@ benchmarks: - random - tasty-bench - unison-util-relation - -dependencies: - - base - - containers - - deepseq - - extra - - nonempty-containers - - unison-prelude + - unison-prelude ghc-options: -Wall diff --git a/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs b/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs index 9f39a23223..ee060e3ef7 100644 --- a/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs +++ b/lib/unison-util-relation/src/Unison/Util/BiMultimap.hs @@ -170,6 +170,7 @@ withoutRan ys m = domain :: BiMultimap a b -> Map a (NESet b) domain = toMultimap +-- | /O(1)/. range :: BiMultimap a b -> Map b a range = toMapR diff --git a/lib/unison-util-relation/src/Unison/Util/Relation.hs b/lib/unison-util-relation/src/Unison/Util/Relation.hs index 060f990ad9..8e2fd5f5eb 100644 --- a/lib/unison-util-relation/src/Unison/Util/Relation.hs +++ b/lib/unison-util-relation/src/Unison/Util/Relation.hs @@ -88,6 +88,8 @@ module Unison.Util.Relation outerJoinRanMultimaps, union, unions, + unionDomainWith, + unionRangeWith, -- * Converting to other data structures toList, @@ -230,6 +232,14 @@ union r s = range = M.unionWith S.union (range r) (range s) } +unionDomainWith :: (Ord a, Ord b) => (a -> Set b -> Set b -> Set b) -> Relation a b -> Relation a b -> Relation a b +unionDomainWith f xs ys = + fromMultimap (Map.unionWithKey f (domain xs) (domain ys)) + +unionRangeWith :: (Ord a, Ord b) => (b -> Set a -> Set a -> Set a) -> Relation a b -> Relation a b -> Relation a b +unionRangeWith f xs ys = + swap (fromMultimap (Map.unionWithKey f (range xs) (range ys))) + intersection :: (Ord a, Ord b) => Relation a b -> Relation a b -> Relation a b intersection r s = Relation diff --git a/lib/unison-util-relation/unison-util-relation.cabal b/lib/unison-util-relation/unison-util-relation.cabal index e8d38d8b57..dc30238fa6 100644 --- a/lib/unison-util-relation/unison-util-relation.cabal +++ b/lib/unison-util-relation/unison-util-relation.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -74,13 +74,8 @@ test-suite util-relation-tests build-depends: base , code-page - , containers - , deepseq , easytest - , extra - , nonempty-containers , random - , unison-prelude , unison-util-relation default-language: Haskell2010 @@ -110,9 +105,6 @@ benchmark relation base , code-page , containers - , deepseq - , extra - , nonempty-containers , random , tasty-bench , unison-prelude diff --git a/nix/haskell-nix-flake.nix b/nix/haskell-nix-flake.nix index ac4764c781..f63ffee53f 100644 --- a/nix/haskell-nix-flake.nix +++ b/nix/haskell-nix-flake.nix @@ -32,6 +32,7 @@ (args.nativeBuildInputs or []) ++ [ pkgs.cachix + pkgs.gettext # for envsubst, used by unison-src/builtin-tests/interpreter-tests.sh pkgs.hpack pkgs.pkg-config pkgs.stack-wrapped diff --git a/nix/unison-project.nix b/nix/unison-project.nix index aa191a5a44..3ca79d706b 100644 --- a/nix/unison-project.nix +++ b/nix/unison-project.nix @@ -25,7 +25,6 @@ in } ]; branchMap = { - "https://github.com/unisonweb/configurator.git"."e47e9e9fe1f576f8c835183b9def52d73c01327a" = "unison"; "https://github.com/unisonweb/shellmet.git"."2fd348592c8f51bb4c0ca6ba4bc8e38668913746" = "topic/avoid-callCommand"; }; } diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000000..8b89522fdf --- /dev/null +++ b/package.yaml @@ -0,0 +1,77 @@ +name: unison-syntax +github: unisonweb/unison +copyright: Copyright (C) 2013-2022 Unison Computing, PBC and contributors + +ghc-options: -Wall + +library: + source-dirs: src + when: + - condition: false + other-modules: Paths_unison_syntax + + dependencies: + - base + - bytes + - containers + - cryptonite + - deriving-compat + - extra + - free + - lens + - megaparsec + - mtl + - parser-combinators + - text + - unison-core + - unison-core1 + - unison-hash + - unison-prelude + - unison-util-base32hex + - unison-util-bytes + +tests: + syntax-tests: + when: + - condition: false + other-modules: Paths_unison_syntax + dependencies: + - base + - code-page + - easytest + - unison-syntax + - unison-core + - unison-prelude + main: Main.hs + source-dirs: test + +default-extensions: + - ApplicativeDo + - BangPatterns + - BlockArguments + - DeriveAnyClass + - DeriveFoldable + - DeriveFunctor + - DeriveGeneric + - DeriveTraversable + - DerivingStrategies + - DerivingVia + - DoAndIfThenElse + - DuplicateRecordFields + - FlexibleContexts + - FlexibleInstances + - FunctionalDependencies + - GeneralizedNewtypeDeriving + - ImportQualifiedPost + - LambdaCase + - MultiParamTypeClasses + - NamedFieldPuns + - OverloadedStrings + - PatternSynonyms + - RankNTypes + - ScopedTypeVariables + - StandaloneDeriving + - TupleSections + - TypeApplications + - TypeFamilies + - ViewPatterns diff --git a/parser-typechecker/package.yaml b/parser-typechecker/package.yaml index de5bbd70e3..d9760e15c9 100644 --- a/parser-typechecker/package.yaml +++ b/parser-typechecker/package.yaml @@ -2,147 +2,7 @@ name: unison-parser-typechecker github: unisonweb/unison copyright: Copyright (C) 2013-2021 Unison Computing, PBC and contributors -ghc-options: -Wall -O0 -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures - -flags: - optimized: - manual: true - default: true - arraychecks: - manual: true - default: false - -when: - - condition: flag(optimized) - ghc-options: -funbox-strict-fields -O2 - - condition: flag(arraychecks) - cpp-options: -DARRAY_CHECK - -dependencies: - - ListLike - - aeson - - ansi-terminal - - asn1-encoding - - asn1-types - - async - - atomic-primops - - base - - base16 >= 0.2.1.0 - - base64-bytestring - - basement - - binary - - bytes - - bytestring - - bytestring-to-vector - - cereal - - clock - - concurrent-output - - configurator - - containers >= 0.6.3 - - cryptonite - - data-default - - data-memocombinators - - deepseq - - directory - - either - - errors - - exceptions - - extra - - filelock - - filepath - - fingertree - - fuzzyfind - - free - - generic-lens - - hashable - - hashtables - - haskeline - - http-client - - http-media - - http-types - - IntervalMap - - iproute - - lens - - lucid - - megaparsec - - memory - - mmorph - - monad-validate - - mtl - - mutable-containers - - murmur-hash - - mwc-random - - natural-transformation - - network - - network-simple - - network-udp - - network-uri - - nonempty-containers - - open-browser - - openapi3 - - optparse-applicative - - pem - - pretty-simple - - primitive - - process - - random >= 1.2.0 - - raw-strings-qq - - recover-rtti - - regex-base - - regex-tdfa - - safe - - safe-exceptions - - semialign - - semigroups - - servant - - servant-client - - servant-docs - - servant-openapi3 - - servant-server - - shellmet - - stm - - tagged - - temporary - - terminal-size >= 0.3.3 - - text - - text-short - - these - - time - - tls - - transformers - - unicode-show - - unison-codebase - - unison-codebase-sqlite - - unison-codebase-sqlite-hashing-v2 - - unison-codebase-sync - - unison-core - - unison-core1 - - unison-hash - - unison-hashing-v2 - - unison-prelude - - unison-pretty-printer - - unison-sqlite - - unison-syntax - - unison-util-base32hex - - unison-util-bytes - - unison-util-cache - - unison-util-relation - - unison-util-rope - - unison-util-serialization - - unliftio - - uuid - - uri-encode - - utf8-string - - vector - - wai - - warp - - witch - - witherable - - crypton-x509 - - crypton-x509-store - - crypton-x509-system - - yaml - - zlib +ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures library: source-dirs: src @@ -150,18 +10,91 @@ library: - condition: false other-modules: Paths_unison_parser_typechecker + dependencies: + - ListLike + - aeson + - async + - atomic-primops + - base + - bytes + - bytestring + - concurrent-output + - containers >= 0.6.3 + - errors + - extra + - filelock + - filepath + - free + - generic-lens + - hashable + - hashtables + - lens + - megaparsec + - mmorph + - mtl + - mutable-containers + - network-uri + - nonempty-containers + - pretty-simple + - regex-tdfa + - semialign + - semigroups + - servant-client + - stm + - text + - these + - time + - transformers + - unicode-show + - unison-codebase + - unison-codebase-sqlite + - unison-codebase-sqlite-hashing-v2 + - unison-codebase-sync + - unison-core + - unison-core1 + - unison-hash + - unison-hashing-v2 + - unison-prelude + - unison-pretty-printer + - unison-sqlite + - unison-syntax + - unison-util-base32hex + - unison-util-bytes + - unison-util-cache + - unison-util-recursion + - unison-util-relation + - unison-util-rope + - unison-util-serialization + - unliftio + - uuid + - vector + - witherable + tests: parser-typechecker-tests: source-dirs: tests main: Suite.hs ghc-options: -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0 dependencies: + - base - code-page + - containers - easytest - - filemanip - - split - - hex-text + - text + - unison-core + - unison-core1 + - unison-hash - unison-parser-typechecker + - unison-prelude + - unison-pretty-printer + - unison-syntax + - unison-util-relation + - unison-util-rope + - megaparsec + - mtl + - temporary + - raw-strings-qq + - unison-hashing-v2 when: - condition: false other-modules: Paths_unison_parser_typechecker diff --git a/parser-typechecker/src/Unison/Builtin.hs b/parser-typechecker/src/Unison/Builtin.hs index 1a9477fa63..15934d4895 100644 --- a/parser-typechecker/src/Unison/Builtin.hs +++ b/parser-typechecker/src/Unison/Builtin.hs @@ -103,7 +103,7 @@ builtinEffectDecls :: [(Symbol, (R.Id, EffectDeclaration))] builtinEffectDecls = [(v, (r, Intrinsic <$ d)) | (v, r, d) <- DD.builtinEffectDecls] codeLookup :: (Applicative m) => CodeLookup Symbol m Ann -codeLookup = CodeLookup (const $ pure Nothing) $ \r -> +codeLookup = CodeLookup (const $ pure Nothing) (const $ pure Nothing) $ \r -> pure $ lookup r [(r, Right x) | (r, x) <- snd <$> builtinDataDecls] <|> lookup r [(r, Left x) | (r, x) <- snd <$> builtinEffectDecls] diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index a741477b0c..1fcb0e5c7c 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -92,10 +92,6 @@ module Unison.Codebase -- * Sync - -- ** Local sync - syncFromDirectory, - syncToDirectory, - -- * Codebase path getCodebaseDir, CodebasePath, @@ -110,7 +106,6 @@ module Unison.Codebase addDefsToCodebase, componentReferencesForReference, installUcmDependencies, - toCodeLookup, typeLookupForDependencies, unsafeGetComponentLength, SqliteCodebase.Operations.emptyCausalHash, @@ -132,7 +127,6 @@ import Unison.Builtin.Terms qualified as Builtin import Unison.Codebase.Branch (Branch) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.BuiltinAnnotation (BuiltinAnnotation (builtinAnnotation)) -import Unison.Codebase.CodeLookup qualified as CL import Unison.Codebase.Path import Unison.Codebase.Path qualified as Path import Unison.Codebase.ProjectPath qualified as PP @@ -150,10 +144,9 @@ import Unison.Parser.Ann (Ann) import Unison.Parser.Ann qualified as Parser import Unison.Prelude import Unison.Project (ProjectAndBranch (ProjectAndBranch), ProjectBranchName, ProjectName) -import Unison.Reference (Reference, TermReferenceId, TypeReference) +import Unison.Reference (Reference, TermReference, TermReferenceId, TypeReference) import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent -import Unison.Runtime.IOSource qualified as IOSource import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Term (Term) @@ -163,6 +156,7 @@ import Unison.Type qualified as Type import Unison.Typechecker.TypeLookup (TypeLookup (TypeLookup)) import Unison.Typechecker.TypeLookup qualified as TL import Unison.UnisonFile qualified as UF +import Unison.Util.Defns (Defns (..), DefnsF) import Unison.Util.Relation qualified as Rel import Unison.Var (Var) import Unison.WatchKind qualified as WK @@ -364,35 +358,50 @@ lookupWatchCache codebase h = do -- and all of their type dependencies, including builtins. typeLookupForDependencies :: Codebase IO Symbol Ann -> - Set Reference -> + DefnsF Set TermReference TypeReference -> Sqlite.Transaction (TL.TypeLookup Symbol Ann) typeLookupForDependencies codebase s = do when debug $ traceM $ "typeLookupForDependencies " ++ show s - (<> Builtin.typeLookup) <$> depthFirstAccum mempty s + (<> Builtin.typeLookup) <$> depthFirstAccum s where - depthFirstAccum :: TL.TypeLookup Symbol Ann -> Set Reference -> Sqlite.Transaction (TL.TypeLookup Symbol Ann) - depthFirstAccum tl refs = foldM go tl (Set.filter (unseen tl) refs) + depthFirstAccum :: + DefnsF Set TermReference TypeReference -> + Sqlite.Transaction (TL.TypeLookup Symbol Ann) + depthFirstAccum refs = do + tl <- depthFirstAccumTypes mempty refs.types + foldM goTerm tl (Set.filter (unseen tl) refs.terms) + + depthFirstAccumTypes :: + TL.TypeLookup Symbol Ann -> + Set TypeReference -> + Sqlite.Transaction (TL.TypeLookup Symbol Ann) + depthFirstAccumTypes tl refs = + foldM goType tl (Set.filter (unseen tl) refs) -- We need the transitive dependencies of data decls -- that are scrutinized in a match expression for -- pattern match coverage checking (specifically for -- the inhabitation check). We ensure these are found -- by collecting all transitive type dependencies. - go tl ref@(Reference.DerivedId id) = + goTerm :: TypeLookup Symbol Ann -> TermReference -> Sqlite.Transaction (TypeLookup Symbol Ann) + goTerm tl ref = getTypeOfTerm codebase ref >>= \case Just typ -> let z = tl <> TypeLookup (Map.singleton ref typ) mempty mempty - in depthFirstAccum z (Type.dependencies typ) - Nothing -> - getTypeDeclaration codebase id >>= \case - Just (Left ed) -> - let z = tl <> TypeLookup mempty mempty (Map.singleton ref ed) - in depthFirstAccum z (DD.typeDependencies $ DD.toDataDecl ed) - Just (Right dd) -> - let z = tl <> TypeLookup mempty (Map.singleton ref dd) mempty - in depthFirstAccum z (DD.typeDependencies dd) - Nothing -> pure tl - go tl Reference.Builtin {} = pure tl -- codebase isn't consulted for builtins + in depthFirstAccumTypes z (Type.dependencies typ) + Nothing -> pure tl + + goType :: TypeLookup Symbol Ann -> TypeReference -> Sqlite.Transaction (TypeLookup Symbol Ann) + goType tl ref@(Reference.DerivedId id) = + getTypeDeclaration codebase id >>= \case + Just (Left ed) -> + let z = tl <> TypeLookup mempty mempty (Map.singleton ref ed) + in depthFirstAccumTypes z (DD.typeDependencies $ DD.toDataDecl ed) + Just (Right dd) -> + let z = tl <> TypeLookup mempty (Map.singleton ref dd) mempty + in depthFirstAccumTypes z (DD.typeDependencies dd) + Nothing -> pure tl + goType tl Reference.Builtin {} = pure tl -- codebase isn't consulted for builtins unseen :: TL.TypeLookup Symbol a -> Reference -> Bool unseen tl r = isNothing @@ -401,12 +410,6 @@ typeLookupForDependencies codebase s = do <|> Map.lookup r (TL.effectDecls tl) $> () ) -toCodeLookup :: (MonadIO m) => Codebase m Symbol Parser.Ann -> CL.CodeLookup Symbol m Parser.Ann -toCodeLookup c = - CL.CodeLookup (runTransaction c . getTerm c) (runTransaction c . getTypeDeclaration c) - <> Builtin.codeLookup - <> IOSource.codeLookupM - -- | Get the type of a term. -- -- Note that it is possible to call 'putTerm', then 'getTypeOfTerm', and receive @Nothing@, per the semantics of @@ -465,14 +468,28 @@ termsOfTypeByReference c r = . Set.map (fmap Reference.DerivedId) <$> termsOfTypeImpl c r -filterTermsByReferentHavingType :: (Var v) => Codebase m v a -> Type v a -> Set Referent.Referent -> Sqlite.Transaction (Set Referent.Referent) +filterTermsByReferentHavingType :: + (Var v) => + Codebase m v a -> + Type v a -> + Set Referent.Referent -> + Sqlite.Transaction (Set Referent.Referent) filterTermsByReferentHavingType c ty = filterTermsByReferentHavingTypeByReference c $ Hashing.typeToReference ty -filterTermsByReferenceIdHavingType :: (Var v) => Codebase m v a -> Type v a -> Set TermReferenceId -> Sqlite.Transaction (Set TermReferenceId) +filterTermsByReferenceIdHavingType :: + (Var v) => + Codebase m v a -> + Type v a -> + Set TermReferenceId -> + Sqlite.Transaction (Set TermReferenceId) filterTermsByReferenceIdHavingType c ty = filterTermsByReferenceIdHavingTypeImpl c (Hashing.typeToReference ty) -- | Find the subset of `tms` which match the exact type `r` points to. -filterTermsByReferentHavingTypeByReference :: Codebase m v a -> TypeReference -> Set Referent.Referent -> Sqlite.Transaction (Set Referent.Referent) +filterTermsByReferentHavingTypeByReference :: + Codebase m v a -> + TypeReference -> + Set Referent.Referent -> + Sqlite.Transaction (Set Referent.Referent) filterTermsByReferentHavingTypeByReference c r tms = do let (builtins, derived) = partitionEithers . map p $ Set.toList tms let builtins' = diff --git a/parser-typechecker/src/Unison/Codebase/CodeLookup.hs b/parser-typechecker/src/Unison/Codebase/CodeLookup.hs index bca52cecfb..b27a2e7948 100644 --- a/parser-typechecker/src/Unison/Codebase/CodeLookup.hs +++ b/parser-typechecker/src/Unison/Codebase/CodeLookup.hs @@ -8,37 +8,44 @@ import Unison.Prelude import Unison.Reference qualified as Reference import Unison.Term (Term) import Unison.Term qualified as Term +import Unison.Type (Type) +import Unison.Util.Defns (Defns (..)) import Unison.Util.Set qualified as Set import Unison.Var (Var) data CodeLookup v m a = CodeLookup { getTerm :: Reference.Id -> m (Maybe (Term v a)), + getTypeOfTerm :: Reference.Id -> m (Maybe (Type v a)), getTypeDeclaration :: Reference.Id -> m (Maybe (Decl v a)) } instance MFunctor (CodeLookup v) where - hoist f (CodeLookup tm tp) = CodeLookup (f . tm) (f . tp) + hoist f (CodeLookup tm tmTyp tp) = CodeLookup (f . tm) (f . tmTyp) (f . tp) instance (Ord v, Functor m) => Functor (CodeLookup v m) where - fmap f cl = CodeLookup tm ty + fmap f cl = CodeLookup tm tmTyp ty where tm id = fmap (Term.amap f) <$> getTerm cl id ty id = fmap md <$> getTypeDeclaration cl id + tmTyp id = (fmap . fmap) f <$> getTypeOfTerm cl id md (Left e) = Left (f <$> e) md (Right d) = Right (f <$> d) instance (Monad m) => Semigroup (CodeLookup v m a) where - c1 <> c2 = CodeLookup tm ty + c1 <> c2 = CodeLookup tm tmTyp ty where tm id = do o <- getTerm c1 id case o of Nothing -> getTerm c2 id; Just _ -> pure o + tmTyp id = do + o <- getTypeOfTerm c1 id + case o of Nothing -> getTypeOfTerm c2 id; Just _ -> pure o ty id = do o <- getTypeDeclaration c1 id case o of Nothing -> getTypeDeclaration c2 id; Just _ -> pure o instance (Monad m) => Monoid (CodeLookup v m a) where - mempty = CodeLookup (const $ pure Nothing) (const $ pure Nothing) + mempty = CodeLookup (const $ pure Nothing) (const $ pure Nothing) (const $ pure Nothing) -- todo: can this be implemented in terms of TransitiveClosure.transitiveClosure? -- todo: add some tests on this guy? @@ -56,7 +63,7 @@ transitiveDependencies code seen0 rid = getIds = Set.mapMaybe Reference.toId in getTerm code rid >>= \case Just t -> - foldM (transitiveDependencies code) seen (getIds $ Term.dependencies t) + foldM (transitiveDependencies code) seen (getIds $ let deps = Term.dependencies t in deps.terms <> deps.types) Nothing -> getTypeDeclaration code rid >>= \case Nothing -> pure seen diff --git a/parser-typechecker/src/Unison/Codebase/CodeLookup/Util.hs b/parser-typechecker/src/Unison/Codebase/CodeLookup/Util.hs index 82c323fe78..708891159e 100644 --- a/parser-typechecker/src/Unison/Codebase/CodeLookup/Util.hs +++ b/parser-typechecker/src/Unison/Codebase/CodeLookup/Util.hs @@ -8,15 +8,18 @@ import Unison.DataDeclaration qualified as DataDeclaration import Unison.Prelude import Unison.Reference qualified as Reference import Unison.Term qualified as Term +import Unison.Type qualified as Type import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Type (TypecheckedUnisonFile) import Unison.Var (Var) fromTypecheckedUnisonFile :: forall m v a. (Var v, Monad m) => TypecheckedUnisonFile v a -> CodeLookup v m a -fromTypecheckedUnisonFile tuf = CodeLookup tm ty +fromTypecheckedUnisonFile tuf = CodeLookup tm tmTyp ty where tm :: Reference.Id -> m (Maybe (Term.Term v a)) - tm id = pure $ Map.lookup id termMap + tm id = pure . fmap fst $ Map.lookup id termMap + tmTyp :: Reference.Id -> m (Maybe (Type.Type v a)) + tmTyp id = pure . fmap snd $ Map.lookup id termMap ty :: Reference.Id -> m (Maybe (DataDeclaration.Decl v a)) ty id = pure $ Map.lookup id dataDeclMap <|> Map.lookup id effectDeclMap dataDeclMap = @@ -31,5 +34,5 @@ fromTypecheckedUnisonFile tuf = CodeLookup tm ty | (_, (Reference.DerivedId id, ad)) <- Map.toList (UF.effectDeclarations' tuf) ] - termMap :: Map Reference.Id (Term.Term v a) - termMap = Map.fromList [(id, tm) | (_a, id, _wk, tm, _tp) <- toList $ UF.hashTermsId tuf] + termMap :: Map Reference.Id (Term.Term v a, Type.Type v a) + termMap = Map.fromList [(id, (tm, typ)) | (_a, id, _wk, tm, typ) <- toList $ UF.hashTermsId tuf] diff --git a/parser-typechecker/src/Unison/Codebase/Runtime.hs b/parser-typechecker/src/Unison/Codebase/Runtime.hs index 2669df121f..f790076f27 100644 --- a/parser-typechecker/src/Unison/Codebase/Runtime.hs +++ b/parser-typechecker/src/Unison/Codebase/Runtime.hs @@ -29,6 +29,13 @@ type Error = P.Pretty P.ColorText type Term v = Term.Term v () +data CompileOpts = COpts + { profile :: Bool + } + +defaultCompileOpts :: CompileOpts +defaultCompileOpts = COpts {profile = False} + data Runtime v = Runtime { terminate :: IO (), evaluate :: @@ -37,6 +44,7 @@ data Runtime v = Runtime Term v -> IO (Either Error ([Error], Term v)), compileTo :: + CompileOpts -> CL.CodeLookup v IO () -> PPE.PrettyPrintEnv -> Reference -> diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs index c104e79c87..e4d363b4c0 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs @@ -12,19 +12,10 @@ module Unison.Codebase.SqliteCodebase ) where -import Control.Monad.Except qualified as Except -import Control.Monad.Extra qualified as Monad import Data.Either.Extra () -import Data.IORef import Data.Map qualified as Map -import Data.Set qualified as Set -import System.Console.ANSI qualified as ANSI import System.FileLock (SharedExclusive (Exclusive), withTryFileLock) -import U.Codebase.HashTags (CausalHash, PatchHash (..)) -import U.Codebase.Sqlite.Queries qualified as Q -import U.Codebase.Sqlite.Sync22 qualified as Sync22 -import U.Codebase.Sqlite.V2.HashHandle (v2HashHandle) -import U.Codebase.Sync qualified as Sync +import U.Codebase.HashTags (CausalHash) import Unison.Codebase (Codebase, CodebasePath) import Unison.Codebase qualified as Codebase1 import Unison.Codebase.Branch (Branch (..)) @@ -35,11 +26,9 @@ import Unison.Codebase.Init.CreateCodebaseError qualified as Codebase1 import Unison.Codebase.Init.OpenCodebaseError (OpenCodebaseError (..)) import Unison.Codebase.Init.OpenCodebaseError qualified as Codebase1 import Unison.Codebase.SqliteCodebase.Branch.Cache (newBranchCache) -import Unison.Codebase.SqliteCodebase.Branch.Dependencies qualified as BD import Unison.Codebase.SqliteCodebase.Migrations qualified as Migrations import Unison.Codebase.SqliteCodebase.Operations qualified as CodebaseOps import Unison.Codebase.SqliteCodebase.Paths -import Unison.Codebase.SqliteCodebase.SyncEphemeral qualified as SyncEphemeral import Unison.Codebase.Type (LocalOrRemote (..)) import Unison.Codebase.Type qualified as C import Unison.DataDeclaration (Decl) @@ -55,17 +44,15 @@ import Unison.Symbol (Symbol) import Unison.Term (Term) import Unison.Type (Type) import Unison.Util.Cache qualified as Cache -import Unison.Util.Timing (time) import Unison.WatchKind qualified as UF -import UnliftIO (UnliftIO (..), finally) +import UnliftIO (finally) import UnliftIO qualified as UnliftIO import UnliftIO.Concurrent qualified as UnliftIO -import UnliftIO.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist) +import UnliftIO.Directory (createDirectoryIfMissing, doesFileExist) import UnliftIO.STM -debug, debugProcessBranches :: Bool +debug :: Bool debug = False -debugProcessBranches = False init :: (HasCallStack, MonadUnliftIO m) => @@ -127,14 +114,6 @@ withCodebaseOrError debugName dir lockOption migrationStrategy action = do False -> pure (Left Codebase1.OpenCodebaseDoesntExist) True -> sqliteCodebase debugName dir Local lockOption migrationStrategy action -initSchemaIfNotExist :: (MonadIO m) => FilePath -> m () -initSchemaIfNotExist path = liftIO do - unlessM (doesDirectoryExist $ makeCodebaseDirPath path) $ - createDirectoryIfMissing True (makeCodebaseDirPath path) - unlessM (doesFileExist $ makeCodebasePath path) $ - withConnection "initSchemaIfNotExist" path \conn -> - Sqlite.runTransaction conn CodebaseOps.createSchema - -- 1) buffer up the component -- 2) in the event that the component is complete, then what? -- * can write component provided all of its dependency components are complete. @@ -267,25 +246,6 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action UnliftIO.evaluate b pure () - syncFromDirectory :: Codebase1.CodebasePath -> Branch m -> m () - syncFromDirectory srcRoot b = - withConnection (debugName ++ ".sync.src") srcRoot \srcConn -> - withConn \destConn -> do - progressStateRef <- liftIO (newIORef emptySyncProgressState) - Sqlite.runReadOnlyTransaction srcConn \runSrc -> - Sqlite.runWriteTransaction destConn \runDest -> do - syncInternal (syncProgress progressStateRef) runSrc runDest b - - syncToDirectory :: Codebase1.CodebasePath -> Branch m -> m () - syncToDirectory destRoot b = - withConn \srcConn -> - withConnection (debugName ++ ".sync.dest") destRoot \destConn -> do - progressStateRef <- liftIO (newIORef emptySyncProgressState) - initSchemaIfNotExist destRoot - Sqlite.runReadOnlyTransaction srcConn \runSrc -> - Sqlite.runWriteTransaction destConn \runDest -> do - syncInternal (syncProgress progressStateRef) runSrc runDest b - getWatch :: UF.WatchKind -> Reference.Id -> Sqlite.Transaction (Maybe (Term Symbol Ann)) getWatch = CodebaseOps.getWatch getDeclType @@ -323,8 +283,6 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action getTermComponentWithTypes, getBranchForHash, putBranch, - syncFromDirectory, - syncToDirectory, getWatch, termsOfTypeImpl, termsMentioningTypeImpl, @@ -352,79 +310,6 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action Nothing -> Left OpenCodebaseFileLockFailed Just x -> x -syncInternal :: - forall m. - (MonadUnliftIO m) => - Sync.Progress m Sync22.Entity -> - (forall a. Sqlite.Transaction a -> m a) -> - (forall a. Sqlite.Transaction a -> m a) -> - Branch m -> - m () -syncInternal progress runSrc runDest b = time "syncInternal" do - UnliftIO runInIO <- askUnliftIO - - let syncEnv = Sync22.Env runSrc runDest (16 * 1024 * 1024) - -- we want to use sync22 wherever possible - -- so for each source branch, we'll check if it exists in the destination codebase - -- or if it exists in the source codebase, then we can sync22 it - -- if it doesn't exist in the dest or source branch, - -- then just use putBranch to the dest - sync <- liftIO (Sync22.sync22 v2HashHandle (Sync22.hoistEnv lift syncEnv)) - let doSync :: [Sync22.Entity] -> m () - doSync = - throwExceptT - . Except.withExceptT SyncEphemeral.Sync22Error - . Sync.sync' sync (Sync.transformProgress lift progress) - let processBranches :: [Entity m] -> m () - processBranches = \case - [] -> pure () - b0@(B h mb) : rest -> do - when debugProcessBranches do - traceM $ "processBranches " ++ show b0 - traceM $ " queue: " ++ show rest - ifM - (runDest (CodebaseOps.branchExists h)) - do - when debugProcessBranches $ traceM $ " " ++ show b0 ++ " already exists in dest db" - processBranches rest - do - when debugProcessBranches $ traceM $ " " ++ show b0 ++ " doesn't exist in dest db" - runSrc (Q.loadCausalHashIdByCausalHash h) >>= \case - Just chId -> do - when debugProcessBranches $ traceM $ " " ++ show b0 ++ " exists in source db, so delegating to direct sync" - doSync [Sync22.C chId] - processBranches rest - Nothing -> - mb >>= \b -> do - when debugProcessBranches $ traceM $ " " ++ show b0 ++ " doesn't exist in either db, so delegating to Codebase.putBranch" - let (branchDeps, BD.to' -> BD.Dependencies' es ts ds) = BD.fromBranch b - when debugProcessBranches do - traceM $ " branchDeps: " ++ show (fst <$> branchDeps) - traceM $ " terms: " ++ show ts - traceM $ " decls: " ++ show ds - traceM $ " edits: " ++ show es - (cs, es, ts, ds) <- runDest do - cs <- filterM (fmap not . CodebaseOps.branchExists . fst) branchDeps - es <- filterM (fmap not . CodebaseOps.patchExists) es - ts <- filterM (fmap not . CodebaseOps.termExists) ts - ds <- filterM (fmap not . CodebaseOps.declExists) ds - pure (cs, es, ts, ds) - if null cs && null es && null ts && null ds - then do - runDest (CodebaseOps.putBranch (Branch.transform (Sqlite.unsafeIO . runInIO) b)) - processBranches rest - else do - let bs = map (uncurry B) cs - os = map O (coerce @[PatchHash] @[Hash] es <> ts <> ds) - processBranches (os ++ bs ++ b0 : rest) - O h : rest -> do - when debugProcessBranches $ traceM $ "processBranches O " ++ take 10 (show h) - oId <- runSrc (Q.expectHashIdByHash h >>= Q.expectObjectIdForAnyHashId) - doSync [Sync22.O oId] - processBranches rest - let bHash = Branch.headHash b - time "SyncInternal.processBranches" $ processBranches [B bHash (pure b)] - data Entity m = B CausalHash (m (Branch m)) | O Hash @@ -433,89 +318,6 @@ instance Show (Entity m) where show (B h _) = "B " ++ take 10 (show h) show (O h) = "O " ++ take 10 (show h) -data SyncProgressState = SyncProgressState - { _needEntities :: Maybe (Set Sync22.Entity), - _doneEntities :: Either Int (Set Sync22.Entity), - _warnEntities :: Either Int (Set Sync22.Entity) - } - -emptySyncProgressState :: SyncProgressState -emptySyncProgressState = SyncProgressState (Just mempty) (Right mempty) (Right mempty) - -syncProgress :: forall m. (MonadIO m) => IORef SyncProgressState -> Sync.Progress m Sync22.Entity -syncProgress progressStateRef = Sync.Progress (liftIO . need) (liftIO . done) (liftIO . warn) (liftIO allDone) - where - quiet = False - maxTrackedHashCount = 1024 * 1024 - size :: SyncProgressState -> Int - size = \case - SyncProgressState Nothing (Left i) (Left j) -> i + j - SyncProgressState (Just need) (Right done) (Right warn) -> Set.size need + Set.size done + Set.size warn - SyncProgressState _ _ _ -> undefined - - need, done, warn :: Sync22.Entity -> IO () - need h = do - unless quiet $ Monad.whenM (readIORef progressStateRef <&> (== 0) . size) $ putStr "\n" - readIORef progressStateRef >>= \case - SyncProgressState Nothing Left {} Left {} -> pure () - SyncProgressState (Just need) (Right done) (Right warn) -> - if Set.size need + Set.size done + Set.size warn > maxTrackedHashCount - then writeIORef progressStateRef $ SyncProgressState Nothing (Left $ Set.size done) (Left $ Set.size warn) - else - if Set.member h done || Set.member h warn - then pure () - else writeIORef progressStateRef $ SyncProgressState (Just $ Set.insert h need) (Right done) (Right warn) - SyncProgressState _ _ _ -> undefined - unless quiet printSynced - - done h = do - unless quiet $ Monad.whenM (readIORef progressStateRef <&> (== 0) . size) $ putStr "\n" - readIORef progressStateRef >>= \case - SyncProgressState Nothing (Left done) warn -> - writeIORef progressStateRef $ SyncProgressState Nothing (Left (done + 1)) warn - SyncProgressState (Just need) (Right done) warn -> - writeIORef progressStateRef $ SyncProgressState (Just $ Set.delete h need) (Right $ Set.insert h done) warn - SyncProgressState _ _ _ -> undefined - unless quiet printSynced - - warn h = do - unless quiet $ Monad.whenM (readIORef progressStateRef <&> (== 0) . size) $ putStr "\n" - readIORef progressStateRef >>= \case - SyncProgressState Nothing done (Left warn) -> - writeIORef progressStateRef $ SyncProgressState Nothing done (Left $ warn + 1) - SyncProgressState (Just need) done (Right warn) -> - writeIORef progressStateRef $ SyncProgressState (Just $ Set.delete h need) done (Right $ Set.insert h warn) - SyncProgressState _ _ _ -> undefined - unless quiet printSynced - - allDone = do - readIORef progressStateRef >>= putStrLn . renderState (" " ++ "Done syncing ") - - printSynced :: IO () - printSynced = - readIORef progressStateRef >>= \s -> - finally - do ANSI.hideCursor; putStr . renderState (" " ++ "Synced ") $ s - ANSI.showCursor - - renderState :: String -> SyncProgressState -> String - renderState prefix = \case - SyncProgressState Nothing (Left done) (Left warn) -> - "\r" ++ prefix ++ show done ++ " entities" ++ if warn > 0 then " with " ++ show warn ++ " warnings." else "." - SyncProgressState (Just _need) (Right done) (Right warn) -> - "\r" - ++ prefix - ++ show (Set.size done + Set.size warn) - ++ " entities" - ++ if Set.size warn > 0 - then " with " ++ show (Set.size warn) ++ " warnings." - else "." - SyncProgressState need done warn -> - "invalid SyncProgressState " - ++ show (fmap v need, bimap id v done, bimap id v warn) - where - v = const () - -- | Given two codebase roots (e.g. "./mycodebase"), safely copy the codebase -- at the source to the destination. -- Note: this does not copy the .unisonConfig file. diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/SyncEphemeral.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/SyncEphemeral.hs index 1dcbb24b27..b9247fdf70 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/SyncEphemeral.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/SyncEphemeral.hs @@ -2,7 +2,6 @@ module Unison.Codebase.SqliteCodebase.SyncEphemeral where import U.Codebase.HashTags (CausalHash) import U.Codebase.Sqlite.DbId (SchemaVersion) -import U.Codebase.Sqlite.Sync22 qualified as Sync22 import Unison.Hash (Hash) import Unison.Prelude @@ -12,8 +11,7 @@ data Dependencies = Dependencies } data Error - = Sync22Error Sync22.Error - | SrcWrongSchema SchemaVersion + = SrcWrongSchema SchemaVersion | DestWrongSchema SchemaVersion | DisappearingBranch CausalHash deriving stock (Show) diff --git a/parser-typechecker/src/Unison/Codebase/Type.hs b/parser-typechecker/src/Unison/Codebase/Type.hs index af69f555cd..e7ee5ef640 100644 --- a/parser-typechecker/src/Unison/Codebase/Type.hs +++ b/parser-typechecker/src/Unison/Codebase/Type.hs @@ -9,14 +9,13 @@ module Unison.Codebase.Type where import U.Codebase.HashTags (CausalHash) -import U.Codebase.Reference qualified as V2 import Unison.Codebase.Branch (Branch) import Unison.CodebasePath (CodebasePath) import Unison.ConstructorType qualified as CT import Unison.DataDeclaration (Decl) import Unison.Hash (Hash) import Unison.Prelude -import Unison.Reference (Reference, TypeReference) +import Unison.Reference (Reference, TermReferenceId, TypeReference, TypeReferenceId) import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent import Unison.ShortHash (ShortHash) @@ -31,27 +30,27 @@ data Codebase m v a = Codebase -- -- Note that it is possible to call 'putTerm', then 'getTerm', and receive @Nothing@, per the semantics of -- 'putTerm'. - getTerm :: Reference.Id -> Sqlite.Transaction (Maybe (Term v a)), + getTerm :: TermReferenceId -> Sqlite.Transaction (Maybe (Term v a)), -- | Get the type of a user-defined term. -- -- Note that it is possible to call 'putTerm', then 'getTypeOfTermImpl', and receive @Nothing@, per the semantics of -- 'putTerm'. - getTypeOfTermImpl :: Reference.Id -> Sqlite.Transaction (Maybe (Type v a)), + getTypeOfTermImpl :: TermReferenceId -> Sqlite.Transaction (Maybe (Type v a)), -- | Get a type declaration. -- -- Note that it is possible to call 'putTypeDeclaration', then 'getTypeDeclaration', and receive @Nothing@, per the -- semantics of 'putTypeDeclaration'. - getTypeDeclaration :: Reference.Id -> Sqlite.Transaction (Maybe (Decl v a)), + getTypeDeclaration :: TypeReferenceId -> Sqlite.Transaction (Maybe (Decl v a)), -- | Get the type of a given decl. - getDeclType :: V2.Reference -> Sqlite.Transaction CT.ConstructorType, + getDeclType :: TypeReference -> Sqlite.Transaction CT.ConstructorType, -- | Enqueue the put of a user-defined term (with its type) into the codebase, if it doesn't already exist. The -- implementation may choose to delay the put until all of the term's (and its type's) references are stored as -- well. - putTerm :: Reference.Id -> Term v a -> Type v a -> Sqlite.Transaction (), + putTerm :: TermReferenceId -> Term v a -> Type v a -> Sqlite.Transaction (), putTermComponent :: Hash -> [(Term v a, Type v a)] -> Sqlite.Transaction (), -- | Enqueue the put of a type declaration into the codebase, if it doesn't already exist. The implementation may -- choose to delay the put until all of the type declaration's references are stored as well. - putTypeDeclaration :: Reference.Id -> Decl v a -> Sqlite.Transaction (), + putTypeDeclaration :: TypeReferenceId -> Decl v a -> Sqlite.Transaction (), putTypeDeclarationComponent :: Hash -> [Decl v a] -> Sqlite.Transaction (), -- getTermComponent :: Hash -> m (Maybe [Term v a]), getTermComponentWithTypes :: Hash -> Sqlite.Transaction (Maybe [(Term v a, Type v a)]), @@ -61,12 +60,8 @@ data Codebase m v a = Codebase -- -- The terms and type declarations that a branch references must already exist in the codebase. putBranch :: Branch m -> m (), - -- | Copy a branch and all of its dependencies from the given codebase into this one. - syncFromDirectory :: CodebasePath -> Branch m -> m (), - -- | Copy a branch and all of its dependencies from this codebase into the given codebase. - syncToDirectory :: CodebasePath -> Branch m -> m (), -- | @getWatch k r@ returns watch result @t@ that was previously put by @putWatch k r t@. - getWatch :: WK.WatchKind -> Reference.Id -> Sqlite.Transaction (Maybe (Term v a)), + getWatch :: WK.WatchKind -> TermReferenceId -> Sqlite.Transaction (Maybe (Term v a)), -- | Get the set of user-defined terms-or-constructors that have the given type. termsOfTypeImpl :: Reference -> Sqlite.Transaction (Set Referent.Id), -- | Get the set of user-defined terms-or-constructors mention the given type anywhere in their signature. diff --git a/parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs b/parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs index 59d168b2e1..0958aaf9c4 100644 --- a/parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs +++ b/parser-typechecker/src/Unison/DataDeclaration/Dependencies.hs @@ -121,5 +121,6 @@ hashFieldAccessors ppe declName vars declRef dd = do dataDecls = Map.singleton declRef (void dd), effectDecls = mempty }, - termsByShortname = mempty + termsByShortname = mempty, + topLevelComponents = Map.empty } diff --git a/parser-typechecker/src/Unison/FileParsers.hs b/parser-typechecker/src/Unison/FileParsers.hs index cc02c9f736..f1c352aea8 100644 --- a/parser-typechecker/src/Unison/FileParsers.hs +++ b/parser-typechecker/src/Unison/FileParsers.hs @@ -9,20 +9,22 @@ import Control.Lens import Control.Monad.State (evalStateT) import Data.Foldable qualified as Foldable import Data.List (partition) -import Data.List.NonEmpty qualified as List.NonEmpty +import Data.List qualified as List import Data.Map qualified as Map import Data.Sequence qualified as Seq import Data.Set qualified as Set import Unison.ABT qualified as ABT import Unison.Blank qualified as Blank import Unison.Builtin qualified as Builtin -import Unison.Name qualified as Name +import Unison.ConstructorReference qualified as ConstructorReference +import Unison.Name (Name) import Unison.Names qualified as Names -import Unison.NamesWithHistory qualified as Names +import Unison.Names.ResolvesTo (ResolvesTo (..)) import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.PrettyPrintEnv.Names qualified as PPE -import Unison.Reference (Reference) +import Unison.Reference (TermReference, TypeReference) +import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Result (CompilerBug (..), Note (..), ResultT, pattern Result) import Unison.Result qualified as Result @@ -37,7 +39,10 @@ import Unison.Typechecker.TypeLookup qualified as TL import Unison.UnisonFile (definitionLocation) import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Names qualified as UF +import Unison.Util.Defns (Defns (..), DefnsF) import Unison.Util.List qualified as List +import Unison.Util.Map qualified as Map (upsert) +import Unison.Util.Relation (Relation) import Unison.Util.Relation qualified as Rel import Unison.Var (Var) import Unison.Var qualified as Var @@ -73,10 +78,11 @@ data ShouldUseTndr m -- * The parsing environment that was used to parse the parsed Unison file. -- * The parsed Unison file for which the typechecking environment is applicable. computeTypecheckingEnvironment :: + forall m v. (Var v, Monad m) => ShouldUseTndr m -> [Type v] -> - (Set Reference -> m (TL.TypeLookup v Ann)) -> + (DefnsF Set TermReference TypeReference -> m (TL.TypeLookup v Ann)) -> UnisonFile v -> m (Typechecker.Env v Ann) computeTypecheckingEnvironment shouldUseTndr ambientAbilities typeLookupf uf = @@ -87,52 +93,53 @@ computeTypecheckingEnvironment shouldUseTndr ambientAbilities typeLookupf uf = Typechecker.Env { ambientAbilities = ambientAbilities, typeLookup = tl, - termsByShortname = Map.empty + termsByShortname = Map.empty, + topLevelComponents = Map.empty } ShouldUseTndr'Yes parsingEnv -> do - let preexistingNames = Parser.names parsingEnv - tm = UF.typecheckingTerm uf - possibleDeps = - [ (name, shortname, r) - | (name, r) <- Rel.toList (Names.terms preexistingNames), - v <- Set.toList (Term.freeVars tm), - let shortname = Name.unsafeParseVar v, - name `Name.endsWithReverseSegments` List.NonEmpty.toList (Name.reverseSegments shortname) - ] - possibleRefs = Referent.toReference . view _3 <$> possibleDeps - tl <- fmap (UF.declsToTypeLookup uf <>) (typeLookupf (UF.dependencies uf <> Set.fromList possibleRefs)) - -- For populating the TDNR environment, we pick definitions - -- from the namespace and from the local file whose full name - -- has a suffix that equals one of the free variables in the file. - -- Example, the namespace has [foo.bar.baz, qux.quaffle] and - -- the file has definitons [utils.zonk, utils.blah] and - -- the file has free variables [bar.baz, zonk]. - -- - -- In this case, [foo.bar.baz, utils.zonk] are used to create - -- the TDNR environment. - let fqnsByShortName = - List.multimap $ - -- external TDNR possibilities - [ (shortname, nr) - | (name, shortname, r) <- possibleDeps, - typ <- toList $ TL.typeOfReferent tl r, - let nr = Typechecker.NamedReference name typ (Context.ReplacementRef r) - ] - <> - -- local file TDNR possibilities - [ (shortname, nr) - | (name, r) <- Rel.toList (Names.terms $ UF.toNames uf), - v <- Set.toList (Term.freeVars tm), - let shortname = Name.unsafeParseVar v, - name `Name.endsWithReverseSegments` List.NonEmpty.toList (Name.reverseSegments shortname), - typ <- toList $ TL.typeOfReferent tl r, - let nr = Typechecker.NamedReference name typ (Context.ReplacementRef r) - ] + let tm = UF.typecheckingTerm uf + resolveName :: Name -> Relation Name (ResolvesTo Referent) + resolveName = + Names.resolveNameIncludingNames + (Names.shadowing1 (Names.terms (UF.toNames uf)) (Names.terms (Parser.names parsingEnv))) + (Set.map Name.unsafeParseVar (UF.toTermAndWatchNames uf)) + possibleDeps = do + v <- Set.toList (Term.freeVars tm) + let shortname = Name.unsafeParseVar v + (name, ref) <- Rel.toList (resolveName shortname) + [(name, shortname, ref)] + possibleRefs = + List.foldl' + ( \acc -> \case + (_, _, ResolvesToNamespace ref0) -> + case ref0 of + Referent.Con ref _ -> acc & over #types (Set.insert (ref ^. ConstructorReference.reference_)) + Referent.Ref ref -> acc & over #terms (Set.insert ref) + (_, _, ResolvesToLocal _) -> acc + ) + (Defns Set.empty Set.empty) + possibleDeps + tl <- fmap (UF.declsToTypeLookup uf <>) (typeLookupf (UF.dependencies uf <> possibleRefs)) + let termsByShortname :: Map Name [Either Name (Typechecker.NamedReference v Ann)] + termsByShortname = + List.foldl' + ( \acc -> \case + (name, shortname, ResolvesToLocal _) -> let v = Left name in Map.upsert (maybe [v] (v :)) shortname acc + (name, shortname, ResolvesToNamespace ref) -> + case TL.typeOfReferent tl ref of + Just ty -> + let v = Right (Typechecker.NamedReference name ty (Context.ReplacementRef ref)) + in Map.upsert (maybe [v] (v :)) shortname acc + Nothing -> acc + ) + Map.empty + possibleDeps pure Typechecker.Env - { ambientAbilities = ambientAbilities, + { ambientAbilities, typeLookup = tl, - termsByShortname = fqnsByShortName + termsByShortname, + topLevelComponents = Map.empty } synthesizeFile :: diff --git a/parser-typechecker/src/Unison/Hashing/V2/Convert.hs b/parser-typechecker/src/Unison/Hashing/V2/Convert.hs index 7585e6b8b9..972c55db2a 100644 --- a/parser-typechecker/src/Unison/Hashing/V2/Convert.hs +++ b/parser-typechecker/src/Unison/Hashing/V2/Convert.hs @@ -227,7 +227,7 @@ h2mReferent getCT = \case hashDataDecls :: (Var v) => Map v (Memory.DD.DataDeclaration v a) -> - ResolutionResult v a [(v, Memory.Reference.Id, Memory.DD.DataDeclaration v a)] + ResolutionResult a [(v, Memory.Reference.Id, Memory.DD.DataDeclaration v a)] hashDataDecls memDecls = do let hashingDecls = fmap m2hDecl memDecls hashingResult <- Hashing.hashDecls Name.unsafeParseVar hashingDecls @@ -239,7 +239,7 @@ hashDataDecls memDecls = do hashDecls :: (Var v) => Map v (Memory.DD.Decl v a) -> - ResolutionResult v a [(v, Memory.Reference.Id, Memory.DD.Decl v a)] + ResolutionResult a [(v, Memory.Reference.Id, Memory.DD.Decl v a)] hashDecls memDecls = do -- want to unwrap the decl before doing the rehashing, and then wrap it back up the same way let howToReassemble = diff --git a/parser-typechecker/src/Unison/KindInference/Generate.hs b/parser-typechecker/src/Unison/KindInference/Generate.hs index ab675534d2..0886cacc4c 100644 --- a/parser-typechecker/src/Unison/KindInference/Generate.hs +++ b/parser-typechecker/src/Unison/KindInference/Generate.hs @@ -27,6 +27,7 @@ import Unison.Prelude import Unison.Reference (Reference) import Unison.Term qualified as Term import Unison.Type qualified as Type +import Unison.Util.Recursion import Unison.Var (Type (User), Var (typed), freshIn) -------------------------------------------------------------------------------- @@ -101,7 +102,7 @@ typeConstraintTree resultVar term@ABT.Term {annotation, out} = do restConstraints <- typeConstraintTree resultVar b pure $ Node [effConstraints, restConstraints] Type.Effects effs -> do - Node <$> for effs \eff -> do + ParentConstraint (IsAbility resultVar (Provenance EffectsList annotation)) . Node <$> for effs \eff -> do effKind <- freshVar eff effConstraints <- typeConstraintTree effKind eff pure $ ParentConstraint (IsAbility effKind (Provenance EffectsList $ ABT.annotation eff)) effConstraints @@ -160,7 +161,7 @@ instantiateType type0 k = -- | Process type annotations depth-first. Allows processing -- annotations with lexical scoping. dfAnns :: (loc -> Type.Type v loc -> b -> b) -> (b -> b -> b) -> b -> Term.Term v loc -> b -dfAnns annAlg cons nil = ABT.cata \ann abt0 -> case abt0 of +dfAnns annAlg cons nil = cata \(ABT.Term' _ ann abt0) -> case abt0 of ABT.Var _ -> nil ABT.Cycle x -> x ABT.Abs _ x -> x @@ -173,7 +174,7 @@ dfAnns annAlg cons nil = ABT.cata \ann abt0 -> case abt0 of -- annotations. hackyStripAnns :: (Ord v) => Term.Term v loc -> Term.Term v loc hackyStripAnns = - snd . ABT.cata \ann abt0 -> case abt0 of + snd . cata \(ABT.Term' _ ann abt0) -> case abt0 of ABT.Var v -> (False, ABT.var ann v) ABT.Cycle (_, x) -> (False, ABT.cycle ann x) ABT.Abs v (_, x) -> (False, ABT.abs ann v x) @@ -188,7 +189,7 @@ hackyStripAnns = in (isHack, Term.constructor ann cref) t -> (False, ABT.tm ann (snd <$> t)) where - stripAnns = ABT.cata \ann abt0 -> case abt0 of + stripAnns = cata \(ABT.Term' _ ann abt0) -> case abt0 of ABT.Var v -> ABT.var ann v ABT.Cycle x -> ABT.cycle ann x ABT.Abs v x -> ABT.abs ann v x diff --git a/parser-typechecker/src/Unison/Parsers.hs b/parser-typechecker/src/Unison/Parsers.hs index fc1500a12f..13ce658a8a 100644 --- a/parser-typechecker/src/Unison/Parsers.hs +++ b/parser-typechecker/src/Unison/Parsers.hs @@ -78,7 +78,9 @@ unsafeParseFileBuiltinsOnly = Parser.ParsingEnv { uniqueNames = mempty, uniqueTypeGuid = \_ -> pure Nothing, - names = Builtin.names + names = Builtin.names, + maybeNamespace = Nothing, + localNamespacePrefixedTypesAndConstructors = mempty } unsafeParseFile :: (Monad m) => String -> Parser.ParsingEnv m -> m (UnisonFile Symbol Ann) diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage.hs b/parser-typechecker/src/Unison/PatternMatchCoverage.hs index 30973b8256..75cd0a7ce4 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage.hs @@ -35,7 +35,6 @@ module Unison.PatternMatchCoverage ) where -import Data.List.NonEmpty (nonEmpty) import Data.Set qualified as Set import Debug.Trace import Unison.Debug @@ -63,16 +62,14 @@ checkMatch :: checkMatch scrutineeType cases = do ppe <- getPrettyPrintEnv v0 <- fresh - mgrdtree0 <- traverse (desugarMatch scrutineeType v0) (nonEmpty cases) - doDebug (P.hang (title "desugared:") (prettyGrdTreeMaybe (prettyPmGrd ppe) (\_ -> "") mgrdtree0)) (pure ()) + grdtree0 <- desugarMatch scrutineeType v0 cases + doDebug (P.hang (title "desugared:") (prettyGrdTree (prettyPmGrd ppe) (\_ -> "") grdtree0)) (pure ()) let initialUncovered = Set.singleton (NC.markDirty v0 $ NC.declVar v0 scrutineeType id NC.emptyNormalizedConstraints) - (uncovered, grdtree1) <- case mgrdtree0 of - Nothing -> pure (initialUncovered, Nothing) - Just grdtree0 -> fmap Just <$> uncoverAnnotate initialUncovered grdtree0 + (uncovered, grdtree1) <- uncoverAnnotate initialUncovered grdtree0 doDebug ( P.sep "\n" - [ P.hang (title "annotated:") (prettyGrdTreeMaybe (NC.prettyDnf ppe) (NC.prettyDnf ppe . fst) grdtree1), + [ P.hang (title "annotated:") (prettyGrdTree (NC.prettyDnf ppe) (NC.prettyDnf ppe . fst) grdtree1), P.hang (title "uncovered:") (NC.prettyDnf ppe uncovered) ] ) @@ -80,14 +77,9 @@ checkMatch scrutineeType cases = do uncoveredExpanded <- concat . fmap Set.toList <$> traverse (expandSolution v0) (Set.toList uncovered) doDebug (P.hang (title "uncovered expanded:") (NC.prettyDnf ppe (Set.fromList uncoveredExpanded))) (pure ()) let sols = map (generateInhabitants v0) uncoveredExpanded - let (_accessible, inaccessible, redundant) = case grdtree1 of - Nothing -> ([], [], []) - Just x -> classify x + let (_accessible, inaccessible, redundant) = classify grdtree1 pure (redundant, inaccessible, sols) where - prettyGrdTreeMaybe prettyNode prettyLeaf = \case - Nothing -> "" - Just x -> prettyGrdTree prettyNode prettyLeaf x title = P.bold doDebug out = case shouldDebug PatternCoverage of True -> trace (P.toAnsiUnbroken out) diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/Desugar.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/Desugar.hs index 8587d44d6c..273f1298e2 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/Desugar.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/Desugar.hs @@ -3,18 +3,17 @@ module Unison.PatternMatchCoverage.Desugar ) where -import Data.List.NonEmpty (NonEmpty (..)) import U.Core.ABT qualified as ABT import Unison.Pattern import Unison.Pattern qualified as Pattern import Unison.PatternMatchCoverage.Class -import Unison.PatternMatchCoverage.Fix import Unison.PatternMatchCoverage.GrdTree import Unison.PatternMatchCoverage.PmGrd import Unison.PatternMatchCoverage.PmLit qualified as PmLit import Unison.Term (MatchCase (..), Term', app, var) import Unison.Type (Type) import Unison.Type qualified as Type +import Unison.Util.Recursion -- | Desugar a match into a 'GrdTree' desugarMatch :: @@ -25,7 +24,7 @@ desugarMatch :: -- | scrutinee variable v -> -- | match cases - NonEmpty (MatchCase loc (Term' vt v loc)) -> + [MatchCase loc (Term' vt v loc)] -> m (GrdTree (PmGrd vt v loc) loc) desugarMatch scrutineeType v0 cs0 = Fork <$> traverse desugarClause cs0 where @@ -115,32 +114,31 @@ listToGrdTree :: [v] -> m (GrdTree (PmGrd vt v loc) loc) listToGrdTree _listTyp elemTyp listVar nl0 k0 vs0 = - let (minLen, maxLen) = countMinListLen nl0 - in Grd (PmListInterval listVar minLen maxLen) <$> go 0 0 nl0 k0 vs0 + let (minLen, maxLen) = cata countMinListLen nl0 0 + in Grd (PmListInterval listVar minLen maxLen) <$> cata go nl0 0 0 k0 vs0 where - go consCount snocCount (Fix pat) k vs = case pat of + go pat consCount snocCount k vs = case pat of N'ConsF x xs -> do element <- fresh let grd = PmListHead listVar consCount element elemTyp let !consCount' = consCount + 1 - Grd grd <$> desugarPattern elemTyp element x (go consCount' snocCount xs k) vs + Grd grd <$> desugarPattern elemTyp element x (xs consCount' snocCount k) vs N'SnocF xs x -> do element <- fresh let grd = PmListTail listVar snocCount element elemTyp let !snocCount' = snocCount + 1 - Grd grd <$> go consCount snocCount' xs (desugarPattern elemTyp element x k) vs + Grd grd <$> xs consCount snocCount' (desugarPattern elemTyp element x k) vs N'NilF -> k vs N'VarF _ -> k (listVar : vs) N'UnboundF _ -> k vs - countMinListLen :: NormalizedList loc -> (Int, Int) - countMinListLen = - ($ 0) . cata \case - N'ConsF _ b -> \acc -> b $! acc + 1 - N'SnocF b _ -> \acc -> b $! acc + 1 - N'NilF -> \ !n -> (n, n) - N'VarF _ -> \ !n -> (n, maxBound) - N'UnboundF _ -> \ !n -> (n, maxBound) + countMinListLen :: Algebra (NormalizedListF loc) (Int -> (Int, Int)) + countMinListLen = \case + N'ConsF _ b -> \acc -> b $! acc + 1 + N'SnocF b _ -> \acc -> b $! acc + 1 + N'NilF -> \ !n -> (n, n) + N'VarF _ -> \ !n -> (n, maxBound) + N'UnboundF _ -> \ !n -> (n, maxBound) data NormalizedListF loc a = N'ConsF (Pattern loc) a diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/Fix.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/Fix.hs deleted file mode 100644 index 9accc06fb4..0000000000 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/Fix.hs +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE QuantifiedConstraints #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE UndecidableInstances #-} - -module Unison.PatternMatchCoverage.Fix where - -newtype Fix f = Fix {unFix :: f (Fix f)} - -deriving instance (forall a. (Show a) => Show (f a)) => Show (Fix f) - -deriving instance (forall a. (Eq a) => Eq (f a)) => Eq (Fix f) - -deriving instance (Eq (Fix f), forall a. (Ord a) => Ord (f a)) => Ord (Fix f) - -cata :: (Functor f) => (f a -> a) -> Fix f -> a -cata alg = let c = alg . fmap c . unFix in c - -para :: (Functor f) => (f (Fix f, a) -> a) -> Fix f -> a -para alg = let c = alg . fmap (\x -> (x, c x)) . unFix in c diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/GrdTree.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/GrdTree.hs index 15b28e3da3..3d6e142b9d 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/GrdTree.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/GrdTree.hs @@ -10,12 +10,10 @@ module Unison.PatternMatchCoverage.GrdTree ) where -import Data.List.NonEmpty (NonEmpty (..)) -import Data.List.NonEmpty qualified as NEL import Data.ListLike (ListLike) -import Unison.PatternMatchCoverage.Fix import Unison.Prelude import Unison.Util.Pretty +import Unison.Util.Recursion -- | A @GrdTree@ is the simple language to desugar matches into. All -- pattern matching constructs (/e.g./ structural pattern matching, @@ -55,7 +53,7 @@ data GrdTreeF n l a | -- | A constraint of some kind (structural pattern match, boolan guard, etc) GrdF n a | -- | A list of alternative matches, tried in order - ForkF (NonEmpty a) + ForkF [a] deriving stock (Functor, Show) prettyGrdTree :: forall n l s. (ListLike s Char, IsString s) => (n -> Pretty s) -> (l -> Pretty s) -> GrdTree n l -> Pretty s @@ -64,7 +62,7 @@ prettyGrdTree prettyNode prettyLeaf = cata phi phi = \case LeafF l -> prettyLeaf l GrdF n rest -> sep " " [prettyNode n, "──", rest] - ForkF xs -> "──" <> group (sep "\n" (makeTree $ NEL.toList xs)) + ForkF xs -> "──" <> group (sep "\n" $ makeTree xs) makeTree :: [Pretty s] -> [Pretty s] makeTree = \case [] -> [] @@ -82,7 +80,7 @@ pattern Leaf x = Fix (LeafF x) pattern Grd :: n -> GrdTree n l -> GrdTree n l pattern Grd x rest = Fix (GrdF x rest) -pattern Fork :: NonEmpty (GrdTree n l) -> GrdTree n l +pattern Fork :: [GrdTree n l] -> GrdTree n l pattern Fork alts = Fix (ForkF alts) {-# COMPLETE Leaf, Grd, Fork #-} diff --git a/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs b/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs index b605750686..8986f4c409 100644 --- a/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs +++ b/parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs @@ -16,7 +16,6 @@ import Data.Foldable import Data.Function import Data.Functor import Data.Functor.Compose -import Data.List.NonEmpty (NonEmpty (..)) import Data.Map qualified as Map import Data.Sequence qualified as Seq import Data.Set qualified as Set @@ -29,7 +28,6 @@ import Unison.PatternMatchCoverage.Class import Unison.PatternMatchCoverage.Constraint (Constraint) import Unison.PatternMatchCoverage.Constraint qualified as C import Unison.PatternMatchCoverage.EffectHandler -import Unison.PatternMatchCoverage.Fix import Unison.PatternMatchCoverage.GrdTree import Unison.PatternMatchCoverage.IntervalSet (IntervalSet) import Unison.PatternMatchCoverage.IntervalSet qualified as IntervalSet @@ -43,6 +41,7 @@ import Unison.Prelude import Unison.Type (Type) import Unison.Type qualified as Type import Unison.Util.Pretty qualified as P +import Unison.Util.Recursion import Unison.Var (Var) -- | top-down traversal of the 'GrdTree' that produces: @@ -74,12 +73,11 @@ uncoverAnnotate z grdtree0 = cata phi grdtree0 z LeafF l -> \nc -> do nc' <- ensureInhabited' nc pure (Set.empty, Leaf (nc', l)) - ForkF (kinit :| ks) -> \nc0 -> do + ForkF ks -> \nc0 -> do -- depth-first fold in match-case order to acculate the -- constraints for a match failure at every case. - (nc1, t1) <- kinit nc0 - (ncfinal, ts) <- foldlM (\(nc, ts) a -> a nc >>= \(nc', t) -> pure (nc', t : ts)) (nc1, []) ks - pure (ncfinal, Fork (t1 :| reverse ts)) + (ncfinal, ts) <- foldlM (\(nc, ts) a -> a nc >>= \(nc', t) -> pure (nc', t : ts)) (nc0, []) ks + pure (ncfinal, Fork $ reverse ts) GrdF grd k -> \nc0 -> case grd of PmEffect var con convars -> handleGrd (PosEffect var (Effect con) convars) (NegEffect var (Effect con)) k nc0 PmEffectPure var resume -> handleGrd (PosEffect var NoEffect [resume]) (NegEffect var NoEffect) k nc0 diff --git a/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs b/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs index 5d8264202c..1ed83d451f 100644 --- a/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs +++ b/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs @@ -8,7 +8,9 @@ module Unison.PrettyPrintEnv.Names Suffixifier, dontSuffixify, suffixifyByHash, + suffixifyByHashName, suffixifyByName, + suffixifyByHashWithUnhashedTermsInScope, -- * Pretty-print env makePPE, @@ -23,11 +25,14 @@ import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Names (Names) import Unison.Names qualified as Names +import Unison.Names.ResolvesTo (ResolvesTo (..)) import Unison.NamesWithHistory qualified as Names import Unison.Prelude import Unison.PrettyPrintEnv (PrettyPrintEnv (PrettyPrintEnv)) import Unison.Reference (TypeReference) import Unison.Referent (Referent) +import Unison.Util.Relation (Relation) +import Unison.Util.Relation qualified as Relation ------------------------------------------------------------------------------------------------------------------------ -- Namer @@ -84,6 +89,27 @@ suffixifyByHash names = suffixifyType = \name -> Name.suffixifyByHash name (Names.types names) } +suffixifyByHashName :: Names -> Suffixifier +suffixifyByHashName names = + Suffixifier + { suffixifyTerm = \name -> Name.suffixifyByHashName name (Names.terms names), + suffixifyType = \name -> Name.suffixifyByHashName name (Names.types names) + } + +suffixifyByHashWithUnhashedTermsInScope :: Set Name -> Names -> Suffixifier +suffixifyByHashWithUnhashedTermsInScope localTermNames namespaceNames = + Suffixifier + { suffixifyTerm = \name -> Name.suffixifyByHash name terms, + suffixifyType = \name -> Name.suffixifyByHash name (Names.types namespaceNames) + } + where + terms :: Relation Name (ResolvesTo Referent) + terms = + Names.terms namespaceNames + & Relation.subtractDom localTermNames + & Relation.mapRan ResolvesToNamespace + & Relation.union (Relation.fromList (map (\name -> (name, ResolvesToLocal name)) (Set.toList localTermNames))) + ------------------------------------------------------------------------------------------------------------------------ -- Pretty-print env diff --git a/parser-typechecker/src/Unison/PrettyPrintEnvDecl/Names.hs b/parser-typechecker/src/Unison/PrettyPrintEnvDecl/Names.hs index 53e171eec1..274f418049 100644 --- a/parser-typechecker/src/Unison/PrettyPrintEnvDecl/Names.hs +++ b/parser-typechecker/src/Unison/PrettyPrintEnvDecl/Names.hs @@ -1,11 +1,8 @@ module Unison.PrettyPrintEnvDecl.Names ( makePPED, - makeFilePPED, - makeCodebasePPED, ) where -import Unison.Names (Names) import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (PrettyPrintEnvDecl)) @@ -14,23 +11,3 @@ makePPED namer suffixifier = PrettyPrintEnvDecl (PPE.makePPE namer PPE.dontSuffixify) (PPE.makePPE namer suffixifier) - --- | Make a PPED suitable for names in a Unison file. --- --- Such names have special suffixification rules: aliases may *not* be referred to by a common suffix. For example, if --- a file contains --- --- one.foo = 6 --- two.foo = 6 --- --- then the suffix `foo` will *not* be accepted (currently). So, this PPE uses the "suffixify by name" strategy. -makeFilePPED :: Names -> PrettyPrintEnvDecl -makeFilePPED names = - makePPED (PPE.namer names) (PPE.suffixifyByName names) - --- | Make a PPED suitable for names in the codebase. These names are hash qualified and suffixified by hash. -makeCodebasePPED :: Names -> PrettyPrintEnvDecl -makeCodebasePPED names = - makePPED - (PPE.hqNamer 10 names) - (PPE.suffixifyByHash names) diff --git a/parser-typechecker/src/Unison/PrintError.hs b/parser-typechecker/src/Unison/PrintError.hs index 691d7cd3ef..9d5dd0cf84 100644 --- a/parser-typechecker/src/Unison/PrintError.hs +++ b/parser-typechecker/src/Unison/PrintError.hs @@ -32,7 +32,7 @@ import Text.Megaparsec qualified as P import Unison.ABT qualified as ABT import Unison.Builtin.Decls (unitRef, pattern TupleType') import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) -import Unison.HashQualified (HashQualified) +import Unison.HashQualified qualified as HQ import Unison.HashQualifiedPrime qualified as HQ' import Unison.Kind (Kind) import Unison.Kind qualified as Kind @@ -59,6 +59,7 @@ import Unison.Syntax.Name qualified as Name (toText) import Unison.Syntax.NamePrinter (prettyHashQualified0) import Unison.Syntax.Parser (Annotated, ann) import Unison.Syntax.Parser qualified as Parser +import Unison.Syntax.Precedence qualified as Precedence import Unison.Syntax.TermPrinter qualified as TermPrinter import Unison.Term qualified as Term import Unison.Type (Type) @@ -1126,13 +1127,10 @@ renderContext env ctx@(C.Context es) = renderTerm :: (IsString s, Var v) => Env -> Term.Term' (TypeVar.TypeVar loc0 v) v loc1 -> s renderTerm env e = - let s = Color.toPlain $ TermPrinter.pretty' (Just 80) env (TypeVar.lowerTerm e) - in if length s > Settings.renderTermMaxLength - then fromString ("..." <> drop (length s - Settings.renderTermMaxLength) s) - else fromString s + fromString (Color.toPlain $ TermPrinter.pretty' (Just 80) env (TypeVar.lowerTerm e)) renderPattern :: Env -> Pattern ann -> ColorText -renderPattern env e = Pr.renderUnbroken . Pr.syntaxToColor . fst $ TermPrinter.prettyPattern env TermPrinter.emptyAc 0 ([] :: [Symbol]) e +renderPattern env e = Pr.renderUnbroken . Pr.syntaxToColor . fst $ TermPrinter.prettyPattern env TermPrinter.emptyAc Precedence.Annotation ([] :: [Symbol]) e -- | renders a type with no special styling renderType' :: (IsString s, Var v) => Env -> Type v loc -> s @@ -1427,6 +1425,18 @@ renderParseErrors s = \case <> "after the" <> Pr.group (style ErrorSite "0o" <> ".") ] + L.InvalidBinaryLiteral -> + Pr.lines + [ "This number isn't valid syntax: ", + "", + excerpt, + Pr.wrap $ + "I was expecting only binary characters" + <> "(one of" + <> Pr.group (style Code "01" <> ")") + <> "after the" + <> Pr.group (style ErrorSite "0b" <> ".") + ] L.InvalidShortHash h -> Pr.lines [ "Invalid hash: " <> style ErrorSite (fromString h), @@ -1774,21 +1784,6 @@ renderParseErrors s = \case tokenAsErrorSite s tok ] in (msg, [rangeForToken tok]) - go (Parser.EmptyMatch tok) = - let msg = - Pr.indentN 2 . Pr.callout "😶" $ - Pr.lines - [ Pr.wrap - ( "I expected some patterns after a " - <> style ErrorSite "match" - <> "/" - <> style ErrorSite "with" - <> " or cases but I didn't find any." - ), - "", - tokenAsErrorSite s tok - ] - in (msg, [rangeForToken tok]) go (Parser.EmptyWatch tok) = let msg = Pr.lines @@ -1797,8 +1792,6 @@ renderParseErrors s = \case annotatedAsErrorSite s tok ] in (msg, maybeToList $ rangeForAnnotated tok) - go (Parser.UnknownAbilityConstructor tok _referents) = (unknownConstructor "ability" tok, [rangeForToken tok]) - go (Parser.UnknownDataConstructor tok _referents) = (unknownConstructor "data" tok, [rangeForToken tok]) go (Parser.UnknownId tok referents references) = let msg = Pr.lines @@ -1870,24 +1863,6 @@ renderParseErrors s = \case ] in (msg, [rangeForToken tok]) - unknownConstructor :: - String -> L.Token (HashQualified Name) -> Pretty ColorText - unknownConstructor ctorType tok = - Pr.lines - [ (Pr.wrap . mconcat) - [ "I don't know about any ", - fromString ctorType, - " constructor named ", - Pr.group - ( stylePretty ErrorSite (prettyHashQualified0 (L.payload tok)) - <> "." - ), - "Maybe make sure it's correctly spelled and that you've imported it:" - ], - "", - tokenAsErrorSite s tok - ] - annotatedAsErrorSite :: (Annotated a) => String -> a -> Pretty ColorText annotatedAsErrorSite = annotatedAsStyle ErrorSite @@ -1968,11 +1943,11 @@ intLiteralSyntaxTip term expectedType = case (term, expectedType) of -- | Pretty prints resolution failure annotations, including a table of disambiguation -- suggestions. prettyResolutionFailures :: - forall v a. - (Annotated a, Var v, Ord a) => + forall a. + (Annotated a, Ord a) => -- | src String -> - [Names.ResolutionFailure v a] -> + [Names.ResolutionFailure a] -> Pretty ColorText prettyResolutionFailures s allFailures = Pr.callout "❓" $ @@ -1987,32 +1962,39 @@ prettyResolutionFailures s allFailures = where -- Collapses identical failures which may have multiple annotations into a single failure. -- uniqueFailures - ambiguitiesToTable :: [Names.ResolutionFailure v a] -> Pretty ColorText + ambiguitiesToTable :: [Names.ResolutionFailure a] -> Pretty ColorText ambiguitiesToTable failures = - let pairs :: ([(v, Maybe (NESet String))]) + let pairs :: ([(HQ.HashQualified Name, Maybe (NESet String))]) pairs = nubOrd . fmap toAmbiguityPair $ failures spacerRow = ("", "") in Pr.column2Header "Symbol" "Suggestions" $ spacerRow : (intercalateMap [spacerRow] prettyRow pairs) - toAmbiguityPair :: Names.ResolutionFailure v annotation -> (v, Maybe (NESet String)) + toAmbiguityPair :: Names.ResolutionFailure annotation -> (HQ.HashQualified Name, Maybe (NESet String)) toAmbiguityPair = \case - (Names.TermResolutionFailure v _ (Names.Ambiguous names refs)) -> do + (Names.TermResolutionFailure name _ (Names.Ambiguous names refs localNames)) -> do let ppe = ppeFromNames names - in (v, Just $ NES.map (showTermRef ppe) refs) - (Names.TypeResolutionFailure v _ (Names.Ambiguous names refs)) -> do + in ( name, + Just $ + NES.unsafeFromSet + (Set.map (showTermRef ppe) refs <> Set.map (Text.unpack . Name.toText) localNames) + ) + (Names.TypeResolutionFailure name _ (Names.Ambiguous names refs localNames)) -> do let ppe = ppeFromNames names - in (v, Just $ NES.map (showTypeRef ppe) refs) - (Names.TermResolutionFailure v _ Names.NotFound) -> (v, Nothing) - (Names.TypeResolutionFailure v _ Names.NotFound) -> (v, Nothing) + in ( name, + Just $ + NES.unsafeFromSet (Set.map (showTypeRef ppe) refs <> Set.map (Text.unpack . Name.toText) localNames) + ) + (Names.TermResolutionFailure name _ Names.NotFound) -> (name, Nothing) + (Names.TypeResolutionFailure name _ Names.NotFound) -> (name, Nothing) ppeFromNames :: Names.Names -> PPE.PrettyPrintEnv ppeFromNames names = PPE.makePPE (PPE.hqNamer PPE.todoHashLength names) PPE.dontSuffixify - prettyRow :: (v, Maybe (NESet String)) -> [(Pretty ColorText, Pretty ColorText)] - prettyRow (v, mSet) = case mSet of - Nothing -> [(prettyVar v, Pr.hiBlack "No matches")] - Just suggestions -> zip ([prettyVar v] ++ repeat "") (Pr.string <$> toList suggestions) + prettyRow :: (HQ.HashQualified Name, Maybe (NESet String)) -> [(Pretty ColorText, Pretty ColorText)] + prettyRow (name, mSet) = case mSet of + Nothing -> [(prettyHashQualified0 name, Pr.hiBlack "No matches")] + Just suggestions -> zip ([prettyHashQualified0 name] ++ repeat "") (Pr.string <$> toList suggestions) useExamples :: Pretty ColorText useExamples = diff --git a/parser-typechecker/src/Unison/Result.hs b/parser-typechecker/src/Unison/Result.hs index 63df0a99e0..1c542c524f 100644 --- a/parser-typechecker/src/Unison/Result.hs +++ b/parser-typechecker/src/Unison/Result.hs @@ -18,7 +18,7 @@ type ResultT notes f = MaybeT (WriterT notes f) data Note v loc = Parsing (Parser.Err v) - | NameResolutionFailures [Names.ResolutionFailure v loc] + | NameResolutionFailures [Names.ResolutionFailure loc] | UnknownSymbol v loc | TypeError (Context.ErrorNote v loc) | TypeInfo (Context.InfoNote v loc) diff --git a/parser-typechecker/src/Unison/Runtime/ANF.hs b/parser-typechecker/src/Unison/Runtime/ANF.hs deleted file mode 100644 index 0c2fa20ff8..0000000000 --- a/parser-typechecker/src/Unison/Runtime/ANF.hs +++ /dev/null @@ -1,2322 +0,0 @@ -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ViewPatterns #-} - -module Unison.Runtime.ANF - ( minimizeCyclesOrCrash, - pattern TVar, - pattern TLit, - pattern TBLit, - pattern TApp, - pattern TApv, - pattern TCom, - pattern TCon, - pattern TKon, - pattern TReq, - pattern TPrm, - pattern TFOp, - pattern THnd, - pattern TLet, - pattern TLetD, - pattern TFrc, - pattern TLets, - pattern TName, - pattern TBind, - pattern TBinds, - pattern TShift, - pattern TMatch, - CompileExn (..), - internalBug, - Mem (..), - Lit (..), - Direction (..), - SuperNormal (..), - SuperGroup (..), - POp (..), - FOp, - close, - saturate, - float, - floatGroup, - lamLift, - lamLiftGroup, - litRef, - inlineAlias, - addDefaultCases, - ANormalF (.., AApv, ACom, ACon, AKon, AReq, APrm, AFOp), - ANormal, - RTag, - CTag, - Tag (..), - GroupRef (..), - Value (..), - Cont (..), - BLit (..), - packTags, - unpackTags, - maskTags, - ANFM, - Branched (.., MatchDataCover), - Func (..), - SGEqv (..), - equivocate, - superNormalize, - anfTerm, - valueTermLinks, - valueLinks, - groupTermLinks, - foldGroupLinks, - overGroupLinks, - traverseGroupLinks, - normalLinks, - prettyGroup, - prettySuperNormal, - prettyANF, - ) -where - -import Control.Exception (throw) -import Control.Lens (snoc, unsnoc) -import Control.Monad.Reader (ReaderT (..), ask, local) -import Control.Monad.State (MonadState (..), State, gets, modify, runState) -import Data.Bifoldable (Bifoldable (..)) -import Data.Bitraversable (Bitraversable (..)) -import Data.Bits (shiftL, shiftR, (.&.), (.|.)) -import Data.Functor.Compose (Compose (..)) -import Data.List hiding (and, or) -import Data.Map qualified as Map -import Data.Primitive qualified as PA -import Data.Set qualified as Set -import Data.Text qualified as Data.Text -import GHC.Stack (CallStack, callStack) -import Unison.ABT qualified as ABT -import Unison.ABT.Normalized qualified as ABTN -import Unison.Blank (nameb) -import Unison.Builtin.Decls qualified as Ty -import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) -import Unison.Hashing.V2.Convert (hashTermComponentsWithoutTypes) -import Unison.Pattern (SeqOp (..)) -import Unison.Pattern qualified as P -import Unison.Prelude -import Unison.Reference (Id, Reference, Reference' (Builtin, DerivedId)) -import Unison.Referent (Referent, pattern Con, pattern Ref) -import Unison.Symbol (Symbol) -import Unison.Term hiding (List, Ref, Text, float, fresh, resolve) -import Unison.Type qualified as Ty -import Unison.Typechecker.Components (minimize') -import Unison.Util.Bytes (Bytes) -import Unison.Util.EnumContainers as EC -import Unison.Util.Pretty qualified as Pretty -import Unison.Util.Text qualified as Util.Text -import Unison.Var (Var, typed) -import Unison.Var qualified as Var -import Prelude hiding (abs, and, or, seq) -import Prelude qualified - --- For internal errors -data CompileExn = CE CallStack (Pretty.Pretty Pretty.ColorText) - deriving (Show) - -instance Exception CompileExn - -internalBug :: (HasCallStack) => String -> a -internalBug = throw . CE callStack . Pretty.lit . fromString - -closure :: (Var v) => Map v (Set v, Set v) -> Map v (Set v) -closure m0 = trace (snd <$> m0) - where - refs = fst <$> m0 - - expand acc fvs rvs = - fvs <> foldMap (\r -> Map.findWithDefault mempty r acc) rvs - - trace acc - | acc == acc' = acc - | otherwise = trace acc' - where - acc' = Map.intersectionWith (expand acc) acc refs - -expandRec :: - (Var v, Monoid a) => - Set v -> - [(v, Term v a)] -> - [(v, Term v a)] -expandRec keep vbs = mkSub <$> fvl - where - mkSub (v, fvs) = (v, apps' (var mempty v) (var mempty <$> fvs)) - - fvl = - Map.toList - . fmap (Set.toList) - . closure - $ Set.partition (`Set.member` keep) - . ABT.freeVars - <$> Map.fromList vbs - -expandSimple :: - (Var v, Monoid a) => - Set v -> - (v, Term v a) -> - (v, Term v a) -expandSimple keep (v, bnd) = (v, apps' (var a v) evs) - where - a = ABT.annotation bnd - fvs = ABT.freeVars bnd - evs = map (var a) . Set.toList $ Set.difference fvs keep - -abstract :: (Var v) => Set v -> Term v a -> Term v a -abstract keep bnd = lamWithoutBindingAnns a evs bnd - where - a = ABT.annotation bnd - fvs = ABT.freeVars bnd - evs = Set.toList $ Set.difference fvs keep - -enclose :: - (Var v, Monoid a) => - Set v -> - (Set v -> Term v a -> Term v a) -> - Term v a -> - Maybe (Term v a) -enclose keep rec (LetRecNamedTop' top vbs bd) = - Just $ letRec' top lvbs lbd - where - xpnd = expandRec keep' vbs - keep' = Set.union keep . Set.fromList . map fst $ vbs - lvbs = - vbs - <&> \(v, trm) -> - (v, ABT.annotation trm, (rec keep' . abstract keep' . ABT.substs xpnd) trm) - lbd = rec keep' . ABT.substs xpnd $ bd --- will be lifted, so keep this variable -enclose keep rec (Let1NamedTop' top v b@(unAnn -> LamsNamed' vs bd) e) = - Just . let1' top [(v, lamb)] . rec (Set.insert v keep) $ - ABT.subst v av e - where - (_, av) = expandSimple keep (v, b) - keep' = Set.difference keep $ Set.fromList vs - fvs = ABT.freeVars b - evs = Set.toList $ Set.difference fvs keep - a = ABT.annotation b - lbody = rec keep' bd - annotate tm - | Ann' _ ty <- b = ann a tm ty - | otherwise = tm - lamb = lamWithoutBindingAnns a evs (annotate $ lamWithoutBindingAnns a vs lbody) -enclose keep rec t@(unLamsAnnot -> Just (vs0, mty, vs1, body)) = - Just $ if null evs then lamb else apps' lamb $ map (var a) evs - where - -- remove shadowed variables - keep' = Set.difference keep $ Set.fromList (vs0 ++ vs1) - fvs = ABT.freeVars t - evs = Set.toList $ Set.difference fvs keep - a = ABT.annotation t - lbody = rec keep' body - annotate tm - | Just ty <- mty = ann a tm ty - | otherwise = tm - lamb = lamWithoutBindingAnns a (evs ++ vs0) . annotate . lamWithoutBindingAnns a vs1 $ lbody -enclose keep rec t@(Handle' h body) - | isStructured body = - Just . handle (ABT.annotation t) (rec keep h) $ apps' lamb args - where - fvs = ABT.freeVars body - evs = Set.toList $ Set.difference fvs keep - a = ABT.annotation body - lbody = rec keep body - fv = Var.freshIn fvs $ typed Var.Eta - args - | null evs = [constructor a (ConstructorReference Ty.unitRef 0)] - | otherwise = var a <$> evs - lamb - | null evs = lamWithoutBindingAnns a [fv] lbody - | otherwise = lamWithoutBindingAnns a evs lbody -enclose keep rec t@(Match' s0 cs0) = Just $ match a s cs - where - a = ABT.annotation t - s = rec keep s0 - cs = encloseCase a keep rec <$> cs0 -enclose _ _ _ = Nothing - -encloseCase :: - (Var v, Monoid a) => - a -> - Set v -> - (Set v -> Term v a -> Term v a) -> - MatchCase a (Term v a) -> - MatchCase a (Term v a) -encloseCase a keep rec0 (MatchCase pats guard body) = - MatchCase pats (rec <$> guard) (rec body) - where - rec (ABT.AbsN' vs bd) = - ABT.absChain' ((,) a <$> vs) $ - rec0 (keep `Set.difference` Set.fromList vs) bd - -newtype Prefix v x = Pfx (Map v [v]) deriving (Show) - -instance Functor (Prefix v) where - fmap _ (Pfx m) = Pfx m - -instance (Ord v) => Applicative (Prefix v) where - pure _ = Pfx Map.empty - Pfx ml <*> Pfx mr = Pfx $ Map.unionWith common ml mr - -common :: (Eq v) => [v] -> [v] -> [v] -common (u : us) (v : vs) - | u == v = u : common us vs -common _ _ = [] - -splitPfx :: v -> [Term v a] -> (Prefix v x, [Term v a]) -splitPfx v = first (Pfx . Map.singleton v) . split - where - split (Var' u : as) = first (u :) $ split as - split rest = ([], rest) - --- Finds the common variable prefixes that function variables are --- applied to, so that they can be reduced. -prefix :: (Ord v) => Term v a -> Prefix v (Term v a) -prefix = ABT.visit \case - Apps' (Var' u) as -> case splitPfx u as of - (pf, rest) -> Just $ traverse prefix rest *> pf - Var' u -> Just . Pfx $ Map.singleton u [] - _ -> Nothing - -appPfx :: (Ord v) => Prefix v a -> v -> [v] -> [v] -appPfx (Pfx m) v = maybe (const []) common $ Map.lookup v m - --- Rewrites a term by dropping the first n arguments to every --- application of `v`. This just assumes such a thing makes sense, as --- in `beta`, where we've calculated how many arguments to drop by --- looking at every occurrence of `v`. -dropPrefix :: (Ord v) => (Semigroup a) => v -> Int -> Term v a -> Term v a -dropPrefix _ 0 = id -dropPrefix v n = ABT.visitPure rw - where - rw (Apps' f@(Var' u) as) - | v == u = Just (apps' (var (ABT.annotation f) u) (drop n as)) - rw _ = Nothing - -dropPrefixes :: - (Ord v) => (Semigroup a) => Map v Int -> Term v a -> Term v a -dropPrefixes m = ABT.visitPure rw - where - rw (Apps' f@(Var' u) as) - | Just n <- Map.lookup u m = - Just (apps' (var (ABT.annotation f) u) (drop n as)) - rw _ = Nothing - --- Performs opposite transformations to those in enclose. Named after --- the lambda case, which is beta reduction. -beta :: (Var v) => (Monoid a) => (Term v a -> Term v a) -> Term v a -> Maybe (Term v a) -beta rec (LetRecNamedTop' top (fmap (fmap rec) -> vbs) (rec -> bd)) = - Just $ letRec' top lvbs lbd - where - -- Avoid completely reducing a lambda expression, because recursive - -- lets must be guarded. - args (v, LamsNamed' vs Ann' {}) = (v, vs) - args (v, LamsNamed' vs _) = (v, init vs) - args (v, _) = (v, []) - - Pfx m0 = traverse_ (prefix . snd) vbs *> prefix bd - - f ls rs = case common ls rs of - [] -> Nothing - vs -> Just vs - - m = Map.map length $ Map.differenceWith f (Map.fromList $ map args vbs) m0 - lvbs = - vbs <&> \(v, b0) -> (v,ABT.annotation b0,) $ case b0 of - LamsNamed' vs b - | Just n <- Map.lookup v m -> - lamWithoutBindingAnns (ABT.annotation b0) (drop n vs) (dropPrefixes m b) - -- shouldn't happen - b -> dropPrefixes m b - - lbd = dropPrefixes m bd -beta rec (Let1NamedTop' top v l@(LamsNamed' vs bd) (rec -> e)) - | n > 0 = Just $ let1' top [(v, lamb)] (dropPrefix v n e) - | otherwise = Nothing - where - lamb = lamWithoutBindingAnns al (drop n vs) (bd) - al = ABT.annotation l - -- Calculate a maximum number of arguments to drop. - -- Enclosing doesn't create let-bound lambdas, so we - -- should never reduce a lambda to a non-lambda, as that - -- could affect evaluation order. - m - | Ann' _ _ <- bd = length vs - | otherwise = length vs - 1 - n = min m . length $ appPfx (prefix e) v vs -beta rec (Apps' l@(LamsNamed' vs body) as) - | n <- matchVars 0 vs as, - n > 0 = - Just $ apps' (lamWithoutBindingAnns al (drop n vs) (rec body)) (drop n as) - | otherwise = Nothing - where - al = ABT.annotation l - matchVars !n (u : us) (Var' v : as) | u == v = matchVars (1 + n) us as - matchVars n _ _ = n -beta _ _ = Nothing - -isStructured :: (Var v) => Term v a -> Bool -isStructured (Var' _) = False -isStructured (Lam' _) = False -isStructured (Nat' _) = False -isStructured (Int' _) = False -isStructured (Float' _) = False -isStructured (Text' _) = False -isStructured (Char' _) = False -isStructured (Constructor' _) = False -isStructured (Apps' Constructor' {} args) = any isStructured args -isStructured (If' b t f) = - isStructured b || isStructured t || isStructured f -isStructured (And' l r) = isStructured l || isStructured r -isStructured (Or' l r) = isStructured l || isStructured r -isStructured _ = True - -close :: (Var v, Monoid a) => Set v -> Term v a -> Term v a -close keep tm = ABT.visitPure (enclose keep close) tm - --- Attempts to undo what was done in `close`. Useful for decompiling. -open :: (Var v, Monoid a) => Term v a -> Term v a -open x = ABT.visitPure (beta open) x - -type FloatM v a r = State (Set v, [(v, Term v a)], [(v, Term v a)]) r - -freshFloat :: (Var v) => Set v -> v -> v -freshFloat avoid (Var.freshIn avoid -> v0) = - case Var.typeOf v0 of - Var.User nm - | v <- typed (Var.User $ nm <> w), - v `Set.notMember` avoid -> - v - | otherwise -> - freshFloat (Set.insert v0 avoid) v0 - _ -> v0 - where - w = Data.Text.pack . show $ Var.freshId v0 - -groupFloater :: - (Var v, Monoid a) => - (Term v a -> FloatM v a (Term v a)) -> - [(v, Term v a)] -> - FloatM v a (Map v v) -groupFloater rec vbs = do - cvs <- gets (\(vs, _, _) -> vs) - let shadows = - [ (v, freshFloat cvs v) - | (v, _) <- vbs, - Set.member v cvs - ] - shadowMap = Map.fromList shadows - rn v = Map.findWithDefault v v shadowMap - shvs = Set.fromList $ map (rn . fst) vbs - modify $ \(cvs, ctx, dcmp) -> (cvs <> shvs, ctx, dcmp) - fvbs <- traverse (\(v, b) -> (,) (rn v) <$> rec' (ABT.renames shadowMap b)) vbs - let dvbs = fmap (\(v, b) -> (rn v, deannotate b)) vbs - modify $ \(vs, ctx, dcmp) -> (vs, ctx ++ fvbs, dcmp <> dvbs) - pure shadowMap - where - rec' b - | Just (vs0, mty, vs1, bd) <- unLamsAnnot b = - lamWithoutBindingAnns a vs0 . maybe id (flip $ ann a) mty . lamWithoutBindingAnns a vs1 <$> rec bd - where - a = ABT.annotation b - rec' b = rec b - -letFloater :: - (Var v, Monoid a) => - (Term v a -> FloatM v a (Term v a)) -> - [(v, Term v a)] -> - Term v a -> - FloatM v a (Term v a) -letFloater rec vbs e = do - shadowMap <- groupFloater rec vbs - pure $ ABT.renames shadowMap e - -lamFloater :: - (Var v, Monoid a) => - Bool -> - Term v a -> - Maybe v -> - a -> - [v] -> - Term v a -> - FloatM v a v -lamFloater closed tm mv a vs bd = - state $ \trip@(cvs, ctx, dcmp) -> case find p ctx of - Just (v, _) -> (v, trip) - Nothing -> - let v = ABT.freshIn cvs $ fromMaybe (typed Var.Float) mv - in ( v, - ( Set.insert v cvs, - ctx <> [(v, lamWithoutBindingAnns a vs bd)], - floatDecomp closed v tm dcmp - ) - ) - where - tgt = unannotate (lamWithoutBindingAnns a vs bd) - p (_, flam) = unannotate flam == tgt - -floatDecomp :: - Bool -> v -> Term v a -> [(v, Term v a)] -> [(v, Term v a)] -floatDecomp True v b dcmp = (v, b) : dcmp -floatDecomp False _ _ dcmp = dcmp - -floater :: - (Var v, Monoid a) => - Bool -> - (Term v a -> FloatM v a (Term v a)) -> - Term v a -> - Maybe (FloatM v a (Term v a)) -floater top rec tm0@(Ann' tm ty) = - (fmap . fmap) (\tm -> ann a tm ty) (floater top rec tm) - where - a = ABT.annotation tm0 -floater top rec (LetRecNamed' vbs e) = - Just $ - letFloater rec vbs e >>= \case - lm@(LamsNamed' vs bd) | top -> lamWithoutBindingAnns a vs <$> rec bd - where - a = ABT.annotation lm - tm -> rec tm -floater _ rec (Let1Named' v b e) - | Just (vs0, _, vs1, bd) <- unLamsAnnot b = - Just $ - rec bd - >>= lamFloater True b (Just v) a (vs0 ++ vs1) - >>= \lv -> rec $ ABT.renames (Map.singleton v lv) e - where - a = ABT.annotation b -floater top rec tm@(LamsNamed' vs bd) - | top = Just $ lamWithoutBindingAnns a vs <$> rec bd - | otherwise = Just $ do - bd <- rec bd - lv <- lamFloater True tm Nothing a vs bd - pure $ var a lv - where - a = ABT.annotation tm -floater _ _ _ = Nothing - -postFloat :: - (Var v) => - (Monoid a) => - Map v Reference -> - (Set v, [(v, Term v a)], [(v, Term v a)]) -> - ( [(v, Term v a)], - [(v, Id)], - [(Reference, Term v a)], - [(Reference, Term v a)] - ) -postFloat orig (_, bs, dcmp) = - ( subs, - subvs, - fmap (first DerivedId) tops, - dcmp >>= \(v, tm) -> - let stm = open $ ABT.substs dsubs tm - in (subm Map.! v, stm) : [(r, stm) | Just r <- [Map.lookup v orig]] - ) - where - m = - fmap (fmap deannotate) - . hashTermComponentsWithoutTypes - . Map.fromList - $ bs - trips = Map.toList m - f (v, (id, tm)) = ((v, id), (v, idtm), (id, tm)) - where - idtm = ref (ABT.annotation tm) (DerivedId id) - (subvs, subs, tops) = unzip3 $ map f trips - subm = fmap DerivedId (Map.fromList subvs) - dsubs = Map.toList $ Map.map (ref mempty) orig <> Map.fromList subs - -float :: - (Var v) => - (Monoid a) => - Map v Reference -> - Term v a -> - (Term v a, Map Reference Reference, [(Reference, Term v a)], [(Reference, Term v a)]) -float orig tm = case runState go0 (Set.empty, [], []) of - (bd, st) -> case postFloat orig st of - (subs, subvs, tops, dcmp) -> - ( letRec' True [] . ABT.substs subs . deannotate $ bd, - Map.fromList . mapMaybe f $ subvs, - tops, - dcmp - ) - where - f (v, i) = (,DerivedId i) <$> Map.lookup v orig - go0 = fromMaybe (go tm) (floater True go tm) - go = ABT.visit $ floater False go - -floatGroup :: - (Var v) => - (Monoid a) => - Map v Reference -> - [(v, Term v a)] -> - ([(v, Id)], [(Reference, Term v a)], [(Reference, Term v a)]) -floatGroup orig grp = case runState go0 (Set.empty, [], []) of - (_, st) -> case postFloat orig st of - (_, subvs, tops, dcmp) -> (subvs, tops, dcmp) - where - go = ABT.visit $ floater False go - go0 = groupFloater go grp - -unAnn :: Term v a -> Term v a -unAnn (Ann' tm _) = tm -unAnn tm = tm - -unLamsAnnot :: Term v a -> Maybe ([v], Maybe (Ty.Type v a), [v], Term v a) -unLamsAnnot tm0 - | null vs0, null vs1 = Nothing - | otherwise = Just (vs0, mty, vs1, bd) - where - (vs0, bd0) - | LamsNamed' vs bd <- tm0 = (vs, bd) - | otherwise = ([], tm0) - (mty, bd1) - | Ann' bd ty <- bd0 = (Just ty, bd) - | otherwise = (Nothing, bd0) - (vs1, bd) - | LamsNamed' vs bd <- bd1 = (vs, bd) - | otherwise = ([], bd1) - -deannotate :: (Var v) => Term v a -> Term v a -deannotate = ABT.visitPure $ \case - Ann' c _ -> Just $ deannotate c - _ -> Nothing - -lamLift :: - (Var v) => - (Monoid a) => - Map v Reference -> - Term v a -> - (Term v a, Map Reference Reference, [(Reference, Term v a)], [(Reference, Term v a)]) -lamLift orig = float orig . close Set.empty - -lamLiftGroup :: - (Var v) => - (Monoid a) => - Map v Reference -> - [(v, Term v a)] -> - ([(v, Id)], [(Reference, Term v a)], [(Reference, Term v a)]) -lamLiftGroup orig gr = floatGroup orig . (fmap . fmap) (close keep) $ gr - where - keep = Set.fromList $ map fst gr - -saturate :: - (Var v, Monoid a) => - Map ConstructorReference Int -> - Term v a -> - Term v a -saturate dat = ABT.visitPure $ \case - Apps' f@(Constructor' r) args -> sat r f args - Apps' f@(Request' r) args -> sat r f args - f@(Constructor' r) -> sat r f [] - f@(Request' r) -> sat r f [] - _ -> Nothing - where - frsh avoid _ = - let v = Var.freshIn avoid $ typed Var.Eta - in (Set.insert v avoid, v) - sat r f args = case Map.lookup r dat of - Just n - | m < n, - vs <- snd $ mapAccumL frsh fvs [1 .. n - m], - nargs <- var mempty <$> vs -> - Just . lamWithoutBindingAnns mempty vs . apps' f $ args' ++ nargs - | m > n, - (sargs, eargs) <- splitAt n args', - sv <- Var.freshIn fvs $ typed Var.Eta -> - Just - . let1' False [(sv, apps' f sargs)] - $ apps' (var mempty sv) eargs - _ -> Just (apps' f args') - where - m = length args - fvs = foldMap freeVars args - args' = saturate dat <$> args - -addDefaultCases :: (Var v) => (Monoid a) => Text -> Term v a -> Term v a -addDefaultCases = ABT.visitPure . defaultCaseVisitor - -defaultCaseVisitor :: - (Var v) => (Monoid a) => Text -> Term v a -> Maybe (Term v a) -defaultCaseVisitor func m@(Match' scrut cases) - | scrut <- addDefaultCases func scrut, - cases <- fmap (addDefaultCases func) <$> cases = - Just $ match a scrut (cases ++ [dflt]) - where - a = ABT.annotation m - v = Var.freshIn mempty $ typed Var.Blank - txt = "pattern match failure in function `" <> func <> "`" - msg = text a txt - bu = ref a (Builtin "bug") - dflt = - MatchCase (P.Var a) Nothing - . ABT.abs' a v - $ apps bu [(a, Ty.tupleTerm [msg, var a v])] -defaultCaseVisitor _ _ = Nothing - -inlineAlias :: (Var v) => (Monoid a) => Term v a -> Term v a -inlineAlias = ABT.visitPure $ \case - Let1Named' v b@(Var' _) e -> Just . inlineAlias $ ABT.subst v b e - _ -> Nothing - -minimizeCyclesOrCrash :: (Var v) => Term v a -> Term v a -minimizeCyclesOrCrash t = case minimize' t of - Right t -> t - Left e -> - internalBug $ - "tried to minimize let rec with duplicate definitions: " - ++ show (fst <$> toList e) - -data Mem = UN | BX deriving (Eq, Ord, Show, Enum) - --- Context entries with evaluation strategy -data CTE v s - = ST (Direction Word16) [v] [Mem] s - | LZ v (Either Reference v) [v] - deriving (Show) - -pattern ST1 :: Direction Word16 -> v -> Mem -> s -> CTE v s -pattern ST1 d v m s = ST d [v] [m] s - -data ANormalF v e - = ALet (Direction Word16) [Mem] e e - | AName (Either Reference v) [v] e - | ALit Lit - | ABLit Lit -- direct boxed literal - | AMatch v (Branched e) - | AShift Reference e - | AHnd [Reference] v e - | AApp (Func v) [v] - | AFrc v - | AVar v - deriving (Show, Eq) - --- Types representing components that will go into the runtime tag of --- a data type value. RTags correspond to references, while CTags --- correspond to constructors. -newtype RTag = RTag Word64 - deriving stock (Eq, Ord, Show, Read) - deriving newtype (EC.EnumKey) - -newtype CTag = CTag Word16 - deriving stock (Eq, Ord, Show, Read) - deriving newtype (EC.EnumKey) - -class Tag t where rawTag :: t -> Word64 - -instance Tag RTag where rawTag (RTag w) = w - -instance Tag CTag where rawTag (CTag w) = fromIntegral w - -packTags :: RTag -> CTag -> Word64 -packTags (RTag rt) (CTag ct) = ri .|. ci - where - ri = rt `shiftL` 16 - ci = fromIntegral ct - -unpackTags :: Word64 -> (RTag, CTag) -unpackTags w = (RTag $ w `shiftR` 16, CTag . fromIntegral $ w .&. 0xFFFF) - --- Masks a packed tag to extract just the constructor tag portion -maskTags :: Word64 -> Word64 -maskTags w = w .&. 0xFFFF - -ensureRTag :: (Ord n, Show n, Num n) => String -> n -> r -> r -ensureRTag s n x - | n > 0xFFFFFFFFFFFF = - internalBug $ s ++ "@RTag: too large: " ++ show n - | otherwise = x - -ensureCTag :: (Ord n, Show n, Num n) => String -> n -> r -> r -ensureCTag s n x - | n > 0xFFFF = - internalBug $ s ++ "@CTag: too large: " ++ show n - | otherwise = x - -instance Enum RTag where - toEnum i = ensureRTag "toEnum" i . RTag $ toEnum i - fromEnum (RTag w) = fromEnum w - -instance Enum CTag where - toEnum i = ensureCTag "toEnum" i . CTag $ toEnum i - fromEnum (CTag w) = fromEnum w - -instance Num RTag where - fromInteger i = ensureRTag "fromInteger" i . RTag $ fromInteger i - (+) = internalBug "RTag: +" - (*) = internalBug "RTag: *" - abs = internalBug "RTag: abs" - signum = internalBug "RTag: signum" - negate = internalBug "RTag: negate" - -instance Num CTag where - fromInteger i = ensureCTag "fromInteger" i . CTag $ fromInteger i - (+) = internalBug "CTag: +" - (*) = internalBug "CTag: *" - abs = internalBug "CTag: abs" - signum = internalBug "CTag: signum" - negate = internalBug "CTag: negate" - -instance Functor (ANormalF v) where - fmap _ (AVar v) = AVar v - fmap _ (ALit l) = ALit l - fmap _ (ABLit l) = ABLit l - fmap f (ALet d m bn bo) = ALet d m (f bn) (f bo) - fmap f (AName n as bo) = AName n as $ f bo - fmap f (AMatch v br) = AMatch v $ f <$> br - fmap f (AHnd rs h e) = AHnd rs h $ f e - fmap f (AShift i e) = AShift i $ f e - fmap _ (AFrc v) = AFrc v - fmap _ (AApp f args) = AApp f args - -instance Bifunctor ANormalF where - bimap f _ (AVar v) = AVar (f v) - bimap _ _ (ALit l) = ALit l - bimap _ _ (ABLit l) = ABLit l - bimap _ g (ALet d m bn bo) = ALet d m (g bn) (g bo) - bimap f g (AName n as bo) = AName (f <$> n) (f <$> as) $ g bo - bimap f g (AMatch v br) = AMatch (f v) $ fmap g br - bimap f g (AHnd rs v e) = AHnd rs (f v) $ g e - bimap _ g (AShift i e) = AShift i $ g e - bimap f _ (AFrc v) = AFrc (f v) - bimap f _ (AApp fu args) = AApp (fmap f fu) $ fmap f args - -instance Bifoldable ANormalF where - bifoldMap f _ (AVar v) = f v - bifoldMap _ _ (ALit _) = mempty - bifoldMap _ _ (ABLit _) = mempty - bifoldMap _ g (ALet _ _ b e) = g b <> g e - bifoldMap f g (AName n as e) = foldMap f n <> foldMap f as <> g e - bifoldMap f g (AMatch v br) = f v <> foldMap g br - bifoldMap f g (AHnd _ h e) = f h <> g e - bifoldMap _ g (AShift _ e) = g e - bifoldMap f _ (AFrc v) = f v - bifoldMap f _ (AApp func args) = foldMap f func <> foldMap f args - -instance ABTN.Align ANormalF where - align f _ (AVar u) (AVar v) = Just $ AVar <$> f u v - align _ _ (ALit l) (ALit r) - | l == r = Just $ pure (ALit l) - align _ _ (ABLit l) (ABLit r) - | l == r = Just $ pure (ABLit l) - align _ g (ALet dl ccl bl el) (ALet dr ccr br er) - | dl == dr, - ccl == ccr = - Just $ ALet dl ccl <$> g bl br <*> g el er - align f g (AName hl asl el) (AName hr asr er) - | length asl == length asr, - Just hs <- alignEither f hl hr = - Just $ - AName - <$> hs - <*> traverse (uncurry f) (zip asl asr) - <*> g el er - align f g (AMatch vl bsl) (AMatch vr bsr) - | Just bss <- alignBranch g bsl bsr = - Just $ AMatch <$> f vl vr <*> bss - align f g (AHnd rl hl bl) (AHnd rr hr br) - | rl == rr = Just $ AHnd rl <$> f hl hr <*> g bl br - align _ g (AShift rl bl) (AShift rr br) - | rl == rr = Just $ AShift rl <$> g bl br - align f _ (AFrc u) (AFrc v) = Just $ AFrc <$> f u v - align f _ (AApp hl asl) (AApp hr asr) - | Just hs <- alignFunc f hl hr, - length asl == length asr = - Just $ AApp <$> hs <*> traverse (uncurry f) (zip asl asr) - align _ _ _ _ = Nothing - -alignEither :: - (Applicative f) => - (l -> r -> f s) -> - Either Reference l -> - Either Reference r -> - Maybe (f (Either Reference s)) -alignEither _ (Left rl) (Left rr) | rl == rr = Just . pure $ Left rl -alignEither f (Right u) (Right v) = Just $ Right <$> f u v -alignEither _ _ _ = Nothing - -alignMaybe :: - (Applicative f) => - (l -> r -> f s) -> - Maybe l -> - Maybe r -> - Maybe (f (Maybe s)) -alignMaybe f (Just l) (Just r) = Just $ Just <$> f l r -alignMaybe _ Nothing Nothing = Just (pure Nothing) -alignMaybe _ _ _ = Nothing - -alignFunc :: - (Applicative f) => - (vl -> vr -> f vs) -> - Func vl -> - Func vr -> - Maybe (f (Func vs)) -alignFunc f (FVar u) (FVar v) = Just $ FVar <$> f u v -alignFunc _ (FComb rl) (FComb rr) | rl == rr = Just . pure $ FComb rl -alignFunc f (FCont u) (FCont v) = Just $ FCont <$> f u v -alignFunc _ (FCon rl tl) (FCon rr tr) - | rl == rr, tl == tr = Just . pure $ FCon rl tl -alignFunc _ (FReq rl tl) (FReq rr tr) - | rl == rr, tl == tr = Just . pure $ FReq rl tl -alignFunc _ (FPrim ol) (FPrim or) - | ol == or = Just . pure $ FPrim ol -alignFunc _ _ _ = Nothing - -alignBranch :: - (Applicative f) => - (el -> er -> f es) -> - Branched el -> - Branched er -> - Maybe (f (Branched es)) -alignBranch _ MatchEmpty MatchEmpty = Just $ pure MatchEmpty -alignBranch f (MatchIntegral bl dl) (MatchIntegral br dr) - | keysSet bl == keysSet br, - Just ds <- alignMaybe f dl dr = - Just $ - MatchIntegral - <$> interverse f bl br - <*> ds -alignBranch f (MatchText bl dl) (MatchText br dr) - | Map.keysSet bl == Map.keysSet br, - Just ds <- alignMaybe f dl dr = - Just $ - MatchText - <$> traverse id (Map.intersectionWith f bl br) - <*> ds -alignBranch f (MatchRequest bl pl) (MatchRequest br pr) - | Map.keysSet bl == Map.keysSet br, - all p (Map.keysSet bl) = - Just $ - MatchRequest - <$> traverse id (Map.intersectionWith (interverse (alignCCs f)) bl br) - <*> f pl pr - where - p r = keysSet hsl == keysSet hsr && all q (keys hsl) - where - hsl = bl Map.! r - hsr = br Map.! r - q t = fst (hsl ! t) == fst (hsr ! t) -alignBranch f (MatchData rfl bl dl) (MatchData rfr br dr) - | rfl == rfr, - keysSet bl == keysSet br, - all (\t -> fst (bl ! t) == fst (br ! t)) (keys bl), - Just ds <- alignMaybe f dl dr = - Just $ MatchData rfl <$> interverse (alignCCs f) bl br <*> ds -alignBranch f (MatchSum bl) (MatchSum br) - | keysSet bl == keysSet br, - all (\w -> fst (bl ! w) == fst (br ! w)) (keys bl) = - Just $ MatchSum <$> interverse (alignCCs f) bl br -alignBranch f (MatchNumeric rl bl dl) (MatchNumeric rr br dr) - | rl == rr, - keysSet bl == keysSet br, - Just ds <- alignMaybe f dl dr = - Just $ - MatchNumeric rl - <$> interverse f bl br - <*> ds -alignBranch _ _ _ = Nothing - -alignCCs :: (Functor f) => (l -> r -> f s) -> (a, l) -> (a, r) -> f (a, s) -alignCCs f (ccs, l) (_, r) = (,) ccs <$> f l r - -matchLit :: Term v a -> Maybe Lit -matchLit (Int' i) = Just $ I i -matchLit (Nat' n) = Just $ N n -matchLit (Float' f) = Just $ F f -matchLit (Text' t) = Just $ T (Util.Text.fromText t) -matchLit (Char' c) = Just $ C c -matchLit _ = Nothing - -pattern TLet :: - (ABT.Var v) => - Direction Word16 -> - v -> - Mem -> - ABTN.Term ANormalF v -> - ABTN.Term ANormalF v -> - ABTN.Term ANormalF v -pattern TLet d v m bn bo = ABTN.TTm (ALet d [m] bn (ABTN.TAbs v bo)) - -pattern TLetD :: - (ABT.Var v) => - v -> - Mem -> - ABTN.Term ANormalF v -> - ABTN.Term ANormalF v -> - ABTN.Term ANormalF v -pattern TLetD v m bn bo = ABTN.TTm (ALet Direct [m] bn (ABTN.TAbs v bo)) - -pattern TLets :: - (ABT.Var v) => - Direction Word16 -> - [v] -> - [Mem] -> - ABTN.Term ANormalF v -> - ABTN.Term ANormalF v -> - ABTN.Term ANormalF v -pattern TLets d vs ms bn bo = ABTN.TTm (ALet d ms bn (ABTN.TAbss vs bo)) - -pattern TName :: - (ABT.Var v) => - v -> - Either Reference v -> - [v] -> - ABTN.Term ANormalF v -> - ABTN.Term ANormalF v -pattern TName v f as bo = ABTN.TTm (AName f as (ABTN.TAbs v bo)) - -pattern Lit' :: Lit -> Term v a -pattern Lit' l <- (matchLit -> Just l) - -pattern TLit :: - (ABT.Var v) => - Lit -> - ABTN.Term ANormalF v -pattern TLit l = ABTN.TTm (ALit l) - -pattern TBLit :: - (ABT.Var v) => - Lit -> - ABTN.Term ANormalF v -pattern TBLit l = ABTN.TTm (ABLit l) - -pattern TApp :: - (ABT.Var v) => - Func v -> - [v] -> - ABTN.Term ANormalF v -pattern TApp f args = ABTN.TTm (AApp f args) - -pattern AApv :: v -> [v] -> ANormalF v e -pattern AApv v args = AApp (FVar v) args - -pattern TApv :: - (ABT.Var v) => - v -> - [v] -> - ABTN.Term ANormalF v -pattern TApv v args = TApp (FVar v) args - -pattern ACom :: Reference -> [v] -> ANormalF v e -pattern ACom r args = AApp (FComb r) args - -pattern TCom :: - (ABT.Var v) => - Reference -> - [v] -> - ABTN.Term ANormalF v -pattern TCom r args = TApp (FComb r) args - -pattern ACon :: Reference -> CTag -> [v] -> ANormalF v e -pattern ACon r t args = AApp (FCon r t) args - -pattern TCon :: - (ABT.Var v) => - Reference -> - CTag -> - [v] -> - ABTN.Term ANormalF v -pattern TCon r t args = TApp (FCon r t) args - -pattern AKon :: v -> [v] -> ANormalF v e -pattern AKon v args = AApp (FCont v) args - -pattern TKon :: - (ABT.Var v) => - v -> - [v] -> - ABTN.Term ANormalF v -pattern TKon v args = TApp (FCont v) args - -pattern AReq :: Reference -> CTag -> [v] -> ANormalF v e -pattern AReq r t args = AApp (FReq r t) args - -pattern TReq :: - (ABT.Var v) => - Reference -> - CTag -> - [v] -> - ABTN.Term ANormalF v -pattern TReq r t args = TApp (FReq r t) args - -pattern APrm :: POp -> [v] -> ANormalF v e -pattern APrm p args = AApp (FPrim (Left p)) args - -pattern TPrm :: - (ABT.Var v) => - POp -> - [v] -> - ABTN.Term ANormalF v -pattern TPrm p args = TApp (FPrim (Left p)) args - -pattern AFOp :: FOp -> [v] -> ANormalF v e -pattern AFOp p args = AApp (FPrim (Right p)) args - -pattern TFOp :: - (ABT.Var v) => - FOp -> - [v] -> - ABTN.Term ANormalF v -pattern TFOp p args = TApp (FPrim (Right p)) args - -pattern THnd :: - (ABT.Var v) => - [Reference] -> - v -> - ABTN.Term ANormalF v -> - ABTN.Term ANormalF v -pattern THnd rs h b = ABTN.TTm (AHnd rs h b) - -pattern TShift :: - (ABT.Var v) => - Reference -> - v -> - ABTN.Term ANormalF v -> - ABTN.Term ANormalF v -pattern TShift i v e = ABTN.TTm (AShift i (ABTN.TAbs v e)) - -pattern TMatch :: - (ABT.Var v) => - v -> - Branched (ABTN.Term ANormalF v) -> - ABTN.Term ANormalF v -pattern TMatch v cs = ABTN.TTm (AMatch v cs) - -pattern TFrc :: (ABT.Var v) => v -> ABTN.Term ANormalF v -pattern TFrc v = ABTN.TTm (AFrc v) - -pattern TVar :: (ABT.Var v) => v -> ABTN.Term ANormalF v -pattern TVar v = ABTN.TTm (AVar v) - -{-# COMPLETE TLet, TName, TVar, TApp, TFrc, TLit, THnd, TShift, TMatch #-} - -{-# COMPLETE - TLet, - TName, - TVar, - TFrc, - TApv, - TCom, - TCon, - TKon, - TReq, - TPrm, - TFOp, - TLit, - THnd, - TShift, - TMatch - #-} - -bind :: (Var v) => Cte v -> ANormal v -> ANormal v -bind (ST d us ms bu) = TLets d us ms bu -bind (LZ u f as) = TName u f as - -unbind :: (Var v) => ANormal v -> Maybe (Cte v, ANormal v) -unbind (TLets d us ms bu bd) = Just (ST d us ms bu, bd) -unbind (TName u f as bd) = Just (LZ u f as, bd) -unbind _ = Nothing - -unbinds :: (Var v) => ANormal v -> ([Cte v], ANormal v) -unbinds (TLets d us ms bu (unbinds -> (ctx, bd))) = - (ST d us ms bu : ctx, bd) -unbinds (TName u f as (unbinds -> (ctx, bd))) = (LZ u f as : ctx, bd) -unbinds tm = ([], tm) - -pattern TBind :: - (Var v) => - Cte v -> - ANormal v -> - ANormal v -pattern TBind bn bd <- - (unbind -> Just (bn, bd)) - where - TBind bn bd = bind bn bd - -pattern TBinds :: (Var v) => [Cte v] -> ANormal v -> ANormal v -pattern TBinds ctx bd <- - (unbinds -> (ctx, bd)) - where - TBinds ctx bd = foldr bind bd ctx - -{-# COMPLETE TBinds #-} - -data SeqEnd = SLeft | SRight - deriving (Eq, Ord, Enum, Show) - --- Note: MatchNumeric is a new form for matching directly on boxed --- numeric data. This leaves MatchIntegral around so that builtins can --- continue to use it. But interchanged code can be free of unboxed --- details. -data Branched e - = MatchIntegral (EnumMap Word64 e) (Maybe e) - | MatchText (Map.Map Util.Text.Text e) (Maybe e) - | MatchRequest (Map Reference (EnumMap CTag ([Mem], e))) e - | MatchEmpty - | MatchData Reference (EnumMap CTag ([Mem], e)) (Maybe e) - | MatchSum (EnumMap Word64 ([Mem], e)) - | MatchNumeric Reference (EnumMap Word64 e) (Maybe e) - deriving (Show, Eq, Functor, Foldable, Traversable) - --- Data cases expected to cover all constructors -pattern MatchDataCover :: Reference -> EnumMap CTag ([Mem], e) -> Branched e -pattern MatchDataCover r m = MatchData r m Nothing - -data BranchAccum v - = AccumEmpty - | AccumIntegral - Reference - (Maybe (ANormal v)) - (EnumMap Word64 (ANormal v)) - | AccumText - (Maybe (ANormal v)) - (Map.Map Util.Text.Text (ANormal v)) - | AccumDefault (ANormal v) - | AccumPure (ANormal v) - | AccumRequest - (Map Reference (EnumMap CTag ([Mem], ANormal v))) - (Maybe (ANormal v)) - | AccumData - Reference - (Maybe (ANormal v)) - (EnumMap CTag ([Mem], ANormal v)) - | AccumSeqEmpty (ANormal v) - | AccumSeqView - SeqEnd - (Maybe (ANormal v)) -- empty - (ANormal v) -- cons/snoc - | AccumSeqSplit - SeqEnd - Int -- split at - (Maybe (ANormal v)) -- default - (ANormal v) -- split - -instance Semigroup (BranchAccum v) where - AccumEmpty <> r = r - l <> AccumEmpty = l - AccumIntegral rl dl cl <> AccumIntegral rr dr cr - | rl == rr = AccumIntegral rl (dl <|> dr) $ cl <> cr - AccumText dl cl <> AccumText dr cr = - AccumText (dl <|> dr) (cl <> cr) - AccumData rl dl cl <> AccumData rr dr cr - | rl == rr = AccumData rl (dl <|> dr) (cl <> cr) - AccumDefault dl <> AccumIntegral r _ cr = - AccumIntegral r (Just dl) cr - AccumDefault dl <> AccumText _ cr = - AccumText (Just dl) cr - AccumDefault dl <> AccumData rr _ cr = - AccumData rr (Just dl) cr - AccumIntegral r dl cl <> AccumDefault dr = - AccumIntegral r (dl <|> Just dr) cl - AccumText dl cl <> AccumDefault dr = - AccumText (dl <|> Just dr) cl - AccumData rl dl cl <> AccumDefault dr = - AccumData rl (dl <|> Just dr) cl - l@(AccumPure _) <> AccumPure _ = l - AccumPure dl <> AccumRequest hr _ = AccumRequest hr (Just dl) - AccumRequest hl dl <> AccumPure dr = - AccumRequest hl (dl <|> Just dr) - AccumRequest hl dl <> AccumRequest hr dr = - AccumRequest hm $ dl <|> dr - where - hm = Map.unionWith (<>) hl hr - l@(AccumSeqEmpty _) <> AccumSeqEmpty _ = l - AccumSeqEmpty eml <> AccumSeqView er _ cnr = - AccumSeqView er (Just eml) cnr - AccumSeqView el eml cnl <> AccumSeqEmpty emr = - AccumSeqView el (eml <|> Just emr) cnl - AccumSeqView el eml cnl <> AccumSeqView er emr _ - | el /= er = - internalBug "AccumSeqView: trying to merge views of opposite ends" - | otherwise = AccumSeqView el (eml <|> emr) cnl - AccumSeqView _ _ _ <> AccumDefault _ = - internalBug "seq views may not have defaults" - AccumDefault _ <> AccumSeqView _ _ _ = - internalBug "seq views may not have defaults" - AccumSeqSplit el nl dl bl <> AccumSeqSplit er nr dr _ - | el /= er = - internalBug - "AccumSeqSplit: trying to merge splits at opposite ends" - | nl /= nr = - internalBug - "AccumSeqSplit: trying to merge splits at different positions" - | otherwise = - AccumSeqSplit el nl (dl <|> dr) bl - AccumDefault dl <> AccumSeqSplit er nr _ br = - AccumSeqSplit er nr (Just dl) br - AccumSeqSplit el nl dl bl <> AccumDefault dr = - AccumSeqSplit el nl (dl <|> Just dr) bl - _ <> _ = internalBug $ "cannot merge data cases for different types" - -instance Monoid (BranchAccum e) where - mempty = AccumEmpty - --- Foreign operation, indexed by words -type FOp = Word64 - -data Func v - = -- variable - FVar v - | -- top-level combinator - FComb !Reference - | -- continuation jump - FCont v - | -- data constructor - FCon !Reference !CTag - | -- ability request - FReq !Reference !CTag - | -- prim op - FPrim (Either POp FOp) - deriving (Show, Eq, Functor, Foldable, Traversable) - -data Lit - = I Int64 - | N Word64 - | F Double - | T Util.Text.Text - | C Char - | LM Referent - | LY Reference - deriving (Show, Eq) - -litRef :: Lit -> Reference -litRef (I _) = Ty.intRef -litRef (N _) = Ty.natRef -litRef (F _) = Ty.floatRef -litRef (T _) = Ty.textRef -litRef (C _) = Ty.charRef -litRef (LM _) = Ty.termLinkRef -litRef (LY _) = Ty.typeLinkRef - --- Note: Enum/Bounded instances should only be used for things like --- getting a list of all ops. Using auto-generated numberings for --- serialization, for instance, could cause observable changes to --- formats that we want to control and version. -data POp - = -- Int - ADDI - | SUBI - | MULI - | DIVI -- +,-,*,/ - | SGNI - | NEGI - | MODI -- sgn,neg,mod - | POWI - | SHLI - | SHRI -- pow,shiftl,shiftr - | INCI - | DECI - | LEQI - | EQLI -- inc,dec,<=,== - -- Nat - | ADDN - | SUBN - | MULN - | DIVN -- +,-,*,/ - | MODN - | TZRO - | LZRO - | POPC -- mod,trailing/leadingZeros,popCount - | POWN - | SHLN - | SHRN -- pow,shiftl,shiftr - | ANDN - | IORN - | XORN - | COMN -- and,or,xor,complement - | INCN - | DECN - | LEQN - | EQLN -- inc,dec,<=,== - -- Float - | ADDF - | SUBF - | MULF - | DIVF -- +,-,*,/ - | MINF - | MAXF - | LEQF - | EQLF -- min,max,<=,== - | POWF - | EXPF - | SQRT - | LOGF -- pow,exp,sqrt,log - | LOGB -- logBase - | ABSF - | CEIL - | FLOR - | TRNF -- abs,ceil,floor,truncate - | RNDF -- round - -- Trig - | COSF - | ACOS - | COSH - | ACSH -- cos,acos,cosh,acosh - | SINF - | ASIN - | SINH - | ASNH -- sin,asin,sinh,asinh - | TANF - | ATAN - | TANH - | ATNH -- tan,atan,tanh,atanh - | ATN2 -- atan2 - -- Text - | CATT - | TAKT - | DRPT - | SIZT -- ++,take,drop,size - | IXOT -- indexOf - | UCNS - | USNC - | EQLT - | LEQT -- uncons,unsnoc,==,<= - | PAKT - | UPKT -- pack,unpack - -- Sequence - | CATS - | TAKS - | DRPS - | SIZS -- ++,take,drop,size - | CONS - | SNOC - | IDXS - | BLDS -- cons,snoc,at,build - | VWLS - | VWRS - | SPLL - | SPLR -- viewl,viewr,splitl,splitr - -- Bytes - | PAKB - | UPKB - | TAKB - | DRPB -- pack,unpack,take,drop - | IXOB -- indexOf - | IDXB - | SIZB - | FLTB - | CATB -- index,size,flatten,append - -- Conversion - | ITOF - | NTOF - | ITOT - | NTOT - | TTOI - | TTON - | TTOF - | FTOT - | -- Concurrency - FORK - | -- Universal operations - EQLU - | CMPU - | EROR - | -- Code - MISS - | CACH - | LKUP - | LOAD -- isMissing,cache_,lookup,load - | CVLD - | SDBX -- validate, sandbox - | VALU - | TLTT -- value, Term.Link.toText - -- Debug - | PRNT - | INFO - | TRCE - | DBTX - | -- STM - ATOM - | TFRC -- try force - | SDBL -- sandbox link list - | SDBV -- sandbox check for Values - deriving (Show, Eq, Ord, Enum, Bounded) - -type ANormal = ABTN.Term ANormalF - -type Cte v = CTE v (ANormal v) - -type Ctx v = Directed () [Cte v] - -data Direction a = Indirect a | Direct - deriving (Eq, Ord, Show, Functor, Foldable, Traversable) - -directed :: (Foldable f) => f (Cte v) -> Directed () (f (Cte v)) -directed x = (foldMap f x, x) - where - f (ST d _ _ _) = () <$ d - f _ = Direct - -instance (Semigroup a) => Semigroup (Direction a) where - Indirect l <> Indirect r = Indirect $ l <> r - Direct <> r = r - l <> Direct = l - -instance (Semigroup a) => Monoid (Direction a) where - mempty = Direct - -type Directed a = (,) (Direction a) - -type DNormal v = Directed () (ANormal v) - --- Should be a completely closed term -data SuperNormal v = Lambda {conventions :: [Mem], bound :: ANormal v} - deriving (Show, Eq) - -data SuperGroup v = Rec - { group :: [(v, SuperNormal v)], - entry :: SuperNormal v - } - deriving (Show) - -instance (Var v) => Eq (SuperGroup v) where - g0 == g1 | Left _ <- equivocate g0 g1 = False | otherwise = True - --- Failure modes for SuperGroup alpha equivalence test -data SGEqv v - = -- mismatch number of definitions in group - NumDefns (SuperGroup v) (SuperGroup v) - | -- mismatched SuperNormal calling conventions - DefnConventions (SuperNormal v) (SuperNormal v) - | -- mismatched subterms in corresponding definition - Subterms (ANormal v) (ANormal v) - --- Checks if two SuperGroups are equivalent up to renaming. The rest --- of the structure must match on the nose. If the two groups are not --- equivalent, an example of conflicting structure is returned. -equivocate :: - (Var v) => - SuperGroup v -> - SuperGroup v -> - Either (SGEqv v) () -equivocate g0@(Rec bs0 e0) g1@(Rec bs1 e1) - | length bs0 == length bs1 = - traverse_ eqvSN (zip ns0 ns1) *> eqvSN (e0, e1) - | otherwise = Left $ NumDefns g0 g1 - where - (vs0, ns0) = unzip bs0 - (vs1, ns1) = unzip bs1 - vm = Map.fromList (zip vs1 vs0) - - promote (Left (l, r)) = Left $ Subterms l r - promote (Right v) = Right v - - eqvSN (Lambda ccs0 e0, Lambda ccs1 e1) - | ccs0 == ccs1 = promote $ ABTN.alpha vm e0 e1 - eqvSN (n0, n1) = Left $ DefnConventions n0 n1 - -type ANFM v = - ReaderT - (Set v) - (State (Word64, Word16, [(v, SuperNormal v)])) - -type ANFD v = Compose (ANFM v) (Directed ()) - -data GroupRef = GR Reference Word64 - deriving (Show) - -data Value - = Partial GroupRef [Word64] [Value] - | Data Reference Word64 [Word64] [Value] - | Cont [Word64] [Value] Cont - | BLit BLit - deriving (Show) - -data Cont - = KE - | Mark Word64 Word64 [Reference] (Map Reference Value) Cont - | Push Word64 Word64 Word64 Word64 GroupRef Cont - deriving (Show) - -data BLit - = Text Util.Text.Text - | List (Seq Value) - | TmLink Referent - | TyLink Reference - | Bytes Bytes - | Quote Value - | Code (SuperGroup Symbol) - | BArr PA.ByteArray - | Pos Word64 - | Neg Word64 - | Char Char - | Float Double - | Arr (PA.Array Value) - deriving (Show) - -groupVars :: ANFM v (Set v) -groupVars = ask - -bindLocal :: (Ord v) => [v] -> ANFM v r -> ANFM v r -bindLocal vs = local (Set.\\ Set.fromList vs) - -freshANF :: (Var v) => Word64 -> v -freshANF fr = Var.freshenId fr $ typed Var.ANFBlank - -fresh :: (Var v) => ANFM v v -fresh = state $ \(fr, bnd, cs) -> (freshANF fr, (fr + 1, bnd, cs)) - -contextualize :: (Var v) => DNormal v -> ANFM v (Ctx v, v) -contextualize (_, TVar cv) = do - gvs <- groupVars - if cv `Set.notMember` gvs - then pure (pure [], cv) - else do - bv <- fresh - d <- Indirect <$> binder - pure (directed [ST1 d bv BX $ TApv cv []], bv) -contextualize (d0, tm) = do - fv <- fresh - d <- bindDirection d0 - pure ((d0, [ST1 d fv BX tm]), fv) - -binder :: ANFM v Word16 -binder = state $ \(fr, bnd, cs) -> (bnd, (fr, bnd + 1, cs)) - -bindDirection :: Direction a -> ANFM v (Direction Word16) -bindDirection = traverse (const binder) - -record :: (Var v) => (v, SuperNormal v) -> ANFM v () -record p = modify $ \(fr, bnd, to) -> (fr, bnd, p : to) - -superNormalize :: (Var v) => Term v a -> SuperGroup v -superNormalize tm = Rec l c - where - (bs, e) - | LetRecNamed' bs e <- tm = (bs, e) - | otherwise = ([], tm) - grp = Set.fromList $ fst <$> bs - comp = traverse_ superBinding bs *> toSuperNormal e - subc = runReaderT comp grp - (c, (_, _, l)) = runState subc (0, 1, []) - -superBinding :: (Var v) => (v, Term v a) -> ANFM v () -superBinding (v, tm) = do - nf <- toSuperNormal tm - modify $ \(cvs, bnd, ctx) -> (cvs, bnd, (v, nf) : ctx) - -toSuperNormal :: (Var v) => Term v a -> ANFM v (SuperNormal v) -toSuperNormal tm = do - grp <- groupVars - if not . Set.null . (Set.\\ grp) $ freeVars tm - then internalBug $ "free variables in supercombinator: " ++ show tm - else - Lambda (BX <$ vs) . ABTN.TAbss vs . snd - <$> bindLocal vs (anfTerm body) - where - (vs, body) = fromMaybe ([], tm) $ unLams' tm - -anfTerm :: (Var v) => Term v a -> ANFM v (DNormal v) -anfTerm tm = f <$> anfBlock tm - where - -- f = uncurry (liftA2 TBinds) - f ((_, []), dtm) = dtm - f ((_, cx), (_, tm)) = (Indirect (), TBinds cx tm) - -floatableCtx :: (Var v) => Ctx v -> Bool -floatableCtx = all p . snd - where - p (LZ _ _ _) = True - p (ST _ _ _ tm) = q tm - q (TLit _) = True - q (TVar _) = True - q (TCon _ _ _) = True - q _ = False - -anfHandled :: (Var v) => Term v a -> ANFM v (Ctx v, DNormal v) -anfHandled body = - anfBlock body >>= \case - (ctx, (_, t@TCon {})) -> - fresh <&> \v -> - (ctx <> pure [ST1 Direct v BX t], pure $ TVar v) - (ctx, (_, t@(TLit l))) -> - fresh <&> \v -> - (ctx <> pure [ST1 Direct v cc t], pure $ TVar v) - where - cc = case l of T {} -> BX; LM {} -> BX; LY {} -> BX; _ -> UN - p -> pure p - -fls, tru :: (Var v) => ANormal v -fls = TCon Ty.booleanRef 0 [] -tru = TCon Ty.booleanRef 1 [] - --- Helper function for renaming a variable arising from a --- let v = u --- binding during ANF translation. Renames a variable in a --- context, and returns an indication of whether the varible --- was shadowed by one of the context bindings. -renameCtx :: (Var v) => v -> v -> Ctx v -> (Ctx v, Bool) -renameCtx v u (d, ctx) | (ctx, b) <- rn [] ctx = ((d, ctx), b) - where - swap w - | w == v = u - | otherwise = w - - rn acc [] = (reverse acc, False) - rn acc (ST d vs ccs b : es) - | any (== v) vs = (reverse acc ++ e : es, True) - | otherwise = rn (e : acc) es - where - e = ST d vs ccs $ ABTN.rename v u b - rn acc (LZ w f as : es) - | w == v = (reverse acc ++ e : es, True) - | otherwise = rn (e : acc) es - where - e = LZ w (swap <$> f) (swap <$> as) - -anfBlock :: (Var v) => Term v a -> ANFM v (Ctx v, DNormal v) -anfBlock (Var' v) = pure (mempty, pure $ TVar v) -anfBlock (If' c t f) = do - (cctx, cc) <- anfBlock c - (df, cf) <- anfTerm f - (dt, ct) <- anfTerm t - (cx, v) <- contextualize cc - let cases = - MatchData - (Builtin $ Data.Text.pack "Boolean") - (EC.mapSingleton 0 ([], cf)) - (Just ct) - pure (cctx <> cx, (Indirect () <> df <> dt, TMatch v cases)) -anfBlock (And' l r) = do - (lctx, vl) <- anfArg l - (d, tmr) <- anfTerm r - let tree = - TMatch vl . MatchDataCover Ty.booleanRef $ - mapFromList - [ (0, ([], fls)), - (1, ([], tmr)) - ] - pure (lctx, (Indirect () <> d, tree)) -anfBlock (Or' l r) = do - (lctx, vl) <- anfArg l - (d, tmr) <- anfTerm r - let tree = - TMatch vl . MatchDataCover Ty.booleanRef $ - mapFromList - [ (1, ([], tru)), - (0, ([], tmr)) - ] - pure (lctx, (Indirect () <> d, tree)) -anfBlock (Handle' h body) = - anfArg h >>= \(hctx, vh) -> - anfHandled body >>= \case - (ctx, (_, TCom f as)) | floatableCtx ctx -> do - v <- fresh - pure - ( hctx <> ctx <> pure [LZ v (Left f) as], - (Indirect (), TApp (FVar vh) [v]) - ) - (ctx, (_, TApv f as)) | floatableCtx ctx -> do - v <- fresh - pure - ( hctx <> ctx <> pure [LZ v (Right f) as], - (Indirect (), TApp (FVar vh) [v]) - ) - (ctx, (_, TVar v)) | floatableCtx ctx -> do - pure (hctx <> ctx, (Indirect (), TApp (FVar vh) [v])) - p@(_, _) -> - internalBug $ "handle body should be a simple call: " ++ show p -anfBlock (Match' scrut cas) = do - (sctx, sc) <- anfBlock scrut - (cx, v) <- contextualize sc - (d, brn) <- anfCases v cas - fmap (first ((Indirect () <> d) <>)) <$> case brn of - AccumDefault (TBinds (directed -> dctx) df) -> do - pure (sctx <> cx <> dctx, pure df) - AccumRequest _ Nothing -> - internalBug "anfBlock: AccumRequest without default" - AccumPure (ABTN.TAbss us bd) - | [u] <- us, - TBinds (directed -> bx) bd <- bd -> - case cx of - (_, []) -> do - d0 <- Indirect <$> binder - pure (sctx <> pure [ST1 d0 u BX (TFrc v)] <> bx, pure bd) - (d0, [ST1 d1 _ BX tm]) -> - pure (sctx <> (d0, [ST1 d1 u BX tm]) <> bx, pure bd) - _ -> internalBug "anfBlock|AccumPure: impossible" - | otherwise -> internalBug "pure handler with too many variables" - AccumRequest abr (Just df) -> do - (r, vs) <- do - r <- fresh - v <- fresh - gvs <- groupVars - let hfb = ABTN.TAbs v . TMatch v $ MatchRequest abr df - hfvs = Set.toList $ ABTN.freeVars hfb `Set.difference` gvs - record (r, Lambda (BX <$ hfvs ++ [v]) . ABTN.TAbss hfvs $ hfb) - pure (r, hfvs) - hv <- fresh - let (d, msc) - | (d, [ST1 _ _ BX tm]) <- cx = (d, tm) - | (_, [ST _ _ _ _]) <- cx = - internalBug "anfBlock: impossible" - | otherwise = (Indirect (), TFrc v) - pure - ( sctx <> pure [LZ hv (Right r) vs], - (d, THnd (Map.keys abr) hv msc) - ) - AccumText df cs -> - pure (sctx <> cx, pure . TMatch v $ MatchText cs df) - AccumIntegral r df cs -> - pure (sctx <> cx, pure $ TMatch v $ MatchNumeric r cs df) - AccumData r df cs -> - pure (sctx <> cx, pure . TMatch v $ MatchData r cs df) - AccumSeqEmpty _ -> - internalBug "anfBlock: non-exhaustive AccumSeqEmpty" - AccumSeqView en (Just em) bd -> do - r <- fresh - let op - | SLeft <- en = Builtin "List.viewl" - | otherwise = Builtin "List.viewr" - b <- binder - pure - ( sctx - <> cx - <> (Indirect (), [ST1 (Indirect b) r BX (TCom op [v])]), - pure . TMatch r $ - MatchDataCover - Ty.seqViewRef - ( EC.mapFromList - [ (fromIntegral Ty.seqViewEmpty, ([], em)), - (fromIntegral Ty.seqViewElem, ([BX, BX], bd)) - ] - ) - ) - AccumSeqView {} -> - internalBug "anfBlock: non-exhaustive AccumSeqView" - AccumSeqSplit en n mdf bd -> do - i <- fresh - r <- fresh - s <- fresh - b <- binder - let split = ST1 (Indirect b) r BX (TCom op [i, v]) - pure - ( sctx <> cx <> directed [lit i, split], - pure . TMatch r . MatchDataCover Ty.seqViewRef $ - mapFromList - [ (fromIntegral Ty.seqViewEmpty, ([], df s)), - (fromIntegral Ty.seqViewElem, ([BX, BX], bd)) - ] - ) - where - op - | SLeft <- en = Builtin "List.splitLeft" - | otherwise = Builtin "List.splitRight" - lit i = ST1 Direct i BX (TBLit . N $ fromIntegral n) - df n = - fromMaybe - ( TLet Direct n BX (TLit (T "pattern match failure")) $ - TPrm EROR [n, v] - ) - mdf - AccumEmpty -> pure (sctx <> cx, pure $ TMatch v MatchEmpty) -anfBlock (Let1Named' v b e) = - anfBlock b >>= \case - (bctx, (Direct, TVar u)) -> do - (ectx, ce) <- anfBlock e - (ectx, shaded) <- pure $ renameCtx v u ectx - ce <- pure $ if shaded then ce else ABTN.rename v u <$> ce - pure (bctx <> ectx, ce) - (bctx, (d0, cb)) -> bindLocal [v] $ do - (ectx, ce) <- anfBlock e - d <- bindDirection d0 - let octx = bctx <> directed [ST1 d v BX cb] <> ectx - pure (octx, ce) -anfBlock (Apps' (Blank' b) args) = do - nm <- fresh - (actx, cas) <- anfArgs args - pure - ( actx <> pure [ST1 Direct nm BX (TLit (T msg))], - pure $ TPrm EROR (nm : cas) - ) - where - msg = Util.Text.pack . fromMaybe "blank expression" $ nameb b -anfBlock (Apps' f args) = do - (fctx, (d, cf)) <- anfFunc f - (actx, cas) <- anfArgs args - pure (fctx <> actx, (d, TApp cf cas)) -anfBlock (Constructor' (ConstructorReference r t)) = - pure (mempty, pure $ TCon r (fromIntegral t) []) -anfBlock (Request' (ConstructorReference r t)) = - pure (mempty, (Indirect (), TReq r (fromIntegral t) [])) -anfBlock (Boolean' b) = - pure (mempty, pure $ TCon Ty.booleanRef (if b then 1 else 0) []) -anfBlock (Lit' l@(T _)) = - pure (mempty, pure $ TLit l) -anfBlock (Lit' l) = - pure (mempty, pure $ TBLit l) -anfBlock (Ref' r) = pure (mempty, (Indirect (), TCom r [])) -anfBlock (Blank' b) = do - nm <- fresh - ev <- fresh - pure - ( pure - [ ST1 Direct nm BX (TLit (T name)), - ST1 Direct ev BX (TLit (T $ Util.Text.pack msg)) - ], - pure $ TPrm EROR [nm, ev] - ) - where - name = "blank expression" - msg = fromMaybe "blank expression" $ nameb b -anfBlock (TermLink' r) = pure (mempty, pure . TLit $ LM r) -anfBlock (TypeLink' r) = pure (mempty, pure . TLit $ LY r) -anfBlock (List' as) = fmap (pure . TPrm BLDS) <$> anfArgs tms - where - tms = toList as -anfBlock t = internalBug $ "anf: unhandled term: " ++ show t - --- Note: this assumes that patterns have already been translated --- to a state in which every case matches a single layer of data, --- with no guards, and no variables ignored. This is not checked --- completely. -anfInitCase :: - (Var v) => - v -> - MatchCase p (Term v a) -> - ANFD v (BranchAccum v) -anfInitCase u (MatchCase p guard (ABT.AbsN' vs bd)) - | Just _ <- guard = internalBug "anfInitCase: unexpected guard" - | P.Unbound _ <- p, - [] <- vs = - AccumDefault <$> anfBody bd - | P.Var _ <- p, - [v] <- vs = - AccumDefault . ABTN.rename v u <$> anfBody bd - | P.Var _ <- p = - internalBug $ "vars: " ++ show (length vs) - | P.Int _ (fromIntegral -> i) <- p = - AccumIntegral Ty.intRef Nothing . EC.mapSingleton i <$> anfBody bd - | P.Nat _ i <- p = - AccumIntegral Ty.natRef Nothing . EC.mapSingleton i <$> anfBody bd - | P.Char _ c <- p, - w <- fromIntegral $ fromEnum c = - AccumIntegral Ty.charRef Nothing . EC.mapSingleton w <$> anfBody bd - | P.Boolean _ b <- p, - t <- if b then 1 else 0 = - AccumData Ty.booleanRef Nothing - . EC.mapSingleton t - . ([],) - <$> anfBody bd - | P.Text _ t <- p, - [] <- vs = - AccumText Nothing . Map.singleton (Util.Text.fromText t) <$> anfBody bd - | P.Constructor _ (ConstructorReference r t) ps <- p = do - (,) - <$> expandBindings ps vs - <*> anfBody bd - <&> \(us, bd) -> - AccumData r Nothing . EC.mapSingleton (fromIntegral t) . (BX <$ us,) $ ABTN.TAbss us bd - | P.EffectPure _ q <- p = - (,) - <$> expandBindings [q] vs - <*> anfBody bd - <&> \(us, bd) -> AccumPure $ ABTN.TAbss us bd - | P.EffectBind _ (ConstructorReference r t) ps pk <- p = do - (,,) - <$> expandBindings (snoc ps pk) vs - <*> Compose (pure <$> fresh) - <*> anfBody bd - <&> \(exp, kf, bd) -> - let (us, uk) = - maybe (internalBug "anfInitCase: unsnoc impossible") id $ - unsnoc exp - jn = Builtin "jumpCont" - in flip AccumRequest Nothing - . Map.singleton r - . EC.mapSingleton (fromIntegral t) - . (BX <$ us,) - . ABTN.TAbss us - . TShift r kf - $ TName uk (Left jn) [kf] bd - | P.SequenceLiteral _ [] <- p = - AccumSeqEmpty <$> anfBody bd - | P.SequenceOp _ l op r <- p, - Concat <- op, - P.SequenceLiteral p ll <- l = do - AccumSeqSplit SLeft (length ll) Nothing - <$> (ABTN.TAbss <$> expandBindings [P.Var p, r] vs <*> anfBody bd) - | P.SequenceOp _ l op r <- p, - Concat <- op, - P.SequenceLiteral p rl <- r = - AccumSeqSplit SLeft (length rl) Nothing - <$> (ABTN.TAbss <$> expandBindings [l, P.Var p] vs <*> anfBody bd) - | P.SequenceOp _ l op r <- p, - dir <- case op of Cons -> SLeft; _ -> SRight = - AccumSeqView dir Nothing - <$> (ABTN.TAbss <$> expandBindings [l, r] vs <*> anfBody bd) - where - anfBody tm = Compose . bindLocal vs $ anfTerm tm -anfInitCase _ (MatchCase p _ _) = - internalBug $ "anfInitCase: unexpected pattern: " ++ show p - -valueTermLinks :: Value -> [Reference] -valueTermLinks = Set.toList . valueLinks f - where - f False r = Set.singleton r - f _ _ = Set.empty - -valueLinks :: (Monoid a) => (Bool -> Reference -> a) -> Value -> a -valueLinks f (Partial (GR cr _) _ bs) = - f False cr <> foldMap (valueLinks f) bs -valueLinks f (Data dr _ _ bs) = - f True dr <> foldMap (valueLinks f) bs -valueLinks f (Cont _ bs k) = - foldMap (valueLinks f) bs <> contLinks f k -valueLinks f (BLit l) = blitLinks f l - -contLinks :: (Monoid a) => (Bool -> Reference -> a) -> Cont -> a -contLinks f (Push _ _ _ _ (GR cr _) k) = - f False cr <> contLinks f k -contLinks f (Mark _ _ ps de k) = - foldMap (f True) ps - <> Map.foldMapWithKey (\k c -> f True k <> valueLinks f c) de - <> contLinks f k -contLinks _ KE = mempty - -blitLinks :: (Monoid a) => (Bool -> Reference -> a) -> BLit -> a -blitLinks f (List s) = foldMap (valueLinks f) s -blitLinks _ _ = mempty - -groupTermLinks :: (Var v) => SuperGroup v -> [Reference] -groupTermLinks = Set.toList . foldGroupLinks f - where - f False r = Set.singleton r - f _ _ = Set.empty - -overGroupLinks :: - (Var v) => - (Bool -> Reference -> Reference) -> - SuperGroup v -> - SuperGroup v -overGroupLinks f = - runIdentity . traverseGroupLinks (\b -> Identity . f b) - -traverseGroupLinks :: - (Applicative f, Var v) => - (Bool -> Reference -> f Reference) -> - SuperGroup v -> - f (SuperGroup v) -traverseGroupLinks f (Rec bs e) = - Rec <$> (traverse . traverse) (normalLinks f) bs <*> normalLinks f e - -foldGroupLinks :: - (Monoid r, Var v) => - (Bool -> Reference -> r) -> - SuperGroup v -> - r -foldGroupLinks f = getConst . traverseGroupLinks (\b -> Const . f b) - -normalLinks :: - (Applicative f, Var v) => - (Bool -> Reference -> f Reference) -> - SuperNormal v -> - f (SuperNormal v) -normalLinks f (Lambda ccs e) = Lambda ccs <$> anfLinks f e - -anfLinks :: - (Applicative f, Var v) => - (Bool -> Reference -> f Reference) -> - ANormal v -> - f (ANormal v) -anfLinks f (ABTN.Term _ (ABTN.Abs v e)) = - ABTN.TAbs v <$> anfLinks f e -anfLinks f (ABTN.Term _ (ABTN.Tm e)) = - ABTN.TTm <$> anfFLinks f (anfLinks f) e - -anfFLinks :: - (Applicative f) => - (Bool -> Reference -> f Reference) -> - (e -> f e) -> - ANormalF v e -> - f (ANormalF v e) -anfFLinks _ g (ALet d ccs b e) = ALet d ccs <$> g b <*> g e -anfFLinks f g (AName er vs e) = - flip AName vs <$> bitraverse (f False) pure er <*> g e -anfFLinks f g (AMatch v bs) = - AMatch v <$> branchLinks (f True) g bs -anfFLinks f g (AShift r e) = - AShift <$> f True r <*> g e -anfFLinks f g (AHnd rs v e) = - flip AHnd v <$> traverse (f True) rs <*> g e -anfFLinks f _ (AApp fu vs) = flip AApp vs <$> funcLinks f fu -anfFLinks f _ (ALit l) = ALit <$> litLinks f l -anfFLinks _ _ v = pure v - -litLinks :: - (Applicative f) => - (Bool -> Reference -> f Reference) -> - Lit -> - f Lit -litLinks f (LY r) = LY <$> f True r -litLinks f (LM (Con (ConstructorReference r i) t)) = - LM . flip Con t . flip ConstructorReference i <$> f True r -litLinks f (LM (Ref r)) = LM . Ref <$> f False r -litLinks _ v = pure v - -branchLinks :: - (Applicative f) => - (Reference -> f Reference) -> - (e -> f e) -> - Branched e -> - f (Branched e) -branchLinks f g (MatchRequest m e) = - MatchRequest . Map.fromList - <$> traverse (bitraverse f $ (traverse . traverse) g) (Map.toList m) - <*> g e -branchLinks f g (MatchData r m e) = - MatchData <$> f r <*> (traverse . traverse) g m <*> traverse g e -branchLinks _ g (MatchText m e) = - MatchText <$> traverse g m <*> traverse g e -branchLinks _ g (MatchIntegral m e) = - MatchIntegral <$> traverse g m <*> traverse g e -branchLinks _ g (MatchNumeric r m e) = - MatchNumeric r <$> traverse g m <*> traverse g e -branchLinks _ g (MatchSum m) = - MatchSum <$> (traverse . traverse) g m -branchLinks _ _ MatchEmpty = pure MatchEmpty - -funcLinks :: - (Applicative f) => - (Bool -> Reference -> f Reference) -> - Func v -> - f (Func v) -funcLinks f (FComb r) = FComb <$> f False r -funcLinks f (FCon r t) = flip FCon t <$> f True r -funcLinks f (FReq r t) = flip FReq t <$> f True r -funcLinks _ ff = pure ff - -expandBindings' :: - (Var v) => - Word64 -> - [P.Pattern p] -> - [v] -> - Either String (Word64, [v]) -expandBindings' fr [] [] = Right (fr, []) -expandBindings' fr (P.Unbound _ : ps) vs = - fmap (u :) <$> expandBindings' (fr + 1) ps vs - where - u = freshANF fr -expandBindings' fr (P.Var _ : ps) (v : vs) = - fmap (v :) <$> expandBindings' fr ps vs -expandBindings' _ [] (_ : _) = - Left "expandBindings': more bindings than expected" -expandBindings' _ (_ : _) [] = - Left "expandBindings': more patterns than expected" -expandBindings' _ _ _ = - Left $ "expandBindings': unexpected pattern" - -expandBindings :: (Var v) => [P.Pattern p] -> [v] -> ANFD v [v] -expandBindings ps vs = - Compose . state $ \(fr, bnd, co) -> case expandBindings' fr ps vs of - Left err -> internalBug $ err ++ " " ++ show (ps, vs) - Right (fr, l) -> (pure l, (fr, bnd, co)) - -anfCases :: - (Var v) => - v -> - [MatchCase p (Term v a)] -> - ANFM v (Directed () (BranchAccum v)) -anfCases u = getCompose . fmap fold . traverse (anfInitCase u) - -anfFunc :: (Var v) => Term v a -> ANFM v (Ctx v, Directed () (Func v)) -anfFunc (Var' v) = pure (mempty, (Indirect (), FVar v)) -anfFunc (Ref' r) = pure (mempty, (Indirect (), FComb r)) -anfFunc (Constructor' (ConstructorReference r t)) = pure (mempty, (Direct, FCon r $ fromIntegral t)) -anfFunc (Request' (ConstructorReference r t)) = pure (mempty, (Indirect (), FReq r $ fromIntegral t)) -anfFunc tm = do - (fctx, ctm) <- anfBlock tm - (cx, v) <- contextualize ctm - pure (fctx <> cx, (Indirect (), FVar v)) - -anfArg :: (Var v) => Term v a -> ANFM v (Ctx v, v) -anfArg tm = do - (ctx, ctm) <- anfBlock tm - (cx, v) <- contextualize ctm - pure (ctx <> cx, v) - -anfArgs :: (Var v) => [Term v a] -> ANFM v (Ctx v, [v]) -anfArgs tms = first fold . unzip <$> traverse anfArg tms - -indent :: Int -> ShowS -indent ind = showString (replicate (ind * 2) ' ') - -prettyGroup :: (Var v) => String -> SuperGroup v -> ShowS -prettyGroup s (Rec grp ent) = - showString ("let rec[" ++ s ++ "]\n") - . foldr f id grp - . showString "entry" - . prettySuperNormal 1 ent - where - f (v, sn) r = - indent 1 - . pvar v - . prettySuperNormal 2 sn - . showString "\n" - . r - -pvar :: (Var v) => v -> ShowS -pvar v = showString . Data.Text.unpack $ Var.name v - -prettyVars :: (Var v) => [v] -> ShowS -prettyVars = - foldr (\v r -> showString " " . pvar v . r) id - -prettyLVars :: (Var v) => [Mem] -> [v] -> ShowS -prettyLVars [] [] = showString " " -prettyLVars (c : cs) (v : vs) = - showString " " - . showParen True (pvar v . showString ":" . shows c) - . prettyLVars cs vs -prettyLVars [] (_ : _) = internalBug "more variables than conventions" -prettyLVars (_ : _) [] = internalBug "more conventions than variables" - -prettyRBind :: (Var v) => [v] -> ShowS -prettyRBind [] = showString "()" -prettyRBind [v] = pvar v -prettyRBind (v : vs) = - showParen True $ - pvar v . foldr (\v r -> shows v . showString "," . r) id vs - -prettySuperNormal :: (Var v) => Int -> SuperNormal v -> ShowS -prettySuperNormal ind (Lambda ccs (ABTN.TAbss vs tm)) = - prettyLVars ccs vs - . showString "=" - . prettyANF False (ind + 1) tm - -reqSpace :: (Var v) => Bool -> ANormal v -> Bool -reqSpace _ TLets {} = True -reqSpace _ TName {} = True -reqSpace b _ = b - -prettyANF :: (Var v) => Bool -> Int -> ANormal v -> ShowS -prettyANF m ind tm = - prettySpace (reqSpace m tm) ind . case tm of - TLets _ vs _ bn bo -> - prettyRBind vs - . showString " =" - . prettyANF False (ind + 1) bn - . prettyANF True ind bo - TName v f vs bo -> - prettyRBind [v] - . showString " := " - . prettyLZF f - . prettyVars vs - . prettyANF True ind bo - TLit l -> shows l - TFrc v -> showString "!" . pvar v - TVar v -> pvar v - TApp f vs -> prettyFunc f . prettyVars vs - TMatch v bs -> - showString "match " - . pvar v - . showString " with" - . prettyBranches (ind + 1) bs - TShift r v bo -> - showString "shift[" - . shows r - . showString "]" - . prettyVars [v] - . showString "." - . prettyANF False (ind + 1) bo - THnd rs v bo -> - showString "handle" - . prettyRefs rs - . prettyANF False (ind + 1) bo - . showString " with " - . pvar v - _ -> shows tm - -prettySpace :: Bool -> Int -> ShowS -prettySpace False _ = showString " " -prettySpace True ind = showString "\n" . indent ind - -prettyLZF :: (Var v) => Either Reference v -> ShowS -prettyLZF (Left w) = showString "ENV(" . shows w . showString ") " -prettyLZF (Right v) = pvar v . showString " " - -prettyRefs :: [Reference] -> ShowS -prettyRefs [] = showString "{}" -prettyRefs (r : rs) = - showString "{" - . shows r - . foldr (\t r -> shows t . showString "," . r) id rs - . showString "}" - -prettyFunc :: (Var v) => Func v -> ShowS -prettyFunc (FVar v) = pvar v . showString " " -prettyFunc (FCont v) = pvar v . showString " " -prettyFunc (FComb w) = showString "ENV(" . shows w . showString ")" -prettyFunc (FCon r t) = - showString "CON(" - . shows r - . showString "," - . shows t - . showString ")" -prettyFunc (FReq r t) = - showString "REQ(" - . shows r - . showString "," - . shows t - . showString ")" -prettyFunc (FPrim op) = either shows shows op . showString " " - -prettyBranches :: (Var v) => Int -> Branched (ANormal v) -> ShowS -prettyBranches ind bs = case bs of - MatchEmpty -> showString "{}" - MatchIntegral bs df -> - maybe id (\e -> prettyCase ind (showString "_") e id) df - . foldr (uncurry $ prettyCase ind . shows) id (mapToList bs) - MatchText bs df -> - maybe id (\e -> prettyCase ind (showString "_") e id) df - . foldr (uncurry $ prettyCase ind . shows) id (Map.toList bs) - MatchData _ bs df -> - maybe id (\e -> prettyCase ind (showString "_") e id) df - . foldr - (uncurry $ prettyCase ind . shows) - id - (mapToList $ snd <$> bs) - MatchRequest bs df -> - foldr - ( \(r, m) s -> - foldr - (\(c, e) -> prettyCase ind (prettyReq r c) e) - s - (mapToList $ snd <$> m) - ) - (prettyCase ind (prettyReq (0 :: Int) (0 :: Int)) df id) - (Map.toList bs) - MatchSum bs -> - foldr - (uncurry $ prettyCase ind . shows) - id - (mapToList $ snd <$> bs) - MatchNumeric _ bs df -> - maybe id (\e -> prettyCase ind (showString "_") e id) df - . foldr (uncurry $ prettyCase ind . shows) id (mapToList bs) - -- _ -> error "prettyBranches: todo" - where - -- prettyReq :: Reference -> CTag -> ShowS - prettyReq r c = - showString "REQ(" - . shows r - . showString "," - . shows c - . showString ")" - -prettyCase :: (Var v) => Int -> ShowS -> ANormal v -> ShowS -> ShowS -prettyCase ind sc (ABTN.TAbss vs e) r = - showString "\n" - . indent ind - . sc - . prettyVars vs - . showString " ->" - . prettyANF False (ind + 1) e - . r diff --git a/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs b/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs deleted file mode 100644 index 995856e1b4..0000000000 --- a/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs +++ /dev/null @@ -1,993 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE PatternSynonyms #-} - -module Unison.Runtime.ANF.Serialize where - -import Control.Monad -import Data.ByteString (ByteString) -import Data.ByteString.Lazy qualified as L -import Data.Bytes.Get hiding (getBytes) -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Bytes.VarInt -import Data.Foldable (traverse_) -import Data.Functor ((<&>)) -import Data.Map as Map (Map, fromList, lookup) -import Data.Maybe (mapMaybe) -import Data.Sequence qualified as Seq -import Data.Serialize.Put (runPutLazy) -import Data.Text (Text) -import Data.Word (Word16, Word32, Word64) -import GHC.IsList qualified (fromList) -import GHC.Stack -import Unison.ABT.Normalized (Term (..)) -import Unison.Reference (Reference, Reference' (Builtin), pattern Derived) -import Unison.Runtime.ANF as ANF hiding (Tag) -import Unison.Runtime.Exception -import Unison.Runtime.Serialize -import Unison.Util.EnumContainers qualified as EC -import Unison.Util.Text qualified as Util.Text -import Unison.Var (Type (ANFBlank), Var (..)) -import Prelude hiding (getChar, putChar) - -type Version = Word32 - -data TmTag - = VarT - | ForceT - | AppT - | HandleT - | ShiftT - | MatchT - | LitT - | NameRefT - | NameVarT - | LetDirT - | LetIndT - | BxLitT - -data FnTag - = FVarT - | FCombT - | FContT - | FConT - | FReqT - | FPrimT - | FForeignT - -data MtTag - = MIntT - | MTextT - | MReqT - | MEmptyT - | MDataT - | MSumT - | MNumT - -data LtTag - = IT - | NT - | FT - | TT - | CT - | LMT - | LYT - -data BLTag - = TextT - | ListT - | TmLinkT - | TyLinkT - | BytesT - | QuoteT - | CodeT - | BArrT - | PosT - | NegT - | CharT - | FloatT - | ArrT - -data VaTag = PartialT | DataT | ContT | BLitT - -data CoTag = KET | MarkT | PushT - -instance Tag TmTag where - tag2word = \case - VarT -> 1 - ForceT -> 2 - AppT -> 3 - HandleT -> 4 - ShiftT -> 5 - MatchT -> 6 - LitT -> 7 - NameRefT -> 8 - NameVarT -> 9 - LetDirT -> 10 - LetIndT -> 11 - BxLitT -> 12 - word2tag = \case - 1 -> pure VarT - 2 -> pure ForceT - 3 -> pure AppT - 4 -> pure HandleT - 5 -> pure ShiftT - 6 -> pure MatchT - 7 -> pure LitT - 8 -> pure NameRefT - 9 -> pure NameVarT - 10 -> pure LetDirT - 11 -> pure LetIndT - 12 -> pure BxLitT - n -> unknownTag "TmTag" n - -instance Tag FnTag where - tag2word = \case - FVarT -> 0 - FCombT -> 1 - FContT -> 2 - FConT -> 3 - FReqT -> 4 - FPrimT -> 5 - FForeignT -> 6 - - word2tag = \case - 0 -> pure FVarT - 1 -> pure FCombT - 2 -> pure FContT - 3 -> pure FConT - 4 -> pure FReqT - 5 -> pure FPrimT - 6 -> pure FForeignT - n -> unknownTag "FnTag" n - -instance Tag MtTag where - tag2word = \case - MIntT -> 0 - MTextT -> 1 - MReqT -> 2 - MEmptyT -> 3 - MDataT -> 4 - MSumT -> 5 - MNumT -> 6 - - word2tag = \case - 0 -> pure MIntT - 1 -> pure MTextT - 2 -> pure MReqT - 3 -> pure MEmptyT - 4 -> pure MDataT - 5 -> pure MSumT - 6 -> pure MNumT - n -> unknownTag "MtTag" n - -instance Tag LtTag where - tag2word = \case - IT -> 0 - NT -> 1 - FT -> 2 - TT -> 3 - CT -> 4 - LMT -> 5 - LYT -> 6 - - word2tag = \case - 0 -> pure IT - 1 -> pure NT - 2 -> pure FT - 3 -> pure TT - 4 -> pure CT - 5 -> pure LMT - 6 -> pure LYT - n -> unknownTag "LtTag" n - -instance Tag BLTag where - tag2word = \case - TextT -> 0 - ListT -> 1 - TmLinkT -> 2 - TyLinkT -> 3 - BytesT -> 4 - QuoteT -> 5 - CodeT -> 6 - BArrT -> 7 - PosT -> 8 - NegT -> 9 - CharT -> 10 - FloatT -> 11 - ArrT -> 12 - - word2tag = \case - 0 -> pure TextT - 1 -> pure ListT - 2 -> pure TmLinkT - 3 -> pure TyLinkT - 4 -> pure BytesT - 5 -> pure QuoteT - 6 -> pure CodeT - 7 -> pure BArrT - 8 -> pure PosT - 9 -> pure NegT - 10 -> pure CharT - 11 -> pure FloatT - 12 -> pure ArrT - t -> unknownTag "BLTag" t - -instance Tag VaTag where - tag2word = \case - PartialT -> 0 - DataT -> 1 - ContT -> 2 - BLitT -> 3 - - word2tag = \case - 0 -> pure PartialT - 1 -> pure DataT - 2 -> pure ContT - 3 -> pure BLitT - t -> unknownTag "VaTag" t - -instance Tag CoTag where - tag2word = \case - KET -> 0 - MarkT -> 1 - PushT -> 2 - word2tag = \case - 0 -> pure KET - 1 -> pure MarkT - 2 -> pure PushT - t -> unknownTag "CoTag" t - -index :: (Eq v) => [v] -> v -> Maybe Word64 -index ctx u = go 0 ctx - where - go !_ [] = Nothing - go n (v : vs) - | v == u = Just n - | otherwise = go (n + 1) vs - -deindex :: (HasCallStack) => [v] -> Word64 -> v -deindex [] _ = exn "deindex: bad index" -deindex (v : vs) n - | n == 0 = v - | otherwise = deindex vs (n - 1) - -pushCtx :: [v] -> [v] -> [v] -pushCtx us vs = reverse us ++ vs - -putIndex :: (MonadPut m) => Word64 -> m () -putIndex = serialize . VarInt - -getIndex :: (MonadGet m) => m Word64 -getIndex = unVarInt <$> deserialize - -putVar :: (MonadPut m) => (Eq v) => [v] -> v -> m () -putVar ctx v - | Just i <- index ctx v = putIndex i - | otherwise = exn "putVar: variable not in context" - -getVar :: (MonadGet m) => [v] -> m v -getVar ctx = deindex ctx <$> getIndex - -putArgs :: (MonadPut m) => (Eq v) => [v] -> [v] -> m () -putArgs ctx is = putFoldable (putVar ctx) is - -getArgs :: (MonadGet m) => [v] -> m [v] -getArgs ctx = getList (getVar ctx) - -putCCs :: (MonadPut m) => [Mem] -> m () -putCCs ccs = putLength n *> traverse_ putCC ccs - where - n = length ccs - putCC UN = putWord8 0 - putCC BX = putWord8 1 - -getCCs :: (MonadGet m) => m [Mem] -getCCs = - getList $ - getWord8 <&> \case - 0 -> UN - 1 -> BX - _ -> exn "getCCs: bad calling convention" - --- Serializes a `SuperGroup`. --- --- The Reference map allows certain term references to be switched out --- for a given 64 bit word. This is used when re-hashing intermediate --- code. For actual serialization, the empty map should be used, so --- that the process is reversible. The purpose of this is merely to --- strip out (mutual/)self-references when producing a byte sequence --- to recompute a hash of a connected component of intermediate --- definitons, since it is infeasible to --- --- The EnumMap associates 'foreign' operations with a textual name --- that is used as the serialized representation. Since they are --- generated somewhat dynamically, it is not easy to associate them --- with a fixed numbering like we can with POps. -putGroup :: - (MonadPut m) => - (Var v) => - Map Reference Word64 -> - EC.EnumMap FOp Text -> - SuperGroup v -> - m () -putGroup refrep fops (Rec bs e) = - putLength n - *> traverse_ (putComb refrep fops ctx) cs - *> putComb refrep fops ctx e - where - n = length us - (us, cs) = unzip bs - ctx = pushCtx us [] - -getGroup :: (MonadGet m) => (Var v) => m (SuperGroup v) -getGroup = do - l <- getLength - let n = fromIntegral l - vs = getFresh <$> take l [0 ..] - ctx = pushCtx vs [] - cs <- replicateM l (getComb ctx n) - Rec (zip vs cs) <$> getComb ctx n - -putComb :: - (MonadPut m) => - (Var v) => - Map Reference Word64 -> - EC.EnumMap FOp Text -> - [v] -> - SuperNormal v -> - m () -putComb refrep fops ctx (Lambda ccs (TAbss us e)) = - putCCs ccs *> putNormal refrep fops (pushCtx us ctx) e - -getFresh :: (Var v) => Word64 -> v -getFresh n = freshenId n $ typed ANFBlank - -getComb :: (MonadGet m) => (Var v) => [v] -> Word64 -> m (SuperNormal v) -getComb ctx frsh0 = do - ccs <- getCCs - let us = zipWith (\_ -> getFresh) ccs [frsh0 ..] - frsh = frsh0 + fromIntegral (length ccs) - Lambda ccs . TAbss us <$> getNormal (pushCtx us ctx) frsh - -putNormal :: - (MonadPut m) => - (Var v) => - Map Reference Word64 -> - EC.EnumMap FOp Text -> - [v] -> - ANormal v -> - m () -putNormal refrep fops ctx tm = case tm of - TVar v -> putTag VarT *> putVar ctx v - TFrc v -> putTag ForceT *> putVar ctx v - TApp f as -> putTag AppT *> putFunc refrep fops ctx f *> putArgs ctx as - THnd rs h e -> - putTag HandleT - *> putRefs rs - *> putVar ctx h - *> putNormal refrep fops ctx e - TShift r v e -> - putTag ShiftT *> putReference r *> putNormal refrep fops (v : ctx) e - TMatch v bs -> - putTag MatchT - *> putVar ctx v - *> putBranches refrep fops ctx bs - TLit l -> putTag LitT *> putLit l - TBLit l -> putTag BxLitT *> putLit l - TName v (Left r) as e -> - putTag NameRefT - *> pr - *> putArgs ctx as - *> putNormal refrep fops (v : ctx) e - where - pr - | Just w <- Map.lookup r refrep = putWord64be w - | otherwise = putReference r - TName v (Right u) as e -> - putTag NameVarT - *> putVar ctx u - *> putArgs ctx as - *> putNormal refrep fops (v : ctx) e - TLets Direct us ccs l e -> - putTag LetDirT - *> putCCs ccs - *> putNormal refrep fops ctx l - *> putNormal refrep fops (pushCtx us ctx) e - TLets (Indirect w) us ccs l e -> - putTag LetIndT - *> putWord16be w - *> putCCs ccs - *> putNormal refrep fops ctx l - *> putNormal refrep fops (pushCtx us ctx) e - _ -> exn "putNormal: malformed term" - -getNormal :: (MonadGet m) => (Var v) => [v] -> Word64 -> m (ANormal v) -getNormal ctx frsh0 = - getTag >>= \case - VarT -> TVar <$> getVar ctx - ForceT -> TFrc <$> getVar ctx - AppT -> TApp <$> getFunc ctx <*> getArgs ctx - HandleT -> THnd <$> getRefs <*> getVar ctx <*> getNormal ctx frsh0 - ShiftT -> - flip TShift v <$> getReference <*> getNormal (v : ctx) (frsh0 + 1) - where - v = getFresh frsh0 - MatchT -> TMatch <$> getVar ctx <*> getBranches ctx frsh0 - LitT -> TLit <$> getLit - BxLitT -> TBLit <$> getLit - NameRefT -> - TName v . Left - <$> getReference - <*> getArgs ctx - <*> getNormal (v : ctx) (frsh0 + 1) - where - v = getFresh frsh0 - NameVarT -> - TName v . Right - <$> getVar ctx - <*> getArgs ctx - <*> getNormal (v : ctx) (frsh0 + 1) - where - v = getFresh frsh0 - LetDirT -> do - ccs <- getCCs - let l = length ccs - frsh = frsh0 + fromIntegral l - us = getFresh <$> take l [frsh0 ..] - TLets Direct us ccs - <$> getNormal ctx frsh0 - <*> getNormal (pushCtx us ctx) frsh - LetIndT -> do - w <- getWord16be - ccs <- getCCs - let l = length ccs - frsh = frsh0 + fromIntegral l - us = getFresh <$> take l [frsh0 ..] - TLets (Indirect w) us ccs - <$> getNormal ctx frsh0 - <*> getNormal (pushCtx us ctx) frsh - -putFunc :: - (MonadPut m) => - (Var v) => - Map Reference Word64 -> - EC.EnumMap FOp Text -> - [v] -> - Func v -> - m () -putFunc refrep fops ctx f = case f of - FVar v -> putTag FVarT *> putVar ctx v - FComb r - | Just w <- Map.lookup r refrep -> putTag FCombT *> putWord64be w - | otherwise -> putTag FCombT *> putReference r - FCont v -> putTag FContT *> putVar ctx v - FCon r c -> putTag FConT *> putReference r *> putCTag c - FReq r c -> putTag FReqT *> putReference r *> putCTag c - FPrim (Left p) -> putTag FPrimT *> putPOp p - FPrim (Right f) - | Just nm <- EC.lookup f fops -> - putTag FForeignT *> putText nm - | otherwise -> - exn $ "putFunc: could not serialize foreign operation: " ++ show f - -getFunc :: (MonadGet m) => (Var v) => [v] -> m (Func v) -getFunc ctx = - getTag >>= \case - FVarT -> FVar <$> getVar ctx - FCombT -> FComb <$> getReference - FContT -> FCont <$> getVar ctx - FConT -> FCon <$> getReference <*> getCTag - FReqT -> FReq <$> getReference <*> getCTag - FPrimT -> FPrim . Left <$> getPOp - FForeignT -> exn "getFunc: can't deserialize a foreign func" - -putPOp :: (MonadPut m) => POp -> m () -putPOp op - | Just w <- Map.lookup op pop2word = putWord16be w - | otherwise = exn $ "putPOp: unknown POp: " ++ show op - -getPOp :: (MonadGet m) => m POp -getPOp = - getWord16be >>= \w -> case Map.lookup w word2pop of - Just op -> pure op - Nothing -> exn "getPOp: unknown enum code" - -pOpCode :: POp -> Word16 -pOpCode op = case op of - ADDI -> 0 - SUBI -> 1 - MULI -> 2 - DIVI -> 3 - SGNI -> 4 - NEGI -> 5 - MODI -> 6 - POWI -> 7 - SHLI -> 8 - SHRI -> 9 - INCI -> 10 - DECI -> 11 - LEQI -> 12 - EQLI -> 13 - ADDN -> 14 - SUBN -> 15 - MULN -> 16 - DIVN -> 17 - MODN -> 18 - TZRO -> 19 - LZRO -> 20 - POWN -> 21 - SHLN -> 22 - SHRN -> 23 - ANDN -> 24 - IORN -> 25 - XORN -> 26 - COMN -> 27 - INCN -> 28 - DECN -> 29 - LEQN -> 30 - EQLN -> 31 - ADDF -> 32 - SUBF -> 33 - MULF -> 34 - DIVF -> 35 - MINF -> 36 - MAXF -> 37 - LEQF -> 38 - EQLF -> 39 - POWF -> 40 - EXPF -> 41 - SQRT -> 42 - LOGF -> 43 - LOGB -> 44 - ABSF -> 45 - CEIL -> 46 - FLOR -> 47 - TRNF -> 48 - RNDF -> 49 - COSF -> 50 - ACOS -> 51 - COSH -> 52 - ACSH -> 53 - SINF -> 54 - ASIN -> 55 - SINH -> 56 - ASNH -> 57 - TANF -> 58 - ATAN -> 59 - TANH -> 60 - ATNH -> 61 - ATN2 -> 62 - CATT -> 63 - TAKT -> 64 - DRPT -> 65 - SIZT -> 66 - UCNS -> 67 - USNC -> 68 - EQLT -> 69 - LEQT -> 70 - PAKT -> 71 - UPKT -> 72 - CATS -> 73 - TAKS -> 74 - DRPS -> 75 - SIZS -> 76 - CONS -> 77 - SNOC -> 78 - IDXS -> 79 - BLDS -> 80 - VWLS -> 81 - VWRS -> 82 - SPLL -> 83 - SPLR -> 84 - PAKB -> 85 - UPKB -> 86 - TAKB -> 87 - DRPB -> 88 - IDXB -> 89 - SIZB -> 90 - FLTB -> 91 - CATB -> 92 - ITOF -> 93 - NTOF -> 94 - ITOT -> 95 - NTOT -> 96 - TTOI -> 97 - TTON -> 98 - TTOF -> 99 - FTOT -> 100 - FORK -> 101 - EQLU -> 102 - CMPU -> 103 - EROR -> 104 - PRNT -> 105 - INFO -> 106 - POPC -> 107 - MISS -> 108 - CACH -> 109 - LKUP -> 110 - LOAD -> 111 - CVLD -> 112 - SDBX -> 113 - VALU -> 114 - TLTT -> 115 - TRCE -> 116 - ATOM -> 117 - TFRC -> 118 - DBTX -> 119 - IXOT -> 120 - IXOB -> 121 - SDBL -> 122 - SDBV -> 123 - -pOpAssoc :: [(POp, Word16)] -pOpAssoc = map (\op -> (op, pOpCode op)) [minBound .. maxBound] - -pop2word :: Map POp Word16 -pop2word = fromList pOpAssoc - -word2pop :: Map Word16 POp -word2pop = fromList $ swap <$> pOpAssoc - where - swap (x, y) = (y, x) - -putLit :: (MonadPut m) => Lit -> m () -putLit (I i) = putTag IT *> putInt i -putLit (N n) = putTag NT *> putNat n -putLit (F f) = putTag FT *> putFloat f -putLit (T t) = putTag TT *> putText (Util.Text.toText t) -putLit (C c) = putTag CT *> putChar c -putLit (LM r) = putTag LMT *> putReferent r -putLit (LY r) = putTag LYT *> putReference r - -getLit :: (MonadGet m) => m Lit -getLit = - getTag >>= \case - IT -> I <$> getInt - NT -> N <$> getNat - FT -> F <$> getFloat - TT -> T . Util.Text.fromText <$> getText - CT -> C <$> getChar - LMT -> LM <$> getReferent - LYT -> LY <$> getReference - -putBLit :: (MonadPut m) => BLit -> m () -putBLit (Text t) = putTag TextT *> putText (Util.Text.toText t) -putBLit (List s) = putTag ListT *> putFoldable putValue s -putBLit (TmLink r) = putTag TmLinkT *> putReferent r -putBLit (TyLink r) = putTag TyLinkT *> putReference r -putBLit (Bytes b) = putTag BytesT *> putBytes b -putBLit (Quote v) = putTag QuoteT *> putValue v -putBLit (Code g) = putTag CodeT *> putGroup mempty mempty g -putBLit (BArr a) = putTag BArrT *> putByteArray a -putBLit (Pos n) = putTag PosT *> putPositive n -putBLit (Neg n) = putTag NegT *> putPositive n -putBLit (Char c) = putTag CharT *> putChar c -putBLit (Float d) = putTag FloatT *> putFloat d -putBLit (Arr a) = putTag ArrT *> putFoldable putValue a - -getBLit :: (MonadGet m) => Version -> m BLit -getBLit v = - getTag >>= \case - TextT -> Text . Util.Text.fromText <$> getText - ListT -> List . Seq.fromList <$> getList (getValue v) - TmLinkT -> TmLink <$> getReferent - TyLinkT -> TyLink <$> getReference - BytesT -> Bytes <$> getBytes - QuoteT -> Quote <$> getValue v - CodeT -> Code <$> getGroup - BArrT -> BArr <$> getByteArray - PosT -> Pos <$> getPositive - NegT -> Neg <$> getPositive - CharT -> Char <$> getChar - FloatT -> Float <$> getFloat - ArrT -> Arr . GHC.IsList.fromList <$> getList (getValue v) - -putRefs :: (MonadPut m) => [Reference] -> m () -putRefs rs = putFoldable putReference rs - -getRefs :: (MonadGet m) => m [Reference] -getRefs = getList getReference - -putBranches :: - (MonadPut m) => - (Var v) => - Map Reference Word64 -> - EC.EnumMap FOp Text -> - [v] -> - Branched (ANormal v) -> - m () -putBranches refrep fops ctx bs = case bs of - MatchEmpty -> putTag MEmptyT - MatchIntegral m df -> do - putTag MIntT - putEnumMap putWord64be (putNormal refrep fops ctx) m - putMaybe df $ putNormal refrep fops ctx - MatchText m df -> do - putTag MTextT - putMap (putText . Util.Text.toText) (putNormal refrep fops ctx) m - putMaybe df $ putNormal refrep fops ctx - MatchRequest m (TAbs v df) -> do - putTag MReqT - putMap putReference (putEnumMap putCTag (putCase refrep fops ctx)) m - putNormal refrep fops (v : ctx) df - MatchData r m df -> do - putTag MDataT - putReference r - putEnumMap putCTag (putCase refrep fops ctx) m - putMaybe df $ putNormal refrep fops ctx - MatchSum m -> do - putTag MSumT - putEnumMap putWord64be (putCase refrep fops ctx) m - MatchNumeric r m df -> do - putTag MNumT - putReference r - putEnumMap putWord64be (putNormal refrep fops ctx) m - putMaybe df $ putNormal refrep fops ctx - _ -> exn "putBranches: malformed intermediate term" - -getBranches :: - (MonadGet m) => (Var v) => [v] -> Word64 -> m (Branched (ANormal v)) -getBranches ctx frsh0 = - getTag >>= \case - MEmptyT -> pure MatchEmpty - MIntT -> - MatchIntegral - <$> getEnumMap getWord64be (getNormal ctx frsh0) - <*> getMaybe (getNormal ctx frsh0) - MTextT -> - MatchText - <$> getMap (Util.Text.fromText <$> getText) (getNormal ctx frsh0) - <*> getMaybe (getNormal ctx frsh0) - MReqT -> - MatchRequest - <$> getMap getReference (getEnumMap getCTag (getCase ctx frsh0)) - <*> (TAbs v <$> getNormal (v : ctx) (frsh0 + 1)) - where - v = getFresh frsh0 - MDataT -> - MatchData - <$> getReference - <*> getEnumMap getCTag (getCase ctx frsh0) - <*> getMaybe (getNormal ctx frsh0) - MSumT -> MatchSum <$> getEnumMap getWord64be (getCase ctx frsh0) - MNumT -> - MatchNumeric - <$> getReference - <*> getEnumMap getWord64be (getNormal ctx frsh0) - <*> getMaybe (getNormal ctx frsh0) - -putCase :: - (MonadPut m) => - (Var v) => - Map Reference Word64 -> - EC.EnumMap FOp Text -> - [v] -> - ([Mem], ANormal v) -> - m () -putCase refrep fops ctx (ccs, (TAbss us e)) = - putCCs ccs *> putNormal refrep fops (pushCtx us ctx) e - -getCase :: (MonadGet m) => (Var v) => [v] -> Word64 -> m ([Mem], ANormal v) -getCase ctx frsh0 = do - ccs <- getCCs - let l = length ccs - frsh = frsh0 + fromIntegral l - us = getFresh <$> take l [frsh0 ..] - (,) ccs . TAbss us <$> getNormal (pushCtx us ctx) frsh - -putCTag :: (MonadPut m) => CTag -> m () -putCTag c = serialize (VarInt $ fromEnum c) - -getCTag :: (MonadGet m) => m CTag -getCTag = toEnum . unVarInt <$> deserialize - -putGroupRef :: (MonadPut m) => GroupRef -> m () -putGroupRef (GR r i) = - putReference r *> putWord64be i - -getGroupRef :: (MonadGet m) => m GroupRef -getGroupRef = GR <$> getReference <*> getWord64be - --- Notes --- --- Starting with version 4 of the value format, it is expected that --- unboxed data does not actually occur in the values being sent. For --- most values this was not a problem: --- --- - Partial applications had no way of directly including unboxed --- values, because they all result from surface level unison --- applications --- - Unboxed values in Data only occurred to represent certain --- builtin types. Those have been replaced by BLits. --- --- However, some work was required to make sure no unboxed data ended --- up in Cont. The runtime has been modified to avoid using the --- unboxed stack in generated code, so now only builtins use it, --- effectively. Since continuations are never captured inside builtins --- (and even if we wanted to do that, we could arrange for a clean --- unboxed stack), this is no longer a problem, either. --- --- So, unboxed data is completely absent from the format. We are now --- exchanging unison surface values, effectively. -putValue :: (MonadPut m) => Value -> m () -putValue (Partial gr [] vs) = - putTag PartialT - *> putGroupRef gr - *> putFoldable putValue vs -putValue Partial {} = - exn "putValue: Partial with unboxed values no longer supported" -putValue (Data r t [] vs) = - putTag DataT - *> putReference r - *> putWord64be t - *> putFoldable putValue vs -putValue Data {} = - exn "putValue: Data with unboxed contents no longer supported" -putValue (Cont [] bs k) = - putTag ContT - *> putFoldable putValue bs - *> putCont k -putValue Cont {} = - exn "putValue: Cont with unboxed stack no longer supported" -putValue (BLit l) = - putTag BLitT *> putBLit l - -getValue :: (MonadGet m) => Version -> m Value -getValue v = - getTag >>= \case - PartialT - | v < 4 -> - Partial <$> getGroupRef <*> getList getWord64be <*> getList (getValue v) - | otherwise -> - flip Partial [] <$> getGroupRef <*> getList (getValue v) - DataT - | v < 4 -> - Data - <$> getReference - <*> getWord64be - <*> getList getWord64be - <*> getList (getValue v) - | otherwise -> - (\r t -> Data r t []) - <$> getReference - <*> getWord64be - <*> getList (getValue v) - ContT - | v < 4 -> - Cont <$> getList getWord64be <*> getList (getValue v) <*> getCont v - | otherwise -> Cont [] <$> getList (getValue v) <*> getCont v - BLitT -> BLit <$> getBLit v - -putCont :: (MonadPut m) => Cont -> m () -putCont KE = putTag KET -putCont (Mark 0 ba rs ds k) = - putTag MarkT - *> putWord64be ba - *> putFoldable putReference rs - *> putMap putReference putValue ds - *> putCont k -putCont Mark {} = - exn "putCont: Mark with unboxed args no longer supported" -putCont (Push 0 j 0 n gr k) = - putTag PushT - *> putWord64be j - *> putWord64be n - *> putGroupRef gr - *> putCont k -putCont Push {} = - exn "putCont: Push with unboxed information no longer supported" - -getCont :: (MonadGet m) => Version -> m Cont -getCont v = - getTag >>= \case - KET -> pure KE - MarkT - | v < 4 -> - Mark - <$> getWord64be - <*> getWord64be - <*> getList getReference - <*> getMap getReference (getValue v) - <*> getCont v - | otherwise -> - Mark 0 - <$> getWord64be - <*> getList getReference - <*> getMap getReference (getValue v) - <*> getCont v - PushT - | v < 4 -> - Push - <$> getWord64be - <*> getWord64be - <*> getWord64be - <*> getWord64be - <*> getGroupRef - <*> getCont v - | otherwise -> - (\j n -> Push 0 j 0 n) - <$> getWord64be - <*> getWord64be - <*> getGroupRef - <*> getCont v - -deserializeGroup :: (Var v) => ByteString -> Either String (SuperGroup v) -deserializeGroup bs = runGetS (getVersion *> getGroup) bs - where - getVersion = - getWord32be >>= \case - 1 -> pure () - 2 -> pure () - n -> fail $ "deserializeGroup: unknown version: " ++ show n - -serializeGroup :: - (Var v) => EC.EnumMap FOp Text -> SuperGroup v -> ByteString -serializeGroup fops sg = runPutS (putVersion *> putGroup mempty fops sg) - where - putVersion = putWord32be codeVersion - --- | Serializes a `SuperGroup` for rehashing. --- --- Expected as arguments are some code, and the `Reference` that --- refers to it. In particular, if the code refers to itself by --- reference, or if the code is part of a mututally-recursive set of --- definitions (which have a common hash), the reference used as part --- of that (mutual) recursion must be supplied. --- --- Using that reference, we find all references in the code to that --- connected component. In the resulting byte string, those references --- are instead replaced by positions in a listing of the connected --- component. This means that the byte string is independent of the --- hash used for the self reference. Only the order matters (which is --- determined by the `Reference`). Then the bytes can be re-hashed to --- establish a new hash for the connected component. This operation --- should be idempotent as long as the indexing is preserved. --- --- Supplying a `Builtin` reference is not supported. Such code --- shouldn't be subject to rehashing. -serializeGroupForRehash :: - (Var v) => - EC.EnumMap FOp Text -> - Reference -> - SuperGroup v -> - L.ByteString -serializeGroupForRehash _ (Builtin _) _ = - error "serializeForRehash: builtin reference" -serializeGroupForRehash fops (Derived h _) sg = - runPutLazy $ putGroup refrep fops sg - where - f r@(Derived h' i) | h == h' = Just (r, i) - f _ = Nothing - refrep = Map.fromList . mapMaybe f $ groupTermLinks sg - -getVersionedValue :: (MonadGet m) => m Value -getVersionedValue = getVersion >>= getValue - where - getVersion = - getWord32be >>= \case - n - | n < 1 -> fail $ "deserializeValue: unknown version: " ++ show n - | n < 3 -> fail $ "deserializeValue: unsupported version: " ++ show n - | 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 - putVersion = putWord32be valueVersion - -serializeValueLazy :: Value -> L.ByteString -serializeValueLazy v = runPutLazy (putVersion *> putValue v) - where - putVersion = putWord32be valueVersion - -valueVersion :: Word32 -valueVersion = 4 - -codeVersion :: Word32 -codeVersion = 2 diff --git a/parser-typechecker/src/Unison/Runtime/Array.hs b/parser-typechecker/src/Unison/Runtime/Array.hs deleted file mode 100644 index 1b6d34fdc2..0000000000 --- a/parser-typechecker/src/Unison/Runtime/Array.hs +++ /dev/null @@ -1,384 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE StandaloneKindSignatures #-} - --- This module wraps the operations in the primitive package so that --- bounds checks can be toggled on during the build for debugging --- purposes. It exports the entire API for the three array types --- needed, and adds wrappers for the operations that are unchecked in --- the base library. --- --- Checking is toggled using the `arraychecks` flag. -module Unison.Runtime.Array - ( module EPA, - byteArrayToList, - readArray, - writeArray, - copyArray, - copyMutableArray, - cloneMutableArray, - readByteArray, - writeByteArray, - indexByteArray, - copyByteArray, - copyMutableByteArray, - moveByteArray, - readPrimArray, - writePrimArray, - indexPrimArray, - ) -where - -import Control.Monad.Primitive -import Data.Kind (Constraint) -import Data.Primitive.Array as EPA hiding - ( cloneMutableArray, - copyArray, - copyMutableArray, - readArray, - writeArray, - ) -import Data.Primitive.Array qualified as PA -import Data.Primitive.ByteArray as EPA hiding - ( copyByteArray, - copyMutableByteArray, - indexByteArray, - moveByteArray, - readByteArray, - writeByteArray, - ) -import Data.Primitive.ByteArray qualified as PA -import Data.Primitive.PrimArray as EPA hiding - ( indexPrimArray, - readPrimArray, - writePrimArray, - ) -import Data.Primitive.PrimArray qualified as PA -import Data.Primitive.Types -import Data.Word (Word8) -import GHC.IsList (toList) - -#ifdef ARRAY_CHECK -import GHC.Stack - -type CheckCtx :: Constraint -type CheckCtx = HasCallStack - -type MA = MutableArray -type MBA = MutableByteArray -type A = Array -type BA = ByteArray - --- check index mutable array -checkIMArray - :: CheckCtx - => String - -> (MA s a -> Int -> r) - -> MA s a -> Int -> r -checkIMArray name f arr i - | i < 0 || sizeofMutableArray arr <= i - = error $ name ++ " unsafe check out of bounds: " ++ show i - | otherwise = f arr i -{-# inline checkIMArray #-} - --- check copy array -checkCArray - :: CheckCtx - => String - -> (MA s a -> Int -> A a -> Int -> Int -> r) - -> MA s a -> Int -> A a -> Int -> Int -> r -checkCArray name f dst d src s l - | d < 0 - || s < 0 - || sizeofMutableArray dst < d + l - || sizeofArray src < s + l - = error $ name ++ " unsafe check out of bounds: " ++ show (d, s, l) - | otherwise = f dst d src s l -{-# inline checkCArray #-} - --- check copy mutable array -checkCMArray - :: CheckCtx - => String - -> (MA s a -> Int -> MA s a -> Int -> Int -> r) - -> MA s a -> Int -> MA s a -> Int -> Int -> r -checkCMArray name f dst d src s l - | d < 0 - || s < 0 - || sizeofMutableArray dst < d + l - || sizeofMutableArray src < s + l - = error $ name ++ " unsafe check out of bounds: " ++ show (d, s, l) - | otherwise = f dst d src s l -{-# inline checkCMArray #-} - --- check range mutable array -checkRMArray - :: CheckCtx - => String - -> (MA s a -> Int -> Int -> r) - -> MA s a -> Int -> Int -> r -checkRMArray name f arr o l - | o < 0 || sizeofMutableArray arr < o+l - = error $ name ++ "unsafe check out of bounds: " ++ show (o, l) - | otherwise = f arr o l -{-# inline checkRMArray #-} - --- check index byte array -checkIBArray - :: CheckCtx - => Prim a - => String - -> a - -> (ByteArray -> Int -> r) - -> ByteArray -> Int -> r -checkIBArray name a f arr i - | i < 0 || sizeofByteArray arr `quot` sizeOf a <= i - = error $ name ++ " unsafe check out of bounds: " ++ show i - | otherwise = f arr i -{-# inline checkIBArray #-} - --- check index mutable byte array -checkIMBArray - :: CheckCtx - => Prim a - => String - -> a - -> (MutableByteArray s -> Int -> r) - -> MutableByteArray s -> Int -> r -checkIMBArray name a f arr i - | i < 0 || sizeofMutableByteArray arr `quot` sizeOf a <= i - = error $ name ++ " unsafe check out of bounds: " ++ show i - | otherwise = f arr i -{-# inline checkIMBArray #-} - --- check copy byte array -checkCBArray - :: CheckCtx - => String - -> (MBA s -> Int -> BA -> Int -> Int -> r) - -> MBA s -> Int -> BA -> Int -> Int -> r -checkCBArray name f dst d src s l - | d < 0 - || s < 0 - || sizeofMutableByteArray dst < d + l - || sizeofByteArray src < s + l - = error $ name ++ " unsafe check out of bounds: " ++ show (d, s, l) - | otherwise = f dst d src s l -{-# inline checkCBArray #-} - --- check copy mutable byte array -checkCMBArray - :: CheckCtx - => String - -> (MBA s -> Int -> MBA s -> Int -> Int -> r) - -> MBA s -> Int -> MBA s -> Int -> Int -> r -checkCMBArray name f dst d src s l - | d < 0 - || s < 0 - || sizeofMutableByteArray dst < d + l - || sizeofMutableByteArray src < s + l - = error $ name ++ " unsafe check out of bounds: " ++ show (d, s, l) - | otherwise = f dst d src s l -{-# inline checkCMBArray #-} - --- check index prim array -checkIPArray - :: CheckCtx - => Prim a - => String - -> (PrimArray a -> Int -> r) - -> PrimArray a -> Int -> r -checkIPArray name f arr i - | i < 0 || sizeofPrimArray arr <= i - = error $ name ++ " unsafe check out of bounds: " ++ show i - | otherwise = f arr i -{-# inline checkIPArray #-} - --- check index mutable prim array -checkIMPArray - :: CheckCtx - => Prim a - => String - -> (MutablePrimArray s a -> Int -> r) - -> MutablePrimArray s a -> Int -> r -checkIMPArray name f arr i - | i < 0 || sizeofMutablePrimArray arr <= i - = error $ name ++ " unsafe check out of bounds: " ++ show i - | otherwise = f arr i -{-# inline checkIMPArray #-} - -#else -type CheckCtx :: Constraint -type CheckCtx = () - -checkIMArray, checkIMPArray, checkIPArray :: String -> r -> r -checkCArray, checkCMArray, checkRMArray :: String -> r -> r -checkIMArray _ = id -checkIMPArray _ = id -checkCArray _ = id -checkCMArray _ = id -checkRMArray _ = id -checkIPArray _ = id - -checkIBArray, checkIMBArray :: String -> a -> r -> r -checkCBArray, checkCMBArray :: String -> r -> r -checkIBArray _ _ = id -checkIMBArray _ _ = id -checkCBArray _ = id -checkCMBArray _ = id -#endif - -readArray :: - (CheckCtx) => - (PrimMonad m) => - MutableArray (PrimState m) a -> - Int -> - m a -readArray = checkIMArray "readArray" PA.readArray -{-# INLINE readArray #-} - -writeArray :: - (CheckCtx) => - (PrimMonad m) => - MutableArray (PrimState m) a -> - Int -> - a -> - m () -writeArray = checkIMArray "writeArray" PA.writeArray -{-# INLINE writeArray #-} - -copyArray :: - (CheckCtx) => - (PrimMonad m) => - MutableArray (PrimState m) a -> - Int -> - Array a -> - Int -> - Int -> - m () -copyArray = checkCArray "copyArray" PA.copyArray -{-# INLINE copyArray #-} - -cloneMutableArray :: - (CheckCtx) => - (PrimMonad m) => - MutableArray (PrimState m) a -> - Int -> - Int -> - m (MutableArray (PrimState m) a) -cloneMutableArray = checkRMArray "cloneMutableArray" PA.cloneMutableArray -{-# INLINE cloneMutableArray #-} - -copyMutableArray :: - (CheckCtx) => - (PrimMonad m) => - MutableArray (PrimState m) a -> - Int -> - MutableArray (PrimState m) a -> - Int -> - Int -> - m () -copyMutableArray = checkCMArray "copyMutableArray" PA.copyMutableArray -{-# INLINE copyMutableArray #-} - -readByteArray :: - forall a m. - (CheckCtx) => - (PrimMonad m) => - (Prim a) => - MutableByteArray (PrimState m) -> - Int -> - m a -readByteArray = checkIMBArray @a "readByteArray" undefined PA.readByteArray -{-# INLINE readByteArray #-} - -writeByteArray :: - forall a m. - (CheckCtx) => - (PrimMonad m) => - (Prim a) => - MutableByteArray (PrimState m) -> - Int -> - a -> - m () -writeByteArray = checkIMBArray @a "writeByteArray" undefined PA.writeByteArray -{-# INLINE writeByteArray #-} - -indexByteArray :: - forall a. - (CheckCtx) => - (Prim a) => - ByteArray -> - Int -> - a -indexByteArray = checkIBArray @a "indexByteArray" undefined PA.indexByteArray -{-# INLINE indexByteArray #-} - -copyByteArray :: - (CheckCtx) => - (PrimMonad m) => - MutableByteArray (PrimState m) -> - Int -> - ByteArray -> - Int -> - Int -> - m () -copyByteArray = checkCBArray "copyByteArray" PA.copyByteArray -{-# INLINE copyByteArray #-} - -copyMutableByteArray :: - (CheckCtx) => - (PrimMonad m) => - MutableByteArray (PrimState m) -> - Int -> - MutableByteArray (PrimState m) -> - Int -> - Int -> - m () -copyMutableByteArray = checkCMBArray "copyMutableByteArray" PA.copyMutableByteArray -{-# INLINE copyMutableByteArray #-} - -moveByteArray :: - (CheckCtx) => - (PrimMonad m) => - MutableByteArray (PrimState m) -> - Int -> - MutableByteArray (PrimState m) -> - Int -> - Int -> - m () -moveByteArray = checkCMBArray "moveByteArray" PA.moveByteArray -{-# INLINE moveByteArray #-} - -readPrimArray :: - (CheckCtx) => - (PrimMonad m) => - (Prim a) => - MutablePrimArray (PrimState m) a -> - Int -> - m a -readPrimArray = checkIMPArray "readPrimArray" PA.readPrimArray -{-# INLINE readPrimArray #-} - -writePrimArray :: - (CheckCtx) => - (PrimMonad m) => - (Prim a) => - MutablePrimArray (PrimState m) a -> - Int -> - a -> - m () -writePrimArray = checkIMPArray "writePrimArray" PA.writePrimArray -{-# INLINE writePrimArray #-} - -indexPrimArray :: - (CheckCtx) => - (Prim a) => - PrimArray a -> - Int -> - a -indexPrimArray = checkIPArray "indexPrimArray" PA.indexPrimArray -{-# INLINE indexPrimArray #-} - -byteArrayToList :: ByteArray -> [Word8] -byteArrayToList = toList diff --git a/parser-typechecker/src/Unison/Runtime/Builtin.hs b/parser-typechecker/src/Unison/Runtime/Builtin.hs deleted file mode 100644 index f9c827fda9..0000000000 --- a/parser-typechecker/src/Unison/Runtime/Builtin.hs +++ /dev/null @@ -1,3679 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -module Unison.Runtime.Builtin - ( builtinLookup, - builtinTermNumbering, - builtinTypeNumbering, - builtinTermBackref, - builtinTypeBackref, - builtinForeigns, - sandboxedForeigns, - numberedTermLookup, - Sandbox (..), - baseSandboxInfo, - ) -where - -import Control.Concurrent (ThreadId) -import Control.Concurrent as SYS - ( killThread, - threadDelay, - ) -import Control.Concurrent.MVar as SYS -import Control.Concurrent.STM qualified as STM -import Control.DeepSeq (NFData) -import Control.Exception (evaluate) -import Control.Exception.Safe qualified as Exception -import Control.Monad.Catch (MonadCatch) -import Control.Monad.Primitive qualified as PA -import Control.Monad.Reader (ReaderT (..), ask, runReaderT) -import Control.Monad.State.Strict (State, execState, modify) -import Crypto.Error (CryptoError (..), CryptoFailable (..)) -import Crypto.Hash qualified as Hash -import Crypto.MAC.HMAC qualified as HMAC -import Crypto.PubKey.Ed25519 qualified as Ed25519 -import Crypto.PubKey.RSA.PKCS15 qualified as RSA -import Crypto.Random (getRandomBytes) -import Data.Bits (shiftL, shiftR, (.|.)) -import Data.ByteArray qualified as BA -import Data.ByteString (hGet, hGetSome, hPut) -import Data.ByteString.Lazy qualified as L -import Data.Default (def) -import Data.Digest.Murmur64 (asWord64, hash64) -import Data.IORef as SYS - ( IORef, - newIORef, - readIORef, - writeIORef, - ) -import Data.IP (IP) -import Data.Map qualified as Map -import Data.PEM (PEM, pemContent, pemParseLBS) -import Data.Set (insert) -import Data.Set qualified as Set -import Data.Text qualified -import Data.Text.IO qualified as Text.IO -import Data.Time.Clock.POSIX as SYS - ( getPOSIXTime, - posixSecondsToUTCTime, - utcTimeToPOSIXSeconds, - ) -import Data.Time.LocalTime (TimeZone (..), getTimeZone) -import Data.X509 qualified as X -import Data.X509.CertificateStore qualified as X -import Data.X509.Memory qualified as X -import GHC.Conc qualified as STM -import GHC.IO (IO (IO)) -import Network.Simple.TCP as SYS - ( HostPreference (..), - bindSock, - closeSock, - connectSock, - listenSock, - recv, - send, - ) -import Network.Socket as SYS - ( PortNumber, - Socket, - accept, - socketPort, - ) -import Network.TLS as TLS -import Network.TLS.Extra.Cipher as Cipher -import Network.UDP as UDP - ( ClientSockAddr, - ListenSocket, - UDPSocket (..), - clientSocket, - close, - recv, - recvFrom, - send, - sendTo, - serverSocket, - stop, - ) -import System.Clock (Clock (..), getTime, nsec, sec) -import System.Directory as SYS - ( createDirectoryIfMissing, - doesDirectoryExist, - doesPathExist, - getCurrentDirectory, - getDirectoryContents, - getFileSize, - getModificationTime, - getTemporaryDirectory, - removeDirectoryRecursive, - removeFile, - renameDirectory, - renameFile, - setCurrentDirectory, - ) -import System.Environment as SYS - ( getArgs, - getEnv, - ) -import System.Exit as SYS (ExitCode (..)) -import System.FilePath (isPathSeparator) -import System.IO (Handle) -import System.IO as SYS - ( IOMode (..), - hClose, - hGetBuffering, - hGetChar, - hGetEcho, - hIsEOF, - hIsOpen, - hIsSeekable, - hReady, - hSeek, - hSetBuffering, - hSetEcho, - hTell, - openFile, - stderr, - stdin, - stdout, - ) -import System.IO.Temp (createTempDirectory) -import System.Process as SYS - ( getProcessExitCode, - proc, - runInteractiveProcess, - terminateProcess, - waitForProcess, - withCreateProcess, - ) -import System.X509 qualified as X -import Unison.ABT.Normalized hiding (TTm) -import Unison.Builtin qualified as Ty (builtinTypes) -import Unison.Builtin.Decls qualified as Ty -import Unison.Prelude hiding (Text, some) -import Unison.Reference -import Unison.Referent (Referent, pattern Ref) -import Unison.Runtime.ANF as ANF -import Unison.Runtime.ANF.Rehash (checkGroupHashes) -import Unison.Runtime.ANF.Serialize as ANF -import Unison.Runtime.Array qualified as PA -import Unison.Runtime.Crypto.Rsa as Rsa -import Unison.Runtime.Exception (die) -import Unison.Runtime.Foreign - ( Foreign (Wrap), - HashAlgorithm (..), - pattern Failure, - ) -import Unison.Runtime.Foreign qualified as F -import Unison.Runtime.Foreign.Function -import Unison.Runtime.Stack (Closure) -import Unison.Runtime.Stack qualified as Closure -import Unison.Symbol -import Unison.Type (charRef) -import Unison.Type qualified as Ty -import Unison.Util.Bytes qualified as Bytes -import Unison.Util.EnumContainers as EC -import Unison.Util.RefPromise - ( Promise, - Ticket, - casIORef, - newPromise, - peekTicket, - readForCAS, - readPromise, - tryReadPromise, - writePromise, - ) -import Unison.Util.Text (Text) -import Unison.Util.Text qualified as Util.Text -import Unison.Util.Text.Pattern qualified as TPat -import Unison.Var - -type Failure = F.Failure Closure - -freshes :: (Var v) => Int -> [v] -freshes = freshes' mempty - -freshes' :: (Var v) => Set v -> Int -> [v] -freshes' avoid0 = go avoid0 [] - where - go _ vs 0 = vs - go avoid vs n = - let v = freshIn avoid $ typed ANFBlank - in go (insert v avoid) (v : vs) (n - 1) - -class Fresh t where fresh :: t - -fresh1 :: (Var v) => v -fresh1 = head $ freshes 1 - -instance (Var v) => Fresh (v, v) where - fresh = (v1, v2) - where - [v1, v2] = freshes 2 - -instance (Var v) => Fresh (v, v, v) where - fresh = (v1, v2, v3) - where - [v1, v2, v3] = freshes 3 - -instance (Var v) => Fresh (v, v, v, v) where - fresh = (v1, v2, v3, v4) - where - [v1, v2, v3, v4] = freshes 4 - -instance (Var v) => Fresh (v, v, v, v, v) where - fresh = (v1, v2, v3, v4, v5) - where - [v1, v2, v3, v4, v5] = freshes 5 - -instance (Var v) => Fresh (v, v, v, v, v, v) where - fresh = (v1, v2, v3, v4, v5, v6) - where - [v1, v2, v3, v4, v5, v6] = freshes 6 - -instance (Var v) => Fresh (v, v, v, v, v, v, v) where - fresh = (v1, v2, v3, v4, v5, v6, v7) - where - [v1, v2, v3, v4, v5, v6, v7] = freshes 7 - -instance (Var v) => Fresh (v, v, v, v, v, v, v, v) where - fresh = (v1, v2, v3, v4, v5, v6, v7, v8) - where - [v1, v2, v3, v4, v5, v6, v7, v8] = freshes 8 - -instance (Var v) => Fresh (v, v, v, v, v, v, v, v, v) where - fresh = (v1, v2, v3, v4, v5, v6, v7, v8, v9) - where - [v1, v2, v3, v4, v5, v6, v7, v8, v9] = freshes 9 - -instance (Var v) => Fresh (v, v, v, v, v, v, v, v, v, v) where - fresh = (v1, v2, v3, v4, v5, v6, v7, v8, v9, v10) - where - [v1, v2, v3, v4, v5, v6, v7, v8, v9, v10] = freshes 10 - -instance (Var v) => Fresh (v, v, v, v, v, v, v, v, v, v, v) where - fresh = (v1, v2, v3, v4, v5, v6, v7, v8, v9, v10, v11) - where - [v1, v2, v3, v4, v5, v6, v7, v8, v9, v10, v11] = freshes 11 - -instance (Var v) => Fresh (v, v, v, v, v, v, v, v, v, v, v, v, v) where - fresh = (v1, v2, v3, v4, v5, v6, v7, v8, v9, v10, v11, v12, v13) - where - [v1, v2, v3, v4, v5, v6, v7, v8, v9, v10, v11, v12, v13] = freshes 13 - -instance (Var v) => Fresh (v, v, v, v, v, v, v, v, v, v, v, v, v, v) where - fresh = (v1, v2, v3, v4, v5, v6, v7, v8, v9, v10, v11, v12, v13, v14) - where - [v1, v2, v3, v4, v5, v6, v7, v8, v9, v10, v11, v12, v13, v14] = freshes 14 - -fls, tru :: (Var v) => ANormal v -fls = TCon Ty.booleanRef 0 [] -tru = TCon Ty.booleanRef 1 [] - -none :: (Var v) => ANormal v -none = TCon Ty.optionalRef (fromIntegral Ty.noneId) [] - -some, left, right :: (Var v) => v -> ANormal v -some a = TCon Ty.optionalRef (fromIntegral Ty.someId) [a] -left x = TCon Ty.eitherRef (fromIntegral Ty.eitherLeftId) [x] -right x = TCon Ty.eitherRef (fromIntegral Ty.eitherRightId) [x] - -seqViewEmpty :: (Var v) => ANormal v -seqViewEmpty = TCon Ty.seqViewRef (fromIntegral Ty.seqViewEmpty) [] - -seqViewElem :: (Var v) => v -> v -> ANormal v -seqViewElem l r = TCon Ty.seqViewRef (fromIntegral Ty.seqViewElem) [l, r] - -boolift :: (Var v) => v -> ANormal v -boolift v = - TMatch v $ MatchIntegral (mapFromList [(0, fls), (1, tru)]) Nothing - -notlift :: (Var v) => v -> ANormal v -notlift v = - TMatch v $ MatchIntegral (mapFromList [(1, fls), (0, tru)]) Nothing - -unbox :: (Var v) => v -> Reference -> v -> ANormal v -> ANormal v -unbox v0 r v b = - TMatch v0 $ - MatchData r (mapSingleton 0 $ ([UN], TAbs v b)) Nothing - -unenum :: (Var v) => Int -> v -> Reference -> v -> ANormal v -> ANormal v -unenum n v0 r v nx = - TMatch v0 $ MatchData r cases Nothing - where - mkCase i = (toEnum i, ([], TLetD v UN (TLit . I $ fromIntegral i) nx)) - cases = mapFromList . fmap mkCase $ [0 .. n - 1] - -unop0 :: (Var v) => Int -> ([v] -> ANormal v) -> SuperNormal v -unop0 n f = - Lambda [BX] - . TAbss [x0] - $ f xs - where - xs@(x0 : _) = freshes (1 + n) - -binop0 :: (Var v) => Int -> ([v] -> ANormal v) -> SuperNormal v -binop0 n f = - Lambda [BX, BX] - . TAbss [x0, y0] - $ f xs - where - xs@(x0 : y0 : _) = freshes (2 + n) - -unop :: (Var v) => POp -> Reference -> SuperNormal v -unop pop rf = unop' pop rf rf - -unop' :: (Var v) => POp -> Reference -> Reference -> SuperNormal v -unop' pop rfi rfo = - unop0 2 $ \[x0, x, r] -> - unbox x0 rfi x - . TLetD r UN (TPrm pop [x]) - $ TCon rfo 0 [r] - -binop :: (Var v) => POp -> Reference -> SuperNormal v -binop pop rf = binop' pop rf rf rf - -binop' :: - (Var v) => - POp -> - Reference -> - Reference -> - Reference -> - SuperNormal v -binop' pop rfx rfy rfr = - binop0 3 $ \[x0, y0, x, y, r] -> - unbox x0 rfx x - . unbox y0 rfy y - . TLetD r UN (TPrm pop [x, y]) - $ TCon rfr 0 [r] - -cmpop :: (Var v) => POp -> Reference -> SuperNormal v -cmpop pop rf = - binop0 3 $ \[x0, y0, x, y, b] -> - unbox x0 rf x - . unbox y0 rf y - . TLetD b UN (TPrm pop [x, y]) - $ boolift b - -cmpopb :: (Var v) => POp -> Reference -> SuperNormal v -cmpopb pop rf = - binop0 3 $ \[x0, y0, x, y, b] -> - unbox x0 rf x - . unbox y0 rf y - . TLetD b UN (TPrm pop [y, x]) - $ boolift b - -cmpopn :: (Var v) => POp -> Reference -> SuperNormal v -cmpopn pop rf = - binop0 3 $ \[x0, y0, x, y, b] -> - unbox x0 rf x - . unbox y0 rf y - . TLetD b UN (TPrm pop [x, y]) - $ notlift b - -cmpopbn :: (Var v) => POp -> Reference -> SuperNormal v -cmpopbn pop rf = - binop0 3 $ \[x0, y0, x, y, b] -> - unbox x0 rf x - . unbox y0 rf y - . TLetD b UN (TPrm pop [y, x]) - $ notlift b - -addi, subi, muli, divi, modi, shli, shri, powi :: (Var v) => SuperNormal v -addi = binop ADDI Ty.intRef -subi = binop SUBI Ty.intRef -muli = binop MULI Ty.intRef -divi = binop DIVI Ty.intRef -modi = binop MODI Ty.intRef -shli = binop' SHLI Ty.intRef Ty.natRef Ty.intRef -shri = binop' SHRI Ty.intRef Ty.natRef Ty.intRef -powi = binop' POWI Ty.intRef Ty.natRef Ty.intRef - -addn, subn, muln, divn, modn, shln, shrn, pown :: (Var v) => SuperNormal v -addn = binop ADDN Ty.natRef -subn = binop' SUBN Ty.natRef Ty.natRef Ty.intRef -muln = binop MULN Ty.natRef -divn = binop DIVN Ty.natRef -modn = binop MODN Ty.natRef -shln = binop SHLN Ty.natRef -shrn = binop SHRN Ty.natRef -pown = binop POWN Ty.natRef - -eqi, eqn, lti, ltn, lei, len :: (Var v) => SuperNormal v -eqi = cmpop EQLI Ty.intRef -lti = cmpopbn LEQI Ty.intRef -lei = cmpop LEQI Ty.intRef -eqn = cmpop EQLN Ty.natRef -ltn = cmpopbn LEQN Ty.natRef -len = cmpop LEQN Ty.natRef - -gti, gtn, gei, gen :: (Var v) => SuperNormal v -gti = cmpopn LEQI Ty.intRef -gei = cmpopb LEQI Ty.intRef -gtn = cmpopn LEQN Ty.intRef -gen = cmpopb LEQN Ty.intRef - -inci, incn :: (Var v) => SuperNormal v -inci = unop INCI Ty.intRef -incn = unop INCN Ty.natRef - -sgni, negi :: (Var v) => SuperNormal v -sgni = unop SGNI Ty.intRef -negi = unop NEGI Ty.intRef - -lzeron, tzeron, lzeroi, tzeroi, popn, popi :: (Var v) => SuperNormal v -lzeron = unop LZRO Ty.natRef -tzeron = unop TZRO Ty.natRef -popn = unop POPC Ty.natRef -popi = unop' POPC Ty.intRef Ty.natRef -lzeroi = unop' LZRO Ty.intRef Ty.natRef -tzeroi = unop' TZRO Ty.intRef Ty.natRef - -andn, orn, xorn, compln, andi, ori, xori, compli :: (Var v) => SuperNormal v -andn = binop ANDN Ty.natRef -orn = binop IORN Ty.natRef -xorn = binop XORN Ty.natRef -compln = unop COMN Ty.natRef -andi = binop ANDN Ty.intRef -ori = binop IORN Ty.intRef -xori = binop XORN Ty.intRef -compli = unop COMN Ty.intRef - -addf, - subf, - mulf, - divf, - powf, - sqrtf, - logf, - logbf :: - (Var v) => SuperNormal v -addf = binop ADDF Ty.floatRef -subf = binop SUBF Ty.floatRef -mulf = binop MULF Ty.floatRef -divf = binop DIVF Ty.floatRef -powf = binop POWF Ty.floatRef -sqrtf = unop SQRT Ty.floatRef -logf = unop LOGF Ty.floatRef -logbf = binop LOGB Ty.floatRef - -expf, absf :: (Var v) => SuperNormal v -expf = unop EXPF Ty.floatRef -absf = unop ABSF Ty.floatRef - -cosf, sinf, tanf, acosf, asinf, atanf :: (Var v) => SuperNormal v -cosf = unop COSF Ty.floatRef -sinf = unop SINF Ty.floatRef -tanf = unop TANF Ty.floatRef -acosf = unop ACOS Ty.floatRef -asinf = unop ASIN Ty.floatRef -atanf = unop ATAN Ty.floatRef - -coshf, - sinhf, - tanhf, - acoshf, - asinhf, - atanhf, - atan2f :: - (Var v) => SuperNormal v -coshf = unop COSH Ty.floatRef -sinhf = unop SINH Ty.floatRef -tanhf = unop TANH Ty.floatRef -acoshf = unop ACSH Ty.floatRef -asinhf = unop ASNH Ty.floatRef -atanhf = unop ATNH Ty.floatRef -atan2f = binop ATN2 Ty.floatRef - -ltf, gtf, lef, gef, eqf, neqf :: (Var v) => SuperNormal v -ltf = cmpopbn LEQF Ty.floatRef -gtf = cmpopn LEQF Ty.floatRef -lef = cmpop LEQF Ty.floatRef -gef = cmpopb LEQF Ty.floatRef -eqf = cmpop EQLF Ty.floatRef -neqf = cmpopn EQLF Ty.floatRef - -minf, maxf :: (Var v) => SuperNormal v -minf = binop MINF Ty.floatRef -maxf = binop MAXF Ty.floatRef - -ceilf, floorf, truncf, roundf, i2f, n2f :: (Var v) => SuperNormal v -ceilf = unop' CEIL Ty.floatRef Ty.intRef -floorf = unop' FLOR Ty.floatRef Ty.intRef -truncf = unop' TRNF Ty.floatRef Ty.intRef -roundf = unop' RNDF Ty.floatRef Ty.intRef -i2f = unop' ITOF Ty.intRef Ty.floatRef -n2f = unop' NTOF Ty.natRef Ty.floatRef - -trni :: (Var v) => SuperNormal v -trni = unop0 3 $ \[x0, x, z, b] -> - unbox x0 Ty.intRef x - . TLetD z UN (TLit $ I 0) - . TLetD b UN (TPrm LEQI [x, z]) - . TMatch b - $ MatchIntegral - (mapSingleton 1 $ TCon Ty.natRef 0 [z]) - (Just $ TCon Ty.natRef 0 [x]) - -modular :: (Var v) => POp -> (Bool -> ANormal v) -> SuperNormal v -modular pop ret = - unop0 3 $ \[x0, x, m, t] -> - unbox x0 Ty.intRef x - . TLetD t UN (TLit $ I 2) - . TLetD m UN (TPrm pop [x, t]) - . TMatch m - $ MatchIntegral - (mapSingleton 1 $ ret True) - (Just $ ret False) - -evni, evnn, oddi, oddn :: (Var v) => SuperNormal v -evni = modular MODI (\b -> if b then fls else tru) -oddi = modular MODI (\b -> if b then tru else fls) -evnn = modular MODN (\b -> if b then fls else tru) -oddn = modular MODN (\b -> if b then tru else fls) - -dropn :: (Var v) => SuperNormal v -dropn = binop0 4 $ \[x0, y0, x, y, b, r] -> - unbox x0 Ty.natRef x - . unbox y0 Ty.natRef y - . TLetD b UN (TPrm LEQN [x, y]) - . TLet - (Indirect 1) - r - UN - ( TMatch b $ - MatchIntegral - (mapSingleton 1 $ TLit $ N 0) - (Just $ TPrm SUBN [x, y]) - ) - $ TCon Ty.natRef 0 [r] - -appendt, taket, dropt, indext, indexb, sizet, unconst, unsnoct :: (Var v) => SuperNormal v -appendt = binop0 0 $ \[x, y] -> TPrm CATT [x, y] -taket = binop0 1 $ \[x0, y, x] -> - unbox x0 Ty.natRef x $ - TPrm TAKT [x, y] -dropt = binop0 1 $ \[x0, y, x] -> - unbox x0 Ty.natRef x $ - TPrm DRPT [x, y] - -atb = binop0 4 $ \[n0, b, n, t, r0, r] -> - unbox n0 Ty.natRef n - . TLetD t UN (TPrm IDXB [n, b]) - . TMatch t - . MatchSum - $ mapFromList - [ (0, ([], none)), - ( 1, - ( [UN], - TAbs r0 - . TLetD r BX (TCon Ty.natRef 0 [r0]) - $ some r - ) - ) - ] - -indext = binop0 3 $ \[x, y, t, r0, r] -> - TLetD t UN (TPrm IXOT [x, y]) - . TMatch t - . MatchSum - $ mapFromList - [ (0, ([], none)), - ( 1, - ( [UN], - TAbs r0 - . TLetD r BX (TCon Ty.natRef 0 [r0]) - $ some r - ) - ) - ] - -indexb = binop0 3 $ \[x, y, t, i, r] -> - TLetD t UN (TPrm IXOB [x, y]) - . TMatch t - . MatchSum - $ mapFromList - [ (0, ([], none)), - ( 1, - ( [UN], - TAbs i - . TLetD r BX (TCon Ty.natRef 0 [i]) - $ some r - ) - ) - ] - -sizet = unop0 1 $ \[x, r] -> - TLetD r UN (TPrm SIZT [x]) $ - TCon Ty.natRef 0 [r] - -unconst = unop0 7 $ \[x, t, c0, c, y, p, u, yp] -> - TLetD t UN (TPrm UCNS [x]) - . TMatch t - . MatchSum - $ mapFromList - [ (0, ([], none)), - ( 1, - ( [UN, BX], - TAbss [c0, y] - . TLetD u BX (TCon Ty.unitRef 0 []) - . TLetD yp BX (TCon Ty.pairRef 0 [y, u]) - . TLetD c BX (TCon Ty.charRef 0 [c0]) - . TLetD p BX (TCon Ty.pairRef 0 [c, yp]) - $ some p - ) - ) - ] - -unsnoct = unop0 7 $ \[x, t, c0, c, y, p, u, cp] -> - TLetD t UN (TPrm USNC [x]) - . TMatch t - . MatchSum - $ mapFromList - [ (0, ([], none)), - ( 1, - ( [BX, UN], - TAbss [y, c0] - . TLetD u BX (TCon Ty.unitRef 0 []) - . TLetD c BX (TCon Ty.charRef 0 [c0]) - . TLetD cp BX (TCon Ty.pairRef 0 [c, u]) - . TLetD p BX (TCon Ty.pairRef 0 [y, cp]) - $ some p - ) - ) - ] - -appends, conss, snocs :: (Var v) => SuperNormal v -appends = binop0 0 $ \[x, y] -> TPrm CATS [x, y] -conss = binop0 0 $ \[x, y] -> TPrm CONS [x, y] -snocs = binop0 0 $ \[x, y] -> TPrm SNOC [x, y] - -coerceType :: (Var v) => Reference -> Reference -> SuperNormal v -coerceType fromType toType = unop0 1 $ \[x, r] -> - unbox x fromType r $ - TCon toType 0 [r] - -takes, drops, sizes, ats, emptys :: (Var v) => SuperNormal v -takes = binop0 1 $ \[x0, y, x] -> - unbox x0 Ty.natRef x $ - TPrm TAKS [x, y] -drops = binop0 1 $ \[x0, y, x] -> - unbox x0 Ty.natRef x $ - TPrm DRPS [x, y] -sizes = unop0 1 $ \[x, r] -> - TLetD r UN (TPrm SIZS [x]) $ - TCon Ty.natRef 0 [r] -ats = binop0 3 $ \[x0, y, x, t, r] -> - unbox x0 Ty.natRef x - . TLetD t UN (TPrm IDXS [x, y]) - . TMatch t - . MatchSum - $ mapFromList - [ (0, ([], none)), - (1, ([BX], TAbs r $ some r)) - ] -emptys = Lambda [] $ TPrm BLDS [] - -viewls, viewrs :: (Var v) => SuperNormal v -viewls = unop0 3 $ \[s, u, h, t] -> - TLetD u UN (TPrm VWLS [s]) - . TMatch u - . MatchSum - $ mapFromList - [ (0, ([], seqViewEmpty)), - (1, ([BX, BX], TAbss [h, t] $ seqViewElem h t)) - ] -viewrs = unop0 3 $ \[s, u, i, l] -> - TLetD u UN (TPrm VWRS [s]) - . TMatch u - . MatchSum - $ mapFromList - [ (0, ([], seqViewEmpty)), - (1, ([BX, BX], TAbss [i, l] $ seqViewElem i l)) - ] - -splitls, splitrs :: (Var v) => SuperNormal v -splitls = binop0 4 $ \[n0, s, n, t, l, r] -> - unbox n0 Ty.natRef n - . TLetD t UN (TPrm SPLL [n, s]) - . TMatch t - . MatchSum - $ mapFromList - [ (0, ([], seqViewEmpty)), - (1, ([BX, BX], TAbss [l, r] $ seqViewElem l r)) - ] -splitrs = binop0 4 $ \[n0, s, n, t, l, r] -> - unbox n0 Ty.natRef n - . TLetD t UN (TPrm SPLR [n, s]) - . TMatch t - . MatchSum - $ mapFromList - [ (0, ([], seqViewEmpty)), - (1, ([BX, BX], TAbss [l, r] $ seqViewElem l r)) - ] - -eqt, neqt, leqt, geqt, lesst, great :: SuperNormal Symbol -eqt = binop0 1 $ \[x, y, b] -> - TLetD b UN (TPrm EQLT [x, y]) $ - boolift b -neqt = binop0 1 $ \[x, y, b] -> - TLetD b UN (TPrm EQLT [x, y]) $ - notlift b -leqt = binop0 1 $ \[x, y, b] -> - TLetD b UN (TPrm LEQT [x, y]) $ - boolift b -geqt = binop0 1 $ \[x, y, b] -> - TLetD b UN (TPrm LEQT [y, x]) $ - boolift b -lesst = binop0 1 $ \[x, y, b] -> - TLetD b UN (TPrm LEQT [y, x]) $ - notlift b -great = binop0 1 $ \[x, y, b] -> - TLetD b UN (TPrm LEQT [x, y]) $ - notlift b - -packt, unpackt :: SuperNormal Symbol -packt = unop0 0 $ \[s] -> TPrm PAKT [s] -unpackt = unop0 0 $ \[t] -> TPrm UPKT [t] - -packb, unpackb, emptyb, appendb :: SuperNormal Symbol -packb = unop0 0 $ \[s] -> TPrm PAKB [s] -unpackb = unop0 0 $ \[b] -> TPrm UPKB [b] -emptyb = - Lambda [] - . TLetD es BX (TPrm BLDS []) - $ TPrm PAKB [es] - where - es = fresh1 -appendb = binop0 0 $ \[x, y] -> TPrm CATB [x, y] - -takeb, dropb, atb, sizeb, flattenb :: SuperNormal Symbol -takeb = binop0 1 $ \[n0, b, n] -> - unbox n0 Ty.natRef n $ - TPrm TAKB [n, b] -dropb = binop0 1 $ \[n0, b, n] -> - unbox n0 Ty.natRef n $ - TPrm DRPB [n, b] -sizeb = unop0 1 $ \[b, n] -> - TLetD n UN (TPrm SIZB [b]) $ - TCon Ty.natRef 0 [n] -flattenb = unop0 0 $ \[b] -> TPrm FLTB [b] - -i2t, n2t, f2t :: SuperNormal Symbol -i2t = unop0 1 $ \[n0, n] -> - unbox n0 Ty.intRef n $ - TPrm ITOT [n] -n2t = unop0 1 $ \[n0, n] -> - unbox n0 Ty.natRef n $ - TPrm NTOT [n] -f2t = unop0 1 $ \[f0, f] -> - unbox f0 Ty.floatRef f $ - TPrm FTOT [f] - -t2i, t2n, t2f :: SuperNormal Symbol -t2i = unop0 3 $ \[x, t, n0, n] -> - TLetD t UN (TPrm TTOI [x]) - . TMatch t - . MatchSum - $ mapFromList - [ (0, ([], none)), - ( 1, - ( [UN], - TAbs n0 - . TLetD n BX (TCon Ty.intRef 0 [n0]) - $ some n - ) - ) - ] -t2n = unop0 3 $ \[x, t, n0, n] -> - TLetD t UN (TPrm TTON [x]) - . TMatch t - . MatchSum - $ mapFromList - [ (0, ([], none)), - ( 1, - ( [UN], - TAbs n0 - . TLetD n BX (TCon Ty.natRef 0 [n0]) - $ some n - ) - ) - ] -t2f = unop0 3 $ \[x, t, f0, f] -> - TLetD t UN (TPrm TTOF [x]) - . TMatch t - . MatchSum - $ mapFromList - [ (0, ([], none)), - ( 1, - ( [UN], - TAbs f0 - . TLetD f BX (TCon Ty.floatRef 0 [f0]) - $ some f - ) - ) - ] - -equ :: SuperNormal Symbol -equ = binop0 1 $ \[x, y, b] -> - TLetD b UN (TPrm EQLU [x, y]) $ - boolift b - -cmpu :: SuperNormal Symbol -cmpu = binop0 2 $ \[x, y, c, i] -> - TLetD c UN (TPrm CMPU [x, y]) - . TLetD i UN (TPrm DECI [c]) - $ TCon Ty.intRef 0 [i] - -ltu :: SuperNormal Symbol -ltu = binop0 1 $ \[x, y, c] -> - TLetD c UN (TPrm CMPU [x, y]) - . TMatch c - $ MatchIntegral - (mapFromList [(0, TCon Ty.booleanRef 1 [])]) - (Just $ TCon Ty.booleanRef 0 []) - -gtu :: SuperNormal Symbol -gtu = binop0 1 $ \[x, y, c] -> - TLetD c UN (TPrm CMPU [x, y]) - . TMatch c - $ MatchIntegral - (mapFromList [(2, TCon Ty.booleanRef 1 [])]) - (Just $ TCon Ty.booleanRef 0 []) - -geu :: SuperNormal Symbol -geu = binop0 1 $ \[x, y, c] -> - TLetD c UN (TPrm CMPU [x, y]) - . TMatch c - $ MatchIntegral - (mapFromList [(0, TCon Ty.booleanRef 0 [])]) - (Just $ TCon Ty.booleanRef 1 []) - -leu :: SuperNormal Symbol -leu = binop0 1 $ \[x, y, c] -> - TLetD c UN (TPrm CMPU [x, y]) - . TMatch c - $ MatchIntegral - (mapFromList [(2, TCon Ty.booleanRef 0 [])]) - (Just $ TCon Ty.booleanRef 1 []) - -notb :: SuperNormal Symbol -notb = unop0 0 $ \[b] -> - TMatch b . flip (MatchData Ty.booleanRef) Nothing $ - mapFromList [(0, ([], tru)), (1, ([], fls))] - -orb :: SuperNormal Symbol -orb = binop0 0 $ \[p, q] -> - TMatch p . flip (MatchData Ty.booleanRef) Nothing $ - mapFromList [(1, ([], tru)), (0, ([], TVar q))] - -andb :: SuperNormal Symbol -andb = binop0 0 $ \[p, q] -> - TMatch p . flip (MatchData Ty.booleanRef) Nothing $ - mapFromList [(0, ([], fls)), (1, ([], TVar q))] - --- unsafeCoerce, used for numeric types where conversion is a --- no-op on the representation. Ideally this will be inlined and --- eliminated so that no instruction is necessary. -cast :: Reference -> Reference -> SuperNormal Symbol -cast ri ro = - unop0 1 $ \[x0, x] -> - unbox x0 ri x $ - TCon ro 0 [x] - --- This version of unsafeCoerce is the identity function. It works --- only if the two types being coerced between are actually the same, --- because it keeps the same representation. It is not capable of --- e.g. correctly translating between two types with compatible bit --- representations, because tagging information will be retained. -poly'coerce :: SuperNormal Symbol -poly'coerce = unop0 0 $ \[x] -> TVar x - -jumpk :: SuperNormal Symbol -jumpk = binop0 0 $ \[k, a] -> TKon k [a] - -scope'run :: SuperNormal Symbol -scope'run = - unop0 1 $ \[e, un] -> - TLetD un BX (TCon Ty.unitRef 0 []) $ - TApp (FVar e) [un] - -fork'comp :: SuperNormal Symbol -fork'comp = - Lambda [BX] - . TAbs act - . TLetD unit BX (TCon Ty.unitRef 0 []) - . TName lz (Right act) [unit] - $ TPrm FORK [lz] - where - (act, unit, lz) = fresh - -try'eval :: SuperNormal Symbol -try'eval = - Lambda [BX] - . TAbs act - . TLetD unit BX (TCon Ty.unitRef 0 []) - . TName lz (Right act) [unit] - . TLetD ta UN (TPrm TFRC [lz]) - . TMatch ta - . MatchSum - $ mapFromList - [ exnCase lnk msg xtra any fail, - (1, ([BX], TAbs r (TVar r))) - ] - where - (act, unit, lz, ta, lnk, msg, xtra, any, fail, r) = fresh - -bug :: Util.Text.Text -> SuperNormal Symbol -bug name = - unop0 1 $ \[x, n] -> - TLetD n BX (TLit $ T name) $ - TPrm EROR [n, x] - -watch :: SuperNormal Symbol -watch = - binop0 0 $ \[t, v] -> - TLets Direct [] [] (TPrm PRNT [t]) $ - TVar v - -raise :: SuperNormal Symbol -raise = - unop0 3 $ \[r, f, n, k] -> - TMatch r - . flip MatchRequest (TAbs f $ TVar f) - . Map.singleton Ty.exceptionRef - $ mapSingleton - 0 - ( [BX], - TAbs f - . TShift Ty.exceptionRef k - . TLetD n BX (TLit $ T "builtin.raise") - $ TPrm EROR [n, f] - ) - -gen'trace :: SuperNormal Symbol -gen'trace = - binop0 0 $ \[t, v] -> - TLets Direct [] [] (TPrm TRCE [t, v]) $ - TCon Ty.unitRef 0 [] - -debug'text :: SuperNormal Symbol -debug'text = - unop0 3 $ \[c, r, t, e] -> - TLetD r UN (TPrm DBTX [c]) - . TMatch r - . MatchSum - $ mapFromList - [ (0, ([], none)), - (1, ([BX], TAbs t . TLetD e BX (left t) $ some e)), - (2, ([BX], TAbs t . TLetD e BX (right t) $ some e)) - ] - -code'missing :: SuperNormal Symbol -code'missing = - unop0 1 $ \[link, b] -> - TLetD b UN (TPrm MISS [link]) $ - boolift b - -code'cache :: SuperNormal Symbol -code'cache = unop0 0 $ \[new] -> TPrm CACH [new] - -code'lookup :: SuperNormal Symbol -code'lookup = - unop0 2 $ \[link, t, r] -> - TLetD t UN (TPrm LKUP [link]) - . TMatch t - . MatchSum - $ mapFromList - [ (0, ([], none)), - (1, ([BX], TAbs r $ some r)) - ] - -code'validate :: SuperNormal Symbol -code'validate = - unop0 6 $ \[item, t, ref, msg, extra, any, fail] -> - TLetD t UN (TPrm CVLD [item]) - . TMatch t - . MatchSum - $ mapFromList - [ ( 1, - ([BX, BX, BX],) - . TAbss [ref, msg, extra] - . TLetD any BX (TCon Ty.anyRef 0 [extra]) - . TLetD fail BX (TCon Ty.failureRef 0 [ref, msg, any]) - $ some fail - ), - ( 0, - ([],) $ - none - ) - ] - -term'link'to'text :: SuperNormal Symbol -term'link'to'text = - unop0 0 $ \[link] -> TPrm TLTT [link] - -value'load :: SuperNormal Symbol -value'load = - unop0 2 $ \[vlu, t, r] -> - TLetD t UN (TPrm LOAD [vlu]) - . TMatch t - . MatchSum - $ mapFromList - [ (0, ([BX], TAbs r $ left r)), - (1, ([BX], TAbs r $ right r)) - ] - -value'create :: SuperNormal Symbol -value'create = unop0 0 $ \[x] -> TPrm VALU [x] - -check'sandbox :: SuperNormal Symbol -check'sandbox = - Lambda [BX, BX] - . TAbss [refs, val] - . TLetD b UN (TPrm SDBX [refs, val]) - $ boolift b - where - (refs, val, b) = fresh - -sandbox'links :: SuperNormal Symbol -sandbox'links = Lambda [BX] . TAbs ln $ TPrm SDBL [ln] - where - ln = fresh1 - -value'sandbox :: SuperNormal Symbol -value'sandbox = - Lambda [BX, BX] - . TAbss [refs, val] - $ TPrm SDBV [refs, val] - where - (refs, val) = fresh - -stm'atomic :: SuperNormal Symbol -stm'atomic = - Lambda [BX] - . TAbs act - . TLetD unit BX (TCon Ty.unitRef 0 []) - . TName lz (Right act) [unit] - $ TPrm ATOM [lz] - where - (act, unit, lz) = fresh - -type ForeignOp = FOp -> ([Mem], ANormal Symbol) - -standard'handle :: ForeignOp -standard'handle instr = - ([BX],) - . TAbss [h0] - . unenum 3 h0 Ty.stdHandleRef h - $ TFOp instr [h] - where - (h0, h) = fresh - -any'construct :: SuperNormal Symbol -any'construct = - unop0 0 $ \[v] -> - TCon Ty.anyRef 0 [v] - -any'extract :: SuperNormal Symbol -any'extract = - unop0 1 $ - \[v, v1] -> - TMatch v $ - MatchData Ty.anyRef (mapSingleton 0 $ ([BX], TAbs v1 (TVar v1))) Nothing - -seek'handle :: ForeignOp -seek'handle instr = - ([BX, BX, BX],) - . TAbss [arg1, arg2, arg3] - . unenum 3 arg2 Ty.seekModeRef seek - . unbox arg3 Ty.intRef nat - . TLetD result UN (TFOp instr [arg1, seek, nat]) - $ outIoFailUnit stack1 stack2 stack3 unit fail result - where - (arg1, arg2, arg3, seek, nat, stack1, stack2, stack3, unit, fail, result) = fresh - -no'buf, line'buf, block'buf, sblock'buf :: (Enum e) => e -no'buf = toEnum $ fromIntegral Ty.bufferModeNoBufferingId -line'buf = toEnum $ fromIntegral Ty.bufferModeLineBufferingId -block'buf = toEnum $ fromIntegral Ty.bufferModeBlockBufferingId -sblock'buf = toEnum $ fromIntegral Ty.bufferModeSizedBlockBufferingId - -infixr 0 --> - -(-->) :: a -> b -> (a, b) -x --> y = (x, y) - --- Box an unboxed value --- Takes the boxed variable, the unboxed variable, and the type of the value -box :: (Var v) => v -> v -> Reference -> Term ANormalF v -> Term ANormalF v -box b u ty = TLetD b BX (TCon ty 0 [u]) - -time'zone :: ForeignOp -time'zone instr = - ([BX],) - . TAbss [bsecs] - . unbox bsecs Ty.intRef secs - . TLets Direct [offset, summer, name] [UN, UN, BX] (TFOp instr [secs]) - . box bsummer summer Ty.natRef - . box boffset offset Ty.intRef - . TLetD un BX (TCon Ty.unitRef 0 []) - . TLetD p2 BX (TCon Ty.pairRef 0 [name, un]) - . TLetD p1 BX (TCon Ty.pairRef 0 [bsummer, p2]) - $ TCon Ty.pairRef 0 [boffset, p1] - where - (secs, bsecs, offset, boffset, summer, bsummer, name, un, p2, p1) = fresh - -start'process :: ForeignOp -start'process instr = - ([BX, BX],) - . TAbss [exe, args] - . TLets Direct [hin, hout, herr, hproc] [BX, BX, BX, BX] (TFOp instr [exe, args]) - . TLetD un BX (TCon Ty.unitRef 0 []) - . TLetD p3 BX (TCon Ty.pairRef 0 [hproc, un]) - . TLetD p2 BX (TCon Ty.pairRef 0 [herr, p3]) - . TLetD p1 BX (TCon Ty.pairRef 0 [hout, p2]) - $ TCon Ty.pairRef 0 [hin, p1] - where - (exe, args, hin, hout, herr, hproc, un, p3, p2, p1) = fresh - -set'buffering :: ForeignOp -set'buffering instr = - ([BX, BX],) - . TAbss [handle, bmode] - . TMatch bmode - . MatchDataCover Ty.bufferModeRef - $ mapFromList - [ no'buf --> [] --> k1 no'buf, - line'buf --> [] --> k1 line'buf, - block'buf --> [] --> k1 block'buf, - sblock'buf - --> [BX] - --> TAbs n - . TMatch n - . MatchDataCover Ty.bufferModeRef - $ mapFromList - [ 0 - --> [UN] - --> TAbs w - . TLetD tag UN (TLit (N sblock'buf)) - $ k2 [tag, w] - ] - ] - where - k1 num = - TLetD tag UN (TLit (N num)) $ - k2 [tag] - k2 args = - TLetD r UN (TFOp instr (handle : args)) $ - outIoFailUnit s1 s2 s3 u f r - (handle, bmode, tag, n, w, s1, s2, s3, u, f, r) = fresh - -get'buffering'output :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> v -> v -> ANormal v -get'buffering'output eitherResult stack1 stack2 stack3 resultTag anyVar failVar successVar = - TMatch eitherResult . MatchSum $ - mapFromList - [ failureCase stack1 stack2 stack3 anyVar failVar, - ( 1, - ([UN],) - . TAbs resultTag - . TMatch resultTag - . MatchSum - $ mapFromList - [ no'buf - --> [] - --> TLetD successVar BX (TCon Ty.bufferModeRef no'buf []) - $ right successVar, - line'buf - --> [] - --> TLetD successVar BX (TCon Ty.bufferModeRef line'buf []) - $ right successVar, - block'buf - --> [] - --> TLetD successVar BX (TCon Ty.bufferModeRef block'buf []) - $ right successVar, - sblock'buf - --> [UN] - --> TAbs stack1 - . TLetD stack2 BX (TCon Ty.natRef 0 [stack1]) - . TLetD successVar BX (TCon Ty.bufferModeRef sblock'buf [stack2]) - $ right successVar - ] - ) - ] - -get'buffering :: ForeignOp -get'buffering = - inBx arg1 eitherResult $ - get'buffering'output eitherResult n n2 n3 resultTag anyVar failVar successVar - where - (arg1, eitherResult, n, n2, n3, resultTag, anyVar, failVar, successVar) = fresh - -crypto'hash :: ForeignOp -crypto'hash instr = - ([BX, BX],) - . TAbss [alg, x] - . TLetD vl BX (TPrm VALU [x]) - $ TFOp instr [alg, vl] - where - (alg, x, vl) = fresh - -murmur'hash :: ForeignOp -murmur'hash instr = - ([BX],) - . TAbss [x] - . TLetD vl BX (TPrm VALU [x]) - . TLetD result UN (TFOp instr [vl]) - $ TCon Ty.natRef 0 [result] - where - (x, vl, result) = fresh - -crypto'hmac :: ForeignOp -crypto'hmac instr = - ([BX, BX, BX],) - . TAbss [alg, by, x] - . TLetD vl BX (TPrm VALU [x]) - $ TFOp instr [alg, by, vl] - where - (alg, by, x, vl) = fresh - --- Input Shape -- these will represent different argument lists a --- foreign might expect --- --- They will be named according to their shape: --- inBx : one boxed input arg --- inNat : one Nat input arg --- inBxBx : two boxed input args --- --- All of these functions will have take (at least) the same three arguments --- --- instr : the foreign instruction to call --- result : a variable containing the result of the foreign call --- cont : a term which will be evaluated when a result from the foreign call is on the stack --- - --- () -> ... -inUnit :: forall v. (Var v) => v -> v -> ANormal v -> FOp -> ([Mem], ANormal v) -inUnit unit result cont instr = - ([BX], TAbs unit $ TLetD result UN (TFOp instr []) cont) - --- a -> ... -inBx :: forall v. (Var v) => v -> v -> ANormal v -> FOp -> ([Mem], ANormal v) -inBx arg result cont instr = - ([BX],) - . TAbs arg - $ TLetD result UN (TFOp instr [arg]) cont - --- Nat -> ... -inNat :: forall v. (Var v) => v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v) -inNat arg nat result cont instr = - ([BX],) - . TAbs arg - . unbox arg Ty.natRef nat - $ TLetD result UN (TFOp instr [nat]) cont - --- Maybe a -> b -> ... -inMaybeBx :: forall v. (Var v) => v -> v -> v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v) -inMaybeBx arg1 arg2 arg3 mb result cont instr = - ([BX, BX],) - . TAbss [arg1, arg2] - . TMatch arg1 - . flip (MatchData Ty.optionalRef) Nothing - $ mapFromList - [ ( fromIntegral Ty.noneId, - ( [], - TLetD mb UN (TLit $ I 0) $ - TLetD result UN (TFOp instr [mb, arg2]) cont - ) - ), - (fromIntegral Ty.someId, ([BX], TAbs arg3 . TLetD mb UN (TLit $ I 1) $ TLetD result UN (TFOp instr [mb, arg3, arg2]) cont)) - ] - --- a -> b -> ... -inBxBx :: forall v. (Var v) => v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v) -inBxBx arg1 arg2 result cont instr = - ([BX, BX],) - . TAbss [arg1, arg2] - $ TLetD result UN (TFOp instr [arg1, arg2]) cont - --- a -> b -> c -> ... -inBxBxBx :: forall v. (Var v) => v -> v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v) -inBxBxBx arg1 arg2 arg3 result cont instr = - ([BX, BX, BX],) - . TAbss [arg1, arg2, arg3] - $ TLetD result UN (TFOp instr [arg1, arg2, arg3]) cont - -set'echo :: ForeignOp -set'echo instr = - ([BX, BX],) - . TAbss [arg1, arg2] - . unenum 2 arg2 Ty.booleanRef bol - . TLetD result UN (TFOp instr [arg1, bol]) - $ outIoFailUnit stack1 stack2 stack3 unit fail result - where - (arg1, arg2, bol, stack1, stack2, stack3, unit, fail, result) = fresh - --- a -> Nat -> ... -inBxNat :: forall v. (Var v) => v -> v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v) -inBxNat arg1 arg2 nat result cont instr = - ([BX, BX],) - . TAbss [arg1, arg2] - . unbox arg2 Ty.natRef nat - $ TLetD result UN (TFOp instr [arg1, nat]) cont - -inBxNatNat :: - (Var v) => v -> v -> v -> v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v) -inBxNatNat arg1 arg2 arg3 nat1 nat2 result cont instr = - ([BX, BX, BX],) - . TAbss [arg1, arg2, arg3] - . unbox arg2 Ty.natRef nat1 - . unbox arg3 Ty.natRef nat2 - $ TLetD result UN (TFOp instr [arg1, nat1, nat2]) cont - -inBxNatBx :: (Var v) => v -> v -> v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v) -inBxNatBx arg1 arg2 arg3 nat result cont instr = - ([BX, BX, BX],) - . TAbss [arg1, arg2, arg3] - . unbox arg2 Ty.natRef nat - $ TLetD result UN (TFOp instr [arg1, nat, arg3]) cont - --- a -> IOMode -> ... -inBxIomr :: forall v. (Var v) => v -> v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v) -inBxIomr arg1 arg2 fm result cont instr = - ([BX, BX],) - . TAbss [arg1, arg2] - . unenum 4 arg2 Ty.fileModeRef fm - $ TLetD result UN (TFOp instr [arg1, fm]) cont - --- Output Shape -- these will represent different ways of translating --- the result of a foreign call to a Unison Term --- --- They will be named according to the output type --- outInt : a foreign function returning an Int --- outBool : a foreign function returning a boolean --- outIOFail : a function returning (Either Failure a) --- --- All of these functions will take a Var named result containing the --- result of the foreign call --- - -outMaybe :: forall v. (Var v) => v -> v -> ANormal v -outMaybe maybe result = - TMatch result . MatchSum $ - mapFromList - [ (0, ([], none)), - (1, ([BX], TAbs maybe $ some maybe)) - ] - -outMaybeNat :: (Var v) => v -> v -> v -> ANormal v -outMaybeNat tag result n = - TMatch tag . MatchSum $ - mapFromList - [ (0, ([], none)), - ( 1, - ( [UN], - TAbs result - . TLetD n BX (TCon Ty.natRef 0 [n]) - $ some n - ) - ) - ] - -outMaybeNTup :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> v -> ANormal v -outMaybeNTup a b n u bp p result = - TMatch result . MatchSum $ - mapFromList - [ (0, ([], none)), - ( 1, - ( [UN, BX], - TAbss [a, b] - . TLetD u BX (TCon Ty.unitRef 0 []) - . TLetD bp BX (TCon Ty.pairRef 0 [b, u]) - . TLetD n BX (TCon Ty.natRef 0 [a]) - . TLetD p BX (TCon Ty.pairRef 0 [n, bp]) - $ some p - ) - ) - ] - -outMaybeTup :: (Var v) => v -> v -> v -> v -> v -> v -> ANormal v -outMaybeTup a b u bp ap result = - TMatch result . MatchSum $ - mapFromList - [ (0, ([], none)), - ( 1, - ( [BX, BX], - TAbss [a, b] - . TLetD u BX (TCon Ty.unitRef 0 []) - . TLetD bp BX (TCon Ty.pairRef 0 [b, u]) - . TLetD ap BX (TCon Ty.pairRef 0 [a, bp]) - $ some ap - ) - ) - ] - --- Note: the Io part doesn't really do anything. There's no actual --- representation of `IO`. -outIoFail :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v -outIoFail stack1 stack2 stack3 any fail result = - TMatch result . MatchSum $ - mapFromList - [ failureCase stack1 stack2 stack3 any fail, - (1, ([BX], TAbs stack1 $ right stack1)) - ] - -outIoFailNat :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v -outIoFailNat stack1 stack2 stack3 fail extra result = - TMatch result . MatchSum $ - mapFromList - [ failureCase stack1 stack2 stack3 extra fail, - ( 1, - ([UN],) - . TAbs stack3 - . TLetD extra BX (TCon Ty.natRef 0 [stack3]) - $ right extra - ) - ] - -outIoFailChar :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v -outIoFailChar stack1 stack2 stack3 fail extra result = - TMatch result . MatchSum $ - mapFromList - [ failureCase stack1 stack2 stack3 extra fail, - ( 1, - ([UN],) - . TAbs stack3 - . TLetD extra BX (TCon Ty.charRef 0 [stack3]) - $ right extra - ) - ] - -failureCase :: - (Var v) => v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v)) -failureCase stack1 stack2 stack3 any fail = - (0,) - . ([BX, BX, BX],) - . TAbss [stack1, stack2, stack3] - . TLetD any BX (TCon Ty.anyRef 0 [stack3]) - . TLetD fail BX (TCon Ty.failureRef 0 [stack1, stack2, any]) - $ left fail - -exnCase :: - (Var v) => v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v)) -exnCase stack1 stack2 stack3 any fail = - (0,) - . ([BX, BX, BX],) - . TAbss [stack1, stack2, stack3] - . TLetD any BX (TCon Ty.anyRef 0 [stack3]) - . TLetD fail BX (TCon Ty.failureRef 0 [stack1, stack2, any]) - $ TReq Ty.exceptionRef 0 [fail] - -outIoExnNat :: - forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v -outIoExnNat stack1 stack2 stack3 any fail result = - TMatch result . MatchSum $ - mapFromList - [ exnCase stack1 stack2 stack3 any fail, - ( 1, - ([UN],) - . TAbs stack1 - $ TCon Ty.natRef 0 [stack1] - ) - ] - -outIoExnUnit :: - forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v -outIoExnUnit stack1 stack2 stack3 any fail result = - TMatch result . MatchSum $ - mapFromList - [ exnCase stack1 stack2 stack3 any fail, - (1, ([], TCon Ty.unitRef 0 [])) - ] - -outIoExnBox :: - (Var v) => v -> v -> v -> v -> v -> v -> ANormal v -outIoExnBox stack1 stack2 stack3 any fail result = - TMatch result . MatchSum $ - mapFromList - [ exnCase stack1 stack2 stack3 any fail, - (1, ([BX], TAbs stack1 $ TVar stack1)) - ] - -outIoExnEBoxBox :: - (Var v) => v -> v -> v -> v -> v -> v -> v -> v -> ANormal v -outIoExnEBoxBox stack1 stack2 stack3 any fail t0 t1 res = - TMatch t0 . MatchSum $ - mapFromList - [ exnCase stack1 stack2 stack3 any fail, - ( 1, - ([UN],) - . TAbs t1 - . TMatch t1 - . MatchSum - $ mapFromList - [ (0, ([BX], TAbs res $ left res)), - (1, ([BX], TAbs res $ right res)) - ] - ) - ] - -outIoFailBox :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v -outIoFailBox stack1 stack2 stack3 any fail result = - TMatch result . MatchSum $ - mapFromList - [ failureCase stack1 stack2 stack3 any fail, - ( 1, - ([BX],) - . TAbs stack1 - $ right stack1 - ) - ] - -outIoFailUnit :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v -outIoFailUnit stack1 stack2 stack3 extra fail result = - TMatch result . MatchSum $ - mapFromList - [ failureCase stack1 stack2 stack3 extra fail, - ( 1, - ([],) - . TLetD extra BX (TCon Ty.unitRef 0 []) - $ right extra - ) - ] - -outIoFailBool :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v -outIoFailBool stack1 stack2 stack3 extra fail result = - TMatch result . MatchSum $ - mapFromList - [ failureCase stack1 stack2 stack3 extra fail, - ( 1, - ([UN],) - . TAbs stack3 - . TLet (Indirect 1) extra BX (boolift stack3) - $ right extra - ) - ] - -outIoFailTup :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> v -> v -> ANormal v -outIoFailTup stack1 stack2 stack3 stack4 stack5 extra fail result = - TMatch result . MatchSum $ - mapFromList - [ failureCase stack1 stack2 stack3 extra fail, - ( 1, - ( [BX, BX], - TAbss [stack1, stack2] - . TLetD stack3 BX (TCon Ty.unitRef 0 []) - . TLetD stack4 BX (TCon Ty.pairRef 0 [stack2, stack3]) - . TLetD stack5 BX (TCon Ty.pairRef 0 [stack1, stack4]) - $ right stack5 - ) - ) - ] - -outIoFailG :: - (Var v) => - v -> - v -> - v -> - v -> - v -> - v -> - ((ANormal v -> ANormal v) -> ([Mem], ANormal v)) -> - ANormal v -outIoFailG stack1 stack2 stack3 fail result output k = - TMatch result . MatchSum $ - mapFromList - [ failureCase stack1 stack2 stack3 output fail, - ( 1, - k $ \t -> - TLetD output BX t $ - right output - ) - ] - --- Input / Output glue --- --- These are pairings of input and output functions to handle a --- foreign call. The input function represents the numbers and types --- of the inputs to a forein call. The output function takes the --- result of the foreign call and turns it into a Unison type. --- - --- a -direct :: ForeignOp -direct instr = ([], TFOp instr []) - --- () -> a -unitDirect :: ForeignOp -unitDirect instr = ([BX],) . TAbs arg $ TFOp instr [] where arg = fresh1 - --- a -> b -boxDirect :: ForeignOp -boxDirect instr = - ([BX],) - . TAbs arg - $ TFOp instr [arg] - where - arg = fresh1 - --- () -> Either Failure Nat -unitToEFNat :: ForeignOp -unitToEFNat = - inUnit unit result $ - outIoFailNat stack1 stack2 stack3 fail nat result - where - (unit, stack1, stack2, stack3, fail, nat, result) = fresh - --- () -> Int -unitToInt :: ForeignOp -unitToInt = - inUnit unit result $ - TCon Ty.intRef 0 [result] - where - (unit, result) = fresh - --- () -> Either Failure a -unitToEFBox :: ForeignOp -unitToEFBox = - inUnit unit result $ - outIoFailBox stack1 stack2 stack3 any fail result - where - (unit, stack1, stack2, stack3, fail, any, result) = fresh - --- a -> Int -boxToInt :: ForeignOp -boxToInt = inBx arg result (TCon Ty.intRef 0 [result]) - where - (arg, result) = fresh - --- a -> Nat -boxToNat :: ForeignOp -boxToNat = inBx arg result (TCon Ty.natRef 0 [result]) - where - (arg, result) = fresh - -boxIomrToEFBox :: ForeignOp -boxIomrToEFBox = - inBxIomr arg1 arg2 enum result $ - outIoFailBox stack1 stack2 stack3 any fail result - where - (arg1, arg2, enum, stack1, stack2, stack3, any, fail, result) = fresh - --- a -> () -boxTo0 :: ForeignOp -boxTo0 = inBx arg result (TCon Ty.unitRef 0 []) - where - (arg, result) = fresh - --- a -> b ->{E} () -boxBoxTo0 :: ForeignOp -boxBoxTo0 instr = - ([BX, BX],) - . TAbss [arg1, arg2] - . TLets Direct [] [] (TFOp instr [arg1, arg2]) - $ TCon Ty.unitRef 0 [] - where - (arg1, arg2) = fresh - --- a -> b ->{E} Nat -boxBoxToNat :: ForeignOp -boxBoxToNat instr = - ([BX, BX],) - . TAbss [arg1, arg2] - . TLetD result UN (TFOp instr [arg1, arg2]) - $ TCon Ty.natRef 0 [result] - where - (arg1, arg2, result) = fresh - --- a -> b -> Option c - --- a -> Bool -boxToBool :: ForeignOp -boxToBool = - inBx arg result $ - boolift result - where - (arg, result) = fresh - --- a -> b -> Bool -boxBoxToBool :: ForeignOp -boxBoxToBool = - inBxBx arg1 arg2 result $ boolift result - where - (arg1, arg2, result) = fresh - --- a -> b -> c -> Bool -boxBoxBoxToBool :: ForeignOp -boxBoxBoxToBool = - inBxBxBx arg1 arg2 arg3 result $ boolift result - where - (arg1, arg2, arg3, result) = fresh - --- Nat -> c --- Works for an type that's packed into a word, just --- pass `wordDirect Ty.natRef`, `wordDirect Ty.floatRef` --- etc -wordDirect :: Reference -> ForeignOp -wordDirect wordType instr = - ([BX],) - . TAbss [b1] - . unbox b1 wordType ub1 - $ TFOp instr [ub1] - where - (b1, ub1) = fresh - --- Nat -> Bool -boxWordToBool :: Reference -> ForeignOp -boxWordToBool wordType instr = - ([BX, BX],) - . TAbss [b1, w1] - . unbox w1 wordType uw1 - $ TLetD result UN (TFOp instr [b1, uw1]) (boolift result) - where - (b1, w1, uw1, result) = fresh - --- Nat -> Nat -> c -wordWordDirect :: Reference -> Reference -> ForeignOp -wordWordDirect word1 word2 instr = - ([BX, BX],) - . TAbss [b1, b2] - . unbox b1 word1 ub1 - . unbox b2 word2 ub2 - $ TFOp instr [ub1, ub2] - where - (b1, b2, ub1, ub2) = fresh - --- Nat -> a -> c --- Works for an type that's packed into a word, just --- pass `wordBoxDirect Ty.natRef`, `wordBoxDirect Ty.floatRef` --- etc -wordBoxDirect :: Reference -> ForeignOp -wordBoxDirect wordType instr = - ([BX, BX],) - . TAbss [b1, b2] - . unbox b1 wordType ub1 - $ TFOp instr [ub1, b2] - where - (b1, b2, ub1) = fresh - --- a -> Nat -> c --- works for any second argument type that is packed into a word -boxWordDirect :: Reference -> ForeignOp -boxWordDirect wordType instr = - ([BX, BX],) - . TAbss [b1, b2] - . unbox b2 wordType ub2 - $ TFOp instr [b1, ub2] - where - (b1, b2, ub2) = fresh - --- a -> b -> c -boxBoxDirect :: ForeignOp -boxBoxDirect instr = - ([BX, BX],) - . TAbss [b1, b2] - $ TFOp instr [b1, b2] - where - (b1, b2) = fresh - --- a -> b -> c -> d -boxBoxBoxDirect :: ForeignOp -boxBoxBoxDirect instr = - ([BX, BX, BX],) - . TAbss [b1, b2, b3] - $ TFOp instr [b1, b2, b3] - where - (b1, b2, b3) = fresh - --- a -> Either Failure b -boxToEFBox :: ForeignOp -boxToEFBox = - inBx arg result $ - outIoFailBox stack1 stack2 stack3 any fail result - where - (arg, result, stack1, stack2, stack3, any, fail) = fresh - --- a -> Either Failure (b, c) -boxToEFTup :: ForeignOp -boxToEFTup = - inBx arg result $ - outIoFailTup stack1 stack2 stack3 stack4 stack5 extra fail result - where - (arg, result, stack1, stack2, stack3, stack4, stack5, extra, fail) = fresh - --- a -> Either Failure (Maybe b) -boxToEFMBox :: ForeignOp -boxToEFMBox = - inBx arg result - . outIoFailG stack1 stack2 stack3 fail result output - $ \k -> - ( [UN], - TAbs stack3 . TMatch stack3 . MatchSum $ - mapFromList - [ (0, ([], k $ none)), - (1, ([BX], TAbs stack4 . k $ some stack4)) - ] - ) - where - (arg, result, stack1, stack2, stack3, stack4, fail, output) = fresh - --- a -> Maybe b -boxToMaybeBox :: ForeignOp -boxToMaybeBox = - inBx arg result $ outMaybe maybe result - where - (arg, maybe, result) = fresh - --- a -> Maybe Nat -boxToMaybeNat :: ForeignOp -boxToMaybeNat = inBx arg tag $ outMaybeNat tag result n - where - (arg, tag, result, n) = fresh - --- a -> Maybe (Nat, b) -boxToMaybeNTup :: ForeignOp -boxToMaybeNTup = - inBx arg result $ outMaybeNTup a b c u bp p result - where - (arg, a, b, c, u, bp, p, result) = fresh - --- a -> b -> Maybe (c, d) -boxBoxToMaybeTup :: ForeignOp -boxBoxToMaybeTup = - inBxBx arg1 arg2 result $ outMaybeTup a b u bp ap result - where - (arg1, arg2, a, b, u, bp, ap, result) = fresh - --- a -> Either Failure Bool -boxToEFBool :: ForeignOp -boxToEFBool = - inBx arg result $ - outIoFailBool stack1 stack2 stack3 bool fail result - where - (arg, stack1, stack2, stack3, bool, fail, result) = fresh - --- a -> Either Failure Char -boxToEFChar :: ForeignOp -boxToEFChar = - inBx arg result $ - outIoFailChar stack1 stack2 stack3 bool fail result - where - (arg, stack1, stack2, stack3, bool, fail, result) = fresh - --- a -> b -> Either Failure Bool -boxBoxToEFBool :: ForeignOp -boxBoxToEFBool = - inBxBx arg1 arg2 result $ - outIoFailBool stack1 stack2 stack3 bool fail result - where - (arg1, arg2, stack1, stack2, stack3, bool, fail, result) = fresh - --- a -> b -> c -> Either Failure Bool -boxBoxBoxToEFBool :: ForeignOp -boxBoxBoxToEFBool = - inBxBxBx arg1 arg2 arg3 result $ - outIoFailBool stack1 stack2 stack3 bool fail result - where - (arg1, arg2, arg3, stack1, stack2, stack3, bool, fail, result) = fresh - --- a -> Either Failure () -boxToEF0 :: ForeignOp -boxToEF0 = - inBx arg result $ - outIoFailUnit stack1 stack2 stack3 unit fail result - where - (arg, result, stack1, stack2, stack3, unit, fail) = fresh - --- a -> b -> Either Failure () -boxBoxToEF0 :: ForeignOp -boxBoxToEF0 = - inBxBx arg1 arg2 result $ - outIoFailUnit stack1 stack2 stack3 fail unit result - where - (arg1, arg2, result, stack1, stack2, stack3, fail, unit) = fresh - --- a -> b -> c -> Either Failure () -boxBoxBoxToEF0 :: ForeignOp -boxBoxBoxToEF0 = - inBxBxBx arg1 arg2 arg3 result $ - outIoFailUnit stack1 stack2 stack3 fail unit result - where - (arg1, arg2, arg3, result, stack1, stack2, stack3, fail, unit) = fresh - --- a -> Either Failure Nat -boxToEFNat :: ForeignOp -boxToEFNat = - inBx arg result $ - outIoFailNat stack1 stack2 stack3 nat fail result - where - (arg, result, stack1, stack2, stack3, nat, fail) = fresh - --- Maybe a -> b -> Either Failure c -maybeBoxToEFBox :: ForeignOp -maybeBoxToEFBox = - inMaybeBx arg1 arg2 arg3 mb result $ - outIoFail stack1 stack2 stack3 any fail result - where - (arg1, arg2, arg3, mb, result, stack1, stack2, stack3, any, fail) = fresh - --- a -> b -> Either Failure c -boxBoxToEFBox :: ForeignOp -boxBoxToEFBox = - inBxBx arg1 arg2 result $ - outIoFail stack1 stack2 stack3 any fail result - where - (arg1, arg2, result, stack1, stack2, stack3, any, fail) = fresh - --- a -> b -> c -> Either Failure d -boxBoxBoxToEFBox :: ForeignOp -boxBoxBoxToEFBox = - inBxBxBx arg1 arg2 arg3 result $ - outIoFail stack1 stack2 stack3 any fail result - where - (arg1, arg2, arg3, result, stack1, stack2, stack3, any, fail) = fresh - --- Nat -> a --- Nat only -natToBox :: ForeignOp -natToBox = wordDirect Ty.natRef - --- Nat -> Nat -> a --- Nat only -natNatToBox :: ForeignOp -natNatToBox = wordWordDirect Ty.natRef Ty.natRef - --- Nat -> Nat -> a -> b -natNatBoxToBox :: ForeignOp -natNatBoxToBox instr = - ([BX, BX, BX],) - . TAbss [a1, a2, a3] - . unbox a1 Ty.natRef ua1 - . unbox a2 Ty.natRef ua2 - $ TFOp instr [ua1, ua2, a3] - where - (a1, a2, a3, ua1, ua2) = fresh - --- a -> Nat -> c --- Nat only -boxNatToBox :: ForeignOp -boxNatToBox = boxWordDirect Ty.natRef - --- a -> Nat -> Either Failure b -boxNatToEFBox :: ForeignOp -boxNatToEFBox = - inBxNat arg1 arg2 nat result $ - outIoFail stack1 stack2 stack3 any fail result - where - (arg1, arg2, nat, stack1, stack2, stack3, any, fail, result) = fresh - --- a -> Nat ->{Exception} b -boxNatToExnBox :: ForeignOp -boxNatToExnBox = - inBxNat arg1 arg2 nat result $ - outIoExnBox stack1 stack2 stack3 fail any result - where - (arg1, arg2, nat, stack1, stack2, stack3, any, fail, result) = fresh - --- a -> Nat -> b ->{Exception} () -boxNatBoxToExnUnit :: ForeignOp -boxNatBoxToExnUnit = - inBxNatBx arg1 arg2 arg3 nat result $ - outIoExnUnit stack1 stack2 stack3 any fail result - where - (arg1, arg2, arg3, nat, stack1, stack2, stack3, any, fail, result) = fresh - --- a -> Nat ->{Exception} Nat -boxNatToExnNat :: ForeignOp -boxNatToExnNat = - inBxNat arg1 arg2 nat result $ - outIoExnNat stack1 stack2 stack3 any fail result - where - (arg1, arg2, nat, stack1, stack2, stack3, any, fail, result) = fresh - --- a -> Nat -> Nat ->{Exception} () -boxNatNatToExnUnit :: ForeignOp -boxNatNatToExnUnit = - inBxNatNat arg1 arg2 arg3 nat1 nat2 result $ - outIoExnUnit stack1 stack2 stack3 any fail result - where - (arg1, arg2, arg3, nat1, nat2, result, stack1, stack2, stack3, any, fail) = fresh - --- a -> Nat -> Nat ->{Exception} b -boxNatNatToExnBox :: ForeignOp -boxNatNatToExnBox = - inBxNatNat arg1 arg2 arg3 nat1 nat2 result $ - outIoExnBox stack1 stack2 stack3 any fail result - where - (arg1, arg2, arg3, nat1, nat2, result, stack1, stack2, stack3, any, fail) = fresh - --- a -> Nat -> b -> Nat -> Nat ->{Exception} () -boxNatBoxNatNatToExnUnit :: ForeignOp -boxNatBoxNatNatToExnUnit instr = - ([BX, BX, BX, BX, BX],) - . TAbss [a0, a1, a2, a3, a4] - . unbox a1 Ty.natRef ua1 - . unbox a3 Ty.natRef ua3 - . unbox a4 Ty.natRef ua4 - . TLetD result UN (TFOp instr [a0, ua1, a2, ua3, ua4]) - $ outIoExnUnit stack1 stack2 stack3 any fail result - where - (a0, a1, a2, a3, a4, ua1, ua3, ua4, result, stack1, stack2, stack3, any, fail) = fresh - --- a ->{Exception} Either b c -boxToExnEBoxBox :: ForeignOp -boxToExnEBoxBox instr = - ([BX],) - . TAbs a - . TLetD t0 UN (TFOp instr [a]) - $ outIoExnEBoxBox stack1 stack2 stack3 any fail t0 t1 result - where - (a, stack1, stack2, stack3, any, fail, t0, t1, result) = fresh - --- Nat -> Either Failure b --- natToEFBox :: ForeignOp --- natToEFBox = inNat arg nat result $ outIoFail stack1 stack2 fail result --- where --- (arg, nat, stack1, stack2, fail, result) = fresh - --- Nat -> Either Failure () -natToEFUnit :: ForeignOp -natToEFUnit = - inNat arg nat result - . TMatch result - . MatchSum - $ mapFromList - [ failureCase stack1 stack2 stack3 unit fail, - ( 1, - ([],) - . TLetD unit BX (TCon Ty.unitRef 0 []) - $ right unit - ) - ] - where - (arg, nat, result, fail, stack1, stack2, stack3, unit) = fresh - --- a -> Either b c -boxToEBoxBox :: ForeignOp -boxToEBoxBox instr = - ([BX],) - . TAbss [b] - . TLetD e UN (TFOp instr [b]) - . TMatch e - . MatchSum - $ mapFromList - [ (0, ([BX], TAbs ev $ left ev)), - (1, ([BX], TAbs ev $ right ev)) - ] - where - (e, b, ev) = fresh - -builtinLookup :: Map.Map Reference (Sandbox, SuperNormal Symbol) -builtinLookup = - Map.fromList - . map (\(t, f) -> (Builtin t, f)) - $ [ ("Int.+", (Untracked, addi)), - ("Int.-", (Untracked, subi)), - ("Int.*", (Untracked, muli)), - ("Int./", (Untracked, divi)), - ("Int.mod", (Untracked, modi)), - ("Int.==", (Untracked, eqi)), - ("Int.<", (Untracked, lti)), - ("Int.<=", (Untracked, lei)), - ("Int.>", (Untracked, gti)), - ("Int.>=", (Untracked, gei)), - ("Int.fromRepresentation", (Untracked, coerceType Ty.natRef Ty.intRef)), - ("Int.toRepresentation", (Untracked, coerceType Ty.intRef Ty.natRef)), - ("Int.increment", (Untracked, inci)), - ("Int.signum", (Untracked, sgni)), - ("Int.negate", (Untracked, negi)), - ("Int.truncate0", (Untracked, trni)), - ("Int.isEven", (Untracked, evni)), - ("Int.isOdd", (Untracked, oddi)), - ("Int.shiftLeft", (Untracked, shli)), - ("Int.shiftRight", (Untracked, shri)), - ("Int.trailingZeros", (Untracked, tzeroi)), - ("Int.leadingZeros", (Untracked, lzeroi)), - ("Int.and", (Untracked, andi)), - ("Int.or", (Untracked, ori)), - ("Int.xor", (Untracked, xori)), - ("Int.complement", (Untracked, compli)), - ("Int.pow", (Untracked, powi)), - ("Int.toText", (Untracked, i2t)), - ("Int.fromText", (Untracked, t2i)), - ("Int.toFloat", (Untracked, i2f)), - ("Int.popCount", (Untracked, popi)), - ("Nat.+", (Untracked, addn)), - ("Nat.-", (Untracked, subn)), - ("Nat.sub", (Untracked, subn)), - ("Nat.*", (Untracked, muln)), - ("Nat./", (Untracked, divn)), - ("Nat.mod", (Untracked, modn)), - ("Nat.==", (Untracked, eqn)), - ("Nat.<", (Untracked, ltn)), - ("Nat.<=", (Untracked, len)), - ("Nat.>", (Untracked, gtn)), - ("Nat.>=", (Untracked, gen)), - ("Nat.increment", (Untracked, incn)), - ("Nat.isEven", (Untracked, evnn)), - ("Nat.isOdd", (Untracked, oddn)), - ("Nat.shiftLeft", (Untracked, shln)), - ("Nat.shiftRight", (Untracked, shrn)), - ("Nat.trailingZeros", (Untracked, tzeron)), - ("Nat.leadingZeros", (Untracked, lzeron)), - ("Nat.and", (Untracked, andn)), - ("Nat.or", (Untracked, orn)), - ("Nat.xor", (Untracked, xorn)), - ("Nat.complement", (Untracked, compln)), - ("Nat.pow", (Untracked, pown)), - ("Nat.drop", (Untracked, dropn)), - ("Nat.toInt", (Untracked, cast Ty.natRef Ty.intRef)), - ("Nat.toFloat", (Untracked, n2f)), - ("Nat.toText", (Untracked, n2t)), - ("Nat.fromText", (Untracked, t2n)), - ("Nat.popCount", (Untracked, popn)), - ("Float.+", (Untracked, addf)), - ("Float.-", (Untracked, subf)), - ("Float.*", (Untracked, mulf)), - ("Float./", (Untracked, divf)), - ("Float.pow", (Untracked, powf)), - ("Float.log", (Untracked, logf)), - ("Float.logBase", (Untracked, logbf)), - ("Float.sqrt", (Untracked, sqrtf)), - ("Float.fromRepresentation", (Untracked, coerceType Ty.natRef Ty.floatRef)), - ("Float.toRepresentation", (Untracked, coerceType Ty.floatRef Ty.natRef)), - ("Float.min", (Untracked, minf)), - ("Float.max", (Untracked, maxf)), - ("Float.<", (Untracked, ltf)), - ("Float.>", (Untracked, gtf)), - ("Float.<=", (Untracked, lef)), - ("Float.>=", (Untracked, gef)), - ("Float.==", (Untracked, eqf)), - ("Float.!=", (Untracked, neqf)), - ("Float.acos", (Untracked, acosf)), - ("Float.asin", (Untracked, asinf)), - ("Float.atan", (Untracked, atanf)), - ("Float.cos", (Untracked, cosf)), - ("Float.sin", (Untracked, sinf)), - ("Float.tan", (Untracked, tanf)), - ("Float.acosh", (Untracked, acoshf)), - ("Float.asinh", (Untracked, asinhf)), - ("Float.atanh", (Untracked, atanhf)), - ("Float.cosh", (Untracked, coshf)), - ("Float.sinh", (Untracked, sinhf)), - ("Float.tanh", (Untracked, tanhf)), - ("Float.exp", (Untracked, expf)), - ("Float.abs", (Untracked, absf)), - ("Float.ceiling", (Untracked, ceilf)), - ("Float.floor", (Untracked, floorf)), - ("Float.round", (Untracked, roundf)), - ("Float.truncate", (Untracked, truncf)), - ("Float.atan2", (Untracked, atan2f)), - ("Float.toText", (Untracked, f2t)), - ("Float.fromText", (Untracked, t2f)), - -- text - ("Text.empty", (Untracked, Lambda [] $ TLit (T ""))), - ("Text.++", (Untracked, appendt)), - ("Text.take", (Untracked, taket)), - ("Text.drop", (Untracked, dropt)), - ("Text.indexOf", (Untracked, indext)), - ("Text.size", (Untracked, sizet)), - ("Text.==", (Untracked, eqt)), - ("Text.!=", (Untracked, neqt)), - ("Text.<=", (Untracked, leqt)), - ("Text.>=", (Untracked, geqt)), - ("Text.<", (Untracked, lesst)), - ("Text.>", (Untracked, great)), - ("Text.uncons", (Untracked, unconst)), - ("Text.unsnoc", (Untracked, unsnoct)), - ("Text.toCharList", (Untracked, unpackt)), - ("Text.fromCharList", (Untracked, packt)), - ("Boolean.not", (Untracked, notb)), - ("Boolean.or", (Untracked, orb)), - ("Boolean.and", (Untracked, andb)), - ("bug", (Untracked, bug "builtin.bug")), - ("todo", (Untracked, bug "builtin.todo")), - ("Debug.watch", (Tracked, watch)), - ("Debug.trace", (Tracked, gen'trace)), - ("Debug.toText", (Tracked, debug'text)), - ("unsafe.coerceAbilities", (Untracked, poly'coerce)), - ("Char.toNat", (Untracked, cast Ty.charRef Ty.natRef)), - ("Char.fromNat", (Untracked, cast Ty.natRef Ty.charRef)), - ("Bytes.empty", (Untracked, emptyb)), - ("Bytes.fromList", (Untracked, packb)), - ("Bytes.toList", (Untracked, unpackb)), - ("Bytes.++", (Untracked, appendb)), - ("Bytes.take", (Untracked, takeb)), - ("Bytes.drop", (Untracked, dropb)), - ("Bytes.at", (Untracked, atb)), - ("Bytes.indexOf", (Untracked, indexb)), - ("Bytes.size", (Untracked, sizeb)), - ("Bytes.flatten", (Untracked, flattenb)), - ("List.take", (Untracked, takes)), - ("List.drop", (Untracked, drops)), - ("List.size", (Untracked, sizes)), - ("List.++", (Untracked, appends)), - ("List.at", (Untracked, ats)), - ("List.cons", (Untracked, conss)), - ("List.snoc", (Untracked, snocs)), - ("List.empty", (Untracked, emptys)), - ("List.viewl", (Untracked, viewls)), - ("List.viewr", (Untracked, viewrs)), - ("List.splitLeft", (Untracked, splitls)), - ("List.splitRight", (Untracked, splitrs)), - -- - -- , B "Debug.watch" $ forall1 "a" (\a -> text --> a --> a) - ("Universal.==", (Untracked, equ)), - ("Universal.compare", (Untracked, cmpu)), - ("Universal.>", (Untracked, gtu)), - ("Universal.<", (Untracked, ltu)), - ("Universal.>=", (Untracked, geu)), - ("Universal.<=", (Untracked, leu)), - -- internal stuff - ("jumpCont", (Untracked, jumpk)), - ("raise", (Untracked, raise)), - ("IO.forkComp.v2", (Tracked, fork'comp)), - ("Scope.run", (Untracked, scope'run)), - ("Code.isMissing", (Tracked, code'missing)), - ("Code.cache_", (Tracked, code'cache)), - ("Code.lookup", (Tracked, code'lookup)), - ("Code.validate", (Tracked, code'validate)), - ("Value.load", (Tracked, value'load)), - ("Value.value", (Tracked, value'create)), - ("Any.Any", (Untracked, any'construct)), - ("Any.unsafeExtract", (Untracked, any'extract)), - ("Link.Term.toText", (Untracked, term'link'to'text)), - ("STM.atomically", (Tracked, stm'atomic)), - ("validateSandboxed", (Untracked, check'sandbox)), - ("Value.validateSandboxed", (Tracked, value'sandbox)), - ("sandboxLinks", (Tracked, sandbox'links)), - ("IO.tryEval", (Tracked, try'eval)) - ] - ++ foreignWrappers - -type FDecl v = - ReaderT Bool (State (Word64, [(Data.Text.Text, (Sandbox, SuperNormal v))], EnumMap Word64 (Data.Text.Text, ForeignFunc))) - --- Data type to determine whether a builtin should be tracked for --- sandboxing. Untracked means that it can be freely used, and Tracked --- means that the sandboxing check will by default consider them --- disallowed. -data Sandbox = Tracked | Untracked - deriving (Eq, Ord, Show, Read, Enum, Bounded) - -bomb :: Data.Text.Text -> a -> IO r -bomb name _ = die $ "attempted to use sandboxed operation: " ++ Data.Text.unpack name - -declareForeign :: - Sandbox -> - Data.Text.Text -> - ForeignOp -> - ForeignFunc -> - FDecl Symbol () -declareForeign sand name op func0 = do - sanitize <- ask - modify $ \(w, codes, funcs) -> - let func - | sanitize, - Tracked <- sand, - FF r w _ <- func0 = - FF r w (bomb name) - | otherwise = func0 - code = (name, (sand, uncurry Lambda (op w))) - in (w + 1, code : codes, mapInsert w (name, func) funcs) - -mkForeignIOF :: - (ForeignConvention a, ForeignConvention r) => - (a -> IO r) -> - ForeignFunc -mkForeignIOF f = mkForeign $ \a -> tryIOE (f a) - where - tryIOE :: IO a -> IO (Either Failure a) - tryIOE = fmap handleIOE . try - handleIOE :: Either IOException a -> Either Failure a - handleIOE (Left e) = Left $ Failure Ty.ioFailureRef (Util.Text.pack (show e)) unitValue - handleIOE (Right a) = Right a - -unitValue :: Closure -unitValue = Closure.Enum Ty.unitRef 0 - -natValue :: Word64 -> Closure -natValue w = Closure.DataU1 Ty.natRef 0 (fromIntegral w) - -mkForeignTls :: - forall a r. - (ForeignConvention a, ForeignConvention r) => - (a -> IO r) -> - ForeignFunc -mkForeignTls f = mkForeign $ \a -> fmap flatten (tryIO2 (tryIO1 (f a))) - where - tryIO1 :: IO r -> IO (Either TLS.TLSException r) - tryIO1 = try - tryIO2 :: IO (Either TLS.TLSException r) -> IO (Either IOException (Either TLS.TLSException r)) - tryIO2 = try - flatten :: Either IOException (Either TLS.TLSException r) -> Either (Failure) r - flatten (Left e) = Left (Failure Ty.ioFailureRef (Util.Text.pack (show e)) unitValue) - flatten (Right (Left e)) = Left (Failure Ty.tlsFailureRef (Util.Text.pack (show e)) unitValue) - flatten (Right (Right a)) = Right a - -mkForeignTlsE :: - forall a r. - (ForeignConvention a, ForeignConvention r) => - (a -> IO (Either Failure r)) -> - ForeignFunc -mkForeignTlsE f = mkForeign $ \a -> fmap flatten (tryIO2 (tryIO1 (f a))) - where - tryIO1 :: IO (Either Failure r) -> IO (Either TLS.TLSException (Either Failure r)) - tryIO1 = try - tryIO2 :: IO (Either TLS.TLSException (Either Failure r)) -> IO (Either IOException (Either TLS.TLSException (Either Failure r))) - tryIO2 = try - flatten :: Either IOException (Either TLS.TLSException (Either Failure r)) -> Either Failure r - flatten (Left e) = Left (Failure Ty.ioFailureRef (Util.Text.pack (show e)) unitValue) - flatten (Right (Left e)) = Left (Failure Ty.tlsFailureRef (Util.Text.pack (show e)) unitValue) - flatten (Right (Right (Left e))) = Left e - flatten (Right (Right (Right a))) = Right a - -declareUdpForeigns :: FDecl Symbol () -declareUdpForeigns = do - declareForeign Tracked "IO.UDP.clientSocket.impl.v1" boxBoxToEFBox - . mkForeignIOF - $ \(host :: Util.Text.Text, port :: Util.Text.Text) -> - let hostStr = Util.Text.toString host - portStr = Util.Text.toString port - in UDP.clientSocket hostStr portStr True - - declareForeign Tracked "IO.UDP.UDPSocket.recv.impl.v1" boxToEFBox - . mkForeignIOF - $ \(sock :: UDPSocket) -> Bytes.fromArray <$> UDP.recv sock - - declareForeign Tracked "IO.UDP.UDPSocket.send.impl.v1" boxBoxToEF0 - . mkForeignIOF - $ \(sock :: UDPSocket, bytes :: Bytes.Bytes) -> - UDP.send sock (Bytes.toArray bytes) - - declareForeign Tracked "IO.UDP.UDPSocket.close.impl.v1" boxToEF0 - . mkForeignIOF - $ \(sock :: UDPSocket) -> UDP.close sock - - declareForeign Tracked "IO.UDP.ListenSocket.close.impl.v1" boxToEF0 - . mkForeignIOF - $ \(sock :: ListenSocket) -> UDP.stop sock - - declareForeign Tracked "IO.UDP.UDPSocket.toText.impl.v1" boxDirect - . mkForeign - $ \(sock :: UDPSocket) -> pure $ show sock - - declareForeign Tracked "IO.UDP.serverSocket.impl.v1" boxBoxToEFBox - . mkForeignIOF - $ \(ip :: Util.Text.Text, port :: Util.Text.Text) -> - let maybeIp = readMaybe $ Util.Text.toString ip :: Maybe IP - maybePort = readMaybe $ Util.Text.toString port :: Maybe PortNumber - in case (maybeIp, maybePort) of - (Nothing, _) -> fail "Invalid IP Address" - (_, Nothing) -> fail "Invalid Port Number" - (Just ip, Just pt) -> UDP.serverSocket (ip, pt) - - declareForeign Tracked "IO.UDP.ListenSocket.toText.impl.v1" boxDirect - . mkForeign - $ \(sock :: ListenSocket) -> pure $ show sock - - declareForeign Tracked "IO.UDP.ListenSocket.recvFrom.impl.v1" boxToEFTup - . mkForeignIOF - $ fmap (first Bytes.fromArray) <$> UDP.recvFrom - - declareForeign Tracked "IO.UDP.ClientSockAddr.toText.v1" boxDirect - . mkForeign - $ \(sock :: ClientSockAddr) -> pure $ show sock - - declareForeign Tracked "IO.UDP.ListenSocket.sendTo.impl.v1" boxBoxBoxToEF0 - . mkForeignIOF - $ \(socket :: ListenSocket, bytes :: Bytes.Bytes, addr :: ClientSockAddr) -> - UDP.sendTo socket (Bytes.toArray bytes) addr - -declareForeigns :: FDecl Symbol () -declareForeigns = do - declareUdpForeigns - declareForeign Tracked "IO.openFile.impl.v3" boxIomrToEFBox $ - mkForeignIOF $ \(fnameText :: Util.Text.Text, n :: Int) -> - let fname = Util.Text.toString fnameText - mode = case n of - 0 -> ReadMode - 1 -> WriteMode - 2 -> AppendMode - _ -> ReadWriteMode - in openFile fname mode - - declareForeign Tracked "IO.closeFile.impl.v3" boxToEF0 $ mkForeignIOF hClose - declareForeign Tracked "IO.isFileEOF.impl.v3" boxToEFBool $ mkForeignIOF hIsEOF - declareForeign Tracked "IO.isFileOpen.impl.v3" boxToEFBool $ mkForeignIOF hIsOpen - declareForeign Tracked "IO.getEcho.impl.v1" boxToEFBool $ mkForeignIOF hGetEcho - declareForeign Tracked "IO.ready.impl.v1" boxToEFBool $ mkForeignIOF hReady - declareForeign Tracked "IO.getChar.impl.v1" boxToEFChar $ mkForeignIOF hGetChar - declareForeign Tracked "IO.isSeekable.impl.v3" boxToEFBool $ mkForeignIOF hIsSeekable - - declareForeign Tracked "IO.seekHandle.impl.v3" seek'handle - . mkForeignIOF - $ \(h, sm, n) -> hSeek h sm (fromIntegral (n :: Int)) - - declareForeign Tracked "IO.handlePosition.impl.v3" boxToEFNat - -- TODO: truncating integer - . mkForeignIOF - $ \h -> fromInteger @Word64 <$> hTell h - - declareForeign Tracked "IO.getBuffering.impl.v3" get'buffering $ - mkForeignIOF hGetBuffering - - declareForeign Tracked "IO.setBuffering.impl.v3" set'buffering - . mkForeignIOF - $ uncurry hSetBuffering - - declareForeign Tracked "IO.setEcho.impl.v1" set'echo . mkForeignIOF $ uncurry hSetEcho - - declareForeign Tracked "IO.getLine.impl.v1" boxToEFBox $ - mkForeignIOF $ - fmap Util.Text.fromText . Text.IO.hGetLine - - declareForeign Tracked "IO.getBytes.impl.v3" boxNatToEFBox . mkForeignIOF $ - \(h, n) -> Bytes.fromArray <$> hGet h n - - declareForeign Tracked "IO.getSomeBytes.impl.v1" boxNatToEFBox . mkForeignIOF $ - \(h, n) -> Bytes.fromArray <$> hGetSome h n - - declareForeign Tracked "IO.putBytes.impl.v3" boxBoxToEF0 . mkForeignIOF $ \(h, bs) -> hPut h (Bytes.toArray bs) - - declareForeign Tracked "IO.systemTime.impl.v3" unitToEFNat $ - mkForeignIOF $ - \() -> getPOSIXTime - - declareForeign Tracked "IO.systemTimeMicroseconds.v1" unitToInt $ - mkForeign $ - \() -> fmap (1e6 *) getPOSIXTime - - declareForeign Tracked "Clock.internals.monotonic.v1" unitToEFBox $ - mkForeignIOF $ - \() -> getTime Monotonic - - declareForeign Tracked "Clock.internals.realtime.v1" unitToEFBox $ - mkForeignIOF $ - \() -> getTime Realtime - - declareForeign Tracked "Clock.internals.processCPUTime.v1" unitToEFBox $ - mkForeignIOF $ - \() -> getTime ProcessCPUTime - - declareForeign Tracked "Clock.internals.threadCPUTime.v1" unitToEFBox $ - mkForeignIOF $ - \() -> getTime ThreadCPUTime - - declareForeign Tracked "Clock.internals.sec.v1" boxToInt $ - mkForeign (\n -> pure (fromIntegral $ sec n :: Word64)) - - -- A TimeSpec that comes from getTime never has negative nanos, - -- so we can safely cast to Nat - declareForeign Tracked "Clock.internals.nsec.v1" boxToNat $ - mkForeign (\n -> pure (fromIntegral $ nsec n :: Word64)) - - declareForeign Tracked "Clock.internals.systemTimeZone.v1" time'zone $ - mkForeign - ( \secs -> do - TimeZone offset summer name <- getTimeZone (posixSecondsToUTCTime (fromIntegral (secs :: Int))) - pure (offset :: Int, summer, name) - ) - - let chop = reverse . dropWhile isPathSeparator . reverse - - declareForeign Tracked "IO.getTempDirectory.impl.v3" unitToEFBox $ - mkForeignIOF $ - \() -> chop <$> getTemporaryDirectory - - declareForeign Tracked "IO.createTempDirectory.impl.v3" boxToEFBox $ - mkForeignIOF $ \prefix -> do - temp <- getTemporaryDirectory - chop <$> createTempDirectory temp prefix - - declareForeign Tracked "IO.getCurrentDirectory.impl.v3" unitToEFBox - . mkForeignIOF - $ \() -> getCurrentDirectory - - declareForeign Tracked "IO.setCurrentDirectory.impl.v3" boxToEF0 $ - mkForeignIOF setCurrentDirectory - - declareForeign Tracked "IO.fileExists.impl.v3" boxToEFBool $ - mkForeignIOF doesPathExist - - declareForeign Tracked "IO.getEnv.impl.v1" boxToEFBox $ - mkForeignIOF getEnv - - declareForeign Tracked "IO.getArgs.impl.v1" unitToEFBox $ - mkForeignIOF $ - \() -> fmap Util.Text.pack <$> SYS.getArgs - - declareForeign Tracked "IO.isDirectory.impl.v3" boxToEFBool $ - mkForeignIOF doesDirectoryExist - - declareForeign Tracked "IO.createDirectory.impl.v3" boxToEF0 $ - mkForeignIOF $ - createDirectoryIfMissing True - - declareForeign Tracked "IO.removeDirectory.impl.v3" boxToEF0 $ - mkForeignIOF removeDirectoryRecursive - - declareForeign Tracked "IO.renameDirectory.impl.v3" boxBoxToEF0 $ - mkForeignIOF $ - uncurry renameDirectory - - declareForeign Tracked "IO.directoryContents.impl.v3" boxToEFBox $ - mkForeignIOF $ - (fmap Util.Text.pack <$>) . getDirectoryContents - - declareForeign Tracked "IO.removeFile.impl.v3" boxToEF0 $ - mkForeignIOF removeFile - - declareForeign Tracked "IO.renameFile.impl.v3" boxBoxToEF0 $ - mkForeignIOF $ - uncurry renameFile - - declareForeign Tracked "IO.getFileTimestamp.impl.v3" boxToEFNat - . mkForeignIOF - $ fmap utcTimeToPOSIXSeconds . getModificationTime - - declareForeign Tracked "IO.getFileSize.impl.v3" boxToEFNat - -- TODO: truncating integer - . mkForeignIOF - $ \fp -> fromInteger @Word64 <$> getFileSize fp - - declareForeign Tracked "IO.serverSocket.impl.v3" maybeBoxToEFBox - . mkForeignIOF - $ \( mhst :: Maybe Util.Text.Text, - port - ) -> - fst <$> SYS.bindSock (hostPreference mhst) port - - declareForeign Tracked "Socket.toText" boxDirect - . mkForeign - $ \(sock :: Socket) -> pure $ show sock - - declareForeign Tracked "Handle.toText" boxDirect - . mkForeign - $ \(hand :: Handle) -> pure $ show hand - - declareForeign Tracked "ThreadId.toText" boxDirect - . mkForeign - $ \(threadId :: ThreadId) -> pure $ show threadId - - declareForeign Tracked "IO.socketPort.impl.v3" boxToEFNat - . mkForeignIOF - $ \(handle :: Socket) -> do - n <- SYS.socketPort handle - return (fromIntegral n :: Word64) - - declareForeign Tracked "IO.listen.impl.v3" boxToEF0 - . mkForeignIOF - $ \sk -> SYS.listenSock sk 2048 - - declareForeign Tracked "IO.clientSocket.impl.v3" boxBoxToEFBox - . mkForeignIOF - $ fmap fst . uncurry SYS.connectSock - - declareForeign Tracked "IO.closeSocket.impl.v3" boxToEF0 $ - mkForeignIOF SYS.closeSock - - declareForeign Tracked "IO.socketAccept.impl.v3" boxToEFBox - . mkForeignIOF - $ fmap fst . SYS.accept - - declareForeign Tracked "IO.socketSend.impl.v3" boxBoxToEF0 - . mkForeignIOF - $ \(sk, bs) -> SYS.send sk (Bytes.toArray bs) - - declareForeign Tracked "IO.socketReceive.impl.v3" boxNatToEFBox - . mkForeignIOF - $ \(hs, n) -> - maybe mempty Bytes.fromArray <$> SYS.recv hs n - - declareForeign Tracked "IO.kill.impl.v3" boxToEF0 $ mkForeignIOF killThread - - let mx :: Word64 - mx = fromIntegral (maxBound :: Int) - - customDelay :: Word64 -> IO () - customDelay n - | n < mx = threadDelay (fromIntegral n) - | otherwise = threadDelay maxBound >> customDelay (n - mx) - - declareForeign Tracked "IO.delay.impl.v3" natToEFUnit $ - mkForeignIOF customDelay - - declareForeign Tracked "IO.stdHandle" standard'handle - . mkForeign - $ \(n :: Int) -> case n of - 0 -> pure SYS.stdin - 1 -> pure SYS.stdout - 2 -> pure SYS.stderr - _ -> die "IO.stdHandle: invalid input." - - let exitDecode ExitSuccess = 0 - exitDecode (ExitFailure n) = n - - declareForeign Tracked "IO.process.call" boxBoxToNat . mkForeign $ - \(exe, map Util.Text.unpack -> args) -> - withCreateProcess (proc exe args) $ \_ _ _ p -> - exitDecode <$> waitForProcess p - - declareForeign Tracked "IO.process.start" start'process . mkForeign $ - \(exe, map Util.Text.unpack -> args) -> - runInteractiveProcess exe args Nothing Nothing - - declareForeign Tracked "IO.process.kill" boxTo0 . mkForeign $ - terminateProcess - - declareForeign Tracked "IO.process.wait" boxToNat . mkForeign $ - \ph -> exitDecode <$> waitForProcess ph - - declareForeign Tracked "IO.process.exitCode" boxToMaybeNat . mkForeign $ - fmap (fmap exitDecode) . getProcessExitCode - - declareForeign Tracked "MVar.new" boxDirect - . mkForeign - $ \(c :: Closure) -> newMVar c - - declareForeign Tracked "MVar.newEmpty.v2" unitDirect - . mkForeign - $ \() -> newEmptyMVar @Closure - - declareForeign Tracked "MVar.take.impl.v3" boxToEFBox - . mkForeignIOF - $ \(mv :: MVar Closure) -> takeMVar mv - - declareForeign Tracked "MVar.tryTake" boxToMaybeBox - . mkForeign - $ \(mv :: MVar Closure) -> tryTakeMVar mv - - declareForeign Tracked "MVar.put.impl.v3" boxBoxToEF0 - . mkForeignIOF - $ \(mv :: MVar Closure, x) -> putMVar mv x - - declareForeign Tracked "MVar.tryPut.impl.v3" boxBoxToEFBool - . mkForeignIOF - $ \(mv :: MVar Closure, x) -> tryPutMVar mv x - - declareForeign Tracked "MVar.swap.impl.v3" boxBoxToEFBox - . mkForeignIOF - $ \(mv :: MVar Closure, x) -> swapMVar mv x - - declareForeign Tracked "MVar.isEmpty" boxToBool - . mkForeign - $ \(mv :: MVar Closure) -> isEmptyMVar mv - - declareForeign Tracked "MVar.read.impl.v3" boxToEFBox - . mkForeignIOF - $ \(mv :: MVar Closure) -> readMVar mv - - declareForeign Tracked "MVar.tryRead.impl.v3" boxToEFMBox - . mkForeignIOF - $ \(mv :: MVar Closure) -> tryReadMVar mv - - declareForeign Untracked "Char.toText" (wordDirect Ty.charRef) . mkForeign $ - \(ch :: Char) -> pure (Util.Text.singleton ch) - - declareForeign Untracked "Text.repeat" (wordBoxDirect Ty.natRef) . mkForeign $ - \(n :: Word64, txt :: Util.Text.Text) -> pure (Util.Text.replicate (fromIntegral n) txt) - - declareForeign Untracked "Text.reverse" boxDirect . mkForeign $ - pure . Util.Text.reverse - - declareForeign Untracked "Text.toUppercase" boxDirect . mkForeign $ - pure . Util.Text.toUppercase - - declareForeign Untracked "Text.toLowercase" boxDirect . mkForeign $ - pure . Util.Text.toLowercase - - declareForeign Untracked "Text.toUtf8" boxDirect . mkForeign $ - pure . Util.Text.toUtf8 - - declareForeign Untracked "Text.fromUtf8.impl.v3" boxToEFBox . mkForeign $ - pure . mapLeft (\t -> Failure Ty.ioFailureRef (Util.Text.pack t) unitValue) . Util.Text.fromUtf8 - - declareForeign Tracked "Tls.ClientConfig.default" boxBoxDirect . mkForeign $ - \(hostName :: Util.Text.Text, serverId :: Bytes.Bytes) -> - fmap - ( \store -> - (defaultParamsClient (Util.Text.unpack hostName) (Bytes.toArray serverId)) - { TLS.clientSupported = def {TLS.supportedCiphers = Cipher.ciphersuite_strong}, - TLS.clientShared = def {TLS.sharedCAStore = store} - } - ) - X.getSystemCertificateStore - - declareForeign Tracked "Tls.ServerConfig.default" boxBoxDirect $ - mkForeign $ - \(certs :: [X.SignedCertificate], key :: X.PrivKey) -> - pure $ - (def :: TLS.ServerParams) - { TLS.serverSupported = def {TLS.supportedCiphers = Cipher.ciphersuite_strong}, - TLS.serverShared = def {TLS.sharedCredentials = Credentials [(X.CertificateChain certs, key)]} - } - - let updateClient :: X.CertificateStore -> TLS.ClientParams -> TLS.ClientParams - updateClient certs client = client {TLS.clientShared = ((clientShared client) {TLS.sharedCAStore = certs})} - in declareForeign Tracked "Tls.ClientConfig.certificates.set" boxBoxDirect . mkForeign $ - \(certs :: [X.SignedCertificate], params :: ClientParams) -> pure $ updateClient (X.makeCertificateStore certs) params - - let updateServer :: X.CertificateStore -> TLS.ServerParams -> TLS.ServerParams - updateServer certs client = client {TLS.serverShared = ((serverShared client) {TLS.sharedCAStore = certs})} - in declareForeign Tracked "Tls.ServerConfig.certificates.set" boxBoxDirect . mkForeign $ - \(certs :: [X.SignedCertificate], params :: ServerParams) -> pure $ updateServer (X.makeCertificateStore certs) params - - declareForeign Tracked "TVar.new" boxDirect . mkForeign $ - \(c :: Closure) -> unsafeSTMToIO $ STM.newTVar c - - declareForeign Tracked "TVar.read" boxDirect . mkForeign $ - \(v :: STM.TVar Closure) -> unsafeSTMToIO $ STM.readTVar v - - declareForeign Tracked "TVar.write" boxBoxTo0 . mkForeign $ - \(v :: STM.TVar Closure, c :: Closure) -> - unsafeSTMToIO $ STM.writeTVar v c - - declareForeign Tracked "TVar.newIO" boxDirect . mkForeign $ - \(c :: Closure) -> STM.newTVarIO c - - declareForeign Tracked "TVar.readIO" boxDirect . mkForeign $ - \(v :: STM.TVar Closure) -> STM.readTVarIO v - - declareForeign Tracked "TVar.swap" boxBoxDirect . mkForeign $ - \(v, c :: Closure) -> unsafeSTMToIO $ STM.swapTVar v c - - declareForeign Tracked "STM.retry" unitDirect . mkForeign $ - \() -> unsafeSTMToIO STM.retry :: IO Closure - - -- Scope and Ref stuff - declareForeign Untracked "Scope.ref" boxDirect - . mkForeign - $ \(c :: Closure) -> newIORef c - - declareForeign Tracked "IO.ref" boxDirect - . mkForeign - $ \(c :: Closure) -> evaluate c >>= newIORef - - -- The docs for IORef state that IORef operations can be observed - -- out of order ([1]) but actually GHC does emit the appropriate - -- load and store barriers nowadays ([2], [3]). - -- - -- [1] https://hackage.haskell.org/package/base-4.17.0.0/docs/Data-IORef.html#g:2 - -- [2] https://github.com/ghc/ghc/blob/master/compiler/GHC/StgToCmm/Prim.hs#L286 - -- [3] https://github.com/ghc/ghc/blob/master/compiler/GHC/StgToCmm/Prim.hs#L298 - declareForeign Untracked "Ref.read" boxDirect . mkForeign $ - \(r :: IORef Closure) -> readIORef r - - declareForeign Untracked "Ref.write" boxBoxTo0 . mkForeign $ - \(r :: IORef Closure, c :: Closure) -> evaluate c >>= writeIORef r - - declareForeign Tracked "Ref.readForCas" boxDirect . mkForeign $ - \(r :: IORef Closure) -> readForCAS r - - declareForeign Tracked "Ref.Ticket.read" boxDirect . mkForeign $ - \(t :: Ticket Closure) -> pure $ peekTicket t - - -- In GHC, CAS returns both a Boolean and the current value of the - -- IORef, which can be used to retry a failed CAS. - -- This strategy is more efficient than returning a Boolean only - -- because it uses a single call to cmpxchg in assembly (see [1]) to - -- avoid an extra read per CAS iteration, however it's not supported - -- in Scheme. - -- Therefore, we adopt the more common signature that only returns a - -- Boolean, which doesn't even suffer from spurious failures because - -- GHC issues loads of mutable variables with memory_order_acquire - -- (see [2]) - -- - -- [1]: https://github.com/ghc/ghc/blob/master/rts/PrimOps.cmm#L697 - -- [2]: https://github.com/ghc/ghc/blob/master/compiler/GHC/StgToCmm/Prim.hs#L285 - declareForeign Tracked "Ref.cas" boxBoxBoxToBool . mkForeign $ - \(r :: IORef Closure, t :: Ticket Closure, v :: Closure) -> fmap fst $ - do - t <- evaluate t - casIORef r t v - - declareForeign Tracked "Promise.new" unitDirect . mkForeign $ - \() -> newPromise @Closure - - -- the only exceptions from Promise.read are async and shouldn't be caught - declareForeign Tracked "Promise.read" boxDirect . mkForeign $ - \(p :: Promise Closure) -> readPromise p - - declareForeign Tracked "Promise.tryRead" boxToMaybeBox . mkForeign $ - \(p :: Promise Closure) -> tryReadPromise p - - declareForeign Tracked "Promise.write" boxBoxToBool . mkForeign $ - \(p :: Promise Closure, a :: Closure) -> writePromise p a - - declareForeign Tracked "Tls.newClient.impl.v3" boxBoxToEFBox . mkForeignTls $ - \( config :: TLS.ClientParams, - socket :: SYS.Socket - ) -> TLS.contextNew socket config - - declareForeign Tracked "Tls.newServer.impl.v3" boxBoxToEFBox . mkForeignTls $ - \( config :: TLS.ServerParams, - socket :: SYS.Socket - ) -> TLS.contextNew socket config - - declareForeign Tracked "Tls.handshake.impl.v3" boxToEF0 . mkForeignTls $ - \(tls :: TLS.Context) -> TLS.handshake tls - - declareForeign Tracked "Tls.send.impl.v3" boxBoxToEF0 . mkForeignTls $ - \( tls :: TLS.Context, - bytes :: Bytes.Bytes - ) -> TLS.sendData tls (Bytes.toLazyByteString bytes) - - let wrapFailure t = Failure Ty.tlsFailureRef (Util.Text.pack t) unitValue - decoded :: Bytes.Bytes -> Either String PEM - decoded bytes = case pemParseLBS $ Bytes.toLazyByteString bytes of - Right (pem : _) -> Right pem - Right [] -> Left "no PEM found" - Left l -> Left l - asCert :: PEM -> Either String X.SignedCertificate - asCert pem = X.decodeSignedCertificate $ pemContent pem - in declareForeign Tracked "Tls.decodeCert.impl.v3" boxToEFBox . mkForeignTlsE $ - \(bytes :: Bytes.Bytes) -> pure $ mapLeft wrapFailure $ (decoded >=> asCert) bytes - - declareForeign Tracked "Tls.encodeCert" boxDirect . mkForeign $ - \(cert :: X.SignedCertificate) -> pure $ Bytes.fromArray $ X.encodeSignedObject cert - - declareForeign Tracked "Tls.decodePrivateKey" boxDirect . mkForeign $ - \(bytes :: Bytes.Bytes) -> pure $ X.readKeyFileFromMemory $ L.toStrict $ Bytes.toLazyByteString bytes - - declareForeign Tracked "Tls.encodePrivateKey" boxDirect . mkForeign $ - \(privateKey :: X.PrivKey) -> pure $ Util.Text.toUtf8 $ Util.Text.pack $ show privateKey - - declareForeign Tracked "Tls.receive.impl.v3" boxToEFBox . mkForeignTls $ - \(tls :: TLS.Context) -> do - bs <- TLS.recvData tls - pure $ Bytes.fromArray bs - - declareForeign Tracked "Tls.terminate.impl.v3" boxToEF0 . mkForeignTls $ - \(tls :: TLS.Context) -> TLS.bye tls - - declareForeign Untracked "Code.validateLinks" boxToExnEBoxBox - . mkForeign - $ \(lsgs0 :: [(Referent, SuperGroup Symbol)]) -> do - let f (msg, rs) = - Failure Ty.miscFailureRef (Util.Text.fromText msg) rs - pure . first f $ checkGroupHashes lsgs0 - declareForeign Untracked "Code.dependencies" boxDirect - . mkForeign - $ \(sg :: SuperGroup Symbol) -> - pure $ Wrap Ty.termLinkRef . Ref <$> groupTermLinks sg - declareForeign Untracked "Code.serialize" boxDirect - . mkForeign - $ \(sg :: SuperGroup Symbol) -> - pure . Bytes.fromArray $ serializeGroup builtinForeignNames sg - declareForeign Untracked "Code.deserialize" boxToEBoxBox - . mkForeign - $ pure . deserializeGroup @Symbol . Bytes.toArray - declareForeign Untracked "Code.display" boxBoxDirect . mkForeign $ - \(nm, sg) -> pure $ prettyGroup @Symbol (Util.Text.unpack nm) sg "" - declareForeign Untracked "Value.dependencies" boxDirect - . mkForeign - $ pure . fmap (Wrap Ty.termLinkRef . Ref) . valueTermLinks - declareForeign Untracked "Value.serialize" boxDirect - . mkForeign - $ pure . Bytes.fromArray . serializeValue - declareForeign Untracked "Value.deserialize" boxToEBoxBox - . mkForeign - $ pure . deserializeValue . Bytes.toArray - -- Hashing functions - let declareHashAlgorithm :: forall alg. (Hash.HashAlgorithm alg) => Data.Text.Text -> alg -> FDecl Symbol () - declareHashAlgorithm txt alg = do - let algoRef = Builtin ("crypto.HashAlgorithm." <> txt) - declareForeign Untracked ("crypto.HashAlgorithm." <> txt) direct . mkForeign $ \() -> - pure (HashAlgorithm algoRef alg) - - declareHashAlgorithm "Sha3_512" Hash.SHA3_512 - declareHashAlgorithm "Sha3_256" Hash.SHA3_256 - declareHashAlgorithm "Sha2_512" Hash.SHA512 - declareHashAlgorithm "Sha2_256" Hash.SHA256 - declareHashAlgorithm "Sha1" Hash.SHA1 - declareHashAlgorithm "Blake2b_512" Hash.Blake2b_512 - declareHashAlgorithm "Blake2b_256" Hash.Blake2b_256 - declareHashAlgorithm "Blake2s_256" Hash.Blake2s_256 - declareHashAlgorithm "Md5" Hash.MD5 - - declareForeign Untracked "crypto.hashBytes" boxBoxDirect . mkForeign $ - \(HashAlgorithm _ alg, b :: Bytes.Bytes) -> - let ctx = Hash.hashInitWith alg - in pure . Bytes.fromArray . Hash.hashFinalize $ Hash.hashUpdates ctx (Bytes.byteStringChunks b) - - declareForeign Untracked "crypto.hmacBytes" boxBoxBoxDirect - . mkForeign - $ \(HashAlgorithm _ alg, key :: Bytes.Bytes, msg :: Bytes.Bytes) -> - let out = u alg $ HMAC.hmac (Bytes.toArray @BA.Bytes key) (Bytes.toArray @BA.Bytes msg) - u :: a -> HMAC.HMAC a -> HMAC.HMAC a - u _ h = h -- to help typechecker along - in pure $ Bytes.fromArray out - - declareForeign Untracked "crypto.hash" crypto'hash . mkForeign $ - \(HashAlgorithm _ alg, x) -> - let hashlazy :: - (Hash.HashAlgorithm a) => - a -> - L.ByteString -> - Hash.Digest a - hashlazy _ l = Hash.hashlazy l - in pure . Bytes.fromArray . hashlazy alg $ serializeValueLazy x - - declareForeign Untracked "crypto.hmac" crypto'hmac . mkForeign $ - \(HashAlgorithm _ alg, key, x) -> - let hmac :: - (Hash.HashAlgorithm a) => a -> L.ByteString -> HMAC.HMAC a - hmac _ s = - HMAC.finalize - . HMAC.updates - (HMAC.initialize $ Bytes.toArray @BA.Bytes key) - $ L.toChunks s - in pure . Bytes.fromArray . hmac alg $ serializeValueLazy x - - declareForeign Untracked "crypto.Ed25519.sign.impl" boxBoxBoxToEFBox - . mkForeign - $ pure . signEd25519Wrapper - - declareForeign Untracked "crypto.Ed25519.verify.impl" boxBoxBoxToEFBool - . mkForeign - $ pure . verifyEd25519Wrapper - - declareForeign Untracked "crypto.Rsa.sign.impl" boxBoxToEFBox - . mkForeign - $ pure . signRsaWrapper - - declareForeign Untracked "crypto.Rsa.verify.impl" boxBoxBoxToEFBool - . mkForeign - $ pure . verifyRsaWrapper - - let catchAll :: (MonadCatch m, MonadIO m, NFData a) => m a -> m (Either Util.Text.Text a) - catchAll e = do - e <- Exception.tryAnyDeep e - pure $ case e of - Left se -> Left (Util.Text.pack (show se)) - Right a -> Right a - - declareForeign Untracked "Universal.murmurHash" murmur'hash . mkForeign $ - pure . asWord64 . hash64 . serializeValueLazy - - declareForeign Tracked "IO.randomBytes" natToBox . mkForeign $ - \n -> Bytes.fromArray <$> getRandomBytes @IO @ByteString n - - declareForeign Untracked "Bytes.zlib.compress" boxDirect . mkForeign $ pure . Bytes.zlibCompress - declareForeign Untracked "Bytes.gzip.compress" boxDirect . mkForeign $ pure . Bytes.gzipCompress - declareForeign Untracked "Bytes.zlib.decompress" boxToEBoxBox . mkForeign $ \bs -> - catchAll (pure (Bytes.zlibDecompress bs)) - declareForeign Untracked "Bytes.gzip.decompress" boxToEBoxBox . mkForeign $ \bs -> - catchAll (pure (Bytes.gzipDecompress bs)) - - declareForeign Untracked "Bytes.toBase16" boxDirect . mkForeign $ pure . Bytes.toBase16 - declareForeign Untracked "Bytes.toBase32" boxDirect . mkForeign $ pure . Bytes.toBase32 - declareForeign Untracked "Bytes.toBase64" boxDirect . mkForeign $ pure . Bytes.toBase64 - declareForeign Untracked "Bytes.toBase64UrlUnpadded" boxDirect . mkForeign $ pure . Bytes.toBase64UrlUnpadded - - declareForeign Untracked "Bytes.fromBase16" boxToEBoxBox . mkForeign $ - pure . mapLeft Util.Text.fromText . Bytes.fromBase16 - declareForeign Untracked "Bytes.fromBase32" boxToEBoxBox . mkForeign $ - pure . mapLeft Util.Text.fromText . Bytes.fromBase32 - declareForeign Untracked "Bytes.fromBase64" boxToEBoxBox . mkForeign $ - pure . mapLeft Util.Text.fromText . Bytes.fromBase64 - declareForeign Untracked "Bytes.fromBase64UrlUnpadded" boxToEBoxBox . mkForeign $ - pure . mapLeft Util.Text.fromText . Bytes.fromBase64UrlUnpadded - - declareForeign Untracked "Bytes.decodeNat64be" boxToMaybeNTup . mkForeign $ pure . Bytes.decodeNat64be - declareForeign Untracked "Bytes.decodeNat64le" boxToMaybeNTup . mkForeign $ pure . Bytes.decodeNat64le - declareForeign Untracked "Bytes.decodeNat32be" boxToMaybeNTup . mkForeign $ pure . Bytes.decodeNat32be - declareForeign Untracked "Bytes.decodeNat32le" boxToMaybeNTup . mkForeign $ pure . Bytes.decodeNat32le - declareForeign Untracked "Bytes.decodeNat16be" boxToMaybeNTup . mkForeign $ pure . Bytes.decodeNat16be - declareForeign Untracked "Bytes.decodeNat16le" boxToMaybeNTup . mkForeign $ pure . Bytes.decodeNat16le - - declareForeign Untracked "Bytes.encodeNat64be" (wordDirect Ty.natRef) . mkForeign $ pure . Bytes.encodeNat64be - declareForeign Untracked "Bytes.encodeNat64le" (wordDirect Ty.natRef) . mkForeign $ pure . Bytes.encodeNat64le - declareForeign Untracked "Bytes.encodeNat32be" (wordDirect Ty.natRef) . mkForeign $ pure . Bytes.encodeNat32be - declareForeign Untracked "Bytes.encodeNat32le" (wordDirect Ty.natRef) . mkForeign $ pure . Bytes.encodeNat32le - declareForeign Untracked "Bytes.encodeNat16be" (wordDirect Ty.natRef) . mkForeign $ pure . Bytes.encodeNat16be - declareForeign Untracked "Bytes.encodeNat16le" (wordDirect Ty.natRef) . mkForeign $ pure . Bytes.encodeNat16le - - declareForeign Untracked "MutableArray.copyTo!" boxNatBoxNatNatToExnUnit - . mkForeign - $ \(dst, doff, src, soff, l) -> - let name = "MutableArray.copyTo!" - in if l == 0 - then pure (Right ()) - else - checkBounds name (PA.sizeofMutableArray dst) (doff + l - 1) $ - checkBounds name (PA.sizeofMutableArray src) (soff + l - 1) $ - Right - <$> PA.copyMutableArray @IO @Closure - dst - (fromIntegral doff) - src - (fromIntegral soff) - (fromIntegral l) - - declareForeign Untracked "MutableByteArray.copyTo!" boxNatBoxNatNatToExnUnit - . mkForeign - $ \(dst, doff, src, soff, l) -> - let name = "MutableByteArray.copyTo!" - in if l == 0 - then pure (Right ()) - else - checkBoundsPrim name (PA.sizeofMutableByteArray dst) (doff + l) 0 $ - checkBoundsPrim name (PA.sizeofMutableByteArray src) (soff + l) 0 $ - Right - <$> PA.copyMutableByteArray @IO - dst - (fromIntegral doff) - src - (fromIntegral soff) - (fromIntegral l) - - declareForeign Untracked "ImmutableArray.copyTo!" boxNatBoxNatNatToExnUnit - . mkForeign - $ \(dst, doff, src, soff, l) -> - let name = "ImmutableArray.copyTo!" - in if l == 0 - then pure (Right ()) - else - checkBounds name (PA.sizeofMutableArray dst) (doff + l - 1) $ - checkBounds name (PA.sizeofArray src) (soff + l - 1) $ - Right - <$> PA.copyArray @IO @Closure - dst - (fromIntegral doff) - src - (fromIntegral soff) - (fromIntegral l) - - declareForeign Untracked "ImmutableArray.size" boxToNat . mkForeign $ - pure . fromIntegral @Int @Word64 . PA.sizeofArray @Closure - declareForeign Untracked "MutableArray.size" boxToNat . mkForeign $ - pure . fromIntegral @Int @Word64 . PA.sizeofMutableArray @PA.RealWorld @Closure - declareForeign Untracked "ImmutableByteArray.size" boxToNat . mkForeign $ - pure . fromIntegral @Int @Word64 . PA.sizeofByteArray - declareForeign Untracked "MutableByteArray.size" boxToNat . mkForeign $ - pure . fromIntegral @Int @Word64 . PA.sizeofMutableByteArray @PA.RealWorld - - declareForeign Untracked "ImmutableByteArray.copyTo!" boxNatBoxNatNatToExnUnit - . mkForeign - $ \(dst, doff, src, soff, l) -> - let name = "ImmutableByteArray.copyTo!" - in if l == 0 - then pure (Right ()) - else - checkBoundsPrim name (PA.sizeofMutableByteArray dst) (doff + l) 0 $ - checkBoundsPrim name (PA.sizeofByteArray src) (soff + l) 0 $ - Right - <$> PA.copyByteArray @IO - dst - (fromIntegral doff) - src - (fromIntegral soff) - (fromIntegral l) - - declareForeign Untracked "MutableArray.read" boxNatToExnBox - . mkForeign - $ checkedRead "MutableArray.read" - declareForeign Untracked "MutableByteArray.read8" boxNatToExnNat - . mkForeign - $ checkedRead8 "MutableByteArray.read8" - declareForeign Untracked "MutableByteArray.read16be" boxNatToExnNat - . mkForeign - $ checkedRead16 "MutableByteArray.read16be" - declareForeign Untracked "MutableByteArray.read24be" boxNatToExnNat - . mkForeign - $ checkedRead24 "MutableByteArray.read24be" - declareForeign Untracked "MutableByteArray.read32be" boxNatToExnNat - . mkForeign - $ checkedRead32 "MutableByteArray.read32be" - declareForeign Untracked "MutableByteArray.read40be" boxNatToExnNat - . mkForeign - $ checkedRead40 "MutableByteArray.read40be" - declareForeign Untracked "MutableByteArray.read64be" boxNatToExnNat - . mkForeign - $ checkedRead64 "MutableByteArray.read64be" - - declareForeign Untracked "MutableArray.write" boxNatBoxToExnUnit - . mkForeign - $ checkedWrite "MutableArray.write" - declareForeign Untracked "MutableByteArray.write8" boxNatNatToExnUnit - . mkForeign - $ checkedWrite8 "MutableByteArray.write8" - declareForeign Untracked "MutableByteArray.write16be" boxNatNatToExnUnit - . mkForeign - $ checkedWrite16 "MutableByteArray.write16be" - declareForeign Untracked "MutableByteArray.write32be" boxNatNatToExnUnit - . mkForeign - $ checkedWrite32 "MutableByteArray.write32be" - declareForeign Untracked "MutableByteArray.write64be" boxNatNatToExnUnit - . mkForeign - $ checkedWrite64 "MutableByteArray.write64be" - - declareForeign Untracked "ImmutableArray.read" boxNatToExnBox - . mkForeign - $ checkedIndex "ImmutableArray.read" - declareForeign Untracked "ImmutableByteArray.read8" boxNatToExnNat - . mkForeign - $ checkedIndex8 "ImmutableByteArray.read8" - declareForeign Untracked "ImmutableByteArray.read16be" boxNatToExnNat - . mkForeign - $ checkedIndex16 "ImmutableByteArray.read16be" - declareForeign Untracked "ImmutableByteArray.read24be" boxNatToExnNat - . mkForeign - $ checkedIndex24 "ImmutableByteArray.read24be" - declareForeign Untracked "ImmutableByteArray.read32be" boxNatToExnNat - . mkForeign - $ checkedIndex32 "ImmutableByteArray.read32be" - declareForeign Untracked "ImmutableByteArray.read40be" boxNatToExnNat - . mkForeign - $ checkedIndex40 "ImmutableByteArray.read40be" - declareForeign Untracked "ImmutableByteArray.read64be" boxNatToExnNat - . mkForeign - $ checkedIndex64 "ImmutableByteArray.read64be" - - declareForeign Untracked "MutableByteArray.freeze!" boxDirect . mkForeign $ - PA.unsafeFreezeByteArray - declareForeign Untracked "MutableArray.freeze!" boxDirect . mkForeign $ - PA.unsafeFreezeArray @IO @Closure - - declareForeign Untracked "MutableByteArray.freeze" boxNatNatToExnBox . mkForeign $ - \(src, off, len) -> - if len == 0 - then fmap Right . PA.unsafeFreezeByteArray =<< PA.newByteArray 0 - else - checkBoundsPrim - "MutableByteArray.freeze" - (PA.sizeofMutableByteArray src) - (off + len) - 0 - $ Right <$> PA.freezeByteArray src (fromIntegral off) (fromIntegral len) - - declareForeign Untracked "MutableArray.freeze" boxNatNatToExnBox . mkForeign $ - \(src, off, len) -> - if len == 0 - then fmap Right . PA.unsafeFreezeArray =<< PA.newArray 0 Closure.BlackHole - else - checkBounds - "MutableArray.freeze" - (PA.sizeofMutableArray src) - (off + len - 1) - $ Right <$> PA.freezeArray src (fromIntegral off) (fromIntegral len) - - declareForeign Untracked "MutableByteArray.length" boxToNat . mkForeign $ - pure . PA.sizeofMutableByteArray @PA.RealWorld - - declareForeign Untracked "ImmutableByteArray.length" boxToNat . mkForeign $ - pure . PA.sizeofByteArray - - declareForeign Tracked "IO.array" natToBox . mkForeign $ - \n -> PA.newArray n Closure.BlackHole - declareForeign Tracked "IO.arrayOf" boxNatToBox . mkForeign $ - \(v :: Closure, n) -> PA.newArray n v - declareForeign Tracked "IO.bytearray" natToBox . mkForeign $ PA.newByteArray - declareForeign Tracked "IO.bytearrayOf" natNatToBox - . mkForeign - $ \(init, sz) -> do - arr <- PA.newByteArray sz - PA.fillByteArray arr 0 sz init - pure arr - - declareForeign Untracked "Scope.array" natToBox . mkForeign $ - \n -> PA.newArray n Closure.BlackHole - declareForeign Untracked "Scope.arrayOf" boxNatToBox . mkForeign $ - \(v :: Closure, n) -> PA.newArray n v - declareForeign Untracked "Scope.bytearray" natToBox . mkForeign $ PA.newByteArray - declareForeign Untracked "Scope.bytearrayOf" natNatToBox - . mkForeign - $ \(init, sz) -> do - arr <- PA.newByteArray sz - PA.fillByteArray arr 0 sz init - pure arr - - declareForeign Untracked "Text.patterns.literal" boxDirect . mkForeign $ - \txt -> evaluate . TPat.cpattern $ TPat.Literal txt - declareForeign Untracked "Text.patterns.digit" direct . mkForeign $ - let v = TPat.cpattern (TPat.Char (TPat.CharRange '0' '9')) in \() -> pure v - declareForeign Untracked "Text.patterns.letter" direct . mkForeign $ - let v = TPat.cpattern (TPat.Char (TPat.CharClass TPat.Letter)) in \() -> pure v - declareForeign Untracked "Text.patterns.space" direct . mkForeign $ - let v = TPat.cpattern (TPat.Char (TPat.CharClass TPat.Whitespace)) in \() -> pure v - declareForeign Untracked "Text.patterns.punctuation" direct . mkForeign $ - let v = TPat.cpattern (TPat.Char (TPat.CharClass TPat.Punctuation)) in \() -> pure v - declareForeign Untracked "Text.patterns.anyChar" direct . mkForeign $ - let v = TPat.cpattern (TPat.Char TPat.Any) in \() -> pure v - declareForeign Untracked "Text.patterns.eof" direct . mkForeign $ - let v = TPat.cpattern TPat.Eof in \() -> pure v - let ccd = wordWordDirect Ty.charRef Ty.charRef - declareForeign Untracked "Text.patterns.charRange" ccd . mkForeign $ - \(beg, end) -> evaluate . TPat.cpattern . TPat.Char $ TPat.CharRange beg end - declareForeign Untracked "Text.patterns.notCharRange" ccd . mkForeign $ - \(beg, end) -> evaluate . TPat.cpattern . TPat.Char . TPat.Not $ TPat.CharRange beg end - declareForeign Untracked "Text.patterns.charIn" boxDirect . mkForeign $ \ccs -> do - cs <- for ccs $ \case - Closure.DataU1 _ _ i -> pure (toEnum i) - _ -> die "Text.patterns.charIn: non-character closure" - evaluate . TPat.cpattern . TPat.Char $ TPat.CharSet cs - declareForeign Untracked "Text.patterns.notCharIn" boxDirect . mkForeign $ \ccs -> do - cs <- for ccs $ \case - Closure.DataU1 _ _ i -> pure (toEnum i) - _ -> die "Text.patterns.notCharIn: non-character closure" - evaluate . TPat.cpattern . TPat.Char . TPat.Not $ TPat.CharSet cs - declareForeign Untracked "Pattern.many" boxDirect . mkForeign $ - \(TPat.CP p _) -> evaluate . TPat.cpattern $ TPat.Many False p - declareForeign Untracked "Pattern.many.corrected" boxDirect . mkForeign $ - \(TPat.CP p _) -> evaluate . TPat.cpattern $ TPat.Many True p - declareForeign Untracked "Pattern.capture" boxDirect . mkForeign $ - \(TPat.CP p _) -> evaluate . TPat.cpattern $ TPat.Capture p - declareForeign Untracked "Pattern.captureAs" boxBoxDirect . mkForeign $ - \(t, (TPat.CP p _)) -> evaluate . TPat.cpattern $ TPat.CaptureAs t p - declareForeign Untracked "Pattern.join" boxDirect . mkForeign $ \ps -> - evaluate . TPat.cpattern . TPat.Join $ map (\(TPat.CP p _) -> p) ps - declareForeign Untracked "Pattern.or" boxBoxDirect . mkForeign $ - \(TPat.CP l _, TPat.CP r _) -> evaluate . TPat.cpattern $ TPat.Or l r - declareForeign Untracked "Pattern.replicate" natNatBoxToBox . mkForeign $ - \(m0 :: Word64, n0 :: Word64, TPat.CP p _) -> - let m = fromIntegral m0; n = fromIntegral n0 - in evaluate . TPat.cpattern $ TPat.Replicate m n p - - declareForeign Untracked "Pattern.run" boxBoxToMaybeTup . mkForeign $ - \(TPat.CP _ matcher, input :: Text) -> pure $ matcher input - - declareForeign Untracked "Pattern.isMatch" boxBoxToBool . mkForeign $ - \(TPat.CP _ matcher, input :: Text) -> pure . isJust $ matcher input - - declareForeign Untracked "Char.Class.any" direct . mkForeign $ \() -> pure TPat.Any - declareForeign Untracked "Char.Class.not" boxDirect . mkForeign $ pure . TPat.Not - declareForeign Untracked "Char.Class.and" boxBoxDirect . mkForeign $ \(a, b) -> pure $ TPat.Intersect a b - declareForeign Untracked "Char.Class.or" boxBoxDirect . mkForeign $ \(a, b) -> pure $ TPat.Union a b - declareForeign Untracked "Char.Class.range" (wordWordDirect charRef charRef) . mkForeign $ \(a, b) -> pure $ TPat.CharRange a b - declareForeign Untracked "Char.Class.anyOf" boxDirect . mkForeign $ \ccs -> do - cs <- for ccs $ \case - Closure.DataU1 _ _ i -> pure (toEnum i) - _ -> die "Text.patterns.charIn: non-character closure" - evaluate $ TPat.CharSet cs - declareForeign Untracked "Char.Class.alphanumeric" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.AlphaNum) - declareForeign Untracked "Char.Class.upper" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Upper) - declareForeign Untracked "Char.Class.lower" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Lower) - declareForeign Untracked "Char.Class.whitespace" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Whitespace) - declareForeign Untracked "Char.Class.control" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Control) - declareForeign Untracked "Char.Class.printable" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Printable) - declareForeign Untracked "Char.Class.mark" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.MarkChar) - declareForeign Untracked "Char.Class.number" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Number) - declareForeign Untracked "Char.Class.punctuation" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Punctuation) - declareForeign Untracked "Char.Class.symbol" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Symbol) - declareForeign Untracked "Char.Class.separator" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Separator) - declareForeign Untracked "Char.Class.letter" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Letter) - declareForeign Untracked "Char.Class.is" (boxWordToBool charRef) . mkForeign $ \(cl, c) -> evaluate $ TPat.charPatternPred cl c - declareForeign Untracked "Text.patterns.char" boxDirect . mkForeign $ \c -> - let v = TPat.cpattern (TPat.Char c) in pure v - -type RW = PA.PrimState IO - -checkedRead :: - Text -> (PA.MutableArray RW Closure, Word64) -> IO (Either Failure Closure) -checkedRead name (arr, w) = - checkBounds - name - (PA.sizeofMutableArray arr) - w - (Right <$> PA.readArray arr (fromIntegral w)) - -checkedWrite :: - Text -> (PA.MutableArray RW Closure, Word64, Closure) -> IO (Either Failure ()) -checkedWrite name (arr, w, v) = - checkBounds - name - (PA.sizeofMutableArray arr) - w - (Right <$> PA.writeArray arr (fromIntegral w) v) - -checkedIndex :: - Text -> (PA.Array Closure, Word64) -> IO (Either Failure Closure) -checkedIndex name (arr, w) = - checkBounds - name - (PA.sizeofArray arr) - w - (Right <$> PA.indexArrayM arr (fromIntegral w)) - -checkedRead8 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64) -checkedRead8 name (arr, i) = - checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 1 $ - (Right . fromIntegral) <$> PA.readByteArray @Word8 arr j - where - j = fromIntegral i - -checkedRead16 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64) -checkedRead16 name (arr, i) = - checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 2 $ - mk16 - <$> PA.readByteArray @Word8 arr j - <*> PA.readByteArray @Word8 arr (j + 1) - where - j = fromIntegral i - -checkedRead24 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64) -checkedRead24 name (arr, i) = - checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 3 $ - mk24 - <$> PA.readByteArray @Word8 arr j - <*> PA.readByteArray @Word8 arr (j + 1) - <*> PA.readByteArray @Word8 arr (j + 2) - where - j = fromIntegral i - -checkedRead32 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64) -checkedRead32 name (arr, i) = - checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 4 $ - mk32 - <$> PA.readByteArray @Word8 arr j - <*> PA.readByteArray @Word8 arr (j + 1) - <*> PA.readByteArray @Word8 arr (j + 2) - <*> PA.readByteArray @Word8 arr (j + 3) - where - j = fromIntegral i - -checkedRead40 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64) -checkedRead40 name (arr, i) = - checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 6 $ - mk40 - <$> PA.readByteArray @Word8 arr j - <*> PA.readByteArray @Word8 arr (j + 1) - <*> PA.readByteArray @Word8 arr (j + 2) - <*> PA.readByteArray @Word8 arr (j + 3) - <*> PA.readByteArray @Word8 arr (j + 4) - where - j = fromIntegral i - -checkedRead64 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64) -checkedRead64 name (arr, i) = - checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 8 $ - mk64 - <$> PA.readByteArray @Word8 arr j - <*> PA.readByteArray @Word8 arr (j + 1) - <*> PA.readByteArray @Word8 arr (j + 2) - <*> PA.readByteArray @Word8 arr (j + 3) - <*> PA.readByteArray @Word8 arr (j + 4) - <*> PA.readByteArray @Word8 arr (j + 5) - <*> PA.readByteArray @Word8 arr (j + 6) - <*> PA.readByteArray @Word8 arr (j + 7) - where - j = fromIntegral i - -mk16 :: Word8 -> Word8 -> Either Failure Word64 -mk16 b0 b1 = Right $ (fromIntegral b0 `shiftL` 8) .|. (fromIntegral b1) - -mk24 :: Word8 -> Word8 -> Word8 -> Either Failure Word64 -mk24 b0 b1 b2 = - Right $ - (fromIntegral b0 `shiftL` 16) - .|. (fromIntegral b1 `shiftL` 8) - .|. (fromIntegral b2) - -mk32 :: Word8 -> Word8 -> Word8 -> Word8 -> Either Failure Word64 -mk32 b0 b1 b2 b3 = - Right $ - (fromIntegral b0 `shiftL` 24) - .|. (fromIntegral b1 `shiftL` 16) - .|. (fromIntegral b2 `shiftL` 8) - .|. (fromIntegral b3) - -mk40 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Either Failure Word64 -mk40 b0 b1 b2 b3 b4 = - Right $ - (fromIntegral b0 `shiftL` 32) - .|. (fromIntegral b1 `shiftL` 24) - .|. (fromIntegral b2 `shiftL` 16) - .|. (fromIntegral b3 `shiftL` 8) - .|. (fromIntegral b4) - -mk64 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Either Failure Word64 -mk64 b0 b1 b2 b3 b4 b5 b6 b7 = - Right $ - (fromIntegral b0 `shiftL` 56) - .|. (fromIntegral b1 `shiftL` 48) - .|. (fromIntegral b2 `shiftL` 40) - .|. (fromIntegral b3 `shiftL` 32) - .|. (fromIntegral b4 `shiftL` 24) - .|. (fromIntegral b5 `shiftL` 16) - .|. (fromIntegral b6 `shiftL` 8) - .|. (fromIntegral b7) - -checkedWrite8 :: Text -> (PA.MutableByteArray RW, Word64, Word64) -> IO (Either Failure ()) -checkedWrite8 name (arr, i, v) = - checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 1 $ do - PA.writeByteArray arr j (fromIntegral v :: Word8) - pure (Right ()) - where - j = fromIntegral i - -checkedWrite16 :: Text -> (PA.MutableByteArray RW, Word64, Word64) -> IO (Either Failure ()) -checkedWrite16 name (arr, i, v) = - checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 2 $ do - PA.writeByteArray arr j (fromIntegral $ v `shiftR` 8 :: Word8) - PA.writeByteArray arr (j + 1) (fromIntegral v :: Word8) - pure (Right ()) - where - j = fromIntegral i - -checkedWrite32 :: Text -> (PA.MutableByteArray RW, Word64, Word64) -> IO (Either Failure ()) -checkedWrite32 name (arr, i, v) = - checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 4 $ do - PA.writeByteArray arr j (fromIntegral $ v `shiftR` 24 :: Word8) - PA.writeByteArray arr (j + 1) (fromIntegral $ v `shiftR` 16 :: Word8) - PA.writeByteArray arr (j + 2) (fromIntegral $ v `shiftR` 8 :: Word8) - PA.writeByteArray arr (j + 3) (fromIntegral v :: Word8) - pure (Right ()) - where - j = fromIntegral i - -checkedWrite64 :: Text -> (PA.MutableByteArray RW, Word64, Word64) -> IO (Either Failure ()) -checkedWrite64 name (arr, i, v) = - checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 8 $ do - PA.writeByteArray arr j (fromIntegral $ v `shiftR` 56 :: Word8) - PA.writeByteArray arr (j + 1) (fromIntegral $ v `shiftR` 48 :: Word8) - PA.writeByteArray arr (j + 2) (fromIntegral $ v `shiftR` 40 :: Word8) - PA.writeByteArray arr (j + 3) (fromIntegral $ v `shiftR` 32 :: Word8) - PA.writeByteArray arr (j + 4) (fromIntegral $ v `shiftR` 24 :: Word8) - PA.writeByteArray arr (j + 5) (fromIntegral $ v `shiftR` 16 :: Word8) - PA.writeByteArray arr (j + 6) (fromIntegral $ v `shiftR` 8 :: Word8) - PA.writeByteArray arr (j + 7) (fromIntegral v :: Word8) - pure (Right ()) - where - j = fromIntegral i - --- index single byte -checkedIndex8 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64) -checkedIndex8 name (arr, i) = - checkBoundsPrim name (PA.sizeofByteArray arr) i 1 . pure $ - let j = fromIntegral i - in Right . fromIntegral $ PA.indexByteArray @Word8 arr j - --- index 16 big-endian -checkedIndex16 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64) -checkedIndex16 name (arr, i) = - checkBoundsPrim name (PA.sizeofByteArray arr) i 2 . pure $ - let j = fromIntegral i - in mk16 (PA.indexByteArray arr j) (PA.indexByteArray arr (j + 1)) - --- index 32 big-endian -checkedIndex24 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64) -checkedIndex24 name (arr, i) = - checkBoundsPrim name (PA.sizeofByteArray arr) i 3 . pure $ - let j = fromIntegral i - in mk24 - (PA.indexByteArray arr j) - (PA.indexByteArray arr (j + 1)) - (PA.indexByteArray arr (j + 2)) - --- index 32 big-endian -checkedIndex32 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64) -checkedIndex32 name (arr, i) = - checkBoundsPrim name (PA.sizeofByteArray arr) i 4 . pure $ - let j = fromIntegral i - in mk32 - (PA.indexByteArray arr j) - (PA.indexByteArray arr (j + 1)) - (PA.indexByteArray arr (j + 2)) - (PA.indexByteArray arr (j + 3)) - --- index 40 big-endian -checkedIndex40 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64) -checkedIndex40 name (arr, i) = - checkBoundsPrim name (PA.sizeofByteArray arr) i 5 . pure $ - let j = fromIntegral i - in mk40 - (PA.indexByteArray arr j) - (PA.indexByteArray arr (j + 1)) - (PA.indexByteArray arr (j + 2)) - (PA.indexByteArray arr (j + 3)) - (PA.indexByteArray arr (j + 4)) - --- index 64 big-endian -checkedIndex64 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64) -checkedIndex64 name (arr, i) = - checkBoundsPrim name (PA.sizeofByteArray arr) i 8 . pure $ - let j = fromIntegral i - in mk64 - (PA.indexByteArray arr j) - (PA.indexByteArray arr (j + 1)) - (PA.indexByteArray arr (j + 2)) - (PA.indexByteArray arr (j + 3)) - (PA.indexByteArray arr (j + 4)) - (PA.indexByteArray arr (j + 5)) - (PA.indexByteArray arr (j + 6)) - (PA.indexByteArray arr (j + 7)) - -checkBounds :: Text -> Int -> Word64 -> IO (Either Failure b) -> IO (Either Failure b) -checkBounds name l w act - | w < fromIntegral l = act - | otherwise = pure $ Left err - where - msg = name <> ": array index out of bounds" - err = Failure Ty.arrayFailureRef msg (natValue w) - --- Performs a bounds check on a byte array. Strategy is as follows: --- --- isz = signed array size-in-bytes --- off = unsigned byte offset into the array --- esz = unsigned number of bytes to be read --- --- 1. Turn the signed size-in-bytes of the array unsigned --- 2. Add the offset to the to-be-read number to get the maximum size needed --- 3. Check that the actual array size is at least as big as the needed size --- 4. Check that the offset is less than the size --- --- Step 4 ensures that step 3 has not overflowed. Since an actual array size can --- only be 63 bits (since it is signed), the only way for 3 to overflow is if --- the offset is larger than a possible array size, since it would need to be --- 2^64-k, where k is the small (<=8) number of bytes to be read. -checkBoundsPrim :: - Text -> Int -> Word64 -> Word64 -> IO (Either Failure b) -> IO (Either Failure b) -checkBoundsPrim name isz off esz act - | w > bsz || off > bsz = pure $ Left err - | otherwise = act - where - msg = name <> ": array index out of bounds" - err = Failure Ty.arrayFailureRef msg (natValue off) - - bsz = fromIntegral isz - w = off + esz - -hostPreference :: Maybe Util.Text.Text -> SYS.HostPreference -hostPreference Nothing = SYS.HostAny -hostPreference (Just host) = SYS.Host $ Util.Text.unpack host - -signEd25519Wrapper :: - (Bytes.Bytes, Bytes.Bytes, Bytes.Bytes) -> Either Failure Bytes.Bytes -signEd25519Wrapper (secret0, public0, msg0) = case validated of - CryptoFailed err -> - Left (Failure Ty.cryptoFailureRef (errMsg err) unitValue) - CryptoPassed (secret, public) -> - Right . Bytes.fromArray $ Ed25519.sign secret public msg - where - msg = Bytes.toArray msg0 :: ByteString - validated = - (,) - <$> Ed25519.secretKey (Bytes.toArray secret0 :: ByteString) - <*> Ed25519.publicKey (Bytes.toArray public0 :: ByteString) - - errMsg CryptoError_PublicKeySizeInvalid = - "ed25519: Public key size invalid" - errMsg CryptoError_SecretKeySizeInvalid = - "ed25519: Secret key size invalid" - errMsg CryptoError_SecretKeyStructureInvalid = - "ed25519: Secret key structure invalid" - errMsg _ = "ed25519: unexpected error" - -verifyEd25519Wrapper :: - (Bytes.Bytes, Bytes.Bytes, Bytes.Bytes) -> Either Failure Bool -verifyEd25519Wrapper (public0, msg0, sig0) = case validated of - CryptoFailed err -> - Left $ Failure Ty.cryptoFailureRef (errMsg err) unitValue - CryptoPassed (public, sig) -> - Right $ Ed25519.verify public msg sig - where - msg = Bytes.toArray msg0 :: ByteString - validated = - (,) - <$> Ed25519.publicKey (Bytes.toArray public0 :: ByteString) - <*> Ed25519.signature (Bytes.toArray sig0 :: ByteString) - - errMsg CryptoError_PublicKeySizeInvalid = - "ed25519: Public key size invalid" - errMsg CryptoError_SecretKeySizeInvalid = - "ed25519: Secret key size invalid" - errMsg CryptoError_SecretKeyStructureInvalid = - "ed25519: Secret key structure invalid" - errMsg _ = "ed25519: unexpected error" - -signRsaWrapper :: - (Bytes.Bytes, Bytes.Bytes) -> Either Failure Bytes.Bytes -signRsaWrapper (secret0, msg0) = case validated of - Left err -> - Left (Failure Ty.cryptoFailureRef err unitValue) - Right secret -> - case RSA.sign Nothing (Just Hash.SHA256) secret msg of - Left err -> Left (Failure Ty.cryptoFailureRef (Rsa.rsaErrorToText err) unitValue) - Right signature -> Right $ Bytes.fromByteString signature - where - msg = Bytes.toArray msg0 :: ByteString - validated = Rsa.parseRsaPrivateKey (Bytes.toArray secret0 :: ByteString) - -verifyRsaWrapper :: - (Bytes.Bytes, Bytes.Bytes, Bytes.Bytes) -> Either Failure Bool -verifyRsaWrapper (public0, msg0, sig0) = case validated of - Left err -> - Left $ Failure Ty.cryptoFailureRef err unitValue - Right public -> - Right $ RSA.verify (Just Hash.SHA256) public msg sig - where - msg = Bytes.toArray msg0 :: ByteString - sig = Bytes.toArray sig0 :: ByteString - validated = Rsa.parseRsaPublicKey (Bytes.toArray public0 :: ByteString) - -typeReferences :: [(Reference, Word64)] -typeReferences = zip rs [1 ..] - where - rs = - [r | (_, r) <- Ty.builtinTypes] - ++ [DerivedId i | (_, i, _) <- Ty.builtinDataDecls] - ++ [DerivedId i | (_, i, _) <- Ty.builtinEffectDecls] - -foreignDeclResults :: - Bool -> (Word64, [(Data.Text.Text, (Sandbox, SuperNormal Symbol))], EnumMap Word64 (Data.Text.Text, ForeignFunc)) -foreignDeclResults sanitize = - execState (runReaderT declareForeigns sanitize) (0, [], mempty) - -foreignWrappers :: [(Data.Text.Text, (Sandbox, SuperNormal Symbol))] -foreignWrappers | (_, l, _) <- foreignDeclResults False = reverse l - -numberedTermLookup :: EnumMap Word64 (SuperNormal Symbol) -numberedTermLookup = - mapFromList . zip [1 ..] . Map.elems . fmap snd $ builtinLookup - -builtinTermNumbering :: Map Reference Word64 -builtinTermNumbering = - Map.fromList (zip (Map.keys $ builtinLookup) [1 ..]) - -builtinTermBackref :: EnumMap Word64 Reference -builtinTermBackref = - mapFromList . zip [1 ..] . Map.keys $ builtinLookup - -builtinTypeNumbering :: Map Reference Word64 -builtinTypeNumbering = Map.fromList typeReferences - -builtinTypeBackref :: EnumMap Word64 Reference -builtinTypeBackref = mapFromList $ swap <$> typeReferences - where - swap (x, y) = (y, x) - -builtinForeigns :: EnumMap Word64 ForeignFunc -builtinForeigns | (_, _, m) <- foreignDeclResults False = snd <$> m - -sandboxedForeigns :: EnumMap Word64 ForeignFunc -sandboxedForeigns | (_, _, m) <- foreignDeclResults True = snd <$> m - -builtinForeignNames :: EnumMap Word64 Data.Text.Text -builtinForeignNames | (_, _, m) <- foreignDeclResults False = fst <$> m - --- Bootstrapping for sandbox check. The eventual map will be one with --- associations `r -> s` where `s` is all the 'sensitive' base --- functions that `r` calls. -baseSandboxInfo :: Map Reference (Set Reference) -baseSandboxInfo = - Map.fromList $ - [ (r, Set.singleton r) - | (r, (sb, _)) <- Map.toList builtinLookup, - sb == Tracked - ] - -unsafeSTMToIO :: STM.STM a -> IO a -unsafeSTMToIO (STM.STM m) = IO m diff --git a/parser-typechecker/src/Unison/Runtime/Decompile.hs b/parser-typechecker/src/Unison/Runtime/Decompile.hs deleted file mode 100644 index 00e8c4445a..0000000000 --- a/parser-typechecker/src/Unison/Runtime/Decompile.hs +++ /dev/null @@ -1,250 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ViewPatterns #-} - -module Unison.Runtime.Decompile - ( decompile, - DecompResult, - DecompError (..), - renderDecompError, - ) -where - -import Data.Set (singleton) -import Unison.ABT (substs) -import Unison.Codebase.Runtime (Error) -import Unison.ConstructorReference (GConstructorReference (..)) -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 (..), - pattern DataC, - pattern PApV, - ) -import Unison.Syntax.NamePrinter (prettyReference) -import Unison.Term - ( Term, - app, - apps', - boolean, - builtin, - char, - constructor, - float, - int, - list, - list', - nat, - ref, - termLink, - text, - typeLink, - pattern LamNamed', - ) -import Unison.Term qualified as Term -import Unison.Type - ( anyRef, - booleanRef, - charRef, - floatRef, - iarrayRef, - ibytearrayRef, - intRef, - listRef, - natRef, - termLinkRef, - typeLinkRef, - ) -import Unison.Util.Bytes qualified as By -import Unison.Util.Pretty (indentN, lines, lit, syntaxToColor, wrap) -import Unison.Util.Text qualified as Text -import Unison.Var (Var) -import Unsafe.Coerce -- for Int -> Double -import Prelude hiding (lines) - -con :: (Var v) => Reference -> Word64 -> Term v () -con rf ct = constructor () (ConstructorReference rf $ fromIntegral ct) - -bug :: (Var v) => Text -> Term v () -bug msg = app () (builtin () "bug") (text () msg) - -err :: DecompError -> a -> (Set DecompError, a) -err err x = (singleton err, x) - -data DecompError - = BadBool !Word64 - | BadUnboxed !Reference - | BadForeign !Reference - | BadData !Reference - | BadPAp !Reference - | UnkComb !Reference - | UnkLocal !Reference !Word64 - | Cont - | Exn - deriving (Eq, Ord) - -type DecompResult v = (Set DecompError, Term v ()) - -prf :: Reference -> Error -prf = syntaxToColor . prettyReference 10 - -renderDecompError :: DecompError -> Error -renderDecompError (BadBool n) = - lines - [ wrap "A boolean value had an unexpected constructor tag:", - indentN 2 . lit . fromString $ show n - ] -renderDecompError (BadUnboxed rf) = - lines - [ wrap "An apparent numeric type had an unrecognized reference:", - indentN 2 $ prf rf - ] -renderDecompError (BadForeign rf) = - lines - [ wrap "A foreign value with no decompiled representation was encountered:", - indentN 2 $ prf rf - ] -renderDecompError (BadData rf) = - lines - [ wrap - "A data type with no decompiled representation was encountered:", - indentN 2 $ prf rf - ] -renderDecompError (BadPAp rf) = - lines - [ wrap "A partial function application could not be decompiled: ", - indentN 2 $ prf rf - ] -renderDecompError (UnkComb rf) = - lines - [ wrap "A reference to an unknown function was encountered: ", - indentN 2 $ prf rf - ] -renderDecompError (UnkLocal rf n) = - lines - [ "A reference to an unknown portion to a function was encountered: ", - indentN 2 $ "function: " <> prf rf, - indentN 2 $ "section: " <> lit (fromString $ show n) - ] -renderDecompError Cont = "A continuation value was encountered" -renderDecompError Exn = "An exception value was encountered" - -decompile :: - (Var v) => - (Reference -> Maybe Reference) -> - (Word64 -> Word64 -> Maybe (Term v ())) -> - Closure -> - DecompResult v -decompile _ _ (DataC rf (maskTags -> ct) [] []) - | rf == booleanRef = tag2bool ct -decompile _ _ (DataC rf (maskTags -> ct) [i] []) = - decompileUnboxed rf ct i -decompile backref topTerms (DataC rf _ [] [b]) - | rf == anyRef = - app () (builtin () "Any.Any") <$> decompile backref topTerms b -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 "" - | 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 - | k > 0, - Just _ <- topTerms rt 0 = - err (UnkLocal rf k) $ bug "" - | otherwise = err (UnkComb rf) $ ref () rf -decompile _ _ (PAp (CIx rf _ _) _ _) = - err (BadPAp rf) $ bug "" -decompile _ _ (DataC rf _ _ _) = err (BadData rf) $ bug "" -decompile _ _ BlackHole = err Exn $ bug "" -decompile _ _ (Captured {}) = err Cont $ bug "" -decompile backref topTerms (Foreign f) = - decompileForeign backref topTerms f - -tag2bool :: (Var v) => Word64 -> DecompResult v -tag2bool 0 = pure (boolean () False) -tag2bool 1 = pure (boolean () True) -tag2bool n = err (BadBool n) $ con booleanRef n - -substitute :: (Var v) => Term v () -> [Term v ()] -> Term v () -substitute = align [] - where - align vts (LamNamed' v bd) (t : ts) = align ((v, t) : vts) bd ts - align vts tm [] = substs vts tm - -- this should not happen - align vts tm ts = apps' (substs vts tm) ts - -decompileUnboxed :: - (Var v) => Reference -> Word64 -> Int -> DecompResult v -decompileUnboxed r _ i - | r == natRef = pure . nat () $ fromIntegral i - | r == intRef = pure . int () $ fromIntegral i - | r == floatRef = pure . float () $ unsafeCoerce i - | r == charRef = pure . char () $ toEnum i - | otherwise = err (BadUnboxed r) . nat () $ fromIntegral i - -decompileForeign :: - (Var v) => - (Reference -> Maybe Reference) -> - (Word64 -> Word64 -> Maybe (Term v ())) -> - Foreign -> - DecompResult v -decompileForeign backref topTerms f - | Just t <- maybeUnwrapBuiltin f = pure $ text () (Text.toText t) - | Just b <- maybeUnwrapBuiltin f = pure $ decompileBytes b - | Just h <- maybeUnwrapBuiltin f = pure $ decompileHashAlgorithm h - | Just l <- maybeUnwrapForeign termLinkRef f = - pure . termLink () $ case l of - Ref r -> maybe l Ref $ backref r - _ -> 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 _) = - err (BadForeign r) $ bug text - where - text - | Builtin name <- r = "<" <> name <> ">" - | otherwise = "" - -decompileBytes :: (Var v) => By.Bytes -> Term v () -decompileBytes = - app () (builtin () $ fromString "Bytes.fromList") - . list () - . fmap (nat () . fromIntegral) - . By.toWord8s - -decompileHashAlgorithm :: (Var v) => HashAlgorithm -> Term v () -decompileHashAlgorithm (HashAlgorithm r _) = ref () r - -unwrapSeq :: Foreign -> Maybe (Seq Closure) -unwrapSeq = maybeUnwrapForeign listRef diff --git a/parser-typechecker/src/Unison/Runtime/Foreign/Function.hs b/parser-typechecker/src/Unison/Runtime/Foreign/Function.hs deleted file mode 100644 index 3f1b93d9e2..0000000000 --- a/parser-typechecker/src/Unison/Runtime/Foreign/Function.hs +++ /dev/null @@ -1,548 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE ViewPatterns #-} - -module Unison.Runtime.Foreign.Function - ( ForeignFunc (..), - ForeignConvention (..), - mkForeign, - ) -where - -import Control.Concurrent (ThreadId) -import Control.Concurrent.MVar (MVar) -import Control.Concurrent.STM (TVar) -import Control.Exception (evaluate) -import Data.Atomics (Ticket) -import Data.Char qualified as Char -import Data.Foldable (toList) -import Data.IORef (IORef) -import Data.Primitive.Array as PA -import Data.Primitive.ByteArray as PA -import Data.Sequence qualified as Sq -import Data.Time.Clock.POSIX (POSIXTime) -import Data.Word (Word16, Word32, Word64, Word8) -import GHC.IO.Exception (IOErrorType (..), IOException (..)) -import Network.Socket (Socket) -import Network.UDP (UDPSocket) -import System.IO (BufferMode (..), Handle, IOMode, SeekMode) -import Unison.Builtin.Decls qualified as Ty -import Unison.Reference (Reference) -import Unison.Runtime.ANF (Mem (..), SuperGroup, Value, internalBug) -import Unison.Runtime.Exception -import Unison.Runtime.Foreign -import Unison.Runtime.MCode -import Unison.Runtime.Stack -import Unison.Symbol (Symbol) -import Unison.Type - ( iarrayRef, - ibytearrayRef, - marrayRef, - mbytearrayRef, - mvarRef, - promiseRef, - refRef, - ticketRef, - tvarRef, - typeLinkRef, - ) -import Unison.Util.Bytes (Bytes) -import Unison.Util.RefPromise (Promise) -import Unison.Util.Text (Text, pack, unpack) - --- Foreign functions operating on stacks -data ForeignFunc where - FF :: - (Stack 'UN -> Stack 'BX -> Args -> IO a) -> - (Stack 'UN -> Stack 'BX -> r -> IO (Stack 'UN, Stack 'BX)) -> - (a -> IO r) -> - ForeignFunc - -instance Show ForeignFunc where - show _ = "ForeignFunc" - -instance Eq ForeignFunc where - _ == _ = internalBug "Eq ForeignFunc" - -instance Ord ForeignFunc where - compare _ _ = internalBug "Ord ForeignFunc" - -class ForeignConvention a where - readForeign :: - [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a) - writeForeign :: - Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX) - -mkForeign :: - (ForeignConvention a, ForeignConvention r) => - (a -> IO r) -> - ForeignFunc -mkForeign ev = FF readArgs writeForeign ev - where - readArgs ustk bstk (argsToLists -> (us, bs)) = - readForeign us bs ustk bstk >>= \case - ([], [], a) -> pure a - _ -> - internalBug - "mkForeign: too many arguments for foreign function" - -instance ForeignConvention Int where - readForeign (i : us) bs ustk _ = (us,bs,) <$> peekOff ustk i - readForeign [] _ _ _ = foreignCCError "Int" - writeForeign ustk bstk i = do - ustk <- bump ustk - (ustk, bstk) <$ poke ustk i - -instance ForeignConvention Word64 where - readForeign (i : us) bs ustk _ = (us,bs,) <$> peekOffN ustk i - readForeign [] _ _ _ = foreignCCError "Word64" - writeForeign ustk bstk n = do - ustk <- bump ustk - (ustk, bstk) <$ pokeN ustk n - -instance ForeignConvention Word8 where - readForeign = readForeignAs (fromIntegral :: Word64 -> Word8) - writeForeign = writeForeignAs (fromIntegral :: Word8 -> Word64) - -instance ForeignConvention Word16 where - readForeign = readForeignAs (fromIntegral :: Word64 -> Word16) - writeForeign = writeForeignAs (fromIntegral :: Word16 -> Word64) - -instance ForeignConvention Word32 where - readForeign = readForeignAs (fromIntegral :: Word64 -> Word32) - writeForeign = writeForeignAs (fromIntegral :: Word32 -> Word64) - -instance ForeignConvention Char where - readForeign (i : us) bs ustk _ = (us,bs,) . Char.chr <$> peekOff ustk i - readForeign [] _ _ _ = foreignCCError "Char" - writeForeign ustk bstk ch = do - ustk <- bump ustk - (ustk, bstk) <$ poke ustk (Char.ord ch) - -instance ForeignConvention Closure where - readForeign us (i : bs) _ bstk = (us,bs,) <$> peekOff bstk i - readForeign _ [] _ _ = foreignCCError "Closure" - writeForeign ustk bstk c = do - bstk <- bump bstk - (ustk, bstk) <$ (poke bstk =<< evaluate c) - -instance ForeignConvention Text where - readForeign = readForeignBuiltin - writeForeign = writeForeignBuiltin - -instance ForeignConvention Bytes where - readForeign = readForeignBuiltin - writeForeign = writeForeignBuiltin - -instance ForeignConvention Socket where - readForeign = readForeignBuiltin - writeForeign = writeForeignBuiltin - -instance ForeignConvention UDPSocket where - readForeign = readForeignBuiltin - writeForeign = writeForeignBuiltin - -instance ForeignConvention ThreadId where - readForeign = readForeignBuiltin - writeForeign = writeForeignBuiltin - -instance ForeignConvention Handle where - readForeign = readForeignBuiltin - writeForeign = writeForeignBuiltin - -instance ForeignConvention POSIXTime where - readForeign = readForeignAs (fromIntegral :: Int -> POSIXTime) - writeForeign = writeForeignAs (round :: POSIXTime -> Int) - -instance (ForeignConvention a) => ForeignConvention (Maybe a) where - readForeign (i : us) bs ustk bstk = - peekOff ustk i >>= \case - 0 -> pure (us, bs, Nothing) - 1 -> fmap Just <$> readForeign us bs ustk bstk - _ -> foreignCCError "Maybe" - readForeign [] _ _ _ = foreignCCError "Maybe" - - writeForeign ustk bstk Nothing = do - ustk <- bump ustk - (ustk, bstk) <$ poke ustk 0 - writeForeign ustk bstk (Just x) = do - (ustk, bstk) <- writeForeign ustk bstk x - ustk <- bump ustk - (ustk, bstk) <$ poke ustk 1 - -instance - (ForeignConvention a, ForeignConvention b) => - ForeignConvention (Either a b) - where - readForeign (i : us) bs ustk bstk = - peekOff ustk i >>= \case - 0 -> readForeignAs Left us bs ustk bstk - 1 -> readForeignAs Right us bs ustk bstk - _ -> foreignCCError "Either" - readForeign _ _ _ _ = foreignCCError "Either" - - writeForeign ustk bstk (Left a) = do - (ustk, bstk) <- writeForeign ustk bstk a - ustk <- bump ustk - (ustk, bstk) <$ poke ustk 0 - writeForeign ustk bstk (Right b) = do - (ustk, bstk) <- writeForeign ustk bstk b - ustk <- bump ustk - (ustk, bstk) <$ poke ustk 1 - -ioeDecode :: Int -> IOErrorType -ioeDecode 0 = AlreadyExists -ioeDecode 1 = NoSuchThing -ioeDecode 2 = ResourceBusy -ioeDecode 3 = ResourceExhausted -ioeDecode 4 = EOF -ioeDecode 5 = IllegalOperation -ioeDecode 6 = PermissionDenied -ioeDecode 7 = UserError -ioeDecode _ = internalBug "ioeDecode" - -ioeEncode :: IOErrorType -> Int -ioeEncode AlreadyExists = 0 -ioeEncode NoSuchThing = 1 -ioeEncode ResourceBusy = 2 -ioeEncode ResourceExhausted = 3 -ioeEncode EOF = 4 -ioeEncode IllegalOperation = 5 -ioeEncode PermissionDenied = 6 -ioeEncode UserError = 7 -ioeEncode _ = internalBug "ioeDecode" - -instance ForeignConvention IOException where - readForeign = readForeignAs (bld . ioeDecode) - where - bld t = IOError Nothing t "" "" Nothing Nothing - - writeForeign = writeForeignAs (ioeEncode . ioe_type) - -readForeignAs :: - (ForeignConvention a) => - (a -> b) -> - [Int] -> - [Int] -> - Stack 'UN -> - Stack 'BX -> - IO ([Int], [Int], b) -readForeignAs f us bs ustk bstk = fmap f <$> readForeign us bs ustk bstk - -writeForeignAs :: - (ForeignConvention b) => - (a -> b) -> - Stack 'UN -> - Stack 'BX -> - a -> - IO (Stack 'UN, Stack 'BX) -writeForeignAs f ustk bstk x = writeForeign ustk bstk (f x) - -readForeignEnum :: - (Enum a) => - [Int] -> - [Int] -> - Stack 'UN -> - Stack 'BX -> - IO ([Int], [Int], a) -readForeignEnum = readForeignAs toEnum - -writeForeignEnum :: - (Enum a) => - Stack 'UN -> - Stack 'BX -> - a -> - IO (Stack 'UN, Stack 'BX) -writeForeignEnum = writeForeignAs fromEnum - -readForeignBuiltin :: - (BuiltinForeign b) => - [Int] -> - [Int] -> - Stack 'UN -> - Stack 'BX -> - IO ([Int], [Int], b) -readForeignBuiltin = readForeignAs (unwrapBuiltin . marshalToForeign) - -writeForeignBuiltin :: - (BuiltinForeign b) => - Stack 'UN -> - Stack 'BX -> - b -> - IO (Stack 'UN, Stack 'BX) -writeForeignBuiltin = writeForeignAs (Foreign . wrapBuiltin) - -writeTypeLink :: - Stack 'UN -> - Stack 'BX -> - Reference -> - IO (Stack 'UN, Stack 'BX) -writeTypeLink = writeForeignAs (Foreign . Wrap typeLinkRef) - -readTypelink :: - [Int] -> - [Int] -> - Stack 'UN -> - Stack 'BX -> - IO ([Int], [Int], Reference) -readTypelink = readForeignAs (unwrapForeign . marshalToForeign) - -instance ForeignConvention Double where - readForeign (i : us) bs ustk _ = (us,bs,) <$> peekOffD ustk i - readForeign _ _ _ _ = foreignCCError "Double" - writeForeign ustk bstk d = - bump ustk >>= \ustk -> - (ustk, bstk) <$ pokeD ustk d - -instance ForeignConvention Bool where - readForeign = readForeignEnum - writeForeign = writeForeignEnum - -instance ForeignConvention String where - readForeign = readForeignAs unpack - writeForeign = writeForeignAs pack - -instance ForeignConvention SeekMode where - readForeign = readForeignEnum - writeForeign = writeForeignEnum - -instance ForeignConvention IOMode where - readForeign = readForeignEnum - writeForeign = writeForeignEnum - -instance ForeignConvention () where - readForeign us bs _ _ = pure (us, bs, ()) - writeForeign ustk bstk _ = pure (ustk, bstk) - -instance - (ForeignConvention a, ForeignConvention b) => - ForeignConvention (a, b) - where - readForeign us bs ustk bstk = do - (us, bs, a) <- readForeign us bs ustk bstk - (us, bs, b) <- readForeign us bs ustk bstk - pure (us, bs, (a, b)) - - writeForeign ustk bstk (x, y) = do - (ustk, bstk) <- writeForeign ustk bstk y - writeForeign ustk bstk x - -instance (ForeignConvention a) => ForeignConvention (Failure a) where - readForeign us bs ustk bstk = do - (us, bs, typeref) <- readTypelink us bs ustk bstk - (us, bs, message) <- readForeign us bs ustk bstk - (us, bs, any) <- readForeign us bs ustk bstk - pure (us, bs, Failure typeref message any) - - writeForeign ustk bstk (Failure typeref message any) = do - (ustk, bstk) <- writeForeign ustk bstk any - (ustk, bstk) <- writeForeign ustk bstk message - writeTypeLink ustk bstk typeref - -instance - ( ForeignConvention a, - ForeignConvention b, - ForeignConvention c - ) => - ForeignConvention (a, b, c) - where - readForeign us bs ustk bstk = do - (us, bs, a) <- readForeign us bs ustk bstk - (us, bs, b) <- readForeign us bs ustk bstk - (us, bs, c) <- readForeign us bs ustk bstk - pure (us, bs, (a, b, c)) - - writeForeign ustk bstk (a, b, c) = do - (ustk, bstk) <- writeForeign ustk bstk c - (ustk, bstk) <- writeForeign ustk bstk b - writeForeign ustk bstk a - -instance - ( ForeignConvention a, - ForeignConvention b, - ForeignConvention c, - ForeignConvention d - ) => - ForeignConvention (a, b, c, d) - where - readForeign us bs ustk bstk = do - (us, bs, a) <- readForeign us bs ustk bstk - (us, bs, b) <- readForeign us bs ustk bstk - (us, bs, c) <- readForeign us bs ustk bstk - (us, bs, d) <- readForeign us bs ustk bstk - pure (us, bs, (a, b, c, d)) - - writeForeign ustk bstk (a, b, c, d) = do - (ustk, bstk) <- writeForeign ustk bstk d - (ustk, bstk) <- writeForeign ustk bstk c - (ustk, bstk) <- writeForeign ustk bstk b - writeForeign ustk bstk a - -instance - ( ForeignConvention a, - ForeignConvention b, - ForeignConvention c, - ForeignConvention d, - ForeignConvention e - ) => - ForeignConvention (a, b, c, d, e) - where - readForeign us bs ustk bstk = do - (us, bs, a) <- readForeign us bs ustk bstk - (us, bs, b) <- readForeign us bs ustk bstk - (us, bs, c) <- readForeign us bs ustk bstk - (us, bs, d) <- readForeign us bs ustk bstk - (us, bs, e) <- readForeign us bs ustk bstk - pure (us, bs, (a, b, c, d, e)) - - writeForeign ustk bstk (a, b, c, d, e) = do - (ustk, bstk) <- writeForeign ustk bstk e - (ustk, bstk) <- writeForeign ustk bstk d - (ustk, bstk) <- writeForeign ustk bstk c - (ustk, bstk) <- writeForeign ustk bstk b - writeForeign ustk bstk a - -no'buf, line'buf, block'buf, sblock'buf :: Int -no'buf = fromIntegral Ty.bufferModeNoBufferingId -line'buf = fromIntegral Ty.bufferModeLineBufferingId -block'buf = fromIntegral Ty.bufferModeBlockBufferingId -sblock'buf = fromIntegral Ty.bufferModeSizedBlockBufferingId - -instance ForeignConvention BufferMode where - readForeign (i : us) bs ustk bstk = - peekOff ustk i >>= \case - t - | t == no'buf -> pure (us, bs, NoBuffering) - | t == line'buf -> pure (us, bs, LineBuffering) - | t == block'buf -> pure (us, bs, BlockBuffering Nothing) - | t == sblock'buf -> - fmap (BlockBuffering . Just) - <$> readForeign us bs ustk bstk - | otherwise -> - foreignCCError $ - "BufferMode (unknown tag: " <> show t <> ")" - readForeign _ _ _ _ = foreignCCError $ "BufferMode (empty stack)" - - writeForeign ustk bstk bm = - bump ustk >>= \ustk -> - case bm of - NoBuffering -> (ustk, bstk) <$ poke ustk no'buf - LineBuffering -> (ustk, bstk) <$ poke ustk line'buf - BlockBuffering Nothing -> (ustk, bstk) <$ poke ustk block'buf - BlockBuffering (Just n) -> do - poke ustk n - ustk <- bump ustk - (ustk, bstk) <$ poke ustk sblock'buf - -instance ForeignConvention [Closure] where - readForeign us (i : bs) _ bstk = - (us,bs,) . toList <$> peekOffS bstk i - readForeign _ _ _ _ = foreignCCError "[Closure]" - writeForeign ustk bstk l = do - bstk <- bump bstk - (ustk, bstk) <$ pokeS bstk (Sq.fromList l) - -instance ForeignConvention [Foreign] where - readForeign = readForeignAs (fmap marshalToForeign) - writeForeign = writeForeignAs (fmap Foreign) - -instance ForeignConvention (MVar Closure) where - readForeign = readForeignAs (unwrapForeign . marshalToForeign) - writeForeign = writeForeignAs (Foreign . Wrap mvarRef) - -instance ForeignConvention (TVar Closure) where - readForeign = readForeignAs (unwrapForeign . marshalToForeign) - writeForeign = writeForeignAs (Foreign . Wrap tvarRef) - -instance ForeignConvention (IORef Closure) where - readForeign = readForeignAs (unwrapForeign . marshalToForeign) - writeForeign = writeForeignAs (Foreign . Wrap refRef) - -instance ForeignConvention (Ticket Closure) where - readForeign = readForeignAs (unwrapForeign . marshalToForeign) - writeForeign = writeForeignAs (Foreign . Wrap ticketRef) - -instance ForeignConvention (Promise Closure) where - readForeign = readForeignAs (unwrapForeign . marshalToForeign) - writeForeign = writeForeignAs (Foreign . Wrap promiseRef) - -instance ForeignConvention (SuperGroup Symbol) where - readForeign = readForeignBuiltin - writeForeign = writeForeignBuiltin - -instance ForeignConvention Value where - readForeign = readForeignBuiltin - writeForeign = writeForeignBuiltin - -instance ForeignConvention Foreign where - readForeign = readForeignAs marshalToForeign - writeForeign = writeForeignAs Foreign - -instance ForeignConvention (PA.MutableArray s Closure) where - readForeign = readForeignAs (unwrapForeign . marshalToForeign) - writeForeign = writeForeignAs (Foreign . Wrap marrayRef) - -instance ForeignConvention (PA.MutableByteArray s) where - readForeign = readForeignAs (unwrapForeign . marshalToForeign) - writeForeign = writeForeignAs (Foreign . Wrap mbytearrayRef) - -instance ForeignConvention (PA.Array Closure) where - readForeign = readForeignAs (unwrapForeign . marshalToForeign) - writeForeign = writeForeignAs (Foreign . Wrap iarrayRef) - -instance ForeignConvention PA.ByteArray where - readForeign = readForeignAs (unwrapForeign . marshalToForeign) - writeForeign = writeForeignAs (Foreign . Wrap ibytearrayRef) - -instance {-# OVERLAPPABLE #-} (BuiltinForeign b) => ForeignConvention b where - readForeign = readForeignBuiltin - writeForeign = writeForeignBuiltin - -fromUnisonPair :: Closure -> (a, b) -fromUnisonPair (DataC _ _ [] [x, DataC _ _ [] [y, _]]) = - (unwrapForeignClosure x, unwrapForeignClosure y) -fromUnisonPair _ = error "fromUnisonPair: invalid closure" - -toUnisonPair :: - (BuiltinForeign a, BuiltinForeign b) => (a, b) -> Closure -toUnisonPair (x, y) = - DataC - Ty.pairRef - 0 - [] - [wr x, DataC Ty.pairRef 0 [] [wr y, un]] - where - un = DataC Ty.unitRef 0 [] [] - wr z = Foreign $ wrapBuiltin z - -unwrapForeignClosure :: Closure -> a -unwrapForeignClosure = unwrapForeign . marshalToForeign - -instance {-# OVERLAPPABLE #-} (BuiltinForeign a, BuiltinForeign b) => ForeignConvention [(a, b)] where - readForeign us (i : bs) _ bstk = - (us,bs,) - . fmap fromUnisonPair - . toList - <$> peekOffS bstk i - readForeign _ _ _ _ = foreignCCError "[(a,b)]" - - writeForeign ustk bstk l = do - bstk <- bump bstk - (ustk, bstk) <$ pokeS bstk (toUnisonPair <$> Sq.fromList l) - -instance {-# OVERLAPPABLE #-} (BuiltinForeign b) => ForeignConvention [b] where - readForeign us (i : bs) _ bstk = - (us,bs,) - . fmap unwrapForeignClosure - . toList - <$> peekOffS bstk i - readForeign _ _ _ _ = foreignCCError "[b]" - writeForeign ustk bstk l = do - bstk <- bump bstk - (ustk, bstk) <$ pokeS bstk (Foreign . wrapBuiltin <$> Sq.fromList l) - -foreignCCError :: String -> IO a -foreignCCError nm = - die $ "mismatched foreign calling convention for `" ++ nm ++ "`" diff --git a/parser-typechecker/src/Unison/Runtime/MCode.hs b/parser-typechecker/src/Unison/Runtime/MCode.hs deleted file mode 100644 index c3d9c837bb..0000000000 --- a/parser-typechecker/src/Unison/Runtime/MCode.hs +++ /dev/null @@ -1,1635 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE PatternSynonyms #-} - -module Unison.Runtime.MCode - ( Args' (..), - Args (..), - RefNums (..), - MLit (..), - Instr (..), - Section (.., MatchT, MatchW), - Comb (..), - Combs, - CombIx (..), - Ref (..), - UPrim1 (..), - UPrim2 (..), - BPrim1 (..), - BPrim2 (..), - Branch (..), - bcount, - ucount, - emitCombs, - emitComb, - emptyRNs, - argsToLists, - combRef, - combDeps, - combTypes, - prettyCombs, - prettyComb, - ) -where - -import Data.Bifunctor (bimap, first) -import Data.Bits (shiftL, shiftR, (.|.)) -import Data.Coerce -import Data.List (partition) -import Data.Map.Strict qualified as M -import Data.Primitive.ByteArray -import Data.Primitive.PrimArray -import Data.Word (Word16, Word64) -import GHC.Stack (HasCallStack) -import Unison.ABT.Normalized (pattern TAbss) -import Unison.Reference (Reference) -import Unison.Referent (Referent) -import Unison.Runtime.ANF - ( ANormal, - Branched (..), - CTag, - Direction (..), - Func (..), - Mem (..), - SuperGroup (..), - SuperNormal (..), - internalBug, - packTags, - pattern TApp, - pattern TBLit, - pattern TFOp, - pattern TFrc, - pattern THnd, - pattern TLets, - pattern TLit, - pattern TMatch, - pattern TName, - pattern TPrm, - pattern TShift, - pattern TVar, - ) -import Unison.Runtime.ANF qualified as ANF -import Unison.Util.EnumContainers as EC -import Unison.Util.Text (Text) -import Unison.Var (Var) - --- This outlines some of the ideas/features in this core --- language, and how they may be used to implement features of --- the surface language. - ------------------------ --- Delimited control -- ------------------------ - --- There is native support for delimited control operations in --- the core language. This means we can: --- 1. delimit a block of code with an integer tagged prompt, --- which corresponds to pushing a frame onto the --- continuation with said tag --- 2. capture a portion of the continuation up to a particular --- tag frame and turn it into a value, which _removes_ the --- tag frame from the continuation in the process --- 3. push such a captured value back onto the continuation - --- TBD: Since the captured continuations in _delimited_ control --- are (in this case impure) functions, it may make sense to make --- the representation of functions support these captured --- continuations directly. - --- The obvious use case of this feature is effects and handlers. --- Delimiting a block with a prompt is part of installing a --- handler for said block at least naively. The other part is --- establishing the code that should be executed for each --- operation to be handled. - --- It's important (I believe) in #2 that the prompt be removed --- from the continuation by a control effect. The captured --- continuation not being automatically delimited corresponds to --- a shallow handler's obligation to re-establish the handling of --- a re-invoked computation if it wishes to do so. The delimiter --- being removed from the capturing code's continuation --- corresponds to a handler being allowed to yield effects from --- the same siganture that it is handling. - --- In special cases, it should be possible to omit use of control --- effects in handlers. At the least, if a handler case resumes --- the computation in tail position, it should be unnecessary to --- capture the continuation at all. If all cases act this way, we --- don't need a delimiter, because we will never capture. - --- TBD: it may make more sense to have prompt pushing be part of --- some other construct, due to A-normal forms of the code. - ------------------------------ --- Unboxed sum-of-products -- ------------------------------ - --- It is not usually stated this way, but one of the core --- features of the STG machine is that functions/closures can --- return unboxed sum-of-products types. This is actually the way --- _all_ data types work in STG. The discriminee of a case --- statement must eventually return by pushing several values --- onto the stack (the product part) and specifying which branch --- to return to (the sum part). - --- The way heap allocated data is produced is that an --- intermediate frame may be in the continuation that grabs this --- information from the local storage and puts it into the heap. --- If this frame were omitted, only the unboxed component would --- be left. Also, in STG, the heap allocated data is just a means --- of reconstructing its unboxed analogue. Evaluating a heap --- allocated data type value just results in pushing its stored --- fields back on the stack, and immediately returning the tag. - --- The portion of this with the heap allocation frame omitted --- seems to be a natural match for the case analysis portion of --- handlers. A naive implementation of an effect algebra is as --- the data type of the polynomial functor generated by the --- signature, and handling corresponds to case analysis. However, --- in a real implementation, we don't want a heap allocated --- representation of this algebra, because its purpose is control --- flow. Each operation will be handled once as it occurs, and we --- won't save work by remembering some reified representation of --- which operations were used. - --- Since handlers in unison are written as functions, it seems to --- make sense to define a calling convention for unboxed --- sum-of-products as arguments. Variable numbers of stack --- positions could be pushed for such arguments, with tags --- specifying which case is being provided. - --- TBD: sum arguments to a function correspond to a product of --- functions, so it's possible that the calling convention for --- these functions should be similar to returning to a case, --- where we push arguments and then select which of several --- pieces of code to jump to. This view also seems relevant to --- the optimized implementation of certain forms of handler, --- where we want effects to just directly select some code to --- execute based on state that has been threaded to that point. - --- One thing to note: it probably does not make sense to --- completely divide returns into unboxed returns and allocation --- frames. The reason this works in STG is laziness. Naming a --- computation with `let` does not do any evaluation, but it does --- allocate space for its (boxed) result. The only thing that --- _does_ demand evaluation is case analysis. So, if a value with --- sum type is being evaluated, we know it must be about to be --- unpacked, and it makes little sense to pack it on the stack, --- though we can build a closure version of it in the writeback --- location established by `let`. - --- By contrast, in unison a `let` of a sum type evaluates it --- immediately, even if no one is analyzing it. So we might waste --- work rearranging the stack with the unpacked contents when we --- only needed the closure version to begin with. Instead, we --- gain the ability to make the unpacking operation use no stack, --- because we know what we are unpacking must be a value. Turning --- boxed function calls into unboxed versions thus seems like a --- situational optimization, rather than a universal calling --- convention. - -------------------------------- --- Delimited Dynamic Binding -- -------------------------------- - --- There is a final component to the implementation of ability --- handlers in this runtime system, and that is dynamically --- scoped variables associated to each prompt. Each prompt --- corresponds to an ability signature, and `reset` to a handler --- for said signature, but we need storage space for the code --- installed by said handler. It is possible to implement --- dynamically scoped variables entirely with delimited --- continuations, but it is more efficient to keep track of the --- storage directly when manipulating the continuations. - --- The dynamic scoping---and how it interacts with --- continuations---corresponds to the nested structure of --- handlers. Installing a handler establishes a variable scope, --- shadowing outer scopes for the same prompt. Shifting, however, --- can exit these scopes dynamically. So, for instance, if we --- have a structure like: - --- reset 0 $ ... --- reset 1 $ ... --- reset 0 $ ... --- shift 1 - --- We have nested scopes 0>1>0, with the second 0 shadowing the --- first. However, when we shift to 1, the inner 0 scope is --- captured into the continuation, and uses of the 0 ability in --- will be handled by the outer handler until it is shadowed --- again (and the captured continuation will re-establish the --- shadowing). - --- Mutation of the variables is possible, but mutation only --- affects the current scope. Essentially, the dynamic scoping is --- of mutable references, and when scope changes, we switch --- between different references, and the mutation of each --- reference does not affect the others. The purpose of the --- mutation is to enable more efficient implementation of --- certain recursive, 'deep' handlers, since those can operate --- more like stateful code than control operators. - -data Args' - = Arg1 !Int - | Arg2 !Int !Int - | -- frame index of each argument to the function - ArgN {-# UNPACK #-} !(PrimArray Int) - | ArgR !Int !Int - deriving (Show) - -data Args - = ZArgs - | UArg1 !Int - | UArg2 !Int !Int - | BArg1 !Int - | BArg2 !Int !Int - | DArg2 !Int !Int - | UArgR !Int !Int - | BArgR !Int !Int - | DArgR !Int !Int !Int !Int - | BArgN !(PrimArray Int) - | UArgN !(PrimArray Int) - | DArgN !(PrimArray Int) !(PrimArray Int) - | DArgV !Int !Int - deriving (Show, Eq, Ord) - -argsToLists :: Args -> ([Int], [Int]) -argsToLists ZArgs = ([], []) -argsToLists (UArg1 i) = ([i], []) -argsToLists (UArg2 i j) = ([i, j], []) -argsToLists (BArg1 i) = ([], [i]) -argsToLists (BArg2 i j) = ([], [i, j]) -argsToLists (DArg2 i j) = ([i], [j]) -argsToLists (UArgR i l) = (take l [i ..], []) -argsToLists (BArgR i l) = ([], take l [i ..]) -argsToLists (DArgR ui ul bi bl) = (take ul [ui ..], take bl [bi ..]) -argsToLists (BArgN bs) = ([], primArrayToList bs) -argsToLists (UArgN us) = (primArrayToList us, []) -argsToLists (DArgN us bs) = (primArrayToList us, primArrayToList bs) -argsToLists (DArgV _ _) = internalBug "argsToLists: DArgV" - -ucount, bcount :: Args -> Int -ucount (UArg1 _) = 1 -ucount (UArg2 _ _) = 2 -ucount (DArg2 _ _) = 1 -ucount (UArgR _ l) = l -ucount (DArgR _ l _ _) = l -ucount _ = 0 -{-# INLINE ucount #-} -bcount (BArg1 _) = 1 -bcount (BArg2 _ _) = 2 -bcount (DArg2 _ _) = 1 -bcount (BArgR _ l) = l -bcount (DArgR _ _ _ l) = l -bcount (BArgN a) = sizeofPrimArray a -bcount _ = 0 -{-# INLINE bcount #-} - -data UPrim1 - = -- integral - DECI - | INCI - | NEGI - | SGNI -- decrement,increment,negate,signum - | LZRO - | TZRO - | COMN - | POPC -- leading/trailingZeroes,complement - -- floating - | ABSF - | EXPF - | LOGF - | SQRT -- abs,exp,log,sqrt - | COSF - | ACOS - | COSH - | ACSH -- cos,acos,cosh,acosh - | SINF - | ASIN - | SINH - | ASNH -- sin,asin,sinh,asinh - | TANF - | ATAN - | TANH - | ATNH -- tan,atan,tanh,atanh - | ITOF - | NTOF - | CEIL - | FLOR -- intToFloat,natToFloat,ceiling,floor - | TRNF - | RNDF -- truncate,round - deriving (Show, Eq, Ord) - -data UPrim2 - = -- integral - ADDI - | SUBI - | MULI - | DIVI - | MODI -- +,-,*,/,mod - | DIVN - | MODN - | SHLI - | SHRI - | SHRN - | POWI -- shiftl,shiftr,shiftr,pow - | EQLI - | LEQI - | LEQN -- ==,<=,<= - | ANDN - | IORN - | XORN -- and,or,xor - -- floating - | EQLF - | LEQF -- ==,<= - | ADDF - | SUBF - | MULF - | DIVF - | ATN2 -- +,-,*,/,atan2 - | POWF - | LOGB - | MAXF - | MINF -- pow,low,max,min - deriving (Show, Eq, Ord) - -data BPrim1 - = -- text - SIZT - | USNC - | UCNS -- size,unsnoc,uncons - | ITOT - | NTOT - | FTOT -- intToText,natToText,floatToText - | TTOI - | TTON - | TTOF -- textToInt,textToNat,textToFloat - | PAKT - | UPKT -- pack,unpack - -- sequence - | VWLS - | VWRS - | SIZS -- viewl,viewr,size - | PAKB - | UPKB - | SIZB -- pack,unpack,size - | FLTB -- flatten - -- code - | MISS - | CACH - | LKUP - | LOAD -- isMissing,cache_,lookup,load - | CVLD -- validate - | VALU - | TLTT -- value, Term.Link.toText - -- debug - | DBTX -- debug text - | SDBL -- sandbox link list - deriving (Show, Eq, Ord) - -data BPrim2 - = -- universal - EQLU - | CMPU -- ==,compare - -- text - | DRPT - | CATT - | TAKT -- drop,append,take - | IXOT -- indexof - | EQLT - | LEQT - | LEST -- ==,<=,< - -- sequence - | DRPS - | CATS - | TAKS -- drop,append,take - | CONS - | SNOC - | IDXS -- cons,snoc,index - | SPLL - | SPLR -- splitLeft,splitRight - -- bytes - | TAKB - | DRPB - | IDXB - | CATB -- take,drop,index,append - | IXOB -- indexof - -- general - | THRO -- throw - | TRCE -- trace - -- code - | SDBX -- sandbox - | SDBV -- sandbox Value - deriving (Show, Eq, Ord) - -data MLit - = MI !Int - | MD !Double - | MT !Text - | MM !Referent - | MY !Reference - deriving (Show, Eq, Ord) - --- Instructions for manipulating the data stack in the main portion of --- a block -data Instr - = -- 1-argument unboxed primitive operations - UPrim1 - !UPrim1 -- primitive instruction - !Int -- index of prim argument - | -- 2-argument unboxed primitive operations - UPrim2 - !UPrim2 -- primitive instruction - !Int -- index of first prim argument - !Int -- index of second prim argument - | -- 1-argument primitive operations that may involve boxed values - BPrim1 - !BPrim1 - !Int - | -- 2-argument primitive operations that may involve boxed values - BPrim2 - !BPrim2 - !Int - !Int - | -- Call out to a Haskell function. This is considerably slower - -- for very simple operations, hence the primops. - ForeignCall - !Bool -- catch exceptions - !Word64 -- FFI call - !Args -- arguments - | -- Set the value of a dynamic reference - SetDyn - !Word64 -- the prompt tag of the reference - !Int -- the stack index of the closure to store - | -- Capture the continuation up to a given marker. - Capture !Word64 -- the prompt tag - | -- This is essentially the opposite of `Call`. Pack a given - -- statically known function into a closure with arguments. - -- No stack is necessary, because no nested evaluation happens, - -- so the instruction directly takes a follow-up. - Name !Ref !Args - | -- Dump some debugging information about the machine state to - -- the screen. - Info !String -- prefix for output - | -- Pack a data type value into a closure and place it - -- on the stack. - Pack - !Reference -- data type reference - !Word64 -- tag - !Args -- arguments to pack - | -- Unpack the contents of a data type onto the stack - Unpack - !(Maybe Reference) -- debug reference - !Int -- stack index of data to unpack - | -- Push a particular value onto the appropriate stack - Lit !MLit -- value to push onto the stack - | -- Push a particular value directly onto the boxed stack - BLit !Reference !MLit - | -- Print a value on the unboxed stack - Print !Int -- index of the primitive value to print - | -- Put a delimiter on the continuation - Reset !(EnumSet Word64) -- prompt ids - | -- Fork thread evaluating delayed computation on boxed stack - Fork !Int - | -- Atomic transaction evaluating delayed computation on boxed stack - Atomically !Int - | -- Build a sequence consisting of a variable number of arguments - Seq !Args - | -- Force a delayed expression, catching any runtime exceptions involved - TryForce !Int - deriving (Show, Eq, Ord) - -data Section - = -- Apply a function to arguments. This is the 'slow path', and - -- handles applying functions from arbitrary sources. This - -- requires checks to determine what exactly should happen. - App - !Bool -- skip argument check for known calling convention - !Ref -- function to call - !Args -- arguments - | -- This is the 'fast path', for when we statically know we're - -- making an exactly saturated call to a statically known - -- function. This allows skipping various checks that can cost - -- time in very tight loops. This also allows skipping the - -- stack check if we know that the current stack allowance is - -- sufficient for where we're jumping to. - Call - !Bool -- skip stack check - !Word64 -- global function reference - !Args -- arguments - | -- Jump to a captured continuation value. - Jump - !Int -- index of captured continuation - !Args -- arguments to send to continuation - | -- Branch on the value in the unboxed data stack - Match - !Int -- index of unboxed item to match on - !Branch -- branches - | -- Yield control to the current continuation, with arguments - Yield !Args -- values to yield - | -- Prefix an instruction onto a section - Ins !Instr !Section - | -- Sequence two sections. The second is pushed as a return - -- point for the results of the first. Stack modifications in - -- the first are lost on return to the second. - Let !Section !CombIx - | -- Throw an exception with the given message - Die String - | -- Immediately stop a thread of interpretation. This is more of - -- a debugging tool than a proper operation to target. - Exit - | -- Branch on a data type without dumping the tag onto the unboxed - -- stack. - DMatch - !(Maybe Reference) -- expected data type - !Int -- index of data item on boxed stack - !Branch -- branches - | -- Branch on a numeric type without dumping it to the stack - NMatch - !(Maybe Reference) -- expected data type - !Int -- index of data item on boxed stack - !Branch -- branches - | -- Branch on a request representation without dumping the tag - -- portion to the unboxed stack. - RMatch - !Int -- index of request item on the boxed stack - !Section -- pure case - !(EnumMap Word64 Branch) -- effect cases - deriving (Show, Eq, Ord) - -data CombIx - = CIx - !Reference -- top reference - !Word64 -- top level - !Word64 -- section - deriving (Eq, Ord, Show) - -combRef :: CombIx -> Reference -combRef (CIx r _ _) = r - -data RefNums = RN - { dnum :: Reference -> Word64, - cnum :: Reference -> Word64 - } - -emptyRNs :: RefNums -emptyRNs = RN mt mt - where - mt _ = internalBug "RefNums: empty" - -data Comb - = Lam - !Int -- Number of unboxed arguments - !Int -- Number of boxed arguments - !Int -- Maximum needed unboxed frame size - !Int -- Maximum needed boxed frame size - !Section -- Entry - deriving (Show, Eq, Ord) - -type Combs = EnumMap Word64 Comb - -data Ref - = Stk !Int -- stack reference to a closure - | Env - !Word64 -- global environment reference to a combinator - !Word64 -- section - | Dyn !Word64 -- dynamic scope reference to a closure - deriving (Show, Eq, Ord) - -data Branch - = -- if tag == n then t else f - Test1 - !Word64 - !Section - !Section - | Test2 - !Word64 - !Section -- if tag == m then ... - !Word64 - !Section -- else if tag == n then ... - !Section -- else ... - | TestW - !Section - !(EnumMap Word64 Section) - | TestT - !Section - !(M.Map Text Section) - deriving (Show, Eq, Ord) - --- Convenience patterns for matches used in the algorithms below. -pattern MatchW :: Int -> Section -> EnumMap Word64 Section -> Section -pattern MatchW i d cs = Match i (TestW d cs) - -pattern MatchT :: Int -> Section -> M.Map Text Section -> Section -pattern MatchT i d cs = Match i (TestT d cs) - -pattern NMatchW :: - Maybe Reference -> Int -> Section -> EnumMap Word64 Section -> Section -pattern NMatchW r i d cs = NMatch r i (TestW d cs) - --- Representation of the variable context available in the current --- frame. This tracks tags that have been dumped to the stack for --- proper indexing. The `Block` constructor is used to mark when we --- go into the first portion of a `Let`, to track the size of that --- sub-frame. -data Ctx v - = ECtx - | Block (Ctx v) - | Tag (Ctx v) - | Var v Mem (Ctx v) - deriving (Show) - --- Represents the context formed by the top-level let rec around a --- set of definitions. Previous steps have normalized the term to --- only contain a single recursive binding group. The variables in --- this binding group are resolved to numbered combinators rather --- than stack positions. -type RCtx v = M.Map v Word64 - --- Add a sequence of variables and corresponding calling conventions --- to the context. -ctx :: [v] -> [Mem] -> Ctx v -ctx vs cs = pushCtx (zip vs cs) ECtx - --- Look up a variable in the context, getting its position on the --- relevant stack and its calling convention if it is there. -ctxResolve :: (Var v) => Ctx v -> v -> Maybe (Int, Mem) -ctxResolve ctx v = walk 0 0 ctx - where - walk _ _ ECtx = Nothing - walk ui bi (Block ctx) = walk ui bi ctx - walk ui bi (Tag ctx) = walk (ui + 1) bi ctx - walk ui bi (Var x m ctx) - | v == x = case m of BX -> Just (bi, m); UN -> Just (ui, m) - | otherwise = walk ui' bi' ctx - where - (ui', bi') = case m of BX -> (ui, bi + 1); UN -> (ui + 1, bi) - --- Add a sequence of variables and calling conventions to the context. -pushCtx :: [(v, Mem)] -> Ctx v -> Ctx v -pushCtx new old = foldr (uncurry Var) old new - --- Concatenate two contexts -catCtx :: Ctx v -> Ctx v -> Ctx v -catCtx ECtx r = r -catCtx (Tag l) r = Tag $ catCtx l r -catCtx (Block l) r = Block $ catCtx l r -catCtx (Var v m l) r = Var v m $ catCtx l r - --- Split the context after a particular variable -breakAfter :: (Eq v) => (v -> Bool) -> Ctx v -> (Ctx v, Ctx v) -breakAfter _ ECtx = (ECtx, ECtx) -breakAfter p (Tag vs) = first Tag $ breakAfter p vs -breakAfter p (Block vs) = first Block $ breakAfter p vs -breakAfter p (Var v m vs) = (Var v m lvs, rvs) - where - (lvs, rvs) - | p v = (ECtx, vs) - | otherwise = breakAfter p vs - --- Modify the context to contain the variables introduced by an --- unboxed sum -sumCtx :: (Var v) => Ctx v -> v -> [(v, Mem)] -> Ctx v -sumCtx ctx v vcs - | (lctx, rctx) <- breakAfter (== v) ctx = - catCtx lctx $ pushCtx vcs rctx - --- Look up a variable in the top let rec context -rctxResolve :: (Var v) => RCtx v -> v -> Maybe Word64 -rctxResolve ctx u = M.lookup u ctx - --- Compile a top-level definition group to a collection of combinators. --- The provided word refers to the numbering for the overall group, --- and intra-group calls are numbered locally, with 0 specifying --- the global entry point. -emitCombs :: - (Var v) => - RefNums -> - Reference -> - Word64 -> - SuperGroup v -> - EnumMap Word64 Comb -emitCombs rns grpr grpn (Rec grp ent) = - emitComb rns grpr grpn rec (0, ent) <> aux - where - (rvs, cmbs) = unzip grp - ixs = map (`shiftL` 16) [1 ..] - rec = M.fromList $ zip rvs ixs - aux = foldMap (emitComb rns grpr grpn rec) (zip ixs cmbs) - --- Type for aggregating the necessary stack frame size. First field is --- unboxed size, second is boxed. The Applicative instance takes the --- point-wise maximum, so that combining values from different branches --- results in finding the maximum value of either size necessary. -data Counted a = C !Int !Int a - deriving (Functor) - -instance Applicative Counted where - pure = C 0 0 - C u0 b0 f <*> C u1 b1 x = C (max u0 u1) (max b0 b1) (f x) - -newtype Emit a - = EM (Word64 -> (EC.EnumMap Word64 Comb, Counted a)) - deriving (Functor) - -runEmit :: Word64 -> Emit a -> EC.EnumMap Word64 Comb -runEmit w (EM e) = fst $ e w - -instance Applicative Emit where - pure = EM . pure . pure . pure - EM ef <*> EM ex = EM $ (liftA2 . liftA2) (<*>) ef ex - -counted :: Counted a -> Emit a -counted = EM . pure . pure - -onCount :: (Counted a -> Counted b) -> Emit a -> Emit b -onCount f (EM e) = EM $ fmap f <$> e - -letIndex :: Word16 -> Word64 -> Word64 -letIndex l c = c .|. fromIntegral l - -record :: Ctx v -> Word16 -> Emit Section -> Emit Word64 -record ctx l (EM es) = EM $ \c -> - let (m, C u b s) = es c - (au, ab) = countCtx0 0 0 ctx - n = letIndex l c - in (EC.mapInsert n (Lam au ab u b s) m, C u b n) - -recordTop :: [v] -> Word16 -> Emit Section -> Emit () -recordTop vs l (EM e) = EM $ \c -> - let (m, C u b s) = e c - ab = length vs - n = letIndex l c - in (EC.mapInsert n (Lam 0 ab u b s) m, C u b ()) - --- Counts the stack space used by a context and annotates a value --- with it. -countCtx :: Ctx v -> a -> Emit a -countCtx ctx = counted . C u b where (u, b) = countCtx0 0 0 ctx - -countCtx0 :: Int -> Int -> Ctx v -> (Int, Int) -countCtx0 !ui !bi (Var _ UN ctx) = countCtx0 (ui + 1) bi ctx -countCtx0 ui bi (Var _ BX ctx) = countCtx0 ui (bi + 1) ctx -countCtx0 ui bi (Tag ctx) = countCtx0 (ui + 1) bi ctx -countCtx0 ui bi (Block ctx) = countCtx0 ui bi ctx -countCtx0 ui bi ECtx = (ui, bi) - -emitComb :: - (Var v) => - RefNums -> - Reference -> - Word64 -> - RCtx v -> - (Word64, SuperNormal v) -> - EC.EnumMap Word64 Comb -emitComb rns grpr grpn rec (n, Lambda ccs (TAbss vs bd)) = - runEmit n - . recordTop vs 0 - $ emitSection rns grpr grpn rec (ctx vs ccs) bd - -addCount :: Int -> Int -> Emit a -> Emit a -addCount i j = onCount $ \(C u b x) -> C (u + i) (b + j) x - --- Emit a machine code section from an ANF term -emitSection :: - (Var v) => - RefNums -> - Reference -> - Word64 -> - RCtx v -> - Ctx v -> - ANormal v -> - Emit Section -emitSection rns grpr grpn rec ctx (TLets d us ms bu bo) = - emitLet rns grpr grpn rec d (zip us ms) ctx bu $ - emitSection rns grpr grpn rec ectx bo - where - ectx = pushCtx (zip us ms) ctx -emitSection rns grpr grpn rec ctx (TName u (Left f) args bo) = - emitClosures grpn rec ctx args $ \ctx as -> - Ins (Name (Env (cnum rns f) 0) as) - <$> emitSection rns grpr grpn rec (Var u BX ctx) bo -emitSection rns grpr grpn rec ctx (TName u (Right v) args bo) - | Just (i, BX) <- ctxResolve ctx v = - emitClosures grpn rec ctx args $ \ctx as -> - Ins (Name (Stk i) as) - <$> emitSection rns grpr grpn rec (Var u BX ctx) bo - | Just n <- rctxResolve rec v = - emitClosures grpn rec ctx args $ \ctx as -> - Ins (Name (Env grpn n) as) - <$> emitSection rns grpr grpn rec (Var u BX ctx) bo - | otherwise = emitSectionVErr v -emitSection _ _ grpn rec ctx (TVar v) - | Just (i, BX) <- ctxResolve ctx v = countCtx ctx . Yield $ BArg1 i - | Just (i, UN) <- ctxResolve ctx v = countCtx ctx . Yield $ UArg1 i - | Just j <- rctxResolve rec v = - countCtx ctx $ App False (Env grpn j) ZArgs - | otherwise = emitSectionVErr v -emitSection _ _ grpn _ ctx (TPrm p args) = - -- 3 is a conservative estimate of how many extra stack slots - -- a prim op will need for its results. - addCount 3 3 - . countCtx ctx - . Ins (emitPOp p $ emitArgs grpn ctx args) - . Yield - $ DArgV i j - where - (i, j) = countBlock ctx -emitSection _ _ grpn _ ctx (TFOp p args) = - addCount 3 3 - . countCtx ctx - . Ins (emitFOp p $ emitArgs grpn ctx args) - . Yield - $ DArgV i j - where - (i, j) = countBlock ctx -emitSection rns _ grpn rec ctx (TApp f args) = - emitClosures grpn rec ctx args $ \ctx as -> - countCtx ctx $ emitFunction rns grpn rec ctx f as -emitSection _ _ _ _ ctx (TLit l) = - c . countCtx ctx . Ins (emitLit l) . Yield $ litArg l - where - c - | ANF.T {} <- l = addCount 0 1 - | ANF.LM {} <- l = addCount 0 1 - | ANF.LY {} <- l = addCount 0 1 - | otherwise = addCount 1 0 -emitSection _ _ _ _ ctx (TBLit l) = - addCount 0 1 . countCtx ctx . Ins (emitBLit l) . Yield $ BArg1 0 -emitSection rns grpr grpn rec ctx (TMatch v bs) - | Just (i, BX) <- ctxResolve ctx v, - MatchData r cs df <- bs = - DMatch (Just r) i - <$> emitDataMatching r rns grpr grpn rec ctx cs df - | Just (i, BX) <- ctxResolve ctx v, - MatchRequest hs0 df <- bs, - hs <- mapFromList $ first (dnum rns) <$> M.toList hs0 = - uncurry (RMatch i) - <$> emitRequestMatching rns grpr grpn rec ctx hs df - | Just (i, UN) <- ctxResolve ctx v, - MatchIntegral cs df <- bs = - emitLitMatching - MatchW - "missing integral case" - rns - grpr - grpn - rec - ctx - i - cs - df - | Just (i, BX) <- ctxResolve ctx v, - MatchNumeric r cs df <- bs = - emitLitMatching - (NMatchW (Just r)) - "missing integral case" - rns - grpr - grpn - rec - ctx - i - cs - df - | Just (i, BX) <- ctxResolve ctx v, - MatchText cs df <- bs = - emitLitMatching - MatchT - "missing text case" - rns - grpr - grpn - rec - ctx - i - cs - df - | Just (i, UN) <- ctxResolve ctx v, - MatchSum cs <- bs = - emitSumMatching rns grpr grpn rec ctx v i cs - | Just (_, cc) <- ctxResolve ctx v = - internalBug $ - "emitSection: mismatched calling convention for match: " - ++ matchCallingError cc bs - | otherwise = - internalBug $ - "emitSection: could not resolve match variable: " ++ show (ctx, v) -emitSection rns grpr grpn rec ctx (THnd rs h b) - | Just (i, BX) <- ctxResolve ctx h = - Ins (Reset (EC.setFromList ws)) - . flip (foldr (\r -> Ins (SetDyn r i))) ws - <$> emitSection rns grpr grpn rec ctx b - | otherwise = emitSectionVErr h - where - ws = dnum rns <$> rs -emitSection rns grpr grpn rec ctx (TShift r v e) = - Ins (Capture $ dnum rns r) - <$> emitSection rns grpr grpn rec (Var v BX ctx) e -emitSection _ _ _ _ ctx (TFrc v) - | Just (i, BX) <- ctxResolve ctx v = - countCtx ctx $ App False (Stk i) ZArgs - | Just _ <- ctxResolve ctx v = - internalBug $ - "emitSection: values to be forced must be boxed: " ++ show v - | otherwise = emitSectionVErr v -emitSection _ _ _ _ _ tm = - internalBug $ "emitSection: unhandled code: " ++ show tm - --- Emit the code for a function call -emitFunction :: - (Var v) => - RefNums -> - Word64 -> -- self combinator number - RCtx v -> -- recursive binding group - Ctx v -> -- local context - Func v -> - Args -> - Section -emitFunction _ grpn rec ctx (FVar v) as - | Just (i, BX) <- ctxResolve ctx v = - App False (Stk i) as - | Just j <- rctxResolve rec v = - App False (Env grpn j) as - | otherwise = emitSectionVErr v -emitFunction rns _ _ _ (FComb r) as - | otherwise -- slow path - = - App False (Env n 0) as - where - n = cnum rns r -emitFunction rns _ _ _ (FCon r t) as = - Ins (Pack r (packTags rt t) as) - . Yield - $ BArg1 0 - where - rt = toEnum . fromIntegral $ dnum rns r -emitFunction rns _ _ _ (FReq r e) as = - -- Currently implementing packed calling convention for abilities - -- TODO ct is 16 bits, but a is 48 bits. This will be a problem if we have - -- more than 2^16 types. - Ins (Pack r (packTags rt e) as) - . App True (Dyn a) - $ BArg1 0 - where - a = dnum rns r - rt = toEnum . fromIntegral $ a -emitFunction _ _ _ ctx (FCont k) as - | Just (i, BX) <- ctxResolve ctx k = Jump i as - | Nothing <- ctxResolve ctx k = emitFunctionVErr k - | otherwise = internalBug $ "emitFunction: continuations are boxed" -emitFunction _ _ _ _ (FPrim _) _ = - internalBug "emitFunction: impossible" - -countBlock :: Ctx v -> (Int, Int) -countBlock = go 0 0 - where - go !ui !bi (Var _ UN ctx) = go (ui + 1) bi ctx - go ui bi (Var _ BX ctx) = go ui (bi + 1) ctx - go ui bi (Tag ctx) = go (ui + 1) bi ctx - go ui bi _ = (ui, bi) - -matchCallingError :: Mem -> Branched v -> String -matchCallingError cc b = "(" ++ show cc ++ "," ++ brs ++ ")" - where - brs - | MatchData _ _ _ <- b = "MatchData" - | MatchEmpty <- b = "MatchEmpty" - | MatchIntegral _ _ <- b = "MatchIntegral" - | MatchNumeric _ _ _ <- b = "MatchNumeric" - | MatchRequest _ _ <- b = "MatchRequest" - | MatchSum _ <- b = "MatchSum" - | MatchText _ _ <- b = "MatchText" - -emitSectionVErr :: (Var v, HasCallStack) => v -> a -emitSectionVErr v = - internalBug $ - "emitSection: could not resolve function variable: " ++ show v - -emitFunctionVErr :: (Var v, HasCallStack) => v -> a -emitFunctionVErr v = - internalBug $ - "emitFunction: could not resolve function variable: " ++ show v - -litArg :: ANF.Lit -> Args -litArg ANF.T {} = BArg1 0 -litArg ANF.LM {} = BArg1 0 -litArg ANF.LY {} = BArg1 0 -litArg _ = UArg1 0 - --- Emit machine code for a let expression. Some expressions do not --- require a machine code Let, which uses more complicated stack --- manipulation. -emitLet :: - (Var v) => - RefNums -> - Reference -> - Word64 -> - RCtx v -> - Direction Word16 -> - [(v, Mem)] -> - Ctx v -> - ANormal v -> - Emit Section -> - Emit Section -emitLet _ _ _ _ _ _ _ (TLit l) = - fmap (Ins $ emitLit l) -emitLet _ _ _ _ _ _ _ (TBLit l) = - fmap (Ins $ emitBLit l) --- emitLet rns grp _ _ _ ctx (TApp (FComb r) args) --- -- We should be able to tell if we are making a saturated call --- -- or not here. We aren't carrying the information here yet, though. --- | False -- not saturated --- = fmap (Ins . Name (Env n 0) $ emitArgs grp ctx args) --- where --- n = cnum rns r -emitLet rns _ grpn _ _ _ ctx (TApp (FCon r n) args) = - fmap (Ins . Pack r (packTags rt n) $ emitArgs grpn ctx args) - where - rt = toEnum . fromIntegral $ dnum rns r -emitLet _ _ grpn _ _ _ ctx (TApp (FPrim p) args) = - fmap (Ins . either emitPOp emitFOp p $ emitArgs grpn ctx args) -emitLet rns grpr grpn rec d vcs ctx bnd - | Direct <- d = - internalBug $ "unsupported compound direct let: " ++ show bnd - | Indirect w <- d = - \esect -> - f - <$> emitSection rns grpr grpn rec (Block ctx) bnd - <*> record (pushCtx vcs ctx) w esect - where - f s w = Let s (CIx grpr grpn w) - --- Translate from ANF prim ops to machine code operations. The --- machine code operations are divided with respect to more detailed --- information about expected number and types of arguments. -emitPOp :: ANF.POp -> Args -> Instr --- Integral -emitPOp ANF.ADDI = emitP2 ADDI -emitPOp ANF.ADDN = emitP2 ADDI -emitPOp ANF.SUBI = emitP2 SUBI -emitPOp ANF.SUBN = emitP2 SUBI -emitPOp ANF.MULI = emitP2 MULI -emitPOp ANF.MULN = emitP2 MULI -emitPOp ANF.DIVI = emitP2 DIVI -emitPOp ANF.DIVN = emitP2 DIVN -emitPOp ANF.MODI = emitP2 MODI -- TODO: think about how these behave -emitPOp ANF.MODN = emitP2 MODN -- TODO: think about how these behave -emitPOp ANF.POWI = emitP2 POWI -emitPOp ANF.POWN = emitP2 POWI -emitPOp ANF.SHLI = emitP2 SHLI -emitPOp ANF.SHLN = emitP2 SHLI -- Note: left shift behaves uniformly -emitPOp ANF.SHRI = emitP2 SHRI -emitPOp ANF.SHRN = emitP2 SHRN -emitPOp ANF.LEQI = emitP2 LEQI -emitPOp ANF.LEQN = emitP2 LEQN -emitPOp ANF.EQLI = emitP2 EQLI -emitPOp ANF.EQLN = emitP2 EQLI -emitPOp ANF.SGNI = emitP1 SGNI -emitPOp ANF.NEGI = emitP1 NEGI -emitPOp ANF.INCI = emitP1 INCI -emitPOp ANF.INCN = emitP1 INCI -emitPOp ANF.DECI = emitP1 DECI -emitPOp ANF.DECN = emitP1 DECI -emitPOp ANF.TZRO = emitP1 TZRO -emitPOp ANF.LZRO = emitP1 LZRO -emitPOp ANF.POPC = emitP1 POPC -emitPOp ANF.ANDN = emitP2 ANDN -emitPOp ANF.IORN = emitP2 IORN -emitPOp ANF.XORN = emitP2 XORN -emitPOp ANF.COMN = emitP1 COMN --- Float -emitPOp ANF.ADDF = emitP2 ADDF -emitPOp ANF.SUBF = emitP2 SUBF -emitPOp ANF.MULF = emitP2 MULF -emitPOp ANF.DIVF = emitP2 DIVF -emitPOp ANF.LEQF = emitP2 LEQF -emitPOp ANF.EQLF = emitP2 EQLF -emitPOp ANF.MINF = emitP2 MINF -emitPOp ANF.MAXF = emitP2 MAXF -emitPOp ANF.POWF = emitP2 POWF -emitPOp ANF.EXPF = emitP1 EXPF -emitPOp ANF.ABSF = emitP1 ABSF -emitPOp ANF.SQRT = emitP1 SQRT -emitPOp ANF.LOGF = emitP1 LOGF -emitPOp ANF.LOGB = emitP2 LOGB -emitPOp ANF.CEIL = emitP1 CEIL -emitPOp ANF.FLOR = emitP1 FLOR -emitPOp ANF.TRNF = emitP1 TRNF -emitPOp ANF.RNDF = emitP1 RNDF -emitPOp ANF.COSF = emitP1 COSF -emitPOp ANF.SINF = emitP1 SINF -emitPOp ANF.TANF = emitP1 TANF -emitPOp ANF.COSH = emitP1 COSH -emitPOp ANF.SINH = emitP1 SINH -emitPOp ANF.TANH = emitP1 TANH -emitPOp ANF.ACOS = emitP1 ACOS -emitPOp ANF.ATAN = emitP1 ATAN -emitPOp ANF.ASIN = emitP1 ASIN -emitPOp ANF.ACSH = emitP1 ACSH -emitPOp ANF.ASNH = emitP1 ASNH -emitPOp ANF.ATNH = emitP1 ATNH -emitPOp ANF.ATN2 = emitP2 ATN2 --- conversions -emitPOp ANF.ITOF = emitP1 ITOF -emitPOp ANF.NTOF = emitP1 NTOF -emitPOp ANF.ITOT = emitBP1 ITOT -emitPOp ANF.NTOT = emitBP1 NTOT -emitPOp ANF.FTOT = emitBP1 FTOT -emitPOp ANF.TTON = emitBP1 TTON -emitPOp ANF.TTOI = emitBP1 TTOI -emitPOp ANF.TTOF = emitBP1 TTOF --- text -emitPOp ANF.CATT = emitBP2 CATT -emitPOp ANF.TAKT = emitBP2 TAKT -emitPOp ANF.DRPT = emitBP2 DRPT -emitPOp ANF.IXOT = emitBP2 IXOT -emitPOp ANF.SIZT = emitBP1 SIZT -emitPOp ANF.UCNS = emitBP1 UCNS -emitPOp ANF.USNC = emitBP1 USNC -emitPOp ANF.EQLT = emitBP2 EQLT -emitPOp ANF.LEQT = emitBP2 LEQT -emitPOp ANF.PAKT = emitBP1 PAKT -emitPOp ANF.UPKT = emitBP1 UPKT --- sequence -emitPOp ANF.CATS = emitBP2 CATS -emitPOp ANF.TAKS = emitBP2 TAKS -emitPOp ANF.DRPS = emitBP2 DRPS -emitPOp ANF.SIZS = emitBP1 SIZS -emitPOp ANF.CONS = emitBP2 CONS -emitPOp ANF.SNOC = emitBP2 SNOC -emitPOp ANF.IDXS = emitBP2 IDXS -emitPOp ANF.VWLS = emitBP1 VWLS -emitPOp ANF.VWRS = emitBP1 VWRS -emitPOp ANF.SPLL = emitBP2 SPLL -emitPOp ANF.SPLR = emitBP2 SPLR --- bytes -emitPOp ANF.PAKB = emitBP1 PAKB -emitPOp ANF.UPKB = emitBP1 UPKB -emitPOp ANF.TAKB = emitBP2 TAKB -emitPOp ANF.DRPB = emitBP2 DRPB -emitPOp ANF.IXOB = emitBP2 IXOB -emitPOp ANF.IDXB = emitBP2 IDXB -emitPOp ANF.SIZB = emitBP1 SIZB -emitPOp ANF.FLTB = emitBP1 FLTB -emitPOp ANF.CATB = emitBP2 CATB --- universal comparison -emitPOp ANF.EQLU = emitBP2 EQLU -emitPOp ANF.CMPU = emitBP2 CMPU --- code operations -emitPOp ANF.MISS = emitBP1 MISS -emitPOp ANF.CACH = emitBP1 CACH -emitPOp ANF.LKUP = emitBP1 LKUP -emitPOp ANF.TLTT = emitBP1 TLTT -emitPOp ANF.CVLD = emitBP1 CVLD -emitPOp ANF.LOAD = emitBP1 LOAD -emitPOp ANF.VALU = emitBP1 VALU -emitPOp ANF.SDBX = emitBP2 SDBX -emitPOp ANF.SDBL = emitBP1 SDBL -emitPOp ANF.SDBV = emitBP2 SDBV --- error call -emitPOp ANF.EROR = emitBP2 THRO -emitPOp ANF.TRCE = emitBP2 TRCE -emitPOp ANF.DBTX = emitBP1 DBTX --- non-prim translations -emitPOp ANF.BLDS = Seq -emitPOp ANF.FORK = \case - BArg1 i -> Fork i - _ -> internalBug "fork takes exactly one boxed argument" -emitPOp ANF.ATOM = \case - BArg1 i -> Atomically i - _ -> internalBug "atomically takes exactly one boxed argument" -emitPOp ANF.PRNT = \case - BArg1 i -> Print i - _ -> internalBug "print takes exactly one boxed argument" -emitPOp ANF.INFO = \case - ZArgs -> Info "debug" - _ -> internalBug "info takes no arguments" -emitPOp ANF.TFRC = \case - BArg1 i -> TryForce i - _ -> internalBug "tryEval takes exactly one boxed argument" - --- handled in emitSection because Die is not an instruction - --- Emit machine code for ANF IO operations. These are all translated --- to 'foreing function' calls, but there is a special case for the --- standard handle access function, because it does not yield an --- explicit error. -emitFOp :: ANF.FOp -> Args -> Instr -emitFOp fop = ForeignCall True (fromIntegral $ fromEnum fop) - --- Helper functions for packing the variable argument representation --- into the indexes stored in prim op instructions -emitP1 :: UPrim1 -> Args -> Instr -emitP1 p (UArg1 i) = UPrim1 p i -emitP1 p a = - internalBug $ - "wrong number of args for unary unboxed primop: " - ++ show (p, a) - -emitP2 :: UPrim2 -> Args -> Instr -emitP2 p (UArg2 i j) = UPrim2 p i j -emitP2 p a = - internalBug $ - "wrong number of args for binary unboxed primop: " - ++ show (p, a) - -emitBP1 :: BPrim1 -> Args -> Instr -emitBP1 p (UArg1 i) = BPrim1 p i -emitBP1 p (BArg1 i) = BPrim1 p i -emitBP1 p a = - internalBug $ - "wrong number of args for unary boxed primop: " - ++ show (p, a) - -emitBP2 :: BPrim2 -> Args -> Instr -emitBP2 p (UArg2 i j) = BPrim2 p i j -emitBP2 p (BArg2 i j) = BPrim2 p i j -emitBP2 p (DArg2 i j) = BPrim2 p i j -emitBP2 p a = - internalBug $ - "wrong number of args for binary boxed primop: " - ++ show (p, a) - -emitDataMatching :: - (Var v) => - Reference -> - RefNums -> - Reference -> - Word64 -> - RCtx v -> - Ctx v -> - EnumMap CTag ([Mem], ANormal v) -> - Maybe (ANormal v) -> - Emit Branch -emitDataMatching r rns grpr grpn rec ctx cs df = - TestW <$> edf <*> traverse (emitCase rns grpr grpn rec ctx) (coerce cs) - where - -- Note: this is not really accurate. A default data case needs - -- stack space corresponding to the actual data that shows up there. - -- However, we currently don't use default cases for data. - edf - | Just co <- df = emitSection rns grpr grpn rec ctx co - | otherwise = countCtx ctx $ Die ("missing data case for hash " <> show r) - --- Emits code corresponding to an unboxed sum match. --- The match is against a tag on the stack, and cases introduce --- variables to the middle of the context, because the fields were --- already there, but it was unknown how many there were until --- branching on the tag. -emitSumMatching :: - (Var v) => - RefNums -> - Reference -> - Word64 -> - RCtx v -> - Ctx v -> - v -> - Int -> - EnumMap Word64 ([Mem], ANormal v) -> - Emit Section -emitSumMatching rns grpr grpn rec ctx v i cs = - MatchW i edf <$> traverse (emitSumCase rns grpr grpn rec ctx v) cs - where - edf = Die "uncovered unboxed sum case" - -emitRequestMatching :: - (Var v) => - RefNums -> - Reference -> - Word64 -> - RCtx v -> - Ctx v -> - EnumMap Word64 (EnumMap CTag ([Mem], ANormal v)) -> - ANormal v -> - Emit (Section, EnumMap Word64 Branch) -emitRequestMatching rns grpr grpn rec ctx hs df = (,) <$> pur <*> tops - where - pur = emitCase rns grpr grpn rec ctx ([BX], df) - tops = traverse f (coerce hs) - f cs = TestW edf <$> traverse (emitCase rns grpr grpn rec ctx) cs - edf = Die "unhandled ability" - -emitLitMatching :: - (Var v) => - (Traversable f) => - (Int -> Section -> f Section -> Section) -> - String -> - RefNums -> - Reference -> - Word64 -> - RCtx v -> - Ctx v -> - Int -> - f (ANormal v) -> - Maybe (ANormal v) -> - Emit Section -emitLitMatching con err rns grpr grpn rec ctx i cs df = - con i <$> edf <*> traverse (emitCase rns grpr grpn rec ctx . ([],)) cs - where - edf - | Just co <- df = emitSection rns grpr grpn rec ctx co - | otherwise = countCtx ctx $ Die err - -emitCase :: - (Var v) => - RefNums -> - Reference -> - Word64 -> - RCtx v -> - Ctx v -> - ([Mem], ANormal v) -> - Emit Section -emitCase rns grpr grpn rec ctx (ccs, TAbss vs bo) = - emitSection rns grpr grpn rec (pushCtx (zip vs ccs) ctx) bo - -emitSumCase :: - (Var v) => - RefNums -> - Reference -> - Word64 -> - RCtx v -> - Ctx v -> - v -> - ([Mem], ANormal v) -> - Emit Section -emitSumCase rns grpr grpn rec ctx v (ccs, TAbss vs bo) = - emitSection rns grpr grpn rec (sumCtx ctx v $ zip vs ccs) bo - -litToMLit :: ANF.Lit -> MLit -litToMLit (ANF.I i) = MI $ fromIntegral i -litToMLit (ANF.N n) = MI $ fromIntegral n -litToMLit (ANF.C c) = MI $ fromEnum c -litToMLit (ANF.F d) = MD d -litToMLit (ANF.T t) = MT t -litToMLit (ANF.LM r) = MM r -litToMLit (ANF.LY r) = MY r - -emitLit :: ANF.Lit -> Instr -emitLit = Lit . litToMLit - -doubleToInt :: Double -> Int -doubleToInt d = indexByteArray (byteArrayFromList [d]) 0 - -emitBLit :: ANF.Lit -> Instr -emitBLit l@(ANF.F d) = BLit (ANF.litRef l) (MI $ doubleToInt d) -emitBLit l = BLit (ANF.litRef l) (litToMLit l) - --- Emits some fix-up code for calling functions. Some of the --- variables in scope come from the top-level let rec, but these --- are definitions, not values on the stack. These definitions cannot --- be passed directly as function arguments, and must have a --- corresponding stack entry allocated first. So, this function inserts --- these allocations and passes the appropriate context into the --- provided continuation. -emitClosures :: - (Var v) => - Word64 -> - RCtx v -> - Ctx v -> - [v] -> - (Ctx v -> Args -> Emit Section) -> - Emit Section -emitClosures grpn rec ctx args k = - allocate ctx args $ \ctx -> k ctx $ emitArgs grpn ctx args - where - allocate ctx [] k = k ctx - allocate ctx (a : as) k - | Just _ <- ctxResolve ctx a = allocate ctx as k - | Just n <- rctxResolve rec a = - Ins (Name (Env grpn n) ZArgs) <$> allocate (Var a BX ctx) as k - | otherwise = - internalBug $ "emitClosures: unknown reference: " ++ show a - -emitArgs :: (Var v) => Word64 -> Ctx v -> [v] -> Args -emitArgs grpn ctx args - | Just l <- traverse (ctxResolve ctx) args = demuxArgs l - | otherwise = - internalBug $ - "emitArgs[" - ++ show grpn - ++ "]: " - ++ "could not resolve argument variables: " - ++ show args - --- Turns a list of stack positions and calling conventions into the --- argument format expected in the machine code. -demuxArgs :: [(Int, Mem)] -> Args -demuxArgs as0 = - case bimap (fmap fst) (fmap fst) $ partition ((== UN) . snd) as0 of - ([], []) -> ZArgs - ([], [i]) -> BArg1 i - ([], [i, j]) -> BArg2 i j - ([i], []) -> UArg1 i - ([i, j], []) -> UArg2 i j - ([i], [j]) -> DArg2 i j - ([], bs) -> BArgN $ primArrayFromList bs - (us, []) -> UArgN $ primArrayFromList us - -- TODO: handle ranges - (us, bs) -> DArgN (primArrayFromList us) (primArrayFromList bs) - -combDeps :: Comb -> [Word64] -combDeps (Lam _ _ _ _ s) = sectionDeps s - -combTypes :: Comb -> [Word64] -combTypes (Lam _ _ _ _ s) = sectionTypes s - -sectionDeps :: Section -> [Word64] -sectionDeps (App _ (Env w _) _) = [w] -sectionDeps (Call _ w _) = [w] -sectionDeps (Match _ br) = branchDeps br -sectionDeps (DMatch _ _ br) = branchDeps br -sectionDeps (RMatch _ pu br) = - sectionDeps pu ++ foldMap branchDeps br -sectionDeps (NMatch _ _ br) = branchDeps br -sectionDeps (Ins i s) - | Name (Env w _) _ <- i = w : sectionDeps s - | otherwise = sectionDeps s -sectionDeps (Let s (CIx _ w _)) = w : sectionDeps s -sectionDeps _ = [] - -sectionTypes :: Section -> [Word64] -sectionTypes (Ins i s) = instrTypes i ++ sectionTypes s -sectionTypes (Let s _) = sectionTypes s -sectionTypes (Match _ br) = branchTypes br -sectionTypes (DMatch _ _ br) = branchTypes br -sectionTypes (NMatch _ _ br) = branchTypes br -sectionTypes (RMatch _ pu br) = - sectionTypes pu ++ foldMap branchTypes br -sectionTypes _ = [] - -instrTypes :: Instr -> [Word64] -instrTypes (Pack _ w _) = [w `shiftR` 16] -instrTypes (Reset ws) = setToList ws -instrTypes (Capture w) = [w] -instrTypes (SetDyn w _) = [w] -instrTypes _ = [] - -branchDeps :: Branch -> [Word64] -branchDeps (Test1 _ s1 d) = sectionDeps s1 ++ sectionDeps d -branchDeps (Test2 _ s1 _ s2 d) = - sectionDeps s1 ++ sectionDeps s2 ++ sectionDeps d -branchDeps (TestW d m) = - sectionDeps d ++ foldMap sectionDeps m -branchDeps (TestT d m) = - sectionDeps d ++ foldMap sectionDeps m - -branchTypes :: Branch -> [Word64] -branchTypes (Test1 _ s1 d) = sectionTypes s1 ++ sectionTypes d -branchTypes (Test2 _ s1 _ s2 d) = - sectionTypes s1 ++ sectionTypes s2 ++ sectionTypes d -branchTypes (TestW d m) = - sectionTypes d ++ foldMap sectionTypes m -branchTypes (TestT d m) = - sectionTypes d ++ foldMap sectionTypes m - -indent :: Int -> ShowS -indent ind = showString (replicate (ind * 2) ' ') - -prettyCombs :: - Word64 -> - EnumMap Word64 Comb -> - ShowS -prettyCombs w es = - foldr - (\(i, c) r -> prettyComb w i c . showString "\n" . r) - id - (mapToList es) - -prettyComb :: Word64 -> Word64 -> Comb -> ShowS -prettyComb w i (Lam ua ba _ _ s) = - shows w - . showString ":" - . shows i - . shows [ua, ba] - . showString ":\n" - . prettySection 2 s - -prettySection :: Int -> Section -> ShowS -prettySection ind sec = - indent ind . case sec of - App _ r as -> - showString "App " - . showsPrec 12 r - . showString " " - . prettyArgs as - Call _ i as -> - showString "Call " . shows i . showString " " . prettyArgs as - Jump i as -> - showString "Jump " . shows i . showString " " . prettyArgs as - Match i bs -> - showString "Match " - . shows i - . showString "\n" - . prettyBranches (ind + 1) bs - Yield as -> showString "Yield " . prettyArgs as - Ins i nx -> - prettyIns i . showString "\n" . prettySection ind nx - Let s n -> - showString "Let\n" - . prettySection (ind + 2) s - . showString "\n" - . indent ind - . prettyIx n - Die s -> showString $ "Die " ++ s - Exit -> showString "Exit" - DMatch _ i bs -> - showString "DMatch " - . shows i - . showString "\n" - . prettyBranches (ind + 1) bs - NMatch _ i bs -> - showString "NMatch " - . shows i - . showString "\n" - . prettyBranches (ind + 1) bs - RMatch i pu bs -> - showString "RMatch " - . shows i - . showString "\nPUR ->\n" - . prettySection (ind + 1) pu - . foldr (\p r -> rqc p . r) id (mapToList bs) - where - rqc (i, e) = - showString "\n" - . shows i - . showString " ->\n" - . prettyBranches (ind + 1) e - -prettyIx :: CombIx -> ShowS -prettyIx (CIx _ c s) = - showString "Resume[" - . shows c - . showString "," - . shows s - . showString "]" - -prettyBranches :: Int -> Branch -> ShowS -prettyBranches ind bs = - case bs of - Test1 i e df -> pdf df . picase i e - Test2 i ei j ej df -> pdf df . picase i ei . picase j ej - TestW df m -> - pdf df . foldr (\(i, e) r -> picase i e . r) id (mapToList m) - TestT df m -> - pdf df . foldr (\(i, e) r -> ptcase i e . r) id (M.toList m) - where - pdf e = indent ind . showString "DFLT ->\n" . prettySection (ind + 1) e - ptcase t e = - showString "\n" - . indent ind - . shows t - . showString " ->\n" - . prettySection (ind + 1) e - picase i e = - showString "\n" - . indent ind - . shows i - . showString " ->\n" - . prettySection (ind + 1) e - -un :: ShowS -un = ('U' :) - -bx :: ShowS -bx = ('B' :) - -prettyIns :: Instr -> ShowS -prettyIns (Pack r i as) = - showString "Pack " - . showsPrec 10 r - . (' ' :) - . shows i - . (' ' :) - . prettyArgs as -prettyIns i = shows i - -prettyArgs :: Args -> ShowS -prettyArgs ZArgs = shows @[Int] [] -prettyArgs (UArg1 i) = un . shows [i] -prettyArgs (BArg1 i) = bx . shows [i] -prettyArgs (UArg2 i j) = un . shows [i, j] -prettyArgs (BArg2 i j) = bx . shows [i, j] -prettyArgs (DArg2 i j) = un . shows [i] . (' ' :) . bx . shows [j] -prettyArgs (UArgR i l) = un . shows (Prelude.take l [i ..]) -prettyArgs (BArgR i l) = bx . shows (Prelude.take l [i ..]) -prettyArgs (DArgR i l j k) = - un - . shows (Prelude.take l [i ..]) - . (' ' :) - . bx - . shows (Prelude.take k [j ..]) -prettyArgs (UArgN v) = un . shows (primArrayToList v) -prettyArgs (BArgN v) = bx . shows (primArrayToList v) -prettyArgs (DArgN u b) = - un - . shows (primArrayToList u) - . (' ' :) - . bx - . shows (primArrayToList b) -prettyArgs (DArgV i j) = ('V' :) . shows [i, j] diff --git a/parser-typechecker/src/Unison/Runtime/MCode/Serialize.hs b/parser-typechecker/src/Unison/Runtime/MCode/Serialize.hs deleted file mode 100644 index 2d1cabf8d3..0000000000 --- a/parser-typechecker/src/Unison/Runtime/MCode/Serialize.hs +++ /dev/null @@ -1,443 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE PatternSynonyms #-} - -module Unison.Runtime.MCode.Serialize - ( putComb, - getComb, - ) -where - -import Data.Bytes.Get -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Bytes.VarInt -import Data.Primitive.PrimArray -import Data.Word (Word64) -import GHC.Exts (IsList (..)) -import Unison.Runtime.MCode hiding (MatchT) -import Unison.Runtime.Serialize -import Unison.Util.Text qualified as Util.Text - -putComb :: (MonadPut m) => Comb -> m () -putComb (Lam ua ba uf bf body) = - pInt ua *> pInt ba *> pInt uf *> pInt bf *> putSection body - -getComb :: (MonadGet m) => m Comb -getComb = Lam <$> gInt <*> gInt <*> gInt <*> gInt <*> getSection - -data SectionT - = AppT - | CallT - | JumpT - | MatchT - | YieldT - | InsT - | LetT - | DieT - | ExitT - | DMatchT - | NMatchT - | RMatchT - -instance Tag SectionT where - tag2word AppT = 0 - tag2word CallT = 1 - tag2word JumpT = 2 - tag2word MatchT = 3 - tag2word YieldT = 4 - tag2word InsT = 5 - tag2word LetT = 6 - tag2word DieT = 7 - tag2word ExitT = 8 - tag2word DMatchT = 9 - tag2word NMatchT = 10 - tag2word RMatchT = 11 - - word2tag 0 = pure AppT - word2tag 1 = pure CallT - word2tag 2 = pure JumpT - word2tag 3 = pure MatchT - word2tag 4 = pure YieldT - word2tag 5 = pure InsT - word2tag 6 = pure LetT - word2tag 7 = pure DieT - word2tag 8 = pure ExitT - word2tag 9 = pure DMatchT - word2tag 10 = pure NMatchT - word2tag 11 = pure RMatchT - word2tag i = unknownTag "SectionT" i - -putSection :: (MonadPut m) => Section -> m () -putSection (App b r a) = - putTag AppT *> serialize b *> putRef r *> putArgs a -putSection (Call b w a) = - putTag CallT *> serialize b *> pWord w *> putArgs a -putSection (Jump i a) = - putTag JumpT *> pInt i *> putArgs a -putSection (Match i b) = - putTag MatchT *> pInt i *> putBranch b -putSection (Yield a) = - putTag YieldT *> putArgs a -putSection (Ins i s) = - putTag InsT *> putInstr i *> putSection s -putSection (Let s ci) = - putTag LetT *> putSection s *> putCombIx ci -putSection (Die s) = - putTag DieT *> serialize s -putSection Exit = - putTag ExitT -putSection (DMatch mr i b) = - putTag DMatchT *> putMaybe mr putReference *> pInt i *> putBranch b -putSection (NMatch mr i b) = - putTag NMatchT *> putMaybe mr putReference *> pInt i *> putBranch b -putSection (RMatch i pu bs) = - putTag RMatchT - *> pInt i - *> putSection pu - *> putEnumMap pWord putBranch bs - -getSection :: (MonadGet m) => m Section -getSection = - getTag >>= \case - AppT -> App <$> deserialize <*> getRef <*> getArgs - CallT -> Call <$> deserialize <*> gWord <*> getArgs - JumpT -> Jump <$> gInt <*> getArgs - MatchT -> Match <$> gInt <*> getBranch - YieldT -> Yield <$> getArgs - InsT -> Ins <$> getInstr <*> getSection - LetT -> Let <$> getSection <*> getCombIx - DieT -> Die <$> deserialize - ExitT -> pure Exit - DMatchT -> DMatch <$> getMaybe getReference <*> gInt <*> getBranch - NMatchT -> NMatch <$> getMaybe getReference <*> gInt <*> getBranch - RMatchT -> - RMatch <$> gInt <*> getSection <*> getEnumMap gWord getBranch - -data InstrT - = UPrim1T - | UPrim2T - | BPrim1T - | BPrim2T - | ForeignCallT - | SetDynT - | CaptureT - | NameT - | InfoT - | PackT - | UnpackT - | LitT - | PrintT - | ResetT - | ForkT - | AtomicallyT - | SeqT - | TryForceT - | BLitT - -instance Tag InstrT where - tag2word UPrim1T = 0 - tag2word UPrim2T = 1 - tag2word BPrim1T = 2 - tag2word BPrim2T = 3 - tag2word ForeignCallT = 4 - tag2word SetDynT = 5 - tag2word CaptureT = 6 - tag2word NameT = 7 - tag2word InfoT = 8 - tag2word PackT = 9 - tag2word UnpackT = 10 - tag2word LitT = 11 - tag2word PrintT = 12 - tag2word ResetT = 13 - tag2word ForkT = 14 - tag2word AtomicallyT = 15 - tag2word SeqT = 16 - tag2word TryForceT = 17 - tag2word BLitT = 18 - - word2tag 0 = pure UPrim1T - word2tag 1 = pure UPrim2T - word2tag 2 = pure BPrim1T - word2tag 3 = pure BPrim2T - word2tag 4 = pure ForeignCallT - word2tag 5 = pure SetDynT - word2tag 6 = pure CaptureT - word2tag 7 = pure NameT - word2tag 8 = pure InfoT - word2tag 9 = pure PackT - word2tag 10 = pure UnpackT - word2tag 11 = pure LitT - word2tag 12 = pure PrintT - word2tag 13 = pure ResetT - word2tag 14 = pure ForkT - word2tag 15 = pure AtomicallyT - word2tag 16 = pure SeqT - word2tag 17 = pure TryForceT - word2tag 18 = pure BLitT - word2tag n = unknownTag "InstrT" n - -putInstr :: (MonadPut m) => Instr -> m () -putInstr (UPrim1 up i) = - putTag UPrim1T *> putTag up *> pInt i -putInstr (UPrim2 up i j) = - putTag UPrim2T *> putTag up *> pInt i *> pInt j -putInstr (BPrim1 bp i) = - putTag BPrim1T *> putTag bp *> pInt i -putInstr (BPrim2 bp i j) = - putTag BPrim2T *> putTag bp *> pInt i *> pInt j -putInstr (ForeignCall b w a) = - putTag ForeignCallT *> serialize b *> pWord w *> putArgs a -putInstr (SetDyn w i) = - putTag SetDynT *> pWord w *> pInt i -putInstr (Capture w) = - putTag CaptureT *> pWord w -putInstr (Name r a) = - putTag NameT *> putRef r *> putArgs a -putInstr (Info s) = - putTag InfoT *> serialize s -putInstr (Pack r w a) = - putTag PackT *> putReference r *> pWord w *> putArgs a -putInstr (Unpack mr i) = - putTag UnpackT *> putMaybe mr putReference *> pInt i -putInstr (Lit l) = - putTag LitT *> putLit l -putInstr (BLit r l) = - putTag BLitT *> putReference r *> putLit l -putInstr (Print i) = - putTag PrintT *> pInt i -putInstr (Reset s) = - putTag ResetT *> putEnumSet pWord s -putInstr (Fork i) = - putTag ForkT *> pInt i -putInstr (Atomically i) = - putTag AtomicallyT *> pInt i -putInstr (Seq a) = - putTag SeqT *> putArgs a -putInstr (TryForce i) = - putTag TryForceT *> pInt i - -getInstr :: (MonadGet m) => m Instr -getInstr = - getTag >>= \case - UPrim1T -> UPrim1 <$> getTag <*> gInt - UPrim2T -> UPrim2 <$> getTag <*> gInt <*> gInt - BPrim1T -> BPrim1 <$> getTag <*> gInt - BPrim2T -> BPrim2 <$> getTag <*> gInt <*> gInt - ForeignCallT -> ForeignCall <$> deserialize <*> gWord <*> getArgs - SetDynT -> SetDyn <$> gWord <*> gInt - CaptureT -> Capture <$> gWord - NameT -> Name <$> getRef <*> getArgs - InfoT -> Info <$> deserialize - PackT -> Pack <$> getReference <*> gWord <*> getArgs - UnpackT -> Unpack <$> getMaybe getReference <*> gInt - LitT -> Lit <$> getLit - BLitT -> BLit <$> getReference <*> getLit - PrintT -> Print <$> gInt - ResetT -> Reset <$> getEnumSet gWord - ForkT -> Fork <$> gInt - AtomicallyT -> Atomically <$> gInt - SeqT -> Seq <$> getArgs - TryForceT -> TryForce <$> gInt - -data ArgsT - = ZArgsT - | UArg1T - | UArg2T - | BArg1T - | BArg2T - | DArg2T - | UArgRT - | BArgRT - | DArgRT - | BArgNT - | UArgNT - | DArgNT - | DArgVT - -instance Tag ArgsT where - tag2word ZArgsT = 0 - tag2word UArg1T = 1 - tag2word UArg2T = 2 - tag2word BArg1T = 3 - tag2word BArg2T = 4 - tag2word DArg2T = 5 - tag2word UArgRT = 6 - tag2word BArgRT = 7 - tag2word DArgRT = 8 - tag2word BArgNT = 9 - tag2word UArgNT = 10 - tag2word DArgNT = 11 - tag2word DArgVT = 12 - - word2tag 0 = pure ZArgsT - word2tag 1 = pure UArg1T - word2tag 2 = pure UArg2T - word2tag 3 = pure BArg1T - word2tag 4 = pure BArg2T - word2tag 5 = pure DArg2T - word2tag 6 = pure UArgRT - word2tag 7 = pure BArgRT - word2tag 8 = pure DArgRT - word2tag 9 = pure BArgNT - word2tag 10 = pure UArgNT - word2tag 11 = pure DArgNT - word2tag 12 = pure DArgVT - word2tag n = unknownTag "ArgsT" n - -putArgs :: (MonadPut m) => Args -> m () -putArgs ZArgs = putTag ZArgsT -putArgs (UArg1 i) = putTag UArg1T *> pInt i -putArgs (UArg2 i j) = putTag UArg1T *> pInt i *> pInt j -putArgs (BArg1 i) = putTag BArg1T *> pInt i -putArgs (BArg2 i j) = putTag BArg2T *> pInt i *> pInt j -putArgs (DArg2 i j) = putTag DArg2T *> pInt i *> pInt j -putArgs (UArgR i j) = putTag UArgRT *> pInt i *> pInt j -putArgs (BArgR i j) = putTag BArgRT *> pInt i *> pInt j -putArgs (DArgR i j k l) = - putTag DArgRT *> pInt i *> pInt j *> pInt k *> pInt l -putArgs (BArgN pa) = putTag BArgNT *> putIntArr pa -putArgs (UArgN pa) = putTag UArgNT *> putIntArr pa -putArgs (DArgN ua ba) = - putTag DArgNT *> putIntArr ua *> putIntArr ba -putArgs (DArgV i j) = putTag DArgVT *> pInt i *> pInt j - -getArgs :: (MonadGet m) => m Args -getArgs = - getTag >>= \case - ZArgsT -> pure ZArgs - UArg1T -> UArg1 <$> gInt - UArg2T -> UArg2 <$> gInt <*> gInt - BArg1T -> BArg1 <$> gInt - BArg2T -> BArg2 <$> gInt <*> gInt - DArg2T -> DArg2 <$> gInt <*> gInt - UArgRT -> UArgR <$> gInt <*> gInt - BArgRT -> BArgR <$> gInt <*> gInt - DArgRT -> DArgR <$> gInt <*> gInt <*> gInt <*> gInt - BArgNT -> BArgN <$> getIntArr - UArgNT -> UArgN <$> getIntArr - DArgNT -> DArgN <$> getIntArr <*> getIntArr - DArgVT -> DArgV <$> gInt <*> gInt - -data RefT = StkT | EnvT | DynT - -instance Tag RefT where - tag2word StkT = 0 - tag2word EnvT = 1 - tag2word DynT = 2 - - word2tag 0 = pure StkT - word2tag 1 = pure EnvT - word2tag 2 = pure DynT - word2tag n = unknownTag "RefT" n - -putRef :: (MonadPut m) => Ref -> m () -putRef (Stk i) = putTag StkT *> pInt i -putRef (Env i j) = putTag EnvT *> pWord i *> pWord j -putRef (Dyn i) = putTag DynT *> pWord i - -getRef :: (MonadGet m) => m Ref -getRef = - getTag >>= \case - StkT -> Stk <$> gInt - EnvT -> Env <$> gWord <*> gWord - DynT -> Dyn <$> gWord - -putCombIx :: (MonadPut m) => CombIx -> m () -putCombIx (CIx r n i) = putReference r *> pWord n *> pWord i - -getCombIx :: (MonadGet m) => m CombIx -getCombIx = CIx <$> getReference <*> gWord <*> gWord - -data MLitT = MIT | MDT | MTT | MMT | MYT - -instance Tag MLitT where - tag2word MIT = 0 - tag2word MDT = 1 - tag2word MTT = 2 - tag2word MMT = 3 - tag2word MYT = 4 - - word2tag 0 = pure MIT - word2tag 1 = pure MDT - word2tag 2 = pure MTT - word2tag 3 = pure MMT - word2tag 4 = pure MYT - word2tag n = unknownTag "MLitT" n - -putLit :: (MonadPut m) => MLit -> m () -putLit (MI i) = putTag MIT *> pInt i -putLit (MD d) = putTag MDT *> putFloat d -putLit (MT t) = putTag MTT *> putText (Util.Text.toText t) -putLit (MM r) = putTag MMT *> putReferent r -putLit (MY r) = putTag MYT *> putReference r - -getLit :: (MonadGet m) => m MLit -getLit = - getTag >>= \case - MIT -> MI <$> gInt - MDT -> MD <$> getFloat - MTT -> MT . Util.Text.fromText <$> getText - MMT -> MM <$> getReferent - MYT -> MY <$> getReference - -data BranchT = Test1T | Test2T | TestWT | TestTT - -instance Tag BranchT where - tag2word Test1T = 0 - tag2word Test2T = 1 - tag2word TestWT = 2 - tag2word TestTT = 3 - - word2tag 0 = pure Test1T - word2tag 1 = pure Test2T - word2tag 2 = pure TestWT - word2tag 3 = pure TestTT - word2tag n = unknownTag "BranchT" n - -putBranch :: (MonadPut m) => Branch -> m () -putBranch (Test1 w s d) = - putTag Test1T *> pWord w *> putSection s *> putSection d -putBranch (Test2 a sa b sb d) = - putTag Test2T - *> pWord a - *> putSection sa - *> pWord b - *> putSection sb - *> putSection d -putBranch (TestW d m) = - putTag TestWT *> putSection d *> putEnumMap pWord putSection m -putBranch (TestT d m) = - putTag TestTT *> putSection d *> putMap (putText . Util.Text.toText) putSection m - -getBranch :: (MonadGet m) => m Branch -getBranch = - getTag >>= \case - Test1T -> Test1 <$> gWord <*> getSection <*> getSection - Test2T -> - Test2 - <$> gWord - <*> getSection - <*> gWord - <*> getSection - <*> getSection - TestWT -> TestW <$> getSection <*> getEnumMap gWord getSection - TestTT -> TestT <$> getSection <*> getMap (Util.Text.fromText <$> getText) getSection - -gInt :: (MonadGet m) => m Int -gInt = unVarInt <$> deserialize - -pInt :: (MonadPut m) => Int -> m () -pInt i = serialize (VarInt i) - -gWord :: (MonadGet m) => m Word64 -gWord = unVarInt <$> deserialize - -pWord :: (MonadPut m) => Word64 -> m () -pWord w = serialize (VarInt w) - -putIntArr :: (MonadPut m) => PrimArray Int -> m () -putIntArr pa = putFoldable pInt $ toList pa - -getIntArr :: (MonadGet m) => m (PrimArray Int) -getIntArr = fromList <$> getList gInt diff --git a/parser-typechecker/src/Unison/Runtime/Machine.hs b/parser-typechecker/src/Unison/Runtime/Machine.hs deleted file mode 100644 index eecc5cc09b..0000000000 --- a/parser-typechecker/src/Unison/Runtime/Machine.hs +++ /dev/null @@ -1,2502 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ViewPatterns #-} --- TODO: Fix up all the uni-patterns -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -module Unison.Runtime.Machine where - -import Control.Concurrent (ThreadId) -import Control.Concurrent.STM as STM -import Control.Exception -import Data.Bits -import Data.Map.Strict qualified as M -import Data.Ord (comparing) -import Data.Primitive.ByteArray qualified as BA -import Data.Sequence qualified as Sq -import Data.Set qualified as S -import Data.Set qualified as Set -import Data.Text qualified as DTx -import Data.Text.IO qualified as Tx -import Data.Traversable -import GHC.Conc as STM (unsafeIOToSTM) -import GHC.Stack -import Unison.Builtin.Decls (exceptionRef, ioFailureRef) -import Unison.Builtin.Decls qualified as Rf -import Unison.ConstructorReference qualified as CR -import Unison.Prelude hiding (Text) -import Unison.Reference - ( Reference, - Reference' (Builtin), - isBuiltin, - toShortHash, - ) -import Unison.Referent (Referent, pattern Con, pattern Ref) -import Unison.Runtime.ANF as ANF - ( CompileExn (..), - Mem (..), - SuperGroup, - foldGroupLinks, - maskTags, - packTags, - valueLinks, - ) -import Unison.Runtime.ANF qualified as ANF -import Unison.Runtime.Array as PA -import Unison.Runtime.Builtin -import Unison.Runtime.Exception -import Unison.Runtime.Foreign -import Unison.Runtime.Foreign.Function -import Unison.Runtime.MCode -import Unison.Runtime.Stack -import Unison.ShortHash qualified as SH -import Unison.Symbol (Symbol) -import Unison.Type qualified as Rf -import Unison.Util.Bytes qualified as By -import Unison.Util.EnumContainers as EC -import Unison.Util.Pretty (toPlainUnbroken) -import Unison.Util.Text qualified as Util.Text -import UnliftIO (IORef) -import UnliftIO qualified -import UnliftIO.Concurrent qualified as UnliftIO - --- | A ref storing every currently active thread. --- This is helpful for cleaning up orphaned threads when the main process --- completes. We track threads when running in a host process like UCM, --- otherwise we don't bother since forked threads are cleaned up automatically on --- termination. -type ActiveThreads = Maybe (IORef (Set ThreadId)) - -type Tag = Word64 - --- dynamic environment -type DEnv = EnumMap Word64 Closure - -data Tracer - = NoTrace - | MsgTrace String String String - | SimpleTrace String - --- code caching environment -data CCache = CCache - { foreignFuncs :: EnumMap Word64 ForeignFunc, - sandboxed :: Bool, - tracer :: Bool -> Closure -> Tracer, - combs :: TVar (EnumMap Word64 Combs), - combRefs :: TVar (EnumMap Word64 Reference), - tagRefs :: TVar (EnumMap Word64 Reference), - freshTm :: TVar Word64, - freshTy :: TVar Word64, - intermed :: TVar (M.Map Reference (SuperGroup Symbol)), - refTm :: TVar (M.Map Reference Word64), - refTy :: TVar (M.Map Reference Word64), - sandbox :: TVar (M.Map Reference (Set Reference)) - } - -refNumsTm :: CCache -> IO (M.Map Reference Word64) -refNumsTm cc = readTVarIO (refTm cc) - -refNumsTy :: CCache -> IO (M.Map Reference Word64) -refNumsTy cc = readTVarIO (refTy cc) - -refNumTm :: CCache -> Reference -> IO Word64 -refNumTm cc r = - refNumsTm cc >>= \case - (M.lookup r -> Just w) -> pure w - _ -> die $ "refNumTm: unknown reference: " ++ show r - -refNumTy :: CCache -> Reference -> IO Word64 -refNumTy cc r = - refNumsTy cc >>= \case - (M.lookup r -> Just w) -> pure w - _ -> die $ "refNumTy: unknown reference: " ++ show r - -refNumTy' :: CCache -> Reference -> IO (Maybe Word64) -refNumTy' cc r = M.lookup r <$> refNumsTy cc - -baseCCache :: Bool -> IO CCache -baseCCache sandboxed = do - CCache ffuncs sandboxed noTrace - <$> newTVarIO combs - <*> newTVarIO builtinTermBackref - <*> newTVarIO builtinTypeBackref - <*> newTVarIO ftm - <*> newTVarIO fty - <*> newTVarIO mempty - <*> newTVarIO builtinTermNumbering - <*> newTVarIO builtinTypeNumbering - <*> newTVarIO baseSandboxInfo - where - ffuncs | sandboxed = sandboxedForeigns | otherwise = builtinForeigns - noTrace _ _ = NoTrace - ftm = 1 + maximum builtinTermNumbering - fty = 1 + maximum builtinTypeNumbering - - rns = emptyRNs {dnum = refLookup "ty" builtinTypeNumbering} - - combs = - mapWithKey - (\k v -> let r = builtinTermBackref ! k in emitComb @Symbol rns r k mempty (0, v)) - numberedTermLookup - -info :: (Show a) => String -> a -> IO () -info ctx x = infos ctx (show x) - -infos :: String -> String -> IO () -infos ctx s = putStrLn $ ctx ++ ": " ++ s - -stk'info :: Stack 'BX -> IO () -stk'info s@(BS _ _ sp _) = do - let prn i - | i < 0 = return () - | otherwise = peekOff s i >>= print >> prn (i - 1) - prn sp - --- Entry point for evaluating a section -eval0 :: CCache -> ActiveThreads -> Section -> IO () -eval0 !env !activeThreads !co = do - ustk <- alloc - bstk <- alloc - (denv, k) <- - topDEnv <$> readTVarIO (refTy env) <*> readTVarIO (refTm env) - eval env denv activeThreads ustk bstk (k KE) dummyRef co - -topDEnv :: - M.Map Reference Word64 -> - M.Map Reference Word64 -> - (DEnv, K -> K) -topDEnv rfTy rfTm - | Just n <- M.lookup exceptionRef rfTy, - rcrf <- Builtin (DTx.pack "raise"), - Just j <- M.lookup rcrf rfTm = - ( EC.mapSingleton n (PAp (CIx rcrf j 0) unull bnull), - Mark 0 0 (EC.setSingleton n) mempty - ) -topDEnv _ _ = (mempty, id) - --- Entry point for evaluating a numbered combinator. --- An optional callback for the base of the stack may be supplied. --- --- This is the entry point actually used in the interactive --- environment currently. -apply0 :: - Maybe (Stack 'UN -> Stack 'BX -> IO ()) -> - CCache -> - ActiveThreads -> - Word64 -> - IO () -apply0 !callback !env !threadTracker !i = do - ustk <- alloc - bstk <- alloc - cmbrs <- readTVarIO $ combRefs env - (denv, kf) <- - topDEnv <$> readTVarIO (refTy env) <*> readTVarIO (refTm env) - r <- case EC.lookup i cmbrs of - Just r -> pure r - Nothing -> die "apply0: missing reference to entry point" - apply env denv threadTracker ustk bstk (kf k0) True ZArgs $ - PAp (CIx r i 0) unull bnull - where - k0 = maybe KE (CB . Hook) callback - --- Apply helper currently used for forking. Creates the new stacks --- necessary to evaluate a closure with the provided information. -apply1 :: - (Stack 'UN -> Stack 'BX -> IO ()) -> - CCache -> - ActiveThreads -> - Closure -> - IO () -apply1 callback env threadTracker clo = do - ustk <- alloc - bstk <- alloc - apply env mempty threadTracker ustk bstk k0 True ZArgs clo - where - k0 = CB $ Hook callback - --- Entry point for evaluating a saved continuation. --- --- The continuation must be from an evaluation context expecting a --- unit value. -jump0 :: - (Stack 'UN -> Stack 'BX -> IO ()) -> - CCache -> - ActiveThreads -> - Closure -> - IO () -jump0 !callback !env !activeThreads !clo = do - ustk <- alloc - bstk <- alloc - (denv, kf) <- - topDEnv <$> readTVarIO (refTy env) <*> readTVarIO (refTm env) - bstk <- bump bstk - poke bstk (Enum Rf.unitRef unitTag) - jump env denv activeThreads ustk bstk (kf k0) (BArg1 0) clo - where - k0 = CB (Hook callback) - -unitValue :: Closure -unitValue = Enum Rf.unitRef unitTag - -lookupDenv :: Word64 -> DEnv -> Closure -lookupDenv p denv = fromMaybe BlackHole $ EC.lookup p denv - -buildLit :: Reference -> MLit -> Closure -buildLit rf (MI i) - | Just n <- M.lookup rf builtinTypeNumbering, - rt <- toEnum (fromIntegral n) = - DataU1 rf (packTags rt 0) i - | otherwise = error "buildLit: unknown reference" -buildLit _ (MT t) = Foreign (Wrap Rf.textRef t) -buildLit _ (MM r) = Foreign (Wrap Rf.termLinkRef r) -buildLit _ (MY r) = Foreign (Wrap Rf.typeLinkRef r) -buildLit _ (MD _) = error "buildLit: double" - -exec :: - CCache -> - DEnv -> - ActiveThreads -> - Stack 'UN -> - Stack 'BX -> - K -> - Reference -> - Instr -> - IO (DEnv, Stack 'UN, Stack 'BX, K) -exec !_ !denv !_activeThreads !ustk !bstk !k _ (Info tx) = do - info tx ustk - info tx bstk - info tx k - pure (denv, ustk, bstk, k) -exec !env !denv !_activeThreads !ustk !bstk !k _ (Name r args) = do - bstk <- name ustk bstk args =<< resolve env denv bstk r - pure (denv, ustk, bstk, k) -exec !_ !denv !_activeThreads !ustk !bstk !k _ (SetDyn p i) = do - clo <- peekOff bstk i - pure (EC.mapInsert p clo denv, ustk, bstk, k) -exec !_ !denv !_activeThreads !ustk !bstk !k _ (Capture p) = do - (cap, denv, ustk, bstk, k) <- splitCont denv ustk bstk k p - bstk <- bump bstk - poke bstk cap - pure (denv, ustk, bstk, k) -exec !_ !denv !_activeThreads !ustk !bstk !k _ (UPrim1 op i) = do - ustk <- uprim1 ustk op i - pure (denv, ustk, bstk, k) -exec !_ !denv !_activeThreads !ustk !bstk !k _ (UPrim2 op i j) = do - ustk <- uprim2 ustk op i j - pure (denv, ustk, bstk, k) -exec !env !denv !_activeThreads !ustk !bstk !k _ (BPrim1 MISS i) - | sandboxed env = die "attempted to use sandboxed operation: isMissing" - | otherwise = do - clink <- peekOff bstk i - let Ref link = unwrapForeign $ marshalToForeign clink - m <- readTVarIO (intermed env) - ustk <- bump ustk - if (link `M.member` m) then poke ustk 1 else poke ustk 0 - pure (denv, ustk, bstk, k) -exec !env !denv !_activeThreads !ustk !bstk !k _ (BPrim1 CACH i) - | sandboxed env = die "attempted to use sandboxed operation: cache" - | otherwise = do - arg <- peekOffS bstk i - news <- decodeCacheArgument arg - unknown <- cacheAdd news env - bstk <- bump bstk - pokeS - bstk - (Sq.fromList $ Foreign . Wrap Rf.termLinkRef . Ref <$> unknown) - pure (denv, ustk, bstk, k) -exec !env !denv !_activeThreads !ustk !bstk !k _ (BPrim1 CVLD i) - | sandboxed env = die "attempted to use sandboxed operation: validate" - | otherwise = do - arg <- peekOffS bstk i - news <- decodeCacheArgument arg - codeValidate news env >>= \case - Nothing -> do - ustk <- bump ustk - poke ustk 0 - pure (denv, ustk, bstk, k) - Just (Failure ref msg clo) -> do - ustk <- bump ustk - bstk <- bumpn bstk 3 - poke ustk 1 - poke bstk (Foreign $ Wrap Rf.typeLinkRef ref) - pokeOffBi bstk 1 msg - pokeOff bstk 2 clo - pure (denv, ustk, bstk, k) -exec !env !denv !_activeThreads !ustk !bstk !k _ (BPrim1 LKUP i) - | sandboxed env = die "attempted to use sandboxed operation: lookup" - | otherwise = do - clink <- peekOff bstk i - let Ref link = unwrapForeign $ marshalToForeign clink - m <- readTVarIO (intermed env) - ustk <- bump ustk - bstk <- case M.lookup link m of - Nothing - | Just w <- M.lookup link builtinTermNumbering, - Just sn <- EC.lookup w numberedTermLookup -> do - poke ustk 1 - bstk <- bump bstk - bstk <$ pokeBi bstk (ANF.Rec [] sn) - | otherwise -> bstk <$ poke ustk 0 - Just sg -> do - poke ustk 1 - bstk <- bump bstk - bstk <$ pokeBi bstk sg - pure (denv, ustk, bstk, k) -exec !_ !denv !_activeThreads !ustk !bstk !k _ (BPrim1 TLTT i) = do - clink <- peekOff bstk i - let shortHash = case unwrapForeign $ marshalToForeign clink of - Ref r -> toShortHash r - Con r _ -> CR.toShortHash r - let sh = Util.Text.fromText . SH.toText $ shortHash - bstk <- bump bstk - pokeBi bstk sh - pure (denv, ustk, bstk, k) -exec !env !denv !_activeThreads !ustk !bstk !k _ (BPrim1 LOAD i) - | sandboxed env = die "attempted to use sandboxed operation: load" - | otherwise = do - v <- peekOffBi bstk i - ustk <- bump ustk - bstk <- bump bstk - reifyValue env v >>= \case - Left miss -> do - poke ustk 0 - pokeS bstk $ - Sq.fromList $ - Foreign . Wrap Rf.termLinkRef . Ref <$> miss - Right x -> do - poke ustk 1 - poke bstk x - pure (denv, ustk, bstk, k) -exec !env !denv !_activeThreads !ustk !bstk !k _ (BPrim1 VALU i) = do - m <- readTVarIO (tagRefs env) - c <- peekOff bstk i - bstk <- bump bstk - pokeBi bstk =<< reflectValue m c - pure (denv, ustk, bstk, k) -exec !env !denv !_activeThreads !ustk !bstk !k _ (BPrim1 DBTX i) - | sandboxed env = - die "attempted to use sandboxed operation: Debug.toText" - | otherwise = do - clo <- peekOff bstk i - ustk <- bump ustk - bstk <- case tracer env False clo of - NoTrace -> bstk <$ poke ustk 0 - MsgTrace _ _ tx -> do - poke ustk 1 - bstk <- bump bstk - bstk <$ pokeBi bstk (Util.Text.pack tx) - SimpleTrace tx -> do - poke ustk 2 - bstk <- bump bstk - bstk <$ pokeBi bstk (Util.Text.pack tx) - pure (denv, ustk, bstk, k) -exec !env !denv !_activeThreads !ustk !bstk !k _ (BPrim1 SDBL i) - | sandboxed env = - die "attempted to use sandboxed operation: sandboxLinks" - | otherwise = do - tl <- peekOffBi bstk i - bstk <- bump bstk - pokeS bstk . encodeSandboxListResult =<< sandboxList env tl - pure (denv, ustk, bstk, k) -exec !_ !denv !_activeThreads !ustk !bstk !k _ (BPrim1 op i) = do - (ustk, bstk) <- bprim1 ustk bstk op i - pure (denv, ustk, bstk, k) -exec !env !denv !_activeThreads !ustk !bstk !k _ (BPrim2 SDBX i j) = do - s <- peekOffS bstk i - c <- peekOff bstk j - l <- decodeSandboxArgument s - b <- checkSandboxing env l c - ustk <- bump ustk - poke ustk $ if b then 1 else 0 - pure (denv, ustk, bstk, k) -exec !env !denv !_activeThreads !ustk !bstk !k _ (BPrim2 SDBV i j) - | sandboxed env = - die "attempted to use sandboxed operation: Value.validateSandboxed" - | otherwise = do - s <- peekOffS bstk i - v <- peekOffBi bstk j - l <- decodeSandboxArgument s - res <- checkValueSandboxing env l v - bstk <- bump bstk - poke bstk $ encodeSandboxResult res - pure (denv, ustk, bstk, k) -exec !_ !denv !_activeThreads !ustk !bstk !k _ (BPrim2 EQLU i j) = do - x <- peekOff bstk i - y <- peekOff bstk j - ustk <- bump ustk - poke ustk $ if universalEq (==) x y then 1 else 0 - pure (denv, ustk, bstk, k) -exec !_ !denv !_activeThreads !ustk !bstk !k _ (BPrim2 CMPU i j) = do - x <- peekOff bstk i - y <- peekOff bstk j - ustk <- bump ustk - poke ustk . fromEnum $ universalCompare compare x y - pure (denv, ustk, bstk, k) -exec !_ !_ !_activeThreads !_ !bstk !k r (BPrim2 THRO i j) = do - name <- peekOffBi @Util.Text.Text bstk i - x <- peekOff bstk j - throwIO (BU (traceK r k) (Util.Text.toText name) x) -exec !env !denv !_activeThreads !ustk !bstk !k _ (BPrim2 TRCE i j) - | sandboxed env = die "attempted to use sandboxed operation: trace" - | otherwise = do - tx <- peekOffBi bstk i - clo <- peekOff bstk j - case tracer env True clo of - NoTrace -> pure () - SimpleTrace str -> do - putStrLn $ "trace: " ++ Util.Text.unpack tx - putStrLn str - MsgTrace msg ugl pre -> do - putStrLn $ "trace: " ++ Util.Text.unpack tx - putStrLn "" - putStrLn msg - putStrLn "\nraw structure:\n" - putStrLn ugl - putStrLn "partial decompilation:\n" - putStrLn pre - pure (denv, ustk, bstk, k) -exec !_ !denv !_trackThreads !ustk !bstk !k _ (BPrim2 op i j) = do - (ustk, bstk) <- bprim2 ustk bstk op i j - pure (denv, ustk, bstk, k) -exec !_ !denv !_activeThreads !ustk !bstk !k _ (Pack r t args) = do - clo <- buildData ustk bstk r t args - bstk <- bump bstk - poke bstk clo - pure (denv, ustk, bstk, k) -exec !_ !denv !_activeThreads !ustk !bstk !k _ (Unpack r i) = do - (ustk, bstk) <- dumpData r ustk bstk =<< peekOff bstk i - pure (denv, ustk, bstk, k) -exec !_ !denv !_activeThreads !ustk !bstk !k _ (Print i) = do - t <- peekOffBi bstk i - Tx.putStrLn (Util.Text.toText t) - pure (denv, ustk, bstk, k) -exec !_ !denv !_activeThreads !ustk !bstk !k _ (Lit (MI n)) = do - ustk <- bump ustk - poke ustk n - pure (denv, ustk, bstk, k) -exec !_ !denv !_activeThreads !ustk !bstk !k _ (Lit (MD d)) = do - ustk <- bump ustk - pokeD ustk d - pure (denv, ustk, bstk, k) -exec !_ !denv !_activeThreads !ustk !bstk !k _ (Lit (MT t)) = do - bstk <- bump bstk - poke bstk (Foreign (Wrap Rf.textRef t)) - pure (denv, ustk, bstk, k) -exec !_ !denv !_activeThreads !ustk !bstk !k _ (Lit (MM r)) = do - bstk <- bump bstk - poke bstk (Foreign (Wrap Rf.termLinkRef r)) - pure (denv, ustk, bstk, k) -exec !_ !denv !_activeThreads !ustk !bstk !k _ (Lit (MY r)) = do - bstk <- bump bstk - poke bstk (Foreign (Wrap Rf.typeLinkRef r)) - pure (denv, ustk, bstk, k) -exec !_ !denv !_activeThreads !ustk !bstk !k _ (BLit rf l) = do - bstk <- bump bstk - poke bstk $ buildLit rf l - pure (denv, ustk, bstk, k) -exec !_ !denv !_activeThreads !ustk !bstk !k _ (Reset ps) = do - (ustk, ua) <- saveArgs ustk - (bstk, ba) <- saveArgs bstk - pure (denv, ustk, bstk, Mark ua ba ps clos k) - where - clos = EC.restrictKeys denv ps -exec !_ !denv !_activeThreads !ustk !bstk !k _ (Seq as) = do - l <- closureArgs bstk as - bstk <- bump bstk - pokeS bstk $ Sq.fromList l - pure (denv, ustk, bstk, k) -exec !env !denv !_activeThreads !ustk !bstk !k _ (ForeignCall _ w args) - | Just (FF arg res ev) <- EC.lookup w (foreignFuncs env) = - uncurry (denv,,,k) - <$> (arg ustk bstk args >>= ev >>= res ustk bstk) - | otherwise = - die $ "reference to unknown foreign function: " ++ show w -exec !env !denv !activeThreads !ustk !bstk !k _ (Fork i) - | sandboxed env = die "attempted to use sandboxed operation: fork" - | otherwise = do - tid <- forkEval env activeThreads =<< peekOff bstk i - bstk <- bump bstk - poke bstk . Foreign . Wrap Rf.threadIdRef $ tid - pure (denv, ustk, bstk, k) -exec !env !denv !activeThreads !ustk !bstk !k _ (Atomically i) - | sandboxed env = die $ "attempted to use sandboxed operation: atomically" - | otherwise = do - c <- peekOff bstk i - bstk <- bump bstk - atomicEval env activeThreads (poke bstk) c - pure (denv, ustk, bstk, k) -exec !env !denv !activeThreads !ustk !bstk !k _ (TryForce i) - | sandboxed env = die $ "attempted to use sandboxed operation: tryForce" - | otherwise = do - c <- peekOff bstk i - ustk <- bump ustk - bstk <- bump bstk - ev <- Control.Exception.try $ nestEval env activeThreads (poke bstk) c - bstk <- encodeExn ustk bstk ev - pure (denv, ustk, bstk, k) -{-# INLINE exec #-} - -encodeExn :: - Stack 'UN -> - Stack 'BX -> - Either SomeException () -> - IO (Stack 'BX) -encodeExn ustk bstk (Right _) = bstk <$ poke ustk 1 -encodeExn ustk bstk (Left exn) = do - bstk <- bumpn bstk 2 - poke ustk 0 - poke bstk $ Foreign (Wrap Rf.typeLinkRef link) - pokeOffBi bstk 1 msg - bstk <$ pokeOff bstk 2 extra - where - disp e = Util.Text.pack $ show e - (link, msg, extra) - | Just (ioe :: IOException) <- fromException exn = - (Rf.ioFailureRef, disp ioe, unitValue) - | Just re <- fromException exn = case re of - PE _stk msg -> - (Rf.runtimeFailureRef, Util.Text.pack $ toPlainUnbroken msg, unitValue) - BU _ tx cl -> (Rf.runtimeFailureRef, Util.Text.fromText tx, cl) - | Just (ae :: ArithException) <- fromException exn = - (Rf.arithmeticFailureRef, disp ae, unitValue) - | Just (nae :: NestedAtomically) <- fromException exn = - (Rf.stmFailureRef, disp nae, unitValue) - | Just (be :: BlockedIndefinitelyOnSTM) <- fromException exn = - (Rf.stmFailureRef, disp be, unitValue) - | Just (be :: BlockedIndefinitelyOnMVar) <- fromException exn = - (Rf.ioFailureRef, disp be, unitValue) - | Just (ie :: AsyncException) <- fromException exn = - (Rf.threadKilledFailureRef, disp ie, unitValue) - | otherwise = (Rf.miscFailureRef, disp exn, unitValue) - -numValue :: Maybe Reference -> Closure -> IO Word64 -numValue _ (DataU1 _ _ i) = pure (fromIntegral i) -numValue mr clo = - die $ - "numValue: bad closure: " - ++ show clo - ++ maybe "" (\r -> "\nexpected type: " ++ show r) mr - -eval :: - CCache -> - DEnv -> - ActiveThreads -> - Stack 'UN -> - Stack 'BX -> - K -> - Reference -> - Section -> - IO () -eval !env !denv !activeThreads !ustk !bstk !k r (Match i (TestT df cs)) = do - t <- peekOffBi bstk i - eval env denv activeThreads ustk bstk k r $ selectTextBranch t df cs -eval !env !denv !activeThreads !ustk !bstk !k r (Match i br) = do - n <- peekOffN ustk i - eval env denv activeThreads ustk bstk k r $ selectBranch n br -eval !env !denv !activeThreads !ustk !bstk !k r (DMatch mr i br) = do - (t, ustk, bstk) <- dumpDataNoTag mr ustk bstk =<< peekOff bstk i - eval env denv activeThreads ustk bstk k r $ - selectBranch (maskTags t) br -eval !env !denv !activeThreads !ustk !bstk !k r (NMatch mr i br) = do - n <- numValue mr =<< peekOff bstk i - eval env denv activeThreads ustk bstk k r $ selectBranch n br -eval !env !denv !activeThreads !ustk !bstk !k r (RMatch i pu br) = do - (t, ustk, bstk) <- dumpDataNoTag Nothing ustk bstk =<< peekOff bstk i - if t == 0 - then eval env denv activeThreads ustk bstk k r pu - else case ANF.unpackTags t of - (ANF.rawTag -> e, ANF.rawTag -> t) - | Just ebs <- EC.lookup e br -> - eval env denv activeThreads ustk bstk k r $ selectBranch t ebs - | otherwise -> unhandledErr "eval" env e -eval !env !denv !activeThreads !ustk !bstk !k _ (Yield args) - | asize ustk + asize bstk > 0, - BArg1 i <- args = - peekOff bstk i >>= apply env denv activeThreads ustk bstk k False ZArgs - | otherwise = do - (ustk, bstk) <- moveArgs ustk bstk args - ustk <- frameArgs ustk - bstk <- frameArgs bstk - yield env denv activeThreads ustk bstk k -eval !env !denv !activeThreads !ustk !bstk !k _ (App ck r args) = - resolve env denv bstk r - >>= apply env denv activeThreads ustk bstk k ck args -eval !env !denv !activeThreads !ustk !bstk !k _ (Call ck n args) = - combSection env (CIx dummyRef n 0) - >>= enter env denv activeThreads ustk bstk k ck args -eval !env !denv !activeThreads !ustk !bstk !k _ (Jump i args) = - peekOff bstk i >>= jump env denv activeThreads ustk bstk k args -eval !env !denv !activeThreads !ustk !bstk !k r (Let nw cix) = do - (ustk, ufsz, uasz) <- saveFrame ustk - (bstk, bfsz, basz) <- saveFrame bstk - eval env denv activeThreads ustk bstk (Push ufsz bfsz uasz basz cix k) r nw -eval !env !denv !activeThreads !ustk !bstk !k r (Ins i nx) = do - (denv, ustk, bstk, k) <- exec env denv activeThreads ustk bstk k r i - eval env denv activeThreads ustk bstk k r nx -eval !_ !_ !_ !_activeThreads !_ !_ _ Exit = pure () -eval !_ !_ !_ !_activeThreads !_ !_ _ (Die s) = die s -{-# NOINLINE eval #-} - -forkEval :: CCache -> ActiveThreads -> Closure -> IO ThreadId -forkEval env activeThreads clo = - do - threadId <- - UnliftIO.forkFinally - (apply1 err env activeThreads clo) - (const cleanupThread) - trackThread threadId - pure threadId - where - err :: Stack 'UN -> Stack 'BX -> IO () - err _ _ = pure () - trackThread :: ThreadId -> IO () - trackThread threadID = do - case activeThreads of - Nothing -> pure () - Just activeThreads -> UnliftIO.atomicModifyIORef' activeThreads (\ids -> (Set.insert threadID ids, ())) - cleanupThread :: IO () - cleanupThread = do - case activeThreads of - Nothing -> pure () - Just activeThreads -> do - myThreadId <- UnliftIO.myThreadId - UnliftIO.atomicModifyIORef' activeThreads (\ids -> (Set.delete myThreadId ids, ())) -{-# INLINE forkEval #-} - -nestEval :: CCache -> ActiveThreads -> (Closure -> IO ()) -> Closure -> IO () -nestEval env activeThreads write clo = apply1 readBack env activeThreads clo - where - readBack _ bstk = peek bstk >>= write -{-# INLINE nestEval #-} - -atomicEval :: CCache -> ActiveThreads -> (Closure -> IO ()) -> Closure -> IO () -atomicEval env activeThreads write clo = - atomically . unsafeIOToSTM $ nestEval env activeThreads write clo -{-# INLINE atomicEval #-} - --- fast path application -enter :: - CCache -> - DEnv -> - ActiveThreads -> - Stack 'UN -> - Stack 'BX -> - K -> - Bool -> - Args -> - Comb -> - IO () -enter !env !denv !activeThreads !ustk !bstk !k !ck !args !comb = do - ustk <- if ck then ensure ustk uf else pure ustk - bstk <- if ck then ensure bstk bf else pure bstk - (ustk, bstk) <- moveArgs ustk bstk args - ustk <- acceptArgs ustk ua - bstk <- acceptArgs bstk ba - -- TODO: start putting references in `Call` if we ever start - -- detecting saturated calls. - eval env denv activeThreads ustk bstk k dummyRef entry - where - Lam ua ba uf bf entry = comb -{-# INLINE enter #-} - --- fast path by-name delaying -name :: Stack 'UN -> Stack 'BX -> Args -> Closure -> IO (Stack 'BX) -name !ustk !bstk !args clo = case clo of - PAp comb useg bseg -> do - (useg, bseg) <- closeArgs I ustk bstk useg bseg args - bstk <- bump bstk - poke bstk $ PAp comb useg bseg - pure bstk - _ -> die $ "naming non-function: " ++ show clo -{-# INLINE name #-} - --- slow path application -apply :: - CCache -> - DEnv -> - ActiveThreads -> - Stack 'UN -> - Stack 'BX -> - K -> - Bool -> - Args -> - Closure -> - IO () -apply !env !denv !activeThreads !ustk !bstk !k !ck !args (PAp comb useg bseg) = - combSection env comb >>= \case - Lam ua ba uf bf entry - | ck || ua <= uac && ba <= bac -> do - ustk <- ensure ustk uf - bstk <- ensure bstk bf - (ustk, bstk) <- moveArgs ustk bstk args - ustk <- dumpSeg ustk useg A - bstk <- dumpSeg bstk bseg A - ustk <- acceptArgs ustk ua - bstk <- acceptArgs bstk ba - eval env denv activeThreads ustk bstk k (combRef comb) entry - | otherwise -> do - (useg, bseg) <- closeArgs C ustk bstk useg bseg args - ustk <- discardFrame =<< frameArgs ustk - bstk <- discardFrame =<< frameArgs bstk - bstk <- bump bstk - poke bstk $ PAp comb useg bseg - yield env denv activeThreads ustk bstk k - where - uac = asize ustk + ucount args + uscount useg - bac = asize bstk + bcount args + bscount bseg -apply !env !denv !activeThreads !ustk !bstk !k !_ !args clo - | ZArgs <- args, - asize ustk == 0, - asize bstk == 0 = do - ustk <- discardFrame ustk - bstk <- discardFrame bstk - bstk <- bump bstk - poke bstk clo - yield env denv activeThreads ustk bstk k - | otherwise = die $ "applying non-function: " ++ show clo -{-# INLINE apply #-} - -jump :: - CCache -> - DEnv -> - ActiveThreads -> - Stack 'UN -> - Stack 'BX -> - K -> - Args -> - Closure -> - IO () -jump !env !denv !activeThreads !ustk !bstk !k !args clo = case clo of - Captured sk0 ua ba useg bseg -> do - let (up, bp, sk) = adjust sk0 - (useg, bseg) <- closeArgs K ustk bstk useg bseg args - ustk <- discardFrame ustk - bstk <- discardFrame bstk - ustk <- dumpSeg ustk useg $ F (ucount args) ua - bstk <- dumpSeg bstk bseg $ F (bcount args) ba - ustk <- adjustArgs ustk up - bstk <- adjustArgs bstk bp - repush env activeThreads ustk bstk denv sk k - _ -> die "jump: non-cont" - where - -- Adjusts a repushed continuation to account for pending arguments. If - -- there are any frames in the pushed continuation, the nearest one needs to - -- record the additional pending arguments. - -- - -- If the repushed continuation has no frames, then the arguments are still - -- pending, and the result stacks need to be adjusted. Hence the 3 results. - adjust (Mark ua ba rs denv k) = - (0, 0, Mark (ua + asize ustk) (ba + asize bstk) rs denv k) - adjust (Push un bn ua ba cix k) = - (0, 0, Push un bn (ua + asize ustk) (ba + asize bstk) cix k) - adjust k = (asize ustk, asize bstk, k) -{-# INLINE jump #-} - -repush :: - CCache -> - ActiveThreads -> - Stack 'UN -> - Stack 'BX -> - DEnv -> - K -> - K -> - IO () -repush !env !activeThreads !ustk !bstk = go - where - go !denv KE !k = yield env denv activeThreads ustk bstk k - go !denv (Mark ua ba ps cs sk) !k = go denv' sk $ Mark ua ba ps cs' k - where - denv' = cs <> EC.withoutKeys denv ps - cs' = EC.restrictKeys denv ps - go !denv (Push un bn ua ba nx sk) !k = - go denv sk $ Push un bn ua ba nx k - go !_ (CB _) !_ = die "repush: impossible" -{-# INLINE repush #-} - -moveArgs :: - Stack 'UN -> - Stack 'BX -> - Args -> - IO (Stack 'UN, Stack 'BX) -moveArgs !ustk !bstk ZArgs = do - ustk <- discardFrame ustk - bstk <- discardFrame bstk - pure (ustk, bstk) -moveArgs !ustk !bstk (DArgV i j) = do - ustk <- - if ul > 0 - then prepareArgs ustk (ArgR 0 ul) - else discardFrame ustk - bstk <- - if bl > 0 - then prepareArgs bstk (ArgR 0 bl) - else discardFrame bstk - pure (ustk, bstk) - where - ul = fsize ustk - i - bl = fsize bstk - j -moveArgs !ustk !bstk (UArg1 i) = do - ustk <- prepareArgs ustk (Arg1 i) - bstk <- discardFrame bstk - pure (ustk, bstk) -moveArgs !ustk !bstk (UArg2 i j) = do - ustk <- prepareArgs ustk (Arg2 i j) - bstk <- discardFrame bstk - pure (ustk, bstk) -moveArgs !ustk !bstk (UArgR i l) = do - ustk <- prepareArgs ustk (ArgR i l) - bstk <- discardFrame bstk - pure (ustk, bstk) -moveArgs !ustk !bstk (BArg1 i) = do - ustk <- discardFrame ustk - bstk <- prepareArgs bstk (Arg1 i) - pure (ustk, bstk) -moveArgs !ustk !bstk (BArg2 i j) = do - ustk <- discardFrame ustk - bstk <- prepareArgs bstk (Arg2 i j) - pure (ustk, bstk) -moveArgs !ustk !bstk (BArgR i l) = do - ustk <- discardFrame ustk - bstk <- prepareArgs bstk (ArgR i l) - pure (ustk, bstk) -moveArgs !ustk !bstk (DArg2 i j) = do - ustk <- prepareArgs ustk (Arg1 i) - bstk <- prepareArgs bstk (Arg1 j) - pure (ustk, bstk) -moveArgs !ustk !bstk (DArgR ui ul bi bl) = do - ustk <- prepareArgs ustk (ArgR ui ul) - bstk <- prepareArgs bstk (ArgR bi bl) - pure (ustk, bstk) -moveArgs !ustk !bstk (UArgN as) = do - ustk <- prepareArgs ustk (ArgN as) - bstk <- discardFrame bstk - pure (ustk, bstk) -moveArgs !ustk !bstk (BArgN as) = do - ustk <- discardFrame ustk - bstk <- prepareArgs bstk (ArgN as) - pure (ustk, bstk) -moveArgs !ustk !bstk (DArgN us bs) = do - ustk <- prepareArgs ustk (ArgN us) - bstk <- prepareArgs bstk (ArgN bs) - pure (ustk, bstk) -{-# INLINE moveArgs #-} - -closureArgs :: Stack 'BX -> Args -> IO [Closure] -closureArgs !_ ZArgs = pure [] -closureArgs !bstk (BArg1 i) = do - x <- peekOff bstk i - pure [x] -closureArgs !bstk (BArg2 i j) = do - x <- peekOff bstk i - y <- peekOff bstk j - pure [x, y] -closureArgs !bstk (BArgR i l) = - for (take l [i ..]) (peekOff bstk) -closureArgs !bstk (BArgN bs) = - for (PA.primArrayToList bs) (peekOff bstk) -closureArgs !_ _ = - error "closure arguments can only be boxed." -{-# INLINE closureArgs #-} - -buildData :: - Stack 'UN -> Stack 'BX -> Reference -> Tag -> Args -> IO Closure -buildData !_ !_ !r !t ZArgs = pure $ Enum r t -buildData !ustk !_ !r !t (UArg1 i) = do - x <- peekOff ustk i - pure $ DataU1 r t x -buildData !ustk !_ !r !t (UArg2 i j) = do - x <- peekOff ustk i - y <- peekOff ustk j - pure $ DataU2 r t x y -buildData !_ !bstk !r !t (BArg1 i) = do - x <- peekOff bstk i - pure $ DataB1 r t x -buildData !_ !bstk !r !t (BArg2 i j) = do - x <- peekOff bstk i - y <- peekOff bstk j - pure $ DataB2 r t x y -buildData !ustk !bstk !r !t (DArg2 i j) = do - x <- peekOff ustk i - y <- peekOff bstk j - pure $ DataUB r t x y -buildData !ustk !_ !r !t (UArgR i l) = do - useg <- augSeg I ustk unull (Just $ ArgR i l) - pure $ DataG r t useg bnull -buildData !_ !bstk !r !t (BArgR i l) = do - bseg <- augSeg I bstk bnull (Just $ ArgR i l) - pure $ DataG r t unull bseg -buildData !ustk !bstk !r !t (DArgR ui ul bi bl) = do - useg <- augSeg I ustk unull (Just $ ArgR ui ul) - bseg <- augSeg I bstk bnull (Just $ ArgR bi bl) - pure $ DataG r t useg bseg -buildData !ustk !_ !r !t (UArgN as) = do - useg <- augSeg I ustk unull (Just $ ArgN as) - pure $ DataG r t useg bnull -buildData !_ !bstk !r !t (BArgN as) = do - bseg <- augSeg I bstk bnull (Just $ ArgN as) - pure $ DataG r t unull bseg -buildData !ustk !bstk !r !t (DArgN us bs) = do - useg <- augSeg I ustk unull (Just $ ArgN us) - bseg <- augSeg I bstk bnull (Just $ ArgN bs) - pure $ DataG r t useg bseg -buildData !ustk !bstk !r !t (DArgV ui bi) = do - useg <- - if ul > 0 - then augSeg I ustk unull (Just $ ArgR 0 ul) - else pure unull - bseg <- - if bl > 0 - then augSeg I bstk bnull (Just $ ArgR 0 bl) - else pure bnull - pure $ DataG r t useg bseg - where - ul = fsize ustk - ui - bl = fsize bstk - bi -{-# INLINE buildData #-} - --- Dumps a data type closure to the stack without writing its tag. --- Instead, the tag is returned for direct case analysis. -dumpDataNoTag :: - Maybe Reference -> - Stack 'UN -> - Stack 'BX -> - Closure -> - IO (Word64, Stack 'UN, Stack 'BX) -dumpDataNoTag !_ !ustk !bstk (Enum _ t) = pure (t, ustk, bstk) -dumpDataNoTag !_ !ustk !bstk (DataU1 _ t x) = do - ustk <- bump ustk - poke ustk x - pure (t, ustk, bstk) -dumpDataNoTag !_ !ustk !bstk (DataU2 _ t x y) = do - ustk <- bumpn ustk 2 - pokeOff ustk 1 y - poke ustk x - pure (t, ustk, bstk) -dumpDataNoTag !_ !ustk !bstk (DataB1 _ t x) = do - bstk <- bump bstk - poke bstk x - pure (t, ustk, bstk) -dumpDataNoTag !_ !ustk !bstk (DataB2 _ t x y) = do - bstk <- bumpn bstk 2 - pokeOff bstk 1 y - poke bstk x - pure (t, ustk, bstk) -dumpDataNoTag !_ !ustk !bstk (DataUB _ t x y) = do - ustk <- bump ustk - bstk <- bump bstk - poke ustk x - poke bstk y - pure (t, ustk, bstk) -dumpDataNoTag !_ !ustk !bstk (DataG _ t us bs) = do - ustk <- dumpSeg ustk us S - bstk <- dumpSeg bstk bs S - pure (t, ustk, bstk) -dumpDataNoTag !mr !_ !_ clo = - die $ - "dumpDataNoTag: bad closure: " - ++ show clo - ++ maybe "" (\r -> "\nexpected type: " ++ show r) mr -{-# INLINE dumpDataNoTag #-} - -dumpData :: - Maybe Reference -> - Stack 'UN -> - Stack 'BX -> - Closure -> - IO (Stack 'UN, Stack 'BX) -dumpData !_ !ustk !bstk (Enum _ t) = do - ustk <- bump ustk - pokeN ustk $ maskTags t - pure (ustk, bstk) -dumpData !_ !ustk !bstk (DataU1 _ t x) = do - ustk <- bumpn ustk 2 - pokeOff ustk 1 x - pokeN ustk $ maskTags t - pure (ustk, bstk) -dumpData !_ !ustk !bstk (DataU2 _ t x y) = do - ustk <- bumpn ustk 3 - pokeOff ustk 2 y - pokeOff ustk 1 x - pokeN ustk $ maskTags t - pure (ustk, bstk) -dumpData !_ !ustk !bstk (DataB1 _ t x) = do - ustk <- bump ustk - bstk <- bump bstk - poke bstk x - pokeN ustk $ maskTags t - pure (ustk, bstk) -dumpData !_ !ustk !bstk (DataB2 _ t x y) = do - ustk <- bump ustk - bstk <- bumpn bstk 2 - pokeOff bstk 1 y - poke bstk x - pokeN ustk $ maskTags t - pure (ustk, bstk) -dumpData !_ !ustk !bstk (DataUB _ t x y) = do - ustk <- bumpn ustk 2 - bstk <- bump bstk - pokeOff ustk 1 x - poke bstk y - pokeN ustk $ maskTags t - pure (ustk, bstk) -dumpData !_ !ustk !bstk (DataG _ t us bs) = do - ustk <- dumpSeg ustk us S - bstk <- dumpSeg bstk bs S - ustk <- bump ustk - pokeN ustk $ maskTags t - pure (ustk, bstk) -dumpData !mr !_ !_ clo = - die $ - "dumpData: bad closure: " - ++ show clo - ++ maybe "" (\r -> "\nexpected type: " ++ show r) mr -{-# INLINE dumpData #-} - --- Note: although the representation allows it, it is impossible --- to under-apply one sort of argument while over-applying the --- other. Thus, it is unnecessary to worry about doing tricks to --- only grab a certain number of arguments. -closeArgs :: - Augment -> - Stack 'UN -> - Stack 'BX -> - Seg 'UN -> - Seg 'BX -> - Args -> - IO (Seg 'UN, Seg 'BX) -closeArgs mode !ustk !bstk !useg !bseg args = - (,) - <$> augSeg mode ustk useg uargs - <*> augSeg mode bstk bseg bargs - where - (uargs, bargs) = case args of - ZArgs -> (Nothing, Nothing) - UArg1 i -> (Just $ Arg1 i, Nothing) - BArg1 i -> (Nothing, Just $ Arg1 i) - UArg2 i j -> (Just $ Arg2 i j, Nothing) - BArg2 i j -> (Nothing, Just $ Arg2 i j) - UArgR i l -> (Just $ ArgR i l, Nothing) - BArgR i l -> (Nothing, Just $ ArgR i l) - DArg2 i j -> (Just $ Arg1 i, Just $ Arg1 j) - DArgR ui ul bi bl -> (Just $ ArgR ui ul, Just $ ArgR bi bl) - UArgN as -> (Just $ ArgN as, Nothing) - BArgN as -> (Nothing, Just $ ArgN as) - DArgN us bs -> (Just $ ArgN us, Just $ ArgN bs) - DArgV ui bi -> (ua, ba) - where - ua - | ul > 0 = Just $ ArgR 0 ul - | otherwise = Nothing - ba - | bl > 0 = Just $ ArgR 0 bl - | otherwise = Nothing - ul = fsize ustk - ui - bl = fsize bstk - bi - -peekForeign :: Stack 'BX -> Int -> IO a -peekForeign bstk i = - peekOff bstk i >>= \case - Foreign x -> pure $ unwrapForeign x - _ -> die "bad foreign argument" -{-# INLINE peekForeign #-} - -uprim1 :: Stack 'UN -> UPrim1 -> Int -> IO (Stack 'UN) -uprim1 !ustk DECI !i = do - m <- peekOff ustk i - ustk <- bump ustk - poke ustk (m - 1) - pure ustk -uprim1 !ustk INCI !i = do - m <- peekOff ustk i - ustk <- bump ustk - poke ustk (m + 1) - pure ustk -uprim1 !ustk NEGI !i = do - m <- peekOff ustk i - ustk <- bump ustk - poke ustk (-m) - pure ustk -uprim1 !ustk SGNI !i = do - m <- peekOff ustk i - ustk <- bump ustk - poke ustk (signum m) - pure ustk -uprim1 !ustk ABSF !i = do - d <- peekOffD ustk i - ustk <- bump ustk - pokeD ustk (abs d) - pure ustk -uprim1 !ustk CEIL !i = do - d <- peekOffD ustk i - ustk <- bump ustk - poke ustk (ceiling d) - pure ustk -uprim1 !ustk FLOR !i = do - d <- peekOffD ustk i - ustk <- bump ustk - poke ustk (floor d) - pure ustk -uprim1 !ustk TRNF !i = do - d <- peekOffD ustk i - ustk <- bump ustk - poke ustk (truncate d) - pure ustk -uprim1 !ustk RNDF !i = do - d <- peekOffD ustk i - ustk <- bump ustk - poke ustk (round d) - pure ustk -uprim1 !ustk EXPF !i = do - d <- peekOffD ustk i - ustk <- bump ustk - pokeD ustk (exp d) - pure ustk -uprim1 !ustk LOGF !i = do - d <- peekOffD ustk i - ustk <- bump ustk - pokeD ustk (log d) - pure ustk -uprim1 !ustk SQRT !i = do - d <- peekOffD ustk i - ustk <- bump ustk - pokeD ustk (sqrt d) - pure ustk -uprim1 !ustk COSF !i = do - d <- peekOffD ustk i - ustk <- bump ustk - pokeD ustk (cos d) - pure ustk -uprim1 !ustk SINF !i = do - d <- peekOffD ustk i - ustk <- bump ustk - pokeD ustk (sin d) - pure ustk -uprim1 !ustk TANF !i = do - d <- peekOffD ustk i - ustk <- bump ustk - pokeD ustk (tan d) - pure ustk -uprim1 !ustk COSH !i = do - d <- peekOffD ustk i - ustk <- bump ustk - pokeD ustk (cosh d) - pure ustk -uprim1 !ustk SINH !i = do - d <- peekOffD ustk i - ustk <- bump ustk - pokeD ustk (sinh d) - pure ustk -uprim1 !ustk TANH !i = do - d <- peekOffD ustk i - ustk <- bump ustk - pokeD ustk (tanh d) - pure ustk -uprim1 !ustk ACOS !i = do - d <- peekOffD ustk i - ustk <- bump ustk - pokeD ustk (acos d) - pure ustk -uprim1 !ustk ASIN !i = do - d <- peekOffD ustk i - ustk <- bump ustk - pokeD ustk (asin d) - pure ustk -uprim1 !ustk ATAN !i = do - d <- peekOffD ustk i - ustk <- bump ustk - pokeD ustk (atan d) - pure ustk -uprim1 !ustk ASNH !i = do - d <- peekOffD ustk i - ustk <- bump ustk - pokeD ustk (asinh d) - pure ustk -uprim1 !ustk ACSH !i = do - d <- peekOffD ustk i - ustk <- bump ustk - pokeD ustk (acosh d) - pure ustk -uprim1 !ustk ATNH !i = do - d <- peekOffD ustk i - ustk <- bump ustk - pokeD ustk (atanh d) - pure ustk -uprim1 !ustk ITOF !i = do - n <- peekOff ustk i - ustk <- bump ustk - pokeD ustk (fromIntegral n) - pure ustk -uprim1 !ustk NTOF !i = do - n <- peekOffN ustk i - ustk <- bump ustk - pokeD ustk (fromIntegral n) - pure ustk -uprim1 !ustk LZRO !i = do - n <- peekOffN ustk i - ustk <- bump ustk - poke ustk (countLeadingZeros n) - pure ustk -uprim1 !ustk TZRO !i = do - n <- peekOffN ustk i - ustk <- bump ustk - poke ustk (countTrailingZeros n) - pure ustk -uprim1 !ustk POPC !i = do - n <- peekOffN ustk i - ustk <- bump ustk - poke ustk (popCount n) - pure ustk -uprim1 !ustk COMN !i = do - n <- peekOffN ustk i - ustk <- bump ustk - pokeN ustk (complement n) - pure ustk -{-# INLINE uprim1 #-} - -uprim2 :: Stack 'UN -> UPrim2 -> Int -> Int -> IO (Stack 'UN) -uprim2 !ustk ADDI !i !j = do - m <- peekOff ustk i - n <- peekOff ustk j - ustk <- bump ustk - poke ustk (m + n) - pure ustk -uprim2 !ustk SUBI !i !j = do - m <- peekOff ustk i - n <- peekOff ustk j - ustk <- bump ustk - poke ustk (m - n) - pure ustk -uprim2 !ustk MULI !i !j = do - m <- peekOff ustk i - n <- peekOff ustk j - ustk <- bump ustk - poke ustk (m * n) - pure ustk -uprim2 !ustk DIVI !i !j = do - m <- peekOff ustk i - n <- peekOff ustk j - ustk <- bump ustk - poke ustk (m `div` n) - pure ustk -uprim2 !ustk MODI !i !j = do - m <- peekOff ustk i - n <- peekOff ustk j - ustk <- bump ustk - poke ustk (m `mod` n) - pure ustk -uprim2 !ustk SHLI !i !j = do - m <- peekOff ustk i - n <- peekOff ustk j - ustk <- bump ustk - poke ustk (m `shiftL` n) - pure ustk -uprim2 !ustk SHRI !i !j = do - m <- peekOff ustk i - n <- peekOff ustk j - ustk <- bump ustk - poke ustk (m `shiftR` n) - pure ustk -uprim2 !ustk SHRN !i !j = do - m <- peekOffN ustk i - n <- peekOff ustk j - ustk <- bump ustk - pokeN ustk (m `shiftR` n) - pure ustk -uprim2 !ustk POWI !i !j = do - m <- peekOff ustk i - n <- peekOffN ustk j - ustk <- bump ustk - poke ustk (m ^ n) - pure ustk -uprim2 !ustk EQLI !i !j = do - m <- peekOff ustk i - n <- peekOff ustk j - ustk <- bump ustk - poke ustk $ if m == n then 1 else 0 - pure ustk -uprim2 !ustk LEQI !i !j = do - m <- peekOff ustk i - n <- peekOff ustk j - ustk <- bump ustk - poke ustk $ if m <= n then 1 else 0 - pure ustk -uprim2 !ustk LEQN !i !j = do - m <- peekOffN ustk i - n <- peekOffN ustk j - ustk <- bump ustk - poke ustk $ if m <= n then 1 else 0 - pure ustk -uprim2 !ustk DIVN !i !j = do - m <- peekOffN ustk i - n <- peekOffN ustk j - ustk <- bump ustk - pokeN ustk (m `div` n) - pure ustk -uprim2 !ustk MODN !i !j = do - m <- peekOffN ustk i - n <- peekOffN ustk j - ustk <- bump ustk - pokeN ustk (m `mod` n) - pure ustk -uprim2 !ustk ADDF !i !j = do - x <- peekOffD ustk i - y <- peekOffD ustk j - ustk <- bump ustk - pokeD ustk (x + y) - pure ustk -uprim2 !ustk SUBF !i !j = do - x <- peekOffD ustk i - y <- peekOffD ustk j - ustk <- bump ustk - pokeD ustk (x - y) - pure ustk -uprim2 !ustk MULF !i !j = do - x <- peekOffD ustk i - y <- peekOffD ustk j - ustk <- bump ustk - pokeD ustk (x * y) - pure ustk -uprim2 !ustk DIVF !i !j = do - x <- peekOffD ustk i - y <- peekOffD ustk j - ustk <- bump ustk - pokeD ustk (x / y) - pure ustk -uprim2 !ustk LOGB !i !j = do - x <- peekOffD ustk i - y <- peekOffD ustk j - ustk <- bump ustk - pokeD ustk (logBase x y) - pure ustk -uprim2 !ustk POWF !i !j = do - x <- peekOffD ustk i - y <- peekOffD ustk j - ustk <- bump ustk - pokeD ustk (x ** y) - pure ustk -uprim2 !ustk MAXF !i !j = do - x <- peekOffD ustk i - y <- peekOffD ustk j - ustk <- bump ustk - pokeD ustk (max x y) - pure ustk -uprim2 !ustk MINF !i !j = do - x <- peekOffD ustk i - y <- peekOffD ustk j - ustk <- bump ustk - pokeD ustk (min x y) - pure ustk -uprim2 !ustk EQLF !i !j = do - x <- peekOffD ustk i - y <- peekOffD ustk j - ustk <- bump ustk - poke ustk (if x == y then 1 else 0) - pure ustk -uprim2 !ustk LEQF !i !j = do - x <- peekOffD ustk i - y <- peekOffD ustk j - ustk <- bump ustk - poke ustk (if x <= y then 1 else 0) - pure ustk -uprim2 !ustk ATN2 !i !j = do - x <- peekOffD ustk i - y <- peekOffD ustk j - ustk <- bump ustk - pokeD ustk (atan2 x y) - pure ustk -uprim2 !ustk ANDN !i !j = do - x <- peekOffN ustk i - y <- peekOffN ustk j - ustk <- bump ustk - pokeN ustk (x .&. y) - pure ustk -uprim2 !ustk IORN !i !j = do - x <- peekOffN ustk i - y <- peekOffN ustk j - ustk <- bump ustk - pokeN ustk (x .|. y) - pure ustk -uprim2 !ustk XORN !i !j = do - x <- peekOffN ustk i - y <- peekOffN ustk j - ustk <- bump ustk - pokeN ustk (xor x y) - pure ustk -{-# INLINE uprim2 #-} - -bprim1 :: - Stack 'UN -> - Stack 'BX -> - BPrim1 -> - Int -> - IO (Stack 'UN, Stack 'BX) -bprim1 !ustk !bstk SIZT i = do - t <- peekOffBi bstk i - ustk <- bump ustk - poke ustk $ Util.Text.size t - pure (ustk, bstk) -bprim1 !ustk !bstk SIZS i = do - s <- peekOffS bstk i - ustk <- bump ustk - poke ustk $ Sq.length s - pure (ustk, bstk) -bprim1 !ustk !bstk ITOT i = do - n <- peekOff ustk i - bstk <- bump bstk - pokeBi bstk . Util.Text.pack $ show n - pure (ustk, bstk) -bprim1 !ustk !bstk NTOT i = do - n <- peekOffN ustk i - bstk <- bump bstk - pokeBi bstk . Util.Text.pack $ show n - pure (ustk, bstk) -bprim1 !ustk !bstk FTOT i = do - f <- peekOffD ustk i - bstk <- bump bstk - pokeBi bstk . Util.Text.pack $ show f - pure (ustk, bstk) -bprim1 !ustk !bstk USNC i = - peekOffBi bstk i >>= \t -> case Util.Text.unsnoc t of - Nothing -> do - ustk <- bump ustk - poke ustk 0 - pure (ustk, bstk) - Just (t, c) -> do - ustk <- bumpn ustk 2 - bstk <- bump bstk - pokeOff ustk 1 $ fromEnum c - poke ustk 1 - pokeBi bstk t - pure (ustk, bstk) -bprim1 !ustk !bstk UCNS i = - peekOffBi bstk i >>= \t -> case Util.Text.uncons t of - Nothing -> do - ustk <- bump ustk - poke ustk 0 - pure (ustk, bstk) - Just (c, t) -> do - ustk <- bumpn ustk 2 - bstk <- bump bstk - pokeOff ustk 1 $ fromEnum c - poke ustk 1 - pokeBi bstk t - pure (ustk, bstk) -bprim1 !ustk !bstk TTOI i = - peekOffBi bstk i >>= \t -> case readm $ Util.Text.unpack t of - Just n - | fromIntegral (minBound :: Int) <= n, - n <= fromIntegral (maxBound :: Int) -> do - ustk <- bumpn ustk 2 - poke ustk 1 - pokeOff ustk 1 (fromInteger n) - pure (ustk, bstk) - _ -> do - ustk <- bump ustk - poke ustk 0 - pure (ustk, bstk) - where - readm ('+' : s) = readMaybe s - readm s = readMaybe s -bprim1 !ustk !bstk TTON i = - peekOffBi bstk i >>= \t -> case readMaybe $ Util.Text.unpack t of - Just n - | 0 <= n, - n <= fromIntegral (maxBound :: Word) -> do - ustk <- bumpn ustk 2 - poke ustk 1 - pokeOffN ustk 1 (fromInteger n) - pure (ustk, bstk) - _ -> do - ustk <- bump ustk - poke ustk 0 - pure (ustk, bstk) -bprim1 !ustk !bstk TTOF i = - peekOffBi bstk i >>= \t -> case readMaybe $ Util.Text.unpack t of - Nothing -> do - ustk <- bump ustk - poke ustk 0 - pure (ustk, bstk) - Just f -> do - ustk <- bumpn ustk 2 - poke ustk 1 - pokeOffD ustk 1 f - pure (ustk, bstk) -bprim1 !ustk !bstk VWLS i = - peekOffS bstk i >>= \case - Sq.Empty -> do - ustk <- bump ustk - poke ustk 0 - pure (ustk, bstk) - x Sq.:<| xs -> do - ustk <- bump ustk - poke ustk 1 - bstk <- bumpn bstk 2 - pokeOffS bstk 1 xs - poke bstk x - pure (ustk, bstk) -bprim1 !ustk !bstk VWRS i = - peekOffS bstk i >>= \case - Sq.Empty -> do - ustk <- bump ustk - poke ustk 0 - pure (ustk, bstk) - xs Sq.:|> x -> do - ustk <- bump ustk - poke ustk 1 - bstk <- bumpn bstk 2 - pokeOff bstk 1 x - pokeS bstk xs - pure (ustk, bstk) -bprim1 !ustk !bstk PAKT i = do - s <- peekOffS bstk i - bstk <- bump bstk - pokeBi bstk . Util.Text.pack . toList $ clo2char <$> s - pure (ustk, bstk) - where - clo2char (DataU1 _ t i) | t == charTag = toEnum i - clo2char c = error $ "pack text: non-character closure: " ++ show c -bprim1 !ustk !bstk UPKT i = do - t <- peekOffBi bstk i - bstk <- bump bstk - pokeS bstk - . Sq.fromList - . fmap (DataU1 Rf.charRef charTag . fromEnum) - . Util.Text.unpack - $ t - pure (ustk, bstk) -bprim1 !ustk !bstk PAKB i = do - s <- peekOffS bstk i - bstk <- bump bstk - pokeBi bstk . By.fromWord8s . fmap clo2w8 $ toList s - pure (ustk, bstk) - where - clo2w8 (DataU1 _ t n) | t == natTag = toEnum n - clo2w8 c = error $ "pack bytes: non-natural closure: " ++ show c -bprim1 !ustk !bstk UPKB i = do - b <- peekOffBi bstk i - bstk <- bump bstk - pokeS bstk . Sq.fromList . fmap (DataU1 Rf.natRef natTag . fromEnum) $ - By.toWord8s b - pure (ustk, bstk) -bprim1 !ustk !bstk SIZB i = do - b <- peekOffBi bstk i - ustk <- bump ustk - poke ustk $ By.size b - pure (ustk, bstk) -bprim1 !ustk !bstk FLTB i = do - b <- peekOffBi bstk i - bstk <- bump bstk - pokeBi bstk $ By.flatten b - pure (ustk, bstk) --- impossible -bprim1 !ustk !bstk MISS _ = pure (ustk, bstk) -bprim1 !ustk !bstk CACH _ = pure (ustk, bstk) -bprim1 !ustk !bstk LKUP _ = pure (ustk, bstk) -bprim1 !ustk !bstk CVLD _ = pure (ustk, bstk) -bprim1 !ustk !bstk TLTT _ = pure (ustk, bstk) -bprim1 !ustk !bstk LOAD _ = pure (ustk, bstk) -bprim1 !ustk !bstk VALU _ = pure (ustk, bstk) -bprim1 !ustk !bstk DBTX _ = pure (ustk, bstk) -bprim1 !ustk !bstk SDBL _ = pure (ustk, bstk) -{-# INLINE bprim1 #-} - -bprim2 :: - Stack 'UN -> - Stack 'BX -> - BPrim2 -> - Int -> - Int -> - IO (Stack 'UN, Stack 'BX) -bprim2 !ustk !bstk EQLU i j = do - x <- peekOff bstk i - y <- peekOff bstk j - ustk <- bump ustk - poke ustk $ if universalEq (==) x y then 1 else 0 - pure (ustk, bstk) -bprim2 !ustk !bstk IXOT i j = do - x <- peekOffBi bstk i - y <- peekOffBi bstk j - case Util.Text.indexOf x y of - Nothing -> do - ustk <- bump ustk - poke ustk 0 - pure (ustk, bstk) - Just i -> do - ustk <- bumpn ustk 2 - poke ustk 1 - pokeOffN ustk 1 i - pure (ustk, bstk) -bprim2 !ustk !bstk IXOB i j = do - x <- peekOffBi bstk i - y <- peekOffBi bstk j - case By.indexOf x y of - Nothing -> do - ustk <- bump ustk - poke ustk 0 - pure (ustk, bstk) - Just i -> do - ustk <- bumpn ustk 2 - poke ustk 1 - pokeOffN ustk 1 i - pure (ustk, bstk) -bprim2 !ustk !bstk DRPT i j = do - n <- peekOff ustk i - t <- peekOffBi bstk j - bstk <- bump bstk - -- Note; if n < 0, the Nat argument was greater than the maximum - -- signed integer. As an approximation, just return the empty - -- string, as a string larger than this would require an absurd - -- amount of memory. - pokeBi bstk $ if n < 0 then Util.Text.empty else Util.Text.drop n t - pure (ustk, bstk) -bprim2 !ustk !bstk CATT i j = do - x <- peekOffBi bstk i - y <- peekOffBi bstk j - bstk <- bump bstk - pokeBi bstk $ (x <> y :: Util.Text.Text) - pure (ustk, bstk) -bprim2 !ustk !bstk TAKT i j = do - n <- peekOff ustk i - t <- peekOffBi bstk j - bstk <- bump bstk - -- Note: if n < 0, the Nat argument was greater than the maximum - -- signed integer. As an approximation, we just return the original - -- string, because it's unlikely such a large string exists. - pokeBi bstk $ if n < 0 then t else Util.Text.take n t - pure (ustk, bstk) -bprim2 !ustk !bstk EQLT i j = do - x <- peekOffBi @Util.Text.Text bstk i - y <- peekOffBi bstk j - ustk <- bump ustk - poke ustk $ if x == y then 1 else 0 - pure (ustk, bstk) -bprim2 !ustk !bstk LEQT i j = do - x <- peekOffBi @Util.Text.Text bstk i - y <- peekOffBi bstk j - ustk <- bump ustk - poke ustk $ if x <= y then 1 else 0 - pure (ustk, bstk) -bprim2 !ustk !bstk LEST i j = do - x <- peekOffBi @Util.Text.Text bstk i - y <- peekOffBi bstk j - ustk <- bump ustk - poke ustk $ if x < y then 1 else 0 - pure (ustk, bstk) -bprim2 !ustk !bstk DRPS i j = do - n <- peekOff ustk i - s <- peekOffS bstk j - bstk <- bump bstk - -- Note: if n < 0, then the Nat argument was larger than the largest - -- signed integer. Seq actually doesn't handle this well, despite it - -- being possible to build (lazy) sequences this large. So, - -- approximate by yielding the empty sequence. - pokeS bstk $ if n < 0 then Sq.empty else Sq.drop n s - pure (ustk, bstk) -bprim2 !ustk !bstk TAKS i j = do - n <- peekOff ustk i - s <- peekOffS bstk j - bstk <- bump bstk - -- Note: if n < 0, then the Nat argument was greater than the - -- largest signed integer. It is possible to build such large - -- sequences, but the internal size will actually be wrong then. So, - -- we just return the original sequence as an approximation. - pokeS bstk $ if n < 0 then s else Sq.take n s - pure (ustk, bstk) -bprim2 !ustk !bstk CONS i j = do - x <- peekOff bstk i - s <- peekOffS bstk j - bstk <- bump bstk - pokeS bstk $ x Sq.<| s - pure (ustk, bstk) -bprim2 !ustk !bstk SNOC i j = do - s <- peekOffS bstk i - x <- peekOff bstk j - bstk <- bump bstk - pokeS bstk $ s Sq.|> x - pure (ustk, bstk) -bprim2 !ustk !bstk CATS i j = do - x <- peekOffS bstk i - y <- peekOffS bstk j - bstk <- bump bstk - pokeS bstk $ x Sq.>< y - pure (ustk, bstk) -bprim2 !ustk !bstk IDXS i j = do - n <- peekOff ustk i - s <- peekOffS bstk j - case Sq.lookup n s of - Nothing -> do - ustk <- bump ustk - poke ustk 0 - pure (ustk, bstk) - Just x -> do - ustk <- bump ustk - poke ustk 1 - bstk <- bump bstk - poke bstk x - pure (ustk, bstk) -bprim2 !ustk !bstk SPLL i j = do - n <- peekOff ustk i - s <- peekOffS bstk j - if Sq.length s < n - then do - ustk <- bump ustk - poke ustk 0 - pure (ustk, bstk) - else do - ustk <- bump ustk - poke ustk 1 - bstk <- bumpn bstk 2 - let (l, r) = Sq.splitAt n s - pokeOffS bstk 1 r - pokeS bstk l - pure (ustk, bstk) -bprim2 !ustk !bstk SPLR i j = do - n <- peekOff ustk i - s <- peekOffS bstk j - if Sq.length s < n - then do - ustk <- bump ustk - poke ustk 0 - pure (ustk, bstk) - else do - ustk <- bump ustk - poke ustk 1 - bstk <- bumpn bstk 2 - let (l, r) = Sq.splitAt (Sq.length s - n) s - pokeOffS bstk 1 r - pokeS bstk l - pure (ustk, bstk) -bprim2 !ustk !bstk TAKB i j = do - n <- peekOff ustk i - b <- peekOffBi bstk j - bstk <- bump bstk - -- If n < 0, the Nat argument was larger than the maximum signed - -- integer. Building a value this large would reuire an absurd - -- amount of memory, so just assume n is larger. - pokeBi bstk $ if n < 0 then b else By.take n b - pure (ustk, bstk) -bprim2 !ustk !bstk DRPB i j = do - n <- peekOff ustk i - b <- peekOffBi bstk j - bstk <- bump bstk - -- See above for n < 0 - pokeBi bstk $ if n < 0 then By.empty else By.drop n b - pure (ustk, bstk) -bprim2 !ustk !bstk IDXB i j = do - n <- peekOff ustk i - b <- peekOffBi bstk j - ustk <- bump ustk - ustk <- case By.at n b of - Nothing -> ustk <$ poke ustk 0 - Just x -> do - poke ustk $ fromIntegral x - ustk <- bump ustk - ustk <$ poke ustk 1 - pure (ustk, bstk) -bprim2 !ustk !bstk CATB i j = do - l <- peekOffBi bstk i - r <- peekOffBi bstk j - bstk <- bump bstk - pokeBi bstk (l <> r :: By.Bytes) - pure (ustk, bstk) -bprim2 !ustk !bstk THRO _ _ = pure (ustk, bstk) -- impossible -bprim2 !ustk !bstk TRCE _ _ = pure (ustk, bstk) -- impossible -bprim2 !ustk !bstk CMPU _ _ = pure (ustk, bstk) -- impossible -bprim2 !ustk !bstk SDBX _ _ = pure (ustk, bstk) -- impossible -bprim2 !ustk !bstk SDBV _ _ = pure (ustk, bstk) -- impossible -{-# INLINE bprim2 #-} - -yield :: - CCache -> - DEnv -> - ActiveThreads -> - Stack 'UN -> - Stack 'BX -> - K -> - IO () -yield !env !denv !activeThreads !ustk !bstk !k = leap denv k - where - leap !denv0 (Mark ua ba ps cs k) = do - let denv = cs <> EC.withoutKeys denv0 ps - clo = denv0 EC.! EC.findMin ps - poke bstk . DataB1 Rf.effectRef 0 =<< peek bstk - ustk <- adjustArgs ustk ua - bstk <- adjustArgs bstk ba - apply env denv activeThreads ustk bstk k False (BArg1 0) clo - leap !denv (Push ufsz bfsz uasz basz cix k) = do - Lam _ _ uf bf nx <- combSection env cix - ustk <- restoreFrame ustk ufsz uasz - bstk <- restoreFrame bstk bfsz basz - ustk <- ensure ustk uf - bstk <- ensure bstk bf - eval env denv activeThreads ustk bstk k (combRef cix) nx - leap _ (CB (Hook f)) = f ustk bstk - leap _ KE = pure () -{-# INLINE yield #-} - -selectTextBranch :: - Util.Text.Text -> Section -> M.Map Util.Text.Text Section -> Section -selectTextBranch t df cs = M.findWithDefault df t cs -{-# INLINE selectTextBranch #-} - -selectBranch :: Tag -> Branch -> Section -selectBranch t (Test1 u y n) - | t == u = y - | otherwise = n -selectBranch t (Test2 u cu v cv e) - | t == u = cu - | t == v = cv - | otherwise = e -selectBranch t (TestW df cs) = lookupWithDefault df t cs -selectBranch _ (TestT {}) = error "impossible" -{-# INLINE selectBranch #-} - --- Splits off a portion of the continuation up to a given prompt. --- --- The main procedure walks along the 'code' stack `k`, keeping track of how --- many cells of the data stacks need to be captured. Then the `finish` function --- performs the actual splitting of the data stacks together with some tweaking. --- --- Some special attention is required for pending arguments for over-applied --- functions. They are part of the continuation, so how many there are at the --- time of capture is recorded in the `Captured` closure, so that information --- can be restored later. Also, the `Mark` frame that is popped off as part of --- this operation potentially exposes pending arguments beyond the delimited --- region, so those are restored in the `finish` function. -splitCont :: - DEnv -> - Stack 'UN -> - Stack 'BX -> - K -> - Word64 -> - IO (Closure, DEnv, Stack 'UN, Stack 'BX, K) -splitCont !denv !ustk !bstk !k !p = - walk denv uasz basz KE k - where - uasz = asize ustk - basz = asize bstk - walk !denv !usz !bsz !ck KE = - die "fell off stack" >> finish denv usz bsz 0 0 ck KE - walk !denv !usz !bsz !ck (CB _) = - die "fell off stack" >> finish denv usz bsz 0 0 ck KE - walk !denv !usz !bsz !ck (Mark ua ba ps cs k) - | EC.member p ps = finish denv' usz bsz ua ba ck k - | otherwise = walk denv' (usz + ua) (bsz + ba) (Mark ua ba ps cs' ck) k - where - denv' = cs <> EC.withoutKeys denv ps - cs' = EC.restrictKeys denv ps - walk !denv !usz !bsz !ck (Push un bn ua ba br k) = - walk denv (usz + un + ua) (bsz + bn + ba) (Push un bn ua ba br ck) k - - finish !denv !usz !bsz !ua !ba !ck !k = do - (useg, ustk) <- grab ustk usz - (bseg, bstk) <- grab bstk bsz - ustk <- adjustArgs ustk ua - bstk <- adjustArgs bstk ba - return (Captured ck uasz basz useg bseg, denv, ustk, bstk, k) -{-# INLINE splitCont #-} - -discardCont :: - DEnv -> - Stack 'UN -> - Stack 'BX -> - K -> - Word64 -> - IO (DEnv, Stack 'UN, Stack 'BX, K) -discardCont denv ustk bstk k p = - splitCont denv ustk bstk k p - <&> \(_, denv, ustk, bstk, k) -> (denv, ustk, bstk, k) -{-# INLINE discardCont #-} - -resolve :: CCache -> DEnv -> Stack 'BX -> Ref -> IO Closure -resolve env _ _ (Env n i) = - readTVarIO (combRefs env) >>= \rs -> case EC.lookup n rs of - Just r -> pure $ PAp (CIx r n i) unull bnull - Nothing -> die $ "resolve: missing reference for comb: " ++ show n -resolve _ _ bstk (Stk i) = peekOff bstk i -resolve env denv _ (Dyn i) = case EC.lookup i denv of - Just clo -> pure clo - Nothing -> unhandledErr "resolve" env i - -unhandledErr :: String -> CCache -> Word64 -> IO a -unhandledErr fname env i = - readTVarIO (tagRefs env) >>= \rs -> case EC.lookup i rs of - Just r -> bomb (show r) - Nothing -> bomb (show i) - where - bomb sh = die $ fname ++ ": unhandled ability request: " ++ sh - -combSection :: (HasCallStack) => CCache -> CombIx -> IO Comb -combSection env (CIx _ n i) = - readTVarIO (combs env) >>= \cs -> case EC.lookup n cs of - Just cmbs -> case EC.lookup i cmbs of - Just cmb -> pure cmb - Nothing -> - die $ - "unknown section `" - ++ show i - ++ "` of combinator `" - ++ show n - ++ "`." - Nothing -> die $ "unknown combinator `" ++ show n ++ "`." - -dummyRef :: Reference -dummyRef = Builtin (DTx.pack "dummy") - -reserveIds :: Word64 -> TVar Word64 -> IO Word64 -reserveIds n free = atomically . stateTVar free $ \i -> (i, i + n) - -updateMap :: (Semigroup s) => s -> TVar s -> STM s -updateMap new0 r = do - new <- evaluateSTM new0 - stateTVar r $ \old -> - let total = new <> old in (total, total) - -refLookup :: String -> M.Map Reference Word64 -> Reference -> Word64 -refLookup s m r - | Just w <- M.lookup r m = w - | otherwise = - error $ "refLookup:" ++ s ++ ": unknown reference: " ++ show r - -decodeCacheArgument :: - Sq.Seq Closure -> IO [(Reference, SuperGroup Symbol)] -decodeCacheArgument s = for (toList s) $ \case - DataB2 _ _ (Foreign x) (DataB2 _ _ (Foreign y) _) -> - case unwrapForeign x of - Ref r -> pure (r, unwrapForeign y) - _ -> die "decodeCacheArgument: Con reference" - _ -> die "decodeCacheArgument: unrecognized value" - -decodeSandboxArgument :: Sq.Seq Closure -> IO [Reference] -decodeSandboxArgument s = fmap join . for (toList s) $ \case - Foreign x -> case unwrapForeign x of - Ref r -> pure [r] - _ -> pure [] -- constructor - _ -> die "decodeSandboxArgument: unrecognized value" - -encodeSandboxListResult :: [Reference] -> Sq.Seq Closure -encodeSandboxListResult = - Sq.fromList . fmap (Foreign . Wrap Rf.termLinkRef . Ref) - -encodeSandboxResult :: Either [Reference] [Reference] -> Closure -encodeSandboxResult (Left rfs) = - encodeLeft . Foreign . Wrap Rf.listRef $ encodeSandboxListResult rfs -encodeSandboxResult (Right rfs) = - encodeRight . Foreign . Wrap Rf.listRef $ encodeSandboxListResult rfs - -encodeLeft :: Closure -> Closure -encodeLeft = DataB1 Rf.eitherRef leftTag - -encodeRight :: Closure -> Closure -encodeRight = DataB1 Rf.eitherRef rightTag - -addRefs :: - TVar Word64 -> - TVar (M.Map Reference Word64) -> - TVar (EnumMap Word64 Reference) -> - S.Set Reference -> - STM (M.Map Reference Word64) -addRefs vfrsh vfrom vto rs = do - from0 <- readTVar vfrom - let new = S.filter (`M.notMember` from0) rs - sz = fromIntegral $ S.size new - frsh <- stateTVar vfrsh $ \i -> (i, i + sz) - let newl = S.toList new - from = M.fromList (zip newl [frsh ..]) <> from0 - nto = mapFromList (zip [frsh ..] newl) - writeTVar vfrom from - modifyTVar vto (nto <>) - pure from - -codeValidate :: - [(Reference, SuperGroup Symbol)] -> - CCache -> - IO (Maybe (Failure Closure)) -codeValidate tml cc = do - rty0 <- readTVarIO (refTy cc) - fty <- readTVarIO (freshTy cc) - let f b r - | b, M.notMember r rty0 = S.singleton r - | otherwise = mempty - ntys0 = (foldMap . foldMap) (foldGroupLinks f) tml - ntys = M.fromList $ zip (S.toList ntys0) [fty ..] - rty = ntys <> rty0 - ftm <- readTVarIO (freshTm cc) - rtm0 <- readTVarIO (refTm cc) - let rs = fst <$> tml - rtm = rtm0 `M.withoutKeys` S.fromList rs - rns = RN (refLookup "ty" rty) (refLookup "tm" rtm) - combinate (n, (r, g)) = evaluate $ emitCombs rns r n g - (Nothing <$ traverse_ combinate (zip [ftm ..] tml)) - `catch` \(CE cs perr) -> - let msg = Util.Text.pack $ toPlainUnbroken perr - extra = Foreign . Wrap Rf.textRef . Util.Text.pack $ show cs - in pure . Just $ Failure ioFailureRef msg extra - -sandboxList :: CCache -> Referent -> IO [Reference] -sandboxList cc (Ref r) = do - sands <- readTVarIO $ sandbox cc - pure . maybe [] S.toList $ M.lookup r sands -sandboxList _ _ = pure [] - -checkSandboxing :: - CCache -> - [Reference] -> - Closure -> - IO Bool -checkSandboxing cc allowed0 c = do - sands <- readTVarIO $ sandbox cc - let f r - | Just rs <- M.lookup r sands = - rs `S.difference` allowed - | otherwise = mempty - pure $ S.null (closureTermRefs f c) - where - allowed = S.fromList allowed0 - --- Checks a Value for sandboxing. A Left result indicates that some --- dependencies of the Value are unknown. A Right result indicates --- builtins transitively referenced by the Value that are disallowed. -checkValueSandboxing :: - CCache -> - [Reference] -> - ANF.Value -> - IO (Either [Reference] [Reference]) -checkValueSandboxing cc allowed0 v = do - sands <- readTVarIO $ sandbox cc - have <- readTVarIO $ intermed cc - let f False r - | Nothing <- M.lookup r have, - not (isBuiltin r) = - (S.singleton r, mempty) - | Just rs <- M.lookup r sands = - (mempty, rs `S.difference` allowed) - f _ _ = (mempty, mempty) - case valueLinks f v of - (miss, sbx) - | S.null miss -> pure . Right $ S.toList sbx - | otherwise -> pure . Left $ S.toList miss - where - allowed = S.fromList allowed0 - --- Just evaluating to force exceptions. Shouldn't actually be that --- unsafe. -evaluateSTM :: a -> STM a -evaluateSTM x = unsafeIOToSTM (evaluate x) - -cacheAdd0 :: - S.Set Reference -> - [(Reference, SuperGroup Symbol)] -> - [(Reference, Set Reference)] -> - CCache -> - IO () -cacheAdd0 ntys0 tml sands cc = atomically $ do - have <- readTVar (intermed cc) - let new = M.difference toAdd have - sz = fromIntegral $ M.size new - rgs = M.toList new - rs = fst <$> rgs - int <- writeTVar (intermed cc) (have <> new) - rty <- addRefs (freshTy cc) (refTy cc) (tagRefs cc) ntys0 - ntm <- stateTVar (freshTm cc) $ \i -> (i, i + sz) - rtm <- updateMap (M.fromList $ zip rs [ntm ..]) (refTm cc) - -- check for missing references - let rns = RN (refLookup "ty" rty) (refLookup "tm" rtm) - combinate n (r, g) = (n, emitCombs rns r n g) - nrs <- updateMap (mapFromList $ zip [ntm ..] rs) (combRefs cc) - ncs <- updateMap (mapFromList $ zipWith combinate [ntm ..] rgs) (combs cc) - nsn <- updateMap (M.fromList sands) (sandbox cc) - pure $ int `seq` rtm `seq` nrs `seq` ncs `seq` nsn `seq` () - where - toAdd = M.fromList tml - -expandSandbox :: - Map Reference (Set Reference) -> - [(Reference, SuperGroup Symbol)] -> - [(Reference, Set Reference)] -expandSandbox sand0 groups = fixed mempty - where - f sand False r = fromMaybe mempty $ M.lookup r sand - f _ True _ = mempty - - h sand (r, foldGroupLinks (f sand) -> s) - | S.null s = Nothing - | otherwise = Just (r, s) - - fixed extra - | extra == extra' = new - | otherwise = fixed extra' - where - new = mapMaybe (h $ extra <> sand0) groups - extra' = M.fromList new - -cacheAdd :: - [(Reference, SuperGroup Symbol)] -> - CCache -> - IO [Reference] -cacheAdd l cc = do - rtm <- readTVarIO (refTm cc) - rty <- readTVarIO (refTy cc) - sand <- readTVarIO (sandbox cc) - let known = M.keysSet rtm <> S.fromList (fst <$> l) - f b r - | not b, S.notMember r known = Const (S.singleton r, mempty) - | b, M.notMember r rty = Const (mempty, S.singleton r) - | otherwise = Const (mempty, mempty) - (missing, tys) = getConst $ (foldMap . foldMap) (foldGroupLinks f) l - l' = filter (\(r, _) -> M.notMember r rtm) l - if S.null missing - then [] <$ cacheAdd0 tys l' (expandSandbox sand l') cc - else pure $ S.toList missing - -reflectValue :: EnumMap Word64 Reference -> Closure -> IO ANF.Value -reflectValue rty = goV - where - err s = "reflectValue: cannot prepare value for serialization: " ++ s - refTy w - | Just r <- EC.lookup w rty = pure r - | otherwise = - die $ err "unknown type reference" - - goIx (CIx r _ i) = ANF.GR r i - - goV (PApV cix ua ba) = - ANF.Partial (goIx cix) (fromIntegral <$> ua) <$> traverse goV ba - goV (DataC _ t [w] []) = ANF.BLit <$> reflectUData t w - goV (DataC r t us bs) = - ANF.Data r (maskTags t) (fromIntegral <$> us) <$> traverse goV bs - goV (CapV k _ _ us bs) = - ANF.Cont (fromIntegral <$> us) <$> traverse goV bs <*> goK k - goV (Foreign f) = ANF.BLit <$> goF f - goV BlackHole = die $ err "black hole" - - goK (CB _) = die $ err "callback continuation" - goK KE = pure ANF.KE - goK (Mark ua ba ps de k) = do - ps <- traverse refTy (EC.setToList ps) - de <- traverse (\(k, v) -> (,) <$> refTy k <*> goV v) (mapToList de) - ANF.Mark (fromIntegral ua) (fromIntegral ba) ps (M.fromList de) <$> goK k - goK (Push uf bf ua ba cix k) = - ANF.Push - (fromIntegral uf) - (fromIntegral bf) - (fromIntegral ua) - (fromIntegral ba) - (goIx cix) - <$> goK k - - goF f - | Just t <- maybeUnwrapBuiltin f = - pure (ANF.Text t) - | Just b <- maybeUnwrapBuiltin f = - pure (ANF.Bytes b) - | Just s <- maybeUnwrapForeign Rf.listRef f = - ANF.List <$> traverse goV s - | Just l <- maybeUnwrapForeign Rf.termLinkRef f = - pure (ANF.TmLink l) - | Just l <- maybeUnwrapForeign Rf.typeLinkRef f = - pure (ANF.TyLink l) - | Just v <- maybeUnwrapForeign Rf.valueRef f = - pure (ANF.Quote v) - | Just g <- maybeUnwrapForeign Rf.codeRef f = - pure (ANF.Code g) - | Just a <- maybeUnwrapForeign Rf.ibytearrayRef f = - pure (ANF.BArr a) - | Just a <- maybeUnwrapForeign Rf.iarrayRef f = - ANF.Arr <$> traverse goV a - | otherwise = die $ err $ "foreign value: " <> (show f) - - reflectUData :: Word64 -> Int -> IO ANF.BLit - reflectUData t v - | t == natTag = pure $ ANF.Pos (fromIntegral v) - | t == charTag = pure $ ANF.Char (toEnum v) - | t == intTag, v >= 0 = pure $ ANF.Pos (fromIntegral v) - | t == intTag, v < 0 = pure $ ANF.Neg (fromIntegral (-v)) - | t == floatTag = pure $ ANF.Float (intToDouble v) - | otherwise = die . err $ "unboxed data: " <> show (t, v) - -reifyValue :: CCache -> ANF.Value -> IO (Either [Reference] Closure) -reifyValue cc val = do - erc <- - atomically $ - readTVar (refTm cc) >>= \rtm -> - case S.toList $ S.filter (`M.notMember` rtm) tmLinks of - [] -> - Right . (,rtm) - <$> addRefs (freshTy cc) (refTy cc) (tagRefs cc) tyLinks - l -> pure (Left l) - traverse (\rfs -> reifyValue0 rfs val) erc - where - f False r = (mempty, S.singleton r) - f True r = (S.singleton r, mempty) - (tyLinks, tmLinks) = valueLinks f val - -reifyValue0 :: - (M.Map Reference Word64, M.Map Reference Word64) -> - ANF.Value -> - IO Closure -reifyValue0 (rty, rtm) = goV - where - err s = "reifyValue: cannot restore value: " ++ s - refTy r - | Just w <- M.lookup r rty = pure w - | otherwise = die . err $ "unknown type reference: " ++ show r - refTm r - | Just w <- M.lookup r rtm = pure w - | otherwise = die . err $ "unknown term reference: " ++ show r - goIx (ANF.GR r i) = refTm r <&> \n -> CIx r n i - - goV (ANF.Partial gr ua ba) = - pap <$> (goIx gr) <*> traverse goV ba - where - pap i = PApV i (fromIntegral <$> ua) - goV (ANF.Data r t0 us bs) = do - t <- flip packTags (fromIntegral t0) . fromIntegral <$> refTy r - DataC r t (fromIntegral <$> us) <$> traverse goV bs - goV (ANF.Cont us bs k) = cv <$> goK k <*> traverse goV bs - where - cv k bs = CapV k ua ba (fromIntegral <$> us) bs - where - (uksz, bksz) = frameDataSize k - ua = fromIntegral $ length us - uksz - ba = fromIntegral $ length bs - bksz - goV (ANF.BLit l) = goL l - - goK ANF.KE = pure KE - goK (ANF.Mark ua ba ps de k) = - mrk - <$> traverse refTy ps - <*> traverse (\(k, v) -> (,) <$> refTy k <*> goV v) (M.toList de) - <*> goK k - where - mrk ps de k = - Mark (fromIntegral ua) (fromIntegral ba) (setFromList ps) (mapFromList de) k - goK (ANF.Push uf bf ua ba gr k) = - Push - (fromIntegral uf) - (fromIntegral bf) - (fromIntegral ua) - (fromIntegral ba) - <$> (goIx gr) - <*> goK k - - goL (ANF.Text t) = pure . Foreign $ Wrap Rf.textRef t - goL (ANF.List l) = Foreign . Wrap Rf.listRef <$> traverse goV l - goL (ANF.TmLink r) = pure . Foreign $ Wrap Rf.termLinkRef r - goL (ANF.TyLink r) = pure . Foreign $ Wrap Rf.typeLinkRef r - goL (ANF.Bytes b) = pure . Foreign $ Wrap Rf.bytesRef b - goL (ANF.Quote v) = pure . Foreign $ Wrap Rf.valueRef v - goL (ANF.Code g) = pure . Foreign $ Wrap Rf.codeRef g - goL (ANF.BArr a) = pure . Foreign $ Wrap Rf.ibytearrayRef a - goL (ANF.Char c) = pure $ DataU1 Rf.charRef charTag (fromEnum c) - goL (ANF.Pos w) = - pure $ DataU1 Rf.natRef natTag (fromIntegral w) - goL (ANF.Neg w) = - pure $ DataU1 Rf.intRef intTag (-fromIntegral w) - goL (ANF.Float d) = - pure $ DataU1 Rf.floatRef floatTag (doubleToInt d) - goL (ANF.Arr a) = Foreign . Wrap Rf.iarrayRef <$> traverse goV a - -doubleToInt :: Double -> Int -doubleToInt d = indexByteArray (BA.byteArrayFromList [d]) 0 - -intToDouble :: Int -> Double -intToDouble w = indexByteArray (BA.byteArrayFromList [w]) 0 - --- Universal comparison functions - -closureNum :: Closure -> Int -closureNum PAp {} = 0 -closureNum DataC {} = 1 -closureNum Captured {} = 2 -closureNum Foreign {} = 3 -closureNum BlackHole {} = error "BlackHole" - -universalEq :: - (Foreign -> Foreign -> Bool) -> - Closure -> - Closure -> - Bool -universalEq frn = eqc - where - eql cm l r = length l == length r && and (zipWith cm l r) - eqc (DataC _ ct1 [w1] []) (DataC _ ct2 [w2] []) = - matchTags ct1 ct2 && w1 == w2 - eqc (DataC _ ct1 us1 bs1) (DataC _ ct2 us2 bs2) = - ct1 == ct2 - && eql (==) us1 us2 - && eql eqc bs1 bs2 - eqc (PApV i1 us1 bs1) (PApV i2 us2 bs2) = - i1 == i2 - && eql (==) us1 us2 - && eql eqc bs1 bs2 - eqc (CapV k1 ua1 ba1 us1 bs1) (CapV k2 ua2 ba2 us2 bs2) = - k1 == k2 - && ua1 == ua2 - && ba1 == ba2 - && eql (==) us1 us2 - && eql eqc bs1 bs2 - eqc (Foreign fl) (Foreign fr) - | Just al <- maybeUnwrapForeign Rf.iarrayRef fl, - Just ar <- maybeUnwrapForeign Rf.iarrayRef fr = - arrayEq eqc al ar - | Just sl <- maybeUnwrapForeign Rf.listRef fl, - Just sr <- maybeUnwrapForeign Rf.listRef fr = - length sl == length sr && and (Sq.zipWith eqc sl sr) - | otherwise = frn fl fr - eqc c d = closureNum c == closureNum d - - -- serialization doesn't necessarily preserve Int tags, so be - -- more accepting for those. - matchTags ct1 ct2 = - ct1 == ct2 - || (ct1 == intTag && ct2 == natTag) - || (ct1 == natTag && ct2 == intTag) - -arrayEq :: (Closure -> Closure -> Bool) -> PA.Array Closure -> PA.Array Closure -> Bool -arrayEq eqc l r - | PA.sizeofArray l /= PA.sizeofArray r = False - | otherwise = go (PA.sizeofArray l - 1) - where - go i - | i < 0 = True - | otherwise = eqc (PA.indexArray l i) (PA.indexArray r i) && go (i - 1) - --- IEEE floating point layout is such that comparison as integers --- somewhat works. Positive floating values map to positive integers --- and negatives map to negatives. The corner cases are: --- --- 1. If both numbers are negative, ordering is flipped. --- 2. There is both +0 and -0, with -0 being represented as the --- minimum signed integer. --- 3. NaN does weird things. --- --- So, the strategy here is to compare normally if one argument is --- positive, since positive numbers compare normally to others. --- Otherwise, the sign bit is cleared and the numbers are compared --- backwards. Clearing the sign bit maps -0 to +0 and maps a negative --- number to its absolute value (including infinities). The multiple --- NaN values are just handled according to bit patterns, rather than --- IEEE specified behavior. --- --- Transitivity is somewhat non-obvious for this implementation. --- --- if i <= j and j <= k --- if j > 0 then k > 0, so all 3 comparisons use `compare` --- if k > 0 then k > i, since i <= j <= 0 --- if all 3 are <= 0, all 3 comparisons use the alternate --- comparison, which is transitive via `compare` -compareAsFloat :: Int -> Int -> Ordering -compareAsFloat i j - | i > 0 || j > 0 = compare i j - | otherwise = compare (clear j) (clear i) - where - clear k = clearBit k 64 - -compareAsNat :: Int -> Int -> Ordering -compareAsNat i j = compare ni nj - where - ni, nj :: Word - ni = fromIntegral i - nj = fromIntegral j - -floatTag :: Word64 -floatTag - | Just n <- M.lookup Rf.floatRef builtinTypeNumbering, - rt <- toEnum (fromIntegral n) = - packTags rt 0 - | otherwise = error "internal error: floatTag" - -natTag :: Word64 -natTag - | Just n <- M.lookup Rf.natRef builtinTypeNumbering, - rt <- toEnum (fromIntegral n) = - packTags rt 0 - | otherwise = error "internal error: natTag" - -intTag :: Word64 -intTag - | Just n <- M.lookup Rf.intRef builtinTypeNumbering, - rt <- toEnum (fromIntegral n) = - packTags rt 0 - | otherwise = error "internal error: intTag" - -charTag :: Word64 -charTag - | Just n <- M.lookup Rf.charRef builtinTypeNumbering, - rt <- toEnum (fromIntegral n) = - packTags rt 0 - | otherwise = error "internal error: charTag" - -unitTag :: Word64 -unitTag - | Just n <- M.lookup Rf.unitRef builtinTypeNumbering, - rt <- toEnum (fromIntegral n) = - packTags rt 0 - | otherwise = error "internal error: unitTag" - -leftTag, rightTag :: Word64 -(leftTag, rightTag) - | Just n <- M.lookup Rf.eitherRef builtinTypeNumbering, - et <- toEnum (fromIntegral n), - lt <- toEnum (fromIntegral Rf.eitherLeftId), - rt <- toEnum (fromIntegral Rf.eitherRightId) = - (packTags et lt, packTags et rt) - | otherwise = error "internal error: either tags" - -universalCompare :: - (Foreign -> Foreign -> Ordering) -> - Closure -> - Closure -> - Ordering -universalCompare frn = cmpc False - where - cmpl cm l r = - compare (length l) (length r) <> fold (zipWith cm l r) - cmpc _ (DataC _ ct1 [i] []) (DataC _ ct2 [j] []) - | ct1 == floatTag, ct2 == floatTag = compareAsFloat i j - | ct1 == natTag, ct2 == natTag = compareAsNat i j - | ct1 == intTag, ct2 == natTag = compare i j - | ct1 == natTag, ct2 == intTag = compare i j - cmpc tyEq (DataC rf1 ct1 us1 bs1) (DataC rf2 ct2 us2 bs2) = - (if tyEq && ct1 /= ct2 then compare rf1 rf2 else EQ) - <> compare (maskTags ct1) (maskTags ct2) - <> cmpl compare us1 us2 - -- when comparing corresponding `Any` values, which have - -- existentials inside check that type references match - <> cmpl (cmpc $ tyEq || rf1 == Rf.anyRef) bs1 bs2 - cmpc tyEq (PApV i1 us1 bs1) (PApV i2 us2 bs2) = - compare i1 i2 - <> cmpl compare us1 us2 - <> cmpl (cmpc tyEq) bs1 bs2 - cmpc _ (CapV k1 ua1 ba1 us1 bs1) (CapV k2 ua2 ba2 us2 bs2) = - compare k1 k2 - <> compare ua1 ua2 - <> compare ba1 ba2 - <> cmpl compare us1 us2 - <> cmpl (cmpc True) bs1 bs2 - cmpc tyEq (Foreign fl) (Foreign fr) - | Just sl <- maybeUnwrapForeign Rf.listRef fl, - Just sr <- maybeUnwrapForeign Rf.listRef fr = - fold (Sq.zipWith (cmpc tyEq) sl sr) - <> compare (length sl) (length sr) - | Just al <- maybeUnwrapForeign Rf.iarrayRef fl, - Just ar <- maybeUnwrapForeign Rf.iarrayRef fr = - arrayCmp (cmpc tyEq) al ar - | otherwise = frn fl fr - cmpc _ c d = comparing closureNum c d - -arrayCmp :: - (Closure -> Closure -> Ordering) -> - PA.Array Closure -> - PA.Array Closure -> - Ordering -arrayCmp cmpc l r = - comparing PA.sizeofArray l r <> go (PA.sizeofArray l - 1) - where - go i - | i < 0 = EQ - | otherwise = cmpc (PA.indexArray l i) (PA.indexArray r i) <> go (i - 1) diff --git a/parser-typechecker/src/Unison/Runtime/Serialize.hs b/parser-typechecker/src/Unison/Runtime/Serialize.hs deleted file mode 100644 index 064200cd55..0000000000 --- a/parser-typechecker/src/Unison/Runtime/Serialize.hs +++ /dev/null @@ -1,527 +0,0 @@ -{-# LANGUAGE PatternSynonyms #-} - -module Unison.Runtime.Serialize where - -import Control.Monad (replicateM) -import Data.Bits (Bits) -import Data.ByteString qualified as B -import Data.Bytes.Get hiding (getBytes) -import Data.Bytes.Get qualified as Ser -import Data.Bytes.Put -import Data.Bytes.Serial -import Data.Bytes.Signed (Unsigned) -import Data.Bytes.VarInt -import Data.Foldable (traverse_) -import Data.Int (Int64) -import Data.Map.Strict as Map (Map, fromList, toList) -import Data.Primitive qualified as PA -import Data.Text (Text) -import Data.Text.Encoding (decodeUtf8, encodeUtf8) -import Data.Vector.Primitive qualified as BA -import Data.Word (Word64, Word8) -import GHC.Exts as IL (IsList (..)) -import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) -import Unison.ConstructorType qualified as CT -import Unison.Hash (Hash) -import Unison.Hash qualified as Hash -import Unison.Reference (Id' (..), Reference, Reference' (Builtin, DerivedId), pattern Derived) -import Unison.Referent (Referent, pattern Con, pattern Ref) -import Unison.Runtime.Exception -import Unison.Runtime.MCode - ( BPrim1 (..), - BPrim2 (..), - UPrim1 (..), - UPrim2 (..), - ) -import Unison.Util.Bytes qualified as Bytes -import Unison.Util.EnumContainers as EC - -unknownTag :: (MonadGet m) => String -> Word8 -> m a -unknownTag t w = - remaining >>= \r -> - exn $ - "unknown " - ++ t - ++ " word: " - ++ show w - ++ " (" - ++ show (fromIntegral @_ @Int r) - ++ " bytes remaining)" - -class Tag t where - tag2word :: t -> Word8 - word2tag :: (MonadGet m) => Word8 -> m t - -putTag :: (MonadPut m) => (Tag t) => t -> m () -putTag = putWord8 . tag2word - -getTag :: (MonadGet m) => (Tag t) => m t -getTag = word2tag =<< getWord8 - --- Some basics, moved over from V1 serialization -putChar :: (MonadPut m) => Char -> m () -putChar = serialize . VarInt . fromEnum - -getChar :: (MonadGet m) => m Char -getChar = toEnum . unVarInt <$> deserialize - -putFloat :: (MonadPut m) => Double -> m () -putFloat = serializeBE - -getFloat :: (MonadGet m) => m Double -getFloat = deserializeBE - -putBool :: (MonadPut m) => Bool -> m () -putBool b = putWord8 (if b then 1 else 0) - -getBool :: (MonadGet m) => m Bool -getBool = d =<< getWord8 - where - d 0 = pure False - d 1 = pure True - d n = exn $ "getBool: bad tag: " ++ show n - -putNat :: (MonadPut m) => Word64 -> m () -putNat = putWord64be - -getNat :: (MonadGet m) => m Word64 -getNat = getWord64be - -putInt :: (MonadPut m) => Int64 -> m () -putInt = serializeBE - -getInt :: (MonadGet m) => m Int64 -getInt = deserializeBE - -putLength :: - ( MonadPut m, - Integral n, - Integral (Unsigned n), - Bits n, - Bits (Unsigned n) - ) => - n -> - m () -putLength = serialize . VarInt - -getLength :: - ( MonadGet m, - Integral n, - Integral (Unsigned n), - Bits n, - Bits (Unsigned n) - ) => - m n -getLength = unVarInt <$> deserialize - --- Checks for negatives, in case you put an Integer, which does not --- behave properly for negative numbers. -putPositive :: - (MonadPut m, Bits n, Bits (Unsigned n), Integral n, Integral (Unsigned n)) => - n -> - m () -putPositive n - | n < 0 = exn $ "putPositive: negative number: " ++ show (toInteger n) - | otherwise = serialize (VarInt n) - --- Reads as an Integer, then checks that the result will fit in the --- result type. -getPositive :: forall m n. (Bounded n, Integral n, MonadGet m) => m n -getPositive = validate . unVarInt =<< deserialize - where - mx0 :: n - mx0 = maxBound - mx :: Integer - mx = fromIntegral mx0 - - validate :: Integer -> m n - validate n - | n <= mx = pure $ fromIntegral n - | otherwise = fail $ "getPositive: overflow: " ++ show n - -putFoldable :: - (Foldable f, MonadPut m) => (a -> m ()) -> f a -> m () -putFoldable putA as = do - putLength (length as) - traverse_ putA as - -putMap :: (MonadPut m) => (a -> m ()) -> (b -> m ()) -> Map a b -> m () -putMap putA putB m = putFoldable (putPair putA putB) (Map.toList m) - -getList :: (MonadGet m) => m a -> m [a] -getList a = getLength >>= (`replicateM` a) - -getMap :: (MonadGet m, Ord a) => m a -> m b -> m (Map a b) -getMap getA getB = Map.fromList <$> getList (getPair getA getB) - -putEnumMap :: - (MonadPut m) => - (EnumKey k) => - (k -> m ()) -> - (v -> m ()) -> - EnumMap k v -> - m () -putEnumMap pk pv m = putFoldable (putPair pk pv) (mapToList m) - -getEnumMap :: (MonadGet m) => (EnumKey k) => m k -> m v -> m (EnumMap k v) -getEnumMap gk gv = mapFromList <$> getList (getPair gk gv) - -putEnumSet :: (MonadPut m) => (EnumKey k) => (k -> m ()) -> EnumSet k -> m () -putEnumSet pk s = putLength (setSize s) *> traverseSet_ pk s - -getEnumSet :: (MonadGet m) => (EnumKey k) => m k -> m (EnumSet k) -getEnumSet gk = setFromList <$> getList gk - -putMaybe :: (MonadPut m) => Maybe a -> (a -> m ()) -> m () -putMaybe Nothing _ = putWord8 0 -putMaybe (Just a) putA = putWord8 1 *> putA a - -getMaybe :: (MonadGet m) => m a -> m (Maybe a) -getMaybe getA = - getWord8 >>= \tag -> case tag of - 0 -> pure Nothing - 1 -> Just <$> getA - _ -> unknownTag "Maybe" tag - -putPair :: (MonadPut m) => (a -> m ()) -> (b -> m ()) -> (a, b) -> m () -putPair putA putB (a, b) = putA a *> putB b - -getPair :: (MonadGet m) => m a -> m b -> m (a, b) -getPair = liftA2 (,) - -getBytes :: (MonadGet m) => m Bytes.Bytes -getBytes = Bytes.fromChunks <$> getList getBlock - -putBytes :: (MonadPut m) => Bytes.Bytes -> m () -putBytes = putFoldable putBlock . Bytes.chunks - -getByteArray :: (MonadGet m) => m PA.ByteArray -getByteArray = PA.byteArrayFromList <$> getList getWord8 - -putByteArray :: (MonadPut m) => PA.ByteArray -> m () -putByteArray a = putFoldable putWord8 (IL.toList a) - -getBlock :: (MonadGet m) => m Bytes.Chunk -getBlock = getLength >>= fmap Bytes.byteStringToChunk . getByteString - -putBlock :: (MonadPut m) => Bytes.Chunk -> m () -putBlock b = putLength (BA.length b) *> putByteString (Bytes.chunkToByteString b) - -putHash :: (MonadPut m) => Hash -> m () -putHash h = do - let bs = Hash.toByteString h - putLength (B.length bs) - putByteString bs - -getHash :: (MonadGet m) => m Hash -getHash = do - len <- getLength - bs <- B.copy <$> Ser.getBytes len - pure $ Hash.fromByteString bs - -putReferent :: (MonadPut m) => Referent -> m () -putReferent = \case - Ref r -> do - putWord8 0 - putReference r - Con r ct -> do - putWord8 1 - putConstructorReference r - putConstructorType ct - -getReferent :: (MonadGet m) => m Referent -getReferent = do - tag <- getWord8 - case tag of - 0 -> Ref <$> getReference - 1 -> Con <$> getConstructorReference <*> getConstructorType - _ -> unknownTag "getReferent" tag - -getConstructorType :: (MonadGet m) => m CT.ConstructorType -getConstructorType = - getWord8 >>= \case - 0 -> pure CT.Data - 1 -> pure CT.Effect - t -> unknownTag "getConstructorType" t - -putConstructorType :: (MonadPut m) => CT.ConstructorType -> m () -putConstructorType = \case - CT.Data -> putWord8 0 - CT.Effect -> putWord8 1 - -putText :: (MonadPut m) => Text -> m () -putText text = do - let bs = encodeUtf8 text - putLength $ B.length bs - putByteString bs - -getText :: (MonadGet m) => m Text -getText = do - len <- getLength - bs <- B.copy <$> Ser.getBytes len - pure $ decodeUtf8 bs - -putReference :: (MonadPut m) => Reference -> m () -putReference r = case r of - Builtin name -> do - putWord8 0 - putText name - Derived hash i -> do - putWord8 1 - putHash hash - putLength i - -getReference :: (MonadGet m) => m Reference -getReference = do - tag <- getWord8 - case tag of - 0 -> Builtin <$> getText - 1 -> DerivedId <$> (Id <$> getHash <*> getLength) - _ -> unknownTag "Reference" tag - -putConstructorReference :: (MonadPut m) => ConstructorReference -> m () -putConstructorReference (ConstructorReference r i) = do - putReference r - putLength i - -getConstructorReference :: (MonadGet m) => m ConstructorReference -getConstructorReference = - ConstructorReference <$> getReference <*> getLength - -instance Tag UPrim1 where - tag2word DECI = 0 - tag2word INCI = 1 - tag2word NEGI = 2 - tag2word SGNI = 3 - tag2word LZRO = 4 - tag2word TZRO = 5 - tag2word COMN = 6 - tag2word POPC = 7 - tag2word ABSF = 8 - tag2word EXPF = 9 - tag2word LOGF = 10 - tag2word SQRT = 11 - tag2word COSF = 12 - tag2word ACOS = 13 - tag2word COSH = 14 - tag2word ACSH = 15 - tag2word SINF = 16 - tag2word ASIN = 17 - tag2word SINH = 18 - tag2word ASNH = 19 - tag2word TANF = 20 - tag2word ATAN = 21 - tag2word TANH = 22 - tag2word ATNH = 23 - tag2word ITOF = 24 - tag2word NTOF = 25 - tag2word CEIL = 26 - tag2word FLOR = 27 - tag2word TRNF = 28 - tag2word RNDF = 29 - - word2tag 0 = pure DECI - word2tag 1 = pure INCI - word2tag 2 = pure NEGI - word2tag 3 = pure SGNI - word2tag 4 = pure LZRO - word2tag 5 = pure TZRO - word2tag 6 = pure COMN - word2tag 7 = pure POPC - word2tag 8 = pure ABSF - word2tag 9 = pure EXPF - word2tag 10 = pure LOGF - word2tag 11 = pure SQRT - word2tag 12 = pure COSF - word2tag 13 = pure ACOS - word2tag 14 = pure COSH - word2tag 15 = pure ACSH - word2tag 16 = pure SINF - word2tag 17 = pure ASIN - word2tag 18 = pure SINH - word2tag 19 = pure ASNH - word2tag 20 = pure TANF - word2tag 21 = pure ATAN - word2tag 22 = pure TANH - word2tag 23 = pure ATNH - word2tag 24 = pure ITOF - word2tag 25 = pure NTOF - word2tag 26 = pure CEIL - word2tag 27 = pure FLOR - word2tag 28 = pure TRNF - word2tag 29 = pure RNDF - word2tag n = unknownTag "UPrim1" n - -instance Tag UPrim2 where - tag2word ADDI = 0 - tag2word SUBI = 1 - tag2word MULI = 2 - tag2word DIVI = 3 - tag2word MODI = 4 - tag2word DIVN = 5 - tag2word MODN = 6 - tag2word SHLI = 7 - tag2word SHRI = 8 - tag2word SHRN = 9 - tag2word POWI = 10 - tag2word EQLI = 11 - tag2word LEQI = 12 - tag2word LEQN = 13 - tag2word ANDN = 14 - tag2word IORN = 15 - tag2word XORN = 16 - tag2word EQLF = 17 - tag2word LEQF = 18 - tag2word ADDF = 19 - tag2word SUBF = 20 - tag2word MULF = 21 - tag2word DIVF = 22 - tag2word ATN2 = 23 - tag2word POWF = 24 - tag2word LOGB = 25 - tag2word MAXF = 26 - tag2word MINF = 27 - - word2tag 0 = pure ADDI - word2tag 1 = pure SUBI - word2tag 2 = pure MULI - word2tag 3 = pure DIVI - word2tag 4 = pure MODI - word2tag 5 = pure DIVN - word2tag 6 = pure MODN - word2tag 7 = pure SHLI - word2tag 8 = pure SHRI - word2tag 9 = pure SHRN - word2tag 10 = pure POWI - word2tag 11 = pure EQLI - word2tag 12 = pure LEQI - word2tag 13 = pure LEQN - word2tag 14 = pure ANDN - word2tag 15 = pure IORN - word2tag 16 = pure XORN - word2tag 17 = pure EQLF - word2tag 18 = pure LEQF - word2tag 19 = pure ADDF - word2tag 20 = pure SUBF - word2tag 21 = pure MULF - word2tag 22 = pure DIVF - word2tag 23 = pure ATN2 - word2tag 24 = pure POWF - word2tag 25 = pure LOGB - word2tag 26 = pure MAXF - word2tag 27 = pure MINF - word2tag n = unknownTag "UPrim2" n - -instance Tag BPrim1 where - tag2word SIZT = 0 - tag2word USNC = 1 - tag2word UCNS = 2 - tag2word ITOT = 3 - tag2word NTOT = 4 - tag2word FTOT = 5 - tag2word TTOI = 6 - tag2word TTON = 7 - tag2word TTOF = 8 - tag2word PAKT = 9 - tag2word UPKT = 10 - tag2word VWLS = 11 - tag2word VWRS = 12 - tag2word SIZS = 13 - tag2word PAKB = 14 - tag2word UPKB = 15 - tag2word SIZB = 16 - tag2word FLTB = 17 - tag2word MISS = 18 - tag2word CACH = 19 - tag2word LKUP = 20 - tag2word LOAD = 21 - tag2word CVLD = 22 - tag2word VALU = 23 - tag2word TLTT = 24 - tag2word DBTX = 25 - tag2word SDBL = 26 - - word2tag 0 = pure SIZT - word2tag 1 = pure USNC - word2tag 2 = pure UCNS - word2tag 3 = pure ITOT - word2tag 4 = pure NTOT - word2tag 5 = pure FTOT - word2tag 6 = pure TTOI - word2tag 7 = pure TTON - word2tag 8 = pure TTOF - word2tag 9 = pure PAKT - word2tag 10 = pure UPKT - word2tag 11 = pure VWLS - word2tag 12 = pure VWRS - word2tag 13 = pure SIZS - word2tag 14 = pure PAKB - word2tag 15 = pure UPKB - word2tag 16 = pure SIZB - word2tag 17 = pure FLTB - word2tag 18 = pure MISS - word2tag 19 = pure CACH - word2tag 20 = pure LKUP - word2tag 21 = pure LOAD - word2tag 22 = pure CVLD - word2tag 23 = pure VALU - word2tag 24 = pure TLTT - word2tag 25 = pure DBTX - word2tag 26 = pure SDBL - word2tag n = unknownTag "BPrim1" n - -instance Tag BPrim2 where - tag2word EQLU = 0 - tag2word CMPU = 1 - tag2word DRPT = 2 - tag2word CATT = 3 - tag2word TAKT = 4 - tag2word EQLT = 5 - tag2word LEQT = 6 - tag2word LEST = 7 - tag2word DRPS = 8 - tag2word CATS = 9 - tag2word TAKS = 10 - tag2word CONS = 11 - tag2word SNOC = 12 - tag2word IDXS = 13 - tag2word SPLL = 14 - tag2word SPLR = 15 - tag2word TAKB = 16 - tag2word DRPB = 17 - tag2word IDXB = 18 - tag2word CATB = 19 - tag2word THRO = 20 - tag2word TRCE = 21 - tag2word SDBX = 22 - tag2word IXOT = 23 - tag2word IXOB = 24 - tag2word SDBV = 25 - - word2tag 0 = pure EQLU - word2tag 1 = pure CMPU - word2tag 2 = pure DRPT - word2tag 3 = pure CATT - word2tag 4 = pure TAKT - word2tag 5 = pure EQLT - word2tag 6 = pure LEQT - word2tag 7 = pure LEST - word2tag 8 = pure DRPS - word2tag 9 = pure CATS - word2tag 10 = pure TAKS - word2tag 11 = pure CONS - word2tag 12 = pure SNOC - word2tag 13 = pure IDXS - word2tag 14 = pure SPLL - word2tag 15 = pure SPLR - word2tag 16 = pure TAKB - word2tag 17 = pure DRPB - word2tag 18 = pure IDXB - word2tag 19 = pure CATB - word2tag 20 = pure THRO - word2tag 21 = pure TRCE - word2tag 22 = pure SDBX - word2tag 23 = pure IXOT - word2tag 24 = pure IXOB - word2tag 25 = pure SDBV - word2tag n = unknownTag "BPrim2" n diff --git a/parser-typechecker/src/Unison/Runtime/Stack.hs b/parser-typechecker/src/Unison/Runtime/Stack.hs deleted file mode 100644 index ebfe67f85a..0000000000 --- a/parser-typechecker/src/Unison/Runtime/Stack.hs +++ /dev/null @@ -1,725 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ViewPatterns #-} - -module Unison.Runtime.Stack - ( K (..), - Closure (.., DataC, PApV, CapV), - Callback (..), - Augment (..), - Dump (..), - MEM (..), - Stack (..), - Off, - SZ, - FP, - traceK, - frameDataSize, - marshalToForeign, - unull, - bnull, - peekD, - peekOffD, - pokeD, - pokeOffD, - peekN, - peekOffN, - pokeN, - pokeOffN, - peekBi, - peekOffBi, - pokeBi, - pokeOffBi, - peekOffS, - pokeS, - pokeOffS, - frameView, - uscount, - bscount, - closureTermRefs, - ) -where - -import Control.Monad (when) -import Control.Monad.Primitive -import Data.Foldable as F (for_) -import Data.Kind qualified as Kind -import Data.Sequence (Seq) -import Data.Word -import GHC.Exts as L (IsList (..)) -import GHC.Stack (HasCallStack) -import Unison.Reference (Reference) -import Unison.Runtime.ANF as ANF (Mem (..)) -import Unison.Runtime.Array -import Unison.Runtime.Foreign -import Unison.Runtime.MCode -import Unison.Type qualified as Ty -import Unison.Util.EnumContainers as EC -import Prelude hiding (words) - -newtype Callback = Hook (Stack 'UN -> Stack 'BX -> IO ()) - -instance Eq Callback where _ == _ = True - -instance Ord Callback where compare _ _ = EQ - --- Evaluation stack -data K - = KE - | -- callback hook - CB Callback - | -- mark continuation with a prompt - Mark - !Int -- pending unboxed args - !Int -- pending boxed args - !(EnumSet Word64) - !(EnumMap Word64 Closure) - !K - | -- save information about a frame for later resumption - Push - !Int -- unboxed frame size - !Int -- boxed frame size - !Int -- pending unboxed args - !Int -- pending boxed args - !CombIx -- local continuation reference - !K - deriving (Eq, Ord) - -data Closure - = PAp - {-# UNPACK #-} !CombIx -- reference - {-# UNPACK #-} !(Seg 'UN) -- unboxed args - {- unpack -} - !(Seg 'BX) -- boxed args - | Enum !Reference !Word64 - | DataU1 !Reference !Word64 !Int - | DataU2 !Reference !Word64 !Int !Int - | DataB1 !Reference !Word64 !Closure - | DataB2 !Reference !Word64 !Closure !Closure - | DataUB !Reference !Word64 !Int !Closure - | DataG !Reference !Word64 !(Seg 'UN) !(Seg 'BX) - | -- code cont, u/b arg size, u/b data stacks - Captured !K !Int !Int {-# UNPACK #-} !(Seg 'UN) !(Seg 'BX) - | Foreign !Foreign - | BlackHole - deriving (Show, Eq, Ord) - -traceK :: Reference -> K -> [(Reference, Int)] -traceK begin = dedup (begin, 1) - where - dedup p (Mark _ _ _ _ k) = dedup p k - dedup p@(cur, n) (Push _ _ _ _ (CIx r _ _) k) - | cur == r = dedup (cur, 1 + n) k - | otherwise = p : dedup (r, 1) k - dedup p _ = [p] - -splitData :: Closure -> Maybe (Reference, Word64, [Int], [Closure]) -splitData (Enum r t) = Just (r, t, [], []) -splitData (DataU1 r t i) = Just (r, t, [i], []) -splitData (DataU2 r t i j) = Just (r, t, [i, j], []) -splitData (DataB1 r t x) = Just (r, t, [], [x]) -splitData (DataB2 r t x y) = Just (r, t, [], [x, y]) -splitData (DataUB r t i y) = Just (r, t, [i], [y]) -splitData (DataG r t us bs) = Just (r, t, ints us, bsegToList bs) -splitData _ = Nothing - --- | Converts an unboxed segment to a list of integers for a more interchangeable --- representation. The segments are stored in backwards order, so this reverses --- the contents. -ints :: ByteArray -> [Int] -ints ba = fmap (indexByteArray ba) [n - 1, n - 2 .. 0] - where - n = sizeofByteArray ba `div` 8 - --- | Converts a list of integers representing an unboxed segment back into the --- appropriate segment. Segments are stored backwards in the runtime, so this --- reverses the list. -useg :: [Int] -> Seg 'UN -useg ws = case L.fromList $ reverse ws of - PrimArray ba -> ByteArray ba - --- | Converts a boxed segment to a list of closures. The segments are stored --- backwards, so this reverses the contents. -bsegToList :: Seg 'BX -> [Closure] -bsegToList = reverse . L.toList - --- | Converts a list of closures back to a boxed segment. Segments are stored --- backwards, so this reverses the contents. -bseg :: [Closure] -> Seg 'BX -bseg = L.fromList . reverse - -formData :: Reference -> Word64 -> [Int] -> [Closure] -> Closure -formData r t [] [] = Enum r t -formData r t [i] [] = DataU1 r t i -formData r t [i, j] [] = DataU2 r t i j -formData r t [] [x] = DataB1 r t x -formData r t [] [x, y] = DataB2 r t x y -formData r t [i] [x] = DataUB r t i x -formData r t us bs = DataG r t (useg us) (bseg bs) - -frameDataSize :: K -> (Int, Int) -frameDataSize = go 0 0 - where - go usz bsz KE = (usz, bsz) - go usz bsz (CB _) = (usz, bsz) - go usz bsz (Mark ua ba _ _ k) = go (usz + ua) (bsz + ba) k - go usz bsz (Push uf bf ua ba _ k) = go (usz + uf + ua) (bsz + bf + ba) k - -pattern DataC :: Reference -> Word64 -> [Int] -> [Closure] -> Closure -pattern DataC rf ct us bs <- - (splitData -> Just (rf, ct, us, bs)) - where - DataC rf ct us bs = formData rf ct us bs - -pattern PApV :: CombIx -> [Int] -> [Closure] -> Closure -pattern PApV ic us bs <- - PAp ic (ints -> us) (bsegToList -> bs) - where - PApV ic us bs = PAp ic (useg us) (bseg bs) - -pattern CapV :: K -> Int -> Int -> [Int] -> [Closure] -> Closure -pattern CapV k ua ba us bs <- - Captured k ua ba (ints -> us) (bsegToList -> bs) - where - CapV k ua ba us bs = Captured k ua ba (useg us) (bseg bs) - -{-# COMPLETE DataC, PAp, Captured, Foreign, BlackHole #-} - -{-# COMPLETE DataC, PApV, Captured, Foreign, BlackHole #-} - -{-# COMPLETE DataC, PApV, CapV, Foreign, BlackHole #-} - -marshalToForeign :: (HasCallStack) => Closure -> Foreign -marshalToForeign (Foreign x) = x -marshalToForeign c = - error $ "marshalToForeign: unhandled closure: " ++ show c - -type Off = Int - -type SZ = Int - -type FP = Int - -type UA = MutableByteArray (PrimState IO) - -type BA = MutableArray (PrimState IO) Closure - -words :: Int -> Int -words n = n `div` 8 - -bytes :: Int -> Int -bytes n = n * 8 - -uargOnto :: UA -> Off -> UA -> Off -> Args' -> IO Int -uargOnto stk sp cop cp0 (Arg1 i) = do - (x :: Int) <- readByteArray stk (sp - i) - writeByteArray cop cp x - pure cp - where - cp = cp0 + 1 -uargOnto stk sp cop cp0 (Arg2 i j) = do - (x :: Int) <- readByteArray stk (sp - i) - (y :: Int) <- readByteArray stk (sp - j) - writeByteArray cop cp x - writeByteArray cop (cp - 1) y - pure cp - where - cp = cp0 + 2 -uargOnto stk sp cop cp0 (ArgN v) = do - buf <- - if overwrite - then newByteArray $ bytes sz - else pure cop - let loop i - | i < 0 = return () - | otherwise = do - (x :: Int) <- readByteArray stk (sp - indexPrimArray v i) - writeByteArray buf (boff - i) x - loop $ i - 1 - loop $ sz - 1 - when overwrite $ - copyMutableByteArray cop (bytes $ cp + 1) buf 0 (bytes sz) - pure cp - where - cp = cp0 + sz - sz = sizeofPrimArray v - overwrite = sameMutableByteArray stk cop - boff | overwrite = sz - 1 | otherwise = cp0 + sz -uargOnto stk sp cop cp0 (ArgR i l) = do - moveByteArray cop cbp stk sbp (bytes l) - pure $ cp0 + l - where - cbp = bytes $ cp0 + 1 - sbp = bytes $ sp - i - l + 1 - -bargOnto :: BA -> Off -> BA -> Off -> Args' -> IO Int -bargOnto stk sp cop cp0 (Arg1 i) = do - x <- readArray stk (sp - i) - writeArray cop cp x - pure cp - where - cp = cp0 + 1 -bargOnto stk sp cop cp0 (Arg2 i j) = do - x <- readArray stk (sp - i) - y <- readArray stk (sp - j) - writeArray cop cp x - writeArray cop (cp - 1) y - pure cp - where - cp = cp0 + 2 -bargOnto stk sp cop cp0 (ArgN v) = do - buf <- - if overwrite - then newArray sz BlackHole - else pure cop - let loop i - | i < 0 = return () - | otherwise = do - x <- readArray stk $ sp - indexPrimArray v i - writeArray buf (boff - i) x - loop $ i - 1 - loop $ sz - 1 - - when overwrite $ - copyMutableArray cop (cp0 + 1) buf 0 sz - pure cp - where - cp = cp0 + sz - sz = sizeofPrimArray v - overwrite = stk == cop - boff | overwrite = sz - 1 | otherwise = cp0 + sz -bargOnto stk sp cop cp0 (ArgR i l) = do - copyMutableArray cop (cp0 + 1) stk (sp - i - l + 1) l - pure $ cp0 + l - -data Dump = A | F Int Int | S - -dumpAP :: Int -> Int -> Int -> Dump -> Int -dumpAP _ fp sz d@(F _ a) = dumpFP fp sz d - a -dumpAP ap _ _ _ = ap - -dumpFP :: Int -> Int -> Dump -> Int -dumpFP fp _ S = fp -dumpFP fp sz A = fp + sz -dumpFP fp sz (F n _) = fp + sz - n - --- closure augmentation mode --- instruction, kontinuation, call -data Augment = I | K | C - -class MEM (b :: Mem) where - data Stack b :: Kind.Type - type Elem b :: Kind.Type - type Seg b :: Kind.Type - alloc :: IO (Stack b) - peek :: Stack b -> IO (Elem b) - peekOff :: Stack b -> Off -> IO (Elem b) - poke :: Stack b -> Elem b -> IO () - pokeOff :: Stack b -> Off -> Elem b -> IO () - grab :: Stack b -> SZ -> IO (Seg b, Stack b) - ensure :: Stack b -> SZ -> IO (Stack b) - bump :: Stack b -> IO (Stack b) - bumpn :: Stack b -> SZ -> IO (Stack b) - duplicate :: Stack b -> IO (Stack b) - discardFrame :: Stack b -> IO (Stack b) - saveFrame :: Stack b -> IO (Stack b, SZ, SZ) - saveArgs :: Stack b -> IO (Stack b, SZ) - restoreFrame :: Stack b -> SZ -> SZ -> IO (Stack b) - prepareArgs :: Stack b -> Args' -> IO (Stack b) - acceptArgs :: Stack b -> Int -> IO (Stack b) - frameArgs :: Stack b -> IO (Stack b) - augSeg :: Augment -> Stack b -> Seg b -> Maybe Args' -> IO (Seg b) - dumpSeg :: Stack b -> Seg b -> Dump -> IO (Stack b) - adjustArgs :: Stack b -> SZ -> IO (Stack b) - fsize :: Stack b -> SZ - asize :: Stack b -> SZ - -instance MEM 'UN where - data Stack 'UN = - -- Note: uap <= ufp <= usp - US - { uap :: !Int, -- arg pointer - ufp :: !Int, -- frame pointer - usp :: !Int, -- stack pointer - ustk :: {-# UNPACK #-} !(MutableByteArray (PrimState IO)) - } - type Elem 'UN = Int - type Seg 'UN = ByteArray - alloc = US (-1) (-1) (-1) <$> newByteArray 4096 - {-# INLINE alloc #-} - peek (US _ _ sp stk) = readByteArray stk sp - {-# INLINE peek #-} - peekOff (US _ _ sp stk) i = readByteArray stk (sp - i) - {-# INLINE peekOff #-} - poke (US _ _ sp stk) n = writeByteArray stk sp n - {-# INLINE poke #-} - pokeOff (US _ _ sp stk) i n = writeByteArray stk (sp - i) n - {-# INLINE pokeOff #-} - - -- Eats up arguments - grab (US _ fp sp stk) sze = do - mut <- newByteArray sz - copyMutableByteArray mut 0 stk (bfp - sz) sz - seg <- unsafeFreezeByteArray mut - moveByteArray stk (bfp - sz) stk bfp fsz - pure (seg, US (fp - sze) (fp - sze) (sp - sze) stk) - where - sz = bytes sze - bfp = bytes $ fp + 1 - fsz = bytes $ sp - fp - {-# INLINE grab #-} - - ensure stki@(US ap fp sp stk) sze - | sze <= 0 || bytes (sp + sze + 1) < ssz = pure stki - | otherwise = do - stk' <- resizeMutableByteArray stk (ssz + ext) - pure $ US ap fp sp stk' - where - ssz = sizeofMutableByteArray stk - ext - | bytes sze > 10240 = bytes sze + 4096 - | otherwise = 10240 - {-# INLINE ensure #-} - - bump (US ap fp sp stk) = pure $ US ap fp (sp + 1) stk - {-# INLINE bump #-} - - bumpn (US ap fp sp stk) n = pure $ US ap fp (sp + n) stk - {-# INLINE bumpn #-} - - duplicate (US ap fp sp stk) = - US ap fp sp <$> do - b <- newByteArray sz - copyMutableByteArray b 0 stk 0 sz - pure b - where - sz = sizeofMutableByteArray stk - {-# INLINE duplicate #-} - - discardFrame (US ap fp _ stk) = pure $ US ap fp fp stk - {-# INLINE discardFrame #-} - - saveFrame (US ap fp sp stk) = pure (US sp sp sp stk, sp - fp, fp - ap) - {-# INLINE saveFrame #-} - - saveArgs (US ap fp sp stk) = pure (US fp fp sp stk, fp - ap) - {-# INLINE saveArgs #-} - - restoreFrame (US _ fp0 sp stk) fsz asz = pure $ US ap fp sp stk - where - fp = fp0 - fsz - ap = fp - asz - {-# INLINE restoreFrame #-} - - prepareArgs (US ap fp sp stk) (ArgR i l) - | fp + l + i == sp = pure $ US ap (sp - i) (sp - i) stk - prepareArgs (US ap fp sp stk) args = do - sp <- uargOnto stk sp stk fp args - pure $ US ap sp sp stk - {-# INLINE prepareArgs #-} - - acceptArgs (US ap fp sp stk) n = pure $ US ap (fp - n) sp stk - {-# INLINE acceptArgs #-} - - frameArgs (US ap _ sp stk) = pure $ US ap ap sp stk - {-# INLINE frameArgs #-} - - augSeg mode (US ap fp sp stk) seg margs = do - cop <- newByteArray $ ssz + psz + asz - copyByteArray cop soff seg 0 ssz - copyMutableByteArray cop 0 stk (bytes $ ap + 1) psz - for_ margs $ uargOnto stk sp cop (words poff + pix - 1) - unsafeFreezeByteArray cop - where - ssz = sizeofByteArray seg - pix | I <- mode = 0 | otherwise = fp - ap - (poff, soff) - | K <- mode = (ssz, 0) - | otherwise = (0, psz + asz) - psz = bytes pix - asz = case margs of - Nothing -> 0 - Just (Arg1 _) -> 8 - Just (Arg2 _ _) -> 16 - Just (ArgN v) -> bytes $ sizeofPrimArray v - Just (ArgR _ l) -> bytes l - {-# INLINE augSeg #-} - - dumpSeg (US ap fp sp stk) seg mode = do - copyByteArray stk bsp seg 0 ssz - pure $ US ap' fp' sp' stk - where - bsp = bytes $ sp + 1 - ssz = sizeofByteArray seg - sz = words ssz - sp' = sp + sz - fp' = dumpFP fp sz mode - ap' = dumpAP ap fp sz mode - {-# INLINE dumpSeg #-} - - adjustArgs (US ap fp sp stk) sz = pure $ US (ap - sz) fp sp stk - {-# INLINE adjustArgs #-} - - fsize (US _ fp sp _) = sp - fp - {-# INLINE fsize #-} - - asize (US ap fp _ _) = fp - ap - {-# INLINE asize #-} - -peekN :: Stack 'UN -> IO Word64 -peekN (US _ _ sp stk) = readByteArray stk sp -{-# INLINE peekN #-} - -peekD :: Stack 'UN -> IO Double -peekD (US _ _ sp stk) = readByteArray stk sp -{-# INLINE peekD #-} - -peekOffN :: Stack 'UN -> Int -> IO Word64 -peekOffN (US _ _ sp stk) i = readByteArray stk (sp - i) -{-# INLINE peekOffN #-} - -peekOffD :: Stack 'UN -> Int -> IO Double -peekOffD (US _ _ sp stk) i = readByteArray stk (sp - i) -{-# INLINE peekOffD #-} - -pokeN :: Stack 'UN -> Word64 -> IO () -pokeN (US _ _ sp stk) n = writeByteArray stk sp n -{-# INLINE pokeN #-} - -pokeD :: Stack 'UN -> Double -> IO () -pokeD (US _ _ sp stk) d = writeByteArray stk sp d -{-# INLINE pokeD #-} - -pokeOffN :: Stack 'UN -> Int -> Word64 -> IO () -pokeOffN (US _ _ sp stk) i n = writeByteArray stk (sp - i) n -{-# INLINE pokeOffN #-} - -pokeOffD :: Stack 'UN -> Int -> Double -> IO () -pokeOffD (US _ _ sp stk) i d = writeByteArray stk (sp - i) d -{-# INLINE pokeOffD #-} - -pokeBi :: (BuiltinForeign b) => Stack 'BX -> b -> IO () -pokeBi bstk x = poke bstk (Foreign $ wrapBuiltin x) -{-# INLINE pokeBi #-} - -pokeOffBi :: (BuiltinForeign b) => Stack 'BX -> Int -> b -> IO () -pokeOffBi bstk i x = pokeOff bstk i (Foreign $ wrapBuiltin x) -{-# INLINE pokeOffBi #-} - -peekBi :: (BuiltinForeign b) => Stack 'BX -> IO b -peekBi bstk = unwrapForeign . marshalToForeign <$> peek bstk -{-# INLINE peekBi #-} - -peekOffBi :: (BuiltinForeign b) => Stack 'BX -> Int -> IO b -peekOffBi bstk i = unwrapForeign . marshalToForeign <$> peekOff bstk i -{-# INLINE peekOffBi #-} - -peekOffS :: Stack 'BX -> Int -> IO (Seq Closure) -peekOffS bstk i = - unwrapForeign . marshalToForeign <$> peekOff bstk i -{-# INLINE peekOffS #-} - -pokeS :: Stack 'BX -> Seq Closure -> IO () -pokeS bstk s = poke bstk (Foreign $ Wrap Ty.listRef s) -{-# INLINE pokeS #-} - -pokeOffS :: Stack 'BX -> Int -> Seq Closure -> IO () -pokeOffS bstk i s = pokeOff bstk i (Foreign $ Wrap Ty.listRef s) -{-# INLINE pokeOffS #-} - -unull :: Seg 'UN -unull = byteArrayFromListN 0 ([] :: [Int]) - -bnull :: Seg 'BX -bnull = fromListN 0 [] - -instance Show (Stack 'BX) where - show (BS ap fp sp _) = - "BS " ++ show ap ++ " " ++ show fp ++ " " ++ show sp - -instance Show (Stack 'UN) where - show (US ap fp sp _) = - "US " ++ show ap ++ " " ++ show fp ++ " " ++ show sp - -instance Show K where - show k = "[" ++ go "" k - where - go _ KE = "]" - go _ (CB _) = "]" - go com (Push uf bf ua ba ci k) = - com ++ show (uf, bf, ua, ba, ci) ++ go "," k - go com (Mark ua ba ps _ k) = - com ++ "M " ++ show ua ++ " " ++ show ba ++ " " ++ show ps ++ go "," k - -instance MEM 'BX where - data Stack 'BX = BS - { bap :: !Int, - bfp :: !Int, - bsp :: !Int, - bstk :: {-# UNPACK #-} !(MutableArray (PrimState IO) Closure) - } - type Elem 'BX = Closure - type Seg 'BX = Array Closure - - alloc = BS (-1) (-1) (-1) <$> newArray 512 BlackHole - {-# INLINE alloc #-} - - peek (BS _ _ sp stk) = readArray stk sp - {-# INLINE peek #-} - - peekOff (BS _ _ sp stk) i = readArray stk (sp - i) - {-# INLINE peekOff #-} - - poke (BS _ _ sp stk) x = writeArray stk sp x - {-# INLINE poke #-} - - pokeOff (BS _ _ sp stk) i x = writeArray stk (sp - i) x - {-# INLINE pokeOff #-} - - grab (BS _ fp sp stk) sz = do - seg <- unsafeFreezeArray =<< cloneMutableArray stk (fp + 1 - sz) sz - copyMutableArray stk (fp + 1 - sz) stk (fp + 1) fsz - pure (seg, BS (fp - sz) (fp - sz) (sp - sz) stk) - where - fsz = sp - fp - {-# INLINE grab #-} - - ensure stki@(BS ap fp sp stk) sz - | sz <= 0 = pure stki - | sp + sz + 1 < ssz = pure stki - | otherwise = do - stk' <- newArray (ssz + ext) BlackHole - copyMutableArray stk' 0 stk 0 (sp + 1) - pure $ BS ap fp sp stk' - where - ssz = sizeofMutableArray stk - ext - | sz > 1280 = sz + 512 - | otherwise = 1280 - {-# INLINE ensure #-} - - bump (BS ap fp sp stk) = pure $ BS ap fp (sp + 1) stk - {-# INLINE bump #-} - - bumpn (BS ap fp sp stk) n = pure $ BS ap fp (sp + n) stk - {-# INLINE bumpn #-} - - duplicate (BS ap fp sp stk) = - BS ap fp sp <$> cloneMutableArray stk 0 (sizeofMutableArray stk) - {-# INLINE duplicate #-} - - discardFrame (BS ap fp _ stk) = pure $ BS ap fp fp stk - {-# INLINE discardFrame #-} - - saveFrame (BS ap fp sp stk) = pure (BS sp sp sp stk, sp - fp, fp - ap) - {-# INLINE saveFrame #-} - - saveArgs (BS ap fp sp stk) = pure (BS fp fp sp stk, fp - ap) - {-# INLINE saveArgs #-} - - restoreFrame (BS _ fp0 sp stk) fsz asz = pure $ BS ap fp sp stk - where - fp = fp0 - fsz - ap = fp - asz - {-# INLINE restoreFrame #-} - - prepareArgs (BS ap fp sp stk) (ArgR i l) - | fp + i + l == sp = pure $ BS ap (sp - i) (sp - i) stk - prepareArgs (BS ap fp sp stk) args = do - sp <- bargOnto stk sp stk fp args - pure $ BS ap sp sp stk - {-# INLINE prepareArgs #-} - - acceptArgs (BS ap fp sp stk) n = pure $ BS ap (fp - n) sp stk - {-# INLINE acceptArgs #-} - - frameArgs (BS ap _ sp stk) = pure $ BS ap ap sp stk - {-# INLINE frameArgs #-} - - augSeg mode (BS ap fp sp stk) seg margs = do - cop <- newArray (ssz + psz + asz) BlackHole - copyArray cop soff seg 0 ssz - copyMutableArray cop poff stk (ap + 1) psz - for_ margs $ bargOnto stk sp cop (poff + psz - 1) - unsafeFreezeArray cop - where - ssz = sizeofArray seg - psz | I <- mode = 0 | otherwise = fp - ap - (poff, soff) - | K <- mode = (ssz, 0) - | otherwise = (0, psz + asz) - asz = case margs of - Nothing -> 0 - Just (Arg1 _) -> 1 - Just (Arg2 _ _) -> 2 - Just (ArgN v) -> sizeofPrimArray v - Just (ArgR _ l) -> l - {-# INLINE augSeg #-} - - dumpSeg (BS ap fp sp stk) seg mode = do - copyArray stk (sp + 1) seg 0 sz - pure $ BS ap' fp' sp' stk - where - sz = sizeofArray seg - sp' = sp + sz - fp' = dumpFP fp sz mode - ap' = dumpAP ap fp sz mode - {-# INLINE dumpSeg #-} - - adjustArgs (BS ap fp sp stk) sz = pure $ BS (ap - sz) fp sp stk - {-# INLINE adjustArgs #-} - - fsize (BS _ fp sp _) = sp - fp - {-# INLINE fsize #-} - - asize (BS ap fp _ _) = fp - ap - -frameView :: (MEM b) => (Show (Elem b)) => Stack b -> IO () -frameView stk = putStr "|" >> gof False 0 - where - fsz = fsize stk - asz = asize stk - gof delim n - | n >= fsz = putStr "|" >> goa False 0 - | otherwise = do - when delim $ putStr "," - putStr . show =<< peekOff stk n - gof True (n + 1) - goa delim n - | n >= asz = putStrLn "|.." - | otherwise = do - when delim $ putStr "," - putStr . show =<< peekOff stk (fsz + n) - goa True (n + 1) - -uscount :: Seg 'UN -> Int -uscount seg = words $ sizeofByteArray seg - -bscount :: Seg 'BX -> Int -bscount seg = sizeofArray seg - -closureTermRefs :: (Monoid m) => (Reference -> m) -> (Closure -> m) -closureTermRefs f (PAp (CIx r _ _) _ cs) = - f r <> foldMap (closureTermRefs f) cs -closureTermRefs f (DataB1 _ _ c) = closureTermRefs f c -closureTermRefs f (DataB2 _ _ c1 c2) = - closureTermRefs f c1 <> closureTermRefs f c2 -closureTermRefs f (DataUB _ _ _ c) = - closureTermRefs f c -closureTermRefs f (Captured k _ _ _ cs) = - contTermRefs f k <> foldMap (closureTermRefs f) cs -closureTermRefs f (Foreign fo) - | Just (cs :: Seq Closure) <- maybeUnwrapForeign Ty.listRef fo = - foldMap (closureTermRefs f) cs -closureTermRefs _ _ = mempty - -contTermRefs :: (Monoid m) => (Reference -> m) -> K -> m -contTermRefs f (Mark _ _ _ m k) = - foldMap (closureTermRefs f) m <> contTermRefs f k -contTermRefs f (Push _ _ _ _ (CIx r _ _) k) = - f r <> contTermRefs f k -contTermRefs _ _ = mempty diff --git a/parser-typechecker/src/Unison/Syntax/FileParser.hs b/parser-typechecker/src/Unison/Syntax/FileParser.hs index 6185747380..1c41678d1f 100644 --- a/parser-typechecker/src/Unison/Syntax/FileParser.hs +++ b/parser-typechecker/src/Unison/Syntax/FileParser.hs @@ -6,7 +6,6 @@ where import Control.Lens import Control.Monad.Reader (asks, local) import Data.List qualified as List -import Data.List.NonEmpty (pattern (:|)) import Data.Map qualified as Map import Data.Set qualified as Set import Data.Text qualified as Text @@ -14,24 +13,26 @@ import Text.Megaparsec qualified as P import Unison.ABT qualified as ABT import Unison.DataDeclaration (DataDeclaration, EffectDeclaration) import Unison.DataDeclaration qualified as DD +import Unison.DataDeclaration qualified as DataDeclaration import Unison.DataDeclaration.Records (generateRecordAccessors) import Unison.Name qualified as Name import Unison.NameSegment qualified as NameSegment import Unison.Names qualified as Names import Unison.Names.ResolutionResult qualified as Names -import Unison.NamesWithHistory qualified as Names import Unison.Parser.Ann (Ann) import Unison.Parser.Ann qualified as Ann import Unison.Prelude import Unison.Reference (TypeReferenceId) import Unison.Syntax.DeclParser (declarations) import Unison.Syntax.Lexer qualified as L -import Unison.Syntax.Name qualified as Name (toText, unsafeParseVar) +import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar) import Unison.Syntax.Parser import Unison.Syntax.TermParser qualified as TermParser -import Unison.Syntax.Var qualified as Var (namespaced) -import Unison.Term (Term) +import Unison.Syntax.Var qualified as Var (namespaced, namespaced2) +import Unison.Term (Term, Term2) import Unison.Term qualified as Term +import Unison.Type (Type) +import Unison.Type qualified as Type import Unison.UnisonFile (UnisonFile (..)) import Unison.UnisonFile.Env qualified as UF import Unison.UnisonFile.Names qualified as UFN @@ -42,40 +43,106 @@ import Unison.WatchKind (WatchKind) import Unison.WatchKind qualified as UF import Prelude hiding (readFile) -resolutionFailures :: (Ord v) => [Names.ResolutionFailure v Ann] -> P v m x +resolutionFailures :: (Ord v) => [Names.ResolutionFailure Ann] -> P v m x resolutionFailures es = P.customFailure (ResolutionFailures es) file :: forall m v. (Monad m, Var v) => P v m (UnisonFile v Ann) file = do _ <- openBlock + + -- Parse an optional directive like "namespace foo.bar" + maybeNamespace :: Maybe Name.Name <- + optional (reserved "namespace") >>= \case + Nothing -> pure Nothing + Just _ -> do + namespace <- importWordyId <|> importSymbolyId + void (optional semi) + pure (Just (L.payload namespace)) + let maybeNamespaceVar = Name.toVar <$> maybeNamespace + -- The file may optionally contain top-level imports, -- which are parsed and applied to the type decls and term stanzas (namesStart, imports) <- TermParser.imports <* optional semi (dataDecls, effectDecls, parsedAccessors) <- declarations - env <- case UFN.environmentFor namesStart dataDecls effectDecls of - Right (Right env) -> pure env - Right (Left es) -> P.customFailure $ TypeDeclarationErrors es - Left es -> resolutionFailures (toList es) - let accessors :: [[(v, Ann, Term v Ann)]] + + env <- + let applyNamespaceToDecls :: forall decl. Iso' decl (DataDeclaration v Ann) -> Map v decl -> Map v decl + applyNamespaceToDecls dataDeclL = + case maybeNamespaceVar of + Nothing -> id + Just namespace -> Map.fromList . map f . Map.toList + where + f :: (v, decl) -> (v, decl) + f (declName, decl) = + ( Var.namespaced2 namespace declName, + review dataDeclL (applyNamespaceToDataDecl namespace unNamespacedTypeNames (view dataDeclL decl)) + ) + + unNamespacedTypeNames :: Set v + unNamespacedTypeNames = + Set.union (Map.keysSet dataDecls) (Map.keysSet effectDecls) + + dataDecls1 = applyNamespaceToDecls id dataDecls + effectDecls1 = applyNamespaceToDecls DataDeclaration.asDataDecl_ effectDecls + in case UFN.environmentFor namesStart dataDecls1 effectDecls1 of + Right (Right env) -> pure env + Right (Left es) -> P.customFailure $ TypeDeclarationErrors es + Left es -> resolutionFailures (toList es) + let unNamespacedAccessors :: [(v, Ann, Term v Ann)] + unNamespacedAccessors = do + (typ, fields) <- parsedAccessors + -- The parsed accessor has an un-namespaced type, so apply the namespace directive (if necessary) before + -- looking up in the environment computed by `environmentFor`. + let typ1 = maybe id Var.namespaced2 maybeNamespaceVar (L.payload typ) + Just (r, _) <- [Map.lookup typ1 (UF.datas env)] + -- Generate the record accessors with *un-namespaced* names (passing `typ` rather than `typ1`) below, because we + -- need to know these names in order to perform rewriting. As an example, + -- + -- namespace foo + -- type Bar = { baz : Nat } + -- term = ... Bar.baz ... + -- + -- we want to rename `Bar.baz` to `foo.Bar.baz`, and it seems easier to first generate un-namespaced accessors + -- like `Bar.baz`, rather than rip off the namespace from accessors like `foo.Bar.baz` (though not by much). + generateRecordAccessors Var.namespaced Ann.GeneratedFrom (toPair <$> fields) (L.payload typ) r + where + toPair (tok, typ) = (L.payload tok, ann tok <> ann typ) + let accessors :: [(v, Ann, Term v Ann)] accessors = - [ generateRecordAccessors Var.namespaced Ann.GeneratedFrom (toPair <$> fields) (L.payload typ) r - | (typ, fields) <- parsedAccessors, - Just (r, _) <- [Map.lookup (L.payload typ) (UF.datas env)] - ] - toPair (tok, typ) = (L.payload tok, ann tok <> ann typ) - let importNames = [(Name.unsafeParseVar v, Name.unsafeParseVar v2) | (v, v2) <- imports] - let locals = Names.importing importNames (UF.names env) + unNamespacedAccessors + & case maybeNamespaceVar of + Nothing -> id + Just namespace -> over (mapped . _1) (Var.namespaced2 namespace) -- At this stage of the file parser, we've parsed all the type and ability - -- declarations. The `push locals` here has the effect - -- of making suffix-based name resolution prefer type and constructor names coming - -- from the local file. - -- - -- There's some more complicated logic below to have suffix-based name resolution - -- make use of _terms_ from the local file. - local (\e -> e {names = Names.push locals namesStart}) do + -- declarations. + let updateEnvForTermParsing e = + e + { names = Names.shadowing (UF.names env) namesStart, + maybeNamespace, + localNamespacePrefixedTypesAndConstructors = UF.names env + } + local updateEnvForTermParsing do names <- asks names - stanzas0 <- sepBy semi stanza - let stanzas = fmap (TermParser.substImports names imports) <$> stanzas0 + stanzas <- do + unNamespacedStanzas0 <- sepBy semi stanza + let unNamespacedStanzas = fmap (TermParser.substImports names imports) <$> unNamespacedStanzas0 + pure $ + unNamespacedStanzas + & case maybeNamespaceVar of + Nothing -> id + Just namespace -> + let unNamespacedTermNamespaceNames :: Set v + unNamespacedTermNamespaceNames = + Set.unions + [ -- The vars parsed from the stanzas themselves (before applying namespace directive) + Set.fromList (unNamespacedStanzas >>= getVars), + -- The un-namespaced constructor names (from the *originally-parsed* data and effect decls) + foldMap (Set.fromList . DataDeclaration.constructorVars) dataDecls, + foldMap (Set.fromList . DataDeclaration.constructorVars . DataDeclaration.toDataDecl) effectDecls, + -- The un-namespaced accessors + Set.fromList (map (view _1) unNamespacedAccessors) + ] + in map (applyNamespaceToStanza namespace unNamespacedTermNamespaceNames) _ <- closeBlock let (termsr, watchesr) = foldl' go ([], []) stanzas go (terms, watches) s = case s of @@ -89,28 +156,13 @@ file = do -- All locally declared term variables, running example: -- [foo.alice, bar.alice, zonk.bob] fqLocalTerms :: [v] - fqLocalTerms = (stanzas0 >>= getVars) <> (view _1 <$> join accessors) - -- suffixified local term bindings shadow any same-named thing from the outer codebase scope - -- example: `foo.bar` in local file scope will shadow `foo.bar` and `bar` in codebase scope - let (curNames, resolveLocals) = - ( Names.shadowTerms locals names, - resolveLocals - ) - where - -- Each unique suffix mapped to its fully qualified name - canonicalVars :: Map v v - canonicalVars = UFN.variableCanonicalizer fqLocalTerms - - -- All unique local term name suffixes - these we want to - -- avoid resolving to a term that's in the codebase - locals :: [Name.Name] - locals = (Name.unsafeParseVar <$> Map.keys canonicalVars) - - -- A function to replace unique local term suffixes with their - -- fully qualified name - replacements = [(v, Term.var () v2) | (v, v2) <- Map.toList canonicalVars, v /= v2] - resolveLocals = ABT.substsInheritAnnotation replacements - let bindNames = Term.bindSomeNames Name.unsafeParseVar (Set.fromList fqLocalTerms) curNames . resolveLocals + fqLocalTerms = (stanzas >>= getVars) <> (view _1 <$> accessors) + let bindNames = + Term.bindNames + Name.unsafeParseVar + Name.toVar + (Set.fromList fqLocalTerms) + (Names.shadowTerms (map Name.unsafeParseVar fqLocalTerms) names) terms <- case List.validate (traverseOf _3 bindNames) terms of Left es -> resolutionFailures (toList es) Right terms -> pure terms @@ -120,9 +172,48 @@ file = do validateUnisonFile (UF.datasId env) (UF.effectsId env) - (terms <> join accessors) + (terms <> accessors) (List.multimap watches) +applyNamespaceToDataDecl :: forall a v. (Var v) => v -> Set v -> DataDeclaration v a -> DataDeclaration v a +applyNamespaceToDataDecl namespace locallyBoundTypes = + over (DataDeclaration.constructors_ . mapped) \(ann, conName, conTy) -> + (ann, Var.namespaced2 namespace conName, ABT.substsInheritAnnotation replacements conTy) + where + -- Replace var "Foo" with var "namespace.Foo" + replacements :: [(v, Type v ())] + replacements = + locallyBoundTypes + & Set.toList + & map (\v -> (v, Type.var () (Var.namespaced2 namespace v))) + +applyNamespaceToStanza :: + forall a v. + (Var v) => + v -> + Set v -> + Stanza v (Term v a) -> + Stanza v (Term v a) +applyNamespaceToStanza namespace locallyBoundTerms = \case + Binding x -> Binding (goBinding x) + Bindings xs -> Bindings (map goBinding xs) + WatchBinding wk ann x -> WatchBinding wk ann (goBinding x) + WatchExpression wk guid ann term -> WatchExpression wk guid ann (goTerm term) + where + goBinding :: ((Ann, v), Term v a) -> ((Ann, v), Term v a) + goBinding ((ann, name), term) = + ((ann, Var.namespaced2 namespace name), goTerm term) + + goTerm :: Term v a -> Term v a + goTerm = + ABT.substsInheritAnnotation replacements + + replacements :: [(v, Term2 v a a v ())] + replacements = + locallyBoundTerms + & Set.toList + & map (\v -> (v, Term.var () (Var.namespaced2 namespace v))) + -- | Final validations and sanity checks to perform before finishing parsing. validateUnisonFile :: (Ord v) => @@ -237,7 +328,7 @@ stanza = watchExpression <|> unexpectedAction <|> binding binding@((_, v), _) <- TermParser.binding pure $ case doc of Nothing -> Binding binding - Just (spanAnn, doc) -> Bindings [((spanAnn, Var.namespaced (v :| [Var.named "doc"])), doc), binding] + Just (spanAnn, doc) -> Bindings [((spanAnn, Var.namespaced2 v (Var.named "doc")), doc), binding] watched :: (Monad m, Var v) => P v m (UF.WatchKind, Text, Ann) watched = P.try do diff --git a/parser-typechecker/src/Unison/Syntax/FilePrinter.hs b/parser-typechecker/src/Unison/Syntax/FilePrinter.hs new file mode 100644 index 0000000000..0c0d3b0443 --- /dev/null +++ b/parser-typechecker/src/Unison/Syntax/FilePrinter.hs @@ -0,0 +1,97 @@ +module Unison.Syntax.FilePrinter + ( renderDefnsForUnisonFile, + ) +where + +import Control.Lens (mapped, _1) +import Control.Monad.Writer (Writer) +import Control.Monad.Writer qualified as Writer +import Data.List qualified as List +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Unison.Builtin.Decls qualified as Builtin.Decls +import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) +import Unison.DataDeclaration (Decl) +import Unison.DeclNameLookup (DeclNameLookup, expectConstructorNames) +import Unison.HashQualified qualified as HQ +import Unison.HashQualifiedPrime qualified as HQ' +import Unison.Name (Name) +import Unison.Prelude +import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) +import Unison.Reference (TypeReferenceId) +import Unison.Reference qualified as Reference +import Unison.Referent (Referent) +import Unison.Referent qualified as Referent +import Unison.Syntax.DeclPrinter (AccessorName) +import Unison.Syntax.DeclPrinter qualified as DeclPrinter +import Unison.Syntax.TermPrinter qualified as TermPrinter +import Unison.Term (Term) +import Unison.Type (Type) +import Unison.Typechecker qualified as Typechecker +import Unison.Util.Defns (Defns (..), DefnsF) +import Unison.Util.Pretty (ColorText, Pretty) +import Unison.Util.Pretty qualified as Pretty +import Unison.Var (Var) + +-- | Render definitions destined for a Unison file. +-- +-- This first renders the types (discovering which record accessors will be generated upon parsing), then renders the +-- terms (being careful not to render any record accessors, since those would cause duplicate binding errors upon +-- parsing). +renderDefnsForUnisonFile :: + forall a v. + (Var v, Monoid a) => + DeclNameLookup -> + PrettyPrintEnvDecl -> + DefnsF (Map Name) (Term v a, Type v a) (TypeReferenceId, Decl v a) -> + DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText) +renderDefnsForUnisonFile declNameLookup ppe defns = + let (types, accessorNames) = Writer.runWriter (Map.traverseWithKey renderType defns.types) + in Defns + { terms = Map.mapMaybeWithKey (renderTerm accessorNames) defns.terms, + types + } + where + renderType :: Name -> (TypeReferenceId, Decl v a) -> Writer (Set AccessorName) (Pretty ColorText) + renderType name (ref, typ) = + fmap Pretty.syntaxToColor $ + DeclPrinter.prettyDeclW + -- Sort of a hack; since the decl printer looks in the PPE for names of constructors, + -- we just delete all term names out and add back the constructors... + -- probably no need to wipe out the suffixified side but we do it anyway + (setPpedToConstructorNames declNameLookup name ref ppe) + (Reference.fromId ref) + (HQ.NameOnly name) + typ + + renderTerm :: Set Name -> Name -> (Term v a, Type v a) -> Maybe (Pretty ColorText) + renderTerm accessorNames name (term, typ) = do + guard (not (Set.member name accessorNames)) + let hqName = HQ.NameOnly name + let rendered + | Typechecker.isEqual (Builtin.Decls.testResultListType mempty) typ = + "test> " <> TermPrinter.prettyBindingWithoutTypeSignature ppe.suffixifiedPPE hqName term + | otherwise = TermPrinter.prettyBinding ppe.suffixifiedPPE hqName term + Just (Pretty.syntaxToColor rendered) + +setPpedToConstructorNames :: DeclNameLookup -> Name -> TypeReferenceId -> PrettyPrintEnvDecl -> PrettyPrintEnvDecl +setPpedToConstructorNames declNameLookup name ref = + set (#unsuffixifiedPPE . #termNames) referentNames + . set (#suffixifiedPPE . #termNames) referentNames + where + constructorNameMap :: Map ConstructorReference Name + constructorNameMap = + Map.fromList + ( name + & expectConstructorNames declNameLookup + & List.zip [0 ..] + & over (mapped . _1) (ConstructorReference (Reference.fromId ref)) + ) + + referentNames :: Referent -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)] + referentNames = \case + Referent.Con conRef _ -> + case Map.lookup conRef constructorNameMap of + Nothing -> [] + Just conName -> let hqConName = HQ'.NameOnly conName in [(hqConName, hqConName)] + Referent.Ref _ -> [] diff --git a/parser-typechecker/src/Unison/Syntax/Precedence.hs b/parser-typechecker/src/Unison/Syntax/Precedence.hs new file mode 100644 index 0000000000..2a74b1181f --- /dev/null +++ b/parser-typechecker/src/Unison/Syntax/Precedence.hs @@ -0,0 +1,71 @@ +module Unison.Syntax.Precedence where + +import Data.Map qualified as Map +import Unison.Prelude + +-- Precedence rules for infix operators. +-- Lower number means higher precedence (tighter binding). +-- Operators not in this list have no precedence and will simply be parsed +-- left-to-right. +infixRules :: Map Text Precedence +infixRules = + Map.fromList do + (ops, prec) <- zip infixLevels (map (InfixOp . Level) [0 ..]) + map (,prec) ops + +-- | Indicates this is the RHS of a top-level definition. +isTopLevelPrecedence :: Precedence -> Bool +isTopLevelPrecedence i = i == Basement + +increment :: Precedence -> Precedence +increment = \case + Basement -> Bottom + Bottom -> Annotation + Annotation -> Statement + Statement -> Control + Control -> InfixOp Lowest + InfixOp Lowest -> InfixOp (Level 0) + InfixOp (Level n) -> InfixOp (Level (n + 1)) + InfixOp Highest -> Application + Application -> Prefix + Prefix -> Top + Top -> Top + +data Precedence + = -- | The lowest precedence, used for top-level bindings + Basement + | -- | Used for terms that never need parentheses + Bottom + | -- | Type annotations + Annotation + | -- | A statement in a block + Statement + | -- | Control flow constructs like `if`, `match`, `case` + Control + | -- | Infix operators + InfixOp InfixPrecedence + | -- | Function application + Application + | -- | Prefix operators like `'`, `!` + Prefix + | -- | The highest precedence, used for let bindings and blocks + Top + deriving (Eq, Ord, Show) + +data InfixPrecedence = Lowest | Level Int | Highest + deriving (Eq, Ord, Show) + +infixLevels :: [[Text]] +infixLevels = + [ ["||", "|"], + ["&&", "&"], + ["==", "!==", "!=", "==="], + ["<", ">", ">=", "<="], + ["+", "-"], + ["*", "/", "%"], + ["^", "^^", "**"] + ] + +-- | Returns the precedence of an infix operator, if it has one. +operatorPrecedence :: Text -> Maybe Precedence +operatorPrecedence op = Map.lookup op infixRules diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs index 85406c84bf..90913645f0 100644 --- a/parser-typechecker/src/Unison/Syntax/TermParser.hs +++ b/parser-typechecker/src/Unison/Syntax/TermParser.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE PartialTypeSignatures #-} module Unison.Syntax.TermParser @@ -12,8 +13,8 @@ module Unison.Syntax.TermParser ) where -import Control.Comonad.Cofree (Cofree ((:<))) import Control.Monad.Reader (asks, local) +import Data.Bitraversable (bitraverse) import Data.Char qualified as Char import Data.Foldable (foldrM) import Data.List qualified as List @@ -25,7 +26,6 @@ import Data.Sequence qualified as Sequence import Data.Set qualified as Set import Data.Text qualified as Text import Data.Tuple.Extra qualified as TupleE -import Data.Void (absurd, vacuous) import Text.Megaparsec qualified as P import U.Codebase.Reference (ReferenceType (..)) import U.Core.ABT qualified as ABT @@ -40,20 +40,23 @@ import Unison.Name qualified as Name import Unison.NameSegment qualified as NameSegment import Unison.Names (Names) import Unison.Names qualified as Names +import Unison.Names.ResolutionResult (ResolutionError (..), ResolutionFailure (..)) import Unison.NamesWithHistory qualified as Names import Unison.Parser.Ann (Ann (Ann)) import Unison.Parser.Ann qualified as Ann import Unison.Pattern (Pattern) import Unison.Pattern qualified as Pattern import Unison.Prelude -import Unison.Reference (Reference) +import Unison.Reference (TypeReference) import Unison.Referent (Referent) +import Unison.Referent qualified as Referent import Unison.Syntax.Lexer.Unison qualified as L import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar) import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Syntax.Parser hiding (seq) import Unison.Syntax.Parser qualified as Parser (seq, uniqueName) import Unison.Syntax.Parser.Doc.Data qualified as Doc +import Unison.Syntax.Precedence (operatorPrecedence) import Unison.Syntax.TypeParser qualified as TypeParser import Unison.Term (IsTop, Term) import Unison.Term qualified as Term @@ -62,6 +65,7 @@ import Unison.Type qualified as Type import Unison.Typechecker.Components qualified as Components import Unison.Util.Bytes qualified as Bytes import Unison.Util.List (intercalateMapWith, quenchRuns) +import Unison.Util.Recursion import Unison.Var (Var) import Unison.Var qualified as Var import Prelude hiding (and, or, seq) @@ -69,9 +73,9 @@ import Prelude hiding (and, or, seq) {- Precedence of language constructs is identical to Haskell, except that all operators (like +, <*>, or any sequence of non-alphanumeric characters) are -left-associative and equal precedence, and operators must have surrounding -whitespace (a + b, not a+b) to distinguish from identifiers that may contain -operator characters (like empty? or fold-left). +left-associative and equal precedence (with a few exceptions), and operators +must have surrounding whitespace (a + b, not a+b) to distinguish from +identifiers that may contain operator characters (like empty? or fold-left). Sections / partial application of infix operators is not implemented. -} @@ -116,16 +120,19 @@ rewriteBlock = do rhs <- openBlockWith "==>" *> TypeParser.computationType <* closeBlock pure (DD.rewriteType (ann kw <> ann rhs) (L.payload <$> vs) lhs rhs) -typeLink' :: (Monad m, Var v) => P v m (L.Token Reference) +typeLink' :: (Monad m, Var v) => P v m (L.Token TypeReference) typeLink' = findUniqueType =<< hqPrefixId -findUniqueType :: (Monad m, Var v) => L.Token (HQ.HashQualified Name) -> P v m (L.Token Reference) -findUniqueType id = do - ns <- asks names - case Names.lookupHQType Names.IncludeSuffixes (L.payload id) ns of - s - | Set.size s == 1 -> pure $ const (Set.findMin s) <$> id - | otherwise -> customFailure $ UnknownType id s +findUniqueType :: (Monad m, Var v) => L.Token (HQ.HashQualified Name) -> P v m (L.Token TypeReference) +findUniqueType id = + resolveToLocalNamespacedType id >>= \case + Nothing -> do + ns <- asks names + case Names.lookupHQType Names.IncludeSuffixes (L.payload id) ns of + s + | Set.size s == 1 -> pure (Set.findMin s <$ id) + | otherwise -> customFailure $ UnknownType id s + Just ref -> pure (ref <$ id) termLink' :: (Monad m, Var v) => P v m (L.Token Referent) termLink' = do @@ -136,27 +143,46 @@ termLink' = do | Set.size s == 1 -> pure $ const (Set.findMin s) <$> id | otherwise -> customFailure $ UnknownTerm id s -link' :: (Monad m, Var v) => P v m (Either (L.Token Reference) (L.Token Referent)) +link' :: (Monad m, Var v) => P v m (Either (L.Token TypeReference) (L.Token Referent)) link' = do id <- hqPrefixId ns <- asks names - case (Names.lookupHQTerm Names.IncludeSuffixes (L.payload id) ns, Names.lookupHQType Names.IncludeSuffixes (L.payload id) ns) of - (s, s2) | Set.size s == 1 && Set.null s2 -> pure . Right $ const (Set.findMin s) <$> id - (s, s2) | Set.size s2 == 1 && Set.null s -> pure . Left $ const (Set.findMin s2) <$> id - (s, s2) -> customFailure $ UnknownId id s s2 + let s = Names.lookupHQTerm Names.IncludeSuffixes (L.payload id) ns + let s2 = Names.lookupHQType Names.IncludeSuffixes (L.payload id) ns + if + | Set.size s == 1 && Set.null s2 -> pure . Right $ Set.findMin s <$ id + | Set.size s2 == 1 && Set.null s -> pure . Left $ Set.findMin s2 <$ id + | True -> customFailure $ UnknownId id s s2 link :: (Monad m, Var v) => TermP v m link = termLink <|> typeLink where typeLink = do - _ <- P.try (reserved "typeLink") -- type opens a block, gotta use something else + _ <- reserved "typeLink" -- type opens a block, gotta use something else tok <- typeLink' pure $ Term.typeLink (ann tok) (L.payload tok) termLink = do - _ <- P.try (reserved "termLink") + _ <- reserved "termLink" tok <- termLink' pure $ Term.termLink (ann tok) (L.payload tok) +resolveToLocalNamespacedType :: (Monad m, Ord v) => L.Token (HQ.HashQualified Name) -> P v m (Maybe TypeReference) +resolveToLocalNamespacedType tok = + case L.payload tok of + HQ.NameOnly name -> + asks maybeNamespace >>= \case + Nothing -> pure Nothing + Just namespace -> do + localNames <- asks localNamespacePrefixedTypesAndConstructors + pure case Names.lookupHQType Names.ExactName (HQ.NameOnly (Name.joinDot namespace name)) localNames of + refs + | Set.null refs -> Nothing + -- 2+ name case is impossible: we looked up exact names in the locally-bound names. Two bindings + -- with the same name would have been a parse error. So, just take the minimum element from the set, + -- which we know is a singleton. + | otherwise -> Just (Set.findMin refs) + _ -> pure Nothing + -- We disallow type annotations and lambdas, -- just function application and operators blockTerm :: (Monad m, Var v) => TermP v m @@ -168,25 +194,16 @@ match = do scrutinee <- term _ <- optionalCloseBlock _ <- - P.try (openBlockWith "with") <|> do + openBlockWith "with" <|> do t <- anyToken P.customFailure (ExpectedBlockOpen "with" t) - (_arities, cases) <- NonEmpty.unzip <$> matchCases1 start + (_arities, cases) <- unzip <$> matchCases _ <- optionalCloseBlock - pure $ - Term.match - (ann start <> ann (NonEmpty.last cases)) - scrutinee - (toList cases) - -matchCases1 :: (Monad m, Var v) => L.Token () -> P v m (NonEmpty (Int, Term.MatchCase Ann (Term v Ann))) -matchCases1 start = do - cases <- - (sepBy semi matchCase) - <&> \cases_ -> [(n, c) | (n, cs) <- cases_, c <- cs] - case cases of - [] -> P.customFailure (EmptyMatch start) - (c : cs) -> pure (c NonEmpty.:| cs) + let anns = foldr ((<>) . ann) (ann start) $ lastMay cases + pure $ Term.match anns scrutinee cases + +matchCases :: (Monad m, Var v) => P v m [(Int, Term.MatchCase Ann (Term v Ann))] +matchCases = sepBy semi matchCase <&> \cases_ -> [(n, c) | (n, cs) <- cases_, c <- cs] -- Returns the arity of the pattern and the `MatchCase`. Examples: -- @@ -211,7 +228,7 @@ matchCase = do _ <- reserved "|" guard <- asum - [ Nothing <$ P.try (quasikeyword "otherwise"), + [ Nothing <$ quasikeyword "otherwise", Just <$> infixAppOrBooleanOp ] (_spanAnn, t) <- layoutBlock "->" @@ -285,42 +302,92 @@ parsePattern = label "pattern" root else pure (Pattern.Var (ann v), [tokenToPair v]) unbound :: P v m (Pattern Ann, [(Ann, v)]) unbound = (\tok -> (Pattern.Unbound (ann tok), [])) <$> blank - ctor :: CT.ConstructorType -> (L.Token (HQ.HashQualified Name) -> Set ConstructorReference -> Error v) -> P v m (L.Token ConstructorReference) - ctor ct err = do + ctor :: CT.ConstructorType -> P v m (L.Token ConstructorReference) + ctor ct = do -- this might be a var, so we avoid consuming it at first - tok <- P.try (P.lookAhead hqPrefixId) - names <- asks names - -- probably should avoid looking up in `names` if `L.payload tok` - -- starts with a lowercase - case Names.lookupHQPattern Names.IncludeSuffixes (L.payload tok) ct names of - s - | Set.null s -> die tok s - | Set.size s > 1 -> die tok s - | otherwise -> -- matched ctor name, consume the token - do _ <- anyToken; pure (Set.findMin s <$ tok) + tok <- P.lookAhead hqPrefixId + + -- First, if: + -- + -- * The token isn't hash-qualified (e.g. "Foo.Bar") + -- * We're under a namespace directive (e.g. "baz") + -- * There's an exact match for a locally-bound constructor (e.g. "baz.Foo.Bar") + -- + -- Then: + -- + -- * Use that constructor reference (duh) + -- + -- Else: + -- + -- * Fall through to the normal logic of looking the constructor name up in all of the names (which includes + -- the locally-bound constructors). + + maybeLocalCtor <- + case L.payload tok of + HQ.NameOnly name -> + asks maybeNamespace >>= \case + Nothing -> pure Nothing + Just namespace -> do + localNames <- asks localNamespacePrefixedTypesAndConstructors + case Names.lookupHQPattern Names.ExactName (HQ.NameOnly (Name.joinDot namespace name)) ct localNames of + refs + | Set.null refs -> pure Nothing + -- 2+ name case is impossible: we looked up exact names in the locally-bound names. Two bindings + -- with the same name would have been a parse error. So, just take the minimum element from the set, + -- which we know is a singleton. + | otherwise -> do + -- matched ctor name, consume the token + _ <- anyToken + pure (Just (Set.findMin refs)) + _ -> pure Nothing + + case maybeLocalCtor of + Just localCtor -> pure (localCtor <$ tok) + Nothing -> do + names <- asks names + case Names.lookupHQPattern Names.IncludeSuffixes (L.payload tok) ct names of + s + | Set.size s == 1 -> do + -- matched ctor name, consume the token + _ <- anyToken + pure (Set.findMin s <$ tok) + | otherwise -> die names tok s where - isLower = Text.all Char.isLower . Text.take 1 . Name.toText + isLower = Text.all Char.isLower . Text.take 1 . NameSegment.toUnescapedText . Name.lastSegment isIgnored n = Text.take 1 (Name.toText n) == "_" - die hq s = case L.payload hq of - -- if token not hash qualified or uppercase, + die :: Names -> L.Token (HQ.HashQualified Name) -> Set ConstructorReference -> P v m a + die names hq s = case L.payload hq of + -- if token not hash qualified and not uppercase, -- fail w/out consuming it to allow backtracking HQ.NameOnly n | Set.null s && (isLower n || isIgnored n) -> fail $ "not a constructor name: " <> show n - -- it was hash qualified, and wasn't found in the env, that's a failure! - _ -> failCommitted $ err hq s - + -- it was hash qualified and/or uppercase, and was either not found or ambiguous, that's a failure! + _ -> + failCommitted $ + ResolutionFailures + [ TermResolutionFailure + (L.payload hq) + (ann hq) + if Set.null s + then NotFound + else + Ambiguous + names + (Set.map (\ref -> Referent.Con ref ct) s) + -- Eh, here we're saying there are no "local" constructors – they're all from "the namespace". + -- That's not necessarily true, but it doesn't (currently) affect the error message any, and + -- we have already parsed and hashed local constructors (so they aren't really different from + -- namespace constructors). + Set.empty + ] unzipPatterns f elems = case unzip elems of (patterns, vs) -> f patterns (join vs) - effectBind0 = do - tok <- ctor CT.Effect UnknownAbilityConstructor + effectBind = do + tok <- ctor CT.Effect leaves <- many leaf _ <- reserved "->" - pure (tok, leaves) - - effectBind = do - (tok, leaves) <- P.try effectBind0 (cont, vsp) <- parsePattern pure $ let f patterns vs = (Pattern.EffectBind (ann tok <> ann cont) (L.payload tok) patterns cont, vs ++ vsp) @@ -332,17 +399,42 @@ parsePattern = label "pattern" root effect = do start <- openBlockWith "{" - (inner, vs) <- effectBind <|> effectPure - end <- closeBlock + + -- After the opening curly brace, we are expecting either an EffectBind or an EffectPure: + -- + -- EffectBind EffectPure + -- + -- { foo bar -> baz } { qux } + -- ^^^^^^^^^^^^^^ ^^^ + -- + -- We accomplish that as follows: + -- + -- * First try EffectPure + "}" + -- * If that fails, back the parser up and try EffectBind + "}" instaed + -- + -- This won't always result in the best possible error messages, but it's not exactly trivial to do better, + -- requiring more sophisticated look-ahead logic. So, this is how it works for now. + (inner, vs, end) <- + asum + [ P.try do + (inner, vs) <- effectPure + end <- closeBlock + pure (inner, vs, end), + do + (inner, vs) <- effectBind + end <- closeBlock + pure (inner, vs, end) + ] + pure (Pattern.setLoc inner (ann start <> ann end), vs) -- ex: unique type Day = Mon | Tue | ... - nullaryCtor = P.try do - tok <- ctor CT.Data UnknownDataConstructor + nullaryCtor = do + tok <- ctor CT.Data pure (Pattern.Constructor (ann tok) (L.payload tok) [], []) constructor = do - tok <- ctor CT.Data UnknownDataConstructor + tok <- ctor CT.Data let f patterns vs = let loc = foldl (<>) (ann tok) $ map ann patterns in (Pattern.Constructor loc (L.payload tok) patterns, vs) @@ -369,16 +461,17 @@ handle = label "handle" do -- Meaning the newline gets overwritten when pretty-printing and it messes things up. pure $ Term.handle (handleSpan <> ann handler) handler b -checkCasesArities :: (Ord v, Annotated a) => NonEmpty (Int, a) -> P v m (Int, NonEmpty a) -checkCasesArities cases@((i, _) NonEmpty.:| rest) = - case List.find (\(j, _) -> j /= i) rest of +checkCasesArities :: (Ord v, Annotated a) => [(Int, a)] -> P v m (Int, [a]) +checkCasesArities = \case + [] -> pure (1, []) + cases@((i, _) : rest) -> case List.find (\(j, _) -> j /= i) rest of Nothing -> pure (i, snd <$> cases) Just (j, a) -> P.customFailure $ PatternArityMismatch i j (ann a) lamCase :: (Monad m, Var v) => TermP v m lamCase = do start <- openBlockWith "cases" - cases <- matchCases1 start + cases <- matchCases (arity, cases) <- checkCasesArities cases _ <- optionalCloseBlock lamvars <- replicateM arity (Parser.uniqueName 10) @@ -390,8 +483,8 @@ lamCase = do lamvarTerm = case lamvarTerms of [e] -> e es -> DD.tupleTerm es - anns = ann start <> ann (NonEmpty.last cases) - matchTerm = Term.match anns lamvarTerm (toList cases) + anns = foldr ((<>) . ann) (ann start) $ lastMay cases + matchTerm = Term.match anns lamvarTerm cases let annotatedVars = (Ann.GeneratedFrom $ ann start,) <$> vars pure $ Term.lam' anns annotatedVars matchTerm @@ -419,9 +512,6 @@ list = Parser.seq Term.list hashQualifiedPrefixTerm :: (Monad m, Var v) => TermP v m hashQualifiedPrefixTerm = resolveHashQualified =<< hqPrefixId -hashQualifiedInfixTerm :: (Monad m, Var v) => TermP v m -hashQualifiedInfixTerm = resolveHashQualified =<< hqInfixId - quasikeyword :: (Ord v) => Text -> P v m (L.Token ()) quasikeyword kw = queryToken \case L.WordyId (HQ'.NameOnly n) | nameIsKeyword n kw -> Just () @@ -438,14 +528,15 @@ nameIsKeyword name keyword = -- committed if that short hash can't be found in the current environment resolveHashQualified :: (Monad m, Var v) => L.Token (HQ.HashQualified Name) -> TermP v m resolveHashQualified tok = do - names <- asks names case L.payload tok of HQ.NameOnly n -> pure $ Term.var (ann tok) (Name.toVar n) - hqn -> case Names.lookupHQTerm Names.IncludeSuffixes hqn names of - s - | Set.null s -> failCommitted $ UnknownTerm tok s - | Set.size s > 1 -> failCommitted $ UnknownTerm tok s - | otherwise -> pure $ Term.fromReferent (ann tok) (Set.findMin s) + _ -> do + names <- asks names + case Names.lookupHQTerm Names.IncludeSuffixes (L.payload tok) names of + s + | Set.null s -> failCommitted $ UnknownTerm tok s + | Set.size s > 1 -> failCommitted $ UnknownTerm tok s + | otherwise -> pure $ Term.fromReferent (ann tok) (Set.findMin s) termLeaf :: forall m v. (Monad m, Var v) => TermP v m termLeaf = @@ -514,10 +605,9 @@ doc2Block :: forall m v. (Monad m, Var v) => P v m (Ann {- Annotation for the wh doc2Block = do L.Token docContents startDoc endDoc <- doc let docAnn = Ann startDoc endDoc - (docAnn,) . docUntitledSection (gann docAnn) <$> traverse (cata $ docTop <=< sequenceA) docContents + (docAnn,) . docUntitledSection (gann docAnn) <$> traverse foldTop docContents where - cata :: (Functor f) => (f a -> a) -> Cofree f x -> a - cata fn (_ :< fx) = fn $ cata fn <$> fx + foldTop = cataM \(a :<< top) -> docTop a =<< bitraverse (cataM \(a :<< leaf) -> docLeaf a leaf) pure top gann :: (Annotated a) => a -> Ann gann = Ann.GeneratedFrom . ann @@ -532,9 +622,9 @@ doc2Block = do docUntitledSection ann (Doc.UntitledSection tops) = Term.app ann (f ann "UntitledSection") $ Term.list (gann tops) tops - docTop :: Doc.Top (ReferenceType, HQ'.HashQualified Name) [L.Token L.Lexeme] (Term v Ann) -> TermP v m - docTop d = case d of - Doc.Section title body -> pure $ Term.apps' (f d "Section") [title, Term.list (gann body) body] + docTop :: Ann -> Doc.Top [L.Token L.Lexeme] (Term v Ann) (Term v Ann) -> TermP v m + docTop d = \case + Doc.Section title body -> pure $ Term.apps' (f d "Section") [docParagraph d title, Term.list (gann body) body] Doc.Eval code -> Term.app (gann d) (f d "Eval") . addDelay . snd <$> subParse (block' False False "syntax.docEval" (pure $ pure ()) $ Ann.External <$ P.eof) code @@ -545,25 +635,29 @@ doc2Block = do pure $ Term.apps' (f d "CodeBlock") - [Term.text (ann label) . Text.pack $ L.payload label, Term.text (ann body) . Text.pack $ L.payload body] + [Term.text d $ Text.pack label, Term.text d $ Text.pack body] + Doc.List' list -> pure $ docList d list + Doc.Paragraph' para -> pure $ docParagraph d para + + docParagraph d leaves = Term.app (gann d) (f d "Paragraph") . Term.list d $ toList leaves + + docList :: Ann -> Doc.List (Term v Ann) -> Term v Ann + docList d = \case Doc.BulletedList items -> - pure $ Term.app (gann d) (f d "BulletedList") . Term.list (gann items) . toList $ docColumn <$> items + Term.app (gann d) (f d "BulletedList") . Term.list (gann d) . toList $ docColumn d <$> items Doc.NumberedList items@((n, _) :| _) -> - pure $ - Term.apps' - (f d "NumberedList") - [Term.nat (ann d) $ L.payload n, Term.list (gann $ snd <$> items) . toList $ docColumn . snd <$> items] - Doc.Paragraph leaves -> - Term.app (gann d) (f d "Paragraph") . Term.list (ann leaves) . toList <$> traverse docLeaf leaves - - docColumn :: Doc.Column (Term v Ann) -> Term v Ann - docColumn d@(Doc.Column para sublist) = - Term.app (gann d) (f d "Column") . Term.list (gann d) $ para : toList sublist - - docLeaf :: Doc.Leaf (ReferenceType, HQ'.HashQualified Name) [L.Token L.Lexeme] (Term v Ann) -> TermP v m - docLeaf d = case d of - Doc.Link link -> Term.app (gann d) (f d "Link") <$> docEmbedLink link - Doc.NamedLink para target -> Term.apps' (f d "NamedLink") . (para :) . pure <$> docLeaf (vacuous target) + Term.apps' + (f d "NumberedList") + [Term.nat (ann d) $ n, Term.list (gann d) . toList $ docColumn d . snd <$> items] + + docColumn :: Ann -> Doc.Column (Term v Ann) -> Term v Ann + docColumn d (Doc.Column para sublist) = + Term.app (gann d) (f d "Column") . Term.list (gann d) $ docParagraph d para : toList (docList d <$> sublist) + + docLeaf :: Ann -> Doc.Leaf (L.Token (ReferenceType, HQ'.HashQualified Name)) [L.Token L.Lexeme] (Term v Ann) -> TermP v m + docLeaf d = \case + Doc.Link link -> Term.app (gann d) (f d "Link") <$> docEmbedLink d link + Doc.NamedLink para group -> pure $ Term.apps' (f d "NamedLink") [docParagraph d para, docGroup d group] Doc.Example code -> do trm <- subParse term code pure . Term.apps' (f d "Example") $ case trm of @@ -573,56 +667,56 @@ doc2Block = do lam = addDelay $ Term.lam' (ann tm) ((mempty,) <$> fvs) tm in [n, lam] tm -> [Term.nat (ann tm) 0, addDelay tm] - Doc.Transclude code -> Term.app (gann d) (f d "Transclude") <$> subParse term code - Doc.Bold para -> pure $ Term.app (gann d) (f d "Bold") para - Doc.Italic para -> pure $ Term.app (gann d) (f d "Italic") para - Doc.Strikethrough para -> pure $ Term.app (gann d) (f d "Strikethrough") para - Doc.Verbatim leaf -> Term.app (gann d) (f d "Verbatim") <$> docLeaf (bimap absurd absurd leaf) - Doc.Code leaf -> Term.app (gann d) (f d "Code") <$> docLeaf (bimap absurd absurd leaf) + Doc.Transclude' trans -> docTransclude d trans + Doc.Bold para -> pure . Term.app (gann d) (f d "Bold") $ docParagraph d para + Doc.Italic para -> pure . Term.app (gann d) (f d "Italic") $ docParagraph d para + Doc.Strikethrough para -> pure . Term.app (gann d) (f d "Strikethrough") $ docParagraph d para + Doc.Verbatim leaf -> pure . Term.app (gann d) (f d "Verbatim") $ docWord d leaf + Doc.Code leaf -> pure . Term.app (gann d) (f d "Code") $ docWord d leaf Doc.Source elems -> - Term.app (gann d) (f d "Source") . Term.list (ann elems) . toList <$> traverse docSourceElement elems + Term.app (gann d) (f d "Source") . Term.list d . toList <$> traverse (docSourceElement d) elems Doc.FoldedSource elems -> - Term.app (gann d) (f d "FoldedSource") . Term.list (ann elems) . toList <$> traverse docSourceElement elems + Term.app (gann d) (f d "FoldedSource") . Term.list d . toList <$> traverse (docSourceElement d) elems Doc.EvalInline code -> Term.app (gann d) (f d "EvalInline") . addDelay <$> subParse term code Doc.Signature links -> - Term.app (gann d) (f d "Signature") . Term.list (ann links) . toList <$> traverse docEmbedSignatureLink links - Doc.SignatureInline link -> Term.app (gann d) (f d "SignatureInline") <$> docEmbedSignatureLink link - Doc.Word txt -> pure . Term.app (gann d) (f d "Word") . Term.text (ann txt) . Text.pack $ L.payload txt - Doc.Group (Doc.Join leaves) -> - Term.app (gann d) (f d "Group") . Term.app (gann d) (f d "Join") . Term.list (ann leaves) . toList - <$> traverse docLeaf leaves - - docEmbedLink :: Doc.EmbedLink (ReferenceType, HQ'.HashQualified Name) -> TermP v m - docEmbedLink d@(Doc.EmbedLink (L.Token (level, ident) start end)) = case level of + Term.app (gann d) (f d "Signature") . Term.list d . toList <$> traverse (docEmbedSignatureLink d) links + Doc.SignatureInline link -> Term.app (gann d) (f d "SignatureInline") <$> docEmbedSignatureLink d link + Doc.Word' word -> pure $ docWord d word + Doc.Group' group -> pure $ docGroup d group + + docEmbedLink :: Ann -> Doc.EmbedLink (L.Token (ReferenceType, HQ'.HashQualified Name)) -> TermP v m + docEmbedLink d (Doc.EmbedLink (L.Token (level, ident) start end)) = case level of RtType -> Term.app (gann d) (f d "EmbedTypeLink") . Term.typeLink (ann d) . L.payload <$> findUniqueType (L.Token (HQ'.toHQ ident) start end) RtTerm -> Term.app (gann d) (f d "EmbedTermLink") . addDelay <$> resolveHashQualified (L.Token (HQ'.toHQ ident) start end) + docTransclude :: Ann -> Doc.Transclude [L.Token L.Lexeme] -> TermP v m + docTransclude d (Doc.Transclude code) = Term.app (gann d) (f d "Transclude") <$> subParse term code + docSourceElement :: - Doc.SourceElement - (ReferenceType, HQ'.HashQualified Name) - (Doc.Leaf (ReferenceType, HQ'.HashQualified Name) [L.Token L.Lexeme] Void) -> + Ann -> + Doc.SourceElement (L.Token (ReferenceType, HQ'.HashQualified Name)) (Doc.Transclude [L.Token L.Lexeme]) -> TermP v m - docSourceElement d@(Doc.SourceElement link anns) = do - link' <- docEmbedLink link - anns' <- traverse docEmbedAnnotation anns - pure $ Term.apps' (f d "SourceElement") [link', Term.list (ann anns) anns'] - - docEmbedSignatureLink :: Doc.EmbedSignatureLink (ReferenceType, HQ'.HashQualified Name) -> TermP v m - docEmbedSignatureLink d@(Doc.EmbedSignatureLink (L.Token (level, ident) start end)) = case level of + docSourceElement d (Doc.SourceElement link anns) = do + link' <- docEmbedLink d link + anns' <- traverse (docEmbedAnnotation d) anns + pure $ Term.apps' (f d "SourceElement") [link', Term.list d anns'] + + docEmbedSignatureLink :: + Ann -> Doc.EmbedSignatureLink (L.Token (ReferenceType, HQ'.HashQualified Name)) -> TermP v m + docEmbedSignatureLink d (Doc.EmbedSignatureLink (L.Token (level, ident) start end)) = case level of RtType -> P.customFailure . TypeNotAllowed $ L.Token (HQ'.toHQ ident) start end RtTerm -> Term.app (gann d) (f d "EmbedSignatureLink") . addDelay <$> resolveHashQualified (L.Token (HQ'.toHQ ident) start end) docEmbedAnnotation :: - Doc.EmbedAnnotation - (ReferenceType, HQ'.HashQualified Name) - (Doc.Leaf (ReferenceType, HQ'.HashQualified Name) [L.Token L.Lexeme] Void) -> + Ann -> + Doc.EmbedAnnotation (L.Token (ReferenceType, HQ'.HashQualified Name)) (Doc.Transclude [L.Token L.Lexeme]) -> TermP v m - docEmbedAnnotation d@(Doc.EmbedAnnotation a) = + docEmbedAnnotation d (Doc.EmbedAnnotation a) = -- This is the only place I’m not sure we’re doing the right thing. In the lexer, this can be an identifier or a -- DocLeaf, but here it could be either /text/ or a Doc element. And I don’t think there’s any way the lexemes -- produced for an identifier and the lexemes consumed for text line up. So, I think this is a bugfix I can’t @@ -633,9 +727,16 @@ doc2Block = do RtType -> P.customFailure . TypeNotAllowed $ L.Token (HQ'.toHQ ident) start end RtTerm -> resolveHashQualified $ L.Token (HQ'.toHQ ident) start end ) - (docLeaf . vacuous) + (docTransclude d) a + docWord :: Ann -> Doc.Word -> Term v Ann + docWord d (Doc.Word txt) = Term.app (gann d) (f d "Word") . Term.text d $ Text.pack txt + + docGroup :: Ann -> Doc.Group (Term v Ann) -> Term v Ann + docGroup d (Doc.Group (Doc.Join leaves)) = + Term.app d (f d "Group") . Term.app d (f d "Join") . Term.list (ann leaves) $ toList leaves + docBlock :: (Monad m, Var v) => TermP v m docBlock = do openTok <- openBlockWith "[:" @@ -1041,17 +1142,85 @@ term4 = f <$> some termLeaf f (func : args) = Term.apps func ((\a -> (ann func <> ann a, a)) <$> args) f [] = error "'some' shouldn't produce an empty list" +data InfixParse v + = InfixOp (L.Token (HQ.HashQualified Name)) (Term v Ann) (InfixParse v) (InfixParse v) + | InfixAnd (L.Token String) (InfixParse v) (InfixParse v) + | InfixOr (L.Token String) (InfixParse v) (InfixParse v) + | InfixOperand (Term v Ann) + deriving (Show, Eq, Ord) + -- e.g. term4 + term4 - term4 -- or term4 || term4 && term4 -infixAppOrBooleanOp :: (Monad m, Var v) => TermP v m -infixAppOrBooleanOp = chainl1 term4 (or <|> and <|> infixApp) +-- The algorithm works as follows: +-- 1. Parse the expression left-associated +-- 2. Starting at the leftmost operator subexpression, see if the next operator +-- has higher precedence. If so, rotate the expression to the right. +-- e.g. in `a + b * c`, we first parse `(a + b) * c` then rotate to `a + (b * c)`. +-- 3. Perform the algorithm on the right-hand side if necessary, as `b` might be +-- an infix expression with lower precedence than `*`. +-- 4. Proceed to the next operator to the right in the original expression and +-- repeat steps 2-3 until we reach the end. +infixAppOrBooleanOp :: forall m v. (Monad m, Var v) => TermP v m +infixAppOrBooleanOp = do + (p, ps) <- prelimParse + -- traceShowM ("orig" :: String, foldl' (flip ($)) p ps) + let p' = reassociate (p, ps) + -- traceShowM ("reassoc" :: String, p') + return (applyInfixOps p') where - or = orf <$> label "or" (reserved "||") - orf op lhs rhs = Term.or (ann lhs <> ann op <> ann rhs) lhs rhs - and = andf <$> label "and" (reserved "&&") - andf op lhs rhs = Term.and (ann lhs <> ann op <> ann rhs) lhs rhs - infixApp = infixAppf <$> label "infixApp" (hashQualifiedInfixTerm <* optional semi) - infixAppf op lhs rhs = Term.apps' op [lhs, rhs] + -- To handle a mix of infix operators with and without precedence rules, + -- we first parse the expression left-associated, then reassociate it + -- according to the precedence rules. + prelimParse = + chainl1Accum (InfixOperand <$> term4) genericInfixApp + genericInfixApp = + (InfixAnd <$> (label "and" (reserved "&&"))) + <|> (InfixOr <$> (label "or" (reserved "||"))) + <|> (uncurry InfixOp <$> parseInfix) + shouldRotate child parent = case (child, parent) of + (Just p1, Just p2) -> p1 < p2 + _ -> False + parseInfix = label "infixApp" do + op <- hqInfixId <* optional semi + resolved <- resolveHashQualified op + pure (op, resolved) + reassociate (exp, ops) = + foldl' checkOp exp ops + checkOp exp op = fixUp (op exp) + fixUp = \case + InfixOp op tm lhs rhs -> + rotate (unqualified op) (InfixOp op tm) lhs rhs + InfixAnd op lhs rhs -> + rotate "&&" (InfixAnd op) lhs rhs + InfixOr op lhs rhs -> + rotate "||" (InfixOr op) lhs rhs + x -> x + rotate op ctor lhs rhs = + case lhs of + InfixOp lop ltm ll lr + | shouldRotate (operatorPrecedence (unqualified lop)) (operatorPrecedence op) -> + InfixOp lop ltm ll (fixUp (ctor lr rhs)) + InfixAnd lop ll lr + | shouldRotate (operatorPrecedence "&&") (operatorPrecedence op) -> + InfixAnd lop ll (fixUp (ctor lr rhs)) + InfixOr lop ll lr + | shouldRotate (operatorPrecedence "||") (operatorPrecedence op) -> + InfixOr lop ll (fixUp (ctor lr rhs)) + _ -> ctor lhs rhs + unqualified t = Maybe.fromJust $ NameSegment.toEscapedText . Name.lastSegment <$> (HQ.toName $ L.payload t) + applyInfixOps :: InfixParse v -> Term v Ann + applyInfixOps t = case t of + InfixOp _ tm lhs rhs -> + Term.apps' tm [applyInfixOps lhs, applyInfixOps rhs] + InfixOperand tm -> tm + InfixAnd op lhs rhs -> + let lhs' = applyInfixOps lhs + rhs' = applyInfixOps rhs + in Term.and (ann lhs' <> ann op <> ann rhs') lhs' rhs' + InfixOr op lhs rhs -> + let lhs' = applyInfixOps lhs + rhs' = applyInfixOps rhs + in Term.or (ann lhs' <> ann op <> ann rhs') lhs' rhs' typedecl :: (Monad m, Var v) => P v m (L.Token v, Type v Ann) typedecl = @@ -1074,22 +1243,20 @@ verifyRelativeName' name = do -- example: -- (x, y) = foo --- hd +: tl | hd < 10 = [1,2,3] -- stuff -- -- desugars to: -- -- match foo with --- (x,y) -> match [1,2,3] with --- hd +: tl | hd < 10 -> stuff +-- (x,y) -> stuff -- destructuringBind :: forall m v. (Monad m, Var v) => P v m (Ann, Term v Ann -> Term v Ann) destructuringBind = do -- We have to look ahead as far as the `=` to know if this is a bind or -- just an action, for instance: - -- Some 42 + -- (Some 42) -- vs - -- Some 42 = List.head elems + -- (Some 42) = List.head elems (p, boundVars) <- P.try do (p, boundVars) <- parsePattern let boundVars' = snd <$> boundVars @@ -1249,14 +1416,14 @@ block' isTop implicitUnitAtEnd s openBlock closeBlock = do open <- openBlock (names, imports) <- imports _ <- optional semi - statements <- local (\e -> e {names = names}) $ sepBy semi statement + statements <- local (\e -> e {names}) $ sepBy semi statement end <- closeBlock body <- substImports names imports <$> go open statements pure (ann open <> ann end, body) where statement = asum [Binding <$> binding, DestructuringBind <$> destructuringBind, Action <$> blockTerm] go :: L.Token () -> [BlockElement v] -> P v m (Term v Ann) - go open bs = + go open = let finish :: Term.Term v Ann -> TermP v m finish tm = case Components.minimize' tm of Left dups -> customFailure $ DuplicateTermNames (toList dups) @@ -1296,7 +1463,7 @@ block' isTop implicitUnitAtEnd s openBlock closeBlock = do if implicitUnitAtEnd then (toList bs, DD.unitTerm a) else (toList bs, Term.var a (positionalVar a Var.missingResult)) - in toTm bs + in toTm number :: (Var v) => TermP v m number = number' (tok Term.int) (tok Term.nat) (tok Term.float) diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index 5c41701bf8..e516fb404a 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -7,6 +7,7 @@ module Unison.Syntax.TermPrinter prettyBinding, prettyBinding', prettyBindingWithoutTypeSignature, + prettyDoc2, pretty0, runPretty, prettyPattern, @@ -19,7 +20,6 @@ import Control.Monad.State qualified as State import Data.Char (isPrint) import Data.List import Data.List qualified as List -import Data.List.NonEmpty qualified as NEL import Data.Map qualified as Map import Data.Set qualified as Set import Data.Text (unpack) @@ -38,7 +38,6 @@ import Unison.HashQualified qualified as HQ import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name -import Unison.NameSegment (NameSegment) import Unison.Pattern (Pattern) import Unison.Pattern qualified as Pattern import Unison.Prelude @@ -55,6 +54,7 @@ import Unison.Syntax.Lexer.Unison (showEscapeChar) import Unison.Syntax.Name qualified as Name (isSymboly, parseText, parseTextEither, toText, unsafeParseText) import Unison.Syntax.NamePrinter (styleHashQualified'') import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText) +import Unison.Syntax.Precedence (InfixPrecedence (..), Precedence (..), increment, isTopLevelPrecedence, operatorPrecedence) import Unison.Syntax.TypePrinter qualified as TypePrinter import Unison.Term import Unison.Type (Type, pattern ForallsNamed') @@ -92,7 +92,7 @@ data AmbientContext = AmbientContext { -- The operator precedence of the enclosing context (a number from 0 to 11, -- or -1 to render without outer parentheses unconditionally). -- Function application has precedence 10. - precedence :: !Int, -- -2 indicates top level binding, this is occasionally useful + precedence :: !Precedence, blockContext :: !BlockContext, infixContext :: !InfixContext, imports :: !Imports, @@ -125,50 +125,58 @@ data DocLiteralContext We illustrate precedence rules as follows. - >=10 - 10f 10x + >=Application + (Application)f (Application)x This example shows that a function application f x is enclosed in - parentheses whenever the ambient precedence around it is >= 10, and that - when printing its two components, an ambient precedence of 10 is used in + parentheses whenever the ambient precedence around it is >= Application, and that + when printing its two components, an ambient precedence of Application is used in both places. The pretty-printer uses the following rules for printing terms. - >=12 - let x = (-1)y - 1z + >=Top + let x = (Bottom)y + (Statement)z - >=11 - ! 11x - ' 11x - 11x ? + >=Prefix + ! (Prefix)x + ' (Prefix)x + (Prefix)x ? - >=10 - 10f 10x 10y ... + >=(Application) + (Application)f (Application)x (Application)y ... termLink t typeLink t - >=3 - x -> 2y - 3x + 3y + ... 3z + >=(Infix +) + (Infix +)x + (Infix +)y + ... (Infix +)z - >=2 - if 0a then 0b else 0c - handle 0b with 0h - case 2x of - a | 2g -> 0b + Printing an infix operator in infix position has the following additional + rule: If the operator has a lower precedence than the ambient precedence, + it is enclosed in parentheses. If the operator has no precedence rule, + its precedence is assumed to be higher than any operator to its right, and + lower than any operator to its left. - >=0 - 10a : 0Int + >(Control) + x -> (Control)y + + >=(Control) + if (Annotation)a then (Annotation)b else (Annotation)c + handle (Annoration)b with (Annotation)h + case (Control)x of + a | (Control)g -> (Control)b + + >=(Annotation) + (Application)a : (Annotation)Int And the following for patterns. - >=11 - x@11p + >=Prefix + x@(Prefix)p - >=10 - Con 10p 10q ... + >=Application + Con (Application)p (Application)q ... -- never any external parens added around the following { p } @@ -191,7 +199,7 @@ pretty0 a tm | isTopLevelPrecedence (precedence a) && not (isBindingSoftHangable -- we allow use clause insertion here even when it otherwise wouldn't be -- (as long as the tm isn't soft hangable, if it gets soft hung then -- adding use clauses beforehand will mess things up) - tmp <- pretty0 (a {imports = im, precedence = -1}) tm + tmp <- pretty0 (a {imports = im, precedence = Bottom}) tm pure $ PP.lines (uses <> [tmp]) where (im, uses) = calcImports (imports a) tm @@ -217,19 +225,19 @@ pretty0 TermLink' r -> do n <- getPPE let name = elideFQN im $ PrettyPrintEnv.termName n r - pure . paren (p >= 10) $ + pure . paren (p >= Application) $ fmt S.LinkKeyword "termLink " <> parenIfInfix name ic (styleHashQualified'' (fmt $ S.TermReference r) name) TypeLink' r -> do n <- getPPE let name = elideFQN im $ PrettyPrintEnv.typeName n r - pure . paren (p >= 10) $ + pure . paren (p >= Application) $ fmt S.LinkKeyword "typeLink " <> parenIfInfix name ic (styleHashQualified'' (fmt $ S.TypeReference r) name) Ann' tm t -> do - tm' <- pretty0 (ac 10 Normal im doc) tm + tm' <- pretty0 (ac Application Normal im doc) tm tp' <- TypePrinter.pretty0 im 0 t - pure . paren (p >= 0) $ tm' <> PP.hang (fmt S.TypeAscriptionColon " :") tp' + pure . paren (p >= Annotation) $ tm' <> PP.hang (fmt S.TypeAscriptionColon " :") tp' Int' i -> pure . fmt S.NumericLiteral . l $ (if i >= 0 then ("+" ++ show i) else (show i)) Nat' u -> pure . fmt S.NumericLiteral . l $ show u Float' f -> pure . fmt S.NumericLiteral . l $ show f @@ -247,7 +255,7 @@ pretty0 where -- we only use this syntax if we're not wrapped in something else, -- to avoid possible round trip issues if the text ends at an odd column - useRaw _ | p >= 0 = Nothing + useRaw _ | p >= Annotation = Nothing useRaw s | Text.find (== '\n') s == Just '\n' && Text.all ok s = n 3 useRaw _ = Nothing ok ch = isPrint ch || ch == '\n' || ch == '\r' @@ -278,13 +286,13 @@ pretty0 conRef = Referent.Con ref CT.Effect pure $ styleHashQualified'' (fmt $ S.TermReference conRef) name Handle' h body -> do - pb <- pretty0 (ac 0 Block im doc) body - ph <- pretty0 (ac 0 Block im doc) h + pb <- pretty0 (ac Annotation Block im doc) body + ph <- pretty0 (ac Annotation Block im doc) h let hangHandler = case h of -- handle ... with cases LamsNamedMatch' [] _ -> \a b -> a <> " " <> b _ -> PP.hang - pure . paren (p >= 2) $ + pure . paren (p >= Control) $ if PP.isMultiLine pb || PP.isMultiLine ph then PP.lines @@ -301,36 +309,36 @@ pretty0 ] Delay' x | Match' _ _ <- x -> do - px <- pretty0 (ac 0 Block im doc) x + px <- pretty0 (ac Annotation Block im doc) x let hang = if isSoftHangable x then PP.softHang else PP.hang - pure . paren (p >= 3) $ + pure . paren (p > Control) $ fmt S.ControlKeyword "do" `hang` px | otherwise -> do let (im0', uses0) = calcImports im x - let allowUses = isLet x || p < 0 + let allowUses = isLet x || (p == Bottom) let im' = if allowUses then im0' else im let uses = if allowUses then uses0 else [] - let soft = isSoftHangable x && null uses && p < 3 + let soft = isSoftHangable x && null uses && p < Annotation let hang = if soft then PP.softHang else PP.hang - px <- pretty0 (ac 0 Block im' doc) x + px <- pretty0 (ac Annotation Block im' doc) x -- this makes sure we get proper indentation if `px` spills onto -- multiple lines, since `do` introduces layout block - let indent = PP.Width (if soft then 2 else 0) + (if soft && p < 3 then 1 else 0) - pure . paren (p >= 3) $ + let indent = PP.Width (if soft then 2 else 0) + (if soft && p < Application then 1 else 0) + pure . paren (p > Control) $ fmt S.ControlKeyword "do" `hang` PP.lines (uses <> [PP.indentNAfterNewline indent px]) List' xs -> do let listLink p = fmt (S.TypeReference Type.listRef) p let comma = listLink ", " `PP.orElse` ("\n" <> listLink ", ") - pelems <- traverse (fmap (PP.indentNAfterNewline 2) . pretty0 (ac 0 Normal im doc)) xs + pelems <- traverse (fmap (PP.indentNAfterNewline 2) . pretty0 (ac Annotation Normal im doc)) xs let open = listLink "[" `PP.orElse` listLink "[ " let close = listLink "]" `PP.orElse` ("\n" <> listLink "]") pure $ PP.group (open <> PP.sep comma pelems <> close) If' cond t f -> do - pcond <- pretty0 (ac 2 Block im doc) cond - pt <- pretty0 (ac 0 Block im doc) t - pf <- pretty0 (ac 0 Block im doc) f - pure . paren (p >= 2) $ + pcond <- pretty0 (ac Control Block im doc) cond + pt <- pretty0 (ac Annotation Block im doc) t + pf <- pretty0 (ac Annotation Block im doc) f + pure . paren (p >= Control) $ if PP.isMultiLine pcond then PP.lines @@ -360,19 +368,19 @@ pretty0 -- blah -- See `isDestructuringBind` definition. Match' scrutinee cs@[MatchCase pat guard (AbsN' vs body)] - | p <= 2 && isDestructuringBind scrutinee cs -> do + | p <= Control && isDestructuringBind scrutinee cs -> do n <- getPPE let letIntro = case bc of Block -> id Normal -> \x -> fmt S.ControlKeyword "let" `PP.hang` x lhs <- do - let (lhs, _) = prettyPattern n (ac 0 Block im doc) 10 vs pat + let (lhs, _) = prettyPattern n (ac Annotation Block im doc) Application vs pat guard' <- printGuard guard pure $ PP.group lhs `PP.hang` guard' let eq = fmt S.BindingEquals "=" - rhs <- pretty0 (ac (-1) Block im doc) scrutinee + rhs <- pretty0 (ac Bottom Block im doc) scrutinee letIntro <$> do - prettyBody <- pretty0 (ac (-1) Block im doc) body + prettyBody <- pretty0 (ac Bottom Block im doc) body pure $ PP.lines [ (lhs <> eq) `PP.hang` rhs, @@ -382,13 +390,13 @@ pretty0 printGuard Nothing = pure mempty printGuard (Just g') = do let (_, g) = ABT.unabs g' - prettyg <- pretty0 (ac 2 Normal im doc) g + prettyg <- pretty0 (ac Control Normal im doc) g pure $ fmt S.DelimiterChar "| " <> prettyg Match' scrutinee branches -> do - ps <- pretty0 (ac 2 Normal im doc) scrutinee + ps <- pretty0 (ac Control Normal im doc) scrutinee pbs <- printCase im doc (arity1Branches branches) -- don't print with `cases` syntax - pure . paren (p >= 2) $ + pure . paren (p >= Control) $ if PP.isMultiLine ps then PP.lines @@ -396,7 +404,7 @@ pretty0 fmt S.ControlKeyword " with" `PP.hang` pbs ] else (fmt S.ControlKeyword "match " <> ps <> fmt S.ControlKeyword " with") `PP.hang` pbs - Apps' f args -> paren (p >= 10) <$> (PP.hang <$> goNormal 9 f <*> PP.spacedTraverse (goNormal 10) args) + Apps' f args -> paren (p >= Application) <$> (PP.hang <$> goNormal (InfixOp Highest) f <*> PP.spacedTraverse (goNormal Application) args) t -> pure $ l "error: " <> l (show t) where goNormal prec tm = pretty0 (ac prec Normal im doc) tm @@ -416,6 +424,101 @@ pretty0 Ref' r -> isSymbolic $ PrettyPrintEnv.termName n (Referent.Ref r) Var' v -> isSymbolic $ HQ.unsafeFromVar v _ -> False + -- Gets the precedence of an infix operator, if it has one. + termPrecedence :: Term3 v PrintAnnotation -> Maybe Precedence + termPrecedence = \case + Ref' r -> + HQ.toName (PrettyPrintEnv.termName n (Referent.Ref r)) + >>= operatorPrecedence + . NameSegment.toEscapedText + . Name.lastSegment + Var' v -> + HQ.toName (HQ.unsafeFromVar v) + >>= operatorPrecedence + . NameSegment.toEscapedText + . Name.lastSegment + _ -> Nothing + prettyBinaryApp ctx term = + case (term, binaryOpsPred) of + BinaryAppPred' f a b -> + let prec = termPrecedence f + p = precedence ctx + im = imports ctx + doc = docContext ctx + in case unBinaryAppsPred' (term, binaryOpsPred) of + -- Only render infix operators as a table + -- if there's more than one of the same + -- operator in a row. + Just (apps@(_ : _ : _), lastArg) -> do + prettyLast <- pretty0 (ac (fromMaybe (InfixOp Highest) prec) Normal im doc) lastArg + prettyApps <- binaryApps apps prettyLast + pure $ paren (p > fromMaybe (InfixOp Lowest) prec) prettyApps + _ -> do + prettyF <- pretty0 (AmbientContext Application Normal Infix im doc False) f + prettyA <- prettyBinaryApp (ac (fromMaybe (InfixOp Lowest) prec) Normal im doc) a + -- We increment the precedence for the right-hand side + -- since we want parens if the right-hand side is an + -- infix operator app with the same precedence as the + -- current operator. + prettyB <- prettyBinaryApp (ac (maybe (InfixOp Highest) increment prec) Normal im doc) b + pure . parenNoGroup (p > fromMaybe (InfixOp Lowest) prec) $ + (prettyA <> " " <> prettyF <> " " <> prettyB) `PP.orElse` (prettyA <> "\n" <> PP.indent " " (prettyF <> " " <> prettyB)) + _ -> pretty0 ctx term + unBinaryAppsPred' :: + ( Term3 v PrintAnnotation, + Term3 v PrintAnnotation -> Bool + ) -> + Maybe + ( [ ( Term3 v PrintAnnotation, + Term3 v PrintAnnotation + ) + ], + Term3 v PrintAnnotation + ) + unBinaryAppsPred' (t, isInfix) = + go t isInfix + where + go t pred = + case unBinaryAppPred (t, pred) of + Just (f, x, y) -> + -- We only chain together infix operators in a table + -- if they are literally the same operator. + let inChain g = isInfix g && (g == f) + l = unBinaryAppsPred' (x, inChain) + in case l of + Just (as, xLast) -> Just ((xLast, f) : as, y) + Nothing -> Just ([(x, f)], y) + Nothing -> Nothing + + -- Render a binary infix operator sequence, like [(a2, f2), (a1, f1)], + -- meaning (a1 `f1` a2) `f2` (a3 rendered by the caller), producing + -- "a1 `f1` a2 `f2`". Except the operators are all symbolic, so we won't + -- produce any backticks. We build the result out from the right, + -- starting at `f2`. + binaryApps :: + [(Term3 v PrintAnnotation, Term3 v PrintAnnotation)] -> + Pretty SyntaxText -> + m (Pretty SyntaxText) + binaryApps xs last = + do + let xs' = reverse xs + psh <- join <$> traverse (uncurry (r (InfixOp Lowest))) (take 1 xs') + pst <- join <$> traverse (uncurry (r (InfixOp Highest))) (drop 1 xs') + let ps = psh <> pst + let unbroken = PP.spaced (ps <> [last]) + broken = PP.hang (head ps) . PP.column2 . psCols $ tail ps <> [last] + pure (unbroken `PP.orElse` broken) + where + psCols ps = case take 2 ps of + [x, y] -> (x, y) : psCols (drop 2 ps) + [x] -> [(x, "")] + [] -> [] + _ -> undefined + r p a f = + sequenceA + [ pretty0 (ac (if isBlock a then Top else fromMaybe p (termPrecedence f)) Normal im doc) a, + pretty0 (AmbientContext Application Normal Infix im doc False) f + ] case (term, binaryOpsPred) of (DD.Doc, _) | doc == MaybeDoc -> @@ -426,27 +529,27 @@ pretty0 let conRef = DD.pairCtorRef name <- elideFQN im <$> applyPPE2 PrettyPrintEnv.termName conRef let pair = parenIfInfix name ic $ styleHashQualified'' (fmt (S.TermReference conRef)) name - x' <- pretty0 (ac 10 Normal im doc) x - pure . paren (p >= 10) $ + x' <- pretty0 (ac Application Normal im doc) x + pure . paren (p >= Application) $ pair `PP.hang` PP.spaced [x', fmt (S.TermReference DD.unitCtorRef) "()"] (TupleTerm' xs, _) -> do let tupleLink p = fmt (S.TypeReference DD.pairRef) p let comma = tupleLink ", " `PP.orElse` ("\n" <> tupleLink ", ") - pelems <- traverse (fmap (PP.indentNAfterNewline 2) . goNormal 0) xs + pelems <- traverse (fmap (PP.indentNAfterNewline 2) . goNormal Annotation) xs let clist = PP.sep comma pelems let open = tupleLink "(" `PP.orElse` tupleLink "( " let close = tupleLink ")" `PP.orElse` ("\n" <> tupleLink ")") pure $ PP.group (open <> clist <> close) (App' f@(Builtin' "Any.Any") arg, _) -> - paren (p >= 10) <$> (PP.hang <$> goNormal 9 f <*> goNormal 10 arg) + paren (p >= Application) <$> (PP.hang <$> goNormal (InfixOp Highest) f <*> goNormal Application arg) (DD.Rewrites' rs, _) -> do let kw = fmt S.ControlKeyword "@rewrite" arr = fmt S.ControlKeyword "==>" control = fmt S.ControlKeyword - sub kw lhs = PP.sep " " <$> sequence [pure $ control kw, goNormal 0 lhs, pure arr] - go (DD.RewriteTerm' lhs rhs) = PP.hang <$> sub "term" lhs <*> goNormal 0 rhs - go (DD.RewriteCase' lhs rhs) = PP.hang <$> sub "case" lhs <*> goNormal 0 rhs + sub kw lhs = PP.sep " " <$> sequence [pure $ control kw, goNormal Annotation lhs, pure arr] + go (DD.RewriteTerm' lhs rhs) = PP.hang <$> sub "term" lhs <*> goNormal Annotation rhs + go (DD.RewriteCase' lhs rhs) = PP.hang <$> sub "case" lhs <*> goNormal Annotation rhs go (DD.RewriteSignature' vs lhs rhs) = do lhs <- TypePrinter.pretty0 im 0 lhs PP.hang (PP.sep " " (stuff lhs)) <$> TypePrinter.pretty0 im 0 rhs @@ -456,17 +559,29 @@ pretty0 <> [fmt S.Var (PP.text (Var.name v)) | v <- vs] <> (if null vs then [] else [fmt S.TypeOperator "."]) <> [lhs, arr] - go tm = goNormal 10 tm + go tm = goNormal Application tm PP.hang kw <$> fmap PP.lines (traverse go rs) (Bytes' bs, _) -> pure $ PP.group $ fmt S.BytesLiteral "0xs" <> PP.shown (Bytes.fromWord8s (map fromIntegral bs)) - BinaryAppsPred' apps lastArg -> do - prettyLast <- pretty0 (ac 3 Normal im doc) lastArg - prettyApps <- binaryApps apps prettyLast - pure $ paren (p >= 3) prettyApps - -- Note that && and || are at the same precedence, which can cause - -- confusion, so for clarity we do not want to elide the parentheses in a - -- case like `(x || y) && z`. + binApp@(BinaryAppPred' {}) -> do + v <- PP.group <$> prettyBinaryApp a (fst binApp) + pure v + (And' a b, _) -> do + let prec = operatorPrecedence "&&" + prettyF = fmt S.ControlKeyword "&&" + prettyA <- pretty0 (ac (fromMaybe (InfixOp Lowest) prec) Normal im doc) a + prettyB <- pretty0 (ac (fromMaybe (InfixOp Highest) prec) Normal im doc) b + pure . parenNoGroup (p > fromMaybe (InfixOp Lowest) prec) $ + (prettyA <> " " <> prettyF <> " " <> prettyB) + `PP.orElse` (prettyA <> "\n" <> PP.indent " " (prettyF <> " " <> prettyB)) + (Or' a b, _) -> do + let prec = operatorPrecedence "||" + prettyF = fmt S.ControlKeyword "||" + prettyA <- pretty0 (ac (fromMaybe (InfixOp Lowest) prec) Normal im doc) a + prettyB <- pretty0 (ac (fromMaybe (InfixOp Highest) prec) Normal im doc) b + pure . parenNoGroup (p > fromMaybe (InfixOp Lowest) prec) $ + (prettyA <> " " <> prettyF <> " " <> prettyB) + `PP.orElse` (prettyA <> "\n" <> PP.indent " " (prettyF <> " " <> prettyB)) {- When a delayed computation block is passed to a function as the last argument in a context where the ambient precedence is low enough, we can elide parentheses @@ -488,52 +603,36 @@ pretty0 ...) -} (App' x (Constructor' (ConstructorReference DD.UnitRef 0)), _) | isLeaf x -> do - px <- pretty0 (ac (if isBlock x then 0 else 9) Normal im doc) x - pure . paren (p >= 11 || isBlock x && p >= 3) $ + px <- pretty0 (ac (if isBlock x then Annotation else InfixOp Highest) Normal im doc) x + pure . paren (p >= Prefix || isBlock x && p >= (InfixOp Lowest)) $ px <> fmt S.Unit (l "()") (Apps' f (unsnoc -> Just (args, lastArg)), _) | isSoftHangable lastArg -> do - fun <- goNormal 9 f - args' <- traverse (goNormal 10) args - lastArg' <- goNormal 0 lastArg + fun <- goNormal (InfixOp Highest) f + args' <- traverse (goNormal Application) args + lastArg' <- goNormal Annotation lastArg let softTab = PP.softbreak <> ("" `PP.orElse` " ") - pure . paren (p >= 3) $ + pure . paren (p >= (InfixOp Lowest)) $ PP.group (PP.group (PP.group (PP.sep softTab (fun : args') <> softTab)) <> lastArg') - (Ands' xs lastArg, _) -> - paren (p >= 10) <$> do - lastArg' <- pretty0 (ac 10 Normal im doc) lastArg - booleanOps (fmt S.ControlKeyword "&&") xs lastArg' - (Ors' xs lastArg, _) -> - paren (p >= 10) <$> do - lastArg' <- pretty0 (ac 10 Normal im doc) lastArg - booleanOps (fmt S.ControlKeyword "||") xs lastArg' _other -> case (term, nonForcePred) of - OverappliedBinaryAppPred' f a b r - | binaryOpsPred f -> - -- Special case for overapplied binary op - do - prettyB <- pretty0 (ac 3 Normal im doc) b - prettyR <- PP.spacedTraverse (pretty0 (ac 10 Normal im doc)) r - prettyA <- binaryApps [(f, a)] prettyB - pure $ paren True $ PP.hang prettyA prettyR AppsPred' f args -> - paren (p >= 10) <$> do - f' <- pretty0 (ac 10 Normal im doc) f - args' <- PP.spacedTraverse (pretty0 (ac 10 Normal im doc)) args + paren (p >= Application) <$> do + f' <- pretty0 (ac Application Normal im doc) f + args' <- PP.spacedTraverse (pretty0 (ac Application Normal im doc)) args pure $ f' `PP.hang` args' _other -> case (term, \v -> nonUnitArgPred v && not (isDelay term)) of (LamsNamedMatch' [] branches, _) -> do pbs <- printCase im doc branches - pure . paren (p >= 3) $ + pure . paren (p >= InfixOp Lowest) $ PP.group (fmt S.ControlKeyword "cases") `PP.hang` pbs LamsNamedPred' vs body -> do - prettyBody <- pretty0 (ac 2 Normal im doc) body + prettyBody <- pretty0 (ac Control Normal im doc) body let hang = case body of Delay' (Lets' _ _) -> PP.softHang Lets' _ _ -> PP.softHang Match' _ _ -> PP.softHang _ -> PP.hang - pure . paren (p >= 3) $ + pure . paren (p >= InfixOp Lowest) $ PP.group (varList vs <> fmt S.ControlKeyword " ->") `hang` prettyBody _other -> go term @@ -553,14 +652,14 @@ pretty0 printLet elideUnit sc bs e im uses = do bs <- traverse printBinding bs body <- body e - pure . paren (sc /= Block && p >= 12) . letIntro $ PP.lines (uses <> bs <> body) + pure . paren (sc /= Block && p >= Top) . letIntro $ PP.lines (uses <> bs <> body) where body (Constructor' (ConstructorReference DD.UnitRef 0)) | elideUnit = pure [] - body e = (: []) <$> pretty0 (ac 0 Normal im doc) e + body e = (: []) <$> pretty0 (ac Annotation Normal im doc) e printBinding (v, binding) = if Var.isAction v - then pretty0 (ac (-1) Normal im doc) binding - else renderPrettyBinding <$> prettyBinding0' (ac (-1) Normal im doc) (HQ.unsafeFromVar v) binding + then pretty0 (ac Bottom Normal im doc) binding + else renderPrettyBinding <$> prettyBinding0' (ac Bottom Normal im doc) (HQ.unsafeFromVar v) binding letIntro = case sc of Block -> id Normal -> \x -> fmt S.ControlKeyword "let" `PP.hang` x @@ -573,64 +672,12 @@ pretty0 nonUnitArgPred :: (Var v) => v -> Bool nonUnitArgPred v = Var.name v /= "()" - -- Render a binary infix operator sequence, like [(a2, f2), (a1, f1)], - -- meaning (a1 `f1` a2) `f2` (a3 rendered by the caller), producing - -- "a1 `f1` a2 `f2`". Except the operators are all symbolic, so we won't - -- produce any backticks. We build the result out from the right, - -- starting at `f2`. - binaryApps :: - [(Term3 v PrintAnnotation, Term3 v PrintAnnotation)] -> - Pretty SyntaxText -> - m (Pretty SyntaxText) - binaryApps xs last = - do - ps <- join <$> traverse (uncurry r) (reverse xs) - let unbroken = PP.spaced (ps <> [last]) - broken = PP.hang (head ps) . PP.column2 . psCols $ tail ps <> [last] - pure (unbroken `PP.orElse` broken) - where - psCols ps = case take 2 ps of - [x, y] -> (x, y) : psCols (drop 2 ps) - [x] -> [(x, "")] - [] -> [] - _ -> undefined - r a f = - sequenceA - [ pretty0 (ac (if isBlock a then 12 else 3) Normal im doc) a, - pretty0 (AmbientContext 10 Normal Infix im doc False) f - ] - - -- Render sequence of infix &&s or ||s, like [x2, x1], - -- meaning (x1 && x2) && (x3 rendered by the caller), producing - -- "x1 && x2 &&". The result is built from the right. - booleanOps :: - Pretty SyntaxText -> - [Term3 v PrintAnnotation] -> - Pretty SyntaxText -> - m (Pretty SyntaxText) - booleanOps op xs last = do - ps <- join <$> traverse r (reverse xs) - let unbroken = PP.spaced (ps <> [last]) - broken = PP.hang (head ps) . PP.column2 . psCols $ tail ps <> [last] - pure (unbroken `PP.orElse` broken) - where - psCols ps = case take 2 ps of - [x, y] -> (x, y) : psCols (drop 2 ps) - [x] -> [(x, "")] - [] -> [] - _ -> undefined - r a = - sequence - [ pretty0 (ac (if isBlock a then 12 else 10) Normal im doc) a, - pure op - ] - prettyPattern :: forall v loc. (Var v) => PrettyPrintEnv -> AmbientContext -> - Int -> + Precedence -> [v] -> Pattern loc -> (Pretty SyntaxText, [v]) @@ -657,7 +704,7 @@ prettyPattern n c@AmbientContext {imports = im} p vs patt = case patt of Pattern.Text _ t -> (fmt S.TextLiteral $ l $ show t, vs) TuplePattern pats | length pats /= 1 -> - let (pats_printed, tail_vs) = patterns (-1) vs pats + let (pats_printed, tail_vs) = patterns Bottom vs pats in (PP.parenthesizeCommas pats_printed, tail_vs) Pattern.Constructor _ ref [] -> (styleHashQualified'' (fmt $ S.TermReference conRef) name, vs) @@ -665,10 +712,10 @@ prettyPattern n c@AmbientContext {imports = im} p vs patt = case patt of name = elideFQN im $ PrettyPrintEnv.termName n conRef conRef = Referent.Con ref CT.Data Pattern.Constructor _ ref pats -> - let (pats_printed, tail_vs) = patternsSep 10 PP.softbreak vs pats + let (pats_printed, tail_vs) = patternsSep Application PP.softbreak vs pats name = elideFQN im $ PrettyPrintEnv.termName n conRef conRef = Referent.Con ref CT.Data - in ( paren (p >= 10) $ + in ( paren (p >= Application) $ styleHashQualified'' (fmt $ S.TermReference conRef) name `PP.hang` pats_printed, tail_vs @@ -676,15 +723,15 @@ prettyPattern n c@AmbientContext {imports = im} p vs patt = case patt of Pattern.As _ pat -> case vs of (v : tail_vs) -> - let (printed, eventual_tail) = prettyPattern n c 11 tail_vs pat - in (paren (p >= 11) (fmt S.Var (l $ Var.nameStr v) <> fmt S.DelimiterChar (l "@") <> printed), eventual_tail) + let (printed, eventual_tail) = prettyPattern n c Prefix tail_vs pat + in (paren (p >= Prefix) (fmt S.Var (l $ Var.nameStr v) <> fmt S.DelimiterChar (l "@") <> printed), eventual_tail) _ -> error "prettyPattern: Expected at least one var" Pattern.EffectPure _ pat -> - let (printed, eventual_tail) = prettyPattern n c (-1) vs pat + let (printed, eventual_tail) = prettyPattern n c Bottom vs pat in (PP.sep " " [fmt S.DelimiterChar "{", printed, fmt S.DelimiterChar "}"], eventual_tail) Pattern.EffectBind _ ref pats k_pat -> - let (pats_printed, tail_vs) = patternsSep 10 PP.softbreak vs pats - (k_pat_printed, eventual_tail) = prettyPattern n c 0 tail_vs k_pat + let (pats_printed, tail_vs) = patternsSep Application PP.softbreak vs pats + (k_pat_printed, eventual_tail) = prettyPattern n c Annotation tail_vs k_pat name = elideFQN im $ PrettyPrintEnv.termName n conRef conRef = Referent.Con ref CT.Effect in ( PP.group @@ -700,16 +747,16 @@ prettyPattern n c@AmbientContext {imports = im} p vs patt = case patt of eventual_tail ) Pattern.SequenceLiteral _ pats -> - let (pats_printed, tail_vs) = patternsSep (-1) (fmt S.DelimiterChar ", ") vs pats + let (pats_printed, tail_vs) = patternsSep Bottom (fmt S.DelimiterChar ", ") vs pats in (fmt S.DelimiterChar "[" <> pats_printed <> fmt S.DelimiterChar "]", tail_vs) Pattern.SequenceOp _ l op r -> let (pl, lvs) = prettyPattern n c p vs l - (pr, rvs) = prettyPattern n c (p + 1) lvs r + (pr, rvs) = prettyPattern n c (increment p) lvs r f i s = (paren (p >= i) (pl <> " " <> fmt (S.Op op) s <> " " <> pr), rvs) in case op of - Pattern.Cons -> f 0 "+:" - Pattern.Snoc -> f 0 ":+" - Pattern.Concat -> f 0 "++" + Pattern.Cons -> f Annotation "+:" + Pattern.Snoc -> f Annotation ":+" + Pattern.Concat -> f Annotation "++" where l :: (IsString s) => String -> s l = fromString @@ -792,14 +839,14 @@ printCase im doc ms0 = grid = traverse go ms patLhs env vs pats = case pats of - [pat] -> PP.group (fst (prettyPattern env (ac 0 Block im doc) (-1) vs pat)) + [pat] -> PP.group (fst (prettyPattern env (ac Annotation Block im doc) Bottom vs pat)) pats -> PP.group . PP.sep (PP.indentAfterNewline " " $ "," <> PP.softbreak) . (`evalState` vs) . for pats $ \pat -> do vs <- State.get - let (p, rem) = prettyPattern env (ac 0 Block im doc) (-1) vs pat + let (p, rem) = prettyPattern env (ac Annotation Block im doc) Bottom vs pat State.put rem pure p arrow = fmt S.ControlKeyword "->" @@ -822,8 +869,8 @@ printCase im doc ms0 = -- strip off any Abs-chain around the guard, guard variables are rendered -- like any other variable, ex: case Foo x y | x < y -> ... PP.spaceIfNeeded (fmt S.DelimiterChar "|") - <$> pretty0 (ac 2 Normal im doc) g - printBody = pretty0 (ac 0 Block im doc) + <$> pretty0 (ac Control Normal im doc) g + printBody = pretty0 (ac Annotation Block im doc) -- A pretty term binding, split into the type signature (possibly empty) and the term. data PrettyBinding = PrettyBinding @@ -882,7 +929,7 @@ prettyBinding_ :: Term2 v at ap v a -> Pretty SyntaxText prettyBinding_ go ppe n tm = - runPretty (avoidShadowing tm ppe) . fmap go $ prettyBinding0 (ac (-2) Block Map.empty MaybeDoc) n tm + runPretty (avoidShadowing tm ppe) . fmap go $ prettyBinding0 (ac Basement Block Map.empty MaybeDoc) n tm prettyBinding' :: (Var v) => @@ -1062,8 +1109,11 @@ prettyDoc n im term = spaceUnlessBroken = PP.orElse " " "" paren :: Bool -> Pretty SyntaxText -> Pretty SyntaxText -paren True s = PP.group $ fmt S.Parenthesis "(" <> s <> fmt S.Parenthesis ")" -paren False s = PP.group s +paren b s = PP.group $ parenNoGroup b s + +parenNoGroup :: Bool -> Pretty SyntaxText -> Pretty SyntaxText +parenNoGroup True s = fmt S.Parenthesis "(" <> s <> fmt S.Parenthesis ")" +parenNoGroup False s = s parenIfInfix :: HQ.HashQualified Name -> @@ -1080,12 +1130,12 @@ isSymbolic = maybe False Name.isSymboly . HQ.toName emptyAc :: AmbientContext -emptyAc = ac (-1) Normal Map.empty MaybeDoc +emptyAc = ac Bottom Normal Map.empty MaybeDoc emptyBlockAc :: AmbientContext -emptyBlockAc = ac (-1) Block Map.empty MaybeDoc +emptyBlockAc = ac Bottom Block Map.empty MaybeDoc -ac :: Int -> BlockContext -> Imports -> DocLiteralContext -> AmbientContext +ac :: Precedence -> BlockContext -> Imports -> DocLiteralContext -> AmbientContext ac prec bc im doc = AmbientContext prec bc NonInfix im doc False fmt :: S.Element r -> Pretty (S.SyntaxText' r) -> Pretty (S.SyntaxText' r) @@ -1235,7 +1285,6 @@ instance Monoid PrintAnnotation where suffixCounterTerm :: (Var v) => PrettyPrintEnv -> Set Name -> Set Name -> Term2 v at ap v a -> PrintAnnotation suffixCounterTerm n usedTm usedTy = \case - Var' v -> countHQ mempty $ HQ.unsafeFromVar v Ref' r -> countHQ usedTm $ PrettyPrintEnv.termName n (Referent.Ref r) Constructor' r | noImportRefs (r ^. ConstructorReference.reference_) -> mempty Constructor' r -> countHQ usedTm $ PrettyPrintEnv.termName n (Referent.Con r CT.Data) @@ -1578,13 +1627,15 @@ isDestructuringBind scrutinee [MatchCase pat _ (ABT.AbsN' vs _)] = Pattern.Unbound _ -> False isDestructuringBind _ _ = False -isBlock :: (Ord v) => Term2 vt at ap v a -> Bool +isBlock :: (Var v, Ord v) => Term2 vt at ap v a -> Bool isBlock tm = case tm of If' {} -> True Handle' _ _ -> True Match' _ _ -> True LetBlock _ _ -> True + DDelay' _ -> True + Delay' _ -> True _ -> False pattern LetBlock :: @@ -2116,7 +2167,9 @@ nameEndsWith ppe suffix r = case PrettyPrintEnv.termName ppe (Referent.Ref r) of -- 1. Form the set of all local variables used anywhere in the term -- 2. When picking a name for a term, see if it is contained in this set. -- If yes: use a minimally qualified name which is longer than the suffixed name, --- but doesn't conflict with any local vars. +-- but doesn't conflict with any local vars. If even the fully-qualified +-- name conflicts with any local vars, make it absolute. (This relies on +-- disallowing absolute names for local variables). -- If no: use the suffixed name for the term -- -- The algorithm does the same for type references in signatures. @@ -2140,25 +2193,19 @@ avoidShadowing tm (PrettyPrintEnv terms types) = usedTypeNames = Set.fromList [n | Ann' _ ty <- ABT.subterms tm, v <- ABT.allVars ty, n <- varToName v] tweak :: Set Name -> (HQ'.HashQualified Name, HQ'.HashQualified Name) -> (HQ'.HashQualified Name, HQ'.HashQualified Name) - tweak used (fullName, HQ'.NameOnly suffixedName) + tweak used (HQ'.NameOnly fullName, HQ'.NameOnly suffixedName) | Set.member suffixedName used = - let revFQNSegments :: NEL.NonEmpty NameSegment - revFQNSegments = Name.reverseSegments (HQ'.toName fullName) - minimallySuffixed :: HQ'.HashQualified Name - minimallySuffixed = - revFQNSegments - -- Get all suffixes (it's inits instead of tails because name segments are in reverse order) - & NEL.inits - -- Drop the empty 'init' - & NEL.tail - & mapMaybe (fmap Name.fromReverseSegments . NEL.nonEmpty) -- Convert back into names + let resuffixifiedName :: Name + resuffixifiedName = + fullName + & Name.suffixes -- Drop the suffixes that we know are shorter than the suffixified name & List.drop (Name.countSegments suffixedName) - -- Drop the suffixes that are equal to local variables - & filter ((\n -> n `Set.notMember` used)) - & listToMaybe - & maybe fullName HQ'.NameOnly - in (fullName, minimallySuffixed) + -- Find the first (shortest) suffix that isn't in the used set + & find (\n -> n `Set.notMember` used) + -- If there isn't one, use the absolut-ified full name + & fromMaybe (Name.makeAbsolute fullName) + in (HQ'.NameOnly fullName, HQ'.NameOnly resuffixifiedName) tweak _ p = p varToName :: (Var v) => v -> [Name] varToName = toList . Name.parseText . Var.name @@ -2169,7 +2216,3 @@ isLeaf (Constructor' {}) = True isLeaf (Request' {}) = True isLeaf (Ref' {}) = True isLeaf _ = False - --- | Indicates this is the RHS of a top-level definition. -isTopLevelPrecedence :: Int -> Bool -isTopLevelPrecedence i = i == -2 diff --git a/parser-typechecker/src/Unison/Typechecker.hs b/parser-typechecker/src/Unison/Typechecker.hs index b40b5a5626..20b4fe8918 100644 --- a/parser-typechecker/src/Unison/Typechecker.hs +++ b/parser-typechecker/src/Unison/Typechecker.hs @@ -21,13 +21,7 @@ where import Control.Lens import Control.Monad.Fail (fail) -import Control.Monad.State - ( State, - StateT, - execState, - get, - modify, - ) +import Control.Monad.State (State, StateT, execState, get, modify) import Control.Monad.Writer import Data.Foldable import Data.Map qualified as Map @@ -92,7 +86,12 @@ data Env v loc = Env -- -- This mapping is populated before typechecking with as few entries -- as are needed to help resolve variables needing TDNR in the file. - termsByShortname :: Map Name.Name [NamedReference v loc] + -- + -- - Left means a term in the file (for which we don't have a type before typechecking) + -- - Right means a term/constructor in the namespace, or a constructor in the file (for which we do have a type + -- before typechecking) + termsByShortname :: Map Name.Name [Either Name.Name (NamedReference v loc)], + topLevelComponents :: Map Name.Name (NamedReference v loc) } deriving stock (Generic) @@ -234,8 +233,7 @@ typeDirectedNameResolution ppe oldNotes oldType env = do addTypedComponent (Context.TopLevelComponent vtts) = for_ vtts \(v, typ, _) -> let name = Name.unsafeParseVar (Var.reset v) - in for_ (Name.suffixes name) \suffix -> - #termsByShortname %= Map.insertWith (<>) suffix [NamedReference name typ (Context.ReplacementVar v)] + in #topLevelComponents %= Map.insert name (NamedReference name typ (Context.ReplacementVar v)) addTypedComponent _ = pure () suggest :: [Resolution v loc] -> Result (Notes v loc) () @@ -305,7 +303,12 @@ typeDirectedNameResolution ppe oldNotes oldType env = do resolveNote env = \case Context.SolvedBlank (B.Resolve loc str) v it -> do let shortname = Name.unsafeParseText (Text.pack str) - matches = Map.findWithDefault [] shortname env.termsByShortname + matches = + env.termsByShortname + & Map.findWithDefault [] shortname + & mapMaybe \case + Left longname -> Map.lookup longname env.topLevelComponents + Right namedRef -> Just namedRef suggestions <- wither (resolve it) matches pure $ Just diff --git a/parser-typechecker/src/Unison/Typechecker/Context.hs b/parser-typechecker/src/Unison/Typechecker/Context.hs index 214fe95a0c..767fa37316 100644 --- a/parser-typechecker/src/Unison/Typechecker/Context.hs +++ b/parser-typechecker/src/Unison/Typechecker/Context.hs @@ -1526,10 +1526,8 @@ ensurePatternCoverage theMatch _theMatchType _scrutinee scrutineeType cases = do } (redundant, _inaccessible, uncovered) <- flip evalStateT pmcState do checkMatch scrutineeType cases - let checkUncovered = case Nel.nonEmpty uncovered of - Nothing -> pure () - Just xs -> failWith (UncoveredPatterns matchLoc xs) - checkRedundant = foldr (\a b -> failWith (RedundantPattern a) *> b) (pure ()) redundant + let checkUncovered = maybe (pure ()) (failWith . UncoveredPatterns matchLoc) $ Nel.nonEmpty uncovered + checkRedundant = foldr ((*>) . failWith . RedundantPattern) (pure ()) redundant checkUncovered *> checkRedundant checkCases :: diff --git a/parser-typechecker/src/Unison/UnisonFile.hs b/parser-typechecker/src/Unison/UnisonFile.hs index 7aaa1f5cd2..785482bac6 100644 --- a/parser-typechecker/src/Unison/UnisonFile.hs +++ b/parser-typechecker/src/Unison/UnisonFile.hs @@ -57,7 +57,7 @@ import Unison.Hashing.V2.Convert qualified as Hashing import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.Prelude -import Unison.Reference (Reference) +import Unison.Reference (Reference, TermReference, TypeReference) import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent import Unison.Term (Term) @@ -66,6 +66,7 @@ import Unison.Type (Type) import Unison.Type qualified as Type import Unison.Typechecker.TypeLookup qualified as TL import Unison.UnisonFile.Type (TypecheckedUnisonFile (..), UnisonFile (..), pattern TypecheckedUnisonFile, pattern UnisonFile) +import Unison.Util.Defns (Defns (..), DefnsF) import Unison.Util.List qualified as List import Unison.Var (Var) import Unison.Var qualified as Var @@ -84,7 +85,7 @@ emptyUnisonFile = leftBiasedMerge :: forall v a. (Ord v) => UnisonFile v a -> UnisonFile v a -> UnisonFile v a leftBiasedMerge lhs rhs = - let mergedTerms = Map.foldlWithKey' (addNotIn lhsTermNames) (terms lhs) (terms rhs) + let mergedTerms = Map.foldlWithKey' (addNotIn lhsTermNames) lhs.terms rhs.terms mergedWatches = Map.foldlWithKey' addWatch (watches lhs) (watches rhs) mergedDataDecls = Map.foldlWithKey' (addNotIn lhsTypeNames) (dataDeclarationsId lhs) (dataDeclarationsId rhs) mergedEffectDecls = Map.foldlWithKey' (addNotIn lhsTypeNames) (effectDeclarationsId lhs) (effectDeclarationsId rhs) @@ -96,7 +97,7 @@ leftBiasedMerge lhs rhs = } where lhsTermNames = - Map.keysSet (terms lhs) + Map.keysSet lhs.terms <> foldMap (\x -> Set.fromList [v | (v, _, _) <- x]) (watches lhs) lhsTypeNames = @@ -132,7 +133,7 @@ allWatches = join . Map.elems . watches -- | Get the location of a given definition in the file. definitionLocation :: (Var v) => v -> UnisonFile v a -> Maybe a definitionLocation v uf = - terms uf ^? ix v . _1 + uf.terms ^? ix v . _1 <|> watches uf ^? folded . folded . filteredBy (_1 . only v) . _2 <|> dataDeclarations uf ^? ix v . _2 . to DD.annotation <|> effectDeclarations uf ^? ix v . _2 . to (DD.annotation . DD.toDataDecl) @@ -152,7 +153,7 @@ typecheckingTerm uf = termBindings :: UnisonFile v a -> [(v, a, Term v a)] termBindings uf = - Map.foldrWithKey (\k (a, t) b -> (k, a, t) : b) [] (terms uf) + Map.foldrWithKey (\k (a, t) b -> (k, a, t) : b) [] uf.terms -- backwards compatibility with the old data type dataDeclarations' :: TypecheckedUnisonFile v a -> Map v (Reference, DataDeclaration v a) @@ -337,12 +338,20 @@ termSignatureExternalLabeledDependencies -- Returns the dependencies of the `UnisonFile` input. Needed so we can -- load information about these dependencies before starting typechecking. -dependencies :: (Monoid a, Var v) => UnisonFile v a -> Set Reference -dependencies (UnisonFile ds es ts ws) = - foldMap (DD.typeDependencies . snd) ds - <> foldMap (DD.typeDependencies . DD.toDataDecl . snd) es - <> foldMap (Term.dependencies . snd) ts - <> foldMap (foldMap (Term.dependencies . view _3)) ws +dependencies :: (Monoid a, Var v) => UnisonFile v a -> DefnsF Set TermReference TypeReference +dependencies file = + fold + [ Defns + { terms = Set.empty, + types = + Set.unions + [ foldMap (DD.typeDependencies . snd) file.dataDeclarationsId, + foldMap (DD.typeDependencies . DD.toDataDecl . snd) file.effectDeclarationsId + ] + }, + foldMap (Term.dependencies . snd) file.terms, + foldMap (foldMap (Term.dependencies . view _3)) file.watches + ] discardTypes :: (Ord v) => TypecheckedUnisonFile v a -> UnisonFile v a discardTypes (TypecheckedUnisonFileId datas effects terms watches _) = @@ -397,7 +406,7 @@ constructorsForDecls types uf = -- | All bindings in the term namespace: terms, test watches (since those are the only watches that are actually stored -- in the codebase), data constructors, and effect constructors. -termNamespaceBindings :: Ord v => TypecheckedUnisonFile v a -> Set v +termNamespaceBindings :: (Ord v) => TypecheckedUnisonFile v a -> Set v termNamespaceBindings uf = terms <> tests <> datacons <> effcons where @@ -413,7 +422,7 @@ termNamespaceBindings uf = uf.effectDeclarationsId' -- | All bindings in the term namespace: data declarations and effect declarations. -typeNamespaceBindings :: Ord v => TypecheckedUnisonFile v a -> Set v +typeNamespaceBindings :: (Ord v) => TypecheckedUnisonFile v a -> Set v typeNamespaceBindings uf = datas <> effs where diff --git a/parser-typechecker/src/Unison/UnisonFile/Names.hs b/parser-typechecker/src/Unison/UnisonFile/Names.hs index 00fdd5f115..c6ead705a1 100644 --- a/parser-typechecker/src/Unison/UnisonFile/Names.hs +++ b/parser-typechecker/src/Unison/UnisonFile/Names.hs @@ -1,7 +1,13 @@ -module Unison.UnisonFile.Names where +module Unison.UnisonFile.Names + ( addNamesFromTypeCheckedUnisonFile, + environmentFor, + toNames, + toTermAndWatchNames, + typecheckedToNames, + ) +where -import Control.Lens -import Data.List.Extra (nubOrd) +import Control.Lens (_1) import Data.Map qualified as Map import Data.Set qualified as Set import Unison.ABT qualified as ABT @@ -9,23 +15,19 @@ import Unison.DataDeclaration (DataDeclaration, EffectDeclaration (..)) import Unison.DataDeclaration qualified as DD import Unison.DataDeclaration.Names qualified as DD.Names import Unison.Hashing.V2.Convert qualified as Hashing -import Unison.Name qualified as Name import Unison.Names (Names (..)) +import Unison.Names qualified as Names import Unison.Names.ResolutionResult qualified as Names -import Unison.NamesWithHistory qualified as Names import Unison.Prelude import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent import Unison.Syntax.Name qualified as Name -import Unison.Term qualified as Term import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Env (Env (..)) import Unison.UnisonFile.Error (Error (DupDataAndAbility, UnknownType)) -import Unison.UnisonFile.Type (TypecheckedUnisonFile (TypecheckedUnisonFileId), UnisonFile (UnisonFileId)) -import Unison.Util.List qualified as List +import Unison.UnisonFile.Type (TypecheckedUnisonFile, UnisonFile) import Unison.Util.Relation qualified as Relation import Unison.Var (Var) -import Unison.Var qualified as Var import Unison.WatchKind qualified as WK toNames :: (Var v) => UnisonFile v a -> Names @@ -34,8 +36,16 @@ toNames uf = datas <> effects datas = foldMap (DD.Names.dataDeclToNames' Name.unsafeParseVar) (Map.toList (UF.dataDeclarationsId uf)) effects = foldMap (DD.Names.effectDeclToNames' Name.unsafeParseVar) (Map.toList (UF.effectDeclarationsId uf)) -addNamesFromUnisonFile :: (Var v) => UnisonFile v a -> Names -> Names -addNamesFromUnisonFile unisonFile names = Names.shadowing (toNames unisonFile) names +-- | The set of all term and test watch names. No constructors. +toTermAndWatchNames :: (Var v) => UnisonFile v a -> Set v +toTermAndWatchNames uf = + Map.keysSet uf.terms + <> foldMap + ( \case + (WK.TestWatch, xs) -> Set.fromList (map (view _1) xs) + _ -> Set.empty + ) + (Map.toList uf.watches) typecheckedToNames :: (Var v) => TypecheckedUnisonFile v a -> Names typecheckedToNames uf = Names (terms <> ctors) types @@ -64,58 +74,6 @@ typecheckedToNames uf = Names (terms <> ctors) types addNamesFromTypeCheckedUnisonFile :: (Var v) => TypecheckedUnisonFile v a -> Names -> Names addNamesFromTypeCheckedUnisonFile unisonFile names = Names.shadowing (typecheckedToNames unisonFile) names -typecheckedUnisonFile0 :: (Ord v) => TypecheckedUnisonFile v a -typecheckedUnisonFile0 = TypecheckedUnisonFileId Map.empty Map.empty mempty mempty mempty - --- Substitutes free type and term variables occurring in the terms of this --- `UnisonFile` using `externalNames`. --- --- Hash-qualified names are substituted during parsing, but non-HQ names are --- substituted at the end of parsing, since they can be locally bound. Example, in --- `x -> x + math.sqrt 2`, we don't know if `math.sqrt` is locally bound until --- we are done parsing, whereas `math.sqrt#abc` can be resolved immediately --- as it can't refer to a local definition. -bindNames :: - (Var v) => - Names -> - UnisonFile v a -> - Names.ResolutionResult v a (UnisonFile v a) -bindNames names (UnisonFileId d e ts ws) = do - -- todo: consider having some kind of binding structure for terms & watches - -- so that you don't weirdly have free vars to tiptoe around. - -- The free vars should just be the things that need to be bound externally. - let termVarsSet = Map.keysSet ts <> Set.fromList (Map.elems ws >>= map (view _1)) - -- todo: can we clean up this lambda using something like `second` - ts' <- traverse (\(a, t) -> (a,) <$> Term.bindNames Name.unsafeParseVar termVarsSet names t) ts - ws' <- traverse (traverse (\(v, a, t) -> (v,a,) <$> Term.bindNames Name.unsafeParseVar termVarsSet names t)) ws - pure $ UnisonFileId d e ts' ws' - --- | Given the set of fully-qualified variable names, this computes --- a Map from unique suffixes to the fully qualified name. --- --- Example, given [foo.bar, qux.bar, baz.quaffle], this returns: --- --- Map [ foo.bar -> foo.bar --- , qux.bar -> qux.bar --- , baz.quaffle -> baz.quaffle --- , quaffle -> baz.quaffle --- ] --- --- This is used to replace variable references with their canonical --- fully qualified variables. --- --- It's used below in `environmentFor` and also during the term resolution --- process. -variableCanonicalizer :: forall v. (Var v) => [v] -> Map v v -variableCanonicalizer vs = - done $ List.multimap do - v <- vs - let n = Name.unsafeParseVar v - suffix <- Name.suffixes n - pure (Var.named (Name.toText suffix), v) - where - done xs = Map.fromList [(k, v) | (k, nubOrd -> [v]) <- Map.toList xs] <> Map.fromList [(v, v) | v <- vs] - -- This function computes hashes for data and effect declarations, and -- also returns a function for resolving strings to (Reference, ConstructorId) -- for parsing of pattern matching @@ -128,14 +86,16 @@ environmentFor :: Names -> Map v (DataDeclaration v a) -> Map v (EffectDeclaration v a) -> - Names.ResolutionResult v a (Either [Error v a] (Env v a)) + Names.ResolutionResult a (Either [Error v a] (Env v a)) environmentFor names dataDecls0 effectDecls0 = do - let locallyBoundTypes = variableCanonicalizer (Map.keys dataDecls0 <> Map.keys effectDecls0) - -- data decls and hash decls may reference each other, and thus must be hashed together + let locallyBoundTypes = Map.keysSet dataDecls0 <> Map.keysSet effectDecls0 + + -- data decls and effect decls may reference each other, and thus must be hashed together dataDecls :: Map v (DataDeclaration v a) <- - traverse (DD.Names.bindNames Name.unsafeParseVar locallyBoundTypes names) dataDecls0 + traverse (DD.Names.bindNames Name.unsafeParseVar Name.toVar locallyBoundTypes names) dataDecls0 effectDecls :: Map v (EffectDeclaration v a) <- - traverse (DD.withEffectDeclM (DD.Names.bindNames Name.unsafeParseVar locallyBoundTypes names)) effectDecls0 + traverse (DD.withEffectDeclM (DD.Names.bindNames Name.unsafeParseVar Name.toVar locallyBoundTypes names)) effectDecls0 + let allDecls0 :: Map v (DataDeclaration v a) allDecls0 = Map.union dataDecls (toDataDecl <$> effectDecls) hashDecls' :: [(v, Reference.Id, DataDeclaration v a)] <- Hashing.hashDataDecls allDecls0 diff --git a/parser-typechecker/src/Unison/Util/EnumContainers.hs b/parser-typechecker/src/Unison/Util/EnumContainers.hs index ec61f3f8cc..fe62ee69d7 100644 --- a/parser-typechecker/src/Unison/Util/EnumContainers.hs +++ b/parser-typechecker/src/Unison/Util/EnumContainers.hs @@ -15,6 +15,7 @@ module Unison.Util.EnumContainers keysSet, restrictKeys, withoutKeys, + mapDifference, member, lookup, lookupWithDefault, @@ -31,6 +32,7 @@ module Unison.Util.EnumContainers where import Data.Bifunctor +import Data.Functor.Classes (Eq1, Ord1) import Data.IntMap.Strict qualified as IM import Data.IntSet qualified as IS import Data.Word (Word16, Word64) @@ -59,7 +61,9 @@ newtype EnumMap k a = EM (IM.IntMap a) ) deriving newtype ( Monoid, - Semigroup + Semigroup, + Eq1, + Ord1 ) newtype EnumSet k = ES IS.IntSet @@ -118,6 +122,9 @@ restrictKeys (EM m) (ES s) = EM $ IM.restrictKeys m s withoutKeys :: (EnumKey k) => EnumMap k a -> EnumSet k -> EnumMap k a withoutKeys (EM m) (ES s) = EM $ IM.withoutKeys m s +mapDifference :: (EnumKey k) => EnumMap k a -> EnumMap k b -> EnumMap k a +mapDifference (EM l) (EM r) = EM $ IM.difference l r + member :: (EnumKey k) => k -> EnumSet k -> Bool member e (ES s) = IS.member (keyToInt e) s diff --git a/parser-typechecker/src/Unison/Util/TQueue.hs b/parser-typechecker/src/Unison/Util/TQueue.hs index 23ebfa6791..a6109f9a7d 100644 --- a/parser-typechecker/src/Unison/Util/TQueue.hs +++ b/parser-typechecker/src/Unison/Util/TQueue.hs @@ -8,8 +8,11 @@ import UnliftIO.STM hiding (TQueue) data TQueue a = TQueue (TVar (Seq a)) (TVar Word64) +prepopulatedIO :: forall a m. (MonadIO m) => Seq a -> m (TQueue a) +prepopulatedIO as = TQueue <$> newTVarIO as <*> newTVarIO (fromIntegral $ length as) + newIO :: forall a m. (MonadIO m) => m (TQueue a) -newIO = TQueue <$> newTVarIO mempty <*> newTVarIO 0 +newIO = prepopulatedIO mempty size :: TQueue a -> STM Int size (TQueue q _) = S.length <$> readTVar q diff --git a/parser-typechecker/tests/Suite.hs b/parser-typechecker/tests/Suite.hs index a3f0d89d65..4ef15dfd23 100644 --- a/parser-typechecker/tests/Suite.hs +++ b/parser-typechecker/tests/Suite.hs @@ -9,13 +9,11 @@ import System.IO import System.IO.CodePage (withCP65001) import Unison.Core.Test.Name qualified as Name import Unison.Test.ABT qualified as ABT -import Unison.Test.ANF qualified as ANF import Unison.Test.Codebase.Branch qualified as Branch import Unison.Test.Codebase.Causal qualified as Causal import Unison.Test.Codebase.Path qualified as Path import Unison.Test.CodebaseInit qualified as CodebaseInit import Unison.Test.DataDeclaration qualified as DataDeclaration -import Unison.Test.MCode qualified as MCode import Unison.Test.Referent qualified as Referent import Unison.Test.Syntax.FileParser qualified as FileParser import Unison.Test.Syntax.TermParser qualified as TermParser @@ -25,7 +23,6 @@ import Unison.Test.Type qualified as Type import Unison.Test.Typechecker qualified as Typechecker import Unison.Test.Typechecker.Context qualified as Context import Unison.Test.Typechecker.TypeError qualified as TypeError -import Unison.Test.UnisonSources qualified as UnisonSources import Unison.Test.Util.Relation qualified as Relation import Unison.Test.Util.Text qualified as Text import Unison.Test.Var qualified as Var @@ -38,7 +35,6 @@ test = Type.test, TypeError.test, TypePrinter.test, - UnisonSources.test, FileParser.test, DataDeclaration.test, Text.test, @@ -47,8 +43,6 @@ test = Causal.test, Referent.test, ABT.test, - ANF.test, - MCode.test, Var.test, Typechecker.test, Context.test, diff --git a/parser-typechecker/tests/Unison/Core/Test/Name.hs b/parser-typechecker/tests/Unison/Core/Test/Name.hs index de10924772..61293d3240 100644 --- a/parser-typechecker/tests/Unison/Core/Test/Name.hs +++ b/parser-typechecker/tests/Unison/Core/Test/Name.hs @@ -80,9 +80,9 @@ testSplitName = testSuffixes :: [Test ()] testSuffixes = [ scope "one namespace" $ expectEqual (suffixes (Name.unsafeParseText "bar")) [Name.unsafeParseText "bar"], - scope "two namespaces" $ expectEqual (suffixes (Name.unsafeParseText "foo.bar")) [Name.unsafeParseText "foo.bar", Name.unsafeParseText "bar"], - scope "multiple namespaces" $ expectEqual (suffixes (Name.unsafeParseText "foo.bar.baz")) [Name.unsafeParseText "foo.bar.baz", Name.unsafeParseText "bar.baz", Name.unsafeParseText "baz"], - scope "terms named `.`" $ expectEqual (suffixes (Name.unsafeParseText "base.`.`")) [Name.unsafeParseText "base.`.`", Name.unsafeParseText "`.`"] + scope "two namespaces" $ expectEqual (suffixes (Name.unsafeParseText "foo.bar")) [Name.unsafeParseText "bar", Name.unsafeParseText "foo.bar"], + scope "multiple namespaces" $ expectEqual (suffixes (Name.unsafeParseText "foo.bar.baz")) [Name.unsafeParseText "baz", Name.unsafeParseText "bar.baz", Name.unsafeParseText "foo.bar.baz"], + scope "terms named `.`" $ expectEqual (suffixes (Name.unsafeParseText "base.`.`")) [Name.unsafeParseText "`.`", Name.unsafeParseText "base.`.`"] ] testSuffixSearch :: [Test ()] diff --git a/parser-typechecker/tests/Unison/Test/ANF.hs b/parser-typechecker/tests/Unison/Test/ANF.hs deleted file mode 100644 index 9e2aa9c4b6..0000000000 --- a/parser-typechecker/tests/Unison/Test/ANF.hs +++ /dev/null @@ -1,224 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE PatternGuards #-} - -module Unison.Test.ANF where - -import Control.Monad.Reader (ReaderT (..)) -import Control.Monad.State (evalState) -import Data.Map qualified as Map -import Data.Set qualified as Set -import Data.Word (Word64) -import EasyTest -import Unison.ABT qualified as ABT -import Unison.ABT.Normalized (Term (TAbs)) -import Unison.ConstructorReference (GConstructorReference (..)) -import Unison.Pattern qualified as P -import Unison.Reference (Reference, Reference' (Builtin)) -import Unison.Runtime.ANF as ANF -import Unison.Runtime.MCode (RefNums (..), emitCombs) -import Unison.Term qualified as Term -import Unison.Test.Common (tm) -import Unison.Type as Ty -import Unison.Util.EnumContainers as EC -import Unison.Util.Text qualified as Util.Text -import Unison.Var as Var - --- testSNF s = ok --- where --- t0 = tm s --- snf = toSuperNormal (const 0) t0 - -simpleRefs :: Reference -> RTag -simpleRefs r - | r == Ty.natRef = 0 - | r == Ty.intRef = 1 - | r == Ty.floatRef = 2 - | r == Ty.booleanRef = 3 - | r == Ty.textRef = 4 - | r == Ty.charRef = 5 - | otherwise = 100 - -runANF :: (Var v) => ANFM v a -> a -runANF m = evalState (runReaderT m Set.empty) (0, 1, []) - -testANF :: String -> Test () -testANF s - | t0 == denormalize anf = ok - | otherwise = crash $ show $ denormalize anf - where - t0 = const () `Term.amap` tm s - anf = snd . runANF $ anfTerm t0 - -testLift :: String -> Test () -testLift s = case cs of !_ -> ok - where - cs = - emitCombs (RN (const 0) (const 0)) (Builtin "Test") 0 - . superNormalize - . (\(ll, _, _, _) -> ll) - . lamLift mempty - $ tm s - -denormalizeLit :: (Var v) => Lit -> Term.Term0 v -denormalizeLit (I i) = Term.int () i -denormalizeLit (N n) = Term.nat () n -denormalizeLit (F f) = Term.float () f -denormalizeLit (T t) = Term.text () (Util.Text.toText t) -denormalizeLit (C c) = Term.char () c -denormalizeLit (LM r) = Term.termLink () r -denormalizeLit (LY r) = Term.typeLink () r - -denormalize :: (Var v) => ANormal v -> Term.Term0 v -denormalize (TVar v) = Term.var () v -denormalize (TLit l) = denormalizeLit l -denormalize (TBLit l) = denormalizeLit l -denormalize (THnd _ _ _) = - error "denormalize handler" --- = Term.match () (denormalize b) $ denormalizeHandler h -denormalize (TShift _ _ _) = - error "denormalize shift" -denormalize (TLet _ v _ bn bo) - | typeOf v == ANFBlank = ABT.subst v dbn dbo - | otherwise = Term.let1_ False [(v, dbn)] dbo - where - dbn = denormalize bn - dbo = denormalize bo -denormalize (TName _ _ _ _) = - error "can't denormalize by-name bindings" -denormalize (TMatch v cs) = - Term.match () (ABT.var v) $ denormalizeMatch cs -denormalize (TApp f args) - | FCon r 0 <- f, - r `elem` [Ty.natRef, Ty.intRef], - [v] <- args = - Term.var () v -denormalize (TApp f args) = Term.apps' df (Term.var () <$> args) - where - df = case f of - FVar v -> Term.var () v - FComb _ -> error "FComb" - FCon r n -> - Term.constructor () (ConstructorReference r (fromIntegral $ rawTag n)) - FReq r n -> - Term.request () (ConstructorReference r (fromIntegral $ rawTag n)) - FPrim _ -> error "FPrim" - FCont _ -> error "denormalize FCont" -denormalize (TFrc _) = error "denormalize TFrc" - -denormalizeRef :: RTag -> Reference -denormalizeRef r - | 0 <- rawTag r = Ty.natRef - | 1 <- rawTag r = Ty.intRef - | 2 <- rawTag r = Ty.floatRef - | 3 <- rawTag r = Ty.booleanRef - | 4 <- rawTag r = Ty.textRef - | 5 <- rawTag r = Ty.charRef - | otherwise = error "denormalizeRef" - -backReference :: Word64 -> Reference -backReference _ = error "backReference" - -denormalizeMatch :: - (Var v) => Branched (ANormal v) -> [Term.MatchCase () (Term.Term0 v)] -denormalizeMatch b - | MatchEmpty <- b = [] - | MatchIntegral m df <- b = - (dcase (ipat @Word64 @Integer Ty.intRef) <$> mapToList m) ++ dfcase df - | MatchText m df <- b = - (dcase (const @_ @Integer $ P.Text () . Util.Text.toText) <$> Map.toList m) ++ dfcase df - | MatchData r cs Nothing <- b, - [(0, ([UN], zb))] <- mapToList cs, - TAbs i (TMatch j (MatchIntegral m df)) <- zb, - i == j = - (dcase (ipat @Word64 @Integer r) <$> mapToList m) ++ dfcase df - | MatchData r m df <- b = - (dcase (dpat r) . fmap snd <$> mapToList m) ++ dfcase df - | MatchRequest hs df <- b = denormalizeHandler hs df - | MatchNumeric _ cs df <- b = - (dcase (ipat @Word64 @Integer Ty.intRef) <$> mapToList cs) ++ dfcase df - | MatchSum _ <- b = error "MatchSum not a compilation target" - where - dfcase (Just d) = - [Term.MatchCase (P.Unbound ()) Nothing $ denormalize d] - dfcase Nothing = [] - - dcase p (t, br) = Term.MatchCase (p n t) Nothing dbr - where - (n, dbr) = denormalizeBranch br - - ipat :: (Integral a) => Reference -> p -> a -> P.Pattern () - ipat r _ i - | r == Ty.natRef = P.Nat () $ fromIntegral i - | otherwise = P.Int () $ fromIntegral i - dpat r n t = P.Constructor () (ConstructorReference r (fromIntegral (fromEnum t))) (replicate n $ P.Var ()) - -denormalizeBranch :: - (Num a, Var v) => - Term ANormalF v -> - (a, ABT.Term (Term.F v () ()) v ()) -denormalizeBranch (TAbs v br) = (n + 1, ABT.abs v dbr) - where - (n, dbr) = denormalizeBranch br -denormalizeBranch tm = (0, denormalize tm) - -denormalizeHandler :: - (Var v) => - Map.Map Reference (EnumMap CTag ([Mem], ANormal v)) -> - ANormal v -> - [Term.MatchCase () (Term.Term0 v)] -denormalizeHandler cs df = dcs - where - dcs = Map.foldMapWithKey rf cs <> dfc - dfc = - [ Term.MatchCase - (P.EffectPure () (P.Var ())) - Nothing - db - ] - where - (_, db) = denormalizeBranch @Int df - rf r rcs = foldMapWithKey (cf r) rcs - cf r t b = - [ Term.MatchCase - ( P.EffectBind - () - (ConstructorReference r (fromIntegral (fromEnum t))) - (replicate n $ P.Var ()) - (P.Var ()) - ) - Nothing - db - ] - where - (n, db) = denormalizeBranch (snd b) - -test :: Test () -test = - scope "anf" . tests $ - [ scope "lift" . tests $ - [ testLift - "let\n\ - \ g = m x -> ##Nat.+ x m\n\ - \ m -> g m m", - testLift - "m n -> let\n\ - \ f acc i = match i with\n\ - \ 0 -> acc\n\ - \ _ -> f (##Nat.+ acc n) (##Nat.sub i 1)\n\ - \ f 0 m" - ], - scope "denormalize" . tests $ - [ testANF "1", - testANF "1 + 2", - testANF - "match x with\n\ - \ +1 -> foo\n\ - \ +2 -> bar\n\ - \ +3 -> baz", - testANF - "1 + match x with\n\ - \ +1 -> foo\n\ - \ +2 -> bar", - testANF "(match x with +3 -> foo) + (match x with +2 -> foo)" - ] - ] diff --git a/parser-typechecker/tests/Unison/Test/Common.hs b/parser-typechecker/tests/Unison/Test/Common.hs index ba1e5916c0..e1d880002c 100644 --- a/parser-typechecker/tests/Unison/Test/Common.hs +++ b/parser-typechecker/tests/Unison/Test/Common.hs @@ -87,5 +87,7 @@ parsingEnv = Parser.ParsingEnv { uniqueNames = mempty, uniqueTypeGuid = \_ -> pure Nothing, - names = B.names + names = B.names, + maybeNamespace = Nothing, + localNamespacePrefixedTypesAndConstructors = mempty } diff --git a/parser-typechecker/tests/Unison/Test/MCode.hs b/parser-typechecker/tests/Unison/Test/MCode.hs deleted file mode 100644 index 8224914d6d..0000000000 --- a/parser-typechecker/tests/Unison/Test/MCode.hs +++ /dev/null @@ -1,117 +0,0 @@ -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE TypeApplications #-} - -module Unison.Test.MCode where - -import Control.Concurrent.STM -import Data.Map.Strict qualified as Map -import EasyTest -import Unison.Reference (Reference, Reference' (Builtin)) -import Unison.Runtime.ANF - ( SuperGroup (..), - lamLift, - superNormalize, - ) -import Unison.Runtime.MCode - ( Args (..), - Branch (..), - Instr (..), - Section (..), - ) -import Unison.Runtime.Machine - ( CCache (..), - apply0, - baseCCache, - cacheAdd, - ) -import Unison.Runtime.Pattern -import Unison.Symbol (Symbol) -import Unison.Term (unannotate) -import Unison.Test.Common (tm) - -dummyRef :: Reference -dummyRef = Builtin "dummy" - -mainRef :: Reference -mainRef = Builtin "main" - -modifyTVarTest :: TVar a -> (a -> a) -> Test () -modifyTVarTest v f = io . atomically $ modifyTVar v f - -testEval0 :: [(Reference, SuperGroup Symbol)] -> SuperGroup Symbol -> Test () -testEval0 env main = - ok << io do - cc <- baseCCache False - _ <- cacheAdd ((mainRef, main) : env) cc - rtm <- readTVarIO (refTm cc) - apply0 Nothing cc Nothing (rtm Map.! mainRef) - where - (<<) = flip (>>) - -asrt :: Section -asrt = - Ins (Unpack Nothing 0) $ - Match 0 $ - Test1 - 1 - (Yield (BArg1 0)) - (Die "assertion failed") - -multRec :: String -multRec = - "let\n\ - \ n = 5\n\ - \ f acc i = match i with\n\ - \ 0 -> acc\n\ - \ _ -> f (##Nat.+ acc n) (##Nat.sub i 1)\n\ - \ if (##Nat.== (f 0 1000) 5000) then () else ##bug ()" - -testEval :: String -> Test () -testEval s = testEval0 (fmap superNormalize <$> ctx) (superNormalize ll) - where - (ll, _, ctx, _) = - lamLift mempty - . splitPatterns builtinDataSpec - . unannotate - $ tm s - -nested :: String -nested = - "let\n\ - \ x = match 2 with\n\ - \ 0 -> ##Nat.+ 0 1\n\ - \ m@n -> n\n\ - \ if (##Nat.== x 2) then () else ##bug ()" - -matching'arguments :: String -matching'arguments = - "let\n\ - \ f x y z = y\n\ - \ g x = f x\n\ - \ blorf = let\n\ - \ a = 0\n\ - \ b = 1\n\ - \ d = 2\n\ - \ h = g a b\n\ - \ c = 2\n\ - \ h c\n\ - \ if (##Nat.== blorf 1) then () else ##bug ()" - -test :: Test () -test = - scope "mcode" . tests $ - [ scope "2=2" $ testEval "if (##Nat.== 2 2) then () else ##bug ()", - scope "2=1+1" $ testEval "if (##Nat.== 2 (##Nat.+ 1 1)) then () else ##bug ()", - scope "2=3-1" $ testEval "if (##Nat.== 2 (##Nat.sub 3 1)) then () else ##bug ()", - scope "5*5=25" $ - testEval "if (##Nat.== (##Nat.* 5 5) 25) then () else ##bug ()", - scope "5*1000=5000" $ - testEval "if (##Nat.== (##Nat.* 5 1000) 5000) then () else ##bug ()", - scope "5*1000=5000 rec" $ testEval multRec, - scope "nested" $ - testEval nested, - scope "matching arguments" $ - testEval matching'arguments - ] diff --git a/parser-typechecker/tests/Unison/Test/Syntax/FileParser.hs b/parser-typechecker/tests/Unison/Test/Syntax/FileParser.hs index f436e5efe3..7896d75fd9 100644 --- a/parser-typechecker/tests/Unison/Test/Syntax/FileParser.hs +++ b/parser-typechecker/tests/Unison/Test/Syntax/FileParser.hs @@ -60,9 +60,7 @@ test = emptyWatchTest, signatureNeedsAccompanyingBodyTest, emptyBlockTest, - expectedBlockOpenTest, - unknownDataConstructorTest, - unknownAbilityConstructorTest + expectedBlockOpenTest ] expectFileParseFailure :: String -> (P.Error Symbol -> Test ()) -> Test () @@ -117,26 +115,6 @@ expectedBlockOpenTest = P.ExpectedBlockOpen _ _ -> ok _ -> crash "Error wasn't ExpectedBlockOpen" -unknownDataConstructorTest :: Test () -unknownDataConstructorTest = - scope "unknownDataConstructorTest" $ - expectFileParseFailure "m a = match a with A -> 1" expectation - where - expectation :: (Var e) => P.Error e -> Test () - expectation e = case e of - P.UnknownDataConstructor _ _ -> ok - _ -> crash "Error wasn't UnknownDataConstructor" - -unknownAbilityConstructorTest :: Test () -unknownAbilityConstructorTest = - scope "unknownAbilityConstructorTest" $ - expectFileParseFailure "f e = match e with {E t -> u} -> 1" expectation - where - expectation :: (Var e) => P.Error e -> Test () - expectation e = case e of - P.UnknownAbilityConstructor _ _ -> ok - _ -> crash "Error wasn't UnknownAbilityConstructor" - parses :: String -> Test () parses s = scope s $ do let p :: UnisonFile Symbol P.Ann diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index 018ec3eb7b..820c2bec16 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.0. +-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack @@ -17,14 +17,6 @@ source-repository head type: git location: https://github.com/unisonweb/unison -flag arraychecks - manual: True - default: False - -flag optimized - manual: True - default: True - library exposed-modules: U.Codebase.Branch.Diff @@ -48,7 +40,6 @@ library Unison.Codebase.CodeLookup.Util Unison.Codebase.Editor.DisplayObject Unison.Codebase.Editor.RemoteRepo - Unison.Codebase.Execute Unison.Codebase.FileCodebase Unison.Codebase.Init Unison.Codebase.Init.CreateCodebaseError @@ -112,7 +103,6 @@ library Unison.PatternMatchCoverage.Constraint Unison.PatternMatchCoverage.Desugar Unison.PatternMatchCoverage.EffectHandler - Unison.PatternMatchCoverage.Fix Unison.PatternMatchCoverage.GrdTree Unison.PatternMatchCoverage.IntervalSet Unison.PatternMatchCoverage.ListPat @@ -133,32 +123,13 @@ library Unison.PrettyPrintEnvDecl.Sqlite Unison.PrintError Unison.Result - Unison.Runtime.ANF - Unison.Runtime.ANF.Rehash - Unison.Runtime.ANF.Serialize - Unison.Runtime.Array - Unison.Runtime.Builtin - Unison.Runtime.Crypto.Rsa - Unison.Runtime.Debug - Unison.Runtime.Decompile - Unison.Runtime.Exception - Unison.Runtime.Foreign - Unison.Runtime.Foreign.Function - Unison.Runtime.Interface - Unison.Runtime.IOSource - Unison.Runtime.Machine - Unison.Runtime.MCode - Unison.Runtime.MCode.Serialize - Unison.Runtime.Pattern - Unison.Runtime.Serialize - Unison.Runtime.SparseVector - Unison.Runtime.Stack - Unison.Runtime.Vector Unison.Share.Types Unison.Syntax.DeclParser Unison.Syntax.DeclPrinter Unison.Syntax.FileParser + Unison.Syntax.FilePrinter Unison.Syntax.NamePrinter + Unison.Syntax.Precedence Unison.Syntax.TermParser Unison.Syntax.TermPrinter Unison.Syntax.TypeParser @@ -220,101 +191,41 @@ library TypeApplications TypeFamilies ViewPatterns - ghc-options: -Wall -O0 -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures + ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures build-depends: - IntervalMap - , ListLike + ListLike , aeson - , ansi-terminal - , asn1-encoding - , asn1-types , async , atomic-primops , base - , base16 >=0.2.1.0 - , base64-bytestring - , basement - , binary , bytes , bytestring - , bytestring-to-vector - , cereal - , clock , concurrent-output - , configurator , containers >=0.6.3 - , crypton-x509 - , crypton-x509-store - , crypton-x509-system - , cryptonite - , data-default - , data-memocombinators - , deepseq - , directory - , either , errors - , exceptions , extra , filelock , filepath - , fingertree , free - , fuzzyfind , generic-lens , hashable , hashtables - , haskeline - , http-client - , http-media - , http-types - , iproute , lens - , lucid , megaparsec - , memory , mmorph - , monad-validate , mtl - , murmur-hash , mutable-containers - , mwc-random - , natural-transformation - , network - , network-simple - , network-udp , network-uri , nonempty-containers - , open-browser - , openapi3 - , optparse-applicative - , pem , pretty-simple - , primitive - , process - , random >=1.2.0 - , raw-strings-qq - , recover-rtti - , regex-base , regex-tdfa - , safe - , safe-exceptions , semialign , semigroups - , servant , servant-client - , servant-docs - , servant-openapi3 - , servant-server - , shellmet , stm - , tagged - , temporary - , terminal-size >=0.3.3 , text - , text-short , these , time - , tls , transformers , unicode-show , unison-codebase @@ -332,25 +243,15 @@ library , unison-util-base32hex , unison-util-bytes , unison-util-cache + , unison-util-recursion , unison-util-relation , unison-util-rope , unison-util-serialization , unliftio - , uri-encode - , utf8-string , uuid , vector - , wai - , warp - , witch , witherable - , yaml - , zlib default-language: Haskell2010 - if flag(optimized) - ghc-options: -funbox-strict-fields -O2 - if flag(arraychecks) - cpp-options: -DARRAY_CHECK test-suite parser-typechecker-tests type: exitcode-stdio-1.0 @@ -358,16 +259,13 @@ test-suite parser-typechecker-tests other-modules: Unison.Core.Test.Name Unison.Test.ABT - Unison.Test.ANF Unison.Test.Codebase.Branch Unison.Test.Codebase.Causal Unison.Test.Codebase.Path Unison.Test.CodebaseInit Unison.Test.Common Unison.Test.DataDeclaration - Unison.Test.MCode Unison.Test.Referent - Unison.Test.Runtime.Crypto.Rsa Unison.Test.Syntax.FileParser Unison.Test.Syntax.TermParser Unison.Test.Syntax.TypePrinter @@ -377,7 +275,6 @@ test-suite parser-typechecker-tests Unison.Test.Typechecker.Components Unison.Test.Typechecker.Context Unison.Test.Typechecker.TypeError - Unison.Test.UnisonSources Unison.Test.Util.Pretty Unison.Test.Util.Relation Unison.Test.Util.Text @@ -414,112 +311,17 @@ test-suite parser-typechecker-tests TypeApplications TypeFamilies ViewPatterns - ghc-options: -Wall -O0 -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0 + ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0 build-depends: - IntervalMap - , ListLike - , aeson - , ansi-terminal - , asn1-encoding - , asn1-types - , async - , atomic-primops - , base - , base16 >=0.2.1.0 - , base64-bytestring - , basement - , binary - , bytes - , bytestring - , bytestring-to-vector - , cereal - , clock + base , code-page - , concurrent-output - , configurator - , containers >=0.6.3 - , crypton-x509 - , crypton-x509-store - , crypton-x509-system - , cryptonite - , data-default - , data-memocombinators - , deepseq - , directory + , containers , easytest - , either - , errors - , exceptions - , extra - , filelock - , filemanip - , filepath - , fingertree - , free - , fuzzyfind - , generic-lens - , hashable - , hashtables - , haskeline - , hex-text - , http-client - , http-media - , http-types - , iproute - , lens - , lucid , megaparsec - , memory - , mmorph - , monad-validate , mtl - , murmur-hash - , mutable-containers - , mwc-random - , natural-transformation - , network - , network-simple - , network-udp - , network-uri - , nonempty-containers - , open-browser - , openapi3 - , optparse-applicative - , pem - , pretty-simple - , primitive - , process - , random >=1.2.0 , raw-strings-qq - , recover-rtti - , regex-base - , regex-tdfa - , safe - , safe-exceptions - , semialign - , semigroups - , servant - , servant-client - , servant-docs - , servant-openapi3 - , servant-server - , shellmet - , split - , stm - , tagged , temporary - , terminal-size >=0.3.3 , text - , text-short - , these - , time - , tls - , transformers - , unicode-show - , unison-codebase - , unison-codebase-sqlite - , unison-codebase-sqlite-hashing-v2 - , unison-codebase-sync , unison-core , unison-core1 , unison-hash @@ -527,27 +329,7 @@ test-suite parser-typechecker-tests , unison-parser-typechecker , unison-prelude , unison-pretty-printer - , unison-sqlite , unison-syntax - , unison-util-base32hex - , unison-util-bytes - , unison-util-cache , unison-util-relation , unison-util-rope - , unison-util-serialization - , unliftio - , uri-encode - , utf8-string - , uuid - , vector - , wai - , warp - , witch - , witherable - , yaml - , zlib default-language: Haskell2010 - if flag(optimized) - ghc-options: -funbox-strict-fields -O2 - if flag(arraychecks) - cpp-options: -DARRAY_CHECK diff --git a/scheme-libs/racket/unison-runtime.rkt b/scheme-libs/racket/unison-runtime.rkt index 23b5e85e19..7ddb9fea0d 100644 --- a/scheme-libs/racket/unison-runtime.rkt +++ b/scheme-libs/racket/unison-runtime.rkt @@ -30,7 +30,6 @@ unison/data-info unison/chunked-seq unison/primops - unison/builtin unison/primops-generated unison/builtin-generated) @@ -68,12 +67,12 @@ (let ([bs (grab-bytes port)]) (match (builtin-Value.deserialize (bytes->chunked-bytes bs)) [(unison-data _ t (list q)) - (= t ref-either-right:tag) + #:when (= t ref-either-right:tag) (apply values (unison-tuple->list (reify-value (unison-quote-val q))))] - [else - (raise "unexpected input")]))) + [val + (raise (format "unexpected input: ~a " (describe-value val)))]))) (define (natural->bytes/variable n) (let rec ([i n] [acc '()]) @@ -118,9 +117,9 @@ (define ((eval-exn-handler port) rq) (request-case rq [pure (result) (encode-success result port)] - [ref-exception:typelink + [ref-exception [0 (fail) - (control ref-exception:typelink k + (control ref-exception k (encode-exception fail port))]])) ; Implements the evaluation mode of operation. First decodes the @@ -134,33 +133,34 @@ ([exn:bug? (lambda (e) (encode-error e out))]) (parameterize ([current-command-line-arguments args]) - (handle [ref-exception:typelink] (eval-exn-handler out) + (handle [ref-exception] (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 ; loading. This file can then be built with `raco exe`. -(define (write-module srcf main-ref icode) +(define (write-module prof srcf main-ref icode) (call-with-output-file srcf (lambda (port) (parameterize ([print-as-expression #t]) (display "#lang racket/base\n\n" port) - (for ([expr (build-intermediate-module main-ref icode)]) + (for ([expr (build-intermediate-module #:profile prof main-ref icode)]) (pretty-print expr port 1) (newline port)) (newline port))) #:exists 'replace)) ; Decodes input and writes a module to the specified file. -(define (do-generate srcf) +(define (do-generate prof srcf) (define-values (icode main-ref) (decode-input (current-input-port))) - (write-module srcf main-ref icode)) + (write-module prof srcf main-ref icode)) (define generate-to (make-parameter #f)) (define show-version (make-parameter #f)) (define use-port-num (make-parameter #f)) +(define enable-profiling (make-parameter #f)) (define (handle-command-line) (command-line @@ -177,6 +177,10 @@ file "generate code to " (generate-to file)] + #:once-each + [("--profile") + "enable profiling" + (enable-profiling #t)] #:args remaining (list->vector remaining))) @@ -185,7 +189,7 @@ (current-command-line-arguments sub-args)) (cond [(show-version) (displayln "unison-runtime version 0.0.11")] - [(generate-to) (do-generate (generate-to))] + [(generate-to) (do-generate (enable-profiling) (generate-to))] [(use-port-num) (match (string->number (use-port-num)) [port diff --git a/scheme-libs/racket/unison/arithmetic.rkt b/scheme-libs/racket/unison/arithmetic.rkt deleted file mode 100644 index a50364eb55..0000000000 --- a/scheme-libs/racket/unison/arithmetic.rkt +++ /dev/null @@ -1,104 +0,0 @@ -#!racket/base - -(provide - builtin-Nat.+ - builtin-Nat.+:termlink - builtin-Nat.toFloat - builtin-Nat.toFloat:termlink - builtin-Nat.increment - builtin-Nat.increment:termlink - builtin-Nat.drop - builtin-Nat.drop:termlink - builtin-Float.* - builtin-Float.*:termlink - builtin-Float.fromRepresentation - builtin-Float.fromRepresentation:termlink - builtin-Float.toRepresentation - builtin-Float.toRepresentation:termlink - builtin-Float.ceiling - builtin-Float.ceiling:termlink - builtin-Int.+ - builtin-Int.+:termlink - builtin-Int.- - builtin-Int.-:termlink - builtin-Int./ - builtin-Int./:termlink - builtin-Int.increment - builtin-Int.increment:termlink - builtin-Int.negate - builtin-Int.negate:termlink - builtin-Int.fromRepresentation - builtin-Int.fromRepresentation:termlink - builtin-Int.toRepresentation - builtin-Int.toRepresentation:termlink - builtin-Int.signum - builtin-Int.signum:termlink) - -(require racket - racket/fixnum - racket/flonum - racket/performance-hint - unison/data - unison/boot) - -(begin-encourage-inline - (define-unison-builtin - (builtin-Nat.+ m n) - (clamp-natural (+ m n))) - - (define-unison-builtin - (builtin-Nat.drop m n) - (max 0 (- m n))) - - (define-unison-builtin - (builtin-Nat.increment n) - (clamp-natural (add1 n))) - (define-unison-builtin - (builtin-Int.increment i) (clamp-integer (add1 i))) - (define-unison-builtin - (builtin-Int.negate i) (if (> i nbit63) (- i) i)) - (define-unison-builtin - (builtin-Int.+ i j) (clamp-integer (+ i j))) - (define-unison-builtin - (builtin-Int.- i j) (clamp-integer (- i j))) - (define-unison-builtin - (builtin-Int./ i j) (floor (/ i j))) - (define-unison-builtin - (builtin-Int.signum i) (sgn i)) - (define-unison-builtin - (builtin-Float.* x y) (fl* x y)) - - (define-unison-builtin - (builtin-Nat.toFloat n) (->fl n)) - - (define-unison-builtin - (builtin-Float.ceiling f) - (clamp-integer (fl->exact-integer (ceiling f)))) - - ; If someone can suggest a better mechanism for these, - ; that would be appreciated. - (define-unison-builtin - (builtin-Float.toRepresentation fl) - (integer-bytes->integer - (real->floating-point-bytes fl 8 #t) ; big endian - #f ; unsigned - #t)) ; big endian - - (define-unison-builtin - (builtin-Float.fromRepresentation n) - (floating-point-bytes->real - (integer->integer-bytes n 8 #f #t) ; unsigned, big endian - #t)) ; big endian - - (define-unison-builtin - (builtin-Int.toRepresentation i) - (integer-bytes->integer - (integer->integer-bytes i 8 #t #t) ; signed, big endian - #f #t)) ; unsigned, big endian - - (define-unison-builtin - (builtin-Int.fromRepresentation n) - (integer-bytes->integer - (integer->integer-bytes n 8 #f #t) ; unsigned, big endian - #t #t)) ; signed, big endian - ) diff --git a/scheme-libs/racket/unison/boot.ss b/scheme-libs/racket/unison/boot.ss index ed8b0f7d35..90a4530a69 100644 --- a/scheme-libs/racket/unison/boot.ss +++ b/scheme-libs/racket/unison/boot.ss @@ -63,6 +63,7 @@ clamp-integer clamp-natural + natural-max0 wrap-natural bit64 bit63 @@ -88,6 +89,9 @@ exception->string raise-unison-exception + exn:io? + exn:arith? + request request-case sum @@ -100,6 +104,7 @@ describe-value decode-value + describe-hash top-exn-handler @@ -108,6 +113,7 @@ referent->termlink typelink->reference termlink->referent + termlink->reference unison-tuple->list list->unison-tuple @@ -117,7 +123,7 @@ (require (for-syntax racket/set - (only-in racket partition flatten split-at) + (only-in racket partition flatten split-at string-trim identity) (only-in racket/string string-prefix?) (only-in racket/syntax format-id)) (rename-in @@ -128,11 +134,12 @@ ; (for-syntax (only-in unison/core syntax->list)) (only-in racket/control control0-at) racket/performance-hint + racket/trace unison/core + unison/curry unison/data unison/sandbox unison/data-info - unison/crypto (only-in unison/chunked-seq string->chunked-string chunked-string->string @@ -157,15 +164,28 @@ ; Our definition macro needs to generate multiple entry points for the ; defined procedures, so this is a function for making up names for ; those based on the original. -(define-for-syntax (adjust-symbol name post) +(define-for-syntax (adjust-symbol #:trim trim? name post) + (define trimmer + (if trim? + (lambda (n) (string-trim n #px"-\\d+$")) + identity)) + (string->symbol (string-append - (symbol->string name) + (trimmer (symbol->string name)) ":" post))) -(define-for-syntax (adjust-name name post) - (datum->syntax name (adjust-symbol (syntax->datum name) post) name)) +(define-for-syntax (adjust-name #:trim [trim? #f] name post) + (datum->syntax name (adjust-symbol #:trim trim? (syntax->datum name) post) name)) + +(define-for-syntax (ref-link? name:link:stx) + (string-prefix? (symbol->string (syntax->datum name:link:stx)) "ref-")) + +(define-for-syntax (build-groupref internal? name:link:stx lo) + (if (and internal? (ref-link? name:link:stx)) + #f + #`(termlink->groupref #,name:link:stx #,lo))) ; Helper function. Turns a list of syntax objects into a ; list-syntax object. @@ -198,12 +218,17 @@ ; This builds the core definition for a unison definition. It is just ; a lambda expression with the original code, but with an additional ; keyword argument for threading purity information. -(define-for-syntax (make-impl name:impl:stx arg:stx body:stx) +(define-for-syntax (make-impl value? name:impl:stx arg:stx body:stx) (with-syntax ([name:impl name:impl:stx] [args arg:stx] [body body:stx]) - (syntax/loc body:stx - (define (name:impl #:pure pure? . args) . body)))) + (cond + [value? + (syntax/loc body:stx + (define name:impl . body))] + [else + (syntax/loc body:stx + (define (name:impl . args) . body))]))) (define frame-contents (gensym)) @@ -217,6 +242,7 @@ (define-for-syntax (make-fast-path #:force-pure force-pure? + #:value value? loc ; original location name:fast:stx name:impl:stx arg:stx) @@ -224,118 +250,45 @@ (with-syntax ([name:impl name:impl:stx] [name:fast name:fast:stx] [args arg:stx]) - (if force-pure? - (syntax/loc loc - (define name:fast name:impl)) + (cond + [value? + (syntax/loc loc + (define (name:fast) name:impl))] + + [force-pure? + (syntax/loc loc + ; note: for some reason this performs better than + ; (define name:fast name:impl) + (define (name:fast . args) (name:impl . args)))] + + [else + (syntax/loc loc + (define (name:fast #:pure pure? . args) + (if pure? + (name:impl #:pure pure? . args) + (with-continuation-mark + frame-contents + (vector . args) + (name:impl #:pure pure? . args)))))]))) - (syntax/loc loc - (define (name:fast #:pure pure? . args) - (if pure? - (name:impl #:pure pure? . args) - (with-continuation-mark - frame-contents - (vector . args) - (name:impl #:pure pure? . args)))))))) - -; Slow path -- unnecessary -; (define-for-syntax (make-slow-path loc name argstx) -; (with-syntax ([name:slow (adjust-symbol name "slow")] -; [n (length (syntax->list argstx))]) -; (syntax/loc loc -; (define (name:slow #:pure pure? . as) -; (define k (length as)) -; (cond -; [(< k n) (unison-closure n name:slow as)] -; [(= k n) (apply name:fast #:pure pure? as)] -; [(> k n) -; (define-values (h t) (split-at as n)) -; (apply -; (apply name:fast #:pure pure? h) -; #:pure pure? -; t)]))))) - -; This definition builds a macro that defines the behavior of actual -; occurences of the definition names. It has the following behavior: -; -; 1. Exactly saturated occurences directly call the fast path -; 2. Undersaturated or unapplied occurrences become closure -; construction -; 3. Oversaturated occurrences become an appropriate nested -; application -; -; Because of point 2, all function values end up represented as -; unison-closure objects, so a slow path procedure is no longer -; necessary; it is handled by the prop:procedure of the closure -; structure. This should also make various universal operations easier -; to handle, because we can just test for unison-closures, instead of -; having to deal with raw procedures. (define-for-syntax - (make-callsite-macro - #:internal internal? - loc ; original location - name:stx name:fast:stx - arity:val) + (make-main loc value? inline? name:stx ref:stx name:impl:stx n) (with-syntax ([name name:stx] - [name:fast name:fast:stx] - [arity arity:val]) + [name:impl name:impl:stx] + [gr ref:stx] + [n (datum->syntax loc n)]) (cond - [internal? - (syntax/loc loc - (define-syntax (name stx) - (syntax-case stx () - [(_ #:by-name _ . bs) - (syntax/loc stx - (unison-closure arity name:fast (list . bs)))] - [(_ . bs) - (let ([k (length (syntax->list #'bs))]) - (cond - [(= arity k) ; saturated - (syntax/loc stx - (name:fast #:pure #t . bs))] - [(> arity k) ; undersaturated - (syntax/loc stx - (unison-closure arity name:fast (list . bs)))] - [(< arity k) ; oversaturated - (define-values (h t) - (split-at (syntax->list #'bs) arity)) - - (quasisyntax/loc stx - ((name:fast #:pure #t #,@h) #,@t))]))] - [_ (syntax/loc stx - (unison-closure arity name:fast (list)))])))] + [value? + (syntax/loc loc + (define (name) name:impl))] + [inline? + (syntax/loc loc + (define name + (unison-curry #:inline n gr name:impl)))] [else - (syntax/loc loc - (define-syntax (name stx) - (syntax-case stx () - [(_ #:by-name _ . bs) - (syntax/loc stx - (unison-closure arity name:fast (list . bs)))] - [(_ . bs) - (let ([k (length (syntax->list #'bs))]) - - ; todo: purity - - ; capture local pure? - (with-syntax ([pure? (format-id stx "pure?")]) - (cond - [(= arity k) ; saturated - (syntax/loc stx - (name:fast #:pure pure? . bs))] - [(> arity k) - (syntax/loc stx - (unison-closure n name:fast (list . bs)))] - [(< arity k) ; oversaturated - (define-values (h t) - (split-at (syntax->list #'bs) arity)) - - ; TODO: pending argument frame - (quasisyntax/loc stx - ((name:fast #:pure pure? #,@h) - #:pure pure? - #,@t))])))] - ; non-applied occurrence; partial ap immediately - [_ (syntax/loc stx - (unison-closure arity name:fast (list)))])))]))) + (syntax/loc loc + (define name + (unison-curry n gr name:impl)))]))) (define-for-syntax (link-decl no-link-decl? loc name:stx name:fast:stx name:impl:stx) @@ -350,17 +303,33 @@ ((declare-function-link name:fast name:link) (declare-function-link name:impl name:link))))))) +(define-for-syntax + (trace-decls trace? loc name:impl:stx) + (if trace? + (with-syntax ([name:impl name:impl:stx]) + (syntax/loc loc + ((trace name:impl)))) + #'())) + (define-for-syntax (process-hints hs) (for/fold ([internal? #f] [force-pure? #t] [gen-link? #f] - [no-link-decl? #f]) + [no-link-decl? #f] + [trace? #f] + [inline? #f] + [recursive? #f] + [value? #f]) ([h hs]) (values (or internal? (eq? h 'internal)) (or force-pure? (eq? h 'force-pure) (eq? h 'internal)) (or gen-link? (eq? h 'gen-link)) - (or no-link-decl? (eq? h 'no-link-decl))))) + (or no-link-decl? (eq? h 'no-link-decl)) + (or trace? (eq? h 'trace)) + (or inline? (eq? h 'inline)) + (or recursive? (eq? h 'recursive)) + (or value? (eq? h 'value))))) (define-for-syntax (make-link-def gen-link? loc name:stx name:link:stx) @@ -386,29 +355,44 @@ (define-for-syntax (expand-define-unison #:hints hints + #:local [lo 0] loc name:stx arg:stx expr:stx) - (define-values - (internal? force-pure? gen-link? no-link-decl?) + (define-values (internal? + force-pure? + gen-link? + no-link-decl? + trace? + inline? + recursive? + value?) (process-hints hints)) - (let ([name:fast:stx (adjust-name name:stx "fast")] - [name:impl:stx (adjust-name name:stx "impl")] - [name:link:stx (adjust-name name:stx "termlink")] - [arity (length (syntax->list arg:stx))]) + + (let* ([name:fast:stx (adjust-name name:stx "fast")] + [name:impl:stx (adjust-name name:stx "impl")] + [name:link:stx (adjust-name name:stx "termlink" #:trim #t)] + [ref:stx (build-groupref internal? name:link:stx lo)] + [arity (length (syntax->list arg:stx))]) (with-syntax ([(link ...) (make-link-def gen-link? loc name:stx name:link:stx)] [fast (make-fast-path - #:force-pure force-pure? + #:force-pure #t ; force-pure? + #:value value? loc name:fast:stx name:impl:stx arg:stx)] - [impl (make-impl name:impl:stx arg:stx expr:stx)] - [call (make-callsite-macro - #:internal internal? - loc name:stx name:fast:stx arity)] - [(decls ...) - (link-decl no-link-decl? loc name:stx name:fast:stx name:impl:stx)]) - (syntax/loc loc - (begin link ... impl fast call decls ...))))) + [impl (make-impl value? name:impl:stx arg:stx expr:stx)] + [main (make-main loc value? inline? name:stx ref:stx name:impl:stx arity)] + ; [(decls ...) + ; (link-decl no-link-decl? loc name:stx name:fast:stx name:impl:stx)] + [(traces ...) + (trace-decls trace? loc name:impl:stx)]) + (quasisyntax/loc loc + (begin + link ... + #,(if (or recursive? inline?) #'(begin-encourage-inline impl) #'impl) + traces ... + #,(if (or recursive? inline?) #'(begin-encourage-inline fast) #'fast) + #,(if inline? #'(begin-encourage-inline main) #'main)))))) ; Function definition supporting various unison features, like ; partial application and continuation serialization. See above for @@ -422,10 +406,25 @@ ; `pure?` indicator is not being threaded). (define-syntax (define-unison stx) (syntax-case stx () + [(define-unsion #:hints hs #:local n (name . args) . exprs) + (expand-define-unison + #:local (syntax->datum #'n) + #:hints (syntax->datum #'hs) + stx #'name #'args #'exprs)] + [(define-unsion #:local n #:hints hs (name . args) . exprs) + (expand-define-unison + #:local (syntax->datum #'n) + #:hints (syntax->datum #'hs) + stx #'name #'args #'exprs)] [(define-unison #:hints hs (name . args) . exprs) (expand-define-unison #:hints (syntax->datum #'hs) stx #'name #'args #'exprs)] + [(define-unison #:local n (name . args) . exprs) + (expand-define-unison + #:local (syntax->datum #'n) + #:hints '[] + stx #'name #'args #'exprs)] [(define-unison (name . args) . exprs) (expand-define-unison #:hints '[internal] @@ -433,32 +432,42 @@ (define-syntax (define-unison-builtin stx) (syntax-case stx () + [(define-unison-builtin #:local n #:hints [h ...] . rest) + (syntax/loc stx + (define-unison #:local n #:hints [inline internal gen-link h ...] . rest))] + [(define-unison-builtin #:local n . rest) + (syntax/loc stx + (define-unison #:local n #:hints [inline internal gen-link] . rest))] + [(define-unison-builtin #:hints [h ...] . rest) + (syntax/loc stx + (define-unison #:hints [inline internal gen-link h ...] . rest))] [(define-unison-builtin . rest) (syntax/loc stx - (define-unison #:hints [internal gen-link] . rest))])) + (define-unison #:hints [inline internal gen-link] . rest))])) ; call-by-name bindings (define-syntax (name stx) (syntax-case stx () [(name ([v (f . args)] ...) body ...) (syntax/loc stx - (let ([v (f #:by-name #t . args)] ...) body ...))])) + (let ([v (build-closure f . args)] ...) body ...))])) ; Wrapper that more closely matches `handle` constructs (define-syntax handle (syntax-rules () [(handle [r ...] h e ...) - (call-with-handler (list r ...) h (lambda () e ...))])) + (call-with-handler '(r ...) h (lambda () e ...))])) ; wrapper that more closely matches ability requests (define-syntax request (syntax-rules () [(request r t . args) - (let ([rq (make-request r t (list . args))]) - (let ([current-mark (ref-mark r)]) - (if (equal? #f current-mark) - (error "Unhandled top-level effect! " (list r t . args)) - ((cdr current-mark) rq))))])) + (let* ([key (quote r)] + [rq (make-request key t (list . args))] + [current-mark (ref-mark key)]) + (if (pair? current-mark) + ((cdr current-mark) rq) + (error "unhandled ability request: " (list key t . args))))])) ; See the explanation of `handle` for a more thorough understanding ; of why this is doing two control operations. @@ -471,7 +480,7 @@ (define-syntax control (syntax-rules () [(control r k e ...) - (let ([p (car (ref-mark r))]) + (let ([p (car (ref-mark (quote r)))]) (control0-at p k (control0-at p _k e ...)))])) ; forces something that is expected to be a thunk, defined with @@ -666,7 +675,7 @@ (syntax-case stx () [(a sc ...) #`((unison-request b t vs) - #:when (equal? a b) + #:when (eq? (quote a) b) (match* (t vs) #,@(map mk-req (syntax->list #'(sc ...)))))]))) @@ -697,7 +706,12 @@ (match id [(unison-data _ t (list rf i)) #:when (= t ref-id-id:tag) - (unison-termlink-derived rf i)])])) + (unison-termlink-derived rf i)])] + [else + (raise-argument-error + 'reference->termlink + "unison-reference?" + rf)])) (define (referent->termlink rn) (match rn @@ -739,6 +753,16 @@ [(unison-termlink-con tyl i) (ref-referent-con (typelink->reference tyl) i)])) +(define (termlink->reference rn) + (match rn + [(unison-termlink-builtin name) + (ref-reference-builtin + (string->chunked-string name))] + [(unison-termlink-derived bs i) + (ref-reference-derived (ref-id-id bs i))] + [else (raise "termlink->reference: con case")])) + + (define (unison-seq . l) (vector->chunked-list (list->vector l))) @@ -755,9 +779,9 @@ (display "")] [else (display (describe-value x))])] - [ref-exception:typelink + [ref-exception [0 (f) - (control ref-exception:typelink k + (control ref-exception k (let ([disp (describe-value f)]) (raise (make-exn:bug @@ -785,6 +809,15 @@ (if (fixnum? n) n (modulo n bit64))) + ; For natural arithmetic operations that can yield negatives, this + ; ensures that they are clamped back to 0. + ; + ; Note: (max 0 n) is apparently around 2-3x slower than this, hence + ; the custom operation. I've factored it out here in case something + ; even better is found, but this seems to match the performance of + ; the underlying operation. + (define (natural-max0 n) (if (>= n 0) n 0)) + ; module arithmetic appropriate for when a Nat operation my either ; have too large or a negative result. (define (wrap-natural n) @@ -793,7 +826,7 @@ (define (raise-unison-exception ty msg val) (request - ref-exception:typelink + ref-exception 0 (ref-failure-failure ty msg (unison-any-any val)))) @@ -802,3 +835,13 @@ ref-runtimefailure:typelink (string->chunked-string (exn:bug-msg b)) (exn:bug-val b))) + +(define (exn:io? e) + (or (exn:fail:read? e) + (exn:fail:filesystem? e) + (exn:fail:network? e))) + +(define (exn:arith? e) + (or (exn:fail:contract:divide-by-zero? e) + (exn:fail:contract:non-fixnum-result? e))) + diff --git a/scheme-libs/racket/unison/builtin.rkt b/scheme-libs/racket/unison/builtin.rkt deleted file mode 100644 index 85d591b497..0000000000 --- a/scheme-libs/racket/unison/builtin.rkt +++ /dev/null @@ -1,4 +0,0 @@ -#lang racket/base -(require unison/udp) - -(provide (all-from-out)) diff --git a/scheme-libs/racket/unison/bytes-nat.rkt b/scheme-libs/racket/unison/bytes-nat.rkt index c86036cd02..56e63e8cc0 100644 --- a/scheme-libs/racket/unison/bytes-nat.rkt +++ b/scheme-libs/racket/unison/bytes-nat.rkt @@ -1,46 +1,33 @@ #lang racket/base -(require unison/chunked-seq unison/data unison/boot) +(require unison/chunked-seq unison/data unison/data-info unison/boot) -(provide - (rename-out [encodeNat16be unison-FOp-Bytes.encodeNat16be]) - (prefix-out - unison-FOp-Bytes. - (combine-out - decodeNat16be - decodeNat16le - decodeNat32be - decodeNat32le - decodeNat64be - decodeNat64le - encodeNat16be - encodeNat16le - encodeNat32be - encodeNat32le - encodeNat64be - encodeNat64le))) +(provide decodeNatBe decodeNatLe + encodeNatBe encodeNatLe) +; TODO: this algorithm isn't good for large bytes values. It flattens +; the entire byte rope to a single chunk, reads the value off, builds +; a sub-chunk, then rebuilds the byte rope from the subchunk. (define (decodeNatBe bytes size) (if (< (chunked-bytes-length bytes) size) - none + ref-optional-none (let ([buf (chunked-bytes->bytes bytes)]) (define (loop acc n) (if (> n 0) - (begin (loop (+ (arithmetic-shift acc 8) (bytes-ref buf (- size n))) (- n 1)) - ) - acc - )) - (sum 1 (loop 0 size) (bytes->chunked-bytes - (subbytes buf size)))))) + acc)) + (ref-optional-some + (unison-tuple + (loop 0 size) + (bytes->chunked-bytes (subbytes buf size))))))) (define (decodeNatLe bytes size) (if (< (chunked-bytes-length bytes) size) - none + ref-optional-none (let ([buf (chunked-bytes->bytes bytes)]) (define (loop acc n) (if (> n 0) @@ -50,8 +37,10 @@ (bytes-ref buf (- n 1))) (- n 1)) acc)) - (sum 1 (loop 0 size) (bytes->chunked-bytes - (subbytes buf size)))))) + (ref-optional-some + (unison-tuple + (loop 0 size) + (bytes->chunked-bytes (subbytes buf size))))))) (define (encodeNatBe num size) (define buf (make-bytes size 0)) @@ -83,4 +72,4 @@ (define (decodeNat32be num) (decodeNatBe num 4)) (define (decodeNat32le num) (decodeNatLe num 4)) (define (decodeNat64be num) (decodeNatBe num 8)) -(define (decodeNat64le num) (decodeNatLe num 8)) \ No newline at end of file +(define (decodeNat64le num) (decodeNatLe num 8)) diff --git a/scheme-libs/racket/unison/concurrent.ss b/scheme-libs/racket/unison/concurrent.ss index a929ad77c8..275382b323 100644 --- a/scheme-libs/racket/unison/concurrent.ss +++ b/scheme-libs/racket/unison/concurrent.ss @@ -23,6 +23,7 @@ (rename (only (racket base) box + car unbox set-box! box-cas! @@ -38,6 +39,7 @@ with-handlers exn:break?) (box ref-new) + (car icar) (unbox ref-read) (set-box! ref-write) (sleep sleep-secs)) @@ -48,7 +50,7 @@ (define (promise-new) (let* ([sem (make-semaphore)] [evt (semaphore-peek-evt sem)] - [value none]) + [value ref-optional-none]) (make-promise sem evt value))) (define (promise-try-read promise) (promise-value promise)) @@ -57,26 +59,33 @@ (let loop () (let ([value (promise-value promise)]) (cond - [(some? value) (option-get value)] + [(= (unison-data-tag value) ref-optional-some:tag) + (icar (unison-data-fields value))] [else (sync/enable-break (promise-event promise)) (loop)])))) (define (promise-write promise new-value) (let loop () (let* ([value (promise-value promise)] - [cas! (lambda () (unsafe-struct*-cas! promise 2 value (some new-value)))] - [awake-readers (lambda () (semaphore-post (promise-semaphore promise)))]) + [cas! (lambda () + (unsafe-struct*-cas! + promise 2 + value + (ref-optional-some new-value)))] + [awake-readers (lambda () + (semaphore-post + (promise-semaphore promise)))]) (cond - [(some? value) sum-false] + [(= (unison-data-tag value) ref-optional-some:tag) #f] [else - (let ([ok (parameterize-break #f (if (cas!) (awake-readers) sum-false))]) - (if ok sum-true (loop)))])))) + (let ([ok (parameterize-break #f (if (cas!) (awake-readers) #f))]) + (if ok #t (loop)))])))) (define (ref-cas ref ticket value) - (if (box-cas! ref ticket value) sum-true sum-false)) + (if (box-cas! ref ticket value) #t #f)) (define (sleep n) (sleep-secs (/ n 1000000)) - (right sum-unit)) + (ref-either-right ref-unit-unit)) ;; Swallows uncaught breaks/thread kills rather than logging them to ;; match the behaviour of the Haskell runtime @@ -88,5 +97,5 @@ (define (kill threadId) (break-thread threadId) - (right sum-unit)) + (ref-either-right ref-unit-unit)) ) diff --git a/scheme-libs/racket/unison/core.ss b/scheme-libs/racket/unison/core.ss index 0985c20464..75b969847c 100644 --- a/scheme-libs/racket/unison/core.ss +++ b/scheme-libs/racket/unison/core.ss @@ -31,17 +31,12 @@ unison-tuple list->unison-tuple - freeze-bytevector! - freeze-vector! - freeze-subvector - bytevector bytevector-append - current-microseconds - decode-value describe-value + describe-hash bytevector->string/utf-8 string->bytevector/utf-8) @@ -195,17 +190,13 @@ (string-append "{Code " (describe-value v) "}")] [(unison-cont-reflected fs) "{Continuation}"] [(unison-cont-wrapped _) "{Continuation}"] - [(unison-closure _ code env) - (define dc - (termlink->string (lookup-function-link code) #t)) + [(unison-closure gr code env) + (define dc (groupref->string gr #t)) (define (f v) (string-append " " (describe-value v))) (string-append* dc (map f env))] - [(? procedure?) - (string-append - "ref" - (termlink->string (lookup-function-link x) #t))] + [(? procedure?) (describe-value (build-closure x))] [(? chunked-list?) (describe-list-sq (vector->list (chunked-list->vector x)))] [(? chunked-string?) @@ -226,18 +217,6 @@ [else (format "~a" x)])) -(define (current-microseconds) - (fl->fx (* 1000 (current-inexact-milliseconds)))) - -(define (list-head l n) - (let rec ([c l] [m n]) - (cond - [(eqv? m 0) '()] - [(null? c) '()] - [else - (let ([sub (rec (cdr c) (- m 1))]) - (cons (car c) sub))]))) - ; Simple macro to expand a syntactic sequence of comparisons into a ; short-circuiting nested comparison. (define-syntax comparisons @@ -254,6 +233,8 @@ (let rec ([cls ls] [crs rs]) (cond [(and (null? cls) (null? crs)) '=] + [(null? cls) '<] + [(null? crs) '>] [else (comparisons (universal-compare (car cls) (car crs) cmp-ty) @@ -285,6 +266,22 @@ (compare-num i j))] [(? unison-typelink-builtin?) '>])])) +(define (compare-groupref lr rr) + (match lr + [(unison-groupref-builtin lname) + (match rr + [(unison-groupref-builtin rname) + (compare-string lname rname)] + [else '<])] + [(unison-groupref-derived lh li ll) + (match rr + [(unison-groupref-derived rh ri rl) + (comparisons + (compare-bytes lh rh) + (compare-num li ri) + (compare-num ll rl))] + [else '>])])) + (define (compare-termlink ll rl) (match ll [(unison-termlink-builtin lnm) @@ -310,8 +307,8 @@ (define (value->category v) (cond - [(procedure? v) 0] [(unison-closure? v) 0] + [(procedure? v) 0] [(number? v) 1] [(char? v) 1] [(boolean? v) 1] @@ -350,18 +347,18 @@ (define (compare-proc l r cmp-ty) (define (unpack v) - (if (procedure? v) - (values (lookup-function-link v) '()) - (values - (lookup-function-link (unison-closure-code v)) - (unison-closure-env v)))) + (define clo (build-closure v)) + + (values + (unison-closure-ref clo) + (unison-closure-env clo))) - (define-values (lnl envl) (unpack l)) + (define-values (grl envl) (unpack l)) - (define-values (lnr envr) (unpack r)) + (define-values (grr envr) (unpack r)) (comparisons - (compare-termlink lnl lnr) + (compare-groupref grl grr) (lexico-compare envl envr cmp-ty))) (define (compare-timespec l r) @@ -386,7 +383,7 @@ (chunked-bytes-compare/recur l r compare-byte)] [(and (unison-data? l) (unison-data? r)) (compare-data l r cmp-ty)] [(and (bytes? r) (bytes? r)) (compare-bytes l r)] - [(and (u-proc? l) (u-proc? r)) (compare-proc l r)] + [(and (u-proc? l) (u-proc? r)) (compare-proc l r cmp-ty)] [(and (unison-termlink? l) (unison-termlink? r)) (compare-termlink l r)] [(and (unison-typelink? l) (unison-typelink? r)) @@ -453,19 +450,6 @@ ([c (in-chunked-string-chunks s)]) (f acc (string->chunked-string (m c))))) -(define freeze-vector! unsafe-vector*->immutable-vector!) - -(define (freeze-subvector src off len) - (let ([dst (make-vector len)]) - (let next ([i (fx1- len)]) - (if (< i 0) - (begin - (freeze-vector! dst) - (sum 1 dst)) - (begin - (vector-set! dst i (vector-ref src (+ off i))) - (next (fx1- i))))))) - (define (write-exn:bug ex port mode) (when mode (write-string "hex-string hex-string->bytes) - - ) - -(provide (prefix-out unison-FOp-crypto. - (combine-out - HashAlgorithm.Md5 - HashAlgorithm.Sha1 - HashAlgorithm.Sha2_256 - HashAlgorithm.Sha2_512 - HashAlgorithm.Sha3_256 - HashAlgorithm.Sha3_512 - HashAlgorithm.Blake2s_256 - HashAlgorithm.Blake2b_256 - HashAlgorithm.Blake2b_512 - hashBytes - hmacBytes - Ed25519.sign.impl - Ed25519.verify.impl - ))) - -(define-runtime-path libb2-so '(so "libb2" ("1" #f))) - -(define libb2 - (with-handlers [[exn:fail? exn->string]] - (ffi-lib libb2-so '("1" #f)))) - -(define _EVP-pointer (_cpointer 'EVP)) - -; returns a function that, when called, either -; 1) raises an exception, if libcrypto failed to load, or -; 2) returns a pair of (_EVP-pointer bits) -(define (lc-algo name bits) - (if (string? libcrypto) - (lambda _ (raise (error 'libcrypto "~a\n~a" name libcrypto))) - (let ([getter (get-ffi-obj name libcrypto (_fun -> _EVP-pointer))]) - (lambda [] - (cons (getter) bits))))) - -(define (check v who) - (unless (= 1 v) - (error who "failed with return value ~a" v))) - -(define EVP_Digest - (if (string? libcrypto) - (lambda _ (raise (error 'libcrypto "EVP_Digest\n~a" libcrypto))) - (get-ffi-obj "EVP_Digest" libcrypto - (_fun - _pointer ; input - _int ; input-len - _pointer ; output - _pointer ; null - _EVP-pointer ; algorithm - _pointer ; null - -> (r : _int) - -> (unless (= 1 r) - (error 'EVP_Digest "failed with return value ~a" r)))))) - -(define HMAC - (if (string? libcrypto) - (lambda _ (raise (error 'libcrypto "HMAC\n~a" libcrypto))) - (get-ffi-obj "HMAC" libcrypto - (_fun - _EVP-pointer ; algorithm - _pointer ; key - _int ; key-len - _pointer ; input - _int ; input-len - _pointer ; output pointer - _pointer ; null - -> _pointer ; unused - )))) - -(define (libb2-raw fn) - (if (string? libb2) - (lambda _ (raise (error 'libb2 "~a\n~a" fn libb2))) - (get-ffi-obj fn libb2 - (_fun - _pointer ; output - _pointer ; input - _pointer ; key - _int ; output-len - _int ; input-len - _int ; key-len - -> (r : _int) - -> (unless (= 0 r) - (error 'blake2 "~a failed with return value ~a" fn r)))))) - -(define blake2b-raw (libb2-raw "blake2b")) -(define blake2s-raw (libb2-raw "blake2s")) - -(define HashAlgorithm.Md5 (lc-algo "EVP_md5" 128)) -(define HashAlgorithm.Sha1 (lc-algo "EVP_sha1" 160)) -(define HashAlgorithm.Sha2_256 (lc-algo "EVP_sha256" 256)) -(define HashAlgorithm.Sha2_512 (lc-algo "EVP_sha512" 512)) -(define HashAlgorithm.Sha3_256 (lc-algo "EVP_sha3_256" 256)) -(define HashAlgorithm.Sha3_512 (lc-algo "EVP_sha3_512" 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))) - -(define (HashAlgorithm.Blake2s_256) (cons 'blake2s 256)) -(define (HashAlgorithm.Blake2b_512) (cons 'blake2b 512)) -; This one isn't provided by libcrypto, for some reason -(define (HashAlgorithm.Blake2b_256) (cons 'blake2b 256)) - -; kind is a pair of (algorithm bits) -; where algorithm is either an EVP_pointer for libcrypto functions, -; or the tag 'blake2b for libb2 function. -(define (hashBytes kind input) - (bytes->chunked-bytes (hashBytes-raw kind (chunked-bytes->bytes input)))) - -; kind is a pair of (algorithm bits) -; where algorithm is either an EVP_pointer for libcrypto functions, -; or the tag 'blake2b for libb2 function. -(define (hashBytes-raw kind input) - (let* ([bytes (/ (cdr kind) 8)] - [output (make-bytes bytes)] - [algo (car kind)]) - (case algo - ['blake2b (blake2b-raw output input #f bytes (bytes-length input) 0)] - ['blake2s (blake2s-raw output input #f bytes (bytes-length input) 0)] - [else (EVP_Digest input (bytes-length input) output #f algo #f)]) - - output)) - -; Mutates and returns the first argument -(define (xor one two) - (for ([i (in-range (bytes-length one))]) - (bytes-set! one i - (bitwise-xor - (bytes-ref one i) - (bytes-ref two i)))) - one) - -; doing the blake hmac by hand. libcrypto -; supports hmac natively, so we just defer to that -(define (hmacBlake kind key input) - (let* - ([bytes (/ (cdr kind) 8)] - [blocksize (case (car kind) ['blake2b 128] ['blake2s 64])] - - [key_ - (let ([key_ (make-bytes blocksize 0)]) - (bytes-copy! key_ 0 - (if (< blocksize (bytes-length key)) - (hashBytes-raw kind key) - key)) - key_)] - - [opad (xor (make-bytes blocksize #x5c) key_)] - [ipad (xor (make-bytes blocksize #x36) key_)] - - [full (bytes-append - opad - (hashBytes-raw kind (bytes-append ipad input)))]) - (hashBytes-raw kind full))) - -(define (hmacBytes kind key input) - (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)] - ['blake2s (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` -(module+ test - (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-raw (HashAlgorithm.Sha1) #"key" #"message")) - "2088df74d5f2146b48146caf4965377e9d0be3a4")) - - (test-case "blake2b-256 hmac" - (check-equal? - (bytes->hex-string (hmacBytes-raw (HashAlgorithm.Blake2b_256) #"key" #"message")) - "442d98a3872d3f56220f89e2b23d0645610b37c33dd3315ef224d0e39ada6751")) - - (test-case "blake2b-512 hmac" - (check-equal? - (bytes->hex-string (hmacBytes-raw (HashAlgorithm.Blake2b_512) #"key" #"message")) - "04e9ada930688cde75eec939782eed653073dd621d7643f813702976257cf037d325b50eedd417c01b6ad1f978fbe2980a93d27d854044e8626df6fa279d6680")) - - (test-case "blake2s-256 hmac" - (check-equal? - (bytes->hex-string (hmacBytes-raw (HashAlgorithm.Blake2s_256) #"key" #"message")) - "bba8fa28708ae80d249e317318c95c859f3f77512be23910d5094d9110454d6f")) - - (test-case "md5 basic" - (check-equal? - (bytes->hex-string (hashBytes-raw (HashAlgorithm.Md5) #"")) - "d41d8cd98f00b204e9800998ecf8427e")) - - (test-case "sha1 basic" - (check-equal? - (bytes->hex-string (hashBytes-raw (HashAlgorithm.Sha1) #"")) - "da39a3ee5e6b4b0d3255bfef95601890afd80709")) - - (test-case "sha2-256 basic" - (check-equal? - (bytes->hex-string (hashBytes-raw (HashAlgorithm.Sha2_256) #"")) - "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855")) - - (test-case "sha2-512 basic" - (check-equal? - (bytes->hex-string (hashBytes-raw (HashAlgorithm.Sha2_512) #"")) - "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e")) - - (test-case "sha3-256 basic" - (check-equal? - (bytes->hex-string (hashBytes-raw (HashAlgorithm.Sha3_256) #"")) - "a7ffc6f8bf1ed76651c14756a061d662f580ff4de43b49fa82d80a4b80f8434a")) - - (test-case "sha3-512 basic" - (check-equal? - (bytes->hex-string (hashBytes-raw (HashAlgorithm.Sha3_512) #"")) - "a69f73cca23a9ac5c8b567dc185a756e97c982164fe25859e0d1dcc1475c80a615b2123af1f5f94c11e3e9402c3ac558f500199d95b6d3e301758586281dcd26")) - - (test-case "blake2s_256 basic" - (check-equal? - (bytes->hex-string (hashBytes-raw (HashAlgorithm.Blake2s_256) #"")) - "69217a3079908094e11121d042354a7c1f55b6482ca1a51e1b250dfd1ed0eef9")) - - (test-case "blake2b_256 basic" - (check-equal? - (bytes->hex-string (hashBytes-raw (HashAlgorithm.Blake2b_256) #"")) - "0e5751c026e543b2e8ab2eb06099daa1d1e5df47778f7787faab45cdf12fe3a8")) - - (test-case "blake2b_512 basic" - (check-equal? - (bytes->hex-string (hashBytes-raw (HashAlgorithm.Blake2b_512) #"")) - "786a02f742015903c6c6fd852552d272912f4740e15847618a86e217f71f5419d25e1031afee585313896444934eb04b903a685b1448b755d56f701afe9be2ce"))) diff --git a/scheme-libs/racket/unison/curry.rkt b/scheme-libs/racket/unison/curry.rkt new file mode 100644 index 0000000000..0fe7a080f5 --- /dev/null +++ b/scheme-libs/racket/unison/curry.rkt @@ -0,0 +1,124 @@ + +#lang racket + +(provide + unison-curry + unison-curry-0 + unison-curry-1 + unison-curry-2 + unison-curry-3 + unison-curry-4 + unison-curry-5 + unison-curry-6 + unison-curry-7 + unison-curry-8 + unison-curry-9) + +(require racket/performance-hint + racket/unsafe/undefined + (for-syntax + (only-in racket + const range match empty-sequence)) + unison/data) + +(define-for-syntax (vsym #:pre [pre "x"] n) + (string->symbol (string-append pre (number->string n)))) + +(define-for-syntax (curry-cases loc n ref:stx fun:stx us vs) + (define (sub us vs) (curry-expr loc n ref:stx fun:stx us vs)) + + (for/foldr ([cases (list)]) ([p (in-partitions vs)]) + (match p + [(cons pre post) + (with-syntax ([(u ...) us] + [(v ...) pre] + [f fun:stx]) + (cond + [(null? post) + (list* + (syntax/loc loc + [(v ...) (f u ... v ...)]) + (syntax/loc loc + [(v ... . rest) (apply (f u ... v ...) rest)]) + cases)] + [else + (with-syntax ([sc (sub (append us pre) post)]) + (cons + (syntax/loc loc [(v ...) sc]) + cases))]))]))) + +; Build case-lambdas that are nested n-deep for partitions of +; variables us and vs. +(define-for-syntax (curry-expr loc n ref:stx fun:stx us vs) + (cond + [(= 0 n) + (with-syntax ([(u ...) us] [gr ref:stx] [f fun:stx]) + (syntax/loc loc + (unison-closure gr f (list u ...))))] + [else + (with-syntax ([(c ...) (curry-cases loc (sub1 n) ref:stx fun:stx us vs)]) + (syntax/loc loc + (case-lambda c ...)))])) + +(define-for-syntax (in-parts pre post) + (in-sequences + (in-value (cons (reverse pre) post)) + (match post + ['() empty-sequence] + [(cons x xs) (in-parts (cons x pre) xs)]))) + +(define-for-syntax (in-partitions xs) (in-parts '() xs)) + +(define-for-syntax (build-curried loc n ref:stx fun:stx) + (define xs:stx (generate-temporaries (map (const 'x) (range n)))) + + (curry-expr loc 2 ref:stx fun:stx '() xs:stx)) + +(define-for-syntax (build-curry loc n) + (define ref:stx (syntax/loc loc gr)) + (define fun:stx (syntax/loc loc f)) + + (with-syntax ([body (build-curried loc n ref:stx fun:stx)]) + (syntax/loc loc + (lambda (gr f) body)))) + +(define-syntax (make-curry stx) + (syntax-case stx () + [(make-curry n gr f) + (build-curried stx (syntax->datum #'n) #'gr #'f)])) + ; (build-curry stx (syntax->datum #'n))])) + +(begin-encourage-inline + (define ((unison-curry-0 gr f) #:reflect [ref? unsafe-undefined] . rest) + (if (eq? ref? unsafe-undefined) + (if (= (length rest) 0) + (f) + (apply (f) rest)) + (unison-closure gr f rest))) + + (define (unison-curry-1 gr f) (make-curry 1 gr f)) + (define (unison-curry-2 gr f) (make-curry 2 gr f)) + (define (unison-curry-3 gr f) (make-curry 3 gr f)) + (define (unison-curry-4 gr f) (make-curry 4 gr f)) + (define (unison-curry-5 gr f) (make-curry 5 gr f)) + (define (unison-curry-6 gr f) (make-curry 6 gr f)) + (define (unison-curry-7 gr f) (make-curry 7 gr f)) + (define (unison-curry-8 gr f) (make-curry 8 gr f)) + (define (unison-curry-9 gr f) (make-curry 9 gr f))) + +(define-syntax (unison-curry stx) + (syntax-case stx () + [(unison-curry #:inline n gr f) + (build-curried stx (syntax->datum #'n) #'gr #'f)] + [(unison-curry n gr f) + (let ([m (syntax->datum #'n)]) + (cond + [(< m 10) + (define curry:stx (vsym #:pre "unison-curry-" m)) + (with-syntax ([u-curry curry:stx]) + (syntax/loc stx + (u-curry gr f)))] + [else + (build-curried stx m #'gr #'f)]))])) + + diff --git a/scheme-libs/racket/unison/data.ss b/scheme-libs/racket/unison/data.ss index a110be41f2..f4c6edfd8a 100644 --- a/scheme-libs/racket/unison/data.ss +++ b/scheme-libs/racket/unison/data.ss @@ -29,10 +29,15 @@ (struct-out unison-typelink) (struct-out unison-typelink-builtin) (struct-out unison-typelink-derived) + (struct-out unison-groupref) + (struct-out unison-groupref-builtin) + (struct-out unison-groupref-derived) (struct-out unison-code) (struct-out unison-quote) (struct-out unison-timespec) + build-closure + call-with-handler call-with-marks @@ -112,7 +117,11 @@ unison-pair->cons typelink->string - termlink->string) + termlink->string + groupref->string + + groupref->termlink + termlink->groupref) (require (rename-in racket @@ -223,6 +232,48 @@ (hash i) #:reflection-name 'termlink) +; A groupref is like a termlink, but is used for reflection of +; functions. As such, there is no con case. Also, there's an extra +; level of indexing involved in grouprefs, because multiple scheme +; functions can be generated from the same top level unison +; definition, even after floating. +(struct unison-groupref () + #:methods gen:custom-write + [(define (write-proc gr port mode) + (write-string (groupref->string gr #t) port))] + #:property prop:equal+hash + (let () + (define (equal-proc grl grr rec) + (match grl + [(unison-groupref-builtin nl) + (match grr + [(unison-groupref-builtin nr) + (rec nl nr)] + [else #f])] + [(unison-groupref-derived hl il ll) + (match grr + [(unison-groupref-derived hr ir lr) + (and (rec hl hr) (= il ir) (= ll lr))] + [else #f])])) + + (define ((hash-proc init) gr rec) + (match gr + [(unison-groupref-builtin n) + (fxxor (fx*/wraparound (rec n) 113) + (fx*/wraparound init 109))] + [(unison-groupref-derived h i l) + (fxxor (fx*/wraparound (rec h) 127) + (fx*/wraparound (rec i) 131) + (fx*/wraparound (rec l) 137))])) + + (list equal-proc (hash-proc 3) (hash-proc 5)))) + +(struct unison-groupref-builtin unison-groupref + (name)) + +(struct unison-groupref-derived unison-groupref + (hash index local)) + (struct unison-typelink () #:transparent #:reflection-name 'typelink @@ -302,7 +353,7 @@ (write-string ")" port)) (struct unison-closure - (arity code env) + (ref code env) #:transparent #:methods gen:custom-write [(define (write-proc clo port mode) @@ -324,24 +375,40 @@ ; This means that there is never a bare unison function being passed ; as a value. So, we can define the slow path here once and for all. #:property prop:procedure - (lambda (clo #:pure [pure? #f] #:by-name [by-name? #f] . rest) - (define arity (unison-closure-arity clo)) - (define old-env (unison-closure-env clo)) + (lambda (clo . rest) (define code (unison-closure-code clo)) + (define arity (procedure-arity code)) + (define old-env (unison-closure-env clo)) (define new-env (append old-env rest)) (define k (length rest)) (define l (length new-env)) (cond - [(or by-name? (> arity l)) - (struct-copy unison-closure clo [env new-env])] [(= arity l) ; saturated - (apply code #:pure pure? new-env)] + (apply code new-env)] [(= k 0) clo] ; special case, 0-applying undersaturated [(< arity l) ; TODO: pending arg annotation if no pure? (define-values (now pending) (split-at new-env arity)) - (apply (apply code #:pure pure? now) #:pure pure? pending)]))) + (apply (apply code now) pending)] + [else ; still undersaturated + (struct-copy unison-closure clo [env new-env])]))) + +(define (reflect-procedure f) + (if (unison-closure? f) + f + (let-values ([(req opt) (procedure-keywords f)]) + (if (member '#:reflect opt) + ; 0-arg case + (f #:reflect #t) + ; otherwise, by convention, applying enough to 0 args reflects + ((f)))))) + +(define (build-closure f . args) + (define clo (reflect-procedure f)) + (define env (unison-closure-env clo)) + + (struct-copy unison-closure clo [env (append env args)])) (struct unison-timespec (sec nsec) #:transparent @@ -662,7 +729,8 @@ (define code-associations (make-hash)) (define (declare-code hs co) - (hash-set! code-associations hs co)) + (unless (hash-has-key? code-associations hs) + (hash-set! code-associations hs co))) (define (lookup-code hs) (let ([mco (hash-ref code-associations hs #f)]) @@ -694,19 +762,29 @@ "#" (bytevector->base32-string hs #:alphabet 'hex))) -(define (ix-string i) +(define (ix-string #:sep [sep "."] i) (if (= i 0) "" - (string-append "." (number->string i)))) + (string-append sep (number->string i)))) -(define (typelink->string ln [short #f]) - (define (clip s) (if short (substring s 0 8) s)) +(define (clip short s) (if short (substring s 0 8) s)) +(define (typelink->string ln [short #f]) (match ln [(unison-typelink-builtin name) (string-append "##" name)] [(unison-typelink-derived hs i) - (string-append (clip (hash-string hs)) (ix-string i))])) + (string-append (clip short (hash-string hs)) (ix-string i))])) + +(define (groupref->string gr [short #f]) + (match gr + [(unison-groupref-builtin name) + (string-append "##" name)] + [(unison-groupref-derived hs i l) + (string-append + (clip short (hash-string hs)) + (ix-string i) + (ix-string #:sep "-" l))])) (define (termlink->string ln [short #f]) (define (clip s) (if short (substring s 0 8) s)) @@ -720,3 +798,22 @@ (string-append (typelink->string rf short) "#" (number->string t))])) +(define (groupref->termlink gr) + (match gr + [(unison-groupref-builtin name) + (unison-termlink-builtin name)] + [(unison-groupref-derived hs i _) + (unison-termlink-derived hs i)])) + +(define (termlink->groupref ln l) + (match ln + [#f #f] + [(unison-termlink-builtin name) + (unison-groupref-builtin name)] + [(unison-termlink-derived hs i) + (unison-groupref-derived hs i l)] + [(unison-termlink-con r i) + (raise-argument-error + 'termlink->groupref + "builtin or derived link" + ln)])) diff --git a/scheme-libs/racket/unison/gzip.rkt b/scheme-libs/racket/unison/gzip.rkt index c223476c8d..ed4c40304f 100644 --- a/scheme-libs/racket/unison/gzip.rkt +++ b/scheme-libs/racket/unison/gzip.rkt @@ -7,10 +7,9 @@ bytes->chunked-bytes chunked-bytes->bytes)) -(provide (prefix-out unison-FOp-Bytes. - (combine-out - gzip.compress - gzip.decompress))) +(provide + gzip-bytes + gunzip-bytes) (define (gzip-bytes bytes) (let ([op1 (open-output-bytes)]) diff --git a/scheme-libs/racket/unison/io-handles.rkt b/scheme-libs/racket/unison/io-handles.rkt deleted file mode 100644 index 575d247163..0000000000 --- a/scheme-libs/racket/unison/io-handles.rkt +++ /dev/null @@ -1,263 +0,0 @@ -#lang racket/base -(require racket/string - rnrs/io/ports-6 - (only-in rnrs standard-error-port standard-input-port standard-output-port vector-map) - (only-in racket empty? with-output-to-string system/exit-code system false?) - (only-in unison/boot data-case define-unison-builtin) - unison/data - unison/chunked-seq - unison/data - unison/data-info - unison/chunked-seq - unison/data - ) - -(provide - unison-FOp-IO.stdHandle - unison-FOp-IO.openFile.impl.v3 - - builtin-IO.seekHandle.impl.v3 - builtin-IO.seekHandle.impl.v3:termlink - builtin-IO.getLine.impl.v1 - builtin-IO.getLine.impl.v1:termlink - builtin-IO.getSomeBytes.impl.v1 - builtin-IO.getSomeBytes.impl.v1:termlink - builtin-IO.getBuffering.impl.v3 - builtin-IO.getBuffering.impl.v3:termlink - builtin-IO.setBuffering.impl.v3 - builtin-IO.setBuffering.impl.v3:termlink - builtin-IO.getEcho.impl.v1 - builtin-IO.getEcho.impl.v1:termlink - builtin-IO.setEcho.impl.v1 - builtin-IO.setEcho.impl.v1:termlink - builtin-IO.getArgs.impl.v1 - builtin-IO.getArgs.impl.v1:termlink - builtin-IO.getEnv.impl.v1 - builtin-IO.getEnv.impl.v1:termlink - builtin-IO.getChar.impl.v1 - builtin-IO.getChar.impl.v1:termlink - builtin-IO.isFileOpen.impl.v3 - builtin-IO.isFileOpen.impl.v3:termlink - builtin-IO.isSeekable.impl.v3 - builtin-IO.isSeekable.impl.v3:termlink - builtin-IO.handlePosition.impl.v3 - builtin-IO.handlePosition.impl.v3:termlink - builtin-IO.process.call - builtin-IO.process.call:termlink - builtin-IO.getCurrentDirectory.impl.v3 - builtin-IO.getCurrentDirectory.impl.v3:termlink - builtin-IO.ready.impl.v1 - builtin-IO.ready.impl.v1:termlink - -; Still to implement: -; handlePosition.impl.v3 -; isSeekable.impl.v3 -; getChar.impl.v1 - ) - -; typeLink msg any -(define (Exception typeLink message payload) - (let* ([a (unison-any-any payload)] - [msg (string->chunked-string message)] - [f (ref-failure-failure typeLink msg a)]) - (ref-either-left f))) - -(define-unison-builtin - (builtin-IO.isFileOpen.impl.v3 port) - (ref-either-right (not (port-closed? port)))) - -(define-unison-builtin - (builtin-IO.ready.impl.v1 port) - (if (byte-ready? port) - (ref-either-right #t) - (if (port-eof? port) - (Exception ref-iofailure:typelink "EOF" port) - (ref-either-right #f)))) - -(define-unison-builtin - (builtin-IO.getCurrentDirectory.impl.v3 unit) - (ref-either-right - (string->chunked-string (path->string (current-directory))))) - -(define-unison-builtin - (builtin-IO.isSeekable.impl.v3 handle) - (ref-either-right - (port-has-set-port-position!? handle))) - -(define-unison-builtin - (builtin-IO.handlePosition.impl.v3 handle) - (ref-either-right (port-position handle))) - -(define-unison-builtin - (builtin-IO.seekHandle.impl.v3 handle mode amount) - (data-case mode - (0 () - (set-port-position! handle amount) - (ref-either-right none)) - (1 () - (let ([current (port-position handle)]) - (set-port-position! handle (+ current amount)) - (ref-either-right none))) - (2 () - (Exception - ref-iofailure:typelink - "SeekFromEnd not supported" - 0)))) - -(define-unison-builtin - (builtin-IO.getLine.impl.v1 handle) - (let* ([line (read-line handle)]) - (if (eof-object? line) - (ref-either-right (string->chunked-string "")) - (ref-either-right (string->chunked-string line)) - ))) - -(define-unison-builtin - (builtin-IO.getChar.impl.v1 handle) - (let* ([char (read-char handle)]) - (if (eof-object? char) - (Exception - ref-iofailure:typelink - "End of file reached" - ref-unit-unit) - (ref-either-right char)))) - -(define-unison-builtin - (builtin-IO.getSomeBytes.impl.v1 handle nbytes) - (let* ([buffer (make-bytes nbytes)] - [line (read-bytes-avail! buffer handle)]) - (cond - [(eof-object? line) - (ref-either-right (bytes->chunked-bytes #""))] - [(procedure? line) - (Exception - ref-iofailure:typelink - "getSomeBytes.impl: special value returned" - ref-unit-unit)] - [else - (ref-either-right - (bytes->chunked-bytes - (if (< line nbytes) - (subbytes buffer 0 line) - buffer)))]))) - -(define-unison-builtin - (builtin-IO.getBuffering.impl.v3 handle) - (case (file-stream-buffer-mode handle) - [(none) (ref-either-right ref-buffermode-no-buffering)] - [(line) (ref-either-right - ref-buffermode-line-buffering)] - [(block) (ref-either-right - ref-buffermode-block-buffering)] - [(#f) (Exception - ref-iofailure:typelink - "Unable to determine buffering mode of handle" - ref-unit-unit)] - [else (Exception - ref-iofailure:typelink - "Unexpected response from file-stream-buffer-mode" - ref-unit-unit)])) - -(define-unison-builtin - (builtin-IO.setBuffering.impl.v3 handle mode) - (data-case mode - (0 () - (file-stream-buffer-mode handle 'none) - (ref-either-right none)) - (1 () - (file-stream-buffer-mode handle 'line) - (ref-either-right none)) - (2 () - (file-stream-buffer-mode handle 'block) - (ref-either-right none)) - (3 (size) - (Exception - ref-iofailure:typelink - "Sized block buffering not supported" - ref-unit-unit)))) - -(define (with-buffer-mode port mode) - (file-stream-buffer-mode port mode) - port) - -(define stdin (with-buffer-mode (standard-input-port) 'none)) -(define stdout (with-buffer-mode (standard-output-port) 'line)) -(define stderr (with-buffer-mode (standard-error-port) 'line)) - -(define (unison-FOp-IO.stdHandle n) - (case n - [(0) stdin] - [(1) stdout] - [(2) stderr])) - -(define-unison-builtin - (builtin-IO.getEcho.impl.v1 handle) - (if (eq? handle stdin) - (ref-either-right (get-stdin-echo)) - (Exception - ref-iofailure:typelink - "getEcho only supported on stdin" - ref-unit-unit))) - -(define-unison-builtin - (builtin-IO.setEcho.impl.v1 handle echo) - (if (eq? handle stdin) - (begin - (if echo - (system "stty echo") - (system "stty -echo")) - (ref-either-right none)) - (Exception - ref-iofailure:typelink - "setEcho only supported on stdin" - ref-unit-unit))) - -(define (get-stdin-echo) - (let ([current (with-output-to-string (lambda () (system "stty -a")))]) - (string-contains? current " echo "))) - -(define-unison-builtin - (builtin-IO.getArgs.impl.v1 unit) - (ref-either-right - (vector->chunked-list - (vector-map string->chunked-string (current-command-line-arguments))))) - -(define-unison-builtin - (builtin-IO.getEnv.impl.v1 key) - (let ([value (environment-variables-ref (current-environment-variables) (string->bytes/utf-8 (chunked-string->string key)))]) - (if (false? value) - (Exception - ref-iofailure:typelink - "environmental variable not found" - key) - (ref-either-right - (string->chunked-string (bytes->string/utf-8 value)))))) - -(define (unison-FOp-IO.openFile.impl.v3 fn0 mode) - (define fn (chunked-string->string fn0)) - - (right (case mode - [(0) (open-input-file fn)] - [(1) (open-output-file fn #:exists 'truncate)] - [(2) (open-output-file fn #:exists 'append)] - [else (open-input-output-file fn #:exists 'can-update)]))) - -;; From https://github.com/sorawee/shlex/blob/5de06500e8c831cfc8dffb99d57a76decc02c569/main.rkt (MIT License) -;; with is a port of https://github.com/python/cpython/blob/bf2f76ec0976c09de79c8827764f30e3b6fba776/Lib/shlex.py#L325 -(define unsafe-pattern #rx"[^a-zA-Z0-9_@%+=:,./-]") -(define (quote-arg s) - (if (non-empty-string? s) - (if (regexp-match unsafe-pattern s) - (string-append "'" (string-replace s "'" "'\"'\"'") "'") - s) - "''")) - -(define-unison-builtin - (builtin-IO.process.call command arguments) - (system/exit-code - (string-join (cons - (chunked-string->string command) - (map (lambda (arg) (quote-arg (chunked-string->string arg))) - (vector->list - (chunked-list->vector arguments)))) - " "))) diff --git a/scheme-libs/racket/unison/io.rkt b/scheme-libs/racket/unison/io.rkt deleted file mode 100644 index ae99bd1978..0000000000 --- a/scheme-libs/racket/unison/io.rkt +++ /dev/null @@ -1,215 +0,0 @@ -#lang racket/base -(require unison/data - unison/chunked-seq - unison/core - unison/data-info - racket/file - racket/flonum - (only-in racket - date-dst? - date-time-zone-offset - date*-time-zone-name) - (only-in unison/boot data-case define-unison-builtin) - (only-in - rnrs/arithmetic/flonums-6 - flmod)) -(require racket/file) - -(provide - builtin-Clock.internals.systemTimeZone.v1 - (prefix-out - unison-FOp-Clock.internals. - (combine-out - threadCPUTime.v1 - processCPUTime.v1 - realtime.v1 - monotonic.v1 - sec.v1 - nsec.v1)) - (prefix-out - unison-FOp-IO. - (combine-out - getFileTimestamp.impl.v3 - getTempDirectory.impl.v3 - removeFile.impl.v3 - getFileSize.impl.v3)) - - builtin-IO.fileExists.impl.v3 - builtin-IO.fileExists.impl.v3:termlink - builtin-IO.renameFile.impl.v3 - builtin-IO.renameFile.impl.v3:termlink - builtin-IO.createDirectory.impl.v3 - builtin-IO.createDirectory.impl.v3:termlink - builtin-IO.removeDirectory.impl.v3 - builtin-IO.removeDirectory.impl.v3:termlink - builtin-IO.directoryContents.impl.v3 - builtin-IO.directoryContents.impl.v3:termlink - builtin-IO.setCurrentDirectory.impl.v3 - builtin-IO.setCurrentDirectory.impl.v3:termlink - builtin-IO.renameDirectory.impl.v3 - builtin-IO.renameDirectory.impl.v3:termlink - builtin-IO.isDirectory.impl.v3 - builtin-IO.isDirectory.impl.v3:termlink - builtin-IO.systemTime.impl.v3 - builtin-IO.systemTime.impl.v3:termlink - builtin-IO.systemTimeMicroseconds.impl.v3 - builtin-IO.systemTimeMicroseconds.impl.v3:termlink - builtin-IO.createTempDirectory.impl.v3 - builtin-IO.createTempDirectory.impl.v3:termlink) - -(define (failure-result ty msg vl) - (ref-either-left - (ref-failure-failure - ty - (string->chunked-string msg) - (unison-any-any vl)))) - -(define (getFileSize.impl.v3 path) - (with-handlers - [[exn:fail:filesystem? - (lambda (e) - (exception - ref-iofailure:typelink - (exception->string e) - ref-unit-unit))]] - (right (file-size (chunked-string->string path))))) - -(define (getFileTimestamp.impl.v3 path) - (with-handlers - [[exn:fail:filesystem? - (lambda (e) - (exception - ref-iofailure:typelink - (exception->string e) - ref-unit-unit))]] - (right (file-or-directory-modify-seconds (chunked-string->string path))))) - -; in haskell, it's not just file but also directory -(define-unison-builtin - (builtin-IO.fileExists.impl.v3 path) - (let ([path-string (chunked-string->string path)]) - (ref-either-right - (or - (file-exists? path-string) - (directory-exists? path-string))))) - -(define (removeFile.impl.v3 path) - (delete-file (chunked-string->string path)) - (right none)) - -(define (getTempDirectory.impl.v3) - (right (string->chunked-string (path->string (find-system-path 'temp-dir))))) - -(define-unison-builtin - (builtin-IO.setCurrentDirectory.impl.v3 path) - (current-directory (chunked-string->string path)) - (ref-either-right none)) - -(define-unison-builtin - (builtin-IO.directoryContents.impl.v3 path) - (with-handlers - [[exn:fail:filesystem? - (lambda (e) - (failure-result - ref-iofailure:typelink - (exception->string e) - ref-unit-unit))]] - (let* ([dirps (directory-list (chunked-string->string path))] - [dirss (map path->string dirps)]) - (ref-either-right - (vector->chunked-list - (list->vector - (map - string->chunked-string - (list* "." ".." dirss)))))))) - - -(define-unison-builtin - (builtin-IO.createTempDirectory.impl.v3 prefix) - (ref-either-right - (string->chunked-string - (path->string - (make-temporary-directory* - (string->bytes/utf-8 - (chunked-string->string prefix)) #""))))) - -(define-unison-builtin - (builtin-IO.createDirectory.impl.v3 file) - (make-directory (chunked-string->string file)) - (ref-either-right none)) - -(define-unison-builtin - (builtin-IO.removeDirectory.impl.v3 file) - (delete-directory/files (chunked-string->string file)) - (ref-either-right none)) - -(define-unison-builtin - (builtin-IO.isDirectory.impl.v3 path) - (ref-either-right - (directory-exists? (chunked-string->string path)))) - -(define-unison-builtin - (builtin-IO.renameDirectory.impl.v3 old new) - (rename-file-or-directory (chunked-string->string old) - (chunked-string->string new)) - (ref-either-right none)) - -(define-unison-builtin - (builtin-IO.renameFile.impl.v3 old new) - (rename-file-or-directory (chunked-string->string old) - (chunked-string->string new)) - (ref-either-right none)) - -(define-unison-builtin - (builtin-IO.systemTime.impl.v3 unit) - (ref-either-right (current-seconds))) - -(define-unison-builtin - (builtin-IO.systemTimeMicroseconds.impl.v3 unit) - (ref-either-right (inexact->exact (* 1000 (current-inexact-milliseconds))))) - -(define-unison-builtin - (builtin-Clock.internals.systemTimeZone.v1 secs) - (let* ([d (seconds->date secs)]) - (list->unison-tuple - (list - (date-time-zone-offset d) - (if (date-dst? d) 1 0) - (date*-time-zone-name d))))) - -(define (threadCPUTime.v1) - (right - (integer->time - (current-process-milliseconds (current-thread))))) - -(define (processCPUTime.v1) - (right - (integer->time - (current-process-milliseconds #f)))) - -(define (realtime.v1) - (right - (float->time - (current-inexact-milliseconds)))) - -(define (monotonic.v1) - (right - (float->time - (current-inexact-monotonic-milliseconds)))) - -(define (integer->time msecs) - (unison-timespec - (truncate (/ msecs 1000)) - (* (modulo msecs 1000) 1000000))) - -(define (float->time msecs) - (unison-timespec - (trunc (/ msecs 1000)) - (trunc (* (flmod msecs 1000.0) 1000000)))) - -; -(define (trunc f) (inexact->exact (truncate f))) - -(define sec.v1 unison-timespec-sec) - -(define nsec.v1 unison-timespec-nsec) diff --git a/scheme-libs/racket/unison/math.rkt b/scheme-libs/racket/unison/math.rkt deleted file mode 100644 index 654ac6944d..0000000000 --- a/scheme-libs/racket/unison/math.rkt +++ /dev/null @@ -1,184 +0,0 @@ -#lang racket/base - -(require math/base - racket/performance-hint - rnrs/arithmetic/bitwise-6 - (only-in unison/boot - clamp-integer - clamp-natural - data-case - define-unison-builtin - nbit63)) - -(provide - builtin-Float.exp - builtin-Float.exp:termlink - builtin-Float.log - builtin-Float.log:termlink - builtin-Float.max - builtin-Float.max:termlink - builtin-Float.min - builtin-Float.min:termlink - builtin-Float.tan - builtin-Float.tan:termlink - builtin-Float.tanh - builtin-Float.tanh:termlink - builtin-Float.logBase - builtin-Float.logBase:termlink - builtin-Int.* - builtin-Int.*:termlink - builtin-Int.pow - builtin-Int.pow:termlink - builtin-Int.trailingZeros - builtin-Int.trailingZeros:termlink - builtin-Nat.trailingZeros - builtin-Nat.trailingZeros:termlink - builtin-Int.popCount - builtin-Int.popCount:termlink - builtin-Nat.popCount - builtin-Nat.popCount:termlink - builtin-Float.pow - builtin-Float.pow:termlink - - (prefix-out unison-POp- - (combine-out - ABSF - ACOS - ACSH - ADDF - ADDI - LOGB - ASIN - SINH - TRNF - RNDF - SQRT - TANH - TANF - TZRO - POPC - ASNH - ATAN - ATN2 - ATNH - CEIL - FLOR - EXPF - COSF - COSH - MAXF - MINF - MULF - MULI - NEGI - NTOF - POWF - POWI - POWN - DIVF - DIVI - EQLF - EQLI - SUBF - SUBI - SGNI - LEQF - SINF - ITOF))) - -(define-unison-builtin - (builtin-Float.logBase base num) - (log num base)) -(define (LOGB base num) (log num base)) - -(define-unison-builtin - (builtin-Float.exp n) (exp n)) - -(define-unison-builtin - (builtin-Float.log n) (log n)) - -(define-unison-builtin - (builtin-Float.max n m) (max n m)) - -(define-unison-builtin - (builtin-Float.min n m) (min n m)) - -(define-unison-builtin - (builtin-Float.tan n) (tan n)) - -(define-unison-builtin - (builtin-Float.tanh n) (tanh n)) - -(define-unison-builtin - (builtin-Int.* n m) (clamp-integer (* n m))) - -(define-unison-builtin - (builtin-Int.pow n m) (clamp-integer (expt n m))) - -(define-unison-builtin - (builtin-Int.trailingZeros n) (TZRO n)) - -(define-unison-builtin - (builtin-Nat.trailingZeros n) (TZRO n)) - -(define-unison-builtin - (builtin-Nat.popCount n) (POPC n)) - -(define-unison-builtin - (builtin-Int.popCount n) (POPC n)) - -(define-unison-builtin - (builtin-Float.pow n m) (expt n m)) - -(define (EXPF n) (exp n)) -(define ABSF abs) -(define ACOS acos) -(define ACSH acosh) -(define ADDF +) -(define (ADDI i j) (clamp-integer (+ i j))) -(define SUBF -) -(define (SUBI i j) (clamp-integer (- i j))) -(define (SGNI n) (if (< n 0) -1 (if (> n 0) +1 0))) -(define MAXF max) -(define MINF min) -(define MULF *) -(define (MULI i j) (clamp-integer (* i j))) -(define (NEGI i) (if (> i nbit63) (- i) i)) -(define NTOF exact->inexact) -(define POWF expt) -(define (POWI i j) (clamp-integer (expt i j))) -(define (POWN i j) (clamp-natural (expt i j))) -(define ASIN asin) -(define ASNH asinh) -(define ATAN atan) -(define ATN2 atan) -(define ATNH atanh) -(define CEIL ceiling) -(define FLOR floor) -(define COSF cos) -(define (TRNF f) - (cond - [(or (= f +inf.0) (= f -inf.0) (eqv? f +nan.0) (eqv? f +nan.f)) 0] - [else (clamp-integer (inexact->exact (truncate f)))])) -(define RNDF round) -(define SQRT sqrt) -(define TANF tan) -(define TANH tanh) -(define SINF sin) -(define SINH sinh) -(define COSH cosh) -(define DIVF /) -(define (DIVI i j) (floor (/ i j))) -(define ITOF exact->inexact) -(define (EQLF a b) (if (= a b) 1 0)) -(define (LEQF a b) (if (<= a b) 1 0)) -(define (EQLI a b) (if (= a b) 1 0)) - -(define (POPC n) - (modulo (bitwise-bit-count n) 65)) - -(define (TZRO n) - (let ([bit (bitwise-first-bit-set n)]) - (if (eq? -1 bit) - 64 - bit))) diff --git a/scheme-libs/racket/unison/network-utils.rkt b/scheme-libs/racket/unison/network-utils.rkt index a7b6cab73a..952cda94c7 100644 --- a/scheme-libs/racket/unison/network-utils.rkt +++ b/scheme-libs/racket/unison/network-utils.rkt @@ -5,27 +5,34 @@ unison/chunked-seq unison/core) ; exception->string, chunked-string -(provide handle-errors) +(provide + handle-errors + (struct-out socket-pair)) -(define (handle-errors fn) - (with-handlers - [[exn:fail:network? - (lambda (e) - (exception - ref-iofailure:typelink - (exception->string e) - ref-unit-unit))] - [exn:fail:contract? +(struct socket-pair (input output)) + +(define-syntax handle-errors + (syntax-rules () + [(_ ex ...) + (with-handlers + [[exn:fail:network? + (lambda (e) + (exception + ref-iofailure:typelink + (exception->string e) + ref-unit-unit))] + [exn:fail:contract? + (lambda (e) + (exception + ref-miscfailure:typelink + (exception->string e) + ref-unit-unit))] + [(lambda _ #t) (lambda (e) (exception ref-miscfailure:typelink - (exception->string e) - ref-unit-unit))] - [(lambda _ #t) - (lambda (e) - (exception - ref-miscfailure:typelink - (string->chunked-string - (format "Unknown exception ~a" (exn->string e))) - ref-unit-unit))]] - (fn))) + (string->chunked-string + (format "Unknown exception ~a" (exn->string e))) + ref-unit-unit))]] + ex ...)])) + diff --git a/scheme-libs/racket/unison/primops-generated.rkt b/scheme-libs/racket/unison/primops-generated.rkt index 105d3ec205..741e1da740 100644 --- a/scheme-libs/racket/unison/primops-generated.rkt +++ b/scheme-libs/racket/unison/primops-generated.rkt @@ -7,6 +7,7 @@ #!racket/base (require (except-in racket false true unit any) racket/vector + racket/hash unison/boot unison/boot-generated (only-in unison/bytevector bytevector->base32-string) @@ -41,12 +42,12 @@ builtin-crypto.hash:termlink builtin-crypto.hmac:termlink - unison-POp-CACH - unison-POp-LOAD - unison-POp-LKUP + builtin-Value.load + builtin-Value.load:termlink + builtin-Code.cache_ + builtin-Code.cache_:termlink ; some exports of internal machinery for use elsewhere - gen-code reify-value reflect-value termlink->name @@ -85,9 +86,7 @@ [(unison-data _ t (list as h tms)) #:when (= t ref-schemeterm-handle:tag) `(handle - ,(map - (lambda (tx) (text->linkname tx)) - (chunked-list->list as)) + ,(map text->ident (chunked-list->list as)) ,(text->ident h) ,@(map decode-term (chunked-list->list tms)))] [(unison-data _ t (list hd sc cs)) @@ -125,6 +124,22 @@ (raise (format "decode-binding: unimplemented case: ~a" bn))])) +; This decodes the internal unison SchemeIntermed structure for +; representing generated declarations of intermediate code. The +; structure is just a pair of a name and a SchemeTerm representing +; the code. +(define (decode-intermediate im) + (match im + [(unison-data _ t (list name tm)) + #:when (= t ref-schemeintermed-interdef:tag) + `(define ,(text->ident name #:suffix ":code") + ,(decode-term tm))] + [else + (raise-argument-error + 'decode-intermediate + "scheme-intermediate" + im)])) + (define (decode-hints hs) (define (hint->sym t) (cond @@ -140,18 +155,35 @@ [(unison-data _ t (list)) (values def (cons (hint->sym t) out))]))) +(define (decode-local lo) + (match lo + [(unison-data _ t (list)) + #:when (= t ref-optional-none:tag) + 0] + [(unison-data _ t (list n)) + #:when (= t ref-optional-some:tag) + n])) + (define (decode-syntax dfn) (match dfn - [(unison-data _ t (list nm hs vs bd)) + [(unison-data _ t (list nm lo hs vs bd)) #:when (= t ref-schemedefn-define:tag) (let-values ([(head) (map text->ident (cons nm (chunked-list->list vs)))] + [(ln) (decode-local lo)] [(def hints) (decode-hints (chunked-list->list hs))] [(body) (decode-term bd)]) (if (null? hints) - (list def head body) - (list def '#:hints hints head body)))] + (list def '#:local ln head body) + (list def '#:local ln '#:hints hints head body)))] + [(unison-data _ t (list nm hs bd)) + #:when (= t ref-schemedefn-defineval:tag) + (let-values + ([(head) (text->ident nm)] + [(def hints) (decode-hints (chunked-list->list hs))] + [(body) (decode-term bd)]) + (list def '#:hints (cons 'value hints) (list head) body))] [(unison-data _ t (list nm bd)) #:when (= t ref-schemedefn-alias:tag) (list 'define (text->ident nm) (decode-term bd))] @@ -169,7 +201,7 @@ (let* ([st (chunked-string->string tx)]) (string->symbol (string-append st ":typelink")))) -(define (text->ident tx) +(define (text->ident tx #:suffix [suffix ""]) (let* ([st (chunked-string->string tx)] [n (string->number st)] [c (string->char st)]) @@ -178,7 +210,7 @@ [(equal? st "#t") #t] [c c] [n n] - [else (string->symbol st)]))) + [else (string->symbol (string-append st suffix))]))) (define (decode-ref rf) (match rf @@ -253,15 +285,6 @@ (raise (string-append "termlink-bytes: called with constructor link"))])) -(define (termlink->reference rn) - (match rn - [(unison-termlink-builtin name) - (ref-reference-builtin - (string->chunked-string name))] - [(unison-termlink-derived bs i) - (ref-reference-derived (ref-id-id bs i))] - [else (raise "termlink->reference: con case")])) - (define (group-reference gr) (data-case gr [0 (r _) r])) @@ -271,14 +294,18 @@ (namespace-require ''#%kernel ns) ns)) -(define runtime-module-map (make-hash)) +(define runtime-module-term-map (make-hash)) +(define runtime-module-type-map (make-hash)) (define (reflect-derived bs i) (data ref-reference:typelink ref-reference-derived:tag (data ref-id:typelink ref-id-id:tag bs i))) (define (function->groupref f) - (match (lookup-function-link f) + (reflect-groupref (unison-closure-ref (build-closure f)))) + +(define (link->groupref ln) + (match ln [(unison-termlink-derived h i) (ref-groupref-group (ref-reference-derived @@ -288,7 +315,7 @@ (ref-groupref-group (ref-reference-builtin (string->chunked-string name)) 0)] - [else (raise "function->groupref: con case")])) + [else (raise "link->groupref: con case")])) (define (reify-vlit vl) (match vl @@ -335,11 +362,6 @@ #:when (= t ref-groupref-group:tag) (cons (reference->typelink r) i)])) -(define (reflect-groupref rt) - (match rt - [(cons l i) - (ref-groupref-group (typelink->reference l) i)])) - (define (parse-continuation orig k0 vs0) (let rec ([k k0] [vs vs0] [frames '()]) (match k @@ -402,7 +424,7 @@ [(unison-data _ t (list gr bs0)) #:when (= t ref-value-partial:tag) (let ([bs (map reify-value (chunked-list->list bs0))] - [proc (resolve-proc gr)]) + [proc (build-closure (resolve-proc gr))]) (struct-copy unison-closure proc [env bs]))] [(unison-data _ t (list vl)) #:when (= t ref-value-vlit:tag) @@ -450,6 +472,18 @@ [else (ref-reference-builtin (string->chunked-string "Float"))])) +(define (reflect-groupref gr) + (match gr + [(unison-groupref-derived h i l) + (ref-groupref-group + (ref-reference-derived + (ref-id-id h i)) + l)] + [(unison-groupref-builtin name) + (ref-groupref-group + (ref-reference-builtin (string->chunked-string name)) + 0)])) + (define (reflect-value v) (match v [(? boolean?) @@ -511,10 +545,11 @@ (map typelink->reference refs) (reflect-handlers hs)) (append args vs))]))] - [(unison-closure arity f as) + [(unison-closure gr f as) (ref-value-partial - (function->groupref f) + (reflect-groupref gr) (list->chunked-list (map reflect-value as)))] + [(? procedure?) (reflect-value (build-closure v))] [(unison-data rf t fs) (ref-value-data (reflect-typelink rf) @@ -524,25 +559,23 @@ (define (check-sandbox-ok ok l) (remove* ok (check-sandbox l))) -(define (sandbox-proc ok f) - (check-sandbox-ok ok (lookup-function-link f))) - (define (sandbox-scheme-value ok v) (match v [(? chunked-list?) (for/fold ([acc '()]) ([e (in-chunked-list v)]) - (append (sandbox-value ok e) acc))] - [(unison-closure arity f as) - (for/fold ([acc (sandbox-proc ok f)]) ([a (in-list as)]) + (append (sandbox-scheme-value ok e) acc))] + [(unison-closure gr f as) + (define link (groupref->termlink gr)) + (for/fold ([acc (check-sandbox-ok ok link)]) ([a (in-list as)]) (append (sandbox-scheme-value ok a) acc))] - [(? procedure?) (sandbox-proc ok v)] + [(? procedure?) (sandbox-scheme-value ok (build-closure v))] [(unison-data rf t fs) (for/fold ([acc '()]) ([e (in-list fs)]) (append (sandbox-scheme-value ok e) acc))] [else '()])) (define (check-known l acc) - (if (need-dependency? l) (cons l acc) acc)) + (if (need-code? l) (cons l acc) acc)) ; check sandboxing information for an internal.runtime.Value (define (sandbox-value ok v) @@ -604,77 +637,180 @@ (chunked-list->list (gen-typelink-defns links)))) -(define (gen-code args) - (let-values ([(tl co) (splat-upair args)]) - (match tl - [(unison-termlink-con r t) - (raise "CACH: trying to add code for data constructor")] - [(unison-termlink-builtin name) - (raise "CACH: trying to add code for a builtin")] - [(unison-termlink-derived bs i) - (let* ([sg (unison-code-rep co)] - [r (reflect-derived bs i)] - [ds (cons - (gen-link-def r) - (chunked-list->list (gen-scheme r sg)))] - [dc (decode-term (gen-link-decl r))]) - (append (map decode-syntax ds) (list dc)))]))) +(define (gen-code-decl r) + (define linkstr (chunked-string->string (ref-typelink-name r))) + (define name:link + (string->symbol (string-replace linkstr "typelink" "termlink"))) + (define name:code + (string->symbol (string-replace linkstr "typelink" "code"))) + + `(declare-code ,name:link (unison-code ,name:code))) + +; Given a termlink, code pair, generates associated definition +; and declaration code. Returns multiple results. +; +; This is the runtime loading version. It isn't necessary to generate +; code related definitions, because we already have the code values +; to add directly to the cache. +(define (gen-code:runtime arities tl co) + (match tl + [(unison-termlink-derived bs i) + (define sg (unison-code-rep co)) + (define r (reflect-derived bs i)) + (define ln (decode-syntax (gen-link-def r))) + (define ds (chunked-list->list (gen-scheme arities r sg))) + (define dc (decode-term (gen-link-decl r))) + + (values ln dc (map decode-syntax ds))] + [else + (raise-argument-error + 'gen-code:runtime + "unison-termlink-derived?" + tl)])) + +; Given a termlink, code pair, generates associated definition +; and declaration code. Returns multiple results. +; +; This is the version for compiling to intermediate code. It generates +; code declarations that will recreate the code values in the +; compiled executable. +(define (gen-code:intermed arities tl co) + (match tl + [(unison-termlink-derived bs i) + (define sg (unison-code-rep co)) + (define r (reflect-derived bs i)) + (define ln (decode-syntax (gen-link-def r))) + (define dc (decode-term (gen-link-decl r))) + (define cv (decode-intermediate (gen-code-value r sg))) + (define cd (gen-code-decl r)) + (define ds (chunked-list->list (gen-scheme arities r sg))) + + (values ln dc cv cd (map decode-syntax ds))] + [else + (raise-argument-error + 'gen-code:intermed + "unison-termlink-derived?" + tl)])) + +; Converts a link->code map into an appropriately sorted list +; for code generation. It's necessary to topologically sort +; the code so that values occur after the things they reference. +(define (codemap->link-order defs) + (define input + (for/list ([(tl co) defs]) + (unison-tuple + (termlink->reference tl) + (unison-code-rep co)))) + + (define result (topsort-code-refs (list->chunked-list input))) + + (for/list ([r (in-chunked-list result)]) + (reference->termlink r))) + +; Given a list of termlink, code pairs, returns multiple lists +; of definitions and declarations. The lists are returned as +; multiple results, each one containing a particular type of +; definition. +; +; This is the version for compiling to runtime code. +(define (gen-codes:runtime arities defs) + (for/lists (lndefs lndecs dfns) + ([tl (codemap->link-order defs)]) + (gen-code:runtime arities tl (hash-ref defs tl)))) + +; Given a list of termlink, code pairs, returns multiple lists +; of definitions and declarations. The lists are returned as +; multiple results, each one containing a particular type of +; definition. +; +; This is the version for compiling to intermediate code. +(define (gen-codes:intermed arities defs) + (for/lists (lndefs lndecs codefs codecls dfns) + ([tl (codemap->link-order defs)]) + (gen-code:intermed arities tl (hash-ref defs tl)))) (define (flatten ls) (cond [(null? ls) '()] [else (append (car ls) (flatten (cdr ls)))])) -(define module-count 0) +(define module-count (box 0)) (define (fresh-module-name) - (let ([n module-count]) - (set! module-count (+ n 1)) - (string-append "runtime-module-" (number->string n)))) + (let* ([n (unbox module-count)] + [sn (+ n 1)]) + (if (box-cas! module-count n sn) + (string-append "runtime-module-" (number->string n)) + (fresh-module-name)))) (define (generate-module-name links) - (if (null? links) - (raise "could not generate module name for dynamic code") - (let* ([top (car links)] - [bs (termlink-bytes top)] - [ebs (fresh-module-name)]) - (if (hash-has-key? runtime-module-map bs) - (generate-module-name (cdr links)) - (string->symbol ebs))))) + (string->symbol (fresh-module-name))) (define (register-code udefs) - (for-each - (lambda (p) - (let-values ([(ln co) (splat-upair p)]) - (declare-code ln co))) - udefs)) - -(define (add-module-associations links mname) - (for-each - (lambda (link) - (let ([bs (termlink-bytes link)]) - (if (hash-has-key? runtime-module-map bs) - #f - (hash-set! runtime-module-map bs mname)))) - links)) - -(define (need-dependency? l) - (let ([ln (if (unison-data? l) (reference->termlink l) l)]) - (and (unison-termlink-derived? ln) (not (have-code? ln))))) + (for ([(ln co) udefs]) + (declare-code ln co))) + +(define (runtime-code-loaded? link) + (hash-has-key? runtime-module-term-map (termlink-bytes link))) + +(define (add-module-term-associations links mname) + (for ([link links]) + (define bs (termlink-bytes link)) + (unless (hash-has-key? runtime-module-term-map bs) + (hash-set! runtime-module-term-map bs mname)))) + +(define (add-module-type-associations links mname) + (for ([link links]) + (unless (hash-has-key? runtime-module-type-map link) + (hash-set! runtime-module-type-map link mname)))) + +(define ((assoc-raise name l)) + (raise-argument-error name "declared link" l)) + +(define (termlink->module link + [default (assoc-raise + 'termlink->module + (describe-value link))]) + (termbytes->module (termlink-bytes link) default)) + +(define (termbytes->module bs + [default (assoc-raise + 'termbytes->module + (describe-hash bs))]) + (hash-ref runtime-module-term-map bs default)) + +; Resolves the module in which a typelink is declared. Using a +; canonical typelink is important for abilities, because the +; continuation mechanism uses eq? to compare them. This should +; only be a concern for code, though. +(define (typelink->module link + [default (assoc-raise + 'module-type-association + (describe-value link))]) + (hash-ref runtime-module-type-map link default)) + +(define (need-code? l) + (define ln (if (unison-data? l) (reference->termlink l) l)) + (and (unison-termlink-derived? ln) (not (have-code? ln)))) + +(define (need-code-loaded? l) + (define ln (if (unison-data? l) (reference->termlink l) l)) + (and (unison-termlink-derived? ln) (not (runtime-code-loaded? ln)))) + +(define (have-code-loaded? ln) + (and (unison-termlink-derived? ln) (runtime-code-loaded? ln))) + +(define (need-typelink? l) + (let ([ln (if (unison-data? l) (reference->typelink l) l)]) + (not (hash-has-key? runtime-module-type-map ln)))) (define (resolve-builtin nm) - (dynamic-require - 'unison/primops - nm - (lambda () - (dynamic-require - 'unison/simple-wrappers - nm)))) + (dynamic-require 'unison/primops nm)) (define (termlink->proc tl) (match tl [(unison-termlink-derived bs i) - (let ([mname (hash-ref runtime-module-map bs)]) + (let ([mname (hash-ref runtime-module-term-map bs)]) (parameterize ([current-namespace runtime-namespace]) (dynamic-require `(quote ,mname) (termlink->name tl))))] [(unison-termlink-builtin name) @@ -690,7 +826,7 @@ (string->symbol (string-append "builtin-" tx))))] [1 (bs i) (let ([sym (group-ref-sym gr)] - [mname (hash-ref runtime-module-map bs)]) + [mname (termbytes->module bs)]) (parameterize ([current-namespace runtime-namespace]) (dynamic-require `(quote ,mname) sym)))])) @@ -698,29 +834,67 @@ ; This expects to receive a list of termlink, code pairs, and ; generates a scheme module that contains the corresponding ; definitions. -(define (build-intermediate-module primary dfns0) - (let* ([udefs (chunked-list->list dfns0)] - [pname (termlink->name primary)] - [tmlinks (map ufst udefs)] - [codes (map usnd udefs)] - [tylinks (typelink-deps codes)] - [sdefs (flatten (map gen-code udefs))]) - `((require unison/boot - unison/data-info - unison/primops - unison/primops-generated - unison/builtin-generated - unison/simple-wrappers - unison/compound-wrappers) - - ,@(typelink-defns-code tylinks) - - ,@sdefs - - (handle [ref-exception:typelink] top-exn-handler - (,pname #f))))) - -(define (build-runtime-module mname tylinks tmlinks defs) +(define (build-intermediate-module #:profile [profile? #f] primary dfns0) + (define udefs + (for/hash ([p (in-chunked-list dfns0)] + #:when (need-code-loaded? (ufst p))) + (splat-upair p))) + (define-values (tmlinks codes arities) + (for/lists (ts cs as) + ([(tl co) udefs]) + (values tl co (arity-tuple tl co)))) + + (define pname (termlink->name primary)) + (define tylinks (typelink-deps codes)) + + (define-values + (lndefs lndecs codefs codecls dfns) + (gen-codes:intermed (list->chunked-list arities) udefs)) + + `((require unison/boot + unison/data + unison/data-info + unison/primops + unison/primops-generated + unison/builtin-generated + ,@(if profile? '(profile profile/render-text) '())) + + ,@(typelink-defns-code tylinks) + + ; termlink definitions + ,@lndefs + + ; procedure definitions + ,@(flatten dfns) + + ; code definitions + ,@codefs + + ; code declarations + ,@codecls + + ,(if profile? + `(profile + (handle [ref-exception] top-exn-handler (,pname #f)) + #:threads #t + #:periodic-renderer (list 60.0 render)) + `(handle [ref-exception] top-exn-handler (,pname #f))))) + +(define (extra-requires tyrefs tmrefs) + (define tmreqs + (for/list ([l tmrefs] + #:when (unison-termlink-derived? l)) + (termlink->module l))) + + (define tyreqs + (for/list ([l (map reference->typelink tyrefs)] + #:when (unison-typelink-derived? l)) + (typelink->module l #f))) + + (remove #f (remove-duplicates (append tmreqs tyreqs)))) + + +(define (build-runtime-module mname reqs tylinks tmlinks defs) (define (provided-tylink r) (string->symbol (chunked-string->string @@ -734,8 +908,7 @@ unison/primops unison/primops-generated unison/builtin-generated - unison/simple-wrappers - unison/compound-wrappers) + ,@(map (lambda (s) `(quote ,s)) reqs)) (provide ,@tynames @@ -745,60 +918,194 @@ ,@defs)) -(define (add-runtime-module mname tylinks tmlinks defs) - (eval (build-runtime-module mname tylinks tmlinks defs) +(define (add-runtime-module mname reqs tylinks tmlinks defs) + (eval (build-runtime-module mname reqs tylinks tmlinks defs) runtime-namespace)) (define (code-dependencies co) - (chunked-list->list - (group-term-dependencies - (unison-code-rep co)))) - + (map reference->termlink + (chunked-list->list + (group-term-dependencies + (unison-code-rep co))))) + +; Extracts the main arity of a code value. Only the main entry +; is called from other combinators. +(define (code-arity co) (group-arity (unison-code-rep co))) + +; This adds a synchronization barrier around code loading. It uses +; a lock associated with the namespace, so this it will also be safe +; with regard to concurrent instantiations of any modules that get +; defined. +; +; It's possible that this could be made more fine grained. We were +; running into two issues in practice: +; +; 1. It was possible for a module to think it needs to declare +; some combinators that actually occur in modules that are +; depended upon, resulting in duplicate definiton errors. +; +; 2. It was possible for module-n to depend on module-m, but for +; module-n to be defined an instantiated before module-m was +; actually added to the namespace. +; +; This is due to how we keep track of which runtime definitions are +; in which module. There is a separate map storing those associations, +; and they are not inherently synchronized with the module registry. +; Any other synchronization scheme needs to account for these issues. (define (add-runtime-code mname0 dfns0) - (define (map-links dss) - (map (lambda (ds) (map reference->termlink ds)) dss)) + (namespace-call-with-registry-lock runtime-namespace + (lambda () (add-runtime-code-pre mname0 dfns0)))) - (let ([udefs (chunked-list->list dfns0)]) - (cond - [(not (null? udefs)) - (let* ([tmlinks (map ufst udefs)] - [codes (map usnd udefs)] - [refs (map termlink->reference tmlinks)] - [depss (map code-dependencies codes)] - [tylinks (typelink-deps codes)] - [deps (flatten depss)] - [fdeps (filter need-dependency? deps)] - [rdeps (remove* refs fdeps)]) - (cond - [(null? fdeps) empty-chunked-list] - [(null? rdeps) - (let ([ndefs (map gen-code udefs)] - [sdefs (flatten (map gen-code udefs))] - [mname (or mname0 (generate-module-name tmlinks))]) - (expand-sandbox tmlinks (map-links depss)) - (register-code udefs) - (add-module-associations tmlinks mname) - (add-runtime-module mname tylinks tmlinks sdefs) - empty-chunked-list)] - [else - (list->chunked-list - (map reference->termlink rdeps))]))] - [else empty-chunked-list]))) - -(define (unison-POp-CACH dfns0) (add-runtime-code #f dfns0)) - -(define (unison-POp-LOAD v0) - (let* ([val (unison-quote-val v0)] - [deps (value-term-dependencies val)] - [fldeps (chunked-list->list deps)] - [fdeps (filter need-dependency? (chunked-list->list deps))]) - (if (null? fdeps) - (sum 1 (reify-value val)) - (sum 0 - (list->chunked-list - (map reference->termlink fdeps)))))) - -(define (unison-POp-LKUP tl) (lookup-code tl)) +(define (add-runtime-code-pre mname0 dfns0) + ; flatten and filter out unnecessary definitions + (define udefs + (for/hash ([p (in-chunked-list dfns0)] + #:when (need-code-loaded? (ufst p))) + (splat-upair p))) + + (define-values (tmlinks codes) + (for/lists (fsts snds) + ([(fst snd) udefs]) + (values fst snd))) + + (cond + ; short circuit if we have all the definitions loaded + [(null? udefs) empty-chunked-list] + [else + (define deps (flatten (map code-dependencies codes))) + ; classifying dependencies + ; hdeps - dependencies that are already loaded + ; ldeps - dependencies that we have code for, but need loading + ; ndeps - dependencies that we need code for + ; rdeps - ndeps that haven't been provided in dfns0 + (define-values (nldeps hdeps) (partition need-code-loaded? deps)) + (define-values (ndeps ldeps) (partition need-code? nldeps)) + (define rdeps (remove* tmlinks ndeps)) + (cond + [(not (null? rdeps)) + (list->chunked-list rdeps)] + + [else + ; add in definitions that haven't been loaded yet + (define tdefs + (hash-union udefs (resolve-unloaded ldeps) + #:combine (lambda (_ y) y))) + + (add-runtime-code-proc mname0 tdefs)])])) + +; Given a termlink and a list of dependencies for said link, tests +; if the code is recursive. This is done by seeing if it references +; any link with the same bytes. If it does, it must be (mututally) +; recursive. The only way for two definitions to get the same parent +; hash at this point is if they refer to one another. +(define (detect-recursion link deps) + (define self (termlink-bytes link)) + (ormap (lambda (other) + (match other + [(unison-termlink-derived other _) + (equal? self other)] + [else #f])) + deps)) + +(define (arity-tuple tl co) + (unison-tuple + (termlink->reference tl) + (code-arity co))) + +; Creates and adds a module for given module name and definitions. +; +; Passing #f for mname0 makes the procedure make up a fresh name. +; +; udefs should be a map associating termlinks to their code. It is +; assumed that udefs contains all the associations necessary to load +; the code successfully. So, any dependencies of the code in the map +; are either also in the map, or have already been loaded. The +; procedures that call into this one should have checked these already +; and given appropriate errors if we're missing code. +(define (add-runtime-code-proc mname0 udefs) + ; Unpack the map into component lists + (define-values (tmlinks codes arities depss) + (for/lists (ls cs as ds) + ([(tl co) udefs]) + (values + tl + co + (arity-tuple tl co) + (code-dependencies co)))) + + (define tylinks (chunked-list->list (typelink-deps codes))) + (define-values (ntylinks htylinks) (partition need-typelink? tylinks)) + + (define hdeps (filter have-code-loaded? (flatten depss))) + + (define-values (lndefs lndecs dfns) + (gen-codes:runtime (list->chunked-list arities) udefs)) + (define sdefs (append lndefs (append* dfns) lndecs)) + (define reqs (extra-requires htylinks hdeps)) + (define mname (or mname0 (generate-module-name tmlinks))) + + (expand-sandbox tmlinks depss) + (register-code udefs) + (add-module-type-associations + (map reference->typelink ntylinks) + mname) + (add-module-term-associations tmlinks mname) + (add-runtime-module mname reqs (list->chunked-list ntylinks) tmlinks sdefs) + + ; final result: no dependencies needed + empty-chunked-list) + +; Finds (transitively) code for references that we _know_ the code for, +; but which haven't been loaded into the runtime yet. +(define (resolve-unloaded need #:found [found (make-immutable-hash)]) + (match need + ['() found] + [(cons ln need) + #:when (hash-has-key? found ln) + (resolve-unloaded need #:found found)] + [(cons ln need) + (match (lookup-code ln) + [(unison-sum 0 (list)) + (raise-argument-error + 'resolve-unloaded + "have-code?" + ln)] + [(unison-sum 1 (list co)) + (define deps + (filter need-code-loaded? + (code-dependencies co))) + + (resolve-unloaded + (append need deps) + #:found (hash-set found ln co))])] + [else + (raise-argument-error + 'resolve-unloaded + "dependency list" + need)])) + +(define-unison-builtin (builtin-Code.cache_ dfns0) + (add-runtime-code #f dfns0)) + +(define-unison-builtin (builtin-Value.load v0) + (define val (unison-quote-val v0)) + (define deps + (map reference->termlink + (chunked-list->list (value-term-dependencies val)))) + + (namespace-call-with-registry-lock runtime-namespace + (lambda () + + (define-values (ndeps hdeps) (partition need-code? deps)) + + (cond + [(not (null? ndeps)) + (ref-either-left (list->chunked-list ndeps))] + [else + (define ldeps (filter need-code-loaded? hdeps)) + (define to-load (resolve-unloaded ldeps)) + (add-runtime-code-proc #f to-load) + (ref-either-right (reify-value val))])))) (define-unison-builtin (builtin-Code.lookup tl) (match (lookup-code tl) diff --git a/scheme-libs/racket/unison/primops.ss b/scheme-libs/racket/unison/primops.ss index 712727499f..671b1e17c3 100644 --- a/scheme-libs/racket/unison/primops.ss +++ b/scheme-libs/racket/unison/primops.ss @@ -1,1496 +1,58 @@ -; This library implements pimitive operations that are used in -; builtins. There are two different sorts of primitive operations, but -; the difference is essentially irrelevant except for naming schemes. -; -; POps are part of a large enumeration of 'instructions' directly -; implemented in the Haskell runtime. These are referred to using the -; naming scheme `unison-POp-INST` where `INST` is the name of the -; instruction, which is (at the time of this writing) 4 letters. -; -; FOps are 'foreign' functons, which are allowed to be declared more -; flexibly in the Haskell runtime. Each such declaration associates a -; builtin to a Haskell function. For these, the naming shceme is -; `unison-FOp-NAME` where `NAME` is the name of the unison builtin -; associated to the declaration. -; -; Both POps and FOps are always called with exactly the right number -; of arguments, so they may be implemented as ordinary scheme -; definitions with a fixed number of arguments. By implementing the -; POp/FOp, you are expecting the associated unison function(s) to be -; implemented by code generation from the wrappers in -; Unison.Runtime.Builtin, so the POp/FOp implementation must -; take/return arguments that match what is expected in those wrappers. - +; This library re-exports all of the builtin operation modules. +; Builtins are now directly implemented, rather than using the +; implementation details of the Haskell interpreter. The individual +; modules are divided to be somewhat more organized, but downstream +; modules can just require this one to get them all. #lang racket/base -(provide - builtin-Float.* - builtin-Float.*:termlink - builtin-Float.>= - builtin-Float.>=:termlink - builtin-Float.<= - builtin-Float.<=:termlink - builtin-Float.> - builtin-Float.>:termlink - builtin-Float.< - builtin-Float.<:termlink - builtin-Float.== - builtin-Float.==:termlink - builtin-Float.fromRepresentation - builtin-Float.fromRepresentation:termlink - builtin-Float.toRepresentation - builtin-Float.toRepresentation:termlink - builtin-Float.ceiling - builtin-Float.ceiling:termlink - builtin-Float.exp - builtin-Float.exp:termlink - builtin-Float.log - builtin-Float.log:termlink - builtin-Float.max - builtin-Float.max:termlink - builtin-Float.min - builtin-Float.min:termlink - builtin-Float.tan - builtin-Float.tan:termlink - builtin-Float.tanh - builtin-Float.tanh:termlink - builtin-Float.logBase - builtin-Float.logBase:termlink - builtin-Float.pow - builtin-Float.pow:termlink - builtin-Int.pow - builtin-Int.pow:termlink - builtin-Int.* - builtin-Int.*:termlink - builtin-Int.+ - builtin-Int.+:termlink - builtin-Int.- - builtin-Int.-:termlink - builtin-Int./ - builtin-Int./:termlink - builtin-Int.increment - builtin-Int.increment:termlink - builtin-Int.negate - builtin-Int.negate:termlink - builtin-Int.fromRepresentation - builtin-Int.fromRepresentation:termlink - builtin-Int.toRepresentation - builtin-Int.toRepresentation:termlink - builtin-Int.signum - builtin-Int.signum:termlink - builtin-Int.trailingZeros - builtin-Int.trailingZeros:termlink - builtin-Int.popCount - builtin-Int.popCount:termlink - builtin-Int.isEven - builtin-Int.isEven:termlink - builtin-Int.isOdd - builtin-Int.isOdd:termlink - builtin-Int.== - builtin-Int.==:termlink - builtin-Int.< - builtin-Int.<:termlink - builtin-Int.<= - builtin-Int.<=:termlink - builtin-Int.> - builtin-Int.>:termlink - builtin-Int.>= - builtin-Int.>=:termlink - builtin-Nat.+ - builtin-Nat.+:termlink - builtin-Nat.drop - builtin-Nat.drop:termlink - builtin-Nat.== - builtin-Nat.==:termlink - builtin-Nat.< - builtin-Nat.<:termlink - builtin-Nat.<= - builtin-Nat.<=:termlink - builtin-Nat.> - builtin-Nat.>:termlink - builtin-Nat.>= - builtin-Nat.>=:termlink - builtin-Nat.isEven - builtin-Nat.isEven:termlink - builtin-Nat.isOdd - builtin-Nat.isOdd:termlink - builtin-Nat.increment - builtin-Nat.increment:termlink - builtin-Nat.popCount - builtin-Nat.popCount:termlink - builtin-Nat.toFloat - builtin-Nat.toFloat:termlink - builtin-Nat.trailingZeros - builtin-Nat.trailingZeros:termlink - builtin-Text.indexOf - builtin-Text.indexOf:termlink - builtin-Text.== - builtin-Text.==:termlink - builtin-Text.!= - builtin-Text.!=:termlink - builtin-Text.<= - builtin-Text.<=:termlink - builtin-Text.>= - builtin-Text.>=:termlink - builtin-Text.< - builtin-Text.<:termlink - builtin-Text.> - builtin-Text.>:termlink - builtin-Bytes.indexOf - builtin-Bytes.indexOf:termlink - builtin-IO.randomBytes - builtin-IO.randomBytes:termlink - builtin-IO.tryEval - builtin-IO.tryEval:termlink - - builtin-Scope.bytearrayOf - builtin-Scope.bytearrayOf:termlink - - builtin-Universal.== - builtin-Universal.==:termlink - builtin-Universal.> - builtin-Universal.>:termlink - builtin-Universal.>= - builtin-Universal.>=:termlink - builtin-Universal.< - builtin-Universal.<:termlink - builtin-Universal.<= - builtin-Universal.<=:termlink - builtin-Universal.compare - builtin-Universal.compare:termlink - builtin-Universal.murmurHash:termlink - - builtin-unsafe.coerceAbilities - builtin-unsafe.coerceAbilities:termlink - - builtin-List.splitLeft - builtin-List.splitLeft:termlink - builtin-List.splitRight - builtin-List.splitRight:termlink - - builtin-Link.Term.toText - builtin-Link.Term.toText:termlink - - builtin-Value.toBuiltin - builtin-Value.toBuiltin:termlink - builtin-Value.fromBuiltin - builtin-Value.fromBuiltin:termlink - builtin-Code.fromGroup - builtin-Code.fromGroup:termlink - builtin-Code.toGroup - builtin-Code.toGroup:termlink - builtin-TermLink.fromReferent - builtin-TermLink.fromReferent:termlink - builtin-TermLink.toReferent - builtin-TermLink.toReferent:termlink - builtin-TypeLink.toReference - builtin-TypeLink.toReference:termlink - - builtin-IO.UDP.clientSocket.impl.v1 - builtin-IO.UDP.clientSocket.impl.v1:termlink - builtin-IO.UDP.UDPSocket.recv.impl.v1 - builtin-IO.UDP.UDPSocket.recv.impl.v1:termlink - builtin-IO.UDP.UDPSocket.send.impl.v1 - builtin-IO.UDP.UDPSocket.send.impl.v1:termlink - builtin-IO.UDP.UDPSocket.close.impl.v1 - builtin-IO.UDP.UDPSocket.close.impl.v1:termlink - builtin-IO.UDP.ListenSocket.close.impl.v1 - builtin-IO.UDP.ListenSocket.close.impl.v1:termlink - builtin-IO.UDP.UDPSocket.toText.impl.v1 - builtin-IO.UDP.UDPSocket.toText.impl.v1:termlink - builtin-IO.UDP.serverSocket.impl.v1 - builtin-IO.UDP.serverSocket.impl.v1:termlink - builtin-IO.UDP.ListenSocket.toText.impl.v1 - builtin-IO.UDP.ListenSocket.toText.impl.v1:termlink - builtin-IO.UDP.ListenSocket.recvFrom.impl.v1 - builtin-IO.UDP.ListenSocket.recvFrom.impl.v1:termlink - builtin-IO.UDP.ClientSockAddr.toText.v1 - builtin-IO.UDP.ClientSockAddr.toText.v1:termlink - builtin-IO.UDP.ListenSocket.sendTo.impl.v1 - builtin-IO.UDP.ListenSocket.sendTo.impl.v1:termlink - - unison-FOp-internal.dataTag - unison-FOp-Char.toText - ; unison-FOp-Code.dependencies - ; unison-FOp-Code.serialize - unison-FOp-IO.closeFile.impl.v3 - unison-FOp-IO.openFile.impl.v3 - ; unison-FOp-IO.isFileEOF.impl.v3 - unison-FOp-IO.putBytes.impl.v3 - unison-FOp-IO.getBytes.impl.v3 - builtin-IO.seekHandle.impl.v3 - builtin-IO.seekHandle.impl.v3:termlink - builtin-IO.getLine.impl.v1 - builtin-IO.getLine.impl.v1:termlink - builtin-IO.getSomeBytes.impl.v1 - builtin-IO.getSomeBytes.impl.v1:termlink - builtin-IO.setBuffering.impl.v3 - builtin-IO.setBuffering.impl.v3:termlink - builtin-IO.getBuffering.impl.v3 - builtin-IO.getBuffering.impl.v3:termlink - builtin-IO.setEcho.impl.v1 - builtin-IO.setEcho.impl.v1:termlink - builtin-IO.isFileOpen.impl.v3 - builtin-IO.isFileOpen.impl.v3:termlink - builtin-IO.ready.impl.v1 - builtin-IO.ready.impl.v1:termlink - builtin-IO.process.call - builtin-IO.process.call:termlink - builtin-IO.getEcho.impl.v1 - builtin-IO.getEcho.impl.v1:termlink - builtin-IO.getArgs.impl.v1 - builtin-IO.getArgs.impl.v1:termlink - builtin-IO.getEnv.impl.v1 - builtin-IO.getEnv.impl.v1:termlink - builtin-IO.getChar.impl.v1 - builtin-IO.getChar.impl.v1:termlink - builtin-IO.getCurrentDirectory.impl.v3 - builtin-IO.getCurrentDirectory.impl.v3:termlink - builtin-IO.removeDirectory.impl.v3 - builtin-IO.removeDirectory.impl.v3:termlink - builtin-IO.renameFile.impl.v3 - builtin-IO.renameFile.impl.v3:termlink - builtin-IO.createTempDirectory.impl.v3 - builtin-IO.createTempDirectory.impl.v3:termlink - builtin-IO.createDirectory.impl.v3 - builtin-IO.createDirectory.impl.v3:termlink - builtin-IO.setCurrentDirectory.impl.v3 - builtin-IO.setCurrentDirectory.impl.v3:termlink - builtin-IO.renameDirectory.impl.v3 - builtin-IO.renameDirectory.impl.v3:termlink - builtin-IO.isDirectory.impl.v3 - builtin-IO.isDirectory.impl.v3:termlink - builtin-IO.isSeekable.impl.v3 - builtin-IO.isSeekable.impl.v3:termlink - builtin-IO.handlePosition.impl.v3 - builtin-IO.handlePosition.impl.v3:termlink - builtin-IO.systemTime.impl.v3 - builtin-IO.systemTime.impl.v3:termlink - builtin-IO.systemTimeMicroseconds.impl.v3 - builtin-IO.systemTimeMicroseconds.impl.v3:termlink - - builtin-Char.Class.is - builtin-Char.Class.is:termlink - builtin-Pattern.captureAs - builtin-Pattern.captureAs:termlink - builtin-Pattern.many.corrected - builtin-Pattern.many.corrected:termlink - builtin-Pattern.isMatch - builtin-Pattern.isMatch:termlink - builtin-IO.fileExists.impl.v3 - builtin-IO.fileExists.impl.v3:termlink - builtin-IO.isFileEOF.impl.v3 - builtin-IO.isFileEOF.impl.v3:termlink - - unison-FOp-IO.getFileSize.impl.v3 - unison-FOp-IO.getFileTimestamp.impl.v3 - ; unison-FOp-IO.fileExists.impl.v3 - unison-FOp-IO.removeFile.impl.v3 - unison-FOp-IO.getTempDirectory.impl.v3 - unison-FOp-Text.fromUtf8.impl.v3 - unison-FOp-Text.repeat - unison-FOp-Text.reverse - unison-FOp-Text.toUtf8 - unison-FOp-Text.toLowercase - unison-FOp-Text.toUppercase - unison-FOp-Pattern.run - unison-FOp-Pattern.isMatch - unison-FOp-Pattern.many - unison-FOp-Pattern.capture - unison-FOp-Pattern.join - unison-FOp-Pattern.or - unison-FOp-Pattern.replicate - unison-FOp-Text.patterns.digit - unison-FOp-Text.patterns.letter - unison-FOp-Text.patterns.punctuation - unison-FOp-Text.patterns.charIn - unison-FOp-Text.patterns.notCharIn - unison-FOp-Text.patterns.anyChar - unison-FOp-Text.patterns.space - unison-FOp-Text.patterns.charRange - unison-FOp-Text.patterns.notCharRange - unison-FOp-Text.patterns.literal - unison-FOp-Text.patterns.eof - unison-FOp-Text.patterns.char - unison-FOp-Char.Class.is - unison-FOp-Char.Class.any - unison-FOp-Char.Class.alphanumeric - unison-FOp-Char.Class.upper - unison-FOp-Char.Class.lower - unison-FOp-Char.Class.number - unison-FOp-Char.Class.punctuation - unison-FOp-Char.Class.symbol - unison-FOp-Char.Class.letter - unison-FOp-Char.Class.whitespace - unison-FOp-Char.Class.control - unison-FOp-Char.Class.printable - unison-FOp-Char.Class.mark - unison-FOp-Char.Class.separator - unison-FOp-Char.Class.or - unison-FOp-Char.Class.range - unison-FOp-Char.Class.anyOf - unison-FOp-Char.Class.and - unison-FOp-Char.Class.not - unison-FOp-Clock.internals.nsec.v1 - unison-FOp-Clock.internals.sec.v1 - unison-FOp-Clock.internals.threadCPUTime.v1 - unison-FOp-Clock.internals.processCPUTime.v1 - unison-FOp-Clock.internals.realtime.v1 - unison-FOp-Clock.internals.monotonic.v1 - builtin-Clock.internals.systemTimeZone.v1 - builtin-Clock.internals.systemTimeZone.v1:termlink - - - ; unison-FOp-Value.serialize - unison-FOp-IO.stdHandle - unison-FOp-IO.getArgs.impl.v1 - - builtin-IO.directoryContents.impl.v3 - builtin-IO.directoryContents.impl.v3:termlink - unison-FOp-IO.systemTimeMicroseconds.v1 - - unison-FOp-ImmutableArray.copyTo! - unison-FOp-ImmutableArray.read - - unison-FOp-MutableArray.copyTo! - unison-FOp-MutableArray.freeze! - unison-FOp-MutableArray.freeze - unison-FOp-MutableArray.read - unison-FOp-MutableArray.write - unison-FOp-MutableArray.size - unison-FOp-ImmutableArray.size - - unison-FOp-MutableByteArray.size - unison-FOp-ImmutableByteArray.size - - unison-FOp-MutableByteArray.length - unison-FOp-ImmutableByteArray.length - - unison-FOp-ImmutableByteArray.copyTo! - unison-FOp-ImmutableByteArray.read8 - unison-FOp-ImmutableByteArray.read16be - unison-FOp-ImmutableByteArray.read24be - unison-FOp-ImmutableByteArray.read32be - unison-FOp-ImmutableByteArray.read40be - unison-FOp-ImmutableByteArray.read48be - unison-FOp-ImmutableByteArray.read56be - unison-FOp-ImmutableByteArray.read64be - - unison-FOp-MutableByteArray.copyTo! - unison-FOp-MutableByteArray.freeze! - unison-FOp-MutableByteArray.write8 - unison-FOp-MutableByteArray.write16be - unison-FOp-MutableByteArray.write32be - unison-FOp-MutableByteArray.write64be - unison-FOp-MutableByteArray.read8 - unison-FOp-MutableByteArray.read16be - unison-FOp-MutableByteArray.read24be - unison-FOp-MutableByteArray.read32be - unison-FOp-MutableByteArray.read40be - unison-FOp-MutableByteArray.read64be - - unison-FOp-Scope.bytearray - unison-FOp-Scope.bytearrayOf - unison-FOp-Scope.array - unison-FOp-Scope.arrayOf - unison-FOp-Scope.ref - - unison-FOp-IO.bytearray - unison-FOp-IO.bytearrayOf - unison-FOp-IO.array - unison-FOp-IO.arrayOf - - unison-FOp-IO.ref - unison-FOp-Ref.read - unison-FOp-Ref.write - unison-FOp-Ref.readForCas - unison-FOp-Ref.Ticket.read - unison-FOp-Ref.cas - - unison-FOp-Promise.new - unison-FOp-Promise.read - unison-FOp-Promise.tryRead - unison-FOp-Promise.write - - unison-FOp-IO.delay.impl.v3 - unison-POp-FORK - unison-FOp-IO.kill.impl.v3 - - unison-FOp-Handle.toText - unison-FOp-Socket.toText - unison-FOp-ThreadId.toText - - unison-POp-ABSF - unison-POp-ACOS - unison-POp-ACSH - unison-POp-ADDF - unison-POp-ASIN - unison-POp-ASNH - unison-POp-ATAN - unison-POp-ATN2 - unison-POp-ATNH - unison-POp-CEIL - unison-POp-FLOR - unison-POp-COSF - unison-POp-COSH - unison-POp-DIVF - unison-POp-DIVI - unison-POp-EQLF - unison-POp-EQLI - unison-POp-SUBF - unison-POp-SUBI - unison-POp-SGNI - unison-POp-LEQF - unison-POp-SINF - unison-POp-SINH - unison-POp-TRNF - unison-POp-RNDF - unison-POp-SQRT - unison-POp-TANH - unison-POp-TANF - unison-POp-TZRO - unison-POp-POPC - unison-POp-ITOF +(provide + (all-from-out + unison/primops/array + unison/primops/bytes + unison/primops/concurrent + unison/primops/crypto + unison/primops/io + unison/primops/io-handles + unison/primops/list + unison/primops/math + unison/primops/misc + unison/primops/pattern + unison/primops/ref + unison/primops/tcp + unison/primops/text + unison/primops/tls + unison/primops/udp + unison/primops/universal) - unison-POp-ADDN - unison-POp-ANDN unison-POp-BLDS - unison-POp-CATS - unison-POp-CATT - unison-POp-CATB - unison-POp-CMPU - unison-POp-COMN - unison-POp-CONS - unison-POp-DBTX - unison-POp-DECI - unison-POp-INCI - unison-POp-DECN - unison-POp-INCN - unison-POp-DIVN - unison-POp-DRPB - unison-POp-DRPS - unison-POp-DRPT - unison-POp-EQLN - unison-POp-EQLT - unison-POp-EXPF - unison-POp-LEQT - unison-POp-EQLU - unison-POp-EROR - unison-POp-FTOT - unison-POp-IDXB - unison-POp-IDXS - unison-POp-IORN - unison-POp-ITOT - unison-POp-LEQN - ; unison-POp-LKUP - unison-POp-LZRO - unison-POp-MULN - unison-POp-MODN - unison-POp-NTOT - unison-POp-PAKT - unison-POp-SHLI - unison-POp-SHLN - unison-POp-SHRI - unison-POp-SHRN - unison-POp-SIZS - unison-POp-SIZT - unison-POp-SIZB - unison-POp-SNOC - unison-POp-SUBN - unison-POp-SUBI - unison-POp-TAKS - unison-POp-TAKT - unison-POp-TAKB - unison-POp-TRCE - unison-POp-PRNT - unison-POp-TTON - unison-POp-TTOI - unison-POp-TTOF - unison-POp-UPKT - unison-POp-XORN - unison-POp-VALU - unison-POp-VWLS - unison-POp-UCNS - unison-POp-USNC - unison-POp-FLTB - unison-POp-MAXF - unison-POp-MINF - unison-POp-MULF - unison-POp-MULI - unison-POp-NEGI - unison-POp-NTOF - unison-POp-POWF - unison-POp-POWI - unison-POp-POWN - - unison-POp-UPKB - unison-POp-PAKB - unison-POp-ADDI - unison-POp-MULI - unison-POp-MODI - unison-POp-LEQI - unison-POp-LOGB - unison-POp-LOGF - unison-POp-POWN - unison-POp-VWRS - unison-POp-SPLL - unison-POp-SPLR - - unison-FOp-Bytes.gzip.compress - unison-FOp-Bytes.gzip.decompress - unison-FOp-Bytes.zlib.compress - unison-FOp-Bytes.zlib.decompress - unison-FOp-Bytes.toBase16 - unison-FOp-Bytes.toBase32 - unison-FOp-Bytes.toBase64 - unison-FOp-Bytes.toBase64UrlUnpadded - unison-FOp-Bytes.fromBase16 - unison-FOp-Bytes.fromBase32 - unison-FOp-Bytes.fromBase64 - unison-FOp-Bytes.fromBase64UrlUnpadded - unison-FOp-Bytes.encodeNat16be - unison-FOp-Bytes.encodeNat16le - unison-FOp-Bytes.encodeNat32be - unison-FOp-Bytes.encodeNat32le - unison-FOp-Bytes.encodeNat64be - unison-FOp-Bytes.encodeNat64le - unison-FOp-Bytes.decodeNat16be - unison-FOp-Bytes.decodeNat16le - unison-FOp-Bytes.decodeNat32be - unison-FOp-Bytes.decodeNat32le - unison-FOp-Bytes.decodeNat64be - unison-FOp-Bytes.decodeNat64le - - unison-FOp-crypto.hashBytes - unison-FOp-crypto.hmacBytes - unison-FOp-crypto.HashAlgorithm.Md5 - unison-FOp-crypto.HashAlgorithm.Sha1 - unison-FOp-crypto.HashAlgorithm.Sha2_256 - unison-FOp-crypto.HashAlgorithm.Sha2_512 - unison-FOp-crypto.HashAlgorithm.Sha3_256 - unison-FOp-crypto.HashAlgorithm.Sha3_512 - unison-FOp-crypto.HashAlgorithm.Blake2s_256 - unison-FOp-crypto.HashAlgorithm.Blake2b_256 - unison-FOp-crypto.HashAlgorithm.Blake2b_512 - - unison-FOp-IO.clientSocket.impl.v3 - unison-FOp-IO.closeSocket.impl.v3 - unison-FOp-IO.socketReceive.impl.v3 - unison-FOp-IO.socketSend.impl.v3 - unison-FOp-IO.socketPort.impl.v3 - unison-FOp-IO.serverSocket.impl.v3 - unison-FOp-IO.socketAccept.impl.v3 - unison-FOp-IO.listen.impl.v3 - unison-FOp-Tls.ClientConfig.default - unison-FOp-Tls.ClientConfig.certificates.set - unison-FOp-Tls.decodeCert.impl.v3 - unison-FOp-Tls.encodeCert - unison-FOp-Tls.newServer.impl.v3 - unison-FOp-Tls.decodePrivateKey - unison-FOp-Tls.encodePrivateKey - unison-FOp-Tls.ServerConfig.default - unison-FOp-Tls.handshake.impl.v3 - unison-FOp-Tls.newClient.impl.v3 - unison-FOp-Tls.receive.impl.v3 - unison-FOp-Tls.send.impl.v3 - unison-FOp-Tls.terminate.impl.v3 - - ; fake builtins - builtin-murmurHashBytes) + unison-FOp-internal.dataTag) (require - (except-in racket - eof - sleep) - - (only-in srfi/13 string-reverse) - rnrs/bytevectors-6 - - racket/performance-hint - - (only-in racket/flonum - fl< - fl> - fl<= - fl>= - fl=) - - (only-in racket/string - string-contains? - string-replace) - - unison/arithmetic - unison/bytevector - unison/core - - (only-in unison/boot - define-unison-builtin - referent->termlink - termlink->referent - typelink->reference - clamp-integer - clamp-natural - wrap-natural - exn:bug->exception - raise-unison-exception - bit64 - bit63 - nbit63) - - unison/data - unison/data-info - unison/math - unison/chunked-seq - unison/chunked-bytes - unison/string-search - unison/bytes-nat - unison/pattern - unison/crypto - unison/io - unison/io-handles - unison/murmurhash - unison/tls - unison/tcp - unison/udp - unison/gzip - unison/zlib - unison/concurrent - racket/random) - -; (define-builtin-link Float.*) -; (define-builtin-link Float.fromRepresentation) -; (define-builtin-link Float.toRepresentation) -; (define-builtin-link Float.ceiling) -; (define-builtin-link Float.exp) -; (define-builtin-link Float.log) -; (define-builtin-link Float.max) -; (define-builtin-link Float.min) -; (define-builtin-link Float.tan) -; (define-builtin-link Float.tanh) -; (define-builtin-link Float.logBase) -; (define-builtin-link Float.pow) -; (define-builtin-link Float.>) -; (define-builtin-link Float.<) -; (define-builtin-link Float.>=) -; (define-builtin-link Float.<=) -; (define-builtin-link Float.==) -; (define-builtin-link Int.pow) -; (define-builtin-link Int.*) -; (define-builtin-link Int.+) -; (define-builtin-link Int.-) -; (define-builtin-link Int./) -; (define-builtin-link Int.>) -; (define-builtin-link Int.<) -; (define-builtin-link Int.>=) -; (define-builtin-link Int.<=) -; (define-builtin-link Int.==) -; (define-builtin-link Int.isEven) -; (define-builtin-link Int.isOdd) -; (define-builtin-link Int.increment) -; (define-builtin-link Int.negate) -; (define-builtin-link Int.fromRepresentation) -; (define-builtin-link Int.toRepresentation) -; (define-builtin-link Int.signum) -; (define-builtin-link Int.trailingZeros) -; (define-builtin-link Int.popCount) -; (define-builtin-link Nat.increment) -; (define-builtin-link Nat.popCount) -; (define-builtin-link Nat.toFloat) -; (define-builtin-link Nat.trailingZeros) -; (define-builtin-link Nat.+) -; (define-builtin-link Nat.>) -; (define-builtin-link Nat.<) -; (define-builtin-link Nat.>=) -; (define-builtin-link Nat.<=) -; (define-builtin-link Nat.==) -; (define-builtin-link Nat.drop) -; (define-builtin-link Nat.isEven) -; (define-builtin-link Nat.isOdd) -; (define-builtin-link Text.indexOf) -; (define-builtin-link Text.>) -; (define-builtin-link Text.<) -; (define-builtin-link Text.>=) -; (define-builtin-link Text.<=) -; (define-builtin-link Text.==) -; (define-builtin-link Text.!=) -; (define-builtin-link Bytes.indexOf) -; (define-builtin-link IO.randomBytes) -; (define-builtin-link IO.tryEval) -; (define-builtin-link List.splitLeft) -; (define-builtin-link List.splitRight) -; (define-builtin-link Value.toBuiltin) -; (define-builtin-link Value.fromBuiltin) -; (define-builtin-link Code.fromGroup) -; (define-builtin-link Code.toGroup) -; (define-builtin-link TermLink.fromReferent) -; (define-builtin-link TermLink.toReferent) -; (define-builtin-link TypeLink.toReference) -; (define-builtin-link IO.seekHandle.impl.v3) -; (define-builtin-link IO.getLine.impl.v1) -; (define-builtin-link IO.getSomeBytes.impl.v1) -; (define-builtin-link IO.setBuffering.impl.v3) -; (define-builtin-link IO.getBuffering.impl.v3) -; (define-builtin-link IO.setEcho.impl.v1) -; (define-builtin-link IO.isFileOpen.impl.v3) -; (define-builtin-link IO.ready.impl.v1) -; (define-builtin-link IO.process.call) -; (define-builtin-link IO.getEcho.impl.v1) -; (define-builtin-link IO.getArgs.impl.v1) -; (define-builtin-link IO.getEnv.impl.v1) -; (define-builtin-link IO.getChar.impl.v1) -; (define-builtin-link IO.getCurrentDirectory.impl.v3) -; (define-builtin-link IO.directoryContents.impl.v3) -; (define-builtin-link IO.removeDirectory.impl.v3) -; (define-builtin-link IO.renameFile.impl.v3) -; (define-builtin-link IO.createTempDirectory.impl.v3) -; (define-builtin-link IO.createDirectory.impl.v3) -; (define-builtin-link IO.setCurrentDirectory.impl.v3) -; (define-builtin-link IO.renameDirectory.impl.v3) -; (define-builtin-link IO.fileExists.impl.v3) -; (define-builtin-link IO.isDirectory.impl.v3) -; (define-builtin-link IO.isFileEOF.impl.v3) -; (define-builtin-link IO.isSeekable.impl.v3) -; (define-builtin-link IO.handlePosition.impl.v3) -; (define-builtin-link IO.systemTime.impl.v3) -; (define-builtin-link IO.systemTimeMicroseconds.impl.v3) -; (define-builtin-link Universal.==) -; (define-builtin-link Universal.>) -; (define-builtin-link Universal.<) -; (define-builtin-link Universal.>=) -; (define-builtin-link Universal.<=) -; (define-builtin-link Universal.compare) -(define-builtin-link Universal.murmurHash) -; (define-builtin-link Pattern.captureAs) -; (define-builtin-link Pattern.many.corrected) -; (define-builtin-link Pattern.isMatch) -; (define-builtin-link Char.Class.is) -; (define-builtin-link Scope.bytearrayOf) -; (define-builtin-link unsafe.coerceAbilities) -(define-builtin-link Clock.internals.systemTimeZone.v1) - -(begin-encourage-inline - (define-unison-builtin (builtin-Value.toBuiltin v) (unison-quote v)) - (define-unison-builtin (builtin-Value.fromBuiltin v) - (unison-quote-val v)) - (define-unison-builtin (builtin-Code.fromGroup sg) (unison-code sg)) - (define-unison-builtin (builtin-Code.toGroup co) - (unison-code-rep co)) - (define-unison-builtin (builtin-TermLink.fromReferent rf) - (referent->termlink rf)) - (define-unison-builtin (builtin-TermLink.toReferent tl) - (termlink->referent tl)) - (define-unison-builtin (builtin-TypeLink.toReference tl) - (typelink->reference tl)) - (define-unison-builtin (builtin-murmurHashBytes bs) - (murmurhash-bytes (chunked-bytes->bytes bs))) - - (define-unison-builtin (builtin-IO.randomBytes n) - (bytes->chunked-bytes (crypto-random-bytes n))) - - (define-unison-builtin (builtin-List.splitLeft n s) - (match (unison-POp-SPLL n s) - [(unison-sum 0 fs) ref-seqview-empty] - [(unison-sum 1 (list l r)) (ref-seqview-elem l r)])) - - (define-unison-builtin (builtin-List.splitRight n s) - (match (unison-POp-SPLR n s) - [(unison-sum 0 fs) ref-seqview-empty] - [(unison-sum 1 (list l r)) (ref-seqview-elem l r)])) - - (define-unison-builtin (builtin-Float.> x y) (fl> x y)) - (define-unison-builtin (builtin-Float.< x y) (fl< x y)) - (define-unison-builtin (builtin-Float.>= x y) (fl>= x y)) - (define-unison-builtin (builtin-Float.<= x y) (fl<= x y)) - (define-unison-builtin (builtin-Float.== x y) (fl= x y)) - - (define-unison-builtin (builtin-Int.> x y) (> x y)) - (define-unison-builtin (builtin-Int.< x y) (< x y)) - (define-unison-builtin (builtin-Int.>= x y) (>= x y)) - (define-unison-builtin (builtin-Int.<= x y) (<= x y)) - (define-unison-builtin (builtin-Int.== x y) (= x y)) - (define-unison-builtin (builtin-Int.isEven x) (even? x)) - (define-unison-builtin (builtin-Int.isOdd x) (odd? x)) - - (define-unison-builtin (builtin-Nat.> x y) (> x y)) - (define-unison-builtin (builtin-Nat.< x y) (< x y)) - (define-unison-builtin (builtin-Nat.>= x y) (>= x y)) - (define-unison-builtin (builtin-Nat.<= x y) (<= x y)) - (begin-encourage-inline - (define-unison-builtin (builtin-Nat.== x y) (= x y))) - - (define-unison-builtin (builtin-Nat.isEven x) (even? x)) - (define-unison-builtin (builtin-Nat.isOdd x) (odd? x)) - - ; Note: chunked-string x y) - (not (chunked-string= x y) (chunked-string x y) - (case (universal-compare x y) [(>) #t] [else #f])) - (define-unison-builtin (builtin-Universal.< x y) - (case (universal-compare x y) [(<) #t] [else #f])) - (define-unison-builtin (builtin-Universal.<= x y) - (case (universal-compare x y) [(>) #f] [else #t])) - (define-unison-builtin (builtin-Universal.>= x y) - (case (universal-compare x y) [(<) #f] [else #t])) - (define-unison-builtin (builtin-Universal.compare x y) - (case (universal-compare x y) - [(>) 1] [(<) -1] [else 0])) - - (define-unison-builtin (builtin-Scope.bytearrayOf i n) - (make-bytes n i)) - - ; (define-builtin-link Link.Type.toText) - (define-unison-builtin (builtin-Link.Type.toText ln) - (string->chunked-string (typelink->string ln))) - - ; (define-builtin-link Link.Term.toText) - (define-unison-builtin (builtin-Link.Term.toText ln) - (string->chunked-string (termlink->string ln))) - - (define-unison-builtin (builtin-Char.Class.is cc c) - (pattern-match? cc (string->chunked-string (string c)))) - - (define-unison-builtin (builtin-Pattern.captureAs c p) - (capture-as c p)) - - (define-unison-builtin (builtin-Pattern.many.corrected p) (many p)) - - (define-unison-builtin (builtin-Pattern.isMatch p s) - (pattern-match? p s)) - - (define-unison-builtin (builtin-unsafe.coerceAbilities f) f) - - (define (unison-POp-UPKB bs) - (build-chunked-list - (chunked-bytes-length bs) - (lambda (i) (chunked-bytes-ref bs i)))) - - (define (unison-POp-ADDI i j) (clamp-integer (+ i j))) - (define (unison-POp-MULI i j) (clamp-integer (* i j))) - (define (unison-POp-MODI i j) (clamp-integer (modulo i j))) - (define (unison-POp-LEQI a b) (bool (<= a b))) - (define (unison-POp-POWN m n) (clamp-natural (expt m n))) - (define unison-POp-LOGF log) - - (define (reify-exn thunk) - (with-handlers - ([exn:fail:contract? - (lambda (e) - (sum 0 '() (exception->string e) ref-unit-unit))]) - (thunk))) - - ; Core implemented primops, upon which primops-in-unison can be built. - (define (unison-POp-ADDN m n) (clamp-natural (+ m n))) - (define (unison-POp-ANDN m n) (bitwise-and m n)) - (define unison-POp-BLDS - (lambda args-list - (foldr (lambda (e l) (chunked-list-add-first l e)) empty-chunked-list args-list))) - (define (unison-POp-CATS l r) (chunked-list-append l r)) - (define (unison-POp-CATT l r) (chunked-string-append l r)) - (define (unison-POp-CATB l r) (chunked-bytes-append l r)) - (define (unison-POp-CMPU l r) (ord (universal-compare l r))) - (define (unison-POp-COMN n) (wrap-natural (bitwise-not n))) - (define (unison-POp-CONS x xs) (chunked-list-add-first xs x)) - (define (unison-POp-DECI n) (clamp-integer (sub1 n))) - (define (unison-POp-INCI n) (clamp-integer (add1 n))) - (define (unison-POp-DECN n) (wrap-natural (sub1 n))) - (define (unison-POp-INCN n) (clamp-natural (add1 n))) - (define (unison-POp-DIVN m n) (quotient m n)) - (define (unison-POp-DRPB n bs) (chunked-bytes-drop bs n)) - (define (unison-POp-DRPS n l) (chunked-list-drop l n)) - (define (unison-POp-DRPT n t) (chunked-string-drop t n)) - (define (unison-POp-EQLN m n) (bool (= m n))) - (define (unison-POp-EQLT s t) (bool (equal? s t))) - (define (unison-POp-LEQT s t) (bool (chunked-stringstring fnm)]) - (raise (make-exn:bug snm x)))) - (define (unison-POp-FTOT f) - (define base (number->string f)) - (define dotted - (if (string-contains? base ".") - base - (string-replace base "e" ".0e"))) - (string->chunked-string - (string-replace dotted "+" ""))) - (define (unison-POp-IDXB n bs) - (with-handlers - ([exn:fail:contract? (lambda (e) none)]) - (some (chunked-bytes-ref bs n)))) - (define (unison-POp-IDXS n l) - (with-handlers - ([exn:fail:contract? (lambda (x) none)]) - (some (chunked-list-ref l n)))) - (define (unison-POp-IORN m n) (bitwise-ior m n)) - (define (unison-POp-ITOT n) - (string->chunked-string (number->string n))) - (define (unison-POp-LEQN m n) (bool (<= m n))) - (define (unison-POp-LZRO m) (- 64 (integer-length m))) - (define (unison-POp-MULN m n) (clamp-natural (* m n))) - (define (unison-POp-MODN m n) (modulo m n)) - (define (unison-POp-NTOT n) (string->chunked-string (number->string n))) - (define (unison-POp-PAKB l) - (build-chunked-bytes - (chunked-list-length l) - (lambda (i) (chunked-list-ref l i)))) - (define (unison-POp-PAKT l) - (build-chunked-string - (chunked-list-length l) - (lambda (i) (chunked-list-ref l i)))) - (define (unison-POp-SHLI i k) - (clamp-integer (arithmetic-shift i k))) - (define (unison-POp-SHLN n k) - (clamp-natural (arithmetic-shift n k))) - (define (unison-POp-SHRI i k) (arithmetic-shift i (- k))) - (define (unison-POp-SHRN n k) (arithmetic-shift n (- k))) - (define (unison-POp-SIZS l) (chunked-list-length l)) - (define (unison-POp-SIZT t) (chunked-string-length t)) - (define (unison-POp-SIZB b) (chunked-bytes-length b)) - (define (unison-POp-SNOC xs x) (chunked-list-add-last xs x)) - (define (unison-POp-SUBN m n) (clamp-integer (- m n))) - (define (unison-POp-SUBI m n) (clamp-integer (- m n))) - (define (unison-POp-TAKS n s) (chunked-list-take s n)) - (define (unison-POp-TAKT n t) (chunked-string-take t n)) - (define (unison-POp-TAKB n t) (chunked-bytes-take t n)) - - (define (->optional v) - (if v - (ref-optional-some v) - ref-optional-none)) - - (define-unison-builtin (builtin-Text.indexOf n h) - (->optional (chunked-string-index-of h n))) - (define-unison-builtin (builtin-Bytes.indexOf n h) - (->optional (chunked-bytes-index-of h n))) - - ;; TODO currently only runs in low-level tracing support - (define (unison-POp-DBTX x) - (sum 1 (string->chunked-string (describe-value x)))) - - (define (unison-FOp-Handle.toText h) - (string->chunked-string (describe-value h))) - (define (unison-FOp-Socket.toText s) - (string->chunked-string (describe-value s))) - (define (unison-FOp-ThreadId.toText tid) - (string->chunked-string (describe-value tid))) - - (define (unison-POp-TRCE s x) - (display "trace: ") - (display (chunked-string->string s)) - (newline) - (display (describe-value x)) - (newline)) - (define (unison-POp-PRNT s) - (display (chunked-string->string s)) - (newline)) - (define (unison-POp-TTON s) - (let ([mn (string->number (chunked-string->string s))]) - (if (and (exact-nonnegative-integer? mn) (< mn bit64)) - (some mn) - none))) - (define (unison-POp-TTOI s) - (let ([mn (string->number (chunked-string->string s))]) - (if (and (exact-integer? mn) (>= mn nbit63) (< mn bit63)) - (some mn) - none))) - (define (unison-POp-TTOF s) - (let ([mn (string->number (chunked-string->string s))]) - (if mn (some mn) none))) - (define (unison-POp-UPKT s) - (build-chunked-list - (chunked-string-length s) - (lambda (i) (chunked-string-ref s i)))) - (define (unison-POp-VWLS l) - (if (chunked-list-empty? l) - (sum 0) - (let-values ([(t h) (chunked-list-pop-first l)]) - (sum 1 h t)))) - (define (unison-POp-VWRS l) - (if (chunked-list-empty? l) - (sum 0) - (let-values ([(t h) (chunked-list-pop-last l)]) - (sum 1 t h)))) - (define (unison-POp-SPLL i s) - (if (< (chunked-list-length s) i) - (sum 0) - (let-values ([(l r) (chunked-list-split-at s i)]) - (sum 1 l r)))) - (define (unison-POp-SPLR i s) ; TODO write test that stresses this - (let ([len (chunked-list-length s) ]) - (if (< len i) - (sum 0) - (let-values ([(l r) (chunked-list-split-at s (- len i))]) - (sum 1 l r))))) - - (define (unison-POp-UCNS s) - (if (chunked-string-empty? s) - (sum 0) - (let-values ([(t h) (chunked-string-pop-first s)]) - (sum 1 (char h) t)))) - - (define (unison-POp-USNC s) - (if (chunked-string-empty? s) - (sum 0) - (let-values ([(t h) (chunked-string-pop-last s)]) - (sum 1 t (char h))))) - - ;; TODO flatten operation on Bytes is a no-op for now (and possibly ever) - (define (unison-POp-FLTB b) b) - - (define (unison-POp-XORN m n) (bitwise-xor m n)) - (define (unison-POp-VALU c) (decode-value c)) - - (define (unison-FOp-ImmutableByteArray.read16be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u16-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read24be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u24-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read32be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u32-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read40be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u40-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read48be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u48-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read56be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u56-ref bs n 'big))))) - - (define (unison-FOp-ImmutableByteArray.read64be bs n) - (reify-exn - (lambda () - (sum 1 (bytevector-u64-ref bs n 'big))))) - - (define unison-FOp-internal.dataTag unison-data-tag) - - (define (unison-FOp-IO.getBytes.impl.v3 p n) - (reify-exn - (lambda () - (right - (bytes->chunked-bytes - (read-bytes n p)))))) - - (define (unison-FOp-IO.putBytes.impl.v3 p bs) - (begin - (write-bytes (chunked-bytes->bytes bs) p) - (flush-output p) - (sum 1 #f))) - - (define (unison-FOp-Char.toText c) (string->chunked-string (string (integer->char c)))) - - (define (unison-FOp-IO.getArgs.impl.v1) - (sum 1 (cdr (command-line)))) - - (define unison-FOp-IO.systemTimeMicroseconds.v1 current-microseconds) - - ;; TODO should we convert Bytes -> Text directly without the intermediate conversions? - (define (unison-FOp-Text.fromUtf8.impl.v3 b) - (with-handlers - ([exn:fail:contract? - (lambda (e) - (exception - ref-iofailure:typelink - (string->chunked-string - (string-append - "Invalid UTF-8 stream: " - (describe-value b))) - (exception->string e)))]) - (right (string->chunked-string (bytes->string/utf-8 (chunked-bytes->bytes b)))))) - - ;; TODO should we convert Text -> Bytes directly without the intermediate conversions? - (define (unison-FOp-Text.toUtf8 s) - (bytes->chunked-bytes (string->bytes/utf-8 (chunked-string->string s)))) - - (define-unison-builtin (builtin-IO.isFileEOF.impl.v3 p) - (ref-either-right (eof-object? (peek-byte p)))) - - (define (unison-FOp-IO.closeFile.impl.v3 h) - (if (input-port? h) - (close-input-port h) - (close-output-port h)) - (right none)) - - (define (unison-FOp-Text.repeat n t) - (let loop ([cnt 0] - [acc empty-chunked-string]) - (if (= cnt n) - acc - (loop (+ cnt 1) (chunked-string-append acc t))))) - - (define (unison-FOp-Text.reverse s) - (chunked-string-foldMap-chunks - s - string-reverse - (lambda (acc c) (chunked-string-append c acc)))) - - (define (unison-FOp-Text.toLowercase s) - (chunked-string-foldMap-chunks s string-downcase chunked-string-append)) - - (define (unison-FOp-Text.toUppercase s) - (chunked-string-foldMap-chunks s string-upcase chunked-string-append)) - - (define (unison-FOp-Pattern.run p s) - (let* ([r (pattern-match p s)]) - (if r (sum 1 (cdr r) (car r)) (sum 0)))) - - (define (unison-FOp-Pattern.isMatch p s) (bool (pattern-match? p s))) - (define (unison-FOp-Pattern.many p) (many p)) - (define (unison-FOp-Pattern.capture p) (capture p)) - (define (unison-FOp-Pattern.join ps) - (join* ps)) - (define (unison-FOp-Pattern.or p1 p2) (choice p1 p2)) - (define (unison-FOp-Pattern.replicate n m p) (replicate p n m)) - - (define (unison-FOp-Text.patterns.digit) digit) - (define (unison-FOp-Text.patterns.letter) letter) - (define (unison-FOp-Text.patterns.punctuation) punctuation) - (define (unison-FOp-Text.patterns.charIn cs) (chars cs)) - (define (unison-FOp-Text.patterns.notCharIn cs) (not-chars cs)) - (define (unison-FOp-Text.patterns.anyChar) any-char) - (define (unison-FOp-Text.patterns.space) space) - (define (unison-FOp-Text.patterns.charRange a z) (char-range (integer->char a) (integer->char z))) - (define (unison-FOp-Text.patterns.notCharRange a z) (not-char-range (integer->char a) (integer->char z))) - (define (unison-FOp-Text.patterns.literal s) (literal s)) - (define (unison-FOp-Text.patterns.eof) eof) - (define (unison-FOp-Text.patterns.char cc) cc) - (define (unison-FOp-Char.Class.is cc c) - (unison-FOp-Pattern.isMatch cc (unison-FOp-Char.toText c))) - (define (unison-FOp-Char.Class.any) (unison-FOp-Text.patterns.anyChar)) - (define (unison-FOp-Char.Class.punctuation) - (unison-FOp-Text.patterns.punctuation)) - (define (unison-FOp-Char.Class.letter) (unison-FOp-Text.patterns.letter)) - (define (unison-FOp-Char.Class.alphanumeric) alphanumeric) - (define (unison-FOp-Char.Class.upper) upper) - (define (unison-FOp-Char.Class.lower) lower) - (define (unison-FOp-Char.Class.number) number) - (define (unison-FOp-Char.Class.symbol) symbol) - (define (unison-FOp-Char.Class.whitespace) space) - (define (unison-FOp-Char.Class.control) control) - (define (unison-FOp-Char.Class.printable) printable) - (define (unison-FOp-Char.Class.mark) mark) - (define (unison-FOp-Char.Class.separator) separator) - (define (unison-FOp-Char.Class.or p1 p2) (char-class-or p1 p2)) - (define (unison-FOp-Char.Class.range a z) - (unison-FOp-Text.patterns.charRange a z)) - (define (unison-FOp-Char.Class.anyOf cs) (unison-FOp-Text.patterns.charIn cs)) - (define (unison-FOp-Char.Class.and cc1 cc2) (char-class-and cc1 cc2)) - (define (unison-FOp-Char.Class.not cc) (char-class-not cc)) - - (define (catch-array thunk) - (reify-exn thunk)) - - (define (unison-FOp-ImmutableArray.read vec i) - (catch-array - (lambda () - (sum 1 (vector-ref vec i))))) - - (define (unison-FOp-ImmutableArray.copyTo! dst doff src soff n) - (catch-array - (lambda () - (vector-copy! dst doff src soff n) - (sum 1)))) - - (define (unison-FOp-MutableArray.copyTo! dst doff src soff l) - (catch-array - (lambda () - (vector-copy! dst doff src soff l) - (sum 1)))) - - (define unison-FOp-MutableArray.freeze! freeze-vector!) - - (define unison-FOp-MutableArray.freeze freeze-subvector) - - (define (unison-FOp-MutableArray.read src i) - (catch-array - (lambda () - (sum 1 (vector-ref src i))))) - - (define (unison-FOp-MutableArray.write dst i x) - (catch-array - (lambda () - (vector-set! dst i x) - (sum 1)))) - - (define (unison-FOp-ImmutableByteArray.copyTo! dst doff src soff n) - (catch-array - (lambda () - (bytes-copy! dst doff src soff n) - (sum 1)))) - - (define (unison-FOp-ImmutableByteArray.read8 arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u8-ref arr i))))) - - (define (unison-FOp-MutableByteArray.copyTo! dst doff src soff l) - (catch-array - (lambda () - (bytes-copy! dst doff src soff l) - (sum 1)))) - - (define unison-FOp-MutableByteArray.freeze! freeze-bytevector!) - - (define (unison-FOp-MutableByteArray.write8 arr i b) - (catch-array - (lambda () - (bytevector-u8-set! arr i b) - (sum 1)))) - - (define (unison-FOp-MutableByteArray.write16be arr i b) - (catch-array - (lambda () - (bytevector-u16-set! arr i b 'big) - (sum 1)))) - - (define (unison-FOp-MutableByteArray.write32be arr i b) - (catch-array - (lambda () - (bytevector-u32-set! arr i b 'big) - (sum 1)))) - - (define (unison-FOp-MutableByteArray.write64be arr i b) - (catch-array - (lambda () - (bytevector-u64-set! arr i b 'big) - (sum 1)))) - - (define (unison-FOp-MutableByteArray.read8 arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u8-ref arr i))))) - - (define (unison-FOp-MutableByteArray.read16be arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u16-ref arr i 'big))))) - - (define (unison-FOp-MutableByteArray.read24be arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u24-ref arr i 'big))))) - - (define (unison-FOp-MutableByteArray.read32be arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u32-ref arr i 'big))))) - - (define (unison-FOp-MutableByteArray.read40be arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u40-ref arr i 'big))))) - - (define (unison-FOp-MutableByteArray.read64be arr i) - (catch-array - (lambda () - (sum 1 (bytevector-u64-ref arr i 'big))))) - - (define (unison-FOp-Scope.bytearray n) (make-bytes n)) - (define (unison-FOp-IO.bytearray n) (make-bytes n)) - - (define (unison-FOp-Scope.array n) (make-vector n)) - (define (unison-FOp-IO.array n) (make-vector n)) - - (define (unison-FOp-Scope.bytearrayOf b n) (make-bytes n b)) - (define (unison-FOp-IO.bytearrayOf b n) (make-bytes n b)) - - (define (unison-FOp-Scope.arrayOf v n) (make-vector n v)) - (define (unison-FOp-IO.arrayOf v n) (make-vector n v)) - - (define unison-FOp-MutableByteArray.length bytevector-length) - (define unison-FOp-ImmutableByteArray.length bytevector-length) - (define unison-FOp-MutableByteArray.size bytevector-length) - (define unison-FOp-ImmutableByteArray.size bytevector-length) - (define unison-FOp-MutableArray.size vector-length) - (define unison-FOp-ImmutableArray.size vector-length) - - (define (unison-POp-FORK thunk) (fork thunk)) - (define (unison-FOp-IO.delay.impl.v3 micros) (sleep micros)) - (define (unison-FOp-IO.kill.impl.v3 threadId) (kill threadId)) - (define (unison-FOp-Scope.ref a) (ref-new a)) - (define (unison-FOp-IO.ref a) (ref-new a)) - (define (unison-FOp-Ref.read ref) (ref-read ref)) - (define (unison-FOp-Ref.write ref a) (ref-write ref a)) - (define (unison-FOp-Ref.readForCas ref) (ref-read ref)) - (define (unison-FOp-Ref.Ticket.read ticket) ticket) - (define (unison-FOp-Ref.cas ref ticket value) (ref-cas ref ticket value)) - (define (unison-FOp-Promise.new) (promise-new)) - (define (unison-FOp-Promise.read promise) (promise-read promise)) - (define (unison-FOp-Promise.tryRead promise) (promise-try-read promise)) - (define (unison-FOp-Promise.write promise a) (promise-write promise a))) - - -(define (exn:io? e) - (or (exn:fail:read? e) - (exn:fail:filesystem? e) - (exn:fail:network? e))) - -(define (exn:arith? e) - (or (exn:fail:contract:divide-by-zero? e) - (exn:fail:contract:non-fixnum-result? e))) - -(define-unison-builtin (builtin-IO.tryEval thunk) - (with-handlers - ([exn:break? - (lambda (e) - (raise-unison-exception - ref-threadkilledfailure:typelink - (string->chunked-string "thread killed") - ref-unit-unit))] - [exn:io? - (lambda (e) - (raise-unison-exception - ref-iofailure:typelink - (exception->string e) - ref-unit-unit))] - [exn:arith? - (lambda (e) - (raise-unison-exception - ref-arithfailure:typelink - (exception->string e) - ref-unit-unit))] - [exn:bug? (lambda (e) (exn:bug->exception e))] - [exn:fail? - (lambda (e) - (raise-unison-exception - ref-runtimefailure:typelink - (exception->string e) - ref-unit-unit))] - [(lambda (x) #t) - (lambda (e) - (raise-unison-exception - ref-miscfailure:typelink - (exception->string e) - ref-unit-unit))]) - (thunk ref-unit-unit))) - -; (declare-builtin-link builtin-Float.*) -; (declare-builtin-link builtin-Float.fromRepresentation) -; (declare-builtin-link builtin-Float.toRepresentation) -; (declare-builtin-link builtin-Float.ceiling) -; (declare-builtin-link builtin-Float.exp) -; (declare-builtin-link builtin-Float.log) -; (declare-builtin-link builtin-Float.max) -; (declare-builtin-link builtin-Float.min) -; (declare-builtin-link builtin-Float.tan) -; (declare-builtin-link builtin-Float.tanh) -; (declare-builtin-link builtin-Float.logBase) -; (declare-builtin-link builtin-Float.pow) -; (declare-builtin-link builtin-Float.>) -; (declare-builtin-link builtin-Float.<) -; (declare-builtin-link builtin-Float.>=) -; (declare-builtin-link builtin-Float.<=) -; (declare-builtin-link builtin-Float.==) -; (declare-builtin-link builtin-Int.pow) -; (declare-builtin-link builtin-Int.*) -; (declare-builtin-link builtin-Int.+) -; (declare-builtin-link builtin-Int.-) -; (declare-builtin-link builtin-Int./) -; (declare-builtin-link builtin-Int.>) -; (declare-builtin-link builtin-Int.<) -; (declare-builtin-link builtin-Int.>=) -; (declare-builtin-link builtin-Int.<=) -; (declare-builtin-link builtin-Int.==) -; (declare-builtin-link builtin-Int.isEven) -; (declare-builtin-link builtin-Int.isOdd) -; (declare-builtin-link builtin-Int.increment) -; (declare-builtin-link builtin-Int.negate) -; (declare-builtin-link builtin-Int.fromRepresentation) -; (declare-builtin-link builtin-Int.toRepresentation) -; (declare-builtin-link builtin-Int.signum) -; (declare-builtin-link builtin-Int.trailingZeros) -; (declare-builtin-link builtin-Int.popCount) -; (declare-builtin-link builtin-Nat.increment) -; (declare-builtin-link builtin-Nat.popCount) -; (declare-builtin-link builtin-Nat.toFloat) -; (declare-builtin-link builtin-Nat.trailingZeros) -; (declare-builtin-link builtin-Nat.+) -; (declare-builtin-link builtin-Nat.>) -; (declare-builtin-link builtin-Nat.<) -; (declare-builtin-link builtin-Nat.>=) -; (declare-builtin-link builtin-Nat.<=) -; (declare-builtin-link builtin-Nat.==) -; (declare-builtin-link builtin-Nat.drop) -; (declare-builtin-link builtin-Nat.isEven) -; (declare-builtin-link builtin-Nat.isOdd) -; (declare-builtin-link builtin-Text.indexOf) -; (declare-builtin-link builtin-Text.>) -; (declare-builtin-link builtin-Text.<) -; (declare-builtin-link builtin-Text.>=) -; (declare-builtin-link builtin-Text.<=) -; (declare-builtin-link builtin-Text.==) -; (declare-builtin-link builtin-Text.!=) -; (declare-builtin-link builtin-Bytes.indexOf) -; (declare-builtin-link builtin-IO.randomBytes) -; (declare-builtin-link builtin-IO.tryEval) -; (declare-builtin-link builtin-List.splitLeft) -; (declare-builtin-link builtin-List.splitRight) -; (declare-builtin-link builtin-Value.toBuiltin) -; (declare-builtin-link builtin-Value.fromBuiltin) -; (declare-builtin-link builtin-Code.fromGroup) -; (declare-builtin-link builtin-Code.toGroup) -; (declare-builtin-link builtin-TermLink.fromReferent) -; (declare-builtin-link builtin-TermLink.toReferent) -; (declare-builtin-link builtin-TypeLink.toReference) -; (declare-builtin-link builtin-IO.seekHandle.impl.v3) -; (declare-builtin-link builtin-IO.getLine.impl.v1) -; (declare-builtin-link builtin-IO.getSomeBytes.impl.v1) -; (declare-builtin-link builtin-IO.setBuffering.impl.v3) -; (declare-builtin-link builtin-IO.getBuffering.impl.v3) -; (declare-builtin-link builtin-IO.setEcho.impl.v1) -; (declare-builtin-link builtin-IO.isFileOpen.impl.v3) -; (declare-builtin-link builtin-IO.ready.impl.v1) -; (declare-builtin-link builtin-IO.process.call) -; (declare-builtin-link builtin-IO.getEcho.impl.v1) -; (declare-builtin-link builtin-IO.getArgs.impl.v1) -; (declare-builtin-link builtin-IO.getEnv.impl.v1) -; (declare-builtin-link builtin-IO.getChar.impl.v1) -; (declare-builtin-link builtin-IO.directoryContents.impl.v3) -; (declare-builtin-link builtin-IO.getCurrentDirectory.impl.v3) -; (declare-builtin-link builtin-IO.removeDirectory.impl.v3) -; (declare-builtin-link builtin-IO.renameFile.impl.v3) -; (declare-builtin-link builtin-IO.createTempDirectory.impl.v3) -; (declare-builtin-link builtin-IO.createDirectory.impl.v3) -; (declare-builtin-link builtin-IO.setCurrentDirectory.impl.v3) -; (declare-builtin-link builtin-IO.renameDirectory.impl.v3) -; (declare-builtin-link builtin-IO.fileExists.impl.v3) -; (declare-builtin-link builtin-IO.isDirectory.impl.v3) -; (declare-builtin-link builtin-IO.isFileEOF.impl.v3) -; (declare-builtin-link builtin-IO.isSeekable.impl.v3) -; (declare-builtin-link builtin-IO.handlePosition.impl.v3) -; (declare-builtin-link builtin-IO.systemTime.impl.v3) -; (declare-builtin-link builtin-IO.systemTimeMicroseconds.impl.v3) -; (declare-builtin-link builtin-Universal.==) -; (declare-builtin-link builtin-Universal.>) -; (declare-builtin-link builtin-Universal.<) -; (declare-builtin-link builtin-Universal.>=) -; (declare-builtin-link builtin-Universal.<=) -; (declare-builtin-link builtin-Universal.compare) -; (declare-builtin-link builtin-Pattern.isMatch) -; (declare-builtin-link builtin-Scope.bytearrayOf) -; (declare-builtin-link builtin-Char.Class.is) -; (declare-builtin-link builtin-Pattern.many.corrected) -; (declare-builtin-link builtin-unsafe.coerceAbilities) -; (declare-builtin-link builtin-Clock.internals.systemTimeZone.v1) + unison/primops/array + unison/primops/bytes + unison/primops/concurrent + unison/primops/crypto + unison/primops/io + unison/primops/io-handles + unison/primops/list + unison/primops/math + unison/primops/misc + unison/primops/pattern + unison/primops/ref + unison/primops/tcp + unison/primops/text + unison/primops/tls + unison/primops/udp + unison/primops/universal) + +(require unison/chunked-seq + unison/core + unison/data + racket/match) + +; BLDS occurs directly in list literal code +(define (unison-POp-BLDS . xs) + (vector->chunked-list (list->vector xs))) + +; occurs in some replacement code for the racket compiler +(define (unison-FOp-internal.dataTag v) (unison-data-tag v)) diff --git a/scheme-libs/racket/unison/primops/array.rkt b/scheme-libs/racket/unison/primops/array.rkt new file mode 100644 index 0000000000..c6937d2cd8 --- /dev/null +++ b/scheme-libs/racket/unison/primops/array.rkt @@ -0,0 +1,229 @@ +#lang racket/base + +(require unison/boot + unison/bytevector + unison/data + unison/data-info) + +(require + rnrs/bytevectors-6 + (only-in racket/unsafe/ops + [unsafe-vector*->immutable-vector! freeze-vector!])) + +(provide + builtin-ImmutableArray.copyTo! + builtin-ImmutableArray.copyTo!:termlink + builtin-ImmutableArray.read + builtin-ImmutableArray.read:termlink + builtin-ImmutableArray.size + builtin-ImmutableArray.size:termlink + builtin-ImmutableByteArray.copyTo! + builtin-ImmutableByteArray.copyTo!:termlink + builtin-ImmutableByteArray.read16be + builtin-ImmutableByteArray.read16be:termlink + builtin-ImmutableByteArray.read24be + builtin-ImmutableByteArray.read24be:termlink + builtin-ImmutableByteArray.read32be + builtin-ImmutableByteArray.read32be:termlink + builtin-ImmutableByteArray.read40be + builtin-ImmutableByteArray.read40be:termlink + builtin-ImmutableByteArray.read64be + builtin-ImmutableByteArray.read64be:termlink + builtin-ImmutableByteArray.read8 + builtin-ImmutableByteArray.read8:termlink + builtin-ImmutableByteArray.size + builtin-ImmutableByteArray.size:termlink + + builtin-MutableArray.copyTo! + builtin-MutableArray.copyTo!:termlink + builtin-MutableArray.freeze + builtin-MutableArray.freeze:termlink + builtin-MutableArray.freeze! + builtin-MutableArray.freeze!:termlink + builtin-MutableArray.read + builtin-MutableArray.read:termlink + builtin-MutableArray.size + builtin-MutableArray.size:termlink + builtin-MutableArray.write + builtin-MutableArray.write:termlink + builtin-MutableByteArray.copyTo! + builtin-MutableByteArray.copyTo!:termlink + builtin-MutableByteArray.freeze! + builtin-MutableByteArray.freeze!:termlink + builtin-MutableByteArray.read16be + builtin-MutableByteArray.read16be:termlink + builtin-MutableByteArray.read24be + builtin-MutableByteArray.read24be:termlink + builtin-MutableByteArray.read32be + builtin-MutableByteArray.read32be:termlink + builtin-MutableByteArray.read40be + builtin-MutableByteArray.read40be:termlink + builtin-MutableByteArray.read64be + builtin-MutableByteArray.read64be:termlink + builtin-MutableByteArray.read8 + builtin-MutableByteArray.read8:termlink + builtin-MutableByteArray.size + builtin-MutableByteArray.size:termlink + builtin-MutableByteArray.write16be + builtin-MutableByteArray.write16be:termlink + builtin-MutableByteArray.write32be + builtin-MutableByteArray.write32be:termlink + builtin-MutableByteArray.write64be + builtin-MutableByteArray.write64be:termlink + builtin-MutableByteArray.write8 + builtin-MutableByteArray.write8:termlink + + builtin-Scope.array + builtin-Scope.array:termlink + builtin-Scope.arrayOf + builtin-Scope.arrayOf:termlink + builtin-Scope.bytearray + builtin-Scope.bytearray:termlink + builtin-Scope.bytearrayOf + builtin-Scope.bytearrayOf:termlink) + + +(define-syntax handle-array + (syntax-rules () + [(_ ex ...) + (with-handlers + ([exn:fail:contract? + (lambda (e) + (request + ref-exception + 0 + (ref-failure-failure + ref-arrayfailure:typelink + (string->chunked-string (exception->string e)) + (unison-any-any ref-unit-unit))))]) + ex ...)])) + +(define-unison-builtin + (builtin-ImmutableArray.copyTo! dst doff src soff n) + (handle-array + (vector-copy! dst doff src soff (+ soff n)) + ref-unit-unit)) + +(define-unison-builtin (builtin-ImmutableArray.read arr i) + (handle-array (vector-ref arr i))) + +(define-unison-builtin (builtin-ImmutableArray.size arr) + (vector-length arr)) + +(define-unison-builtin + (builtin-ImmutableByteArray.copyTo! dst doff src soff n) + (handle-array + (bytes-copy! dst doff src soff (+ soff n)) + ref-unit-unit)) + +(define-unison-builtin (builtin-ImmutableByteArray.read16be arr i) + (handle-array (bytevector-u16-ref arr i 'big))) + +(define-unison-builtin (builtin-ImmutableByteArray.read24be arr i) + (handle-array (bytevector-u24-ref arr i 'big))) + +(define-unison-builtin (builtin-ImmutableByteArray.read32be arr i) + (handle-array (bytevector-u32-ref arr i 'big))) + +(define-unison-builtin (builtin-ImmutableByteArray.read40be arr i) + (handle-array (bytevector-u40-ref arr i 'big))) + +(define-unison-builtin (builtin-ImmutableByteArray.read64be arr i) + (handle-array (bytevector-u64-ref arr i 'big))) + +(define-unison-builtin (builtin-ImmutableByteArray.read8 arr i) + (handle-array (bytevector-u8-ref arr i))) + +(define-unison-builtin (builtin-ImmutableByteArray.size arr) + (bytevector-length arr)) + +(define-unison-builtin (builtin-MutableArray.copyTo! dst doff src soff l) + (handle-array + (vector-copy! dst doff src soff (+ soff l)) + ref-unit-unit)) + +(define-unison-builtin (builtin-MutableArray.freeze arr i j) + (freeze-subvector arr i j)) + +(define-unison-builtin (builtin-MutableArray.freeze! arr) + (freeze-vector! arr)) + +(define-unison-builtin (builtin-MutableArray.read arr i) + (handle-array (vector-ref arr i))) + +(define-unison-builtin (builtin-MutableArray.size arr) + (vector-length arr)) + +(define-unison-builtin (builtin-MutableArray.write dst i x) + (handle-array + (vector-set! dst i x) + ref-unit-unit)) + +(define-unison-builtin + (builtin-MutableByteArray.copyTo! dst doff src soff l) + (handle-array + (bytes-copy! dst doff src soff (+ soff l)) + ref-unit-unit)) + +(define-unison-builtin (builtin-MutableByteArray.freeze! arr) + (freeze-bytevector! arr)) + +(define-unison-builtin (builtin-MutableByteArray.read16be arr i) + (handle-array (bytevector-u16-ref arr i 'big))) + +(define-unison-builtin (builtin-MutableByteArray.read24be arr i) + (handle-array (bytevector-u24-ref arr i 'big))) + +(define-unison-builtin (builtin-MutableByteArray.read32be arr i) + (handle-array (bytevector-u32-ref arr i 'big))) + +(define-unison-builtin (builtin-MutableByteArray.read40be arr i) + (handle-array (bytevector-u40-ref arr i 'big))) + +(define-unison-builtin (builtin-MutableByteArray.read64be arr i) + (handle-array (bytevector-u64-ref arr i 'big))) + +(define-unison-builtin (builtin-MutableByteArray.read8 arr i) + (handle-array (bytevector-u8-ref arr i))) + +(define-unison-builtin (builtin-MutableByteArray.size arr) + (bytevector-length arr)) + +(define-unison-builtin (builtin-MutableByteArray.write16be arr i m) + (handle-array + (bytevector-u16-set! arr i m 'big) + ref-unit-unit)) + +(define-unison-builtin (builtin-MutableByteArray.write32be arr i m) + (handle-array + (bytevector-u32-set! arr i m 'big) + ref-unit-unit)) + +(define-unison-builtin (builtin-MutableByteArray.write64be arr i m) + (handle-array + (bytevector-u64-set! arr i m 'big) + ref-unit-unit)) + +(define-unison-builtin (builtin-MutableByteArray.write8 arr i m) + (handle-array + (bytevector-u8-set! arr i m) + ref-unit-unit)) + +(define-unison-builtin (builtin-Scope.array n) + (make-vector n)) + +(define-unison-builtin (builtin-Scope.arrayOf v n) + (make-vector n v)) + +(define-unison-builtin (builtin-Scope.bytearray n) + (make-bytes n)) + +(define-unison-builtin (builtin-Scope.bytearrayOf i n) + (make-bytes n i)) + +(define (freeze-subvector src off len0) + (define len (min len0 (- (vector-length src) off))) + (define dst (make-vector len)) + + (vector-copy! dst 0 src off (+ off len)) + (freeze-vector! dst)) diff --git a/scheme-libs/racket/unison/primops/bytes.rkt b/scheme-libs/racket/unison/primops/bytes.rkt new file mode 100644 index 0000000000..6259fdf7e4 --- /dev/null +++ b/scheme-libs/racket/unison/primops/bytes.rkt @@ -0,0 +1,222 @@ + +#lang racket/base + +(require unison/boot + unison/bytes-nat + unison/chunked-bytes + unison/chunked-seq + unison/data + unison/data-info + unison/gzip + unison/string-search + unison/zlib) + +(provide + builtin-Bytes.++ + builtin-Bytes.++:termlink + builtin-Bytes.at + builtin-Bytes.at:termlink + builtin-Bytes.decodeNat16be + builtin-Bytes.decodeNat16be:termlink + builtin-Bytes.decodeNat16le + builtin-Bytes.decodeNat16le:termlink + builtin-Bytes.decodeNat32be + builtin-Bytes.decodeNat32be:termlink + builtin-Bytes.decodeNat32le + builtin-Bytes.decodeNat32le:termlink + builtin-Bytes.decodeNat64be + builtin-Bytes.decodeNat64be:termlink + builtin-Bytes.decodeNat64le + builtin-Bytes.decodeNat64le:termlink + builtin-Bytes.drop + builtin-Bytes.drop:termlink + builtin-Bytes.empty + builtin-Bytes.empty:termlink + builtin-Bytes.encodeNat16be + builtin-Bytes.encodeNat16be:termlink + builtin-Bytes.encodeNat16le + builtin-Bytes.encodeNat16le:termlink + builtin-Bytes.encodeNat32be + builtin-Bytes.encodeNat32be:termlink + builtin-Bytes.encodeNat32le + builtin-Bytes.encodeNat32le:termlink + builtin-Bytes.encodeNat64be + builtin-Bytes.encodeNat64be:termlink + builtin-Bytes.encodeNat64le + builtin-Bytes.encodeNat64le:termlink + builtin-Bytes.flatten + builtin-Bytes.flatten:termlink + builtin-Bytes.fromBase16 + builtin-Bytes.fromBase16:termlink + builtin-Bytes.fromBase32 + builtin-Bytes.fromBase32:termlink + builtin-Bytes.fromBase64 + builtin-Bytes.fromBase64:termlink + builtin-Bytes.fromBase64UrlUnpadded + builtin-Bytes.fromBase64UrlUnpadded:termlink + builtin-Bytes.fromList + builtin-Bytes.fromList:termlink + builtin-Bytes.gzip.compress + builtin-Bytes.gzip.compress:termlink + builtin-Bytes.gzip.decompress + builtin-Bytes.gzip.decompress:termlink + builtin-Bytes.indexOf + builtin-Bytes.indexOf:termlink + builtin-Bytes.size + builtin-Bytes.size:termlink + builtin-Bytes.take + builtin-Bytes.take:termlink + builtin-Bytes.toBase16 + builtin-Bytes.toBase16:termlink + builtin-Bytes.toBase32 + builtin-Bytes.toBase32:termlink + builtin-Bytes.toBase64 + builtin-Bytes.toBase64:termlink + builtin-Bytes.toBase64UrlUnpadded + builtin-Bytes.toBase64UrlUnpadded:termlink + builtin-Bytes.toList + builtin-Bytes.toList:termlink + builtin-Bytes.zlib.compress + builtin-Bytes.zlib.compress:termlink + builtin-Bytes.zlib.decompress + builtin-Bytes.zlib.decompress:termlink) + +(define-unison-builtin (builtin-Bytes.++ l r) + (chunked-bytes-append l r)) + +(define-unison-builtin (builtin-Bytes.at n bs) + (with-handlers + ([exn:fail:contract? (lambda (e) ref-optional-none)]) + (ref-optional-some (chunked-bytes-ref bs n)))) + +(define-unison-builtin (builtin-Bytes.decodeNat16be bs) + (decodeNatBe bs 2)) + +(define-unison-builtin (builtin-Bytes.decodeNat16le bs) + (decodeNatLe bs 2)) + +(define-unison-builtin (builtin-Bytes.decodeNat32be bs) + (decodeNatBe bs 4)) + +(define-unison-builtin (builtin-Bytes.decodeNat32le bs) + (decodeNatLe bs 4)) + +(define-unison-builtin (builtin-Bytes.decodeNat64be bs) + (decodeNatBe bs 8)) + +(define-unison-builtin (builtin-Bytes.decodeNat64le bs) + (decodeNatLe bs 8)) + +(define-unison-builtin (builtin-Bytes.drop n bs) + (chunked-bytes-drop bs n)) + +(define-unison-builtin #:hints [value] (builtin-Bytes.empty) + empty-chunked-bytes) + +(define-unison-builtin (builtin-Bytes.encodeNat16be n) + (encodeNatBe n 2)) + +(define-unison-builtin (builtin-Bytes.encodeNat16le n) + (encodeNatLe n 2)) + +(define-unison-builtin (builtin-Bytes.encodeNat32be n) + (encodeNatBe n 4)) + +(define-unison-builtin (builtin-Bytes.encodeNat32le n) + (encodeNatLe n 4)) + +(define-unison-builtin (builtin-Bytes.encodeNat64be n) + (encodeNatBe n 8)) + +(define-unison-builtin (builtin-Bytes.encodeNat64le n) + (encodeNatLe n 8)) + +; Note: the current implementation has no mechanism for +; flattening the representation, but in the event this changes, +; this should be revisited. +(define-unison-builtin (builtin-Bytes.flatten bs) bs) + +(define-unison-builtin (builtin-Bytes.fromBase16 bs) + (with-handlers + ([exn:fail? (lambda (e) (ref-either-left (exception->string e)))]) + (ref-either-right (base16-decode bs)))) + +(define-unison-builtin (builtin-Bytes.fromBase32 bs) + (with-handlers + ([exn:fail? (lambda (e) (ref-either-left (exception->string e)))]) + (ref-either-right (base32-decode bs)))) + +(define-unison-builtin (builtin-Bytes.fromBase64 bs) + (with-handlers + ([exn:fail? (lambda (e) (ref-either-left (exception->string e)))]) + (ref-either-right (base64-decode bs)))) + +(define-unison-builtin (builtin-Bytes.fromBase64UrlUnpadded bs) + (with-handlers + ([exn:fail? (lambda (e) (ref-either-left (exception->string e)))]) + (ref-either-right (base64-decode bs #:padded? #f)))) + +(define-unison-builtin (builtin-Bytes.fromList l) + (build-chunked-bytes + (chunked-list-length l) + (lambda (i) (chunked-list-ref l i)))) + +(define-unison-builtin (builtin-Bytes.gzip.compress bs) + (bytes->chunked-bytes (gzip-bytes (chunked-bytes->bytes bs)))) + +(define-unison-builtin (builtin-Bytes.gzip.decompress bs) + (with-handlers + [[exn:fail? (lambda (e) (ref-either-left (exception->string e)))]] + (ref-either-right + (bytes->chunked-bytes + (gunzip-bytes + (chunked-bytes->bytes bs)))))) + +(define-unison-builtin (builtin-Bytes.size bs) + (chunked-bytes-length bs)) + +(define-unison-builtin (builtin-Bytes.take n bs) + (chunked-bytes-take bs n)) + +(define-unison-builtin (builtin-Bytes.toBase16 bs) + (base16-encode bs)) + +(define-unison-builtin (builtin-Bytes.toBase32 bs) + (base32-encode bs)) + +(define-unison-builtin (builtin-Bytes.toBase64 bs) + (base64-encode bs)) + +(define-unison-builtin (builtin-Bytes.toBase64UrlUnpadded bs) + (base64-encode bs #:pad? #f)) + +(define-unison-builtin (builtin-Bytes.toList bs) + (build-chunked-list + (chunked-bytes-length bs) + (lambda (i) (chunked-bytes-ref bs i)))) + +(define-unison-builtin (builtin-Bytes.zlib.compress bs) + (bytes->chunked-bytes + (zlib-deflate-bytes + (chunked-bytes->bytes bs)))) + +(define-unison-builtin (builtin-Bytes.zlib.decompress bs) + (with-handlers + [[exn:fail? + (lambda (e) + (ref-either-left + (ref-failure-failure + ref-miscfailure:typelink + (exception->string e) + (unison-any-any ref-unit-unit))))]] + (ref-either-right + (bytes->chunked-bytes + (zlib-inflate-bytes + (chunked-bytes->bytes bs)))))) + +(define-unison-builtin (builtin-Bytes.indexOf n h) + (define v (chunked-bytes-index-of h n)) + + (if v + (ref-optional-some v) + ref-optional-none)) diff --git a/scheme-libs/racket/unison/primops/concurrent.rkt b/scheme-libs/racket/unison/primops/concurrent.rkt new file mode 100644 index 0000000000..b873a0e743 --- /dev/null +++ b/scheme-libs/racket/unison/primops/concurrent.rkt @@ -0,0 +1,53 @@ + +#lang racket/base + +(require unison/boot + unison/concurrent + unison/data + unison/data-info) + +(provide + builtin-IO.delay.impl.v3 + builtin-IO.delay.impl.v3:termlink + builtin-IO.forkComp.v2 + builtin-IO.forkComp.v2:termlink + builtin-IO.kill.impl.v3 + builtin-IO.kill.impl.v3:termlink + + builtin-Promise.new + builtin-Promise.new:termlink + builtin-Promise.read + builtin-Promise.read:termlink + builtin-Promise.tryRead + builtin-Promise.tryRead:termlink + builtin-Promise.write + builtin-Promise.write:termlink + builtin-ThreadId.toText + builtin-ThreadId.toText:termlink) + + +(define-unison-builtin (builtin-Promise.new _) (promise-new)) + +(define-unison-builtin (builtin-Promise.read p) (promise-read p)) + +(define-unison-builtin (builtin-Promise.tryRead p) (promise-try-read p)) + +(define-unison-builtin (builtin-Promise.write p v) (promise-write p v)) + +(define-unison-builtin (builtin-ThreadId.toText tid) + (string->chunked-string (describe-value tid))) + +(define-unison-builtin (builtin-IO.delay.impl.v3 micros) + ; TODO: this seems like it should have error handling, but it hadn't + ; been implemented yet. + (sleep micros) + (ref-either-right ref-unit-unit)) + +(define-unison-builtin (builtin-IO.forkComp.v2 k) + (fork (lambda () (k ref-unit-unit)))) + +(define-unison-builtin (builtin-IO.kill.impl.v3 tid) + ; TODO: this seems like it should have error handling, but it hadn't + ; been implemented yet. + (kill tid) + (ref-either-right ref-unit-unit)) diff --git a/scheme-libs/racket/unison/primops/crypto.rkt b/scheme-libs/racket/unison/primops/crypto.rkt new file mode 100644 index 0000000000..8a0607b998 --- /dev/null +++ b/scheme-libs/racket/unison/primops/crypto.rkt @@ -0,0 +1,438 @@ +#lang racket/base + +(require ffi/unsafe + ffi/unsafe/define + racket/exn + racket/runtime-path + (for-syntax racket/base) + openssl/libcrypto + unison/boot + unison/chunked-seq + racket/bool + (only-in openssl/sha1 bytes->hex-string hex-string->bytes) + + ) + +(provide + builtin-crypto.HashAlgorithm.Blake2b_256 + builtin-crypto.HashAlgorithm.Blake2b_256:termlink + builtin-crypto.HashAlgorithm.Blake2b_512 + builtin-crypto.HashAlgorithm.Blake2b_512:termlink + builtin-crypto.HashAlgorithm.Blake2s_256 + builtin-crypto.HashAlgorithm.Blake2s_256:termlink + builtin-crypto.HashAlgorithm.Md5 + builtin-crypto.HashAlgorithm.Md5:termlink + builtin-crypto.HashAlgorithm.Sha1 + builtin-crypto.HashAlgorithm.Sha1:termlink + builtin-crypto.HashAlgorithm.Sha2_256 + builtin-crypto.HashAlgorithm.Sha2_256:termlink + builtin-crypto.HashAlgorithm.Sha2_512 + builtin-crypto.HashAlgorithm.Sha2_512:termlink + builtin-crypto.HashAlgorithm.Sha3_256 + builtin-crypto.HashAlgorithm.Sha3_256:termlink + builtin-crypto.HashAlgorithm.Sha3_512 + builtin-crypto.HashAlgorithm.Sha3_512:termlink + builtin-crypto.hashBytes + builtin-crypto.hashBytes:termlink + builtin-crypto.hmacBytes + builtin-crypto.hmacBytes:termlink + builtin-crypto.Ed25519.verify.impl + builtin-crypto.Ed25519.verify.impl:termlink + builtin-crypto.Ed25519.sign.impl + builtin-crypto.Ed25519.sign.impl:termlink) + +(define-runtime-path libb2-so '(so "libb2" ("1" #f))) + +(define libb2 + (with-handlers [[exn:fail? exn->string]] + (ffi-lib libb2-so '("1" #f)))) + +(define _EVP-pointer (_cpointer 'EVP)) + +; returns a function that, when called, either +; 1) raises an exception, if libcrypto failed to load, or +; 2) returns a pair of (_EVP-pointer bits) +(define (lc-algo name bits) + (if (string? libcrypto) + (raise (error 'libcrypto "~a\n~a" name libcrypto)) + (let ([getter (get-ffi-obj name libcrypto (_fun -> _EVP-pointer))]) + (cons (getter) bits)))) + +(define (check v who) + (unless (= 1 v) + (error who "failed with return value ~a" v))) + +(define EVP_Digest + (if (string? libcrypto) + (lambda _ (raise (error 'libcrypto "EVP_Digest\n~a" libcrypto))) + (get-ffi-obj "EVP_Digest" libcrypto + (_fun + _pointer ; input + _int ; input-len + _pointer ; output + _pointer ; null + _EVP-pointer ; algorithm + _pointer ; null + -> (r : _int) + -> (unless (= 1 r) + (error 'EVP_Digest "failed with return value ~a" r)))))) + +(define HMAC + (if (string? libcrypto) + (lambda _ (raise (error 'libcrypto "HMAC\n~a" libcrypto))) + (get-ffi-obj "HMAC" libcrypto + (_fun + _EVP-pointer ; algorithm + _pointer ; key + _int ; key-len + _pointer ; input + _int ; input-len + _pointer ; output pointer + _pointer ; null + -> _pointer ; unused + )))) + +(define (libb2-raw fn) + (if (string? libb2) + (lambda _ (raise (error 'libb2 "~a\n~a" fn libb2))) + (get-ffi-obj fn libb2 + (_fun + _pointer ; output + _pointer ; input + _pointer ; key + _int ; output-len + _int ; input-len + _int ; key-len + -> (r : _int) + -> (unless (= 0 r) + (error 'blake2 "~a failed with return value ~a" fn r)))))) + +(define blake2b-raw (libb2-raw "blake2b")) +(define blake2s-raw (libb2-raw "blake2s")) + +(define-unison-builtin #:hints [value] + (builtin-crypto.HashAlgorithm.Md5) + (lc-algo "EVP_md5" 128)) + +(define-unison-builtin #:hints [value] + (builtin-crypto.HashAlgorithm.Sha1) + (lc-algo "EVP_sha1" 160)) + +(define-unison-builtin #:hints [value] + (builtin-crypto.HashAlgorithm.Sha2_256) + (lc-algo "EVP_sha256" 256)) + +(define-unison-builtin #:hints [value] + (builtin-crypto.HashAlgorithm.Sha2_512) + (lc-algo "EVP_sha512" 512)) + +(define-unison-builtin #:hints [value] + (builtin-crypto.HashAlgorithm.Sha3_256) + (lc-algo "EVP_sha3_256" 256)) + +(define-unison-builtin #:hints [value] + (builtin-crypto.HashAlgorithm.Sha3_512) + (lc-algo "EVP_sha3_512" 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-unison-builtin + (builtin-crypto.Ed25519.sign.impl seed _ignored_pubkey input) + (bytes->chunked-bytes + (evpSign-raw + (chunked-bytes->bytes seed) + (chunked-bytes->bytes input)))) + +(define-unison-builtin + (builtin-crypto.Ed25519.verify.impl public-key input signature) + (evpVerify-raw + (chunked-bytes->bytes public-key) + (chunked-bytes->bytes input) + (chunked-bytes->bytes signature))) + +(define-unison-builtin #:hints [value] + (builtin-crypto.HashAlgorithm.Blake2s_256) + (cons 'blake2s 256)) +(define-unison-builtin #:hints [value] + (builtin-crypto.HashAlgorithm.Blake2b_512) + (cons 'blake2b 512)) + +; This one isn't provided by libcrypto, for some reason +(define-unison-builtin #:hints [value] + (builtin-crypto.HashAlgorithm.Blake2b_256) + (cons 'blake2b 256)) + +; kind is a pair of (algorithm bits) +; where algorithm is either an EVP_pointer for libcrypto functions, +; or the tag 'blake2b for libb2 function. +(define-unison-builtin (builtin-crypto.hashBytes kind input) + (bytes->chunked-bytes + (hashBytes-raw kind (chunked-bytes->bytes input)))) + +; kind is a pair of (algorithm bits) +; where algorithm is either an EVP_pointer for libcrypto functions, +; or the tag 'blake2b for libb2 function. +(define (hashBytes-raw kind input) + (let* ([bytes (/ (cdr kind) 8)] + [output (make-bytes bytes)] + [algo (car kind)]) + (case algo + ['blake2b (blake2b-raw output input #f bytes (bytes-length input) 0)] + ['blake2s (blake2s-raw output input #f bytes (bytes-length input) 0)] + [else (EVP_Digest input (bytes-length input) output #f algo #f)]) + + output)) + +; Mutates and returns the first argument +(define (xor one two) + (for ([i (in-range (bytes-length one))]) + (bytes-set! one i + (bitwise-xor + (bytes-ref one i) + (bytes-ref two i)))) + one) + +; doing the blake hmac by hand. libcrypto +; supports hmac natively, so we just defer to that +(define (hmacBlake kind key input) + (let* + ([bytes (/ (cdr kind) 8)] + [blocksize (case (car kind) ['blake2b 128] ['blake2s 64])] + + [key_ + (let ([key_ (make-bytes blocksize 0)]) + (bytes-copy! key_ 0 + (if (< blocksize (bytes-length key)) + (hashBytes-raw kind key) + key)) + key_)] + + [opad (xor (make-bytes blocksize #x5c) key_)] + [ipad (xor (make-bytes blocksize #x36) key_)] + + [full (bytes-append + opad + (hashBytes-raw kind (bytes-append ipad input)))]) + (hashBytes-raw kind full))) + +(define-unison-builtin (builtin-crypto.hmacBytes kind key input) + (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)] + ['blake2s (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` +(module+ test + (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-raw (builtin-crypto.HashAlgorithm.Sha1) #"key" #"message")) + "2088df74d5f2146b48146caf4965377e9d0be3a4")) + + (test-case "blake2b-256 hmac" + (check-equal? + (bytes->hex-string (hmacBytes-raw (builtin-crypto.HashAlgorithm.Blake2b_256) #"key" #"message")) + "442d98a3872d3f56220f89e2b23d0645610b37c33dd3315ef224d0e39ada6751")) + + (test-case "blake2b-512 hmac" + (check-equal? + (bytes->hex-string (hmacBytes-raw (builtin-crypto.HashAlgorithm.Blake2b_512) #"key" #"message")) + "04e9ada930688cde75eec939782eed653073dd621d7643f813702976257cf037d325b50eedd417c01b6ad1f978fbe2980a93d27d854044e8626df6fa279d6680")) + + (test-case "blake2s-256 hmac" + (check-equal? + (bytes->hex-string (hmacBytes-raw (builtin-crypto.HashAlgorithm.Blake2s_256) #"key" #"message")) + "bba8fa28708ae80d249e317318c95c859f3f77512be23910d5094d9110454d6f")) + + (test-case "md5 basic" + (check-equal? + (bytes->hex-string (hashBytes-raw (builtin-crypto.HashAlgorithm.Md5) #"")) + "d41d8cd98f00b204e9800998ecf8427e")) + + (test-case "sha1 basic" + (check-equal? + (bytes->hex-string (hashBytes-raw (builtin-crypto.HashAlgorithm.Sha1) #"")) + "da39a3ee5e6b4b0d3255bfef95601890afd80709")) + + (test-case "sha2-256 basic" + (check-equal? + (bytes->hex-string (hashBytes-raw (builtin-crypto.HashAlgorithm.Sha2_256) #"")) + "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855")) + + (test-case "sha2-512 basic" + (check-equal? + (bytes->hex-string (hashBytes-raw (builtin-crypto.HashAlgorithm.Sha2_512) #"")) + "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e")) + + (test-case "sha3-256 basic" + (check-equal? + (bytes->hex-string (hashBytes-raw (builtin-crypto.HashAlgorithm.Sha3_256) #"")) + "a7ffc6f8bf1ed76651c14756a061d662f580ff4de43b49fa82d80a4b80f8434a")) + + (test-case "sha3-512 basic" + (check-equal? + (bytes->hex-string (hashBytes-raw (builtin-crypto.HashAlgorithm.Sha3_512) #"")) + "a69f73cca23a9ac5c8b567dc185a756e97c982164fe25859e0d1dcc1475c80a615b2123af1f5f94c11e3e9402c3ac558f500199d95b6d3e301758586281dcd26")) + + (test-case "blake2s_256 basic" + (check-equal? + (bytes->hex-string (hashBytes-raw (builtin-crypto.HashAlgorithm.Blake2s_256) #"")) + "69217a3079908094e11121d042354a7c1f55b6482ca1a51e1b250dfd1ed0eef9")) + + (test-case "blake2b_256 basic" + (check-equal? + (bytes->hex-string (hashBytes-raw (builtin-crypto.HashAlgorithm.Blake2b_256) #"")) + "0e5751c026e543b2e8ab2eb06099daa1d1e5df47778f7787faab45cdf12fe3a8")) + + (test-case "blake2b_512 basic" + (check-equal? + (bytes->hex-string (hashBytes-raw (builtin-crypto.HashAlgorithm.Blake2b_512) #"")) + "786a02f742015903c6c6fd852552d272912f4740e15847618a86e217f71f5419d25e1031afee585313896444934eb04b903a685b1448b755d56f701afe9be2ce"))) diff --git a/scheme-libs/racket/unison/primops/io-handles.rkt b/scheme-libs/racket/unison/primops/io-handles.rkt new file mode 100644 index 0000000000..94724dca6f --- /dev/null +++ b/scheme-libs/racket/unison/primops/io-handles.rkt @@ -0,0 +1,305 @@ +#lang racket/base + +(require racket/string + rnrs/io/ports-6 + (only-in rnrs standard-error-port standard-input-port standard-output-port) + (only-in racket + empty? + match + with-output-to-string + system/exit-code + system + false?) + unison/boot + unison/data + unison/chunked-seq + unison/data + unison/data-info + unison/chunked-seq + unison/data + ) + +(provide + builtin-Handle.toText + builtin-Handle.toText:termlink + + builtin-IO.closeFile.impl.v3 + builtin-IO.closeFile.impl.v3:termlink + builtin-IO.getBytes.impl.v3 + builtin-IO.getBytes.impl.v3:termlink + builtin-IO.stdHandle + builtin-IO.stdHandle:termlink + builtin-IO.openFile.impl.v3 + builtin-IO.openFile.impl.v3:termlink + builtin-IO.putBytes.impl.v3 + builtin-IO.putBytes.impl.v3:termlink + builtin-IO.seekHandle.impl.v3 + builtin-IO.seekHandle.impl.v3:termlink + builtin-IO.getLine.impl.v1 + builtin-IO.getLine.impl.v1:termlink + builtin-IO.getSomeBytes.impl.v1 + builtin-IO.getSomeBytes.impl.v1:termlink + builtin-IO.getBuffering.impl.v3 + builtin-IO.getBuffering.impl.v3:termlink + builtin-IO.setBuffering.impl.v3 + builtin-IO.setBuffering.impl.v3:termlink + builtin-IO.getEcho.impl.v1 + builtin-IO.getEcho.impl.v1:termlink + builtin-IO.setEcho.impl.v1 + builtin-IO.setEcho.impl.v1:termlink + builtin-IO.getChar.impl.v1 + builtin-IO.getChar.impl.v1:termlink + builtin-IO.isFileOpen.impl.v3 + builtin-IO.isFileOpen.impl.v3:termlink + builtin-IO.isSeekable.impl.v3 + builtin-IO.isSeekable.impl.v3:termlink + builtin-IO.handlePosition.impl.v3 + builtin-IO.handlePosition.impl.v3:termlink + builtin-IO.process.call + builtin-IO.process.call:termlink + builtin-IO.ready.impl.v1 + builtin-IO.ready.impl.v1:termlink + +; Still to implement: +; handlePosition.impl.v3 +; isSeekable.impl.v3 +; getChar.impl.v1 + ) + +; typeLink msg any +(define (Exception typeLink message payload) + (let* ([a (unison-any-any payload)] + [msg (string->chunked-string message)] + [f (ref-failure-failure typeLink msg a)]) + (ref-either-left f))) + +(define-unison-builtin + (builtin-IO.isFileOpen.impl.v3 port) + (ref-either-right (not (port-closed? port)))) + +(define-unison-builtin + (builtin-IO.ready.impl.v1 port) + (if (byte-ready? port) + (ref-either-right #t) + (if (port-eof? port) + (Exception ref-iofailure:typelink "EOF" port) + (ref-either-right #f)))) + +(define-unison-builtin + (builtin-IO.isSeekable.impl.v3 handle) + (ref-either-right + (port-has-set-port-position!? handle))) + +(define-unison-builtin + (builtin-IO.handlePosition.impl.v3 handle) + (ref-either-right (port-position handle))) + +(define-unison-builtin + (builtin-IO.seekHandle.impl.v3 handle mode amount) + (data-case mode + (0 () + (set-port-position! handle amount) + (ref-either-right none)) + (1 () + (let ([current (port-position handle)]) + (set-port-position! handle (+ current amount)) + (ref-either-right none))) + (2 () + (Exception + ref-iofailure:typelink + "SeekFromEnd not supported" + 0)))) + +(define-unison-builtin + (builtin-IO.getLine.impl.v1 handle) + (let* ([line (read-line handle)]) + (if (eof-object? line) + (ref-either-right (string->chunked-string "")) + (ref-either-right (string->chunked-string line)) + ))) + +(define-unison-builtin + (builtin-IO.getChar.impl.v1 handle) + (let* ([char (read-char handle)]) + (if (eof-object? char) + (Exception + ref-iofailure:typelink + "End of file reached" + ref-unit-unit) + (ref-either-right char)))) + +(define-unison-builtin + (builtin-IO.getSomeBytes.impl.v1 handle nbytes) + (let* ([buffer (make-bytes nbytes)] + [line (read-bytes-avail! buffer handle)]) + (cond + [(eof-object? line) + (ref-either-right (bytes->chunked-bytes #""))] + [(procedure? line) + (Exception + ref-iofailure:typelink + "getSomeBytes.impl: special value returned" + ref-unit-unit)] + [else + (ref-either-right + (bytes->chunked-bytes + (if (< line nbytes) + (subbytes buffer 0 line) + buffer)))]))) + +(define-unison-builtin + (builtin-IO.getBuffering.impl.v3 handle) + (case (file-stream-buffer-mode handle) + [(none) (ref-either-right ref-buffermode-no-buffering)] + [(line) (ref-either-right + ref-buffermode-line-buffering)] + [(block) (ref-either-right + ref-buffermode-block-buffering)] + [(#f) (Exception + ref-iofailure:typelink + "Unable to determine buffering mode of handle" + ref-unit-unit)] + [else (Exception + ref-iofailure:typelink + "Unexpected response from file-stream-buffer-mode" + ref-unit-unit)])) + +(define-unison-builtin + (builtin-IO.setBuffering.impl.v3 handle mode) + (data-case mode + (0 () + (file-stream-buffer-mode handle 'none) + (ref-either-right none)) + (1 () + (file-stream-buffer-mode handle 'line) + (ref-either-right none)) + (2 () + (file-stream-buffer-mode handle 'block) + (ref-either-right none)) + (3 (size) + (Exception + ref-iofailure:typelink + "Sized block buffering not supported" + ref-unit-unit)))) + +(define (with-buffer-mode port mode) + (file-stream-buffer-mode port mode) + port) + +(define stdin (with-buffer-mode (standard-input-port) 'none)) +(define stdout (with-buffer-mode (standard-output-port) 'line)) +(define stderr (with-buffer-mode (standard-error-port) 'line)) + +(define-unison-builtin (builtin-IO.stdHandle sth) + (match sth + [(unison-data r t (list)) + (=> break) + (cond + [(= t ref-stdhandle-stdin:tag) stdin] + [(= t ref-stdhandle-stdout:tag) stdout] + [(= t ref-stdhandle-stderr:tag) stderr] + [else (break)])] + [else + (raise (make-exn:bug "invalid standard handle" sth))])) + +(define-unison-builtin + (builtin-IO.getEcho.impl.v1 handle) + (if (eq? handle stdin) + (ref-either-right (get-stdin-echo)) + (Exception + ref-iofailure:typelink + "getEcho only supported on stdin" + ref-unit-unit))) + +(define-unison-builtin + (builtin-IO.setEcho.impl.v1 handle echo) + (if (eq? handle stdin) + (begin + (if echo + (system "stty echo") + (system "stty -echo")) + (ref-either-right none)) + (Exception + ref-iofailure:typelink + "setEcho only supported on stdin" + ref-unit-unit))) + +(define (get-stdin-echo) + (let ([current (with-output-to-string (lambda () (system "stty -a")))]) + (string-contains? current " echo "))) + +(define-unison-builtin (builtin-IO.openFile.impl.v3 name mode) + (define fn (chunked-string->string name)) + + (match mode + [(unison-data r t _) + (=> break) + (ref-either-right + (cond + [(= t ref-filemode-read:tag) + (open-input-file fn)] + [(= t ref-filemode-write:tag) + (open-output-file fn #:exists 'truncate)] + [(= t ref-filemode-append:tag) + (open-output-file fn #:exists 'append)] + [(= t ref-filemode-readwrite:tag) + (open-input-output-file fn #:exists 'can-update)] + ; break back to outer match + [else (break)]))] + [else + (ref-either-left + (ref-failure-failure + ref-iofailure:typelink + (string->chunked-string "invalid file mode") + (unison-any-any mode)))])) + +;; From https://github.com/sorawee/shlex/blob/5de06500e8c831cfc8dffb99d57a76decc02c569/main.rkt (MIT License) +;; with is a port of https://github.com/python/cpython/blob/bf2f76ec0976c09de79c8827764f30e3b6fba776/Lib/shlex.py#L325 +(define unsafe-pattern #rx"[^a-zA-Z0-9_@%+=:,./-]") +(define (quote-arg s) + (if (non-empty-string? s) + (if (regexp-match unsafe-pattern s) + (string-append "'" (string-replace s "'" "'\"'\"'") "'") + s) + "''")) + +(define-unison-builtin + (builtin-IO.process.call command arguments) + (system/exit-code + (string-join (cons + (chunked-string->string command) + (map (lambda (arg) (quote-arg (chunked-string->string arg))) + (vector->list + (chunked-list->vector arguments)))) + " "))) + +(define-unison-builtin (builtin-Handle.toText h) + (string->chunked-string (describe-value h))) + +(define-unison-builtin (builtin-IO.getBytes.impl.v3 h n) + (with-handlers + ; TODO: seems like we should catch more + [[exn:fail:contract? + (lambda (e) + (ref-either-left + (ref-failure-failure + ref-iofailure:typelink + (exception->string e) + ref-unit-unit)))]] + (ref-either-right + (bytes->chunked-bytes + (read-bytes n h))))) + +(define-unison-builtin (builtin-IO.putBytes.impl.v3 h bs) + ; TODO: error checking? + (write-bytes (chunked-bytes->bytes bs) h) + (flush-output h) + (ref-either-right ref-unit-unit)) + +(define-unison-builtin (builtin-IO.closeFile.impl.v3 h) + ; TODO: review this implementation; moved from primops.ss + (if (input-port? h) + (close-input-port h) + (close-output-port h)) + (ref-either-right ref-unit-unit)) + diff --git a/scheme-libs/racket/unison/primops/io.rkt b/scheme-libs/racket/unison/primops/io.rkt new file mode 100644 index 0000000000..cb9265e618 --- /dev/null +++ b/scheme-libs/racket/unison/primops/io.rkt @@ -0,0 +1,320 @@ +#lang racket/base +(require unison/boot + unison/chunked-seq + unison/data + unison/data-info + racket/exn + racket/file + racket/fixnum + racket/flonum + (only-in racket + date-dst? + date-time-zone-offset + date*-time-zone-name + false? + vector-map) + racket/random + (only-in + rnrs/arithmetic/flonums-6 + flmod)) +(require racket/file) + +(provide + builtin-Clock.internals.systemTimeZone.v1 + builtin-Clock.internals.systemTimeZone.v1:termlink + builtin-Clock.internals.monotonic.v1 + builtin-Clock.internals.monotonic.v1:termlink + builtin-Clock.internals.nsec.v1 + builtin-Clock.internals.nsec.v1:termlink + builtin-Clock.internals.processCPUTime.v1 + builtin-Clock.internals.processCPUTime.v1:termlink + builtin-Clock.internals.realtime.v1 + builtin-Clock.internals.realtime.v1:termlink + builtin-Clock.internals.sec.v1 + builtin-Clock.internals.sec.v1:termlink + builtin-Clock.internals.threadCPUTime.v1 + builtin-Clock.internals.threadCPUTime.v1:termlink + + builtin-IO.getFileTimestamp.impl.v3 + builtin-IO.getFileTimestamp.impl.v3:termlink + builtin-IO.getFileSize.impl.v3 + builtin-IO.getFileSize.impl.v3:termlink + builtin-IO.getTempDirectory.impl.v3 + builtin-IO.getTempDirectory.impl.v3:termlink + builtin-IO.randomBytes + builtin-IO.randomBytes:termlink + builtin-IO.removeFile.impl.v3 + builtin-IO.removeFile.impl.v3:termlink + builtin-IO.systemTimeMicroseconds.v1 + builtin-IO.systemTimeMicroseconds.v1:termlink + builtin-IO.tryEval + builtin-IO.tryEval:termlink + + builtin-IO.isFileEOF.impl.v3 + builtin-IO.isFileEOF.impl.v3:termlink + builtin-IO.fileExists.impl.v3 + builtin-IO.fileExists.impl.v3:termlink + builtin-IO.renameFile.impl.v3 + builtin-IO.renameFile.impl.v3:termlink + builtin-IO.createDirectory.impl.v3 + builtin-IO.createDirectory.impl.v3:termlink + builtin-IO.removeDirectory.impl.v3 + builtin-IO.removeDirectory.impl.v3:termlink + builtin-IO.directoryContents.impl.v3 + builtin-IO.directoryContents.impl.v3:termlink + builtin-IO.setCurrentDirectory.impl.v3 + builtin-IO.setCurrentDirectory.impl.v3:termlink + builtin-IO.renameDirectory.impl.v3 + builtin-IO.renameDirectory.impl.v3:termlink + builtin-IO.isDirectory.impl.v3 + builtin-IO.isDirectory.impl.v3:termlink + builtin-IO.systemTime.impl.v3 + builtin-IO.systemTime.impl.v3:termlink + builtin-IO.systemTimeMicroseconds.impl.v3 + builtin-IO.systemTimeMicroseconds.impl.v3:termlink + builtin-IO.createTempDirectory.impl.v3 + builtin-IO.createTempDirectory.impl.v3:termlink + + builtin-IO.getArgs.impl.v1 + builtin-IO.getArgs.impl.v1:termlink + builtin-IO.getEnv.impl.v1 + builtin-IO.getEnv.impl.v1:termlink + builtin-IO.getCurrentDirectory.impl.v3 + builtin-IO.getCurrentDirectory.impl.v3:termlink + + ) + +(define (failure-result ty msg vl) + (ref-either-left + (ref-failure-failure + ty + (string->chunked-string msg) + (unison-any-any vl)))) + +(define (exn-failure e) + (failure-result + ref-iofailure:typelink + (exn->string e) + ref-unit-unit)) + +(define-unison-builtin (builtin-IO.getFileSize.impl.v3 path) + (with-handlers + [[exn:fail:filesystem? exn-failure]] + (ref-either-right (file-size (chunked-string->string path))))) + +(define-unison-builtin (builtin-IO.getFileTimestamp.impl.v3 path) + (with-handlers + [[exn:fail:filesystem? exn-failure]] + (ref-either-right + (file-or-directory-modify-seconds + (chunked-string->string path))))) + +; in haskell, it's not just file but also directory +(define-unison-builtin + (builtin-IO.fileExists.impl.v3 path) + (let ([path-string (chunked-string->string path)]) + (ref-either-right + (or + (file-exists? path-string) + (directory-exists? path-string))))) + +(define-unison-builtin (builtin-IO.removeFile.impl.v3 path) + (delete-file (chunked-string->string path)) + (ref-either-right ref-unit-unit)) + +(define-unison-builtin (builtin-IO.getTempDirectory.impl.v3 _) + (ref-either-right + (string->chunked-string + (path->string (find-system-path 'temp-dir))))) + +(define-unison-builtin + (builtin-IO.setCurrentDirectory.impl.v3 path) + (current-directory (chunked-string->string path)) + (ref-either-right none)) + +(define-unison-builtin + (builtin-IO.directoryContents.impl.v3 path) + (with-handlers + [[exn:fail:filesystem? + (lambda (e) + (failure-result + ref-iofailure:typelink + (exception->string e) + ref-unit-unit))]] + (let* ([dirps (directory-list (chunked-string->string path))] + [dirss (map path->string dirps)]) + (ref-either-right + (vector->chunked-list + (list->vector + (map + string->chunked-string + (list* "." ".." dirss)))))))) + + +(define-unison-builtin + (builtin-IO.createTempDirectory.impl.v3 prefix) + (ref-either-right + (string->chunked-string + (path->string + (make-temporary-directory* + (string->bytes/utf-8 + (chunked-string->string prefix)) #""))))) + +(define-unison-builtin + (builtin-IO.createDirectory.impl.v3 file) + (make-directory (chunked-string->string file)) + (ref-either-right none)) + +(define-unison-builtin + (builtin-IO.removeDirectory.impl.v3 file) + (delete-directory/files (chunked-string->string file)) + (ref-either-right none)) + +(define-unison-builtin + (builtin-IO.isDirectory.impl.v3 path) + (ref-either-right + (directory-exists? (chunked-string->string path)))) + +(define-unison-builtin + (builtin-IO.renameDirectory.impl.v3 old new) + (rename-file-or-directory (chunked-string->string old) + (chunked-string->string new)) + (ref-either-right none)) + +(define-unison-builtin + (builtin-IO.renameFile.impl.v3 old new) + (rename-file-or-directory (chunked-string->string old) + (chunked-string->string new)) + (ref-either-right none)) + +(define-unison-builtin + (builtin-IO.systemTime.impl.v3 unit) + (ref-either-right (current-seconds))) + +(define-unison-builtin + (builtin-IO.systemTimeMicroseconds.impl.v3 unit) + (ref-either-right (inexact->exact (* 1000 (current-inexact-milliseconds))))) + +(define-unison-builtin + (builtin-Clock.internals.systemTimeZone.v1 secs) + (let* ([d (seconds->date secs)]) + (list->unison-tuple + (list + (date-time-zone-offset d) + (if (date-dst? d) 1 0) + (date*-time-zone-name d))))) + +(define-unison-builtin (builtin-Clock.internals.threadCPUTime.v1 _) + (ref-either-right + (integer->time + (current-process-milliseconds (current-thread))))) + +(define-unison-builtin (builtin-Clock.internals.processCPUTime.v1 _) + (ref-either-right + (integer->time + (current-process-milliseconds #f)))) + +(define-unison-builtin (builtin-Clock.internals.realtime.v1 _) + (ref-either-right + (float->time + (current-inexact-milliseconds)))) + +(define-unison-builtin (builtin-Clock.internals.monotonic.v1 _) + (ref-either-right + (float->time + (current-inexact-monotonic-milliseconds)))) + +(define (integer->time msecs) + (unison-timespec + (truncate (/ msecs 1000)) + (* (modulo msecs 1000) 1000000))) + +(define (float->time msecs) + (unison-timespec + (trunc (/ msecs 1000)) + (trunc (* (flmod msecs 1000.0) 1000000)))) + +; +(define (trunc f) (inexact->exact (truncate f))) + +(define-unison-builtin (builtin-Clock.internals.sec.v1 ts) + (unison-timespec-sec ts)) + +(define-unison-builtin (builtin-Clock.internals.nsec.v1 ts) + (unison-timespec-nsec ts)) + +(define-unison-builtin (builtin-IO.systemTimeMicroseconds.v1 _) + (current-microseconds)) + +(define-unison-builtin (builtin-IO.tryEval thunk) + (with-handlers + ([exn:break? + (lambda (e) + (raise-unison-exception + ref-threadkilledfailure:typelink + (string->chunked-string "thread killed") + ref-unit-unit))] + [exn:io? + (lambda (e) + (raise-unison-exception + ref-iofailure:typelink + (exception->string e) + ref-unit-unit))] + [exn:arith? + (lambda (e) + (raise-unison-exception + ref-arithfailure:typelink + (exception->string e) + ref-unit-unit))] + [exn:bug? (lambda (e) (exn:bug->exception e))] + [exn:fail? + (lambda (e) + (raise-unison-exception + ref-runtimefailure:typelink + (exception->string e) + ref-unit-unit))] + [(lambda (x) #t) + (lambda (e) + (raise-unison-exception + ref-miscfailure:typelink + (exception->string e) + ref-unit-unit))]) + (thunk ref-unit-unit))) + +(define-unison-builtin (builtin-IO.randomBytes n) + (bytes->chunked-bytes (crypto-random-bytes n))) + +(define-unison-builtin (builtin-IO.isFileEOF.impl.v3 p) + (ref-either-right (eof-object? (peek-byte p)))) + +(define-unison-builtin (builtin-IO.getArgs.impl.v1 unit) + (ref-either-right + (vector->chunked-list + (vector-map string->chunked-string + (current-command-line-arguments))))) + +(define-unison-builtin (builtin-IO.getEnv.impl.v1 key) + (define value + (environment-variables-ref + (current-environment-variables) + (string->bytes/utf-8 (chunked-string->string key)))) + + (if (false? value) + (ref-either-left + (ref-failure-failure + ref-iofailure:typelink + "environmental variable not found" + (unison-any-any key))) + + (ref-either-right + (string->chunked-string (bytes->string/utf-8 value))))) + +(define-unison-builtin (builtin-IO.getCurrentDirectory.impl.v3 unit) + (ref-either-right + (string->chunked-string (path->string (current-directory))))) + + + +(define (current-microseconds) + (fl->fx (* 1000 (current-inexact-milliseconds)))) + diff --git a/scheme-libs/racket/unison/primops/list.rkt b/scheme-libs/racket/unison/primops/list.rkt new file mode 100644 index 0000000000..cb7b52dab8 --- /dev/null +++ b/scheme-libs/racket/unison/primops/list.rkt @@ -0,0 +1,83 @@ + +#lang racket/base + +(require unison/boot + unison/chunked-seq + unison/data + unison/data-info) + +(provide + builtin-List.++ + builtin-List.++:termlink + builtin-List.at + builtin-List.at:termlink + builtin-List.cons + builtin-List.cons:termlink + builtin-List.drop + builtin-List.drop:termlink + builtin-List.size + builtin-List.size:termlink + builtin-List.snoc + builtin-List.snoc:termlink + builtin-List.splitLeft + builtin-List.splitLeft:termlink + builtin-List.splitRight + builtin-List.splitRight:termlink + builtin-List.take + builtin-List.take:termlink + builtin-List.viewl + builtin-List.viewl:termlink + builtin-List.viewr + builtin-List.viewr:termlink) + + +(define-unison-builtin (builtin-List.++ xs ys) + (chunked-list-append xs ys)) + +(define-unison-builtin (builtin-List.at n xs) + (with-handlers + ([exn:fail:contract? (lambda (e) ref-optional-none)]) + (ref-optional-some (chunked-list-ref xs n)))) + +(define-unison-builtin (builtin-List.cons x xs) + (chunked-list-add-first xs x)) + +(define-unison-builtin (builtin-List.drop n xs) + (chunked-list-drop xs n)) + +(define-unison-builtin (builtin-List.size xs) + (chunked-list-length xs)) + +(define-unison-builtin (builtin-List.snoc xs x) + (chunked-list-add-last xs x)) + +(define-unison-builtin (builtin-List.take n xs) + (chunked-list-take xs n)) + +(define-unison-builtin (builtin-List.viewl xs) + (if (chunked-list-empty? xs) + ref-seqview-empty + (let-values ([(t h) (chunked-list-pop-first xs)]) + (ref-seqview-elem h t)))) + +(define-unison-builtin (builtin-List.viewr xs) + (if (chunked-list-empty? xs) + ref-seqview-empty + (let-values ([(t h) (chunked-list-pop-last xs)]) + (ref-seqview-elem t h)))) + +(define-unison-builtin (builtin-List.splitLeft n s) + (if (< (chunked-list-length s) n) + ref-seqview-empty + (let-values ([(l r) (chunked-list-split-at s n)]) + (ref-seqview-elem l r)))) + +; Copied TODO: write test that stresses this +(define-unison-builtin (builtin-List.splitRight n s) + (define len (chunked-list-length s)) + + (if (< len n) + ref-seqview-empty + (let-values ([(l r) (chunked-list-split-at s (- len n))]) + (ref-seqview-elem l r)))) + diff --git a/scheme-libs/racket/unison/primops/math.rkt b/scheme-libs/racket/unison/primops/math.rkt new file mode 100644 index 0000000000..94aa47f7d8 --- /dev/null +++ b/scheme-libs/racket/unison/primops/math.rkt @@ -0,0 +1,493 @@ +#lang racket/base + +(require unison/boot + unison/chunked-seq + unison/data + unison/data-info + + (except-in math/base sum) + + racket/fixnum + racket/flonum + + (only-in racket/string + string-contains? + string-replace) + + (only-in rnrs/arithmetic/bitwise-6 + bitwise-bit-count + bitwise-first-bit-set)) + +(provide + builtin-Float.+ + builtin-Float.+:termlink + builtin-Float.* + builtin-Float.*:termlink + builtin-Float.- + builtin-Float.-:termlink + builtin-Float./ + builtin-Float./:termlink + builtin-Float.>= + builtin-Float.>=:termlink + builtin-Float.<= + builtin-Float.<=:termlink + builtin-Float.> + builtin-Float.>:termlink + builtin-Float.< + builtin-Float.<:termlink + builtin-Float.== + builtin-Float.==:termlink + builtin-Float.abs + builtin-Float.abs:termlink + builtin-Float.acos + builtin-Float.acos:termlink + builtin-Float.acosh + builtin-Float.acosh:termlink + builtin-Float.asin + builtin-Float.asin:termlink + builtin-Float.asinh + builtin-Float.asinh:termlink + builtin-Float.atan + builtin-Float.atan:termlink + builtin-Float.atan2 + builtin-Float.atan2:termlink + builtin-Float.atanh + builtin-Float.atanh:termlink + builtin-Float.cos + builtin-Float.cos:termlink + builtin-Float.cosh + builtin-Float.cosh:termlink + builtin-Float.fromText + builtin-Float.fromText:termlink + builtin-Float.sin + builtin-Float.sin:termlink + builtin-Float.sinh + builtin-Float.sinh:termlink + builtin-Float.toText + builtin-Float.toText:termlink + builtin-Float.truncate + builtin-Float.truncate:termlink + builtin-Float.exp + builtin-Float.exp:termlink + builtin-Float.fromRepresentation + builtin-Float.fromRepresentation:termlink + builtin-Float.log + builtin-Float.log:termlink + builtin-Float.max + builtin-Float.max:termlink + builtin-Float.min + builtin-Float.min:termlink + builtin-Float.pow + builtin-Float.pow:termlink + builtin-Float.sqrt + builtin-Float.sqrt:termlink + builtin-Float.tan + builtin-Float.tan:termlink + builtin-Float.tanh + builtin-Float.tanh:termlink + builtin-Float.toRepresentation + builtin-Float.toRepresentation:termlink + builtin-Float.logBase + builtin-Float.logBase:termlink + builtin-Float.fromRepresentation + builtin-Float.fromRepresentation:termlink + builtin-Float.toRepresentation + builtin-Float.toRepresentation:termlink + builtin-Float.ceiling + builtin-Float.ceiling:termlink + + + builtin-Int.+ + builtin-Int.+:termlink + builtin-Int.* + builtin-Int.*:termlink + builtin-Int.- + builtin-Int.-:termlink + builtin-Int./ + builtin-Int./:termlink + builtin-Int.== + builtin-Int.==:termlink + builtin-Int.< + builtin-Int.<:termlink + builtin-Int.<= + builtin-Int.<=:termlink + builtin-Int.> + builtin-Int.>:termlink + builtin-Int.>= + builtin-Int.>=:termlink + builtin-Int.and + builtin-Int.and:termlink + builtin-Int.complement + builtin-Int.complement:termlink + builtin-Int.fromRepresentation + builtin-Int.fromRepresentation:termlink + builtin-Int.fromText + builtin-Int.fromText:termlink + builtin-Int.increment + builtin-Int.increment:termlink + builtin-Int.isEven + builtin-Int.isEven:termlink + builtin-Int.isOdd + builtin-Int.isOdd:termlink + builtin-Int.leadingZeros + builtin-Int.leadingZeros:termlink + builtin-Int.mod + builtin-Int.mod:termlink + builtin-Int.negate + builtin-Int.negate:termlink + builtin-Int.or + builtin-Int.or:termlink + builtin-Int.popCount + builtin-Int.popCount:termlink + builtin-Int.shiftLeft + builtin-Int.shiftLeft:termlink + builtin-Int.shiftRight + builtin-Int.shiftRight:termlink + builtin-Int.signum + builtin-Int.signum:termlink + builtin-Int.toFloat + builtin-Int.toFloat:termlink + builtin-Int.toRepresentation + builtin-Int.toRepresentation:termlink + builtin-Int.toText + builtin-Int.toText:termlink + builtin-Int.truncate0 + builtin-Int.truncate0:termlink + builtin-Int.xor + builtin-Int.xor:termlink + builtin-Int.pow + builtin-Int.pow:termlink + builtin-Int.trailingZeros + builtin-Int.trailingZeros:termlink + + + builtin-Nat.+ + builtin-Nat.+:termlink + builtin-Nat.* + builtin-Nat.*:termlink + builtin-Nat./ + builtin-Nat./:termlink + builtin-Nat.== + builtin-Nat.==:termlink + builtin-Nat.< + builtin-Nat.<:termlink + builtin-Nat.<= + builtin-Nat.<=:termlink + builtin-Nat.> + builtin-Nat.>:termlink + builtin-Nat.>= + builtin-Nat.>=:termlink + builtin-Nat.and + builtin-Nat.and:termlink + builtin-Nat.complement + builtin-Nat.complement:termlink + builtin-Nat.drop + builtin-Nat.drop:termlink + builtin-Nat.increment + builtin-Nat.increment:termlink + builtin-Nat.isEven + builtin-Nat.isEven:termlink + builtin-Nat.isOdd + builtin-Nat.isOdd:termlink + builtin-Nat.fromText + builtin-Nat.fromText:termlink + builtin-Nat.leadingZeros + builtin-Nat.leadingZeros:termlink + builtin-Nat.mod + builtin-Nat.mod:termlink + builtin-Nat.or + builtin-Nat.or:termlink + builtin-Nat.popCount + builtin-Nat.popCount:termlink + builtin-Nat.pow + builtin-Nat.pow:termlink + builtin-Nat.shiftLeft + builtin-Nat.shiftLeft:termlink + builtin-Nat.shiftRight + builtin-Nat.shiftRight:termlink + builtin-Nat.sub + builtin-Nat.sub:termlink + builtin-Nat.toFloat + builtin-Nat.toFloat:termlink + builtin-Nat.toInt + builtin-Nat.toInt:termlink + builtin-Nat.toText + builtin-Nat.toText:termlink + builtin-Nat.trailingZeros + builtin-Nat.trailingZeros:termlink + builtin-Nat.xor + builtin-Nat.xor:termlink) + + +(define-unison-builtin (builtin-Float.* x y) (fl* x y)) + +(define-unison-builtin (builtin-Float.+ x y) (fl+ x y)) + +(define-unison-builtin (builtin-Float.- x y) (fl- x y)) + +(define-unison-builtin (builtin-Float./ x y) (fl/ x y)) + +(define-unison-builtin (builtin-Float.> x y) (fl> x y)) + +(define-unison-builtin (builtin-Float.< x y) (fl< x y)) + +(define-unison-builtin (builtin-Float.>= x y) (fl>= x y)) + +(define-unison-builtin (builtin-Float.<= x y) (fl<= x y)) + +(define-unison-builtin (builtin-Float.== x y) (fl= x y)) + +(define-unison-builtin (builtin-Float.abs x) (flabs x)) + +(define-unison-builtin (builtin-Float.acos x) (flacos x)) + +(define-unison-builtin (builtin-Float.acosh x) (acosh x)) + +(define-unison-builtin (builtin-Float.asin x) (flasin x)) + +(define-unison-builtin (builtin-Float.asinh x) (asinh x)) + +(define-unison-builtin (builtin-Float.atan x) (flatan x)) + +(define-unison-builtin (builtin-Float.atan2 y x) (atan y x)) + +(define-unison-builtin (builtin-Float.atanh x) (atanh x)) + +(define-unison-builtin (builtin-Float.cos x) (flcos x)) + +(define-unison-builtin (builtin-Float.cosh x) (cosh x)) + +(define-unison-builtin (builtin-Float.fromText t) + (define mn (string->number (chunked-string->string t))) + + (if mn + (ref-optional-some mn) + ref-optional-none)) + +(define-unison-builtin (builtin-Float.sin x) (flsin x)) + +(define-unison-builtin (builtin-Float.sinh x) (sinh x)) + +(define-unison-builtin (builtin-Float.toText x) + (define base (number->string x)) + (define dotted + (if (string-contains? base ".") + base + (string-replace base "e" ".0e"))) + + (string->chunked-string + (string-replace dotted "+" ""))) + +(define-unison-builtin (builtin-Float.truncate x) + (cond + [(or (= x +inf.0) + (= x -inf.0) + (eqv? x +nan.0) + (eqv? x +nan.f)) + 0] + [else (clamp-integer (inexact->exact (truncate x)))])) + +(define-unison-builtin (builtin-Float.logBase base num) + (log num base)) + +(define-unison-builtin (builtin-Float.exp n) (exp n)) + +(define-unison-builtin (builtin-Float.log n) (log n)) + +(define-unison-builtin (builtin-Float.max n m) (max n m)) + +(define-unison-builtin (builtin-Float.min n m) (min n m)) + +(define-unison-builtin (builtin-Float.tan n) (tan n)) + +(define-unison-builtin (builtin-Float.tanh n) (tanh n)) + +(define-unison-builtin (builtin-Float.pow n m) (expt n m)) + +(define-unison-builtin (builtin-Float.sqrt x) (sqrt x)) + +(define-unison-builtin (builtin-Float.ceiling x) + (clamp-integer (fl->exact-integer (ceiling x)))) + +; If someone can suggest a better mechanism for these, +; that would be appreciated. +(define-unison-builtin (builtin-Float.toRepresentation fl) + (integer-bytes->integer + (real->floating-point-bytes fl 8 #t) ; big endian + #f ; unsigned + #t)) ; big endian + +(define-unison-builtin (builtin-Float.fromRepresentation n) + (floating-point-bytes->real + (integer->integer-bytes n 8 #f #t) ; unsigned, big endian + #t)) ; big endian + + + +(define-unison-builtin (builtin-Int.toRepresentation i) + (integer-bytes->integer + (integer->integer-bytes i 8 #t #t) ; signed, big endian + #f #t)) ; unsigned, big endian + +(define-unison-builtin (builtin-Int.fromRepresentation n) + (integer-bytes->integer + (integer->integer-bytes n 8 #f #t) ; unsigned, big endian + #t #t)) ; signed, big endian + +(define-unison-builtin (builtin-Int.and i j) (bitwise-and i j)) + +(define-unison-builtin (builtin-Int.complement i) + (clamp-integer (bitwise-not i))) + +(define-unison-builtin (builtin-Int.fromText t) + (define mn (string->number (chunked-string->string t))) + + (if (and (exact-integer? mn) (>= mn nbit63) (< mn bit63)) + (ref-optional-some mn) + ref-optional-none)) + +; more complicated due to negatives +(define-unison-builtin (builtin-Int.leadingZeros i) + (define len (integer-length i)) + (if (< len 0) + 0 + (- 64 len))) + +(define-unison-builtin (builtin-Int.mod i j) + (clamp-integer (modulo i j))) + +(define-unison-builtin (builtin-Int.or i j) (bitwise-ior i j)) + +(define-unison-builtin (builtin-Int.shiftLeft i k) + (clamp-integer (arithmetic-shift i k))) + +(define-unison-builtin (builtin-Int.shiftRight i k) + (arithmetic-shift i (- k))) + +(define-unison-builtin (builtin-Int.toFloat i) (exact->inexact i)) + +(define-unison-builtin (builtin-Int.toText i) + (string->chunked-string (number->string i))) + +(define-unison-builtin (builtin-Int.truncate0 i) (if (< i 0) 0 i)) + +(define-unison-builtin (builtin-Int.xor i j) (bitwise-xor i j)) + +(define-unison-builtin (builtin-Int.* n m) (clamp-integer (* n m))) + +(define-unison-builtin (builtin-Int.pow n m) (clamp-integer (expt n m))) + +(define-unison-builtin (builtin-Int.trailingZeros i) + (define bit (bitwise-first-bit-set i)) + + (if (= -1 bit) 64 bit)) + +; todo: review +(define-unison-builtin (builtin-Int.popCount i) + (modulo (bitwise-bit-count i) 65)) + +(define-unison-builtin (builtin-Int.increment i) + (clamp-integer (add1 i))) + +(define-unison-builtin (builtin-Int.negate i) + (if (> i nbit63) (- i) i)) + +(define-unison-builtin (builtin-Int.+ i j) (clamp-integer (+ i j))) + +(define-unison-builtin (builtin-Int.- i j) (clamp-integer (- i j))) + +(define-unison-builtin (builtin-Int./ i j) (floor (/ i j))) + +(define-unison-builtin (builtin-Int.signum i) (sgn i)) + +(define-unison-builtin (builtin-Int.> x y) (> x y)) + +(define-unison-builtin (builtin-Int.< x y) (< x y)) + +(define-unison-builtin (builtin-Int.>= x y) (>= x y)) + +(define-unison-builtin (builtin-Int.<= x y) (<= x y)) + +(define-unison-builtin (builtin-Int.== x y) (= x y)) + +(define-unison-builtin (builtin-Int.isEven x) (even? x)) + +(define-unison-builtin (builtin-Int.isOdd x) (odd? x)) + + + +(define-unison-builtin (builtin-Nat.> x y) (> x y)) + +(define-unison-builtin (builtin-Nat.< x y) (< x y)) + +(define-unison-builtin (builtin-Nat.>= x y) (>= x y)) + +(define-unison-builtin (builtin-Nat.<= x y) (<= x y)) + +(define-unison-builtin (builtin-Nat.== x y) (= x y)) + +(define-unison-builtin (builtin-Nat.isEven x) (even? x)) + +(define-unison-builtin (builtin-Nat.isOdd x) (odd? x)) + +(define-unison-builtin (builtin-Nat.+ m n) (clamp-natural (+ m n))) + +(define-unison-builtin (builtin-Nat.drop m n) (natural-max0 (- m n))) + +(define-unison-builtin (builtin-Nat.increment n) + (clamp-natural (add1 n))) + +(define-unison-builtin (builtin-Nat.* m n) (clamp-natural (* m n))) + +(define-unison-builtin (builtin-Nat./ m n) (quotient m n)) + +(define-unison-builtin (builtin-Nat.and m n) (bitwise-and m n)) + +(define-unison-builtin (builtin-Nat.toFloat n) (->fl n)) + +(define-unison-builtin (builtin-Nat.complement m) + (wrap-natural (bitwise-not m))) + +(define-unison-builtin (builtin-Nat.fromText t) + (define mn (string->number (chunked-string->string t))) + + (if (and (exact-nonnegative-integer? mn) (< mn bit64)) + (ref-optional-some mn) + ref-optional-none)) + +(define-unison-builtin (builtin-Nat.leadingZeros m) + (- 64 (integer-length m))) + +(define-unison-builtin (builtin-Nat.mod m n) (modulo m n)) + +(define-unison-builtin (builtin-Nat.or m n) (bitwise-ior m n)) + +(define-unison-builtin (builtin-Nat.pow m n) + (clamp-natural (expt m n))) + +(define-unison-builtin (builtin-Nat.shiftLeft m k) + (clamp-natural (arithmetic-shift m k))) + +(define-unison-builtin (builtin-Nat.shiftRight m k) + (arithmetic-shift m (- k))) + +(define-unison-builtin (builtin-Nat.sub m n) + (clamp-integer (- m n))) + +(define-unison-builtin (builtin-Nat.toInt m) + ; might need to wrap + (clamp-integer m)) + +(define-unison-builtin (builtin-Nat.toText m) + (string->chunked-string (number->string m))) + +(define-unison-builtin (builtin-Nat.xor m n) (bitwise-xor m n)) + +(define-unison-builtin (builtin-Nat.trailingZeros n) + (define bit (bitwise-first-bit-set n)) + + (if (= -1 bit) 64 bit)) + +(define-unison-builtin (builtin-Nat.popCount n) + (bitwise-bit-count n)) + diff --git a/scheme-libs/racket/unison/primops/misc.rkt b/scheme-libs/racket/unison/primops/misc.rkt new file mode 100644 index 0000000000..17a49bd083 --- /dev/null +++ b/scheme-libs/racket/unison/primops/misc.rkt @@ -0,0 +1,128 @@ + +#lang racket/base + +(require unison/boot + unison/chunked-seq + unison/data + unison/data-info + unison/murmurhash) + +(require racket/match) + +(provide + builtin-Boolean.not + builtin-Boolean.not:termlink + + builtin-Any.Any + builtin-Any.Any:termlink + builtin-Any.unsafeExtract + builtin-Any.unsafeExtract:termlink + + builtin-Debug.toText + builtin-Debug.toText:termlink + builtin-Debug.trace + builtin-Debug.trace:termlink + builtin-Debug.watch + builtin-Debug.watch:termlink + + builtin-Scope.run + builtin-Scope.run:termlink + + builtin-bug + builtin-bug:termlink + + builtin-Universal.murmurHash:termlink + + builtin-unsafe.coerceAbilities + builtin-unsafe.coerceAbilities:termlink + + builtin-jumpCont + builtin-jumpCont:termlink + builtin-todo + builtin-todo:termlink + + builtin-Link.Term.toText + builtin-Link.Term.toText:termlink + + builtin-Value.toBuiltin + builtin-Value.toBuiltin:termlink + builtin-Value.fromBuiltin + builtin-Value.fromBuiltin:termlink + builtin-Code.fromGroup + builtin-Code.fromGroup:termlink + builtin-Code.toGroup + builtin-Code.toGroup:termlink + builtin-TermLink.fromReferent + builtin-TermLink.fromReferent:termlink + builtin-TermLink.toReferent + builtin-TermLink.toReferent:termlink + builtin-TypeLink.toReference + builtin-TypeLink.toReference:termlink + + + ; fake builtins + builtin-murmurHashBytes) + + + +(define-unison-builtin (builtin-Boolean.not b) (not b)) + +(define-unison-builtin (builtin-Any.Any x) (unison-any-any x)) + +(define-unison-builtin (builtin-Any.unsafeExtract x) + (match x + [(unison-data r t (list x)) x])) + +(define-unison-builtin (builtin-Debug.toText v) + (ref-optional-some + (ref-either-left + (string->chunked-string + (describe-value v))))) + +(define-unison-builtin (builtin-Debug.trace msg v) + (display "trace: ") + (displayln (chunked-string->string msg)) + (displayln (describe-value v)) + ref-unit-unit) + +(define-unison-builtin (builtin-Debug.watch msg v) + (displayln (chunked-string->string msg)) + v) + +(define-unison-builtin (builtin-bug x) + (raise (make-exn:bug "builtin.bug" x))) + +(define-unison-builtin (builtin-jumpCont k v) (k v)) + +(define-unison-builtin (builtin-todo x) + (raise (make-exn:bug "builtin.todo" x))) + +(define-unison-builtin (builtin-Scope.run k) + (k ref-unit-unit)) + +(define-builtin-link Universal.murmurHash) + +(define-unison-builtin (builtin-murmurHashBytes bs) + (murmurhash-bytes (chunked-bytes->bytes bs))) + +(define-unison-builtin (builtin-unsafe.coerceAbilities f) f) + +(define-unison-builtin (builtin-Link.Term.toText ln) + (string->chunked-string (termlink->string ln))) + +(define-unison-builtin (builtin-Value.toBuiltin v) (unison-quote v)) +(define-unison-builtin (builtin-Value.fromBuiltin v) + (unison-quote-val v)) +(define-unison-builtin (builtin-Code.fromGroup sg) (unison-code sg)) +(define-unison-builtin (builtin-Code.toGroup co) + (unison-code-rep co)) +(define-unison-builtin (builtin-TermLink.fromReferent rf) + (referent->termlink rf)) +(define-unison-builtin (builtin-TermLink.toReferent tl) + (termlink->referent tl)) +(define-unison-builtin (builtin-TypeLink.toReference tl) + (typelink->reference tl)) + +(define-unison-builtin (builtin-Link.Type.toText ln) + (string->chunked-string (typelink->string ln))) + diff --git a/scheme-libs/racket/unison/primops/pattern.rkt b/scheme-libs/racket/unison/primops/pattern.rkt new file mode 100644 index 0000000000..c06b614977 --- /dev/null +++ b/scheme-libs/racket/unison/primops/pattern.rkt @@ -0,0 +1,213 @@ +#lang racket/base + +(require (except-in unison/boot control) + unison/data + unison/data-info + unison/pattern) + +(provide + builtin-Char.Class.alphanumeric + builtin-Char.Class.alphanumeric:termlink + builtin-Char.Class.and + builtin-Char.Class.and:termlink + builtin-Char.Class.any + builtin-Char.Class.any:termlink + builtin-Char.Class.anyOf + builtin-Char.Class.anyOf:termlink + builtin-Char.Class.control + builtin-Char.Class.control:termlink + builtin-Char.Class.letter + builtin-Char.Class.letter:termlink + builtin-Char.Class.lower + builtin-Char.Class.lower:termlink + builtin-Char.Class.mark + builtin-Char.Class.mark:termlink + builtin-Char.Class.not + builtin-Char.Class.not:termlink + builtin-Char.Class.number + builtin-Char.Class.number:termlink + builtin-Char.Class.or + builtin-Char.Class.or:termlink + builtin-Char.Class.printable + builtin-Char.Class.printable:termlink + builtin-Char.Class.punctuation + builtin-Char.Class.punctuation:termlink + builtin-Char.Class.range + builtin-Char.Class.range:termlink + builtin-Char.Class.separator + builtin-Char.Class.separator:termlink + builtin-Char.Class.symbol + builtin-Char.Class.symbol:termlink + builtin-Char.Class.upper + builtin-Char.Class.upper:termlink + builtin-Char.Class.whitespace + builtin-Char.Class.whitespace:termlink + + builtin-Pattern.capture + builtin-Pattern.capture:termlink + builtin-Pattern.join + builtin-Pattern.join:termlink + builtin-Pattern.many + builtin-Pattern.many:termlink + builtin-Pattern.or + builtin-Pattern.or:termlink + builtin-Pattern.replicate + builtin-Pattern.replicate:termlink + builtin-Pattern.run + builtin-Pattern.run:termlink + + builtin-Char.Class.is + builtin-Char.Class.is:termlink + builtin-Pattern.captureAs + builtin-Pattern.captureAs:termlink + builtin-Pattern.many.corrected + builtin-Pattern.many.corrected:termlink + builtin-Pattern.isMatch + builtin-Pattern.isMatch:termlink + + builtin-Text.patterns.anyChar + builtin-Text.patterns.anyChar:termlink + builtin-Text.patterns.char + builtin-Text.patterns.char:termlink + builtin-Text.patterns.charIn + builtin-Text.patterns.charIn:termlink + builtin-Text.patterns.charRange + builtin-Text.patterns.charRange:termlink + builtin-Text.patterns.digit + builtin-Text.patterns.digit:termlink + builtin-Text.patterns.eof + builtin-Text.patterns.eof:termlink + builtin-Text.patterns.letter + builtin-Text.patterns.letter:termlink + builtin-Text.patterns.literal + builtin-Text.patterns.literal:termlink + builtin-Text.patterns.notCharIn + builtin-Text.patterns.notCharIn:termlink + builtin-Text.patterns.notCharRange + builtin-Text.patterns.notCharRange:termlink + builtin-Text.patterns.punctuation + builtin-Text.patterns.punctuation:termlink + builtin-Text.patterns.space + builtin-Text.patterns.space:termlink) + + +(define-unison-builtin #:hints [value] (builtin-Char.Class.alphanumeric) + alphanumeric) + +(define-unison-builtin (builtin-Char.Class.and l r) + (char-class-and l r)) + +(define-unison-builtin #:hints [value] (builtin-Char.Class.any) + any-char) + +(define-unison-builtin (builtin-Char.Class.anyOf cs) + (chars cs)) + +(define-unison-builtin #:hints [value] (builtin-Char.Class.control) + control) + +(define-unison-builtin #:hints [value] (builtin-Char.Class.letter) + letter) + +(define-unison-builtin #:hints [value] (builtin-Char.Class.lower) + lower) + +(define-unison-builtin #:hints [value] (builtin-Char.Class.mark) + mark) + +(define-unison-builtin (builtin-Char.Class.not c) + (char-class-not c)) + +(define-unison-builtin #:hints [value] (builtin-Char.Class.number) + number) + +(define-unison-builtin (builtin-Char.Class.or l r) + (char-class-or l r)) + +(define-unison-builtin #:hints [value] (builtin-Char.Class.printable) + printable) + +(define-unison-builtin #:hints [value] (builtin-Char.Class.punctuation) + punctuation) + +(define-unison-builtin (builtin-Char.Class.range l u) + (char-range l u)) + +(define-unison-builtin #:hints [value] (builtin-Char.Class.separator) + separator) + +(define-unison-builtin #:hints [value] (builtin-Char.Class.symbol) + symbol) + +(define-unison-builtin #:hints [value] (builtin-Char.Class.upper) + upper) + +(define-unison-builtin #:hints [value] (builtin-Char.Class.whitespace) + space) + + +(define-unison-builtin (builtin-Pattern.capture p) (capture p)) + +(define-unison-builtin (builtin-Pattern.join ps) (join* ps)) + +(define-unison-builtin (builtin-Pattern.many p) (many p)) + +(define-unison-builtin (builtin-Pattern.or l r) (choice l r)) + +(define-unison-builtin (builtin-Pattern.replicate m n p) + (replicate p m n)) + +(define-unison-builtin (builtin-Pattern.run p t) + (let ([r (pattern-match p t)]) + (if r + (ref-optional-some (unison-tuple (cdr r) (car r))) + ref-optional-none))) + + +(define-unison-builtin #:hints [value] (builtin-Text.patterns.anyChar) + any-char) + +(define-unison-builtin (builtin-Text.patterns.char cc) cc) + +(define-unison-builtin (builtin-Text.patterns.charIn cs) + (chars cs)) + +(define-unison-builtin (builtin-Text.patterns.charRange c d) + (char-range c d)) + +(define-unison-builtin #:hints [value] (builtin-Text.patterns.digit) + digit) + +(define-unison-builtin #:hints [value] (builtin-Text.patterns.eof) + eof) + +(define-unison-builtin #:hints [value] (builtin-Text.patterns.letter) + letter) + +(define-unison-builtin (builtin-Text.patterns.literal t) + (literal t)) + +(define-unison-builtin (builtin-Text.patterns.notCharIn cs) + (not-chars cs)) + +(define-unison-builtin (builtin-Text.patterns.notCharRange c d) + (not-char-range c d)) + +(define-unison-builtin #:hints [value] + (builtin-Text.patterns.punctuation) + punctuation) + +(define-unison-builtin #:hints [value] (builtin-Text.patterns.space) + space) + +(define-unison-builtin (builtin-Char.Class.is cc c) + (pattern-match? cc (string->chunked-string (string c)))) + +(define-unison-builtin (builtin-Pattern.captureAs c p) + (capture-as c p)) + +(define-unison-builtin (builtin-Pattern.many.corrected p) (many p)) + +(define-unison-builtin (builtin-Pattern.isMatch p s) + (pattern-match? p s)) + diff --git a/scheme-libs/racket/unison/primops/ref.rkt b/scheme-libs/racket/unison/primops/ref.rkt new file mode 100644 index 0000000000..8b64ec4f9e --- /dev/null +++ b/scheme-libs/racket/unison/primops/ref.rkt @@ -0,0 +1,44 @@ +#lang racket/base + +(require unison/boot + unison/concurrent + unison/data + unison/data-info) + +(provide + builtin-IO.ref + builtin-IO.ref:termlink + builtin-Ref.Ticket.read + builtin-Ref.Ticket.read:termlink + builtin-Ref.cas + builtin-Ref.cas:termlink + builtin-Ref.read + builtin-Ref.read:termlink + builtin-Ref.readForCas + builtin-Ref.readForCas:termlink + builtin-Ref.write + builtin-Ref.write:termlink + builtin-Scope.ref + builtin-Scope.ref:termlink) + + +(define-unison-builtin (builtin-IO.ref v) + (ref-new v)) + +(define-unison-builtin (builtin-Ref.Ticket.read r) r) + +(define-unison-builtin (builtin-Ref.cas ref ticket value) + (ref-cas ref ticket value)) + +(define-unison-builtin (builtin-Ref.read r) + (ref-read r)) + +(define-unison-builtin (builtin-Ref.readForCas r) + (ref-read r)) + +(define-unison-builtin (builtin-Ref.write r v) + (ref-write r v) + ref-unit-unit) + +(define-unison-builtin (builtin-Scope.ref v) + (ref-new v)) diff --git a/scheme-libs/racket/unison/primops/tcp.rkt b/scheme-libs/racket/unison/primops/tcp.rkt new file mode 100644 index 0000000000..4a3c8f3cf6 --- /dev/null +++ b/scheme-libs/racket/unison/primops/tcp.rkt @@ -0,0 +1,150 @@ +; TCP primitives! +#lang racket/base +(require racket/exn + racket/match + racket/tcp + unison/boot + unison/data + unison/data-info + unison/chunked-seq + unison/network-utils) + +(provide + builtin-IO.clientSocket.impl.v3 + builtin-IO.clientSocket.impl.v3:termlink + builtin-IO.closeSocket.impl.v3 + builtin-IO.closeSocket.impl.v3:termlink + builtin-IO.listen.impl.v3 + builtin-IO.listen.impl.v3:termlink + builtin-IO.serverSocket.impl.v3 + builtin-IO.serverSocket.impl.v3:termlink + builtin-IO.socketAccept.impl.v3 + builtin-IO.socketAccept.impl.v3:termlink + builtin-IO.socketPort.impl.v3 + builtin-IO.socketPort.impl.v3:termlink + builtin-IO.socketReceive.impl.v3 + builtin-IO.socketReceive.impl.v3:termlink + builtin-IO.socketSend.impl.v3 + builtin-IO.socketSend.impl.v3:termlink + builtin-Socket.toText + builtin-Socket.toText:termlink) + +(define-unison-builtin (builtin-IO.closeSocket.impl.v3 socket) + (handle-errors + (if (socket-pair? socket) + (begin + (close-input-port (socket-pair-input socket)) + (close-output-port (socket-pair-output socket))) + (tcp-close socket)) + (ref-either-right ref-unit-unit))) + +; string string -> either failure socket-pair +(define-unison-builtin (builtin-IO.clientSocket.impl.v3 host port) + (handle-errors + (let-values + ([(input output) (tcp-connect + (chunked-string->string host) + (string->number + (chunked-string->string port)))]) + (ref-either-right (socket-pair input output))))) + +; socket bytes -> either failure () +(define-unison-builtin (builtin-IO.socketSend.impl.v3 socket data) + (if (not (socket-pair? socket)) + (ref-either-left + (ref-failure-failure + ref-iofailure:typelink + (string->chunked-string "Cannot send on a server socket") + (unison-any-any ref-unit-unit))) + (begin + (write-bytes (chunked-bytes->bytes data) (socket-pair-output socket)) + (flush-output (socket-pair-output socket)) + (ref-either-right ref-unit-unit)))) + +; socket int -> either failure bytes +(define-unison-builtin (builtin-IO.socketReceive.impl.v3 socket amt) + (if (not (socket-pair? socket)) + (ref-either-left + (ref-failure-failure + ref-iofailure:typelink + (string->chunked-string "Cannot receive on a server socket") + (unison-any-any ref-unit-unit))) + + (handle-errors + (define buffer (make-bytes amt)) + (define read + (read-bytes-avail! buffer (socket-pair-input socket))) + + (ref-either-right + (bytes->chunked-bytes (subbytes buffer 0 read)))))) + +; socket -> either failure nat +(define-unison-builtin (builtin-IO.socketPort.impl.v3 socket) + (define-values (_ local-port __ ___) + (tcp-addresses + (if (socket-pair? socket) + (socket-pair-input socket) + socket) + #t)) + + (ref-either-right local-port)) + +(define (left-fail-exn e) + (ref-either-left + (ref-failure-failure + ref-iofailure:typelink + (exception->string e) + (unison-any-any ref-unit-unit)))) + +(define (left-fail-k e) + (ref-either-left + (ref-failure-failure + ref-miscfailure:typelink + (string->chunked-string "Unknown exception") + (unison-any-any ref-unit-unit)))) + +; optional string -> string -> either failure socket +(define-unison-builtin (builtin-IO.serverSocket.impl.v3 mhost cport) + (define hostname + (match mhost + [(unison-data r t (list host)) + #:when (= t ref-optional-some:tag) + (chunked-string->string host)] + [else #f])) + + (define port (chunked-string->string cport)) + + (with-handlers + [[exn:fail:network? left-fail-exn] + [exn:fail:contract? left-fail-exn] + [(lambda _ #t) left-fail-k]] + + (ref-either-right + (tcp-listen + (string->number port) + 2048 + #t + (if (equal? "0" hostname) #f hostname))))) + +; NOTE: This is a no-op because racket's public TCP stack doesn't have separate operations for +; "bind" vs "listen". We've decided to have `serverSocket` do the "bind & listen", and have +; this do nothing. +; If we want ~a little better parity with the haskell implementation, we might set a flag or +; something on the listener, and error if you try to `accept` on a server socket that you haven't +; called `listen` on yet. +(define-unison-builtin (builtin-IO.listen.impl.v3 _listener) + (ref-either-right ref-unit-unit)) + +(define-unison-builtin (builtin-IO.socketAccept.impl.v3 listener) + (if (socket-pair? listener) + (ref-either-left + (ref-failure-failure + ref-iofailure:typelink + (string->chunked-string "Cannot accept on a non-server socket") + (unison-any-any ref-unit-unit))) + + (let-values ([(input output) (tcp-accept listener)]) + (ref-either-right (socket-pair input output))))) + +(define-unison-builtin (builtin-Socket.toText s) + (string->chunked-string (describe-value s))) diff --git a/scheme-libs/racket/unison/primops/text.rkt b/scheme-libs/racket/unison/primops/text.rkt new file mode 100644 index 0000000000..7d4681ceeb --- /dev/null +++ b/scheme-libs/racket/unison/primops/text.rkt @@ -0,0 +1,178 @@ + +#lang racket/base + +(require unison/boot + unison/chunked-seq + (only-in unison/core + chunked-string-foldMap-chunks + chunked-string= + builtin-Text.>=:termlink + builtin-Text.< + builtin-Text.<:termlink + builtin-Text.> + builtin-Text.>:termlink + builtin-Text.++ + builtin-Text.++:termlink + builtin-Text.drop + builtin-Text.drop:termlink + builtin-Text.empty + builtin-Text.empty:termlink + builtin-Text.fromCharList + builtin-Text.fromCharList:termlink + builtin-Text.fromUtf8.impl.v3 + builtin-Text.fromUtf8.impl.v3:termlink + builtin-Text.repeat + builtin-Text.repeat:termlink + builtin-Text.reverse + builtin-Text.reverse:termlink + builtin-Text.size + builtin-Text.size:termlink + builtin-Text.take + builtin-Text.take:termlink + builtin-Text.toCharList + builtin-Text.toCharList:termlink + builtin-Text.toLowercase + builtin-Text.toLowercase:termlink + builtin-Text.toUppercase + builtin-Text.toUppercase:termlink + builtin-Text.toUtf8 + builtin-Text.toUtf8:termlink + builtin-Text.uncons + builtin-Text.uncons:termlink + builtin-Text.unsnoc + builtin-Text.unsnoc:termlink) + + +(define-unison-builtin (builtin-Char.fromNat n) + (integer->char n)) + +(define-unison-builtin (builtin-Char.toNat c) + (char->integer c)) + +(define-unison-builtin (builtin-Char.toText c) + (string->chunked-string (string c))) + +(define-unison-builtin (builtin-Text.repeat n t) + (let loop ([i 0] + [acc empty-chunked-string]) + (if (= i n) + acc + (loop (add1 i) (chunked-string-append acc t))))) + +(define-unison-builtin (builtin-Text.reverse t) + (chunked-string-foldMap-chunks + t + string-reverse + (lambda (acc c) (chunked-string-append c acc)))) + +(define-unison-builtin (builtin-Text.size t) (chunked-string-length t)) + +(define-unison-builtin (builtin-Text.take n t) (chunked-string-take t n)) + +(define-unison-builtin (builtin-Text.toCharList t) + (build-chunked-list + (chunked-string-length t) + (lambda (i) (chunked-string-ref t i)))) + +(define-unison-builtin (builtin-Text.toLowercase t) + (chunked-string-foldMap-chunks t string-downcase chunked-string-append)) + +(define-unison-builtin (builtin-Text.toUppercase t) + (chunked-string-foldMap-chunks t string-upcase chunked-string-append)) + +(define-unison-builtin (builtin-Text.toUtf8 t) + (bytes->chunked-bytes + (string->bytes/utf-8 + (chunked-string->string t)))) + +(define-unison-builtin (builtin-Text.uncons s) + (cond + [(chunked-string-empty? s) ref-optional-none] + [else + (let-values ([(t c) (chunked-string-pop-first s)]) + (ref-optional-some (unison-tuple c t)))])) + +(define-unison-builtin (builtin-Text.unsnoc s) + (cond + [(chunked-string-empty? s) ref-optional-none] + [else + (let-values ([(t c) (chunked-string-pop-last s)]) + (ref-optional-some (unison-tuple t c)))])) + +; Note: chunked-string x y) + (not (chunked-string= x y) (chunked-stringoptional v) + (if v + (ref-optional-some v) + ref-optional-none)) + +(define-unison-builtin (builtin-Text.indexOf n h) + (->optional (chunked-string-index-of h n))) + +(define-unison-builtin (builtin-Text.++ t u) + (chunked-string-append t u)) + +(define-unison-builtin (builtin-Text.drop n t) + (chunked-string-drop t n)) + +(define-unison-builtin #:hints [value] (builtin-Text.empty) + empty-chunked-string) + +(define-unison-builtin (builtin-Text.fromCharList cs) + (build-chunked-string + (chunked-list-length cs) + (lambda (i) (chunked-list-ref cs i)))) + +(define-unison-builtin (builtin-Text.fromUtf8.impl.v3 bs) + (with-handlers + ([exn:fail:contract? + (lambda (e) + (ref-either-left + (ref-failure-failure + ref-iofailure:typelink + (string->chunked-string + (string-append + "Invalid UTF-8 stream: " + (describe-value bs))) + (unison-any-any (exception->string e)))))]) + (ref-either-right + (string->chunked-string + (bytes->string/utf-8 + (chunked-bytes->bytes bs)))))) + diff --git a/scheme-libs/racket/unison/primops/tls.rkt b/scheme-libs/racket/unison/primops/tls.rkt new file mode 100644 index 0000000000..73ad0c4ecd --- /dev/null +++ b/scheme-libs/racket/unison/primops/tls.rkt @@ -0,0 +1,249 @@ +; TLS primitives! Supplied by openssl (libssl) +#lang racket/base +(require racket/exn + racket/string + racket/file + (only-in racket empty?) + compatibility/mlist + unison/boot + unison/data + unison/data-info + unison/chunked-seq + unison/network-utils + unison/pem + x509 + openssl) + +(provide + builtin-Tls.ClientConfig.certificates.set + builtin-Tls.ClientConfig.certificates.set:termlink + builtin-Tls.ClientConfig.default + builtin-Tls.ClientConfig.default:termlink + builtin-Tls.ServerConfig.default + builtin-Tls.ServerConfig.default:termlink + builtin-Tls.decodeCert.impl.v3 + builtin-Tls.decodeCert.impl.v3:termlink + builtin-Tls.decodePrivateKey + builtin-Tls.decodePrivateKey:termlink + builtin-Tls.encodeCert + builtin-Tls.encodeCert:termlink + builtin-Tls.encodePrivateKey + builtin-Tls.encodePrivateKey:termlink + builtin-Tls.handshake.impl.v3 + builtin-Tls.handshake.impl.v3:termlink + builtin-Tls.newClient.impl.v3 + builtin-Tls.newClient.impl.v3:termlink + builtin-Tls.newServer.impl.v3 + builtin-Tls.newServer.impl.v3:termlink + builtin-Tls.receive.impl.v3 + builtin-Tls.receive.impl.v3:termlink + builtin-Tls.send.impl.v3 + builtin-Tls.send.impl.v3:termlink + builtin-Tls.terminate.impl.v3 + builtin-Tls.terminate.impl.v3:termlink) + +; Native Representations: +; +; tlsPrivateKey - the "pem" struct defined in pem.rkt +; tlsCertificate - currently the raw bytes + +(define (write-to-tmp-file bytes suffix) + (let* ([tmp (make-temporary-file* #"unison" suffix)] + [of (open-output-file tmp #:exists 'replace)]) + (write-bytes bytes of) + (flush-output of) + (close-output-port of) + tmp)) + +(define-unison-builtin (builtin-Tls.encodePrivateKey privateKey) + (bytes->chunked-bytes + (string->bytes/utf-8 (pem->pem-string privateKey)))) + +; bytes -> list tlsPrivateKey +(define-unison-builtin (builtin-Tls.decodePrivateKey bytes) + (vector->chunked-list + (list->vector ; TODO better conversion + (filter + (lambda (pem) (or + (equal? "PRIVATE KEY" (pem-label pem)) + (equal? "RSA PRIVATE KEY" (pem-label pem)))) + + (pem-string->pems + (bytes->string/utf-8 (chunked-bytes->bytes bytes))))))) + +; bytes -> either failure tlsSignedCert +(define-unison-builtin (builtin-Tls.decodeCert.impl.v3 bytes) + (define certs + (read-pem-certificates + (open-input-bytes (chunked-bytes->bytes bytes)))) + + (if (= 1 (length certs)) + (ref-either-right bytes) + (ref-either-left + (ref-failure-failure + ref-tlsfailure:typelink + (string->chunked-string "Could not decode certificate") + (unison-any-any bytes))))) + +; We don't actually "decode" certificates, we just validate them +(define-unison-builtin (builtin-Tls.encodeCert bytes) bytes) + +(struct server-config (certs key)) ; certs = list certificate; key = privateKey + +(define-unison-builtin + ; list tlsSignedCert tlsPrivateKey -> tlsServerConfig + (builtin-Tls.ServerConfig.default certs key) + (server-config certs key)) + +(struct client-config (host certs)) +(struct tls (config input output)) + +; tlsServerConfig socket -> {io} tls +(define-unison-builtin (builtin-Tls.newServer.impl.v3 config socket-pair) + (handle-errors + (let* ([input (socket-pair-input socket-pair)] + [output (socket-pair-output socket-pair)] + [certs (server-config-certs config)] + [key (server-config-key config)] + [key-bytes (string->bytes/utf-8 (pem->pem-string key))] + [tmp (write-to-tmp-file (chunked-bytes->bytes (chunked-list-ref certs 0)) #".pem")]) + (let*-values ([(ctx) (ssl-make-server-context + ; TODO: Once racket can handle the in-memory PEM bytes, + ; we can do away with writing them out to temporary files. + ; https://github.com/racket/racket/pull/4625 + ; #:private-key (list 'pem key-bytes) + #:private-key (list 'pem (write-to-tmp-file key-bytes #".pem")) + #:certificate-chain tmp)] + [(in out) (ports->ssl-ports + input output + #:mode 'accept + #:context ctx + #:close-original? #t + )]) + (ref-either-right (tls config in out)))))) + +(define-unison-builtin + ; string bytes + (builtin-Tls.ClientConfig.default host service-identification-suffix) + (if (= 0 (chunked-bytes-length service-identification-suffix)) + (client-config host empty-chunked-list) + ; todo: better error? + (error 'NotImplemented + "service-identification-suffix not supported"))) + +(define (ServerConfig.certificates.set certs config) + (server-config certs (server-config-key config))) + +(define-unison-builtin + ; list tlsSignedCert tlsClientConfig -> tlsClientConfig + (builtin-Tls.ClientConfig.certificates.set certs config) + (client-config (client-config-host config) certs)) + +(define (left-fail ty msg val) + (ref-either-left + (ref-failure-failure + ty + (string->chunked-string msg) + (unison-any-any val)))) + +(define ((left-fail-exn ty) e) + (left-fail ty (exn->string e) ref-unit-unit)) + +(define ((left-fail-k ty msg) e) + (left-fail ty msg ref-unit-unit)) + +(define (exn:name-mismatch? e) + (string-contains? (exn->string e) "not valid for hostname")) + +(define (exn:cert-verify? e) + (string-contains? (exn->string e) "certificate verify failed")) + +(define-syntax handle-errors + (syntax-rules () + [(handle-errors ex ...) + (with-handlers + [[exn:fail:network? (left-fail-exn ref-iofailure:typelink)] + [exn:fail:contract? (left-fail-exn ref-miscfailure:typelink)] + [exn:name-mismatch? + (left-fail-k ref-tlsfailure:typelink "NameMismatch")] + [exn:cert-verify? + (left-fail-k ref-tlsfailure:typelink + "certificate verify failed")] + [(lambda _ #t) + (lambda (e) + (left-fail + ref-miscfailure:typelink + (format "Unknown exception ~a" (exn->string e)) + ref-unit-unit))]] + ex ...)])) + +(define-unison-builtin (builtin-Tls.newClient.impl.v3 config socket) + (handle-errors + (let* ([input (socket-pair-input socket)] + [output (socket-pair-output socket)] + [hostname (client-config-host config)] + ; TODO: Make the client context up in ClientConfig.default + ; instead of right here. + [ctx (ssl-make-client-context)] + [certs (client-config-certs config)]) + (ssl-set-verify-hostname! ctx #t) + (ssl-set-ciphers! ctx "DEFAULT:!aNULL:!eNULL:!LOW:!EXPORT:!SSLv2") + (ssl-set-verify! ctx #t) + (if (chunked-list-empty? certs) + (ssl-load-default-verify-sources! ctx) + (let ([tmp (write-to-tmp-file (chunked-bytes->bytes (chunked-list-ref certs 0)) #".pem")]) + (ssl-load-verify-source! ctx tmp))) + (let-values ([(in out) (ports->ssl-ports + input output + #:mode 'connect + #:context ctx + #:hostname (chunked-string->string hostname) + #:close-original? #t + )]) + (ref-either-right (tls config in out)))))) + +(define-unison-builtin (builtin-Tls.handshake.impl.v3 tls) + (handle-errors + (ssl-set-verify! (tls-input tls) #t) + (ref-either-right ref-unit-unit))) + +; data = bytes +(define-unison-builtin (builtin-Tls.send.impl.v3 tls data) + (handle-errors + (let* ([output (tls-output tls)]) + (write-bytes (chunked-bytes->bytes data) output) + (flush-output output) + (ref-either-right ref-unit-unit)))) + +(define (read-more n port) + (let* ([buffer (make-bytes n)] + [read (read-bytes-avail! buffer port)]) + (if (< read n) + (subbytes buffer 0 read) + (bytes-append buffer (read-more (* 2 n) port))))) + +(define (read-all n port) + (let* ([buffer (make-bytes n)] + [read (read-bytes-avail! buffer port)]) + (if (= n read) + (bytes-append buffer (read-more (* 2 n) port)) + (subbytes buffer 0 read)))) + +; -> bytes +(define-unison-builtin (builtin-Tls.receive.impl.v3 tls) + (handle-errors + (ref-either-right + (bytes->chunked-bytes (read-all 4096 (tls-input tls)))))) + +(define-unison-builtin (builtin-Tls.terminate.impl.v3 tls) + ; NOTE: This actually does more than the unison impl, + ; which only sends the `close_notify` message, and doesn't + ; mark the port as no longer usable in the runtime. + ; Not sure if this is an important difference. + ; Racket's openssl lib doesn't expose a way to *just* call + ; SSL_Shutdown on a port without also closing it. + (handle-errors + (ssl-abandon-port (tls-input tls)) + (ssl-abandon-port (tls-output tls)) + (ref-either-right ref-unit-unit))) + diff --git a/scheme-libs/racket/unison/udp.rkt b/scheme-libs/racket/unison/primops/udp.rkt similarity index 100% rename from scheme-libs/racket/unison/udp.rkt rename to scheme-libs/racket/unison/primops/udp.rkt diff --git a/scheme-libs/racket/unison/primops/universal.rkt b/scheme-libs/racket/unison/primops/universal.rkt new file mode 100644 index 0000000000..cb66e203d1 --- /dev/null +++ b/scheme-libs/racket/unison/primops/universal.rkt @@ -0,0 +1,42 @@ +#lang racket/base + +(require unison/boot + (only-in unison/core + universal=? + universal-compare) + unison/data + unison/data-info) + +(provide + builtin-Universal.== + builtin-Universal.==:termlink + builtin-Universal.> + builtin-Universal.>:termlink + builtin-Universal.>= + builtin-Universal.>=:termlink + builtin-Universal.< + builtin-Universal.<:termlink + builtin-Universal.<= + builtin-Universal.<=:termlink + builtin-Universal.compare + builtin-Universal.compare:termlink) + + +(define-unison-builtin (builtin-Universal.== x y) (universal=? x y)) + +(define-unison-builtin (builtin-Universal.> x y) + (case (universal-compare x y) [(>) #t] [else #f])) + +(define-unison-builtin (builtin-Universal.< x y) + (case (universal-compare x y) [(<) #t] [else #f])) + +(define-unison-builtin (builtin-Universal.<= x y) + (case (universal-compare x y) [(>) #f] [else #t])) + +(define-unison-builtin (builtin-Universal.>= x y) + (case (universal-compare x y) [(<) #f] [else #t])) + +(define-unison-builtin (builtin-Universal.compare x y) + (case (universal-compare x y) + [(>) 1] [(<) -1] [else 0])) + diff --git a/scheme-libs/racket/unison/tcp.rkt b/scheme-libs/racket/unison/tcp.rkt deleted file mode 100644 index 481e36f648..0000000000 --- a/scheme-libs/racket/unison/tcp.rkt +++ /dev/null @@ -1,127 +0,0 @@ -; TCP primitives! -#lang racket/base -(require racket/exn - racket/match - racket/tcp - unison/data - unison/data-info - unison/chunked-seq - unison/network-utils - unison/core) - -(provide - socket-pair-input - socket-pair-output - (prefix-out - unison-FOp-IO. - (combine-out - clientSocket.impl.v3 - closeSocket.impl.v3 - socketReceive.impl.v3 - socketPort.impl.v3 - serverSocket.impl.v3 - listen.impl.v3 - socketAccept.impl.v3 - socketSend.impl.v3))) - -(struct socket-pair (input output)) - -(define (closeSocket.impl.v3 socket) - (handle-errors - (lambda () - (if (socket-pair? socket) - (begin - (close-input-port (socket-pair-input socket)) - (close-output-port (socket-pair-output socket))) - (tcp-close socket)) - (right none)))) - -(define (clientSocket.impl.v3 host port) ; string string -> socket-pair - (handle-errors - (lambda () - (let-values ([(input output) (tcp-connect (chunked-string->string host) (string->number (chunked-string->string port)))]) - (right (socket-pair input output)))))) - -(define (socketSend.impl.v3 socket data) ; socket bytes -> () - (if (not (socket-pair? socket)) - (exception - ref-iofailure:typelink - (string->chunked-string "Cannot send on a server socket") - ref-unit-unit) - (begin - (write-bytes (chunked-bytes->bytes data) (socket-pair-output socket)) - (flush-output (socket-pair-output socket)) - (right none)))) - -(define (socketReceive.impl.v3 socket amt) ; socket int -> bytes - (if (not (socket-pair? socket)) - (exception - ref-iofailure:typelink - (string->chunked-string "Cannot receive on a server socket")) - (handle-errors - (lambda () - (begin - (let* ([buffer (make-bytes amt)] - [read (read-bytes-avail! buffer (socket-pair-input socket))]) - (right (bytes->chunked-bytes (subbytes buffer 0 read))))))))) - -(define (socketPort.impl.v3 socket) - (let-values ([(_ local-port __ ___) (tcp-addresses - (if (socket-pair? socket) - (socket-pair-input socket) - socket) #t)]) - (right local-port))) - -(define serverSocket.impl.v3 ; string -> socket (or) string string -> socket - (lambda args - (let-values ([(hostname port) - (match args - [(list _ port) (values #f (chunked-string->string port))] - [(list _ hostname port) (values - (chunked-string->string hostname) - (chunked-string->string port))])]) - - (with-handlers - [[exn:fail:network? - (lambda (e) - (exception - ref-iofailure:typelink - (exception->string e) - ref-unit-unit))] - [exn:fail:contract? - (lambda (e) - (exception - ref-iofailure:typelink - (exception->string e) - ref-unit-unit))] - [(lambda _ #t) - (lambda (e) - (exception - ref-miscfailure:typelink - (string->chunked-string "Unknown exception") - ref-unit-unit))] ] - (let ([listener (tcp-listen - (string->number port) - 4 - #t - (if (equal? 0 hostname) #f hostname))]) - (right listener)))))) - -; NOTE: This is a no-op because racket's public TCP stack doesn't have separate operations for -; "bind" vs "listen". We've decided to have `serverSocket` do the "bind & listen", and have -; this do nothing. -; If we want ~a little better parity with the haskell implementation, we might set a flag or -; something on the listener, and error if you try to `accept` on a server socket that you haven't -; called `listen` on yet. -(define (listen.impl.v3 _listener) - (right none)) - -(define (socketAccept.impl.v3 listener) - (if (socket-pair? listener) - (exception - ref-iofailure:typelink - (string->chunked-string "Cannot accept on a non-server socket") - ref-unit-unit) - (begin - (let-values ([(input output) (tcp-accept listener)]) - (right (socket-pair input output)))))) diff --git a/scheme-libs/racket/unison/tls.rkt b/scheme-libs/racket/unison/tls.rkt deleted file mode 100644 index 8f7f3b341f..0000000000 --- a/scheme-libs/racket/unison/tls.rkt +++ /dev/null @@ -1,223 +0,0 @@ -; TLS primitives! Supplied by openssl (libssl) -#lang racket/base -(require racket/exn - racket/string - racket/file - (only-in racket empty?) - compatibility/mlist - unison/data - unison/data-info - unison/chunked-seq - unison/core - unison/tcp - unison/pem - x509 - openssl) - -(provide - (prefix-out - unison-FOp-Tls. - (combine-out - ClientConfig.default - ClientConfig.certificates.set - ServerConfig.default - ServerConfig.certificates.set - decodeCert.impl.v3 - encodeCert - decodePrivateKey - encodePrivateKey - handshake.impl.v3 - newServer.impl.v3 - newClient.impl.v3 - receive.impl.v3 - send.impl.v3 - terminate.impl.v3))) - -; Native Representations: -; -; tlsPrivateKey - the "pem" struct defined in pem.rkt -; tlsCertificate - currently the raw bytes - -(define (write-to-tmp-file bytes suffix) - (let* ([tmp (make-temporary-file* #"unison" suffix)] - [of (open-output-file tmp #:exists 'replace)]) - (write-bytes bytes of) - (flush-output of) - (close-output-port of) - tmp)) - -(define (encodePrivateKey privateKey) - (bytes->chunked-bytes (string->bytes/utf-8 (pem->pem-string privateKey)))) - -(define (decodePrivateKey bytes) ; bytes -> list tlsPrivateKey - (vector->chunked-list - (list->vector ; TODO better conversion - (filter - (lambda (pem) (or - (equal? "PRIVATE KEY" (pem-label pem)) - (equal? "RSA PRIVATE KEY" (pem-label pem)))) - (pem-string->pems (bytes->string/utf-8 (chunked-bytes->bytes bytes))))))) - -(define (decodeCert.impl.v3 bytes) ; bytes -> either failure tlsSignedCert - (let ([certs (read-pem-certificates (open-input-bytes (chunked-bytes->bytes bytes)))]) - (if (= 1 (length certs)) - (right bytes) - (exception - ref-tlsfailure:typelink - (string->chunked-string "nope") - bytes)))) - -; We don't actually "decode" certificates, we just validate them -(define (encodeCert bytes) bytes) - -(struct server-config (certs key)) ; certs = list certificate; key = privateKey - -(define (ServerConfig.default certs key) ; list tlsSignedCert tlsPrivateKey -> tlsServerConfig - (server-config certs key)) - -(struct client-config (host certs)) -(struct tls (config input output)) - -(define (newServer.impl.v3 config socket-pair) ; tlsServerConfig socket -> {io} tls - (handle-errors - (lambda () - (let* ([input (socket-pair-input socket-pair)] - [output (socket-pair-output socket-pair)] - [certs (server-config-certs config)] - [key (server-config-key config)] - [key-bytes (string->bytes/utf-8 (pem->pem-string key))] - [tmp (write-to-tmp-file (chunked-bytes->bytes (chunked-list-ref certs 0)) #".pem")]) - (let*-values ([(ctx) (ssl-make-server-context - ; TODO: Once racket can handle the in-memory PEM bytes, - ; we can do away with writing them out to temporary files. - ; https://github.com/racket/racket/pull/4625 - ; #:private-key (list 'pem key-bytes) - #:private-key (list 'pem (write-to-tmp-file key-bytes #".pem")) - #:certificate-chain tmp)] - [(in out) (ports->ssl-ports - input output - #:mode 'accept - #:context ctx - #:close-original? #t - )]) - (right (tls config in out))))))) - -(define (ClientConfig.default host service-identification-suffix) ; string bytes - (if (= 0 (chunked-bytes-length service-identification-suffix)) - (client-config host empty-chunked-list) - (error 'NotImplemented "service-identification-suffix not supported"))) - -(define (ServerConfig.certificates.set certs config) - (server-config certs (server-config-key config))) - -(define (ClientConfig.certificates.set certs config) ; list tlsSignedCert tlsClientConfig -> tlsClientConfig - (client-config (client-config-host config) certs)) - -(define (handle-errors fn) - (with-handlers - [[exn:fail:network? - (lambda (e) - (exception - ref-iofailure:typelink - (exception->string e) - ref-unit-unit))] - [exn:fail:contract? - (lambda (e) - (exception - ref-miscfailure:typelink - (exception->string e) - ref-unit-unit))] - [(lambda err - (string-contains? (exn->string err) "not valid for hostname")) - (lambda (e) - (exception - ref-tlsfailure:typelink - (string->chunked-string "NameMismatch") - ref-unit-unit))] - [(lambda err - (string-contains? (exn->string err) "certificate verify failed")) - (lambda (e) - (exception - ref-tlsfailure:typelink - (string->chunked-string "certificate verify failed") - ref-unit-unit))] - [(lambda _ #t) - (lambda (e) - (exception - ref-miscfailure:typelink - (string->chunked-string - (format "Unknown exception ~a" (exn->string e))) - ref-unit-unit))]] - (fn))) - -(define (newClient.impl.v3 config socket) - (handle-errors - (lambda () - (let* ([input (socket-pair-input socket)] - [output (socket-pair-output socket)] - [hostname (client-config-host config)] - ; TODO: Make the client context up in ClientConfig.default - ; instead of right here. - [ctx (ssl-make-client-context)] - [certs (client-config-certs config)]) - (ssl-set-verify-hostname! ctx #t) - (ssl-set-ciphers! ctx "DEFAULT:!aNULL:!eNULL:!LOW:!EXPORT:!SSLv2") - (ssl-set-verify! ctx #t) - (if (chunked-list-empty? certs) - (ssl-load-default-verify-sources! ctx) - (let ([tmp (write-to-tmp-file (chunked-bytes->bytes (chunked-list-ref certs 0)) #".pem")]) - (ssl-load-verify-source! ctx tmp))) - (let-values ([(in out) (ports->ssl-ports - input output - #:mode 'connect - #:context ctx - #:hostname (chunked-string->string hostname) - #:close-original? #t - )]) - (right (tls config in out))))))) - -(define (handshake.impl.v3 tls) - (handle-errors - (lambda () - (ssl-set-verify! (tls-input tls) #t) - (right none)))) - -(define (send.impl.v3 tls data) ; data = bytes - (handle-errors - (lambda () - (let* ([output (tls-output tls)]) - (write-bytes (chunked-bytes->bytes data) output) - (flush-output output) - (right none))))) - -(define (read-more n port) - (let* ([buffer (make-bytes n)] - [read (read-bytes-avail! buffer port)]) - (if (< read n) - (subbytes buffer 0 read) - (bytes-append buffer (read-more (* 2 n) port))))) - -(define (read-all n port) - (let* ([buffer (make-bytes n)] - [read (read-bytes-avail! buffer port)]) - (if (= n read) - (bytes-append buffer (read-more (* 2 n) port)) - (subbytes buffer 0 read)))) - -(define (receive.impl.v3 tls) ; -> bytes - (handle-errors - (lambda () - (right (bytes->chunked-bytes (read-all 4096 (tls-input tls))))))) - -(define (terminate.impl.v3 tls) - ; NOTE: This actually does more than the unison impl, - ; which only sends the `close_notify` message, and doesn't - ; mark the port as no longer usable in the runtime. - ; Not sure if this is an important difference. - ; Racket's openssl lib doesn't expose a way to *just* call - ; SSL_Shutdown on a port without also closing it. - (handle-errors - (lambda () - (ssl-abandon-port (tls-input tls)) - (ssl-abandon-port (tls-output tls)) - (right none)))) diff --git a/scheme-libs/racket/unison/zlib.rkt b/scheme-libs/racket/unison/zlib.rkt index a93c781b45..b191eea243 100644 --- a/scheme-libs/racket/unison/zlib.rkt +++ b/scheme-libs/racket/unison/zlib.rkt @@ -9,10 +9,9 @@ file/gunzip file/gzip) -(provide (prefix-out unison-FOp-Bytes. - (combine-out - zlib.compress - zlib.decompress))) +(provide + zlib-deflate-bytes + zlib-inflate-bytes) (define (read-byte-only what i) diff --git a/stack.yaml b/stack.yaml index 19bccd7774..a628e395ea 100644 --- a/stack.yaml +++ b/stack.yaml @@ -34,6 +34,7 @@ packages: - lib/unison-util-bytes - lib/unison-util-cache - lib/unison-util-file-embed + - lib/unison-util-recursion - lib/unison-util-relation - lib/unison-util-rope - parser-typechecker @@ -43,6 +44,7 @@ packages: - unison-core - unison-hashing-v2 - unison-merge + - unison-runtime - unison-share-api - unison-share-projects-api - unison-syntax @@ -51,9 +53,6 @@ packages: resolver: lts-22.26 extra-deps: - # broken version in snapshot - - github: unisonweb/configurator - commit: e47e9e9fe1f576f8c835183b9def52d73c01327a # This custom Haskeline alters ANSI rendering on Windows. # If changing the haskeline dependency, please ensure color renders properly in a # Windows terminal. @@ -63,12 +62,10 @@ extra-deps: # not in stackage - fuzzyfind-3.0.2@sha256:0fcd64eb1016fe0d0232abc26b2b80b32d676707ff41d155a28df8a9572603d4,1921 - - guid-0.1.0@sha256:a7c975be473f6f142d5cc1b39bc807a99043d20b1bb0873fdfe7a3ce84d2faf1,1078 - lock-file-0.7.0.0@sha256:3ad84b5e454145e1d928063b56abb96db24a99a21b493989520e58fa0ab37b00,4484 - monad-validate-1.3.0.0@sha256:eb6ddd5c9cf72ff0563cba604fa00291376e96138fdb4932d00ff3a99d66706e,2605 - recover-rtti-0.4.3@sha256:01adcbab70a6542914df28ac120a23a923d8566236f2c0295998e9419f53dd62,4672 - numerals-0.4.1@sha256:f138b4a0efbde3b3c6cbccb788eff683cb8a5d046f449729712fd174c5ee8a78,11430 - - row-types-1.0.1.2@sha256:4d4c7cb95d06a32b28ba977852d52a26b4c1f695ef083a6fd874ab6d79933b64,3071 - network-udp-0.0.0@sha256:408d2d4fa1a25e49e95752ee124cca641993404bb133ae10fb81daef22d876ae,1075 allow-newer: true @@ -77,7 +74,7 @@ allow-newer-deps: ghc-options: # All packages - "$locals": -Wall -Werror -Wno-name-shadowing -Wno-missing-pattern-synonym-signatures -fprint-expanded-synonyms -fwrite-ide-info #-freverse-errors + "$locals": -Wall -Werror -Wno-name-shadowing -Wno-missing-pattern-synonym-signatures -fprint-expanded-synonyms -fwrite-ide-info -Wunused-packages -funbox-strict-fields #-freverse-errors # See https://github.com/haskell/haskell-language-server/issues/208 "$everything": -haddock diff --git a/stack.yaml.lock b/stack.yaml.lock index 61c24795ea..a2ef8c07f1 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -4,17 +4,6 @@ # https://docs.haskellstack.org/en/stable/lock_files packages: -- completed: - name: configurator - pantry-tree: - sha256: 90547cd983fd15ebdc803e057d3ef8735fe93a75e29a00f8a74eadc13ee0f6e9 - size: 955 - sha256: d4fd87fb7bfc5d8e9fbc3e4ee7302c6b1500cdc00fdb9b659d0f4849b6ebe2d5 - size: 15989 - url: https://github.com/unisonweb/configurator/archive/e47e9e9fe1f576f8c835183b9def52d73c01327a.tar.gz - version: 0.3.0.0 - original: - url: https://github.com/unisonweb/configurator/archive/e47e9e9fe1f576f8c835183b9def52d73c01327a.tar.gz - completed: name: haskeline pantry-tree: @@ -33,13 +22,6 @@ packages: size: 542 original: hackage: fuzzyfind-3.0.2@sha256:0fcd64eb1016fe0d0232abc26b2b80b32d676707ff41d155a28df8a9572603d4,1921 -- completed: - hackage: guid-0.1.0@sha256:a7c975be473f6f142d5cc1b39bc807a99043d20b1bb0873fdfe7a3ce84d2faf1,1078 - pantry-tree: - sha256: a33838b7b1c54f6ac3e1b436b25674948713a4189658e4d82e639b9a689bc90d - size: 364 - original: - hackage: guid-0.1.0@sha256:a7c975be473f6f142d5cc1b39bc807a99043d20b1bb0873fdfe7a3ce84d2faf1,1078 - completed: hackage: lock-file-0.7.0.0@sha256:3ad84b5e454145e1d928063b56abb96db24a99a21b493989520e58fa0ab37b00,4484 pantry-tree: @@ -68,13 +50,6 @@ packages: size: 13751 original: hackage: numerals-0.4.1@sha256:f138b4a0efbde3b3c6cbccb788eff683cb8a5d046f449729712fd174c5ee8a78,11430 -- completed: - hackage: row-types-1.0.1.2@sha256:4d4c7cb95d06a32b28ba977852d52a26b4c1f695ef083a6fd874ab6d79933b64,3071 - pantry-tree: - sha256: 6a3617038d3970095100d14d026c396002a115700500cf3004ffb67ae5a75611 - size: 1060 - original: - hackage: row-types-1.0.1.2@sha256:4d4c7cb95d06a32b28ba977852d52a26b4c1f695ef083a6fd874ab6d79933b64,3071 - completed: hackage: network-udp-0.0.0@sha256:408d2d4fa1a25e49e95752ee124cca641993404bb133ae10fb81daef22d876ae,1075 pantry-tree: diff --git a/unison-cli-integration/integration-tests/IntegrationTests/ArgumentParsing.hs b/unison-cli-integration/integration-tests/IntegrationTests/ArgumentParsing.hs index 02ef8fce9e..0ecbcbb000 100644 --- a/unison-cli-integration/integration-tests/IntegrationTests/ArgumentParsing.hs +++ b/unison-cli-integration/integration-tests/IntegrationTests/ArgumentParsing.hs @@ -2,6 +2,7 @@ module IntegrationTests.ArgumentParsing where +import Control.Monad (when) import Data.List (intercalate) import Data.Time (diffUTCTime, getCurrentTime) import EasyTest @@ -71,10 +72,12 @@ test = do expectExitCode :: ExitCode -> FilePath -> [String] -> String -> Test () expectExitCode expected cmd args stdin = scope (intercalate " " (cmd : args)) do start <- io $ getCurrentTime - (code, _, _) <- io $ readProcessWithExitCode cmd args stdin + (code, _, stdErr) <- io $ readProcessWithExitCode cmd args stdin end <- io $ getCurrentTime let diff = diffUTCTime end start note $ printf "\n[Time: %s sec]" $ show diff + when (code /= expected) do + note ("stderr:\n" <> stdErr) expectEqual code expected defaultArgs :: [String] diff --git a/unison-cli-integration/integration-tests/IntegrationTests/transcript.md b/unison-cli-integration/integration-tests/IntegrationTests/transcript.md index 2db0994f0e..0b26c2d432 100644 --- a/unison-cli-integration/integration-tests/IntegrationTests/transcript.md +++ b/unison-cli-integration/integration-tests/IntegrationTests/transcript.md @@ -1,12 +1,12 @@ # Integration test: transcript -```ucm:hide +``` ucm :hide scratch/main> builtins.mergeio lib.builtins scratch/main> load ./unison-src/transcripts-using-base/base.u scratch/main> add ``` -```unison +``` unison use lib.builtins unique type MyBool = MyTrue | MyFalse @@ -33,7 +33,7 @@ main = do _ -> () ``` -```ucm +``` ucm scratch/main> add scratch/main> compile main ./unison-cli-integration/integration-tests/IntegrationTests/main ``` diff --git a/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md b/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md index 92a636f2c1..5ba2e787e8 100644 --- a/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md +++ b/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md @@ -1,5 +1,13 @@ # Integration test: transcript +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins + +scratch/main> load ./unison-src/transcripts-using-base/base.u + +scratch/main> add +``` + ``` unison use lib.builtins @@ -27,32 +35,30 @@ main = do _ -> () ``` -``` ucm - +``` ucm :added-by-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`: structural ability Break type MyBool main : '{IO, Exception} () resume : Request {g, Break} x -> x - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + structural ability Break type MyBool main : '{IO, Exception} () resume : Request {g, Break} x -> x scratch/main> compile main ./unison-cli-integration/integration-tests/IntegrationTests/main - ``` diff --git a/unison-cli-integration/package.yaml b/unison-cli-integration/package.yaml index 9ea425cb51..b4127e82e9 100644 --- a/unison-cli-integration/package.yaml +++ b/unison-cli-integration/package.yaml @@ -2,11 +2,6 @@ name: unison-cli-integration github: unisonweb/unison copyright: Copyright (C) 2013-2018 Unison Computing, PBC and contributors -flags: - optimized: - manual: true - default: false - ghc-options: -Wall executables: @@ -24,15 +19,10 @@ executables: - directory - easytest - process - - shellmet - time build-tools: - unison-cli-main:unison -when: - - condition: flag(optimized) - ghc-options: -O2 -funbox-strict-fields - default-extensions: - ApplicativeDo - BangPatterns diff --git a/unison-cli-integration/unison-cli-integration.cabal b/unison-cli-integration/unison-cli-integration.cabal index 3b5a0fb543..6cda3a952d 100644 --- a/unison-cli-integration/unison-cli-integration.cabal +++ b/unison-cli-integration/unison-cli-integration.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack @@ -15,10 +15,6 @@ source-repository head type: git location: https://github.com/unisonweb/unison -flag optimized - manual: True - default: False - executable cli-integration-tests main-is: Suite.hs other-modules: @@ -68,8 +64,5 @@ executable cli-integration-tests , easytest , filepath , process - , shellmet , time default-language: Haskell2010 - if flag(optimized) - ghc-options: -O2 -funbox-strict-fields diff --git a/unison-cli-main/package.yaml b/unison-cli-main/package.yaml index b64fe52764..820829493e 100644 --- a/unison-cli-main/package.yaml +++ b/unison-cli-main/package.yaml @@ -2,11 +2,6 @@ name: unison-cli-main github: unisonweb/unison copyright: Copyright (C) 2013-2018 Unison Computing, PBC and contributors -flags: - optimized: - manual: true - default: false - ghc-options: -Wall executables: @@ -24,10 +19,6 @@ executables: - text - unison-cli -when: - - condition: flag(optimized) - ghc-options: -O2 -funbox-strict-fields - default-extensions: - ApplicativeDo - BangPatterns diff --git a/unison-cli-main/unison-cli-main.cabal b/unison-cli-main/unison-cli-main.cabal index 4c54254978..e94c51e228 100644 --- a/unison-cli-main/unison-cli-main.cabal +++ b/unison-cli-main/unison-cli-main.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.0. +-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack @@ -17,10 +17,6 @@ source-repository head type: git location: https://github.com/unisonweb/unison -flag optimized - manual: True - default: False - executable unison main-is: Main.hs other-modules: @@ -68,5 +64,3 @@ executable unison , text , unison-cli default-language: Haskell2010 - if flag(optimized) - ghc-options: -O2 -funbox-strict-fields diff --git a/unison-cli/package.yaml b/unison-cli/package.yaml index a4055184a5..098c48f302 100644 --- a/unison-cli/package.yaml +++ b/unison-cli/package.yaml @@ -2,114 +2,15 @@ name: unison-cli github: unisonweb/unison copyright: Copyright (C) 2013-2018 Unison Computing, PBC and contributors -flags: - optimized: - manual: true - default: false - ghc-options: -Wall dependencies: - - IntervalMap - - ListLike - - aeson >= 2.0.0.0 - - aeson-pretty - - ansi-terminal - - async - base - - bytes - - bytestring - - cmark - - co-log-core - - code-page - - concurrent-output - - conduit - - configurator - - containers >= 0.6.3 - - cryptonite - - deepseq - - directory - - either - - errors - - exceptions - - extra - - filepath - - free - - friendly-time - - fsnotify - - fuzzyfind - - generic-lens - - haskeline - - http-client >= 0.7.6 - - http-client-tls - - http-types - - jwt - - ki - - lens - - lock-file - - lsp >= 2.2.0.0 - - lsp-types >= 2.0.2.0 - - megaparsec - - memory - - mtl - - network - - network-simple - - network-udp - - network-uri - - nonempty-containers - - numerals - - open-browser - - optparse-applicative >= 0.16.1.0 - - pretty-simple - - process - - random >= 1.2.0 - - random-shuffle - - recover-rtti - - regex-tdfa - - semialign - - semigroups - - serialise - - servant - - servant-client - - servant-conduit - - shellmet - - stm - - stm-chans - - template-haskell - - temporary - text - - text-ansi - - text-builder - - text-rope - - these - - these-lens - - time - - transformers - - unison-codebase - - unison-codebase-sqlite - - unison-codebase-sqlite-hashing-v2 - - unison-core - - unison-core1 - - unison-hash - - unison-merge - unison-parser-typechecker - unison-prelude - - unison-pretty-printer - - unison-share-api - - unison-share-projects-api - - unison-sqlite - - unison-syntax - - unison-util-base32hex - - unison-util-relation - - unliftio - - unordered-containers - - uri-encode - - uuid - - vector - - wai - - warp - - witch - - witherable + - megaparsec + - directory library: source-dirs: src @@ -119,11 +20,85 @@ library: - condition: "!os(windows)" dependencies: unix dependencies: + - Diff + - IntervalMap + - ListLike + - aeson >= 2.0.0.0 + - aeson-pretty + - ansi-terminal + - async + - bytestring + - cmark + - co-log-core - code-page + - concurrent-output + - containers >= 0.6.3 + - cryptonite + - either + - errors + - extra + - filepath + - free + - friendly-time + - fsnotify + - generic-lens + - haskeline + - http-client >= 0.7.6 + - http-client-tls + - http-types + - ki + - lens + - lock-file + - lsp >= 2.2.0.0 + - lsp-types >= 2.0.2.0 + - memory + - mtl + - network-simple + - network-uri + - nonempty-containers + - numerals + - open-browser - optparse-applicative >= 0.16.1.0 - - shellmet - - template-haskell + - pretty-simple + - process + - random-shuffle + - recover-rtti + - regex-tdfa + - semialign + - servant + - servant-client + - stm - temporary + - text-ansi + - text-builder + - text-rope + - these + - time + - transformers + - unison-codebase + - unison-codebase-sqlite + - unison-codebase-sqlite-hashing-v2 + - unison-core + - unison-core1 + - unison-hash + - unison-merge + - unison-parser-typechecker + - unison-pretty-printer + - unison-runtime + - unison-share-api + - unison-share-projects-api + - unison-sqlite + - unison-syntax + - unison-util-base32hex + - unison-util-recursion + - unison-util-relation + - unliftio + - uuid + - vector + - wai + - warp + - witch + - witherable tests: cli-tests: @@ -132,11 +107,22 @@ tests: other-modules: Paths_unison_cli dependencies: - code-page + - containers + - cryptonite - easytest + - extra - here - - shellmet + - lens + - lsp-types - temporary + - these - unison-cli + - unison-core + - unison-core1 + - unison-parser-typechecker + - unison-pretty-printer + - unison-syntax + - unison-util-recursion main: Main.hs source-dirs: tests @@ -151,14 +137,10 @@ executables: dependencies: - code-page - easytest - - process - - shellmet - - unison-cli + - filepath - silently - -when: - - condition: flag(optimized) - ghc-options: -O2 -funbox-strict-fields + - unison-cli + - unliftio default-extensions: - ApplicativeDo diff --git a/unison-cli/src/Unison/Cli/Monad.hs b/unison-cli/src/Unison/Cli/Monad.hs index 398982889c..cede3035fb 100644 --- a/unison-cli/src/Unison/Cli/Monad.hs +++ b/unison-cli/src/Unison/Cli/Monad.hs @@ -39,6 +39,7 @@ module Unison.Cli.Monad -- * Communicating output to the user respond, respondNumbered, + withRespondRegion, setNumberedArgs, -- * Debug-timing actions @@ -47,6 +48,7 @@ module Unison.Cli.Monad -- * Running transactions runTransaction, runTransactionWithRollback, + runTransactionWithRollback2, -- * Internal setMostRecentProjectPath, @@ -61,7 +63,6 @@ import Control.Lens import Control.Monad.Reader (MonadReader (..)) import Control.Monad.State.Strict (MonadState) import Control.Monad.State.Strict qualified as State -import Data.Configurator.Types qualified as Configurator import Data.List.NonEmpty qualified as List (NonEmpty) import Data.List.NonEmpty qualified as List.NonEmpty import Data.List.NonEmpty qualified as NonEmpty @@ -70,6 +71,7 @@ import Data.Time.Clock.System (getSystemTime, systemToTAITime) import Data.Time.Clock.TAI (diffAbsoluteTime) import Data.Unique (Unique, newUnique) import System.CPUTime (getCPUTime) +import System.Console.Regions qualified as Console.Regions import Text.Printf (printf) import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) import U.Codebase.Sqlite.Queries qualified as Q @@ -83,10 +85,12 @@ import Unison.Codebase.Editor.UCMVersion (UCMVersion) import Unison.Codebase.Path qualified as Path import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime (Runtime) +import Unison.CommandLine.OutputMessages qualified as OutputMessages import Unison.Core.Project (ProjectAndBranch (..)) import Unison.Debug qualified as Debug import Unison.Parser.Ann (Ann) import Unison.Prelude +import Unison.PrettyTerminal qualified as PrettyTerminal import Unison.Server.CodebaseServer qualified as Server import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) @@ -94,6 +98,7 @@ import Unison.Syntax.Parser qualified as Parser import Unison.Term (Term) import Unison.Type (Type) import Unison.UnisonFile qualified as UF +import Unison.Util.Pretty qualified as Pretty import Unsafe.Coerce (unsafeCoerce) -- | The main command-line app monad. @@ -159,14 +164,13 @@ type SourceName = Text data Env = Env { authHTTPClient :: AuthenticatedHttpClient, codebase :: Codebase IO Symbol Ann, - config :: Configurator.Config, credentialManager :: CredentialManager, -- | Generate a unique name. generateUniqueName :: IO Parser.UniqueName, -- | How to load source code. loadSource :: SourceName -> IO LoadSourceResult, - -- | How to write source code. - writeSource :: SourceName -> Text -> IO (), + -- | How to write source code. Bool = make new fold? + writeSource :: SourceName -> Text -> Bool -> IO (), -- | What to do with output for the user. notify :: Output -> IO (), -- | What to do with numbered output for the user. @@ -426,6 +430,23 @@ respondNumbered output = do args <- liftIO (notifyNumbered output) setNumberedArgs args +-- | Perform a Cli action with access to a console region, which is closed upon completion. +-- +-- (In transcripts, this just outputs messages as normal). +withRespondRegion :: ((Output -> Cli ()) -> Cli a) -> Cli a +withRespondRegion action = do + env <- ask + case env.isTranscriptTest of + False -> + with_ Console.Regions.displayConsoleRegions do + with (Console.Regions.withConsoleRegion Console.Regions.Linear) \region -> + action \output -> + liftIO do + string <- (OutputMessages.notifyUser "." output) + width <- PrettyTerminal.getAvailableWidth + Console.Regions.setConsoleRegion region (Pretty.toANSI width (Pretty.border 2 string)) + True -> action respond + -- | Updates the numbered args, but only if the new args are non-empty. setNumberedArgs :: NumberedArgs -> Cli () setNumberedArgs args = do @@ -444,3 +465,10 @@ runTransactionWithRollback action = do Env {codebase} <- ask liftIO (Codebase.runTransactionWithRollback codebase \rollback -> Right <$> action (\output -> rollback (Left output))) & onLeftM returnEarly + +-- | Run a transaction that can abort early. +-- todo: rename to runTransactionWithRollback +runTransactionWithRollback2 :: ((forall void. a -> Sqlite.Transaction void) -> Sqlite.Transaction a) -> Cli a +runTransactionWithRollback2 action = do + env <- ask + liftIO (Codebase.runTransactionWithRollback env.codebase action) diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 8ea64f0694..242ee77635 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -1,10 +1,7 @@ -- | This module contains miscellaneous helper utils for rote actions in the Cli monad, like resolving a relative path -- to an absolute path, per the current path. module Unison.Cli.MonadUtils - ( -- * @.unisonConfig@ things - getConfig, - - -- * Paths + ( -- * Paths getCurrentPath, getCurrentProjectName, getCurrentProjectBranchName, @@ -88,8 +85,6 @@ where import Control.Lens import Control.Monad.Reader (ask) import Control.Monad.State -import Data.Configurator qualified as Configurator -import Data.Configurator.Types qualified as Configurator import Data.Foldable import Data.Set qualified as Set import U.Codebase.Branch qualified as V2 (Branch) @@ -138,15 +133,6 @@ import Unison.UnisonFile.Names qualified as UFN import Unison.Util.Set qualified as Set import Unison.Var qualified as Var ------------------------------------------------------------------------------------------------------------------------- --- .unisonConfig things - --- | Lookup a config value by key. -getConfig :: (Configurator.Configured a) => Text -> Cli (Maybe a) -getConfig key = do - Cli.Env {config} <- ask - liftIO (Configurator.lookup config key) - ------------------------------------------------------------------------------------------------------------------------ -- Getting paths, path resolution, etc. @@ -570,5 +556,7 @@ makeParsingEnv path names = do ParsingEnv { uniqueNames = uniqueName, uniqueTypeGuid = loadUniqueTypeGuid path, - names + names, + maybeNamespace = Nothing, + localNamespacePrefixedTypesAndConstructors = mempty } diff --git a/unison-cli/src/Unison/Cli/NameResolutionUtils.hs b/unison-cli/src/Unison/Cli/NameResolutionUtils.hs new file mode 100644 index 0000000000..92b06f1e95 --- /dev/null +++ b/unison-cli/src/Unison/Cli/NameResolutionUtils.hs @@ -0,0 +1,51 @@ +-- | Utilities related to resolving names to things. +module Unison.Cli.NameResolutionUtils + ( resolveHQName, + resolveHQToLabeledDependencies, + ) +where + +import Control.Monad.Reader (ask) +import Data.Bifoldable (bifoldMap) +import Data.Set qualified as Set +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.NamesUtils qualified as Cli +import Unison.HashQualified qualified as HQ +import Unison.LabeledDependency (LabeledDependency) +import Unison.LabeledDependency qualified as LD +import Unison.Name (Name) +import Unison.Name qualified as Name +import Unison.Names qualified as Names +import Unison.Prelude +import Unison.Reference (TypeReference) +import Unison.Referent (Referent) +import Unison.Server.NameSearch.Sqlite qualified as Sqlite +import Unison.ShortHash (ShortHash) +import Unison.Util.Defns (Defns (..), DefnsF) + +resolveHQName :: HQ.HashQualified Name -> Cli (DefnsF Set Referent TypeReference) +resolveHQName = \case + HQ.NameOnly name -> do + names <- Cli.currentNames + pure + Defns + { terms = Name.searchByRankedSuffix name names.terms, + types = Name.searchByRankedSuffix name names.types + } + -- rationale: the hash should be unique enough that the name never helps + -- mitchell says: that seems wrong + HQ.HashQualified _n hash -> resolveHashOnly hash + HQ.HashOnly hash -> resolveHashOnly hash + where + resolveHashOnly :: ShortHash -> Cli (DefnsF Set Referent TypeReference) + resolveHashOnly hash = do + env <- ask + Cli.runTransaction do + terms <- Sqlite.termReferentsByShortHash env.codebase hash + types <- Sqlite.typeReferencesByShortHash hash + pure Defns {terms, types} + +resolveHQToLabeledDependencies :: HQ.HashQualified Name -> Cli (Set LabeledDependency) +resolveHQToLabeledDependencies = + fmap (bifoldMap (Set.map LD.referent) (Set.map LD.typeRef)) . resolveHQName diff --git a/unison-cli/src/Unison/Cli/Pretty.hs b/unison-cli/src/Unison/Cli/Pretty.hs index 07a67d1c63..9b72ee98d8 100644 --- a/unison-cli/src/Unison/Cli/Pretty.hs +++ b/unison-cli/src/Unison/Cli/Pretty.hs @@ -37,7 +37,9 @@ module Unison.Cli.Pretty prettySharePath, prettyShareURI, prettySlashProjectBranchName, + prettyTerm, prettyTermName, + prettyType, prettyTypeName, prettyTypeResultHeader', prettyTypeResultHeaderFull', @@ -47,14 +49,11 @@ module Unison.Cli.Pretty prettyWriteRemoteNamespace, shareOrigin, unsafePrettyTermResultSigFull', - prettyTermDisplayObjects, - prettyTypeDisplayObjects, ) where import Control.Lens hiding (at) import Control.Monad.Writer (Writer, runWriter) -import Data.List qualified as List import Data.Map qualified as Map import Data.Set qualified as Set import Data.Time (UTCTime) @@ -92,7 +91,6 @@ import Unison.HashQualified qualified as HQ import Unison.HashQualifiedPrime qualified as HQ' import Unison.LabeledDependency as LD import Unison.Name (Name) -import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.NameSegment.Internal qualified as NameSegment import Unison.Parser.Ann (Ann) @@ -102,10 +100,9 @@ import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnv.Util qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPED import Unison.Project (ProjectAndBranch (..), ProjectName, Semver (..)) -import Unison.Reference (Reference, TermReferenceId) +import Unison.Reference (Reference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) -import Unison.Referent qualified as Referent import Unison.Server.SearchResultPrime qualified as SR' import Unison.ShortHash (ShortHash) import Unison.Symbol (Symbol) @@ -439,34 +436,6 @@ prettyUnisonFile ppe uf@(UF.UnisonFileId datas effects terms watches) = rd = Reference.DerivedId hqv v = HQ.unsafeFromVar v -prettyTypeDisplayObjects :: - PPED.PrettyPrintEnvDecl -> - (Map Reference (DisplayObject () (DD.Decl Symbol Ann))) -> - [P.Pretty SyntaxText] -prettyTypeDisplayObjects pped types = - types - & Map.toList - & map (\(ref, dt) -> (PPE.typeName unsuffixifiedPPE ref, ref, dt)) - & List.sortBy (\(n0, _, _) (n1, _, _) -> Name.compareAlphabetical n0 n1) - & map (prettyType pped) - where - unsuffixifiedPPE = PPED.unsuffixifiedPPE pped - -prettyTermDisplayObjects :: - PPED.PrettyPrintEnvDecl -> - Bool -> - (TermReferenceId -> Bool) -> - (Map Reference.TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))) -> - [P.Pretty SyntaxText] -prettyTermDisplayObjects pped isSourceFile isTest terms = - terms - & Map.toList - & map (\(ref, dt) -> (PPE.termName unsuffixifiedPPE (Referent.Ref ref), ref, dt)) - & List.sortBy (\(n0, _, _) (n1, _, _) -> Name.compareAlphabetical n0 n1) - & map (\t -> prettyTerm pped isSourceFile (fromMaybe False . fmap isTest . Reference.toId $ (t ^. _2)) t) - where - unsuffixifiedPPE = PPED.unsuffixifiedPPE pped - prettyTerm :: PPED.PrettyPrintEnvDecl -> Bool {- whether we're printing to a source-file or not. -} -> diff --git a/unison-cli/src/Unison/Cli/PrettyPrintUtils.hs b/unison-cli/src/Unison/Cli/PrettyPrintUtils.hs deleted file mode 100644 index 8ee18756f4..0000000000 --- a/unison-cli/src/Unison/Cli/PrettyPrintUtils.hs +++ /dev/null @@ -1,39 +0,0 @@ --- | Utilities that have to do with constructing pretty-print environments, given stateful information in the Cli monad --- state/environment, such as the current path. -module Unison.Cli.PrettyPrintUtils - ( prettyPrintEnvDeclFromNames, - currentPrettyPrintEnvDecl, - projectBranchPPED, - ) -where - -import U.Codebase.Sqlite.ProjectBranch (ProjectBranch) -import Unison.Cli.Monad (Cli) -import Unison.Cli.Monad qualified as Cli -import Unison.Cli.NamesUtils qualified as Cli -import Unison.Codebase qualified as Codebase -import Unison.Names (Names) -import Unison.Prelude -import Unison.PrettyPrintEnv.Names qualified as PPE -import Unison.PrettyPrintEnvDecl qualified as PPE hiding (biasTo) -import Unison.PrettyPrintEnvDecl qualified as PPED -import Unison.PrettyPrintEnvDecl.Names qualified as PPED - --- | Builds a pretty print env decl from a names object. -prettyPrintEnvDeclFromNames :: Names -> Cli PPE.PrettyPrintEnvDecl -prettyPrintEnvDeclFromNames ns = - Cli.runTransaction Codebase.hashLength <&> \hashLen -> - PPED.makePPED (PPE.hqNamer hashLen ns) (PPE.suffixifyByHash ns) - --- | Get a pretty print env decl for the current names at the current path. --- --- Prefer using 'prettyPrintEnvDeclFromNames' when you've already got --- a 'Names' value around, since using 'currentPrettyPrintEnvDecl' rebuilds the underlying --- names object. -currentPrettyPrintEnvDecl :: Cli PPE.PrettyPrintEnvDecl -currentPrettyPrintEnvDecl = do - Cli.currentNames >>= prettyPrintEnvDeclFromNames - -projectBranchPPED :: ProjectBranch -> Cli PPED.PrettyPrintEnvDecl -projectBranchPPED pb = do - Cli.projectBranchNames pb >>= prettyPrintEnvDeclFromNames diff --git a/unison-cli/src/Unison/Cli/TypeCheck.hs b/unison-cli/src/Unison/Cli/TypeCheck.hs index e9a8caf547..b7e74a231f 100644 --- a/unison-cli/src/Unison/Cli/TypeCheck.hs +++ b/unison-cli/src/Unison/Cli/TypeCheck.hs @@ -49,7 +49,8 @@ typecheckTerm codebase tm = do Typechecker.Env { ambientAbilities = [], typeLookup, - termsByShortname = Map.empty + termsByShortname = Map.empty, + topLevelComponents = Map.empty } pure $ fmap extract $ FileParsers.synthesizeFile typecheckingEnv file where diff --git a/unison-cli/src/Unison/Cli/UpdateUtils.hs b/unison-cli/src/Unison/Cli/UpdateUtils.hs index 25284c28fd..45a478d6eb 100644 --- a/unison-cli/src/Unison/Cli/UpdateUtils.hs +++ b/unison-cli/src/Unison/Cli/UpdateUtils.hs @@ -9,6 +9,7 @@ module Unison.Cli.UpdateUtils -- * Getting dependents in a namespace getNamespaceDependentsOf, getNamespaceDependentsOf2, + getNamespaceDependentsOf3, -- * Narrowing definitions narrowDefns, @@ -16,19 +17,13 @@ module Unison.Cli.UpdateUtils -- * Hydrating definitions hydrateDefns, - -- * Rendering definitions - renderDefnsForUnisonFile, - -- * Parsing and typechecking parseAndTypecheck, ) where -import Control.Lens (mapped, _1) import Control.Monad.Reader (ask) -import Control.Monad.Writer (Writer) -import Control.Monad.Writer qualified as Writer -import Data.Bifoldable (bifoldMap) +import Data.Bifoldable (bifold, bifoldMap) import Data.Bitraversable (bitraverse) import Data.Foldable qualified as Foldable import Data.List qualified as List @@ -42,40 +37,29 @@ import U.Codebase.Causal qualified import U.Codebase.Reference (TermReferenceId, TypeReferenceId) import U.Codebase.Referent qualified as V2 import U.Codebase.Sqlite.Operations qualified as Operations -import Unison.Builtin.Decls qualified as Builtin.Decls import Unison.Cli.Monad (Cli, Env (..)) import Unison.Cli.Monad qualified as Cli import Unison.Cli.TypeCheck (computeTypecheckingEnvironment) -import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) -import Unison.DataDeclaration (Decl) import Unison.Debug qualified as Debug import Unison.FileParsers qualified as FileParsers import Unison.Hash (Hash) -import Unison.HashQualified qualified as HQ -import Unison.HashQualifiedPrime qualified as HQ' -import Unison.Merge.DeclNameLookup (DeclNameLookup (..), expectConstructorNames) import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment +import Unison.Names (Names) +import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) import Unison.Parsers qualified as Parsers import Unison.Prelude -import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) -import Unison.Reference (Reference, TypeReference) +import Unison.Reference (Reference, TermReference, TypeReference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Result qualified as Result import Unison.Sqlite (Transaction) import Unison.Symbol (Symbol) -import Unison.Syntax.DeclPrinter (AccessorName) -import Unison.Syntax.DeclPrinter qualified as DeclPrinter import Unison.Syntax.Parser qualified as Parser -import Unison.Syntax.TermPrinter qualified as TermPrinter -import Unison.Term (Term) -import Unison.Type (Type) -import Unison.Typechecker qualified as Typechecker import Unison.UnisonFile (TypecheckedUnisonFile) import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap @@ -83,15 +67,12 @@ import Unison.Util.Conflicted (Conflicted (..)) import Unison.Util.Defn (Defn (..)) import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2) import Unison.Util.Nametree (Nametree (..), traverseNametreeWithName, unflattenNametrees) -import Unison.Util.Pretty (ColorText, Pretty) +import Unison.Util.Pretty (Pretty) import Unison.Util.Pretty qualified as Pretty import Unison.Util.Relation (Relation) import Unison.Util.Relation qualified as Relation import Unison.Util.Set qualified as Set -import Unison.Var (Var) import Prelude hiding (unzip, zip, zipWith) -import Unison.Names (Names) -import qualified Unison.Names as Names ------------------------------------------------------------------------------------------------------------------------ -- Loading definitions @@ -193,6 +174,18 @@ getNamespaceDependentsOf2 defns dependencies = do let names = BiMultimap.lookupDom (Reference.fromId ref) defns.types in Set.foldl' (\acc name -> Map.insert name ref acc) acc0 names +-- | Given a namespace and a set of dependencies, return the subset of the namespace that consists of only the +-- (transitive) dependents of the dependencies. +getNamespaceDependentsOf3 :: + Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> + DefnsF Set TermReference TypeReference -> + Transaction (DefnsF Set TermReferenceId TypeReferenceId) +getNamespaceDependentsOf3 defns dependencies = do + let toTermScope = Set.mapMaybe Referent.toReferenceId . BiMultimap.dom + let toTypeScope = Set.mapMaybe Reference.toId . BiMultimap.dom + let scope = bifoldMap toTermScope toTypeScope defns + Operations.transitiveDependentsWithinScope scope (bifold dependencies) + ------------------------------------------------------------------------------------------------------------------------ -- Narrowing definitions @@ -235,13 +228,13 @@ hydrateDefns :: (Hash -> m [term]) -> (Hash -> m [typ]) -> DefnsF (Map name) TermReferenceId TypeReferenceId -> - m (DefnsF (Map name) term (TypeReferenceId, typ)) + m (DefnsF (Map name) (TermReferenceId, term) (TypeReferenceId, typ)) hydrateDefns getTermComponent getTypeComponent = do bitraverse hydrateTerms hydrateTypes where - hydrateTerms :: Map name TermReferenceId -> m (Map name term) + hydrateTerms :: Map name TermReferenceId -> m (Map name (TermReferenceId, term)) hydrateTerms terms = - hydrateDefns_ getTermComponent terms \_ _ -> id + hydrateDefns_ getTermComponent terms \_ -> (,) hydrateTypes :: Map name TypeReferenceId -> m (Map name (TypeReferenceId, typ)) hydrateTypes types = @@ -273,72 +266,6 @@ hydrateDefns_ getComponent defns modify = defns2 = BiMultimap.fromRange defns ------------------------------------------------------------------------------------------------------------------------- --- Rendering definitions - --- | Render definitions destined for a Unison file. --- --- This first renders the types (discovering which record accessors will be generated upon parsing), then renders the --- terms (being careful not to render any record accessors, since those would cause duplicate binding errors upon --- parsing). -renderDefnsForUnisonFile :: - forall a v. - (Var v, Monoid a) => - DeclNameLookup -> - PrettyPrintEnvDecl -> - DefnsF (Map Name) (Term v a, Type v a) (TypeReferenceId, Decl v a) -> - DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText) -renderDefnsForUnisonFile declNameLookup ppe defns = - let (types, accessorNames) = Writer.runWriter (Map.traverseWithKey renderType defns.types) - in Defns - { terms = Map.mapMaybeWithKey (renderTerm accessorNames) defns.terms, - types - } - where - renderType :: Name -> (TypeReferenceId, Decl v a) -> Writer (Set AccessorName) (Pretty ColorText) - renderType name (ref, typ) = - fmap Pretty.syntaxToColor $ - DeclPrinter.prettyDeclW - -- Sort of a hack; since the decl printer looks in the PPE for names of constructors, - -- we just delete all term names out and add back the constructors... - -- probably no need to wipe out the suffixified side but we do it anyway - (setPpedToConstructorNames declNameLookup name ref ppe) - (Reference.fromId ref) - (HQ.NameOnly name) - typ - - renderTerm :: Set Name -> Name -> (Term v a, Type v a) -> Maybe (Pretty ColorText) - renderTerm accessorNames name (term, typ) = do - guard (not (Set.member name accessorNames)) - let hqName = HQ.NameOnly name - let rendered - | Typechecker.isEqual (Builtin.Decls.testResultListType mempty) typ = - "test> " <> TermPrinter.prettyBindingWithoutTypeSignature ppe.suffixifiedPPE hqName term - | otherwise = TermPrinter.prettyBinding ppe.suffixifiedPPE hqName term - Just (Pretty.syntaxToColor rendered) - -setPpedToConstructorNames :: DeclNameLookup -> Name -> TypeReferenceId -> PrettyPrintEnvDecl -> PrettyPrintEnvDecl -setPpedToConstructorNames declNameLookup name ref = - set (#unsuffixifiedPPE . #termNames) referentNames - . set (#suffixifiedPPE . #termNames) referentNames - where - constructorNameMap :: Map ConstructorReference Name - constructorNameMap = - Map.fromList - ( name - & expectConstructorNames declNameLookup - & List.zip [0 ..] - & over (mapped . _1) (ConstructorReference (Reference.fromId ref)) - ) - - referentNames :: Referent -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)] - referentNames = \case - Referent.Con conRef _ -> - case Map.lookup conRef constructorNameMap of - Nothing -> [] - Just conName -> let hqConName = HQ'.NameOnly conName in [(hqConName, hqConName)] - Referent.Ref _ -> [] - ------------------------------------------------------------------------------------------------------------------------ -- Parsing and typechecking diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index df44a8d9ea..7f585cb329 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -14,11 +14,9 @@ import Control.Monad.State qualified as State import Data.Foldable qualified as Foldable import Data.List qualified as List import Data.List.Extra (nubOrd) -import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as Nel import Data.Map qualified as Map import Data.Set qualified as Set -import Data.Set.NonEmpty (NESet) import Data.Set.NonEmpty qualified as NESet import Data.Text qualified as Text import Data.Time (UTCTime) @@ -28,7 +26,6 @@ import U.Codebase.Branch.Diff qualified as V2Branch.Diff import U.Codebase.Causal qualified as V2Causal import U.Codebase.HashTags (CausalHash (..)) import U.Codebase.Reflog qualified as Reflog -import U.Codebase.Sqlite.Queries qualified as Queries import Unison.ABT qualified as ABT import Unison.Builtin qualified as Builtin import Unison.Builtin.Terms qualified as Builtin @@ -36,8 +33,8 @@ import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils (getCurrentProjectBranch) import Unison.Cli.MonadUtils qualified as Cli +import Unison.Cli.NameResolutionUtils (resolveHQToLabeledDependencies) import Unison.Cli.NamesUtils qualified as Cli -import Unison.Cli.PrettyPrintUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch (..), Branch0) @@ -59,9 +56,12 @@ import Unison.Codebase.Editor.HandleInput.DebugDefinition qualified as DebugDefi import Unison.Codebase.Editor.HandleInput.DebugFoldRanges qualified as DebugFoldRanges import Unison.Codebase.Editor.HandleInput.DebugSynhashTerm (handleDebugSynhashTerm) import Unison.Codebase.Editor.HandleInput.DeleteBranch (handleDeleteBranch) +import Unison.Codebase.Editor.HandleInput.DeleteNamespace (getEndangeredDependents, handleDeleteNamespace) import Unison.Codebase.Editor.HandleInput.DeleteProject (handleDeleteProject) +import Unison.Codebase.Editor.HandleInput.Dependents (handleDependents) import Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace) -import Unison.Codebase.Editor.HandleInput.FindAndReplace (handleStructuredFindI, handleStructuredFindReplaceI) +import Unison.Codebase.Editor.HandleInput.EditDependents (handleEditDependents) +import Unison.Codebase.Editor.HandleInput.FindAndReplace (handleStructuredFindI, handleStructuredFindReplaceI, handleTextFindI) import Unison.Codebase.Editor.HandleInput.FormatFile qualified as Format import Unison.Codebase.Editor.HandleInput.Global qualified as Global import Unison.Codebase.Editor.HandleInput.InstallLib (handleInstallLib) @@ -86,7 +86,7 @@ import Unison.Codebase.Editor.HandleInput.Reflogs qualified as Reflogs import Unison.Codebase.Editor.HandleInput.ReleaseDraft (handleReleaseDraft) import Unison.Codebase.Editor.HandleInput.Run (handleRun) import Unison.Codebase.Editor.HandleInput.RuntimeUtils qualified as RuntimeUtils -import Unison.Codebase.Editor.HandleInput.ShowDefinition (showDefinitions) +import Unison.Codebase.Editor.HandleInput.ShowDefinition (handleShowDefinition) import Unison.Codebase.Editor.HandleInput.TermResolution (resolveMainRef) import Unison.Codebase.Editor.HandleInput.Tests qualified as Tests import Unison.Codebase.Editor.HandleInput.Todo (handleTodo) @@ -102,6 +102,7 @@ import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo import Unison.Codebase.Editor.Slurp qualified as Slurp import Unison.Codebase.Editor.SlurpResult qualified as SlurpResult import Unison.Codebase.Editor.StructuredArgument qualified as SA +import Unison.Codebase.Execute qualified as Codebase import Unison.Codebase.IntegrityCheck qualified as IntegrityCheck (integrityCheckFullCodebase) import Unison.Codebase.Metadata qualified as Metadata import Unison.Codebase.Path (Path, Path' (..)) @@ -133,8 +134,10 @@ import Unison.Parser.Ann qualified as Ann import Unison.Parsers qualified as Parsers import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE +import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPE hiding (biasTo, empty) import Unison.PrettyPrintEnvDecl qualified as PPED +import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Reference (Reference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) @@ -149,7 +152,6 @@ import Unison.Server.SearchResult (SearchResult) import Unison.Server.SearchResult qualified as SR import Unison.Share.Codeserver qualified as Codeserver import Unison.ShortHash qualified as SH -import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Syntax.HashQualified qualified as HQ (parseTextWith, toText) import Unison.Syntax.Lexer.Unison qualified as L @@ -193,7 +195,7 @@ loop e = do let previewResponse sourceName sr uf = do names <- Cli.currentNames let namesWithDefinitionsFromFile = UF.addNamesFromTypeCheckedUnisonFile uf names - filePPED <- Cli.prettyPrintEnvDeclFromNames namesWithDefinitionsFromFile + let filePPED = PPED.makePPED (PPE.hqNamer 10 namesWithDefinitionsFromFile) (PPE.suffixifyByHash namesWithDefinitionsFromFile) let suffixifiedPPE = PPE.suffixifiedPPE filePPED Cli.respond $ Typechecked (Text.pack sourceName) suffixifiedPPE sr uf in Cli.time "InputPattern" case input of @@ -372,7 +374,7 @@ loop e = do UiI path' -> openUI path' DocToMarkdownI docName -> do names <- Cli.currentNames - pped <- Cli.prettyPrintEnvDeclFromNames names + let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) Cli.Env {codebase, runtime} <- ask docRefs <- Cli.runTransaction do hqLength <- Codebase.hashLength @@ -498,8 +500,8 @@ loop e = do NamesI global query -> do hqLength <- Cli.runTransaction Codebase.hashLength let searchNames names = do - pped <- Cli.prettyPrintEnvDeclFromNames names - let unsuffixifiedPPE = PPED.unsuffixifiedPPE pped + let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) + unsuffixifiedPPE = PPED.unsuffixifiedPPE pped terms = Names.lookupHQTerm Names.IncludeSuffixes query names types = Names.lookupHQType Names.IncludeSuffixes query names terms' :: [(Referent, [HQ'.HashQualified Name])] @@ -572,53 +574,18 @@ loop e = do delete input doutput getTerms getTypes hqs DeleteTarget'Type doutput hqs -> delete input doutput (const (pure Set.empty)) getTypes hqs DeleteTarget'Term doutput hqs -> delete input doutput getTerms (const (pure Set.empty)) hqs - DeleteTarget'Namespace insistence Nothing -> do - hasConfirmed <- confirmedCommand input - if hasConfirmed || insistence == Force - then do - description <- inputDescription input - pp <- Cli.getCurrentProjectPath - _ <- Cli.updateAt description pp (const Branch.empty) - Cli.respond DeletedEverything - else Cli.respond DeleteEverythingConfirmation - DeleteTarget'Namespace insistence (Just p@(parentPath, childName)) -> do - branch <- Cli.expectBranchAtPath (Path.unsplit p) - description <- inputDescription input - let toDelete = - Names.prefix0 - (Path.nameFromSplit' $ first (Path.RelativePath' . Path.Relative) p) - (Branch.toNames (Branch.head branch)) - afterDelete <- do - names <- Cli.currentNames - endangerments <- Cli.runTransaction (getEndangeredDependents toDelete Set.empty names) - case (null endangerments, insistence) of - (True, _) -> pure (Cli.respond Success) - (False, Force) -> do - ppeDecl <- Cli.currentPrettyPrintEnvDecl - pure do - Cli.respond Success - Cli.respondNumbered $ DeletedDespiteDependents ppeDecl endangerments - (False, Try) -> do - ppeDecl <- Cli.currentPrettyPrintEnvDecl - Cli.respondNumbered $ CantDeleteNamespace ppeDecl endangerments - Cli.returnEarlyWithoutOutput - parentPathAbs <- Cli.resolvePath parentPath - -- We have to modify the parent in order to also wipe out the history at the - -- child. - Cli.updateAt description parentPathAbs \parentBranch -> - parentBranch - & Branch.modifyAt (Path.singleton childName) \_ -> Branch.empty - afterDelete + DeleteTarget'Namespace insistence path -> handleDeleteNamespace input insistence path DeleteTarget'ProjectBranch name -> handleDeleteBranch name DeleteTarget'Project name -> handleDeleteProject name DisplayI outputLoc namesToDisplay -> do traverse_ (displayI outputLoc) namesToDisplay ShowDefinitionI outputLoc showDefinitionScope query -> handleShowDefinition outputLoc showDefinitionScope query - EditNamespaceI paths -> handleEditNamespace LatestFileLocation paths + EditNamespaceI paths -> handleEditNamespace (LatestFileLocation AboveFold) paths FindShallowI pathArg -> handleLs pathArg FindI isVerbose fscope ws -> handleFindI isVerbose fscope ws input StructuredFindI _fscope ws -> handleStructuredFindI ws StructuredFindReplaceI ws -> handleStructuredFindReplaceI ws + TextFindI allowLib ws -> handleTextFindI allowLib ws LoadI maybePath -> handleLoad maybePath ClearI -> Cli.respond ClearScreen AddI requestedNames -> do @@ -632,7 +599,9 @@ loop e = do Cli.runTransaction . Codebase.addDefsToCodebase codebase . SlurpResult.filterUnisonFile sr $ uf pp <- Cli.getCurrentProjectPath Cli.stepAt description (pp, doSlurpAdds adds uf) - pped <- Cli.prettyPrintEnvDeclFromNames $ UF.addNamesFromTypeCheckedUnisonFile uf currentNames + let pped = + let names = UF.addNamesFromTypeCheckedUnisonFile uf currentNames + in PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) let suffixifiedPPE = PPED.suffixifiedPPE pped Cli.respond $ SlurpOutput input suffixifiedPPE sr SaveExecuteResultI resultName -> handleAddRun input resultName @@ -653,14 +622,15 @@ loop e = do let sr = Slurp.slurpFile uf vars Slurp.UpdateOp currentNames previewResponse sourceName sr uf TodoI -> handleTodo - TestI testInput -> Tests.handleTest testInput + TestI native testInput -> Tests.handleTest native testInput ExecuteI main args -> handleRun False main args - MakeStandaloneI output main -> doCompile False output main - CompileSchemeI output main -> - doCompile True (Text.unpack output) main + MakeStandaloneI output main -> + doCompile False False output main + CompileSchemeI prof output main -> + doCompile prof True (Text.unpack output) main ExecuteSchemeI main args -> handleRun True main args - IOTestI main -> Tests.handleIOTest main - IOTestAllI -> Tests.handleAllIOTests + IOTestI native main -> Tests.handleIOTest native main + IOTestAllI native -> Tests.handleAllIOTests native -- UpdateBuiltinsI -> do -- stepAt updateBuiltins -- checkTodo @@ -757,24 +727,25 @@ loop e = do Nothing -> do Cli.respond DebugFuzzyOptionsNoResolver DebugFormatI -> do - Cli.Env {writeSource, loadSource} <- ask + env <- ask void $ runMaybeT do (filePath, _) <- MaybeT Cli.getLatestFile pf <- lift Cli.getLatestParsedFile tf <- lift Cli.getLatestTypecheckedFile names <- lift Cli.currentNames let buildPPED uf tf = - Cli.prettyPrintEnvDeclFromNames $ (fromMaybe mempty $ (UF.typecheckedToNames <$> tf) <|> (UF.toNames <$> uf)) `Names.shadowing` names + let names' = (fromMaybe mempty $ (UF.typecheckedToNames <$> tf) <|> (UF.toNames <$> uf)) `Names.shadowing` names + in pure (PPED.makePPED (PPE.hqNamer 10 names') (PPE.suffixifyByHashName names')) let formatWidth = 80 currentPath <- lift $ Cli.getCurrentPath updates <- MaybeT $ Format.formatFile buildPPED formatWidth currentPath pf tf Nothing source <- - liftIO (loadSource (Text.pack filePath)) >>= \case + liftIO (env.loadSource (Text.pack filePath)) >>= \case Cli.InvalidSourceNameError -> lift $ Cli.returnEarly $ Output.InvalidSourceName filePath Cli.LoadError -> lift $ Cli.returnEarly $ Output.SourceLoadFailed filePath Cli.LoadSuccess contents -> pure contents let updatedSource = Format.applyTextReplacements updates source - liftIO $ writeSource (Text.pack filePath) updatedSource + liftIO $ env.writeSource (Text.pack filePath) updatedSource True DebugDumpNamespacesI -> do let seen h = State.gets (Set.member h) set h = State.modify (Set.insert h) @@ -876,6 +847,7 @@ loop e = do UpgradeCommitI -> handleCommitUpgrade LibInstallI remind libdep -> handleInstallLib remind libdep DebugSynhashTermI name -> handleDebugSynhashTerm name + EditDependentsI name -> handleEditDependents name inputDescription :: Input -> Cli Text inputDescription input = @@ -968,8 +940,11 @@ inputDescription input = Update2I -> pure ("update") UndoI {} -> pure "undo" ExecuteI s args -> pure ("execute " <> Text.unwords (HQ.toText s : fmap Text.pack args)) - IOTestI hq -> pure ("io.test " <> HQ.toText hq) - IOTestAllI -> pure "io.test.all" + IOTestI native hq -> pure (cmd <> HQ.toText hq) + where + cmd | native = "io.test.native " | otherwise = "io.test " + IOTestAllI native -> + pure (if native then "io.test.native.all" else "io.test.all") UpdateBuiltinsI -> pure "builtins.update" MergeBuiltinsI Nothing -> pure "builtins.merge" MergeBuiltinsI (Just path) -> ("builtins.merge " <>) <$> p path @@ -978,7 +953,8 @@ inputDescription input = MakeStandaloneI out nm -> pure ("compile " <> Text.pack out <> " " <> HQ.toText nm) ExecuteSchemeI nm args -> pure $ "run.native " <> Text.unwords (HQ.toText nm : fmap Text.pack args) - CompileSchemeI fi nm -> pure ("compile.native " <> HQ.toText nm <> " " <> fi) + CompileSchemeI pr fi nm -> + pure ("compile.native " <> HQ.toText nm <> " " <> fi <> if pr then " profile" else "") CreateAuthorI id name -> pure ("create.author " <> NameSegment.toEscapedText id <> " " <> name) ClearI {} -> pure "clear" DocToMarkdownI name -> pure ("debug.doc-to-markdown " <> Name.toText name) @@ -1014,6 +990,7 @@ inputDescription input = DisplayI {} -> wat DocsI {} -> wat DocsToHtmlI {} -> wat + EditDependentsI {} -> wat FindI {} -> wat FindShallowI {} -> wat HistoryI {} -> wat @@ -1040,6 +1017,7 @@ inputDescription input = ShowDefinitionI {} -> wat StructuredFindI {} -> wat StructuredFindReplaceI {} -> wat + TextFindI {} -> wat ShowRootReflogI {} -> pure "deprecated.root-reflog" ShowGlobalReflogI {} -> pure "reflog.global" ShowProjectReflogI mayProjName -> do @@ -1100,7 +1078,8 @@ handleFindI isVerbose fscope ws input = do 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 + currentNames <- Cli.currentNames + let pped = PPED.makePPED (PPE.hqNamer 10 currentNames) (PPE.suffixifyByHash currentNames) let suffixifiedPPE = PPED.suffixifiedPPE pped results <- searchBranch0 codebase branch0 names if (null results) @@ -1122,7 +1101,8 @@ handleFindI isVerbose fscope ws input = do 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 + currentNames <- Cli.currentNames + let pped = PPED.makePPED (PPE.hqNamer 10 currentNames) (PPE.suffixifyByHash currentNames) let suffixifiedPPE = PPED.suffixifiedPPE pped results <- searchBranch0 codebase branch0 names respondResults codebase suffixifiedPPE (Just p) results @@ -1130,7 +1110,7 @@ handleFindI isVerbose fscope ws input = do Global.forAllProjectBranches \(projAndBranchNames, _ids) branch -> do let branch0 = Branch.head branch let projectRootNames = Names.makeAbsolute . Branch.toNames $ branch0 - pped <- Cli.prettyPrintEnvDeclFromNames projectRootNames + let pped = PPED.makePPED (PPE.hqNamer 10 projectRootNames) (PPE.suffixifyByHash projectRootNames) results <- searchBranch0 codebase branch0 projectRootNames when (not $ null results) do Cli.setNumberedArgs $ fmap (SA.SearchResult Nothing) results @@ -1180,7 +1160,8 @@ handleDependencies hq = do Cli.Env {codebase} <- ask -- todo: add flag to handle transitive efficiently lds <- resolveHQToLabeledDependencies hq - pped <- Cli.currentPrettyPrintEnvDecl + names <- Cli.currentNames + let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) let suffixifiedPPE = PPED.suffixifiedPPE pped when (null lds) do Cli.returnEarly (LabeledReferenceNotFound hq) @@ -1214,114 +1195,17 @@ handleDependencies hq = do Cli.setNumberedArgs . map SA.HashQualified $ types <> terms Cli.respond $ ListDependencies suffixifiedPPE lds types terms -handleDependents :: HQ.HashQualified Name -> Cli () -handleDependents hq = do - -- todo: add flag to handle transitive efficiently - lds <- resolveHQToLabeledDependencies hq - -- Use an unsuffixified PPE here, so we display full names (relative to the current path), - -- rather than the shortest possible unambiguous name. - pped <- Cli.currentPrettyPrintEnvDecl - let fqppe = PPE.unsuffixifiedPPE pped - let ppe = PPE.suffixifiedPPE pped - when (null lds) do - Cli.returnEarly (LabeledReferenceNotFound hq) - - results <- for (toList lds) \ld -> do - -- The full set of dependent references, any number of which may not have names in the current namespace. - dependents <- - let tp = Codebase.dependents Queries.ExcludeOwnComponent - tm = \case - Referent.Ref r -> Codebase.dependents Queries.ExcludeOwnComponent r - Referent.Con (ConstructorReference r _cid) _ct -> - Codebase.dependents Queries.ExcludeOwnComponent r - in Cli.runTransaction (LD.fold tp tm ld) - let -- True is term names, False is type names - results :: [(Bool, HQ.HashQualified Name, Reference)] - results = do - r <- Set.toList dependents - Just (isTerm, hq) <- [(True,) <$> PPE.terms fqppe (Referent.Ref r), (False,) <$> PPE.types fqppe r] - fullName <- [HQ'.toName hq] - guard (not (Name.beginsWithSegment fullName NameSegment.libSegment)) - Just shortName <- pure $ PPE.terms ppe (Referent.Ref r) <|> PPE.types ppe r - pure (isTerm, HQ'.toHQ shortName, r) - pure results - let sort = fmap fst . nubOrdOn snd . Name.sortByText (HQ.toText . fst) - let types = sort [(n, r) | (False, n, r) <- join results] - let terms = sort [(n, r) | (True, n, r) <- join results] - Cli.setNumberedArgs . map SA.HashQualified $ types <> terms - Cli.respond (ListDependents ppe lds types terms) - --- | Handle a @ShowDefinitionI@ input command, i.e. `view` or `edit`. -handleShowDefinition :: OutputLocation -> ShowDefinitionScope -> NonEmpty (HQ.HashQualified Name) -> Cli () -handleShowDefinition outputLoc showDefinitionScope query = do - Cli.Env {codebase} <- ask - hqLength <- Cli.runTransaction Codebase.hashLength - let hasAbsoluteQuery = any (any Name.isAbsolute) query - (names, unbiasedPPED) <- case (hasAbsoluteQuery, showDefinitionScope) of - -- TODO: We should instead print each definition using the names from its project-branch root. - (True, _) -> do - root <- Cli.getCurrentProjectRoot - let root0 = Branch.head root - let names = Names.makeAbsolute $ Branch.toNames root0 - pped <- Cli.prettyPrintEnvDeclFromNames names - pure (names, pped) - (_, ShowDefinitionGlobal) -> do - -- TODO: Maybe rewrite to be properly global - root <- Cli.getCurrentProjectRoot - let root0 = Branch.head root - let names = Names.makeAbsolute $ Branch.toNames root0 - pped <- Cli.prettyPrintEnvDeclFromNames names - pure (names, pped) - (_, ShowDefinitionLocal) -> do - currentNames <- Cli.currentNames - pped <- Cli.prettyPrintEnvDeclFromNames currentNames - pure (currentNames, pped) - let pped = PPED.biasTo (mapMaybe HQ.toName (toList query)) unbiasedPPED - Backend.DefinitionResults terms types misses <- do - let nameSearch = NameSearch.makeNameSearch hqLength names - Cli.runTransaction (Backend.definitionsByName codebase nameSearch includeCycles Names.IncludeSuffixes (toList query)) - showDefinitions outputLoc pped terms types misses - where - -- `view`: don't include cycles; `edit`: include cycles - includeCycles = - case outputLoc of - ConsoleLocation -> Backend.DontIncludeCycles - FileLocation _ -> Backend.IncludeCycles - LatestFileLocation -> Backend.IncludeCycles - --- todo: compare to `getHQTerms` / `getHQTypes`. Is one universally better? -resolveHQToLabeledDependencies :: HQ.HashQualified Name -> Cli (Set LabeledDependency) -resolveHQToLabeledDependencies = \case - HQ.NameOnly n -> do - names <- Cli.currentNames - let terms, types :: Set LabeledDependency - terms = Set.map LD.referent . Name.searchBySuffix n $ Names.terms names - types = Set.map LD.typeRef . Name.searchBySuffix n $ Names.types names - pure $ terms <> types - -- rationale: the hash should be unique enough that the name never helps - HQ.HashQualified _n sh -> resolveHashOnly sh - HQ.HashOnly sh -> resolveHashOnly sh - where - resolveHashOnly sh = do - Cli.Env {codebase} <- ask - (terms, types) <- - Cli.runTransaction do - terms <- Backend.termReferentsByShortHash codebase sh - types <- Backend.typeReferencesByShortHash sh - pure (terms, types) - pure $ Set.map LD.referent terms <> Set.map LD.typeRef types - doDisplay :: OutputLocation -> Names -> Term Symbol () -> Cli () doDisplay outputLoc names tm = do Cli.Env {codebase} <- ask loopState <- State.get - pped <- Cli.prettyPrintEnvDeclFromNames names + let pped = PPED.makePPED (PPE.hqNamer 10 names) (suffixify names) let suffixifiedPPE = PPED.suffixifiedPPE pped (tms, typs) <- maybe mempty UF.indexByReference <$> Cli.getLatestTypecheckedFile let useCache = True evalTerm tm = fmap ErrorUtil.hush . fmap (fmap Term.unannotate) $ - RuntimeUtils.evalUnisonTermE True suffixifiedPPE useCache (Term.amap (const External) tm) + RuntimeUtils.evalUnisonTermE Sandboxed suffixifiedPPE useCache (Term.amap (const External) tm) loadTerm (Reference.DerivedId r) = case Map.lookup r tms of Nothing -> fmap (fmap Term.unannotate) $ Cli.runTransaction (Codebase.getTerm codebase r) Just (_, tm, _) -> pure (Just $ Term.unannotate tm) @@ -1336,12 +1220,18 @@ doDisplay outputLoc names tm = do rendered <- DisplayValues.displayTerm pped loadTerm loadTypeOfTerm' evalTerm loadDecl tm mayFP <- case outputLoc of ConsoleLocation -> pure Nothing - FileLocation path -> Just <$> Directory.canonicalizePath path - LatestFileLocation -> traverse Directory.canonicalizePath $ fmap fst (loopState ^. #latestFile) <|> Just "scratch.u" + FileLocation path _ -> Just <$> Directory.canonicalizePath path + LatestFileLocation _ -> traverse Directory.canonicalizePath $ fmap fst (loopState ^. #latestFile) <|> Just "scratch.u" whenJust mayFP \fp -> do liftIO $ prependFile fp (Text.pack . P.toPlain 80 $ rendered) Cli.respond $ DisplayRendered mayFP rendered where + suffixify = + case outputLoc of + ConsoleLocation -> PPE.suffixifyByHash + FileLocation _ _ -> PPE.suffixifyByHashName + LatestFileLocation _ -> PPE.suffixifyByHashName + prependFile :: FilePath -> Text -> IO () prependFile filePath txt = do exists <- Directory.doesFileExist filePath @@ -1439,20 +1329,21 @@ searchBranchScored names0 score queries = pair qn = (\score -> (Just score, result)) <$> score qn (Name.toText name) -doCompile :: Bool -> String -> HQ.HashQualified Name -> Cli () -doCompile native output main = do +doCompile :: Bool -> Bool -> String -> HQ.HashQualified Name -> Cli () +doCompile profile native output main = do Cli.Env {codebase, runtime, nativeRuntime} <- ask let theRuntime | native = nativeRuntime | otherwise = runtime (ref, ppe) <- resolveMainRef main - let codeLookup = () <$ Codebase.toCodeLookup codebase + let codeLookup = () <$ Codebase.codebaseToCodeLookup codebase outf | native = output | otherwise = output <> ".uc" + copts = Runtime.defaultCompileOpts {Runtime.profile = profile} whenJustM ( liftIO $ - Runtime.compileTo theRuntime codeLookup ppe ref outf + Runtime.compileTo theRuntime copts codeLookup ppe ref outf ) (Cli.returnEarly . EvaluationFailure) @@ -1502,7 +1393,9 @@ checkDeletes typesTermsTuples doutput inputs = do toRel setRef name = R.fromList (fmap (name,) (toList setRef)) let toDelete = fmap (\(_, names, types, terms) -> Names (toRel terms names) (toRel types names)) splitsNames -- make sure endangered is compeletely contained in paths - projectNames <- Branch.toNames <$> Cli.getCurrentProjectRoot0 + currentBranch <- Cli.getCurrentProjectRoot0 + let projectNames = Branch.toNames currentBranch + projectNamesSansLib = Branch.toNames (Branch.deleteLibdeps currentBranch) -- get only once for the entire deletion set let allTermsToDelete :: Set LabeledDependency allTermsToDelete = Set.unions (fmap Names.labeledReferences toDelete) @@ -1510,9 +1403,7 @@ checkDeletes typesTermsTuples doutput inputs = do endangered <- Cli.runTransaction $ traverse - ( \targetToDelete -> - getEndangeredDependents targetToDelete (allTermsToDelete) projectNames - ) + (\targetToDelete -> getEndangeredDependents targetToDelete allTermsToDelete projectNames projectNamesSansLib) toDelete -- If the overall dependency map is not completely empty, abort deletion let endangeredDeletions = List.filter (\m -> not $ null m || Map.foldr (\s b -> null s || b) False m) endangered @@ -1536,58 +1427,10 @@ checkDeletes typesTermsTuples doutput inputs = do DeleteOutput'NoDiff -> do Cli.respond Success else do - ppeDecl <- Cli.prettyPrintEnvDeclFromNames projectNames + let ppeDecl = PPED.makePPED (PPE.hqNamer 10 projectNames) (PPE.suffixifyByHash projectNames) let combineRefs = List.foldl (Map.unionWith NESet.union) Map.empty endangeredDeletions Cli.respondNumbered (CantDeleteDefinitions ppeDecl combineRefs) --- | Goal: When deleting, we might be removing the last name of a given definition (i.e. the --- definition is going "extinct"). In this case we may wish to take some action or warn the --- user about these "endangered" definitions which would now contain unnamed references. --- The argument `otherDesiredDeletions` is included in this function because the user might want to --- delete a term and all its dependencies in one command, so we give this function access to --- the full set of entities that the user wishes to delete. -getEndangeredDependents :: - -- | Prospective target for deletion - Names -> - -- | All entities we want to delete (including the target) - Set LabeledDependency -> - -- | Names from the current branch - Names -> - -- | map from references going extinct to the set of endangered dependents - Sqlite.Transaction (Map LabeledDependency (NESet LabeledDependency)) -getEndangeredDependents targetToDelete otherDesiredDeletions rootNames = do - -- names of terms left over after target deletion - let remainingNames :: Names - remainingNames = rootNames `Names.difference` targetToDelete - -- target refs for deletion - let refsToDelete :: Set LabeledDependency - refsToDelete = Names.labeledReferences targetToDelete - -- refs left over after deleting target - let remainingRefs :: Set LabeledDependency - remainingRefs = Names.labeledReferences remainingNames - -- remove the other targets for deletion from the remaining terms - let remainingRefsWithoutOtherTargets :: Set LabeledDependency - remainingRefsWithoutOtherTargets = Set.difference remainingRefs otherDesiredDeletions - -- deleting and not left over - let extinct :: Set LabeledDependency - extinct = refsToDelete `Set.difference` remainingRefs - let accumulateDependents :: LabeledDependency -> Sqlite.Transaction (Map LabeledDependency (Set LabeledDependency)) - accumulateDependents ld = - let ref = LD.fold id Referent.toReference ld - in Map.singleton ld . Set.map LD.termRef <$> Codebase.dependents Queries.ExcludeOwnComponent ref - -- All dependents of extinct, including terms which might themselves be in the process of being deleted. - allDependentsOfExtinct :: Map LabeledDependency (Set LabeledDependency) <- - Map.unionsWith (<>) <$> for (Set.toList extinct) accumulateDependents - - -- Filtered to only include dependencies which are not being deleted, but depend one which - -- is going extinct. - let extinctToEndangered :: Map LabeledDependency (NESet LabeledDependency) - extinctToEndangered = - allDependentsOfExtinct & Map.mapMaybe \endangeredDeps -> - let remainingEndangered = endangeredDeps `Set.intersection` remainingRefsWithoutOtherTargets - in NESet.nonEmptySet remainingEndangered - pure extinctToEndangered - displayI :: OutputLocation -> HQ.HashQualified Name -> @@ -1600,11 +1443,11 @@ displayI outputLoc hq = do root <- Cli.getCurrentProjectRoot let root0 = Branch.head root let names = Names.makeAbsolute $ Branch.toNames root0 - pped <- Cli.prettyPrintEnvDeclFromNames names + let pped = PPED.makePPED (PPE.hqNamer 10 names) (suffixify names) pure (names, pped) else do names <- Cli.currentNames - pped <- Cli.prettyPrintEnvDeclFromNames names + let pped = PPED.makePPED (PPE.hqNamer 10 names) (suffixify names) pure (names, pped) let suffixifiedPPE = PPE.suffixifiedPPE pped let bias = maybeToList $ HQ.toName hq @@ -1619,17 +1462,24 @@ displayI outputLoc hq = do then SearchTermsNotFound [hq] else TermAmbiguous suffixifiedPPE hq results let tm = Term.fromReferent External ref - tm <- RuntimeUtils.evalUnisonTerm True (PPE.biasTo bias $ suffixifiedPPE) True tm + tm <- RuntimeUtils.evalUnisonTerm Sandboxed (PPE.biasTo bias $ suffixifiedPPE) True tm doDisplay outputLoc names (Term.unannotate tm) Just (toDisplay, unisonFile) -> do let namesWithDefinitionsFromFile = UF.addNamesFromTypeCheckedUnisonFile unisonFile names - filePPED <- Cli.prettyPrintEnvDeclFromNames namesWithDefinitionsFromFile + let filePPED = PPED.makePPED (PPE.hqNamer 10 namesWithDefinitionsFromFile) (suffixify namesWithDefinitionsFromFile) + let suffixifiedFilePPE = PPE.biasTo bias $ PPE.suffixifiedPPE filePPED (_, watches) <- evalUnisonFile Sandboxed suffixifiedFilePPE unisonFile [] (_, _, _, _, tm, _) <- Map.lookup toDisplay watches & onNothing (error $ "Evaluation dropped a watch expression: " <> Text.unpack (HQ.toText hq)) let ns = UF.addNamesFromTypeCheckedUnisonFile unisonFile names doDisplay outputLoc ns tm + where + suffixify = + case outputLoc of + ConsoleLocation -> PPE.suffixifyByHash + FileLocation _ _ -> PPE.suffixifyByHashName + LatestFileLocation _ -> PPE.suffixifyByHashName docsI :: Name -> Cli () docsI src = do @@ -1672,13 +1522,15 @@ parseType input src = do Parser.ParsingEnv { uniqueNames = mempty, uniqueTypeGuid = \_ -> pure Nothing, - names + names, + maybeNamespace = Nothing, + localNamespacePrefixedTypesAndConstructors = mempty } typ <- Parsers.parseType (Text.unpack (fst lexed)) parsingEnv & onLeftM \err -> Cli.returnEarly (TypeParseError src err) - Type.bindNames Name.unsafeParseVar mempty names (Type.generalizeLowercase mempty typ) & onLeft \errs -> + Type.bindNames Name.unsafeParseVar Name.toVar Set.empty names (Type.generalizeLowercase mempty typ) & onLeft \errs -> Cli.returnEarly (ParseResolutionFailures src (toList errs)) -- Adds a watch expression of the given name to the file, if diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs index ef96ecb983..bcfc05f2db 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/AddRun.hs @@ -12,7 +12,6 @@ import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.NamesUtils qualified as Cli -import Unison.Cli.PrettyPrintUtils qualified as Cli import Unison.Codebase qualified as Codebase import Unison.Codebase.Editor.HandleInput.Update (doSlurpAdds) import Unison.Codebase.Editor.Input (Input) @@ -24,7 +23,9 @@ import Unison.CommandLine.InputPatterns qualified as InputPatterns import Unison.Name (Name) import Unison.Parser.Ann (Ann (External)) import Unison.Prelude +import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPE +import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Symbol (Symbol) import Unison.Syntax.Name qualified as Name import Unison.UnisonFile (TypecheckedUnisonFile) @@ -44,7 +45,7 @@ handleAddRun input resultName = do pp <- Cli.getCurrentProjectPath Cli.stepAt description (pp, doSlurpAdds adds uf) let namesWithDefinitionsFromFile = UF.addNamesFromTypeCheckedUnisonFile uf currentNames - pped <- Cli.prettyPrintEnvDeclFromNames namesWithDefinitionsFromFile + let pped = PPED.makePPED (PPE.hqNamer 10 namesWithDefinitionsFromFile) (PPE.suffixifyByHash namesWithDefinitionsFromFile) let suffixifiedPPE = PPE.suffixifiedPPE pped Cli.respond $ SlurpOutput input suffixifiedPPE sr diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugSynhashTerm.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugSynhashTerm.hs index 2e4144c06d..42944c2dac 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugSynhashTerm.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugSynhashTerm.hs @@ -12,7 +12,6 @@ import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.Pretty (prettyBase32Hex, prettyHash) -import Unison.Cli.PrettyPrintUtils qualified as Cli import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.Editor.Output (Output (..)) @@ -22,7 +21,9 @@ import Unison.Merge.Synhash (hashBuiltinTermTokens, hashDerivedTermTokens) import Unison.Name (Name) import Unison.Names qualified as Names import Unison.Prelude +import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) +import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Reference qualified as Reference import Unison.Syntax.Name qualified as Name import Unison.Util.Pretty (ColorText, Pretty) @@ -32,7 +33,7 @@ handleDebugSynhashTerm :: Name -> Cli () handleDebugSynhashTerm name = do namespace <- Cli.getCurrentBranch0 let names = Branch.toNames namespace - pped <- Cli.prettyPrintEnvDeclFromNames names + let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) for_ (Names.refTermsNamed names name) \ref -> do maybeTokens <- diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteNamespace.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteNamespace.hs new file mode 100644 index 0000000000..14281adc33 --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteNamespace.hs @@ -0,0 +1,134 @@ +module Unison.Codebase.Editor.HandleInput.DeleteNamespace + ( handleDeleteNamespace, + getEndangeredDependents, + ) +where + +import Control.Lens hiding (from) +import Control.Lens qualified as Lens +import Control.Monad.State qualified as State +import Data.Map qualified as Map +import Data.Set qualified as Set +import Data.Set.NonEmpty (NESet) +import Data.Set.NonEmpty qualified as NESet +import U.Codebase.Sqlite.Queries qualified as Queries +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.MonadUtils qualified as Cli +import Unison.Codebase qualified as Codebase +import Unison.Codebase.Branch qualified as Branch +import Unison.Codebase.Branch.Names qualified as Branch +import Unison.Codebase.Editor.Input +import Unison.Codebase.Editor.Output +import Unison.Codebase.Path (Path) +import Unison.Codebase.Path qualified as Path +import Unison.Codebase.ProjectPath qualified as ProjectPath +import Unison.LabeledDependency (LabeledDependency) +import Unison.LabeledDependency qualified as LD +import Unison.NameSegment qualified as NameSegment +import Unison.Names (Names) +import Unison.Names qualified as Names +import Unison.Prelude +import Unison.PrettyPrintEnv.Names qualified as PPE +import Unison.PrettyPrintEnvDecl.Names qualified as PPED +import Unison.Referent qualified as Referent +import Unison.Sqlite qualified as Sqlite + +handleDeleteNamespace :: Input -> Insistence -> Maybe (Path, NameSegment.NameSegment) -> Cli () +handleDeleteNamespace input insistence = \case + Nothing -> do + loopState <- State.get + if loopState.lastInput == Just input || insistence == Force + then do + pp <- Cli.getCurrentProjectPath + _ <- Cli.updateAt (commandName <> " .") pp (const Branch.empty) + Cli.respond DeletedEverything + else Cli.respond DeleteEverythingConfirmation + Just p@(parentPath, childName) -> do + branch <- Cli.expectBranchAtPath (Path.unsplit p) + let toDelete = + Names.prefix0 + (Path.nameFromSplit' $ first (Path.RelativePath' . Path.Relative) p) + (Branch.toNames (Branch.head branch)) + afterDelete <- do + currentBranch <- Cli.getCurrentProjectRoot0 + let names = Branch.toNames currentBranch + namesSansLib = Branch.toNames (Branch.deleteLibdeps currentBranch) + endangerments <- Cli.runTransaction (getEndangeredDependents toDelete Set.empty names namesSansLib) + case (null endangerments, insistence) of + (True, _) -> pure (Cli.respond Success) + (False, Force) -> do + let ppeDecl = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) + pure do + Cli.respond Success + Cli.respondNumbered $ DeletedDespiteDependents ppeDecl endangerments + (False, Try) -> do + let ppeDecl = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) + Cli.respondNumbered $ CantDeleteNamespace ppeDecl endangerments + Cli.returnEarlyWithoutOutput + parentPathAbs <- Cli.resolvePath parentPath + let description = commandName <> " " <> into @Text (parentPathAbs & ProjectPath.absPath_ %~ (`Lens.snoc` childName)) + -- We have to modify the parent in order to also wipe out the history at the + -- child. + Cli.updateAt description parentPathAbs (Branch.modifyAt (Path.singleton childName) \_ -> Branch.empty) + afterDelete + where + commandName :: Text + commandName = + case insistence of + Try -> "delete.namespace" + Force -> "delete.namespace.force" + +-- How I might do it (is this any better than the current algorithm?) +-- +-- 1. Get all direct dependents of the deleted things in the current namespace. +-- 2. For each direct dependent, check a Names built from the deleted namespace – is it there? If not it's the last +-- name. + +-- | Goal: When deleting, we might be removing the last name of a given definition (i.e. the +-- definition is going "extinct"). In this case we may wish to take some action or warn the +-- user about these "endangered" definitions which would now contain unnamed references. +-- The argument `otherDesiredDeletions` is included in this function because the user might want to +-- delete a term and all its dependencies in one command, so we give this function access to +-- the full set of entities that the user wishes to delete. +getEndangeredDependents :: + -- | Prospective target for deletion + Names -> + -- | All entities we want to delete (including the target) + Set LabeledDependency -> + -- | Names from the current branch + Names -> + -- | Names from the current branch, sans `lib` + Names -> + -- | map from references going extinct to the set of endangered dependents + Sqlite.Transaction (Map LabeledDependency (NESet LabeledDependency)) +getEndangeredDependents targetToDelete otherDesiredDeletions rootNames rootNamesSansLib = do + -- deleting and not left over + let extinct :: Set LabeledDependency + extinct = Names.labeledReferences targetToDelete `Set.difference` refsAfterDeletingTarget rootNames + + let accumulateDependents :: LabeledDependency -> Sqlite.Transaction (Map LabeledDependency (Set LabeledDependency)) + accumulateDependents ld = + let ref = LD.fold id Referent.toReference ld + in Map.singleton ld . Set.map LD.termRef <$> Codebase.dependents Queries.ExcludeOwnComponent ref + + -- All dependents of extinct, including terms which might themselves be in the process of being deleted. + allDependentsOfExtinct :: Map LabeledDependency (Set LabeledDependency) <- + Map.unionsWith (<>) <$> for (Set.toList extinct) accumulateDependents + + -- Of all the dependents of things going extinct, we filter down to only those that are not themselves being deleted + -- too (per `otherDesiredDeletion`), and are also somewhere outside `lib`. This allows us to proceed with deleting + -- an entire dependency out of `lib` even if for some reason it contains the only source of names for some other + -- dependency. + let extinctToEndangered :: Map LabeledDependency (NESet LabeledDependency) + extinctToEndangered = + Map.mapMaybe + ( NESet.nonEmptySet + . Set.intersection (Set.difference (refsAfterDeletingTarget rootNamesSansLib) otherDesiredDeletions) + ) + allDependentsOfExtinct + pure extinctToEndangered + where + refsAfterDeletingTarget :: Names -> Set LabeledDependency + refsAfterDeletingTarget names = + Names.labeledReferences (names `Names.difference` targetToDelete) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Dependents.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Dependents.hs new file mode 100644 index 0000000000..46e279c0a8 --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Dependents.hs @@ -0,0 +1,68 @@ +module Unison.Codebase.Editor.HandleInput.Dependents + ( handleDependents, + ) +where + +import Data.Set qualified as Set +import U.Codebase.Sqlite.Queries qualified as Queries +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.NameResolutionUtils (resolveHQToLabeledDependencies) +import Unison.Cli.NamesUtils qualified as Cli +import Unison.Codebase qualified as Codebase +import Unison.Codebase.Editor.Output +import Unison.Codebase.Editor.StructuredArgument qualified as SA +import Unison.ConstructorReference (GConstructorReference (..)) +import Unison.HashQualified qualified as HQ +import Unison.HashQualifiedPrime qualified as HQ' +import Unison.LabeledDependency qualified as LD +import Unison.Name (Name) +import Unison.Name qualified as Name +import Unison.NameSegment qualified as NameSegment +import Unison.Prelude +import Unison.PrettyPrintEnv qualified as PPE +import Unison.PrettyPrintEnv.Names qualified as PPE +import Unison.PrettyPrintEnvDecl qualified as PPE hiding (biasTo, empty) +import Unison.PrettyPrintEnvDecl.Names qualified as PPED +import Unison.Reference (Reference) +import Unison.Referent qualified as Referent +import Unison.Syntax.HashQualified qualified as HQ (toText) +import Unison.Util.List (nubOrdOn) + +handleDependents :: HQ.HashQualified Name -> Cli () +handleDependents hq = do + -- todo: add flag to handle transitive efficiently + lds <- resolveHQToLabeledDependencies hq + -- Use an unsuffixified PPE here, so we display full names (relative to the current path), + -- rather than the shortest possible unambiguous name. + names <- Cli.currentNames + let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) + let fqppe = PPE.unsuffixifiedPPE pped + let ppe = PPE.suffixifiedPPE pped + when (null lds) do + Cli.returnEarly (LabeledReferenceNotFound hq) + + results <- for (toList lds) \ld -> do + -- The full set of dependent references, any number of which may not have names in the current namespace. + dependents <- + let tp = Codebase.dependents Queries.ExcludeOwnComponent + tm = \case + Referent.Ref r -> Codebase.dependents Queries.ExcludeOwnComponent r + Referent.Con (ConstructorReference r _cid) _ct -> + Codebase.dependents Queries.ExcludeOwnComponent r + in Cli.runTransaction (LD.fold tp tm ld) + let -- True is term names, False is type names + results :: [(Bool, HQ.HashQualified Name, Reference)] + results = do + r <- Set.toList dependents + Just (isTerm, hq) <- [(True,) <$> PPE.terms fqppe (Referent.Ref r), (False,) <$> PPE.types fqppe r] + fullName <- [HQ'.toName hq] + guard (not (Name.beginsWithSegment fullName NameSegment.libSegment)) + Just shortName <- pure $ PPE.terms ppe (Referent.Ref r) <|> PPE.types ppe r + pure (isTerm, HQ'.toHQ shortName, r) + pure results + let sort = fmap fst . nubOrdOn snd . Name.sortByText (HQ.toText . fst) + let types = sort [(n, r) | (False, n, r) <- join results] + let terms = sort [(n, r) | (True, n, r) <- join results] + Cli.setNumberedArgs . map SA.HashQualified $ types <> terms + Cli.respond (ListDependents ppe lds types terms) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditDependents.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditDependents.hs new file mode 100644 index 0000000000..b2124c7628 --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditDependents.hs @@ -0,0 +1,105 @@ +module Unison.Codebase.Editor.HandleInput.EditDependents + ( handleEditDependents, + ) +where + +import Control.Monad.Reader (ask) +import Data.Bifoldable (bifold) +import Data.Set qualified as Set +import U.Codebase.Sqlite.Operations qualified as Operations +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.MonadUtils qualified as Cli +import Unison.Cli.NameResolutionUtils (resolveHQName) +import Unison.Codebase.Branch qualified as Branch +import Unison.Codebase.Branch.Names qualified as Branch +import Unison.Codebase.Editor.HandleInput.EditNamespace (getNamesForEdit) +import Unison.Codebase.Editor.HandleInput.ShowDefinition (showDefinitions) +import Unison.Codebase.Editor.Input (OutputLocation (..), RelativeToFold (..)) +import Unison.Codebase.Editor.Output qualified as Output +import Unison.ConstructorReference qualified as ConstructorReference +import Unison.HashQualified qualified as HQ +import Unison.Name (Name) +import Unison.Names (Names (..)) +import Unison.Prelude +import Unison.PrettyPrintEnv.Names qualified as PPE +import Unison.PrettyPrintEnvDecl.Names qualified as PPED +import Unison.Reference (TermReference, TypeReference) +import Unison.Reference qualified as Reference +import Unison.Referent qualified as Referent +import Unison.Util.Defns (Defns (..), DefnsF) +import Unison.Util.Defns qualified as Defns +import Unison.Util.Relation qualified as Relation + +handleEditDependents :: HQ.HashQualified Name -> Cli () +handleEditDependents name = do + -- Get all of the referents and type references this name refers to + refs0 <- resolveHQName name + + -- Since we don't track constructor dependents precisely, convert to just the term and type references + let refs :: DefnsF Set TermReference TypeReference + refs = + let f = \case + Referent.Con ref _ -> Defns.fromTypes (Set.singleton (ref ^. ConstructorReference.reference_)) + Referent.Ref ref -> Defns.fromTerms (Set.singleton ref) + in Defns Set.empty refs0.types <> foldMap f refs0.terms + + (ppe, types, terms) <- + Cli.withRespondRegion \respondRegion -> do + respondRegion (Output.Literal "Loading branch...") + + -- Load the current project namespace and throw away the libdeps + branch <- Cli.getCurrentBranch0 + let ppe = + let names = Branch.toNames branch + in PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHashName names) + + -- Throw away the libdeps + let branchWithoutLibdeps = Branch.deleteLibdeps branch + + -- Identify the local dependents of the input name + respondRegion (Output.Literal "Identifying dependents...") + dependents <- + Cli.runTransaction do + Operations.transitiveDependentsWithinScope + (Branch.deepTermReferenceIds branchWithoutLibdeps <> Branch.deepTypeReferenceIds branchWithoutLibdeps) + (bifold refs) + + let refsAndDependents = + Defns + { terms = + Set.unions + [ Set.mapMonotonic Referent.fromTermReference refs.terms, + Set.mapMonotonic Referent.fromTermReferenceId dependents.terms + ], + types = + Set.unions + [ refs.types, + Set.mapMonotonic Reference.fromId dependents.types + ] + } + + respondRegion (Output.Literal "Loading dependents...") + env <- ask + (types, terms) <- + Cli.runTransaction + ( getNamesForEdit + env.codebase + ppe + Names + { terms = + branchWithoutLibdeps + & Branch.deepTerms + & Relation.restrictDom refsAndDependents.terms + & Relation.swap, + types = + branchWithoutLibdeps + & Branch.deepTypes + & Relation.restrictDom refsAndDependents.types + & Relation.swap + } + ) + pure (ppe, types, terms) + + let misses = [] + showDefinitions (LatestFileLocation WithinFold) ppe terms types misses diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditNamespace.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditNamespace.hs index 6f75ba3a93..f7dec844cf 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditNamespace.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditNamespace.hs @@ -1,4 +1,8 @@ -module Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace) where +module Unison.Codebase.Editor.HandleInput.EditNamespace + ( handleEditNamespace, + getNamesForEdit, + ) +where import Control.Monad.Reader import Data.Foldable qualified as Foldable @@ -9,30 +13,43 @@ import U.Codebase.Reference (Reference' (..)) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli -import Unison.Cli.PrettyPrintUtils qualified as NamesUtils +import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch +import Unison.Codebase.Editor.DisplayObject (DisplayObject) import Unison.Codebase.Editor.DisplayObject qualified as DisplayObject import Unison.Codebase.Editor.HandleInput.ShowDefinition (showDefinitions) import Unison.Codebase.Editor.Input (OutputLocation (..)) import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path +import Unison.DataDeclaration (Decl) import Unison.HashQualified qualified as HQ import Unison.Name (Name) +import Unison.Names (Names) import Unison.Names qualified as Names +import Unison.Parser.Ann (Ann) import Unison.Prelude +import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) +import Unison.PrettyPrintEnvDecl.Names qualified as PPED +import Unison.Reference (TermReference, TypeReference) import Unison.Referent qualified as Referent import Unison.Server.Backend qualified as Backend +import Unison.Sqlite qualified as Sqlite +import Unison.Symbol (Symbol) import Unison.Syntax.DeclPrinter qualified as DeclPrinter +import Unison.Term (Term) +import Unison.Type (Type) import Unison.Util.Monoid (foldMapM) +import Unison.Util.Set qualified as Set handleEditNamespace :: OutputLocation -> [Path] -> Cli () handleEditNamespace outputLoc paths0 = do Cli.Env {codebase} <- ask currentBranch <- Cli.getCurrentBranch0 - ppe <- NamesUtils.currentPrettyPrintEnvDecl + let currentNames = Branch.toNames currentBranch + let ppe = PPED.makePPED (PPE.hqNamer 10 currentNames) (PPE.suffixifyByHashName currentNames) -- Adjust the requested list of paths slightly: if it's missing (i.e. `edit.namespace` without arguments), then behave -- as if the empty path (which there is no syntax for, heh) was supplied. @@ -47,53 +64,67 @@ handleEditNamespace outputLoc paths0 = do List.nubOrd paths & foldMap \path -> let branch = (if path == Path.empty then Branch.withoutLib else id) (Branch.getAt0 path currentBranch) names = Branch.toNames branch - in -- PPED.makePPED (PPE.hqNamer hashLen ns) (PPE.suffixifyByHash ns) - - case Path.toName path of + in case Path.toName path of Nothing -> names Just pathPrefix -> Names.prefix0 pathPrefix names + (types, terms) <- Cli.runTransaction (getNamesForEdit codebase ppe allNamesToEdit) + let misses = [] + showDefinitions outputLoc ppe terms types misses + +-- | Get names "for edit": gets types and terms out the codebase as display objects, but is careful not to get an +-- auto-generated record accessor term like `Foo.bar.set` if it's also getting the corresponding type `Foo`. This is +-- because these name are "for edit", i.e. going into a scratch file, where parsing the record type will generate +-- its accessors. +getNamesForEdit :: + Codebase m Symbol Ann -> + PrettyPrintEnvDecl -> + Names -> + Sqlite.Transaction + ( Map TypeReference (DisplayObject () (Decl Symbol Ann)), + Map TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)) + ) +getNamesForEdit codebase ppe allNamesToEdit = do let termRefs = Names.termReferences allNamesToEdit let typeRefs = Names.typeReferences allNamesToEdit - (types, terms) <- - Cli.runTransaction do - (types, accessorNames) <- - Foldable.foldlM - ( \(types, accessorNames) ref -> - case ref of - ReferenceBuiltin _ -> do - let !types1 = Map.insert ref (DisplayObject.BuiltinObject ()) types - pure (types1, accessorNames) - ReferenceDerived refId -> do - decl <- Codebase.unsafeGetTypeDeclaration codebase refId - let !types1 = Map.insert ref (DisplayObject.UserObject decl) types - let !accessorNames1 = - accessorNames <> case decl of - Left _effectDecl -> Set.empty - Right dataDecl -> - let declAccessorNames :: Name -> Set Name - declAccessorNames declName = - case DeclPrinter.getFieldAndAccessorNames - ppe.unsuffixifiedPPE - ref - (HQ.fromName declName) - dataDecl of - Nothing -> Set.empty - Just (_fieldNames, theAccessorNames) -> Set.fromList theAccessorNames - in foldMap declAccessorNames (Names.namesForReference allNamesToEdit ref) - pure (types1, accessorNames1) - ) - (Map.empty, Set.empty) - typeRefs - terms <- - termRefs & foldMapM \ref -> - let isRecordAccessor = - not (Set.disjoint (Names.namesForReferent allNamesToEdit (Referent.fromTermReference ref)) accessorNames) - in if isRecordAccessor - then pure Map.empty - else Map.singleton ref <$> Backend.displayTerm codebase ref - pure (types, terms) + (types, accessorNames) <- + Foldable.foldlM + ( \(types, accessorNames) ref -> + case ref of + ReferenceBuiltin _ -> do + let !types1 = Map.insert ref (DisplayObject.BuiltinObject ()) types + pure (types1, accessorNames) + ReferenceDerived refId -> do + decl <- Codebase.unsafeGetTypeDeclaration codebase refId + let !types1 = Map.insert ref (DisplayObject.UserObject decl) types + let !accessorNames1 = + accessorNames <> case decl of + Left _effectDecl -> Set.empty + Right dataDecl -> + let declAccessorNames :: Name -> Set Name + declAccessorNames declName = + case DeclPrinter.getFieldAndAccessorNames + ppe.unsuffixifiedPPE + ref + (HQ.fromName declName) + dataDecl of + Nothing -> Set.empty + Just (_fieldNames, theAccessorNames) -> Set.fromList theAccessorNames + in foldMap declAccessorNames (Names.namesForReference allNamesToEdit ref) + pure (types1, accessorNames1) + ) + (Map.empty, Set.empty) + typeRefs - let misses = [] - showDefinitions outputLoc ppe terms types misses + terms <- + termRefs & foldMapM \ref -> + let isRecordAccessor = + Set.intersects + (Names.namesForReferent allNamesToEdit (Referent.fromTermReference ref)) + accessorNames + in if isRecordAccessor + then pure Map.empty + else Map.singleton ref <$> Backend.displayTerm codebase ref + + pure (types, terms) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs index 6a46205240..b18b360db2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs @@ -1,6 +1,7 @@ module Unison.Codebase.Editor.HandleInput.FindAndReplace ( handleStructuredFindReplaceI, handleStructuredFindI, + handleTextFindI, ) where @@ -28,6 +29,7 @@ import Unison.Names (Names) import Unison.Names qualified as Names import Unison.NamesWithHistory qualified as Names import Unison.Parser.Ann (Ann (..)) +import Unison.Pattern qualified as Pattern import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE import Unison.PrettyPrintEnv.Names qualified as PPE @@ -50,7 +52,7 @@ import Unison.Var qualified as Var handleStructuredFindReplaceI :: HQ.HashQualified Name -> Cli () handleStructuredFindReplaceI rule = do - Cli.Env {writeSource} <- ask + env <- ask uf0 <- Cli.expectLatestParsedFile let (prepare, uf, finish) = UF.prepareRewrite uf0 (ppe, _ns, rules) <- lookupRewrite InvalidStructuredFindReplace prepare rule @@ -65,7 +67,7 @@ handleStructuredFindReplaceI rule = do #latestTypecheckedFile .= Just (Left . snd $ uf') let msg = "| Rewrote using: " let rendered = Text.pack . P.toPlain 80 $ renderRewrittenFile ppe msg uf' - liftIO $ writeSource (Text.pack dest) rendered + liftIO $ env.writeSource (Text.pack dest) rendered True Cli.respond $ OutputRewrittenFile dest vs handleStructuredFindI :: HQ.HashQualified Name -> Cli () @@ -91,6 +93,48 @@ handleStructuredFindI rule = do Cli.setNumberedArgs $ map SA.HashQualified results Cli.respond (ListStructuredFind results) +handleTextFindI :: Bool -> [String] -> Cli () +handleTextFindI allowLib tokens = do + Cli.Env {codebase} <- ask + currentBranch <- Cli.getCurrentBranch0 + hqLength <- Cli.runTransaction Codebase.hashLength + let names = Branch.toNames currentBranch + let ppe = PPED.makePPED (PPE.hqNamer hqLength names) (PPE.suffixifyByHash names) + let fqppe = PPED.unsuffixifiedPPE ppe + results :: [(HQ.HashQualified Name, Referent)] <- pure $ do + r <- Set.toList (Relation.ran $ Names.terms names) + Just hq <- [PPE.terms fqppe r] + fullName <- [HQ'.toName hq] + guard (allowLib || not (Name.beginsWithSegment fullName NameSegment.libSegment)) + Referent.Ref _ <- pure r + Just shortName <- [PPE.terms (PPED.suffixifiedPPE ppe) r] + pure (HQ'.toHQ shortName, r) + let ok (hq, Referent.Ref (Reference.DerivedId r)) = do + oe <- Cli.runTransaction (Codebase.getTerm codebase r) + pure $ (hq, maybe False containsTokens oe) + ok (hq, _) = pure (hq, False) + results0 <- traverse ok results + let results = Alphabetical.sortAlphabetically [hq | (hq, True) <- results0] + Cli.setNumberedArgs $ map SA.HashQualified results + Cli.respond (ListTextFind allowLib results) + where + tokensTxt = Text.pack <$> tokens + containsTokens tm = + hasAll . join $ ABT.find txts tm + where + hasAll txts = all (\tok -> any (\haystack -> Text.isInfixOf tok haystack) txts) tokensTxt + txts (Term.Text' haystack) = ABT.Found [haystack] + txts (Term.Nat' haystack) = ABT.Found [Text.pack (show haystack)] + txts (Term.Int' haystack) = ABT.Found [Text.pack (show haystack)] + txts (Term.Float' haystack) = ABT.Found [Text.pack (show haystack)] + txts (Term.Char' haystack) = ABT.Found [Text.pack [haystack]] + txts (Term.Match' _ cases) = ABT.Found r + where + r = join $ Pattern.foldMap' txtPattern . Term.matchPattern <$> cases + txts _ = ABT.Continue + txtPattern (Pattern.Text _ txt) = [txt] + txtPattern _ = [] + lookupRewrite :: (HQ.HashQualified Name -> Output) -> ([Symbol] -> Term Symbol Ann -> Term Symbol Ann) -> diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs index ce5e1aa993..350ae30b09 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs @@ -10,32 +10,38 @@ import Control.Lens ((.=)) import Control.Monad.Reader (ask) import Control.Monad.State.Strict qualified as State import Data.Map.Strict qualified as Map +import Data.Set qualified as Set import Data.Text qualified as Text import System.Environment (withArgs) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.NamesUtils qualified as Cli -import Unison.Cli.PrettyPrintUtils qualified as Cli import Unison.Cli.TypeCheck (computeTypecheckingEnvironment) import Unison.Cli.UniqueTypeGuidLookup qualified as Cli import Unison.Codebase qualified as Codebase +import Unison.Codebase.Editor.HandleInput.RuntimeUtils (EvalMode (..)) import Unison.Codebase.Editor.HandleInput.RuntimeUtils qualified as RuntimeUtils import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Editor.Slurp qualified as Slurp +import Unison.Codebase.Execute qualified as Codebase import Unison.Codebase.Runtime qualified as Runtime import Unison.FileParsers qualified as FileParsers import Unison.Names (Names) +import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) import Unison.Parser.Ann qualified as Ann import Unison.Parsers qualified as Parsers import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE +import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPED +import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Reference qualified as Reference import Unison.Result qualified as Result import Unison.Symbol (Symbol) +import Unison.Syntax.Name qualified as Name import Unison.Syntax.Parser qualified as Parser import Unison.Term (Term) import Unison.Term qualified as Term @@ -43,6 +49,7 @@ import Unison.UnisonFile (TypecheckedUnisonFile) import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Names qualified as UF import Unison.Util.Timing qualified as Timing +import Unison.Var qualified as Var import Unison.WatchKind qualified as WK handleLoad :: Maybe FilePath -> Cli () @@ -64,7 +71,7 @@ loadUnisonFile sourceName text = do unisonFile <- withFile currentNames sourceName text let sr = Slurp.slurpFile unisonFile mempty Slurp.CheckOp currentNames let names = UF.addNamesFromTypeCheckedUnisonFile unisonFile currentNames - pped <- Cli.prettyPrintEnvDeclFromNames names + let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) let ppe = PPE.suffixifiedPPE pped Cli.respond $ Output.Typechecked sourceName ppe sr unisonFile @@ -94,7 +101,9 @@ loadUnisonFile sourceName text = do Parser.ParsingEnv { uniqueNames = uniqueName, uniqueTypeGuid = Cli.loadUniqueTypeGuid pp, - names + names, + maybeNamespace = Nothing, + localNamespacePrefixedTypesAndConstructors = mempty } unisonFile <- Cli.runTransaction (Parsers.parseFile (Text.unpack sourceName) (Text.unpack text) parsingEnv) @@ -106,8 +115,29 @@ loadUnisonFile sourceName text = do computeTypecheckingEnvironment (FileParsers.ShouldUseTndr'Yes parsingEnv) codebase [] unisonFile let Result.Result notes maybeTypecheckedUnisonFile = FileParsers.synthesizeFile typecheckingEnv unisonFile maybeTypecheckedUnisonFile & onNothing do - let namesWithFileDefinitions = UF.addNamesFromUnisonFile unisonFile names - pped <- Cli.prettyPrintEnvDeclFromNames namesWithFileDefinitions + let pped = + let ns = + names + -- Shadow just the type decl and constructor names (because the unison file didn't typecheck so we + -- don't have term `Names`) + & Names.shadowing (UF.toNames unisonFile) + in PPED.makePPED + (PPE.hqNamer 10 ns) + ( PPE.suffixifyByHashWithUnhashedTermsInScope + ( Set.union + (Set.map Name.unsafeParseVar (Map.keysSet (UF.terms unisonFile))) + ( foldMap + ( foldMap \case + (v, _, _) -> + case Var.typeOf v of + Var.User _ -> Set.singleton (Name.unsafeParseVar v) + _ -> Set.empty + ) + (UF.watches unisonFile) + ) + ) + ns + ) let suffixifiedPPE = PPED.suffixifiedPPE pped let tes = [err | Result.TypeError err <- toList notes] cbs = @@ -122,8 +152,6 @@ loadUnisonFile sourceName text = do Cli.respond (Output.CompilerBugs text suffixifiedPPE cbs) Cli.returnEarlyWithoutOutput -data EvalMode = Sandboxed | Permissive | Native - -- | Evaluate all watched expressions in a UnisonFile and return -- their results, keyed by the name of the watch variable. The tuple returned -- has the form: @@ -163,7 +191,7 @@ evalUnisonFile mode ppe unisonFile args = do Cli.with_ (withArgs args) do (nts, errs, map) <- - Cli.ioE (Runtime.evaluateWatches (Codebase.toCodeLookup codebase) ppe watchCache theRuntime unisonFile) \err -> do + Cli.ioE (Runtime.evaluateWatches (Codebase.codebaseToCodeLookup codebase) ppe watchCache theRuntime unisonFile) \err -> do Cli.returnEarly (Output.EvaluationFailure err) when (not $ null errs) (RuntimeUtils.displayDecompileErrors errs) for_ (Map.elems map) \(_loc, kind, hash, _src, value, isHit) -> do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Ls.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Ls.hs index 55be69f3a7..2331f637d7 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Ls.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Ls.hs @@ -7,14 +7,16 @@ import Control.Monad.Reader (ask) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli -import Unison.Cli.PrettyPrintUtils qualified as Cli +import Unison.Cli.NamesUtils qualified as Cli import Unison.Codebase qualified as Codebase import Unison.Codebase.Editor.Output import Unison.Codebase.Editor.StructuredArgument qualified as SA import Unison.Codebase.Path (Path') import Unison.Codebase.ProjectPath (ProjectPathG (..)) import Unison.Prelude +import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPED +import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Server.Backend qualified as Backend handleLs :: Path' -> Cli () @@ -24,7 +26,8 @@ handleLs pathArg = do projectRootBranch <- Cli.runTransaction $ Codebase.expectShallowProjectBranchRoot pp.branch entries <- liftIO (Backend.lsAtPath codebase projectRootBranch (pp.absPath)) Cli.setNumberedArgs $ fmap (SA.ShallowListEntry pathArg) entries - pped <- Cli.currentPrettyPrintEnvDecl + names <- Cli.currentNames + let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) let suffixifiedPPE = PPED.suffixifiedPPE pped -- This used to be a delayed action which only forced the loading of the root -- branch when it was necessary for printing the results, but that got wiped out diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 6696c21831..72920b190d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -16,16 +16,18 @@ module Unison.Codebase.Editor.HandleInput.Merge2 where import Control.Monad.Reader (ask) -import Data.Bifoldable (bifoldMap) -import Data.Bitraversable (bitraverse) -import Data.Foldable qualified as Foldable +import Data.Algorithm.Diff qualified as Diff import Data.List qualified as List import Data.Map.Strict qualified as Map -import Data.Semialign (align, unzip, zipWith) -import Data.Set qualified as Set +import Data.Semialign (zipWith) import Data.Text qualified as Text import Data.Text.IO qualified as Text import Data.These (These (..)) +import System.Directory (canonicalizePath, getTemporaryDirectory, removeFile) +import System.Environment (lookupEnv) +import System.FilePath (()) +import System.IO.Temp qualified as Temporary +import System.Process qualified as Process import Text.ANSI qualified as Text import Text.Builder qualified import Text.Builder qualified as Text (Builder) @@ -33,7 +35,7 @@ import U.Codebase.Branch qualified as V2 (Branch (..), CausalBranch) import U.Codebase.Branch qualified as V2.Branch import U.Codebase.Causal qualified as V2.Causal import U.Codebase.HashTags (CausalHash, unCausalHash) -import U.Codebase.Reference (Reference, TermReferenceId, TypeReference, TypeReferenceId) +import U.Codebase.Reference (TermReferenceId, TypeReference, TypeReferenceId) import U.Codebase.Sqlite.DbId (ProjectId) import U.Codebase.Sqlite.Operations qualified as Operations import U.Codebase.Sqlite.Project (Project (..)) @@ -45,11 +47,9 @@ import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Cli.UpdateUtils - ( getNamespaceDependentsOf2, + ( getNamespaceDependentsOf3, hydrateDefns, loadNamespaceDefinitions, - parseAndTypecheck, - renderDefnsForUnisonFile, ) import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase @@ -71,40 +71,15 @@ import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as DataDeclaration import Unison.Debug qualified as Debug import Unison.Hash qualified as Hash -import Unison.Merge.CombineDiffs (CombinedDiffOp (..), combineDiffs) -import Unison.Merge.Database (MergeDatabase (..), makeMergeDatabase, referent2to1) -import Unison.Merge.DeclCoherencyCheck (checkDeclCoherency, lenientCheckDeclCoherency) -import Unison.Merge.DeclNameLookup (DeclNameLookup (..), expectConstructorNames) -import Unison.Merge.Diff qualified as Merge -import Unison.Merge.DiffOp (DiffOp (..)) -import Unison.Merge.EitherWay (EitherWay (..)) -import Unison.Merge.EitherWayI (EitherWayI (..)) +import Unison.Merge qualified as Merge import Unison.Merge.EitherWayI qualified as EitherWayI -import Unison.Merge.Libdeps qualified as Merge -import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup) -import Unison.Merge.PartitionCombinedDiffs (partitionCombinedDiffs) -import Unison.Merge.Synhashed (Synhashed (..)) import Unison.Merge.Synhashed qualified as Synhashed -import Unison.Merge.ThreeWay (ThreeWay (..)) import Unison.Merge.ThreeWay qualified as ThreeWay -import Unison.Merge.TwoOrThreeWay (TwoOrThreeWay (..)) -import Unison.Merge.TwoWay (TwoWay (..)) -import Unison.Merge.TwoWay qualified as TwoWay -import Unison.Merge.TwoWayI qualified as TwoWayI -import Unison.Merge.Unconflicts (Unconflicts (..)) -import Unison.Merge.Unconflicts qualified as Unconflicts -import Unison.Merge.Updated (Updated (..)) import Unison.Name (Name) +import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment -import Unison.NameSegment.Internal (NameSegment (NameSegment)) -import Unison.NameSegment.Internal qualified as NameSegment -import Unison.Names (Names) -import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) import Unison.Prelude -import Unison.PrettyPrintEnv.Names qualified as PPE -import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) -import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Project ( ProjectAndBranch (..), ProjectBranchName, @@ -121,14 +96,16 @@ import Unison.Sqlite (Transaction) import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Syntax.Name qualified as Name +import Unison.Term (Term) +import Unison.Type (Type) import Unison.UnisonFile (TypecheckedUnisonFile) import Unison.UnisonFile qualified as UnisonFile -import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap -import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2, DefnsF3, alignDefnsWith, defnsAreEmpty, zipDefnsWith, zipDefnsWith3) +import Unison.Util.Conflicted (Conflicted) +import Unison.Util.Defn (Defn) +import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2, DefnsF3, alignDefnsWith) import Unison.Util.Monoid qualified as Monoid -import Unison.Util.Nametree (Nametree (..), flattenNametrees, unflattenNametree) -import Unison.Util.Pretty (ColorText, Pretty) +import Unison.Util.Nametree (Nametree (..), unflattenNametree) import Unison.Util.Pretty qualified as Pretty import Unison.Util.Relation (Relation) import Unison.Util.Relation qualified as Relation @@ -158,7 +135,7 @@ handleMerge (ProjectAndBranch maybeBobProjectName bobBranchName) = do let bobProjectAndBranch = ProjectAndBranch bobProject bobProjectBranch doMergeLocalBranch - TwoWay + Merge.TwoWay { alice = aliceProjectAndBranch, bob = bobProjectAndBranch } @@ -197,7 +174,7 @@ doMerge info = do let mergeTarget = MergeSourceOrTarget'Target aliceBranchNames let mergeSourceAndTarget = MergeSourceAndTarget {alice = aliceBranchNames, bob = info.bob.source} - Cli.Env {codebase} <- ask + env <- ask finalOutput <- Cli.label \done -> do @@ -207,198 +184,264 @@ doMerge info = do -- Otherwise, if LCA == alice (so alice is behind bob), then we could fast forward to bob, so we're done. when (info.lca.causalHash == Just info.alice.causalHash) do - bobBranch <- liftIO (Codebase.expectBranchForHash codebase info.bob.causalHash) + bobBranch <- liftIO (Codebase.expectBranchForHash env.codebase info.bob.causalHash) _ <- Cli.updateAt info.description (PP.projectBranchRoot info.alice.projectAndBranch) (\_aliceBranch -> bobBranch) done (Output.MergeSuccessFastForward mergeSourceAndTarget) - -- Create a bunch of cached database lookup functions - db <- makeMergeDatabase codebase - - -- Load Alice/Bob/LCA causals - causals <- Cli.runTransaction do - traverse - Operations.expectCausalBranchByCausalHash - TwoOrThreeWay - { alice = info.alice.causalHash, - bob = info.bob.causalHash, - lca = info.lca.causalHash - } - - liftIO (debugFunctions.debugCausals causals) - - -- Load Alice/Bob/LCA branches - branches <- - Cli.runTransaction do - alice <- causals.alice.value - bob <- causals.bob.value - lca <- for causals.lca \causal -> causal.value - pure TwoOrThreeWay {lca, alice, bob} - - -- Assert that neither Alice nor Bob have defns in lib - for_ [(mergeTarget, branches.alice), (mergeSource, branches.bob)] \(who, branch) -> do - whenM (Cli.runTransaction (hasDefnsInLib branch)) do - done (Output.MergeDefnsInLib who) - - -- Load Alice/Bob/LCA definitions and decl name lookups - (defns3, declNameLookups, lcaDeclNameLookup) <- do - let emptyNametree = Nametree {value = Defns Map.empty Map.empty, children = Map.empty} - let loadDefns branch = - Cli.runTransaction (loadNamespaceDefinitions (referent2to1 db) branch) - & onLeftM (done . Output.ConflictedDefn "merge") - let load = \case - Nothing -> pure (emptyNametree, DeclNameLookup Map.empty Map.empty) - Just (who, branch) -> do - defns <- loadDefns branch - declNameLookup <- - Cli.runTransaction (checkDeclCoherency db.loadDeclNumConstructors defns) - & onLeftM (done . Output.IncoherentDeclDuringMerge who) - pure (defns, declNameLookup) - - (aliceDefns0, aliceDeclNameLookup) <- load (Just (mergeTarget, branches.alice)) - (bobDefns0, bobDeclNameLookup) <- load (Just (mergeSource, branches.bob)) - lcaDefns0 <- maybe (pure emptyNametree) loadDefns branches.lca - lcaDeclNameLookup <- Cli.runTransaction (lenientCheckDeclCoherency db.loadDeclNumConstructors lcaDefns0) - - let defns3 = flattenNametrees <$> ThreeWay {alice = aliceDefns0, bob = bobDefns0, lca = lcaDefns0} - let declNameLookups = TwoWay {alice = aliceDeclNameLookup, bob = bobDeclNameLookup} - - pure (defns3, declNameLookups, lcaDeclNameLookup) - - let defns = ThreeWay.forgetLca defns3 - - liftIO (debugFunctions.debugDefns defns3 declNameLookups lcaDeclNameLookup) - - -- Diff LCA->Alice and LCA->Bob - diffs <- Cli.runTransaction (Merge.nameBasedNamespaceDiff db declNameLookups lcaDeclNameLookup defns3) - - liftIO (debugFunctions.debugDiffs diffs) - - -- Bail early if it looks like we can't proceed with the merge, because Alice or Bob has one or more conflicted alias - for_ ((,) <$> TwoWay mergeTarget mergeSource <*> diffs) \(who, diff) -> - whenJust (findConflictedAlias defns3.lca diff) \(name1, name2) -> - done (Output.MergeConflictedAliases who name1 name2) - - -- Combine the LCA->Alice and LCA->Bob diffs together - let diff = combineDiffs diffs - - liftIO (debugFunctions.debugCombinedDiff diff) - - -- Partition the combined diff into the conflicted things and the unconflicted things - (conflicts, unconflicts) <- - partitionCombinedDiffs defns declNameLookups diff & onLeft \name -> - done (Output.MergeConflictInvolvingBuiltin name) - - liftIO (debugFunctions.debugPartitionedDiff conflicts unconflicts) - - -- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if there - -- aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are) - dependents <- Cli.runTransaction (identifyDependents defns conflicts unconflicts) - - liftIO (debugFunctions.debugDependents dependents) - - let stageOne :: DefnsF (Map Name) Referent TypeReference - stageOne = - makeStageOne - declNameLookups - conflicts - unconflicts - dependents - (bimap BiMultimap.range BiMultimap.range defns3.lca) - - liftIO (debugFunctions.debugStageOne stageOne) - - -- Load and merge Alice's and Bob's libdeps - mergedLibdeps <- - Cli.runTransaction do - libdeps <- loadLibdeps branches - libdepsToBranch0 db (Merge.mergeLibdeps getTwoFreshNames libdeps) - - -- Make PPE for Alice that contains all of Alice's names, but suffixified against her names + Bob's names - let mkPpes :: TwoWay Names -> Names -> TwoWay PrettyPrintEnvDecl - mkPpes defnsNames libdepsNames = - defnsNames <&> \names -> PPED.makePPED (PPE.namer (names <> libdepsNames)) suffixifier - where - suffixifier = PPE.suffixifyByName (fold defnsNames <> libdepsNames) - let ppes = mkPpes (defnsToNames <$> defns) (Branch.toNames mergedLibdeps) - - hydratedThings <- do - Cli.runTransaction do - for ((,) <$> conflicts <*> dependents) \(conflicts1, dependents1) -> - let hydrate = hydrateDefns (Codebase.unsafeGetTermComponent codebase) Operations.expectDeclComponent - in (,) <$> hydrate conflicts1 <*> hydrate dependents1 - - let (renderedConflicts, renderedDependents) = - unzip $ - ( \declNameLookup (conflicts, dependents) ppe -> - let honk1 = renderDefnsForUnisonFile declNameLookup ppe - in (honk1 conflicts, honk1 dependents) - ) - <$> declNameLookups - <*> hydratedThings - <*> ppes - - let prettyUnisonFile = - makePrettyUnisonFile - TwoWay - { alice = into @Text aliceBranchNames, - bob = - case info.bob.source of - MergeSource'LocalProjectBranch bobBranchNames -> into @Text bobBranchNames - MergeSource'RemoteProjectBranch bobBranchNames - | aliceBranchNames == bobBranchNames -> "remote " <> into @Text bobBranchNames - | otherwise -> into @Text bobBranchNames - MergeSource'RemoteLooseCode info -> - case Path.toName info.path of - Nothing -> "" - Just name -> Name.toText name + Cli.withRespondRegion \respondRegion -> do + respondRegion (Output.Literal "Loading branches...") + + -- Load Alice/Bob/LCA causals + causals <- + Cli.runTransaction do + traverse + Operations.expectCausalBranchByCausalHash + Merge.TwoOrThreeWay + { alice = info.alice.causalHash, + bob = info.bob.causalHash, + lca = info.lca.causalHash } - renderedConflicts - renderedDependents - - let stageOneBranch = defnsAndLibdepsToBranch0 codebase stageOne mergedLibdeps - - maybeTypecheckedUnisonFile <- - let thisMergeHasConflicts = - -- Eh, they'd either both be null, or neither, but just check both maps anyway - not (defnsAreEmpty conflicts.alice) || not (defnsAreEmpty conflicts.bob) - in if thisMergeHasConflicts - then pure Nothing - else do - currentPath <- Cli.getCurrentProjectPath - parsingEnv <- Cli.makeParsingEnv currentPath (Branch.toNames stageOneBranch) - parseAndTypecheck prettyUnisonFile parsingEnv - - let parents = - (\causal -> (causal.causalHash, Codebase.expectBranchForHash codebase causal.causalHash)) <$> causals - - case maybeTypecheckedUnisonFile of - Nothing -> do - Cli.Env {writeSource} <- ask - (_temporaryBranchId, temporaryBranchName) <- - HandleInput.Branch.createBranch - info.description - (HandleInput.Branch.CreateFrom'NamespaceWithParent info.alice.projectAndBranch.branch (Branch.mergeNode stageOneBranch parents.alice parents.bob)) - info.alice.projectAndBranch.project - (findTemporaryBranchName info.alice.projectAndBranch.project.projectId mergeSourceAndTarget) - - scratchFilePath <- - Cli.getLatestFile <&> \case - Nothing -> "scratch.u" - Just (file, _) -> file - liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUnisonFile) - pure (Output.MergeFailure scratchFilePath mergeSourceAndTarget temporaryBranchName) - Just tuf -> do - Cli.runTransaction (Codebase.addDefsToCodebase codebase tuf) - let stageTwoBranch = Branch.batchUpdates (typecheckedUnisonFileToBranchAdds tuf) stageOneBranch - Cli.updateProjectBranchRoot_ - info.alice.projectAndBranch.branch - info.description - (\_aliceBranch -> Branch.mergeNode stageTwoBranch parents.alice parents.bob) - pure (Output.MergeSuccess mergeSourceAndTarget) + + liftIO (debugFunctions.debugCausals causals) + + -- Load Alice/Bob/LCA branches + branches <- + Cli.runTransaction do + alice <- causals.alice.value + bob <- causals.bob.value + lca <- for causals.lca \causal -> causal.value + pure Merge.TwoOrThreeWay {lca, alice, bob} + + -- Assert that neither Alice nor Bob have defns in lib + for_ [(mergeTarget, branches.alice), (mergeSource, branches.bob)] \(who, branch) -> do + whenM (Cli.runTransaction (hasDefnsInLib branch)) do + done (Output.MergeDefnsInLib who) + + -- Load Alice/Bob/LCA definitions + -- + -- FIXME: Oops, if this fails due to a conflicted name, we don't actually say where the conflicted name came from. + -- We should have a better error message (even though you can't do anything about conflicted names in the LCA). + nametrees3 :: Merge.ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) <- do + let referent2to1 = Conversions.referent2to1 (Codebase.getDeclType env.codebase) + let action :: + (forall a. Defn (Conflicted Name Referent) (Conflicted Name TypeReference) -> Transaction a) -> + Transaction (Merge.ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference))) + action rollback = do + alice <- loadNamespaceDefinitions referent2to1 branches.alice & onLeftM rollback + bob <- loadNamespaceDefinitions referent2to1 branches.bob & onLeftM rollback + lca <- + case branches.lca of + Nothing -> pure Nametree {value = Defns Map.empty Map.empty, children = Map.empty} + Just lca -> loadNamespaceDefinitions referent2to1 lca & onLeftM rollback + pure Merge.ThreeWay {alice, bob, lca} + Cli.runTransactionWithRollback2 (\rollback -> Right <$> action (rollback . Left)) + & onLeftM (done . Output.ConflictedDefn "merge") + + libdeps3 <- Cli.runTransaction (loadLibdeps branches) + + let blob0 = Merge.makeMergeblob0 nametrees3 libdeps3 + + -- Hydrate + hydratedDefns :: + Merge.ThreeWay + ( DefnsF + (Map Name) + (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) + (TypeReferenceId, Decl Symbol Ann) + ) <- + Cli.runTransaction $ + traverse + ( hydrateDefns + (Codebase.unsafeGetTermComponent env.codebase) + Operations.expectDeclComponent + ) + ( let f = Map.mapMaybe Referent.toTermReferenceId . BiMultimap.range + g = Map.mapMaybe Reference.toId . BiMultimap.range + in bimap f g <$> blob0.defns + ) + + respondRegion (Output.Literal "Computing diff between branches...") + + blob1 <- + Merge.makeMergeblob1 blob0 hydratedDefns & onLeft \case + Merge.Alice reason -> done (Output.IncoherentDeclDuringMerge mergeTarget reason) + Merge.Bob reason -> done (Output.IncoherentDeclDuringMerge mergeSource reason) + + liftIO (debugFunctions.debugDiffs blob1.diffs) + + liftIO (debugFunctions.debugCombinedDiff blob1.diff) + + blob2 <- + Merge.makeMergeblob2 blob1 & onLeft \err -> + done case err of + Merge.Mergeblob2Error'ConflictedAlias defn0 -> + case defn0 of + Merge.Alice defn -> Output.MergeConflictedAliases mergeTarget defn + Merge.Bob defn -> Output.MergeConflictedAliases mergeSource defn + Merge.Mergeblob2Error'ConflictedBuiltin defn -> Output.MergeConflictInvolvingBuiltin defn + + liftIO (debugFunctions.debugPartitionedDiff blob2.conflicts blob2.unconflicts) + + respondRegion (Output.Literal "Loading dependents of changes...") + + dependents0 <- + Cli.runTransaction $ + for ((,) <$> ThreeWay.forgetLca blob2.defns <*> blob2.coreDependencies) \(defns, deps) -> + getNamespaceDependentsOf3 defns deps + + respondRegion (Output.Literal "Loading and merging library dependencies...") + + -- Load libdeps + (mergedLibdeps, lcaLibdeps) <- do + -- We make a fresh branch cache to load the branch of libdeps. + -- It would probably be better to reuse the codebase's branch cache. + -- FIXME how slow/bad is this without that branch cache? + Cli.runTransaction do + branchCache <- Sqlite.unsafeIO newBranchCache + let load children = + Conversions.branch2to1 + branchCache + (Codebase.getDeclType env.codebase) + V2.Branch {terms = Map.empty, types = Map.empty, patches = Map.empty, children} + mergedLibdeps <- load blob2.libdeps + lcaLibdeps <- load blob2.lcaLibdeps + pure (mergedLibdeps, lcaLibdeps) + + let hasConflicts = + blob2.hasConflicts + + respondRegion (Output.Literal "Rendering Unison file...") + + let blob3 = + Merge.makeMergeblob3 + blob2 + dependents0 + (Branch.toNames mergedLibdeps) + (Branch.toNames lcaLibdeps) + Merge.TwoWay + { alice = into @Text aliceBranchNames, + bob = + case info.bob.source of + MergeSource'LocalProjectBranch bobBranchNames -> into @Text bobBranchNames + MergeSource'RemoteProjectBranch bobBranchNames + | aliceBranchNames == bobBranchNames -> "remote " <> into @Text bobBranchNames + | otherwise -> into @Text bobBranchNames + MergeSource'RemoteLooseCode info -> + case Path.toName info.path of + Nothing -> "" + Just name -> Name.toText name + } + + maybeBlob5 <- + if hasConflicts + then pure Nothing + else case Merge.makeMergeblob4 blob3 of + Left _parseErr -> pure Nothing + Right blob4 -> do + respondRegion (Output.Literal "Typechecking Unison file...") + typeLookup <- Cli.runTransaction (Codebase.typeLookupForDependencies env.codebase blob4.dependencies) + pure case Merge.makeMergeblob5 blob4 typeLookup of + Left _typecheckErr -> Nothing + Right blob5 -> Just blob5 + + let parents = + causals <&> \causal -> (causal.causalHash, Codebase.expectBranchForHash env.codebase causal.causalHash) + + blob5 <- + maybeBlob5 & onNothing do + env <- ask + (_temporaryBranchId, temporaryBranchName) <- + HandleInput.Branch.createBranch + info.description + ( HandleInput.Branch.CreateFrom'NamespaceWithParent + info.alice.projectAndBranch.branch + ( Branch.mergeNode + (defnsAndLibdepsToBranch0 env.codebase blob3.stageTwo mergedLibdeps) + parents.alice + parents.bob + ) + ) + info.alice.projectAndBranch.project + (findTemporaryBranchName info.alice.projectAndBranch.project.projectId mergeSourceAndTarget) + + -- Merge conflicts? Have UCM_MERGETOOL? Result + -- ---------------- ------------------- ------------------------------------------------------------ + -- No No Put code that doesn't parse or typecheck in scratch.u + -- No Yes Put code that doesn't parse or typecheck in scratch.u + -- Yes No Put code that doesn't parse (because conflicts) in scratch.u + -- Yes Yes Run that cool tool + + maybeMergetool <- + if hasConflicts + then liftIO (lookupEnv "UCM_MERGETOOL") + else pure Nothing + + case maybeMergetool of + Nothing -> do + scratchFilePath <- + Cli.getLatestFile <&> \case + Nothing -> "scratch.u" + Just (file, _) -> file + liftIO $ env.writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 blob3.unparsedFile) True + done (Output.MergeFailure scratchFilePath mergeSourceAndTarget temporaryBranchName) + Just mergetool0 -> do + let aliceFilenameSlug = mangleBranchName mergeSourceAndTarget.alice.branch + let bobFilenameSlug = mangleMergeSource mergeSourceAndTarget.bob + makeTempFilename <- + liftIO do + tmpdir0 <- getTemporaryDirectory + tmpdir1 <- canonicalizePath tmpdir0 + tmpdir2 <- Temporary.createTempDirectory tmpdir1 "unison-merge" + pure \filename -> Text.pack (tmpdir2 Text.unpack (Text.Builder.run filename)) + let lcaFilename = makeTempFilename (aliceFilenameSlug <> "-" <> bobFilenameSlug <> "-base.u") + let aliceFilename = makeTempFilename (aliceFilenameSlug <> ".u") + let bobFilename = makeTempFilename (bobFilenameSlug <> ".u") + let mergedFilename = Text.Builder.run (aliceFilenameSlug <> "-" <> bobFilenameSlug <> "-merged.u") + let mergetool = + mergetool0 + & Text.pack + & Text.replace "$BASE" lcaFilename + & Text.replace "$LOCAL" aliceFilename + & Text.replace "$MERGED" mergedFilename + & Text.replace "$REMOTE" bobFilename + exitCode <- + liftIO do + let aliceFileContents = Text.pack (Pretty.toPlain 80 blob3.unparsedSoloFiles.alice) + let bobFileContents = Text.pack (Pretty.toPlain 80 blob3.unparsedSoloFiles.bob) + removeFile (Text.unpack mergedFilename) <|> pure () + env.writeSource lcaFilename (Text.pack (Pretty.toPlain 80 blob3.unparsedSoloFiles.lca)) True + env.writeSource aliceFilename aliceFileContents True + env.writeSource bobFilename bobFileContents True + env.writeSource + mergedFilename + ( makeMergedFileContents + mergeSourceAndTarget + aliceFileContents + bobFileContents + ) + True + let createProcess = (Process.shell (Text.unpack mergetool)) {Process.delegate_ctlc = True} + Process.withCreateProcess createProcess \_ _ _ -> Process.waitForProcess + done (Output.MergeFailureWithMergetool mergeSourceAndTarget temporaryBranchName mergetool exitCode) + + Cli.runTransaction (Codebase.addDefsToCodebase env.codebase blob5.file) + Cli.updateProjectBranchRoot_ + info.alice.projectAndBranch.branch + info.description + ( \_aliceBranch -> + Branch.mergeNode + ( Branch.batchUpdates + (typecheckedUnisonFileToBranchAdds blob5.file) + (defnsAndLibdepsToBranch0 env.codebase blob3.stageOne mergedLibdeps) + ) + parents.alice + parents.bob + ) + pure (Output.MergeSuccess mergeSourceAndTarget) Cli.respond finalOutput -doMergeLocalBranch :: TwoWay (ProjectAndBranch Project ProjectBranch) -> Cli () +doMergeLocalBranch :: Merge.TwoWay (ProjectAndBranch Project ProjectBranch) -> Cli () doMergeLocalBranch branches = do (aliceCausalHash, bobCausalHash, lcaCausalHash) <- Cli.runTransaction do @@ -432,8 +475,8 @@ doMergeLocalBranch branches = do -- Loading basic info out of the database loadLibdeps :: - TwoOrThreeWay (V2.Branch Transaction) -> - Transaction (ThreeWay (Map NameSegment (V2.CausalBranch Transaction))) + Merge.TwoOrThreeWay (V2.Branch Transaction) -> + Transaction (Merge.ThreeWay (Map NameSegment (V2.CausalBranch Transaction))) loadLibdeps branches = do lca <- case branches.lca of @@ -441,7 +484,7 @@ loadLibdeps branches = do Just lcaBranch -> load lcaBranch alice <- load branches.alice bob <- load branches.bob - pure ThreeWay {lca, alice, bob} + pure Merge.ThreeWay {lca, alice, bob} where load :: V2.Branch Transaction -> Transaction (Map NameSegment (V2.CausalBranch Transaction)) load branch = @@ -463,105 +506,7 @@ hasDefnsInLib branch = do pure (not (Map.null libdeps.terms) || not (Map.null libdeps.types)) ------------------------------------------------------------------------------------------------------------------------ --- Creating Unison files - -makePrettyUnisonFile :: - TwoWay Text -> - TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) -> - TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) -> - Pretty ColorText -makePrettyUnisonFile authors conflicts dependents = - fold - [ conflicts - -- Merge the two maps together into one, remembering who authored what - & TwoWay.twoWay (zipDefnsWith align align) - -- Sort alphabetically - & inAlphabeticalOrder - -- Render each conflict, types then terms (even though a type can conflict with a term, in which case they - -- would not be adjacent in the file), with an author comment above each conflicted thing - & ( let f = - foldMap \case - This x -> alice x - That y -> bob y - These x y -> alice x <> bob y - where - alice = prettyBinding (Just (Pretty.text authors.alice)) - bob = prettyBinding (Just (Pretty.text authors.bob)) - in bifoldMap f f - ), - -- Show message that delineates where conflicts end and dependents begin only when there are both conflicts and - -- dependents - let thereAre defns = TwoWay.or (not . defnsAreEmpty <$> defns) - in if thereAre conflicts && thereAre dependents - then - fold - [ "-- The definitions below are not conflicted, but they each depend on one or more\n", - "-- conflicted definitions above.\n\n" - ] - else mempty, - dependents - -- Merge dependents together into one map (they are disjoint) - & TwoWay.twoWay (zipDefnsWith Map.union Map.union) - -- Sort alphabetically - & inAlphabeticalOrder - -- Render each dependent, types then terms, without bothering to comment attribution - & (let f = foldMap (prettyBinding Nothing) in bifoldMap f f) - ] - where - prettyBinding maybeComment binding = - fold - [ case maybeComment of - Nothing -> mempty - Just comment -> "-- " <> comment <> "\n", - binding, - "\n", - "\n" - ] - - inAlphabeticalOrder :: DefnsF (Map Name) a b -> DefnsF [] a b - inAlphabeticalOrder = - bimap f f - where - f = map snd . List.sortOn (Name.toText . fst) . Map.toList - ------------------------------------------------------------------------------------------------------------------------- --- - --- Given just named term/type reference ids, fill out all names that occupy the term and type namespaces. This is simply --- the given names plus all of the types' constructors. --- --- For example, if the input is --- --- declNameLookup = { --- "Maybe" => ["Maybe.Nothing", "Maybe.Just"] --- } --- defns = { --- terms = { "foo" => #foo } --- types = { "Maybe" => #Maybe } --- } -- --- then the output is --- --- defns = { --- terms = { "foo", "Maybe.Nothing", "Maybe.Just" } --- types = { "Maybe" } --- } -refIdsToNames :: DeclNameLookup -> DefnsF (Map Name) term typ -> DefnsF Set Name Name -refIdsToNames declNameLookup = - bifoldMap goTerms goTypes - where - goTerms :: Map Name term -> DefnsF Set Name Name - goTerms terms = - Defns {terms = Map.keysSet terms, types = Set.empty} - - goTypes :: Map Name typ -> DefnsF Set Name Name - goTypes types = - Defns - { terms = foldMap (Set.fromList . expectConstructorNames declNameLookup) names, - types = names - } - where - names = Map.keysSet types defnsAndLibdepsToBranch0 :: Codebase IO v a -> @@ -608,123 +553,6 @@ nametreeToBranch0 nametree = rel2star rel = Star2.Star2 {fact = Relation.dom rel, d1 = rel, d2 = Relation.empty} --- FIXME: let's come up with a better term for "dependencies" in the implementation of this function -identifyDependents :: - TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> - TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> - DefnsF Unconflicts Referent TypeReference -> - Transaction (TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId)) -identifyDependents defns conflicts unconflicts = do - let -- The other person's (i.e. with "Alice" and "Bob" swapped) solo-deleted and solo-updated names - theirSoloUpdatesAndDeletes :: TwoWay (DefnsF Set Name Name) - theirSoloUpdatesAndDeletes = - TwoWay.swap (unconflictedSoloDeletedNames <> unconflictedSoloUpdatedNames) - where - unconflictedSoloDeletedNames :: TwoWay (DefnsF Set Name Name) - unconflictedSoloDeletedNames = - bitraverse Unconflicts.soloDeletedNames Unconflicts.soloDeletedNames unconflicts - - unconflictedSoloUpdatedNames :: TwoWay (DefnsF Set Name Name) - unconflictedSoloUpdatedNames = - bitraverse Unconflicts.soloUpdatedNames Unconflicts.soloUpdatedNames unconflicts - - let dependencies :: TwoWay (Set Reference) - dependencies = - fold - [ -- One source of dependencies: Alice's versions of Bob's unconflicted deletes and updates, and vice-versa. - -- - -- This is name-based: if Bob updates the *name* "foo", then we go find the thing that Alice calls "foo" (if - -- anything), no matter what its hash is. - defnsReferences - <$> ( zipDefnsWith BiMultimap.restrictRan BiMultimap.restrictRan - <$> theirSoloUpdatesAndDeletes - <*> defns - ), - -- The other source of dependencies: Alice's own conflicted things, and ditto for Bob. - -- - -- An example: suppose Alice has foo#alice and Bob has foo#bob, so foo is conflicted. Furthermore, suppose - -- Alice has bar#bar that depends on foo#alice. - -- - -- We want Alice's #alice to be considered a dependency, so that when we go off and find dependents of these - -- dependencies to put in the scratch file for type checking and propagation, we find bar#bar. - -- - -- Note that this is necessary even if bar#bar is unconflicted! We don't want bar#bar to be put directly - -- into the namespace / parsing context for the conflicted merge, because it has an unnamed reference on - -- foo#alice. It rather ought to be in the scratchfile alongside the conflicted foo#alice and foo#bob, so - -- that when that conflict is resolved, it will propagate to bar. - let f :: (Foldable t) => t Reference.Id -> Set Reference - f = - List.foldl' (\acc ref -> Set.insert (Reference.DerivedId ref) acc) Set.empty . Foldable.toList - in bifoldMap f f <$> conflicts - ] - - dependents0 <- - for ((,) <$> defns <*> dependencies) \(defns1, dependencies1) -> - getNamespaceDependentsOf2 defns1 dependencies1 - - -- There is some subset of Alice's dependents (and ditto for Bob of course) that we don't ultimately want/need to put - -- into the scratch file: those for which any of the following are true: - -- - -- 1. It is Alice-conflicted (since we only want to return *unconflicted* things). - -- 2. It was deleted by Bob. - -- 3. It was updated by Bob and not updated by Alice. - let dependents1 :: TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) - dependents1 = - zipDefnsWith Map.withoutKeys Map.withoutKeys - <$> dependents0 - <*> ((bimap Map.keysSet Map.keysSet <$> conflicts) <> theirSoloUpdatesAndDeletes) - - -- Of the remaining dependents, it's still possible that the maps are not disjoint. But whenever the same name key - -- exists in Alice's and Bob's dependents, the value will either be equal (by Unison hash)... - -- - -- { alice = { terms = {"foo" => #alice} } } - -- { bob = { terms = {"foo" => #alice} } } - -- - -- ...or synhash-equal (i.e. the term or type received different auto-propagated updates)... - -- - -- { alice = { terms = {"foo" => #alice} } } - -- { bob = { terms = {"foo" => #bob} } } - -- - -- So, we can arbitrarily keep Alice's, because they will render the same. - -- - -- { alice = { terms = {"foo" => #alice} } } - -- { bob = { terms = {} } } - let dependents2 :: TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) - dependents2 = - dependents1 & over #bob \bob -> - zipDefnsWith Map.difference Map.difference bob dependents1.alice - - pure dependents2 - -makeStageOne :: - TwoWay DeclNameLookup -> - TwoWay (DefnsF (Map Name) termid typeid) -> - DefnsF Unconflicts term typ -> - TwoWay (DefnsF (Map Name) termid typeid) -> - DefnsF (Map Name) term typ -> - DefnsF (Map Name) term typ -makeStageOne declNameLookups conflicts unconflicts dependents = - zipDefnsWith3 makeStageOneV makeStageOneV unconflicts (f conflicts <> f dependents) - where - f :: TwoWay (DefnsF (Map Name) term typ) -> DefnsF Set Name Name - f defns = - fold (refIdsToNames <$> declNameLookups <*> defns) - -makeStageOneV :: Unconflicts v -> Set Name -> Map Name v -> Map Name v -makeStageOneV unconflicts namesToDelete = - (`Map.withoutKeys` namesToDelete) . Unconflicts.apply unconflicts - -defnsReferences :: Defns (BiMultimap Referent name) (BiMultimap TypeReference name) -> Set Reference -defnsReferences = - bifoldMap (Set.map Referent.toReference . BiMultimap.dom) BiMultimap.dom - -defnsToNames :: Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> Names -defnsToNames defns = - Names.Names - { terms = Relation.fromMap (BiMultimap.range defns.terms), - types = Relation.fromMap (BiMultimap.range defns.types) - } - findTemporaryBranchName :: ProjectId -> MergeSourceAndTarget -> Transaction ProjectBranchName findTemporaryBranchName projectId mergeSourceAndTarget = do ProjectUtils.findTemporaryBranchName projectId preferred @@ -738,26 +566,27 @@ findTemporaryBranchName projectId mergeSourceAndTarget = do <> "-into-" <> mangleBranchName mergeSourceAndTarget.alice.branch - mangleMergeSource :: MergeSource -> Text.Builder - mangleMergeSource = \case - MergeSource'LocalProjectBranch (ProjectAndBranch _project branch) -> mangleBranchName branch - MergeSource'RemoteProjectBranch (ProjectAndBranch _project branch) -> "remote-" <> mangleBranchName branch - MergeSource'RemoteLooseCode info -> manglePath info.path - mangleBranchName :: ProjectBranchName -> Text.Builder - mangleBranchName name = - case classifyProjectBranchName name of - ProjectBranchNameKind'Contributor user name1 -> - Text.Builder.text user - <> Text.Builder.char '-' - <> mangleBranchName name1 - ProjectBranchNameKind'DraftRelease semver -> "releases-drafts-" <> mangleSemver semver - ProjectBranchNameKind'Release semver -> "releases-" <> mangleSemver semver - ProjectBranchNameKind'NothingSpecial -> Text.Builder.text (into @Text name) - +mangleMergeSource :: MergeSource -> Text.Builder +mangleMergeSource = \case + MergeSource'LocalProjectBranch (ProjectAndBranch _project branch) -> mangleBranchName branch + MergeSource'RemoteProjectBranch (ProjectAndBranch _project branch) -> "remote-" <> mangleBranchName branch + MergeSource'RemoteLooseCode info -> manglePath info.path + where manglePath :: Path -> Text.Builder manglePath = Monoid.intercalateMap "-" (Text.Builder.text . NameSegment.toUnescapedText) . Path.toList +mangleBranchName :: ProjectBranchName -> Text.Builder +mangleBranchName name = + case classifyProjectBranchName name of + ProjectBranchNameKind'Contributor user name1 -> + Text.Builder.text user + <> Text.Builder.char '-' + <> mangleBranchName name1 + ProjectBranchNameKind'DraftRelease semver -> "releases-drafts-" <> mangleSemver semver + ProjectBranchNameKind'Release semver -> "releases-" <> mangleSemver semver + ProjectBranchNameKind'NothingSpecial -> Text.Builder.text (into @Text name) + where mangleSemver :: Semver -> Text.Builder mangleSemver (Semver x y z) = Text.Builder.decimal x @@ -766,106 +595,6 @@ findTemporaryBranchName projectId mergeSourceAndTarget = do <> Text.Builder.char '.' <> Text.Builder.decimal z --- @findConflictedAlias namespace diff@, given an old namespace and a diff to a new namespace, will return the first --- "conflicted alias" encountered (if any), where a "conflicted alias" is a pair of names that referred to the same --- thing in the old namespace, but different things in the new one. --- --- For example, if the old namespace was --- --- foo = #foo --- bar = #foo --- --- and the new namespace is --- --- foo = #baz --- bar = #qux --- --- then (foo, bar) is a conflicted alias. --- --- This function currently doesn't return whether the conflicted alias is a decl or a term, but it certainly could. -findConflictedAlias :: - (Ord term, Ord typ) => - Defns (BiMultimap term Name) (BiMultimap typ Name) -> - DefnsF3 (Map Name) DiffOp Synhashed term typ -> - Maybe (Name, Name) -findConflictedAlias defns diff = - asum [go defns.terms diff.terms, go defns.types diff.types] - where - go :: forall ref. (Ord ref) => BiMultimap ref Name -> Map Name (DiffOp (Synhashed ref)) -> Maybe (Name, Name) - go namespace diff = - asum (map f (Map.toList diff)) - where - f :: (Name, DiffOp (Synhashed ref)) -> Maybe (Name, Name) - f (name, op) = - case op of - DiffOp'Add _ -> Nothing - DiffOp'Delete _ -> Nothing - DiffOp'Update hashed1 -> - BiMultimap.lookupPreimage name namespace - & Set.delete name - & Set.toList - & map (g hashed1.new) - & asum - where - g :: Synhashed ref -> Name -> Maybe (Name, Name) - g hashed1 alias = - case Map.lookup alias diff of - Just (DiffOp'Update hashed2) | hashed1 == hashed2.new -> Nothing - -- If "foo" was updated but its alias "bar" was deleted, that's ok - Just (DiffOp'Delete _) -> Nothing - _ -> Just (name, alias) - --- Given a name like "base", try "base__1", then "base__2", etc, until we find a name that doesn't --- clash with any existing dependencies. -getTwoFreshNames :: Set NameSegment -> NameSegment -> (NameSegment, NameSegment) -getTwoFreshNames names name0 = - go2 0 - where - -- if - -- name0 = "base" - -- names = {"base__5", "base__6"} - -- then - -- go2 4 = ("base__4", "base__7") - go2 :: Integer -> (NameSegment, NameSegment) - go2 !i - | Set.member name names = go2 (i + 1) - | otherwise = (name, go1 (i + 1)) - where - name = mangled i - - -- if - -- name0 = "base" - -- names = {"base__5", "base__6"} - -- then - -- go1 5 = "base__7" - go1 :: Integer -> NameSegment - go1 !i - | Set.member name names = go1 (i + 1) - | otherwise = name - where - name = mangled i - - mangled :: Integer -> NameSegment - mangled i = - NameSegment (NameSegment.toUnescapedText name0 <> "__" <> tShow i) - -libdepsToBranch0 :: MergeDatabase -> Map NameSegment (V2.CausalBranch Transaction) -> Transaction (Branch0 Transaction) -libdepsToBranch0 db libdeps = do - let branch :: V2.Branch Transaction - branch = - V2.Branch - { terms = Map.empty, - types = Map.empty, - patches = Map.empty, - children = libdeps - } - - -- We make a fresh branch cache to load the branch of libdeps. - -- It would probably be better to reuse the codebase's branch cache. - -- FIXME how slow/bad is this without that branch cache? - branchCache <- Sqlite.unsafeIO newBranchCache - Conversions.branch2to1 branchCache db.loadDeclType branch - typecheckedUnisonFileToBranchAdds :: TypecheckedUnisonFile Symbol Ann -> [(Path, Branch0 m -> Branch0 m)] typecheckedUnisonFileToBranchAdds tuf = do declAdds ++ termAdds @@ -900,43 +629,84 @@ typecheckedUnisonFileToBranchAdds tuf = do splitVar :: Symbol -> Path.Split splitVar = Path.splitFromName . Name.unsafeParseVar +------------------------------------------------------------------------------------------------------------------------ +-- Making file with conflict markers + +makeMergedFileContents :: MergeSourceAndTarget -> Text -> Text -> Text +makeMergedFileContents sourceAndTarget aliceContents bobContents = + let f :: (Text.Builder, Diff.Diff Text) -> Diff.Diff Text -> (Text.Builder, Diff.Diff Text) + f (acc, previous) line = + case (previous, line) of + (Diff.Both {}, Diff.Both bothLine _) -> go (Text.Builder.text bothLine) + (Diff.Both {}, Diff.First aliceLine) -> go (aliceSlug <> Text.Builder.text aliceLine) + (Diff.Both {}, Diff.Second bobLine) -> go (aliceSlug <> middleSlug <> Text.Builder.text bobLine) + (Diff.First {}, Diff.Both bothLine _) -> go (middleSlug <> bobSlug <> Text.Builder.text bothLine) + (Diff.First {}, Diff.First aliceLine) -> go (Text.Builder.text aliceLine) + (Diff.First {}, Diff.Second bobLine) -> go (middleSlug <> Text.Builder.text bobLine) + (Diff.Second {}, Diff.Both bothLine _) -> go (bobSlug <> Text.Builder.text bothLine) + (Diff.Second {}, Diff.First aliceLine) -> go (bobSlug <> aliceSlug <> Text.Builder.text aliceLine) + (Diff.Second {}, Diff.Second bobLine) -> go (Text.Builder.text bobLine) + where + go content = + let !acc1 = acc <> content <> newline + in (acc1, line) + in Diff.getDiff (Text.lines aliceContents) (Text.lines bobContents) + & List.foldl' f (mempty @Text.Builder, Diff.Both Text.empty Text.empty) + & fst + & Text.Builder.run + where + aliceSlug :: Text.Builder + aliceSlug = + "<<<<<<< " <> Text.Builder.text (into @Text sourceAndTarget.alice.branch) <> newline + + middleSlug :: Text.Builder + middleSlug = "=======\n" + + bobSlug :: Text.Builder + bobSlug = + ">>>>>>> " + <> ( case sourceAndTarget.bob of + MergeSource'LocalProjectBranch bobProjectAndBranch -> + Text.Builder.text (into @Text bobProjectAndBranch.branch) + MergeSource'RemoteProjectBranch bobProjectAndBranch -> + "remote " <> Text.Builder.text (into @Text bobProjectAndBranch.branch) + MergeSource'RemoteLooseCode info -> + case Path.toName info.path of + Nothing -> "" + Just name -> Text.Builder.text (Name.toText name) + ) + <> newline + + newline :: Text.Builder + newline = "\n" + ------------------------------------------------------------------------------------------------------------------------ -- Debugging by printing a bunch of stuff out data DebugFunctions = DebugFunctions - { debugCausals :: TwoOrThreeWay (V2.CausalBranch Transaction) -> IO (), - debugDefns :: - ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> - TwoWay DeclNameLookup -> - PartialDeclNameLookup -> - IO (), - debugDiffs :: TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference) -> IO (), - debugCombinedDiff :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> IO (), + { debugCausals :: Merge.TwoOrThreeWay (V2.CausalBranch Transaction) -> IO (), + debugDiffs :: Merge.TwoWay (DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference) -> IO (), + debugCombinedDiff :: DefnsF2 (Map Name) Merge.CombinedDiffOp Referent TypeReference -> IO (), debugPartitionedDiff :: - TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> - DefnsF Unconflicts Referent TypeReference -> - IO (), - debugDependents :: TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> IO (), - debugStageOne :: DefnsF (Map Name) Referent TypeReference -> IO () + Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> + DefnsF Merge.Unconflicts Referent TypeReference -> + IO () } realDebugFunctions :: DebugFunctions realDebugFunctions = DebugFunctions { debugCausals = realDebugCausals, - debugDefns = realDebugDefns, debugDiffs = realDebugDiffs, debugCombinedDiff = realDebugCombinedDiff, - debugPartitionedDiff = realDebugPartitionedDiff, - debugDependents = realDebugDependents, - debugStageOne = realDebugStageOne + debugPartitionedDiff = realDebugPartitionedDiff } fakeDebugFunctions :: DebugFunctions fakeDebugFunctions = - DebugFunctions mempty mempty mempty mempty mempty mempty mempty + DebugFunctions mempty mempty mempty mempty -realDebugCausals :: TwoOrThreeWay (V2.CausalBranch Transaction) -> IO () +realDebugCausals :: Merge.TwoOrThreeWay (V2.CausalBranch Transaction) -> IO () realDebugCausals causals = do Text.putStrLn (Text.bold "\n=== Alice causal hash ===") Text.putStrLn (Hash.toBase32HexText (unCausalHash causals.alice.causalHash)) @@ -947,37 +717,19 @@ realDebugCausals causals = do Nothing -> "Nothing" Just causal -> "Just " <> Hash.toBase32HexText (unCausalHash causal.causalHash) -realDebugDefns :: - ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> - TwoWay DeclNameLookup -> - PartialDeclNameLookup -> - IO () -realDebugDefns defns declNameLookups _lcaDeclNameLookup = do - Text.putStrLn (Text.bold "\n=== Alice definitions ===") - debugDefns1 (bimap BiMultimap.range BiMultimap.range defns.alice) - - Text.putStrLn (Text.bold "\n=== Bob definitions ===") - debugDefns1 (bimap BiMultimap.range BiMultimap.range defns.bob) - - Text.putStrLn (Text.bold "\n=== Alice constructor names ===") - debugConstructorNames declNameLookups.alice.declToConstructors - - Text.putStrLn (Text.bold "\n=== Bob constructor names ===") - debugConstructorNames declNameLookups.bob.declToConstructors - -realDebugDiffs :: TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference) -> IO () +realDebugDiffs :: Merge.TwoWay (DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference) -> IO () realDebugDiffs diffs = do Text.putStrLn (Text.bold "\n=== LCA→Alice diff ===") renderDiff diffs.alice Text.putStrLn (Text.bold "\n=== LCA→Bob diff ===") renderDiff diffs.bob where - renderDiff :: DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference -> IO () + renderDiff :: DefnsF3 (Map Name) Merge.DiffOp Merge.Synhashed Referent TypeReference -> IO () renderDiff diff = do renderThings referentLabel diff.terms renderThings (const "type") diff.types - renderThings :: (ref -> Text) -> Map Name (DiffOp (Synhashed ref)) -> IO () + renderThings :: (ref -> Text) -> Map Name (Merge.DiffOp (Merge.Synhashed ref)) -> IO () renderThings label things = for_ (Map.toList things) \(name, op) -> let go color action x = @@ -990,21 +742,21 @@ realDebugDiffs diffs = do <> " #" <> Hash.toBase32HexText (Synhashed.hash x) in Text.putStrLn case op of - DiffOp'Add x -> go Text.green "+" x - DiffOp'Delete x -> go Text.red "-" x - DiffOp'Update x -> go Text.yellow "%" x.new + Merge.DiffOp'Add x -> go Text.green "+" x + Merge.DiffOp'Delete x -> go Text.red "-" x + Merge.DiffOp'Update x -> go Text.yellow "%" x.new -realDebugCombinedDiff :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> IO () +realDebugCombinedDiff :: DefnsF2 (Map Name) Merge.CombinedDiffOp Referent TypeReference -> IO () realDebugCombinedDiff diff = do Text.putStrLn (Text.bold "\n=== Combined diff ===") renderThings referentLabel Referent.toText diff.terms renderThings (const "type") Reference.toText diff.types where - renderThings :: (ref -> Text) -> (ref -> Text) -> Map Name (CombinedDiffOp ref) -> IO () + renderThings :: (ref -> Text) -> (ref -> Text) -> Map Name (Merge.CombinedDiffOp ref) -> IO () renderThings label renderRef things = for_ (Map.toList things) \(name, op) -> Text.putStrLn case op of - CombinedDiffOp'Add who -> + Merge.CombinedDiffOp'Add who -> Text.green $ "+ " <> Text.italic (label (EitherWayI.value who)) @@ -1015,7 +767,7 @@ realDebugCombinedDiff diff = do <> " (" <> renderWho who <> ")" - CombinedDiffOp'Delete who -> + Merge.CombinedDiffOp'Delete who -> Text.red $ "- " <> Text.italic (label (EitherWayI.value who)) @@ -1026,7 +778,7 @@ realDebugCombinedDiff diff = do <> " (" <> renderWho who <> ")" - CombinedDiffOp'Update who -> + Merge.CombinedDiffOp'Update who -> Text.yellow $ "% " <> Text.italic (label (EitherWayI.value who).new) @@ -1037,7 +789,7 @@ realDebugCombinedDiff diff = do <> " (" <> renderWho who <> ")" - CombinedDiffOp'Conflict ref -> + Merge.CombinedDiffOp'Conflict ref -> Text.magenta $ "! " <> Text.italic (label ref.alice) @@ -1050,24 +802,24 @@ realDebugCombinedDiff diff = do <> "/" <> renderRef ref.bob - renderWho :: EitherWayI v -> Text + renderWho :: Merge.EitherWayI v -> Text renderWho = \case - OnlyAlice _ -> "Alice" - OnlyBob _ -> "Bob" - AliceAndBob _ -> "Alice and Bob" + Merge.OnlyAlice _ -> "Alice" + Merge.OnlyBob _ -> "Bob" + Merge.AliceAndBob _ -> "Alice and Bob" realDebugPartitionedDiff :: - TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> - DefnsF Unconflicts Referent TypeReference -> + Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> + DefnsF Merge.Unconflicts Referent TypeReference -> IO () realDebugPartitionedDiff conflicts unconflicts = do Text.putStrLn (Text.bold "\n=== Alice conflicts ===") - renderConflicts "termid" conflicts.alice.terms (Alice ()) - renderConflicts "typeid" conflicts.alice.types (Alice ()) + renderConflicts "termid" conflicts.alice.terms (Merge.Alice ()) + renderConflicts "typeid" conflicts.alice.types (Merge.Alice ()) Text.putStrLn (Text.bold "\n=== Bob conflicts ===") - renderConflicts "termid" conflicts.bob.terms (Bob ()) - renderConflicts "typeid" conflicts.bob.types (Bob ()) + renderConflicts "termid" conflicts.bob.terms (Merge.Bob ()) + renderConflicts "typeid" conflicts.bob.types (Merge.Bob ()) Text.putStrLn (Text.bold "\n=== Alice unconflicts ===") renderUnconflicts Text.green "+" referentLabel Referent.toText unconflicts.terms.adds.alice @@ -1093,7 +845,7 @@ realDebugPartitionedDiff conflicts unconflicts = do renderUnconflicts Text.yellow "%" referentLabel Referent.toText unconflicts.terms.updates.both renderUnconflicts Text.yellow "%" (const "type") Reference.toText unconflicts.types.updates.both where - renderConflicts :: Text -> Map Name Reference.Id -> EitherWay () -> IO () + renderConflicts :: Text -> Map Name Reference.Id -> Merge.EitherWay () -> IO () renderConflicts label conflicts who = for_ (Map.toList conflicts) \(name, ref) -> Text.putStrLn $ @@ -1105,7 +857,7 @@ realDebugPartitionedDiff conflicts unconflicts = do <> " " <> Reference.idToText ref <> " (" - <> (case who of Alice () -> "Alice"; Bob () -> "Bob") + <> (case who of Merge.Alice () -> "Alice"; Merge.Bob () -> "Bob") <> ")" renderUnconflicts :: @@ -1127,45 +879,6 @@ realDebugPartitionedDiff conflicts unconflicts = do <> " " <> renderRef ref -realDebugDependents :: TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> IO () -realDebugDependents dependents = do - Text.putStrLn (Text.bold "\n=== Alice dependents of Bob deletes, Bob updates, and Alice conflicts ===") - renderThings "termid" dependents.alice.terms - renderThings "typeid" dependents.alice.types - Text.putStrLn (Text.bold "\n=== Bob dependents of Alice deletes, Alice updates, and Bob conflicts ===") - renderThings "termid" dependents.bob.terms - renderThings "typeid" dependents.bob.types - where - renderThings :: Text -> Map Name Reference.Id -> IO () - renderThings label things = - for_ (Map.toList things) \(name, ref) -> - Text.putStrLn $ - Text.italic label - <> " " - <> Name.toText name - <> " " - <> Reference.idToText ref - -realDebugStageOne :: DefnsF (Map Name) Referent TypeReference -> IO () -realDebugStageOne defns = do - Text.putStrLn (Text.bold "\n=== Stage 1 ===") - debugDefns1 defns - -debugConstructorNames :: Map Name [Name] -> IO () -debugConstructorNames names = - for_ (Map.toList names) \(typeName, conNames) -> - Text.putStrLn (Name.toText typeName <> " => " <> Text.intercalate ", " (map Name.toText conNames)) - -debugDefns1 :: DefnsF (Map Name) Referent TypeReference -> IO () -debugDefns1 defns = do - renderThings referentLabel Referent.toText defns.terms - renderThings (const "type") Reference.toText defns.types - where - renderThings :: (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO () - renderThings label renderRef things = - for_ (Map.toList things) \(name, ref) -> - Text.putStrLn (Text.italic (label ref) <> " " <> Name.toText name <> " " <> renderRef ref) - referentLabel :: Referent -> Text referentLabel ref | Referent'.isConstructor ref = "constructor" diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs index aa35d39dde..e801b43393 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs @@ -9,7 +9,7 @@ import Data.Map qualified as Map import Data.Set qualified as Set import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli -import Unison.Cli.PrettyPrintUtils qualified as Cli +import Unison.Cli.NamesUtils qualified as Cli import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) @@ -22,7 +22,9 @@ import Unison.LabeledDependency qualified as LD import Unison.Name (Name) import Unison.NameSegment qualified as NameSegment import Unison.Prelude +import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPED +import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent import Unison.Sqlite qualified as Sqlite @@ -40,7 +42,9 @@ handleNamespaceDependencies namespacePath' = do Cli.returnEarly (Output.BranchEmpty (Output.WhichBranchEmptyPath pp)) externalDependencies <- Cli.runTransaction (namespaceDependencies codebase branch) - pped <- Cli.projectBranchPPED pb + names <- Cli.projectBranchNames pb + + let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) let ppe = PPED.unsuffixifiedPPE pped Cli.respondNumbered $ Output.ListNamespaceDependencies ppe pp externalDependencies diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs index 4dce00e742..b6265e4fec 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs @@ -10,7 +10,6 @@ import Unison.Builtin qualified as Builtin import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.NamesUtils qualified as Cli -import Unison.Cli.PrettyPrintUtils qualified as Cli import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) @@ -21,7 +20,9 @@ import Unison.DataDeclaration qualified as DD import Unison.Parser.Ann (Ann (..)) import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE +import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPED +import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Reference (Reference) import Unison.Reference qualified as Reference import Unison.Sqlite qualified as Sqlite @@ -37,7 +38,8 @@ diffHelper before after = hqLength <- Cli.runTransaction Codebase.hashLength diff <- liftIO (BranchDiff.diff0 before after) names <- Cli.currentNames <&> \currentNames -> currentNames <> Branch.toNames before <> Branch.toNames after - pped <- Cli.prettyPrintEnvDeclFromNames names + let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) + let suffixifiedPPE = PPED.suffixifiedPPE pped fmap (suffixifiedPPE,) do OBranchDiff.toOutput diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs index dcb684b168..9cf1cbeaff 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs @@ -13,7 +13,6 @@ import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.NamesUtils qualified as Cli -import Unison.Cli.PrettyPrintUtils qualified as Cli import Unison.Codebase qualified as Codebase import Unison.Codebase.Editor.HandleInput.Load (EvalMode (Native, Permissive), evalUnisonFile) import Unison.Codebase.Editor.Output qualified as Output @@ -25,7 +24,9 @@ import Unison.Name (Name) import Unison.Parser.Ann (Ann (External)) import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE +import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPED +import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Reference qualified as Reference import Unison.Result qualified as Result import Unison.Symbol (Symbol) @@ -40,6 +41,8 @@ import Unison.Typechecker.TypeLookup qualified as TypeLookup import Unison.UnisonFile (TypecheckedUnisonFile) import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Names qualified as UF +import Unison.Util.Defns (Defns (..)) +import Unison.Util.Recursion import Unison.Var qualified as Var handleRun :: Bool -> HQ.HashQualified Name -> [String] -> Cli () @@ -50,7 +53,7 @@ handleRun native main args = do pure (uf, otyp) names <- Cli.currentNames let namesWithFileDefinitions = UF.addNamesFromTypeCheckedUnisonFile unisonFile names - pped <- Cli.prettyPrintEnvDeclFromNames namesWithFileDefinitions + let pped = PPED.makePPED (PPE.hqNamer 10 namesWithFileDefinitions) (PPE.suffixifyByHash namesWithFileDefinitions) let suffixifiedPPE = PPED.suffixifiedPPE pped let mode | native = Native | otherwise = Permissive (_, xs) <- evalUnisonFile mode suffixifiedPPE unisonFile args @@ -82,12 +85,14 @@ getTerm main = getTerm' main >>= \case NoTermWithThatName -> do mainType <- Runtime.mainType <$> view #runtime - pped <- Cli.currentPrettyPrintEnvDecl + names <- Cli.currentNames + let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) let suffixifiedPPE = PPED.suffixifiedPPE pped Cli.returnEarly $ Output.NoMainFunction main suffixifiedPPE [mainType] TermHasBadType ty -> do mainType <- Runtime.mainType <$> view #runtime - pped <- Cli.currentPrettyPrintEnvDecl + names <- Cli.currentNames + let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) let suffixifiedPPE = PPED.suffixifiedPPE pped Cli.returnEarly $ Output.BadMainFunction "run" main ty suffixifiedPPE [mainType] GetTermSuccess x -> pure x @@ -124,7 +129,9 @@ getTerm' mainName = Cli.Env {codebase, runtime} <- ask case Typechecker.fitsScheme ty (Runtime.mainType runtime) of True -> do - typeLookup <- Cli.runTransaction (Codebase.typeLookupForDependencies codebase (Type.dependencies ty)) + typeLookup <- + Cli.runTransaction $ + Codebase.typeLookupForDependencies codebase Defns {terms = Set.empty, types = Type.dependencies ty} f $! synthesizeForce typeLookup ty False -> pure (TermHasBadType ty) in Cli.getLatestTypecheckedFile >>= \case @@ -159,7 +166,8 @@ synthesizeForce tl typeOfFunc = do Typechecker.Env { ambientAbilities = [DD.exceptionType External, Type.builtinIO External], typeLookup = mempty {TypeLookup.typeOfTerms = Map.singleton ref typeOfFunc} <> tl, - termsByShortname = Map.empty + termsByShortname = Map.empty, + topLevelComponents = Map.empty } case Result.runResultT ( Typechecker.synthesize @@ -194,7 +202,7 @@ stripUnisonFileReferences :: TypecheckedUnisonFile Symbol a -> Term Symbol () -> stripUnisonFileReferences unisonFile term = let refMap :: Map Reference.Id Symbol refMap = Map.fromList . map (\(sym, (_, refId, _, _, _)) -> (refId, sym)) . Map.toList . UF.hashTermsId $ unisonFile - alg () = \case + alg (ABT.Term' _ () abt) = case abt of ABT.Var x -> ABT.var x ABT.Cycle x -> ABT.cycle x ABT.Abs v x -> ABT.abs v x @@ -202,7 +210,7 @@ stripUnisonFileReferences unisonFile term = Term.Ref ref | Just var <- (\k -> Map.lookup k refMap) =<< Reference.toId ref -> ABT.var var x -> ABT.tm x - in ABT.cata alg term + in cata alg term magicMainWatcherString :: String magicMainWatcherString = "main" diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/RuntimeUtils.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/RuntimeUtils.hs index df86793ff4..96f2b098fa 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/RuntimeUtils.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/RuntimeUtils.hs @@ -3,6 +3,8 @@ module Unison.Codebase.Editor.HandleInput.RuntimeUtils evalUnisonTermE, evalPureUnison, displayDecompileErrors, + selectRuntime, + EvalMode (..), ) where @@ -13,6 +15,7 @@ import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Codebase qualified as Codebase import Unison.Codebase.Editor.Output +import Unison.Codebase.Execute qualified as Codebase import Unison.Codebase.Runtime qualified as Runtime import Unison.Hashing.V2.Convert qualified as Hashing import Unison.Parser.Ann (Ann (..)) @@ -27,6 +30,15 @@ import Unison.Term qualified as Term import Unison.Util.Pretty qualified as P import Unison.WatchKind qualified as WK +data EvalMode = Sandboxed | Permissive | Native + +selectRuntime :: EvalMode -> Cli (Runtime.Runtime Symbol) +selectRuntime mode = + ask <&> \Cli.Env {runtime, sandboxedRuntime, nativeRuntime} -> case mode of + Permissive -> runtime + Sandboxed -> sandboxedRuntime + Native -> nativeRuntime + displayDecompileErrors :: [Runtime.Error] -> Cli () displayDecompileErrors errs = Cli.respond (PrintMessage msg) where @@ -40,14 +52,14 @@ displayDecompileErrors errs = Cli.respond (PrintMessage msg) -- | Evaluate a single closed definition. evalUnisonTermE :: - Bool -> + EvalMode -> PPE.PrettyPrintEnv -> Bool -> Term Symbol Ann -> Cli (Either Runtime.Error (Term Symbol Ann)) -evalUnisonTermE sandbox ppe useCache tm = do - Cli.Env {codebase, runtime, sandboxedRuntime} <- ask - let theRuntime = if sandbox then sandboxedRuntime else runtime +evalUnisonTermE mode ppe useCache tm = do + Cli.Env {codebase} <- ask + theRuntime <- selectRuntime mode let watchCache :: Reference.Id -> IO (Maybe (Term Symbol ())) watchCache ref = do @@ -55,7 +67,7 @@ evalUnisonTermE sandbox ppe useCache tm = do pure (Term.amap (\(_ :: Ann) -> ()) <$> maybeTerm) let cache = if useCache then watchCache else Runtime.noCache - r <- liftIO (Runtime.evaluateTerm' (Codebase.toCodeLookup codebase) cache ppe theRuntime tm) + r <- liftIO (Runtime.evaluateTerm' (Codebase.codebaseToCodeLookup codebase) cache ppe theRuntime tm) when useCache do case r of Right (errs, tmr) @@ -72,22 +84,25 @@ evalUnisonTermE sandbox ppe useCache tm = do -- | Evaluate a single closed definition. evalUnisonTerm :: - Bool -> + EvalMode -> PPE.PrettyPrintEnv -> Bool -> Term Symbol Ann -> Cli (Term Symbol Ann) -evalUnisonTerm sandbox ppe useCache tm = - evalUnisonTermE sandbox ppe useCache tm & onLeftM \err -> +evalUnisonTerm mode ppe useCache tm = + evalUnisonTermE mode ppe useCache tm & onLeftM \err -> Cli.returnEarly (EvaluationFailure err) evalPureUnison :: + Bool -> PPE.PrettyPrintEnv -> Bool -> Term Symbol Ann -> Cli (Either Runtime.Error (Term Symbol Ann)) -evalPureUnison ppe useCache tm = evalUnisonTermE False ppe useCache tm' +evalPureUnison native ppe useCache tm = + evalUnisonTermE mode ppe useCache tm' where + mode = if native then Native else Permissive tm' = Term.iff a diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ShowDefinition.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ShowDefinition.hs index 0c4cfada13..2d451150ea 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ShowDefinition.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ShowDefinition.hs @@ -1,31 +1,104 @@ -module Unison.Codebase.Editor.HandleInput.ShowDefinition (showDefinitions) where +module Unison.Codebase.Editor.HandleInput.ShowDefinition + ( handleShowDefinition, + showDefinitions, + ) +where import Control.Lens import Control.Monad.Reader (ask) import Control.Monad.State qualified as State +import Data.List qualified as List +import Data.List.NonEmpty qualified as List (NonEmpty) +import Data.List.NonEmpty qualified as List.NonEmpty import Data.Map qualified as Map import Data.Set qualified as Set import Data.Text qualified as Text import Unison.Builtin.Decls qualified as DD import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli +import Unison.Cli.MonadUtils qualified as Cli +import Unison.Cli.NamesUtils qualified as Cli import Unison.Cli.Pretty qualified as Pretty import Unison.Codebase qualified as Codebase +import Unison.Codebase.Branch qualified as Branch +import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.Editor.DisplayObject (DisplayObject) -import Unison.Codebase.Editor.Input +import Unison.Codebase.Editor.Input (OutputLocation (..), RelativeToFold (..), ShowDefinitionScope (..)) import Unison.Codebase.Editor.Output import Unison.DataDeclaration (Decl) +import Unison.DataDeclaration qualified as DD import Unison.HashQualified qualified as HQ import Unison.Name (Name) +import Unison.Name qualified as Name +import Unison.Names qualified as Names +import Unison.NamesWithHistory qualified as Names import Unison.Parser.Ann (Ann) import Unison.Prelude +import Unison.PrettyPrintEnv qualified as PPE +import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPED +import Unison.PrettyPrintEnvDecl.Names qualified as PPED +import Unison.Reference (Reference, TermReferenceId) import Unison.Reference qualified as Reference +import Unison.Referent qualified as Referent +import Unison.Server.Backend qualified as Backend +import Unison.Server.NameSearch.FromNames qualified as NameSearch import Unison.Symbol (Symbol) +import Unison.Syntax.Name qualified as Name (toVar) +import Unison.Syntax.NamePrinter (SyntaxText) import Unison.Term (Term) import Unison.Type (Type) +import Unison.UnisonFile (TypecheckedUnisonFile (..), UnisonFile (..)) +import Unison.UnisonFile qualified as UnisonFile +import Unison.Util.Defns (Defns (..)) +import Unison.Util.Pretty (Pretty) import Unison.Util.Pretty qualified as Pretty import Unison.Util.Set qualified as Set +import Unison.WatchKind qualified as WatchKind + +-- | Handle a @ShowDefinitionI@ input command, i.e. `view` or `edit`. +handleShowDefinition :: OutputLocation -> ShowDefinitionScope -> List.NonEmpty (HQ.HashQualified Name) -> Cli () +handleShowDefinition outputLoc showDefinitionScope query = do + env <- ask + + let hasAbsoluteQuery = any (any Name.isAbsolute) query + (names, unbiasedPPED) <- case (hasAbsoluteQuery, showDefinitionScope) of + -- TODO: We should instead print each definition using the names from its project-branch root. + (True, _) -> do + root <- Cli.getCurrentProjectRoot + let root0 = Branch.head root + let names = Names.makeAbsolute (Branch.toNames root0) + let pped = PPED.makePPED (PPE.hqNamer 10 names) (suffixify names) + pure (names, pped) + (_, ShowDefinitionGlobal) -> do + -- TODO: Maybe rewrite to be properly global + root <- Cli.getCurrentProjectRoot + let root0 = Branch.head root + let names = Names.makeAbsolute $ Branch.toNames root0 + let pped = PPED.makePPED (PPE.hqNamer 10 names) (suffixify names) + pure (names, pped) + (_, ShowDefinitionLocal) -> do + currentNames <- Cli.currentNames + let pped = PPED.makePPED (PPE.hqNamer 10 currentNames) (suffixify currentNames) + pure (currentNames, pped) + let pped = PPED.biasTo (mapMaybe HQ.toName (List.NonEmpty.toList query)) unbiasedPPED + Backend.DefinitionResults terms types misses <- do + let nameSearch = NameSearch.makeNameSearch 10 names + Cli.runTransaction (Backend.definitionsByName env.codebase nameSearch includeCycles Names.IncludeSuffixes (toList query)) + showDefinitions outputLoc pped terms types misses + where + suffixify = + case outputLoc of + ConsoleLocation -> PPE.suffixifyByHash + FileLocation _ _ -> PPE.suffixifyByHashName + LatestFileLocation _ -> PPE.suffixifyByHashName + + -- `view`: don't include cycles; `edit`: include cycles + includeCycles = + case outputLoc of + ConsoleLocation -> Backend.DontIncludeCycles + FileLocation _ _ -> Backend.IncludeCycles + LatestFileLocation _ -> Backend.IncludeCycles -- | Show the provided definitions to console or scratch file. -- The caller is responsible for ensuring that the definitions include cycles if that's @@ -41,7 +114,7 @@ showDefinitions :: [HQ.HashQualified Name] -> Cli () showDefinitions outputLoc pped terms types misses = do - Cli.Env {codebase, writeSource} <- ask + env <- ask outputPath <- getOutputPath case outputPath of _ | null terms && null types -> pure () @@ -50,37 +123,130 @@ showDefinitions outputLoc pped terms types misses = do let isTest _ = False let isSourceFile = False -- No filepath, render code to console. - let renderedCodePretty = renderCodePretty pped isSourceFile isTest terms types + let (renderedCodePretty, _numRendered) = + renderCodePretty + pped + isSourceFile + isTest + terms + types + (Defns Set.empty Set.empty) Cli.respond $ DisplayDefinitions renderedCodePretty - Just fp -> do + Just (fp, relToFold) -> do + -- Of all the names we were asked to show, if this is a `WithinFold` showing, then exclude the ones that are + -- already bound in the file + excludeNames <- + case relToFold of + AboveFold -> pure (Defns Set.empty Set.empty) + WithinFold -> + use #latestTypecheckedFile <&> \case + Nothing -> Defns Set.empty Set.empty + Just (Left unisonFile) -> + let boundTermNames = Map.keysSet unisonFile.terms + boundTestWatchNames = + Map.toList unisonFile.watches + & foldMap \case + (WatchKind.TestWatch, watches) -> Set.fromList (map (view _1) watches) + _ -> Set.empty + boundDataDeclNames = Map.keysSet unisonFile.dataDeclarationsId + boundEffectDeclNames = Map.keysSet unisonFile.effectDeclarationsId + in Defns + { terms = boundTermNames <> boundTestWatchNames, + types = boundDataDeclNames <> boundEffectDeclNames + } + Just (Right typecheckedUnisonFile) -> + let boundTermNames = foldMap (Set.fromList . map (view _1)) typecheckedUnisonFile.topLevelComponents' + boundTestWatchNames = + typecheckedUnisonFile.watchComponents & foldMap \case + (WatchKind.TestWatch, watches) -> Set.fromList (map (view _1) watches) + _ -> Set.empty + in Defns + { terms = boundTermNames <> boundTestWatchNames, + types = UnisonFile.typeNamespaceBindings typecheckedUnisonFile + } + -- We build an 'isTest' check to prepend "test>" to tests in a scratch file. - testRefs <- Cli.runTransaction (Codebase.filterTermsByReferenceIdHavingType codebase (DD.testResultListType mempty) (Map.keysSet terms & Set.mapMaybe Reference.toId)) + testRefs <- + Cli.runTransaction do + Codebase.filterTermsByReferenceIdHavingType + env.codebase + (DD.testResultListType mempty) + (Map.keysSet terms & Set.mapMaybe Reference.toId) let isTest r = Set.member r testRefs let isSourceFile = True - let renderedCodePretty = renderCodePretty pped isSourceFile isTest terms types - let renderedCodeText = Text.pack $ Pretty.toPlain 80 renderedCodePretty + let (renderedCodePretty, numRendered) = renderCodePretty pped isSourceFile isTest terms types excludeNames + when (numRendered > 0) do + let renderedCodeText = Text.pack $ Pretty.toPlain 80 renderedCodePretty + + -- We set latestFile to be programmatically generated, if we + -- are viewing these definitions to a file - this will skip the + -- next update for that file (which will happen immediately) + #latestFile ?= (fp, True) + liftIO $ + env.writeSource (Text.pack fp) renderedCodeText case relToFold of + AboveFold -> True + WithinFold -> False + Cli.respond $ LoadedDefinitionsToSourceFile fp numRendered - -- We set latestFile to be programmatically generated, if we - -- are viewing these definitions to a file - this will skip the - -- next update for that file (which will happen immediately) - #latestFile ?= (fp, True) - liftIO $ writeSource (Text.pack fp) renderedCodeText - let numDefinitions = Map.size terms + Map.size types - Cli.respond $ LoadedDefinitionsToSourceFile fp numDefinitions when (not (null misses)) (Cli.respond (SearchTermsNotFound misses)) where -- Get the file path to send the definition(s) to. `Nothing` means the terminal. - getOutputPath :: Cli (Maybe FilePath) + getOutputPath :: Cli (Maybe (FilePath, RelativeToFold)) getOutputPath = case outputLoc of ConsoleLocation -> pure Nothing - FileLocation path -> pure (Just path) - LatestFileLocation -> do + FileLocation path relToFold -> pure (Just (path, relToFold)) + LatestFileLocation relToFold -> do loopState <- State.get pure case loopState ^. #latestFile of - Nothing -> Just "scratch.u" - Just (path, _) -> Just path + Nothing -> Just ("scratch.u", relToFold) + Just (path, _) -> Just (path, relToFold) + + renderCodePretty pped isSourceFile isTest terms types excludeNames = + let prettyTypes = prettyTypeDisplayObjects pped types excludeNames.types + prettyTerms = prettyTermDisplayObjects pped isSourceFile isTest terms excludeNames.terms + in ( Pretty.syntaxToColor (Pretty.sep "\n\n" (prettyTypes ++ prettyTerms)), + length prettyTerms + length prettyTypes + ) - renderCodePretty pped isSourceFile isTest terms types = - Pretty.syntaxToColor . Pretty.sep "\n\n" $ - Pretty.prettyTypeDisplayObjects pped types <> Pretty.prettyTermDisplayObjects pped isSourceFile isTest terms +prettyTypeDisplayObjects :: + PPED.PrettyPrintEnvDecl -> + (Map Reference (DisplayObject () (DD.Decl Symbol Ann))) -> + Set Symbol -> + [Pretty SyntaxText] +prettyTypeDisplayObjects pped types excludeNames = + types + & Map.toList + & mapMaybe + ( \(ref, dt) -> do + let hqName = PPE.typeName unsuffixifiedPPE ref + whenJust (HQ.toName hqName) \name -> + guard (Set.notMember (Name.toVar name) excludeNames) + Just (hqName, ref, dt) + ) + & List.sortBy (\(n0, _, _) (n1, _, _) -> Name.compareAlphabetical n0 n1) + & map (Pretty.prettyType pped) + where + unsuffixifiedPPE = PPED.unsuffixifiedPPE pped + +prettyTermDisplayObjects :: + PPED.PrettyPrintEnvDecl -> + Bool -> + (TermReferenceId -> Bool) -> + (Map Reference.TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))) -> + Set Symbol -> + [Pretty SyntaxText] +prettyTermDisplayObjects pped isSourceFile isTest terms excludeNames = + terms + & Map.toList + & mapMaybe + ( \(ref, dt) -> do + let hqName = PPE.termName unsuffixifiedPPE (Referent.Ref ref) + whenJust (HQ.toName hqName) \name -> + guard (Set.notMember (Name.toVar name) excludeNames) + Just (hqName, ref, dt) + ) + & List.sortBy (\(n0, _, _) (n1, _, _) -> Name.compareAlphabetical n0 n1) + & map (\t -> Pretty.prettyTerm pped isSourceFile (fromMaybe False . fmap isTest . Reference.toId $ (t ^. _2)) t) + where + unsuffixifiedPPE = PPED.unsuffixifiedPPE pped diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs index a63ab11a0b..ddc2fe39d2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs @@ -15,7 +15,6 @@ import Data.Set (fromList, toList) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.NamesUtils qualified as Cli -import Unison.Cli.PrettyPrintUtils qualified as Cli import Unison.Codebase qualified as Codebase import Unison.Codebase.Editor.Output (Output (..)) import Unison.Codebase.Path (hqSplitFromName') @@ -27,7 +26,9 @@ import Unison.Names (Names) import Unison.NamesWithHistory qualified as Names import Unison.Parser.Ann (Ann) import Unison.PrettyPrintEnv (PrettyPrintEnv) +import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPED +import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Reference (Reference) import Unison.Referent (Referent, pattern Con, pattern Ref) import Unison.Symbol (Symbol) @@ -74,7 +75,7 @@ lookupTermRefWithType codebase name = do resolveTerm :: HQ.HashQualified Name -> Cli Referent resolveTerm name = do names <- Cli.currentNames - pped <- Cli.prettyPrintEnvDeclFromNames names + let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) let suffixifiedPPE = PPED.suffixifiedPPE pped case lookupTerm name names of [] -> Cli.returnEarly (TermNotFound $ fromJust parsed) @@ -87,7 +88,7 @@ resolveTerm name = do resolveCon :: HQ.HashQualified Name -> Cli ConstructorReference resolveCon name = do names <- Cli.currentNames - pped <- Cli.prettyPrintEnvDeclFromNames names + let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) let suffixifiedPPE = PPED.suffixifiedPPE pped case lookupCon name names of ([], _) -> Cli.returnEarly (TermNotFound $ fromJust parsed) @@ -100,7 +101,7 @@ resolveCon name = do resolveTermRef :: HQ.HashQualified Name -> Cli Reference resolveTermRef name = do names <- Cli.currentNames - pped <- Cli.prettyPrintEnvDeclFromNames names + let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) let suffixifiedPPE = PPED.suffixifiedPPE pped case lookupTermRefs name names of ([], _) -> Cli.returnEarly (TermNotFound $ fromJust parsed) @@ -114,7 +115,7 @@ resolveMainRef :: HQ.HashQualified Name -> Cli (Reference, PrettyPrintEnv) resolveMainRef main = do Cli.Env {codebase, runtime} <- ask names <- Cli.currentNames - pped <- Cli.prettyPrintEnvDeclFromNames names + let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) let suffixifiedPPE = PPED.suffixifiedPPE pped let mainType = Runtime.mainType runtime lookupTermRefWithType codebase main >>= \case diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs index 409f7bac89..867fed7704 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs @@ -20,9 +20,9 @@ import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.NamesUtils qualified as Cli -import Unison.Cli.PrettyPrintUtils qualified as Cli import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch +import Unison.Codebase.Editor.HandleInput.RuntimeUtils (EvalMode (..)) import Unison.Codebase.Editor.HandleInput.RuntimeUtils qualified as RuntimeUtils import Unison.Codebase.Editor.Input (TestInput (..)) import Unison.Codebase.Editor.Output @@ -38,7 +38,9 @@ import Unison.NamesWithHistory qualified as Names import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE +import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPED +import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Reference (TermReferenceId) import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent @@ -58,8 +60,8 @@ import Unison.WatchKind qualified as WK -- | Handle a @test@ command. -- Run pure tests in the current subnamespace. -handleTest :: TestInput -> Cli () -handleTest TestInput {includeLibNamespace, path, showFailures, showSuccesses} = do +handleTest :: Bool -> TestInput -> Cli () +handleTest native TestInput {includeLibNamespace, path, showFailures, showSuccesses} = do Cli.Env {codebase} <- ask testRefs <- findTermsOfTypes codebase includeLibNamespace path (NESet.singleton (DD.testResultListType mempty)) @@ -91,7 +93,7 @@ handleTest TestInput {includeLibNamespace, path, showFailures, showSuccesses} = _ -> Nothing let stats = Output.CachedTests (Set.size testRefs) (Map.size cachedTests) names <- Cli.currentNames - pped <- Cli.prettyPrintEnvDeclFromNames names + let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) let fqnPPE = PPED.unsuffixifiedPPE pped Cli.respondNumbered $ TestResults @@ -113,7 +115,7 @@ handleTest TestInput {includeLibNamespace, path, showFailures, showSuccesses} = Just tm -> do Cli.respond $ TestIncrementalOutputStart fqnPPE (n, total) r -- v don't cache; test cache populated below - tm' <- RuntimeUtils.evalPureUnison fqnPPE False tm + tm' <- RuntimeUtils.evalPureUnison native fqnPPE False tm case tm' of Left e -> do Cli.respond (EvaluationFailure e) @@ -128,11 +130,12 @@ handleTest TestInput {includeLibNamespace, path, showFailures, showSuccesses} = (mFails, mOks) = passFails m Cli.respondNumbered $ TestResults Output.NewlyComputed fqnPPE showSuccesses showFailures mOks mFails -handleIOTest :: HQ.HashQualified Name -> Cli () -handleIOTest main = do - Cli.Env {runtime} <- ask +handleIOTest :: Bool -> HQ.HashQualified Name -> Cli () +handleIOTest native main = do + let mode = if native then Native else Permissive + runtime <- RuntimeUtils.selectRuntime mode names <- Cli.currentNames - pped <- Cli.prettyPrintEnvDeclFromNames names + let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) let suffixifiedPPE = PPED.suffixifiedPPE pped let isIOTest typ = Foldable.any (Typechecker.isSubtype typ) $ Runtime.ioTestTypes runtime refs <- resolveHQNames names (Set.singleton main) @@ -161,11 +164,13 @@ findTermsOfTypes codebase includeLib path filterTypes = do filterTypes & foldMapM \matchTyp -> do Codebase.filterTermsByReferenceIdHavingType codebase matchTyp possibleTests -handleAllIOTests :: Cli () -handleAllIOTests = do - Cli.Env {codebase, runtime} <- ask +handleAllIOTests :: Bool -> Cli () +handleAllIOTests native = do + Cli.Env {codebase} <- ask + let mode = if native then Native else Permissive + runtime <- RuntimeUtils.selectRuntime mode names <- Cli.currentNames - pped <- Cli.prettyPrintEnvDeclFromNames names + let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) let suffixifiedPPE = PPED.suffixifiedPPE pped ioTestRefs <- findTermsOfTypes codebase False Path.empty (Runtime.ioTestTypes runtime) case NESet.nonEmptySet ioTestRefs of @@ -213,7 +218,7 @@ runIOTest ppe ref = do let a = ABT.annotation tm tm = DD.forceTerm a a (Term.refId a ref) -- Don't cache IO tests - tm' <- RuntimeUtils.evalUnisonTerm False ppe False tm + tm' <- RuntimeUtils.evalUnisonTerm Permissive ppe False tm pure $ partitionTestResults tm' partitionTestResults :: Term Symbol Ann -> ([Text {- fails -}], [Text {- oks -}]) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs index 108ceee2a4..2f08a72a6d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Todo.hs @@ -12,7 +12,6 @@ import Unison.Builtin qualified as Builtin import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli -import Unison.Cli.PrettyPrintUtils qualified as Cli import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch @@ -23,6 +22,8 @@ import Unison.Hash (HashFor (..)) import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReasons (..), checkAllDeclCoherency) import Unison.Names qualified as Names import Unison.Prelude +import Unison.PrettyPrintEnv.Names qualified as PPE +import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Reference (TermReference) import Unison.Syntax.Name qualified as Name import Unison.Util.Defns (Defns (..)) @@ -76,7 +77,8 @@ handleTodo = do pure (defnsInLib, dependentsOfTodo.terms, directDependencies, hashLen, incoherentDeclReasons) - ppe <- Cli.currentPrettyPrintEnvDecl + let currentNames = Branch.toNames currentNamespace + let ppe = PPED.makePPED (PPE.hqNamer 10 currentNames) (PPE.suffixifyByHash currentNames) Cli.respondNumbered $ Output'Todo diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs index 38bac30323..84ccff1901 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs @@ -17,7 +17,6 @@ import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.NamesUtils qualified as Cli -import Unison.Cli.PrettyPrintUtils qualified as Cli import Unison.Cli.TypeCheck (computeTypecheckingEnvironment) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) @@ -47,7 +46,9 @@ import Unison.Names (Names) import Unison.Names qualified as Names import Unison.Parser.Ann (Ann (..)) import Unison.Prelude +import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPE hiding (biasTo) +import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Reference (Reference, TermReference, TermReferenceId, TypeReference, TypeReferenceId) import Unison.Reference qualified as Reference import Unison.Referent (Referent) @@ -215,7 +216,7 @@ handleUpdate input optionalPatch requestedNames = do & tShow void $ Cli.updateAt description ppRoot (const projectRootBranchWithPropagatedPatch) let codebaseAndFileNames = UF.addNamesFromTypeCheckedUnisonFile (Slurp.originalFile sr) (Branch.toNames $ Branch.head projectRootBranchWithPropagatedPatch) - pped <- Cli.prettyPrintEnvDeclFromNames codebaseAndFileNames + let pped = PPED.makePPED (PPE.hqNamer 10 codebaseAndFileNames) (PPE.suffixifyByHash codebaseAndFileNames) let suffixifiedPPE = PPE.suffixifiedPPE pped Cli.respond $ SlurpOutput input suffixifiedPPE sr diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index f2650da4d3..b783b00e5f 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs @@ -7,25 +7,21 @@ module Unison.Codebase.Editor.HandleInput.Update2 ) where -import Control.Monad.RWS (ask) +import Control.Lens (mapped, (.=)) +import Control.Monad.Reader.Class (ask) import Data.Bifoldable (bifoldMap) +import Data.Foldable qualified as Foldable import Data.List qualified as List import Data.Map qualified as Map import Data.Set qualified as Set import Data.Text qualified as Text -import U.Codebase.Reference (Reference, TermReferenceId) +import U.Codebase.Reference (Reference, Reference' (..), TermReferenceId) import U.Codebase.Sqlite.Operations qualified as Operations import Unison.Cli.Monad (Cli, Env (..)) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli import Unison.Cli.Pretty qualified as Pretty -import Unison.Cli.UpdateUtils - ( getNamespaceDependentsOf2, - hydrateDefns, - narrowDefns, - parseAndTypecheck, - renderDefnsForUnisonFile, - ) +import Unison.Cli.UpdateUtils (getNamespaceDependentsOf2, hydrateDefns, narrowDefns, parseAndTypecheck) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch @@ -38,8 +34,8 @@ import Unison.Codebase.Path qualified as Path import Unison.Codebase.SqliteCodebase.Operations qualified as Operations import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as Decl -import Unison.Merge.DeclCoherencyCheck (checkDeclCoherency) -import Unison.Merge.DeclNameLookup (DeclNameLookup (..)) +import Unison.DeclNameLookup (DeclNameLookup (..)) +import Unison.Merge qualified as Merge import Unison.Name (Name) import Unison.Names (Names) import Unison.Names qualified as Names @@ -51,13 +47,17 @@ import Unison.PrettyPrintEnvDecl qualified as PPED import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Reference (TypeReference, TypeReferenceId) import Unison.Reference qualified as Reference (fromId) +import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Sqlite (Transaction) import Unison.Symbol (Symbol) +import Unison.Syntax.FilePrinter (renderDefnsForUnisonFile) import Unison.Syntax.Name qualified as Name import Unison.UnisonFile qualified as UF import Unison.UnisonFile.Names qualified as UF import Unison.UnisonFile.Type (TypecheckedUnisonFile) +import Unison.Util.BiMultimap (BiMultimap) +import Unison.Util.BiMultimap qualified as BiMultimap import Unison.Util.Defns (Defns (..), DefnsF, defnsAreEmpty) import Unison.Util.Monoid qualified as Monoid import Unison.Util.Nametree (flattenNametrees) @@ -78,14 +78,33 @@ handleUpdate2 = do let namesIncludingLibdeps = Branch.toNames currentBranch0 -- Assert that the namespace doesn't have any conflicted names - defns <- + nametree <- narrowDefns (Branch.deepDefns currentBranch0ExcludingLibdeps) & onLeft (Cli.returnEarly . Output.ConflictedDefn "update") + let defns :: Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) + defns = + flattenNametrees nametree + + -- Get the number of constructors for every type declaration + numConstructors <- + Cli.runTransaction do + defns.types + & BiMultimap.dom + & Set.toList + & Foldable.foldlM + ( \acc -> \case + ReferenceBuiltin _ -> pure acc + ReferenceDerived ref -> do + num <- Operations.expectDeclNumConstructors ref + pure $! Map.insert ref num acc + ) + Map.empty + -- Assert that the namespace doesn't have any incoherent decls declNameLookup <- - Cli.runTransaction (checkDeclCoherency Operations.expectDeclNumConstructors defns) - & onLeftM (Cli.returnEarly . Output.IncoherentDeclDuringUpdate) + Merge.checkDeclCoherency nametree numConstructors + & onLeft (Cli.returnEarly . Output.IncoherentDeclDuringUpdate) Cli.respond Output.UpdateLookingForDependents @@ -94,7 +113,7 @@ handleUpdate2 = do -- Get all dependents of things being updated dependents0 <- getNamespaceDependentsOf2 - (flattenNametrees defns) + (flattenNametrees nametree) (getExistingReferencesNamed termAndDeclNames (Branch.toNames currentBranch0ExcludingLibdeps)) -- Throw away the dependents that are shadowed by the file itself @@ -125,14 +144,14 @@ handleUpdate2 = do let ppe = makePPE 10 namesIncludingLibdeps (UF.typecheckedToNames tuf) dependents in makePrettyUnisonFile (Pretty.prettyUnisonFile ppe (UF.discardTypes tuf)) - (renderDefnsForUnisonFile declNameLookup ppe hydratedDependents) + (renderDefnsForUnisonFile declNameLookup ppe (over (#terms . mapped) snd hydratedDependents)) parsingEnv <- Cli.makeParsingEnv pp namesIncludingLibdeps secondTuf <- parseAndTypecheck prettyUnisonFile parsingEnv & onNothingM do scratchFilePath <- fst <$> Cli.expectLatestFile - liftIO $ env.writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUnisonFile) + liftIO $ env.writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUnisonFile) True Cli.returnEarly Output.UpdateTypecheckingFailure Cli.respond Output.UpdateTypecheckingSuccess @@ -148,6 +167,7 @@ handleUpdate2 = do (\typeName -> Right (Map.lookup typeName declNameLookup.declToConstructors)) secondTuf Cli.stepAt "update" (path, Branch.batchUpdates branchUpdates) + #latestTypecheckedFile .= Nothing Cli.respond Output.Success @@ -305,16 +325,18 @@ makePPE :: Names -> DefnsF (Map Name) TermReferenceId TypeReferenceId -> PrettyPrintEnvDecl -makePPE hashLen names initialFileNames dependents = +makePPE hashLen namespaceNames initialFileNames dependents = PPED.addFallback - (PPED.makeFilePPED (initialFileNames <> Names.fromUnconflictedReferenceIds dependents)) + ( let names = initialFileNames <> Names.fromUnconflictedReferenceIds dependents + in PPED.makePPED (PPE.namer names) (PPE.suffixifyByName (Names.shadowing names namespaceNames)) + ) ( PPED.makePPED - (PPE.hqNamer hashLen names) + (PPE.hqNamer hashLen namespaceNames) -- We don't want to over-suffixify for a reference in the namespace. For example, say we have "foo.bar" in the -- namespace and "oink.bar" in the file. "bar" may be a unique suffix among the namespace names, but would be -- ambiguous in the context of namespace + file names. -- - -- So, we use `unionLeftName`, which starts with the LHS names (the namespace), and adds to it names from the + -- So, we use `shadowing`, which starts with the LHS names (the namespace), and adds to it names from the -- RHS (the initial file names, i.e. what was originally saved) that don't already exist in the LHS. - (PPE.suffixifyByHash (Names.unionLeftName names initialFileNames)) + (PPE.suffixifyByHash (Names.shadowing namespaceNames initialFileNames)) ) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs index 7a391c99f7..c4331b99f6 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs @@ -59,7 +59,7 @@ import Unison.PrettyPrintEnv qualified as PPE import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) import Unison.PrettyPrintEnvDecl qualified as PPED (addFallback) -import Unison.PrettyPrintEnvDecl.Names qualified as PPED (makeCodebasePPED, makeFilePPED) +import Unison.PrettyPrintEnvDecl.Names qualified as PPED (makePPED) import Unison.Project (ProjectBranchName) import Unison.Reference (TermReference, TermReferenceId, TypeReference, TypeReferenceId) import Unison.Reference qualified as Reference @@ -87,7 +87,7 @@ handleUpgrade oldName newName = do when (oldName == newName) do Cli.returnEarlyWithoutOutput - Cli.Env {codebase, writeSource} <- ask + env <- ask let oldPath = Path.Absolute (Path.fromList [NameSegment.libSegment, oldName]) let newPath = Path.Absolute (Path.fromList [NameSegment.libSegment, newName]) @@ -156,21 +156,29 @@ handleUpgrade oldName newName = do unisonFile <- do addDefinitionsToUnisonFile abort - codebase + env.codebase (findCtorNames Output.UOUUpgrade currentLocalNames currentLocalConstructorNames) dependents UnisonFile.emptyUnisonFile pure ( unisonFile, - makeOldDepPPE - oldName - newName - currentDeepNamesSansOld - (Branch.toNames oldNamespace) - (Branch.toNames oldLocalNamespace) - (Branch.toNames newLocalNamespace) - `PPED.addFallback` PPED.makeFilePPED (Names.fromReferenceIds dependents) - `PPED.addFallback` PPED.makeCodebasePPED currentDeepNamesSansOld + let ppe1 = + makeOldDepPPE + oldName + newName + currentDeepNamesSansOld + (Branch.toNames oldNamespace) + (Branch.toNames oldLocalNamespace) + (Branch.toNames newLocalNamespace) + ppe2 = + PPED.makePPED + (PPE.namer (Names.fromReferenceIds dependents)) + (PPE.suffixifyByName currentDeepNamesSansOld) + ppe3 = + PPED.makePPED + (PPE.hqNamer 10 currentDeepNamesSansOld) + (PPE.suffixifyByHash currentDeepNamesSansOld) + in ppe1 `PPED.addFallback` ppe2 `PPED.addFallback` ppe3 ) pp@(PP.ProjectPath project projectBranch _path) <- Cli.getCurrentProjectPath @@ -189,13 +197,13 @@ handleUpgrade oldName newName = do Cli.getLatestFile <&> \case Nothing -> "scratch.u" Just (file, _) -> file - liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUnisonFile) + liftIO $ env.writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUnisonFile) True Cli.returnEarly $ Output.UpgradeFailure (projectBranch ^. #name) temporaryBranchName scratchFilePath oldName newName branchUpdates <- Cli.runTransactionWithRollback \abort -> do - Codebase.addDefsToCodebase codebase typecheckedUnisonFile + Codebase.addDefsToCodebase env.codebase typecheckedUnisonFile typecheckedUnisonFileToBranchUpdates abort (findCtorNamesMaybe Output.UOUUpgrade currentLocalNames currentLocalConstructorNames Nothing) @@ -300,12 +308,12 @@ makeUnisonFile abort codebase doFindCtorNames defns = do overwriteConstructorNames name ed.toDataDecl <&> \ed' -> uf & #effectDeclarationsId - %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, Decl.EffectDeclaration ed') + %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, Decl.EffectDeclaration ed') Right dd -> overwriteConstructorNames name dd <&> \dd' -> uf & #dataDeclarationsId - %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, dd') + %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, dd') -- Constructor names are bogus when pulled from the database, so we set them to what they should be here overwriteConstructorNames :: Name -> DataDeclaration Symbol Ann -> Transaction (DataDeclaration Symbol Ann) diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index e736c618bd..da06a5fb8e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -8,6 +8,7 @@ module Unison.Codebase.Editor.Input TestInput (..), Event (..), OutputLocation (..), + RelativeToFold (..), PatchPath, BranchIdG (..), BranchId, @@ -126,9 +127,10 @@ data Input | PullI !PullSourceTarget !PullMode | PushRemoteBranchI PushRemoteBranchInput | ResetI (BranchId2 {- namespace to reset it to -}) (Maybe UnresolvedProjectBranch {- ProjectBranch to reset -}) - -- todo: Q: Does it make sense to publish to not-the-root of a Github repo? - | -- Does it make sense to fork from not-the-root of a Github repo? - -- used in Welcome module to give directions to user + | -- | used in Welcome module to give directions to user + -- + -- todo: Q: Does it make sense to publish to not-the-root of a Github repo? + -- Does it make sense to fork from not-the-root of a Github repo? CreateMessage (P.Pretty P.ColorText) | -- Change directory. SwitchBranchI Path' @@ -167,17 +169,17 @@ data Input ExecuteI (HQ.HashQualified Name) [String] | -- save the result of a previous Execute SaveExecuteResultI Name - | -- execute an IO [Result] - IOTestI (HQ.HashQualified Name) - | -- execute all in-scope IO tests - IOTestAllI + | -- execute an IO [Result], bool selects runtime + IOTestI Bool (HQ.HashQualified Name) + | -- execute all in-scope IO tests, interpreter or native + IOTestAllI Bool | -- make a standalone binary file MakeStandaloneI String (HQ.HashQualified Name) | -- execute an IO thunk using scheme ExecuteSchemeI (HQ.HashQualified Name) [String] - | -- compile to a scheme file - CompileSchemeI Text (HQ.HashQualified Name) - | TestI TestInput + | -- compile to a scheme file; profiling flag + CompileSchemeI Bool Text (HQ.HashQualified Name) + | TestI Bool TestInput | CreateAuthorI NameSegment {- identifier -} Text {- name -} | -- Display provided definitions. DisplayI OutputLocation (NonEmpty (HQ.HashQualified Name)) @@ -188,6 +190,7 @@ data Input | FindShallowI Path' | StructuredFindI FindScope (HQ.HashQualified Name) -- sfind findScope query | StructuredFindReplaceI (HQ.HashQualified Name) -- sfind.replace rewriteQuery + | TextFindI Bool [String] -- TextFindI allowLib tokens | -- Show provided definitions. ShowDefinitionI OutputLocation ShowDefinitionScope (NonEmpty (HQ.HashQualified Name)) | ShowRootReflogI {- Deprecated -} @@ -242,6 +245,7 @@ data Input | UpgradeCommitI | MergeCommitI | DebugSynhashTermI !Name + | EditDependentsI !(HQ.HashQualified Name) deriving (Eq, Show) -- | The source of a `branch` command: what to make the new branch from. @@ -291,11 +295,17 @@ data TestInput = TestInput -- Some commands, like `view`, can dump output to either console or a file. data OutputLocation = ConsoleLocation - | LatestFileLocation - | FileLocation FilePath + | LatestFileLocation RelativeToFold + | FileLocation FilePath RelativeToFold -- ClipboardLocation deriving (Eq, Show) +-- | Above a new fold, or within the topmost fold? +data RelativeToFold + = AboveFold + | WithinFold + deriving stock (Eq, Show) + data FindScope = FindLocal Path' | FindLocalAndDeps Path' diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index a681341bb0..28f98e16a2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -26,6 +26,7 @@ import Data.Time (UTCTime) import Network.URI (URI) import Servant.Client qualified as Servant (ClientError) import System.Console.Haskeline qualified as Completion +import System.Exit (ExitCode) import U.Codebase.Branch.Diff (NameChanges) import U.Codebase.HashTags (CausalHash) import U.Codebase.Sqlite.Project qualified as Sqlite @@ -218,7 +219,7 @@ data Output | NoExactTypeMatches | TypeAlreadyExists Path.Split' (Set Reference) | TypeParseError String (Parser.Err Symbol) - | ParseResolutionFailures String [Names.ResolutionFailure Symbol Ann] + | ParseResolutionFailures String [Names.ResolutionFailure Ann] | TypeHasFreeVars (Type Symbol Ann) | TermAlreadyExists Path.Split' (Set Referent) | LabeledReferenceAmbiguous Int (HQ.HashQualified Name) (Set LabeledDependency) @@ -275,6 +276,7 @@ data Output | ListOfDefinitions FindScope PPE.PrettyPrintEnv ListDetailed [SearchResult' Symbol Ann] | ListShallow (IO PPE.PrettyPrintEnv) [ShallowListEntry Symbol Ann] | ListStructuredFind [HQ.HashQualified Name] + | ListTextFind Bool [HQ.HashQualified Name] -- whether lib was included in the search | GlobalFindBranchResults (ProjectAndBranch ProjectName ProjectBranchName) PPE.PrettyPrintEnv ListDetailed [SearchResult' Symbol Ann] | -- ListStructuredFind patternMatchingUsages termBodyUsages -- show the result of add/update @@ -423,10 +425,11 @@ data Output | UpgradeFailure !ProjectBranchName !ProjectBranchName !FilePath !NameSegment !NameSegment | UpgradeSuccess !NameSegment !NameSegment | MergeFailure !FilePath !MergeSourceAndTarget !ProjectBranchName + | MergeFailureWithMergetool !MergeSourceAndTarget !ProjectBranchName !Text !ExitCode | MergeSuccess !MergeSourceAndTarget | MergeSuccessFastForward !MergeSourceAndTarget - | MergeConflictedAliases !MergeSourceOrTarget !Name !Name - | MergeConflictInvolvingBuiltin !Name + | MergeConflictedAliases !MergeSourceOrTarget !(Defn (Name, Name) (Name, Name)) + | MergeConflictInvolvingBuiltin !(Defn Name Name) | MergeDefnsInLib !MergeSourceOrTarget | InstalledLibdep !(ProjectAndBranch ProjectName ProjectBranchName) !NameSegment | NoUpgradeInProgress @@ -437,6 +440,9 @@ data Output | ConflictedDefn !Text {- what operation? -} !(Defn (Conflicted Name Referent) (Conflicted Name TypeReference)) | IncoherentDeclDuringMerge !MergeSourceOrTarget !IncoherentDeclReason | IncoherentDeclDuringUpdate !IncoherentDeclReason + | -- | A literal output message. Use this if it's too cumbersome to create a new Output constructor, e.g. for + -- ephemeral progress messages that are just simple strings like "Loading branch..." + Literal !(P.Pretty P.ColorText) data MoreEntriesThanShown = MoreEntriesThanShown | AllEntriesShown deriving (Eq, Show) @@ -552,6 +558,7 @@ isFailure o = case o of ListOfDefinitions _ _ _ ds -> null ds GlobalFindBranchResults _ _ _ _ -> False ListStructuredFind tms -> null tms + ListTextFind _ tms -> null tms SlurpOutput _ _ sr -> not $ SR.isOk sr ParseErrors {} -> True TypeErrors {} -> True @@ -661,6 +668,7 @@ isFailure o = case o of UpgradeFailure {} -> True UpgradeSuccess {} -> False MergeFailure {} -> True + MergeFailureWithMergetool {} -> True MergeSuccess {} -> False MergeSuccessFastForward {} -> False MergeConflictedAliases {} -> True @@ -675,6 +683,7 @@ isFailure o = case o of ConflictedDefn {} -> True IncoherentDeclDuringMerge {} -> True IncoherentDeclDuringUpdate {} -> True + Literal _ -> False isNumberedFailure :: NumberedOutput -> Bool isNumberedFailure = \case diff --git a/unison-cli/src/Unison/Codebase/Editor/SlurpComponent.hs b/unison-cli/src/Unison/Codebase/Editor/SlurpComponent.hs index 82cc4a862a..3e51fb9aa2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/SlurpComponent.hs +++ b/unison-cli/src/Unison/Codebase/Editor/SlurpComponent.hs @@ -25,21 +25,22 @@ import Data.Set qualified as Set import Data.Tuple (swap) import Unison.DataDeclaration qualified as DD import Unison.Prelude hiding (empty) -import Unison.Reference (Reference) +import Unison.Reference (TypeReference) import Unison.Symbol (Symbol) import Unison.Term qualified as Term import Unison.UnisonFile (TypecheckedUnisonFile) import Unison.UnisonFile qualified as UF +import Unison.Util.Defns (Defns (..)) data SlurpComponent = SlurpComponent { types :: Set Symbol, terms :: Set Symbol, ctors :: Set Symbol } - deriving (Eq, Ord, Show) + deriving (Eq, Generic, Ord, Show) isEmpty :: SlurpComponent -> Bool -isEmpty sc = Set.null (types sc) && Set.null (terms sc) && Set.null (ctors sc) +isEmpty sc = Set.null sc.types && Set.null sc.terms && Set.null sc.ctors empty :: SlurpComponent empty = SlurpComponent {types = Set.empty, terms = Set.empty, ctors = Set.empty} @@ -47,23 +48,23 @@ empty = SlurpComponent {types = Set.empty, terms = Set.empty, ctors = Set.empty} difference :: SlurpComponent -> SlurpComponent -> SlurpComponent difference c1 c2 = SlurpComponent {types = types', terms = terms', ctors = ctors'} where - types' = types c1 `Set.difference` types c2 - terms' = terms c1 `Set.difference` terms c2 - ctors' = ctors c1 `Set.difference` ctors c2 + types' = c1.types `Set.difference` c2.types + terms' = c1.terms `Set.difference` c2.terms + ctors' = c1.ctors `Set.difference` c2.ctors intersection :: SlurpComponent -> SlurpComponent -> SlurpComponent intersection c1 c2 = SlurpComponent {types = types', terms = terms', ctors = ctors'} where - types' = types c1 `Set.intersection` types c2 - terms' = terms c1 `Set.intersection` terms c2 - ctors' = ctors c1 `Set.intersection` ctors c2 + types' = c1.types `Set.intersection` c2.types + terms' = c1.terms `Set.intersection` c2.terms + ctors' = c1.ctors `Set.intersection` c2.ctors instance Semigroup SlurpComponent where c1 <> c2 = SlurpComponent - { types = types c1 <> types c2, - terms = terms c1 <> terms c2, - ctors = ctors c1 <> ctors c2 + { types = c1.types <> c2.types, + terms = c1.terms <> c2.terms, + ctors = c1.ctors <> c2.ctors } instance Monoid SlurpComponent where @@ -79,31 +80,30 @@ closeWithDependencies :: SlurpComponent closeWithDependencies uf inputs = seenDefns {ctors = constructorDeps} where - seenDefns = foldl' termDeps (SlurpComponent {terms = mempty, types = seenTypes, ctors = mempty}) (terms inputs) - seenTypes = foldl' typeDeps mempty (types inputs) + seenDefns = foldl' termDeps (SlurpComponent {terms = mempty, types = seenTypes, ctors = mempty}) inputs.terms + seenTypes = foldl' typeDeps mempty inputs.types constructorDeps :: Set Symbol constructorDeps = UF.constructorsForDecls seenTypes uf termDeps :: SlurpComponent -> Symbol -> SlurpComponent - termDeps seen v | Set.member v (terms seen) = seen - termDeps seen v = fromMaybe seen $ do + termDeps seen v | Set.member v seen.terms = seen + termDeps seen v = fromMaybe seen do term <- findTerm v let -- get the `v`s for the transitive dependency types -- (the ones for terms are just the `freeVars below`) -- although this isn't how you'd do it for a term that's already in codebase tdeps :: [Symbol] - tdeps = resolveTypes $ Term.dependencies term + tdeps = resolveTypes (Term.dependencies term).types seenTypes :: Set Symbol - seenTypes = foldl' typeDeps (types seen) tdeps - seenTerms = Set.insert v (terms seen) + seenTypes = foldl' typeDeps seen.types tdeps + seenTerms = Set.insert v seen.terms pure $ foldl' termDeps ( seen - { types = seenTypes, - terms = seenTerms - } + & #types .~ seenTypes + & #terms .~ seenTerms ) (Term.freeVars term) @@ -115,7 +115,7 @@ closeWithDependencies uf inputs = seenDefns {ctors = constructorDeps} <|> fmap (DD.toDataDecl . snd) (Map.lookup v (UF.effectDeclarations' uf)) pure $ foldl' typeDeps (Set.insert v seen) (resolveTypes $ DD.typeDependencies dd) - resolveTypes :: Set Reference -> [Symbol] + resolveTypes :: Set TypeReference -> [Symbol] resolveTypes rs = [v | r <- Set.toList rs, Just v <- [Map.lookup r typeNames]] findTerm :: Symbol -> Maybe (Term.Term Symbol a) @@ -123,17 +123,17 @@ closeWithDependencies uf inputs = seenDefns {ctors = constructorDeps} allTerms = UF.allTerms uf - typeNames :: Map Reference Symbol + typeNames :: Map TypeReference Symbol typeNames = invert (fst <$> UF.dataDeclarations' uf) <> invert (fst <$> UF.effectDeclarations' uf) invert :: forall k v. (Ord k) => (Ord v) => Map k v -> Map v k invert m = Map.fromList (swap <$> Map.toList m) fromTypes :: Set Symbol -> SlurpComponent -fromTypes vs = mempty {types = vs} +fromTypes vs = SlurpComponent {terms = Set.empty, types = vs, ctors = Set.empty} fromTerms :: Set Symbol -> SlurpComponent -fromTerms vs = mempty {terms = vs} +fromTerms vs = SlurpComponent {terms = vs, types = Set.empty, ctors = Set.empty} fromCtors :: Set Symbol -> SlurpComponent -fromCtors vs = mempty {ctors = vs} +fromCtors vs = SlurpComponent {terms = Set.empty, types = Set.empty, ctors = vs} diff --git a/unison-cli/src/Unison/Codebase/Transcript.hs b/unison-cli/src/Unison/Codebase/Transcript.hs index bd5bbd058f..81d56e7e8c 100644 --- a/unison-cli/src/Unison/Codebase/Transcript.hs +++ b/unison-cli/src/Unison/Codebase/Transcript.hs @@ -10,7 +10,11 @@ module Unison.Codebase.Transcript APIRequest (..), pattern CMarkCodeBlock, Stanza, + InfoTags (..), + defaultInfoTags, + defaultInfoTags', ProcessedBlock (..), + CMark.Node, ) where @@ -24,27 +28,48 @@ type ExpectingError = Bool type ScratchFileName = Text data Hidden = Shown | HideOutput | HideAll - deriving (Eq, Show) + deriving (Eq, Ord, Read, Show) data UcmLine = UcmCommand UcmContext Text | -- | Text does not include the '--' prefix. UcmComment Text + | UcmOutputLine Text + deriving (Eq, Show) -- | Where a command is run: a project branch (myproject/mybranch>). data UcmContext = UcmContextProject (ProjectAndBranch ProjectName ProjectBranchName) + deriving (Eq, Show) data APIRequest = GetRequest Text | APIComment Text + | APIResponseLine Text + deriving (Eq, Show) pattern CMarkCodeBlock :: (Maybe CMark.PosInfo) -> Text -> Text -> CMark.Node pattern CMarkCodeBlock pos info body = CMark.Node pos (CMark.CODE_BLOCK info body) [] type Stanza = Either CMark.Node ProcessedBlock +data InfoTags a = InfoTags + { hidden :: Hidden, + expectingError :: ExpectingError, + generated :: Bool, + additionalTags :: a + } + deriving (Eq, Ord, Read, Show) + +defaultInfoTags :: a -> InfoTags a +defaultInfoTags = InfoTags Shown False False + +-- | If the `additionalTags` form a `Monoid`, then you don’t need to provide a default value for them. +defaultInfoTags' :: (Monoid a) => InfoTags a +defaultInfoTags' = defaultInfoTags mempty + data ProcessedBlock - = Ucm Hidden ExpectingError [UcmLine] - | Unison Hidden ExpectingError (Maybe ScratchFileName) Text - | API [APIRequest] + = Ucm (InfoTags ()) [UcmLine] + | Unison (InfoTags (Maybe ScratchFileName)) Text + | API (InfoTags ()) [APIRequest] + deriving (Eq, Show) diff --git a/unison-cli/src/Unison/Codebase/Transcript/Parser.hs b/unison-cli/src/Unison/Codebase/Transcript/Parser.hs index 47f7965240..4943b5442a 100644 --- a/unison-cli/src/Unison/Codebase/Transcript/Parser.hs +++ b/unison-cli/src/Unison/Codebase/Transcript/Parser.hs @@ -3,12 +3,8 @@ module Unison.Codebase.Transcript.Parser ( -- * printing formatAPIRequest, formatUcmLine, - formatStanza, - formatNode, - formatProcessedBlock, - - -- * conversion - processedBlockToNode, + formatInfoString, + formatStanzas, -- * parsing stanzas, @@ -22,115 +18,116 @@ module Unison.Codebase.Transcript.Parser where import CMark qualified +import Data.Bool (bool) import Data.Char qualified as Char import Data.Text qualified as Text import Text.Megaparsec qualified as P -import Unison.Codebase.Transcript +import Text.Megaparsec.Char qualified as P +import Unison.Codebase.Transcript hiding (expectingError, generated, hidden) import Unison.Prelude import Unison.Project (fullyQualifiedProjectAndBranchNamesParser) +padIfNonEmpty :: Text -> Text +padIfNonEmpty line = if Text.null line then line else " " <> line + formatAPIRequest :: APIRequest -> Text formatAPIRequest = \case - GetRequest txt -> "GET " <> txt - APIComment txt -> "-- " <> txt + GetRequest txt -> "GET " <> txt <> "\n" + APIComment txt -> "--" <> txt <> "\n" + APIResponseLine txt -> Text.unlines . fmap padIfNonEmpty $ Text.lines txt formatUcmLine :: UcmLine -> Text formatUcmLine = \case - UcmCommand context txt -> formatContext context <> "> " <> txt - UcmComment txt -> "--" <> txt + UcmCommand context txt -> formatContext context <> "> " <> txt <> "\n" + UcmComment txt -> "--" <> txt <> "\n" + UcmOutputLine txt -> Text.unlines . fmap padIfNonEmpty $ Text.lines txt where formatContext (UcmContextProject projectAndBranch) = into @Text projectAndBranch -formatStanza :: Stanza -> Text -formatStanza = either formatNode formatProcessedBlock - -formatNode :: CMark.Node -> Text -formatNode = (<> "\n") . CMark.nodeToCommonmark [] Nothing - -formatProcessedBlock :: ProcessedBlock -> Text -formatProcessedBlock = formatNode . processedBlockToNode +formatStanzas :: [Stanza] -> Text +formatStanzas = + CMark.nodeToCommonmark [] Nothing . CMark.Node Nothing CMark.DOCUMENT . fmap (either id processedBlockToNode) processedBlockToNode :: ProcessedBlock -> CMark.Node processedBlockToNode = \case - Ucm _ _ cmds -> CMarkCodeBlock Nothing "ucm" $ foldr ((<>) . formatUcmLine) "" cmds - Unison _hide _ fname txt -> - CMarkCodeBlock Nothing "unison" $ maybe txt (\fname -> Text.unlines ["---", "title: " <> fname, "---", txt]) fname - API apiRequests -> CMarkCodeBlock Nothing "api" $ Text.unlines $ formatAPIRequest <$> apiRequests + Ucm tags cmds -> mkNode (\() -> "") "ucm" tags $ foldr ((<>) . formatUcmLine) "" cmds + Unison tags txt -> mkNode (maybe "" (" " <>)) "unison" tags txt + API tags apiRequests -> mkNode (\() -> "") "api" tags $ foldr ((<>) . formatAPIRequest) "" apiRequests + where + mkNode formatA lang = CMarkCodeBlock Nothing . formatInfoString formatA lang type P = P.Parsec Void Text stanzas :: FilePath -> Text -> Either (P.ParseErrorBundle Text Void) [Stanza] -stanzas srcName = (\(CMark.Node _ _DOCUMENT blocks) -> traverse stanzaFromNode blocks) . CMark.commonmarkToNode [] +stanzas srcName = + -- TODO: Internal warning if `_DOCUMENT` isn’t `CMark.DOCUMENT`. + (\(CMark.Node _ _DOCUMENT blocks) -> traverse stanzaFromNode blocks) + . CMark.commonmarkToNode [CMark.optSourcePos] where stanzaFromNode :: CMark.Node -> Either (P.ParseErrorBundle Text Void) Stanza stanzaFromNode node = case node of - CMarkCodeBlock _ info body -> maybe (Left node) pure <$> P.parse (fenced info) srcName body + CMarkCodeBlock (Just CMark.PosInfo {startLine, startColumn}) info body -> + maybe (Left node) pure <$> snd (P.runParser' fenced $ fencedState srcName startLine startColumn info body) _ -> pure $ Left node ucmLine :: P UcmLine -ucmLine = ucmCommand <|> ucmComment +ucmLine = ucmOutputLine <|> ucmComment <|> ucmCommand where ucmCommand :: P UcmLine ucmCommand = UcmCommand - <$> fmap UcmContextProject (P.try $ fullyQualifiedProjectAndBranchNamesParser <* lineToken (word ">")) - <*> P.takeWhileP Nothing (/= '\n') - <* spaces + <$> fmap + UcmContextProject + (fullyQualifiedProjectAndBranchNamesParser <* lineToken (P.chunk ">") <* nonNewlineSpaces) + <*> restOfLine ucmComment :: P UcmLine ucmComment = P.label "comment (delimited with “--”)" $ - UcmComment <$> (word "--" *> P.takeWhileP Nothing (/= '\n')) <* spaces + UcmComment <$> (P.chunk "--" *> restOfLine) + + ucmOutputLine :: P UcmLine + ucmOutputLine = UcmOutputLine <$> (P.chunk " " *> restOfLine <|> "" <$ P.single '\n' <|> "" <$ P.chunk " \n") + +restOfLine :: P Text +restOfLine = P.takeWhileP Nothing (/= '\n') <* P.single '\n' apiRequest :: P APIRequest -apiRequest = do - apiComment <|> getRequest - where - getRequest = do - word "GET" - spaces - path <- P.takeWhile1P Nothing (/= '\n') - spaces - pure (GetRequest path) - apiComment = do - word "--" - comment <- P.takeWhileP Nothing (/= '\n') - spaces - pure (APIComment comment) - --- | Produce the correct parser for the code block based on the provided info string. -fenced :: Text -> P (Maybe ProcessedBlock) -fenced info = do - body <- P.getInput - P.setInput info - fenceType <- lineToken (word "ucm" <|> word "unison" <|> word "api" <|> language) +apiRequest = + GetRequest <$> (word "GET" *> spaces *> restOfLine) + <|> APIComment <$> (P.chunk "--" *> restOfLine) + <|> APIResponseLine <$> (P.chunk " " *> restOfLine <|> "" <$ P.single '\n' <|> "" <$ P.chunk " \n") + +formatInfoString :: (a -> Text) -> Text -> InfoTags a -> Text +formatInfoString formatA language infoTags = + let infoTagText = formatInfoTags formatA infoTags + in if Text.null infoTagText then language else language <> " " <> infoTagText + +formatInfoTags :: (a -> Text) -> InfoTags a -> Text +formatInfoTags formatA (InfoTags hidden expectingError generated additionalTags) = + formatHidden hidden <> formatExpectingError expectingError <> formatGenerated generated <> formatA additionalTags + +infoTags :: P a -> P (InfoTags a) +infoTags p = + InfoTags + <$> lineToken hidden + <*> lineToken expectingError + <*> lineToken generated + <*> p + <* P.single '\n' + +-- | Parses the info string and contents of a fenced code block. +fenced :: P (Maybe ProcessedBlock) +fenced = do + fenceType <- lineToken language case fenceType of - "ucm" -> do - hide <- hidden - err <- expectingError - P.setInput body - pure . Ucm hide err <$> (spaces *> P.manyTill ucmLine P.eof) - "unison" -> - do - -- todo: this has to be more interesting - -- ```unison:hide - -- ```unison - -- ```unison:hide:all scratch.u - hide <- lineToken hidden - err <- lineToken expectingError - fileName <- optional untilSpace1 - P.setInput body - pure . Unison hide err fileName <$> (spaces *> P.getInput) - "api" -> do - P.setInput body - pure . API <$> (spaces *> P.manyTill apiRequest P.eof) + "ucm" -> fmap pure $ Ucm <$> infoTags (pure ()) <*> P.manyTill ucmLine P.eof + "unison" -> fmap pure $ Unison <$> infoTags (optional untilSpace1) <*> P.getInput + "api" -> fmap pure $ API <$> infoTags (pure ()) <*> P.manyTill apiRequest P.eof _ -> pure Nothing word :: Text -> P Text -word txt = P.try $ do - chs <- P.takeP (Just $ show txt) (Text.length txt) - guard (chs == txt) - pure txt +word text = P.chunk text <* P.notFollowedBy P.alphaNumChar lineToken :: P a -> P a lineToken p = p <* nonNewlineSpaces @@ -138,15 +135,30 @@ lineToken p = p <* nonNewlineSpaces nonNewlineSpaces :: P () nonNewlineSpaces = void $ P.takeWhileP Nothing (\ch -> ch == ' ' || ch == '\t') +formatHidden :: Hidden -> Text +formatHidden = \case + HideAll -> ":hide:all" + HideOutput -> ":hide" + Shown -> "" + hidden :: P Hidden hidden = (HideAll <$ word ":hide:all") <|> (HideOutput <$ word ":hide") <|> pure Shown +formatExpectingError :: ExpectingError -> Text +formatExpectingError = bool "" ":error" + expectingError :: P ExpectingError expectingError = isJust <$> optional (word ":error") +formatGenerated :: ExpectingError -> Text +formatGenerated = bool "" ":added-by-ucm" + +generated :: P Bool +generated = isJust <$> optional (word ":added-by-ucm") + untilSpace1 :: P Text untilSpace1 = P.takeWhile1P Nothing (not . Char.isSpace) @@ -155,3 +167,47 @@ language = P.takeWhileP Nothing (\ch -> Char.isDigit ch || Char.isLower ch || ch spaces :: P () spaces = void $ P.takeWhileP (Just "spaces") Char.isSpace + +-- | Create a parser state that has source locations that match the file (as opposed to being relative to the start of +-- the individual fenced code block). +-- +-- __NB__: If a code block has a fence longer than the minimum (three backticks), the columns for parse errors in the +-- info string will be slightly off (but the printed code excerpt will match the reported positions). +-- +-- __NB__: Creating custom states is likely simpler starting with Megaparsec 9.6.0. +fencedState :: + -- | file containing the fenced code block + FilePath -> + -- | `CMark.startLine` for the block + Int -> + -- | `CMark.startColumn` for the block` + Int -> + -- | info string from the block + Text -> + -- | contents of the code block + Text -> + P.State Text e +fencedState name startLine startColumn info body = + let -- This is the most common opening fence, so we assume it’s the right one. I don’t think there’s any way to get + -- the actual size of the fence from "CMark", so this can be wrong sometimes, but it’s probably the approach + -- that’s least likely to confuse users. + openingFence = "``` " + -- Glue the info string and body back together, as if they hadn’t been split by "CMark". This keeps the position + -- info in sync. + s = info <> "\n" <> body + in P.State + { stateInput = s, + stateOffset = 0, + statePosState = + P.PosState + { pstateInput = s, + pstateOffset = 0, + -- `CMark.startColumn` marks the beginning of the fence, not the beginning of the info string, so we + -- adjust it for the fence that precedes it. + pstateSourcePos = P.SourcePos name (P.mkPos startLine) . P.mkPos $ startColumn + length openingFence, + pstateTabWidth = P.defaultTabWidth, + -- Ensure we print the fence as part of the line if there’s a parse error in the info string. + pstateLinePrefix = openingFence + }, + stateParseErrors = [] + } diff --git a/unison-cli/src/Unison/Codebase/Transcript/Runner.hs b/unison-cli/src/Unison/Codebase/Transcript/Runner.hs index 6e084a2eba..9c06e31da8 100644 --- a/unison-cli/src/Unison/Codebase/Transcript/Runner.hs +++ b/unison-cli/src/Unison/Codebase/Transcript/Runner.hs @@ -8,25 +8,22 @@ module Unison.Codebase.Transcript.Runner ) where +import CMark qualified import Control.Lens (use, (?~)) import Crypto.Random qualified as Random import Data.Aeson qualified as Aeson import Data.Aeson.Encode.Pretty qualified as Aeson import Data.ByteString.Lazy.Char8 qualified as BL -import Data.Configurator qualified as Configurator -import Data.Configurator.Types (Config) import Data.IORef -import Data.List (isSubsequenceOf) import Data.List.NonEmpty qualified as NonEmpty import Data.Map qualified as Map +import Data.Sequence qualified as Seq import Data.Text qualified as Text import Data.These (These (..)) import Data.UUID.V4 qualified as UUID import Network.HTTP.Client qualified as HTTP import System.Environment (lookupEnv) -import System.Exit (die) import System.IO qualified as IO -import System.IO.Error (catchIOError) import Text.Megaparsec qualified as P import U.Codebase.Sqlite.DbId qualified as Db import U.Codebase.Sqlite.Project (Project (..)) @@ -86,7 +83,7 @@ type Runner = String -> Text -> (FilePath, Codebase IO Symbol Ann) -> - IO (Either Error Text) + IO (Either Error (Seq Stanza)) withRunner :: forall m r. @@ -96,59 +93,52 @@ withRunner :: Verbosity -> UCMVersion -> FilePath -> - Maybe FilePath -> (Runner -> m r) -> m r -withRunner isTest verbosity ucmVersion nrtp configFile action = do - withRuntimes nrtp \runtime sbRuntime nRuntime -> withConfig \config -> do - action \transcriptName transcriptSrc (codebaseDir, codebase) -> do - Server.startServer (Backend.BackendEnv {Backend.useNamesIndex = False}) Server.defaultCodebaseServerOpts runtime codebase \baseUrl -> do - let parsed = Transcript.stanzas transcriptName transcriptSrc - result <- for parsed \stanzas -> do - liftIO $ run isTest verbosity codebaseDir stanzas codebase runtime sbRuntime nRuntime config ucmVersion (tShow baseUrl) - pure . join $ first ParseError result +withRunner isTest verbosity ucmVersion nrtp action = + withRuntimes nrtp \runtime sbRuntime nRuntime -> + action \transcriptName transcriptSrc (codebaseDir, codebase) -> + Server.startServer + Backend.BackendEnv {Backend.useNamesIndex = False} + Server.defaultCodebaseServerOpts + runtime + codebase + \baseUrl -> + either + (pure . Left . ParseError) + (run isTest verbosity codebaseDir codebase runtime sbRuntime nRuntime ucmVersion $ tShow baseUrl) + $ Transcript.stanzas transcriptName transcriptSrc where withRuntimes :: FilePath -> (Runtime.Runtime Symbol -> Runtime.Runtime Symbol -> Runtime.Runtime Symbol -> m a) -> m a withRuntimes nrtp action = - RTI.withRuntime False RTI.Persistent ucmVersion \runtime -> do - RTI.withRuntime True RTI.Persistent ucmVersion \sbRuntime -> do - action runtime sbRuntime - =<< liftIO (RTI.startNativeRuntime ucmVersion nrtp) - withConfig :: forall a. ((Maybe Config -> m a) -> m a) - withConfig action = do - case configFile of - Nothing -> action Nothing - Just configFilePath -> do - let loadConfig = liftIO do - catchIOError - (watchConfig configFilePath) - \_ -> die "Your .unisonConfig could not be loaded. Check that it's correct!" - UnliftIO.bracket - loadConfig - (\(_config, cancelConfig) -> liftIO cancelConfig) - (\(config, _cancelConfig) -> action (Just config)) + RTI.withRuntime False RTI.Persistent ucmVersion \runtime -> + RTI.withRuntime True RTI.Persistent ucmVersion \sbRuntime -> + action runtime sbRuntime =<< liftIO (RTI.startNativeRuntime ucmVersion nrtp) + +isGeneratedBlock :: ProcessedBlock -> Bool +isGeneratedBlock = \case + Ucm InfoTags {generated} _ -> generated + Unison InfoTags {generated} _ -> generated + API InfoTags {generated} _ -> generated run :: -- | Whether to treat this transcript run as a transcript test, which will try to make output deterministic Bool -> Verbosity -> FilePath -> - [Stanza] -> Codebase IO Symbol Ann -> Runtime.Runtime Symbol -> Runtime.Runtime Symbol -> Runtime.Runtime Symbol -> - Maybe Config -> UCMVersion -> Text -> - IO (Either Error Text) -run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmVersion baseURL = UnliftIO.try do + [Stanza] -> + IO (Either Error (Seq Stanza)) +run isTest verbosity dir codebase runtime sbRuntime nRuntime ucmVersion baseURL stanzas = UnliftIO.try do httpManager <- HTTP.newManager HTTP.defaultManagerSettings - (initialPP, emptyCausalHashId) <- Codebase.runTransaction codebase do - (_, emptyCausalHashId) <- Codebase.emptyCausalHash - initialPP <- Codebase.expectCurrentProjectPath - pure (initialPP, emptyCausalHashId) + (initialPP, emptyCausalHashId) <- + Codebase.runTransaction codebase . liftA2 (,) Codebase.expectCurrentProjectPath $ snd <$> Codebase.emptyCausalHash unless (isSilent verbosity) . putPrettyLn $ Pretty.lines @@ -161,279 +151,324 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmV credMan <- AuthN.newCredentialManager let tokenProvider :: AuthN.TokenProvider tokenProvider = - case mayShareAccessToken of - Nothing -> do - AuthN.newTokenProvider credMan - Just accessToken -> - \_codeserverID -> pure $ Right accessToken - seedRef <- newIORef (0 :: Int) + maybe + (AuthN.newTokenProvider credMan) + (\accessToken _codeserverID -> pure $ Right accessToken) + mayShareAccessToken -- Queue of Stanzas and Just index, or Nothing if the stanza was programmatically generated -- e.g. a unison-file update by a command like 'edit' - inputQueue <- Q.newIO @(Stanza, Maybe Int) + inputQueue <- + Q.prepopulatedIO . Seq.fromList $ + filter (either (const True) (not . isGeneratedBlock)) stanzas `zip` (Just <$> [1 :: Int ..]) -- Queue of UCM commands to run. -- Nothing indicates the end of a ucm block. cmdQueue <- Q.newIO @(Maybe UcmLine) -- Queue of scratch file updates triggered by UCM itself, e.g. via `edit`, `update`, etc. ucmScratchFileUpdatesQueue <- Q.newIO @(ScratchFileName, Text) + ucmOutput <- newIORef mempty unisonFiles <- newIORef Map.empty out <- newIORef mempty - hidden <- newIORef Shown + currentTags <- newIORef Nothing + isHidden <- newIORef Shown allowErrors <- newIORef False hasErrors <- newIORef False - mStanza <- newIORef Nothing - traverse_ (atomically . Q.enqueue inputQueue) (stanzas `zip` (Just <$> [1 :: Int ..])) - let patternMap = - Map.fromList $ - validInputs - >>= (\p -> (patternName p, p) : ((,p) <$> aliases p)) - let output' :: Bool -> String -> IO () + mBlock <- newIORef Nothing + let patternMap = Map.fromList $ (\p -> (patternName p, p) : ((,p) <$> aliases p)) =<< validInputs + let output' :: Bool -> Stanza -> IO () output' inputEcho msg = do - hide <- readIORef hidden - unless (hideOutput inputEcho hide) $ modifyIORef' out (\acc -> acc <> pure msg) + hide <- hideOutput inputEcho + unless hide $ modifyIORef' out (<> pure msg) - hideOutput :: Bool -> Hidden -> Bool - hideOutput inputEcho = \case + hideOutput' :: Bool -> Hidden -> Bool + hideOutput' inputEcho = \case Shown -> False - HideOutput -> True && (not inputEcho) + HideOutput -> not inputEcho HideAll -> True - output, outputEcho :: String -> IO () + hideOutput :: Bool -> IO Bool + hideOutput inputEcho = hideOutput' inputEcho <$> readIORef isHidden + + output, outputEcho :: Stanza -> IO () output = output' False outputEcho = output' True - apiRequest :: APIRequest -> IO () + outputUcmLine :: UcmLine -> IO () + outputUcmLine line = do + prev <- readIORef ucmOutput + modifyIORef' ucmOutput (<> ((if not (null prev) then pure (UcmOutputLine "\n") else mempty) <> pure line)) + + outputUcmResult :: Pretty.Pretty Pretty.ColorText -> IO () + outputUcmResult line = do + hide <- hideOutput False + unless hide . outputUcmLine . UcmOutputLine . Text.pack $ + -- We shorten the terminal width, because "Transcript" manages a 2-space indent for output lines. + Pretty.toPlain (terminalWidth - 2) line + + maybeDieWithMsg :: String -> IO () + maybeDieWithMsg msg = do + errOk <- readIORef allowErrors + if errOk + then writeIORef hasErrors True + else dieWithMsg msg + + apiRequest :: APIRequest -> IO [APIRequest] apiRequest req = do - output . Text.unpack $ Transcript.formatAPIRequest req <> "\n" + hide <- hideOutput False case req of - APIComment {} -> pure () - GetRequest path -> do - req <- case HTTP.parseRequest (Text.unpack $ baseURL <> path) of - Left err -> dieWithMsg (show err) - Right req -> pure req - respBytes <- HTTP.httpLbs req httpManager - case Aeson.eitherDecode (HTTP.responseBody respBytes) of - Right (v :: Aeson.Value) -> do - let prettyBytes = Aeson.encodePretty' (Aeson.defConfig {Aeson.confCompare = compare}) v - output . (<> "\n") . BL.unpack $ prettyBytes - Left err -> dieWithMsg ("Error decoding response from " <> Text.unpack path <> ": " <> err) + -- We just discard this, because the runner will produce new output lines. + APIResponseLine {} -> pure [] + APIComment {} -> pure $ pure req + GetRequest path -> + either + (([] <$) . maybeDieWithMsg . show) + ( either + (([] <$) . maybeDieWithMsg . (("Error decoding response from " <> Text.unpack path <> ": ") <>)) + ( \(v :: Aeson.Value) -> + pure $ + if hide + then [req] + else + [ req, + APIResponseLine . Text.pack . BL.unpack $ + Aeson.encodePretty' (Aeson.defConfig {Aeson.confCompare = compare}) v + ] + ) + . Aeson.eitherDecode + . HTTP.responseBody + <=< flip HTTP.httpLbs httpManager + ) + . HTTP.parseRequest + . Text.unpack + $ baseURL <> path - awaitInput :: Cli (Either Event Input) - awaitInput = do - cmd <- atomically (Q.tryDequeue cmdQueue) - case cmd of - -- end of ucm block - Just Nothing -> do - liftIO (output "\n```\n") - liftIO dieUnexpectedSuccess - atomically $ void $ do - scratchFileUpdates <- Q.flush ucmScratchFileUpdatesQueue - -- Push them onto the front stanza queue in the correct order. - for (reverse scratchFileUpdates) \(fp, contents) -> do - let fenceDescription = "unison:added-by-ucm " <> fp - -- Output blocks for any scratch file updates the ucm block triggered. - Q.undequeue inputQueue (Left $ CMarkCodeBlock Nothing fenceDescription contents, Nothing) - awaitInput - -- ucm command to run - Just (Just ucmLine) -> do - case ucmLine of - p@(UcmComment {}) -> do - liftIO . output . Text.unpack $ "\n" <> Transcript.formatUcmLine p - awaitInput - p@(UcmCommand context lineTxt) -> do - curPath <- Cli.getCurrentProjectPath - -- We're either going to run the command now (because we're in the right context), else we'll switch to - -- the right context first, then run the command next. - maybeSwitchCommand <- - case context of - UcmContextProject (ProjectAndBranch projectName branchName) -> Cli.runTransaction do - Project {projectId, name = projectName} <- - Q.loadProjectByName projectName - >>= \case - Nothing -> do - projectId <- Sqlite.unsafeIO (Db.ProjectId <$> UUID.nextRandom) - Q.insertProject projectId projectName - pure $ Project {projectId, name = projectName} - Just project -> pure project - projectBranch <- - Q.loadProjectBranchByName projectId branchName >>= \case - Nothing -> do - branchId <- Sqlite.unsafeIO (Db.ProjectBranchId <$> UUID.nextRandom) - let projectBranch = ProjectBranch {projectId, parentBranchId = Nothing, branchId, name = branchName} - Q.insertProjectBranch "Branch Created" emptyCausalHashId projectBranch - pure projectBranch - Just projBranch -> pure projBranch - let projectAndBranchIds = ProjectAndBranch projectBranch.projectId projectBranch.branchId - pure - if (PP.toProjectAndBranch . PP.toIds $ curPath) == projectAndBranchIds - then Nothing - else Just (ProjectSwitchI (ProjectAndBranchNames'Unambiguous (These projectName branchName))) - case maybeSwitchCommand of - Just switchCommand -> do - atomically $ Q.undequeue cmdQueue (Just p) - pure (Right switchCommand) - Nothing -> do - case words . Text.unpack $ lineTxt of - [] -> awaitInput - args -> do - liftIO . output . Text.unpack $ "\n" <> Transcript.formatUcmLine p <> "\n" - numberedArgs <- use #numberedArgs - PP.ProjectAndBranch projId branchId <- PP.toProjectAndBranch . NonEmpty.head <$> use #projectPathStack - let getProjectRoot = liftIO $ Codebase.expectProjectBranchRoot codebase projId branchId - liftIO (parseInput codebase curPath getProjectRoot numberedArgs patternMap args) >>= \case - -- invalid command is treated as a failure - Left msg -> do + endUcmBlock = do + liftIO $ do + tags <- readIORef currentTags + ucmOut <- readIORef ucmOutput + unless (null ucmOut && tags == Nothing) . outputEcho . pure $ + Ucm (fromMaybe defaultInfoTags' {generated = True} tags) ucmOut + writeIORef ucmOutput [] + dieUnexpectedSuccess + atomically $ void $ do + scratchFileUpdates <- Q.flush ucmScratchFileUpdatesQueue + -- Push them onto the front stanza queue in the correct order. + for (reverse scratchFileUpdates) \(fp, contents) -> + -- Output blocks for any scratch file updates the ucm block triggered. + Q.undequeue inputQueue (pure $ Unison (defaultInfoTags $ pure fp) {generated = True} contents, Nothing) + Cli.returnEarlyWithoutOutput + + processUcmLine p = + case p of + -- We just discard this, because the runner will produce new output lines. + UcmOutputLine {} -> Cli.returnEarlyWithoutOutput + UcmComment {} -> do + liftIO $ outputUcmLine p + Cli.returnEarlyWithoutOutput + UcmCommand context lineTxt -> do + curPath <- Cli.getCurrentProjectPath + -- We're either going to run the command now (because we're in the right context), else we'll switch to + -- the right context first, then run the command next. + maybeSwitchCommand <- case context of + UcmContextProject (ProjectAndBranch projectName branchName) -> Cli.runTransaction do + Project {projectId, name = projectName} <- + Q.loadProjectByName projectName + >>= \case + Nothing -> do + projectId <- Sqlite.unsafeIO (Db.ProjectId <$> UUID.nextRandom) + Q.insertProject projectId projectName + pure $ Project {projectId, name = projectName} + Just project -> pure project + projectBranch <- + Q.loadProjectBranchByName projectId branchName >>= \case + Nothing -> do + branchId <- Sqlite.unsafeIO (Db.ProjectBranchId <$> UUID.nextRandom) + let projectBranch = + ProjectBranch {projectId, parentBranchId = Nothing, branchId, name = branchName} + Q.insertProjectBranch "Branch Created" emptyCausalHashId projectBranch + pure projectBranch + Just projBranch -> pure projBranch + let projectAndBranchIds = ProjectAndBranch projectBranch.projectId projectBranch.branchId + pure + if (PP.toProjectAndBranch . PP.toIds $ curPath) == projectAndBranchIds + then Nothing + else Just (ProjectSwitchI (ProjectAndBranchNames'Unambiguous (These projectName branchName))) + case maybeSwitchCommand of + Just switchCommand -> do + atomically . Q.undequeue cmdQueue $ Just p + pure $ Right switchCommand + Nothing -> do + case words . Text.unpack $ lineTxt of + [] -> Cli.returnEarlyWithoutOutput + args -> do + liftIO $ outputUcmLine p + numberedArgs <- use #numberedArgs + PP.ProjectAndBranch projId branchId <- + PP.toProjectAndBranch . NonEmpty.head <$> use #projectPathStack + let getProjectRoot = liftIO $ Codebase.expectProjectBranchRoot codebase projId branchId + liftIO (parseInput codebase curPath getProjectRoot numberedArgs patternMap args) + >>= either + -- invalid command is treated as a failure + ( \msg -> do liftIO $ writeIORef hasErrors True liftIO (readIORef allowErrors) >>= \case True -> do - liftIO (output . Pretty.toPlain terminalWidth $ ("\n" <> msg <> "\n")) - awaitInput - False -> do - liftIO (dieWithMsg $ Pretty.toPlain terminalWidth msg) - -- No input received from this line, try again. - Right Nothing -> awaitInput - Right (Just (_expandedArgs, input)) -> pure $ Right input - Nothing -> do - liftIO (dieUnexpectedSuccess) - liftIO (writeIORef hidden Shown) - liftIO (writeIORef allowErrors False) - maybeStanza <- atomically (Q.tryDequeue inputQueue) - _ <- liftIO (writeIORef mStanza maybeStanza) - case maybeStanza of - Nothing -> do - liftIO (putStrLn "") - pure $ Right QuitI - Just (s, idx) -> do - unless (Verbosity.isSilent verbosity) . liftIO $ do - putStr $ - "\r⚙️ Processing stanza " - ++ show idx - ++ " of " - ++ show (length stanzas) - ++ "." - IO.hFlush IO.stdout - either - ( \node -> do - liftIO . output . Text.unpack $ Transcript.formatNode node - awaitInput - ) - ( \block -> case block of - Unison hide errOk filename txt -> do - liftIO (writeIORef hidden hide) - liftIO . outputEcho . Text.unpack $ Transcript.formatProcessedBlock block - liftIO (writeIORef allowErrors errOk) - -- Open a ucm block which will contain the output from UCM - -- after processing the UnisonFileChanged event. - liftIO (output "``` ucm\n") - -- Close the ucm block after processing the UnisonFileChanged event. - atomically . Q.enqueue cmdQueue $ Nothing - let sourceName = fromMaybe "scratch.u" filename - liftIO $ updateVirtualFile sourceName txt - pure $ Left (UnisonFileChanged sourceName txt) - API apiRequests -> do - liftIO (output "``` api\n") - liftIO (for_ apiRequests apiRequest) - liftIO (output "```\n\n") - awaitInput - Ucm hide errOk cmds -> do - liftIO (writeIORef hidden hide) - liftIO (writeIORef allowErrors errOk) - liftIO (writeIORef hasErrors False) - liftIO (output "``` ucm") - traverse_ (atomically . Q.enqueue cmdQueue . Just) cmds - atomically . Q.enqueue cmdQueue $ Nothing - awaitInput - ) - s - - loadPreviousUnisonBlock name = do - ufs <- readIORef unisonFiles - case Map.lookup name ufs of - Just uf -> - return (Cli.LoadSuccess uf) - Nothing -> - -- This lets transcripts use the `load` command, as in: - -- - -- .> load someFile.u - -- - -- Important for Unison syntax that can't be embedded in - -- transcripts (like docs, which use ``` in their syntax). - let f = Cli.LoadSuccess <$> readUtf8 (Text.unpack name) - in f <|> pure Cli.InvalidSourceNameError - - writeSourceFile :: ScratchFileName -> Text -> IO () - writeSourceFile fp contents = do - shouldShowSourceChanges <- (== Shown) <$> readIORef hidden - when shouldShowSourceChanges $ do - atomically (Q.enqueue ucmScratchFileUpdatesQueue (fp, contents)) + liftIO $ outputUcmResult msg + Cli.returnEarlyWithoutOutput + False -> liftIO . dieWithMsg $ Pretty.toPlain terminalWidth msg + ) + -- No input received from this line, try again. + (maybe Cli.returnEarlyWithoutOutput $ pure . Right . snd) + + startProcessedBlock block = case block of + Unison infoTags txt -> do + liftIO do + writeIORef isHidden $ hidden infoTags + outputEcho $ pure block + writeIORef allowErrors $ expectingError infoTags + -- Open a ucm block which will contain the output from UCM after processing the `UnisonFileChanged` event. + -- Close the ucm block after processing the UnisonFileChanged event. + atomically . Q.enqueue cmdQueue $ Nothing + let sourceName = fromMaybe "scratch.u" $ additionalTags infoTags + liftIO $ updateVirtualFile sourceName txt + pure . Left $ UnisonFileChanged sourceName txt + API infoTags apiRequests -> do + liftIO do + writeIORef isHidden $ hidden infoTags + writeIORef allowErrors $ expectingError infoTags + outputEcho . pure . API infoTags . fold =<< traverse apiRequest apiRequests + Cli.returnEarlyWithoutOutput + Ucm infoTags cmds -> do + liftIO do + writeIORef currentTags $ pure infoTags + writeIORef isHidden $ hidden infoTags + writeIORef allowErrors $ expectingError infoTags + writeIORef hasErrors False + traverse_ (atomically . Q.enqueue cmdQueue . Just) cmds + atomically . Q.enqueue cmdQueue $ Nothing + Cli.returnEarlyWithoutOutput + + showStatus alwaysShow indicator msg = unless (not alwaysShow && Verbosity.isSilent verbosity) do + clearCurrentLine + putStr $ "\r" <> indicator <> " " <> msg + IO.hFlush IO.stdout + + finishTranscript = do + showStatus True "✔️" "Completed transcript.\n" + pure $ Right QuitI + + processStanza stanza midx = do + liftIO . showStatus False "⚙️" $ + maybe + "Processing UCM-generated stanza." + (\idx -> "Processing stanza " <> show idx <> " of " <> show (length stanzas) <> ".") + midx + either + (bypassStanza . Left) + ( \block -> + if isGeneratedBlock block + then bypassStanza $ pure block + else do + liftIO . writeIORef mBlock $ pure block + startProcessedBlock block + ) + stanza + + bypassStanza stanza = do + liftIO $ output stanza + Cli.returnEarlyWithoutOutput + + whatsNext = do + liftIO dieUnexpectedSuccess + liftIO $ writeIORef currentTags Nothing + liftIO $ writeIORef isHidden Shown + liftIO $ writeIORef allowErrors False + maybe (liftIO finishTranscript) (uncurry processStanza) =<< atomically (Q.tryDequeue inputQueue) + + awaitInput :: Cli (Either Event Input) + awaitInput = maybe whatsNext (maybe endUcmBlock processUcmLine) =<< atomically (Q.tryDequeue cmdQueue) + + loadPreviousUnisonBlock name = + maybe + -- This lets transcripts use the `load` command, as in: + -- + -- .> load someFile.u + (fmap Cli.LoadSuccess (readUtf8 $ Text.unpack name) <|> pure Cli.InvalidSourceNameError) + (pure . Cli.LoadSuccess) + . Map.lookup name + =<< readIORef unisonFiles + + writeSource :: ScratchFileName -> Text -> Bool -> IO () + writeSource fp contents _addFold = do + shouldShowSourceChanges <- (== Shown) <$> readIORef isHidden + when shouldShowSourceChanges . atomically $ Q.enqueue ucmScratchFileUpdatesQueue (fp, contents) updateVirtualFile fp contents updateVirtualFile :: ScratchFileName -> Text -> IO () - updateVirtualFile fp contents = do - liftIO (modifyIORef' unisonFiles (Map.insert fp contents)) + updateVirtualFile fp = modifyIORef' unisonFiles . Map.insert fp print :: Output.Output -> IO () print o = do msg <- notifyUser dir o errOk <- readIORef allowErrors - let rendered = Pretty.toPlain terminalWidth (Pretty.border 2 msg) - output rendered + outputUcmResult msg when (Output.isFailure o) $ if errOk then writeIORef hasErrors True - else dieWithMsg rendered + else dieWithMsg $ Pretty.toPlain terminalWidth msg printNumbered :: Output.NumberedOutput -> IO Output.NumberedArgs printNumbered o = do let (msg, numberedArgs) = notifyNumbered o errOk <- readIORef allowErrors - let rendered = Pretty.toPlain terminalWidth (Pretty.border 2 msg) - output rendered + outputUcmResult msg when (Output.isNumberedFailure o) $ if errOk then writeIORef hasErrors True - else dieWithMsg rendered + else dieWithMsg $ Pretty.toPlain terminalWidth msg pure numberedArgs -- Looks at the current stanza and decides if it is contained in the -- output so far. Appends it if not. appendFailingStanza :: IO () appendFailingStanza = do - stanzaOpt <- readIORef mStanza + blockOpt <- readIORef mBlock currentOut <- readIORef out - let stnz = maybe "" (Text.unpack . Transcript.formatStanza . fst) stanzaOpt - unless (stnz `isSubsequenceOf` concat currentOut) $ - modifyIORef' out (\acc -> acc <> pure stnz) + maybe + (pure ()) + (\block -> unless (elem (pure block) currentOut) $ modifyIORef' out (<> pure (pure block))) + blockOpt - -- output ``` and new lines then call transcriptFailure dieWithMsg :: forall a. String -> IO a dieWithMsg msg = do - output "\n```\n\n" appendFailingStanza - transcriptFailure out $ - "The transcript failed due to an error in the stanza above. The error is:\n\n" <> Text.pack msg + transcriptFailure out "The transcript failed due to an error in the stanza above. The error is:" . pure $ + Text.pack msg dieUnexpectedSuccess :: IO () dieUnexpectedSuccess = do errOk <- readIORef allowErrors hasErr <- readIORef hasErrors when (errOk && not hasErr) $ do - output "\n```\n\n" appendFailingStanza - transcriptFailure out "The transcript was expecting an error in the stanza above, but did not encounter one." + transcriptFailure + out + "The transcript was expecting an error in the stanza above, but did not encounter one." + Nothing authenticatedHTTPClient <- AuthN.newAuthenticatedHTTPClient tokenProvider ucmVersion + seedRef <- newIORef (0 :: Int) + let env = Cli.Env { authHTTPClient = authenticatedHTTPClient, codebase, - config = fromMaybe Configurator.empty config, credentialManager = credMan, generateUniqueName = do i <- atomicModifyIORef' seedRef \i -> let !i' = i + 1 in (i', i) pure (Parser.uniqueBase32Namegen (Random.drgNewSeed (Random.seedFromInteger (fromIntegral i)))), loadSource = loadPreviousUnisonBlock, - writeSource = writeSourceFile, + writeSource, notify = print, notifyNumbered = printNumbered, runtime, @@ -444,34 +479,37 @@ run isTest verbosity dir stanzas codebase runtime sbRuntime nRuntime config ucmV isTranscriptTest = isTest } - let loop :: Cli.LoopState -> IO Text + let loop :: Cli.LoopState -> IO (Seq Stanza) loop s0 = do Cli.runCli env s0 awaitInput >>= \case - (Cli.Success input, s1) -> do - let next s = - loop case input of - Left _ -> s - Right inp -> s & #lastInput ?~ inp - Cli.runCli env s1 (HandleInput.loop input) >>= \case - (Cli.Success (), s2) -> next s2 - (Cli.Continue, s2) -> next s2 - (Cli.HaltRepl, _) -> onHalt + (Cli.Success input, s1) -> + let next s = loop $ either (const s) (\inp -> s & #lastInput ?~ inp) input + in Cli.runCli env s1 (HandleInput.loop input) >>= \case + (Cli.Success (), s2) -> next s2 + (Cli.Continue, s2) -> next s2 + (Cli.HaltRepl, _) -> onHalt (Cli.Continue, s1) -> loop s1 (Cli.HaltRepl, _) -> onHalt where - onHalt = do - texts <- readIORef out - pure $ Text.concat (Text.pack <$> toList (texts :: Seq String)) + onHalt = readIORef out loop (Cli.loopState0 (PP.toIds initialPP)) -transcriptFailure :: IORef (Seq String) -> Text -> IO b -transcriptFailure out msg = do +transcriptFailure :: IORef (Seq Stanza) -> Text -> Maybe Text -> IO b +transcriptFailure out heading mbody = do texts <- readIORef out - UnliftIO.throwIO . RunFailure $ mconcat (Text.pack <$> toList texts) <> "\n\n\128721\n\n" <> msg <> "\n" + UnliftIO.throwIO . RunFailure $ + texts + <> Seq.fromList + ( Left + <$> [ CMark.Node Nothing CMark.PARAGRAPH [CMark.Node Nothing (CMark.TEXT "🛑") []], + CMark.Node Nothing CMark.PARAGRAPH [CMark.Node Nothing (CMark.TEXT heading) []] + ] + <> foldr ((:) . CMarkCodeBlock Nothing "") [] mbody + ) data Error = ParseError (P.ParseErrorBundle Text Void) - | RunFailure Text + | RunFailure (Seq Stanza) deriving stock (Show) deriving anyclass (Exception) diff --git a/unison-cli/src/Unison/CommandLine.hs b/unison-cli/src/Unison/CommandLine.hs index 168e264894..99ac5799d9 100644 --- a/unison-cli/src/Unison/CommandLine.hs +++ b/unison-cli/src/Unison/CommandLine.hs @@ -6,7 +6,6 @@ module Unison.CommandLine ( allow, parseInput, prompt, - watchConfig, watchFileSystem, ) where @@ -15,9 +14,6 @@ import Control.Concurrent (forkIO, killThread) import Control.Lens hiding (aside) import Control.Monad.Except import Control.Monad.Trans.Except -import Data.Configurator (autoConfig, autoReload) -import Data.Configurator qualified as Config -import Data.Configurator.Types (Config, Worth (..)) import Data.List (isPrefixOf, isSuffixOf) import Data.Map qualified as Map import Data.Semialign qualified as Align @@ -50,23 +46,12 @@ import Unison.Util.TQueue qualified as Q import UnliftIO.STM import Prelude hiding (readFile, writeFile) -disableWatchConfig :: Bool -disableWatchConfig = False - allow :: FilePath -> Bool allow p = -- ignore Emacs .# prefixed files, see https://github.com/unisonweb/unison/issues/457 not (".#" `isPrefixOf` takeFileName p) && (isSuffixOf ".u" p || isSuffixOf ".uu" p) -watchConfig :: FilePath -> IO (Config, IO ()) -watchConfig path = - if disableWatchConfig - then pure (Config.empty, pure ()) - else do - (config, t) <- autoReload autoConfig [Optional path] - pure (config, killThread t) - watchFileSystem :: Q.TQueue Event -> FilePath -> IO (IO ()) watchFileSystem q dir = do (cancel, watcher) <- Watch.watchDirectory dir allow diff --git a/unison-cli/src/Unison/CommandLine/FZFResolvers.hs b/unison-cli/src/Unison/CommandLine/FZFResolvers.hs index 37fdff8b18..d72e6db9bd 100644 --- a/unison-cli/src/Unison/CommandLine/FZFResolvers.hs +++ b/unison-cli/src/Unison/CommandLine/FZFResolvers.hs @@ -169,9 +169,21 @@ projectNameOptions codebase _projCtx _searchBranch0 = do -- | All possible local project/branch names. -- E.g. '@unison/base/main' projectBranchOptions :: OptionFetcher -projectBranchOptions codebase _projCtx _searchBranch0 = do - Codebase.runTransaction codebase Q.loadAllProjectBranchNamePairs - <&> fmap (into @Text . fst) +projectBranchOptions codebase projCtx _searchBranch0 = do + projs <- Codebase.runTransaction codebase Q.loadAllProjectBranchNamePairs + projs + & foldMap + ( \(names, projIds) -> + if projIds.project == projCtx.project.projectId + then -- If the branch is in the current project, put a shortened version of the branch name first, + -- then the long-form name at the end of the list (in case the user still types the full name) + [(0 :: Int, "/" <> into @Text names.branch), (2, into @Text names)] + else [(1, into @Text names)] + ) + -- Put branches in this project first. + & List.sort + & fmap snd + & pure -- | All possible local branch names within the current project. -- E.g. '@unison/base/main' diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 38d24809de..87597a8653 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -51,6 +51,7 @@ module Unison.CommandLine.InputPatterns docs, docsToHtml, edit, + editDependents, editNamespace, execute, find, @@ -66,7 +67,9 @@ module Unison.CommandLine.InputPatterns helpTopics, history, ioTest, + ioTestNative, ioTestAll, + ioTestAllNative, libInstallInputPattern, load, makeStandalone, @@ -104,8 +107,11 @@ module Unison.CommandLine.InputPatterns saveExecuteResult, sfind, sfindReplace, + textfind, test, + testNative, testAll, + testAllNative, todo, ui, undo, @@ -140,6 +146,7 @@ where import Control.Lens.Cons qualified as Cons import Data.Bitraversable (bitraverse) +import Data.Char (isSpace) import Data.List (intercalate) import Data.List.Extra qualified as List import Data.List.NonEmpty qualified as NE @@ -1024,10 +1031,10 @@ displayTo = file : defs -> maybe (wrongArgsLength "at least two arguments" [file]) - ( \defs -> - Input.DisplayI . Input.FileLocation - <$> unsupportedStructuredArgument displayTo "a file name" file - <*> traverse handleHashQualifiedNameArg defs + ( \defs -> do + file <- unsupportedStructuredArgument displayTo "a file name" file + names <- traverse handleHashQualifiedNameArg defs + pure (Input.DisplayI (Input.FileLocation file Input.AboveFold) names) ) $ NE.nonEmpty defs [] -> wrongArgsLength "at least two arguments" [] @@ -1080,6 +1087,46 @@ undo = "`undo` reverts the most recent change to the codebase." (const $ pure Input.UndoI) +textfind :: Bool -> InputPattern +textfind allowLib = + InputPattern cmdName aliases I.Visible [("token", OnePlus, noCompletionsArg)] msg parse + where + (cmdName, aliases, alternate) = + if allowLib + then ("text.find.all", ["grep.all"], "Use `text.find` to exclude `lib` from search.") + else ("text.find", ["grep"], "Use `text.find.all` to include search of `lib`.") + parse = \case + [] -> Left (P.text "Please supply at least one token.") + words -> pure $ Input.TextFindI allowLib (untokenize $ [e | Left e <- words]) + msg = + P.lines + [ P.wrap $ + makeExample (textfind allowLib) ["token1", "\"99\"", "token2"] + <> " finds terms with literals (text or numeric) containing" + <> "`token1`, `99`, and `token2`.", + "", + P.wrap $ + "Numeric literals must be quoted (ex: \"42\")" + <> "but single words need not be quoted.", + "", + P.wrap alternate + ] + +-- | Reinterprets `"` in the expected way, combining tokens until reaching +-- the closing quote. +-- Example: `untokenize ["\"uno", "dos\""]` becomes `["uno dos"]`. +untokenize :: [String] -> [String] +untokenize words = go (unwords words) + where + go words = case words of + [] -> [] + '"' : quoted -> takeWhile (/= '"') quoted : go (drop 1 . dropWhile (/= '"') $ quoted) + unquoted -> case span ok unquoted of + ("", rem) -> go (dropWhile isSpace rem) + (tok, rem) -> tok : go (dropWhile isSpace rem) + where + ok ch = ch /= '"' && not (isSpace ch) + sfind :: InputPattern sfind = InputPattern "rewrite.find" ["sfind"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg parse @@ -1975,10 +2022,10 @@ pushForce :: InputPattern pushForce = InputPattern "unsafe.force-push" - [] - I.Hidden + ["push.unsafe-force"] + I.Visible [("remote destination", Optional, remoteNamespaceArg), ("local source", Optional, namespaceOrProjectBranchArg suggestionsConfig)] - (P.wrap "Like `push`, but overwrites any remote namespace.") + (P.wrap "Like `push`, but forcibly overwrites the remote namespace.") $ fmap ( \sourceTarget -> Input.PushRemoteBranchI @@ -2335,12 +2382,42 @@ edit = parse = maybe (wrongArgsLength "at least one argument" []) - ( fmap (Input.ShowDefinitionI Input.LatestFileLocation Input.ShowDefinitionLocal) + ( fmap (Input.ShowDefinitionI (Input.LatestFileLocation Input.WithinFold) Input.ShowDefinitionLocal) + . traverse handleHashQualifiedNameArg + ) + . NE.nonEmpty + } + +editNew :: InputPattern +editNew = + InputPattern + { patternName = "edit.new", + aliases = [], + visibility = I.Visible, + args = [("definition to edit", OnePlus, definitionQueryArg)], + help = "Like `edit`, but adds a new fold line below the definitions.", + parse = + maybe + (wrongArgsLength "at least one argument" []) + ( fmap (Input.ShowDefinitionI (Input.LatestFileLocation Input.AboveFold) Input.ShowDefinitionLocal) . traverse handleHashQualifiedNameArg ) . NE.nonEmpty } +editDependents :: InputPattern +editDependents = + InputPattern + { patternName = "edit.dependents", + aliases = [], + visibility = I.Visible, + args = [("definition to edit", Required, definitionQueryArg)], + help = "Like `edit`, but also includes all transitive dependents in the current project.", + parse = \case + [name] -> Input.EditDependentsI <$> handleHashQualifiedNameArg name + args -> wrongArgsLength "exactly one argument" args + } + editNamespace :: InputPattern editNamespace = InputPattern @@ -2798,6 +2875,39 @@ test = fmap ( \path -> Input.TestI + False + Input.TestInput + { includeLibNamespace = False, + path, + showFailures = True, + showSuccesses = True + } + ) + . \case + [] -> pure Path.empty + [pathString] -> handlePathArg pathString + args -> wrongArgsLength "no more than one argument" args + } + +testNative :: InputPattern +testNative = + InputPattern + { patternName = "test.native", + aliases = [], + visibility = I.Hidden, + args = [("namespace", Optional, namespaceArg)], + help = + P.wrapColumn2 + [ ( "`test.native`", + "runs unit tests for the current branch on the native runtime" + ), + ("`test foo`", "runs unit tests for the current branch defined in namespace `foo` on the native runtime") + ], + parse = + fmap + ( \path -> + Input.TestI + True Input.TestInput { includeLibNamespace = False, path, @@ -2822,6 +2932,27 @@ testAll = ( const $ pure $ Input.TestI + False + Input.TestInput + { includeLibNamespace = True, + path = Path.empty, + showFailures = True, + showSuccesses = True + } + ) + +testAllNative :: InputPattern +testAllNative = + InputPattern + "test.native.all" + ["test.all.native"] + I.Hidden + [] + "`test.native.all` runs unit tests for the current branch (including the `lib` namespace) on the native runtime." + ( const $ + pure $ + Input.TestI + True Input.TestInput { includeLibNamespace = True, path = Path.empty, @@ -2921,7 +3052,27 @@ ioTest = ) ], parse = \case - [thing] -> Input.IOTestI <$> handleHashQualifiedNameArg thing + [thing] -> Input.IOTestI False <$> handleHashQualifiedNameArg thing + args -> wrongArgsLength "exactly one argument" args + } + +ioTestNative :: InputPattern +ioTestNative = + InputPattern + { patternName = "io.test.native", + aliases = ["test.io.native", "test.native.io"], + visibility = I.Hidden, + args = [("test to run", Required, exactDefinitionTermQueryArg)], + help = + P.wrapColumn2 + [ ( "`io.test.native mytest`", + "Runs `!mytest` on the native runtime, where `mytest` " + <> "is a delayed test that can use the `IO` and " + <> "`Exception` abilities." + ) + ], + parse = \case + [thing] -> Input.IOTestI True <$> handleHashQualifiedNameArg thing args -> wrongArgsLength "exactly one argument" args } @@ -2939,7 +3090,25 @@ ioTestAll = ) ], parse = \case - [] -> Right Input.IOTestAllI + [] -> Right (Input.IOTestAllI False) + args -> wrongArgsLength "no arguments" args + } + +ioTestAllNative :: InputPattern +ioTestAllNative = + InputPattern + { patternName = "io.test.native.all", + aliases = ["test.io.native.all", "test.native.io.all"], + visibility = I.Hidden, + args = [], + help = + P.wrapColumn2 + [ ( "`io.test.native.all`", + "runs unit tests for the current branch that use IO" + ) + ], + parse = \case + [] -> Right (Input.IOTestAllI True) args -> wrongArgsLength "no arguments" args } @@ -2991,21 +3160,37 @@ compileScheme = "compile.native" [] I.Hidden - [("definition to compile", Required, exactDefinitionTermQueryArg), ("output file", Required, filePathArg)] + [ ("definition to compile", Required, exactDefinitionTermQueryArg), + ("output file", Required, filePathArg), + ("profile", Optional, profileArg) + ] ( P.wrapColumn2 - [ ( makeExample compileScheme ["main", "file"], + [ ( makeExample compileScheme ["main", "file", "profile"], "Creates stand alone executable via compilation to" <> "scheme. The created executable will have the effect" - <> "of running `!main`." + <> "of running `!main`. Providing `profile` as a third" + <> "argument will enable profiling." ) ] ) $ \case - [main, file] -> - Input.CompileSchemeI . Text.pack - <$> unsupportedStructuredArgument compileScheme "a file name" file - <*> handleHashQualifiedNameArg main - args -> wrongArgsLength "exactly two arguments" args + [main, file] -> mkCompileScheme False file main + [main, file, prof] -> do + unsupportedStructuredArgument compileScheme "profile" prof + >>= \case + "profile" -> mkCompileScheme True file main + parg -> + Left . P.text $ + "I expected the third argument to be `profile`, but" + <> " instead recieved `" + <> Text.pack parg + <> "`." + args -> wrongArgsLength "two or three arguments" args + where + mkCompileScheme pf fn mn = + Input.CompileSchemeI pf . Text.pack + <$> unsupportedStructuredArgument compileScheme "a file name" fn + <*> handleHashQualifiedNameArg mn createAuthor :: InputPattern createAuthor = @@ -3430,7 +3615,9 @@ validInputs = docs, docsToHtml, edit, + editDependents, editNamespace, + editNew, execute, find, findIn, @@ -3442,12 +3629,16 @@ validInputs = findVerboseAll, sfind, sfindReplace, + textfind False, + textfind True, forkLocal, help, helpTopics, history, ioTest, + ioTestNative, ioTestAll, + ioTestAllNative, libInstallInputPattern, load, makeStandalone, @@ -3485,7 +3676,9 @@ validInputs = runScheme, saveExecuteResult, test, + testNative, testAll, + testAllNative, todo, ui, undo, @@ -3647,6 +3840,15 @@ remoteNamespaceArg = fzfResolver = Nothing } +profileArg :: ArgumentType +profileArg = + ArgumentType + { typeName = "profile", + suggestions = \_input _cb _http _p -> + pure [Line.simpleCompletion "profile"], + fzfResolver = Nothing + } + data ProjectInclusion = OnlyWithinCurrentProject | OnlyOutsideCurrentProject | AllProjects deriving stock (Eq, Ord, Show) diff --git a/unison-cli/src/Unison/CommandLine/Main.hs b/unison-cli/src/Unison/CommandLine/Main.hs index 914581664b..3b86508eb0 100644 --- a/unison-cli/src/Unison/CommandLine/Main.hs +++ b/unison-cli/src/Unison/CommandLine/Main.hs @@ -9,7 +9,6 @@ import Control.Exception (catch, displayException, finally, mask) import Control.Lens ((?~)) import Control.Lens.Lens import Crypto.Random qualified as Random -import Data.Configurator.Types (Config) import Data.IORef import Data.List.NonEmpty qualified as NEL import Data.List.NonEmpty qualified as NonEmpty @@ -48,6 +47,8 @@ import Unison.Prelude import Unison.PrettyTerminal import Unison.Runtime.IOSource qualified as IOSource import Unison.Server.CodebaseServer qualified as Server +import Unison.Share.Codeserver (isCustomCodeserver) +import Unison.Share.Codeserver qualified as Codeserver import Unison.Symbol (Symbol) import Unison.Syntax.Parser qualified as Parser import Unison.Util.Pretty qualified as P @@ -76,10 +77,17 @@ getUserInput codebase authHTTPClient pp currentProjectRoot numberedArgs = Line.handleInterrupt (pure Nothing) (Line.withInterrupt (Just <$> act)) >>= \case Nothing -> haskelineCtrlCHandling act Just a -> pure a + + codeserverPrompt :: String + codeserverPrompt = + if isCustomCodeserver Codeserver.defaultCodeserver + then "🌐" <> Codeserver.codeserverRegName Codeserver.defaultCodeserver <> maybe "" (":" <>) (show <$> Codeserver.codeserverPort Codeserver.defaultCodeserver) <> "\n" + else "" + go :: Line.InputT IO Input go = do let promptString = P.prettyProjectPath pp - let fullPrompt = P.toANSI 80 (promptString <> fromString prompt) + let fullPrompt = P.toANSI 80 (P.red (P.string codeserverPrompt) <> promptString <> fromString prompt) line <- Line.getInputLine fullPrompt case line of Nothing -> pure QuitI @@ -124,7 +132,6 @@ main :: FilePath -> Welcome.Welcome -> PP.ProjectPathIds -> - Config -> [Either Event Input] -> Runtime.Runtime Symbol -> Runtime.Runtime Symbol -> @@ -135,7 +142,7 @@ main :: (PP.ProjectPathIds -> IO ()) -> ShouldWatchFiles -> IO () -main dir welcome ppIds config initialInputs runtime sbRuntime nRuntime codebase serverBaseUrl ucmVersion lspCheckForChanges shouldWatchFiles = Ki.scoped \scope -> do +main dir welcome ppIds initialInputs runtime sbRuntime nRuntime codebase serverBaseUrl ucmVersion lspCheckForChanges shouldWatchFiles = Ki.scoped \scope -> do _ <- Ki.fork scope do -- Pre-load the project root in the background so it'll be ready when a command needs it. projectRoot <- Codebase.expectProjectBranchRoot codebase ppIds.project ppIds.branch @@ -210,21 +217,22 @@ main dir welcome ppIds config initialInputs runtime sbRuntime nRuntime codebase writeIORef pageOutput True pure x - let foldLine :: Text - foldLine = "\n\n---- Anything below this line is ignored by Unison.\n\n" - let writeSourceFile :: Text -> Text -> IO () - writeSourceFile fp contents = do + let writeSource :: Text -> Text -> Bool -> IO () + writeSource fp contents addFold = do path <- Directory.canonicalizePath (Text.unpack fp) - prependUtf8 path (contents <> foldLine) + prependUtf8 + path + if addFold + then contents <> "\n\n---- Anything below this line is ignored by Unison.\n\n" + else contents <> "\n\n" let env = Cli.Env { authHTTPClient, codebase, - config, credentialManager, loadSource = loadSourceFile, - writeSource = writeSourceFile, + writeSource, generateUniqueName = Parser.uniqueBase32Namegen <$> Random.getSystemDRG, notify, notifyNumbered = \o -> diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 8fe38e4599..ba367d8afd 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -30,6 +30,7 @@ import Servant.Client qualified as Servant import System.Console.ANSI qualified as ANSI import System.Console.Haskeline.Completion qualified as Completion import System.Directory (canonicalizePath, getHomeDirectory) +import System.Exit (ExitCode (..)) import Text.Pretty.Simple (pShowNoColor, pStringNoColor) import U.Codebase.Branch (NamespaceStats (..)) import U.Codebase.Branch.Diff (NameChanges (..)) @@ -97,10 +98,7 @@ import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE import Unison.PrettyPrintEnv.Util qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPED -import Unison.PrettyTerminal - ( clearCurrentLine, - putPretty', - ) +import Unison.PrettyTerminal (clearCurrentLine, putPretty') import Unison.PrintError ( prettyParseError, prettyResolutionFailures, @@ -118,8 +116,7 @@ import Unison.Result qualified as Result import Unison.Server.Backend (ShallowListEntry (..), TypeEntry (..)) import Unison.Server.Backend qualified as Backend import Unison.Server.SearchResultPrime qualified as SR' -import Unison.Share.Sync qualified as Share -import Unison.Share.Sync.Types (CodeserverTransportError (..)) +import Unison.Share.Sync.Types qualified as Share (CodeserverTransportError (..), GetCausalHashByPathError (..), PullError (..)) import Unison.Sync.Types qualified as Share import Unison.Syntax.DeclPrinter qualified as DeclPrinter import Unison.Syntax.HashQualified qualified as HQ (toText, unsafeFromVar) @@ -1320,17 +1317,24 @@ notifyUser dir = \case prettyProjectAndBranchName aliceAndBob.alice <> "was already up-to-date with" <> P.group (prettyMergeSource aliceAndBob.bob <> ".") - MergeConflictedAliases aliceOrBob name1 name2 -> + MergeConflictedAliases aliceOrBob defn -> pure $ P.wrap "Sorry, I wasn't able to perform the merge:" <> P.newline <> P.newline <> P.wrap ( "On the merge ancestor," - <> prettyName name1 - <> "and" - <> prettyName name2 - <> "were aliases for the same definition, but on" + <> ( let (isTerm, name1, name2) = + case defn of + TermDefn (n1, n2) -> (True, n1, n2) + TypeDefn (n1, n2) -> (False, n1, n2) + in prettyName name1 + <> "and" + <> prettyName name2 + <> "were aliases for the same" + <> P.group ((if isTerm then "term" else "type") <> ",") + ) + <> "but on" <> prettyMergeSourceOrTarget aliceOrBob <> "the names have different definitions currently. I'd need just a single new definition to use in their" <> "dependents when I merge." @@ -1361,22 +1365,27 @@ notifyUser dir = \case <> P.newline <> P.newline <> P.wrap "and then try merging again." - MergeConflictInvolvingBuiltin name -> - pure . P.lines $ - [ P.wrap "Sorry, I wasn't able to perform the merge:", - "", - P.wrap - ( "There's a merge conflict on" - <> P.group (prettyName name <> ",") - <> "but it's a builtin on one or both branches. I can't yet handle merge conflicts involving builtins." - ), - "", - P.wrap - ( "Please eliminate this conflict by updating one branch or the other, making" - <> prettyName name - <> "the same on both branches, or making neither of them a builtin, and then try the merge again." - ) - ] + MergeConflictInvolvingBuiltin defn -> + let (isTerm, name) = + case defn of + TermDefn n -> (True, n) + TypeDefn n -> (False, n) + in pure . P.lines $ + [ P.wrap "Sorry, I wasn't able to perform the merge:", + "", + P.wrap + ( "There's a merge conflict on" + <> (if isTerm then "term" else "type") + <> P.group (prettyName name <> ",") + <> "but it's a builtin on one or both branches. I can't yet handle merge conflicts involving builtins." + ), + "", + P.wrap + ( "Please eliminate this conflict by updating one branch or the other, making" + <> prettyName name + <> "the same on both branches, or making neither of them a builtin, and then try the merge again." + ) + ] -- Note [DefnsInLibMessage] If you change this, also change the other similar one MergeDefnsInLib aliceOrBob -> pure . P.lines $ @@ -1436,7 +1445,13 @@ notifyUser dir = \case ListDependencies ppe lds types terms -> pure $ listDependentsOrDependencies ppe "Dependencies" "dependencies" lds types terms ListStructuredFind terms -> - pure $ listStructuredFind terms + pure $ listFind False Nothing terms + ListTextFind True terms -> + pure $ listFind True Nothing terms + ListTextFind False terms -> + pure $ listFind False (Just tip) terms + where + tip = (IP.makeExample (IP.textfind True) [] <> " will search `lib` as well.") DumpUnisonFileHashes hqLength datas effects terms -> pure . P.syntaxToColor . P.lines $ ( effects <&> \(n, r) -> @@ -2013,6 +2028,49 @@ notifyUser dir = \case "to delete the temporary branch and switch back to" <> P.group (prettyProjectBranchName aliceAndBob.alice.branch <> ".") ] + MergeFailureWithMergetool aliceAndBob temp mergetool exitCode -> + case exitCode of + ExitSuccess -> + pure $ + P.lines $ + [ P.wrap $ + "I couldn't automatically merge" + <> prettyMergeSource aliceAndBob.bob + <> "into" + <> P.group (prettyProjectAndBranchName aliceAndBob.alice <> ",") + <> "so I'm running your UCM_MERGETOOL environment variable as", + "", + P.indentN 2 (P.text mergetool), + "", + P.wrap "When you're done, you can run", + "", + P.indentN 2 (IP.makeExampleNoBackticks IP.mergeCommitInputPattern []), + "", + P.wrap $ + "to merge your changes back into" + <> prettyProjectBranchName aliceAndBob.alice.branch + <> "and delete the temporary branch. Or, if you decide to cancel the merge instead, you can run", + "", + P.indentN 2 (IP.makeExampleNoBackticks IP.deleteBranch [prettySlashProjectBranchName temp]), + "", + P.wrap $ + "to delete the temporary branch and switch back to" + <> P.group (prettyProjectBranchName aliceAndBob.alice.branch <> ".") + ] + ExitFailure code -> + pure $ + P.lines $ + [ P.wrap $ + "I couldn't automatically merge" + <> prettyMergeSource aliceAndBob.bob + <> "into" + <> P.group (prettyProjectAndBranchName aliceAndBob.alice <> ",") + <> "so I tried to run your UCM_MERGETOOL environment variable as", + "", + P.indentN 2 (P.text mergetool), + "", + P.wrap ("but it failed with exit code" <> P.group (P.num code <> ".")) + ] MergeSuccess aliceAndBob -> pure . P.wrap $ "I merged" @@ -2202,6 +2260,7 @@ notifyUser dir = \case <> IP.makeExample' IP.delete <> "it. Then try the update again." ] + Literal message -> pure message prettyShareError :: ShareError -> Pretty prettyShareError = @@ -2284,28 +2343,28 @@ prettyEntityValidationFailure = \case Share.NamespaceDiffType -> "namespace diff" Share.CausalType -> "causal" -prettyTransportError :: CodeserverTransportError -> Pretty +prettyTransportError :: Share.CodeserverTransportError -> Pretty prettyTransportError = \case - DecodeFailure msg resp -> + Share.DecodeFailure msg resp -> (P.lines . catMaybes) [ Just ("The server sent a response that we couldn't decode: " <> P.text msg), responseRequestId resp <&> \responseId -> P.newline <> "Request ID: " <> P.blue (P.text responseId) ] - Unauthenticated codeServerURL -> + Share.Unauthenticated codeServerURL -> P.wrap . P.lines $ [ "Authentication with this code server (" <> P.string (Servant.showBaseUrl codeServerURL) <> ") is missing or expired.", "Please run " <> makeExample' IP.authLogin <> "." ] - PermissionDenied msg -> P.hang "Permission denied:" (P.text msg) - UnreachableCodeserver codeServerURL -> + Share.PermissionDenied msg -> P.hang "Permission denied:" (P.text msg) + Share.UnreachableCodeserver codeServerURL -> P.lines $ [ P.wrap $ "Unable to reach the code server hosted at:" <> P.string (Servant.showBaseUrl codeServerURL), "", P.wrap "Please check your network, ensure you've provided the correct location, or try again later." ] - RateLimitExceeded -> "Rate limit exceeded, please try again later." - Timeout -> "The code server timed-out when responding to your request. Please try again later or report an issue if the problem persists." - UnexpectedResponse resp -> + Share.RateLimitExceeded -> "Rate limit exceeded, please try again later." + Share.Timeout -> "The code server timed-out when responding to your request. Please try again later or report an issue if the problem persists." + Share.UnexpectedResponse resp -> (P.lines . catMaybes) [ Just ( "The server sent a " @@ -3579,17 +3638,19 @@ endangeredDependentsTable ppeDecl m = & fmap (\(n, dep) -> numArg n <> prettyLabeled fqnEnv dep) & P.lines -listStructuredFind :: [HQ.HashQualified Name] -> Pretty -listStructuredFind [] = "😶 I couldn't find any matches." -listStructuredFind tms = +listFind :: Bool -> Maybe Pretty -> [HQ.HashQualified Name] -> Pretty +listFind _ Nothing [] = "😶 I couldn't find any matches." +listFind _ (Just onMissing) [] = P.lines ["😶 I couldn't find any matches.", "", tip onMissing] +listFind allowLib _ tms = P.callout "🔎" . P.lines $ - [ "These definitions from the current namespace (excluding `lib`) have matches:", + [ "These definitions from the current namespace " <> parenthetical <> "have matches:", "", P.indentN 2 $ P.numberedList (pnames tms), "", tip (msg (length tms)) ] where + parenthetical = if allowLib then "" else "(excluding `lib`) " pnames hqs = P.syntaxToColor . prettyHashQualified <$> hqs msg 1 = "Try " <> IP.makeExample IP.edit ["1"] <> " to bring this into your scratch file." msg n = diff --git a/unison-cli/src/Unison/LSP/Completion.hs b/unison-cli/src/Unison/LSP/Completion.hs index d822c62be2..6e0ea31d56 100644 --- a/unison-cli/src/Unison/LSP/Completion.hs +++ b/unison-cli/src/Unison/LSP/Completion.hs @@ -42,7 +42,6 @@ import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment -import Unison.NameSegment.Internal qualified as NameSegment import Unison.Names (Names (..)) import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE @@ -334,18 +333,18 @@ completionItemResolveHandler message respond = do LD.TermReferent ref -> do typ <- LSPQ.getTypeOfReferent fileUri ref let renderedType = ": " <> (Text.pack $ TypePrinter.prettyStr (Just typeWidth) (PPED.suffixifiedPPE pped) typ) - let doc = toMarkup (Text.unlines $ ["```unison", Name.toText fullyQualifiedName, "```"] ++ renderedDocs) + let doc = toMarkup (Text.unlines $ ["``` unison", Name.toText fullyQualifiedName, "```"] ++ renderedDocs) pure $ (completion {_detail = Just renderedType, _documentation = Just doc} :: CompletionItem) LD.TypeReference ref -> case ref of Reference.Builtin {} -> do let renderedBuiltin = ": " - let doc = toMarkup (Text.unlines $ ["```unison", Name.toText fullyQualifiedName, "```"] ++ renderedDocs) + let doc = toMarkup (Text.unlines $ ["``` unison", Name.toText fullyQualifiedName, "```"] ++ renderedDocs) pure $ (completion {_detail = Just renderedBuiltin, _documentation = Just doc} :: CompletionItem) Reference.DerivedId refId -> do decl <- LSPQ.getTypeDeclaration fileUri refId let renderedDecl = ": " <> (Text.pack . Pretty.toPlain typeWidth . Pretty.syntaxToColor $ DeclPrinter.prettyDecl pped ref (HQ.NameOnly relativeName) decl) - let doc = toMarkup (Text.unlines $ ["```unison", Name.toText fullyQualifiedName, "```"] ++ renderedDocs) + let doc = toMarkup (Text.unlines $ ["``` unison", Name.toText fullyQualifiedName, "```"] ++ renderedDocs) pure $ (completion {_detail = Just renderedDecl, _documentation = Just doc} :: CompletionItem) _ -> empty where diff --git a/unison-cli/src/Unison/LSP/FileAnalysis.hs b/unison-cli/src/Unison/LSP/FileAnalysis.hs index bec9f8bf9f..2b5363c7ff 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis.hs @@ -92,7 +92,9 @@ checkFile doc = runMaybeT do Parser.ParsingEnv { uniqueNames = uniqueName, uniqueTypeGuid = Cli.loadUniqueTypeGuid pp, - names = parseNames + names = parseNames, + maybeNamespace = Nothing, + localNamespacePrefixedTypesAndConstructors = mempty } (notes, parsedFile, typecheckedFile) <- do liftIO do diff --git a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs index 85a3511cfd..5dd7c14cad 100644 --- a/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs +++ b/unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs @@ -17,10 +17,10 @@ import Unison.Term (Term) import Unison.Term qualified as Term import Unison.Util.List qualified as ListUtils import Unison.Util.Range qualified as Range +import Unison.Util.Recursion import Unison.Var qualified as Var -data VarUsages - = VarUsages +data VarUsages = VarUsages { unusedVars :: Map Symbol (Set Ann), usedVars :: Set Symbol, -- This is generally a copy of usedVars, except that we _don't_ remove variables when they go out of scope. @@ -39,7 +39,7 @@ instance Monoid VarUsages where analyseTerm :: Lsp.Uri -> Term Symbol Ann -> [Diagnostic] analyseTerm fileUri tm = - let (VarUsages {unusedVars}) = ABT.cata alg tm + let (VarUsages {unusedVars}) = cata alg tm vars = Map.toList unusedVars & mapMaybe \(v, ann) -> do (,ann) <$> getRelevantVarName v @@ -63,10 +63,8 @@ analyseTerm fileUri tm = guard (not (Text.isPrefixOf "_" n)) Just n _ -> Nothing - alg :: - Ann -> - (ABT (Term.F Symbol Ann Ann) Symbol VarUsages -> VarUsages) - alg ann abt = case abt of + alg :: Algebra (ABT.Term' (Term.F Symbol Ann Ann) Symbol Ann) VarUsages + alg (ABT.Term' _ ann abt) = case abt of Var v -> VarUsages {unusedVars = mempty, usedVars = Set.singleton v, allUsedVars = Set.singleton v} Cycle x -> x Abs v (VarUsages {unusedVars, usedVars, allUsedVars}) -> diff --git a/unison-cli/src/Unison/LSP/Hover.hs b/unison-cli/src/Unison/LSP/Hover.hs index aa6e6b7cf3..54a34da6b8 100644 --- a/unison-cli/src/Unison/LSP/Hover.hs +++ b/unison-cli/src/Unison/LSP/Hover.hs @@ -52,7 +52,7 @@ hoverInfo uri pos = (hoverInfoForRef <|> hoverInfoForLiteral) where markdownify :: Text -> Text - markdownify rendered = Text.unlines ["```unison", rendered, "```"] + markdownify rendered = Text.unlines ["``` unison", rendered, "```"] prettyWidth :: Pretty.Width prettyWidth = 40 hoverInfoForRef :: MaybeT Lsp Text diff --git a/unison-cli/src/Unison/Main.hs b/unison-cli/src/Unison/Main.hs index 990f11354f..3624a50675 100644 --- a/unison-cli/src/Unison/Main.hs +++ b/unison-cli/src/Unison/Main.hs @@ -27,7 +27,6 @@ import Compat (defaultInterruptHandler, withInterruptHandler) import Control.Concurrent (newEmptyMVar, runInUnboundThread, takeMVar) import Control.Exception (displayException, evaluate) import Data.ByteString.Lazy qualified as BL -import Data.Configurator.Types (Config) import Data.Either.Validation (Validation (..)) import Data.List.NonEmpty (NonEmpty) import Data.Text qualified as Text @@ -57,7 +56,6 @@ import System.FilePath ) import System.IO (stderr) import System.IO.CodePage (withCP65001) -import System.IO.Error (catchIOError) import System.IO.Temp qualified as Temp import System.Path qualified as Path import Text.Megaparsec qualified as MP @@ -74,9 +72,9 @@ import Unison.Codebase.Path qualified as Path import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime qualified as Rt import Unison.Codebase.SqliteCodebase qualified as SC +import Unison.Codebase.Transcript.Parser qualified as Transcript import Unison.Codebase.Transcript.Runner qualified as Transcript import Unison.Codebase.Verbosity qualified as Verbosity -import Unison.CommandLine (watchConfig) import Unison.CommandLine.Helpers (plural') import Unison.CommandLine.Main qualified as CommandLine import Unison.CommandLine.Types qualified as CommandLine @@ -96,7 +94,6 @@ import Unison.Symbol (Symbol) import Unison.Util.Pretty qualified as P import Unison.Version (Version) import Unison.Version qualified as Version -import UnliftIO qualified import UnliftIO.Directory (getHomeDirectory) type Runtimes = @@ -143,220 +140,216 @@ main version = do (renderUsageInfo, globalOptions, command) <- parseCLIArgs progName (Text.unpack (Version.gitDescribeWithDate version)) nrtp <- fixNativeRuntimePath (nativeRuntimePath globalOptions) let GlobalOptions {codebasePathOption = mCodePathOption, exitOption, lspFormattingConfig} = globalOptions - withConfig mCodePathOption \config -> do - currentDir <- getCurrentDirectory - case command of - PrintVersion -> - Text.putStrLn $ Text.pack progName <> " version: " <> Version.gitDescribeWithDate version - Init -> do - exitError - ( P.lines - [ "The Init command has been removed", - P.newline, - P.wrap "Use --codebase-create to create a codebase at a specified location and open it:", - P.indentN 2 (P.hiBlue "$ ucm --codebase-create myNewCodebase"), - "Running UCM without the --codebase-create flag: ", - P.indentN 2 (P.hiBlue "$ ucm"), - P.wrap ("will " <> P.bold "always" <> " create a codebase in your home directory if one does not already exist.") + currentDir <- getCurrentDirectory + case command of + PrintVersion -> + Text.putStrLn $ Text.pack progName <> " version: " <> Version.gitDescribeWithDate version + Init -> do + exitError + ( P.lines + [ "The Init command has been removed", + P.newline, + P.wrap "Use --codebase-create to create a codebase at a specified location and open it:", + P.indentN 2 (P.hiBlue "$ ucm --codebase-create myNewCodebase"), + "Running UCM without the --codebase-create flag: ", + P.indentN 2 (P.hiBlue "$ ucm"), + P.wrap ("will " <> P.bold "always" <> " create a codebase in your home directory if one does not already exist.") + ] + ) + Run (RunFromSymbol mainName) args -> do + getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(_, _, theCodebase) -> do + RTI.withRuntime False RTI.OneOff (Version.gitDescribeWithDate version) \runtime -> do + withArgs args (execute theCodebase runtime mainName) >>= \case + Left err -> exitError err + Right () -> pure () + Run (RunFromFile file mainName) args + | not (isDotU file) -> exitError "Files must have a .u extension." + | otherwise -> do + e <- safeReadUtf8 file + case e of + Left _ -> exitError "I couldn't find that file or it is for some reason unreadable." + Right contents -> do + getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do + withRuntimes nrtp RTI.OneOff \(rt, sbrt, nrt) -> do + let fileEvent = Input.UnisonFileChanged (Text.pack file) contents + let noOpCheckForChanges _ = pure () + let serverUrl = Nothing + startProjectPath <- Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath + launch + version + currentDir + rt + sbrt + nrt + theCodebase + [Left fileEvent, Right $ Input.ExecuteI mainName args, Right Input.QuitI] + serverUrl + (PP.toIds startProjectPath) + initRes + noOpCheckForChanges + CommandLine.ShouldNotWatchFiles + Run (RunFromPipe mainName) args -> do + e <- safeReadUtf8StdIn + case e of + Left _ -> exitError "I had trouble reading this input." + Right contents -> do + getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do + withRuntimes nrtp RTI.OneOff \(rt, sbrt, nrt) -> do + let fileEvent = Input.UnisonFileChanged (Text.pack "") contents + let noOpCheckForChanges _ = pure () + let serverUrl = Nothing + startProjectPath <- Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath + launch + version + currentDir + rt + sbrt + nrt + theCodebase + [Left fileEvent, Right $ Input.ExecuteI mainName args, Right Input.QuitI] + serverUrl + (PP.toIds startProjectPath) + initRes + noOpCheckForChanges + CommandLine.ShouldNotWatchFiles + Run (RunCompiled file) args -> + BL.readFile file >>= \bs -> + try (evaluate $ RTI.decodeStandalone bs) >>= \case + Left (PE _cs err) -> do + exitError . P.lines $ + [ P.wrap . P.text $ + "I was unable to parse this file as a compiled\ + \ program. The parser generated the following error:", + "", + P.indentN 2 $ err ] - ) - Run (RunFromSymbol mainName) args -> do - getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(_, _, theCodebase) -> do - RTI.withRuntime False RTI.OneOff (Version.gitDescribeWithDate version) \runtime -> do - withArgs args (execute theCodebase runtime mainName) >>= \case - Left err -> exitError err - Right () -> pure () - Run (RunFromFile file mainName) args - | not (isDotU file) -> exitError "Files must have a .u extension." - | otherwise -> do - e <- safeReadUtf8 file - case e of - Left _ -> exitError "I couldn't find that file or it is for some reason unreadable." - Right contents -> do - getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do - withRuntimes nrtp RTI.OneOff \(rt, sbrt, nrt) -> do - let fileEvent = Input.UnisonFileChanged (Text.pack file) contents - let noOpCheckForChanges _ = pure () - let serverUrl = Nothing - startProjectPath <- Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath + Right (Left err) -> + exitError . P.lines $ + [ P.wrap . P.text $ + "I was unable to parse this file as a compiled\ + \ program. The parser generated the following error:", + "", + P.indentN 2 . P.wrap $ P.string err + ] + Left _ -> do + exitError . P.wrap . P.text $ + "I was unable to parse this file as a compiled\ + \ program. The parser generated an unrecognized error." + Right (Right (v, rf, combIx, sto)) + | not vmatch -> mismatchMsg + | otherwise -> + withArgs args (RTI.runStandalone sto combIx) >>= \case + Left err -> exitError err + Right () -> pure () + where + vmatch = v == Version.gitDescribeWithDate version + ws s = P.wrap (P.text s) + ifile + | 'c' : 'u' : '.' : rest <- reverse file = reverse rest + | otherwise = file + mismatchMsg = + PT.putPrettyLn . P.lines $ + [ ws + "I can't run this compiled program since \ + \it works with a different version of Unison \ + \than the one you're running.", + "", + "Compiled file version", + P.indentN 4 $ P.text v, + "", + "Your version", + P.indentN 4 $ P.text $ Version.gitDescribeWithDate version, + "", + P.wrap $ + "The program was compiled from hash " + <> (P.text $ "`" <> rf <> "`.") + <> "If you have that hash in your codebase," + <> "you can do:", + "", + P.indentN 4 $ + ".> compile " + <> P.text rf + <> " " + <> P.string ifile, + "", + P.wrap + "to produce a new compiled program \ + \that matches your version of Unison." + ] + Transcript shouldFork shouldSaveCodebase mrtsStatsFp transcriptFiles -> do + let action = runTranscripts version Verbosity.Verbose renderUsageInfo shouldFork shouldSaveCodebase mCodePathOption nrtp transcriptFiles + case mrtsStatsFp of + Nothing -> action + Just fp -> recordRtsStats fp action + Launch isHeadless codebaseServerOpts mayStartingProject shouldWatchFiles -> do + getCodebaseOrExit mCodePathOption (SC.MigrateAfterPrompt SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do + withRuntimes nrtp RTI.Persistent \(runtime, sbRuntime, nRuntime) -> do + startingProjectPath <- do + -- If the user didn't provide a starting path on the command line, put them in the most recent + -- path they cd'd to + case mayStartingProject of + Just startingProject -> do + Codebase.runTransaction theCodebase (ProjectUtils.getProjectAndBranchByNames startingProject) >>= \case + Nothing -> do + PT.putPrettyLn $ + P.callout + "❓" + ( P.lines + [ P.indentN 2 "I couldn't find the project branch: " <> P.text (into @Text startingProject) + ] + ) + System.exitFailure + Just pab -> do + pure $ PP.fromProjectAndBranch pab Path.absoluteEmpty + Nothing -> do + Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath + currentPP <- Codebase.runTransaction theCodebase do + PP.toIds <$> Codebase.expectCurrentProjectPath + changeSignal <- Signal.newSignalIO (Just currentPP) + let lspCheckForChanges pp = Signal.writeSignalIO changeSignal pp + -- Unfortunately, the windows IO manager on GHC 8.* is prone to just hanging forever + -- when waiting for input on handles, so if we listen for LSP connections it will + -- prevent UCM from shutting down properly. Hopefully we can re-enable LSP on + -- Windows when we move to GHC 9.* + -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/1224 + void . Ki.fork scope $ LSP.spawnLsp lspFormattingConfig theCodebase runtime changeSignal + Server.startServer (Backend.BackendEnv {Backend.useNamesIndex = False}) codebaseServerOpts sbRuntime theCodebase $ \baseUrl -> do + case exitOption of + DoNotExit -> do + case isHeadless of + Headless -> do + PT.putPrettyLn $ + P.lines + [ "I've started the Codebase API server at", + P.text $ Server.urlFor Server.Api baseUrl, + "and the Codebase UI at", + P.text $ Server.urlFor (Server.ProjectBranchUI (ProjectAndBranch (UnsafeProjectName "scratch") (UnsafeProjectBranchName "main")) Path.absoluteEmpty Nothing) baseUrl + ] + PT.putPrettyLn $ + P.string "Running the codebase manager headless with " + <> P.shown GHC.Conc.numCapabilities + <> " " + <> plural' GHC.Conc.numCapabilities "cpu" "cpus" + <> "." + mvar <- newEmptyMVar + takeMVar mvar + WithCLI -> do + PT.putPrettyLn $ P.string "Now starting the Unison Codebase Manager (UCM)..." + launch version currentDir - config - rt - sbrt - nrt + runtime + sbRuntime + nRuntime theCodebase - [Left fileEvent, Right $ Input.ExecuteI mainName args, Right Input.QuitI] - serverUrl - (PP.toIds startProjectPath) + [] + (Just baseUrl) + (PP.toIds startingProjectPath) initRes - noOpCheckForChanges - CommandLine.ShouldNotWatchFiles - Run (RunFromPipe mainName) args -> do - e <- safeReadUtf8StdIn - case e of - Left _ -> exitError "I had trouble reading this input." - Right contents -> do - getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do - withRuntimes nrtp RTI.OneOff \(rt, sbrt, nrt) -> do - let fileEvent = Input.UnisonFileChanged (Text.pack "") contents - let noOpCheckForChanges _ = pure () - let serverUrl = Nothing - startProjectPath <- Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath - launch - version - currentDir - config - rt - sbrt - nrt - theCodebase - [Left fileEvent, Right $ Input.ExecuteI mainName args, Right Input.QuitI] - serverUrl - (PP.toIds startProjectPath) - initRes - noOpCheckForChanges - CommandLine.ShouldNotWatchFiles - Run (RunCompiled file) args -> - BL.readFile file >>= \bs -> - try (evaluate $ RTI.decodeStandalone bs) >>= \case - Left (PE _cs err) -> do - exitError . P.lines $ - [ P.wrap . P.text $ - "I was unable to parse this file as a compiled\ - \ program. The parser generated the following error:", - "", - P.indentN 2 $ err - ] - Right (Left err) -> - exitError . P.lines $ - [ P.wrap . P.text $ - "I was unable to parse this file as a compiled\ - \ program. The parser generated the following error:", - "", - P.indentN 2 . P.wrap $ P.string err - ] - Left _ -> do - exitError . P.wrap . P.text $ - "I was unable to parse this file as a compiled\ - \ program. The parser generated an unrecognized error." - Right (Right (v, rf, w, sto)) - | not vmatch -> mismatchMsg - | otherwise -> - withArgs args (RTI.runStandalone sto w) >>= \case - Left err -> exitError err - Right () -> pure () - where - vmatch = v == Version.gitDescribeWithDate version - ws s = P.wrap (P.text s) - ifile - | 'c' : 'u' : '.' : rest <- reverse file = reverse rest - | otherwise = file - mismatchMsg = - PT.putPrettyLn . P.lines $ - [ ws - "I can't run this compiled program since \ - \it works with a different version of Unison \ - \than the one you're running.", - "", - "Compiled file version", - P.indentN 4 $ P.text v, - "", - "Your version", - P.indentN 4 $ P.text $ Version.gitDescribeWithDate version, - "", - P.wrap $ - "The program was compiled from hash " - <> (P.text $ "`" <> rf <> "`.") - <> "If you have that hash in your codebase," - <> "you can do:", - "", - P.indentN 4 $ - ".> compile " - <> P.text rf - <> " " - <> P.string ifile, - "", - P.wrap - "to produce a new compiled program \ - \that matches your version of Unison." - ] - Transcript shouldFork shouldSaveCodebase mrtsStatsFp transcriptFiles -> do - let action = runTranscripts version Verbosity.Verbose renderUsageInfo shouldFork shouldSaveCodebase mCodePathOption nrtp transcriptFiles - case mrtsStatsFp of - Nothing -> action - Just fp -> recordRtsStats fp action - Launch isHeadless codebaseServerOpts mayStartingProject shouldWatchFiles -> do - getCodebaseOrExit mCodePathOption (SC.MigrateAfterPrompt SC.Backup SC.Vacuum) \(initRes, _, theCodebase) -> do - withRuntimes nrtp RTI.Persistent \(runtime, sbRuntime, nRuntime) -> do - startingProjectPath <- do - -- If the user didn't provide a starting path on the command line, put them in the most recent - -- path they cd'd to - case mayStartingProject of - Just startingProject -> do - Codebase.runTransaction theCodebase (ProjectUtils.getProjectAndBranchByNames startingProject) >>= \case - Nothing -> do - PT.putPrettyLn $ - P.callout - "❓" - ( P.lines - [ P.indentN 2 "I couldn't find the project branch: " <> P.text (into @Text startingProject) - ] - ) - System.exitFailure - Just pab -> do - pure $ PP.fromProjectAndBranch pab Path.absoluteEmpty - Nothing -> do - Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath - currentPP <- Codebase.runTransaction theCodebase do - PP.toIds <$> Codebase.expectCurrentProjectPath - changeSignal <- Signal.newSignalIO (Just currentPP) - let lspCheckForChanges pp = Signal.writeSignalIO changeSignal pp - -- Unfortunately, the windows IO manager on GHC 8.* is prone to just hanging forever - -- when waiting for input on handles, so if we listen for LSP connections it will - -- prevent UCM from shutting down properly. Hopefully we can re-enable LSP on - -- Windows when we move to GHC 9.* - -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/1224 - void . Ki.fork scope $ LSP.spawnLsp lspFormattingConfig theCodebase runtime changeSignal - Server.startServer (Backend.BackendEnv {Backend.useNamesIndex = False}) codebaseServerOpts sbRuntime theCodebase $ \baseUrl -> do - case exitOption of - DoNotExit -> do - case isHeadless of - Headless -> do - PT.putPrettyLn $ - P.lines - [ "I've started the Codebase API server at", - P.text $ Server.urlFor Server.Api baseUrl, - "and the Codebase UI at", - P.text $ Server.urlFor (Server.ProjectBranchUI (ProjectAndBranch (UnsafeProjectName "scratch") (UnsafeProjectBranchName "main")) Path.absoluteEmpty Nothing) baseUrl - ] - PT.putPrettyLn $ - P.string "Running the codebase manager headless with " - <> P.shown GHC.Conc.numCapabilities - <> " " - <> plural' GHC.Conc.numCapabilities "cpu" "cpus" - <> "." - mvar <- newEmptyMVar - takeMVar mvar - WithCLI -> do - PT.putPrettyLn $ P.string "Now starting the Unison Codebase Manager (UCM)..." - - launch - version - currentDir - config - runtime - sbRuntime - nRuntime - theCodebase - [] - (Just baseUrl) - (PP.toIds startingProjectPath) - initRes - lspCheckForChanges - shouldWatchFiles - Exit -> do Exit.exitSuccess + lspCheckForChanges + shouldWatchFiles + Exit -> do Exit.exitSuccess where -- (runtime, sandboxed runtime) withRuntimes :: FilePath -> RTI.RuntimeHost -> (Runtimes -> IO a) -> IO a @@ -366,17 +359,6 @@ main version = do action . (runtime,sbRuntime,) -- startNativeRuntime saves the path to `unison-runtime` =<< RTI.startNativeRuntime (Version.gitDescribeWithDate version) nrtp - withConfig :: Maybe CodebasePathOption -> (Config -> IO a) -> IO a - withConfig mCodePathOption action = do - UnliftIO.bracket - ( do - let mcodepath = fmap codebasePathOptionToPath mCodePathOption - configFilePath <- getConfigFilePath mcodepath - catchIOError (watchConfig configFilePath) $ \_ -> - exitError "Your .unisonConfig could not be loaded. Check that it's correct!" - ) - (\(_config, cancel) -> cancel) - (\(config, _cancel) -> action config) -- | Set user agent and configure TLS on global http client. -- Note that the authorized http client is distinct from the global http client. @@ -416,14 +398,12 @@ prepareTranscriptDir verbosity shouldFork mCodePathOption shouldSaveCodebase = d runTranscripts' :: Version -> String -> - Maybe FilePath -> FilePath -> FilePath -> NonEmpty MarkdownFile -> IO Bool -runTranscripts' version progName mcodepath nativeRtp transcriptDir markdownFiles = do +runTranscripts' version progName nativeRtp transcriptDir markdownFiles = do currentDir <- getCurrentDirectory - configFilePath <- getConfigFilePath mcodepath -- We don't need to create a codebase through `getCodebaseOrExit` as we've already done so previously. and <$> getCodebaseOrExit @@ -436,7 +416,6 @@ runTranscripts' version progName mcodepath nativeRtp transcriptDir markdownFiles Verbosity.Verbose (Version.gitDescribeWithDate version) nativeRtp - (Just configFilePath) \runTranscript -> do for markdownFiles $ \(MarkdownFile fileName) -> do transcriptSrc <- readUtf8 fileName @@ -457,7 +436,7 @@ runTranscripts' version progName mcodepath nativeRtp transcriptDir markdownFiles Transcript.RunFailure msg -> ( [ P.indentN 2 $ "An error occurred while running the following file: " <> P.string fileName, "", - P.indentN 2 (P.text msg), + P.indentN 2 (P.text . Transcript.formatStanzas $ toList msg), P.string $ "Run `" <> progName @@ -466,10 +445,10 @@ runTranscripts' version progName mcodepath nativeRtp transcriptDir markdownFiles <> "` " <> "to do more work with it." ], - msg + Transcript.formatStanzas $ toList msg ) ) - pure + (pure . Transcript.formatStanzas . toList) result writeUtf8 outputFile output putStrLn $ "💾 Wrote " <> outputFile @@ -503,7 +482,7 @@ runTranscripts version verbosity renderUsageInfo shouldFork shouldSaveTempCodeba progName <- getProgName transcriptDir <- prepareTranscriptDir verbosity shouldFork mCodePathOption shouldSaveTempCodebase completed <- - runTranscripts' version progName (Just transcriptDir) nativeRtp transcriptDir markdownFiles + runTranscripts' version progName nativeRtp transcriptDir markdownFiles case shouldSaveTempCodebase of DontSaveCodebase -> removeDirectoryRecursive transcriptDir SaveCodebase _ -> @@ -527,7 +506,6 @@ runTranscripts version verbosity renderUsageInfo shouldFork shouldSaveTempCodeba launch :: Version -> FilePath -> - Config -> Rt.Runtime Symbol -> Rt.Runtime Symbol -> Rt.Runtime Symbol -> @@ -539,7 +517,7 @@ launch :: (PP.ProjectPathIds -> IO ()) -> CommandLine.ShouldWatchFiles -> IO () -launch version dir config runtime sbRuntime nRuntime codebase inputs serverBaseUrl startingPath initResult lspCheckForChanges shouldWatchFiles = do +launch version dir runtime sbRuntime nRuntime codebase inputs serverBaseUrl startingPath initResult lspCheckForChanges shouldWatchFiles = do showWelcomeHint <- Codebase.runTransaction codebase Queries.doProjectsExist let isNewCodebase = case initResult of CreatedCodebase -> NewlyCreatedCodebase @@ -550,7 +528,6 @@ launch version dir config runtime sbRuntime nRuntime codebase inputs serverBaseU dir welcome startingPath - config inputs runtime sbRuntime @@ -572,9 +549,6 @@ markdownFile md = case takeExtension md of isDotU :: String -> Bool isDotU file = takeExtension file == ".u" -getConfigFilePath :: Maybe FilePath -> IO FilePath -getConfigFilePath mcodepath = ( ".unisonConfig") <$> Codebase.getCodebaseDir mcodepath - getCodebaseOrExit :: Maybe CodebasePathOption -> SC.MigrationStrategy -> ((InitResult, CodebasePath, Codebase IO Symbol Ann) -> IO r) -> IO r getCodebaseOrExit codebasePathOption migrationStrategy action = do initOptions <- argsToCodebaseInitOptions codebasePathOption diff --git a/unison-cli/src/Unison/Share/Codeserver.hs b/unison-cli/src/Unison/Share/Codeserver.hs index a1617a4411..ea7aee4b73 100644 --- a/unison-cli/src/Unison/Share/Codeserver.hs +++ b/unison-cli/src/Unison/Share/Codeserver.hs @@ -1,4 +1,10 @@ -module Unison.Share.Codeserver where +module Unison.Share.Codeserver + ( isCustomCodeserver, + defaultCodeserver, + resolveCodeserver, + CodeserverURI (..), + ) +where import Network.URI (parseURI) import System.IO.Unsafe (unsafePerformIO) @@ -8,18 +14,24 @@ import Unison.Share.Types import Unison.Share.Types qualified as Share import UnliftIO.Environment (lookupEnv) +shareProd :: CodeserverURI +shareProd = + CodeserverURI + { codeserverScheme = Share.Https, + codeserverUserInfo = "", + codeserverRegName = "api.unison-lang.org", + codeserverPort = Nothing, + codeserverPath = [] + } + +isCustomCodeserver :: CodeserverURI -> Bool +isCustomCodeserver = (/=) shareProd + -- | This is the URI where the share API is based. defaultCodeserver :: CodeserverURI defaultCodeserver = unsafePerformIO $ do lookupEnv "UNISON_SHARE_HOST" <&> \case - Nothing -> - CodeserverURI - { codeserverScheme = Share.Https, - codeserverUserInfo = "", - codeserverRegName = "api.unison-lang.org", - codeserverPort = Nothing, - codeserverPath = [] - } + Nothing -> shareProd Just shareHost -> fromMaybe (error $ "Share Host is not a valid URI: " <> shareHost) $ do uri <- parseURI shareHost diff --git a/unison-cli/tests/Unison/Test/ClearCache.hs b/unison-cli/tests/Unison/Test/ClearCache.hs index 20f5090f2f..8c49f10389 100644 --- a/unison-cli/tests/Unison/Test/ClearCache.hs +++ b/unison-cli/tests/Unison/Test/ClearCache.hs @@ -22,10 +22,10 @@ test = scope "clearWatchCache" $ Ucm.runTranscript c [i| - ```ucm + ``` ucm scratch/main> alias.term ##Nat.+ + ``` - ```unison + ``` unison > 1 + 1 ``` |] @@ -37,7 +37,7 @@ test = scope "clearWatchCache" $ Ucm.runTranscript c [i| - ```ucm + ``` ucm scratch/main> debug.clear-cache ``` |] diff --git a/unison-cli/tests/Unison/Test/LSP.hs b/unison-cli/tests/Unison/Test/LSP.hs index 2ab406da56..02af644740 100644 --- a/unison-cli/tests/Unison/Test/LSP.hs +++ b/unison-cli/tests/Unison/Test/LSP.hs @@ -39,6 +39,7 @@ import Unison.Term qualified as Term import Unison.Type qualified as Type import Unison.UnisonFile qualified as UF import Unison.Util.Monoid (foldMapM) +import Unison.Util.Recursion test :: Test () test = do @@ -344,12 +345,12 @@ annotationNestingTest (name, src) = scope name do -- within the span of the parent node. assertAnnotationsAreNested :: forall f. (Foldable f, Functor f, Show (f (Either String Ann))) => ABT.Term f Symbol Ann -> Test () assertAnnotationsAreNested term = do - case ABT.cata alg term of + case cata alg term of Right _ -> pure () Left err -> crash err where - alg :: Ann -> ABT.ABT f Symbol (Either String Ann) -> Either String Ann - alg ann abt = do + alg :: Algebra (ABT.Term' f Symbol Ann) (Either String Ann) + alg (ABT.Term' _ ann abt) = do childSpan <- abt & foldMapM id case abt of -- Abs nodes are the only nodes whose annotations are allowed to not contain their children, @@ -384,7 +385,9 @@ typecheckSrc name src = do Parser.ParsingEnv { uniqueNames = uniqueName, uniqueTypeGuid = \_ -> pure Nothing, - names = parseNames + names = parseNames, + maybeNamespace = Nothing, + localNamespacePrefixedTypesAndConstructors = mempty } Codebase.runTransaction codebase do Parsers.parseFile name (Text.unpack src) parsingEnv >>= \case diff --git a/unison-cli/tests/Unison/Test/Ucm.hs b/unison-cli/tests/Unison/Test/Ucm.hs index 1a8033c52b..9b2019c71b 100644 --- a/unison-cli/tests/Unison/Test/Ucm.hs +++ b/unison-cli/tests/Unison/Test/Ucm.hs @@ -24,10 +24,11 @@ import Unison.Codebase qualified as Codebase import Unison.Codebase.Init qualified as Codebase.Init import Unison.Codebase.Init.CreateCodebaseError (CreateCodebaseError (..)) import Unison.Codebase.SqliteCodebase qualified as SC +import Unison.Codebase.Transcript.Parser qualified as Transcript import Unison.Codebase.Transcript.Runner qualified as Transcript import Unison.Codebase.Verbosity qualified as Verbosity import Unison.Parser.Ann (Ann) -import Unison.Prelude (traceM) +import Unison.Prelude (toList, traceM) import Unison.PrettyTerminal qualified as PT import Unison.Symbol (Symbol) import Unison.Util.Pretty qualified as P @@ -67,17 +68,18 @@ runTranscript (Codebase codebasePath fmt) transcript = do let err e = fail $ "Parse error: \n" <> show e cbInit = case fmt of CodebaseFormat2 -> SC.init isTest = True - Transcript.withRunner isTest Verbosity.Silent "Unison.Test.Ucm.runTranscript Invalid Version String" rtp configFile $ + Transcript.withRunner isTest Verbosity.Silent "Unison.Test.Ucm.runTranscript Invalid Version String" rtp $ \runner -> do result <- Codebase.Init.withOpenCodebase cbInit "transcript" codebasePath SC.DoLock SC.DontMigrate \codebase -> do Codebase.runTransaction codebase (Codebase.installUcmDependencies codebase) let transcriptSrc = stripMargin . Text.pack $ unTranscript transcript - output <- either err Text.unpack <$> runner "transcript" transcriptSrc (codebasePath, codebase) + output <- + either err (Text.unpack . Transcript.formatStanzas . toList) + <$> runner "transcript" transcriptSrc (codebasePath, codebase) when debugTranscriptOutput $ traceM output pure output either (fail . P.toANSI 80 . P.shown) pure result where - configFile = Nothing -- Note: this needs to be properly configured if these tests ever -- need to do native compiles. But I suspect they won't. rtp = "native-compiler/bin" diff --git a/unison-cli/transcripts/Transcripts.hs b/unison-cli/transcripts/Transcripts.hs index 77220a3061..9b54be7a20 100644 --- a/unison-cli/transcripts/Transcripts.hs +++ b/unison-cli/transcripts/Transcripts.hs @@ -25,6 +25,7 @@ import System.IO.Silently (silence) import Text.Megaparsec qualified as MP import Unison.Codebase.Init (withTemporaryUcmCodebase) import Unison.Codebase.SqliteCodebase qualified as SC +import Unison.Codebase.Transcript.Parser as Transcript import Unison.Codebase.Transcript.Runner as Transcript import Unison.Codebase.Verbosity qualified as Verbosity import Unison.Prelude @@ -36,69 +37,108 @@ data TestConfig = TestConfig } deriving (Show) -type TestBuilder = FilePath -> FilePath -> [String] -> String -> Test () +type TestBuilder = + -- | path to the native runtime + FilePath -> + -- | directory containing prelude & transcript `FilePath`s + FilePath -> + -- | directory to write output files to (often the same as the previous argument) + FilePath -> + -- | prelude files (relative to previous directory `FilePath`) + [FilePath] -> + -- | transcript file (relative to earlier directory `FilePath`) + FilePath -> + Test () testBuilder :: + Bool -> Bool -> ((FilePath, Text) -> IO ()) -> FilePath -> FilePath -> - [String] -> - String -> + FilePath -> + [FilePath] -> + FilePath -> Test () -testBuilder expectFailure recordFailure runtimePath dir prelude transcript = scope transcript $ do - outputs <- io . withTemporaryUcmCodebase SC.init Verbosity.Silent "transcript" SC.DoLock $ \(codebasePath, codebase) -> do - let isTest = True - Transcript.withRunner isTest Verbosity.Silent "TODO: pass version here" runtimePath Nothing \runTranscript -> do - for files \filePath -> do - transcriptSrc <- readUtf8 filePath - out <- silence $ runTranscript filePath transcriptSrc (codebasePath, codebase) - pure (filePath, out) - for_ outputs \case - (filePath, Left err) -> do - let outputFile = outputFileForTranscript filePath - case err of - Transcript.ParseError errors -> do - when (not expectFailure) $ do - let errMsg = "Error parsing " <> filePath <> ": " <> MP.errorBundlePretty errors - io $ recordFailure (filePath, Text.pack errMsg) - crash errMsg - Transcript.RunFailure errOutput -> do - io $ writeUtf8 outputFile errOutput - when (not expectFailure) $ do - io $ Text.putStrLn errOutput - io $ recordFailure (filePath, errOutput) - crash $ "Failure in " <> filePath - (filePath, Right out) -> do - let outputFile = outputFileForTranscript filePath - io $ writeUtf8 outputFile out - when expectFailure $ do - let errMsg = "Expected a failure, but transcript was successful." - io $ recordFailure (filePath, Text.pack errMsg) - crash errMsg - ok +testBuilder expectFailure replaceOriginal recordFailure runtimePath inputDir outputDir prelude transcript = + scope transcript do + outputs <- + io $ withTemporaryUcmCodebase SC.init Verbosity.Silent "transcript" SC.DoLock \(codebasePath, codebase) -> + let isTest = True + in Transcript.withRunner isTest Verbosity.Silent "TODO: pass version here" runtimePath \runTranscript -> + for files \filePath -> do + transcriptSrc <- readUtf8 $ inputDir filePath + out <- silence $ runTranscript filePath transcriptSrc (codebasePath, codebase) + pure (filePath, out) + for_ outputs \case + (filePath, Left err) -> do + let outputFile = outputDir outputFileForTranscript filePath + case err of + Transcript.ParseError errors -> do + let bundle = MP.errorBundlePretty errors + errMsg = "Error parsing " <> filePath <> ": " <> bundle + -- Drop the file name, to avoid POSIX/Windows conflicts + io . writeUtf8 outputFile . Text.dropWhile (/= ':') $ Text.pack bundle + when (not expectFailure) $ do + io $ recordFailure (inputDir filePath, Text.pack errMsg) + crash errMsg + Transcript.RunFailure errOutput -> do + let errText = Transcript.formatStanzas $ toList errOutput + io $ writeUtf8 outputFile errText + when (not expectFailure) $ do + io $ Text.putStrLn errText + io $ recordFailure (inputDir filePath, errText) + crash $ "Failure in " <> filePath + (filePath, Right out) -> do + let outputFile = outputDir if replaceOriginal then filePath else outputFileForTranscript filePath + io . createDirectoryIfMissing True $ takeDirectory outputFile + io . writeUtf8 outputFile . Transcript.formatStanzas $ toList out + when expectFailure $ do + let errMsg = "Expected a failure, but transcript was successful." + io $ recordFailure (filePath, Text.pack errMsg) + crash errMsg + ok where - files = fmap (dir ) (prelude ++ [transcript]) + files = prelude ++ [transcript] outputFileForTranscript :: FilePath -> FilePath outputFileForTranscript filePath = replaceExtension filePath ".output.md" -buildTests :: TestConfig -> TestBuilder -> FilePath -> Test () -buildTests TestConfig {..} testBuilder dir = do - io - . putStrLn - . unlines - $ [ "", - "Searching for transcripts to run in: " ++ dir - ] - files <- io $ listDirectory dir +enumerateTests :: TestConfig -> TestBuilder -> [FilePath] -> Test () +enumerateTests TestConfig {..} testBuilder files = do + io . putStrLn . unlines $ + [ "", + "Running explicitly-named transcripts" + ] + -- Any files that start with _ are treated as prelude + let (prelude, transcripts) = + files + & sort + & partition (isPrefixOf "_" . snd . splitFileName) + -- if there is a matchPrefix set, filter non-prelude files by that prefix - or return True + & second (filter (\f -> maybe True (`isPrefixOf` f) matchPrefix)) + + case length transcripts of + 0 -> pure () + -- EasyTest exits early with "no test results recorded" if you don't give it any tests, this keeps it going till the + -- end so we can search all transcripts for prefix matches. + _ -> + tests (testBuilder runtimePath "." ("unison-src" "transcripts" "project-outputs") prelude <$> transcripts) + +buildTests :: TestConfig -> TestBuilder -> FilePath -> Maybe FilePath -> Test () +buildTests TestConfig {..} testBuilder inputDir outputDir = do + io . putStrLn . unlines $ + [ "", + "Searching for transcripts to run in: " ++ inputDir + ] + files <- io $ listDirectory inputDir -- Any files that start with _ are treated as prelude let (prelude, transcripts) = files & sort - & filter (\f -> takeExtensions f == ".md") - & partition ((isPrefixOf "_") . snd . splitFileName) + & filter (\f -> let ext = takeExtensions f in ext == ".md" || ext == ".markdown") + & partition (isPrefixOf "_" . snd . splitFileName) -- if there is a matchPrefix set, filter non-prelude files by that prefix - or return True & second (filter (\f -> maybe True (`isPrefixOf` f) matchPrefix)) @@ -108,7 +148,7 @@ buildTests TestConfig {..} testBuilder dir = do -- if you don't give it any tests, this keeps it going -- till the end so we can search all transcripts for -- prefix matches. - _ -> tests (testBuilder runtimePath dir prelude <$> transcripts) + _ -> tests (testBuilder runtimePath inputDir (fromMaybe inputDir outputDir) prelude <$> transcripts) -- Transcripts that exit successfully get cleaned-up by the transcript parser. -- Any remaining folders matching "transcript-.*" are output directories @@ -122,13 +162,11 @@ cleanup = do unless (null dirs) $ do io $ createDirectoryIfMissing True "test-output" io $ for_ dirs (\d -> renameDirectory d ("test-output" d)) - io - . putStrLn - . unlines - $ [ "", - "NOTE: All transcript codebases have been moved into", - "the `test-output` directory. Feel free to delete it." - ] + io . putStrLn . unlines $ + [ "", + "NOTE: All transcript codebases have been moved into", + "the `test-output` directory. Feel free to delete it." + ] test :: TestConfig -> Test () test config = do @@ -136,12 +174,16 @@ test config = do -- what went wrong in CI failuresVar <- io $ STM.newTVarIO [] let recordFailure failure = STM.atomically $ STM.modifyTVar' failuresVar (failure :) - buildTests config (testBuilder False recordFailure) $ - "unison-src" "transcripts" - buildTests config (testBuilder False recordFailure) $ - "unison-src" "transcripts-using-base" - buildTests config (testBuilder True recordFailure) $ - "unison-src" "transcripts" "errors" + buildTests config (testBuilder False False recordFailure) ("unison-src" "transcripts") Nothing + buildTests config (testBuilder False True recordFailure) ("unison-src" "transcripts" "idempotent") Nothing + buildTests config (testBuilder False False recordFailure) ("unison-src" "transcripts-using-base") Nothing + buildTests config (testBuilder True False recordFailure) ("unison-src" "transcripts" "errors") Nothing + buildTests config (testBuilder False False recordFailure) "docs" . Just $ + "unison-src" "transcripts" "project-outputs" "docs" + enumerateTests config (testBuilder False False recordFailure) $ + [ ".github/ISSUE_TEMPLATE/bug_report.md", + ".github/pull_request_template.md" + ] failures <- io $ STM.readTVarIO failuresVar -- Print all aggregated failures when (not $ null failures) . io $ Text.putStrLn $ "Failures:" @@ -152,8 +194,7 @@ test config = do cleanup handleArgs :: TestConfig -> [String] -> TestConfig -handleArgs acc ("--runtime-path" : p : rest) = - handleArgs (acc {runtimePath = p}) rest +handleArgs acc ("--runtime-path" : p : rest) = handleArgs (acc {runtimePath = p}) rest handleArgs acc [prefix] = acc {matchPrefix = Just prefix} handleArgs acc _ = acc @@ -165,7 +206,4 @@ defaultConfig = TestConfig Nothing <$> defaultRTP pure (takeDirectory ucm "runtime" "unison-runtime" <.> exeExtension) main :: IO () -main = withCP65001 do - dcfg <- defaultConfig - testConfig <- handleArgs dcfg <$> getArgs - run (test testConfig) +main = withCP65001 $ run . test =<< handleArgs <$> defaultConfig <*> getArgs diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 2955a288da..8f82804198 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.0. +-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack @@ -17,10 +17,6 @@ source-repository head type: git location: https://github.com/unisonweb/unison -flag optimized - manual: True - default: False - library exposed-modules: ArgParse @@ -38,9 +34,9 @@ library Unison.Cli.MergeTypes Unison.Cli.Monad Unison.Cli.MonadUtils + Unison.Cli.NameResolutionUtils Unison.Cli.NamesUtils Unison.Cli.Pretty - Unison.Cli.PrettyPrintUtils Unison.Cli.ProjectUtils Unison.Cli.ServantClientUtils Unison.Cli.Share.Projects @@ -61,7 +57,10 @@ library Unison.Codebase.Editor.HandleInput.DebugFoldRanges Unison.Codebase.Editor.HandleInput.DebugSynhashTerm Unison.Codebase.Editor.HandleInput.DeleteBranch + Unison.Codebase.Editor.HandleInput.DeleteNamespace Unison.Codebase.Editor.HandleInput.DeleteProject + Unison.Codebase.Editor.HandleInput.Dependents + Unison.Codebase.Editor.HandleInput.EditDependents Unison.Codebase.Editor.HandleInput.EditNamespace Unison.Codebase.Editor.HandleInput.FindAndReplace Unison.Codebase.Editor.HandleInput.FormatFile @@ -193,40 +192,34 @@ library ViewPatterns ghc-options: -Wall build-depends: - IntervalMap + Diff + , IntervalMap , ListLike , aeson >=2.0.0.0 , aeson-pretty , ansi-terminal , async , base - , bytes , bytestring , cmark , co-log-core , code-page , concurrent-output - , conduit - , configurator , containers >=0.6.3 , cryptonite - , deepseq , directory , either , errors - , exceptions , extra , filepath , free , friendly-time , fsnotify - , fuzzyfind , generic-lens , haskeline , http-client >=0.7.6 , http-client-tls , http-types - , jwt , ki , lens , lock-file @@ -235,9 +228,7 @@ library , megaparsec , memory , mtl - , network , network-simple - , network-udp , network-uri , nonempty-containers , numerals @@ -245,27 +236,19 @@ library , optparse-applicative >=0.16.1.0 , pretty-simple , process - , random >=1.2.0 , random-shuffle , recover-rtti , regex-tdfa , semialign - , semigroups - , serialise , servant , servant-client - , servant-conduit - , shellmet , stm - , stm-chans - , template-haskell , temporary , text , text-ansi , text-builder , text-rope , these - , these-lens , time , transformers , unison-codebase @@ -278,15 +261,15 @@ library , unison-parser-typechecker , unison-prelude , unison-pretty-printer + , unison-runtime , unison-share-api , unison-share-projects-api , unison-sqlite , unison-syntax , unison-util-base32hex + , unison-util-recursion , unison-util-relation , unliftio - , unordered-containers - , uri-encode , uuid , vector , wai @@ -294,8 +277,6 @@ library , witch , witherable default-language: Haskell2010 - if flag(optimized) - ghc-options: -O2 -funbox-strict-fields if !os(windows) build-depends: unix @@ -340,112 +321,19 @@ executable transcripts ViewPatterns ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-I0 -N -qn4 -qg1" -v0 build-depends: - IntervalMap - , ListLike - , aeson >=2.0.0.0 - , aeson-pretty - , ansi-terminal - , async - , base - , bytes - , bytestring - , cmark - , co-log-core + base , code-page - , concurrent-output - , conduit - , configurator - , containers >=0.6.3 - , cryptonite - , deepseq , directory , easytest - , either - , errors - , exceptions - , extra , filepath - , free - , friendly-time - , fsnotify - , fuzzyfind - , generic-lens - , haskeline - , http-client >=0.7.6 - , http-client-tls - , http-types - , jwt - , ki - , lens - , lock-file - , lsp >=2.2.0.0 - , lsp-types >=2.0.2.0 , megaparsec - , memory - , mtl - , network - , network-simple - , network-udp - , network-uri - , nonempty-containers - , numerals - , open-browser - , optparse-applicative >=0.16.1.0 - , pretty-simple - , process - , random >=1.2.0 - , random-shuffle - , recover-rtti - , regex-tdfa - , semialign - , semigroups - , serialise - , servant - , servant-client - , servant-conduit - , shellmet , silently - , stm - , stm-chans - , template-haskell - , temporary , text - , text-ansi - , text-builder - , text-rope - , these - , these-lens - , time - , transformers , unison-cli - , unison-codebase - , unison-codebase-sqlite - , unison-codebase-sqlite-hashing-v2 - , unison-core - , unison-core1 - , unison-hash - , unison-merge , unison-parser-typechecker , unison-prelude - , unison-pretty-printer - , unison-share-api - , unison-share-projects-api - , unison-sqlite - , unison-syntax - , unison-util-base32hex - , unison-util-relation , unliftio - , unordered-containers - , uri-encode - , uuid - , vector - , wai - , warp - , witch - , witherable default-language: Haskell2010 - if flag(optimized) - ghc-options: -O2 -funbox-strict-fields test-suite cli-tests type: exitcode-stdio-1.0 @@ -494,109 +382,26 @@ test-suite cli-tests ViewPatterns ghc-options: -Wall build-depends: - IntervalMap - , ListLike - , aeson >=2.0.0.0 - , aeson-pretty - , ansi-terminal - , async - , base - , bytes - , bytestring - , cmark - , co-log-core + base , code-page - , concurrent-output - , conduit - , configurator - , containers >=0.6.3 + , containers , cryptonite - , deepseq , directory , easytest - , either - , errors - , exceptions , extra - , filepath - , free - , friendly-time - , fsnotify - , fuzzyfind - , generic-lens - , haskeline , here - , http-client >=0.7.6 - , http-client-tls - , http-types - , jwt - , ki , lens - , lock-file - , lsp >=2.2.0.0 - , lsp-types >=2.0.2.0 + , lsp-types , megaparsec - , memory - , mtl - , network - , network-simple - , network-udp - , network-uri - , nonempty-containers - , numerals - , open-browser - , optparse-applicative >=0.16.1.0 - , pretty-simple - , process - , random >=1.2.0 - , random-shuffle - , recover-rtti - , regex-tdfa - , semialign - , semigroups - , serialise - , servant - , servant-client - , servant-conduit - , shellmet - , stm - , stm-chans - , template-haskell , temporary , text - , text-ansi - , text-builder - , text-rope , these - , these-lens - , time - , transformers , unison-cli - , unison-codebase - , unison-codebase-sqlite - , unison-codebase-sqlite-hashing-v2 , unison-core , unison-core1 - , unison-hash - , unison-merge , unison-parser-typechecker , unison-prelude , unison-pretty-printer - , unison-share-api - , unison-share-projects-api - , unison-sqlite , unison-syntax - , unison-util-base32hex - , unison-util-relation - , unliftio - , unordered-containers - , uri-encode - , uuid - , vector - , wai - , warp - , witch - , witherable + , unison-util-recursion default-language: Haskell2010 - if flag(optimized) - ghc-options: -O2 -funbox-strict-fields diff --git a/unison-core/package.yaml b/unison-core/package.yaml index a65883296f..1b9f2d996e 100644 --- a/unison-core/package.yaml +++ b/unison-core/package.yaml @@ -14,7 +14,6 @@ library: - containers >= 0.6.3 - nonempty-containers - cryptonite - - either - extra - fuzzyfind - generic-lens @@ -23,19 +22,15 @@ library: - memory - mtl - rfc5051 - - safe - semialign - semigroups - text - text-builder - these - - transformers - unison-core - unison-hash - unison-prelude - - unison-util-base32hex - unison-util-relation - - vector - witch tests: @@ -86,12 +81,3 @@ default-extensions: - TupleSections - TypeApplications - ViewPatterns - -flags: - optimized: - manual: true - default: false - -when: - - condition: flag(optimized) - ghc-options: -O2 -funbox-strict-fields diff --git a/unison-core/src/Unison/ABT.hs b/unison-core/src/Unison/ABT.hs index fe9a8f930e..d838b2a730 100644 --- a/unison-core/src/Unison/ABT.hs +++ b/unison-core/src/Unison/ABT.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} --- Based on: http://semantic-domain.blogspot.com/2015/03/abstract-binding-trees.html {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} @@ -12,10 +11,12 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-} +-- | Based on: http://semantic-domain.blogspot.com/2015/03/abstract-binding-trees.html module Unison.ABT ( -- * Types ABT (..), Term (..), + Term' (..), Var (..), V (..), Subst (..), @@ -41,8 +42,6 @@ module Unison.ABT rebuildUp', reannotateUp, rewriteDown, - cata, - para, transform, transformM, foreachSubterm, @@ -111,12 +110,11 @@ import Data.Set qualified as Set import U.Core.ABT ( ABT (..), Term (..), + Term' (..), allVars, - cata, foreachSubterm, freshInBoth, freshenS, - para, rename, subst', substInheritAnnotation, diff --git a/unison-core/src/Unison/ABT/Normalized.hs b/unison-core/src/Unison/ABT/Normalized.hs index b04bb439d3..1fc0316048 100644 --- a/unison-core/src/Unison/ABT/Normalized.hs +++ b/unison-core/src/Unison/ABT/Normalized.hs @@ -17,16 +17,18 @@ module Unison.ABT.Normalized renames, rename, transform, + visit, + visitPure, ) where import Data.Bifoldable import Data.Bifunctor import Data.Foldable (toList) --- import Data.Bitraversable - +import Data.Functor.Identity (Identity (..)) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map +import Data.Maybe (fromMaybe) import Data.Set (Set) import Data.Set qualified as Set import Unison.ABT (Var (..)) @@ -103,7 +105,7 @@ class (Bifoldable f, Bifunctor f) => Align f where alphaErr :: (Align f) => (Var v) => Map v v -> Term f v -> Term f v -> Either (Term f v, Term f v) a -alphaErr un tml tmr = Left (tml, renames count un tmr) +alphaErr un tml tmr = Left (tml, renames0 count un tmr) where count = Map.fromListWith (+) . flip zip [1, 1 ..] $ toList un @@ -133,21 +135,21 @@ pattern TAbss vs bd <- {-# COMPLETE TAbss #-} --- Simultaneous variable renaming. +-- Simultaneous variable renaming implementation. -- -- subvs0 counts the number of variables being renamed to a particular -- variable -- -- rnv0 is the variable renaming map. -renames :: +renames0 :: (Var v, Ord v, Bifunctor f, Bifoldable f) => Map v Int -> Map v v -> Term f v -> Term f v -renames subvs0 rnv0 tm = case tm of +renames0 subvs0 rnv0 tm = case tm of TAbs u body - | not $ Map.null rnv' -> TAbs u' (renames subvs' rnv' body) + | not $ Map.null rnv' -> TAbs u' (renames0 subvs' rnv' body) where rnv' = Map.alter (const $ adjustment) u rnv -- if u is in the set of variables we're substituting in, it @@ -164,7 +166,7 @@ renames subvs0 rnv0 tm = case tm of | otherwise = (Nothing, subvs) TTm body | not $ Map.null rnv -> - TTm $ bimap (\u -> Map.findWithDefault u u rnv) (renames subvs rnv) body + TTm $ bimap (\u -> Map.findWithDefault u u rnv) (renames0 subvs rnv) body _ -> tm where fvs = freeVars tm @@ -179,13 +181,23 @@ renames subvs0 rnv0 tm = case tm of | n <= 1 = Nothing | otherwise = Just (n - 1) +-- Simultaneous variable renaming. +renames :: + (Var v, Ord v, Bifunctor f, Bifoldable f) => + Map v v -> + Term f v -> + Term f v +renames rnv tm = renames0 subvs rnv tm + where + subvs = Map.fromListWith (+) . fmap (,1) $ Map.elems rnv + rename :: (Var v, Ord v, Bifunctor f, Bifoldable f) => v -> v -> Term f v -> Term f v -rename old new = renames (Map.singleton new 1) (Map.singleton old new) +rename old new = renames0 (Map.singleton new 1) (Map.singleton old new) transform :: (Var v, Bifunctor g, Bifoldable f, Bifoldable g) => @@ -194,3 +206,19 @@ transform :: Term g v transform phi (TTm body) = TTm . second (transform phi) $ phi body transform phi (TAbs u body) = TAbs u $ transform phi body + +visit :: + (Applicative g, Bifoldable f, Traversable (f v), Var v) => + (Term f v -> Maybe (g (Term f v))) -> + Term f v -> + g (Term f v) +visit h t = flip fromMaybe (h t) $ case out t of + Abs x e -> TAbs x <$> visit h e + Tm body -> TTm <$> traverse (visit h) body + +visitPure :: + (Bifoldable f, Traversable (f v), Var v) => + (Term f v -> Maybe (Term f v)) -> + Term f v -> + Term f v +visitPure h = runIdentity . visit (fmap pure . h) diff --git a/unison-core/src/Unison/DataDeclaration.hs b/unison-core/src/Unison/DataDeclaration.hs index 513759ac07..5972bd9abe 100644 --- a/unison-core/src/Unison/DataDeclaration.hs +++ b/unison-core/src/Unison/DataDeclaration.hs @@ -49,7 +49,7 @@ import Unison.LabeledDependency qualified as LD import Unison.Name qualified as Name import Unison.Names.ResolutionResult qualified as Names import Unison.Prelude -import Unison.Reference (Reference) +import Unison.Reference (Reference, TypeReference) import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent import Unison.ReferentPrime qualified as Referent' @@ -108,7 +108,7 @@ data DataDeclaration v a = DataDeclaration bound :: [v], constructors' :: [(a, v, Type v a)] } - deriving (Eq, Ord, Show, Functor) + deriving (Eq, Ord, Show, Functor, Generic) constructorCount :: DataDeclaration v a -> Int constructorCount DataDeclaration {constructors'} = length constructors' @@ -211,7 +211,7 @@ bindReferences :: Set v -> Map Name.Name Reference -> DataDeclaration v a -> - Names.ResolutionResult v a (DataDeclaration v a) + Names.ResolutionResult a (DataDeclaration v a) bindReferences unsafeVarToName keepFree names (DataDeclaration m a bound constructors) = do constructors <- for constructors $ \(a, v, ty) -> (a,v,) <$> Type.bindReferences unsafeVarToName keepFree names ty @@ -222,7 +222,7 @@ bindReferences unsafeVarToName keepFree names (DataDeclaration m a bound constru -- (unless the decl is self-referential) -- Note: Does NOT include the referents for fields and field accessors. -- Those must be computed separately because we need access to the typechecker to do so. -typeDependencies :: (Ord v) => DataDeclaration v a -> Set Reference +typeDependencies :: (Ord v) => DataDeclaration v a -> Set TypeReference typeDependencies dd = Set.unions (Type.dependencies <$> constructorTypes dd) diff --git a/unison-core/src/Unison/DataDeclaration/Names.hs b/unison-core/src/Unison/DataDeclaration/Names.hs index e1e7549308..5cc2c297f1 100644 --- a/unison-core/src/Unison/DataDeclaration/Names.hs +++ b/unison-core/src/Unison/DataDeclaration/Names.hs @@ -1,28 +1,30 @@ {-# LANGUAGE RecordWildCards #-} -module Unison.DataDeclaration.Names (bindNames, dataDeclToNames', effectDeclToNames') where - -import Data.Map qualified as Map -import Data.Set qualified as Set -import Unison.ABT qualified as ABT +module Unison.DataDeclaration.Names + ( bindNames, + dataDeclToNames', + effectDeclToNames', + ) +where + +import Control.Lens (traverseOf, _3) import Unison.ConstructorReference (GConstructorReference (..)) import Unison.ConstructorType qualified as CT -import Unison.DataDeclaration (DataDeclaration (DataDeclaration), EffectDeclaration) +import Unison.DataDeclaration (DataDeclaration (..), EffectDeclaration) import Unison.DataDeclaration qualified as DD -import Unison.Name qualified as Name +import Unison.Name (Name) import Unison.Names (Names (Names)) import Unison.Names.ResolutionResult qualified as Names import Unison.Prelude import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent -import Unison.Type qualified as Type import Unison.Type.Names qualified as Type.Names import Unison.Util.Relation qualified as Rel import Unison.Var (Var) import Prelude hiding (cycle) -- implementation of dataDeclToNames and effectDeclToNames -toNames :: (Var v) => (v -> Name.Name) -> CT.ConstructorType -> v -> Reference.Id -> DataDeclaration v a -> Names +toNames :: (Var v) => (v -> Name) -> CT.ConstructorType -> v -> Reference.Id -> DataDeclaration v a -> Names toNames varToName ct typeSymbol (Reference.DerivedId -> r) dd = -- constructor names foldMap names (DD.constructorVars dd `zip` [0 ..]) @@ -32,29 +34,25 @@ toNames varToName ct typeSymbol (Reference.DerivedId -> r) dd = names (ctor, i) = Names (Rel.singleton (varToName ctor) (Referent.Con (ConstructorReference r i) ct)) mempty -dataDeclToNames :: (Var v) => (v -> Name.Name) -> v -> Reference.Id -> DataDeclaration v a -> Names +dataDeclToNames :: (Var v) => (v -> Name) -> v -> Reference.Id -> DataDeclaration v a -> Names dataDeclToNames varToName = toNames varToName CT.Data -effectDeclToNames :: (Var v) => (v -> Name.Name) -> v -> Reference.Id -> EffectDeclaration v a -> Names +effectDeclToNames :: (Var v) => (v -> Name) -> v -> Reference.Id -> EffectDeclaration v a -> Names effectDeclToNames varToName typeSymbol r ed = toNames varToName CT.Effect typeSymbol r $ DD.toDataDecl ed -dataDeclToNames' :: (Var v) => (v -> Name.Name) -> (v, (Reference.Id, DataDeclaration v a)) -> Names +dataDeclToNames' :: (Var v) => (v -> Name) -> (v, (Reference.Id, DataDeclaration v a)) -> Names dataDeclToNames' varToName (v, (r, d)) = dataDeclToNames varToName v r d -effectDeclToNames' :: (Var v) => (v -> Name.Name) -> (v, (Reference.Id, EffectDeclaration v a)) -> Names +effectDeclToNames' :: (Var v) => (v -> Name) -> (v, (Reference.Id, EffectDeclaration v a)) -> Names effectDeclToNames' varToName (v, (r, d)) = effectDeclToNames varToName v r d bindNames :: (Var v) => - (v -> Name.Name) -> - Map v v -> + (v -> Name) -> + (Name -> v) -> + Set v -> Names -> DataDeclaration v a -> - Names.ResolutionResult v a (DataDeclaration v a) -bindNames varToName localNames names (DataDeclaration m a bound constructors) = do - constructors <- for constructors $ \(a, v, ty) -> - (a,v,) <$> Type.Names.bindNames varToName keepFree names (ABT.substsInheritAnnotation subs ty) - pure $ DataDeclaration m a bound constructors - where - keepFree = Set.fromList (Map.elems localNames) - subs = Map.toList $ Map.map (Type.var ()) localNames + Names.ResolutionResult a (DataDeclaration v a) +bindNames unsafeVarToName nameToVar localNames namespaceNames = + traverseOf (#constructors' . traverse . _3) (Type.Names.bindNames unsafeVarToName nameToVar localNames namespaceNames) diff --git a/unison-merge/src/Unison/Merge/DeclNameLookup.hs b/unison-core/src/Unison/DeclNameLookup.hs similarity index 97% rename from unison-merge/src/Unison/Merge/DeclNameLookup.hs rename to unison-core/src/Unison/DeclNameLookup.hs index 35e5b5e10f..70543061fc 100644 --- a/unison-merge/src/Unison/Merge/DeclNameLookup.hs +++ b/unison-core/src/Unison/DeclNameLookup.hs @@ -1,4 +1,4 @@ -module Unison.Merge.DeclNameLookup +module Unison.DeclNameLookup ( DeclNameLookup (..), expectDeclName, expectConstructorNames, diff --git a/unison-core/src/Unison/Name.hs b/unison-core/src/Unison/Name.hs index 371a567e66..2b8cb8f83d 100644 --- a/unison-core/src/Unison/Name.hs +++ b/unison-core/src/Unison/Name.hs @@ -32,14 +32,18 @@ module Unison.Name parent, stripNamePrefix, unqualified, + isUnqualified, -- * To organize later commonPrefix, preferShallowLibDepth, searchByRankedSuffix, searchBySuffix, + filterBySuffix, + filterByRankedSuffix, suffixifyByName, suffixifyByHash, + suffixifyByHashName, sortByText, sortNamed, sortNames, @@ -333,6 +337,13 @@ searchBySuffix suffix rel = where orElse s1 s2 = if Set.null s1 then s2 else s1 +-- | Like 'searchBySuffix', but also keeps the names around. +filterBySuffix :: (Ord r) => Name -> R.Relation Name r -> R.Relation Name r +filterBySuffix suffix rel = + case Map.lookup suffix (R.domain rel) of + Just refs -> R.fromManyRan suffix refs + Nothing -> R.searchDomG R.fromManyRan (compareSuffix suffix) rel + -- Like `searchBySuffix`, but prefers local (outside `lib`) and direct (one `lib` deep) names to indirect (two or more -- `lib` deep) names. searchByRankedSuffix :: (Ord r) => Name -> R.Relation Name r -> Set r @@ -345,6 +356,19 @@ searchByRankedSuffix suffix rel = withNames = map (\r -> (filter ok (toList (R.lookupRan r rel)), r)) (toList rs) in preferShallowLibDepth withNames +-- | Like 'searchByRankedSuffix', but also keeps the names around. +filterByRankedSuffix :: (Ord r) => Name -> R.Relation Name r -> R.Relation Name r +filterByRankedSuffix suffix rel = + let matches = filterBySuffix suffix rel + highestNamePriority = foldMap prio (R.dom matches) + keep (name, _) = prio name <= highestNamePriority + in -- Keep only names that are at or less than the highest name priority. This effectively throws out all indirect + -- dependencies (NamePriorityTwo) if there are any direct dependencies (NamePriorityOne) or local definitions + -- (also NamePriorityOne). + R.filter keep matches + where + prio = nameLocationPriority . classifyNameLocation + -- | precondition: input list is deduped, and so is the Name list in -- the tuple preferShallowLibDepth :: (Ord r) => [([Name], r)] -> Set r @@ -353,29 +377,48 @@ preferShallowLibDepth = \case [x] -> Set.singleton (snd x) rs -> let byPriority = List.multimap (map (first minLibs) rs) - minLibs [] = NamePriorityOne - minLibs ns = minimum (map classifyNamePriority ns) - in case Map.lookup NamePriorityOne byPriority <|> Map.lookup NamePriorityTwo byPriority of + minLibs [] = NamePriorityOne () + minLibs ns = minimum (map (nameLocationPriority . classifyNameLocation) ns) + in case Map.lookup (NamePriorityOne ()) byPriority <|> Map.lookup (NamePriorityTwo ()) byPriority of Nothing -> Set.fromList (map snd rs) Just rs -> Set.fromList rs -data NamePriority - = NamePriorityOne -- highest priority: local names and direct dep names - | NamePriorityTwo -- lowest priority: indirect dep names - deriving stock (Eq, Ord) - -classifyNamePriority :: Name -> NamePriority -classifyNamePriority name = - case isIndirectDependency (List.NonEmpty.toList (segments name)) of - False -> NamePriorityOne - True -> NamePriorityTwo - where - -- isIndirectDependency foo = False - -- isIndirectDependency lib.bar.honk = False - -- isIndirectDependency lib.baz.lib.qux.flonk = True - isIndirectDependency = \case - ((== NameSegment.libSegment) -> True) : _ : ((== NameSegment.libSegment) -> True) : _ -> True - _ -> False +data NameLocation + = NameLocation'Local -- outside lib + | NameLocation'DirectDep -- inside lib, but outside lib.*.lib + | NameLocation'IndirectDep -- inside lib.*.lib + +classifyNameLocation :: Name -> NameLocation +classifyNameLocation name = + case segments name of + ((== NameSegment.libSegment) -> True) :| _ : ((== NameSegment.libSegment) -> True) : _ -> NameLocation'IndirectDep + ((== NameSegment.libSegment) -> True) :| _ -> NameLocation'DirectDep + _ -> NameLocation'Local + +data NamePriority a + = NamePriorityOne !a -- highest priority: local names and direct dep names + | NamePriorityTwo !a -- lowest priority: indirect dep names + deriving stock (Eq, Functor, Ord) + +instance (Monoid a) => Monoid (NamePriority a) where + mempty = NamePriorityTwo mempty + +instance (Semigroup a) => Semigroup (NamePriority a) where + NamePriorityOne x <> NamePriorityOne y = NamePriorityOne (x <> y) + NamePriorityOne x <> NamePriorityTwo _ = NamePriorityOne x + NamePriorityTwo _ <> NamePriorityOne y = NamePriorityOne y + NamePriorityTwo x <> NamePriorityTwo y = NamePriorityTwo (x <> y) + +unNamePriority :: NamePriority a -> a +unNamePriority = \case + NamePriorityOne x -> x + NamePriorityTwo x -> x + +nameLocationPriority :: NameLocation -> NamePriority () +nameLocationPriority = \case + NameLocation'Local -> NamePriorityOne () + NameLocation'DirectDep -> NamePriorityOne () + NameLocation'IndirectDep -> NamePriorityTwo () sortByText :: (a -> Text) -> [a] -> [a] sortByText by as = @@ -443,7 +486,7 @@ stripNamePrefix (Name p0 ss0) (Name p1 ss1) = do s : ss <- List.stripPrefix (reverse (toList ss0)) (reverse (toList ss1)) pure (Name Relative (List.NonEmpty.reverse (s :| ss))) --- | Return all relative suffixes of a name, in descending-length order. The returned list will always be non-empty. +-- | Return all relative suffixes of a name, in ascending-length order. The returned list will always be non-empty. -- -- >>> suffixes "a.b.c" -- ["a.b.c", "a.b", "c"] @@ -451,13 +494,7 @@ stripNamePrefix (Name p0 ss0) (Name p1 ss1) = do -- >>> suffixes ".a.b.c" -- ["a.b.c", "a.b", "c"] suffixes :: Name -> [Name] -suffixes = - reverse . suffixes' - --- Like `suffixes`, but returns names in ascending-length order. Currently unexported, as it's only used in the --- implementation of `shortestUniqueSuffix`. -suffixes' :: Name -> [Name] -suffixes' (Name _ ss0) = do +suffixes (Name _ ss0) = do ss <- List.NonEmpty.tail (List.NonEmpty.inits ss0) -- fromList is safe here because all elements of `tail . inits` are non-empty pure (Name Relative (List.NonEmpty.fromList ss)) @@ -504,28 +541,72 @@ unqualified :: Name -> Name unqualified (Name _ (s :| _)) = Name Relative (s :| []) --- Tries to shorten `fqn` to the smallest suffix that still unambiguously refers to the same name. Uses an efficient --- logarithmic lookup in the provided relation. +isUnqualified :: Name -> Bool +isUnqualified = \case + Name Relative (_ :| []) -> True + Name _ (_ :| _) -> False + +-- Tries to shorten `fqn` to the smallest suffix that still unambiguously refers to the same name. +-- +-- Indirect dependency names don't cause ambiguity in the presence of one or more non-indirect-dependency names. For +-- example, if there are two names "lib.base.List.map" and "lib.something.lib.base.Set.map", then "map" would +-- unambiguously refer to "lib.base.List.map". +-- +-- Uses an efficient logarithmic lookup in the provided relation. -- -- NB: Only works if the `Ord` instance for `Name` orders based on `Name.reverseSegments`. suffixifyByName :: forall r. (Ord r) => Name -> R.Relation Name r -> Name suffixifyByName fqn rel = - fromMaybe fqn (List.find isOk (suffixes' fqn)) + fromMaybe fqn (List.find isOk (suffixes fqn)) where isOk :: Name -> Bool isOk suffix = matchingNameCount == 1 where matchingNameCount :: Int matchingNameCount = - getSum (R.searchDomG (\_ _ -> Sum 1) (compareSuffix suffix) rel) + getSum (unNamePriority (R.searchDomG f (compareSuffix suffix) rel)) + where + f :: Name -> Set r -> NamePriority (Sum Int) + f name _refs = + case nameLocationPriority (classifyNameLocation name) of + NamePriorityOne () -> NamePriorityOne (Sum 1) + NamePriorityTwo () -> NamePriorityTwo (Sum 1) --- Tries to shorten `fqn` to the smallest suffix that still refers the same references. Uses an efficient logarithmic --- lookup in the provided relation. The returned `Name` may refer to multiple hashes if the original FQN did as well. +-- Tries to shorten `fqn` to the smallest suffix that still refers the same references. +-- +-- Like `suffixifyByName`, indirect dependency names don't cause ambiguity in the presence of one or more +-- non-indirect-dependency names. +-- +-- Uses an efficient logarithmic lookup in the provided relation. The returned `Name` may refer to multiple hashes if +-- the original FQN did as well. -- -- NB: Only works if the `Ord` instance for `Name` orders based on `Name.reverseSegments`. suffixifyByHash :: forall r. (Ord r) => Name -> R.Relation Name r -> Name suffixifyByHash fqn rel = - fromMaybe fqn (List.find isOk (suffixes' fqn)) + fromMaybe fqn (List.find isOk (suffixes fqn)) + where + allRefs :: Set r + allRefs = + R.lookupDom fqn rel + + isOk :: Name -> Bool + isOk suffix = + matchingRefs == allRefs + where + matchingRefs :: Set r + matchingRefs = + unNamePriority (R.searchDomG f (compareSuffix suffix) rel) + where + f :: Name -> Set r -> NamePriority (Set r) + f name refs = + refs <$ nameLocationPriority (classifyNameLocation name) + +-- Like `suffixifyByHash`, but "keeps going" (i.e. keeps adding more segments, looking for the best name) if the current +-- suffix could refer to a local definition (i.e. outside lib). This is because such definitions could end up being +-- edited in a scratch file, where "suffixify by hash" doesn't work. +suffixifyByHashName :: forall r. (Ord r) => Name -> R.Relation Name r -> Name +suffixifyByHashName fqn rel = + fromMaybe fqn (List.find isOk (suffixes fqn)) where allRefs :: Set r allRefs = @@ -533,11 +614,34 @@ suffixifyByHash fqn rel = isOk :: Name -> Bool isOk suffix = - Set.size refs == 1 || refs == allRefs + matchingRefs == allRefs + -- Don't use a suffix of 2+ aliases if any of then are non-local names + && case numLocalNames of + 0 -> True + 1 -> numNonLocalNames == 0 + _ -> False where - refs :: Set r - refs = - R.searchDom (compareSuffix suffix) rel + numLocalNames :: Int + numNonLocalNames :: Int + matchingRefs :: Set r + (getSum -> numLocalNames, getSum -> numNonLocalNames, unNamePriority -> matchingRefs) = + R.searchDomG f (compareSuffix suffix) rel + where + f :: Name -> Set r -> (Sum Int, Sum Int, NamePriority (Set r)) + f name refs = + (numLocal, numNonLocal, refs <$ nameLocationPriority location) + where + location = classifyNameLocation name + numLocal = + case location of + NameLocation'Local -> Sum 1 + NameLocation'DirectDep -> Sum 0 + NameLocation'IndirectDep -> Sum 0 + numNonLocal = + case location of + NameLocation'Local -> Sum 0 + NameLocation'DirectDep -> Sum 1 + NameLocation'IndirectDep -> Sum 1 -- | Returns the common prefix of two names as segments -- diff --git a/unison-core/src/Unison/Names.hs b/unison-core/src/Unison/Names.hs index d9d222b9c8..d0613f1411 100644 --- a/unison-core/src/Unison/Names.hs +++ b/unison-core/src/Unison/Names.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RecordWildCards #-} module Unison.Names @@ -38,9 +39,9 @@ module Unison.Names typeReferences, termsNamed, typesNamed, - unionLeft, - unionLeftName, - unionLeftRef, + shadowing, + shadowing1, + preferring, namesForReference, namesForReferent, shadowTerms, @@ -52,9 +53,13 @@ module Unison.Names hashQualifyTermsRelation, fromTermsAndTypes, lenientToNametree, + resolveName, + resolveNameIncludingNames, ) where +import Control.Lens (_2) +import Data.List qualified as List import Data.Map qualified as Map import Data.Semialign (alignWith) import Data.Set qualified as Set @@ -70,6 +75,7 @@ import Unison.LabeledDependency qualified as LD import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) +import Unison.Names.ResolvesTo (ResolvesTo (..)) import Unison.Prelude import Unison.Reference (Reference, TermReference, TermReferenceId, TypeReference, TypeReferenceId) import Unison.Reference qualified as Reference @@ -93,7 +99,7 @@ data Names = Names { terms :: Relation Name Referent, types :: Relation Name TypeReference } - deriving (Eq, Ord, Show) + deriving (Eq, Ord, Show, Generic) instance Semigroup (Names) where Names e1 t1 <> Names e2 t2 = @@ -205,79 +211,31 @@ restrictReferences refs Names {..} = Names terms' types' terms' = R.filterRan ((`Set.member` refs) . Referent.toReference) terms types' = R.filterRan (`Set.member` refs) types --- | Guide to unionLeft* --- Is it ok to create new aliases for parsing? --- Sure. +-- | Construct names from a left-biased map union of the domains of the input names. That is, for each distinct name, +-- if it refers to *any* references in the left argument, use those (ignoring the right). -- --- Is it ok to create name conflicts for parsing? --- It's okay but not great. The user will have to hash-qualify to disambiguate. +-- This is appropriate for shadowing names in the codebase with names in a Unison file, for instance: -- --- Is it ok to create new aliases for pretty-printing? --- Not helpful, we need to choose a name to show. --- We'll just have to choose one at random if there are aliases. --- Is it ok to create name conflicts for pretty-printing? --- Still okay but not great. The pretty-printer will have to hash-qualify --- to disambiguate. --- --- Thus, for parsing: --- unionLeftName is good if the name `n` on the left is the only `n` the --- user will want to reference. It allows the rhs to add aliases. --- unionLeftRef allows new conflicts but no new aliases. Lame? --- (<>) is ok for parsing if we expect to add some conflicted names, --- e.g. from history --- --- For pretty-printing: --- Probably don't want to add new aliases, unless we don't know which --- `Names` is higher priority. So if we do have a preferred `Names`, --- don't use `unionLeftName` or (<>). --- You don't want to create new conflicts either if you have a preferred --- `Names`. So in this case, don't use `unionLeftRef` either. --- I guess that leaves `unionLeft`. --- --- Not sure if the above is helpful or correct! - --- unionLeft two Names, including new aliases, but excluding new name conflicts. --- e.g. unionLeftName [foo -> #a, bar -> #a, cat -> #c] --- [foo -> #b, baz -> #c] --- = [foo -> #a, bar -> #a, baz -> #c, cat -> #c)] --- Btw, it's ok to create name conflicts for parsing environments, if you don't --- mind disambiguating. -unionLeftName :: Names -> Names -> Names -unionLeftName = unionLeft' $ const . R.memberDom - --- unionLeft two Names, including new name conflicts, but excluding new aliases. --- e.g. unionLeftRef [foo -> #a, bar -> #a, cat -> #c] --- [foo -> #b, baz -> #c] --- = [foo -> #a, bar -> #a, foo -> #b, cat -> #c] -unionLeftRef :: Names -> Names -> Names -unionLeftRef (Names priorityTerms priorityTypes) (Names fallbackTerms fallbackTypes) = - Names (restricter priorityTerms fallbackTerms) (restricter priorityTypes fallbackTypes) - where - restricter priorityRel fallbackRel = - let refsExclusiveToFallback = (Relation.ran fallbackRel) `Set.difference` (Relation.ran priorityRel) - in priorityRel <> Relation.restrictRan fallbackRel refsExclusiveToFallback - --- unionLeft two Names, but don't create new aliases or new name conflicts. --- e.g. unionLeft [foo -> #a, bar -> #a, cat -> #c] --- [foo -> #b, baz -> #c] --- = [foo -> #a, bar -> #a, cat -> #c] -unionLeft :: Names -> Names -> Names -unionLeft = unionLeft' go - where - go n r acc = R.memberDom n acc || R.memberRan r acc +-- @shadowing scratchFileNames codebaseNames@ +shadowing :: Names -> Names -> Names +shadowing a b = + Names (shadowing1 a.terms b.terms) (shadowing1 a.types b.types) --- implementation detail of the above -unionLeft' :: - (forall a b. (Ord a, Ord b) => a -> b -> Relation a b -> Bool) -> - Names -> - Names -> - Names -unionLeft' shouldOmit a b = Names terms' types' +shadowing1 :: (Ord a, Ord b) => Relation a b -> Relation a b -> Relation a b +shadowing1 = + Relation.unionDomainWith (\_ x _ -> x) + +-- | Construct names from a left-biased map union of the ranges of the input names. That is, for each distinct +-- reference, if it is referred to by *any* names in the left argument, use those (ignoring the right). +-- +-- This is appropriate for biasing a PPE towards picking names in the left argument. +preferring :: Names -> Names -> Names +preferring xs ys = + Names (preferring1 xs.terms ys.terms) (preferring1 xs.types ys.types) where - terms' = foldl' go a.terms (R.toList b.terms) - types' = foldl' go a.types (R.toList b.types) - go :: (Ord a, Ord b) => Relation a b -> (a, b) -> Relation a b - go acc (n, r) = if shouldOmit n r acc then acc else R.insert n r acc + preferring1 :: (Ord a, Ord b) => Relation a b -> Relation a b -> Relation a b + preferring1 = + Relation.unionRangeWith (\_ x _ -> x) -- | TODO: get this from database. For now it's a constant. numHashChars :: Int @@ -563,3 +521,67 @@ lenientToNametree names = -- The partial `Set.findMin` is fine here because Relation.domain only has non-empty Set values. A NESet would be -- better. unflattenNametree . Map.map Set.findMin . Relation.domain + +-- Given a namespace and locally-bound names that shadow it (i.e. from a Unison file that hasn't been typechecked yet), +-- determine what the name resolves to, per the usual suffix-matching rules (where local defnintions and direct +-- dependencies are preferred to indirect dependencies). +resolveName :: forall ref. (Ord ref, Show ref) => Relation Name ref -> Set Name -> Name -> Set (ResolvesTo ref) +resolveName namespace locals = + \name -> + let exactNamespaceMatches :: Set ref + exactNamespaceMatches = + Relation.lookupDom name namespace + localsPlusNamespaceSuffixMatches :: Set (ResolvesTo ref) + localsPlusNamespaceSuffixMatches = + Name.searchByRankedSuffix name localsPlusNamespace + in if + | Set.member name locals -> Set.singleton (ResolvesToLocal name) + | Set.size exactNamespaceMatches == 1 -> Set.mapMonotonic ResolvesToNamespace exactNamespaceMatches + | otherwise -> localsPlusNamespaceSuffixMatches + where + localsPlusNamespace :: Relation Name (ResolvesTo ref) + localsPlusNamespace = + shadowing1 + ( List.foldl' + (\acc name -> Relation.insert name (ResolvesToLocal name) acc) + Relation.empty + (Set.toList locals) + ) + ( Relation.map + (over _2 ResolvesToNamespace) + namespace + ) + +-- | Like 'resolveName', but include the names in the output. +resolveNameIncludingNames :: + forall ref. + (Ord ref, Show ref) => + Relation Name ref -> + Set Name -> + Name -> + Relation Name (ResolvesTo ref) +resolveNameIncludingNames namespace locals = + \name -> + let exactNamespaceMatches :: Set ref + exactNamespaceMatches = + Relation.lookupDom name namespace + localsPlusNamespaceSuffixMatches :: Relation Name (ResolvesTo ref) + localsPlusNamespaceSuffixMatches = + Name.filterByRankedSuffix name localsPlusNamespace + in if + | Set.member name locals -> Relation.singleton name (ResolvesToLocal name) + | Set.size exactNamespaceMatches == 1 -> Relation.singleton name (ResolvesToNamespace (Set.findMin exactNamespaceMatches)) + | otherwise -> localsPlusNamespaceSuffixMatches + where + localsPlusNamespace :: Relation Name (ResolvesTo ref) + localsPlusNamespace = + shadowing1 + ( List.foldl' + (\acc name -> Relation.insert name (ResolvesToLocal name) acc) + Relation.empty + (Set.toList locals) + ) + ( Relation.map + (over _2 ResolvesToNamespace) + namespace + ) diff --git a/unison-core/src/Unison/Names/ResolutionResult.hs b/unison-core/src/Unison/Names/ResolutionResult.hs index e86bf2ac0b..081e3b5eae 100644 --- a/unison-core/src/Unison/Names/ResolutionResult.hs +++ b/unison-core/src/Unison/Names/ResolutionResult.hs @@ -1,32 +1,39 @@ -module Unison.Names.ResolutionResult where +module Unison.Names.ResolutionResult + ( ResolutionError (..), + ResolutionFailure (..), + ResolutionResult, + getAnnotation, + ) +where -import Data.Set.NonEmpty +import Unison.HashQualified (HashQualified) +import Unison.Name (Name) import Unison.Names (Names) import Unison.Prelude -import Unison.Reference as Reference (Reference) -import Unison.Referent as Referent (Referent) +import Unison.Reference (TypeReference) +import Unison.Referent (Referent) data ResolutionError ref = NotFound - | -- Contains the names which were in scope and which refs were possible options - -- The NonEmpty set of refs must contain 2 or more refs (otherwise what is ambiguous?). - Ambiguous Names (NESet ref) + | -- Contains: + -- + -- 1. The namespace names + -- 2. The refs among those that we could be referring to + -- 3. The local names that we could be referring to + -- + -- The size of set (2.) + the size of set (3.) is at least 2 (otherwise there wouldn't be any ambiguity). + Ambiguous Names (Set ref) (Set Name) deriving (Eq, Ord, Show) --- | ResolutionFailure represents the failure to resolve a given variable. -data ResolutionFailure var annotation - = TypeResolutionFailure var annotation (ResolutionError Reference) - | TermResolutionFailure var annotation (ResolutionError Referent) +-- | ResolutionFailure represents the failure to resolve a given name. +data ResolutionFailure annotation + = TypeResolutionFailure (HashQualified Name) annotation (ResolutionError TypeReference) + | TermResolutionFailure (HashQualified Name) annotation (ResolutionError Referent) deriving (Eq, Ord, Show, Functor, Foldable, Traversable) -getAnnotation :: ResolutionFailure v a -> a +getAnnotation :: ResolutionFailure a -> a getAnnotation = \case TypeResolutionFailure _ a _ -> a TermResolutionFailure _ a _ -> a -getVar :: ResolutionFailure v a -> v -getVar = \case - TypeResolutionFailure v _ _ -> v - TermResolutionFailure v _ _ -> v - -type ResolutionResult v a r = Either (Seq (ResolutionFailure v a)) r +type ResolutionResult a r = Either (Seq (ResolutionFailure a)) r diff --git a/unison-core/src/Unison/Names/ResolvesTo.hs b/unison-core/src/Unison/Names/ResolvesTo.hs new file mode 100644 index 0000000000..378b4af486 --- /dev/null +++ b/unison-core/src/Unison/Names/ResolvesTo.hs @@ -0,0 +1,21 @@ +module Unison.Names.ResolvesTo + ( ResolvesTo (..), + partitionResolutions, + ) +where + +import Unison.Name (Name) +import Unison.Prelude + +data ResolvesTo ref + = ResolvesToNamespace ref + | ResolvesToLocal Name + deriving stock (Eq, Ord, Show) + +partitionResolutions :: [(v, ResolvesTo ref)] -> ([(v, ref)], [(v, Name)]) +partitionResolutions = + partitionEithers . map f + where + f = \case + (v, ResolvesToNamespace ref) -> Left (v, ref) + (v, ResolvesToLocal name) -> Right (v, name) diff --git a/unison-core/src/Unison/NamesWithHistory.hs b/unison-core/src/Unison/NamesWithHistory.hs index 561fa557f8..4ec19c2788 100644 --- a/unison-core/src/Unison/NamesWithHistory.hs +++ b/unison-core/src/Unison/NamesWithHistory.hs @@ -6,7 +6,6 @@ module Unison.NamesWithHistory ( diff, push, - shadowing, lookupHQType, lookupHQType', lookupHQTerm, @@ -104,16 +103,10 @@ push n0 ns = unionLeft0 n1 ns uniqueTerms = [(n, ref) | (n, nubOrd -> [ref]) <- Map.toList terms'] uniqueTypes = [(n, ref) | (n, nubOrd -> [ref]) <- Map.toList types'] --- | Prefer names in the first argument, falling back to names in the second. --- This can be used to shadow names in the codebase with names in a unison file for instance: --- e.g. @shadowing scratchFileNames codebaseNames@ -shadowing :: Names -> Names -> Names -shadowing = Names.unionLeft - -- Find all types whose name has a suffix matching the provided `HashQualified`, -- returning types with relative names if they exist, and otherwise -- returning types with absolute names. -lookupRelativeHQType :: SearchType -> HashQualified Name -> Names -> Set Reference +lookupRelativeHQType :: SearchType -> HashQualified Name -> Names -> Set TypeReference lookupRelativeHQType searchType hq ns = let rs = lookupHQType searchType hq ns keep r = any (not . Name.isAbsolute) (R.lookupRan r (Names.types ns)) @@ -122,17 +115,17 @@ lookupRelativeHQType searchType hq ns = | Set.null rs' -> rs | otherwise -> rs' -lookupRelativeHQType' :: SearchType -> HQ'.HashQualified Name -> Names -> Set Reference +lookupRelativeHQType' :: SearchType -> HQ'.HashQualified Name -> Names -> Set TypeReference lookupRelativeHQType' searchType = lookupRelativeHQType searchType . HQ'.toHQ -- | Find all types whose name has a suffix matching the provided 'HashQualified'. -lookupHQType :: SearchType -> HashQualified Name -> Names -> Set Reference +lookupHQType :: SearchType -> HashQualified Name -> Names -> Set TypeReference lookupHQType searchType = lookupHQRef searchType Names.types Reference.isPrefixOf -- | Find all types whose name has a suffix matching the provided 'HashQualified''. See 'lookupHQType'. -lookupHQType' :: SearchType -> HQ'.HashQualified Name -> Names -> Set Reference +lookupHQType' :: SearchType -> HQ'.HashQualified Name -> Names -> Set TypeReference lookupHQType' searchType = lookupHQType searchType . HQ'.toHQ @@ -236,10 +229,6 @@ termName length r names = hq n = HQ'.take length (HQ'.fromNamedReferent n r) isConflicted n = R.manyDom n (Names.terms names) --- Set HashQualified -> Branch m -> Action' m v Names --- Set HashQualified -> Branch m -> Free (Command m i v) Names --- Set HashQualified -> Branch m -> Command m i v Names --- populate historical names lookupHQPattern :: SearchType -> HQ.HashQualified Name -> diff --git a/unison-core/src/Unison/Term.hs b/unison-core/src/Unison/Term.hs index 5a3ea2127a..884a7a8978 100644 --- a/unison-core/src/Unison/Term.hs +++ b/unison-core/src/Unison/Term.hs @@ -8,15 +8,17 @@ import Control.Monad.State (evalState) import Control.Monad.State qualified as State import Control.Monad.Writer.Strict qualified as Writer import Data.Generics.Sum (_Ctor) +import Data.List qualified as List import Data.Map qualified as Map +import Data.Sequence qualified as Seq import Data.Sequence qualified as Sequence import Data.Set qualified as Set -import Data.Set.NonEmpty qualified as NES import Data.Text qualified as Text import Text.Show import Unison.ABT qualified as ABT import Unison.Blank qualified as B import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) +import Unison.ConstructorReference qualified as ConstructorReference import Unison.ConstructorType qualified as CT import Unison.DataDeclaration.ConstructorId (ConstructorId) import Unison.HashQualified qualified as HQ @@ -26,16 +28,18 @@ import Unison.Name qualified as Name import Unison.Names (Names) import Unison.Names qualified as Names import Unison.Names.ResolutionResult qualified as Names +import Unison.Names.ResolvesTo (ResolvesTo (..), partitionResolutions) import Unison.NamesWithHistory qualified as Names import Unison.Pattern (Pattern) import Unison.Pattern qualified as Pattern import Unison.Prelude -import Unison.Reference (Reference, TermReference, pattern Builtin) +import Unison.Reference (Reference, TermReference, TypeReference, pattern Builtin) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Type (Type) import Unison.Type qualified as Type +import Unison.Util.Defns (Defns (..), DefnsF) import Unison.Util.List (multimap, validate) import Unison.Var (Var) import Unison.Var qualified as Var @@ -147,69 +151,56 @@ bindNames :: forall v a. (Var v) => (v -> Name.Name) -> + (Name.Name -> v) -> Set v -> Names -> Term v a -> - Names.ResolutionResult v a (Term v a) -bindNames unsafeVarToName keepFreeTerms ns e = do - let freeTmVars = [(v, a) | (v, a) <- ABT.freeVarOccurrences keepFreeTerms e] - -- !_ = trace "bindNames.free term vars: " () - -- !_ = traceShow $ fst <$> freeTmVars - freeTyVars = - [ (v, a) | (v, as) <- Map.toList (freeTypeVarAnnotations e), a <- as - ] - -- !_ = trace "bindNames.free type vars: " () - -- !_ = traceShow $ fst <$> freeTyVars - okTm :: (v, a) -> Names.ResolutionResult v a (v, Term v a) - okTm (v, a) = case Names.lookupHQTerm Names.IncludeSuffixes (HQ.NameOnly $ unsafeVarToName v) ns of - rs - | Set.size rs == 1 -> - pure (v, fromReferent a $ Set.findMin rs) - | otherwise -> case NES.nonEmptySet rs of - Nothing -> Left (pure (Names.TermResolutionFailure v a Names.NotFound)) - Just refs -> Left (pure (Names.TermResolutionFailure v a (Names.Ambiguous ns refs))) - okTy (v, a) = case Names.lookupHQType Names.IncludeSuffixes (HQ.NameOnly $ unsafeVarToName v) ns of - rs - | Set.size rs == 1 -> pure (v, Type.ref a $ Set.findMin rs) - | otherwise -> case NES.nonEmptySet rs of - Nothing -> Left (pure (Names.TypeResolutionFailure v a Names.NotFound)) - Just refs -> Left (pure (Names.TypeResolutionFailure v a (Names.Ambiguous ns refs))) - termSubsts <- validate okTm freeTmVars - typeSubsts <- validate okTy freeTyVars - pure . substTypeVars typeSubsts . ABT.substsInheritAnnotation termSubsts $ e - --- This function replaces free term and type variables with --- hashes found in the provided `Names`, using suffix-based --- lookup. Any terms not found in the `Names` are kept free. -bindSomeNames :: - forall v a. - (Var v) => - (v -> Name.Name) -> - Set v -> - Names -> - Term v a -> - Names.ResolutionResult v a (Term v a) --- bindSomeNames ns e | trace "Term.bindSome" False --- || trace "Names =" False --- || traceShow ns False --- || trace "Free type vars:" False --- || traceShow (freeTypeVars e) False --- || trace "Free term vars:" False --- || traceShow (freeVars e) False --- || traceShow e False --- = undefined -bindSomeNames unsafeVarToName avoid ns e = bindNames unsafeVarToName (avoid <> varsToTDNR) ns e + Names.ResolutionResult a (Term v a) +bindNames unsafeVarToName nameToVar localVars namespace = + -- term is bound here because the where-clause binds a data structure that we only want to compute once, then share + -- across all calls to `bindNames` with different terms + \term -> do + let freeTmVars = ABT.freeVarOccurrences localVars term + freeTyVars = + [ (v, a) | (v, as) <- Map.toList (freeTypeVarAnnotations term), a <- as + ] + + okTm :: (v, a) -> Maybe (v, ResolvesTo Referent) + okTm (v, _) = + case Set.size matches of + 1 -> Just (v, Set.findMin matches) + 0 -> Nothing -- not found: leave free for telling user about expected type + _ -> Nothing -- ambiguous: leave free for TDNR + where + matches :: Set (ResolvesTo Referent) + matches = + resolveTermName (unsafeVarToName v) + + okTy :: (v, a) -> Names.ResolutionResult a (v, Type v a) + okTy (v, a) = + case Names.lookupHQType Names.IncludeSuffixes hqName namespace of + rs + | Set.size rs == 1 -> pure (v, Type.ref a $ Set.findMin rs) + | Set.size rs == 0 -> Left (Seq.singleton (Names.TypeResolutionFailure hqName a Names.NotFound)) + | otherwise -> Left (Seq.singleton (Names.TypeResolutionFailure hqName a (Names.Ambiguous namespace rs Set.empty))) + where + hqName = HQ.NameOnly (unsafeVarToName v) + + let (namespaceTermResolutions, localTermResolutions) = + partitionResolutions (mapMaybe okTm freeTmVars) + + termSubsts = + [(v, fromReferent () ref) | (v, ref) <- namespaceTermResolutions] + ++ [(v, var () (nameToVar name)) | (v, name) <- localTermResolutions] + typeSubsts <- validate okTy freeTyVars + pure $ + term + & ABT.substsInheritAnnotation termSubsts + & substTypeVars typeSubsts where - -- `Term.bindNames` takes a set of variables that are not substituted. - -- These should be the variables that will be subject to TDNR, which - -- we compute as the set of variables whose names cannot be found in `ns`. - -- - -- This allows TDNR to disambiguate those names (if multiple definitions - -- share the same suffix) or to report the type expected for that name - -- (if a free variable is being used as a typed hole). - varsToTDNR = Set.filter notFound (freeVars e) - notFound var = - Set.size (Name.searchByRankedSuffix (unsafeVarToName var) (Names.terms ns)) /= 1 + resolveTermName :: Name.Name -> Set (ResolvesTo Referent) + resolveTermName = + Names.resolveName (Names.terms namespace) (Set.map unsafeVarToName localVars) -- Prepare a term for type-directed name resolution by replacing -- any remaining free variables with blanks to be resolved by TDNR @@ -599,6 +590,13 @@ pattern BinaryAppsPred' :: (Term2 vt at ap v a, Term2 vt at ap v a -> Bool) pattern BinaryAppsPred' apps lastArg <- (unBinaryAppsPred -> Just (apps, lastArg)) +pattern BinaryAppPred' :: + Term2 vt at ap v a -> + Term2 vt at ap v a -> + Term2 vt at ap v a -> + (Term2 vt at ap v a, Term2 vt at ap v a -> Bool) +pattern BinaryAppPred' f arg1 arg2 <- (unBinaryAppPred -> Just (f, arg1, arg2)) + pattern OverappliedBinaryAppPred' :: Term2 vt at ap v a -> Term2 vt at ap v a -> @@ -1165,12 +1163,23 @@ unBinaryAppsPred :: ], Term2 vt at ap v a ) -unBinaryAppsPred (t, pred) = case unBinaryApp t of - Just (f, x, y) | pred f -> case unBinaryAppsPred (x, pred) of +unBinaryAppsPred (t, pred) = case unBinaryAppPred (t, pred) of + Just (f, x, y) -> case unBinaryAppsPred (x, pred) of Just (as, xLast) -> Just ((xLast, f) : as, y) Nothing -> Just ([(x, f)], y) _ -> Nothing +unBinaryAppPred :: + (Term2 vt at ap v a, Term2 vt at ap v a -> Bool) -> + Maybe + ( Term2 vt at ap v a, + Term2 vt at ap v a, + Term2 vt at ap v a + ) +unBinaryAppPred (t, pred) = case unBinaryApp t of + Just (f, x, y) | pred f -> Just (f, x, y) + _ -> Nothing + unLams' :: Term2 vt at ap v a -> Maybe ([v], Term2 vt at ap v a) unLams' t = unLamsPred' (t, const True) @@ -1211,27 +1220,27 @@ unReqOrCtor (Request' r) = Just r unReqOrCtor _ = Nothing -- Dependencies including referenced data and effect decls -dependencies :: (Ord v, Ord vt) => Term2 vt at ap v a -> Set Reference -dependencies t = Set.map (LD.fold id Referent.toReference) (labeledDependencies t) +dependencies :: (Ord v, Ord vt) => Term2 vt at ap v a -> DefnsF Set TermReference TypeReference +dependencies = + List.foldl' f (Defns Set.empty Set.empty) . Set.toList . labeledDependencies + where + f :: + DefnsF Set TermReference TypeReference -> + LabeledDependency -> + DefnsF Set TermReference TypeReference + f deps = \case + LD.TermReferent (Referent.Con ref _) -> deps & over #types (Set.insert (ref ^. ConstructorReference.reference_)) + LD.TermReferent (Referent.Ref ref) -> deps & over #terms (Set.insert ref) + LD.TypeReference ref -> deps & over #types (Set.insert ref) termDependencies :: (Ord v, Ord vt) => Term2 vt at ap v a -> Set TermReference termDependencies = - Set.fromList - . mapMaybe - ( LD.fold - (\_typeRef -> Nothing) - ( Referent.fold - (\termRef -> Just termRef) - (\_typeConRef _i _ct -> Nothing) - ) - ) - . toList - . labeledDependencies + (.terms) . dependencies -- gets types from annotations and constructors typeDependencies :: (Ord v, Ord vt) => Term2 vt at ap v a -> Set Reference typeDependencies = - Set.fromList . mapMaybe (LD.fold Just (const Nothing)) . toList . labeledDependencies + (.types) . dependencies -- Gets the types to which this term contains references via patterns and -- data constructors. diff --git a/unison-core/src/Unison/Type.hs b/unison-core/src/Unison/Type.hs index d779aa7ce1..7f26318001 100644 --- a/unison-core/src/Unison/Type.hs +++ b/unison-core/src/Unison/Type.hs @@ -8,8 +8,10 @@ import Data.Generics.Sum (_Ctor) import Data.List.Extra (nubOrd) import Data.Map qualified as Map import Data.Monoid (Any (..)) +import Data.Sequence qualified as Seq import Data.Set qualified as Set import Unison.ABT qualified as ABT +import Unison.HashQualified qualified as HQ import Unison.Kind qualified as K import Unison.LabeledDependency qualified as LD import Unison.Name qualified as Name @@ -55,6 +57,9 @@ _Ref = _Ctor @"Ref" -- | Types are represented as ABTs over the base functor F, with variables in `v` type Type v a = ABT.Term F v a +-- | For use with recursion schemes. +type TypeF v a r = ABT.Term' F v a r + wrapV :: (Ord v) => Type v a -> Type (ABT.V v) a wrapV = ABT.vmap ABT.Bound @@ -71,12 +76,14 @@ bindReferences :: Set v -> Map Name.Name TypeReference -> Type v a -> - Names.ResolutionResult v a (Type v a) + Names.ResolutionResult a (Type v a) bindReferences unsafeVarToName keepFree ns t = let fvs = ABT.freeVarOccurrences keepFree t rs = [(v, a, Map.lookup (unsafeVarToName v) ns) | (v, a) <- fvs] ok (v, _a, Just r) = pure (v, r) - ok (v, a, Nothing) = Left (pure (Names.TypeResolutionFailure v a Names.NotFound)) + ok (v, a, Nothing) = + Left $ + Seq.singleton (Names.TypeResolutionFailure (HQ.NameOnly (unsafeVarToName v)) a Names.NotFound) in List.validate ok rs <&> \es -> bindExternal es t newtype Monotype v a = Monotype {getPolytype :: Type v a} deriving (Eq) diff --git a/unison-core/src/Unison/Type/Names.hs b/unison-core/src/Unison/Type/Names.hs index 5451406cdd..030229fdde 100644 --- a/unison-core/src/Unison/Type/Names.hs +++ b/unison-core/src/Unison/Type/Names.hs @@ -3,33 +3,83 @@ module Unison.Type.Names ) where +import Data.Sequence qualified as Seq import Data.Set qualified as Set -import Data.Set.NonEmpty qualified as NES import Unison.ABT qualified as ABT import Unison.HashQualified qualified as HQ -import Unison.Name qualified as Name +import Unison.Name (Name) +import Unison.Names (Names) import Unison.Names qualified as Names import Unison.Names.ResolutionResult qualified as Names -import Unison.NamesWithHistory qualified as Names +import Unison.Names.ResolvesTo (ResolvesTo (..), partitionResolutions) import Unison.Prelude +import Unison.Reference (TypeReference) import Unison.Type +import Unison.Type qualified as Type import Unison.Util.List qualified as List import Unison.Var (Var) bindNames :: + forall a v. (Var v) => - (v -> Name.Name) -> + (v -> Name) -> + (Name -> v) -> Set v -> - Names.Names -> + Names -> Type v a -> - Names.ResolutionResult v a (Type v a) -bindNames unsafeVarToName keepFree ns t = - let fvs = ABT.freeVarOccurrences keepFree t - rs = [(v, a, Names.lookupHQType Names.IncludeSuffixes (HQ.NameOnly $ unsafeVarToName v) ns) | (v, a) <- fvs] - ok (v, a, rs) = - if Set.size rs == 1 - then pure (v, Set.findMin rs) - else case NES.nonEmptySet rs of - Nothing -> Left (pure (Names.TypeResolutionFailure v a Names.NotFound)) - Just rs' -> Left (pure (Names.TypeResolutionFailure v a (Names.Ambiguous ns rs'))) - in List.validate ok rs <&> \es -> bindExternal es t + Names.ResolutionResult a (Type v a) +bindNames unsafeVarToName nameToVar localVars namespace = + -- type is bound here because the where-clause binds a data structure that we only want to compute once, then share + -- across all calls to `bindNames` with different types + \ty -> + let -- Identify the unresolved variables in the type: those whose names aren't an *exact* match for some locally-bound + -- type. + -- + -- For example: + -- + -- type Foo.Bar = ... + -- type Baz.Qux = ... + -- type Whatever = Whatever Foo.Bar Qux + -- ^^^^^^^ ^^^ + -- | this variable *is* unresolved: it doesn't match any locally-bound type exactly + -- | + -- this variable is *not* unresolved: it matches locally-bound `Foo.Bar` exactly + unresolvedVars :: [(v, a)] + unresolvedVars = + ABT.freeVarOccurrences localVars ty + + okTy :: (v, a) -> Names.ResolutionResult a (v, ResolvesTo TypeReference) + okTy (v, a) = + case Set.size matches of + 1 -> good (Set.findMin matches) + 0 -> bad Names.NotFound + _ -> + let (namespaceMatches, localMatches) = + matches + & Set.toList + & map \case + ResolvesToNamespace ref -> Left ref + ResolvesToLocal name -> Right name + & partitionEithers + & bimap Set.fromList Set.fromList + in bad (Names.Ambiguous namespace namespaceMatches localMatches) + where + matches :: Set (ResolvesTo TypeReference) + matches = + resolveTypeName (unsafeVarToName v) + + bad = Left . Seq.singleton . Names.TypeResolutionFailure (HQ.NameOnly (unsafeVarToName v)) a + good = Right . (v,) + in List.validate okTy unresolvedVars <&> \resolutions -> + let (namespaceResolutions, localResolutions) = partitionResolutions resolutions + in ty + -- Apply namespace resolutions (replacing "Foo" with #Foo where "Foo" refers to namespace) + & bindExternal namespaceResolutions + -- Apply local resolutions (replacing "Foo" with "Full.Name.Foo" where "Full.Name.Foo" is in local vars) + & ABT.substsInheritAnnotation [(v, Type.var () (nameToVar name)) | (v, name) <- localResolutions] + -- Clean up ability lists again – we might have something to de-dupe after resolution + & Type.cleanupAbilityLists + where + resolveTypeName :: Name -> Set (ResolvesTo TypeReference) + resolveTypeName = + Names.resolveName (Names.types namespace) (Set.map unsafeVarToName localVars) diff --git a/unison-core/src/Unison/Util/Defns.hs b/unison-core/src/Unison/Util/Defns.hs index e61c5ba7bb..fed00742b4 100644 --- a/unison-core/src/Unison/Util/Defns.hs +++ b/unison-core/src/Unison/Util/Defns.hs @@ -6,6 +6,8 @@ module Unison.Util.Defns DefnsF4, alignDefnsWith, defnsAreEmpty, + fromTerms, + fromTypes, hoistDefnsF, mapDefns, unzipDefns, @@ -13,6 +15,7 @@ module Unison.Util.Defns zipDefns, zipDefnsWith, zipDefnsWith3, + zipDefnsWith4, ) where @@ -64,6 +67,14 @@ defnsAreEmpty :: (Foldable f, Foldable g) => Defns (f a) (g b) -> Bool defnsAreEmpty defns = null defns.terms && null defns.types +fromTerms :: (Monoid types) => terms -> Defns terms types +fromTerms terms = + Defns {terms, types = mempty} + +fromTypes :: (Monoid terms) => types -> Defns terms types +fromTypes types = + Defns {terms = mempty, types} + hoistDefnsF :: (forall x. f x -> g x) -> DefnsF f a b -> DefnsF g a b hoistDefnsF f (Defns x y) = Defns (f x) (f y) @@ -99,3 +110,14 @@ zipDefnsWith3 :: Defns tm4 ty4 zipDefnsWith3 f g (Defns terms1 types1) (Defns terms2 types2) (Defns terms3 types3) = Defns (f terms1 terms2 terms3) (g types1 types2 types3) + +zipDefnsWith4 :: + (tm1 -> tm2 -> tm3 -> tm4 -> tm5) -> + (ty1 -> ty2 -> ty3 -> ty4 -> ty5) -> + Defns tm1 ty1 -> + Defns tm2 ty2 -> + Defns tm3 ty3 -> + Defns tm4 ty4 -> + Defns tm5 ty5 +zipDefnsWith4 f g (Defns terms1 types1) (Defns terms2 types2) (Defns terms3 types3) (Defns terms4 types4) = + Defns (f terms1 terms2 terms3 terms4) (g types1 types2 types3 types4) diff --git a/unison-core/unison-core1.cabal b/unison-core/unison-core1.cabal index aff6128306..91d1b40b27 100644 --- a/unison-core/unison-core1.cabal +++ b/unison-core/unison-core1.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.0. +-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack @@ -17,10 +17,6 @@ source-repository head type: git location: https://github.com/unisonweb/unison -flag optimized - manual: True - default: False - library exposed-modules: Unison.ABT @@ -32,6 +28,7 @@ library Unison.DataDeclaration.ConstructorId Unison.DataDeclaration.Names Unison.DataDeclaration.Records + Unison.DeclNameLookup Unison.Hashable Unison.HashQualified Unison.HashQualifiedPrime @@ -42,6 +39,7 @@ library Unison.Name.Internal Unison.Names Unison.Names.ResolutionResult + Unison.Names.ResolvesTo Unison.NamesWithHistory Unison.Pattern Unison.Position @@ -100,7 +98,6 @@ library , bytestring , containers >=0.6.3 , cryptonite - , either , extra , fuzzyfind , generic-lens @@ -110,23 +107,17 @@ library , mtl , nonempty-containers , rfc5051 - , safe , semialign , semigroups , text , text-builder , these - , transformers , unison-core , unison-hash , unison-prelude - , unison-util-base32hex , unison-util-relation - , vector , witch default-language: Haskell2010 - if flag(optimized) - ghc-options: -O2 -funbox-strict-fields test-suite tests type: exitcode-stdio-1.0 @@ -174,5 +165,3 @@ test-suite tests , unison-core1 , unison-prelude default-language: Haskell2010 - if flag(optimized) - ghc-options: -O2 -funbox-strict-fields diff --git a/unison-hashing-v2/package.yaml b/unison-hashing-v2/package.yaml index 8d334428ba..a0d531c550 100644 --- a/unison-hashing-v2/package.yaml +++ b/unison-hashing-v2/package.yaml @@ -17,7 +17,6 @@ dependencies: - unison-hash - unison-hashing - unison-prelude - - unison-util-base32hex - unison-util-relation library: diff --git a/unison-hashing-v2/src/Unison/Hashing/V2/DataDeclaration.hs b/unison-hashing-v2/src/Unison/Hashing/V2/DataDeclaration.hs index 7d1d67ce41..3dc7b4eba0 100644 --- a/unison-hashing-v2/src/Unison/Hashing/V2/DataDeclaration.hs +++ b/unison-hashing-v2/src/Unison/Hashing/V2/DataDeclaration.hs @@ -76,7 +76,7 @@ hashDecls :: (Eq v, Var v, Show v) => (v -> Name.Name) -> Map v (DataDeclaration v a) -> - Names.ResolutionResult v a [(v, ReferenceId, DataDeclaration v a)] + Names.ResolutionResult a [(v, ReferenceId, DataDeclaration v a)] hashDecls unsafeVarToName decls = do -- todo: make sure all other external references are resolved before calling this let varToRef = hashDecls0 (void <$> decls) @@ -96,7 +96,7 @@ bindReferences :: Set v -> Map Name.Name Reference -> DataDeclaration v a -> - Names.ResolutionResult v a (DataDeclaration v a) + Names.ResolutionResult a (DataDeclaration v a) bindReferences unsafeVarToName keepFree names (DataDeclaration m a bound constructors) = do constructors <- for constructors $ \(a, v, ty) -> (a,v,) <$> Type.bindReferences unsafeVarToName keepFree names ty diff --git a/unison-hashing-v2/src/Unison/Hashing/V2/Type.hs b/unison-hashing-v2/src/Unison/Hashing/V2/Type.hs index 14a5e0e809..b1397d0e81 100644 --- a/unison-hashing-v2/src/Unison/Hashing/V2/Type.hs +++ b/unison-hashing-v2/src/Unison/Hashing/V2/Type.hs @@ -23,6 +23,7 @@ where import Data.Map qualified as Map import Data.Set qualified as Set import Unison.ABT qualified as ABT +import Unison.HashQualified qualified as HQ import Unison.Hashing.V2.ABT qualified as ABT import Unison.Hashing.V2.Kind qualified as K import Unison.Hashing.V2.Reference (Reference (..), pattern ReferenceDerived) @@ -64,12 +65,12 @@ bindReferences :: Set v -> Map Name.Name Reference -> Type v a -> - Names.ResolutionResult v a (Type v a) + Names.ResolutionResult a (Type v a) bindReferences unsafeVarToName keepFree ns t = let fvs = ABT.freeVarOccurrences keepFree t rs = [(v, a, Map.lookup (unsafeVarToName v) ns) | (v, a) <- fvs] ok (v, _a, Just r) = pure (v, r) - ok (v, a, Nothing) = Left (pure (Names.TypeResolutionFailure v a Names.NotFound)) + ok (v, a, Nothing) = Left (pure (Names.TypeResolutionFailure (HQ.NameOnly (unsafeVarToName v)) a Names.NotFound)) in List.validate ok rs <&> \es -> bindExternal es t -- some smart patterns diff --git a/unison-hashing-v2/unison-hashing-v2.cabal b/unison-hashing-v2/unison-hashing-v2.cabal index f9c9daabd2..feae301be6 100644 --- a/unison-hashing-v2/unison-hashing-v2.cabal +++ b/unison-hashing-v2/unison-hashing-v2.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -78,6 +78,5 @@ library , unison-hash , unison-hashing , unison-prelude - , unison-util-base32hex , unison-util-relation default-language: Haskell2010 diff --git a/unison-merge/package.yaml b/unison-merge/package.yaml index c31adfcd5b..53b339cf9f 100644 --- a/unison-merge/package.yaml +++ b/unison-merge/package.yaml @@ -6,36 +6,23 @@ ghc-options: -Wall dependencies: - base - - bimap - - bitvec - - bytestring - containers - - either - - free - - generic-lens - lens - - monad-validate - mtl - nonempty-containers - - safe - semialign - semigroups - text - these - transformers - - unison-codebase - - unison-codebase-sqlite - - unison-codebase-sqlite-hashing-v2 - unison-core - unison-core1 - unison-hash - unison-parser-typechecker - unison-prelude - - unison-sqlite + - unison-pretty-printer - unison-syntax - - unison-util-cache - unison-util-relation - - vector - witch - witherable @@ -46,8 +33,6 @@ library: # - Unison.Merge2 source-dirs: src when: - - condition: '!os(windows)' - dependencies: unix - condition: false other-modules: Paths_unison_merge @@ -79,6 +64,7 @@ default-extensions: - OverloadedRecordDot - OverloadedStrings - PatternSynonyms + - QuantifiedConstraints - RankNTypes - ScopedTypeVariables - TupleSections diff --git a/unison-merge/src/Unison/Merge.hs b/unison-merge/src/Unison/Merge.hs new file mode 100644 index 0000000000..908e776cd0 --- /dev/null +++ b/unison-merge/src/Unison/Merge.hs @@ -0,0 +1,65 @@ +module Unison.Merge + ( Mergeblob0 (..), + makeMergeblob0, + Mergeblob1 (..), + makeMergeblob1, + Mergeblob2 (..), + Mergeblob2Error (..), + makeMergeblob2, + Mergeblob3 (..), + makeMergeblob3, + Mergeblob4 (..), + makeMergeblob4, + Mergeblob5 (..), + makeMergeblob5, + + -- * Decl coherency checks + PartialDeclNameLookup (..), + IncoherentDeclReason (..), + checkDeclCoherency, + lenientCheckDeclCoherency, + IncoherentDeclReasons (..), + checkAllDeclCoherency, + + -- * Types + CombinedDiffOp (..), + DiffOp (..), + EitherWay (..), + EitherWayI (..), + LibdepDiffOp (..), + Synhashed (..), + ThreeWay (..), + TwoOrThreeWay (..), + TwoWay (..), + TwoWayI (..), + Unconflicts (..), + Updated (..), + ) +where + +import Unison.Merge.CombineDiffs (CombinedDiffOp (..)) +import Unison.Merge.DeclCoherencyCheck + ( IncoherentDeclReason (..), + IncoherentDeclReasons (..), + checkAllDeclCoherency, + checkDeclCoherency, + lenientCheckDeclCoherency, + ) +import Unison.Merge.DiffOp (DiffOp (..)) +import Unison.Merge.EitherWay (EitherWay (..)) +import Unison.Merge.EitherWayI (EitherWayI (..)) +import Unison.Merge.Libdeps (LibdepDiffOp (..)) +import Unison.Merge.Mergeblob0 (Mergeblob0 (..), makeMergeblob0) +import Unison.Merge.Mergeblob1 (Mergeblob1 (..), makeMergeblob1) +import Unison.Merge.Mergeblob2 (Mergeblob2 (..), Mergeblob2Error (..), makeMergeblob2) +import Unison.Merge.Mergeblob3 (Mergeblob3 (..), makeMergeblob3) +import Unison.Merge.Mergeblob4 (Mergeblob4 (..), makeMergeblob4) +import Unison.Merge.Mergeblob5 (Mergeblob5 (..), makeMergeblob5) +import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..)) +import Unison.Merge.Synhashed (Synhashed (..)) +import Unison.Merge.ThreeWay (ThreeWay (..)) +import Unison.Merge.TwoOrThreeWay (TwoOrThreeWay (..)) +import Unison.Merge.TwoWay (TwoWay (..)) +import Unison.Merge.TwoWayI (TwoWayI (..)) +import Unison.Merge.Unconflicts (Unconflicts (..)) +import Unison.Merge.Updated (Updated (..)) diff --git a/unison-merge/src/Unison/Merge/Database.hs b/unison-merge/src/Unison/Merge/Database.hs deleted file mode 100644 index 47d40954e6..0000000000 --- a/unison-merge/src/Unison/Merge/Database.hs +++ /dev/null @@ -1,91 +0,0 @@ -module Unison.Merge.Database - ( MergeDatabase (..), - referent2to1, - makeMergeDatabase, - ) -where - -import Data.Map.Strict qualified as Map -import Data.Text qualified as Text -import U.Codebase.Branch (CausalBranch) -import U.Codebase.HashTags (CausalHash) -import U.Codebase.Reference (Reference' (..), TermReferenceId, TypeReference, TypeReferenceId) -import U.Codebase.Referent (Referent) -import U.Codebase.Referent qualified as Referent -import U.Codebase.Sqlite.Operations qualified as Operations -import Unison.Builtin qualified as Builtins -import Unison.Codebase (Codebase) -import Unison.Codebase qualified as Codebase -import Unison.Codebase.SqliteCodebase.Operations qualified as Operations (expectDeclComponent) -import Unison.ConstructorReference (GConstructorReference (..)) -import Unison.ConstructorType (ConstructorType) -import Unison.DataDeclaration qualified as V1 (Decl) -import Unison.DataDeclaration qualified as V1.Decl -import Unison.Hash (Hash) -import Unison.Parser.Ann qualified as V1 (Ann) -import Unison.Prelude -import Unison.Referent qualified as V1 (Referent) -import Unison.Referent qualified as V1.Referent -import Unison.Sqlite (Transaction) -import Unison.Sqlite qualified as Sqlite -import Unison.Symbol qualified as V1 (Symbol) -import Unison.Term qualified as V1 (Term) -import Unison.Type qualified as V1 (Type) -import Unison.Util.Cache qualified as Cache - ------------------------------------------------------------------------------------------------------------------------- --- Merge database - --- A mini record-of-functions that contains just the (possibly backed by a cache) database queries used in merge. -data MergeDatabase = MergeDatabase - { loadCausal :: CausalHash -> Transaction (CausalBranch Transaction), - loadDeclNumConstructors :: TypeReferenceId -> Transaction Int, - loadDeclType :: TypeReference -> Transaction ConstructorType, - loadV1Decl :: TypeReferenceId -> Transaction (V1.Decl V1.Symbol V1.Ann), - loadV1DeclComponent :: Hash -> Transaction [V1.Decl V1.Symbol V1.Ann], - loadV1Term :: TermReferenceId -> Transaction (V1.Term V1.Symbol V1.Ann), - loadV1TermComponent :: Hash -> Transaction [(V1.Term V1.Symbol V1.Ann, V1.Type V1.Symbol V1.Ann)] - } - -makeMergeDatabase :: (MonadIO m) => Codebase IO V1.Symbol V1.Ann -> m MergeDatabase -makeMergeDatabase codebase = liftIO do - -- Create a bunch of cached database lookup functions - loadCausal <- do - cache <- Cache.semispaceCache 1024 - pure (Sqlite.cacheTransaction cache Operations.expectCausalBranchByCausalHash) - loadDeclNumConstructors <- do - cache <- Cache.semispaceCache 1024 - pure (Sqlite.cacheTransaction cache Operations.expectDeclNumConstructors) - loadV1Decl <- do - cache <- Cache.semispaceCache 1024 - pure (Sqlite.cacheTransaction cache (Codebase.unsafeGetTypeDeclaration codebase)) - -- Since loading a decl type loads the decl and projects out the decl type, just reuse the loadDecl cache - let loadDeclType ref = - case ref of - ReferenceBuiltin name -> - Map.lookup ref Builtins.builtinConstructorType - & maybe (error ("Unknown builtin: " ++ Text.unpack name)) pure - ReferenceDerived refId -> V1.Decl.constructorType <$> loadV1Decl refId - loadV1Term <- do - cache <- Cache.semispaceCache 1024 - pure (Sqlite.cacheTransaction cache (Codebase.unsafeGetTerm codebase)) - let loadV1TermComponent = Codebase.unsafeGetTermComponent codebase - let loadV1DeclComponent = Operations.expectDeclComponent - pure - MergeDatabase - { loadCausal, - loadDeclNumConstructors, - loadDeclType, - loadV1Decl, - loadV1DeclComponent, - loadV1Term, - loadV1TermComponent - } - --- Convert a v2 referent (missing decl type) to a v1 referent. -referent2to1 :: MergeDatabase -> Referent -> Transaction V1.Referent -referent2to1 MergeDatabase {loadDeclType} = \case - Referent.Con typeRef conId -> do - declTy <- loadDeclType typeRef - pure (V1.Referent.Con (ConstructorReference typeRef conId) declTy) - Referent.Ref termRef -> pure (V1.Referent.Ref termRef) diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index 882695231e..697e693d6b 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs @@ -91,9 +91,9 @@ module Unison.Merge.DeclCoherencyCheck where import Control.Lens ((%=), (.=), _2) -import Control.Monad.Except qualified as Except import Control.Monad.State.Strict (StateT) import Control.Monad.State.Strict qualified as State +import Control.Monad.Trans.State.Strict (State) import Data.Functor.Compose (Compose (..)) import Data.IntMap.Strict (IntMap) import Data.IntMap.Strict qualified as IntMap @@ -105,7 +105,7 @@ import Data.Set qualified as Set import U.Codebase.Reference (Reference' (..), TypeReference, TypeReferenceId) import Unison.ConstructorReference (GConstructorReference (..)) import Unison.DataDeclaration.ConstructorId (ConstructorId) -import Unison.Merge.DeclNameLookup (DeclNameLookup (..)) +import Unison.DeclNameLookup (DeclNameLookup (..)) import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..)) import Unison.Name (Name) import Unison.Name qualified as Name @@ -135,21 +135,20 @@ data IncoherentDeclReason deriving stock (Show) checkDeclCoherency :: - (Monad m) => - (TypeReferenceId -> m Int) -> + (HasCallStack) => Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> - m (Either IncoherentDeclReason DeclNameLookup) -checkDeclCoherency loadDeclNumConstructors nametree = - Except.runExceptT $ - checkDeclCoherencyWith - (lift . loadDeclNumConstructors) - OnIncoherentDeclReasons - { onConstructorAlias = \x y z -> Except.throwError (IncoherentDeclReason'ConstructorAlias x y z), - onMissingConstructorName = \x -> Except.throwError (IncoherentDeclReason'MissingConstructorName x), - onNestedDeclAlias = \x y -> Except.throwError (IncoherentDeclReason'NestedDeclAlias x y), - onStrayConstructor = \x y -> Except.throwError (IncoherentDeclReason'StrayConstructor x y) - } - nametree + Map TypeReferenceId Int -> + Either IncoherentDeclReason DeclNameLookup +checkDeclCoherency nametree numConstructorsById = + checkDeclCoherencyWith + (\refId -> Right (expectNumConstructors refId numConstructorsById)) + OnIncoherentDeclReasons + { onConstructorAlias = \x y z -> Left (IncoherentDeclReason'ConstructorAlias x y z), + onMissingConstructorName = \x -> Left (IncoherentDeclReason'MissingConstructorName x), + onNestedDeclAlias = \x y -> Left (IncoherentDeclReason'NestedDeclAlias x y), + onStrayConstructor = \x y -> Left (IncoherentDeclReason'StrayConstructor x y) + } + nametree data IncoherentDeclReasons = IncoherentDeclReasons { constructorAliases :: ![(Name, Name, Name)], @@ -348,20 +347,19 @@ checkDeclCoherencyWith_DoTypes2 loadDeclNumConstructors callbacks go prefix chil -- have coherent decls, but their LCA is out of the user's control and may have incoherent decls, and whether or not it -- does, we still need to compute *some* syntactic hash for its decls. lenientCheckDeclCoherency :: - forall m. - (Monad m) => - (TypeReferenceId -> m Int) -> Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> - m PartialDeclNameLookup -lenientCheckDeclCoherency loadDeclNumConstructors = - fmap (view #declNameLookup) - . (`State.execStateT` LenientDeclCoherencyCheckState Map.empty (PartialDeclNameLookup Map.empty Map.empty)) - . go [] + Map TypeReferenceId Int -> + PartialDeclNameLookup +lenientCheckDeclCoherency nametree numConstructorsById = + nametree + & go [] + & (`State.execState` LenientDeclCoherencyCheckState Map.empty (PartialDeclNameLookup Map.empty Map.empty)) + & view #declNameLookup where go :: [NameSegment] -> (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> - StateT LenientDeclCoherencyCheckState m () + State LenientDeclCoherencyCheckState () go prefix (Nametree defns children) = do for_ (Map.toList defns.terms) \case (_, Referent.Ref _) -> pure () @@ -373,14 +371,14 @@ lenientCheckDeclCoherency loadDeclNumConstructors = forMaybe (Map.toList defns.types) \case (_, ReferenceBuiltin _) -> pure Nothing (name, ReferenceDerived typeRef) -> do - whatHappened <- do - let recordNewDecl :: m (WhatHappened (Map Name ConstructorNames)) - recordNewDecl = - loadDeclNumConstructors typeRef <&> \case - 0 -> UninhabitedDecl - n -> InhabitedDecl (Map.singleton typeName (emptyConstructorNames n)) - state <- State.get - lift (getCompose (Map.upsertF (\_ -> Compose recordNewDecl) typeRef state.expectedConstructors)) + state <- State.get + let whatHappened = + let recordNewDecl :: WhatHappened (Map Name ConstructorNames) + recordNewDecl = + case expectNumConstructors typeRef numConstructorsById of + 0 -> UninhabitedDecl + n -> InhabitedDecl (Map.singleton typeName (emptyConstructorNames n)) + in Map.upsertF (\_ -> recordNewDecl) typeRef state.expectedConstructors case whatHappened of UninhabitedDecl -> do #declNameLookup . #declToConstructors %= Map.insert typeName [] @@ -474,3 +472,11 @@ data WhatHappened a = UninhabitedDecl | InhabitedDecl !a deriving stock (Functor, Show) + +expectNumConstructors :: (HasCallStack) => TypeReferenceId -> Map TypeReferenceId Int -> Int +expectNumConstructors refId numConstructorsById = + case Map.lookup refId numConstructorsById of + Just numConstructors -> numConstructors + Nothing -> + error $ + reportBug "E061715" ("type ref " ++ show refId ++ " not found in map " ++ show numConstructorsById) diff --git a/unison-merge/src/Unison/Merge/Diff.hs b/unison-merge/src/Unison/Merge/Diff.hs index ca57953a2c..39be392c28 100644 --- a/unison-merge/src/Unison/Merge/Diff.hs +++ b/unison-merge/src/Unison/Merge/Diff.hs @@ -3,7 +3,6 @@ module Unison.Merge.Diff ) where -import Data.Bitraversable (bitraverse) import Data.Map.Strict qualified as Map import Data.Semialign (alignWith) import Data.Set qualified as Set @@ -12,14 +11,13 @@ import U.Codebase.Reference (TypeReference) import Unison.ConstructorReference (GConstructorReference (..)) import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as DataDeclaration +import Unison.DeclNameLookup (DeclNameLookup) +import Unison.DeclNameLookup qualified as DeclNameLookup import Unison.Hash (Hash (Hash)) import Unison.HashQualifiedPrime qualified as HQ' -import Unison.Merge.Database (MergeDatabase (..)) -import Unison.Merge.DeclNameLookup (DeclNameLookup) -import Unison.Merge.DeclNameLookup qualified as DeclNameLookup import Unison.Merge.DiffOp (DiffOp (..)) import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..)) -import Unison.Merge.Synhash +import Unison.Merge.Synhash qualified as Synhash import Unison.Merge.Synhashed (Synhashed (..)) import Unison.Merge.ThreeWay (ThreeWay (..)) import Unison.Merge.ThreeWay qualified as ThreeWay @@ -30,12 +28,12 @@ import Unison.Parser.Ann (Ann) import Unison.Prelude hiding (catMaybes) import Unison.PrettyPrintEnv (PrettyPrintEnv (..)) import Unison.PrettyPrintEnv qualified as Ppe -import Unison.Reference (Reference' (..), TypeReferenceId) +import Unison.Reference (Reference' (..), TermReference, TermReferenceId, TypeReferenceId) import Unison.Referent (Referent) import Unison.Referent qualified as Referent -import Unison.Sqlite (Transaction) import Unison.Symbol (Symbol) import Unison.Syntax.Name qualified as Name +import Unison.Term (Term) import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap import Unison.Util.Defns (Defns (..), DefnsF2, DefnsF3, zipDefnsWith) @@ -49,15 +47,16 @@ import Unison.Util.Defns (Defns (..), DefnsF2, DefnsF3, zipDefnsWith) -- where each name is paired with its diff-op (added, deleted, or updated), relative to the LCA between Alice and Bob's -- branches. If the hash of a name did not change, it will not appear in the map. nameBasedNamespaceDiff :: - MergeDatabase -> + (HasCallStack) => TwoWay DeclNameLookup -> PartialDeclNameLookup -> ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> - Transaction (TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)) -nameBasedNamespaceDiff db declNameLookups lcaDeclNameLookup defns = do - lcaHashes <- synhashLcaDefns db ppe lcaDeclNameLookup defns.lca - hashes <- sequence (synhashDefns db ppe <$> declNameLookups <*> ThreeWay.forgetLca defns) - pure (diffNamespaceDefns lcaHashes <$> hashes) + Defns (Map TermReferenceId (Term Symbol Ann)) (Map TypeReferenceId (Decl Symbol Ann)) -> + TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference) +nameBasedNamespaceDiff declNameLookups lcaDeclNameLookup defns hydratedDefns = + let lcaHashes = synhashLcaDefns ppe lcaDeclNameLookup defns.lca hydratedDefns + hashes = synhashDefns ppe hydratedDefns <$> declNameLookups <*> ThreeWay.forgetLca defns + in diffHashedNamespaceDefns lcaHashes <$> hashes where ppe :: PrettyPrintEnv ppe = @@ -67,14 +66,37 @@ nameBasedNamespaceDiff db declNameLookups lcaDeclNameLookup defns = do `Ppe.addFallback` deepNamespaceDefinitionsToPpe defns.bob `Ppe.addFallback` deepNamespaceDefinitionsToPpe defns.lca +diffHashedNamespaceDefns :: + DefnsF2 (Map Name) Synhashed term typ -> + DefnsF2 (Map Name) Synhashed term typ -> + DefnsF3 (Map Name) DiffOp Synhashed term typ +diffHashedNamespaceDefns = + zipDefnsWith f f + where + f :: Map Name (Synhashed ref) -> Map Name (Synhashed ref) -> Map Name (DiffOp (Synhashed ref)) + f old new = + Map.mapMaybe id (alignWith g old new) + + g :: (Eq x) => These x x -> Maybe (DiffOp x) + g = \case + This old -> Just (DiffOp'Delete old) + That new -> Just (DiffOp'Add new) + These old new + | old == new -> Nothing + | otherwise -> Just (DiffOp'Update Updated {old, new}) + +------------------------------------------------------------------------------------------------------------------------ +-- Syntactic hashing + synhashLcaDefns :: - MergeDatabase -> + (HasCallStack) => PrettyPrintEnv -> PartialDeclNameLookup -> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> - Transaction (DefnsF2 (Map Name) Synhashed Referent TypeReference) -synhashLcaDefns db ppe declNameLookup = - synhashDefnsWith hashReferent hashType + Defns (Map TermReferenceId (Term Symbol Ann)) (Map TypeReferenceId (Decl Symbol Ann)) -> + DefnsF2 (Map Name) Synhashed Referent TypeReference +synhashLcaDefns ppe declNameLookup defns hydratedDefns = + synhashDefnsWith hashReferent hashType defns where -- For the LCA only, if we don't have a name for every constructor, or we don't have a name for a decl, that's okay, -- just use a dummy syntactic hash (e.g. where we return `Hash mempty` below in two places). @@ -82,35 +104,33 @@ synhashLcaDefns db ppe declNameLookup = -- This is safe and correct; Alice/Bob can't have such a decl (it violates a merge precondition), so there's no risk -- that we accidentally get an equal hash and classify a real update as unchanged. - hashReferent :: Name -> Referent -> Transaction Hash + hashReferent :: Name -> Referent -> Hash hashReferent name = \case Referent.Con (ConstructorReference ref _) _ -> case Map.lookup name declNameLookup.constructorToDecl of - Nothing -> pure (Hash mempty) -- see note above + Nothing -> Hash mempty -- see note above Just declName -> hashType declName ref - Referent.Ref ref -> synhashTerm db.loadV1Term ppe ref + Referent.Ref ref -> synhashTermReference ppe hydratedDefns.terms ref - hashType :: Name -> TypeReference -> Transaction Hash + hashType :: Name -> TypeReference -> Hash hashType name = \case - ReferenceBuiltin builtin -> pure (synhashBuiltinDecl builtin) + ReferenceBuiltin builtin -> Synhash.synhashBuiltinDecl builtin ReferenceDerived ref -> case sequence (declNameLookup.declToConstructors Map.! name) of - Nothing -> pure (Hash mempty) -- see note above - Just names -> do - decl <- loadDeclWithGoodConstructorNames db names ref - pure (synhashDerivedDecl ppe name decl) + Nothing -> Hash mempty -- see note above + Just names -> synhashDerivedDecl ppe hydratedDefns.types names name ref synhashDefns :: - MergeDatabase -> + (HasCallStack) => PrettyPrintEnv -> + Defns (Map TermReferenceId (Term Symbol Ann)) (Map TypeReferenceId (Decl Symbol Ann)) -> DeclNameLookup -> Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> - Transaction (DefnsF2 (Map Name) Synhashed Referent TypeReference) -synhashDefns db ppe declNameLookup = - -- FIXME: use cache so we only synhash each thing once + DefnsF2 (Map Name) Synhashed Referent TypeReference +synhashDefns ppe hydratedDefns declNameLookup = synhashDefnsWith hashReferent hashType where - hashReferent :: Name -> Referent -> Transaction Hash + hashReferent :: Name -> Referent -> Hash hashReferent name = \case -- We say that a referent constructor *in the namespace* (distinct from a referent that is in a term body) has a -- synhash that is simply equal to the synhash of its type declaration. This is because the type declaration and @@ -119,37 +139,49 @@ synhashDefns db ppe declNameLookup = -- For example, if Alice updates `type Foo = Bar Nat` to `type Foo = Bar Nat Nat`, we want different synhashes on -- both the type (Foo) and the constructor (Foo.Bar). Referent.Con (ConstructorReference ref _) _ -> hashType (DeclNameLookup.expectDeclName declNameLookup name) ref - Referent.Ref ref -> synhashTerm db.loadV1Term ppe ref + Referent.Ref ref -> synhashTermReference ppe hydratedDefns.terms ref - hashType :: Name -> TypeReference -> Transaction Hash + hashType :: Name -> TypeReference -> Hash hashType name = \case - ReferenceBuiltin builtin -> pure (synhashBuiltinDecl builtin) - ReferenceDerived ref -> do - decl <- loadDeclWithGoodConstructorNames db (DeclNameLookup.expectConstructorNames declNameLookup name) ref - pure (synhashDerivedDecl ppe name decl) + ReferenceBuiltin builtin -> Synhash.synhashBuiltinDecl builtin + ReferenceDerived ref -> + synhashDerivedDecl ppe hydratedDefns.types (DeclNameLookup.expectConstructorNames declNameLookup name) name ref + +synhashDerivedDecl :: + (HasCallStack) => + PrettyPrintEnv -> + Map TypeReferenceId (Decl Symbol Ann) -> + [Name] -> + Name -> + TypeReferenceId -> + Hash +synhashDerivedDecl ppe declsById names name ref = + declsById + & expectDecl ref + & DataDeclaration.setConstructorNames (map Name.toVar names) + & Synhash.synhashDerivedDecl ppe name -loadDeclWithGoodConstructorNames :: MergeDatabase -> [Name] -> TypeReferenceId -> Transaction (Decl Symbol Ann) -loadDeclWithGoodConstructorNames db names = - fmap (DataDeclaration.setConstructorNames (map Name.toVar names)) . db.loadV1Decl +synhashTermReference :: (HasCallStack) => PrettyPrintEnv -> Map TermReferenceId (Term Symbol Ann) -> TermReference -> Hash +synhashTermReference ppe termsById = \case + ReferenceBuiltin builtin -> Synhash.synhashBuiltinTerm builtin + ReferenceDerived ref -> Synhash.synhashDerivedTerm ppe (expectTerm ref termsById) -diffNamespaceDefns :: - DefnsF2 (Map Name) Synhashed term typ -> - DefnsF2 (Map Name) Synhashed term typ -> - DefnsF3 (Map Name) DiffOp Synhashed term typ -diffNamespaceDefns = - zipDefnsWith f f +synhashDefnsWith :: + (HasCallStack) => + (Name -> term -> Hash) -> + (Name -> typ -> Hash) -> + Defns (BiMultimap term Name) (BiMultimap typ Name) -> + DefnsF2 (Map Name) Synhashed term typ +synhashDefnsWith hashTerm hashType = do + bimap + (Map.mapWithKey hashTerm1 . BiMultimap.range) + (Map.mapWithKey hashType1 . BiMultimap.range) where - f :: Map Name (Synhashed ref) -> Map Name (Synhashed ref) -> Map Name (DiffOp (Synhashed ref)) - f old new = - Map.mapMaybe id (alignWith g old new) + hashTerm1 name term = + Synhashed (hashTerm name term) term - g :: (Eq x) => These x x -> Maybe (DiffOp x) - g = \case - This old -> Just (DiffOp'Delete old) - That new -> Just (DiffOp'Add new) - These old new - | old == new -> Nothing - | otherwise -> Just (DiffOp'Update Updated {old, new}) + hashType1 name typ = + Synhashed (hashType name typ) typ ------------------------------------------------------------------------------------------------------------------------ -- Pretty-print env helpers @@ -165,23 +197,16 @@ deepNamespaceDefinitionsToPpe Defns {terms, types} = & maybe [] \name -> [(HQ'.NameOnly name, HQ'.NameOnly name)] ------------------------------------------------------------------------------------------------------------------------ --- Syntactic hashing helpers +-- Looking up terms and decls that we expect to be there -synhashDefnsWith :: - (Monad m) => - (Name -> term -> m Hash) -> - (Name -> typ -> m Hash) -> - Defns (BiMultimap term Name) (BiMultimap typ Name) -> - m (DefnsF2 (Map Name) Synhashed term typ) -synhashDefnsWith hashTerm hashType = do - bitraverse - (Map.traverseWithKey hashTerm1 . BiMultimap.range) - (Map.traverseWithKey hashType1 . BiMultimap.range) - where - hashTerm1 name term = do - hash <- hashTerm name term - pure (Synhashed hash term) +expectTerm :: (HasCallStack) => TermReferenceId -> Map TermReferenceId (Term Symbol Ann) -> Term Symbol Ann +expectTerm ref termsById = + case Map.lookup ref termsById of + Nothing -> error (reportBug "E488229" ("term ref " ++ show ref ++ " not found in map " ++ show termsById)) + Just term -> term - hashType1 name typ = do - hash <- hashType name typ - pure (Synhashed hash typ) +expectDecl :: (HasCallStack) => TypeReferenceId -> Map TypeReferenceId (Decl Symbol Ann) -> Decl Symbol Ann +expectDecl ref declsById = + case Map.lookup ref declsById of + Nothing -> error (reportBug "E663160" ("type ref " ++ show ref ++ " not found in map " ++ show declsById)) + Just decl -> decl diff --git a/unison-merge/src/Unison/Merge/FindConflictedAlias.hs b/unison-merge/src/Unison/Merge/FindConflictedAlias.hs new file mode 100644 index 0000000000..bf7222d4dd --- /dev/null +++ b/unison-merge/src/Unison/Merge/FindConflictedAlias.hs @@ -0,0 +1,67 @@ +module Unison.Merge.FindConflictedAlias + ( findConflictedAlias, + ) +where + +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Unison.Merge.DiffOp (DiffOp (..)) +import Unison.Merge.Updated qualified +import Unison.Prelude +import Unison.Util.BiMultimap (BiMultimap) +import Unison.Util.BiMultimap qualified as BiMultimap +import Unison.Util.Defn (Defn (..)) +import Unison.Util.Defns (Defns (..), DefnsF3) + +-- @findConflictedAlias namespace diff@, given an old namespace and a diff to a new namespace, will return the first +-- "conflicted alias" encountered (if any), where a "conflicted alias" is a pair of names that referred to the same +-- thing in the old namespace, but different things in the new one. +-- +-- For example, if the old namespace was +-- +-- foo = #foo +-- bar = #foo +-- +-- and the new namespace is +-- +-- foo = #baz +-- bar = #qux +-- +-- then (foo, bar) is a conflicted alias. +findConflictedAlias :: + forall name synhashed term typ. + (Ord name, forall ref. Eq (synhashed ref), Ord term, Ord typ) => + Defns (BiMultimap term name) (BiMultimap typ name) -> + DefnsF3 (Map name) DiffOp synhashed term typ -> + Maybe (Defn (name, name) (name, name)) +findConflictedAlias defns diff = + asum [TermDefn <$> go defns.terms diff.terms, TypeDefn <$> go defns.types diff.types] + where + go :: + forall ref. + (Eq (synhashed ref), Ord ref) => + BiMultimap ref name -> + Map name (DiffOp (synhashed ref)) -> + Maybe (name, name) + go namespace diff = + asum (map f (Map.toList diff)) + where + f :: (name, DiffOp (synhashed ref)) -> Maybe (name, name) + f (name, op) = + case op of + DiffOp'Add _ -> Nothing + DiffOp'Delete _ -> Nothing + DiffOp'Update hashed1 -> + BiMultimap.lookupPreimage name namespace + & Set.delete name + & Set.toList + & map (g hashed1.new) + & asum + where + g :: synhashed ref -> name -> Maybe (name, name) + g hashed1 alias = + case Map.lookup alias diff of + Just (DiffOp'Update hashed2) | hashed1 == hashed2.new -> Nothing + -- If "foo" was updated but its alias "bar" was deleted, that's ok + Just (DiffOp'Delete _) -> Nothing + _ -> Just (name, alias) diff --git a/unison-merge/src/Unison/Merge/Libdeps.hs b/unison-merge/src/Unison/Merge/Libdeps.hs index defacf036b..ec0b9899d4 100644 --- a/unison-merge/src/Unison/Merge/Libdeps.hs +++ b/unison-merge/src/Unison/Merge/Libdeps.hs @@ -1,6 +1,9 @@ -- | An API for merging together two collections of library dependencies. module Unison.Merge.Libdeps - ( mergeLibdeps, + ( LibdepDiffOp (..), + diffLibdeps, + applyLibdepsDiff, + getTwoFreshLibdepNames, ) where @@ -16,37 +19,35 @@ import Unison.Merge.TwoDiffOps (TwoDiffOps (..)) import Unison.Merge.TwoDiffOps qualified as TwoDiffOps import Unison.Merge.TwoWay (TwoWay (..)) import Unison.Merge.Updated (Updated (..)) +import Unison.NameSegment.Internal (NameSegment (NameSegment)) +import Unison.NameSegment.Internal qualified as NameSegment import Unison.Prelude hiding (catMaybes) import Unison.Util.Map qualified as Map import Witherable (catMaybes) --- | Perform a three-way merge on two collections of library dependencies. -mergeLibdeps :: - forall k v. +------------------------------------------------------------------------------------------------------------------------ +-- Diffing libdeps + +data LibdepDiffOp a + = AddLibdep !a + | AddBothLibdeps !a !a + | DeleteLibdep + +-- | Perform a three-way diff on two collections of library dependencies. +diffLibdeps :: (Ord k, Eq v) => - -- | Freshen a name, e.g. "base" -> ("base__4", "base__5"). - (Set k -> k -> (k, k)) -> -- | Library dependencies. ThreeWay (Map k v) -> - -- | Merged library dependencies. - Map k v -mergeLibdeps freshen libdeps = - mergeDiffs (diff libdeps.lca libdeps.alice) (diff libdeps.lca libdeps.bob) - & applyDiff (freshen usedNames) libdeps.lca - where - usedNames :: Set k - usedNames = - Set.unions - [ Map.keysSet libdeps.lca, - Map.keysSet libdeps.alice, - Map.keysSet libdeps.bob - ] + -- | Library dependencies diff. + Map k (LibdepDiffOp v) +diffLibdeps libdeps = + mergeDiffs (twoWayDiff libdeps.lca libdeps.alice) (twoWayDiff libdeps.lca libdeps.bob) --- `diff old new` computes a diff between old thing `old` and new thing `new`. +-- `twoWayDiff old new` computes a diff between old thing `old` and new thing `new`. -- -- Values present in `old` but not `new` are tagged as "deleted"; similar for "added" and "updated". -diff :: (Ord k, Eq v) => Map k v -> Map k v -> Map k (DiffOp v) -diff = +twoWayDiff :: (Ord k, Eq v) => Map k v -> Map k v -> Map k (DiffOp v) +twoWayDiff = Map.merge (Map.mapMissing \_ -> DiffOp'Delete) (Map.mapMissing \_ -> DiffOp'Add) @@ -97,20 +98,23 @@ combineDiffOps1 = \case | alice == bob -> Just (AddLibdep alice) | otherwise -> Just (AddBothLibdeps alice bob) +------------------------------------------------------------------------------------------------------------------------ +-- Applying libdeps diff + -- Apply a library dependencies diff to the LCA. -applyDiff :: +applyLibdepsDiff :: forall k v. (Ord k) => - -- Freshen a name, e.g. "base" -> ("base__4", "base__5") - (k -> (k, k)) -> - -- The LCA library dependencies. - Map k v -> - -- LCA->Alice+Bob library dependencies diff. + -- | Freshen a name, e.g. "base" -> ("base__4", "base__5"). + (Set k -> k -> (k, k)) -> + -- | Library dependencies. + ThreeWay (Map k v) -> + -- | Library dependencies diff. Map k (LibdepDiffOp v) -> - -- The merged library dependencies. + -- | Merged library dependencies. Map k v -applyDiff freshen = - Map.mergeMap Map.singleton f (\name _ -> f name) +applyLibdepsDiff freshen0 libdeps = + Map.mergeMap Map.singleton f (\name _ -> f name) libdeps.lca where f :: k -> LibdepDiffOp v -> Map k v f k = \case @@ -120,7 +124,48 @@ applyDiff freshen = in Map.fromList [(k1, v1), (k2, v2)] DeleteLibdep -> Map.empty -data LibdepDiffOp a - = AddLibdep !a - | AddBothLibdeps !a !a - | DeleteLibdep + freshen :: k -> (k, k) + freshen = + freshen0 $ + Set.unions + [ Map.keysSet libdeps.lca, + Map.keysSet libdeps.alice, + Map.keysSet libdeps.bob + ] + +------------------------------------------------------------------------------------------------------------------------ +-- Getting fresh libdeps names + +-- Given a name like "base", try "base__1", then "base__2", etc, until we find a name that doesn't +-- clash with any existing dependencies. +getTwoFreshLibdepNames :: Set NameSegment -> NameSegment -> (NameSegment, NameSegment) +getTwoFreshLibdepNames names name0 = + go2 0 + where + -- if + -- name0 = "base" + -- names = {"base__5", "base__6"} + -- then + -- go2 4 = ("base__4", "base__7") + go2 :: Integer -> (NameSegment, NameSegment) + go2 !i + | Set.member name names = go2 (i + 1) + | otherwise = (name, go1 (i + 1)) + where + name = mangled i + + -- if + -- name0 = "base" + -- names = {"base__5", "base__6"} + -- then + -- go1 5 = "base__7" + go1 :: Integer -> NameSegment + go1 !i + | Set.member name names = go1 (i + 1) + | otherwise = name + where + name = mangled i + + mangled :: Integer -> NameSegment + mangled i = + NameSegment (NameSegment.toUnescapedText name0 <> "__" <> tShow i) diff --git a/unison-merge/src/Unison/Merge/Mergeblob0.hs b/unison-merge/src/Unison/Merge/Mergeblob0.hs new file mode 100644 index 0000000000..97fea83cac --- /dev/null +++ b/unison-merge/src/Unison/Merge/Mergeblob0.hs @@ -0,0 +1,32 @@ +module Unison.Merge.Mergeblob0 + ( Mergeblob0 (..), + makeMergeblob0, + ) +where + +import Unison.Merge.ThreeWay (ThreeWay) +import Unison.Name (Name) +import Unison.NameSegment (NameSegment) +import Unison.Prelude +import Unison.Reference (TypeReference) +import Unison.Referent (Referent) +import Unison.Util.BiMultimap (BiMultimap) +import Unison.Util.Defns (Defns, DefnsF) +import Unison.Util.Nametree (Nametree, flattenNametrees) + +data Mergeblob0 libdep = Mergeblob0 + { defns :: ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)), + libdeps :: ThreeWay (Map NameSegment libdep), + nametrees :: ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) + } + +makeMergeblob0 :: + ThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) -> + ThreeWay (Map NameSegment libdep) -> + Mergeblob0 libdep +makeMergeblob0 nametrees libdeps = + Mergeblob0 + { defns = flattenNametrees <$> nametrees, + libdeps, + nametrees + } diff --git a/unison-merge/src/Unison/Merge/Mergeblob1.hs b/unison-merge/src/Unison/Merge/Mergeblob1.hs new file mode 100644 index 0000000000..aef0ec7973 --- /dev/null +++ b/unison-merge/src/Unison/Merge/Mergeblob1.hs @@ -0,0 +1,143 @@ +module Unison.Merge.Mergeblob1 + ( Mergeblob1 (..), + makeMergeblob1, + ) +where + +import Data.List qualified as List +import Data.Map.Strict qualified as Map +import Unison.DataDeclaration (Decl) +import Unison.DataDeclaration qualified as DataDeclaration +import Unison.DeclNameLookup (DeclNameLookup) +import Unison.Merge.CombineDiffs (CombinedDiffOp, combineDiffs) +import Unison.Merge.DeclCoherencyCheck (IncoherentDeclReason, checkDeclCoherency, lenientCheckDeclCoherency) +import Unison.Merge.Diff (nameBasedNamespaceDiff) +import Unison.Merge.DiffOp (DiffOp) +import Unison.Merge.EitherWay (EitherWay (..)) +import Unison.Merge.Libdeps (LibdepDiffOp, applyLibdepsDiff, diffLibdeps, getTwoFreshLibdepNames) +import Unison.Merge.Mergeblob0 (Mergeblob0 (..)) +import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup) +import Unison.Merge.PartitionCombinedDiffs (partitionCombinedDiffs) +import Unison.Merge.Synhashed (Synhashed) +import Unison.Merge.ThreeWay (ThreeWay) +import Unison.Merge.ThreeWay qualified as ThreeWay +import Unison.Merge.TwoWay (TwoWay (..)) +import Unison.Merge.Unconflicts (Unconflicts) +import Unison.Name (Name) +import Unison.NameSegment (NameSegment) +import Unison.Parser.Ann (Ann) +import Unison.Prelude +import Unison.Reference (TermReference, TermReferenceId, TypeReference, TypeReferenceId) +import Unison.Referent (Referent) +import Unison.Symbol (Symbol) +import Unison.Term (Term) +import Unison.Type (Type) +import Unison.Util.BiMultimap (BiMultimap) +import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2, DefnsF3) + +data Mergeblob1 libdep = Mergeblob1 + { conflicts :: TwoWay (DefnsF (Map Name) TermReference TypeReference), + declNameLookups :: TwoWay DeclNameLookup, + defns :: ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)), + diff :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference, + diffs :: TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference), + hydratedDefns :: + ThreeWay + ( DefnsF + (Map Name) + (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) + (TypeReferenceId, Decl Symbol Ann) + ), + lcaDeclNameLookup :: PartialDeclNameLookup, + libdeps :: Map NameSegment libdep, + libdepsDiff :: Map NameSegment (LibdepDiffOp libdep), + lcaLibdeps :: Map NameSegment libdep, + unconflicts :: DefnsF Unconflicts Referent TypeReference + } + +makeMergeblob1 :: + forall libdep. + (Eq libdep) => + Mergeblob0 libdep -> + ThreeWay + ( DefnsF + (Map Name) + (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) + (TypeReferenceId, Decl Symbol Ann) + ) -> + Either (EitherWay IncoherentDeclReason) (Mergeblob1 libdep) +makeMergeblob1 blob hydratedDefns = do + -- Make one big constructor count lookup for all type decls + let numConstructors = + Map.empty + & f (Map.elems hydratedDefns.alice.types) + & f (Map.elems hydratedDefns.bob.types) + & f (Map.elems hydratedDefns.lca.types) + where + f :: [(TypeReferenceId, Decl Symbol Ann)] -> Map TypeReferenceId Int -> Map TypeReferenceId Int + f types acc = + List.foldl' + ( \acc (ref, decl) -> + Map.insert ref (DataDeclaration.constructorCount (DataDeclaration.asDataDecl decl)) acc + ) + acc + types + + -- Make Alice/Bob decl name lookups, which can fail if either have an incoherent decl + declNameLookups <- do + alice <- checkDeclCoherency blob.nametrees.alice numConstructors & mapLeft Alice + bob <- checkDeclCoherency blob.nametrees.bob numConstructors & mapLeft Bob + pure TwoWay {alice, bob} + + -- Make LCA decl name lookup + let lcaDeclNameLookup = + lenientCheckDeclCoherency blob.nametrees.lca numConstructors + + -- Diff LCA->Alice and LCA->Bob + let diffs = + nameBasedNamespaceDiff + declNameLookups + lcaDeclNameLookup + blob.defns + Defns + { terms = + foldMap + (List.foldl' (\acc (ref, (term, _)) -> Map.insert ref term acc) Map.empty . Map.elems . (.terms)) + hydratedDefns, + types = + foldMap + (List.foldl' (\acc (ref, typ) -> Map.insert ref typ acc) Map.empty . Map.elems . (.types)) + hydratedDefns + } + + -- Combine the LCA->Alice and LCA->Bob diffs together + let diff = + combineDiffs diffs + + -- Partition the combined diff into the conflicted things and the unconflicted things + let (conflicts, unconflicts) = + partitionCombinedDiffs (ThreeWay.forgetLca blob.defns) declNameLookups diff + + -- Diff and merge libdeps + let libdepsDiff :: Map NameSegment (LibdepDiffOp libdep) + libdepsDiff = + diffLibdeps blob.libdeps + + let libdeps :: Map NameSegment libdep + libdeps = + applyLibdepsDiff getTwoFreshLibdepNames blob.libdeps libdepsDiff + + pure + Mergeblob1 + { conflicts, + declNameLookups, + defns = blob.defns, + diff, + diffs, + hydratedDefns, + lcaDeclNameLookup, + libdeps, + libdepsDiff, + lcaLibdeps = blob.libdeps.lca, + unconflicts + } diff --git a/unison-merge/src/Unison/Merge/Mergeblob2.hs b/unison-merge/src/Unison/Merge/Mergeblob2.hs new file mode 100644 index 0000000000..629d8d2146 --- /dev/null +++ b/unison-merge/src/Unison/Merge/Mergeblob2.hs @@ -0,0 +1,145 @@ +module Unison.Merge.Mergeblob2 + ( Mergeblob2 (..), + Mergeblob2Error (..), + makeMergeblob2, + ) +where + +import Data.List qualified as List +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Unison.ConstructorReference (GConstructorReference (..)) +import Unison.DataDeclaration (Decl) +import Unison.DeclNameLookup (DeclNameLookup) +import Unison.Merge.EitherWay (EitherWay (..)) +import Unison.Merge.FindConflictedAlias (findConflictedAlias) +import Unison.Merge.Mergeblob1 (Mergeblob1 (..)) +import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup) +import Unison.Merge.PartitionCombinedDiffs (narrowConflictsToNonBuiltins) +import Unison.Merge.ThreeWay (ThreeWay) +import Unison.Merge.ThreeWay qualified as ThreeWay +import Unison.Merge.TwoWay (TwoWay (..)) +import Unison.Merge.TwoWay qualified as TwoWay +import Unison.Merge.Unconflicts (Unconflicts) +import Unison.Merge.Unconflicts qualified as Unconflicts +import Unison.Name (Name) +import Unison.NameSegment (NameSegment) +import Unison.Parser.Ann (Ann) +import Unison.Prelude +import Unison.Reference (TermReference, TermReferenceId, TypeReference, TypeReferenceId) +import Unison.Reference qualified as Reference +import Unison.Referent (Referent) +import Unison.Referent qualified as Referent +import Unison.Symbol (Symbol) +import Unison.Term (Term) +import Unison.Type (Type) +import Unison.Util.BiMultimap (BiMultimap) +import Unison.Util.BiMultimap qualified as BiMultimap +import Unison.Util.Defn (Defn) +import Unison.Util.Defns (Defns (..), DefnsF, defnsAreEmpty, zipDefnsWith) + +data Mergeblob2 libdep = Mergeblob2 + { conflicts :: TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId), + coreDependencies :: TwoWay (DefnsF Set TermReference TypeReference), + declNameLookups :: TwoWay DeclNameLookup, + defns :: ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)), + hasConflicts :: Bool, + hydratedDefns :: + ThreeWay + ( DefnsF + (Map Name) + (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) + (TypeReferenceId, Decl Symbol Ann) + ), + lcaDeclNameLookup :: PartialDeclNameLookup, + lcaLibdeps :: Map NameSegment libdep, + libdeps :: Map NameSegment libdep, + soloUpdatesAndDeletes :: TwoWay (DefnsF Set Name Name), + unconflicts :: DefnsF Unconflicts Referent TypeReference + } + +data Mergeblob2Error + = Mergeblob2Error'ConflictedAlias (EitherWay (Defn (Name, Name) (Name, Name))) + | Mergeblob2Error'ConflictedBuiltin (Defn Name Name) + +makeMergeblob2 :: Mergeblob1 libdep -> Either Mergeblob2Error (Mergeblob2 libdep) +makeMergeblob2 blob = do + -- Bail early if it looks like we can't proceed with the merge, because Alice or Bob has one or more conflicted alias + for_ ((,) <$> TwoWay Alice Bob <*> blob.diffs) \(who, diff) -> + whenJust (findConflictedAlias blob.defns.lca diff) $ + Left . Mergeblob2Error'ConflictedAlias . who + + conflicts <- narrowConflictsToNonBuiltins blob.conflicts & mapLeft Mergeblob2Error'ConflictedBuiltin + + let soloUpdatesAndDeletes :: TwoWay (DefnsF Set Name Name) + soloUpdatesAndDeletes = + Unconflicts.soloUpdatesAndDeletes blob.unconflicts + + let coreDependencies :: TwoWay (DefnsF Set TermReference TypeReference) + coreDependencies = + identifyCoreDependencies + (ThreeWay.forgetLca blob.defns) + (bimap (Set.fromList . Map.elems) (Set.fromList . Map.elems) <$> conflicts) + soloUpdatesAndDeletes + + pure + Mergeblob2 + { conflicts, + coreDependencies, + declNameLookups = blob.declNameLookups, + defns = blob.defns, + -- Eh, they'd either both be null, or neither, but just check both maps anyway + hasConflicts = not (defnsAreEmpty conflicts.alice) || not (defnsAreEmpty conflicts.bob), + hydratedDefns = blob.hydratedDefns, + lcaDeclNameLookup = blob.lcaDeclNameLookup, + lcaLibdeps = blob.lcaLibdeps, + libdeps = blob.libdeps, + soloUpdatesAndDeletes, + unconflicts = blob.unconflicts + } + +identifyCoreDependencies :: + TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> + TwoWay (DefnsF Set TermReferenceId TypeReferenceId) -> + TwoWay (DefnsF Set Name Name) -> + TwoWay (DefnsF Set TermReference TypeReference) +identifyCoreDependencies defns conflicts soloUpdatesAndDeletes = do + fold + [ -- One source of dependencies: Alice's versions of Bob's unconflicted deletes and updates, and vice-versa. + -- + -- This is name-based: if Bob updates the *name* "foo", then we go find the thing that Alice calls "foo" (if + -- anything), no matter what its hash is. + defnsReferences + <$> ( zipDefnsWith BiMultimap.restrictRan BiMultimap.restrictRan + <$> TwoWay.swap soloUpdatesAndDeletes + <*> defns + ), + -- The other source of dependencies: Alice's own conflicted things, and ditto for Bob. + -- + -- An example: suppose Alice has foo#alice and Bob has foo#bob, so foo is conflicted. Furthermore, suppose + -- Alice has bar#bar that depends on foo#alice. + -- + -- We want Alice's #alice to be considered a dependency, so that when we go off and find dependents of these + -- dependencies to put in the scratch file for type checking and propagation, we find bar#bar. + -- + -- Note that this is necessary even if bar#bar is unconflicted! We don't want bar#bar to be put directly + -- into the namespace / parsing context for the conflicted merge, because it has an unnamed reference on + -- foo#alice. It rather ought to be in the scratchfile alongside the conflicted foo#alice and foo#bob, so + -- that when that conflict is resolved, it will propagate to bar. + bimap (Set.map Reference.DerivedId) (Set.map Reference.DerivedId) <$> conflicts + ] + +defnsReferences :: + Defns (BiMultimap Referent name) (BiMultimap TypeReference name) -> + DefnsF Set TermReference TypeReference +defnsReferences defns = + List.foldl' f Defns {terms = Set.empty, types = BiMultimap.dom defns.types} (Set.toList (BiMultimap.dom defns.terms)) + where + f :: DefnsF Set TermReference TypeReference -> Referent -> DefnsF Set TermReference TypeReference + f acc = \case + Referent.Con (ConstructorReference ref _) _ -> + let !types = Set.insert ref acc.types + in Defns {terms = acc.terms, types} + Referent.Ref ref -> + let !terms = Set.insert ref acc.terms + in Defns {terms, types = acc.types} diff --git a/unison-merge/src/Unison/Merge/Mergeblob3.hs b/unison-merge/src/Unison/Merge/Mergeblob3.hs new file mode 100644 index 0000000000..dfb6a795f6 --- /dev/null +++ b/unison-merge/src/Unison/Merge/Mergeblob3.hs @@ -0,0 +1,516 @@ +module Unison.Merge.Mergeblob3 + ( Mergeblob3 (..), + makeMergeblob3, + ) +where + +import Control.Lens (mapped) +import Data.Align (align) +import Data.Bifoldable (bifoldMap) +import Data.List qualified as List +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Set.NonEmpty (NESet) +import Data.Set.NonEmpty qualified as Set.NonEmpty +import Data.Text qualified as Text +import Data.These (These (..)) +import Data.Zip (unzip) +import Unison.DataDeclaration (Decl) +import Unison.DataDeclaration qualified as DataDeclaration +import Unison.DeclNameLookup (DeclNameLookup (..), expectConstructorNames) +import Unison.DeclNameLookup qualified as DeclNameLookup +import Unison.Merge.Mergeblob2 (Mergeblob2 (..)) +import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..)) +import Unison.Merge.ThreeWay (ThreeWay (..)) +import Unison.Merge.ThreeWay qualified as ThreeWay +import Unison.Merge.TwoWay (TwoWay) +import Unison.Merge.TwoWay qualified as TwoWay +import Unison.Merge.Unconflicts (Unconflicts) +import Unison.Merge.Unconflicts qualified as Unconflicts +import Unison.Name (Name) +import Unison.Names (Names (..)) +import Unison.Names qualified as Names +import Unison.Parser.Ann (Ann) +import Unison.Prelude +import Unison.PrettyPrintEnv.Names qualified as PPE +import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl) +import Unison.PrettyPrintEnvDecl.Names qualified as PPED +import Unison.Reference (Reference' (..), TermReferenceId, TypeReference, TypeReferenceId) +import Unison.Referent (Referent) +import Unison.Referent qualified as Referent +import Unison.Symbol (Symbol) +import Unison.Syntax.FilePrinter (renderDefnsForUnisonFile) +import Unison.Syntax.Name qualified as Name +import Unison.Term (Term) +import Unison.Type (Type) +import Unison.Util.BiMultimap (BiMultimap) +import Unison.Util.BiMultimap qualified as BiMultimap +import Unison.Util.Defns (Defns (..), DefnsF, defnsAreEmpty, zipDefnsWith, zipDefnsWith3, zipDefnsWith4) +import Unison.Util.Pretty (ColorText, Pretty) +import Unison.Util.Pretty qualified as Pretty +import Unison.Util.Relation qualified as Relation +import Prelude hiding (unzip) + +data Mergeblob3 = Mergeblob3 + { libdeps :: Names, + stageOne :: DefnsF (Map Name) Referent TypeReference, + stageTwo :: DefnsF (Map Name) Referent TypeReference, + uniqueTypeGuids :: Map Name Text, + -- `unparsedFile` (no mergetool) xor `unparsedSoloFiles` (yes mergetool) are ultimately given to the user + unparsedFile :: Pretty ColorText, + unparsedSoloFiles :: ThreeWay (Pretty ColorText) + } + +makeMergeblob3 :: + Mergeblob2 libdep -> + TwoWay (DefnsF Set TermReferenceId TypeReferenceId) -> + Names -> + Names -> + TwoWay Text -> + Mergeblob3 +makeMergeblob3 blob dependents0 libdeps lcaLibdeps authors = + let conflictsNames :: TwoWay (DefnsF Set Name Name) + conflictsNames = + bimap Map.keysSet Map.keysSet <$> blob.conflicts + + -- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if + -- there aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are) + dependents :: TwoWay (DefnsF Set Name Name) + dependents = + filterDependents + conflictsNames + blob.soloUpdatesAndDeletes + ( let f :: Set TermReferenceId -> Referent -> NESet Name -> Set Name + f deps defn0 names + | Just defn <- Referent.toTermReferenceId defn0, + Set.member defn deps = + Set.NonEmpty.toSet names + | otherwise = Set.empty + g :: Set TypeReferenceId -> TypeReference -> NESet Name -> Set Name + g deps defn0 names + | ReferenceDerived defn <- defn0, + Set.member defn deps = + Set.NonEmpty.toSet names + | otherwise = Set.empty + in zipDefnsWith + (\defns deps -> Map.foldMapWithKey (f deps) (BiMultimap.domain defns)) + (\defns deps -> Map.foldMapWithKey (g deps) (BiMultimap.domain defns)) + <$> ThreeWay.forgetLca blob.defns + <*> dependents0 + ) + + ppe :: PrettyPrintEnvDecl + ppe = + makePrettyPrintEnv + (defnsToNames <$> blob.defns) + libdeps + lcaLibdeps + + renderedConflicts :: TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) + renderedDependents :: TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) + (renderedConflicts, renderedDependents) = + renderConflictsAndDependents + blob.declNameLookups + (ThreeWay.forgetLca blob.hydratedDefns) + conflictsNames + dependents + ppe + + renderedLcaConflicts :: DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText) + renderedLcaConflicts = + renderLcaConflicts + blob.lcaDeclNameLookup + blob.hydratedDefns.lca + conflictsNames + ppe + in Mergeblob3 + { libdeps, + stageOne = + makeStageOne + blob.declNameLookups + conflictsNames + blob.unconflicts + dependents + (bimap BiMultimap.range BiMultimap.range blob.defns.lca), + uniqueTypeGuids = makeUniqueTypeGuids (ThreeWay.forgetLca blob.hydratedDefns), + stageTwo = + makeStageTwo + blob.declNameLookups + conflictsNames + blob.unconflicts + dependents + (bimap BiMultimap.range BiMultimap.range <$> blob.defns), + unparsedFile = makePrettyUnisonFile authors renderedConflicts renderedDependents, + unparsedSoloFiles = + ThreeWay + { alice = renderedConflicts.alice, + bob = renderedConflicts.bob, + lca = renderedLcaConflicts + } + <&> \conflicts -> makePrettySoloUnisonFile conflicts renderedDependents + } + +filterDependents :: + (Ord name) => + TwoWay (DefnsF Set name name) -> + TwoWay (DefnsF Set name name) -> + TwoWay (DefnsF Set name name) -> + TwoWay (DefnsF Set name name) +filterDependents conflicts soloUpdatesAndDeletes dependents0 = + -- There is some subset of Alice's dependents (and ditto for Bob of course) that we don't ultimately want/need to put + -- into the scratch file: those for which any of the following are true: + -- + -- 1. It is Alice-conflicted (since we only want to return *unconflicted* things). + -- 2. It was deleted by Bob. + -- 3. It was updated by Bob and not updated by Alice. + let dependents1 = + zipDefnsWith Set.difference Set.difference + <$> dependents0 + <*> (conflicts <> TwoWay.swap soloUpdatesAndDeletes) + + -- Of the remaining dependents, it's still possible that the maps are not disjoint. But whenever the same name key + -- exists in Alice's and Bob's dependents, the value will either be equal (by Unison hash)... + -- + -- { alice = { terms = {"foo" => #alice} } } + -- { bob = { terms = {"foo" => #alice} } } + -- + -- ...or synhash-equal (i.e. the term or type received different auto-propagated updates)... + -- + -- { alice = { terms = {"foo" => #alice} } } + -- { bob = { terms = {"foo" => #bob} } } + -- + -- So, we can arbitrarily keep Alice's, because they will render the same. + -- + -- { alice = { terms = {"foo" => #alice} } } + -- { bob = { terms = {} } } + dependents2 = + dependents1 & over #bob \bob -> + zipDefnsWith Set.difference Set.difference bob dependents1.alice + in dependents2 + +makeStageOne :: + TwoWay DeclNameLookup -> + TwoWay (DefnsF Set Name Name) -> + DefnsF Unconflicts term typ -> + TwoWay (DefnsF Set Name Name) -> + DefnsF (Map Name) term typ -> + DefnsF (Map Name) term typ +makeStageOne declNameLookups conflicts unconflicts dependents = + zipDefnsWith3 makeStageOneV makeStageOneV unconflicts (f conflicts <> f dependents) + where + f :: TwoWay (DefnsF Set Name Name) -> DefnsF Set Name Name + f defns = + fold (refIdsToNames <$> declNameLookups <*> defns) + +makeStageOneV :: Unconflicts v -> Set Name -> Map Name v -> Map Name v +makeStageOneV unconflicts namesToDelete = + (`Map.withoutKeys` namesToDelete) . Unconflicts.apply unconflicts + +makeStageTwo :: + forall term typ. + TwoWay DeclNameLookup -> + TwoWay (DefnsF Set Name Name) -> + DefnsF Unconflicts term typ -> + TwoWay (DefnsF Set Name Name) -> + ThreeWay (DefnsF (Map Name) term typ) -> + DefnsF (Map Name) term typ +makeStageTwo declNameLookups conflicts unconflicts dependents defns = + zipDefnsWith4 makeStageTwoV makeStageTwoV defns.lca aliceBiasedDependents unconflicts aliceConflicts + where + aliceConflicts :: DefnsF (Map Name) term typ + aliceConflicts = + zipDefnsWith + (\defns conflicts -> Map.restrictKeys defns (conflicts <> aliceConstructorsOfTypeConflicts)) + Map.restrictKeys + defns.alice + conflicts.alice + + aliceConstructorsOfTypeConflicts :: Set Name + aliceConstructorsOfTypeConflicts = + foldMap + (Set.fromList . DeclNameLookup.expectConstructorNames declNameLookups.alice) + conflicts.alice.types + + aliceBiasedDependents :: DefnsF (Map Name) term typ + aliceBiasedDependents = + TwoWay.twoWay + (zipDefnsWith (Map.unionWith const) (Map.unionWith const)) + (zipDefnsWith Map.restrictKeys Map.restrictKeys <$> ThreeWay.forgetLca defns <*> dependents) + +makeStageTwoV :: Map Name v -> Map Name v -> Unconflicts v -> Map Name v -> Map Name v +makeStageTwoV lca dependents unconflicts conflicts = + Map.unionWith const conflicts (Unconflicts.apply unconflicts (Map.unionWith const dependents lca)) + +-- Given just named term/type reference ids, fill out all names that occupy the term and type namespaces. This is simply +-- the given names plus all of the types' constructors. +-- +-- For example, if the input is +-- +-- declNameLookup = { +-- "Maybe" => ["Maybe.Nothing", "Maybe.Just"] +-- } +-- defns = { +-- terms = { "foo" => #foo } +-- types = { "Maybe" => #Maybe } +-- } +-- +-- then the output is +-- +-- defns = { +-- terms = { "foo", "Maybe.Nothing", "Maybe.Just" } +-- types = { "Maybe" } +-- } +refIdsToNames :: DeclNameLookup -> DefnsF Set Name Name -> DefnsF Set Name Name +refIdsToNames declNameLookup = + bifoldMap goTerms goTypes + where + goTerms :: Set Name -> DefnsF Set Name Name + goTerms terms = + Defns {terms, types = Set.empty} + + goTypes :: Set Name -> DefnsF Set Name Name + goTypes types = + Defns + { terms = foldMap (Set.fromList . expectConstructorNames declNameLookup) types, + types + } + +renderConflictsAndDependents :: + TwoWay DeclNameLookup -> + TwoWay (DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann)) -> + TwoWay (DefnsF Set Name Name) -> + TwoWay (DefnsF Set Name Name) -> + PrettyPrintEnvDecl -> + ( TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)), + TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) + ) +renderConflictsAndDependents declNameLookups hydratedDefns conflicts dependents ppe = + unzip $ + ( \declNameLookup (conflicts, dependents) -> + let render = renderDefnsForUnisonFile declNameLookup ppe . over (#terms . mapped) snd + in (render conflicts, render dependents) + ) + <$> declNameLookups + <*> hydratedConflictsAndDependents + where + hydratedConflictsAndDependents :: + TwoWay + ( DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann), + DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann) + ) + hydratedConflictsAndDependents = + ( \as bs cs -> + ( zipDefnsWith Map.restrictKeys Map.restrictKeys as bs, + zipDefnsWith Map.restrictKeys Map.restrictKeys as cs + ) + ) + <$> hydratedDefns + <*> conflicts + <*> dependents + +renderLcaConflicts :: + PartialDeclNameLookup -> + DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann) -> + TwoWay (DefnsF Set Name Name) -> + PrettyPrintEnvDecl -> + DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText) +renderLcaConflicts partialDeclNameLookup hydratedDefns conflicts ppe = + let hydratedConflicts = zipDefnsWith Map.restrictKeys Map.restrictKeys hydratedDefns (fold conflicts) + in renderDefnsForUnisonFile declNameLookup ppe (over (#terms . mapped) snd hydratedConflicts) + where + -- We allow the LCA of a merge to have missing constructor names, yet we do need to render *something* in a file + -- for a mergetool (if one is configured). So, we make the partial decl name lookup total by making bogus + -- constructor names as necessary. + declNameLookup :: DeclNameLookup + declNameLookup = + DeclNameLookup + { constructorToDecl = partialDeclNameLookup.constructorToDecl, + declToConstructors = + makeTotal <$> partialDeclNameLookup.declToConstructors + } + where + makeTotal :: [Maybe Name] -> [Name] + makeTotal names0 = + case sequence names0 of + Just names -> names + Nothing -> + snd $ + List.mapAccumL + makeSomethingUp + (foldMap (maybe Set.empty Set.singleton) names0) + names0 + where + makeSomethingUp :: Set Name -> Maybe Name -> (Set Name, Name) + makeSomethingUp taken = \case + Just name -> (taken, name) + Nothing -> + let name = freshen 0 "Unnamed" + !taken1 = Set.insert name taken + in (taken1, name) + where + freshen :: Int -> Text -> Name + freshen i name0 + | Set.member name taken = freshen (i + 1) name0 + | otherwise = name + where + name :: Name + name = + Name.unsafeParseText (name0 <> if i == 0 then Text.empty else Text.pack (show i)) + +-- Create a PPE that uses Alice's names whenever possible, falling back to Bob's names only when Alice doesn't have any, +-- and falling back to the LCA after that. +-- +-- This results in a file that "looks familiar" to Alice (the one merging in Bob's changes), and avoids superfluous +-- textual conflicts that would arise from preferring Bob's names for Bob's code (where his names differ). +-- +-- The LCA names are not used unless we need to render LCA definitions for a mergetool, but we add them to the PPE in +-- all cases anyway. If this is very expensive, we could consider omitting them in the case that no mergetool is +-- configured. +-- +-- Note that LCA names can make name quality slightly worse. For example, "foo.bar" might exist in the LCA, but deleted +-- in Alice and Bob, and nonetheless prevent some "qux.bar" from rendering as "bar". That seems fine. +makePrettyPrintEnv :: ThreeWay Names -> Names -> Names -> PrettyPrintEnvDecl +makePrettyPrintEnv names libdepsNames lcaLibdeps = + PPED.makePPED + ( PPE.namer + ( Names.preferring + (Names.preferring names.alice names.bob <> libdepsNames) + (names.lca <> lcaLibdeps) + ) + ) + (PPE.suffixifyByName (fold names <> libdepsNames)) + +defnsToNames :: Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> Names +defnsToNames defns = + Names + { terms = Relation.fromMap (BiMultimap.range defns.terms), + types = Relation.fromMap (BiMultimap.range defns.types) + } + +makePrettyUnisonFile :: + TwoWay Text -> + TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) -> + TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) -> + Pretty ColorText +makePrettyUnisonFile authors conflicts dependents = + fold + [ conflicts + -- Merge the two maps together into one, remembering who authored what + & TwoWay.twoWay (zipDefnsWith align align) + -- Sort alphabetically + & inAlphabeticalOrder + -- Render each conflict, types then terms (even though a type can conflict with a term, in which case they + -- would not be adjacent in the file), with an author comment above each conflicted thing + & ( let f = + foldMap \case + This x -> alice x + That y -> bob y + These x y -> alice x <> bob y + where + alice = prettyBinding (Just (Pretty.text authors.alice)) + bob = prettyBinding (Just (Pretty.text authors.bob)) + in bifoldMap f f + ), + -- Show message that delineates where conflicts end and dependents begin only when there are both conflicts and + -- dependents + let thereAre defns = TwoWay.or (not . defnsAreEmpty <$> defns) + in if thereAre conflicts && thereAre dependents + then + fold + [ "-- The definitions below are not conflicted, but they each depend on one or more\n", + "-- conflicted definitions above.\n\n" + ] + else mempty, + makePrettyDependents dependents + ] + where + prettyBinding maybeComment binding = + fold + [ case maybeComment of + Nothing -> mempty + Just comment -> "-- " <> comment <> "\n", + binding, + "\n\n" + ] + +makePrettySoloUnisonFile :: + DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText) -> + TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) -> + Pretty ColorText +makePrettySoloUnisonFile conflicts dependents = + fold + [ conflicts + & inAlphabeticalOrder + & let f = foldMap (<> "\n\n") in bifoldMap f f, + -- Show message that delineates where conflicts end and dependents begin only when there are both conflicts and + -- dependents + if not (defnsAreEmpty conflicts) && TwoWay.or (not . defnsAreEmpty <$> dependents) + then + fold + [ "-- The definitions below are not conflicted, but they each depend on one or more\n", + "-- conflicted definitions.\n\n" + ] + else mempty, + -- Include all dependents when invoking this function with alice/bob/lca conflicts, because we don't want any diff + -- here – we want the mergetool to copy over all dependents after resolving the real conflicts above the fold. + makePrettyDependents dependents + ] + +makePrettyDependents :: TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)) -> Pretty ColorText +makePrettyDependents = + -- Merge dependents together into one map (they are disjoint) + TwoWay.twoWay (zipDefnsWith Map.union Map.union) + >>> + -- Sort alphabetically + inAlphabeticalOrder + -- Render each dependent, types then terms, without bothering to comment attribution + >>> (let f = foldMap (<> "\n\n") in bifoldMap f f) + +inAlphabeticalOrder :: DefnsF (Map Name) a b -> DefnsF [] a b +inAlphabeticalOrder = + bimap f f + where + f = map snd . List.sortOn (Name.toText . fst) . Map.toList + +-- Given Alice's and Bob's hydrated defns, make a mapping from unique type name to unique type GUID, preferring Alice's +-- GUID if they both have one. +makeUniqueTypeGuids :: + TwoWay + ( DefnsF + (Map Name) + (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) + (TypeReferenceId, Decl Symbol Ann) + ) -> + Map Name Text +makeUniqueTypeGuids hydratedDefns = + let -- Start off with just Alice's GUIDs + aliceGuids :: Map Name Text + aliceGuids = + Map.mapMaybe (declGuid . snd) hydratedDefns.alice.types + + -- Define a helper that adds a Bob GUID only if it's not already in the map (so, preferring Alice) + addBobGuid :: Map Name Text -> (Name, (TypeReferenceId, Decl Symbol Ann)) -> Map Name Text + addBobGuid acc (name, (_, bobDecl)) = + Map.alter + ( \case + Nothing -> bobGuid + Just aliceGuid -> Just aliceGuid + ) + name + acc + where + bobGuid :: Maybe Text + bobGuid = + declGuid bobDecl + + -- Tumble in all of Bob's GUIDs with that helper + allTheGuids :: Map Name Text + allTheGuids = + List.foldl' addBobGuid aliceGuids (Map.toList hydratedDefns.bob.types) + in allTheGuids + where + declGuid :: Decl v a -> Maybe Text + declGuid decl = + case (DataDeclaration.asDataDecl decl).modifier of + DataDeclaration.Structural -> Nothing + DataDeclaration.Unique guid -> Just guid diff --git a/unison-merge/src/Unison/Merge/Mergeblob4.hs b/unison-merge/src/Unison/Merge/Mergeblob4.hs new file mode 100644 index 0000000000..fa8f8f0e61 --- /dev/null +++ b/unison-merge/src/Unison/Merge/Mergeblob4.hs @@ -0,0 +1,49 @@ +module Unison.Merge.Mergeblob4 + ( Mergeblob4 (..), + makeMergeblob4, + ) +where + +import Data.Map.Strict qualified as Map +import Unison.Merge.Mergeblob3 (Mergeblob3 (..)) +import Unison.Names (Names (..)) +import Unison.Parser.Ann (Ann) +import Unison.Parsers qualified as Parsers +import Unison.Prelude +import Unison.Reference (TermReference, TypeReference) +import Unison.Symbol (Symbol) +import Unison.Syntax.Parser (ParsingEnv (..)) +import Unison.Syntax.Parser qualified as Parser +import Unison.UnisonFile (UnisonFile) +import Unison.UnisonFile qualified as UnisonFile +import Unison.Util.Defns (Defns (..), DefnsF) +import Unison.Util.Pretty qualified as Pretty +import Unison.Util.Relation qualified as Relation + +data Mergeblob4 = Mergeblob4 + { dependencies :: DefnsF Set TermReference TypeReference, + file :: UnisonFile Symbol Ann + } + +makeMergeblob4 :: Mergeblob3 -> Either (Parser.Err Symbol) Mergeblob4 +makeMergeblob4 blob = do + let stageOneNames = + Names (Relation.fromMap blob.stageOne.terms) (Relation.fromMap blob.stageOne.types) <> blob.libdeps + + parsingEnv = + ParsingEnv + { -- We don't expect to have to generate any new GUIDs, since the uniqueTypeGuid lookup function below should + -- cover all name in the merged file we're about to parse and typecheck. So, this might be more correct as a + -- call to `error`. + uniqueNames = Parser.UniqueName \_ _ -> Nothing, + uniqueTypeGuid = \name -> Identity (Map.lookup name blob.uniqueTypeGuids), + names = stageOneNames, + maybeNamespace = Nothing, + localNamespacePrefixedTypesAndConstructors = mempty + } + file <- runIdentity (Parsers.parseFile "" (Pretty.toPlain 80 blob.unparsedFile) parsingEnv) + Right + Mergeblob4 + { dependencies = UnisonFile.dependencies file, + file + } diff --git a/unison-merge/src/Unison/Merge/Mergeblob5.hs b/unison-merge/src/Unison/Merge/Mergeblob5.hs new file mode 100644 index 0000000000..4390c74838 --- /dev/null +++ b/unison-merge/src/Unison/Merge/Mergeblob5.hs @@ -0,0 +1,33 @@ +module Unison.Merge.Mergeblob5 + ( Mergeblob5 (..), + makeMergeblob5, + ) +where + +import Data.Map.Strict qualified as Map +import Unison.FileParsers qualified as FileParsers +import Unison.Merge.Mergeblob4 (Mergeblob4 (..)) +import Unison.Parser.Ann (Ann) +import Unison.Prelude +import Unison.Result qualified as Result +import Unison.Symbol (Symbol) +import Unison.Typechecker qualified as Typechecker +import Unison.Typechecker.TypeLookup (TypeLookup) +import Unison.UnisonFile (TypecheckedUnisonFile) + +data Mergeblob5 = Mergeblob5 + { file :: TypecheckedUnisonFile Symbol Ann + } + +makeMergeblob5 :: Mergeblob4 -> TypeLookup Symbol Ann -> Either (Seq (Result.Note Symbol Ann)) Mergeblob5 +makeMergeblob5 blob typeLookup = + let typecheckingEnv = + Typechecker.Env + { ambientAbilities = [], + termsByShortname = Map.empty, + typeLookup, + topLevelComponents = Map.empty + } + in case runIdentity (Result.runResultT (FileParsers.synthesizeFile typecheckingEnv blob.file)) of + (Nothing, notes) -> Left notes + (Just file, _) -> Right Mergeblob5 {file} diff --git a/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs b/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs index 5b63f0323e..1f144638bb 100644 --- a/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs +++ b/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs @@ -1,13 +1,14 @@ module Unison.Merge.PartitionCombinedDiffs ( partitionCombinedDiffs, + narrowConflictsToNonBuiltins, ) where import Control.Lens (Lens') import Data.Bitraversable (bitraverse) import Data.Map.Strict qualified as Map +import Unison.DeclNameLookup (DeclNameLookup (..), expectConstructorNames, expectDeclName) import Unison.Merge.CombineDiffs (CombinedDiffOp (..)) -import Unison.Merge.DeclNameLookup (DeclNameLookup (..), expectConstructorNames, expectDeclName) import Unison.Merge.EitherWay (EitherWay (..)) import Unison.Merge.EitherWay qualified as EitherWay import Unison.Merge.EitherWayI (EitherWayI (..)) @@ -27,6 +28,7 @@ import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap +import Unison.Util.Defn (Defn (..)) import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2, defnsAreEmpty) import Unison.Util.Map qualified as Map @@ -35,16 +37,12 @@ partitionCombinedDiffs :: TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> TwoWay DeclNameLookup -> DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> - Either - Name - ( TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId), - DefnsF Unconflicts Referent TypeReference - ) -partitionCombinedDiffs defns declNameLookups diffs = do - let conflicts0 = identifyConflicts declNameLookups defns diffs - let unconflicts = identifyUnconflicts declNameLookups conflicts0 diffs - conflicts <- assertThereAreNoBuiltins conflicts0 - Right (conflicts, unconflicts) + ( TwoWay (DefnsF (Map Name) TermReference TypeReference), + DefnsF Unconflicts Referent TypeReference + ) +partitionCombinedDiffs defns declNameLookups diffs = + let conflicts = identifyConflicts declNameLookups defns diffs + in (conflicts, identifyUnconflicts declNameLookups conflicts diffs) data S = S { me :: !(EitherWay ()), @@ -247,21 +245,20 @@ justTheConflictedNames = CombinedDiffOp'Delete _ -> names CombinedDiffOp'Update _ -> names -assertThereAreNoBuiltins :: +narrowConflictsToNonBuiltins :: TwoWay (DefnsF (Map Name) TermReference TypeReference) -> - Either Name (TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId)) -assertThereAreNoBuiltins = + Either (Defn Name Name) (TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId)) +narrowConflictsToNonBuiltins = traverse (bitraverse (Map.traverseWithKey assertTermIsntBuiltin) (Map.traverseWithKey assertTypeIsntBuiltin)) where - assertTermIsntBuiltin :: Name -> TermReference -> Either Name TermReferenceId + assertTermIsntBuiltin :: Name -> TermReference -> Either (Defn Name Name) TermReferenceId assertTermIsntBuiltin name ref = case Reference.toId ref of - Nothing -> Left name + Nothing -> Left (TermDefn name) Just refId -> Right refId - -- Same body as above, but could be different some day (e.g. return value tells you what namespace) - assertTypeIsntBuiltin :: Name -> TypeReference -> Either Name TypeReferenceId + assertTypeIsntBuiltin :: Name -> TypeReference -> Either (Defn Name Name) TypeReferenceId assertTypeIsntBuiltin name ref = case Reference.toId ref of - Nothing -> Left name + Nothing -> Left (TypeDefn name) Just refId -> Right refId diff --git a/unison-merge/src/Unison/Merge/Synhash.hs b/unison-merge/src/Unison/Merge/Synhash.hs index ec28369bfc..c281f0b6a2 100644 --- a/unison-merge/src/Unison/Merge/Synhash.hs +++ b/unison-merge/src/Unison/Merge/Synhash.hs @@ -28,6 +28,8 @@ module Unison.Merge.Synhash ( synhashType, synhashTerm, + synhashBuiltinTerm, + synhashDerivedTerm, synhashBuiltinDecl, synhashDerivedDecl, @@ -56,7 +58,7 @@ import Unison.Pattern qualified as Pattern import Unison.Prelude import Unison.PrettyPrintEnv (PrettyPrintEnv) import Unison.PrettyPrintEnv qualified as PPE -import Unison.Reference (Reference' (..), TypeReferenceId) +import Unison.Reference (Reference' (..), TermReferenceId) import Unison.Reference qualified as V1 import Unison.Referent (Referent) import Unison.Referent qualified as Referent @@ -84,8 +86,8 @@ synhashBuiltinDecl :: Text -> Hash synhashBuiltinDecl name = H.accumulate [isBuiltinTag, isDeclTag, H.Text name] -hashBuiltinTerm :: Text -> Hash -hashBuiltinTerm = +synhashBuiltinTerm :: Text -> Hash +synhashBuiltinTerm = H.accumulate . hashBuiltinTermTokens hashBuiltinTermTokens :: Text -> [Token] @@ -116,8 +118,8 @@ hashConstructorNameToken declName conName = ) in H.Text (Name.toText strippedConName) -hashDerivedTerm :: (Var v) => PrettyPrintEnv -> Term v a -> Hash -hashDerivedTerm ppe term = +synhashDerivedTerm :: (Var v) => PrettyPrintEnv -> Term v a -> Hash +synhashDerivedTerm ppe term = H.accumulate (hashDerivedTermTokens ppe term) hashDerivedTermTokens :: forall a v. (Var v) => PrettyPrintEnv -> Term v a -> [Token] @@ -216,13 +218,13 @@ hashReferentToken ppe = synhashTerm :: forall m v a. (Monad m, Var v) => - (TypeReferenceId -> m (Term v a)) -> + (TermReferenceId -> m (Term v a)) -> PrettyPrintEnv -> V1.TermReference -> m Hash synhashTerm loadTerm ppe = \case - ReferenceBuiltin builtin -> pure (hashBuiltinTerm builtin) - ReferenceDerived ref -> hashDerivedTerm ppe <$> loadTerm ref + ReferenceBuiltin builtin -> pure (synhashBuiltinTerm builtin) + ReferenceDerived ref -> synhashDerivedTerm ppe <$> loadTerm ref hashTermFTokens :: (Var v) => PrettyPrintEnv -> Term.F v a a () -> [Token] hashTermFTokens ppe = \case diff --git a/unison-merge/src/Unison/Merge/Unconflicts.hs b/unison-merge/src/Unison/Merge/Unconflicts.hs index e5411189a1..39d19e4a4b 100644 --- a/unison-merge/src/Unison/Merge/Unconflicts.hs +++ b/unison-merge/src/Unison/Merge/Unconflicts.hs @@ -2,17 +2,18 @@ module Unison.Merge.Unconflicts ( Unconflicts (..), empty, apply, - soloDeletedNames, - soloUpdatedNames, + soloUpdatesAndDeletes, ) where +import Data.Bitraversable (bitraverse) import Data.Map.Strict qualified as Map import Unison.Merge.TwoWay (TwoWay) import Unison.Merge.TwoWayI (TwoWayI (..)) import Unison.Merge.TwoWayI qualified as TwoWayI import Unison.Name (Name) import Unison.Prelude hiding (empty) +import Unison.Util.Defns (DefnsF) data Unconflicts v = Unconflicts { adds :: !(TwoWayI (Map Name v)), @@ -44,6 +45,18 @@ apply unconflicts = applyDeletes = (`Map.withoutKeys` foldMap Map.keysSet unconflicts.deletes) +soloUpdatesAndDeletes :: DefnsF Unconflicts term typ -> TwoWay (DefnsF Set Name Name) +soloUpdatesAndDeletes unconflicts = + unconflictedSoloDeletedNames <> unconflictedSoloUpdatedNames + where + unconflictedSoloDeletedNames :: TwoWay (DefnsF Set Name Name) + unconflictedSoloDeletedNames = + bitraverse soloDeletedNames soloDeletedNames unconflicts + + unconflictedSoloUpdatedNames :: TwoWay (DefnsF Set Name Name) + unconflictedSoloUpdatedNames = + bitraverse soloUpdatedNames soloUpdatedNames unconflicts + soloDeletedNames :: Unconflicts v -> TwoWay (Set Name) soloDeletedNames = fmap Map.keysSet . TwoWayI.forgetBoth . view #deletes diff --git a/unison-merge/unison-merge.cabal b/unison-merge/unison-merge.cabal index 83131b33be..e53e024a67 100644 --- a/unison-merge/unison-merge.cabal +++ b/unison-merge/unison-merge.cabal @@ -17,15 +17,21 @@ source-repository head library exposed-modules: + Unison.Merge Unison.Merge.CombineDiffs - Unison.Merge.Database Unison.Merge.DeclCoherencyCheck - Unison.Merge.DeclNameLookup Unison.Merge.Diff Unison.Merge.DiffOp Unison.Merge.EitherWay Unison.Merge.EitherWayI + Unison.Merge.FindConflictedAlias Unison.Merge.Libdeps + Unison.Merge.Mergeblob0 + Unison.Merge.Mergeblob1 + Unison.Merge.Mergeblob2 + Unison.Merge.Mergeblob3 + Unison.Merge.Mergeblob4 + Unison.Merge.Mergeblob5 Unison.Merge.PartialDeclNameLookup Unison.Merge.PartitionCombinedDiffs Unison.Merge.Synhash @@ -67,6 +73,7 @@ library OverloadedRecordDot OverloadedStrings PatternSynonyms + QuantifiedConstraints RankNTypes ScopedTypeVariables TupleSections @@ -75,39 +82,23 @@ library ghc-options: -Wall build-depends: base - , bimap - , bitvec - , bytestring , containers - , either - , free - , generic-lens , lens - , monad-validate , mtl , nonempty-containers - , safe , semialign , semigroups , text , these , transformers - , unison-codebase - , unison-codebase-sqlite - , unison-codebase-sqlite-hashing-v2 , unison-core , unison-core1 , unison-hash , unison-parser-typechecker , unison-prelude - , unison-sqlite + , unison-pretty-printer , unison-syntax - , unison-util-cache , unison-util-relation - , vector , witch , witherable default-language: Haskell2010 - if !os(windows) - build-depends: - unix diff --git a/unison-runtime/LICENSE b/unison-runtime/LICENSE new file mode 100644 index 0000000000..c45ac9a548 --- /dev/null +++ b/unison-runtime/LICENSE @@ -0,0 +1,19 @@ +Copyright (c) 2013-2021, Unison Computing, public benefit corp and contributors + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/unison-runtime/package.yaml b/unison-runtime/package.yaml new file mode 100644 index 0000000000..e9221c6d3e --- /dev/null +++ b/unison-runtime/package.yaml @@ -0,0 +1,147 @@ +name: unison-runtime +github: unisonweb/unison +copyright: Copyright (C) 2013-2024 Unison Computing, PBC and contributors + +ghc-options: -Wall -funbox-strict-fields -O2 + +flags: + arraychecks: + manual: true + default: false + stackchecks: + manual: true + default: false + +when: + - condition: flag(arraychecks) + cpp-options: -DARRAY_CHECK + - condition: flag(stackchecks) + cpp-options: -DSTACK_CHECK + + +library: + source-dirs: src + when: + - condition: false + other-modules: Paths_unison_runtime + + dependencies: + - asn1-encoding + - asn1-types + - atomic-primops + - base + - binary + - bytes + - bytestring + - cereal + - clock + - containers >= 0.6.3 + - cryptonite + - data-default + - data-memocombinators + - deepseq + - directory + - exceptions + - filepath + - iproute + - lens + - memory + - mmorph + - mtl + - murmur-hash + - network + - network-simple + - network-udp + - pem + - primitive + - process + - raw-strings-qq + - safe-exceptions + - stm + - tagged + - temporary + - text + - time + - tls + - unison-codebase-sqlite + - unison-core + - unison-core1 + - unison-hash + - unison-parser-typechecker + - unison-prelude + - unison-pretty-printer + - unison-syntax + - unison-util-bytes + - unison-util-recursion + - unliftio + - vector + - crypton-x509 + - crypton-x509-store + - crypton-x509-system + +tests: + runtime-tests: + source-dirs: tests + main: Suite.hs + ghc-options: -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0 + when: + - condition: false + other-modules: Paths_unison_parser_typechecker + dependencies: + - base + - bytes + - cereal + - code-page + - containers + - cryptonite + - directory + - easytest + - hedgehog + - filemanip + - filepath + - hex-text + - lens + - megaparsec + - mtl + - primitive + - stm + - text + - unison-core1 + - unison-hash + - unison-util-bytes + - unison-parser-typechecker + - unison-prelude + - unison-pretty-printer + - unison-runtime + - unison-syntax + +default-extensions: + - ApplicativeDo + - BangPatterns + - BlockArguments + - DeriveAnyClass + - DeriveFunctor + - DeriveGeneric + - DeriveTraversable + - DerivingStrategies + - DerivingVia + - DoAndIfThenElse + - DuplicateRecordFields + - FlexibleContexts + - FlexibleInstances + - GeneralizedNewtypeDeriving + - ImportQualifiedPost + - LambdaCase + - MultiParamTypeClasses + - NamedFieldPuns + - OverloadedLabels + - OverloadedRecordDot + - OverloadedStrings + - PatternSynonyms + - RankNTypes + - ScopedTypeVariables + - StandaloneDeriving + - TupleSections + - TypeApplications + - TypeFamilies + - ViewPatterns diff --git a/parser-typechecker/src/Unison/Codebase/Execute.hs b/unison-runtime/src/Unison/Codebase/Execute.hs similarity index 77% rename from parser-typechecker/src/Unison/Codebase/Execute.hs rename to unison-runtime/src/Unison/Codebase/Execute.hs index 788bc5abe1..22b54c6f7d 100644 --- a/parser-typechecker/src/Unison/Codebase/Execute.hs +++ b/unison-runtime/src/Unison/Codebase/Execute.hs @@ -3,16 +3,22 @@ -- -- This allows one to run standalone applications implemented in the Unison -- language. -module Unison.Codebase.Execute where +module Unison.Codebase.Execute + ( execute, + codebaseToCodeLookup, + ) +where import Control.Exception (finally) import Control.Monad.Except import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.Queries qualified as Q +import Unison.Builtin qualified as Builtin import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch +import Unison.Codebase.CodeLookup qualified as CL import Unison.Codebase.MainTerm (getMainTerm) import Unison.Codebase.MainTerm qualified as MainTerm import Unison.Codebase.Path qualified as Path @@ -20,10 +26,13 @@ import Unison.Codebase.ProjectPath (ProjectPathG (..)) import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Runtime (Runtime) import Unison.Codebase.Runtime qualified as Runtime +import Unison.Codebase.Type (Codebase (..)) import Unison.HashQualified qualified as HQ import Unison.Parser.Ann (Ann) +import Unison.Parser.Ann qualified as Parser import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE +import Unison.Runtime.IOSource qualified as IOSource import Unison.Symbol (Symbol) import Unison.Syntax.HashQualified qualified as HQ (toText) import Unison.Util.Pretty qualified as P @@ -51,8 +60,18 @@ execute codebase runtime mainPath = MainTerm.NotFound s -> throwError ("Not found: " <> P.text (HQ.toText s)) MainTerm.BadType s _ -> throwError (P.text (HQ.toText s) <> " is not of type '{IO} ()") MainTerm.Success _ tm _ -> do - let codeLookup = Codebase.toCodeLookup codebase + let codeLookup = codebaseToCodeLookup codebase ppe = PPE.empty (liftIO $ Runtime.evaluateTerm codeLookup ppe runtime tm) >>= \case Left err -> throwError err Right _ -> pure () + +codebaseToCodeLookup :: (MonadIO m) => Codebase m Symbol Parser.Ann -> CL.CodeLookup Symbol m Parser.Ann +codebaseToCodeLookup c = + CL.CodeLookup goGetTerm goGetTypeOfTerm goGetTypeDecl + <> Builtin.codeLookup + <> IOSource.codeLookupM + where + goGetTerm = (Codebase.runTransaction c . getTerm c) + goGetTypeOfTerm = (Codebase.runTransaction c . getTypeOfTermImpl c) + goGetTypeDecl = (Codebase.runTransaction c . getTypeDeclaration c) diff --git a/unison-runtime/src/Unison/Runtime/ANF.hs b/unison-runtime/src/Unison/Runtime/ANF.hs new file mode 100644 index 0000000000..3e06f7dc0b --- /dev/null +++ b/unison-runtime/src/Unison/Runtime/ANF.hs @@ -0,0 +1,2515 @@ +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} + +module Unison.Runtime.ANF + ( minimizeCyclesOrCrash, + pattern TVar, + pattern TLit, + pattern TBLit, + pattern TApp, + pattern TApv, + pattern TCom, + pattern TCon, + pattern TKon, + pattern TReq, + pattern TPrm, + pattern TFOp, + pattern THnd, + pattern TLet, + pattern TLetD, + pattern TFrc, + pattern TLets, + pattern TName, + pattern TBind, + pattern TBinds, + pattern TShift, + pattern TMatch, + CompileExn (..), + internalBug, + Mem (..), + Lit (..), + Cacheability (..), + Direction (..), + SuperNormal (..), + arity, + SuperGroup (..), + arities, + POp (..), + FOp, + close, + saturate, + float, + floatGroup, + lamLift, + lamLiftGroup, + litRef, + inlineAlias, + addDefaultCases, + ANormalF (.., AApv, ACom, ACon, AKon, AReq, APrm, AFOp), + ANormal, + RTag, + CTag, + PackedTag (..), + Tag (..), + GroupRef (..), + Code (..), + ValList, + Value (..), + Cont (..), + BLit (..), + packTags, + unpackTags, + maskTags, + ANFM, + Branched (.., MatchDataCover), + Func (..), + SGEqv (..), + equivocate, + superNormalize, + anfTerm, + codeGroup, + valueTermLinks, + valueLinks, + groupTermLinks, + buildInlineMap, + inline, + foldGroup, + foldGroupLinks, + overGroup, + overGroupLinks, + traverseGroup, + traverseGroupLinks, + normalLinks, + prettyGroup, + prettySuperNormal, + prettyANF, + ) +where + +import Control.Exception (throw) +import Control.Lens (snoc, unsnoc) +import Control.Monad.Reader (ReaderT (..), ask, local) +import Control.Monad.State (MonadState (..), State, gets, modify, runState) +import Data.Bifoldable (Bifoldable (..)) +import Data.Bitraversable (Bitraversable (..)) +import Data.Functor.Compose (Compose (..)) +import Data.List hiding (and, or) +import Data.Map qualified as Map +import Data.Set qualified as Set +import Data.Text qualified as Data.Text +import GHC.Stack (CallStack, callStack) +import Unison.ABT qualified as ABT +import Unison.ABT.Normalized qualified as ABTN +import Unison.Blank (nameb) +import Unison.Builtin.Decls qualified as Ty +import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) +import Unison.Hashing.V2.Convert (hashTermComponentsWithoutTypes) +import Unison.Pattern (SeqOp (..)) +import Unison.Pattern qualified as P +import Unison.Prelude +import Unison.Reference (Id, Reference, Reference' (Builtin, DerivedId)) +import Unison.Referent (Referent, pattern Con, pattern Ref) +import Unison.Runtime.Array qualified as PA +import Unison.Runtime.TypeTags (CTag (..), PackedTag (..), RTag (..), Tag (..), maskTags, packTags, unpackTags) +import Unison.Symbol (Symbol) +import Unison.Term hiding (List, Ref, Text, arity, float, fresh, resolve) +import Unison.Type qualified as Ty +import Unison.Typechecker.Components (minimize') +import Unison.Util.Bytes (Bytes) +import Unison.Util.EnumContainers as EC +import Unison.Util.Pretty qualified as Pretty +import Unison.Util.Text qualified as Util.Text +import Unison.Var (Var, typed) +import Unison.Var qualified as Var +import Prelude hiding (abs, and, or, seq) + +-- For internal errors +data CompileExn = CE CallStack (Pretty.Pretty Pretty.ColorText) + deriving (Show) + +instance Exception CompileExn + +internalBug :: (HasCallStack) => String -> a +internalBug = throw . CE callStack . Pretty.lit . fromString + +closure :: (Var v) => Map v (Set v, Set v) -> Map v (Set v) +closure m0 = trace (snd <$> m0) + where + refs = fst <$> m0 + + expand acc fvs rvs = + fvs <> foldMap (\r -> Map.findWithDefault mempty r acc) rvs + + trace acc + | acc == acc' = acc + | otherwise = trace acc' + where + acc' = Map.intersectionWith (expand acc) acc refs + +expandRec :: + (Var v, Monoid a) => + Set v -> + [(v, Term v a)] -> + [(v, Term v a)] +expandRec keep vbs = mkSub <$> fvl + where + mkSub (v, fvs) = (v, apps' (var mempty v) (var mempty <$> fvs)) + + fvl = + Map.toList + . fmap (Set.toList) + . closure + $ Set.partition (`Set.member` keep) + . ABT.freeVars + <$> Map.fromList vbs + +expandSimple :: + (Var v, Monoid a) => + Set v -> + (v, Term v a) -> + (v, Term v a) +expandSimple keep (v, bnd) = (v, apps' (var a v) evs) + where + a = ABT.annotation bnd + fvs = ABT.freeVars bnd + evs = map (var a) . Set.toList $ Set.difference fvs keep + +abstract :: (Var v) => Set v -> Term v a -> Term v a +abstract keep bnd = lamWithoutBindingAnns a evs bnd + where + a = ABT.annotation bnd + fvs = ABT.freeVars bnd + evs = Set.toList $ Set.difference fvs keep + +enclose :: + (Var v, Monoid a) => + Set v -> + (Set v -> Term v a -> Term v a) -> + Term v a -> + Maybe (Term v a) +enclose keep rec (LetRecNamedTop' top vbs bd) = + Just $ letRec' top lvbs lbd + where + xpnd = expandRec keep' vbs + keep' = Set.union keep . Set.fromList . map fst $ vbs + lvbs = + vbs + <&> \(v, trm) -> + (v, ABT.annotation trm, (rec keep' . abstract keep' . ABT.substs xpnd) trm) + lbd = rec keep' . ABT.substs xpnd $ bd +-- will be lifted, so keep this variable +enclose keep rec (Let1NamedTop' top v b@(unAnn -> LamsNamed' vs bd) e) = + Just . let1' top [(v, lamb)] . rec (Set.insert v keep) $ + ABT.subst v av e + where + (_, av) = expandSimple keep (v, b) + keep' = Set.difference keep $ Set.fromList vs + fvs = ABT.freeVars b + evs = Set.toList $ Set.difference fvs keep + a = ABT.annotation b + lbody = rec keep' bd + annotate tm + | Ann' _ ty <- b = ann a tm ty + | otherwise = tm + lamb = lamWithoutBindingAnns a evs (annotate $ lamWithoutBindingAnns a vs lbody) +enclose keep rec t@(unLamsAnnot -> Just (vs0, mty, vs1, body)) = + Just $ if null evs then lamb else apps' lamb $ map (var a) evs + where + -- remove shadowed variables + keep' = Set.difference keep $ Set.fromList (vs0 ++ vs1) + fvs = ABT.freeVars t + evs = Set.toList $ Set.difference fvs keep + a = ABT.annotation t + lbody = rec keep' body + annotate tm + | Just ty <- mty = ann a tm ty + | otherwise = tm + lamb = lamWithoutBindingAnns a (evs ++ vs0) . annotate . lamWithoutBindingAnns a vs1 $ lbody +enclose keep rec t@(Handle' h body) + | isStructured body = + Just . handle (ABT.annotation t) (rec keep h) $ apps' lamb args + where + fvs = ABT.freeVars body + evs = Set.toList $ Set.difference fvs keep + a = ABT.annotation body + lbody = rec keep body + fv = Var.freshIn fvs $ typed Var.Eta + args + | null evs = [constructor a (ConstructorReference Ty.unitRef 0)] + | otherwise = var a <$> evs + lamb + | null evs = lamWithoutBindingAnns a [fv] lbody + | otherwise = lamWithoutBindingAnns a evs lbody +enclose keep rec t@(Match' s0 cs0) = Just $ match a s cs + where + a = ABT.annotation t + s = rec keep s0 + cs = encloseCase a keep rec <$> cs0 +enclose _ _ _ = Nothing + +encloseCase :: + (Var v, Monoid a) => + a -> + Set v -> + (Set v -> Term v a -> Term v a) -> + MatchCase a (Term v a) -> + MatchCase a (Term v a) +encloseCase a keep rec0 (MatchCase pats guard body) = + MatchCase pats (rec <$> guard) (rec body) + where + rec (ABT.AbsN' vs bd) = + ABT.absChain' ((,) a <$> vs) $ + rec0 (keep `Set.difference` Set.fromList vs) bd + +newtype Prefix v x = Pfx (Map v [v]) deriving (Show) + +instance Functor (Prefix v) where + fmap _ (Pfx m) = Pfx m + +instance (Ord v) => Applicative (Prefix v) where + pure _ = Pfx Map.empty + Pfx ml <*> Pfx mr = Pfx $ Map.unionWith common ml mr + +common :: (Eq v) => [v] -> [v] -> [v] +common (u : us) (v : vs) + | u == v = u : common us vs +common _ _ = [] + +splitPfx :: v -> [Term v a] -> (Prefix v x, [Term v a]) +splitPfx v = first (Pfx . Map.singleton v) . split + where + split (Var' u : as) = first (u :) $ split as + split rest = ([], rest) + +-- Finds the common variable prefixes that function variables are +-- applied to, so that they can be reduced. +prefix :: (Ord v) => Term v a -> Prefix v (Term v a) +prefix = ABT.visit \case + Apps' (Var' u) as -> case splitPfx u as of + (pf, rest) -> Just $ traverse prefix rest *> pf + Var' u -> Just . Pfx $ Map.singleton u [] + _ -> Nothing + +appPfx :: (Ord v) => Prefix v a -> v -> [v] -> [v] +appPfx (Pfx m) v = maybe (const []) common $ Map.lookup v m + +-- Rewrites a term by dropping the first n arguments to every +-- application of `v`. This just assumes such a thing makes sense, as +-- in `beta`, where we've calculated how many arguments to drop by +-- looking at every occurrence of `v`. +dropPrefix :: (Ord v) => (Semigroup a) => v -> Int -> Term v a -> Term v a +dropPrefix _ 0 = id +dropPrefix v n = ABT.visitPure rw + where + rw (Apps' f@(Var' u) as) + | v == u = Just (apps' (var (ABT.annotation f) u) (drop n as)) + rw _ = Nothing + +dropPrefixes :: + (Ord v) => (Semigroup a) => Map v Int -> Term v a -> Term v a +dropPrefixes m = ABT.visitPure rw + where + rw (Apps' f@(Var' u) as) + | Just n <- Map.lookup u m = + Just (apps' (var (ABT.annotation f) u) (drop n as)) + rw _ = Nothing + +-- Performs opposite transformations to those in enclose. Named after +-- the lambda case, which is beta reduction. +beta :: (Var v) => (Monoid a) => (Term v a -> Term v a) -> Term v a -> Maybe (Term v a) +beta rec (LetRecNamedTop' top (fmap (fmap rec) -> vbs) (rec -> bd)) = + Just $ letRec' top lvbs lbd + where + -- Avoid completely reducing a lambda expression, because recursive + -- lets must be guarded. + args (v, LamsNamed' vs Ann' {}) = (v, vs) + args (v, LamsNamed' vs _) = (v, init vs) + args (v, _) = (v, []) + + Pfx m0 = traverse_ (prefix . snd) vbs *> prefix bd + + f ls rs = case common ls rs of + [] -> Nothing + vs -> Just vs + + m = Map.map length $ Map.differenceWith f (Map.fromList $ map args vbs) m0 + lvbs = + vbs <&> \(v, b0) -> (v,ABT.annotation b0,) $ case b0 of + LamsNamed' vs b + | Just n <- Map.lookup v m -> + lamWithoutBindingAnns (ABT.annotation b0) (drop n vs) (dropPrefixes m b) + -- shouldn't happen + b -> dropPrefixes m b + + lbd = dropPrefixes m bd +beta rec (Let1NamedTop' top v l@(LamsNamed' vs bd) (rec -> e)) + | n > 0 = Just $ let1' top [(v, lamb)] (dropPrefix v n e) + | otherwise = Nothing + where + lamb = lamWithoutBindingAnns al (drop n vs) (bd) + al = ABT.annotation l + -- Calculate a maximum number of arguments to drop. + -- Enclosing doesn't create let-bound lambdas, so we + -- should never reduce a lambda to a non-lambda, as that + -- could affect evaluation order. + m + | Ann' _ _ <- bd = length vs + | otherwise = length vs - 1 + n = min m . length $ appPfx (prefix e) v vs +beta rec (Apps' l@(LamsNamed' vs body) as) + | n <- matchVars 0 vs as, + n > 0 = + Just $ apps' (lamWithoutBindingAnns al (drop n vs) (rec body)) (drop n as) + | otherwise = Nothing + where + al = ABT.annotation l + matchVars !n (u : us) (Var' v : as) | u == v = matchVars (1 + n) us as + matchVars n _ _ = n +beta _ _ = Nothing + +isStructured :: (Var v) => Term v a -> Bool +isStructured (Var' _) = False +isStructured (Lam' _) = False +isStructured (Nat' _) = False +isStructured (Int' _) = False +isStructured (Float' _) = False +isStructured (Text' _) = False +isStructured (Char' _) = False +isStructured (Constructor' _) = False +isStructured (Apps' Constructor' {} args) = any isStructured args +isStructured (If' b t f) = + isStructured b || isStructured t || isStructured f +isStructured (And' l r) = isStructured l || isStructured r +isStructured (Or' l r) = isStructured l || isStructured r +isStructured _ = True + +close :: (Var v, Monoid a) => Set v -> Term v a -> Term v a +close keep tm = ABT.visitPure (enclose keep close) tm + +-- Attempts to undo what was done in `close`. Useful for decompiling. +open :: (Var v, Monoid a) => Term v a -> Term v a +open x = ABT.visitPure (beta open) x + +type FloatM v a r = State (Set v, [(v, Term v a)], [(v, Term v a)]) r + +freshFloat :: (Var v) => Set v -> v -> v +freshFloat avoid (Var.freshIn avoid -> v0) = + case Var.typeOf v0 of + Var.User nm + | v <- typed (Var.User $ nm <> w), + v `Set.notMember` avoid -> + v + | otherwise -> + freshFloat (Set.insert v0 avoid) v0 + _ -> v0 + where + w = Data.Text.pack . show $ Var.freshId v0 + +groupFloater :: + (Var v, Monoid a) => + (Term v a -> FloatM v a (Term v a)) -> + [(v, Term v a)] -> + FloatM v a (Map v v) +groupFloater rec vbs = do + cvs <- gets (\(vs, _, _) -> vs) + let shadows = + [ (v, freshFloat cvs v) + | (v, _) <- vbs, + Set.member v cvs + ] + shadowMap = Map.fromList shadows + rn v = Map.findWithDefault v v shadowMap + shvs = Set.fromList $ map (rn . fst) vbs + modify $ \(cvs, ctx, dcmp) -> (cvs <> shvs, ctx, dcmp) + fvbs <- traverse (\(v, b) -> (,) (rn v) <$> rec' (ABT.renames shadowMap b)) vbs + let dvbs = fmap (\(v, b) -> (rn v, deannotate b)) vbs + modify $ \(vs, ctx, dcmp) -> (vs, ctx ++ fvbs, dcmp <> dvbs) + pure shadowMap + where + rec' b + | Just (vs0, mty, vs1, bd) <- unLamsAnnot b = + lamWithoutBindingAnns a vs0 . maybe id (flip $ ann a) mty . lamWithoutBindingAnns a vs1 <$> rec bd + where + a = ABT.annotation b + rec' b = rec b + +letFloater :: + (Var v, Monoid a) => + (Term v a -> FloatM v a (Term v a)) -> + [(v, Term v a)] -> + Term v a -> + FloatM v a (Term v a) +letFloater rec vbs e = do + shadowMap <- groupFloater rec vbs + pure $ ABT.renames shadowMap e + +lamFloater :: + (Var v, Monoid a) => + Bool -> + Term v a -> + Maybe v -> + a -> + [v] -> + Term v a -> + FloatM v a v +lamFloater closed tm mv a vs bd = + state $ \trip@(cvs, ctx, dcmp) -> case find p ctx of + Just (v, _) -> (v, trip) + Nothing -> + let v = ABT.freshIn cvs $ fromMaybe (typed Var.Float) mv + in ( v, + ( Set.insert v cvs, + ctx <> [(v, lamWithoutBindingAnns a vs bd)], + floatDecomp closed v tm dcmp + ) + ) + where + tgt = unannotate (lamWithoutBindingAnns a vs bd) + p (_, flam) = unannotate flam == tgt + +floatDecomp :: + Bool -> v -> Term v a -> [(v, Term v a)] -> [(v, Term v a)] +floatDecomp True v b dcmp = (v, b) : dcmp +floatDecomp False _ _ dcmp = dcmp + +floater :: + (Var v, Monoid a) => + Bool -> + (Term v a -> FloatM v a (Term v a)) -> + Term v a -> + Maybe (FloatM v a (Term v a)) +floater top rec tm0@(Ann' tm ty) = + (fmap . fmap) (\tm -> ann a tm ty) (floater top rec tm) + where + a = ABT.annotation tm0 +floater top rec (LetRecNamed' vbs e) = + Just $ + letFloater rec vbs e >>= \case + lm@(LamsNamed' vs bd) | top -> lamWithoutBindingAnns a vs <$> rec bd + where + a = ABT.annotation lm + tm -> rec tm +floater _ rec (Let1Named' v b e) + | Just (vs0, _, vs1, bd) <- unLamsAnnot b = + Just $ + rec bd + >>= lamFloater True b (Just v) a (vs0 ++ vs1) + >>= \lv -> rec $ ABT.renames (Map.singleton v lv) e + where + a = ABT.annotation b +floater top rec tm@(LamsNamed' vs bd) + | top = Just $ lamWithoutBindingAnns a vs <$> rec bd + | otherwise = Just $ do + bd <- rec bd + lv <- lamFloater True tm Nothing a vs bd + pure $ var a lv + where + a = ABT.annotation tm +floater _ _ _ = Nothing + +postFloat :: + (Var v) => + (Monoid a) => + Map v Reference -> + (Set v, [(v, Term v a)], [(v, Term v a)]) -> + ( [(v, Term v a)], + [(v, Id)], + [(Reference, Term v a)], + [(Reference, Term v a)] + ) +postFloat orig (_, bs, dcmp) = + ( subs, + subvs, + fmap (first DerivedId) tops, + dcmp >>= \(v, tm) -> + let stm = open $ ABT.substs dsubs tm + in (subm Map.! v, stm) : [(r, stm) | Just r <- [Map.lookup v orig]] + ) + where + m = + fmap (fmap deannotate) + . hashTermComponentsWithoutTypes + . Map.fromList + $ bs + trips = Map.toList m + f (v, (id, tm)) = ((v, id), (v, idtm), (id, tm)) + where + idtm = ref (ABT.annotation tm) (DerivedId id) + (subvs, subs, tops) = unzip3 $ map f trips + subm = fmap DerivedId (Map.fromList subvs) + dsubs = Map.toList $ Map.map (ref mempty) orig <> Map.fromList subs + +float :: + (Var v) => + (Monoid a) => + Map v Reference -> + Term v a -> + (Term v a, Map Reference Reference, [(Reference, Term v a)], [(Reference, Term v a)]) +float orig tm = case runState go0 (Set.empty, [], []) of + (bd, st) -> case postFloat orig st of + (subs, subvs, tops, dcmp) -> + ( letRec' True [] . ABT.substs subs . deannotate $ bd, + Map.fromList . mapMaybe f $ subvs, + tops, + dcmp + ) + where + f (v, i) = (,DerivedId i) <$> Map.lookup v orig + go0 = fromMaybe (go tm) (floater True go tm) + go = ABT.visit $ floater False go + +floatGroup :: + (Var v) => + (Monoid a) => + Map v Reference -> + [(v, Term v a)] -> + ([(v, Id)], [(Reference, Term v a)], [(Reference, Term v a)]) +floatGroup orig grp = case runState go0 (Set.empty, [], []) of + (_, st) -> case postFloat orig st of + (_, subvs, tops, dcmp) -> (subvs, tops, dcmp) + where + go = ABT.visit $ floater False go + go0 = groupFloater go grp + +unAnn :: Term v a -> Term v a +unAnn (Ann' tm _) = tm +unAnn tm = tm + +unLamsAnnot :: Term v a -> Maybe ([v], Maybe (Ty.Type v a), [v], Term v a) +unLamsAnnot tm0 + | null vs0, null vs1 = Nothing + | otherwise = Just (vs0, mty, vs1, bd) + where + (vs0, bd0) + | LamsNamed' vs bd <- tm0 = (vs, bd) + | otherwise = ([], tm0) + (mty, bd1) + | Ann' bd ty <- bd0 = (Just ty, bd) + | otherwise = (Nothing, bd0) + (vs1, bd) + | LamsNamed' vs bd <- bd1 = (vs, bd) + | otherwise = ([], bd1) + +deannotate :: (Var v) => Term v a -> Term v a +deannotate = ABT.visitPure $ \case + Ann' c _ -> Just $ deannotate c + _ -> Nothing + +lamLift :: + (Var v) => + (Monoid a) => + Map v Reference -> + Term v a -> + (Term v a, Map Reference Reference, [(Reference, Term v a)], [(Reference, Term v a)]) +lamLift orig = float orig . close Set.empty + +lamLiftGroup :: + (Var v) => + (Monoid a) => + Map v Reference -> + [(v, Term v a)] -> + ([(v, Id)], [(Reference, Term v a)], [(Reference, Term v a)]) +lamLiftGroup orig gr = floatGroup orig . (fmap . fmap) (close keep) $ gr + where + keep = Set.fromList $ map fst gr + +saturate :: + (Var v, Monoid a) => + Map ConstructorReference Int -> + Term v a -> + Term v a +saturate dat = ABT.visitPure $ \case + Apps' f@(Constructor' r) args -> sat r f args + Apps' f@(Request' r) args -> sat r f args + f@(Constructor' r) -> sat r f [] + f@(Request' r) -> sat r f [] + _ -> Nothing + where + frsh avoid _ = + let v = Var.freshIn avoid $ typed Var.Eta + in (Set.insert v avoid, v) + sat r f args = case Map.lookup r dat of + Just n + | m < n, + vs <- snd $ mapAccumL frsh fvs [1 .. n - m], + nargs <- var mempty <$> vs -> + Just . lamWithoutBindingAnns mempty vs . apps' f $ args' ++ nargs + | m > n, + (sargs, eargs) <- splitAt n args', + sv <- Var.freshIn fvs $ typed Var.Eta -> + Just + . let1' False [(sv, apps' f sargs)] + $ apps' (var mempty sv) eargs + _ -> Just (apps' f args') + where + m = length args + fvs = foldMap freeVars args + args' = saturate dat <$> args + +-- Performs inlining on a supergroup using the inlining information +-- in the map. The map can be created from typical SuperGroup data +-- using the `buildInlineMap` function. +inline :: + (Var v) => + Map Reference (Int, ANormal v) -> + SuperGroup v -> + SuperGroup v +inline inls (Rec bs entry) = Rec (fmap go0 <$> bs) (go0 entry) + where + go0 (Lambda ccs body) = Lambda ccs $ go (30 :: Int) body + -- Note: number argument bails out in recursive inlining cases + go n | n <= 0 = id + go n = ABTN.visitPure \case + TApp (FComb r) args + | Just (arity, expr) <- Map.lookup r inls -> + go (n - 1) <$> tweak expr args arity + _ -> Nothing + + tweak (ABTN.TAbss vs body) args arity + -- exactly saturated + | length args == arity, + rn <- Map.fromList (zip vs args) = + Just $ ABTN.renames rn body + -- oversaturated, only makes sense if body is a call + | length args > arity, + (pre, post) <- splitAt arity args, + rn <- Map.fromList (zip vs pre), + TApp f pre <- ABTN.renames rn body = + Just $ TApp f (pre ++ post) + | otherwise = Nothing + +addDefaultCases :: (Var v) => (Monoid a) => Text -> Term v a -> Term v a +addDefaultCases = ABT.visitPure . defaultCaseVisitor + +defaultCaseVisitor :: + (Var v) => (Monoid a) => Text -> Term v a -> Maybe (Term v a) +defaultCaseVisitor func m@(Match' scrut cases) + | scrut <- addDefaultCases func scrut, + cases <- fmap (addDefaultCases func) <$> cases = + Just $ match a scrut (cases ++ [dflt]) + where + a = ABT.annotation m + v = Var.freshIn mempty $ typed Var.Blank + txt = "pattern match failure in function `" <> func <> "`" + msg = text a txt + bu = ref a (Builtin "bug") + dflt = + MatchCase (P.Var a) Nothing + . ABT.abs' a v + $ apps bu [(a, Ty.tupleTerm [msg, var a v])] +defaultCaseVisitor _ _ = Nothing + +inlineAlias :: (Var v) => (Monoid a) => Term v a -> Term v a +inlineAlias = ABT.visitPure $ \case + Let1Named' v b@(Var' _) e -> Just . inlineAlias $ ABT.subst v b e + _ -> Nothing + +minimizeCyclesOrCrash :: (Var v) => Term v a -> Term v a +minimizeCyclesOrCrash t = case minimize' t of + Right t -> t + Left e -> + internalBug $ + "tried to minimize let rec with duplicate definitions: " + ++ show (fst <$> toList e) + +data Mem = UN | BX deriving (Eq, Ord, Show, Enum) + +-- Context entries with evaluation strategy +data CTE v s + = ST (Direction Word16) [v] [Mem] s + | LZ v (Either Reference v) [v] + deriving (Show) + +pattern ST1 :: Direction Word16 -> v -> Mem -> s -> CTE v s +pattern ST1 d v m s = ST d [v] [m] s + +-- All variables, both bound and free occurring in a CTE. This is +-- useful for avoiding both free and bound variables when +-- freshening. +cteVars :: (Ord v) => Cte v -> Set v +cteVars (ST _ vs _ e) = Set.fromList vs `Set.union` ABTN.freeVars e +cteVars (LZ v r as) = Set.fromList (either (const id) (:) r $ v : as) + +data ANormalF v e + = ALet (Direction Word16) [Mem] e e + | AName (Either Reference v) [v] e + | ALit Lit + | ABLit Lit -- direct boxed literal + | AMatch v (Branched e) + | AShift Reference e + | AHnd [Reference] v e + | AApp (Func v) [v] + | AFrc v + | AVar v + deriving (Show, Eq, Functor, Foldable, Traversable) + +instance Bifunctor ANormalF where + bimap f _ (AVar v) = AVar (f v) + bimap _ _ (ALit l) = ALit l + bimap _ _ (ABLit l) = ABLit l + bimap _ g (ALet d m bn bo) = ALet d m (g bn) (g bo) + bimap f g (AName n as bo) = AName (f <$> n) (f <$> as) $ g bo + bimap f g (AMatch v br) = AMatch (f v) $ fmap g br + bimap f g (AHnd rs v e) = AHnd rs (f v) $ g e + bimap _ g (AShift i e) = AShift i $ g e + bimap f _ (AFrc v) = AFrc (f v) + bimap f _ (AApp fu args) = AApp (fmap f fu) $ fmap f args + +instance Bifoldable ANormalF where + bifoldMap f _ (AVar v) = f v + bifoldMap _ _ (ALit _) = mempty + bifoldMap _ _ (ABLit _) = mempty + bifoldMap _ g (ALet _ _ b e) = g b <> g e + bifoldMap f g (AName n as e) = foldMap f n <> foldMap f as <> g e + bifoldMap f g (AMatch v br) = f v <> foldMap g br + bifoldMap f g (AHnd _ h e) = f h <> g e + bifoldMap _ g (AShift _ e) = g e + bifoldMap f _ (AFrc v) = f v + bifoldMap f _ (AApp func args) = foldMap f func <> foldMap f args + +instance ABTN.Align ANormalF where + align f _ (AVar u) (AVar v) = Just $ AVar <$> f u v + align _ _ (ALit l) (ALit r) + | l == r = Just $ pure (ALit l) + align _ _ (ABLit l) (ABLit r) + | l == r = Just $ pure (ABLit l) + align _ g (ALet dl ccl bl el) (ALet dr ccr br er) + | dl == dr, + ccl == ccr = + Just $ ALet dl ccl <$> g bl br <*> g el er + align f g (AName hl asl el) (AName hr asr er) + | length asl == length asr, + Just hs <- alignEither f hl hr = + Just $ + AName + <$> hs + <*> traverse (uncurry f) (zip asl asr) + <*> g el er + align f g (AMatch vl bsl) (AMatch vr bsr) + | Just bss <- alignBranch g bsl bsr = + Just $ AMatch <$> f vl vr <*> bss + align f g (AHnd rl hl bl) (AHnd rr hr br) + | rl == rr = Just $ AHnd rl <$> f hl hr <*> g bl br + align _ g (AShift rl bl) (AShift rr br) + | rl == rr = Just $ AShift rl <$> g bl br + align f _ (AFrc u) (AFrc v) = Just $ AFrc <$> f u v + align f _ (AApp hl asl) (AApp hr asr) + | Just hs <- alignFunc f hl hr, + length asl == length asr = + Just $ AApp <$> hs <*> traverse (uncurry f) (zip asl asr) + align _ _ _ _ = Nothing + +alignEither :: + (Applicative f) => + (l -> r -> f s) -> + Either Reference l -> + Either Reference r -> + Maybe (f (Either Reference s)) +alignEither _ (Left rl) (Left rr) | rl == rr = Just . pure $ Left rl +alignEither f (Right u) (Right v) = Just $ Right <$> f u v +alignEither _ _ _ = Nothing + +alignMaybe :: + (Applicative f) => + (l -> r -> f s) -> + Maybe l -> + Maybe r -> + Maybe (f (Maybe s)) +alignMaybe f (Just l) (Just r) = Just $ Just <$> f l r +alignMaybe _ Nothing Nothing = Just (pure Nothing) +alignMaybe _ _ _ = Nothing + +alignFunc :: + (Applicative f) => + (vl -> vr -> f vs) -> + Func vl -> + Func vr -> + Maybe (f (Func vs)) +alignFunc f (FVar u) (FVar v) = Just $ FVar <$> f u v +alignFunc _ (FComb rl) (FComb rr) | rl == rr = Just . pure $ FComb rl +alignFunc f (FCont u) (FCont v) = Just $ FCont <$> f u v +alignFunc _ (FCon rl tl) (FCon rr tr) + | rl == rr, tl == tr = Just . pure $ FCon rl tl +alignFunc _ (FReq rl tl) (FReq rr tr) + | rl == rr, tl == tr = Just . pure $ FReq rl tl +alignFunc _ (FPrim ol) (FPrim or) + | ol == or = Just . pure $ FPrim ol +alignFunc _ _ _ = Nothing + +alignBranch :: + (Applicative f) => + (el -> er -> f es) -> + Branched el -> + Branched er -> + Maybe (f (Branched es)) +alignBranch _ MatchEmpty MatchEmpty = Just $ pure MatchEmpty +alignBranch f (MatchIntegral bl dl) (MatchIntegral br dr) + | keysSet bl == keysSet br, + Just ds <- alignMaybe f dl dr = + Just $ + MatchIntegral + <$> interverse f bl br + <*> ds +alignBranch f (MatchText bl dl) (MatchText br dr) + | Map.keysSet bl == Map.keysSet br, + Just ds <- alignMaybe f dl dr = + Just $ + MatchText + <$> traverse id (Map.intersectionWith f bl br) + <*> ds +alignBranch f (MatchRequest bl pl) (MatchRequest br pr) + | Map.keysSet bl == Map.keysSet br, + all p (Map.keysSet bl) = + Just $ + MatchRequest + <$> traverse id (Map.intersectionWith (interverse (alignCCs f)) bl br) + <*> f pl pr + where + p r = keysSet hsl == keysSet hsr && all q (keys hsl) + where + hsl = bl Map.! r + hsr = br Map.! r + q t = fst (hsl ! t) == fst (hsr ! t) +alignBranch f (MatchData rfl bl dl) (MatchData rfr br dr) + | rfl == rfr, + keysSet bl == keysSet br, + all (\t -> fst (bl ! t) == fst (br ! t)) (keys bl), + Just ds <- alignMaybe f dl dr = + Just $ MatchData rfl <$> interverse (alignCCs f) bl br <*> ds +alignBranch f (MatchSum bl) (MatchSum br) + | keysSet bl == keysSet br, + all (\w -> fst (bl ! w) == fst (br ! w)) (keys bl) = + Just $ MatchSum <$> interverse (alignCCs f) bl br +alignBranch f (MatchNumeric rl bl dl) (MatchNumeric rr br dr) + | rl == rr, + keysSet bl == keysSet br, + Just ds <- alignMaybe f dl dr = + Just $ + MatchNumeric rl + <$> interverse f bl br + <*> ds +alignBranch _ _ _ = Nothing + +alignCCs :: (Functor f) => (l -> r -> f s) -> (a, l) -> (a, r) -> f (a, s) +alignCCs f (ccs, l) (_, r) = (,) ccs <$> f l r + +matchLit :: Term v a -> Maybe Lit +matchLit (Int' i) = Just $ I i +matchLit (Nat' n) = Just $ N n +matchLit (Float' f) = Just $ F f +matchLit (Text' t) = Just $ T (Util.Text.fromText t) +matchLit (Char' c) = Just $ C c +matchLit _ = Nothing + +pattern TLet :: + (ABT.Var v) => + Direction Word16 -> + v -> + Mem -> + ABTN.Term ANormalF v -> + ABTN.Term ANormalF v -> + ABTN.Term ANormalF v +pattern TLet d v m bn bo = ABTN.TTm (ALet d [m] bn (ABTN.TAbs v bo)) + +pattern TLetD :: + (ABT.Var v) => + v -> + Mem -> + ABTN.Term ANormalF v -> + ABTN.Term ANormalF v -> + ABTN.Term ANormalF v +pattern TLetD v m bn bo = ABTN.TTm (ALet Direct [m] bn (ABTN.TAbs v bo)) + +pattern TLets :: + (ABT.Var v) => + Direction Word16 -> + [v] -> + [Mem] -> + ABTN.Term ANormalF v -> + ABTN.Term ANormalF v -> + ABTN.Term ANormalF v +pattern TLets d vs ms bn bo = ABTN.TTm (ALet d ms bn (ABTN.TAbss vs bo)) + +pattern TName :: + (ABT.Var v) => + v -> + Either Reference v -> + [v] -> + ABTN.Term ANormalF v -> + ABTN.Term ANormalF v +pattern TName v f as bo = ABTN.TTm (AName f as (ABTN.TAbs v bo)) + +pattern Lit' :: Lit -> Term v a +pattern Lit' l <- (matchLit -> Just l) + +pattern TLit :: + (ABT.Var v) => + Lit -> + ABTN.Term ANormalF v +pattern TLit l = ABTN.TTm (ALit l) + +pattern TBLit :: + (ABT.Var v) => + Lit -> + ABTN.Term ANormalF v +pattern TBLit l = ABTN.TTm (ABLit l) + +pattern TApp :: + (ABT.Var v) => + Func v -> + [v] -> + ABTN.Term ANormalF v +pattern TApp f args = ABTN.TTm (AApp f args) + +pattern AApv :: v -> [v] -> ANormalF v e +pattern AApv v args = AApp (FVar v) args + +pattern TApv :: + (ABT.Var v) => + v -> + [v] -> + ABTN.Term ANormalF v +pattern TApv v args = TApp (FVar v) args + +pattern ACom :: Reference -> [v] -> ANormalF v e +pattern ACom r args = AApp (FComb r) args + +pattern TCom :: + (ABT.Var v) => + Reference -> + [v] -> + ABTN.Term ANormalF v +pattern TCom r args = TApp (FComb r) args + +pattern ACon :: Reference -> CTag -> [v] -> ANormalF v e +pattern ACon r t args = AApp (FCon r t) args + +pattern TCon :: + (ABT.Var v) => + Reference -> + CTag -> + [v] -> + ABTN.Term ANormalF v +pattern TCon r t args = TApp (FCon r t) args + +pattern AKon :: v -> [v] -> ANormalF v e +pattern AKon v args = AApp (FCont v) args + +pattern TKon :: + (ABT.Var v) => + v -> + [v] -> + ABTN.Term ANormalF v +pattern TKon v args = TApp (FCont v) args + +pattern AReq :: Reference -> CTag -> [v] -> ANormalF v e +pattern AReq r t args = AApp (FReq r t) args + +pattern TReq :: + (ABT.Var v) => + Reference -> + CTag -> + [v] -> + ABTN.Term ANormalF v +pattern TReq r t args = TApp (FReq r t) args + +pattern APrm :: POp -> [v] -> ANormalF v e +pattern APrm p args = AApp (FPrim (Left p)) args + +pattern TPrm :: + (ABT.Var v) => + POp -> + [v] -> + ABTN.Term ANormalF v +pattern TPrm p args = TApp (FPrim (Left p)) args + +pattern AFOp :: FOp -> [v] -> ANormalF v e +pattern AFOp p args = AApp (FPrim (Right p)) args + +pattern TFOp :: + (ABT.Var v) => + FOp -> + [v] -> + ABTN.Term ANormalF v +pattern TFOp p args = TApp (FPrim (Right p)) args + +pattern THnd :: + (ABT.Var v) => + [Reference] -> + v -> + ABTN.Term ANormalF v -> + ABTN.Term ANormalF v +pattern THnd rs h b = ABTN.TTm (AHnd rs h b) + +pattern TShift :: + (ABT.Var v) => + Reference -> + v -> + ABTN.Term ANormalF v -> + ABTN.Term ANormalF v +pattern TShift i v e = ABTN.TTm (AShift i (ABTN.TAbs v e)) + +pattern TMatch :: + (ABT.Var v) => + v -> + Branched (ABTN.Term ANormalF v) -> + ABTN.Term ANormalF v +pattern TMatch v cs = ABTN.TTm (AMatch v cs) + +pattern TFrc :: (ABT.Var v) => v -> ABTN.Term ANormalF v +pattern TFrc v = ABTN.TTm (AFrc v) + +pattern TVar :: (ABT.Var v) => v -> ABTN.Term ANormalF v +pattern TVar v = ABTN.TTm (AVar v) + +{-# COMPLETE TLet, TName, TVar, TApp, TFrc, TLit, THnd, TShift, TMatch #-} + +{-# COMPLETE + TLet, + TName, + TVar, + TFrc, + TApv, + TCom, + TCon, + TKon, + TReq, + TPrm, + TFOp, + TLit, + THnd, + TShift, + TMatch + #-} + +bind :: (Var v) => Cte v -> ANormal v -> ANormal v +bind (ST d us ms bu) = TLets d us ms bu +bind (LZ u f as) = TName u f as + +unbind :: (Var v) => ANormal v -> Maybe (Cte v, ANormal v) +unbind (TLets d us ms bu bd) = Just (ST d us ms bu, bd) +unbind (TName u f as bd) = Just (LZ u f as, bd) +unbind _ = Nothing + +unbinds :: (Var v) => ANormal v -> ([Cte v], ANormal v) +unbinds (TLets d us ms bu (unbinds -> (ctx, bd))) = + (ST d us ms bu : ctx, bd) +unbinds (TName u f as (unbinds -> (ctx, bd))) = (LZ u f as : ctx, bd) +unbinds tm = ([], tm) + +pattern TBind :: + (Var v) => + Cte v -> + ANormal v -> + ANormal v +pattern TBind bn bd <- + (unbind -> Just (bn, bd)) + where + TBind bn bd = bind bn bd + +pattern TBinds :: (Var v) => [Cte v] -> ANormal v -> ANormal v +pattern TBinds ctx bd <- + (unbinds -> (ctx, bd)) + where + TBinds ctx bd = foldr bind bd ctx + +{-# COMPLETE TBinds #-} + +data SeqEnd = SLeft | SRight + deriving (Eq, Ord, Enum, Show) + +-- Note: MatchNumeric is a new form for matching directly on boxed +-- numeric data. This leaves MatchIntegral around so that builtins can +-- continue to use it. But interchanged code can be free of unboxed +-- details. +data Branched e + = MatchIntegral (EnumMap Word64 e) (Maybe e) + | MatchText (Map.Map Util.Text.Text e) (Maybe e) + | MatchRequest (Map Reference (EnumMap CTag ([Mem], e))) e + | MatchEmpty + | MatchData Reference (EnumMap CTag ([Mem], e)) (Maybe e) + | MatchSum (EnumMap Word64 ([Mem], e)) + | MatchNumeric Reference (EnumMap Word64 e) (Maybe e) + deriving (Show, Eq, Functor, Foldable, Traversable) + +-- Data cases expected to cover all constructors +pattern MatchDataCover :: Reference -> EnumMap CTag ([Mem], e) -> Branched e +pattern MatchDataCover r m = MatchData r m Nothing + +data BranchAccum v + = AccumEmpty + | AccumIntegral + Reference + (Maybe (ANormal v)) + (EnumMap Word64 (ANormal v)) + | AccumText + (Maybe (ANormal v)) + (Map.Map Util.Text.Text (ANormal v)) + | AccumDefault (ANormal v) + | AccumPure (ANormal v) + | AccumRequest + (Map Reference (EnumMap CTag ([Mem], ANormal v))) + (Maybe (ANormal v)) + | AccumData + Reference + (Maybe (ANormal v)) + (EnumMap CTag ([Mem], ANormal v)) + | AccumSeqEmpty (ANormal v) + | AccumSeqView + SeqEnd + (Maybe (ANormal v)) -- empty + (ANormal v) -- cons/snoc + | AccumSeqSplit + SeqEnd + Int -- split at + (Maybe (ANormal v)) -- default + (ANormal v) -- split + +instance Semigroup (BranchAccum v) where + AccumEmpty <> r = r + l <> AccumEmpty = l + AccumIntegral rl dl cl <> AccumIntegral rr dr cr + | rl == rr = AccumIntegral rl (dl <|> dr) $ cl <> cr + AccumText dl cl <> AccumText dr cr = + AccumText (dl <|> dr) (cl <> cr) + AccumData rl dl cl <> AccumData rr dr cr + | rl == rr = AccumData rl (dl <|> dr) (cl <> cr) + AccumDefault dl <> AccumIntegral r _ cr = + AccumIntegral r (Just dl) cr + AccumDefault dl <> AccumText _ cr = + AccumText (Just dl) cr + AccumDefault dl <> AccumData rr _ cr = + AccumData rr (Just dl) cr + AccumIntegral r dl cl <> AccumDefault dr = + AccumIntegral r (dl <|> Just dr) cl + AccumText dl cl <> AccumDefault dr = + AccumText (dl <|> Just dr) cl + AccumData rl dl cl <> AccumDefault dr = + AccumData rl (dl <|> Just dr) cl + l@(AccumPure _) <> AccumPure _ = l + AccumPure dl <> AccumRequest hr _ = AccumRequest hr (Just dl) + AccumRequest hl dl <> AccumPure dr = + AccumRequest hl (dl <|> Just dr) + AccumRequest hl dl <> AccumRequest hr dr = + AccumRequest hm $ dl <|> dr + where + hm = Map.unionWith (<>) hl hr + l@(AccumSeqEmpty _) <> AccumSeqEmpty _ = l + AccumSeqEmpty eml <> AccumSeqView er _ cnr = + AccumSeqView er (Just eml) cnr + AccumSeqView el eml cnl <> AccumSeqEmpty emr = + AccumSeqView el (eml <|> Just emr) cnl + AccumSeqView el eml cnl <> AccumSeqView er emr _ + | el /= er = + internalBug "AccumSeqView: trying to merge views of opposite ends" + | otherwise = AccumSeqView el (eml <|> emr) cnl + AccumSeqView _ _ _ <> AccumDefault _ = + internalBug "seq views may not have defaults" + AccumDefault _ <> AccumSeqView _ _ _ = + internalBug "seq views may not have defaults" + AccumSeqSplit el nl dl bl <> AccumSeqSplit er nr dr _ + | el /= er = + internalBug + "AccumSeqSplit: trying to merge splits at opposite ends" + | nl /= nr = + internalBug + "AccumSeqSplit: trying to merge splits at different positions" + | otherwise = + AccumSeqSplit el nl (dl <|> dr) bl + AccumDefault dl <> AccumSeqSplit er nr _ br = + AccumSeqSplit er nr (Just dl) br + AccumSeqSplit el nl dl bl <> AccumDefault dr = + AccumSeqSplit el nl (dl <|> Just dr) bl + _ <> _ = internalBug $ "cannot merge data cases for different types" + +instance Monoid (BranchAccum e) where + mempty = AccumEmpty + +-- Foreign operation, indexed by words +type FOp = Word64 + +data Func v + = -- variable + FVar v + | -- top-level combinator + FComb !Reference + | -- continuation jump + FCont v + | -- data constructor + FCon !Reference !CTag + | -- ability request + FReq !Reference !CTag + | -- prim op + FPrim (Either POp FOp) + deriving (Show, Eq, Functor, Foldable, Traversable) + +data Lit + = I Int64 + | N Word64 + | F Double + | T Util.Text.Text + | C Char + | LM Referent -- Term Link + | LY Reference -- Type Link + deriving (Show, Eq) + +litRef :: Lit -> Reference +litRef (I _) = Ty.intRef +litRef (N _) = Ty.natRef +litRef (F _) = Ty.floatRef +litRef (T _) = Ty.textRef +litRef (C _) = Ty.charRef +litRef (LM _) = Ty.termLinkRef +litRef (LY _) = Ty.typeLinkRef + +-- Note: Enum/Bounded instances should only be used for things like +-- getting a list of all ops. Using auto-generated numberings for +-- serialization, for instance, could cause observable changes to +-- formats that we want to control and version. +data POp + = -- Int + ADDI -- + + | SUBI -- - + | MULI + | DIVI -- / + | SGNI -- sgn + | NEGI -- neg + | MODI -- mod + | POWI -- pow + | SHLI -- shiftl + | SHRI -- shiftr + | ANDI -- and + | IORI -- or + | XORI -- xor + | COMI -- complement + | INCI -- inc + | DECI -- dec + | LEQI -- <= + | EQLI -- == + -- Nat + | ADDN -- + + | SUBN -- - + | MULN + | DIVN -- / + | MODN -- mod + | TZRO -- trailingZeros + | LZRO -- leadingZeros + | POPC -- popCount + | POWN -- pow + | SHLN -- shiftl + | SHRN -- shiftr + | ANDN -- and + | IORN -- or + | XORN -- xor + | COMN -- complement + | INCN -- inc + | DECN -- dec + | LEQN -- <= + | EQLN -- == + -- Float + | ADDF -- + + | SUBF -- - + | MULF + | DIVF -- / + | MINF -- min + | MAXF -- max + | LEQF -- <= + | EQLF -- == + | POWF -- pow + | EXPF -- exp + | SQRT -- sqrt + | LOGF -- log + | LOGB -- logBase + | ABSF -- abs + | CEIL -- ceil + | FLOR -- floor + | TRNF -- truncate + | RNDF -- round + -- Trig + | COSF -- cos + | ACOS -- acos + | COSH -- cosh + | ACSH -- acosh + | SINF -- sin + | ASIN -- asin + | SINH -- sinh + | ASNH -- asinh + | TANF -- tan + | ATAN -- atan + | TANH -- tanh + | ATNH -- atanh + | ATN2 -- atan2 + -- Text + | CATT -- ++ + | TAKT -- take + | DRPT -- drop + | SIZT -- size + | IXOT -- indexOf + | UCNS -- uncons + | USNC -- unsnoc + | EQLT -- == + | LEQT -- <= + | PAKT -- pack + | UPKT -- unpack + -- Sequence + | CATS -- ++ + | TAKS -- take + | DRPS -- drop + | SIZS -- size + | CONS -- cons + | SNOC -- snoc + | IDXS -- at + | BLDS -- build + | VWLS -- viewl + | VWRS -- viewr + | SPLL -- splitl + | SPLR -- splitr + -- Bytes + | PAKB -- pack + | UPKB -- unpack + | TAKB -- take + | DRPB -- drop + | IXOB -- indexOf + | IDXB -- index + | SIZB -- size + | FLTB -- flatten + | CATB -- append + -- Conversion + | ITOF -- intToFloat + | NTOF -- natToFloat + | ITOT -- intToText + | NTOT -- natToText + | TTOI -- textToInt + | TTON -- textToNat + | TTOF -- textToFloat + | FTOT -- floatToText + | CAST -- runtime type cast for unboxed values. + | -- Concurrency + FORK -- fork + | -- Universal operations + EQLU -- == + | CMPU -- compare + | EROR -- error + | -- Code + MISS -- isMissing + | CACH -- cache_ + | LKUP -- lookup + | LOAD -- load + | CVLD -- validate + | SDBX -- sandbox + | VALU -- value + | TLTT -- Term.Link.toText + -- Debug + | PRNT -- print + | INFO -- info + | TRCE -- trace + | DBTX -- debugText + | -- STM + ATOM -- atomically + | TFRC -- try force + | SDBL -- sandbox link list + | SDBV -- sandbox check for Values + deriving (Show, Eq, Ord, Enum, Bounded) + +type ANormal = ABTN.Term ANormalF + +type Cte v = CTE v (ANormal v) + +type Ctx v = Directed () [Cte v] + +data Direction a = Indirect a | Direct + deriving (Eq, Ord, Show, Functor, Foldable, Traversable) + +directed :: (Foldable f) => f (Cte v) -> Directed () (f (Cte v)) +directed x = (foldMap f x, x) + where + f (ST d _ _ _) = () <$ d + f _ = Direct + +instance (Semigroup a) => Semigroup (Direction a) where + Indirect l <> Indirect r = Indirect $ l <> r + Direct <> r = r + l <> Direct = l + +instance (Semigroup a) => Monoid (Direction a) where + mempty = Direct + +type Directed a = (,) (Direction a) + +type DNormal v = Directed () (ANormal v) + +-- Should be a completely closed term +data SuperNormal v = Lambda {conventions :: [Mem], bound :: ANormal v} + deriving (Show, Eq) + +data SuperGroup v = Rec + { group :: [(v, SuperNormal v)], + entry :: SuperNormal v + } + deriving (Show) + +-- | Whether the evaluation of a given definition is cacheable or not. +-- i.e. it's a top-level pure value. +data Cacheability = Cacheable | Uncacheable + deriving stock (Eq, Show) + +instance (Var v) => Eq (SuperGroup v) where + g0 == g1 | Left _ <- equivocate g0 g1 = False | otherwise = True + +-- Failure modes for SuperGroup alpha equivalence test +data SGEqv v + = -- mismatch number of definitions in group + NumDefns (SuperGroup v) (SuperGroup v) + | -- mismatched SuperNormal calling conventions + DefnConventions (SuperNormal v) (SuperNormal v) + | -- mismatched subterms in corresponding definition + Subterms (ANormal v) (ANormal v) + +-- Yields the number of arguments directly accepted by a combinator. +arity :: SuperNormal v -> Int +arity (Lambda ccs _) = length ccs + +-- Yields the numbers of arguments directly accepted by the +-- combinators in a group. The main entry is the first element, and +-- local bindings follow in their original order. +arities :: SuperGroup v -> [Int] +arities (Rec bs e) = arity e : fmap (arity . snd) bs + +-- Checks the body of a SuperGroup makes it eligible for inlining. +-- See below for the discussion. +isInlinable :: (Var v) => Reference -> ANormal v -> Bool +isInlinable r (TApp (FComb s) _) = r /= s +isInlinable _ TApp {} = True +isInlinable _ TBLit {} = True +isInlinable _ TVar {} = True +isInlinable _ _ = False + +-- Checks a SuperGroup makes it eligible to be inlined. +-- Unfortunately we need to be quite conservative about this. +-- +-- The heuristic implemented below is as follows: +-- +-- 1. There are no local bindings, so only the 'entry point' +-- matters. +-- 2. The entry point body is just a single expression, that is, +-- an application, variable or literal. +-- +-- The first condition ensures that there isn't any need to jump +-- into a non-entrypoint from outside a group. These should be rare +-- anyway, because the local bindings are no longer used for +-- (unison-level) local function definitions (those are lifted +-- out). The second condition ensures that inlining the body should +-- have no effect on the runtime stack of of the function we're +-- inlining into, because the combinator is just a wrapper around +-- the simple expression. +-- +-- Fortunately, it should be possible to make _most_ builtins have +-- this form, so that their instructions can be inlined directly +-- into the call sites when saturated. +-- +-- The result of this function is the information necessary to +-- inline the combinator—an arity and the body expression with +-- bound variables. This should allow checking if the call is +-- saturated and make it possible to locally substitute for an +-- inlined expression. +-- +-- The `Reference` argument allows us to check if the body is a +-- direct recursive call to the same function, which would result +-- in infinite inlining. This isn't the only such scenario, but +-- it's one we can opportunistically rule out. +inlineInfo :: (Var v) => Reference -> SuperGroup v -> Maybe (Int, ANormal v) +inlineInfo r (Rec [] (Lambda ccs body@(ABTN.TAbss _ e))) + | isInlinable r e = Just (length ccs, body) +inlineInfo _ _ = Nothing + +-- Builds inlining information from a collection of SuperGroups. +-- They are all tested for inlinability, and the result map +-- contains only the information for groups that are able to be +-- inlined. +buildInlineMap :: + (Var v) => + Map Reference (SuperGroup v) -> + Map Reference (Int, ANormal v) +buildInlineMap = + runIdentity + . Map.traverseMaybeWithKey (\r g -> Identity $ inlineInfo r g) + +-- Checks if two SuperGroups are equivalent up to renaming. The rest +-- of the structure must match on the nose. If the two groups are not +-- equivalent, an example of conflicting structure is returned. +equivocate :: + (Var v) => + SuperGroup v -> + SuperGroup v -> + Either (SGEqv v) () +equivocate g0@(Rec bs0 e0) g1@(Rec bs1 e1) + | length bs0 == length bs1 = + traverse_ eqvSN (zip ns0 ns1) *> eqvSN (e0, e1) + | otherwise = Left $ NumDefns g0 g1 + where + (vs0, ns0) = unzip bs0 + (vs1, ns1) = unzip bs1 + vm = Map.fromList (zip vs1 vs0) + + promote (Left (l, r)) = Left $ Subterms l r + promote (Right v) = Right v + + eqvSN (Lambda ccs0 e0, Lambda ccs1 e1) + | ccs0 == ccs1 = promote $ ABTN.alpha vm e0 e1 + eqvSN (n0, n1) = Left $ DefnConventions n0 n1 + +type ANFM v = + ReaderT + (Set v) + (State (Word64, Word16, [(v, SuperNormal v)])) + +type ANFD v = Compose (ANFM v) (Directed ()) + +data GroupRef = GR Reference Word64 + deriving (Show, Eq) + +-- | A list of either unboxed or boxed values. +-- Each slot is one of unboxed or boxed but not both. +type ValList = [Value] + +data Value + = Partial GroupRef ValList + | Data Reference Word64 ValList + | Cont ValList Cont + | BLit BLit + deriving (Show, Eq) + +-- Since we can now track cacheability of supergroups, this type +-- pairs the two together. This is the type that should be used +-- as the representation of unison Code values rather than the +-- previous `SuperGroup Symbol`. +data Code = CodeRep (SuperGroup Symbol) Cacheability + deriving (Show) + +codeGroup :: Code -> SuperGroup Symbol +codeGroup (CodeRep sg _) = sg + +instance Eq Code where + CodeRep sg1 _ == CodeRep sg2 _ = sg1 == sg2 + +overGroup :: (SuperGroup Symbol -> SuperGroup Symbol) -> Code -> Code +overGroup f (CodeRep sg ch) = CodeRep (f sg) ch + +foldGroup :: (Monoid m) => (SuperGroup Symbol -> m) -> Code -> m +foldGroup f (CodeRep sg _) = f sg + +traverseGroup :: + (Applicative f) => + (SuperGroup Symbol -> f (SuperGroup Symbol)) -> + Code -> + f Code +traverseGroup f (CodeRep sg ch) = flip CodeRep ch <$> f sg + +data Cont + = KE + | Mark + Word64 -- pending args + [Reference] + (Map Reference Value) + Cont + | Push + Word64 -- Frame size + Word64 -- Pending args + GroupRef + Cont + deriving (Show, Eq) + +data BLit + = Text Util.Text.Text + | List (Seq Value) + | TmLink Referent + | TyLink Reference + | Bytes Bytes + | Quote Value + | Code Code + | BArr PA.ByteArray + | Arr (PA.Array Value) + | -- Despite the following being in the Boxed Literal type, they all represent unboxed values + Pos Word64 + | Neg Word64 + | Char Char + | Float Double + deriving (Show, Eq) + +groupVars :: ANFM v (Set v) +groupVars = ask + +bindLocal :: (Ord v) => [v] -> ANFM v r -> ANFM v r +bindLocal vs = local (Set.\\ Set.fromList vs) + +freshANF :: (Var v) => Word64 -> v +freshANF fr = Var.freshenId fr $ typed Var.ANFBlank + +fresh :: (Var v) => ANFM v v +fresh = state $ \(fr, bnd, cs) -> (freshANF fr, (fr + 1, bnd, cs)) + +contextualize :: (Var v) => DNormal v -> ANFM v (Ctx v, v) +contextualize (_, TVar cv) = do + gvs <- groupVars + if cv `Set.notMember` gvs + then pure (pure [], cv) + else do + bv <- fresh + d <- Indirect <$> binder + pure (directed [ST1 d bv BX $ TApv cv []], bv) +contextualize (d0, tm) = do + fv <- fresh + d <- bindDirection d0 + pure ((d0, [ST1 d fv BX tm]), fv) + +binder :: ANFM v Word16 +binder = state $ \(fr, bnd, cs) -> (bnd, (fr, bnd + 1, cs)) + +bindDirection :: Direction a -> ANFM v (Direction Word16) +bindDirection = traverse (const binder) + +record :: (Var v) => (v, SuperNormal v) -> ANFM v () +record p = modify $ \(fr, bnd, to) -> (fr, bnd, p : to) + +superNormalize :: (Var v) => Term v a -> SuperGroup v +superNormalize tm = Rec l c + where + (bs, e) + | LetRecNamed' bs e <- tm = (bs, e) + | otherwise = ([], tm) + grp = Set.fromList $ fst <$> bs + comp = traverse_ superBinding bs *> toSuperNormal e + subc = runReaderT comp grp + (c, (_, _, l)) = runState subc (0, 1, []) + +superBinding :: (Var v) => (v, Term v a) -> ANFM v () +superBinding (v, tm) = do + nf <- toSuperNormal tm + modify $ \(cvs, bnd, ctx) -> (cvs, bnd, (v, nf) : ctx) + +toSuperNormal :: (Var v) => Term v a -> ANFM v (SuperNormal v) +toSuperNormal tm = do + grp <- groupVars + if not . Set.null . (Set.\\ grp) $ freeVars tm + then internalBug $ "free variables in supercombinator: " ++ show tm + else + Lambda (BX <$ vs) . ABTN.TAbss vs . snd + <$> bindLocal vs (anfTerm body) + where + (vs, body) = fromMaybe ([], tm) $ unLams' tm + +anfTerm :: (Var v) => Term v a -> ANFM v (DNormal v) +anfTerm tm = f <$> anfBlock tm + where + -- f = uncurry (liftA2 TBinds) + f ((_, []), dtm) = dtm + f ((_, cx), (_, tm)) = (Indirect (), TBinds cx tm) + +floatableCtx :: (Var v) => Ctx v -> Bool +floatableCtx = all p . snd + where + p (LZ _ _ _) = True + p (ST _ _ _ tm) = q tm + q (TLit _) = True + q (TVar _) = True + q (TCon _ _ _) = True + q _ = False + +anfHandled :: (Var v) => Term v a -> ANFM v (Ctx v, DNormal v) +anfHandled body = + anfBlock body >>= \case + (ctx, (_, t@TCon {})) -> + fresh <&> \v -> + (ctx <> pure [ST1 Direct v BX t], pure $ TVar v) + (ctx, (_, t@(TLit l))) -> + fresh <&> \v -> + (ctx <> pure [ST1 Direct v cc t], pure $ TVar v) + where + cc = case l of T {} -> BX; LM {} -> BX; LY {} -> BX; _ -> UN + p -> pure p + +fls, tru :: (Var v) => ANormal v +fls = TCon Ty.booleanRef 0 [] +tru = TCon Ty.booleanRef 1 [] + +-- Helper function for renaming a variable arising from a +-- let v = u +-- binding during ANF translation. Renames a variable in a +-- context, and returns an indication of whether the varible +-- was shadowed by one of the context bindings. +-- +-- Note: this assumes that `u` is not bound by any of the context +-- entries, as no effort is made to rename them to avoid capturing +-- `u`. +renameCtx :: (Var v) => v -> v -> Ctx v -> (Ctx v, Bool) +renameCtx v u (d, ctx) | (ctx, b) <- renameCtes v u ctx = ((d, ctx), b) + +-- As above, but without the Direction. +renameCtes :: (Var v) => v -> v -> [Cte v] -> ([Cte v], Bool) +renameCtes v u = rn [] + where + swap w + | w == v = u + | otherwise = w + + rn acc [] = (reverse acc, False) + rn acc (ST d vs ccs b : es) + | any (== v) vs = (reverse acc ++ e : es, True) + | otherwise = rn (e : acc) es + where + e = ST d vs ccs $ ABTN.rename v u b + rn acc (LZ w f as : es) + | w == v = (reverse acc ++ e : es, True) + | otherwise = rn (e : acc) es + where + e = LZ w (swap <$> f) (swap <$> as) + +-- Simultaneously renames variables in a list of context entries. +-- +-- Assumes that the variables being renamed to are not bound by the +-- context entries, so that it is unnecessary to rename them. +renamesCtes :: (Var v) => Map v v -> [Cte v] -> [Cte v] +renamesCtes rn = map f + where + swap w + | Just u <- Map.lookup w rn = u + | otherwise = w + + f (ST d vs ccs b) = ST d vs ccs (ABTN.renames rn b) + f (LZ v r as) = LZ v (second swap r) (map swap as) + +-- Calculates the free variables occurring in a context. This +-- consists of the free variables in the expressions being bound, +-- but with previously bound variables subtracted. +freeVarsCtx :: (Ord v) => Ctx v -> Set v +freeVarsCtx = freeVarsCte . snd + +freeVarsCte :: (Ord v) => [Cte v] -> Set v +freeVarsCte = foldr m Set.empty + where + m (ST _ vs _ bn) rest = + ABTN.freeVars bn `Set.union` (rest Set.\\ Set.fromList vs) + m (LZ v r as) rest = + Set.fromList (either (const id) (:) r as) + `Set.union` Set.delete v rest + +-- Conditionally freshens a list of variables. The predicate +-- argument selects which variables to freshen, and the set is a set +-- of variables to avoid for freshness. The process ensures that the +-- result is mutually fresh, and returns a new set of variables to +-- avoid, which includes the freshened variables. +-- +-- Presumably any variables selected by the predicate should be +-- included in the set, but the set may contain additional variables +-- to avoid, when freshening. +freshens :: (Var v) => (v -> Bool) -> Set v -> [v] -> (Set v, [v]) +freshens p avoid0 vs = + mapAccumL f (Set.union avoid0 (Set.fromList vs)) vs + where + f avoid v + | p v, u <- Var.freshIn avoid v = (Set.insert u avoid, u) + | otherwise = (avoid, v) + +-- Freshens the variable bindings in a context to avoid a set of +-- variables. Returns the renaming necessary for anything that was +-- bound in the freshened context. +-- +-- Note: this only freshens if it's necessary to avoid variables in +-- the _original_ set. We need to keep track of other variables to +-- avoid when making up new names for those, but it it isn't +-- necessary to freshen variables to remove shadowing _within_ the +-- context, since it is presumably already correctly formed. +freshenCtx :: (Var v) => Set v -> Ctx v -> (Map v v, Ctx v) +freshenCtx avoid0 (d, ctx) = + case go lavoid Map.empty [] $ reverse ctx of + (rn, ctx) -> (rn, (d, ctx)) + where + -- precalculate all variable occurrences in the context to just + -- completely avoid those as well. + lavoid = + foldl (flip $ Set.union . cteVars) avoid0 ctx + + go _ rns fresh [] = (rns, fresh) + go avoid rns fresh (bn : bns) = case bn of + LZ v r as + | v `Set.member` avoid0, + u <- Var.freshIn avoid v, + (fresh, _) <- renameCtes v u fresh, + avoid <- Set.insert u avoid, + rns <- Map.alter (Just . fromMaybe u) v rns -> + go avoid rns (LZ u r as : fresh) bns + ST d vs ccs expr + | (avoid, us) <- freshens (`Set.member` avoid0) avoid vs, + rn <- Map.fromList (filter (uncurry (/=)) $ zip vs us), + not (Map.null rn), + fresh <- renamesCtes rn fresh, + -- Note: rns union left-biased, so inner contexts take + -- priority. + rns <- Map.union rns rn -> + go avoid rns (ST d us ccs expr : fresh) bns + _ -> go avoid rns (bn : fresh) bns + +anfBlock :: (Ord v, Var v) => Term v a -> ANFM v (Ctx v, DNormal v) +anfBlock (Var' v) = pure (mempty, pure $ TVar v) +anfBlock (If' c t f) = do + (cctx, cc) <- anfBlock c + (df, cf) <- anfTerm f + (dt, ct) <- anfTerm t + (cx, v) <- contextualize cc + let cases = + MatchData + (Builtin $ Data.Text.pack "Boolean") + (EC.mapSingleton 0 ([], cf)) + (Just ct) + pure (cctx <> cx, (Indirect () <> df <> dt, TMatch v cases)) +anfBlock (And' l r) = do + (lctx, vl) <- anfArg l + (d, tmr) <- anfTerm r + let tree = + TMatch vl . MatchDataCover Ty.booleanRef $ + mapFromList + [ (0, ([], fls)), + (1, ([], tmr)) + ] + pure (lctx, (Indirect () <> d, tree)) +anfBlock (Or' l r) = do + (lctx, vl) <- anfArg l + (d, tmr) <- anfTerm r + let tree = + TMatch vl . MatchDataCover Ty.booleanRef $ + mapFromList + [ (1, ([], tru)), + (0, ([], tmr)) + ] + pure (lctx, (Indirect () <> d, tree)) +anfBlock (Handle' h body) = + anfArg h >>= \(hctx, vh) -> + anfHandled body >>= \case + (ctx, (_, TCom f as)) | floatableCtx ctx -> do + v <- fresh + pure + ( hctx <> ctx <> pure [LZ v (Left f) as], + (Indirect (), TApp (FVar vh) [v]) + ) + (ctx, (_, TApv f as)) | floatableCtx ctx -> do + v <- fresh + pure + ( hctx <> ctx <> pure [LZ v (Right f) as], + (Indirect (), TApp (FVar vh) [v]) + ) + (ctx, (_, TVar v)) | floatableCtx ctx -> do + pure (hctx <> ctx, (Indirect (), TApp (FVar vh) [v])) + p@(_, _) -> + internalBug $ "handle body should be a simple call: " ++ show p +anfBlock (Match' scrut cas) = do + (sctx, sc) <- anfBlock scrut + (cx, v) <- contextualize sc + (d, brn) <- anfCases v cas + fmap (first ((Indirect () <> d) <>)) <$> case brn of + AccumDefault (TBinds (directed -> dctx) df) -> do + pure (sctx <> cx <> dctx, pure df) + AccumRequest _ Nothing -> + internalBug "anfBlock: AccumRequest without default" + AccumPure (ABTN.TAbss us bd) + | [u] <- us, + TBinds (directed -> bx) bd <- bd -> + case cx of + (_, []) -> do + d0 <- Indirect <$> binder + pure (sctx <> pure [ST1 d0 u BX (TFrc v)] <> bx, pure bd) + (d0, [ST1 d1 _ BX tm]) -> + pure (sctx <> (d0, [ST1 d1 u BX tm]) <> bx, pure bd) + _ -> internalBug "anfBlock|AccumPure: impossible" + | otherwise -> internalBug "pure handler with too many variables" + AccumRequest abr (Just df) -> do + (r, vs) <- do + r <- fresh + v <- fresh + gvs <- groupVars + let hfb = ABTN.TAbs v . TMatch v $ MatchRequest abr df + hfvs = Set.toList $ ABTN.freeVars hfb `Set.difference` gvs + record (r, Lambda (BX <$ hfvs ++ [v]) . ABTN.TAbss hfvs $ hfb) + pure (r, hfvs) + hv <- fresh + let (d, msc) + | (d, [ST1 _ _ BX tm]) <- cx = (d, tm) + | (_, [ST _ _ _ _]) <- cx = + internalBug "anfBlock: impossible" + | otherwise = (Indirect (), TFrc v) + pure + ( sctx <> pure [LZ hv (Right r) vs], + (d, THnd (Map.keys abr) hv msc) + ) + AccumText df cs -> + pure (sctx <> cx, pure . TMatch v $ MatchText cs df) + AccumIntegral r df cs -> + pure (sctx <> cx, pure $ TMatch v $ MatchNumeric r cs df) + AccumData r df cs -> + pure (sctx <> cx, pure . TMatch v $ MatchData r cs df) + AccumSeqEmpty _ -> + internalBug "anfBlock: non-exhaustive AccumSeqEmpty" + AccumSeqView en (Just em) bd -> do + r <- fresh + let op + | SLeft <- en = Builtin "List.viewl" + | otherwise = Builtin "List.viewr" + b <- binder + pure + ( sctx + <> cx + <> (Indirect (), [ST1 (Indirect b) r BX (TCom op [v])]), + pure . TMatch r $ + MatchDataCover + Ty.seqViewRef + ( EC.mapFromList + [ (fromIntegral Ty.seqViewEmpty, ([], em)), + (fromIntegral Ty.seqViewElem, ([BX, BX], bd)) + ] + ) + ) + AccumSeqView {} -> + internalBug "anfBlock: non-exhaustive AccumSeqView" + AccumSeqSplit en n mdf bd -> do + i <- fresh + r <- fresh + s <- fresh + b <- binder + let split = ST1 (Indirect b) r BX (TCom op [i, v]) + pure + ( sctx <> cx <> directed [lit i, split], + pure . TMatch r . MatchDataCover Ty.seqViewRef $ + mapFromList + [ (fromIntegral Ty.seqViewEmpty, ([], df s)), + (fromIntegral Ty.seqViewElem, ([BX, BX], bd)) + ] + ) + where + op + | SLeft <- en = Builtin "List.splitLeft" + | otherwise = Builtin "List.splitRight" + lit i = ST1 Direct i BX (TBLit . N $ fromIntegral n) + df n = + fromMaybe + ( TLet Direct n BX (TLit (T "pattern match failure")) $ + TPrm EROR [n, v] + ) + mdf + AccumEmpty -> pure (sctx <> cx, pure $ TMatch v MatchEmpty) +anfBlock (Let1Named' v b e) = + anfBlock b >>= \case + (bctx, (Direct, TVar u)) -> do + (ectx, ce) <- anfBlock e + (brn, bctx) <- fixupBctx bctx ectx ce + u <- pure $ Map.findWithDefault u u brn + (ectx, shaded) <- pure $ renameCtx v u ectx + ce <- pure $ if shaded then ce else ABTN.rename v u <$> ce + pure (bctx <> ectx, ce) + (bctx, (d0, cb)) -> bindLocal [v] $ do + (ectx, ce) <- anfBlock e + d <- bindDirection d0 + (brn, bctx) <- fixupBctx bctx ectx ce + cb <- pure $ ABTN.renames brn cb + let octx = bctx <> directed [ST1 d v BX cb] <> ectx + pure (octx, ce) + where + fixupBctx bctx ectx (_, ce) = + pure $ freshenCtx (Set.union ecfvs efvs) bctx + where + ecfvs = freeVarsCtx ectx + efvs = ABTN.freeVars ce +anfBlock (Apps' (Blank' b) args) = do + nm <- fresh + (actx, cas) <- anfArgs args + pure + ( actx <> pure [ST1 Direct nm BX (TLit (T msg))], + pure $ TPrm EROR (nm : cas) + ) + where + msg = Util.Text.pack . fromMaybe "blank expression" $ nameb b +anfBlock (Apps' f args) = do + (fctx, (d, cf)) <- anfFunc f + (actx, cas) <- anfArgs args + pure (fctx <> actx, (d, TApp cf cas)) +anfBlock (Constructor' (ConstructorReference r t)) = + pure (mempty, pure $ TCon r (fromIntegral t) []) +anfBlock (Request' (ConstructorReference r t)) = + pure (mempty, (Indirect (), TReq r (fromIntegral t) [])) +anfBlock (Boolean' b) = + pure (mempty, pure $ TCon Ty.booleanRef (if b then 1 else 0) []) +anfBlock (Lit' l@(T _)) = + pure (mempty, pure $ TLit l) +anfBlock (Lit' l) = + pure (mempty, pure $ TBLit l) +anfBlock (Ref' r) = pure (mempty, (Indirect (), TCom r [])) +anfBlock (Blank' b) = do + nm <- fresh + ev <- fresh + pure + ( pure + [ ST1 Direct nm BX (TLit (T name)), + ST1 Direct ev BX (TLit (T $ Util.Text.pack msg)) + ], + pure $ TPrm EROR [nm, ev] + ) + where + name = "blank expression" + msg = fromMaybe "blank expression" $ nameb b +anfBlock (TermLink' r) = pure (mempty, pure . TLit $ LM r) +anfBlock (TypeLink' r) = pure (mempty, pure . TLit $ LY r) +anfBlock (List' as) = fmap (pure . TPrm BLDS) <$> anfArgs tms + where + tms = toList as +anfBlock t = internalBug $ "anf: unhandled term: " ++ show t + +-- Note: this assumes that patterns have already been translated +-- to a state in which every case matches a single layer of data, +-- with no guards, and no variables ignored. This is not checked +-- completely. +anfInitCase :: + (Var v) => + v -> + MatchCase p (Term v a) -> + ANFD v (BranchAccum v) +anfInitCase u (MatchCase p guard (ABT.AbsN' vs bd)) + | Just _ <- guard = internalBug "anfInitCase: unexpected guard" + | P.Unbound _ <- p, + [] <- vs = + AccumDefault <$> anfBody bd + | P.Var _ <- p, + [v] <- vs = + AccumDefault . ABTN.rename v u <$> anfBody bd + | P.Var _ <- p = + internalBug $ "vars: " ++ show (length vs) + | P.Int _ (fromIntegral -> i) <- p = + AccumIntegral Ty.intRef Nothing . EC.mapSingleton i <$> anfBody bd + | P.Nat _ i <- p = + AccumIntegral Ty.natRef Nothing . EC.mapSingleton i <$> anfBody bd + | P.Char _ c <- p, + w <- fromIntegral $ fromEnum c = + AccumIntegral Ty.charRef Nothing . EC.mapSingleton w <$> anfBody bd + | P.Boolean _ b <- p, + t <- if b then 1 else 0 = + AccumData Ty.booleanRef Nothing + . EC.mapSingleton t + . ([],) + <$> anfBody bd + | P.Text _ t <- p, + [] <- vs = + AccumText Nothing . Map.singleton (Util.Text.fromText t) <$> anfBody bd + | P.Constructor _ (ConstructorReference r t) ps <- p = do + (,) + <$> expandBindings ps vs + <*> anfBody bd + <&> \(us, bd) -> + AccumData r Nothing . EC.mapSingleton (fromIntegral t) . (BX <$ us,) $ ABTN.TAbss us bd + | P.EffectPure _ q <- p = + (,) + <$> expandBindings [q] vs + <*> anfBody bd + <&> \(us, bd) -> AccumPure $ ABTN.TAbss us bd + | P.EffectBind _ (ConstructorReference r t) ps pk <- p = do + (,,) + <$> expandBindings (snoc ps pk) vs + <*> Compose (pure <$> fresh) + <*> anfBody bd + <&> \(exp, kf, bd) -> + let (us, uk) = + maybe (internalBug "anfInitCase: unsnoc impossible") id $ + unsnoc exp + jn = Builtin "jumpCont" + in flip AccumRequest Nothing + . Map.singleton r + . EC.mapSingleton (fromIntegral t) + . (BX <$ us,) + . ABTN.TAbss us + . TShift r kf + $ TName uk (Left jn) [kf] bd + | P.SequenceLiteral _ [] <- p = + AccumSeqEmpty <$> anfBody bd + | P.SequenceOp _ l op r <- p, + Concat <- op, + P.SequenceLiteral p ll <- l = do + AccumSeqSplit SLeft (length ll) Nothing + <$> (ABTN.TAbss <$> expandBindings [P.Var p, r] vs <*> anfBody bd) + | P.SequenceOp _ l op r <- p, + Concat <- op, + P.SequenceLiteral p rl <- r = + AccumSeqSplit SLeft (length rl) Nothing + <$> (ABTN.TAbss <$> expandBindings [l, P.Var p] vs <*> anfBody bd) + | P.SequenceOp _ l op r <- p, + dir <- case op of Cons -> SLeft; _ -> SRight = + AccumSeqView dir Nothing + <$> (ABTN.TAbss <$> expandBindings [l, r] vs <*> anfBody bd) + where + anfBody tm = Compose . bindLocal vs $ anfTerm tm +anfInitCase _ (MatchCase p _ _) = + internalBug $ "anfInitCase: unexpected pattern: " ++ show p + +valueTermLinks :: Value -> [Reference] +valueTermLinks = Set.toList . valueLinks f + where + f False r = Set.singleton r + f _ _ = Set.empty + +valueLinks :: (Monoid a) => (Bool -> Reference -> a) -> Value -> a +valueLinks f (Partial (GR cr _) vs) = + f False cr <> foldMap (valueLinks f) vs +valueLinks f (Data dr _ vs) = + f True dr <> foldMap (valueLinks f) vs +valueLinks f (Cont vs k) = + foldMap (valueLinks f) vs <> contLinks f k +valueLinks f (BLit l) = blitLinks f l + +contLinks :: (Monoid a) => (Bool -> Reference -> a) -> Cont -> a +contLinks f (Push _ _ (GR cr _) k) = + f False cr <> contLinks f k +contLinks f (Mark _ ps de k) = + foldMap (f True) ps + <> Map.foldMapWithKey (\k c -> f True k <> valueLinks f c) de + <> contLinks f k +contLinks _ KE = mempty + +blitLinks :: (Monoid a) => (Bool -> Reference -> a) -> BLit -> a +blitLinks f (List s) = foldMap (valueLinks f) s +blitLinks _ _ = mempty + +groupTermLinks :: (Var v) => SuperGroup v -> [Reference] +groupTermLinks = Set.toList . foldGroupLinks f + where + f False r = Set.singleton r + f _ _ = Set.empty + +overGroupLinks :: + (Var v) => + (Bool -> Reference -> Reference) -> + SuperGroup v -> + SuperGroup v +overGroupLinks f = + runIdentity . traverseGroupLinks (\b -> Identity . f b) + +traverseGroupLinks :: + (Applicative f, Var v) => + (Bool -> Reference -> f Reference) -> + SuperGroup v -> + f (SuperGroup v) +traverseGroupLinks f (Rec bs e) = + Rec <$> (traverse . traverse) (normalLinks f) bs <*> normalLinks f e + +foldGroupLinks :: + (Monoid r, Var v) => + (Bool -> Reference -> r) -> + SuperGroup v -> + r +foldGroupLinks f = getConst . traverseGroupLinks (\b -> Const . f b) + +normalLinks :: + (Applicative f, Var v) => + (Bool -> Reference -> f Reference) -> + SuperNormal v -> + f (SuperNormal v) +normalLinks f (Lambda ccs e) = Lambda ccs <$> anfLinks f e + +anfLinks :: + (Applicative f, Var v) => + (Bool -> Reference -> f Reference) -> + ANormal v -> + f (ANormal v) +anfLinks f (ABTN.Term _ (ABTN.Abs v e)) = + ABTN.TAbs v <$> anfLinks f e +anfLinks f (ABTN.Term _ (ABTN.Tm e)) = + ABTN.TTm <$> anfFLinks f (anfLinks f) e + +anfFLinks :: + (Applicative f) => + (Bool -> Reference -> f Reference) -> + (e -> f e) -> + ANormalF v e -> + f (ANormalF v e) +anfFLinks _ g (ALet d ccs b e) = ALet d ccs <$> g b <*> g e +anfFLinks f g (AName er vs e) = + flip AName vs <$> bitraverse (f False) pure er <*> g e +anfFLinks f g (AMatch v bs) = + AMatch v <$> branchLinks (f True) g bs +anfFLinks f g (AShift r e) = + AShift <$> f True r <*> g e +anfFLinks f g (AHnd rs v e) = + flip AHnd v <$> traverse (f True) rs <*> g e +anfFLinks f _ (AApp fu vs) = flip AApp vs <$> funcLinks f fu +anfFLinks f _ (ALit l) = ALit <$> litLinks f l +anfFLinks _ _ v = pure v + +litLinks :: + (Applicative f) => + (Bool -> Reference -> f Reference) -> + Lit -> + f Lit +litLinks f (LY r) = LY <$> f True r +litLinks f (LM (Con (ConstructorReference r i) t)) = + LM . flip Con t . flip ConstructorReference i <$> f True r +litLinks f (LM (Ref r)) = LM . Ref <$> f False r +litLinks _ v = pure v + +branchLinks :: + (Applicative f) => + (Reference -> f Reference) -> + (e -> f e) -> + Branched e -> + f (Branched e) +branchLinks f g (MatchRequest m e) = + MatchRequest . Map.fromList + <$> traverse (bitraverse f $ (traverse . traverse) g) (Map.toList m) + <*> g e +branchLinks f g (MatchData r m e) = + MatchData <$> f r <*> (traverse . traverse) g m <*> traverse g e +branchLinks _ g (MatchText m e) = + MatchText <$> traverse g m <*> traverse g e +branchLinks _ g (MatchIntegral m e) = + MatchIntegral <$> traverse g m <*> traverse g e +branchLinks _ g (MatchNumeric r m e) = + MatchNumeric r <$> traverse g m <*> traverse g e +branchLinks _ g (MatchSum m) = + MatchSum <$> (traverse . traverse) g m +branchLinks _ _ MatchEmpty = pure MatchEmpty + +funcLinks :: + (Applicative f) => + (Bool -> Reference -> f Reference) -> + Func v -> + f (Func v) +funcLinks f (FComb r) = FComb <$> f False r +funcLinks f (FCon r t) = flip FCon t <$> f True r +funcLinks f (FReq r t) = flip FReq t <$> f True r +funcLinks _ ff = pure ff + +expandBindings' :: + (Var v) => + Word64 -> + [P.Pattern p] -> + [v] -> + Either String (Word64, [v]) +expandBindings' fr [] [] = Right (fr, []) +expandBindings' fr (P.Unbound _ : ps) vs = + fmap (u :) <$> expandBindings' (fr + 1) ps vs + where + u = freshANF fr +expandBindings' fr (P.Var _ : ps) (v : vs) = + fmap (v :) <$> expandBindings' fr ps vs +expandBindings' _ [] (_ : _) = + Left "expandBindings': more bindings than expected" +expandBindings' _ (_ : _) [] = + Left "expandBindings': more patterns than expected" +expandBindings' _ _ _ = + Left $ "expandBindings': unexpected pattern" + +expandBindings :: (Var v) => [P.Pattern p] -> [v] -> ANFD v [v] +expandBindings ps vs = + Compose . state $ \(fr, bnd, co) -> case expandBindings' fr ps vs of + Left err -> internalBug $ err ++ " " ++ show (ps, vs) + Right (fr, l) -> (pure l, (fr, bnd, co)) + +anfCases :: + (Var v) => + v -> + [MatchCase p (Term v a)] -> + ANFM v (Directed () (BranchAccum v)) +anfCases u = getCompose . fmap fold . traverse (anfInitCase u) + +anfFunc :: (Var v) => Term v a -> ANFM v (Ctx v, Directed () (Func v)) +anfFunc (Var' v) = pure (mempty, (Indirect (), FVar v)) +anfFunc (Ref' r) = pure (mempty, (Indirect (), FComb r)) +anfFunc (Constructor' (ConstructorReference r t)) = pure (mempty, (Direct, FCon r $ fromIntegral t)) +anfFunc (Request' (ConstructorReference r t)) = pure (mempty, (Indirect (), FReq r $ fromIntegral t)) +anfFunc tm = do + (fctx, ctm) <- anfBlock tm + (cx, v) <- contextualize ctm + pure (fctx <> cx, (Indirect (), FVar v)) + +anfArg :: (Var v) => Term v a -> ANFM v (Ctx v, v) +anfArg tm = do + (ctx, ctm) <- anfBlock tm + (cx, v) <- contextualize ctm + pure (ctx <> cx, v) + +anfArgs :: (Var v) => [Term v a] -> ANFM v (Ctx v, [v]) +anfArgs tms = first fold . unzip <$> traverse anfArg tms + +indent :: Int -> ShowS +indent ind = showString (replicate (ind * 2) ' ') + +prettyGroup :: (Var v) => String -> SuperGroup v -> ShowS +prettyGroup s (Rec grp ent) = + showString ("let rec[" ++ s ++ "]\n") + . foldr f id grp + . showString "entry" + . prettySuperNormal 1 ent + where + f (v, sn) r = + indent 1 + . pvar v + . prettySuperNormal 2 sn + . showString "\n" + . r + +pvar :: (Var v) => v -> ShowS +pvar v = showString . Data.Text.unpack $ Var.name v + +prettyVars :: (Var v) => [v] -> ShowS +prettyVars = + foldr (\v r -> showString " " . pvar v . r) id + +prettyLVars :: (Var v) => [Mem] -> [v] -> ShowS +prettyLVars [] [] = showString " " +prettyLVars (c : cs) (v : vs) = + showString " " + . showParen True (pvar v . showString ":" . shows c) + . prettyLVars cs vs +prettyLVars [] (_ : _) = internalBug "more variables than conventions" +prettyLVars (_ : _) [] = internalBug "more conventions than variables" + +prettyRBind :: (Var v) => [v] -> ShowS +prettyRBind [] = showString "()" +prettyRBind [v] = pvar v +prettyRBind (v : vs) = + showParen True $ + pvar v . foldr (\v r -> shows v . showString "," . r) id vs + +prettySuperNormal :: (Var v) => Int -> SuperNormal v -> ShowS +prettySuperNormal ind (Lambda ccs (ABTN.TAbss vs tm)) = + prettyLVars ccs vs + . showString "=" + . prettyANF False (ind + 1) tm + +reqSpace :: (Var v) => Bool -> ANormal v -> Bool +reqSpace _ TLets {} = True +reqSpace _ TName {} = True +reqSpace b _ = b + +prettyANF :: (Var v) => Bool -> Int -> ANormal v -> ShowS +prettyANF m ind tm = + prettySpace (reqSpace m tm) ind . case tm of + TLets _ vs _ bn bo -> + prettyRBind vs + . showString " =" + . prettyANF False (ind + 1) bn + . prettyANF True ind bo + TName v f vs bo -> + prettyRBind [v] + . showString " := " + . prettyLZF f + . prettyVars vs + . prettyANF True ind bo + TLit l -> shows l + TFrc v -> showString "!" . pvar v + TVar v -> pvar v + TApp f vs -> prettyFunc f . prettyVars vs + TMatch v bs -> + showString "match " + . pvar v + . showString " with" + . prettyBranches (ind + 1) bs + TShift r v bo -> + showString "shift[" + . shows r + . showString "]" + . prettyVars [v] + . showString "." + . prettyANF False (ind + 1) bo + THnd rs v bo -> + showString "handle" + . prettyRefs rs + . prettyANF False (ind + 1) bo + . showString " with " + . pvar v + _ -> shows tm + +prettySpace :: Bool -> Int -> ShowS +prettySpace False _ = showString " " +prettySpace True ind = showString "\n" . indent ind + +prettyLZF :: (Var v) => Either Reference v -> ShowS +prettyLZF (Left w) = showString "ENV(" . shows w . showString ") " +prettyLZF (Right v) = pvar v . showString " " + +prettyRefs :: [Reference] -> ShowS +prettyRefs [] = showString "{}" +prettyRefs (r : rs) = + showString "{" + . shows r + . foldr (\t r -> shows t . showString "," . r) id rs + . showString "}" + +prettyFunc :: (Var v) => Func v -> ShowS +prettyFunc (FVar v) = pvar v . showString " " +prettyFunc (FCont v) = pvar v . showString " " +prettyFunc (FComb w) = showString "ENV(" . shows w . showString ")" +prettyFunc (FCon r t) = + showString "CON(" + . shows r + . showString "," + . shows t + . showString ")" +prettyFunc (FReq r t) = + showString "REQ(" + . shows r + . showString "," + . shows t + . showString ")" +prettyFunc (FPrim op) = either shows shows op . showString " " + +prettyBranches :: (Var v) => Int -> Branched (ANormal v) -> ShowS +prettyBranches ind bs = case bs of + MatchEmpty -> showString "{}" + MatchIntegral bs df -> + maybe id (\e -> prettyCase ind (showString "_") e id) df + . foldr (uncurry $ prettyCase ind . shows) id (mapToList bs) + MatchText bs df -> + maybe id (\e -> prettyCase ind (showString "_") e id) df + . foldr (uncurry $ prettyCase ind . shows) id (Map.toList bs) + MatchData _ bs df -> + maybe id (\e -> prettyCase ind (showString "_") e id) df + . foldr + (uncurry $ prettyCase ind . shows) + id + (mapToList $ snd <$> bs) + MatchRequest bs df -> + foldr + ( \(r, m) s -> + foldr + (\(c, e) -> prettyCase ind (prettyReq r c) e) + s + (mapToList $ snd <$> m) + ) + (prettyCase ind (prettyReq (0 :: Int) (0 :: Int)) df id) + (Map.toList bs) + MatchSum bs -> + foldr + (uncurry $ prettyCase ind . shows) + id + (mapToList $ snd <$> bs) + MatchNumeric _ bs df -> + maybe id (\e -> prettyCase ind (showString "_") e id) df + . foldr (uncurry $ prettyCase ind . shows) id (mapToList bs) + -- _ -> error "prettyBranches: todo" + where + -- prettyReq :: Reference -> CTag -> ShowS + prettyReq r c = + showString "REQ(" + . shows r + . showString "," + . shows c + . showString ")" + +prettyCase :: (Var v) => Int -> ShowS -> ANormal v -> ShowS -> ShowS +prettyCase ind sc (ABTN.TAbss vs e) r = + showString "\n" + . indent ind + . sc + . prettyVars vs + . showString " ->" + . prettyANF False (ind + 1) e + . r diff --git a/parser-typechecker/src/Unison/Runtime/ANF/Rehash.hs b/unison-runtime/src/Unison/Runtime/ANF/Rehash.hs similarity index 84% rename from parser-typechecker/src/Unison/Runtime/ANF/Rehash.hs rename to unison-runtime/src/Unison/Runtime/ANF/Rehash.hs index 4bd3c2434f..a6a50722d8 100644 --- a/parser-typechecker/src/Unison/Runtime/ANF/Rehash.hs +++ b/unison-runtime/src/Unison/Runtime/ANF/Rehash.hs @@ -1,7 +1,7 @@ module Unison.Runtime.ANF.Rehash where import Crypto.Hash -import Data.Bifunctor (bimap, first, second) +import Data.Bifunctor (bimap, second) import Data.ByteArray (convert) import Data.ByteString (cons) import Data.ByteString.Lazy (toChunks) @@ -16,25 +16,23 @@ import Unison.Reference as Reference import Unison.Referent as Referent import Unison.Runtime.ANF as ANF import Unison.Runtime.ANF.Serialize as ANF -import Unison.Var (Var) +import Unison.Symbol (Symbol) checkGroupHashes :: - (Var v) => - [(Referent, SuperGroup v)] -> + [(Referent, Code)] -> Either (Text, [Referent]) (Either [Referent] [Referent]) checkGroupHashes rgs = case checkMissing rgs of Left err -> Left err Right [] -> - case rehashGroups . Map.fromList $ first toReference <$> rgs of + case rehashGroups . Map.fromList $ bimap toReference codeGroup <$> rgs of Left err -> Left err Right (rrs, _) -> Right . Right . fmap (Ref . fst) . filter (uncurry (/=)) $ Map.toList rrs Right ms -> Right (Left $ Ref <$> ms) rehashGroups :: - (Var v) => - Map.Map Reference (SuperGroup v) -> - Either (Text, [Referent]) (Map.Map Reference Reference, Map.Map Reference (SuperGroup v)) + Map.Map Reference (SuperGroup Symbol) -> + Either (Text, [Referent]) (Map.Map Reference Reference, Map.Map Reference (SuperGroup Symbol)) rehashGroups m | badsccs <- filter (not . checkSCC) sccs, not $ null badsccs = @@ -56,12 +54,11 @@ rehashGroups m (rm, sgs) = rehashSCC scc checkMissing :: - (Var v) => - [(Referent, SuperGroup v)] -> + [(Referent, Code)] -> Either (Text, [Referent]) [Reference] -checkMissing (unzip -> (rs, gs)) = do +checkMissing (unzip -> (rs, cs)) = do is <- fmap Set.fromList . traverse f $ rs - pure . nub . foldMap (filter (p is) . groupTermLinks) $ gs + pure . nub . foldMap (filter (p is) . groupTermLinks . codeGroup) $ cs where f (Ref (DerivedId i)) = pure i f r@Ref {} = @@ -74,9 +71,8 @@ checkMissing (unzip -> (rs, gs)) = do p _ _ = False rehashSCC :: - (Var v) => - SCC (Reference, SuperGroup v) -> - (Map.Map Reference Reference, Map.Map Reference (SuperGroup v)) + SCC (Reference, SuperGroup Symbol) -> + (Map.Map Reference Reference, Map.Map Reference (SuperGroup Symbol)) rehashSCC scc | checkSCC scc = (refreps, newSGs) where @@ -103,7 +99,7 @@ rehashSCC scc refreps = Map.fromList $ fmap (\(r, _) -> (r, replace r)) ps rehashSCC scc = error $ "unexpected SCC:\n" ++ show scc -checkSCC :: SCC (Reference, SuperGroup v) -> Bool +checkSCC :: SCC (Reference, a) -> Bool checkSCC AcyclicSCC {} = True checkSCC (CyclicSCC []) = True checkSCC (CyclicSCC (p : ps)) = all (same p) ps diff --git a/unison-runtime/src/Unison/Runtime/ANF/Serialize.hs b/unison-runtime/src/Unison/Runtime/ANF/Serialize.hs new file mode 100644 index 0000000000..61f2a753f8 --- /dev/null +++ b/unison-runtime/src/Unison/Runtime/ANF/Serialize.hs @@ -0,0 +1,1062 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PatternSynonyms #-} + +module Unison.Runtime.ANF.Serialize where + +import Control.Monad +import Data.ByteString (ByteString) +import Data.ByteString.Lazy qualified as L +import Data.Bytes.Get hiding (getBytes) +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Bytes.VarInt +import Data.Foldable (traverse_) +import Data.Functor ((<&>)) +import Data.Map as Map (Map, fromList, lookup) +import Data.Maybe (mapMaybe) +import Data.Sequence qualified as Seq +import Data.Serialize.Put (runPutLazy) +import Data.Text (Text) +import Data.Word (Word16, Word32, Word64) +import GHC.IsList qualified (fromList) +import GHC.Stack +import Unison.ABT.Normalized (Term (..)) +import Unison.Reference (Reference, Reference' (Builtin), pattern Derived) +import Unison.Runtime.ANF as ANF hiding (Tag) +import Unison.Runtime.Exception +import Unison.Runtime.Serialize +import Unison.Util.EnumContainers qualified as EC +import Unison.Util.Text qualified as Util.Text +import Unison.Var (Type (ANFBlank), Var (..)) +import Prelude hiding (getChar, putChar) + +-- Version information is threaded through to allow handling +-- different formats. Transfer means that it is for saving +-- code/values to be restored later. Hash means we're just getting +-- bytes for hashing, so we don't need perfect information. +data Version = Transfer Word32 | Hash Word32 + deriving (Show) + +data TmTag + = VarT + | ForceT + | AppT + | HandleT + | ShiftT + | MatchT + | LitT + | NameRefT + | NameVarT + | LetDirT + | LetIndT + | BxLitT + +data FnTag + = FVarT + | FCombT + | FContT + | FConT + | FReqT + | FPrimT + | FForeignT + +data MtTag + = MIntT + | MTextT + | MReqT + | MEmptyT + | MDataT + | MSumT + | MNumT + +data LtTag + = IT + | NT + | FT + | TT + | CT + | LMT + | LYT + +data BLTag + = TextT + | ListT + | TmLinkT + | TyLinkT + | BytesT + | QuoteT + | CodeT + | BArrT + | PosT + | NegT + | CharT + | FloatT + | ArrT + | CachedCodeT + +data VaTag = PartialT | DataT | ContT | BLitT + +data CoTag = KET | MarkT | PushT + +instance Tag TmTag where + tag2word = \case + VarT -> 1 + ForceT -> 2 + AppT -> 3 + HandleT -> 4 + ShiftT -> 5 + MatchT -> 6 + LitT -> 7 + NameRefT -> 8 + NameVarT -> 9 + LetDirT -> 10 + LetIndT -> 11 + BxLitT -> 12 + word2tag = \case + 1 -> pure VarT + 2 -> pure ForceT + 3 -> pure AppT + 4 -> pure HandleT + 5 -> pure ShiftT + 6 -> pure MatchT + 7 -> pure LitT + 8 -> pure NameRefT + 9 -> pure NameVarT + 10 -> pure LetDirT + 11 -> pure LetIndT + 12 -> pure BxLitT + n -> unknownTag "TmTag" n + +instance Tag FnTag where + tag2word = \case + FVarT -> 0 + FCombT -> 1 + FContT -> 2 + FConT -> 3 + FReqT -> 4 + FPrimT -> 5 + FForeignT -> 6 + + word2tag = \case + 0 -> pure FVarT + 1 -> pure FCombT + 2 -> pure FContT + 3 -> pure FConT + 4 -> pure FReqT + 5 -> pure FPrimT + 6 -> pure FForeignT + n -> unknownTag "FnTag" n + +instance Tag MtTag where + tag2word = \case + MIntT -> 0 + MTextT -> 1 + MReqT -> 2 + MEmptyT -> 3 + MDataT -> 4 + MSumT -> 5 + MNumT -> 6 + + word2tag = \case + 0 -> pure MIntT + 1 -> pure MTextT + 2 -> pure MReqT + 3 -> pure MEmptyT + 4 -> pure MDataT + 5 -> pure MSumT + 6 -> pure MNumT + n -> unknownTag "MtTag" n + +instance Tag LtTag where + tag2word = \case + IT -> 0 + NT -> 1 + FT -> 2 + TT -> 3 + CT -> 4 + LMT -> 5 + LYT -> 6 + + word2tag = \case + 0 -> pure IT + 1 -> pure NT + 2 -> pure FT + 3 -> pure TT + 4 -> pure CT + 5 -> pure LMT + 6 -> pure LYT + n -> unknownTag "LtTag" n + +instance Tag BLTag where + tag2word = \case + TextT -> 0 + ListT -> 1 + TmLinkT -> 2 + TyLinkT -> 3 + BytesT -> 4 + QuoteT -> 5 + CodeT -> 6 + BArrT -> 7 + PosT -> 8 + NegT -> 9 + CharT -> 10 + FloatT -> 11 + ArrT -> 12 + CachedCodeT -> 13 + + word2tag = \case + 0 -> pure TextT + 1 -> pure ListT + 2 -> pure TmLinkT + 3 -> pure TyLinkT + 4 -> pure BytesT + 5 -> pure QuoteT + 6 -> pure CodeT + 7 -> pure BArrT + 8 -> pure PosT + 9 -> pure NegT + 10 -> pure CharT + 11 -> pure FloatT + 12 -> pure ArrT + 13 -> pure CachedCodeT + t -> unknownTag "BLTag" t + +instance Tag VaTag where + tag2word = \case + PartialT -> 0 + DataT -> 1 + ContT -> 2 + BLitT -> 3 + + word2tag = \case + 0 -> pure PartialT + 1 -> pure DataT + 2 -> pure ContT + 3 -> pure BLitT + t -> unknownTag "VaTag" t + +instance Tag CoTag where + tag2word = \case + KET -> 0 + MarkT -> 1 + PushT -> 2 + word2tag = \case + 0 -> pure KET + 1 -> pure MarkT + 2 -> pure PushT + t -> unknownTag "CoTag" t + +index :: (Eq v) => [v] -> v -> Maybe Word64 +index ctx u = go 0 ctx + where + go !_ [] = Nothing + go n (v : vs) + | v == u = Just n + | otherwise = go (n + 1) vs + +deindex :: (HasCallStack) => [v] -> Word64 -> v +deindex [] _ = exn "deindex: bad index" +deindex (v : vs) n + | n == 0 = v + | otherwise = deindex vs (n - 1) + +pushCtx :: [v] -> [v] -> [v] +pushCtx us vs = reverse us ++ vs + +putIndex :: (MonadPut m) => Word64 -> m () +putIndex = serialize . VarInt + +getIndex :: (MonadGet m) => m Word64 +getIndex = unVarInt <$> deserialize + +putVar :: (MonadPut m) => (Eq v) => [v] -> v -> m () +putVar ctx v + | Just i <- index ctx v = putIndex i + | otherwise = exn "putVar: variable not in context" + +getVar :: (MonadGet m) => [v] -> m v +getVar ctx = deindex ctx <$> getIndex + +putArgs :: (MonadPut m) => (Eq v) => [v] -> [v] -> m () +putArgs ctx is = putFoldable (putVar ctx) is + +getArgs :: (MonadGet m) => [v] -> m [v] +getArgs ctx = getList (getVar ctx) + +putCCs :: (MonadPut m) => [Mem] -> m () +putCCs ccs = putLength n *> traverse_ putCC ccs + where + n = length ccs + putCC UN = putWord8 0 + putCC BX = putWord8 1 + +getCCs :: (MonadGet m) => m [Mem] +getCCs = + getList $ + getWord8 <&> \case + 0 -> UN + 1 -> BX + _ -> exn "getCCs: bad calling convention" + +-- Serializes a `SuperGroup`. +-- +-- The Reference map allows certain term references to be switched out +-- for a given 64 bit word. This is used when re-hashing intermediate +-- code. For actual serialization, the empty map should be used, so +-- that the process is reversible. The purpose of this is merely to +-- strip out (mutual/)self-references when producing a byte sequence +-- to recompute a hash of a connected component of intermediate +-- definitons, since it is infeasible to +-- +-- The EnumMap associates 'foreign' operations with a textual name +-- that is used as the serialized representation. Since they are +-- generated somewhat dynamically, it is not easy to associate them +-- with a fixed numbering like we can with POps. +putGroup :: + (MonadPut m) => + (Var v) => + Map Reference Word64 -> + EC.EnumMap FOp Text -> + SuperGroup v -> + m () +putGroup refrep fops (Rec bs e) = + putLength n + *> traverse_ (putComb refrep fops ctx) cs + *> putComb refrep fops ctx e + where + n = length us + (us, cs) = unzip bs + ctx = pushCtx us [] + +getGroup :: (MonadGet m) => (Var v) => m (SuperGroup v) +getGroup = do + l <- getLength + let n = fromIntegral l + vs = getFresh <$> take l [0 ..] + ctx = pushCtx vs [] + cs <- replicateM l (getComb ctx n) + Rec (zip vs cs) <$> getComb ctx n + +putCode :: (MonadPut m) => EC.EnumMap FOp Text -> Code -> m () +putCode fops (CodeRep g c) = putGroup mempty fops g *> putCacheability c + +getCode :: (MonadGet m) => Word32 -> m Code +getCode v = CodeRep <$> getGroup <*> getCache + where + getCache + | v == 3 = getCacheability + | otherwise = pure Uncacheable + +putCacheability :: (MonadPut m) => Cacheability -> m () +putCacheability Uncacheable = putWord8 0 +putCacheability Cacheable = putWord8 1 + +getCacheability :: (MonadGet m) => m Cacheability +getCacheability = + getWord8 >>= \case + 0 -> pure Uncacheable + 1 -> pure Cacheable + n -> exn $ "getBLit: unrecognized cacheability byte: " ++ show n + +putComb :: + (MonadPut m) => + (Var v) => + Map Reference Word64 -> + EC.EnumMap FOp Text -> + [v] -> + SuperNormal v -> + m () +putComb refrep fops ctx (Lambda ccs (TAbss us e)) = + putCCs ccs *> putNormal refrep fops (pushCtx us ctx) e + +getFresh :: (Var v) => Word64 -> v +getFresh n = freshenId n $ typed ANFBlank + +getComb :: (MonadGet m) => (Var v) => [v] -> Word64 -> m (SuperNormal v) +getComb ctx frsh0 = do + ccs <- getCCs + let us = zipWith (\_ -> getFresh) ccs [frsh0 ..] + frsh = frsh0 + fromIntegral (length ccs) + Lambda ccs . TAbss us <$> getNormal (pushCtx us ctx) frsh + +putNormal :: + (MonadPut m) => + (Var v) => + Map Reference Word64 -> + EC.EnumMap FOp Text -> + [v] -> + ANormal v -> + m () +putNormal refrep fops ctx tm = case tm of + TVar v -> putTag VarT *> putVar ctx v + TFrc v -> putTag ForceT *> putVar ctx v + TApp f as -> putTag AppT *> putFunc refrep fops ctx f *> putArgs ctx as + THnd rs h e -> + putTag HandleT + *> putRefs rs + *> putVar ctx h + *> putNormal refrep fops ctx e + TShift r v e -> + putTag ShiftT *> putReference r *> putNormal refrep fops (v : ctx) e + TMatch v bs -> + putTag MatchT + *> putVar ctx v + *> putBranches refrep fops ctx bs + TLit l -> putTag LitT *> putLit l + TBLit l -> putTag BxLitT *> putLit l + TName v (Left r) as e -> + putTag NameRefT + *> pr + *> putArgs ctx as + *> putNormal refrep fops (v : ctx) e + where + pr + | Just w <- Map.lookup r refrep = putWord64be w + | otherwise = putReference r + TName v (Right u) as e -> + putTag NameVarT + *> putVar ctx u + *> putArgs ctx as + *> putNormal refrep fops (v : ctx) e + TLets Direct us ccs l e -> + putTag LetDirT + *> putCCs ccs + *> putNormal refrep fops ctx l + *> putNormal refrep fops (pushCtx us ctx) e + TLets (Indirect w) us ccs l e -> + putTag LetIndT + *> putWord16be w + *> putCCs ccs + *> putNormal refrep fops ctx l + *> putNormal refrep fops (pushCtx us ctx) e + _ -> exn "putNormal: malformed term" + +getNormal :: (MonadGet m) => (Var v) => [v] -> Word64 -> m (ANormal v) +getNormal ctx frsh0 = + getTag >>= \case + VarT -> TVar <$> getVar ctx + ForceT -> TFrc <$> getVar ctx + AppT -> TApp <$> getFunc ctx <*> getArgs ctx + HandleT -> THnd <$> getRefs <*> getVar ctx <*> getNormal ctx frsh0 + ShiftT -> + flip TShift v <$> getReference <*> getNormal (v : ctx) (frsh0 + 1) + where + v = getFresh frsh0 + MatchT -> TMatch <$> getVar ctx <*> getBranches ctx frsh0 + LitT -> TLit <$> getLit + BxLitT -> TBLit <$> getLit + NameRefT -> + TName v . Left + <$> getReference + <*> getArgs ctx + <*> getNormal (v : ctx) (frsh0 + 1) + where + v = getFresh frsh0 + NameVarT -> + TName v . Right + <$> getVar ctx + <*> getArgs ctx + <*> getNormal (v : ctx) (frsh0 + 1) + where + v = getFresh frsh0 + LetDirT -> do + ccs <- getCCs + let l = length ccs + frsh = frsh0 + fromIntegral l + us = getFresh <$> take l [frsh0 ..] + TLets Direct us ccs + <$> getNormal ctx frsh0 + <*> getNormal (pushCtx us ctx) frsh + LetIndT -> do + w <- getWord16be + ccs <- getCCs + let l = length ccs + frsh = frsh0 + fromIntegral l + us = getFresh <$> take l [frsh0 ..] + TLets (Indirect w) us ccs + <$> getNormal ctx frsh0 + <*> getNormal (pushCtx us ctx) frsh + +putFunc :: + (MonadPut m) => + (Var v) => + Map Reference Word64 -> + EC.EnumMap FOp Text -> + [v] -> + Func v -> + m () +putFunc refrep fops ctx f = case f of + FVar v -> putTag FVarT *> putVar ctx v + FComb r + | Just w <- Map.lookup r refrep -> putTag FCombT *> putWord64be w + | otherwise -> putTag FCombT *> putReference r + FCont v -> putTag FContT *> putVar ctx v + FCon r c -> putTag FConT *> putReference r *> putCTag c + FReq r c -> putTag FReqT *> putReference r *> putCTag c + FPrim (Left p) -> putTag FPrimT *> putPOp p + FPrim (Right f) + | Just nm <- EC.lookup f fops -> + putTag FForeignT *> putText nm + | otherwise -> + exn $ "putFunc: could not serialize foreign operation: " ++ show f + +getFunc :: (MonadGet m) => (Var v) => [v] -> m (Func v) +getFunc ctx = + getTag >>= \case + FVarT -> FVar <$> getVar ctx + FCombT -> FComb <$> getReference + FContT -> FCont <$> getVar ctx + FConT -> FCon <$> getReference <*> getCTag + FReqT -> FReq <$> getReference <*> getCTag + FPrimT -> FPrim . Left <$> getPOp + FForeignT -> exn "getFunc: can't deserialize a foreign func" + +putPOp :: (MonadPut m) => POp -> m () +putPOp op + | Just w <- Map.lookup op pop2word = putWord16be w + | otherwise = exn $ "putPOp: unknown POp: " ++ show op + +getPOp :: (MonadGet m) => m POp +getPOp = + getWord16be >>= \w -> case Map.lookup w word2pop of + Just op -> pure op + Nothing -> exn "getPOp: unknown enum code" + +pOpCode :: POp -> Word16 +pOpCode op = case op of + ADDI -> 0 + SUBI -> 1 + MULI -> 2 + DIVI -> 3 + SGNI -> 4 + NEGI -> 5 + MODI -> 6 + POWI -> 7 + SHLI -> 8 + SHRI -> 9 + INCI -> 10 + DECI -> 11 + LEQI -> 12 + EQLI -> 13 + ADDN -> 14 + SUBN -> 15 + MULN -> 16 + DIVN -> 17 + MODN -> 18 + TZRO -> 19 + LZRO -> 20 + POWN -> 21 + SHLN -> 22 + SHRN -> 23 + ANDN -> 24 + IORN -> 25 + XORN -> 26 + COMN -> 27 + INCN -> 28 + DECN -> 29 + LEQN -> 30 + EQLN -> 31 + ADDF -> 32 + SUBF -> 33 + MULF -> 34 + DIVF -> 35 + MINF -> 36 + MAXF -> 37 + LEQF -> 38 + EQLF -> 39 + POWF -> 40 + EXPF -> 41 + SQRT -> 42 + LOGF -> 43 + LOGB -> 44 + ABSF -> 45 + CEIL -> 46 + FLOR -> 47 + TRNF -> 48 + RNDF -> 49 + COSF -> 50 + ACOS -> 51 + COSH -> 52 + ACSH -> 53 + SINF -> 54 + ASIN -> 55 + SINH -> 56 + ASNH -> 57 + TANF -> 58 + ATAN -> 59 + TANH -> 60 + ATNH -> 61 + ATN2 -> 62 + CATT -> 63 + TAKT -> 64 + DRPT -> 65 + SIZT -> 66 + UCNS -> 67 + USNC -> 68 + EQLT -> 69 + LEQT -> 70 + PAKT -> 71 + UPKT -> 72 + CATS -> 73 + TAKS -> 74 + DRPS -> 75 + SIZS -> 76 + CONS -> 77 + SNOC -> 78 + IDXS -> 79 + BLDS -> 80 + VWLS -> 81 + VWRS -> 82 + SPLL -> 83 + SPLR -> 84 + PAKB -> 85 + UPKB -> 86 + TAKB -> 87 + DRPB -> 88 + IDXB -> 89 + SIZB -> 90 + FLTB -> 91 + CATB -> 92 + ITOF -> 93 + NTOF -> 94 + ITOT -> 95 + NTOT -> 96 + TTOI -> 97 + TTON -> 98 + TTOF -> 99 + FTOT -> 100 + FORK -> 101 + EQLU -> 102 + CMPU -> 103 + EROR -> 104 + PRNT -> 105 + INFO -> 106 + POPC -> 107 + MISS -> 108 + CACH -> 109 + LKUP -> 110 + LOAD -> 111 + CVLD -> 112 + SDBX -> 113 + VALU -> 114 + TLTT -> 115 + TRCE -> 116 + ATOM -> 117 + TFRC -> 118 + DBTX -> 119 + IXOT -> 120 + IXOB -> 121 + SDBL -> 122 + SDBV -> 123 + CAST -> 124 + ANDI -> 125 + IORI -> 126 + XORI -> 127 + COMI -> 128 + +pOpAssoc :: [(POp, Word16)] +pOpAssoc = map (\op -> (op, pOpCode op)) [minBound .. maxBound] + +pop2word :: Map POp Word16 +pop2word = fromList pOpAssoc + +word2pop :: Map Word16 POp +word2pop = fromList $ swap <$> pOpAssoc + where + swap (x, y) = (y, x) + +putLit :: (MonadPut m) => Lit -> m () +putLit (I i) = putTag IT *> putInt i +putLit (N n) = putTag NT *> putNat n +putLit (F f) = putTag FT *> putFloat f +putLit (T t) = putTag TT *> putText (Util.Text.toText t) +putLit (C c) = putTag CT *> putChar c +putLit (LM r) = putTag LMT *> putReferent r +putLit (LY r) = putTag LYT *> putReference r + +getLit :: (MonadGet m) => m Lit +getLit = + getTag >>= \case + IT -> I <$> getInt + NT -> N <$> getNat + FT -> F <$> getFloat + TT -> T . Util.Text.fromText <$> getText + CT -> C <$> getChar + LMT -> LM <$> getReferent + LYT -> LY <$> getReference + +putBLit :: (MonadPut m) => Version -> BLit -> m () +putBLit _ (Text t) = putTag TextT *> putText (Util.Text.toText t) +putBLit v (List s) = putTag ListT *> putFoldable (putValue v) s +putBLit _ (TmLink r) = putTag TmLinkT *> putReferent r +putBLit _ (TyLink r) = putTag TyLinkT *> putReference r +putBLit _ (Bytes b) = putTag BytesT *> putBytes b +putBLit v (Quote vl) = putTag QuoteT *> putValue v vl +putBLit v (Code (CodeRep sg ch)) = + putTag tag *> putGroup mempty mempty sg + where + -- Hashing treats everything as uncacheable for consistent + -- results. + tag + | Cacheable <- ch, + Transfer _ <- v = + CachedCodeT + | otherwise = CodeT +putBLit _ (BArr a) = putTag BArrT *> putByteArray a +putBLit _ (Pos n) = putTag PosT *> putPositive n +putBLit _ (Neg n) = putTag NegT *> putPositive n +putBLit _ (Char c) = putTag CharT *> putChar c +putBLit _ (Float d) = putTag FloatT *> putFloat d +putBLit v (Arr a) = putTag ArrT *> putFoldable (putValue v) a + +getBLit :: (MonadGet m) => Version -> m BLit +getBLit v = + getTag >>= \case + TextT -> Text . Util.Text.fromText <$> getText + ListT -> List . Seq.fromList <$> getList (getValue v) + TmLinkT -> TmLink <$> getReferent + TyLinkT -> TyLink <$> getReference + BytesT -> Bytes <$> getBytes + QuoteT -> Quote <$> getValue v + CodeT -> Code . flip CodeRep Uncacheable <$> getGroup + BArrT -> BArr <$> getByteArray + PosT -> Pos <$> getPositive + NegT -> Neg <$> getPositive + CharT -> Char <$> getChar + FloatT -> Float <$> getFloat + ArrT -> Arr . GHC.IsList.fromList <$> getList (getValue v) + CachedCodeT -> Code . flip CodeRep Cacheable <$> getGroup + +putRefs :: (MonadPut m) => [Reference] -> m () +putRefs rs = putFoldable putReference rs + +getRefs :: (MonadGet m) => m [Reference] +getRefs = getList getReference + +putBranches :: + (MonadPut m) => + (Var v) => + Map Reference Word64 -> + EC.EnumMap FOp Text -> + [v] -> + Branched (ANormal v) -> + m () +putBranches refrep fops ctx bs = case bs of + MatchEmpty -> putTag MEmptyT + MatchIntegral m df -> do + putTag MIntT + putEnumMap putWord64be (putNormal refrep fops ctx) m + putMaybe df $ putNormal refrep fops ctx + MatchText m df -> do + putTag MTextT + putMap (putText . Util.Text.toText) (putNormal refrep fops ctx) m + putMaybe df $ putNormal refrep fops ctx + MatchRequest m (TAbs v df) -> do + putTag MReqT + putMap putReference (putEnumMap putCTag (putCase refrep fops ctx)) m + putNormal refrep fops (v : ctx) df + MatchData r m df -> do + putTag MDataT + putReference r + putEnumMap putCTag (putCase refrep fops ctx) m + putMaybe df $ putNormal refrep fops ctx + MatchSum m -> do + putTag MSumT + putEnumMap putWord64be (putCase refrep fops ctx) m + MatchNumeric r m df -> do + putTag MNumT + putReference r + putEnumMap putWord64be (putNormal refrep fops ctx) m + putMaybe df $ putNormal refrep fops ctx + _ -> exn "putBranches: malformed intermediate term" + +getBranches :: + (MonadGet m) => (Var v) => [v] -> Word64 -> m (Branched (ANormal v)) +getBranches ctx frsh0 = + getTag >>= \case + MEmptyT -> pure MatchEmpty + MIntT -> + MatchIntegral + <$> getEnumMap getWord64be (getNormal ctx frsh0) + <*> getMaybe (getNormal ctx frsh0) + MTextT -> + MatchText + <$> getMap (Util.Text.fromText <$> getText) (getNormal ctx frsh0) + <*> getMaybe (getNormal ctx frsh0) + MReqT -> + MatchRequest + <$> getMap getReference (getEnumMap getCTag (getCase ctx frsh0)) + <*> (TAbs v <$> getNormal (v : ctx) (frsh0 + 1)) + where + v = getFresh frsh0 + MDataT -> + MatchData + <$> getReference + <*> getEnumMap getCTag (getCase ctx frsh0) + <*> getMaybe (getNormal ctx frsh0) + MSumT -> MatchSum <$> getEnumMap getWord64be (getCase ctx frsh0) + MNumT -> + MatchNumeric + <$> getReference + <*> getEnumMap getWord64be (getNormal ctx frsh0) + <*> getMaybe (getNormal ctx frsh0) + +putCase :: + (MonadPut m) => + (Var v) => + Map Reference Word64 -> + EC.EnumMap FOp Text -> + [v] -> + ([Mem], ANormal v) -> + m () +putCase refrep fops ctx (ccs, (TAbss us e)) = + putCCs ccs *> putNormal refrep fops (pushCtx us ctx) e + +getCase :: (MonadGet m) => (Var v) => [v] -> Word64 -> m ([Mem], ANormal v) +getCase ctx frsh0 = do + ccs <- getCCs + let l = length ccs + frsh = frsh0 + fromIntegral l + us = getFresh <$> take l [frsh0 ..] + (,) ccs . TAbss us <$> getNormal (pushCtx us ctx) frsh + +putCTag :: (MonadPut m) => CTag -> m () +putCTag c = serialize (VarInt $ fromEnum c) + +getCTag :: (MonadGet m) => m CTag +getCTag = toEnum . unVarInt <$> deserialize + +putGroupRef :: (MonadPut m) => GroupRef -> m () +putGroupRef (GR r i) = + putReference r *> putWord64be i + +getGroupRef :: (MonadGet m) => m GroupRef +getGroupRef = GR <$> getReference <*> getWord64be + +-- Notes +-- +-- Starting with version 4 of the value format, it is expected that +-- unboxed data does not actually occur in the values being sent. For +-- most values this was not a problem: +-- +-- - Partial applications had no way of directly including unboxed +-- values, because they all result from surface level unison +-- applications +-- - Unboxed values in Data only occurred to represent certain +-- builtin types. Those have been replaced by BLits. +-- +-- However, some work was required to make sure no unboxed data ended +-- up in Cont. The runtime has been modified to avoid using the +-- unboxed stack in generated code, so now only builtins use it, +-- effectively. Since continuations are never captured inside builtins +-- (and even if we wanted to do that, we could arrange for a clean +-- unboxed stack), this is no longer a problem, either. +-- +-- So, unboxed data is completely absent from the format. We are now +-- exchanging unison surface values, effectively. +putValue :: (MonadPut m) => Version -> Value -> m () +putValue v (Partial gr vs) = + putTag PartialT + *> putGroupRef gr + *> putFoldable (putValue v) vs +putValue v (Data r t vs) = + putTag DataT + *> putReference r + *> putWord64be t + *> putFoldable (putValue v) vs +putValue v (Cont bs k) = + putTag ContT + *> putFoldable (putValue v) bs + *> putCont v k +putValue v (BLit l) = + putTag BLitT *> putBLit v l + +getValue :: (MonadGet m) => Version -> m Value +getValue v = + getTag >>= \case + PartialT + | Transfer vn <- v, + vn < 4 -> do + gr <- getGroupRef + getList getWord64be >>= assertEmptyUnboxed + bs <- getList (getValue v) + pure $ Partial gr bs + | otherwise -> do + gr <- getGroupRef + vs <- getList (getValue v) + pure $ Partial gr vs + DataT + | Transfer vn <- v, + vn < 4 -> do + r <- getReference + w <- getWord64be + getList getWord64be >>= assertEmptyUnboxed + vs <- getList (getValue v) + pure $ Data r w vs + | otherwise -> do + r <- getReference + w <- getWord64be + vs <- getList (getValue v) + pure $ Data r w vs + ContT + | Transfer vn <- v, + vn < 4 -> do + getList getWord64be >>= assertEmptyUnboxed + bs <- getList (getValue v) + k <- getCont v + pure $ Cont bs k + | otherwise -> do + bs <- getList (getValue v) + k <- getCont v + pure $ Cont bs k + BLitT -> BLit <$> getBLit v + where + assertEmptyUnboxed :: (MonadGet m) => [a] -> m () + assertEmptyUnboxed [] = pure () + assertEmptyUnboxed _ = exn "getValue: unboxed values no longer supported" + +putCont :: (MonadPut m) => Version -> Cont -> m () +putCont _ KE = putTag KET +putCont v (Mark a rs ds k) = + putTag MarkT + *> putWord64be a + *> putFoldable putReference rs + *> putMap putReference (putValue v) ds + *> putCont v k +putCont v (Push f n gr k) = + putTag PushT + *> putWord64be f + *> putWord64be n + *> putGroupRef gr + *> putCont v k + +getCont :: (MonadGet m) => Version -> m Cont +getCont v = + getTag >>= \case + KET -> pure KE + MarkT + | Transfer vn <- v, + vn < 4 -> do + getWord64be >>= assert0 "unboxed arg size" + ba <- getWord64be + refs <- getList getReference + vals <- getMap getReference (getValue v) + cont <- getCont v + pure $ Mark ba refs vals cont + | otherwise -> + Mark + <$> getWord64be + <*> getList getReference + <*> getMap getReference (getValue v) + <*> getCont v + PushT + | Transfer vn <- v, + vn < 4 -> do + getWord64be >>= assert0 "unboxed frame size" + bf <- getWord64be + getWord64be >>= assert0 "unboxed arg size" + ba <- getWord64be + gr <- getGroupRef + cont <- getCont v + pure $ Push bf ba gr cont + | otherwise -> + Push + <$> getWord64be + <*> getWord64be + <*> getGroupRef + <*> getCont v + where + assert0 _name 0 = pure () + assert0 name n = exn $ "getCont: malformed intermediate term. Expected " <> name <> " to be 0, but got " <> show n + +deserializeCode :: ByteString -> Either String Code +deserializeCode bs = runGetS (getVersion >>= getCode) bs + where + getVersion = + getWord32be >>= \case + n | 1 <= n && n <= 3 -> pure n + n -> fail $ "deserializeGroup: unknown version: " ++ show n + +serializeCode :: EC.EnumMap FOp Text -> Code -> ByteString +serializeCode fops co = runPutS (putVersion *> putCode fops co) + where + putVersion = putWord32be codeVersion + +-- | Serializes a `SuperGroup` for rehashing. +-- +-- Expected as arguments are some code, and the `Reference` that +-- refers to it. In particular, if the code refers to itself by +-- reference, or if the code is part of a mututally-recursive set of +-- definitions (which have a common hash), the reference used as part +-- of that (mutual) recursion must be supplied. +-- +-- Using that reference, we find all references in the code to that +-- connected component. In the resulting byte string, those references +-- are instead replaced by positions in a listing of the connected +-- component. This means that the byte string is independent of the +-- hash used for the self reference. Only the order matters (which is +-- determined by the `Reference`). Then the bytes can be re-hashed to +-- establish a new hash for the connected component. This operation +-- should be idempotent as long as the indexing is preserved. +-- +-- Supplying a `Builtin` reference is not supported. Such code +-- shouldn't be subject to rehashing. +serializeGroupForRehash :: + (Var v) => + EC.EnumMap FOp Text -> + Reference -> + SuperGroup v -> + L.ByteString +serializeGroupForRehash _ (Builtin _) _ = + error "serializeForRehash: builtin reference" +serializeGroupForRehash fops (Derived h _) sg = + runPutLazy $ putGroup refrep fops sg + where + f r@(Derived h' i) | h == h' = Just (r, i) + f _ = Nothing + refrep = Map.fromList . mapMaybe f $ groupTermLinks sg + +getVersionedValue :: (MonadGet m) => m Value +getVersionedValue = getVersion >>= getValue . Transfer + where + getVersion = + getWord32be >>= \case + n + | n < 1 -> fail $ "deserializeValue: unknown version: " ++ show n + | n < 3 -> fail $ "deserializeValue: unsupported version: " ++ show n + | 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 (Transfer valueVersion) v) + where + putVersion = putWord32be valueVersion + +-- This serializer is used exclusively for hashing unison values. +-- For this reason, it doesn't prefix the string with the current +-- version, so that only genuine changes in the way things are +-- serialized will change hashes. +-- +-- The 4 prefix is used because we were previously including the +-- version in the hash, so to maintain the same hashes, we need to +-- include the extra bytes that were previously there. +-- +-- Additionally, any major serialization changes should consider +-- retaining this representation as much as possible, even if it +-- becomes a separate format, because there is no need to parse from +-- the hash serialization, just generate and hash it. +serializeValueForHash :: Value -> L.ByteString +serializeValueForHash v = runPutLazy (putPrefix *> putValue (Hash 4) v) + where + putPrefix = putWord32be 4 + +valueVersion :: Word32 +valueVersion = 4 + +codeVersion :: Word32 +codeVersion = 3 diff --git a/unison-runtime/src/Unison/Runtime/Array.hs b/unison-runtime/src/Unison/Runtime/Array.hs new file mode 100644 index 0000000000..e34ff20efb --- /dev/null +++ b/unison-runtime/src/Unison/Runtime/Array.hs @@ -0,0 +1,429 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE StandaloneKindSignatures #-} + +-- This module wraps the operations in the primitive package so that +-- bounds checks can be toggled on during the build for debugging +-- purposes. It exports the entire API for the three array types +-- needed, and adds wrappers for the operations that are unchecked in +-- the base library. +-- +-- Checking is toggled using the `arraychecks` flag. +module Unison.Runtime.Array + ( module EPA, + byteArrayToList, + readArray, + writeArray, + copyArray, + copyMutableArray, + cloneMutableArray, + readByteArray, + writeByteArray, + indexByteArray, + copyByteArray, + copyMutableByteArray, + moveByteArray, + readPrimArray, + writePrimArray, + indexPrimArray, + ) +where + +import Control.Monad.Primitive +import Data.Kind (Constraint) +import Data.Primitive.Array as EPA hiding + ( cloneMutableArray, + copyArray, + copyMutableArray, + readArray, + writeArray, + ) +import Data.Primitive.Array qualified as PA +import Data.Primitive.ByteArray as EPA hiding + ( copyByteArray, + copyMutableByteArray, + indexByteArray, + moveByteArray, + readByteArray, + writeByteArray, + ) +import Data.Primitive.ByteArray qualified as PA +import Data.Primitive.PrimArray as EPA hiding + ( indexPrimArray, + readPrimArray, + writePrimArray, + ) +import Data.Primitive.PrimArray qualified as PA +import Data.Primitive.Types +import Data.Word (Word8) +import GHC.IsList (toList) + +#ifdef ARRAY_CHECK +import GHC.Stack + +type CheckCtx :: Constraint +type CheckCtx = HasCallStack + +type MA = MutableArray +type MBA = MutableByteArray +type A = Array +type BA = ByteArray + +-- check index mutable array +checkIMArray + :: CheckCtx + => String + -> (MA s a -> Int -> r) + -> MA s a -> Int -> r +checkIMArray name f arr i + | i < 0 || sizeofMutableArray arr <= i + = error $ name ++ " unsafe check out of bounds: " ++ show i + | otherwise = f arr i +{-# inline checkIMArray #-} + +-- check copy array +checkCArray + :: CheckCtx + => String + -> (MA s a -> Int -> A a -> Int -> Int -> r) + -> MA s a -> Int -> A a -> Int -> Int -> r +checkCArray name f dst d src s l + | d < 0 + || s < 0 + || sizeofMutableArray dst < d + l + || sizeofArray src < s + l + = error $ name ++ " unsafe check out of bounds: " ++ show (d, s, l) + | otherwise = f dst d src s l +{-# inline checkCArray #-} + +-- check copy mutable array +checkCMArray + :: CheckCtx + => String + -> (MA s a -> Int -> MA s a -> Int -> Int -> r) + -> MA s a -> Int -> MA s a -> Int -> Int -> r +checkCMArray name f dst d src s l + | d < 0 + || s < 0 + || sizeofMutableArray dst < d + l + || sizeofMutableArray src < s + l + = error $ name ++ " unsafe check out of bounds: " ++ show (d, s, l) + | otherwise = f dst d src s l +{-# inline checkCMArray #-} + +-- check range mutable array +checkRMArray + :: CheckCtx + => String + -> (MA s a -> Int -> Int -> r) + -> MA s a -> Int -> Int -> r +checkRMArray name f arr o l + | o < 0 || sizeofMutableArray arr < o+l + = error $ name ++ "unsafe check out of bounds: " ++ show (o, l) + | otherwise = f arr o l +{-# inline checkRMArray #-} + +-- check index byte array +checkIBArray + :: CheckCtx + => Prim a + => String + -> a + -> (ByteArray -> Int -> r) + -> ByteArray -> Int -> r +checkIBArray name a f arr i + | i < 0 || sizeofByteArray arr `quot` sizeOf a <= i + = error $ name ++ " unsafe check out of bounds: " ++ show i + | otherwise = f arr i +{-# inline checkIBArray #-} + +-- check index mutable byte array +checkIMBArray + :: CheckCtx + => Prim a + => PrimMonad m + => String + -> a + -> (MutableByteArray (PrimState m) -> Int -> m r) + -> MutableByteArray (PrimState m) -> Int -> m r +checkIMBArray name a f arr i = do + sz <- getSizeofMutableByteArray arr + if (i < 0 || sz `quot` sizeOf a <= i) + then error $ name ++ " unsafe check out of bounds: " ++ show i + else f arr i +{-# inline checkIMBArray #-} + +-- check write mutable byte array +checkWMBArray + :: CheckCtx + => Prim a + => PrimMonad m + => String + -> (MutableByteArray (PrimState m) -> Int -> a -> m r) + -> MutableByteArray (PrimState m) -> Int -> a -> m r +checkWMBArray name f arr i a = do + sz <- getSizeofMutableByteArray arr + if (i < 0 || sz `quot` sizeOf a <= i) + then error $ name ++ " unsafe check out of bounds: " ++ show i + else f arr i a +{-# inline checkWMBArray #-} + + +-- check copy byte array +checkCBArray + :: CheckCtx + => PrimMonad m + => String + -> (MBA (PrimState m) -> Int -> BA -> Int -> Int -> m r) + -> MBA (PrimState m) -> Int -> BA -> Int -> Int -> m r +checkCBArray name f dst d src s l = do + szd <- getSizeofMutableByteArray dst + if (d < 0 + || s < 0 + || szd < d + l + || sizeofByteArray src < s + l + ) then error $ name ++ " unsafe check out of bounds: " ++ show (d, s, l) + else f dst d src s l +{-# inline checkCBArray #-} + +-- check copy mutable byte array +checkCMBArray + :: CheckCtx + => PrimMonad m + => String + -> (MBA (PrimState m) -> Int -> MBA (PrimState m) -> Int -> Int -> m r) + -> MBA (PrimState m) -> Int -> MBA (PrimState m) -> Int -> Int -> m r +checkCMBArray name f dst d src s l = do + szd <- getSizeofMutableByteArray dst + szs <- getSizeofMutableByteArray src + if ( d < 0 + || s < 0 + || szd < d + l + || szs < s + l + ) then error $ name ++ " unsafe check out of bounds: " ++ show (d, s, l) + else f dst d src s l +{-# inline checkCMBArray #-} + +-- check index prim array +checkIPArray + :: CheckCtx + => Prim a + => String + -> (PrimArray a -> Int -> r) + -> PrimArray a -> Int -> r +checkIPArray name f arr i + | i < 0 || sizeofPrimArray arr <= i + = error $ name ++ " unsafe check out of bounds: " ++ show i + | otherwise = f arr i +{-# inline checkIPArray #-} + +-- check index mutable prim array +checkIMPArray + :: CheckCtx + => PrimMonad m + => Prim a + => String + -> (MutablePrimArray (PrimState m) a -> Int -> m r) + -> MutablePrimArray (PrimState m) a -> Int -> m r +checkIMPArray name f arr i = do + asz <- getSizeofMutablePrimArray arr + if (i < 0 || asz <= i) + then error $ name ++ " unsafe check out of bounds: " ++ show i + else f arr i +{-# inline checkIMPArray #-} + +-- check write mutable prim array +checkWMPArray + :: CheckCtx + => PrimMonad m + => Prim a + => String + -> (MutablePrimArray (PrimState m) a -> Int -> a -> m r) + -> MutablePrimArray (PrimState m) a -> Int -> a -> m r +checkWMPArray name f arr i a = do + asz <- getSizeofMutablePrimArray arr + if (i < 0 || asz <= i) + then error $ name ++ " unsafe check out of bounds: " ++ show i + else f arr i a +{-# inline checkWMPArray #-} + + +#else +type CheckCtx :: Constraint +type CheckCtx = () + +checkIMArray, checkIMPArray, checkWMPArray, checkIPArray :: String -> r -> r +checkCArray, checkCMArray, checkRMArray :: String -> r -> r +checkIMArray _ = id +checkIMPArray _ = id +checkWMPArray _ = id +checkCArray _ = id +checkCMArray _ = id +checkRMArray _ = id +checkIPArray _ = id + +checkIBArray, checkIMBArray:: String -> a -> r -> r +checkCBArray, checkCMBArray :: String -> r -> r +checkIBArray _ _ = id +checkIMBArray _ _ = id +checkCBArray _ = id +checkCMBArray _ = id + +checkWMBArray :: String -> r -> r +checkWMBArray _ = id +#endif + +readArray :: + (CheckCtx) => + (PrimMonad m) => + MutableArray (PrimState m) a -> + Int -> + m a +readArray = checkIMArray "readArray" PA.readArray +{-# INLINE readArray #-} + +writeArray :: + (CheckCtx) => + (PrimMonad m) => + MutableArray (PrimState m) a -> + Int -> + a -> + m () +writeArray = checkIMArray "writeArray" PA.writeArray +{-# INLINE writeArray #-} + +copyArray :: + (CheckCtx) => + (PrimMonad m) => + MutableArray (PrimState m) a -> + Int -> + Array a -> + Int -> + Int -> + m () +copyArray = checkCArray "copyArray" PA.copyArray +{-# INLINE copyArray #-} + +cloneMutableArray :: + (CheckCtx) => + (PrimMonad m) => + MutableArray (PrimState m) a -> + Int -> + Int -> + m (MutableArray (PrimState m) a) +cloneMutableArray = checkRMArray "cloneMutableArray" PA.cloneMutableArray +{-# INLINE cloneMutableArray #-} + +copyMutableArray :: + (CheckCtx) => + (PrimMonad m) => + MutableArray (PrimState m) a -> + Int -> + MutableArray (PrimState m) a -> + Int -> + Int -> + m () +copyMutableArray = checkCMArray "copyMutableArray" PA.copyMutableArray +{-# INLINE copyMutableArray #-} + +readByteArray :: + forall a m. + (CheckCtx) => + (PrimMonad m) => + (Prim a) => + MutableByteArray (PrimState m) -> + Int -> + m a +readByteArray = checkIMBArray @a "readByteArray" undefined PA.readByteArray +{-# INLINE readByteArray #-} + +writeByteArray :: + forall a m. + (CheckCtx) => + (PrimMonad m) => + (Prim a) => + MutableByteArray (PrimState m) -> + Int -> + a -> + m () +writeByteArray = checkWMBArray "writeByteArray" PA.writeByteArray +{-# INLINE writeByteArray #-} + +indexByteArray :: + forall a. + (CheckCtx) => + (Prim a) => + ByteArray -> + Int -> + a +indexByteArray = checkIBArray @a "indexByteArray" undefined PA.indexByteArray +{-# INLINE indexByteArray #-} + +copyByteArray :: + (CheckCtx) => + (PrimMonad m) => + MutableByteArray (PrimState m) -> + Int -> + ByteArray -> + Int -> + Int -> + m () +copyByteArray = checkCBArray "copyByteArray" PA.copyByteArray +{-# INLINE copyByteArray #-} + +copyMutableByteArray :: + (CheckCtx) => + (PrimMonad m) => + MutableByteArray (PrimState m) -> + Int -> + MutableByteArray (PrimState m) -> + Int -> + Int -> + m () +copyMutableByteArray = checkCMBArray "copyMutableByteArray" PA.copyMutableByteArray +{-# INLINE copyMutableByteArray #-} + +moveByteArray :: + (CheckCtx) => + (PrimMonad m) => + MutableByteArray (PrimState m) -> + Int -> + MutableByteArray (PrimState m) -> + Int -> + Int -> + m () +moveByteArray = checkCMBArray "moveByteArray" PA.moveByteArray +{-# INLINE moveByteArray #-} + +readPrimArray :: + (CheckCtx) => + (PrimMonad m) => + (Prim a) => + MutablePrimArray (PrimState m) a -> + Int -> + m a +readPrimArray = checkIMPArray "readPrimArray" PA.readPrimArray +{-# INLINE readPrimArray #-} + +writePrimArray :: + (CheckCtx) => + (PrimMonad m) => + (Prim a) => + MutablePrimArray (PrimState m) a -> + Int -> + a -> + m () +writePrimArray = checkWMPArray "writePrimArray" PA.writePrimArray +{-# INLINE writePrimArray #-} + +indexPrimArray :: + (CheckCtx) => + (Prim a) => + PrimArray a -> + Int -> + a +indexPrimArray = checkIPArray "indexPrimArray" PA.indexPrimArray +{-# INLINE indexPrimArray #-} + +byteArrayToList :: ByteArray -> [Word8] +byteArrayToList = toList diff --git a/unison-runtime/src/Unison/Runtime/Builtin.hs b/unison-runtime/src/Unison/Runtime/Builtin.hs new file mode 100644 index 0000000000..f073f54227 --- /dev/null +++ b/unison-runtime/src/Unison/Runtime/Builtin.hs @@ -0,0 +1,3314 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Unison.Runtime.Builtin + ( builtinLookup, + builtinTermNumbering, + builtinTypeNumbering, + builtinTermBackref, + builtinTypeBackref, + builtinForeigns, + builtinArities, + builtinInlineInfo, + sandboxedForeigns, + numberedTermLookup, + Sandbox (..), + baseSandboxInfo, + ) +where + +import Control.Concurrent (ThreadId) +import Control.Concurrent as SYS + ( killThread, + threadDelay, + ) +import Control.Concurrent.MVar as SYS +import Control.Concurrent.STM qualified as STM +import Control.DeepSeq (NFData) +import Control.Exception (evaluate) +import Control.Exception.Safe qualified as Exception +import Control.Monad.Catch (MonadCatch) +import Control.Monad.Primitive qualified as PA +import Control.Monad.Reader (ReaderT (..), ask, runReaderT) +import Control.Monad.State.Strict (State, execState, modify) +import Crypto.Error (CryptoError (..), CryptoFailable (..)) +import Crypto.Hash qualified as Hash +import Crypto.MAC.HMAC qualified as HMAC +import Crypto.PubKey.Ed25519 qualified as Ed25519 +import Crypto.PubKey.RSA.PKCS15 qualified as RSA +import Crypto.Random (getRandomBytes) +import Data.Bits (shiftL, shiftR, (.|.)) +import Data.ByteArray qualified as BA +import Data.ByteString (hGet, hGetSome, hPut) +import Data.ByteString.Lazy qualified as L +import Data.Default (def) +import Data.Digest.Murmur64 (asWord64, hash64) +import Data.IORef as SYS + ( IORef, + newIORef, + readIORef, + writeIORef, + ) +import Data.IP (IP) +import Data.Map qualified as Map +import Data.PEM (PEM, pemContent, pemParseLBS) +import Data.Set (insert) +import Data.Set qualified as Set +import Data.Text qualified +import Data.Text.IO qualified as Text.IO +import Data.Time.Clock.POSIX as SYS + ( getPOSIXTime, + posixSecondsToUTCTime, + utcTimeToPOSIXSeconds, + ) +import Data.Time.LocalTime (TimeZone (..), getTimeZone) +import Data.X509 qualified as X +import Data.X509.CertificateStore qualified as X +import Data.X509.Memory qualified as X +import GHC.Conc qualified as STM +import GHC.IO (IO (IO)) +import Network.Simple.TCP as SYS + ( HostPreference (..), + bindSock, + closeSock, + connectSock, + listenSock, + recv, + send, + ) +import Network.Socket as SYS + ( PortNumber, + Socket, + accept, + socketPort, + ) +import Network.TLS as TLS +import Network.TLS.Extra.Cipher as Cipher +import Network.UDP as UDP + ( ClientSockAddr, + ListenSocket, + UDPSocket (..), + clientSocket, + close, + recv, + recvFrom, + send, + sendTo, + serverSocket, + stop, + ) +import System.Clock (Clock (..), getTime, nsec, sec) +import System.Directory as SYS + ( createDirectoryIfMissing, + doesDirectoryExist, + doesPathExist, + getCurrentDirectory, + getDirectoryContents, + getFileSize, + getModificationTime, + getTemporaryDirectory, + removeDirectoryRecursive, + removeFile, + renameDirectory, + renameFile, + setCurrentDirectory, + ) +import System.Environment as SYS + ( getArgs, + getEnv, + ) +import System.Exit as SYS (ExitCode (..)) +import System.FilePath (isPathSeparator) +import System.IO (Handle) +import System.IO as SYS + ( IOMode (..), + hClose, + hGetBuffering, + hGetChar, + hGetEcho, + hIsEOF, + hIsOpen, + hIsSeekable, + hReady, + hSeek, + hSetBuffering, + hSetEcho, + hTell, + openFile, + stderr, + stdin, + stdout, + ) +import System.IO.Temp (createTempDirectory) +import System.Process as SYS + ( getProcessExitCode, + proc, + runInteractiveProcess, + terminateProcess, + waitForProcess, + withCreateProcess, + ) +import System.X509 qualified as X +import Unison.ABT.Normalized hiding (TTm) +import Unison.Builtin.Decls qualified as Ty +import Unison.Prelude hiding (Text, some) +import Unison.Reference +import Unison.Referent (Referent, pattern Ref) +import Unison.Runtime.ANF as ANF +import Unison.Runtime.ANF.Rehash (checkGroupHashes) +import Unison.Runtime.ANF.Serialize as ANF +import Unison.Runtime.Array qualified as PA +import Unison.Runtime.Builtin.Types +import Unison.Runtime.Crypto.Rsa as Rsa +import Unison.Runtime.Exception (die) +import Unison.Runtime.Foreign + ( Foreign (Wrap), + HashAlgorithm (..), + pattern Failure, + ) +import Unison.Runtime.Foreign qualified as F +import Unison.Runtime.Foreign.Function +import Unison.Runtime.Stack (UnboxedTypeTag (..), Val (..), emptyVal, unboxedTypeTagToInt) +import Unison.Runtime.Stack qualified as Closure +import Unison.Symbol +import Unison.Type qualified as Ty +import Unison.Util.Bytes qualified as Bytes +import Unison.Util.EnumContainers as EC +import Unison.Util.RefPromise + ( Promise, + Ticket, + casIORef, + newPromise, + peekTicket, + readForCAS, + readPromise, + tryReadPromise, + writePromise, + ) +import Unison.Util.Text (Text) +import Unison.Util.Text qualified as Util.Text +import Unison.Util.Text.Pattern qualified as TPat +import Unison.Var + +type Failure = F.Failure Val + +freshes :: (Var v) => Int -> [v] +freshes = freshes' mempty + +freshes' :: (Var v) => Set v -> Int -> [v] +freshes' avoid0 = go avoid0 [] + where + go _ vs 0 = vs + go avoid vs n = + let v = freshIn avoid $ typed ANFBlank + in go (insert v avoid) (v : vs) (n - 1) + +class Fresh t where fresh :: t + +fresh1 :: (Var v) => v +fresh1 = head $ freshes 1 + +instance (Var v) => Fresh (v, v) where + fresh = (v1, v2) + where + [v1, v2] = freshes 2 + +instance (Var v) => Fresh (v, v, v) where + fresh = (v1, v2, v3) + where + [v1, v2, v3] = freshes 3 + +instance (Var v) => Fresh (v, v, v, v) where + fresh = (v1, v2, v3, v4) + where + [v1, v2, v3, v4] = freshes 4 + +instance (Var v) => Fresh (v, v, v, v, v) where + fresh = (v1, v2, v3, v4, v5) + where + [v1, v2, v3, v4, v5] = freshes 5 + +instance (Var v) => Fresh (v, v, v, v, v, v) where + fresh = (v1, v2, v3, v4, v5, v6) + where + [v1, v2, v3, v4, v5, v6] = freshes 6 + +instance (Var v) => Fresh (v, v, v, v, v, v, v) where + fresh = (v1, v2, v3, v4, v5, v6, v7) + where + [v1, v2, v3, v4, v5, v6, v7] = freshes 7 + +instance (Var v) => Fresh (v, v, v, v, v, v, v, v) where + fresh = (v1, v2, v3, v4, v5, v6, v7, v8) + where + [v1, v2, v3, v4, v5, v6, v7, v8] = freshes 8 + +instance (Var v) => Fresh (v, v, v, v, v, v, v, v, v) where + fresh = (v1, v2, v3, v4, v5, v6, v7, v8, v9) + where + [v1, v2, v3, v4, v5, v6, v7, v8, v9] = freshes 9 + +instance (Var v) => Fresh (v, v, v, v, v, v, v, v, v, v) where + fresh = (v1, v2, v3, v4, v5, v6, v7, v8, v9, v10) + where + [v1, v2, v3, v4, v5, v6, v7, v8, v9, v10] = freshes 10 + +instance (Var v) => Fresh (v, v, v, v, v, v, v, v, v, v, v) where + fresh = (v1, v2, v3, v4, v5, v6, v7, v8, v9, v10, v11) + where + [v1, v2, v3, v4, v5, v6, v7, v8, v9, v10, v11] = freshes 11 + +instance (Var v) => Fresh (v, v, v, v, v, v, v, v, v, v, v, v, v) where + fresh = (v1, v2, v3, v4, v5, v6, v7, v8, v9, v10, v11, v12, v13) + where + [v1, v2, v3, v4, v5, v6, v7, v8, v9, v10, v11, v12, v13] = freshes 13 + +instance (Var v) => Fresh (v, v, v, v, v, v, v, v, v, v, v, v, v, v) where + fresh = (v1, v2, v3, v4, v5, v6, v7, v8, v9, v10, v11, v12, v13, v14) + where + [v1, v2, v3, v4, v5, v6, v7, v8, v9, v10, v11, v12, v13, v14] = freshes 14 + +fls, tru :: (Var v) => ANormal v +fls = TCon Ty.booleanRef 0 [] +tru = TCon Ty.booleanRef 1 [] + +none :: (Var v) => ANormal v +none = TCon Ty.optionalRef (fromIntegral Ty.noneId) [] + +some, left, right :: (Var v) => v -> ANormal v +some a = TCon Ty.optionalRef (fromIntegral Ty.someId) [a] +left x = TCon Ty.eitherRef (fromIntegral Ty.eitherLeftId) [x] +right x = TCon Ty.eitherRef (fromIntegral Ty.eitherRightId) [x] + +seqViewEmpty :: (Var v) => ANormal v +seqViewEmpty = TCon Ty.seqViewRef (fromIntegral Ty.seqViewEmpty) [] + +seqViewElem :: (Var v) => v -> v -> ANormal v +seqViewElem l r = TCon Ty.seqViewRef (fromIntegral Ty.seqViewElem) [l, r] + +boolift :: (Var v) => v -> ANormal v +boolift v = + TMatch v $ MatchIntegral (mapFromList [(0, fls), (1, tru)]) Nothing + +notlift :: (Var v) => v -> ANormal v +notlift v = + TMatch v $ MatchIntegral (mapFromList [(1, fls), (0, tru)]) Nothing + +unenum :: (Var v) => Int -> v -> Reference -> v -> ANormal v -> ANormal v +unenum n v0 r v nx = + TMatch v0 $ MatchData r cases Nothing + where + mkCase i = (toEnum i, ([], TLetD v UN (TLit . I $ fromIntegral i) nx)) + cases = mapFromList . fmap mkCase $ [0 .. n - 1] + +unop0 :: (Var v) => Int -> ([v] -> ANormal v) -> SuperNormal v +unop0 n f = + Lambda [BX] + . TAbss [x0] + $ f xs + where + xs@(x0 : _) = freshes (1 + n) + +binop0 :: (Var v) => Int -> ([v] -> ANormal v) -> SuperNormal v +binop0 n f = + Lambda [BX, BX] + . TAbss [x0, y0] + $ f xs + where + xs@(x0 : y0 : _) = freshes (2 + n) + +unop :: (Var v) => POp -> SuperNormal v +unop pop = + unop0 0 $ \[x] -> + (TPrm pop [x]) + +binop :: + (Var v) => + POp -> + SuperNormal v +binop pop = + binop0 0 $ \[x, y] -> TPrm pop [x, y] + +-- | Lift a comparison op. +cmpop :: (Var v) => POp -> SuperNormal v +cmpop pop = + binop0 1 $ \[x, y, b] -> + TLetD b UN (TPrm pop [x, y]) $ + boolift b + +-- | Like `cmpop`, but swaps the arguments. +cmpopb :: (Var v) => POp -> SuperNormal v +cmpopb pop = + binop0 1 $ \[x, y, b] -> + TLetD b UN (TPrm pop [y, x]) $ + boolift b + +-- | Like `cmpop`, but negates the result. +cmpopn :: (Var v) => POp -> SuperNormal v +cmpopn pop = + binop0 1 $ \[x, y, b] -> + TLetD b UN (TPrm pop [x, y]) $ + notlift b + +-- | Like `cmpop`, but swaps arguments then negates the result. +cmpopbn :: (Var v) => POp -> SuperNormal v +cmpopbn pop = + binop0 1 $ \[x, y, b] -> + TLetD b UN (TPrm pop [y, x]) $ + notlift b + +addi, subi, muli, divi, modi, shli, shri, powi :: (Var v) => SuperNormal v +addi = binop ADDI +subi = binop SUBI +muli = binop MULI +divi = binop DIVI +modi = binop MODI +shli = binop SHLI +shri = binop SHRI +powi = binop POWI + +addn, subn, muln, divn, modn, shln, shrn, pown :: (Var v) => SuperNormal v +addn = binop ADDN +subn = binop SUBN +muln = binop MULN +divn = binop DIVN +modn = binop MODN +shln = binop SHLN +shrn = binop SHRN +pown = binop POWN + +eqi, eqn, lti, ltn, lei, len :: (Var v) => SuperNormal v +eqi = cmpop EQLI +lti = cmpopbn LEQI +lei = cmpop LEQI +eqn = cmpop EQLN +ltn = cmpopbn LEQN +len = cmpop LEQN + +gti, gtn, gei, gen :: (Var v) => SuperNormal v +gti = cmpopn LEQI +gei = cmpopb LEQI +gtn = cmpopn LEQN +gen = cmpopb LEQN + +inci, incn :: (Var v) => SuperNormal v +inci = unop INCI +incn = unop INCN + +sgni, negi :: (Var v) => SuperNormal v +sgni = unop SGNI +negi = unop NEGI + +lzeron, tzeron, lzeroi, tzeroi, popn, popi :: (Var v) => SuperNormal v +lzeron = unop LZRO +tzeron = unop TZRO +popn = unop POPC +popi = unop POPC +lzeroi = unop LZRO +tzeroi = unop TZRO + +andn, orn, xorn, compln, andi, ori, xori, compli :: (Var v) => SuperNormal v +andn = binop ANDN +orn = binop IORN +xorn = binop XORN +compln = unop COMN +andi = binop ANDI +ori = binop IORI +xori = binop XORI +compli = unop COMI + +addf, + subf, + mulf, + divf, + powf, + sqrtf, + logf, + logbf :: + (Var v) => SuperNormal v +addf = binop ADDF +subf = binop SUBF +mulf = binop MULF +divf = binop DIVF +powf = binop POWF +sqrtf = unop SQRT +logf = unop LOGF +logbf = binop LOGB + +expf, absf :: (Var v) => SuperNormal v +expf = unop EXPF +absf = unop ABSF + +cosf, sinf, tanf, acosf, asinf, atanf :: (Var v) => SuperNormal v +cosf = unop COSF +sinf = unop SINF +tanf = unop TANF +acosf = unop ACOS +asinf = unop ASIN +atanf = unop ATAN + +coshf, + sinhf, + tanhf, + acoshf, + asinhf, + atanhf, + atan2f :: + (Var v) => SuperNormal v +coshf = unop COSH +sinhf = unop SINH +tanhf = unop TANH +acoshf = unop ACSH +asinhf = unop ASNH +atanhf = unop ATNH +atan2f = binop ATN2 + +ltf, gtf, lef, gef, eqf, neqf :: (Var v) => SuperNormal v +ltf = cmpopbn LEQF +gtf = cmpopn LEQF +lef = cmpop LEQF +gef = cmpopb LEQF +eqf = cmpop EQLF +neqf = cmpopn EQLF + +minf, maxf :: (Var v) => SuperNormal v +minf = binop MINF +maxf = binop MAXF + +ceilf, floorf, truncf, roundf, i2f, n2f :: (Var v) => SuperNormal v +ceilf = unop CEIL +floorf = unop FLOR +truncf = unop TRNF +roundf = unop RNDF +i2f = unop ITOF +n2f = unop NTOF + +trni :: (Var v) => SuperNormal v +trni = unop0 4 $ \[x, z, b, tag, n] -> + -- TODO: Do we need to do all calculations _before_ the branch? + -- Should probably just replace this with an instruction. + TLetD z UN (TLit $ N 0) + . TLetD b UN (TPrm LEQI [x, z]) + . TLetD tag UN (TLit $ I $ fromIntegral $ unboxedTypeTagToInt NatTag) + . TLetD n UN (TPrm CAST [x, tag]) + . TMatch b + $ MatchIntegral + (mapSingleton 1 $ TVar z) + (Just $ TVar n) + +modular :: (Var v) => POp -> (Bool -> ANormal v) -> SuperNormal v +modular pop ret = + unop0 2 $ \[x, m, t] -> + TLetD t UN (TLit $ I 2) + . TLetD m UN (TPrm pop [x, t]) + . TMatch m + $ MatchIntegral + (mapSingleton 1 $ ret True) + (Just $ ret False) + +evni, evnn, oddi, oddn :: (Var v) => SuperNormal v +evni = modular MODI (\b -> if b then fls else tru) +oddi = modular MODI (\b -> if b then tru else fls) +evnn = modular MODN (\b -> if b then fls else tru) +oddn = modular MODN (\b -> if b then tru else fls) + +dropn :: (Var v) => SuperNormal v +dropn = binop0 4 $ \[x, y, b, r, tag, n] -> + TLetD b UN (TPrm LEQN [x, y]) + -- TODO: Can we avoid this work until after the branch? + -- Should probably just replace this with an instruction. + . TLetD tag UN (TLit $ I $ fromIntegral $ unboxedTypeTagToInt NatTag) + . TLetD r UN (TPrm SUBN [x, y]) + . TLetD n UN (TPrm CAST [r, tag]) + $ ( TMatch b $ + MatchIntegral + (mapSingleton 1 $ TLit $ N 0) + (Just $ TVar n) + ) + +appendt, taket, dropt, indext, indexb, sizet, unconst, unsnoct :: (Var v) => SuperNormal v +appendt = binop0 0 $ \[x, y] -> TPrm CATT [x, y] +taket = binop0 0 $ \[x, y] -> + TPrm TAKT [x, y] +dropt = binop0 0 $ \[x, y] -> + TPrm DRPT [x, y] + +atb = binop0 2 $ \[n, b, t, r] -> + TLetD t UN (TPrm IDXB [n, b]) + . TMatch t + . MatchSum + $ mapFromList + [ (0, ([], none)), + ( 1, + ( [UN], + TAbs r $ some r + ) + ) + ] + +indext = binop0 2 $ \[x, y, t, r] -> + TLetD t UN (TPrm IXOT [x, y]) + . TMatch t + . MatchSum + $ mapFromList + [ (0, ([], none)), + ( 1, + ( [UN], + TAbs r $ some r + ) + ) + ] + +indexb = binop0 2 $ \[x, y, t, r] -> + TLetD t UN (TPrm IXOB [x, y]) + . TMatch t + . MatchSum + $ mapFromList + [ (0, ([], none)), + ( 1, + ( [UN], + TAbs r $ some r + ) + ) + ] + +sizet = unop0 0 $ \[x] -> TPrm SIZT [x] + +unconst = unop0 6 $ \[x, t, c, y, p, u, yp] -> + TLetD t UN (TPrm UCNS [x]) + . TMatch t + . MatchSum + $ mapFromList + [ (0, ([], none)), + ( 1, + ( [UN, BX], + TAbss [c, y] + . TLetD u BX (TCon Ty.unitRef 0 []) + . TLetD yp BX (TCon Ty.pairRef 0 [y, u]) + . TLetD p BX (TCon Ty.pairRef 0 [c, yp]) + $ some p + ) + ) + ] + +unsnoct = unop0 6 $ \[x, t, c, y, p, u, cp] -> + TLetD t UN (TPrm USNC [x]) + . TMatch t + . MatchSum + $ mapFromList + [ (0, ([], none)), + ( 1, + ( [BX, UN], + TAbss [y, c] + . TLetD u BX (TCon Ty.unitRef 0 []) + . TLetD cp BX (TCon Ty.pairRef 0 [c, u]) + . TLetD p BX (TCon Ty.pairRef 0 [y, cp]) + $ some p + ) + ) + ] + +appends, conss, snocs :: (Var v) => SuperNormal v +appends = binop0 0 $ \[x, y] -> TPrm CATS [x, y] +conss = binop0 0 $ \[x, y] -> TPrm CONS [x, y] +snocs = binop0 0 $ \[x, y] -> TPrm SNOC [x, y] + +takes, drops, sizes, ats, emptys :: (Var v) => SuperNormal v +takes = binop0 0 $ \[x, y] -> TPrm TAKS [x, y] +drops = binop0 0 $ \[x, y] -> TPrm DRPS [x, y] +sizes = unop0 0 $ \[x] -> (TPrm SIZS [x]) +ats = binop0 2 $ \[x, y, t, r] -> + TLetD t UN (TPrm IDXS [x, y]) + . TMatch t + . MatchSum + $ mapFromList + [ (0, ([], none)), + (1, ([BX], TAbs r $ some r)) + ] +emptys = Lambda [] $ TPrm BLDS [] + +viewls, viewrs :: (Var v) => SuperNormal v +viewls = unop0 3 $ \[s, u, h, t] -> + TLetD u UN (TPrm VWLS [s]) + . TMatch u + . MatchSum + $ mapFromList + [ (0, ([], seqViewEmpty)), + (1, ([BX, BX], TAbss [h, t] $ seqViewElem h t)) + ] +viewrs = unop0 3 $ \[s, u, i, l] -> + TLetD u UN (TPrm VWRS [s]) + . TMatch u + . MatchSum + $ mapFromList + [ (0, ([], seqViewEmpty)), + (1, ([BX, BX], TAbss [i, l] $ seqViewElem i l)) + ] + +splitls, splitrs :: (Var v) => SuperNormal v +splitls = binop0 3 $ \[n, s, t, l, r] -> + TLetD t UN (TPrm SPLL [n, s]) + . TMatch t + . MatchSum + $ mapFromList + [ (0, ([], seqViewEmpty)), + (1, ([BX, BX], TAbss [l, r] $ seqViewElem l r)) + ] +splitrs = binop0 3 $ \[n, s, t, l, r] -> + TLetD t UN (TPrm SPLR [n, s]) + . TMatch t + . MatchSum + $ mapFromList + [ (0, ([], seqViewEmpty)), + (1, ([BX, BX], TAbss [l, r] $ seqViewElem l r)) + ] + +eqt, neqt, leqt, geqt, lesst, great :: SuperNormal Symbol +eqt = binop0 1 $ \[x, y, b] -> + TLetD b UN (TPrm EQLT [x, y]) $ + boolift b +neqt = binop0 1 $ \[x, y, b] -> + TLetD b UN (TPrm EQLT [x, y]) $ + notlift b +leqt = binop0 1 $ \[x, y, b] -> + TLetD b UN (TPrm LEQT [x, y]) $ + boolift b +geqt = binop0 1 $ \[x, y, b] -> + TLetD b UN (TPrm LEQT [y, x]) $ + boolift b +lesst = binop0 1 $ \[x, y, b] -> + TLetD b UN (TPrm LEQT [y, x]) $ + notlift b +great = binop0 1 $ \[x, y, b] -> + TLetD b UN (TPrm LEQT [x, y]) $ + notlift b + +packt, unpackt :: SuperNormal Symbol +packt = unop0 0 $ \[s] -> TPrm PAKT [s] +unpackt = unop0 0 $ \[t] -> TPrm UPKT [t] + +packb, unpackb, emptyb, appendb :: SuperNormal Symbol +packb = unop0 0 $ \[s] -> TPrm PAKB [s] +unpackb = unop0 0 $ \[b] -> TPrm UPKB [b] +emptyb = + Lambda [] + . TLetD es BX (TPrm BLDS []) + $ TPrm PAKB [es] + where + es = fresh1 +appendb = binop0 0 $ \[x, y] -> TPrm CATB [x, y] + +takeb, dropb, atb, sizeb, flattenb :: SuperNormal Symbol +takeb = binop0 0 $ \[n, b] -> TPrm TAKB [n, b] +dropb = binop0 0 $ \[n, b] -> TPrm DRPB [n, b] +sizeb = unop0 0 $ \[b] -> (TPrm SIZB [b]) +flattenb = unop0 0 $ \[b] -> TPrm FLTB [b] + +i2t, n2t, f2t :: SuperNormal Symbol +i2t = unop0 0 $ \[n] -> TPrm ITOT [n] +n2t = unop0 0 $ \[n] -> TPrm NTOT [n] +f2t = unop0 0 $ \[f] -> TPrm FTOT [f] + +t2i, t2n, t2f :: SuperNormal Symbol +t2i = unop0 2 $ \[x, t, n] -> + TLetD t UN (TPrm TTOI [x]) + . TMatch t + . MatchSum + $ mapFromList + [ (0, ([], none)), + ( 1, + ( [UN], + TAbs n $ some n + ) + ) + ] +t2n = unop0 2 $ \[x, t, n] -> + TLetD t UN (TPrm TTON [x]) + . TMatch t + . MatchSum + $ mapFromList + [ (0, ([], none)), + ( 1, + ( [UN], + TAbs n $ some n + ) + ) + ] +t2f = unop0 2 $ \[x, t, f] -> + TLetD t UN (TPrm TTOF [x]) + . TMatch t + . MatchSum + $ mapFromList + [ (0, ([], none)), + ( 1, + ( [UN], + TAbs f $ some f + ) + ) + ] + +equ :: SuperNormal Symbol +equ = binop0 1 $ \[x, y, b] -> + TLetD b UN (TPrm EQLU [x, y]) $ + boolift b + +cmpu :: SuperNormal Symbol +cmpu = binop0 1 $ \[x, y, c] -> + TLetD c UN (TPrm CMPU [x, y]) $ + (TPrm DECI [c]) + +ltu :: SuperNormal Symbol +ltu = binop0 1 $ \[x, y, c] -> + TLetD c UN (TPrm CMPU [x, y]) + . TMatch c + $ MatchIntegral + (mapFromList [(0, TCon Ty.booleanRef 1 [])]) + (Just $ TCon Ty.booleanRef 0 []) + +gtu :: SuperNormal Symbol +gtu = binop0 1 $ \[x, y, c] -> + TLetD c UN (TPrm CMPU [x, y]) + . TMatch c + $ MatchIntegral + (mapFromList [(2, TCon Ty.booleanRef 1 [])]) + (Just $ TCon Ty.booleanRef 0 []) + +geu :: SuperNormal Symbol +geu = binop0 1 $ \[x, y, c] -> + TLetD c UN (TPrm CMPU [x, y]) + . TMatch c + $ MatchIntegral + (mapFromList [(0, TCon Ty.booleanRef 0 [])]) + (Just $ TCon Ty.booleanRef 1 []) + +leu :: SuperNormal Symbol +leu = binop0 1 $ \[x, y, c] -> + TLetD c UN (TPrm CMPU [x, y]) + . TMatch c + $ MatchIntegral + (mapFromList [(2, TCon Ty.booleanRef 0 [])]) + (Just $ TCon Ty.booleanRef 1 []) + +notb :: SuperNormal Symbol +notb = unop0 0 $ \[b] -> + TMatch b . flip (MatchData Ty.booleanRef) Nothing $ + mapFromList [(0, ([], tru)), (1, ([], fls))] + +orb :: SuperNormal Symbol +orb = binop0 0 $ \[p, q] -> + TMatch p . flip (MatchData Ty.booleanRef) Nothing $ + mapFromList [(1, ([], tru)), (0, ([], TVar q))] + +andb :: SuperNormal Symbol +andb = binop0 0 $ \[p, q] -> + TMatch p . flip (MatchData Ty.booleanRef) Nothing $ + mapFromList [(0, ([], fls)), (1, ([], TVar q))] + +-- A runtime type-cast. Used to unsafely coerce between unboxed +-- types at runtime without changing their representation. +coerceType :: UnboxedTypeTag -> SuperNormal Symbol +coerceType destType = + unop0 1 $ \[v, tag] -> + TLetD tag UN (TLit $ I $ fromIntegral $ unboxedTypeTagToInt destType) $ + TPrm CAST [v, tag] + +-- This version of unsafeCoerce is the identity function. It works +-- only if the two types being coerced between are actually the same, +-- because it keeps the same representation. It is not capable of +-- e.g. correctly translating between two types with compatible bit +-- representations, because tagging information will be retained. +poly'coerce :: SuperNormal Symbol +poly'coerce = unop0 0 $ \[x] -> TVar x + +jumpk :: SuperNormal Symbol +jumpk = binop0 0 $ \[k, a] -> TKon k [a] + +scope'run :: SuperNormal Symbol +scope'run = + unop0 1 $ \[e, un] -> + TLetD un BX (TCon Ty.unitRef 0 []) $ + TApp (FVar e) [un] + +fork'comp :: SuperNormal Symbol +fork'comp = + Lambda [BX] + . TAbs act + . TLetD unit BX (TCon Ty.unitRef 0 []) + . TName lz (Right act) [unit] + $ TPrm FORK [lz] + where + (act, unit, lz) = fresh + +try'eval :: SuperNormal Symbol +try'eval = + Lambda [BX] + . TAbs act + . TLetD unit BX (TCon Ty.unitRef 0 []) + . TName lz (Right act) [unit] + . TLetD ta UN (TPrm TFRC [lz]) + . TMatch ta + . MatchSum + $ mapFromList + [ exnCase lnk msg xtra any fail, + (1, ([BX], TAbs r (TVar r))) + ] + where + (act, unit, lz, ta, lnk, msg, xtra, any, fail, r) = fresh + +bug :: Util.Text.Text -> SuperNormal Symbol +bug name = + unop0 1 $ \[x, n] -> + TLetD n BX (TLit $ T name) $ + TPrm EROR [n, x] + +watch :: SuperNormal Symbol +watch = + binop0 0 $ \[t, v] -> + TLets Direct [] [] (TPrm PRNT [t]) $ + TVar v + +raise :: SuperNormal Symbol +raise = + unop0 3 $ \[r, f, n, k] -> + TMatch r + . flip MatchRequest (TAbs f $ TVar f) + . Map.singleton Ty.exceptionRef + $ mapSingleton + 0 + ( [BX], + TAbs f + . TShift Ty.exceptionRef k + . TLetD n BX (TLit $ T "builtin.raise") + $ TPrm EROR [n, f] + ) + +gen'trace :: SuperNormal Symbol +gen'trace = + binop0 0 $ \[t, v] -> + TLets Direct [] [] (TPrm TRCE [t, v]) $ + TCon Ty.unitRef 0 [] + +debug'text :: SuperNormal Symbol +debug'text = + unop0 3 $ \[c, r, t, e] -> + TLetD r UN (TPrm DBTX [c]) + . TMatch r + . MatchSum + $ mapFromList + [ (0, ([], none)), + (1, ([BX], TAbs t . TLetD e BX (left t) $ some e)), + (2, ([BX], TAbs t . TLetD e BX (right t) $ some e)) + ] + +code'missing :: SuperNormal Symbol +code'missing = + unop0 1 $ \[link, b] -> + TLetD b UN (TPrm MISS [link]) $ + boolift b + +code'cache :: SuperNormal Symbol +code'cache = unop0 0 $ \[new] -> TPrm CACH [new] + +code'lookup :: SuperNormal Symbol +code'lookup = + unop0 2 $ \[link, t, r] -> + TLetD t UN (TPrm LKUP [link]) + . TMatch t + . MatchSum + $ mapFromList + [ (0, ([], none)), + (1, ([BX], TAbs r $ some r)) + ] + +code'validate :: SuperNormal Symbol +code'validate = + unop0 6 $ \[item, t, ref, msg, extra, any, fail] -> + TLetD t UN (TPrm CVLD [item]) + . TMatch t + . MatchSum + $ mapFromList + [ ( 1, + ([BX, BX, BX],) + . TAbss [ref, msg, extra] + . TLetD any BX (TCon Ty.anyRef 0 [extra]) + . TLetD fail BX (TCon Ty.failureRef 0 [ref, msg, any]) + $ some fail + ), + ( 0, + ([],) $ + none + ) + ] + +term'link'to'text :: SuperNormal Symbol +term'link'to'text = + unop0 0 $ \[link] -> TPrm TLTT [link] + +value'load :: SuperNormal Symbol +value'load = + unop0 2 $ \[vlu, t, r] -> + TLetD t UN (TPrm LOAD [vlu]) + . TMatch t + . MatchSum + $ mapFromList + [ (0, ([BX], TAbs r $ left r)), + (1, ([BX], TAbs r $ right r)) + ] + +value'create :: SuperNormal Symbol +value'create = unop0 0 $ \[x] -> TPrm VALU [x] + +check'sandbox :: SuperNormal Symbol +check'sandbox = + Lambda [BX, BX] + . TAbss [refs, val] + . TLetD b UN (TPrm SDBX [refs, val]) + $ boolift b + where + (refs, val, b) = fresh + +sandbox'links :: SuperNormal Symbol +sandbox'links = Lambda [BX] . TAbs ln $ TPrm SDBL [ln] + where + ln = fresh1 + +value'sandbox :: SuperNormal Symbol +value'sandbox = + Lambda [BX, BX] + . TAbss [refs, val] + $ TPrm SDBV [refs, val] + where + (refs, val) = fresh + +stm'atomic :: SuperNormal Symbol +stm'atomic = + Lambda [BX] + . TAbs act + . TLetD unit BX (TCon Ty.unitRef 0 []) + . TName lz (Right act) [unit] + $ TPrm ATOM [lz] + where + (act, unit, lz) = fresh + +type ForeignOp = FOp -> ([Mem], ANormal Symbol) + +standard'handle :: ForeignOp +standard'handle instr = + ([BX],) + . TAbss [h0] + . unenum 3 h0 Ty.stdHandleRef h + $ TFOp instr [h] + where + (h0, h) = fresh + +any'construct :: SuperNormal Symbol +any'construct = + unop0 0 $ \[v] -> + TCon Ty.anyRef 0 [v] + +any'extract :: SuperNormal Symbol +any'extract = + unop0 1 $ + \[v, v1] -> + TMatch v $ + MatchData Ty.anyRef (mapSingleton 0 $ ([BX], TAbs v1 (TVar v1))) Nothing + +seek'handle :: ForeignOp +seek'handle instr = + ([BX, BX, BX],) + . TAbss [arg1, arg2, arg3] + . unenum 3 arg2 Ty.seekModeRef seek + . TLetD result UN (TFOp instr [arg1, seek, arg3]) + $ outIoFailUnit stack1 stack2 stack3 unit fail result + where + (arg1, arg2, arg3, seek, stack1, stack2, stack3, unit, fail, result) = fresh + +no'buf, line'buf, block'buf, sblock'buf :: (Enum e) => e +no'buf = toEnum $ fromIntegral Ty.bufferModeNoBufferingId +line'buf = toEnum $ fromIntegral Ty.bufferModeLineBufferingId +block'buf = toEnum $ fromIntegral Ty.bufferModeBlockBufferingId +sblock'buf = toEnum $ fromIntegral Ty.bufferModeSizedBlockBufferingId + +infixr 0 --> + +(-->) :: a -> b -> (a, b) +x --> y = (x, y) + +time'zone :: ForeignOp +time'zone instr = + ([BX],) + . TAbss [secs] + . TLets Direct [offset, summer, name] [UN, UN, BX] (TFOp instr [secs]) + . TLetD un BX (TCon Ty.unitRef 0 []) + . TLetD p2 BX (TCon Ty.pairRef 0 [name, un]) + . TLetD p1 BX (TCon Ty.pairRef 0 [summer, p2]) + $ TCon Ty.pairRef 0 [offset, p1] + where + (secs, offset, summer, name, un, p2, p1) = fresh + +start'process :: ForeignOp +start'process instr = + ([BX, BX],) + . TAbss [exe, args] + . TLets Direct [hin, hout, herr, hproc] [BX, BX, BX, BX] (TFOp instr [exe, args]) + . TLetD un BX (TCon Ty.unitRef 0 []) + . TLetD p3 BX (TCon Ty.pairRef 0 [hproc, un]) + . TLetD p2 BX (TCon Ty.pairRef 0 [herr, p3]) + . TLetD p1 BX (TCon Ty.pairRef 0 [hout, p2]) + $ TCon Ty.pairRef 0 [hin, p1] + where + (exe, args, hin, hout, herr, hproc, un, p3, p2, p1) = fresh + +set'buffering :: ForeignOp +set'buffering instr = + ([BX, BX],) + . TAbss [handle, bmode] + . TMatch bmode + . MatchDataCover Ty.bufferModeRef + $ mapFromList + [ no'buf --> [] --> k1 no'buf, + line'buf --> [] --> k1 line'buf, + block'buf --> [] --> k1 block'buf, + sblock'buf + --> [BX] + --> TAbs n + . TMatch n + . MatchDataCover Ty.bufferModeRef + $ mapFromList + [ 0 + --> [UN] + --> TAbs w + . TLetD tag UN (TLit (N sblock'buf)) + $ k2 [tag, w] + ] + ] + where + k1 num = + TLetD tag UN (TLit (N num)) $ + k2 [tag] + k2 args = + TLetD r UN (TFOp instr (handle : args)) $ + outIoFailUnit s1 s2 s3 u f r + (handle, bmode, tag, n, w, s1, s2, s3, u, f, r) = fresh + +get'buffering'output :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> v -> v -> ANormal v +get'buffering'output eitherResult stack1 stack2 stack3 resultTag anyVar failVar successVar = + TMatch eitherResult . MatchSum $ + mapFromList + [ failureCase stack1 stack2 stack3 anyVar failVar, + ( 1, + ([UN],) + . TAbs resultTag + . TMatch resultTag + . MatchSum + $ mapFromList + [ no'buf + --> [] + --> TLetD successVar BX (TCon Ty.bufferModeRef no'buf []) + $ right successVar, + line'buf + --> [] + --> TLetD successVar BX (TCon Ty.bufferModeRef line'buf []) + $ right successVar, + block'buf + --> [] + --> TLetD successVar BX (TCon Ty.bufferModeRef block'buf []) + $ right successVar, + sblock'buf + --> [UN] + --> TAbs stack1 + . TLetD successVar BX (TCon Ty.bufferModeRef sblock'buf [stack1]) + $ right successVar + ] + ) + ] + +get'buffering :: ForeignOp +get'buffering = + in1 arg1 eitherResult $ + get'buffering'output eitherResult n n2 n3 resultTag anyVar failVar successVar + where + (arg1, eitherResult, n, n2, n3, resultTag, anyVar, failVar, successVar) = fresh + +crypto'hash :: ForeignOp +crypto'hash instr = + ([BX, BX],) + . TAbss [alg, x] + . TLetD vl BX (TPrm VALU [x]) + $ TFOp instr [alg, vl] + where + (alg, x, vl) = fresh + +murmur'hash :: ForeignOp +murmur'hash instr = + ([BX],) + . TAbss [x] + . TLetD vl BX (TPrm VALU [x]) + $ TFOp instr [vl] + where + (x, vl) = fresh + +crypto'hmac :: ForeignOp +crypto'hmac instr = + ([BX, BX, BX],) + . TAbss [alg, by, x] + . TLetD vl BX (TPrm VALU [x]) + $ TFOp instr [alg, by, vl] + where + (alg, by, x, vl) = fresh + +-- Input Shape -- these represent different argument lists a +-- foreign might expect +-- +-- They are named according to their shape: +-- inUnit : one input arg, unit output +-- in1 : one input arg +-- +-- All of these functions will have take (at least) the same three arguments +-- +-- instr : the foreign instruction to call +-- result : a variable containing the result of the foreign call +-- cont : a term which will be evaluated when a result from the foreign call is on the stack +-- + +-- () -> ... +inUnit :: forall v. (Var v) => v -> v -> ANormal v -> FOp -> ([Mem], ANormal v) +inUnit unit result cont instr = + ([BX], TAbs unit $ TLetD result UN (TFOp instr []) cont) + +inN :: forall v. (Var v) => [v] -> v -> ANormal v -> FOp -> ([Mem], ANormal v) +inN args result cont instr = + (args $> BX,) + . TAbss args + $ TLetD result UN (TFOp instr args) cont + +-- a -> ... +in1 :: forall v. (Var v) => v -> v -> ANormal v -> FOp -> ([Mem], ANormal v) +in1 arg result cont instr = inN [arg] result cont instr + +-- a -> b -> ... +in2 :: forall v. (Var v) => v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v) +in2 arg1 arg2 result cont instr = inN [arg1, arg2] result cont instr + +-- a -> b -> c -> ... +in3 :: forall v. (Var v) => v -> v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v) +in3 arg1 arg2 arg3 result cont instr = inN [arg1, arg2, arg3] result cont instr + +-- Maybe a -> b -> ... +inMaybeBx :: forall v. (Var v) => v -> v -> v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v) +inMaybeBx arg1 arg2 arg3 mb result cont instr = + ([BX, BX],) + . TAbss [arg1, arg2] + . TMatch arg1 + . flip (MatchData Ty.optionalRef) Nothing + $ mapFromList + [ ( fromIntegral Ty.noneId, + ( [], + TLetD mb UN (TLit $ I 0) $ + TLetD result UN (TFOp instr [mb, arg2]) cont + ) + ), + (fromIntegral Ty.someId, ([BX], TAbs arg3 . TLetD mb UN (TLit $ I 1) $ TLetD result UN (TFOp instr [mb, arg3, arg2]) cont)) + ] + +set'echo :: ForeignOp +set'echo instr = + ([BX, BX],) + . TAbss [arg1, arg2] + . unenum 2 arg2 Ty.booleanRef bol + . TLetD result UN (TFOp instr [arg1, bol]) + $ outIoFailUnit stack1 stack2 stack3 unit fail result + where + (arg1, arg2, bol, stack1, stack2, stack3, unit, fail, result) = fresh + +-- a -> IOMode -> ... +inIomr :: forall v. (Var v) => v -> v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v) +inIomr arg1 arg2 fm result cont instr = + ([BX, BX],) + . TAbss [arg1, arg2] + . unenum 4 arg2 Ty.fileModeRef fm + $ TLetD result UN (TFOp instr [arg1, fm]) cont + +-- Output Shape -- these will represent different ways of translating +-- the result of a foreign call to a Unison Term +-- +-- They will be named according to the output type +-- outInt : a foreign function returning an Int +-- outBool : a foreign function returning a boolean +-- outIOFail : a function returning (Either Failure a) +-- +-- All of these functions will take a Var named result containing the +-- result of the foreign call +-- + +outMaybe :: forall v. (Var v) => v -> v -> ANormal v +outMaybe tag result = + TMatch tag . MatchSum $ + mapFromList + [ (0, ([], none)), + (1, ([BX], TAbs result $ some result)) + ] + +outMaybeNTup :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v +outMaybeNTup a b u bp p result = + TMatch result . MatchSum $ + mapFromList + [ (0, ([], none)), + ( 1, + ( [UN, BX], + TAbss [a, b] + . TLetD u BX (TCon Ty.unitRef 0 []) + . TLetD bp BX (TCon Ty.pairRef 0 [b, u]) + . TLetD p BX (TCon Ty.pairRef 0 [a, bp]) + $ some p + ) + ) + ] + +outMaybeTup :: (Var v) => v -> v -> v -> v -> v -> v -> ANormal v +outMaybeTup a b u bp ap result = + TMatch result . MatchSum $ + mapFromList + [ (0, ([], none)), + ( 1, + ( [BX, BX], + TAbss [a, b] + . TLetD u BX (TCon Ty.unitRef 0 []) + . TLetD bp BX (TCon Ty.pairRef 0 [b, u]) + . TLetD ap BX (TCon Ty.pairRef 0 [a, bp]) + $ some ap + ) + ) + ] + +-- Note: the Io part doesn't really do anything. There's no actual +-- representation of `IO`. +outIoFail :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v +outIoFail stack1 stack2 stack3 any fail result = + TMatch result . MatchSum $ + mapFromList + [ failureCase stack1 stack2 stack3 any fail, + (1, ([BX], TAbs stack1 $ right stack1)) + ] + +outIoFailChar :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v +outIoFailChar stack1 stack2 stack3 fail extra result = + TMatch result . MatchSum $ + mapFromList + [ failureCase stack1 stack2 stack3 extra fail, + ( 1, + ([UN],) + . TAbs extra + $ right extra + ) + ] + +failureCase :: + (Var v) => v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v)) +failureCase stack1 stack2 stack3 any fail = + (0,) + . ([BX, BX, BX],) + . TAbss [stack1, stack2, stack3] + . TLetD any BX (TCon Ty.anyRef 0 [stack3]) + . TLetD fail BX (TCon Ty.failureRef 0 [stack1, stack2, any]) + $ left fail + +exnCase :: + (Var v) => v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v)) +exnCase stack1 stack2 stack3 any fail = + (0,) + . ([BX, BX, BX],) + . TAbss [stack1, stack2, stack3] + . TLetD any BX (TCon Ty.anyRef 0 [stack3]) + . TLetD fail BX (TCon Ty.failureRef 0 [stack1, stack2, any]) + $ TReq Ty.exceptionRef 0 [fail] + +outIoExnUnit :: + forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v +outIoExnUnit stack1 stack2 stack3 any fail result = + TMatch result . MatchSum $ + mapFromList + [ exnCase stack1 stack2 stack3 any fail, + (1, ([], TCon Ty.unitRef 0 [])) + ] + +outIoExn :: + (Var v) => v -> v -> v -> v -> v -> v -> ANormal v +outIoExn stack1 stack2 stack3 any fail result = + TMatch result . MatchSum $ + mapFromList + [ exnCase stack1 stack2 stack3 any fail, + (1, ([BX], TAbs stack1 $ TVar stack1)) + ] + +outIoExnEither :: + (Var v) => v -> v -> v -> v -> v -> v -> v -> v -> ANormal v +outIoExnEither stack1 stack2 stack3 any fail t0 t1 res = + TMatch t0 . MatchSum $ + mapFromList + [ exnCase stack1 stack2 stack3 any fail, + ( 1, + ([UN],) + . TAbs t1 + . TMatch t1 + . MatchSum + $ mapFromList + [ (0, ([BX], TAbs res $ left res)), + (1, ([BX], TAbs res $ right res)) + ] + ) + ] + +outIoFailUnit :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v +outIoFailUnit stack1 stack2 stack3 extra fail result = + TMatch result . MatchSum $ + mapFromList + [ failureCase stack1 stack2 stack3 extra fail, + ( 1, + ([],) + . TLetD extra BX (TCon Ty.unitRef 0 []) + $ right extra + ) + ] + +outIoFailBool :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v +outIoFailBool stack1 stack2 stack3 extra fail result = + TMatch result . MatchSum $ + mapFromList + [ failureCase stack1 stack2 stack3 extra fail, + ( 1, + ([UN],) + . TAbs stack3 + . TLet (Indirect 1) extra BX (boolift stack3) + $ right extra + ) + ] + +outIoFailTup :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> v -> v -> ANormal v +outIoFailTup stack1 stack2 stack3 stack4 stack5 extra fail result = + TMatch result . MatchSum $ + mapFromList + [ failureCase stack1 stack2 stack3 extra fail, + ( 1, + ( [BX, BX], + TAbss [stack1, stack2] + . TLetD stack3 BX (TCon Ty.unitRef 0 []) + . TLetD stack4 BX (TCon Ty.pairRef 0 [stack2, stack3]) + . TLetD stack5 BX (TCon Ty.pairRef 0 [stack1, stack4]) + $ right stack5 + ) + ) + ] + +outIoFailG :: + (Var v) => + v -> + v -> + v -> + v -> + v -> + v -> + ((ANormal v -> ANormal v) -> ([Mem], ANormal v)) -> + ANormal v +outIoFailG stack1 stack2 stack3 fail result output k = + TMatch result . MatchSum $ + mapFromList + [ failureCase stack1 stack2 stack3 output fail, + ( 1, + k $ \t -> + TLetD output BX t $ + right output + ) + ] + +-- Input / Output glue +-- +-- These are pairings of input and output functions to handle a +-- foreign call. The input function represents the numbers and types +-- of the inputs to a foreign call. The output function takes the +-- result of the foreign call and turns it into a Unison type. +-- + +-- a +direct :: ForeignOp +direct instr = ([], TFOp instr []) + +-- () -> r +unitToR :: ForeignOp +unitToR = + inUnit unit result $ TVar result + where + (unit, result) = fresh + +-- () -> Either Failure a +unitToEF :: ForeignOp +unitToEF = + inUnit unit result $ + outIoFail stack1 stack2 stack3 any fail result + where + (unit, stack1, stack2, stack3, fail, any, result) = fresh + +argIomrToEF :: ForeignOp +argIomrToEF = + inIomr arg1 arg2 enum result $ + outIoFail stack1 stack2 stack3 any fail result + where + (arg1, arg2, enum, stack1, stack2, stack3, any, fail, result) = fresh + +-- a -> () +argToUnit :: ForeignOp +argToUnit = in1 arg result (TCon Ty.unitRef 0 []) + where + (arg, result) = fresh + +-- a -> b ->{E} () +arg2To0 :: ForeignOp +arg2To0 instr = + ([BX, BX],) + . TAbss [arg1, arg2] + . TLets Direct [] [] (TFOp instr [arg1, arg2]) + $ TCon Ty.unitRef 0 [] + where + (arg1, arg2) = fresh + +-- ... -> Bool +argNToBool :: Int -> ForeignOp +argNToBool n instr = + (replicate n BX,) + . TAbss args + $ TLetD result UN (TFOp instr args) (boolift result) + where + (result : args) = freshes (n + 1) + +argNDirect :: Int -> ForeignOp +argNDirect n instr = + (replicate n BX,) + . TAbss args + $ TFOp instr args + where + args = freshes n + +-- () -> a +-- +-- Unit is unique in that we don't actually pass it as an arg +unitDirect :: ForeignOp +unitDirect instr = ([BX],) . TAbs arg $ TFOp instr [] where arg = fresh1 + +-- a -> Either Failure b +argToEF :: ForeignOp +argToEF = + in1 arg result $ + outIoFail stack1 stack2 stack3 any fail result + where + (arg, result, stack1, stack2, stack3, any, fail) = fresh + +-- a -> Either Failure (b, c) +argToEFTup :: ForeignOp +argToEFTup = + in1 arg result $ + outIoFailTup stack1 stack2 stack3 stack4 stack5 extra fail result + where + (arg, result, stack1, stack2, stack3, stack4, stack5, extra, fail) = fresh + +-- a -> Either Failure (Maybe b) +argToEFM :: ForeignOp +argToEFM = + in1 arg result + . outIoFailG stack1 stack2 stack3 fail result output + $ \k -> + ( [UN], + TAbs stack3 . TMatch stack3 . MatchSum $ + mapFromList + [ (0, ([], k $ none)), + (1, ([BX], TAbs stack4 . k $ some stack4)) + ] + ) + where + (arg, result, stack1, stack2, stack3, stack4, fail, output) = fresh + +-- a -> Maybe b +argToMaybe :: ForeignOp +argToMaybe = in1 arg tag $ outMaybe tag result + where + (arg, tag, result) = fresh + +-- a -> Maybe (Nat, b) +argToMaybeNTup :: ForeignOp +argToMaybeNTup = + in1 arg result $ outMaybeNTup a b u bp p result + where + (arg, a, b, u, bp, p, result) = fresh + +-- a -> b -> Maybe (c, d) +arg2ToMaybeTup :: ForeignOp +arg2ToMaybeTup = + in2 arg1 arg2 result $ outMaybeTup a b u bp ap result + where + (arg1, arg2, a, b, u, bp, ap, result) = fresh + +-- a -> Either Failure Bool +argToEFBool :: ForeignOp +argToEFBool = + in1 arg result $ + outIoFailBool stack1 stack2 stack3 bool fail result + where + (arg, stack1, stack2, stack3, bool, fail, result) = fresh + +-- a -> Either Failure Char +argToEFChar :: ForeignOp +argToEFChar = + in1 arg result $ + outIoFailChar stack1 stack2 stack3 bool fail result + where + (arg, stack1, stack2, stack3, bool, fail, result) = fresh + +-- a -> b -> Either Failure Bool +arg2ToEFBool :: ForeignOp +arg2ToEFBool = + in2 arg1 arg2 result $ + outIoFailBool stack1 stack2 stack3 bool fail result + where + (arg1, arg2, stack1, stack2, stack3, bool, fail, result) = fresh + +-- a -> b -> c -> Either Failure Bool +arg3ToEFBool :: ForeignOp +arg3ToEFBool = + in3 arg1 arg2 arg3 result $ + outIoFailBool stack1 stack2 stack3 bool fail result + where + (arg1, arg2, arg3, stack1, stack2, stack3, bool, fail, result) = fresh + +-- a -> Either Failure () +argToEF0 :: ForeignOp +argToEF0 = + in1 arg result $ + outIoFailUnit stack1 stack2 stack3 unit fail result + where + (arg, result, stack1, stack2, stack3, unit, fail) = fresh + +-- a -> b -> Either Failure () +arg2ToEF0 :: ForeignOp +arg2ToEF0 = + in2 arg1 arg2 result $ + outIoFailUnit stack1 stack2 stack3 fail unit result + where + (arg1, arg2, result, stack1, stack2, stack3, fail, unit) = fresh + +-- a -> b -> c -> Either Failure () +arg3ToEF0 :: ForeignOp +arg3ToEF0 = + in3 arg1 arg2 arg3 result $ + outIoFailUnit stack1 stack2 stack3 fail unit result + where + (arg1, arg2, arg3, result, stack1, stack2, stack3, fail, unit) = fresh + +-- a -> Either Failure b +argToEFNat :: ForeignOp +argToEFNat = + in1 arg result $ + outIoFail stack1 stack2 stack3 nat fail result + where + (arg, result, stack1, stack2, stack3, nat, fail) = fresh + +-- Maybe a -> b -> Either Failure c +maybeToEF :: ForeignOp +maybeToEF = + inMaybeBx arg1 arg2 arg3 mb result $ + outIoFail stack1 stack2 stack3 any fail result + where + (arg1, arg2, arg3, mb, result, stack1, stack2, stack3, any, fail) = fresh + +-- a -> b -> Either Failure c +arg2ToEF :: ForeignOp +arg2ToEF = + in2 arg1 arg2 result $ + outIoFail stack1 stack2 stack3 any fail result + where + (arg1, arg2, result, stack1, stack2, stack3, any, fail) = fresh + +-- a -> b -> c -> Either Failure d +arg3ToEF :: ForeignOp +arg3ToEF = + in3 arg1 arg2 arg3 result $ + outIoFail stack1 stack2 stack3 any fail result + where + (arg1, arg2, arg3, result, stack1, stack2, stack3, any, fail) = fresh + +-- a -> b ->{Exception} c +arg2ToExn :: ForeignOp +arg2ToExn = + in2 arg1 arg2 result $ + outIoExn stack1 stack2 stack3 any fail result + where + (arg1, arg2, stack1, stack2, stack3, any, fail, result) = fresh + +-- a -> b -> c ->{Exception} () +arg3ToExnUnit :: ForeignOp +arg3ToExnUnit = + in3 arg1 arg2 arg3 result $ + outIoExnUnit stack1 stack2 stack3 any fail result + where + (arg1, arg2, arg3, stack1, stack2, stack3, any, fail, result) = fresh + +-- a -> Nat -> Nat ->{Exception} b +arg3ToExn :: ForeignOp +arg3ToExn = + in3 arg1 arg2 arg3 result $ + outIoExn stack1 stack2 stack3 any fail result + where + (arg1, arg2, arg3, result, stack1, stack2, stack3, any, fail) = fresh + +-- a -> Nat -> b -> Nat -> Nat ->{Exception} () +arg5ToExnUnit :: ForeignOp +arg5ToExnUnit instr = + ([BX, BX, BX, BX, BX],) + . TAbss [a0, ua1, a2, ua3, ua4] + . TLetD result UN (TFOp instr [a0, ua1, a2, ua3, ua4]) + $ outIoExnUnit stack1 stack2 stack3 any fail result + where + (a0, a2, ua1, ua3, ua4, result, stack1, stack2, stack3, any, fail) = fresh + +-- a ->{Exception} Either b c +argToExnE :: ForeignOp +argToExnE instr = + ([BX],) + . TAbs a + . TLetD t0 UN (TFOp instr [a]) + $ outIoExnEither stack1 stack2 stack3 any fail t0 t1 result + where + (a, stack1, stack2, stack3, any, fail, t0, t1, result) = fresh + +-- Nat -> Either Failure () +argToEFUnit :: ForeignOp +argToEFUnit = + in1 nat result + . TMatch result + . MatchSum + $ mapFromList + [ failureCase stack1 stack2 stack3 unit fail, + ( 1, + ([],) + . TLetD unit BX (TCon Ty.unitRef 0 []) + $ right unit + ) + ] + where + (nat, result, fail, stack1, stack2, stack3, unit) = fresh + +-- a -> Either b c +argToEither :: ForeignOp +argToEither instr = + ([BX],) + . TAbss [b] + . TLetD e UN (TFOp instr [b]) + . TMatch e + . MatchSum + $ mapFromList + [ (0, ([BX], TAbs ev $ left ev)), + (1, ([BX], TAbs ev $ right ev)) + ] + where + (e, b, ev) = fresh + +builtinLookup :: Map.Map Reference (Sandbox, SuperNormal Symbol) +builtinLookup = + Map.fromList + . map (\(t, f) -> (Builtin t, f)) + $ [ ("Int.+", (Untracked, addi)), + ("Int.-", (Untracked, subi)), + ("Int.*", (Untracked, muli)), + ("Int./", (Untracked, divi)), + ("Int.mod", (Untracked, modi)), + ("Int.==", (Untracked, eqi)), + ("Int.<", (Untracked, lti)), + ("Int.<=", (Untracked, lei)), + ("Int.>", (Untracked, gti)), + ("Int.>=", (Untracked, gei)), + ("Int.fromRepresentation", (Untracked, coerceType IntTag)), + ("Int.toRepresentation", (Untracked, coerceType NatTag)), + ("Int.increment", (Untracked, inci)), + ("Int.signum", (Untracked, sgni)), + ("Int.negate", (Untracked, negi)), + ("Int.truncate0", (Untracked, trni)), + ("Int.isEven", (Untracked, evni)), + ("Int.isOdd", (Untracked, oddi)), + ("Int.shiftLeft", (Untracked, shli)), + ("Int.shiftRight", (Untracked, shri)), + ("Int.trailingZeros", (Untracked, tzeroi)), + ("Int.leadingZeros", (Untracked, lzeroi)), + ("Int.and", (Untracked, andi)), + ("Int.or", (Untracked, ori)), + ("Int.xor", (Untracked, xori)), + ("Int.complement", (Untracked, compli)), + ("Int.pow", (Untracked, powi)), + ("Int.toText", (Untracked, i2t)), + ("Int.fromText", (Untracked, t2i)), + ("Int.toFloat", (Untracked, i2f)), + ("Int.popCount", (Untracked, popi)), + ("Nat.+", (Untracked, addn)), + ("Nat.-", (Untracked, subn)), + ("Nat.sub", (Untracked, subn)), + ("Nat.*", (Untracked, muln)), + ("Nat./", (Untracked, divn)), + ("Nat.mod", (Untracked, modn)), + ("Nat.==", (Untracked, eqn)), + ("Nat.<", (Untracked, ltn)), + ("Nat.<=", (Untracked, len)), + ("Nat.>", (Untracked, gtn)), + ("Nat.>=", (Untracked, gen)), + ("Nat.increment", (Untracked, incn)), + ("Nat.isEven", (Untracked, evnn)), + ("Nat.isOdd", (Untracked, oddn)), + ("Nat.shiftLeft", (Untracked, shln)), + ("Nat.shiftRight", (Untracked, shrn)), + ("Nat.trailingZeros", (Untracked, tzeron)), + ("Nat.leadingZeros", (Untracked, lzeron)), + ("Nat.and", (Untracked, andn)), + ("Nat.or", (Untracked, orn)), + ("Nat.xor", (Untracked, xorn)), + ("Nat.complement", (Untracked, compln)), + ("Nat.pow", (Untracked, pown)), + ("Nat.drop", (Untracked, dropn)), + ("Nat.toInt", (Untracked, coerceType IntTag)), + ("Nat.toFloat", (Untracked, n2f)), + ("Nat.toText", (Untracked, n2t)), + ("Nat.fromText", (Untracked, t2n)), + ("Nat.popCount", (Untracked, popn)), + ("Float.+", (Untracked, addf)), + ("Float.-", (Untracked, subf)), + ("Float.*", (Untracked, mulf)), + ("Float./", (Untracked, divf)), + ("Float.pow", (Untracked, powf)), + ("Float.log", (Untracked, logf)), + ("Float.logBase", (Untracked, logbf)), + ("Float.sqrt", (Untracked, sqrtf)), + ("Float.fromRepresentation", (Untracked, coerceType FloatTag)), + ("Float.toRepresentation", (Untracked, coerceType NatTag)), + ("Float.min", (Untracked, minf)), + ("Float.max", (Untracked, maxf)), + ("Float.<", (Untracked, ltf)), + ("Float.>", (Untracked, gtf)), + ("Float.<=", (Untracked, lef)), + ("Float.>=", (Untracked, gef)), + ("Float.==", (Untracked, eqf)), + ("Float.!=", (Untracked, neqf)), + ("Float.acos", (Untracked, acosf)), + ("Float.asin", (Untracked, asinf)), + ("Float.atan", (Untracked, atanf)), + ("Float.cos", (Untracked, cosf)), + ("Float.sin", (Untracked, sinf)), + ("Float.tan", (Untracked, tanf)), + ("Float.acosh", (Untracked, acoshf)), + ("Float.asinh", (Untracked, asinhf)), + ("Float.atanh", (Untracked, atanhf)), + ("Float.cosh", (Untracked, coshf)), + ("Float.sinh", (Untracked, sinhf)), + ("Float.tanh", (Untracked, tanhf)), + ("Float.exp", (Untracked, expf)), + ("Float.abs", (Untracked, absf)), + ("Float.ceiling", (Untracked, ceilf)), + ("Float.floor", (Untracked, floorf)), + ("Float.round", (Untracked, roundf)), + ("Float.truncate", (Untracked, truncf)), + ("Float.atan2", (Untracked, atan2f)), + ("Float.toText", (Untracked, f2t)), + ("Float.fromText", (Untracked, t2f)), + -- text + ("Text.empty", (Untracked, Lambda [] $ TLit (T ""))), + ("Text.++", (Untracked, appendt)), + ("Text.take", (Untracked, taket)), + ("Text.drop", (Untracked, dropt)), + ("Text.indexOf", (Untracked, indext)), + ("Text.size", (Untracked, sizet)), + ("Text.==", (Untracked, eqt)), + ("Text.!=", (Untracked, neqt)), + ("Text.<=", (Untracked, leqt)), + ("Text.>=", (Untracked, geqt)), + ("Text.<", (Untracked, lesst)), + ("Text.>", (Untracked, great)), + ("Text.uncons", (Untracked, unconst)), + ("Text.unsnoc", (Untracked, unsnoct)), + ("Text.toCharList", (Untracked, unpackt)), + ("Text.fromCharList", (Untracked, packt)), + ("Boolean.not", (Untracked, notb)), + ("Boolean.or", (Untracked, orb)), + ("Boolean.and", (Untracked, andb)), + ("bug", (Untracked, bug "builtin.bug")), + ("todo", (Untracked, bug "builtin.todo")), + ("Debug.watch", (Tracked, watch)), + ("Debug.trace", (Tracked, gen'trace)), + ("Debug.toText", (Tracked, debug'text)), + ("unsafe.coerceAbilities", (Untracked, poly'coerce)), + ("Char.toNat", (Untracked, coerceType NatTag)), + ("Char.fromNat", (Untracked, coerceType CharTag)), + ("Bytes.empty", (Untracked, emptyb)), + ("Bytes.fromList", (Untracked, packb)), + ("Bytes.toList", (Untracked, unpackb)), + ("Bytes.++", (Untracked, appendb)), + ("Bytes.take", (Untracked, takeb)), + ("Bytes.drop", (Untracked, dropb)), + ("Bytes.at", (Untracked, atb)), + ("Bytes.indexOf", (Untracked, indexb)), + ("Bytes.size", (Untracked, sizeb)), + ("Bytes.flatten", (Untracked, flattenb)), + ("List.take", (Untracked, takes)), + ("List.drop", (Untracked, drops)), + ("List.size", (Untracked, sizes)), + ("List.++", (Untracked, appends)), + ("List.at", (Untracked, ats)), + ("List.cons", (Untracked, conss)), + ("List.snoc", (Untracked, snocs)), + ("List.empty", (Untracked, emptys)), + ("List.viewl", (Untracked, viewls)), + ("List.viewr", (Untracked, viewrs)), + ("List.splitLeft", (Untracked, splitls)), + ("List.splitRight", (Untracked, splitrs)), + -- + -- , B "Debug.watch" $ forall1 "a" (\a -> text --> a --> a) + ("Universal.==", (Untracked, equ)), + ("Universal.compare", (Untracked, cmpu)), + ("Universal.>", (Untracked, gtu)), + ("Universal.<", (Untracked, ltu)), + ("Universal.>=", (Untracked, geu)), + ("Universal.<=", (Untracked, leu)), + -- internal stuff + ("jumpCont", (Untracked, jumpk)), + ("raise", (Untracked, raise)), + ("IO.forkComp.v2", (Tracked, fork'comp)), + ("Scope.run", (Untracked, scope'run)), + ("Code.isMissing", (Tracked, code'missing)), + ("Code.cache_", (Tracked, code'cache)), + ("Code.lookup", (Tracked, code'lookup)), + ("Code.validate", (Tracked, code'validate)), + ("Value.load", (Tracked, value'load)), + ("Value.value", (Tracked, value'create)), + ("Any.Any", (Untracked, any'construct)), + ("Any.unsafeExtract", (Untracked, any'extract)), + ("Link.Term.toText", (Untracked, term'link'to'text)), + ("STM.atomically", (Tracked, stm'atomic)), + ("validateSandboxed", (Untracked, check'sandbox)), + ("Value.validateSandboxed", (Tracked, value'sandbox)), + ("sandboxLinks", (Tracked, sandbox'links)), + ("IO.tryEval", (Tracked, try'eval)) + ] + ++ foreignWrappers + +type FDecl v = + ReaderT Bool (State (Word64, [(Data.Text.Text, (Sandbox, SuperNormal v))], EnumMap Word64 (Data.Text.Text, ForeignFunc))) + +-- Data type to determine whether a builtin should be tracked for +-- sandboxing. Untracked means that it can be freely used, and Tracked +-- means that the sandboxing check will by default consider them +-- disallowed. +data Sandbox = Tracked | Untracked + deriving (Eq, Ord, Show, Read, Enum, Bounded) + +bomb :: Data.Text.Text -> a -> IO r +bomb name _ = die $ "attempted to use sandboxed operation: " ++ Data.Text.unpack name + +declareForeign :: + Sandbox -> + Data.Text.Text -> + ForeignOp -> + ForeignFunc -> + FDecl Symbol () +declareForeign sand name op func0 = do + sanitize <- ask + modify $ \(w, codes, funcs) -> + let func + | sanitize, + Tracked <- sand, + FF r w _ <- func0 = + FF r w (bomb name) + | otherwise = func0 + code = (name, (sand, uncurry Lambda (op w))) + in (w + 1, code : codes, mapInsert w (name, func) funcs) + +mkForeignIOF :: + (ForeignConvention a, ForeignConvention r) => + (a -> IO r) -> + ForeignFunc +mkForeignIOF f = mkForeign $ \a -> tryIOE (f a) + where + tryIOE :: IO a -> IO (Either Failure a) + tryIOE = fmap handleIOE . try + handleIOE :: Either IOException a -> Either Failure a + handleIOE (Left e) = Left $ Failure Ty.ioFailureRef (Util.Text.pack (show e)) unitValue + handleIOE (Right a) = Right a + +unitValue :: Val +unitValue = BoxedVal $ Closure.Enum Ty.unitRef (PackedTag 0) + +natValue :: Word64 -> Val +natValue w = NatVal w + +mkForeignTls :: + forall a r. + (ForeignConvention a, ForeignConvention r) => + (a -> IO r) -> + ForeignFunc +mkForeignTls f = mkForeign $ \a -> fmap flatten (tryIO2 (tryIO1 (f a))) + where + tryIO1 :: IO r -> IO (Either TLS.TLSException r) + tryIO1 = try + tryIO2 :: IO (Either TLS.TLSException r) -> IO (Either IOException (Either TLS.TLSException r)) + tryIO2 = try + flatten :: Either IOException (Either TLS.TLSException r) -> Either (Failure) r + flatten (Left e) = Left (Failure Ty.ioFailureRef (Util.Text.pack (show e)) unitValue) + flatten (Right (Left e)) = Left (Failure Ty.tlsFailureRef (Util.Text.pack (show e)) unitValue) + flatten (Right (Right a)) = Right a + +mkForeignTlsE :: + forall a r. + (ForeignConvention a, ForeignConvention r) => + (a -> IO (Either Failure r)) -> + ForeignFunc +mkForeignTlsE f = mkForeign $ \a -> fmap flatten (tryIO2 (tryIO1 (f a))) + where + tryIO1 :: IO (Either Failure r) -> IO (Either TLS.TLSException (Either Failure r)) + tryIO1 = try + tryIO2 :: IO (Either TLS.TLSException (Either Failure r)) -> IO (Either IOException (Either TLS.TLSException (Either Failure r))) + tryIO2 = try + flatten :: Either IOException (Either TLS.TLSException (Either Failure r)) -> Either Failure r + flatten (Left e) = Left (Failure Ty.ioFailureRef (Util.Text.pack (show e)) unitValue) + flatten (Right (Left e)) = Left (Failure Ty.tlsFailureRef (Util.Text.pack (show e)) unitValue) + flatten (Right (Right (Left e))) = Left e + flatten (Right (Right (Right a))) = Right a + +declareUdpForeigns :: FDecl Symbol () +declareUdpForeigns = do + declareForeign Tracked "IO.UDP.clientSocket.impl.v1" arg2ToEF + . mkForeignIOF + $ \(host :: Util.Text.Text, port :: Util.Text.Text) -> + let hostStr = Util.Text.toString host + portStr = Util.Text.toString port + in UDP.clientSocket hostStr portStr True + + declareForeign Tracked "IO.UDP.UDPSocket.recv.impl.v1" argToEF + . mkForeignIOF + $ \(sock :: UDPSocket) -> Bytes.fromArray <$> UDP.recv sock + + declareForeign Tracked "IO.UDP.UDPSocket.send.impl.v1" arg2ToEF0 + . mkForeignIOF + $ \(sock :: UDPSocket, bytes :: Bytes.Bytes) -> + UDP.send sock (Bytes.toArray bytes) + + declareForeign Tracked "IO.UDP.UDPSocket.close.impl.v1" argToEF0 + . mkForeignIOF + $ \(sock :: UDPSocket) -> UDP.close sock + + declareForeign Tracked "IO.UDP.ListenSocket.close.impl.v1" argToEF0 + . mkForeignIOF + $ \(sock :: ListenSocket) -> UDP.stop sock + + declareForeign Tracked "IO.UDP.UDPSocket.toText.impl.v1" (argNDirect 1) + . mkForeign + $ \(sock :: UDPSocket) -> pure $ show sock + + declareForeign Tracked "IO.UDP.serverSocket.impl.v1" arg2ToEF + . mkForeignIOF + $ \(ip :: Util.Text.Text, port :: Util.Text.Text) -> + let maybeIp = readMaybe $ Util.Text.toString ip :: Maybe IP + maybePort = readMaybe $ Util.Text.toString port :: Maybe PortNumber + in case (maybeIp, maybePort) of + (Nothing, _) -> fail "Invalid IP Address" + (_, Nothing) -> fail "Invalid Port Number" + (Just ip, Just pt) -> UDP.serverSocket (ip, pt) + + declareForeign Tracked "IO.UDP.ListenSocket.toText.impl.v1" (argNDirect 1) + . mkForeign + $ \(sock :: ListenSocket) -> pure $ show sock + + declareForeign Tracked "IO.UDP.ListenSocket.recvFrom.impl.v1" argToEFTup + . mkForeignIOF + $ fmap (first Bytes.fromArray) <$> UDP.recvFrom + + declareForeign Tracked "IO.UDP.ClientSockAddr.toText.v1" (argNDirect 1) + . mkForeign + $ \(sock :: ClientSockAddr) -> pure $ show sock + + declareForeign Tracked "IO.UDP.ListenSocket.sendTo.impl.v1" arg3ToEF0 + . mkForeignIOF + $ \(socket :: ListenSocket, bytes :: Bytes.Bytes, addr :: ClientSockAddr) -> + UDP.sendTo socket (Bytes.toArray bytes) addr + +declareForeigns :: FDecl Symbol () +declareForeigns = do + declareUdpForeigns + declareForeign Tracked "IO.openFile.impl.v3" argIomrToEF $ + mkForeignIOF $ \(fnameText :: Util.Text.Text, n :: Int) -> + let fname = Util.Text.toString fnameText + mode = case n of + 0 -> ReadMode + 1 -> WriteMode + 2 -> AppendMode + _ -> ReadWriteMode + in openFile fname mode + + declareForeign Tracked "IO.closeFile.impl.v3" argToEF0 $ mkForeignIOF hClose + declareForeign Tracked "IO.isFileEOF.impl.v3" argToEFBool $ mkForeignIOF hIsEOF + declareForeign Tracked "IO.isFileOpen.impl.v3" argToEFBool $ mkForeignIOF hIsOpen + declareForeign Tracked "IO.getEcho.impl.v1" argToEFBool $ mkForeignIOF hGetEcho + declareForeign Tracked "IO.ready.impl.v1" argToEFBool $ mkForeignIOF hReady + declareForeign Tracked "IO.getChar.impl.v1" argToEFChar $ mkForeignIOF hGetChar + declareForeign Tracked "IO.isSeekable.impl.v3" argToEFBool $ mkForeignIOF hIsSeekable + + declareForeign Tracked "IO.seekHandle.impl.v3" seek'handle + . mkForeignIOF + $ \(h, sm, n) -> hSeek h sm (fromIntegral (n :: Int)) + + declareForeign Tracked "IO.handlePosition.impl.v3" argToEFNat + -- TODO: truncating integer + . mkForeignIOF + $ \h -> fromInteger @Word64 <$> hTell h + + declareForeign Tracked "IO.getBuffering.impl.v3" get'buffering $ + mkForeignIOF hGetBuffering + + declareForeign Tracked "IO.setBuffering.impl.v3" set'buffering + . mkForeignIOF + $ uncurry hSetBuffering + + declareForeign Tracked "IO.setEcho.impl.v1" set'echo . mkForeignIOF $ uncurry hSetEcho + + declareForeign Tracked "IO.getLine.impl.v1" argToEF $ + mkForeignIOF $ + fmap Util.Text.fromText . Text.IO.hGetLine + + declareForeign Tracked "IO.getBytes.impl.v3" arg2ToEF . mkForeignIOF $ + \(h, n) -> Bytes.fromArray <$> hGet h n + + declareForeign Tracked "IO.getSomeBytes.impl.v1" arg2ToEF . mkForeignIOF $ + \(h, n) -> Bytes.fromArray <$> hGetSome h n + + declareForeign Tracked "IO.putBytes.impl.v3" arg2ToEF0 . mkForeignIOF $ \(h, bs) -> hPut h (Bytes.toArray bs) + + declareForeign Tracked "IO.systemTime.impl.v3" unitToEF $ + mkForeignIOF $ + \() -> getPOSIXTime + + declareForeign Tracked "IO.systemTimeMicroseconds.v1" unitToR $ + mkForeign $ + \() -> fmap (1e6 *) getPOSIXTime + + declareForeign Tracked "Clock.internals.monotonic.v1" unitToEF $ + mkForeignIOF $ + \() -> getTime Monotonic + + declareForeign Tracked "Clock.internals.realtime.v1" unitToEF $ + mkForeignIOF $ + \() -> getTime Realtime + + declareForeign Tracked "Clock.internals.processCPUTime.v1" unitToEF $ + mkForeignIOF $ + \() -> getTime ProcessCPUTime + + declareForeign Tracked "Clock.internals.threadCPUTime.v1" unitToEF $ + mkForeignIOF $ + \() -> getTime ThreadCPUTime + + declareForeign Tracked "Clock.internals.sec.v1" (argNDirect 1) $ + mkForeign (\n -> pure (fromIntegral $ sec n :: Word64)) + + -- A TimeSpec that comes from getTime never has negative nanos, + -- so we can safely cast to Nat + declareForeign Tracked "Clock.internals.nsec.v1" (argNDirect 1) $ + mkForeign (\n -> pure (fromIntegral $ nsec n :: Word64)) + + declareForeign Tracked "Clock.internals.systemTimeZone.v1" time'zone $ + mkForeign + ( \secs -> do + TimeZone offset summer name <- getTimeZone (posixSecondsToUTCTime (fromIntegral (secs :: Int))) + pure (offset :: Int, summer, name) + ) + + let chop = reverse . dropWhile isPathSeparator . reverse + + declareForeign Tracked "IO.getTempDirectory.impl.v3" unitToEF $ + mkForeignIOF $ + \() -> chop <$> getTemporaryDirectory + + declareForeign Tracked "IO.createTempDirectory.impl.v3" argToEF $ + mkForeignIOF $ \prefix -> do + temp <- getTemporaryDirectory + chop <$> createTempDirectory temp prefix + + declareForeign Tracked "IO.getCurrentDirectory.impl.v3" unitToEF + . mkForeignIOF + $ \() -> getCurrentDirectory + + declareForeign Tracked "IO.setCurrentDirectory.impl.v3" argToEF0 $ + mkForeignIOF setCurrentDirectory + + declareForeign Tracked "IO.fileExists.impl.v3" argToEFBool $ + mkForeignIOF doesPathExist + + declareForeign Tracked "IO.getEnv.impl.v1" argToEF $ + mkForeignIOF getEnv + + declareForeign Tracked "IO.getArgs.impl.v1" unitToEF $ + mkForeignIOF $ + \() -> fmap Util.Text.pack <$> SYS.getArgs + + declareForeign Tracked "IO.isDirectory.impl.v3" argToEFBool $ + mkForeignIOF doesDirectoryExist + + declareForeign Tracked "IO.createDirectory.impl.v3" argToEF0 $ + mkForeignIOF $ + createDirectoryIfMissing True + + declareForeign Tracked "IO.removeDirectory.impl.v3" argToEF0 $ + mkForeignIOF removeDirectoryRecursive + + declareForeign Tracked "IO.renameDirectory.impl.v3" arg2ToEF0 $ + mkForeignIOF $ + uncurry renameDirectory + + declareForeign Tracked "IO.directoryContents.impl.v3" argToEF $ + mkForeignIOF $ + (fmap Util.Text.pack <$>) . getDirectoryContents + + declareForeign Tracked "IO.removeFile.impl.v3" argToEF0 $ + mkForeignIOF removeFile + + declareForeign Tracked "IO.renameFile.impl.v3" arg2ToEF0 $ + mkForeignIOF $ + uncurry renameFile + + declareForeign Tracked "IO.getFileTimestamp.impl.v3" argToEFNat + . mkForeignIOF + $ fmap utcTimeToPOSIXSeconds . getModificationTime + + declareForeign Tracked "IO.getFileSize.impl.v3" argToEFNat + -- TODO: truncating integer + . mkForeignIOF + $ \fp -> fromInteger @Word64 <$> getFileSize fp + + declareForeign Tracked "IO.serverSocket.impl.v3" maybeToEF + . mkForeignIOF + $ \( mhst :: Maybe Util.Text.Text, + port + ) -> + fst <$> SYS.bindSock (hostPreference mhst) port + + declareForeign Tracked "Socket.toText" (argNDirect 1) + . mkForeign + $ \(sock :: Socket) -> pure $ show sock + + declareForeign Tracked "Handle.toText" (argNDirect 1) + . mkForeign + $ \(hand :: Handle) -> pure $ show hand + + declareForeign Tracked "ThreadId.toText" (argNDirect 1) + . mkForeign + $ \(threadId :: ThreadId) -> pure $ show threadId + + declareForeign Tracked "IO.socketPort.impl.v3" argToEFNat + . mkForeignIOF + $ \(handle :: Socket) -> do + n <- SYS.socketPort handle + return (fromIntegral n :: Word64) + + declareForeign Tracked "IO.listen.impl.v3" argToEF0 + . mkForeignIOF + $ \sk -> SYS.listenSock sk 2048 + + declareForeign Tracked "IO.clientSocket.impl.v3" arg2ToEF + . mkForeignIOF + $ fmap fst . uncurry SYS.connectSock + + declareForeign Tracked "IO.closeSocket.impl.v3" argToEF0 $ + mkForeignIOF SYS.closeSock + + declareForeign Tracked "IO.socketAccept.impl.v3" argToEF + . mkForeignIOF + $ fmap fst . SYS.accept + + declareForeign Tracked "IO.socketSend.impl.v3" arg2ToEF0 + . mkForeignIOF + $ \(sk, bs) -> SYS.send sk (Bytes.toArray bs) + + declareForeign Tracked "IO.socketReceive.impl.v3" arg2ToEF + . mkForeignIOF + $ \(hs, n) -> + maybe mempty Bytes.fromArray <$> SYS.recv hs n + + declareForeign Tracked "IO.kill.impl.v3" argToEF0 $ mkForeignIOF killThread + + let mx :: Word64 + mx = fromIntegral (maxBound :: Int) + + customDelay :: Word64 -> IO () + customDelay n + | n < mx = threadDelay (fromIntegral n) + | otherwise = threadDelay maxBound >> customDelay (n - mx) + + declareForeign Tracked "IO.delay.impl.v3" argToEFUnit $ + mkForeignIOF customDelay + + declareForeign Tracked "IO.stdHandle" standard'handle + . mkForeign + $ \(n :: Int) -> case n of + 0 -> pure SYS.stdin + 1 -> pure SYS.stdout + 2 -> pure SYS.stderr + _ -> die "IO.stdHandle: invalid input." + + let exitDecode ExitSuccess = 0 + exitDecode (ExitFailure n) = n + + declareForeign Tracked "IO.process.call" (argNDirect 2) . mkForeign $ + \(exe, map Util.Text.unpack -> args) -> + withCreateProcess (proc exe args) $ \_ _ _ p -> + exitDecode <$> waitForProcess p + + declareForeign Tracked "IO.process.start" start'process . mkForeign $ + \(exe, map Util.Text.unpack -> args) -> + runInteractiveProcess exe args Nothing Nothing + + declareForeign Tracked "IO.process.kill" argToUnit . mkForeign $ + terminateProcess + + declareForeign Tracked "IO.process.wait" (argNDirect 1) . mkForeign $ + \ph -> exitDecode <$> waitForProcess ph + + declareForeign Tracked "IO.process.exitCode" argToMaybe . mkForeign $ + fmap (fmap exitDecode) . getProcessExitCode + + declareForeign Tracked "MVar.new" (argNDirect 1) + . mkForeign + $ \(c :: Val) -> newMVar c + + declareForeign Tracked "MVar.newEmpty.v2" unitDirect + . mkForeign + $ \() -> newEmptyMVar @Val + + declareForeign Tracked "MVar.take.impl.v3" argToEF + . mkForeignIOF + $ \(mv :: MVar Val) -> takeMVar mv + + declareForeign Tracked "MVar.tryTake" argToMaybe + . mkForeign + $ \(mv :: MVar Val) -> tryTakeMVar mv + + declareForeign Tracked "MVar.put.impl.v3" arg2ToEF0 + . mkForeignIOF + $ \(mv :: MVar Val, x) -> putMVar mv x + + declareForeign Tracked "MVar.tryPut.impl.v3" arg2ToEFBool + . mkForeignIOF + $ \(mv :: MVar Val, x) -> tryPutMVar mv x + + declareForeign Tracked "MVar.swap.impl.v3" arg2ToEF + . mkForeignIOF + $ \(mv :: MVar Val, x) -> swapMVar mv x + + declareForeign Tracked "MVar.isEmpty" (argNToBool 1) + . mkForeign + $ \(mv :: MVar Val) -> isEmptyMVar mv + + declareForeign Tracked "MVar.read.impl.v3" argToEF + . mkForeignIOF + $ \(mv :: MVar Val) -> readMVar mv + + declareForeign Tracked "MVar.tryRead.impl.v3" argToEFM + . mkForeignIOF + $ \(mv :: MVar Val) -> tryReadMVar mv + + declareForeign Untracked "Char.toText" (argNDirect 1) . mkForeign $ + \(ch :: Char) -> pure (Util.Text.singleton ch) + + declareForeign Untracked "Text.repeat" (argNDirect 2) . mkForeign $ + \(n :: Word64, txt :: Util.Text.Text) -> pure (Util.Text.replicate (fromIntegral n) txt) + + declareForeign Untracked "Text.reverse" (argNDirect 1) . mkForeign $ + pure . Util.Text.reverse + + declareForeign Untracked "Text.toUppercase" (argNDirect 1) . mkForeign $ + pure . Util.Text.toUppercase + + declareForeign Untracked "Text.toLowercase" (argNDirect 1) . mkForeign $ + pure . Util.Text.toLowercase + + declareForeign Untracked "Text.toUtf8" (argNDirect 1) . mkForeign $ + pure . Util.Text.toUtf8 + + declareForeign Untracked "Text.fromUtf8.impl.v3" argToEF . mkForeign $ + pure . mapLeft (\t -> Failure Ty.ioFailureRef (Util.Text.pack t) unitValue) . Util.Text.fromUtf8 + + declareForeign Tracked "Tls.ClientConfig.default" (argNDirect 2) . mkForeign $ + \(hostName :: Util.Text.Text, serverId :: Bytes.Bytes) -> + fmap + ( \store -> + (defaultParamsClient (Util.Text.unpack hostName) (Bytes.toArray serverId)) + { TLS.clientSupported = def {TLS.supportedCiphers = Cipher.ciphersuite_strong}, + TLS.clientShared = def {TLS.sharedCAStore = store} + } + ) + X.getSystemCertificateStore + + declareForeign Tracked "Tls.ServerConfig.default" (argNDirect 2) $ + mkForeign $ + \(certs :: [X.SignedCertificate], key :: X.PrivKey) -> + pure $ + (def :: TLS.ServerParams) + { TLS.serverSupported = def {TLS.supportedCiphers = Cipher.ciphersuite_strong}, + TLS.serverShared = def {TLS.sharedCredentials = Credentials [(X.CertificateChain certs, key)]} + } + + let updateClient :: X.CertificateStore -> TLS.ClientParams -> TLS.ClientParams + updateClient certs client = client {TLS.clientShared = ((clientShared client) {TLS.sharedCAStore = certs})} + in declareForeign Tracked "Tls.ClientConfig.certificates.set" (argNDirect 2) . mkForeign $ + \(certs :: [X.SignedCertificate], params :: ClientParams) -> pure $ updateClient (X.makeCertificateStore certs) params + + let updateServer :: X.CertificateStore -> TLS.ServerParams -> TLS.ServerParams + updateServer certs client = client {TLS.serverShared = ((serverShared client) {TLS.sharedCAStore = certs})} + in declareForeign Tracked "Tls.ServerConfig.certificates.set" (argNDirect 2) . mkForeign $ + \(certs :: [X.SignedCertificate], params :: ServerParams) -> pure $ updateServer (X.makeCertificateStore certs) params + + declareForeign Tracked "TVar.new" (argNDirect 1) . mkForeign $ + \(c :: Val) -> unsafeSTMToIO $ STM.newTVar c + + declareForeign Tracked "TVar.read" (argNDirect 1) . mkForeign $ + \(v :: STM.TVar Val) -> unsafeSTMToIO $ STM.readTVar v + + declareForeign Tracked "TVar.write" arg2To0 . mkForeign $ + \(v :: STM.TVar Val, c :: Val) -> + unsafeSTMToIO $ STM.writeTVar v c + + declareForeign Tracked "TVar.newIO" (argNDirect 1) . mkForeign $ + \(c :: Val) -> STM.newTVarIO c + + declareForeign Tracked "TVar.readIO" (argNDirect 1) . mkForeign $ + \(v :: STM.TVar Val) -> STM.readTVarIO v + + declareForeign Tracked "TVar.swap" (argNDirect 2) . mkForeign $ + \(v, c :: Val) -> unsafeSTMToIO $ STM.swapTVar v c + + declareForeign Tracked "STM.retry" unitDirect . mkForeign $ + \() -> unsafeSTMToIO STM.retry :: IO Val + + -- Scope and Ref stuff + declareForeign Untracked "Scope.ref" (argNDirect 1) + . mkForeign + $ \(c :: Val) -> newIORef c + + declareForeign Tracked "IO.ref" (argNDirect 1) + . mkForeign + $ \(c :: Val) -> evaluate c >>= newIORef + + -- The docs for IORef state that IORef operations can be observed + -- out of order ([1]) but actually GHC does emit the appropriate + -- load and store barriers nowadays ([2], [3]). + -- + -- [1] https://hackage.haskell.org/package/base-4.17.0.0/docs/Data-IORef.html#g:2 + -- [2] https://github.com/ghc/ghc/blob/master/compiler/GHC/StgToCmm/Prim.hs#L286 + -- [3] https://github.com/ghc/ghc/blob/master/compiler/GHC/StgToCmm/Prim.hs#L298 + declareForeign Untracked "Ref.read" (argNDirect 1) . mkForeign $ + \(r :: IORef Val) -> readIORef r + + declareForeign Untracked "Ref.write" arg2To0 . mkForeign $ + \(r :: IORef Val, c :: Val) -> evaluate c >>= writeIORef r + + declareForeign Tracked "Ref.readForCas" (argNDirect 1) . mkForeign $ + \(r :: IORef Val) -> readForCAS r + + declareForeign Tracked "Ref.Ticket.read" (argNDirect 1) . mkForeign $ + \(t :: Ticket Val) -> pure $ peekTicket t + + -- In GHC, CAS returns both a Boolean and the current value of the + -- IORef, which can be used to retry a failed CAS. + -- This strategy is more efficient than returning a Boolean only + -- because it uses a single call to cmpxchg in assembly (see [1]) to + -- avoid an extra read per CAS iteration, however it's not supported + -- in Scheme. + -- Therefore, we adopt the more common signature that only returns a + -- Boolean, which doesn't even suffer from spurious failures because + -- GHC issues loads of mutable variables with memory_order_acquire + -- (see [2]) + -- + -- [1]: https://github.com/ghc/ghc/blob/master/rts/PrimOps.cmm#L697 + -- [2]: https://github.com/ghc/ghc/blob/master/compiler/GHC/StgToCmm/Prim.hs#L285 + declareForeign Tracked "Ref.cas" (argNToBool 3) . mkForeign $ + \(r :: IORef Val, t :: Ticket Val, v :: Val) -> fmap fst $ + do + t <- evaluate t + casIORef r t v + + declareForeign Tracked "Promise.new" unitDirect . mkForeign $ + \() -> newPromise @Val + + -- the only exceptions from Promise.read are async and shouldn't be caught + declareForeign Tracked "Promise.read" (argNDirect 1) . mkForeign $ + \(p :: Promise Val) -> readPromise p + + declareForeign Tracked "Promise.tryRead" argToMaybe . mkForeign $ + \(p :: Promise Val) -> tryReadPromise p + + declareForeign Tracked "Promise.write" (argNToBool 2) . mkForeign $ + \(p :: Promise Val, a :: Val) -> writePromise p a + + declareForeign Tracked "Tls.newClient.impl.v3" arg2ToEF . mkForeignTls $ + \( config :: TLS.ClientParams, + socket :: SYS.Socket + ) -> TLS.contextNew socket config + + declareForeign Tracked "Tls.newServer.impl.v3" arg2ToEF . mkForeignTls $ + \( config :: TLS.ServerParams, + socket :: SYS.Socket + ) -> TLS.contextNew socket config + + declareForeign Tracked "Tls.handshake.impl.v3" argToEF0 . mkForeignTls $ + \(tls :: TLS.Context) -> TLS.handshake tls + + declareForeign Tracked "Tls.send.impl.v3" arg2ToEF0 . mkForeignTls $ + \( tls :: TLS.Context, + bytes :: Bytes.Bytes + ) -> TLS.sendData tls (Bytes.toLazyByteString bytes) + + let wrapFailure t = Failure Ty.tlsFailureRef (Util.Text.pack t) unitValue + decoded :: Bytes.Bytes -> Either String PEM + decoded bytes = case pemParseLBS $ Bytes.toLazyByteString bytes of + Right (pem : _) -> Right pem + Right [] -> Left "no PEM found" + Left l -> Left l + asCert :: PEM -> Either String X.SignedCertificate + asCert pem = X.decodeSignedCertificate $ pemContent pem + in declareForeign Tracked "Tls.decodeCert.impl.v3" argToEF . mkForeignTlsE $ + \(bytes :: Bytes.Bytes) -> pure $ mapLeft wrapFailure $ (decoded >=> asCert) bytes + + declareForeign Tracked "Tls.encodeCert" (argNDirect 1) . mkForeign $ + \(cert :: X.SignedCertificate) -> pure $ Bytes.fromArray $ X.encodeSignedObject cert + + declareForeign Tracked "Tls.decodePrivateKey" (argNDirect 1) . mkForeign $ + \(bytes :: Bytes.Bytes) -> pure $ X.readKeyFileFromMemory $ L.toStrict $ Bytes.toLazyByteString bytes + + declareForeign Tracked "Tls.encodePrivateKey" (argNDirect 1) . mkForeign $ + \(privateKey :: X.PrivKey) -> pure $ Util.Text.toUtf8 $ Util.Text.pack $ show privateKey + + declareForeign Tracked "Tls.receive.impl.v3" argToEF . mkForeignTls $ + \(tls :: TLS.Context) -> do + bs <- TLS.recvData tls + pure $ Bytes.fromArray bs + + declareForeign Tracked "Tls.terminate.impl.v3" argToEF0 . mkForeignTls $ + \(tls :: TLS.Context) -> TLS.bye tls + + declareForeign Untracked "Code.validateLinks" argToExnE + . mkForeign + $ \(lsgs0 :: [(Referent, Code)]) -> do + let f (msg, rs) = + Failure Ty.miscFailureRef (Util.Text.fromText msg) rs + pure . first f $ checkGroupHashes lsgs0 + declareForeign Untracked "Code.dependencies" (argNDirect 1) + . mkForeign + $ \(CodeRep sg _) -> + pure $ Wrap Ty.termLinkRef . Ref <$> groupTermLinks sg + declareForeign Untracked "Code.serialize" (argNDirect 1) + . mkForeign + $ \(co :: Code) -> + pure . Bytes.fromArray $ serializeCode builtinForeignNames co + declareForeign Untracked "Code.deserialize" argToEither + . mkForeign + $ pure . deserializeCode . Bytes.toArray + declareForeign Untracked "Code.display" (argNDirect 2) . mkForeign $ + \(nm, (CodeRep sg _)) -> + pure $ prettyGroup @Symbol (Util.Text.unpack nm) sg "" + declareForeign Untracked "Value.dependencies" (argNDirect 1) + . mkForeign + $ pure . fmap (Wrap Ty.termLinkRef . Ref) . valueTermLinks + declareForeign Untracked "Value.serialize" (argNDirect 1) + . mkForeign + $ pure . Bytes.fromArray . serializeValue + declareForeign Untracked "Value.deserialize" argToEither + . mkForeign + $ pure . deserializeValue . Bytes.toArray + -- Hashing functions + let declareHashAlgorithm :: forall alg. (Hash.HashAlgorithm alg) => Data.Text.Text -> alg -> FDecl Symbol () + declareHashAlgorithm txt alg = do + let algoRef = Builtin ("crypto.HashAlgorithm." <> txt) + declareForeign Untracked ("crypto.HashAlgorithm." <> txt) direct . mkForeign $ \() -> + pure (HashAlgorithm algoRef alg) + + declareHashAlgorithm "Sha3_512" Hash.SHA3_512 + declareHashAlgorithm "Sha3_256" Hash.SHA3_256 + declareHashAlgorithm "Sha2_512" Hash.SHA512 + declareHashAlgorithm "Sha2_256" Hash.SHA256 + declareHashAlgorithm "Sha1" Hash.SHA1 + declareHashAlgorithm "Blake2b_512" Hash.Blake2b_512 + declareHashAlgorithm "Blake2b_256" Hash.Blake2b_256 + declareHashAlgorithm "Blake2s_256" Hash.Blake2s_256 + declareHashAlgorithm "Md5" Hash.MD5 + + declareForeign Untracked "crypto.hashBytes" (argNDirect 2) . mkForeign $ + \(HashAlgorithm _ alg, b :: Bytes.Bytes) -> + let ctx = Hash.hashInitWith alg + in pure . Bytes.fromArray . Hash.hashFinalize $ Hash.hashUpdates ctx (Bytes.byteStringChunks b) + + declareForeign Untracked "crypto.hmacBytes" (argNDirect 3) + . mkForeign + $ \(HashAlgorithm _ alg, key :: Bytes.Bytes, msg :: Bytes.Bytes) -> + let out = u alg $ HMAC.hmac (Bytes.toArray @BA.Bytes key) (Bytes.toArray @BA.Bytes msg) + u :: a -> HMAC.HMAC a -> HMAC.HMAC a + u _ h = h -- to help typechecker along + in pure $ Bytes.fromArray out + + declareForeign Untracked "crypto.hash" crypto'hash . mkForeign $ + \(HashAlgorithm _ alg, x) -> + let hashlazy :: + (Hash.HashAlgorithm a) => + a -> + L.ByteString -> + Hash.Digest a + hashlazy _ l = Hash.hashlazy l + in pure . Bytes.fromArray . hashlazy alg $ serializeValueForHash x + + declareForeign Untracked "crypto.hmac" crypto'hmac . mkForeign $ + \(HashAlgorithm _ alg, key, x) -> + let hmac :: + (Hash.HashAlgorithm a) => a -> L.ByteString -> HMAC.HMAC a + hmac _ s = + HMAC.finalize + . HMAC.updates + (HMAC.initialize $ Bytes.toArray @BA.Bytes key) + $ L.toChunks s + in pure . Bytes.fromArray . hmac alg $ serializeValueForHash x + + declareForeign Untracked "crypto.Ed25519.sign.impl" arg3ToEF + . mkForeign + $ pure . signEd25519Wrapper + + declareForeign Untracked "crypto.Ed25519.verify.impl" arg3ToEFBool + . mkForeign + $ pure . verifyEd25519Wrapper + + declareForeign Untracked "crypto.Rsa.sign.impl" arg2ToEF + . mkForeign + $ pure . signRsaWrapper + + declareForeign Untracked "crypto.Rsa.verify.impl" arg3ToEFBool + . mkForeign + $ pure . verifyRsaWrapper + + let catchAll :: (MonadCatch m, MonadIO m, NFData a) => m a -> m (Either Util.Text.Text a) + catchAll e = do + e <- Exception.tryAnyDeep e + pure $ case e of + Left se -> Left (Util.Text.pack (show se)) + Right a -> Right a + + declareForeign Untracked "Universal.murmurHash" murmur'hash . mkForeign $ + pure . asWord64 . hash64 . serializeValueForHash + + declareForeign Tracked "IO.randomBytes" (argNDirect 1) . mkForeign $ + \n -> Bytes.fromArray <$> getRandomBytes @IO @ByteString n + + declareForeign Untracked "Bytes.zlib.compress" (argNDirect 1) . mkForeign $ pure . Bytes.zlibCompress + declareForeign Untracked "Bytes.gzip.compress" (argNDirect 1) . mkForeign $ pure . Bytes.gzipCompress + declareForeign Untracked "Bytes.zlib.decompress" argToEither . mkForeign $ \bs -> + catchAll (pure (Bytes.zlibDecompress bs)) + declareForeign Untracked "Bytes.gzip.decompress" argToEither . mkForeign $ \bs -> + catchAll (pure (Bytes.gzipDecompress bs)) + + declareForeign Untracked "Bytes.toBase16" (argNDirect 1) . mkForeign $ pure . Bytes.toBase16 + declareForeign Untracked "Bytes.toBase32" (argNDirect 1) . mkForeign $ pure . Bytes.toBase32 + declareForeign Untracked "Bytes.toBase64" (argNDirect 1) . mkForeign $ pure . Bytes.toBase64 + declareForeign Untracked "Bytes.toBase64UrlUnpadded" (argNDirect 1) . mkForeign $ pure . Bytes.toBase64UrlUnpadded + + declareForeign Untracked "Bytes.fromBase16" argToEither . mkForeign $ + pure . mapLeft Util.Text.fromText . Bytes.fromBase16 + declareForeign Untracked "Bytes.fromBase32" argToEither . mkForeign $ + pure . mapLeft Util.Text.fromText . Bytes.fromBase32 + declareForeign Untracked "Bytes.fromBase64" argToEither . mkForeign $ + pure . mapLeft Util.Text.fromText . Bytes.fromBase64 + declareForeign Untracked "Bytes.fromBase64UrlUnpadded" argToEither . mkForeign $ + pure . mapLeft Util.Text.fromText . Bytes.fromBase64UrlUnpadded + + declareForeign Untracked "Bytes.decodeNat64be" argToMaybeNTup . mkForeign $ pure . Bytes.decodeNat64be + declareForeign Untracked "Bytes.decodeNat64le" argToMaybeNTup . mkForeign $ pure . Bytes.decodeNat64le + declareForeign Untracked "Bytes.decodeNat32be" argToMaybeNTup . mkForeign $ pure . Bytes.decodeNat32be + declareForeign Untracked "Bytes.decodeNat32le" argToMaybeNTup . mkForeign $ pure . Bytes.decodeNat32le + declareForeign Untracked "Bytes.decodeNat16be" argToMaybeNTup . mkForeign $ pure . Bytes.decodeNat16be + declareForeign Untracked "Bytes.decodeNat16le" argToMaybeNTup . mkForeign $ pure . Bytes.decodeNat16le + + declareForeign Untracked "Bytes.encodeNat64be" (argNDirect 1) . mkForeign $ pure . Bytes.encodeNat64be + declareForeign Untracked "Bytes.encodeNat64le" (argNDirect 1) . mkForeign $ pure . Bytes.encodeNat64le + declareForeign Untracked "Bytes.encodeNat32be" (argNDirect 1) . mkForeign $ pure . Bytes.encodeNat32be + declareForeign Untracked "Bytes.encodeNat32le" (argNDirect 1) . mkForeign $ pure . Bytes.encodeNat32le + declareForeign Untracked "Bytes.encodeNat16be" (argNDirect 1) . mkForeign $ pure . Bytes.encodeNat16be + declareForeign Untracked "Bytes.encodeNat16le" (argNDirect 1) . mkForeign $ pure . Bytes.encodeNat16le + + declareForeign Untracked "MutableArray.copyTo!" arg5ToExnUnit + . mkForeign + $ \(dst, doff, src, soff, l) -> + let name = "MutableArray.copyTo!" + in if l == 0 + then pure (Right ()) + else + checkBounds name (PA.sizeofMutableArray dst) (doff + l - 1) $ + checkBounds name (PA.sizeofMutableArray src) (soff + l - 1) $ + Right + <$> PA.copyMutableArray @IO @Val + dst + (fromIntegral doff) + src + (fromIntegral soff) + (fromIntegral l) + + declareForeign Untracked "MutableByteArray.copyTo!" arg5ToExnUnit + . mkForeign + $ \(dst, doff, src, soff, l) -> + let name = "MutableByteArray.copyTo!" + in if l == 0 + then pure (Right ()) + else + checkBoundsPrim name (PA.sizeofMutableByteArray dst) (doff + l) 0 $ + checkBoundsPrim name (PA.sizeofMutableByteArray src) (soff + l) 0 $ + Right + <$> PA.copyMutableByteArray @IO + dst + (fromIntegral doff) + src + (fromIntegral soff) + (fromIntegral l) + + declareForeign Untracked "ImmutableArray.copyTo!" arg5ToExnUnit + . mkForeign + $ \(dst, doff, src, soff, l) -> + let name = "ImmutableArray.copyTo!" + in if l == 0 + then pure (Right ()) + else + checkBounds name (PA.sizeofMutableArray dst) (doff + l - 1) $ + checkBounds name (PA.sizeofArray src) (soff + l - 1) $ + Right + <$> PA.copyArray @IO @Val + dst + (fromIntegral doff) + src + (fromIntegral soff) + (fromIntegral l) + + declareForeign Untracked "ImmutableArray.size" (argNDirect 1) . mkForeign $ + pure . fromIntegral @Int @Word64 . PA.sizeofArray @Val + declareForeign Untracked "MutableArray.size" (argNDirect 1) . mkForeign $ + pure . fromIntegral @Int @Word64 . PA.sizeofMutableArray @PA.RealWorld @Val + declareForeign Untracked "ImmutableByteArray.size" (argNDirect 1) . mkForeign $ + pure . fromIntegral @Int @Word64 . PA.sizeofByteArray + declareForeign Untracked "MutableByteArray.size" (argNDirect 1) . mkForeign $ + pure . fromIntegral @Int @Word64 . PA.sizeofMutableByteArray @PA.RealWorld + + declareForeign Untracked "ImmutableByteArray.copyTo!" arg5ToExnUnit + . mkForeign + $ \(dst, doff, src, soff, l) -> + let name = "ImmutableByteArray.copyTo!" + in if l == 0 + then pure (Right ()) + else + checkBoundsPrim name (PA.sizeofMutableByteArray dst) (doff + l) 0 $ + checkBoundsPrim name (PA.sizeofByteArray src) (soff + l) 0 $ + Right + <$> PA.copyByteArray @IO + dst + (fromIntegral doff) + src + (fromIntegral soff) + (fromIntegral l) + + declareForeign Untracked "MutableArray.read" arg2ToExn + . mkForeign + $ checkedRead "MutableArray.read" + declareForeign Untracked "MutableByteArray.read8" arg2ToExn + . mkForeign + $ checkedRead8 "MutableByteArray.read8" + declareForeign Untracked "MutableByteArray.read16be" arg2ToExn + . mkForeign + $ checkedRead16 "MutableByteArray.read16be" + declareForeign Untracked "MutableByteArray.read24be" arg2ToExn + . mkForeign + $ checkedRead24 "MutableByteArray.read24be" + declareForeign Untracked "MutableByteArray.read32be" arg2ToExn + . mkForeign + $ checkedRead32 "MutableByteArray.read32be" + declareForeign Untracked "MutableByteArray.read40be" arg2ToExn + . mkForeign + $ checkedRead40 "MutableByteArray.read40be" + declareForeign Untracked "MutableByteArray.read64be" arg2ToExn + . mkForeign + $ checkedRead64 "MutableByteArray.read64be" + + declareForeign Untracked "MutableArray.write" arg3ToExnUnit + . mkForeign + $ checkedWrite "MutableArray.write" + declareForeign Untracked "MutableByteArray.write8" arg3ToExnUnit + . mkForeign + $ checkedWrite8 "MutableByteArray.write8" + declareForeign Untracked "MutableByteArray.write16be" arg3ToExnUnit + . mkForeign + $ checkedWrite16 "MutableByteArray.write16be" + declareForeign Untracked "MutableByteArray.write32be" arg3ToExnUnit + . mkForeign + $ checkedWrite32 "MutableByteArray.write32be" + declareForeign Untracked "MutableByteArray.write64be" arg3ToExnUnit + . mkForeign + $ checkedWrite64 "MutableByteArray.write64be" + + declareForeign Untracked "ImmutableArray.read" arg2ToExn + . mkForeign + $ checkedIndex "ImmutableArray.read" + declareForeign Untracked "ImmutableByteArray.read8" arg2ToExn + . mkForeign + $ checkedIndex8 "ImmutableByteArray.read8" + declareForeign Untracked "ImmutableByteArray.read16be" arg2ToExn + . mkForeign + $ checkedIndex16 "ImmutableByteArray.read16be" + declareForeign Untracked "ImmutableByteArray.read24be" arg2ToExn + . mkForeign + $ checkedIndex24 "ImmutableByteArray.read24be" + declareForeign Untracked "ImmutableByteArray.read32be" arg2ToExn + . mkForeign + $ checkedIndex32 "ImmutableByteArray.read32be" + declareForeign Untracked "ImmutableByteArray.read40be" arg2ToExn + . mkForeign + $ checkedIndex40 "ImmutableByteArray.read40be" + declareForeign Untracked "ImmutableByteArray.read64be" arg2ToExn + . mkForeign + $ checkedIndex64 "ImmutableByteArray.read64be" + + declareForeign Untracked "MutableByteArray.freeze!" (argNDirect 1) . mkForeign $ + PA.unsafeFreezeByteArray + declareForeign Untracked "MutableArray.freeze!" (argNDirect 1) . mkForeign $ + PA.unsafeFreezeArray @IO @Val + + declareForeign Untracked "MutableByteArray.freeze" arg3ToExn . mkForeign $ + \(src, off, len) -> + if len == 0 + then fmap Right . PA.unsafeFreezeByteArray =<< PA.newByteArray 0 + else + checkBoundsPrim + "MutableByteArray.freeze" + (PA.sizeofMutableByteArray src) + (off + len) + 0 + $ Right <$> PA.freezeByteArray src (fromIntegral off) (fromIntegral len) + + declareForeign Untracked "MutableArray.freeze" arg3ToExn . mkForeign $ + \(src :: PA.MutableArray PA.RealWorld Val, off, len) -> + if len == 0 + then fmap Right . PA.unsafeFreezeArray =<< PA.newArray 0 emptyVal + else + checkBounds + "MutableArray.freeze" + (PA.sizeofMutableArray src) + (off + len - 1) + $ Right <$> PA.freezeArray src (fromIntegral off) (fromIntegral len) + + declareForeign Untracked "MutableByteArray.length" (argNDirect 1) . mkForeign $ + pure . PA.sizeofMutableByteArray @PA.RealWorld + + declareForeign Untracked "ImmutableByteArray.length" (argNDirect 1) . mkForeign $ + pure . PA.sizeofByteArray + + declareForeign Tracked "IO.array" (argNDirect 1) . mkForeign $ + \n -> PA.newArray n emptyVal + declareForeign Tracked "IO.arrayOf" (argNDirect 2) . mkForeign $ + \(v :: Val, n) -> PA.newArray n v + declareForeign Tracked "IO.bytearray" (argNDirect 1) . mkForeign $ PA.newByteArray + declareForeign Tracked "IO.bytearrayOf" (argNDirect 2) + . mkForeign + $ \(init, sz) -> do + arr <- PA.newByteArray sz + PA.fillByteArray arr 0 sz init + pure arr + + declareForeign Untracked "Scope.array" (argNDirect 1) . mkForeign $ + \n -> PA.newArray n emptyVal + declareForeign Untracked "Scope.arrayOf" (argNDirect 2) . mkForeign $ + \(v :: Val, n) -> PA.newArray n v + declareForeign Untracked "Scope.bytearray" (argNDirect 1) . mkForeign $ PA.newByteArray + declareForeign Untracked "Scope.bytearrayOf" (argNDirect 2) + . mkForeign + $ \(init, sz) -> do + arr <- PA.newByteArray sz + PA.fillByteArray arr 0 sz init + pure arr + + declareForeign Untracked "Text.patterns.literal" (argNDirect 1) . mkForeign $ + \txt -> evaluate . TPat.cpattern $ TPat.Literal txt + declareForeign Untracked "Text.patterns.digit" direct . mkForeign $ + let v = TPat.cpattern (TPat.Char (TPat.CharRange '0' '9')) in \() -> pure v + declareForeign Untracked "Text.patterns.letter" direct . mkForeign $ + let v = TPat.cpattern (TPat.Char (TPat.CharClass TPat.Letter)) in \() -> pure v + declareForeign Untracked "Text.patterns.space" direct . mkForeign $ + let v = TPat.cpattern (TPat.Char (TPat.CharClass TPat.Whitespace)) in \() -> pure v + declareForeign Untracked "Text.patterns.punctuation" direct . mkForeign $ + let v = TPat.cpattern (TPat.Char (TPat.CharClass TPat.Punctuation)) in \() -> pure v + declareForeign Untracked "Text.patterns.anyChar" direct . mkForeign $ + let v = TPat.cpattern (TPat.Char TPat.Any) in \() -> pure v + declareForeign Untracked "Text.patterns.eof" direct . mkForeign $ + let v = TPat.cpattern TPat.Eof in \() -> pure v + declareForeign Untracked "Text.patterns.charRange" (argNDirect 2) . mkForeign $ + \(beg, end) -> evaluate . TPat.cpattern . TPat.Char $ TPat.CharRange beg end + declareForeign Untracked "Text.patterns.notCharRange" (argNDirect 2) . mkForeign $ + \(beg, end) -> evaluate . TPat.cpattern . TPat.Char . TPat.Not $ TPat.CharRange beg end + declareForeign Untracked "Text.patterns.charIn" (argNDirect 1) . mkForeign $ \ccs -> do + cs <- for ccs $ \case + CharVal c -> pure c + _ -> die "Text.patterns.charIn: non-character closure" + evaluate . TPat.cpattern . TPat.Char $ TPat.CharSet cs + declareForeign Untracked "Text.patterns.notCharIn" (argNDirect 1) . mkForeign $ \ccs -> do + cs <- for ccs $ \case + CharVal c -> pure c + _ -> die "Text.patterns.notCharIn: non-character closure" + evaluate . TPat.cpattern . TPat.Char . TPat.Not $ TPat.CharSet cs + declareForeign Untracked "Pattern.many" (argNDirect 1) . mkForeign $ + \(TPat.CP p _) -> evaluate . TPat.cpattern $ TPat.Many False p + declareForeign Untracked "Pattern.many.corrected" (argNDirect 1) . mkForeign $ + \(TPat.CP p _) -> evaluate . TPat.cpattern $ TPat.Many True p + declareForeign Untracked "Pattern.capture" (argNDirect 1) . mkForeign $ + \(TPat.CP p _) -> evaluate . TPat.cpattern $ TPat.Capture p + declareForeign Untracked "Pattern.captureAs" (argNDirect 2) . mkForeign $ + \(t, (TPat.CP p _)) -> evaluate . TPat.cpattern $ TPat.CaptureAs t p + declareForeign Untracked "Pattern.join" (argNDirect 1) . mkForeign $ \ps -> + evaluate . TPat.cpattern . TPat.Join $ map (\(TPat.CP p _) -> p) ps + declareForeign Untracked "Pattern.or" (argNDirect 2) . mkForeign $ + \(TPat.CP l _, TPat.CP r _) -> evaluate . TPat.cpattern $ TPat.Or l r + declareForeign Untracked "Pattern.replicate" (argNDirect 3) . mkForeign $ + \(m0 :: Word64, n0 :: Word64, TPat.CP p _) -> + let m = fromIntegral m0; n = fromIntegral n0 + in evaluate . TPat.cpattern $ TPat.Replicate m n p + + declareForeign Untracked "Pattern.run" arg2ToMaybeTup . mkForeign $ + \(TPat.CP _ matcher, input :: Text) -> pure $ matcher input + + declareForeign Untracked "Pattern.isMatch" (argNToBool 2) . mkForeign $ + \(TPat.CP _ matcher, input :: Text) -> pure . isJust $ matcher input + + declareForeign Untracked "Char.Class.any" direct . mkForeign $ \() -> pure TPat.Any + declareForeign Untracked "Char.Class.not" (argNDirect 1) . mkForeign $ pure . TPat.Not + declareForeign Untracked "Char.Class.and" (argNDirect 2) . mkForeign $ \(a, b) -> pure $ TPat.Intersect a b + declareForeign Untracked "Char.Class.or" (argNDirect 2) . mkForeign $ \(a, b) -> pure $ TPat.Union a b + declareForeign Untracked "Char.Class.range" (argNDirect 2) . mkForeign $ \(a, b) -> pure $ TPat.CharRange a b + declareForeign Untracked "Char.Class.anyOf" (argNDirect 1) . mkForeign $ \ccs -> do + cs <- for ccs $ \case + CharVal c -> pure c + _ -> die "Text.patterns.charIn: non-character closure" + evaluate $ TPat.CharSet cs + declareForeign Untracked "Char.Class.alphanumeric" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.AlphaNum) + declareForeign Untracked "Char.Class.upper" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Upper) + declareForeign Untracked "Char.Class.lower" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Lower) + declareForeign Untracked "Char.Class.whitespace" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Whitespace) + declareForeign Untracked "Char.Class.control" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Control) + declareForeign Untracked "Char.Class.printable" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Printable) + declareForeign Untracked "Char.Class.mark" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.MarkChar) + declareForeign Untracked "Char.Class.number" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Number) + declareForeign Untracked "Char.Class.punctuation" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Punctuation) + declareForeign Untracked "Char.Class.symbol" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Symbol) + declareForeign Untracked "Char.Class.separator" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Separator) + declareForeign Untracked "Char.Class.letter" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Letter) + declareForeign Untracked "Char.Class.is" (argNToBool 2) . mkForeign $ \(cl, c) -> evaluate $ TPat.charPatternPred cl c + declareForeign Untracked "Text.patterns.char" (argNDirect 1) . mkForeign $ \c -> + let v = TPat.cpattern (TPat.Char c) in pure v + +type RW = PA.PrimState IO + +checkedRead :: + Text -> (PA.MutableArray RW Val, Word64) -> IO (Either Failure Val) +checkedRead name (arr, w) = + checkBounds + name + (PA.sizeofMutableArray arr) + w + (Right <$> PA.readArray arr (fromIntegral w)) + +checkedWrite :: + Text -> (PA.MutableArray RW Val, Word64, Val) -> IO (Either Failure ()) +checkedWrite name (arr, w, v) = + checkBounds + name + (PA.sizeofMutableArray arr) + w + (Right <$> PA.writeArray arr (fromIntegral w) v) + +checkedIndex :: + Text -> (PA.Array Val, Word64) -> IO (Either Failure Val) +checkedIndex name (arr, w) = + checkBounds + name + (PA.sizeofArray arr) + w + (Right <$> PA.indexArrayM arr (fromIntegral w)) + +checkedRead8 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64) +checkedRead8 name (arr, i) = + checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 1 $ + (Right . fromIntegral) <$> PA.readByteArray @Word8 arr j + where + j = fromIntegral i + +checkedRead16 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64) +checkedRead16 name (arr, i) = + checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 2 $ + mk16 + <$> PA.readByteArray @Word8 arr j + <*> PA.readByteArray @Word8 arr (j + 1) + where + j = fromIntegral i + +checkedRead24 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64) +checkedRead24 name (arr, i) = + checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 3 $ + mk24 + <$> PA.readByteArray @Word8 arr j + <*> PA.readByteArray @Word8 arr (j + 1) + <*> PA.readByteArray @Word8 arr (j + 2) + where + j = fromIntegral i + +checkedRead32 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64) +checkedRead32 name (arr, i) = + checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 4 $ + mk32 + <$> PA.readByteArray @Word8 arr j + <*> PA.readByteArray @Word8 arr (j + 1) + <*> PA.readByteArray @Word8 arr (j + 2) + <*> PA.readByteArray @Word8 arr (j + 3) + where + j = fromIntegral i + +checkedRead40 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64) +checkedRead40 name (arr, i) = + checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 6 $ + mk40 + <$> PA.readByteArray @Word8 arr j + <*> PA.readByteArray @Word8 arr (j + 1) + <*> PA.readByteArray @Word8 arr (j + 2) + <*> PA.readByteArray @Word8 arr (j + 3) + <*> PA.readByteArray @Word8 arr (j + 4) + where + j = fromIntegral i + +checkedRead64 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64) +checkedRead64 name (arr, i) = + checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 8 $ + mk64 + <$> PA.readByteArray @Word8 arr j + <*> PA.readByteArray @Word8 arr (j + 1) + <*> PA.readByteArray @Word8 arr (j + 2) + <*> PA.readByteArray @Word8 arr (j + 3) + <*> PA.readByteArray @Word8 arr (j + 4) + <*> PA.readByteArray @Word8 arr (j + 5) + <*> PA.readByteArray @Word8 arr (j + 6) + <*> PA.readByteArray @Word8 arr (j + 7) + where + j = fromIntegral i + +mk16 :: Word8 -> Word8 -> Either Failure Word64 +mk16 b0 b1 = Right $ (fromIntegral b0 `shiftL` 8) .|. (fromIntegral b1) + +mk24 :: Word8 -> Word8 -> Word8 -> Either Failure Word64 +mk24 b0 b1 b2 = + Right $ + (fromIntegral b0 `shiftL` 16) + .|. (fromIntegral b1 `shiftL` 8) + .|. (fromIntegral b2) + +mk32 :: Word8 -> Word8 -> Word8 -> Word8 -> Either Failure Word64 +mk32 b0 b1 b2 b3 = + Right $ + (fromIntegral b0 `shiftL` 24) + .|. (fromIntegral b1 `shiftL` 16) + .|. (fromIntegral b2 `shiftL` 8) + .|. (fromIntegral b3) + +mk40 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Either Failure Word64 +mk40 b0 b1 b2 b3 b4 = + Right $ + (fromIntegral b0 `shiftL` 32) + .|. (fromIntegral b1 `shiftL` 24) + .|. (fromIntegral b2 `shiftL` 16) + .|. (fromIntegral b3 `shiftL` 8) + .|. (fromIntegral b4) + +mk64 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Either Failure Word64 +mk64 b0 b1 b2 b3 b4 b5 b6 b7 = + Right $ + (fromIntegral b0 `shiftL` 56) + .|. (fromIntegral b1 `shiftL` 48) + .|. (fromIntegral b2 `shiftL` 40) + .|. (fromIntegral b3 `shiftL` 32) + .|. (fromIntegral b4 `shiftL` 24) + .|. (fromIntegral b5 `shiftL` 16) + .|. (fromIntegral b6 `shiftL` 8) + .|. (fromIntegral b7) + +checkedWrite8 :: Text -> (PA.MutableByteArray RW, Word64, Word64) -> IO (Either Failure ()) +checkedWrite8 name (arr, i, v) = + checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 1 $ do + PA.writeByteArray arr j (fromIntegral v :: Word8) + pure (Right ()) + where + j = fromIntegral i + +checkedWrite16 :: Text -> (PA.MutableByteArray RW, Word64, Word64) -> IO (Either Failure ()) +checkedWrite16 name (arr, i, v) = + checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 2 $ do + PA.writeByteArray arr j (fromIntegral $ v `shiftR` 8 :: Word8) + PA.writeByteArray arr (j + 1) (fromIntegral v :: Word8) + pure (Right ()) + where + j = fromIntegral i + +checkedWrite32 :: Text -> (PA.MutableByteArray RW, Word64, Word64) -> IO (Either Failure ()) +checkedWrite32 name (arr, i, v) = + checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 4 $ do + PA.writeByteArray arr j (fromIntegral $ v `shiftR` 24 :: Word8) + PA.writeByteArray arr (j + 1) (fromIntegral $ v `shiftR` 16 :: Word8) + PA.writeByteArray arr (j + 2) (fromIntegral $ v `shiftR` 8 :: Word8) + PA.writeByteArray arr (j + 3) (fromIntegral v :: Word8) + pure (Right ()) + where + j = fromIntegral i + +checkedWrite64 :: Text -> (PA.MutableByteArray RW, Word64, Word64) -> IO (Either Failure ()) +checkedWrite64 name (arr, i, v) = + checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 8 $ do + PA.writeByteArray arr j (fromIntegral $ v `shiftR` 56 :: Word8) + PA.writeByteArray arr (j + 1) (fromIntegral $ v `shiftR` 48 :: Word8) + PA.writeByteArray arr (j + 2) (fromIntegral $ v `shiftR` 40 :: Word8) + PA.writeByteArray arr (j + 3) (fromIntegral $ v `shiftR` 32 :: Word8) + PA.writeByteArray arr (j + 4) (fromIntegral $ v `shiftR` 24 :: Word8) + PA.writeByteArray arr (j + 5) (fromIntegral $ v `shiftR` 16 :: Word8) + PA.writeByteArray arr (j + 6) (fromIntegral $ v `shiftR` 8 :: Word8) + PA.writeByteArray arr (j + 7) (fromIntegral v :: Word8) + pure (Right ()) + where + j = fromIntegral i + +-- index single byte +checkedIndex8 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64) +checkedIndex8 name (arr, i) = + checkBoundsPrim name (PA.sizeofByteArray arr) i 1 . pure $ + let j = fromIntegral i + in Right . fromIntegral $ PA.indexByteArray @Word8 arr j + +-- index 16 big-endian +checkedIndex16 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64) +checkedIndex16 name (arr, i) = + checkBoundsPrim name (PA.sizeofByteArray arr) i 2 . pure $ + let j = fromIntegral i + in mk16 (PA.indexByteArray arr j) (PA.indexByteArray arr (j + 1)) + +-- index 32 big-endian +checkedIndex24 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64) +checkedIndex24 name (arr, i) = + checkBoundsPrim name (PA.sizeofByteArray arr) i 3 . pure $ + let j = fromIntegral i + in mk24 + (PA.indexByteArray arr j) + (PA.indexByteArray arr (j + 1)) + (PA.indexByteArray arr (j + 2)) + +-- index 32 big-endian +checkedIndex32 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64) +checkedIndex32 name (arr, i) = + checkBoundsPrim name (PA.sizeofByteArray arr) i 4 . pure $ + let j = fromIntegral i + in mk32 + (PA.indexByteArray arr j) + (PA.indexByteArray arr (j + 1)) + (PA.indexByteArray arr (j + 2)) + (PA.indexByteArray arr (j + 3)) + +-- index 40 big-endian +checkedIndex40 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64) +checkedIndex40 name (arr, i) = + checkBoundsPrim name (PA.sizeofByteArray arr) i 5 . pure $ + let j = fromIntegral i + in mk40 + (PA.indexByteArray arr j) + (PA.indexByteArray arr (j + 1)) + (PA.indexByteArray arr (j + 2)) + (PA.indexByteArray arr (j + 3)) + (PA.indexByteArray arr (j + 4)) + +-- index 64 big-endian +checkedIndex64 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64) +checkedIndex64 name (arr, i) = + checkBoundsPrim name (PA.sizeofByteArray arr) i 8 . pure $ + let j = fromIntegral i + in mk64 + (PA.indexByteArray arr j) + (PA.indexByteArray arr (j + 1)) + (PA.indexByteArray arr (j + 2)) + (PA.indexByteArray arr (j + 3)) + (PA.indexByteArray arr (j + 4)) + (PA.indexByteArray arr (j + 5)) + (PA.indexByteArray arr (j + 6)) + (PA.indexByteArray arr (j + 7)) + +checkBounds :: Text -> Int -> Word64 -> IO (Either Failure b) -> IO (Either Failure b) +checkBounds name l w act + | w < fromIntegral l = act + | otherwise = pure $ Left err + where + msg = name <> ": array index out of bounds" + err = Failure Ty.arrayFailureRef msg (natValue w) + +-- Performs a bounds check on a byte array. Strategy is as follows: +-- +-- isz = signed array size-in-bytes +-- off = unsigned byte offset into the array +-- esz = unsigned number of bytes to be read +-- +-- 1. Turn the signed size-in-bytes of the array unsigned +-- 2. Add the offset to the to-be-read number to get the maximum size needed +-- 3. Check that the actual array size is at least as big as the needed size +-- 4. Check that the offset is less than the size +-- +-- Step 4 ensures that step 3 has not overflowed. Since an actual array size can +-- only be 63 bits (since it is signed), the only way for 3 to overflow is if +-- the offset is larger than a possible array size, since it would need to be +-- 2^64-k, where k is the small (<=8) number of bytes to be read. +checkBoundsPrim :: + Text -> Int -> Word64 -> Word64 -> IO (Either Failure b) -> IO (Either Failure b) +checkBoundsPrim name isz off esz act + | w > bsz || off > bsz = pure $ Left err + | otherwise = act + where + msg = name <> ": array index out of bounds" + err = Failure Ty.arrayFailureRef msg (natValue off) + + bsz = fromIntegral isz + w = off + esz + +hostPreference :: Maybe Util.Text.Text -> SYS.HostPreference +hostPreference Nothing = SYS.HostAny +hostPreference (Just host) = SYS.Host $ Util.Text.unpack host + +signEd25519Wrapper :: + (Bytes.Bytes, Bytes.Bytes, Bytes.Bytes) -> Either Failure Bytes.Bytes +signEd25519Wrapper (secret0, public0, msg0) = case validated of + CryptoFailed err -> + Left (Failure Ty.cryptoFailureRef (errMsg err) unitValue) + CryptoPassed (secret, public) -> + Right . Bytes.fromArray $ Ed25519.sign secret public msg + where + msg = Bytes.toArray msg0 :: ByteString + validated = + (,) + <$> Ed25519.secretKey (Bytes.toArray secret0 :: ByteString) + <*> Ed25519.publicKey (Bytes.toArray public0 :: ByteString) + + errMsg CryptoError_PublicKeySizeInvalid = + "ed25519: Public key size invalid" + errMsg CryptoError_SecretKeySizeInvalid = + "ed25519: Secret key size invalid" + errMsg CryptoError_SecretKeyStructureInvalid = + "ed25519: Secret key structure invalid" + errMsg _ = "ed25519: unexpected error" + +verifyEd25519Wrapper :: + (Bytes.Bytes, Bytes.Bytes, Bytes.Bytes) -> Either Failure Bool +verifyEd25519Wrapper (public0, msg0, sig0) = case validated of + CryptoFailed err -> + Left $ Failure Ty.cryptoFailureRef (errMsg err) unitValue + CryptoPassed (public, sig) -> + Right $ Ed25519.verify public msg sig + where + msg = Bytes.toArray msg0 :: ByteString + validated = + (,) + <$> Ed25519.publicKey (Bytes.toArray public0 :: ByteString) + <*> Ed25519.signature (Bytes.toArray sig0 :: ByteString) + + errMsg CryptoError_PublicKeySizeInvalid = + "ed25519: Public key size invalid" + errMsg CryptoError_SecretKeySizeInvalid = + "ed25519: Secret key size invalid" + errMsg CryptoError_SecretKeyStructureInvalid = + "ed25519: Secret key structure invalid" + errMsg _ = "ed25519: unexpected error" + +signRsaWrapper :: + (Bytes.Bytes, Bytes.Bytes) -> Either Failure Bytes.Bytes +signRsaWrapper (secret0, msg0) = case validated of + Left err -> + Left (Failure Ty.cryptoFailureRef err unitValue) + Right secret -> + case RSA.sign Nothing (Just Hash.SHA256) secret msg of + Left err -> Left (Failure Ty.cryptoFailureRef (Rsa.rsaErrorToText err) unitValue) + Right signature -> Right $ Bytes.fromByteString signature + where + msg = Bytes.toArray msg0 :: ByteString + validated = Rsa.parseRsaPrivateKey (Bytes.toArray secret0 :: ByteString) + +verifyRsaWrapper :: + (Bytes.Bytes, Bytes.Bytes, Bytes.Bytes) -> Either Failure Bool +verifyRsaWrapper (public0, msg0, sig0) = case validated of + Left err -> + Left $ Failure Ty.cryptoFailureRef err unitValue + Right public -> + Right $ RSA.verify (Just Hash.SHA256) public msg sig + where + msg = Bytes.toArray msg0 :: ByteString + sig = Bytes.toArray sig0 :: ByteString + validated = Rsa.parseRsaPublicKey (Bytes.toArray public0 :: ByteString) + +foreignDeclResults :: + Bool -> (Word64, [(Data.Text.Text, (Sandbox, SuperNormal Symbol))], EnumMap Word64 (Data.Text.Text, ForeignFunc)) +foreignDeclResults sanitize = + execState (runReaderT declareForeigns sanitize) (0, [], mempty) + +foreignWrappers :: [(Data.Text.Text, (Sandbox, SuperNormal Symbol))] +foreignWrappers | (_, l, _) <- foreignDeclResults False = reverse l + +numberedTermLookup :: EnumMap Word64 (SuperNormal Symbol) +numberedTermLookup = + mapFromList . zip [1 ..] . Map.elems . fmap snd $ builtinLookup + +builtinTermNumbering :: Map Reference Word64 +builtinTermNumbering = + Map.fromList (zip (Map.keys $ builtinLookup) [1 ..]) + +builtinTermBackref :: EnumMap Word64 Reference +builtinTermBackref = + mapFromList . zip [1 ..] . Map.keys $ builtinLookup + +builtinForeigns :: EnumMap Word64 ForeignFunc +builtinForeigns | (_, _, m) <- foreignDeclResults False = snd <$> m + +sandboxedForeigns :: EnumMap Word64 ForeignFunc +sandboxedForeigns | (_, _, m) <- foreignDeclResults True = snd <$> m + +builtinForeignNames :: EnumMap Word64 Data.Text.Text +builtinForeignNames | (_, _, m) <- foreignDeclResults False = fst <$> m + +-- Bootstrapping for sandbox check. The eventual map will be one with +-- associations `r -> s` where `s` is all the 'sensitive' base +-- functions that `r` calls. +baseSandboxInfo :: Map Reference (Set Reference) +baseSandboxInfo = + Map.fromList $ + [ (r, Set.singleton r) + | (r, (sb, _)) <- Map.toList builtinLookup, + sb == Tracked + ] + +builtinArities :: Map Reference Int +builtinArities = + Map.fromList $ + [(r, arity s) | (r, (_, s)) <- Map.toList builtinLookup] + +builtinInlineInfo :: Map Reference (Int, ANormal Symbol) +builtinInlineInfo = + ANF.buildInlineMap $ fmap (Rec [] . snd) builtinLookup + +unsafeSTMToIO :: STM.STM a -> IO a +unsafeSTMToIO (STM.STM m) = IO m diff --git a/unison-runtime/src/Unison/Runtime/Builtin/Types.hs b/unison-runtime/src/Unison/Runtime/Builtin/Types.hs new file mode 100644 index 0000000000..fe82680dae --- /dev/null +++ b/unison-runtime/src/Unison/Runtime/Builtin/Types.hs @@ -0,0 +1,29 @@ +module Unison.Runtime.Builtin.Types + ( typeReferences, + builtinTypeNumbering, + builtinTypeBackref, + ) +where + +import Data.Map qualified as Map +import Unison.Builtin qualified as Ty (builtinTypes) +import Unison.Builtin.Decls qualified as Ty +import Unison.Prelude hiding (Text, some) +import Unison.Reference +import Unison.Util.EnumContainers as EC + +builtinTypeNumbering :: Map Reference Word64 +builtinTypeNumbering = Map.fromList typeReferences + +typeReferences :: [(Reference, Word64)] +typeReferences = zip rs [1 ..] + where + rs = + [r | (_, r) <- Ty.builtinTypes] + ++ [DerivedId i | (_, i, _) <- Ty.builtinDataDecls] + ++ [DerivedId i | (_, i, _) <- Ty.builtinEffectDecls] + +builtinTypeBackref :: EnumMap Word64 Reference +builtinTypeBackref = mapFromList $ swap <$> typeReferences + where + swap (x, y) = (y, x) diff --git a/parser-typechecker/src/Unison/Runtime/Crypto/Rsa.hs b/unison-runtime/src/Unison/Runtime/Crypto/Rsa.hs similarity index 100% rename from parser-typechecker/src/Unison/Runtime/Crypto/Rsa.hs rename to unison-runtime/src/Unison/Runtime/Crypto/Rsa.hs diff --git a/parser-typechecker/src/Unison/Runtime/Debug.hs b/unison-runtime/src/Unison/Runtime/Debug.hs similarity index 92% rename from parser-typechecker/src/Unison/Runtime/Debug.hs rename to unison-runtime/src/Unison/Runtime/Debug.hs index cc47c54bc8..e162fa32e4 100644 --- a/parser-typechecker/src/Unison/Runtime/Debug.hs +++ b/unison-runtime/src/Unison/Runtime/Debug.hs @@ -20,7 +20,7 @@ import Unison.Var (Var) type Term v = Tm.Term v () -traceComb :: Bool -> Word64 -> Comb -> Bool +traceComb :: (Show clos, Show comb) => Bool -> Word64 -> GComb clos comb -> Bool traceComb False _ _ = True traceComb True w c = trace (prettyComb w 0 c "\n") True diff --git a/unison-runtime/src/Unison/Runtime/Decompile.hs b/unison-runtime/src/Unison/Runtime/Decompile.hs new file mode 100644 index 0000000000..b650f450c9 --- /dev/null +++ b/unison-runtime/src/Unison/Runtime/Decompile.hs @@ -0,0 +1,249 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} + +module Unison.Runtime.Decompile + ( decompile, + DecompResult, + DecompError (..), + renderDecompError, + ) +where + +import Data.Set (singleton) +import Unison.ABT (substs) +import Unison.Codebase.Runtime (Error) +import Unison.ConstructorReference (GConstructorReference (..)) +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 (..), + USeq, + UnboxedTypeTag (..), + Val (..), + pattern DataC, + pattern PApV, + ) +import Unison.Syntax.NamePrinter (prettyReference) +import Unison.Term + ( Term, + app, + apps', + boolean, + builtin, + char, + constructor, + float, + int, + list, + list', + nat, + ref, + termLink, + text, + typeLink, + pattern LamNamed', + ) +import Unison.Term qualified as Term +import Unison.Type + ( anyRef, + booleanRef, + iarrayRef, + ibytearrayRef, + listRef, + termLinkRef, + typeLinkRef, + ) +import Unison.Util.Bytes qualified as By +import Unison.Util.Pretty (indentN, lines, lit, shown, syntaxToColor, wrap) +import Unison.Util.Text qualified as Text +import Unison.Var (Var) +import Prelude hiding (lines) + +con :: (Var v) => Reference -> Word64 -> Term v () +con rf ct = constructor () (ConstructorReference rf $ fromIntegral ct) + +bug :: (Var v) => Text -> Term v () +bug msg = app () (builtin () "bug") (text () msg) + +err :: DecompError -> a -> (Set DecompError, a) +err err x = (singleton err, x) + +data DecompError + = BadBool !Word64 + | BadUnboxed !UnboxedTypeTag + | BadForeign !Reference + | BadData !Reference + | BadPAp !Reference + | UnkComb !Reference + | UnkLocal !Reference !Word64 + | Cont + | Exn + deriving (Eq, Ord) + +type DecompResult v = (Set DecompError, Term v ()) + +prf :: Reference -> Error +prf = syntaxToColor . prettyReference 10 + +printUnboxedTypeTag :: UnboxedTypeTag -> Error +printUnboxedTypeTag = shown + +renderDecompError :: DecompError -> Error +renderDecompError (BadBool n) = + lines + [ wrap "A boolean value had an unexpected constructor tag:", + indentN 2 . lit . fromString $ show n + ] +renderDecompError (BadUnboxed tt) = + lines + [ wrap "An apparent numeric type had an unrecognized packed tag:", + indentN 2 $ printUnboxedTypeTag tt + ] +renderDecompError (BadForeign rf) = + lines + [ wrap "A foreign value with no decompiled representation was encountered:", + indentN 2 $ prf rf + ] +renderDecompError (BadData rf) = + lines + [ wrap + "A data type with no decompiled representation was encountered:", + indentN 2 $ prf rf + ] +renderDecompError (BadPAp rf) = + lines + [ wrap "A partial function application could not be decompiled: ", + indentN 2 $ prf rf + ] +renderDecompError (UnkComb rf) = + lines + [ wrap "A reference to an unknown function was encountered: ", + indentN 2 $ prf rf + ] +renderDecompError (UnkLocal rf n) = + lines + [ "A reference to an unknown portion to a function was encountered: ", + indentN 2 $ "function: " <> prf rf, + indentN 2 $ "section: " <> lit (fromString $ show n) + ] +renderDecompError Cont = "A continuation value was encountered" +renderDecompError Exn = "An exception value was encountered" + +decompile :: + forall v. + (Var v) => + (Reference -> Maybe Reference) -> + (Word64 -> Word64 -> Maybe (Term v ())) -> + Val -> + DecompResult v +decompile backref topTerms = \case + CharVal c -> pure (char () c) + NatVal n -> pure (nat () n) + IntVal i -> pure (int () (fromIntegral i)) + DoubleVal f -> pure (float () f) + Val i (UnboxedTypeTag tt) -> + err (BadUnboxed tt) . nat () $ fromIntegral $ i + Val _u clos -> case clos of + DataC rf (maskTags -> ct) [] + | rf == booleanRef -> tag2bool ct + (DataC rf _ [b]) + | rf == anyRef -> + app () (builtin () "Any.Any") <$> decompile backref topTerms b + (DataC rf (maskTags -> ct) vs) -> + apps' (con rf ct) <$> traverse (decompile backref topTerms) vs + (PApV (CIx rf rt k) _ vs) + | rf == Builtin "jumpCont" -> + err Cont $ bug "" + | Builtin nm <- rf -> + apps' (builtin () nm) <$> traverse (decompile backref topTerms) vs + | Just t <- topTerms rt k -> + Term.etaReduceEtaVars . substitute t + <$> traverse (decompile backref topTerms) vs + | k > 0, + Just _ <- topTerms rt 0 -> + err (UnkLocal rf k) $ bug "" + | otherwise -> err (UnkComb rf) $ ref () rf + (PAp (CIx rf _ _) _ _) -> + err (BadPAp rf) $ bug "" + BlackHole -> err Exn $ bug "" + (Captured {}) -> err Cont $ bug "" + (Foreign f) -> + decompileForeign backref topTerms f + +tag2bool :: (Var v) => Word64 -> DecompResult v +tag2bool 0 = pure (boolean () False) +tag2bool 1 = pure (boolean () True) +tag2bool n = err (BadBool n) $ con booleanRef n + +substitute :: (Var v) => Term v () -> [Term v ()] -> Term v () +substitute = align [] + where + align vts (LamNamed' v bd) (t : ts) = align ((v, t) : vts) bd ts + align vts tm [] = substs vts tm + -- this should not happen + align vts tm ts = apps' (substs vts tm) ts + +decompileForeign :: + (Var v) => + (Reference -> Maybe Reference) -> + (Word64 -> Word64 -> Maybe (Term v ())) -> + Foreign -> + DecompResult v +decompileForeign backref topTerms f + | Just t <- maybeUnwrapBuiltin f = pure $ text () (Text.toText t) + | Just b <- maybeUnwrapBuiltin f = pure $ decompileBytes b + | Just h <- maybeUnwrapBuiltin f = pure $ decompileHashAlgorithm h + | Just l <- maybeUnwrapForeign termLinkRef f = + pure . termLink () $ case l of + Ref r -> maybe l Ref $ backref r + _ -> l + | Just l <- maybeUnwrapForeign typeLinkRef f = + pure $ typeLink () l + | Just (a :: Array Val) <- 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 _) = + err (BadForeign r) $ bug text + where + text + | Builtin name <- r = "<" <> name <> ">" + | otherwise = "" + +decompileBytes :: (Var v) => By.Bytes -> Term v () +decompileBytes = + app () (builtin () $ fromString "Bytes.fromList") + . list () + . fmap (nat () . fromIntegral) + . By.toWord8s + +decompileHashAlgorithm :: (Var v) => HashAlgorithm -> Term v () +decompileHashAlgorithm (HashAlgorithm r _) = ref () r + +unwrapSeq :: Foreign -> Maybe USeq +unwrapSeq = maybeUnwrapForeign listRef diff --git a/parser-typechecker/src/Unison/Runtime/Exception.hs b/unison-runtime/src/Unison/Runtime/Exception.hs similarity index 93% rename from parser-typechecker/src/Unison/Runtime/Exception.hs rename to unison-runtime/src/Unison/Runtime/Exception.hs index 16a149d953..7d0d7bd5ea 100644 --- a/parser-typechecker/src/Unison/Runtime/Exception.hs +++ b/unison-runtime/src/Unison/Runtime/Exception.hs @@ -10,7 +10,7 @@ import Unison.Util.Pretty as P data RuntimeExn = PE CallStack (P.Pretty P.ColorText) - | BU [(Reference, Int)] Text Closure + | BU [(Reference, Int)] Text Val deriving (Show) instance Exception RuntimeExn diff --git a/parser-typechecker/src/Unison/Runtime/Foreign.hs b/unison-runtime/src/Unison/Runtime/Foreign.hs similarity index 96% rename from parser-typechecker/src/Unison/Runtime/Foreign.hs rename to unison-runtime/src/Unison/Runtime/Foreign.hs index c9cd12fafb..29c4034471 100644 --- a/parser-typechecker/src/Unison/Runtime/Foreign.hs +++ b/unison-runtime/src/Unison/Runtime/Foreign.hs @@ -23,7 +23,6 @@ import Control.Concurrent (MVar, ThreadId) import Control.Concurrent.STM (TVar) import Crypto.Hash qualified as Hash import Data.IORef (IORef) -import Data.Primitive (ByteArray, MutableArray, MutableByteArray) import Data.Tagged (Tagged (..)) import Data.X509 qualified as X509 import Network.Socket (Socket) @@ -34,8 +33,8 @@ import System.IO (Handle) import System.Process (ProcessHandle) import Unison.Reference (Reference) import Unison.Referent (Referent) -import Unison.Runtime.ANF (SuperGroup, Value) -import Unison.Symbol (Symbol) +import Unison.Runtime.ANF (Code, Value) +import Unison.Runtime.Array import Unison.Type qualified as Ty import Unison.Util.Bytes (Bytes) import Unison.Util.Text (Text) @@ -130,8 +129,8 @@ charClassCmp :: CharPattern -> CharPattern -> Ordering charClassCmp = compare {-# NOINLINE charClassCmp #-} -codeEq :: SuperGroup Symbol -> SuperGroup Symbol -> Bool -codeEq sg1 sg2 = sg1 == sg2 +codeEq :: Code -> Code -> Bool +codeEq co1 co2 = co1 == co2 {-# NOINLINE codeEq #-} tylEq :: Reference -> Reference -> Bool @@ -256,8 +255,7 @@ instance BuiltinForeign FilePath where foreignRef = Tagged Ty.filePathRef instance BuiltinForeign TLS.Context where foreignRef = Tagged Ty.tlsRef -instance BuiltinForeign (SuperGroup Symbol) where - foreignRef = Tagged Ty.codeRef +instance BuiltinForeign Code where foreignRef = Tagged Ty.codeRef instance BuiltinForeign Value where foreignRef = Tagged Ty.valueRef diff --git a/unison-runtime/src/Unison/Runtime/Foreign/Function.hs b/unison-runtime/src/Unison/Runtime/Foreign/Function.hs new file mode 100644 index 0000000000..13b85e2b14 --- /dev/null +++ b/unison-runtime/src/Unison/Runtime/Foreign/Function.hs @@ -0,0 +1,557 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} + +module Unison.Runtime.Foreign.Function + ( ForeignFunc (..), + ForeignConvention (..), + mkForeign, + ) +where + +import Control.Concurrent (ThreadId) +import Control.Concurrent.MVar (MVar) +import Control.Concurrent.STM (TVar) +import Control.Exception (evaluate) +import Data.Atomics (Ticket) +import Data.Foldable (toList) +import Data.IORef (IORef) +import Data.Sequence qualified as Sq +import Data.Time.Clock.POSIX (POSIXTime) +import Data.Word (Word16, Word32, Word64, Word8) +import GHC.IO.Exception (IOErrorType (..), IOException (..)) +import Network.Socket (Socket) +import Network.UDP (UDPSocket) +import System.IO (BufferMode (..), Handle, IOMode, SeekMode) +import Unison.Builtin.Decls qualified as Ty +import Unison.Reference (Reference) +import Unison.Runtime.ANF (Code, PackedTag (..), Value, internalBug) +import Unison.Runtime.Array qualified as PA +import Unison.Runtime.Exception +import Unison.Runtime.Foreign +import Unison.Runtime.MCode +import Unison.Runtime.Stack +import Unison.Type + ( iarrayRef, + ibytearrayRef, + marrayRef, + mbytearrayRef, + mvarRef, + promiseRef, + refRef, + ticketRef, + tvarRef, + typeLinkRef, + ) +import Unison.Util.Bytes (Bytes) +import Unison.Util.RefPromise (Promise) +import Unison.Util.Text (Text, pack, unpack) + +-- Foreign functions operating on stacks +data ForeignFunc where + FF :: + (Stack -> Args -> IO a) -> + (Stack -> r -> IO Stack) -> + (a -> IO r) -> + ForeignFunc + +instance Show ForeignFunc where + show _ = "ForeignFunc" + +instance Eq ForeignFunc where + _ == _ = internalBug "Eq ForeignFunc" + +instance Ord ForeignFunc where + compare _ _ = internalBug "Ord ForeignFunc" + +class ForeignConvention a where + readForeign :: + [Int] -> Stack -> IO ([Int], a) + writeForeign :: + Stack -> a -> IO Stack + +mkForeign :: + (ForeignConvention a, ForeignConvention r) => + (a -> IO r) -> + ForeignFunc +mkForeign ev = FF readArgs writeForeign ev + where + readArgs stk (argsToLists -> args) = + readForeign args stk >>= \case + ([], a) -> pure a + _ -> + internalBug + "mkForeign: too many arguments for foreign function" + +instance ForeignConvention Int where + readForeign (i : args) stk = (args,) <$> peekOffI stk i + readForeign [] _ = foreignCCError "Int" + writeForeign stk i = do + stk <- bump stk + stk <$ pokeI stk i + +instance ForeignConvention Word64 where + readForeign (i : args) stk = (args,) <$> peekOffN stk i + readForeign [] _ = foreignCCError "Word64" + writeForeign stk n = do + stk <- bump stk + stk <$ pokeN stk n + +-- We don't have a clear mapping from these types to Unison types, most are just mapped to Nats. + +instance ForeignConvention Word8 where + readForeign = readForeignAs (fromIntegral :: Word64 -> Word8) + writeForeign = writeForeignAs (fromIntegral :: Word8 -> Word64) + +instance ForeignConvention Word16 where + readForeign = readForeignAs (fromIntegral :: Word64 -> Word16) + writeForeign = writeForeignAs (fromIntegral :: Word16 -> Word64) + +instance ForeignConvention Word32 where + readForeign = readForeignAs (fromIntegral :: Word64 -> Word32) + writeForeign = writeForeignAs (fromIntegral :: Word32 -> Word64) + +instance ForeignConvention Char where + readForeign (i : args) stk = (args,) <$> peekOffC stk i + readForeign [] _ = foreignCCError "Char" + writeForeign stk ch = do + stk <- bump stk + stk <$ pokeC stk ch + +instance ForeignConvention Val where + readForeign (i : args) stk = (args,) <$> peekOff stk i + readForeign [] _ = foreignCCError "Val" + writeForeign stk v = do + stk <- bump stk + stk <$ (poke stk =<< evaluate v) + +-- In reality this fixes the type to be 'RClosure', but allows us to defer +-- the typechecker a bit and avoid a bunch of annoying type annotations. +instance ForeignConvention Closure where + readForeign (i : args) stk = (args,) <$> bpeekOff stk i + readForeign [] _ = foreignCCError "Closure" + writeForeign stk c = do + stk <- bump stk + stk <$ (bpoke stk =<< evaluate c) + +instance ForeignConvention Text where + readForeign = readForeignBuiltin + writeForeign = writeForeignBuiltin + +instance ForeignConvention Bytes where + readForeign = readForeignBuiltin + writeForeign = writeForeignBuiltin + +instance ForeignConvention Socket where + readForeign = readForeignBuiltin + writeForeign = writeForeignBuiltin + +instance ForeignConvention UDPSocket where + readForeign = readForeignBuiltin + writeForeign = writeForeignBuiltin + +instance ForeignConvention ThreadId where + readForeign = readForeignBuiltin + writeForeign = writeForeignBuiltin + +instance ForeignConvention Handle where + readForeign = readForeignBuiltin + writeForeign = writeForeignBuiltin + +instance ForeignConvention POSIXTime where + readForeign = readForeignAs (fromIntegral :: Int -> POSIXTime) + writeForeign = writeForeignAs (round :: POSIXTime -> Int) + +instance (ForeignConvention a) => ForeignConvention (Maybe a) where + readForeign (i : args) stk = + upeekOff stk i >>= \case + 0 -> pure (args, Nothing) + 1 -> fmap Just <$> readForeign args stk + _ -> foreignCCError "Maybe" + readForeign [] _ = foreignCCError "Maybe" + + writeForeign stk Nothing = do + stk <- bump stk + stk <$ pokeTag stk 0 + writeForeign stk (Just x) = do + stk <- writeForeign stk x + stk <- bump stk + stk <$ pokeTag stk 1 + +instance + (ForeignConvention a, ForeignConvention b) => + ForeignConvention (Either a b) + where + readForeign (i : args) stk = + peekTagOff stk i >>= \case + 0 -> readForeignAs Left args stk + 1 -> readForeignAs Right args stk + _ -> foreignCCError "Either" + readForeign _ _ = foreignCCError "Either" + + writeForeign stk (Left a) = do + stk <- writeForeign stk a + stk <- bump stk + stk <$ pokeTag stk 0 + writeForeign stk (Right b) = do + stk <- writeForeign stk b + stk <- bump stk + stk <$ pokeTag stk 1 + +ioeDecode :: Int -> IOErrorType +ioeDecode 0 = AlreadyExists +ioeDecode 1 = NoSuchThing +ioeDecode 2 = ResourceBusy +ioeDecode 3 = ResourceExhausted +ioeDecode 4 = EOF +ioeDecode 5 = IllegalOperation +ioeDecode 6 = PermissionDenied +ioeDecode 7 = UserError +ioeDecode _ = internalBug "ioeDecode" + +ioeEncode :: IOErrorType -> Int +ioeEncode AlreadyExists = 0 +ioeEncode NoSuchThing = 1 +ioeEncode ResourceBusy = 2 +ioeEncode ResourceExhausted = 3 +ioeEncode EOF = 4 +ioeEncode IllegalOperation = 5 +ioeEncode PermissionDenied = 6 +ioeEncode UserError = 7 +ioeEncode _ = internalBug "ioeDecode" + +instance ForeignConvention IOException where + readForeign = readForeignAs (bld . ioeDecode) + where + bld t = IOError Nothing t "" "" Nothing Nothing + + writeForeign = writeForeignAs (ioeEncode . ioe_type) + +readForeignAs :: + (ForeignConvention a) => + (a -> b) -> + [Int] -> + Stack -> + IO ([Int], b) +readForeignAs f args stk = fmap f <$> readForeign args stk + +writeForeignAs :: + (ForeignConvention b) => + (a -> b) -> + Stack -> + a -> + IO Stack +writeForeignAs f stk x = writeForeign stk (f x) + +readForeignEnum :: + (Enum a) => + [Int] -> + Stack -> + IO ([Int], a) +readForeignEnum = readForeignAs toEnum + +writeForeignEnum :: + (Enum a) => + Stack -> + a -> + IO Stack +writeForeignEnum = writeForeignAs fromEnum + +readForeignBuiltin :: + (BuiltinForeign b) => + [Int] -> + Stack -> + IO ([Int], b) +readForeignBuiltin = readForeignAs (unwrapBuiltin . marshalToForeign) + +writeForeignBuiltin :: + (BuiltinForeign b) => + Stack -> + b -> + IO Stack +writeForeignBuiltin = writeForeignAs (Foreign . wrapBuiltin) + +writeTypeLink :: + Stack -> + Reference -> + IO Stack +writeTypeLink = writeForeignAs (Foreign . Wrap typeLinkRef) + +readTypelink :: + [Int] -> + Stack -> + IO ([Int], Reference) +readTypelink = readForeignAs (unwrapForeign . marshalToForeign) + +instance ForeignConvention Double where + readForeign (i : args) stk = (args,) <$> peekOffD stk i + readForeign _ _ = foreignCCError "Double" + writeForeign stk d = + bump stk >>= \stk -> do + pokeD stk d + pure stk + +instance ForeignConvention Bool where + readForeign = readForeignEnum + writeForeign = writeForeignEnum + +instance ForeignConvention String where + readForeign = readForeignAs unpack + writeForeign = writeForeignAs pack + +instance ForeignConvention SeekMode where + readForeign = readForeignEnum + writeForeign = writeForeignEnum + +instance ForeignConvention IOMode where + readForeign = readForeignEnum + writeForeign = writeForeignEnum + +instance ForeignConvention () where + readForeign args _ = pure (args, ()) + writeForeign stk _ = pure stk + +instance + (ForeignConvention a, ForeignConvention b) => + ForeignConvention (a, b) + where + readForeign args stk = do + (args, a) <- readForeign args stk + (args, b) <- readForeign args stk + pure (args, (a, b)) + + writeForeign stk (x, y) = do + stk <- writeForeign stk y + writeForeign stk x + +instance (ForeignConvention a) => ForeignConvention (Failure a) where + readForeign args stk = do + (args, typeref) <- readTypelink args stk + (args, message) <- readForeign args stk + (args, any) <- readForeign args stk + pure (args, Failure typeref message any) + + writeForeign stk (Failure typeref message any) = do + stk <- writeForeign stk any + stk <- writeForeign stk message + writeTypeLink stk typeref + +instance + ( ForeignConvention a, + ForeignConvention b, + ForeignConvention c + ) => + ForeignConvention (a, b, c) + where + readForeign args stk = do + (args, a) <- readForeign args stk + (args, b) <- readForeign args stk + (args, c) <- readForeign args stk + pure (args, (a, b, c)) + + writeForeign stk (a, b, c) = do + stk <- writeForeign stk c + stk <- writeForeign stk b + writeForeign stk a + +instance + ( ForeignConvention a, + ForeignConvention b, + ForeignConvention c, + ForeignConvention d + ) => + ForeignConvention (a, b, c, d) + where + readForeign args stk = do + (args, a) <- readForeign args stk + (args, b) <- readForeign args stk + (args, c) <- readForeign args stk + (args, d) <- readForeign args stk + pure (args, (a, b, c, d)) + + writeForeign stk (a, b, c, d) = do + stk <- writeForeign stk d + stk <- writeForeign stk c + stk <- writeForeign stk b + writeForeign stk a + +instance + ( ForeignConvention a, + ForeignConvention b, + ForeignConvention c, + ForeignConvention d, + ForeignConvention e + ) => + ForeignConvention (a, b, c, d, e) + where + readForeign args stk = do + (args, a) <- readForeign args stk + (args, b) <- readForeign args stk + (args, c) <- readForeign args stk + (args, d) <- readForeign args stk + (args, e) <- readForeign args stk + pure (args, (a, b, c, d, e)) + + writeForeign stk (a, b, c, d, e) = do + stk <- writeForeign stk e + stk <- writeForeign stk d + stk <- writeForeign stk c + stk <- writeForeign stk b + writeForeign stk a + +no'buf, line'buf, block'buf, sblock'buf :: Word64 +no'buf = fromIntegral Ty.bufferModeNoBufferingId +line'buf = fromIntegral Ty.bufferModeLineBufferingId +block'buf = fromIntegral Ty.bufferModeBlockBufferingId +sblock'buf = fromIntegral Ty.bufferModeSizedBlockBufferingId + +instance ForeignConvention BufferMode where + readForeign (i : args) stk = + peekOffN stk i >>= \case + t + | t == no'buf -> pure (args, NoBuffering) + | t == line'buf -> pure (args, LineBuffering) + | t == block'buf -> pure (args, BlockBuffering Nothing) + | t == sblock'buf -> + fmap (BlockBuffering . Just) + <$> readForeign args stk + | otherwise -> + foreignCCError $ + "BufferMode (unknown tag: " <> show t <> ")" + readForeign _ _ = foreignCCError $ "BufferMode (empty stack)" + + writeForeign stk bm = + bump stk >>= \stk -> + case bm of + NoBuffering -> stk <$ pokeN stk no'buf + LineBuffering -> stk <$ pokeN stk line'buf + BlockBuffering Nothing -> stk <$ pokeN stk block'buf + BlockBuffering (Just n) -> do + pokeI stk n + stk <- bump stk + stk <$ pokeN stk sblock'buf + +-- In reality this fixes the type to be 'RClosure', but allows us to defer +-- the typechecker a bit and avoid a bunch of annoying type annotations. +instance {-# OVERLAPPING #-} ForeignConvention [Val] where + readForeign (i : args) stk = + (args,) . toList <$> peekOffS stk i + readForeign _ _ = foreignCCError "[Val]" + writeForeign stk l = do + stk <- bump stk + stk <$ pokeS stk (Sq.fromList l) + +-- In reality this fixes the type to be 'RClosure', but allows us to defer +-- the typechecker a bit and avoid a bunch of annoying type annotations. +instance {-# OVERLAPPING #-} ForeignConvention [Closure] where + readForeign (i : args) stk = + (args,) . fmap getBoxedVal . toList <$> peekOffS stk i + readForeign _ _ = foreignCCError "[Closure]" + writeForeign stk l = do + stk <- bump stk + stk <$ pokeS stk (Sq.fromList . fmap BoxedVal $ l) + +instance ForeignConvention [Foreign] where + readForeign = readForeignAs (fmap marshalToForeign) + writeForeign = writeForeignAs (fmap Foreign) + +instance ForeignConvention (MVar Val) where + readForeign = readForeignAs (unwrapForeign . marshalToForeign) + writeForeign = writeForeignAs (Foreign . Wrap mvarRef) + +instance ForeignConvention (TVar Val) where + readForeign = readForeignAs (unwrapForeign . marshalToForeign) + writeForeign = writeForeignAs (Foreign . Wrap tvarRef) + +instance ForeignConvention (IORef Val) where + readForeign = readForeignAs (unwrapForeign . marshalToForeign) + writeForeign = writeForeignAs (Foreign . Wrap refRef) + +instance ForeignConvention (Ticket Val) where + readForeign = readForeignAs (unwrapForeign . marshalToForeign) + writeForeign = writeForeignAs (Foreign . Wrap ticketRef) + +instance ForeignConvention (Promise Val) where + readForeign = readForeignAs (unwrapForeign . marshalToForeign) + writeForeign = writeForeignAs (Foreign . Wrap promiseRef) + +instance ForeignConvention Code where + readForeign = readForeignBuiltin + writeForeign = writeForeignBuiltin + +instance ForeignConvention Value where + readForeign = readForeignBuiltin + writeForeign = writeForeignBuiltin + +instance ForeignConvention Foreign where + readForeign = readForeignAs marshalToForeign + writeForeign = writeForeignAs Foreign + +instance ForeignConvention (PA.MutableArray s Val) where + readForeign = readForeignAs (unwrapForeign . marshalToForeign) + writeForeign = writeForeignAs (Foreign . Wrap marrayRef) + +instance ForeignConvention (PA.MutableByteArray s) where + readForeign = readForeignAs (unwrapForeign . marshalToForeign) + writeForeign = writeForeignAs (Foreign . Wrap mbytearrayRef) + +instance ForeignConvention (PA.Array Val) where + readForeign = readForeignAs (unwrapForeign . marshalToForeign) + writeForeign = writeForeignAs (Foreign . Wrap iarrayRef) + +instance ForeignConvention PA.ByteArray where + readForeign = readForeignAs (unwrapForeign . marshalToForeign) + writeForeign = writeForeignAs (Foreign . Wrap ibytearrayRef) + +instance {-# OVERLAPPABLE #-} (BuiltinForeign b) => ForeignConvention b where + readForeign = readForeignBuiltin + writeForeign = writeForeignBuiltin + +fromUnisonPair :: (BuiltinForeign a, BuiltinForeign b) => Closure -> (a, b) +fromUnisonPair (DataC _ _ [BoxedVal x, BoxedVal (DataC _ _ [BoxedVal y, BoxedVal _unit])]) = + (unwrapForeignClosure x, unwrapForeignClosure y) +fromUnisonPair _ = error "fromUnisonPair: invalid closure" + +toUnisonPair :: + (BuiltinForeign a, BuiltinForeign b) => (a, b) -> Closure +toUnisonPair (x, y) = + DataC + Ty.pairRef + (PackedTag 0) + [BoxedVal $ wr x, BoxedVal $ DataC Ty.pairRef (PackedTag 0) [BoxedVal $ wr y, BoxedVal $ un]] + where + un = DataC Ty.unitRef (PackedTag 0) [] + wr z = Foreign $ wrapBuiltin z + +unwrapForeignClosure :: Closure -> a +unwrapForeignClosure = unwrapForeign . marshalToForeign + +instance {-# OVERLAPPABLE #-} (BuiltinForeign a, BuiltinForeign b) => ForeignConvention [(a, b)] where + readForeign (i : args) stk = + (args,) + . fmap (fromUnisonPair . getBoxedVal) + . toList + <$> peekOffS stk i + readForeign _ _ = foreignCCError "[(a,b)]" + + writeForeign stk l = do + stk <- bump stk + stk <$ pokeS stk (boxedVal . toUnisonPair <$> Sq.fromList l) + +instance {-# OVERLAPPABLE #-} (BuiltinForeign b) => ForeignConvention [b] where + readForeign (i : args) stk = + (args,) + . fmap (unwrapForeignClosure . getBoxedVal) + . toList + <$> peekOffS stk i + readForeign _ _ = foreignCCError "[b]" + writeForeign stk l = do + stk <- bump stk + stk <$ pokeS stk (boxedVal . Foreign . wrapBuiltin <$> Sq.fromList l) + +foreignCCError :: String -> IO a +foreignCCError nm = + die $ "mismatched foreign calling convention for `" ++ nm ++ "`" diff --git a/parser-typechecker/src/Unison/Runtime/IOSource.hs b/unison-runtime/src/Unison/Runtime/IOSource.hs similarity index 99% rename from parser-typechecker/src/Unison/Runtime/IOSource.hs rename to unison-runtime/src/Unison/Runtime/IOSource.hs index 4848851f89..f690671fc5 100644 --- a/parser-typechecker/src/Unison/Runtime/IOSource.hs +++ b/unison-runtime/src/Unison/Runtime/IOSource.hs @@ -41,7 +41,9 @@ parsingEnv = Parser.ParsingEnv { uniqueNames = mempty, uniqueTypeGuid = \_ -> pure Nothing, - names = Builtin.names + names = Builtin.names, + maybeNamespace = Nothing, + localNamespacePrefixedTypesAndConstructors = mempty } typecheckingEnv :: Typechecker.Env Symbol Ann diff --git a/parser-typechecker/src/Unison/Runtime/Interface.hs b/unison-runtime/src/Unison/Runtime/Interface.hs similarity index 85% rename from parser-typechecker/src/Unison/Runtime/Interface.hs rename to unison-runtime/src/Unison/Runtime/Interface.hs index 66139742bb..a9103e1ec4 100644 --- a/parser-typechecker/src/Unison/Runtime/Interface.hs +++ b/unison-runtime/src/Unison/Runtime/Interface.hs @@ -13,18 +13,23 @@ module Unison.Runtime.Interface startNativeRuntime, standalone, runStandalone, - StoredCache, + StoredCache + ( -- Exported for tests + SCache + ), decodeStandalone, RuntimeHost (..), Runtime (..), + + -- * Exported for tests + getStoredCache, + putStoredCache, ) where import Control.Concurrent.STM as STM import Control.Exception (throwIO) import Control.Monad --- import Data.Bits (shiftL) - import Control.Monad.State import Data.Binary.Get (runGetOrFail) import Data.ByteString qualified as BS @@ -48,6 +53,7 @@ import Data.Set as Set ) import Data.Set qualified as Set import Data.Text as Text (isPrefixOf, pack, unpack) +import Data.Void (absurd) 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) @@ -71,10 +77,11 @@ import System.Process waitForProcess, withCreateProcess, ) +import Unison.ABT qualified as ABT import Unison.Builtin.Decls qualified as RF import Unison.Codebase.CodeLookup (CodeLookup (..)) import Unison.Codebase.MainTerm (builtinIOTestTypes, builtinMain) -import Unison.Codebase.Runtime (Error, Runtime (..)) +import Unison.Codebase.Runtime (CompileOpts (..), Error, Runtime (..)) import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) import Unison.ConstructorReference qualified as RF import Unison.DataDeclaration (Decl, declFields, declTypeDependencies) @@ -100,19 +107,24 @@ import Unison.Runtime.Decompile import Unison.Runtime.Exception import Unison.Runtime.MCode ( Args (..), - Combs, - Instr (..), + CombIx (..), + GCombs, + GInstr (..), + GSection (..), + RCombs, RefNums (..), - Section (..), + absurdCombs, combDeps, combTypes, emitComb, emptyRNs, + resolveCombs, ) import Unison.Runtime.MCode.Serialize import Unison.Runtime.Machine ( ActiveThreads, CCache (..), + Combs, Tracer (..), apply0, baseCCache, @@ -120,11 +132,13 @@ import Unison.Runtime.Machine cacheAdd0, eval0, expandSandbox, + preEvalTopLevelConstants, refLookup, refNumTm, refNumsTm, refNumsTy, reifyValue, + resolveSection, ) import Unison.Runtime.Pattern import Unison.Runtime.Serialize as SER @@ -134,29 +148,45 @@ import Unison.Syntax.HashQualified qualified as HQ (toText) import Unison.Syntax.NamePrinter (prettyHashQualified) import Unison.Syntax.TermPrinter import Unison.Term qualified as Tm +import Unison.Type qualified as Type import Unison.Util.EnumContainers as EC import Unison.Util.Monoid (foldMapM) import Unison.Util.Pretty as P +import Unison.Util.Recursion qualified as Rec import UnliftIO qualified import UnliftIO.Concurrent qualified as UnliftIO type Term v = Tm.Term v () -data Remapping = Remap - { remap :: Map.Map Reference Reference, - backmap :: Map.Map Reference Reference +type Type v = Type.Type v () + +-- Note that these annotations are suggestions at best, since in many places codebase refs, intermediate refs, and +-- floated refs are all intermingled. +type CodebaseReference = Reference + +-- Note that these annotations are suggestions at best, since in many places codebase refs, intermediate refs, and +-- floated refs are all intermingled. +type IntermediateReference = Reference + +-- Note that these annotations are suggestions at best, since in many places codebase refs, intermediate refs, and +-- floated refs are all intermingled. +type FloatedReference = Reference + +data Remapping from to = Remap + { remap :: Map.Map from to, + backmap :: Map.Map to from } -instance Semigroup Remapping where +instance (Ord from, Ord to) => Semigroup (Remapping from to) where Remap r1 b1 <> Remap r2 b2 = Remap (r1 <> r2) (b1 <> b2) -instance Monoid Remapping where +instance (Ord from, Ord to) => Monoid (Remapping from to) where mempty = Remap mempty mempty data EvalCtx = ECtx { dspec :: DataSpec, - floatRemap :: Remapping, - intermedRemap :: Remapping, + floatRemap :: Remapping CodebaseReference FloatedReference, + intermedRemap :: Remapping FloatedReference IntermediateReference, decompTm :: Map.Map Reference (Map.Map Word64 (Term Symbol)), ccache :: CCache } @@ -321,7 +351,7 @@ backrefAdd :: backrefAdd m ctx@ECtx {decompTm} = ctx {decompTm = m <> decompTm} -remapAdd :: Map.Map Reference Reference -> Remapping -> Remapping +remapAdd :: (Ord from, Ord to) => Map.Map from to -> Remapping from to -> Remapping from to remapAdd m Remap {remap, backmap} = Remap {remap = m <> remap, backmap = tm <> backmap} where @@ -335,31 +365,31 @@ intermedRemapAdd :: Map.Map Reference Reference -> EvalCtx -> EvalCtx intermedRemapAdd m ctx@ECtx {intermedRemap} = ctx {intermedRemap = remapAdd m intermedRemap} -baseToIntermed :: EvalCtx -> Reference -> Maybe Reference +baseToIntermed :: EvalCtx -> CodebaseReference -> Maybe IntermediateReference baseToIntermed ctx r = do r <- Map.lookup r . remap $ floatRemap ctx Map.lookup r . remap $ intermedRemap ctx -- Runs references through the forward maps to get intermediate -- references. Works on both base and floated references. -toIntermed :: EvalCtx -> Reference -> Reference +toIntermed :: EvalCtx -> Reference -> IntermediateReference toIntermed ctx r | r <- Map.findWithDefault r r . remap $ floatRemap ctx, Just r <- Map.lookup r . remap $ intermedRemap ctx = r toIntermed _ r = r -floatToIntermed :: EvalCtx -> Reference -> Maybe Reference +floatToIntermed :: EvalCtx -> FloatedReference -> Maybe IntermediateReference floatToIntermed ctx r = Map.lookup r . remap $ intermedRemap ctx -intermedToBase :: EvalCtx -> Reference -> Maybe Reference +intermedToBase :: EvalCtx -> IntermediateReference -> Maybe CodebaseReference intermedToBase ctx r = do r <- Map.lookup r . backmap $ intermedRemap ctx Map.lookup r . backmap $ floatRemap ctx -- Runs references through the backmaps with defaults at all steps. -backmapRef :: EvalCtx -> Reference -> Reference +backmapRef :: EvalCtx -> Reference -> CodebaseReference backmapRef ctx r0 = r2 where r1 = Map.findWithDefault r0 r0 . backmap $ intermedRemap ctx @@ -425,7 +455,7 @@ loadDeps :: EvalCtx -> [(Reference, Either [Int] [Int])] -> [Reference] -> - IO (EvalCtx, [(Reference, SuperGroup Symbol)]) + IO (EvalCtx, [(Reference, Code)]) loadDeps cl ppe ctx tyrs tmrs = do let cc = ccache ctx sand <- readTVarIO (sandbox cc) @@ -437,22 +467,52 @@ loadDeps cl ppe ctx tyrs tmrs = do _ -> False ctx <- foldM (uncurry . allocType) ctx $ Prelude.filter p tyrs let tyAdd = Set.fromList $ fst <$> tyrs - out@(_, rgrp) <- loadCode cl ppe ctx tmrs - out <$ cacheAdd0 tyAdd rgrp (expandSandbox sand rgrp) cc + (ctx', rgrp) <- loadCode cl ppe ctx tmrs + crgrp <- traverse (checkCacheability cl ctx') rgrp + (ctx', crgrp) <$ cacheAdd0 tyAdd crgrp (expandSandbox sand rgrp) cc -compileValue :: Reference -> [(Reference, SuperGroup Symbol)] -> Value +checkCacheability :: + CodeLookup Symbol IO () -> + EvalCtx -> + (IntermediateReference, SuperGroup Symbol) -> + IO (IntermediateReference, Code) +checkCacheability cl ctx (r, sg) = + getTermType codebaseRef >>= \case + -- A term's result is cacheable iff it has no arrows in its type, + -- this is sufficient since top-level definitions can't have effects without a delay. + Just typ + | not (Rec.cata hasArrows typ) -> + pure (r, CodeRep sg Cacheable) + _ -> pure (r, CodeRep sg Uncacheable) + where + codebaseRef = backmapRef ctx r + getTermType :: CodebaseReference -> IO (Maybe (Type Symbol)) + getTermType = \case + (RF.DerivedId i) -> + getTypeOfTerm cl i >>= \case + Just t -> pure $ Just t + Nothing -> pure Nothing + RF.Builtin {} -> pure $ Nothing + hasArrows :: Type.TypeF v a Bool -> Bool + hasArrows abt = case ABT.out' abt of + (ABT.Tm f) -> case f of + Type.Arrow _ _ -> True + other -> or other + t -> or t + +compileValue :: Reference -> [(Reference, Code)] -> Value compileValue base = flip pair (rf base) . ANF.BLit . List . Seq.fromList . fmap cpair where rf = ANF.BLit . TmLink . RF.Ref - cons x y = Data RF.pairRef 0 [] [x, y] - tt = Data RF.unitRef 0 [] [] + cons x y = Data RF.pairRef 0 [x, y] + tt = Data RF.unitRef 0 [] code sg = ANF.BLit (Code sg) pair x y = cons x (cons y tt) cpair (r, sg) = pair (rf r) (code sg) decompileCtx :: - EnumMap Word64 Reference -> EvalCtx -> Closure -> DecompResult Symbol + EnumMap Word64 Reference -> EvalCtx -> Val -> DecompResult Symbol decompileCtx crs ctx = decompile ib $ backReferenceTm crs fr ir dt where ib = intermedToBase ctx @@ -632,38 +692,41 @@ racoErrMsg c = \case nativeCompile :: FilePath -> IORef EvalCtx -> + CompileOpts -> CodeLookup Symbol IO () -> PrettyPrintEnv -> Reference -> FilePath -> IO (Maybe Error) -nativeCompile executable ctxVar cl ppe base path = tryM $ do +nativeCompile executable ctxVar copts cl ppe base path = tryM $ do ctx <- readIORef ctxVar (tyrs, tmrs) <- collectRefDeps cl base (ctx, codes) <- loadDeps cl ppe ctx tyrs tmrs Just ibase <- pure $ baseToIntermed ctx base - nativeCompileCodes executable codes ibase path + nativeCompileCodes copts executable codes ibase path interpCompile :: Text -> IORef EvalCtx -> + CompileOpts -> CodeLookup Symbol IO () -> PrettyPrintEnv -> Reference -> FilePath -> IO (Maybe Error) -interpCompile version ctxVar cl ppe rf path = tryM $ do +interpCompile version ctxVar _copts cl ppe rf path = tryM $ do ctx <- readIORef ctxVar (tyrs, tmrs) <- collectRefDeps cl rf (ctx, _) <- loadDeps cl ppe ctx tyrs tmrs let cc = ccache ctx lk m = flip Map.lookup m =<< baseToIntermed ctx rf Just w <- lk <$> readTVarIO (refTm cc) + let combIx = CIx rf w 0 sto <- standalone cc w BL.writeFile path . runPutL $ do serialize $ version serialize $ RF.showShort 8 rf - putNat w + putCombIx combIx putStoredCache sto backrefLifted :: @@ -773,34 +836,36 @@ prepareEvaluation :: PrettyPrintEnv -> Term Symbol -> EvalCtx -> - IO (EvalCtx, [(Reference, SuperGroup Symbol)], Reference) + IO (EvalCtx, [(Reference, Code)], Reference) prepareEvaluation ppe tm ctx = do - missing <- cacheAdd rgrp (ccache ctx') + missing <- cacheAdd rcode (ccache ctx') when (not . null $ missing) . fail $ reportBug "E029347" $ "Error in prepareEvaluation, cache is missing: " <> show missing - pure (backrefAdd rbkr ctx', rgrp, rmn) + pure (backrefAdd rbkr ctx', rcode, rmn) where + uncacheable g = CodeRep g Uncacheable (rmn0, frem, rgrp0, rbkr) = intermediateTerm ppe ctx tm int b r | b || Map.member r rgrp0 = r | otherwise = toIntermed ctx r (ctx', rrefs, rgrp) = performRehash - ((fmap . overGroupLinks) int rgrp0) + ((fmap . overGroupLinks) int $ rgrp0) (floatRemapAdd frem ctx) + rcode = second uncacheable <$> rgrp rmn = case Map.lookup rmn0 rrefs of Just r -> r Nothing -> error "prepareEvaluation: could not remap main ref" -watchHook :: IORef Closure -> Stack 'UN -> Stack 'BX -> IO () -watchHook r _ bstk = peek bstk >>= writeIORef r +watchHook :: IORef Val -> Stack -> IO () +watchHook r stk = peek stk >>= writeIORef r backReferenceTm :: EnumMap Word64 Reference -> - Remapping -> - Remapping -> - Map.Map Reference (Map.Map Word64 (Term Symbol)) -> + Remapping IntermediateReference CodebaseReference -> + Remapping FloatedReference IntermediateReference -> + Map.Map CodebaseReference (Map.Map Word64 (Term Symbol)) -> Word64 -> Word64 -> Maybe (Term Symbol) @@ -871,7 +936,7 @@ nativeEvalInContext :: EvalCtx -> Socket -> PortNumber -> - [(Reference, SuperGroup Symbol)] -> + [(Reference, Code)] -> Reference -> IO (Either Error ([Error], Term Symbol)) nativeEvalInContext executable ppe ctx serv port codes base = do @@ -921,12 +986,13 @@ nativeEvalInContext executable ppe ctx serv port codes base = do `UnliftIO.catch` ucrError nativeCompileCodes :: + CompileOpts -> FilePath -> - [(Reference, SuperGroup Symbol)] -> + [(Reference, Code)] -> Reference -> FilePath -> IO () -nativeCompileCodes executable codes base path = do +nativeCompileCodes copts executable codes base path = do ensureRuntimeExists executable ensureRacoExists genDir <- getXdgDirectory XdgCache "unisonlanguage/racket-tmp" @@ -944,7 +1010,11 @@ 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 = ucrCompileProc executable ["-G", srcPath] + dargs = ["-G", srcPath] + pargs + | profile copts = "--profile" : dargs + | otherwise = dargs + p = ucrCompileProc executable pargs makeRacoCmd :: (FilePath -> [String] -> a) -> a makeRacoCmd f = f "raco" ["exe", "-o", path, srcPath] withCreateProcess p callout @@ -959,7 +1029,7 @@ evalInContext :: Word64 -> IO (Either Error ([Error], Term Symbol)) evalInContext ppe ctx activeThreads w = do - r <- newIORef BlackHole + r <- newIORef (boxedVal BlackHole) crs <- readTVarIO (combRefs $ ccache ctx) let hook = watchHook r decom = decompileCtx crs ctx @@ -971,14 +1041,14 @@ evalInContext ppe ctx activeThreads w = do where tr = first (backmapRef ctx) <$> tr0 - debugText fancy c = case decom c of + debugText fancy val = case decom val of (errs, dv) | null errs -> SimpleTrace . debugTextFormat fancy $ pretty ppe dv | otherwise -> MsgTrace (debugTextFormat fancy $ tabulateErrors errs) - (show c) + (show val) (debugTextFormat fancy $ pretty ppe dv) result <- @@ -989,15 +1059,13 @@ evalInContext ppe ctx activeThreads w = do pure $ finish result executeMainComb :: - Word64 -> + CombIx -> CCache -> IO (Either (Pretty ColorText) ()) executeMainComb init cc = do + rSection <- resolveSection cc $ Ins (Pack RF.unitRef (PackedTag 0) ZArgs) $ Call True init init (VArg1 0) result <- - UnliftIO.try - . eval0 cc Nothing - . Ins (Pack RF.unitRef 0 ZArgs) - $ Call True init (BArg1 0) + UnliftIO.try . eval0 cc Nothing $ rSection case result of Left err -> Left <$> formatErr err Right () -> pure (Right ()) @@ -1119,7 +1187,7 @@ catchInternalErrors sub = sub `UnliftIO.catch` hCE `UnliftIO.catch` hRE decodeStandalone :: BL.ByteString -> - Either String (Text, Text, Word64, StoredCache) + Either String (Text, Text, CombIx, StoredCache) decodeStandalone b = bimap thd thd $ runGetOrFail g b where thd (_, _, x) = x @@ -1127,7 +1195,7 @@ decodeStandalone b = bimap thd thd $ runGetOrFail g b (,,,) <$> deserialize <*> deserialize - <*> getNat + <*> getCombIx <*> getStoredCache -- | Whether the runtime is hosted within a persistent session or as a one-off process. @@ -1186,14 +1254,17 @@ tryM = hRE (PE _ e) = pure $ Just e hRE (BU _ _ _) = pure $ Just "impossible" -runStandalone :: StoredCache -> Word64 -> IO (Either (Pretty ColorText) ()) +runStandalone :: StoredCache -> CombIx -> IO (Either (Pretty ColorText) ()) runStandalone sc init = restoreCache sc >>= executeMainComb init +-- | A version of the Code Cache designed to be serialized to disk as +-- standalone bytecode. data StoredCache = SCache (EnumMap Word64 Combs) (EnumMap Word64 Reference) + (EnumSet Word64) (EnumMap Word64 Reference) Word64 Word64 @@ -1201,12 +1272,13 @@ data StoredCache (Map Reference Word64) (Map Reference Word64) (Map Reference (Set Reference)) - deriving (Show) + deriving (Show, Eq) putStoredCache :: (MonadPut m) => StoredCache -> m () -putStoredCache (SCache cs crs trs ftm fty int rtm rty sbs) = do - putEnumMap putNat (putEnumMap putNat putComb) cs +putStoredCache (SCache cs crs cacheableCombs trs ftm fty int rtm rty sbs) = do + putEnumMap putNat (putEnumMap putNat (putComb absurd)) cs putEnumMap putNat putReference crs + putEnumSet putNat cacheableCombs putEnumMap putNat putReference trs putNat ftm putNat fty @@ -1220,6 +1292,7 @@ getStoredCache = SCache <$> getEnumMap getNat (getEnumMap getNat getComb) <*> getEnumMap getNat getReference + <*> getEnumSet getNat <*> getEnumMap getNat getReference <*> getNat <*> getNat @@ -1246,17 +1319,32 @@ tabulateErrors errs = : (listErrors errs) restoreCache :: StoredCache -> IO CCache -restoreCache (SCache cs crs trs ftm fty int rtm rty sbs) = - CCache builtinForeigns False debugText - <$> newTVarIO (cs <> combs) - <*> newTVarIO (crs <> builtinTermBackref) - <*> newTVarIO (trs <> builtinTypeBackref) - <*> newTVarIO ftm - <*> newTVarIO fty - <*> newTVarIO int - <*> newTVarIO (rtm <> builtinTermNumbering) - <*> newTVarIO (rty <> builtinTypeNumbering) - <*> newTVarIO (sbs <> baseSandboxInfo) +restoreCache (SCache cs crs cacheableCombs trs ftm fty int rtm rty sbs) = do + cc <- + CCache builtinForeigns False debugText + <$> newTVarIO srcCombs + <*> newTVarIO combs + <*> newTVarIO (crs <> builtinTermBackref) + <*> newTVarIO cacheableCombs + <*> newTVarIO (trs <> builtinTypeBackref) + <*> newTVarIO ftm + <*> newTVarIO fty + <*> newTVarIO int + <*> newTVarIO (rtm <> builtinTermNumbering) + <*> newTVarIO (rty <> builtinTypeNumbering) + <*> newTVarIO (sbs <> baseSandboxInfo) + let (unresolvedCacheableCombs, unresolvedNonCacheableCombs) = + srcCombs + & absurdCombs + & EC.mapToList + & foldMap + ( \(k, v) -> + if k `member` cacheableCombs + then (EC.mapSingleton k v, mempty) + else (mempty, EC.mapSingleton k v) + ) + preEvalTopLevelConstants unresolvedCacheableCombs unresolvedNonCacheableCombs cc + pure cc where decom = decompile @@ -1273,15 +1361,20 @@ restoreCache (SCache cs crs trs ftm fty int rtm rty sbs) = (debugTextFormat fancy $ pretty PPE.empty dv) rns = emptyRNs {dnum = refLookup "ty" builtinTypeNumbering} rf k = builtinTermBackref ! k + srcCombs :: EnumMap Word64 Combs + srcCombs = + let builtinCombs = mapWithKey (\k v -> emitComb @Symbol rns (rf k) k mempty (0, v)) numberedTermLookup + in builtinCombs <> cs + combs :: EnumMap Word64 (RCombs Val) combs = - mapWithKey - (\k v -> emitComb @Symbol rns (rf k) k mempty (0, v)) - numberedTermLookup + srcCombs + & absurdCombs + & resolveCombs Nothing traceNeeded :: Word64 -> - EnumMap Word64 Combs -> - IO (EnumMap Word64 Combs) + EnumMap Word64 (GCombs clos comb) -> + IO (EnumMap Word64 (GCombs clos comb)) traceNeeded init src = fmap (`withoutKeys` ks) $ go mempty init where ks = keysSet numberedTermLookup @@ -1294,6 +1387,7 @@ traceNeeded init src = fmap (`withoutKeys` ks) $ go mempty init buildSCache :: EnumMap Word64 Combs -> EnumMap Word64 Reference -> + EnumSet Word64 -> EnumMap Word64 Reference -> Word64 -> Word64 -> @@ -1302,10 +1396,11 @@ buildSCache :: Map Reference Word64 -> Map Reference (Set Reference) -> StoredCache -buildSCache cs crsrc trsrc ftm fty intsrc rtmsrc rtysrc sndbx = +buildSCache cs crsrc cacheableCombs trsrc ftm fty intsrc rtmsrc rtysrc sndbx = SCache cs crs + cacheableCombs trs ftm fty @@ -1332,8 +1427,9 @@ buildSCache cs crsrc trsrc ftm fty intsrc rtmsrc rtysrc sndbx = standalone :: CCache -> Word64 -> IO StoredCache standalone cc init = buildSCache - <$> (readTVarIO (combs cc) >>= traceNeeded init) + <$> (readTVarIO (srcCombs cc) >>= traceNeeded init) <*> readTVarIO (combRefs cc) + <*> readTVarIO (cacheableCombs cc) <*> readTVarIO (tagRefs cc) <*> readTVarIO (freshTm cc) <*> readTVarIO (freshTy cc) diff --git a/unison-runtime/src/Unison/Runtime/MCode.hs b/unison-runtime/src/Unison/Runtime/MCode.hs new file mode 100644 index 0000000000..26d392d99a --- /dev/null +++ b/unison-runtime/src/Unison/Runtime/MCode.hs @@ -0,0 +1,1746 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE PatternSynonyms #-} + +module Unison.Runtime.MCode + ( Args' (..), + Args (..), + RefNums (..), + MLit (..), + GInstr (..), + Instr, + RInstr, + GSection (.., MatchT, MatchW), + RSection, + Section, + GComb (.., Lam), + GCombInfo (..), + Comb, + RComb (..), + RCombInfo, + GCombs, + RCombs, + CombIx (..), + GRef (..), + RRef, + Ref, + UPrim1 (..), + UPrim2 (..), + BPrim1 (..), + BPrim2 (..), + GBranch (..), + Branch, + RBranch, + emitCombs, + emitComb, + resolveCombs, + absurdCombs, + emptyRNs, + argsToLists, + countArgs, + combRef, + combDeps, + combTypes, + prettyCombs, + prettyComb, + ) +where + +import Data.Bifoldable (Bifoldable (..)) +import Data.Bifunctor (Bifunctor, bimap, first) +import Data.Bitraversable (Bitraversable (..), bifoldMapDefault, bimapDefault) +import Data.Bits (shiftL, shiftR, (.|.)) +import Data.Coerce +import Data.Functor ((<&>)) +import Data.Map.Strict qualified as M +import Data.Primitive.PrimArray +import Data.Primitive.PrimArray qualified as PA +import Data.Text as Text (unpack) +import Data.Void (Void, absurd) +import Data.Word (Word16, Word64) +import GHC.Stack (HasCallStack) +import Unison.ABT.Normalized (pattern TAbss) +import Unison.Reference (Reference, showShort) +import Unison.Referent (Referent) +import Unison.Runtime.ANF + ( ANormal, + Branched (..), + CTag, + Direction (..), + Func (..), + Mem (..), + PackedTag (..), + SuperGroup (..), + SuperNormal (..), + internalBug, + packTags, + pattern TApp, + pattern TBLit, + pattern TFOp, + pattern TFrc, + pattern THnd, + pattern TLets, + pattern TLit, + pattern TMatch, + pattern TName, + pattern TPrm, + pattern TShift, + pattern TVar, + ) +import Unison.Runtime.ANF qualified as ANF +import Unison.Util.EnumContainers as EC +import Unison.Util.Text (Text) +import Unison.Var (Var) + +-- This outlines some of the ideas/features in this core +-- language, and how they may be used to implement features of +-- the surface language. + +----------------------- +-- Delimited control -- +----------------------- + +-- There is native support for delimited control operations in +-- the core language. This means we can: +-- 1. delimit a block of code with an integer tagged prompt, +-- which corresponds to pushing a frame onto the +-- continuation with said tag +-- 2. capture a portion of the continuation up to a particular +-- tag frame and turn it into a value, which _removes_ the +-- tag frame from the continuation in the process +-- 3. push such a captured value back onto the continuation + +-- TBD: Since the captured continuations in _delimited_ control +-- are (in this case impure) functions, it may make sense to make +-- the representation of functions support these captured +-- continuations directly. + +-- The obvious use case of this feature is effects and handlers. +-- Delimiting a block with a prompt is part of installing a +-- handler for said block at least naively. The other part is +-- establishing the code that should be executed for each +-- operation to be handled. + +-- It's important (I believe) in #2 that the prompt be removed +-- from the continuation by a control effect. The captured +-- continuation not being automatically delimited corresponds to +-- a shallow handler's obligation to re-establish the handling of +-- a re-invoked computation if it wishes to do so. The delimiter +-- being removed from the capturing code's continuation +-- corresponds to a handler being allowed to yield effects from +-- the same siganture that it is handling. + +-- In special cases, it should be possible to omit use of control +-- effects in handlers. At the least, if a handler case resumes +-- the computation in tail position, it should be unnecessary to +-- capture the continuation at all. If all cases act this way, we +-- don't need a delimiter, because we will never capture. + +-- TBD: it may make more sense to have prompt pushing be part of +-- some other construct, due to A-normal forms of the code. + +----------------------------- +-- Unboxed sum-of-products -- +----------------------------- + +-- It is not usually stated this way, but one of the core +-- features of the STG machine is that functions/closures can +-- return unboxed sum-of-products types. This is actually the way +-- _all_ data types work in STG. The discriminee of a case +-- statement must eventually return by pushing several values +-- onto the stack (the product part) and specifying which branch +-- to return to (the sum part). + +-- The way heap allocated data is produced is that an +-- intermediate frame may be in the continuation that grabs this +-- information from the local storage and puts it into the heap. +-- If this frame were omitted, only the unboxed component would +-- be left. Also, in STG, the heap allocated data is just a means +-- of reconstructing its unboxed analogue. Evaluating a heap +-- allocated data type value just results in pushing its stored +-- fields back on the stack, and immediately returning the tag. + +-- The portion of this with the heap allocation frame omitted +-- seems to be a natural match for the case analysis portion of +-- handlers. A naive implementation of an effect algebra is as +-- the data type of the polynomial functor generated by the +-- signature, and handling corresponds to case analysis. However, +-- in a real implementation, we don't want a heap allocated +-- representation of this algebra, because its purpose is control +-- flow. Each operation will be handled once as it occurs, and we +-- won't save work by remembering some reified representation of +-- which operations were used. + +-- Since handlers in unison are written as functions, it seems to +-- make sense to define a calling convention for unboxed +-- sum-of-products as arguments. Variable numbers of stack +-- positions could be pushed for such arguments, with tags +-- specifying which case is being provided. + +-- TBD: sum arguments to a function correspond to a product of +-- functions, so it's possible that the calling convention for +-- these functions should be similar to returning to a case, +-- where we push arguments and then select which of several +-- pieces of code to jump to. This view also seems relevant to +-- the optimized implementation of certain forms of handler, +-- where we want effects to just directly select some code to +-- execute based on state that has been threaded to that point. + +-- One thing to note: it probably does not make sense to +-- completely divide returns into unboxed returns and allocation +-- frames. The reason this works in STG is laziness. Naming a +-- computation with `let` does not do any evaluation, but it does +-- allocate space for its (boxed) result. The only thing that +-- _does_ demand evaluation is case analysis. So, if a value with +-- sum type is being evaluated, we know it must be about to be +-- unpacked, and it makes little sense to pack it on the stack, +-- though we can build a closure version of it in the writeback +-- location established by `let`. + +-- By contrast, in unison a `let` of a sum type evaluates it +-- immediately, even if no one is analyzing it. So we might waste +-- work rearranging the stack with the unpacked contents when we +-- only needed the closure version to begin with. Instead, we +-- gain the ability to make the unpacking operation use no stack, +-- because we know what we are unpacking must be a value. Turning +-- boxed function calls into unboxed versions thus seems like a +-- situational optimization, rather than a universal calling +-- convention. + +------------------------------- +-- Delimited Dynamic Binding -- +------------------------------- + +-- There is a final component to the implementation of ability +-- handlers in this runtime system, and that is dynamically +-- scoped variables associated to each prompt. Each prompt +-- corresponds to an ability signature, and `reset` to a handler +-- for said signature, but we need storage space for the code +-- installed by said handler. It is possible to implement +-- dynamically scoped variables entirely with delimited +-- continuations, but it is more efficient to keep track of the +-- storage directly when manipulating the continuations. + +-- The dynamic scoping---and how it interacts with +-- continuations---corresponds to the nested structure of +-- handlers. Installing a handler establishes a variable scope, +-- shadowing outer scopes for the same prompt. Shifting, however, +-- can exit these scopes dynamically. So, for instance, if we +-- have a structure like: + +-- reset 0 $ ... +-- reset 1 $ ... +-- reset 0 $ ... +-- shift 1 + +-- We have nested scopes 0>1>0, with the second 0 shadowing the +-- first. However, when we shift to 1, the inner 0 scope is +-- captured into the continuation, and uses of the 0 ability in +-- will be handled by the outer handler until it is shadowed +-- again (and the captured continuation will re-establish the +-- shadowing). + +-- Mutation of the variables is possible, but mutation only +-- affects the current scope. Essentially, the dynamic scoping is +-- of mutable references, and when scope changes, we switch +-- between different references, and the mutation of each +-- reference does not affect the others. The purpose of the +-- mutation is to enable more efficient implementation of +-- certain recursive, 'deep' handlers, since those can operate +-- more like stateful code than control operators. + +data Args' + = Arg1 !Int + | Arg2 !Int !Int + | -- frame index of each argument to the function + ArgN {-# UNPACK #-} !(PrimArray Int) + | ArgR !Int !Int + deriving (Show) + +data Args + = ZArgs + | VArg1 !Int + | VArg2 !Int !Int + | VArgR !Int !Int + | VArgN {-# UNPACK #-} !(PrimArray Int) + | VArgV !Int + deriving (Show, Eq, Ord) + +argsToLists :: Args -> [Int] +argsToLists = \case + ZArgs -> [] + VArg1 i -> [i] + VArg2 i j -> [i, j] + VArgR i l -> take l [i ..] + VArgN us -> primArrayToList us + VArgV _ -> internalBug "argsToLists: DArgV" + +countArgs :: Args -> Int +countArgs ZArgs = 0 +countArgs (VArg1 {}) = 1 +countArgs (VArg2 {}) = 2 +countArgs (VArgR _ l) = l +countArgs (VArgN us) = sizeofPrimArray us +countArgs (VArgV {}) = internalBug "countArgs: DArgV" + +data UPrim1 + = -- integral + DECI -- decrement + | DECN + | INCI -- increment + | INCN + | NEGI -- negate + | SGNI -- signum + | LZRO -- leadingZeroes + | TZRO -- trailingZeroes + | COMN -- complement + | COMI -- complement + | POPC -- popCount + -- floating + | ABSF -- abs + | EXPF -- exp + | LOGF -- log + | SQRT -- sqrt + | COSF -- cos + | ACOS -- acos + | COSH -- cosh + | ACSH -- acosh + | SINF -- sin + | ASIN -- asin + | SINH -- sinh + | ASNH -- asinh + | TANF -- tan + | ATAN -- atan + | TANH -- tanh + | ATNH -- atanh + | ITOF -- intToFloat + | NTOF -- natToFloat + | CEIL -- ceiling + | FLOR -- floor + | TRNF -- truncate + | RNDF -- round + deriving (Show, Eq, Ord, Enum, Bounded) + +data UPrim2 + = -- integral + ADDI -- + + | ADDN + | SUBI -- - + | SUBN + | MULI + | MULN + | DIVI -- / + | DIVN + | MODI -- mod + | MODN + | SHLI -- shiftl + | SHLN + | SHRI -- shiftr + | SHRN + | POWI -- pow + | POWN + | EQLI -- == + | EQLN + | LEQI -- <= + | LEQN + | ANDN -- and + | ANDI + | IORN -- or + | IORI + | XORN -- xor + | XORI + | -- floating + EQLF -- == + | LEQF -- <= + | ADDF -- + + | SUBF -- - + | MULF + | DIVF -- / + | ATN2 -- atan2 + | POWF -- pow + | LOGB -- logBase + | MAXF -- max + | MINF -- min + | CAST -- unboxed runtime type cast (int to nat, etc.) + deriving (Show, Eq, Ord, Enum, Bounded) + +data BPrim1 + = -- text + SIZT -- size + | USNC -- unsnoc + | UCNS -- uncons + | ITOT -- intToText + | NTOT -- natToText + | FTOT -- floatToText + | TTOI -- textToInt + | TTON -- textToNat + | TTOF -- textToFloat + | PAKT -- pack + | UPKT -- unpack + -- sequence + | VWLS -- viewl + | VWRS -- viewr + | SIZS -- size + | PAKB -- pack + | UPKB -- unpack + | SIZB -- size + | FLTB -- flatten + -- code + | MISS -- isMissing + | CACH -- cache + | LKUP -- lookup + | LOAD -- load + | CVLD -- validate + | VALU -- value + | TLTT -- Term.Link.toText + -- debug + | DBTX -- debug text + | SDBL -- sandbox link list + deriving (Show, Eq, Ord, Enum, Bounded) + +data BPrim2 + = -- universal + EQLU -- == + | CMPU -- compare + -- text + | DRPT -- drop + | CATT -- append + | TAKT -- take + | IXOT -- indexof + | EQLT -- == + | LEQT -- <= + | LEST -- < + -- sequence + | DRPS -- drop + | CATS -- append + | TAKS -- take + | CONS -- cons + | SNOC -- snoc + | IDXS -- index + | SPLL -- splitLeft + | SPLR -- splitRight + -- bytes + | TAKB -- take + | DRPB -- drop + | IDXB -- index + | CATB -- append + | IXOB -- indexof + -- general + | THRO -- throw + | TRCE -- trace + -- code + | SDBX -- sandbox + | SDBV -- sandbox Value + deriving (Show, Eq, Ord, Enum, Bounded) + +data MLit + = MI !Int + | MN !Word64 + | MC !Char + | MD !Double + | MT !Text + | MM !Referent -- Term Link + | MY !Reference -- Type Link + deriving (Show, Eq, Ord) + +type Instr = GInstr CombIx + +type RInstr val = GInstr (RComb val) + +-- Instructions for manipulating the data stack in the main portion of +-- a block +data GInstr comb + = -- 1-argument unboxed primitive operations + UPrim1 + !UPrim1 -- primitive instruction + !Int -- index of prim argument + | -- 2-argument unboxed primitive operations + UPrim2 + !UPrim2 -- primitive instruction + !Int -- index of first prim argument + !Int -- index of second prim argument + | -- 1-argument primitive operations that may involve boxed values + BPrim1 + !BPrim1 + !Int + | -- 2-argument primitive operations that may involve boxed values + BPrim2 + !BPrim2 + !Int + !Int + | -- Call out to a Haskell function. This is considerably slower + -- for very simple operations, hence the primops. + ForeignCall + !Bool -- catch exceptions + !Word64 -- FFI call + !Args -- arguments + | -- Set the value of a dynamic reference + SetDyn + !Word64 -- the prompt tag of the reference + !Int -- the stack index of the closure to store + | -- Capture the continuation up to a given marker. + Capture !Word64 -- the prompt tag + | -- This is essentially the opposite of `Call`. Pack a given + -- statically known function into a closure with arguments. + -- No stack is necessary, because no nested evaluation happens, + -- so the instruction directly takes a follow-up. + Name !(GRef comb) !Args + | -- Dump some debugging information about the machine state to + -- the screen. + Info !String -- prefix for output + | -- Pack a data type value into a closure and place it + -- on the stack. + Pack + !Reference -- data type reference + !PackedTag -- tag + !Args -- arguments to pack + | -- Push a particular value onto the appropriate stack + Lit !MLit -- value to push onto the stack + | -- Print a value on the unboxed stack + Print !Int -- index of the primitive value to print + | -- Put a delimiter on the continuation + Reset !(EnumSet Word64) -- prompt ids + | -- Fork thread evaluating delayed computation on boxed stack + Fork !Int + | -- Atomic transaction evaluating delayed computation on boxed stack + Atomically !Int + | -- Build a sequence consisting of a variable number of arguments + Seq !Args + | -- Force a delayed expression, catching any runtime exceptions involved + TryForce !Int + deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable) + +type Section = GSection CombIx + +type RSection val = GSection (RComb val) + +data GSection comb + = -- Apply a function to arguments. This is the 'slow path', and + -- handles applying functions from arbitrary sources. This + -- requires checks to determine what exactly should happen. + App + !Bool -- skip argument check for known calling convention + !(GRef comb) -- function to call + !Args -- arguments + | -- This is the 'fast path', for when we statically know we're + -- making an exactly saturated call to a statically known + -- function. This allows skipping various checks that can cost + -- time in very tight loops. This also allows skipping the + -- stack check if we know that the current stack allowance is + -- sufficient for where we're jumping to. + Call + !Bool -- skip stack check + !CombIx + {- Lazy! Might be cyclic -} comb + !Args -- arguments + | -- Jump to a captured continuation value. + Jump + !Int -- index of captured continuation + !Args -- arguments to send to continuation + | -- Branch on the value in the unboxed data stack + Match + !Int -- index of unboxed item to match on + !(GBranch comb) -- branches + | -- Yield control to the current continuation, with arguments + Yield !Args -- values to yield + | -- Prefix an instruction onto a section + Ins !(GInstr comb) !(GSection comb) + | -- Sequence two sections. The second is pushed as a return + -- point for the results of the first. Stack modifications in + -- the first are lost on return to the second. + -- + -- The stored CombIx is a combinator that contains the second + -- section, which can be used to reconstruct structures that + -- throw away the section, like serializable continuation values. + -- Code generation will emit the section as its own combinator, + -- but also include it directly here. + Let + !(GSection comb) -- binding + !CombIx -- body section refrence + !Int -- stack safety + !(GSection comb) -- body code + | -- Throw an exception with the given message + Die String + | -- Immediately stop a thread of interpretation. This is more of + -- a debugging tool than a proper operation to target. + Exit + | -- Branch on a data type without dumping the tag onto the unboxed + -- stack. + DMatch + !(Maybe Reference) -- expected data type + !Int -- index of data item on boxed stack + !(GBranch comb) -- branches + | -- Branch on a numeric type without dumping it to the stack + NMatch + !(Maybe Reference) -- expected data type + !Int -- index of data item on boxed stack + !(GBranch comb) -- branches + | -- Branch on a request representation without dumping the tag + -- portion to the unboxed stack. + RMatch + !Int -- index of request item on the boxed stack + !(GSection comb) -- pure case + !(EnumMap Word64 (GBranch comb)) -- effect cases + deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable) + +data CombIx + = CIx + !Reference -- top reference + !Word64 -- top level + !Word64 -- section + deriving (Eq, Ord, Show) + +combRef :: CombIx -> Reference +combRef (CIx r _ _) = r + +-- dnum maps type references to their number in the runtime +-- cnum maps combinator references to their number +-- anum maps combinator references to their main arity +data RefNums = RN + { dnum :: Reference -> Word64, + cnum :: Reference -> Word64, + anum :: Reference -> Maybe Int + } + +emptyRNs :: RefNums +emptyRNs = RN mt mt (const Nothing) + where + mt _ = internalBug "RefNums: empty" + +type Comb = GComb Void CombIx + +-- Actual information for a proper combinator. The GComb type is no +-- longer strictly a 'combinator.' +data GCombInfo comb + = LamI + !Int -- Number of arguments + !Int -- Maximum needed frame size + !(GSection comb) -- Entry + deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable) + +data GComb val comb + = Comb {-# UNPACK #-} !(GCombInfo comb) + | -- A pre-evaluated comb, typically a pure top-level const + CachedVal !Word64 {- top level comb ix -} !val + deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable) + +pattern Lam :: + Int -> Int -> GSection comb -> GComb val comb +pattern Lam a f sect = Comb (LamI a f sect) + +-- it seems GHC can't figure this out itself +{-# COMPLETE CachedVal, Lam #-} + +instance Bifunctor GComb where + bimap = bimapDefault + +instance Bifoldable GComb where + bifoldMap = bifoldMapDefault + +instance Bitraversable GComb where + bitraverse f _ (CachedVal cix c) = CachedVal cix <$> f c + bitraverse _ f (Lam a fr s) = Lam a fr <$> traverse f s + +type RCombs val = GCombs val (RComb val) + +-- | The fixed point of a GComb where all references to a Comb are themselves Combs. +newtype RComb val = RComb {unRComb :: GComb val (RComb val)} + +type RCombInfo val = GCombInfo (RComb val) + +instance Show (RComb val) where + show _ = "" + +-- | Map of combinators, parameterized by comb reference type +type GCombs val comb = EnumMap Word64 (GComb val comb) + +-- | A reference to a combinator, parameterized by comb +type Ref = GRef CombIx + +type RRef val = GRef (RComb val) + +data GRef comb + = Stk !Int -- stack reference to a closure + | Env !CombIx {- Lazy! Might be cyclic -} comb + | Dyn !Word64 -- dynamic scope reference to a closure + deriving (Show, Functor, Foldable, Traversable) + +instance Eq (GRef comb) where + a == b = compare a b == EQ + +instance Ord (GRef comb) where + compare (Stk a) (Stk b) = compare a b + compare (Stk {}) _ = LT + compare _ (Stk {}) = GT + compare (Env a _) (Env b _) = compare a b + compare (Env {}) _ = LT + compare _ (Env {}) = GT + compare (Dyn a) (Dyn b) = compare a b + +type Branch = GBranch CombIx + +type RBranch val = GBranch (RComb val) + +data GBranch comb + = -- if tag == n then t else f + Test1 + !Word64 + !(GSection comb) + !(GSection comb) + | Test2 + !Word64 + !(GSection comb) -- if tag == m then ... + !Word64 + !(GSection comb) -- else if tag == n then ... + !(GSection comb) -- else ... + | TestW + !(GSection comb) + !(EnumMap Word64 (GSection comb)) + | TestT + !(GSection comb) + !(M.Map Text (GSection comb)) + deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable) + +-- Convenience patterns for matches used in the algorithms below. +pattern MatchW :: Int -> (GSection comb) -> EnumMap Word64 (GSection comb) -> (GSection comb) +pattern MatchW i d cs = Match i (TestW d cs) + +pattern MatchT :: Int -> (GSection comb) -> M.Map Text (GSection comb) -> (GSection comb) +pattern MatchT i d cs = Match i (TestT d cs) + +pattern NMatchW :: + Maybe Reference -> Int -> (GSection comb) -> EnumMap Word64 (GSection comb) -> (GSection comb) +pattern NMatchW r i d cs = NMatch r i (TestW d cs) + +-- Representation of the variable context available in the current +-- frame. This tracks tags that have been dumped to the stack for +-- proper indexing. The `Block` constructor is used to mark when we +-- go into the first portion of a `Let`, to track the size of that +-- sub-frame. +data Ctx v + = ECtx + | Block (Ctx v) + | Tag (Ctx v) + | Var v Mem (Ctx v) + deriving (Show) + +-- Represents the context formed by the top-level let rec around a +-- set of definitions. Previous steps have normalized the term to +-- only contain a single recursive binding group. The variables in +-- this binding group are resolved to numbered combinators rather +-- than stack positions. +type RCtx v = M.Map v Word64 + +-- Add a sequence of variables and corresponding calling conventions +-- to the context. +ctx :: [v] -> [Mem] -> Ctx v +ctx vs cs = pushCtx (zip vs cs) ECtx + +-- Look up a variable in the context, getting its position on the +-- relevant stack and its calling convention if it is there. +ctxResolve :: (Var v) => Ctx v -> v -> Maybe (Int, Mem) +ctxResolve ctx v = walk 0 ctx + where + walk _ ECtx = Nothing + walk i (Block ctx) = walk i ctx + walk i (Tag ctx) = walk (i + 1) ctx + walk i (Var x m ctx) + | v == x = Just (i, m) + | otherwise = walk (i + 1) ctx + +-- Add a sequence of variables and calling conventions to the context. +pushCtx :: [(v, Mem)] -> Ctx v -> Ctx v +pushCtx new old = foldr (uncurry Var) old new + +-- Concatenate two contexts +catCtx :: Ctx v -> Ctx v -> Ctx v +catCtx ECtx r = r +catCtx (Tag l) r = Tag $ catCtx l r +catCtx (Block l) r = Block $ catCtx l r +catCtx (Var v m l) r = Var v m $ catCtx l r + +-- Split the context after a particular variable +breakAfter :: (Eq v) => (v -> Bool) -> Ctx v -> (Ctx v, Ctx v) +breakAfter _ ECtx = (ECtx, ECtx) +breakAfter p (Tag vs) = first Tag $ breakAfter p vs +breakAfter p (Block vs) = first Block $ breakAfter p vs +breakAfter p (Var v m vs) = (Var v m lvs, rvs) + where + (lvs, rvs) + | p v = (ECtx, vs) + | otherwise = breakAfter p vs + +-- Modify the context to contain the variables introduced by an +-- unboxed sum +sumCtx :: (Var v) => Ctx v -> v -> [(v, Mem)] -> Ctx v +sumCtx ctx v vcs + | (lctx, rctx) <- breakAfter (== v) ctx = + catCtx lctx $ pushCtx vcs rctx + +-- Look up a variable in the top let rec context +rctxResolve :: (Var v) => RCtx v -> v -> Maybe Word64 +rctxResolve ctx u = M.lookup u ctx + +-- Compile a top-level definition group to a collection of combinators. +-- The provided word refers to the numbering for the overall group, +-- and intra-group calls are numbered locally, with 0 specifying +-- the global entry point. +emitCombs :: + (Var v) => + RefNums -> + Reference -> + Word64 -> + SuperGroup v -> + EnumMap Word64 Comb +emitCombs rns grpr grpn (Rec grp ent) = + emitComb rns grpr grpn rec (0, ent) <> aux + where + (rvs, cmbs) = unzip grp + ixs = map (`shiftL` 16) [1 ..] + rec = M.fromList $ zip rvs ixs + aux = foldMap (emitComb rns grpr grpn rec) (zip ixs cmbs) + +-- | lazily replace all references to combinators with the combinators themselves, +-- tying the knot recursively when necessary. +resolveCombs :: + -- Existing in-scope combs that might be referenced + Maybe (EnumMap Word64 (RCombs val)) -> + -- Combinators which need their knots tied. + EnumMap Word64 (GCombs val CombIx) -> + EnumMap Word64 (RCombs val) +resolveCombs mayExisting combs = + -- Fixed point lookup; + -- We make sure not to force resolved Combs or we'll loop forever. + let ~resolved = + combs + <&> (fmap . fmap) \(CIx _ n i) -> + let cmbs = case mayExisting >>= EC.lookup n of + Just cmbs -> cmbs + Nothing -> + case EC.lookup n resolved of + Just cmbs -> cmbs + Nothing -> error $ "unknown combinator `" ++ show n ++ "`." + in case EC.lookup i cmbs of + Just cmb -> RComb cmb + Nothing -> + error $ + "unknown section `" + ++ show i + ++ "` of combinator `" + ++ show n + ++ "`." + in resolved + +absurdCombs :: EnumMap Word64 (EnumMap Word64 (GComb Void cix)) -> EnumMap Word64 (GCombs any cix) +absurdCombs = fmap . fmap . first $ absurd + +-- Type for aggregating the necessary stack frame size. First field is the +-- necessary size. The Applicative instance takes the +-- maximum, so that combining values from different branches +-- results in finding the maximum number of slots either side requires. +-- +-- TODO: Now that we have a single stack, most of this counting can probably be simplified. +data Counted a = C !Int a + deriving (Functor) + +instance Applicative Counted where + pure = C 0 + C s0 f <*> C s1 x = C (max s0 s1) (f x) + +newtype Emit a + = EM (Word64 -> (EC.EnumMap Word64 Comb, Counted a)) + deriving (Functor) + +runEmit :: Word64 -> Emit a -> EC.EnumMap Word64 Comb +runEmit w (EM e) = fst $ e w + +instance Applicative Emit where + pure = EM . pure . pure . pure + EM ef <*> EM ex = EM $ (liftA2 . liftA2) (<*>) ef ex + +counted :: Counted a -> Emit a +counted = EM . pure . pure + +onCount :: (Counted a -> Counted b) -> Emit a -> Emit b +onCount f (EM e) = EM $ fmap f <$> e + +letIndex :: Word16 -> Word64 -> Word64 +letIndex l c = c .|. fromIntegral l + +record :: Ctx v -> Word16 -> Emit Section -> Emit (Word64, Comb) +record ctx l (EM es) = EM $ \c -> + let (m, C sz s) = es c + na = countCtx0 0 ctx + n = letIndex l c + comb = Lam na sz s + in (EC.mapInsert n comb m, C sz (n, comb)) + +recordTop :: [v] -> Word16 -> Emit Section -> Emit () +recordTop vs l (EM e) = EM $ \c -> + let (m, C sz s) = e c + na = length vs + n = letIndex l c + in (EC.mapInsert n (Lam na sz s) m, C sz ()) + +-- Counts the stack space used by a context and annotates a value +-- with it. +countCtx :: Ctx v -> a -> Emit a +countCtx ctx = counted . C i + where + i = countCtx0 0 ctx + +countCtx0 :: Int -> Ctx v -> Int +countCtx0 !i (Var _ _ ctx) = countCtx0 (i + 1) ctx +countCtx0 i (Tag ctx) = countCtx0 (i + 1) ctx +countCtx0 i (Block ctx) = countCtx0 i ctx +countCtx0 i ECtx = i + +emitComb :: + (Var v) => + RefNums -> + Reference -> + Word64 -> + RCtx v -> + (Word64, SuperNormal v) -> + EC.EnumMap Word64 Comb +emitComb rns grpr grpn rec (n, Lambda ccs (TAbss vs bd)) = + runEmit n + . recordTop vs 0 + $ emitSection rns grpr grpn rec (ctx vs ccs) bd + +addCount :: Int -> Emit a -> Emit a +addCount i = onCount $ \(C sz x) -> C (sz + i) x + +-- Emit a machine code section from an ANF term +emitSection :: + (Var v) => + RefNums -> + Reference -> + Word64 -> + RCtx v -> + Ctx v -> + ANormal v -> + Emit Section +emitSection rns grpr grpn rec ctx (TLets d us ms bu bo) = + emitLet rns grpr grpn rec d (zip us ms) ctx bu $ + emitSection rns grpr grpn rec ectx bo + where + ectx = pushCtx (zip us ms) ctx +emitSection rns grpr grpn rec ctx (TName u (Left f) args bo) = + emitClosures grpr grpn rec ctx args $ \ctx as -> + let cix = (CIx f (cnum rns f) 0) + in Ins (Name (Env cix cix) as) + <$> emitSection rns grpr grpn rec (Var u BX ctx) bo +emitSection rns grpr grpn rec ctx (TName u (Right v) args bo) + | Just (i, BX) <- ctxResolve ctx v = + emitClosures grpr grpn rec ctx args $ \ctx as -> + Ins (Name (Stk i) as) + <$> emitSection rns grpr grpn rec (Var u BX ctx) bo + | Just n <- rctxResolve rec v = + emitClosures grpr grpn rec ctx args $ \ctx as -> + let cix = (CIx grpr grpn n) + in Ins (Name (Env cix cix) as) + <$> emitSection rns grpr grpn rec (Var u BX ctx) bo + | otherwise = emitSectionVErr v +emitSection _ grpr grpn rec ctx (TVar v) + | Just (i, _) <- ctxResolve ctx v = countCtx ctx . Yield $ VArg1 i + | Just j <- rctxResolve rec v = + let cix = (CIx grpr grpn j) + in countCtx ctx $ App False (Env cix cix) $ ZArgs + | otherwise = emitSectionVErr v +emitSection _ _ grpn _ ctx (TPrm p args) = + -- 3 is a conservative estimate of how many extra stack slots + -- a prim op will need for its results. + addCount 3 + . countCtx ctx + . Ins (emitPOp p $ emitArgs grpn ctx args) + . Yield + . VArgV + $ countBlock ctx +emitSection _ _ grpn _ ctx (TFOp p args) = + addCount 3 + . countCtx ctx + . Ins (emitFOp p $ emitArgs grpn ctx args) + . Yield + . VArgV + $ countBlock ctx +emitSection rns grpr grpn rec ctx (TApp f args) = + emitClosures grpr grpn rec ctx args $ \ctx as -> + countCtx ctx $ emitFunction rns grpr grpn rec ctx f as +emitSection _ _ _ _ ctx (TLit l) = + c . countCtx ctx . Ins (emitLit l) . Yield $ VArg1 0 + where + c + | ANF.T {} <- l = addCount 1 + | ANF.LM {} <- l = addCount 1 + | ANF.LY {} <- l = addCount 1 + | otherwise = addCount 1 +emitSection _ _ _ _ ctx (TBLit l) = + addCount 1 . countCtx ctx . Ins (emitLit l) . Yield $ VArg1 0 +emitSection rns grpr grpn rec ctx (TMatch v bs) + | Just (i, BX) <- ctxResolve ctx v, + MatchData r cs df <- bs = + DMatch (Just r) i + <$> emitDataMatching r rns grpr grpn rec ctx cs df + | Just (i, BX) <- ctxResolve ctx v, + MatchRequest hs0 df <- bs, + hs <- mapFromList $ first (dnum rns) <$> M.toList hs0 = + uncurry (RMatch i) + <$> emitRequestMatching rns grpr grpn rec ctx hs df + | Just (i, UN) <- ctxResolve ctx v, + MatchIntegral cs df <- bs = + emitLitMatching + MatchW + "missing integral case" + rns + grpr + grpn + rec + ctx + i + cs + df + | Just (i, BX) <- ctxResolve ctx v, + MatchNumeric r cs df <- bs = + emitLitMatching + (NMatchW (Just r)) + "missing integral case" + rns + grpr + grpn + rec + ctx + i + cs + df + | Just (i, BX) <- ctxResolve ctx v, + MatchText cs df <- bs = + emitLitMatching + MatchT + "missing text case" + rns + grpr + grpn + rec + ctx + i + cs + df + | Just (i, UN) <- ctxResolve ctx v, + MatchSum cs <- bs = + emitSumMatching rns grpr grpn rec ctx v i cs + | Just (_, cc) <- ctxResolve ctx v = + internalBug $ + "emitSection: mismatched calling convention for match: " + ++ matchCallingError cc bs + | otherwise = + internalBug $ + "emitSection: could not resolve match variable: " ++ show (ctx, v) +emitSection rns grpr grpn rec ctx (THnd rs h b) + | Just (i, BX) <- ctxResolve ctx h = + Ins (Reset (EC.setFromList ws)) + . flip (foldr (\r -> Ins (SetDyn r i))) ws + <$> emitSection rns grpr grpn rec ctx b + | otherwise = emitSectionVErr h + where + ws = dnum rns <$> rs +emitSection rns grpr grpn rec ctx (TShift r v e) = + Ins (Capture $ dnum rns r) + <$> emitSection rns grpr grpn rec (Var v BX ctx) e +emitSection _ _ _ _ ctx (TFrc v) + | Just (i, BX) <- ctxResolve ctx v = + countCtx ctx $ App False (Stk i) ZArgs + | Just _ <- ctxResolve ctx v = + internalBug $ + "emitSection: values to be forced must be boxed: " ++ show v + | otherwise = emitSectionVErr v +emitSection _ _ _ _ _ tm = + internalBug $ "emitSection: unhandled code: " ++ show tm + +-- Emit the code for a function call +emitFunction :: + (Var v) => + RefNums -> + Reference -> + Word64 -> -- self combinator number + RCtx v -> -- recursive binding group + Ctx v -> -- local context + Func v -> + Args -> + Section +emitFunction _ grpr grpn rec ctx (FVar v) as + | Just (i, BX) <- ctxResolve ctx v = + App False (Stk i) as + | Just j <- rctxResolve rec v = + let cix = CIx grpr grpn j + in App False (Env cix cix) as + | otherwise = emitSectionVErr v +emitFunction rns _grpr _ _ _ (FComb r) as + | Just k <- anum rns r, + countArgs as == k -- exactly saturated call + = + Call False cix cix as + | otherwise -- slow path + = + App False (Env cix cix) as + where + n = cnum rns r + cix = CIx r n 0 +emitFunction rns _grpr _ _ _ (FCon r t) as = + Ins (Pack r (packTags rt t) as) + . Yield + $ VArg1 0 + where + rt = toEnum . fromIntegral $ dnum rns r +emitFunction rns _grpr _ _ _ (FReq r e) as = + -- Currently implementing packed calling convention for abilities + -- TODO ct is 16 bits, but a is 48 bits. This will be a problem if we have + -- more than 2^16 types. + Ins (Pack r (packTags rt e) as) + . App True (Dyn a) + $ VArg1 0 + where + a = dnum rns r + rt = toEnum . fromIntegral $ a +emitFunction _ _grpr _ _ ctx (FCont k) as + | Just (i, BX) <- ctxResolve ctx k = Jump i as + | Nothing <- ctxResolve ctx k = emitFunctionVErr k + | otherwise = internalBug $ "emitFunction: continuations are boxed" +emitFunction _ _grpr _ _ _ (FPrim _) _ = + internalBug "emitFunction: impossible" + +countBlock :: Ctx v -> Int +countBlock = go 0 + where + go !i (Var _ _ ctx) = go (i + 1) ctx + go i (Tag ctx) = go (i + 1) ctx + go i _ = i + +matchCallingError :: Mem -> Branched v -> String +matchCallingError cc b = "(" ++ show cc ++ "," ++ brs ++ ")" + where + brs + | MatchData _ _ _ <- b = "MatchData" + | MatchEmpty <- b = "MatchEmpty" + | MatchIntegral _ _ <- b = "MatchIntegral" + | MatchNumeric _ _ _ <- b = "MatchNumeric" + | MatchRequest _ _ <- b = "MatchRequest" + | MatchSum _ <- b = "MatchSum" + | MatchText _ _ <- b = "MatchText" + +emitSectionVErr :: (Var v, HasCallStack) => v -> a +emitSectionVErr v = + internalBug $ + "emitSection: could not resolve function variable: " ++ show v + +emitFunctionVErr :: (Var v, HasCallStack) => v -> a +emitFunctionVErr v = + internalBug $ + "emitFunction: could not resolve function variable: " ++ show v + +-- Emit machine code for a let expression. Some expressions do not +-- require a machine code Let, which uses more complicated stack +-- manipulation. +emitLet :: + (Var v) => + RefNums -> + Reference -> + Word64 -> + RCtx v -> + Direction Word16 -> + [(v, Mem)] -> + Ctx v -> + ANormal v -> + Emit Section -> + Emit Section +emitLet _ _ _ _ _ _ _ (TLit l) = + fmap (Ins $ emitLit l) +emitLet _ _ _ _ _ _ _ (TBLit l) = + fmap (Ins $ emitLit l) +-- emitLet rns grp _ _ _ ctx (TApp (FComb r) args) +-- -- We should be able to tell if we are making a saturated call +-- -- or not here. We aren't carrying the information here yet, though. +-- | False -- not saturated +-- = fmap (Ins . Name (Env n 0) $ emitArgs grp ctx args) +-- where +-- n = cnum rns r +emitLet rns _ grpn _ _ _ ctx (TApp (FCon r n) args) = + fmap (Ins . Pack r (packTags rt n) $ emitArgs grpn ctx args) + where + rt = toEnum . fromIntegral $ dnum rns r +emitLet _ _ grpn _ _ _ ctx (TApp (FPrim p) args) = + fmap (Ins . either emitPOp emitFOp p $ emitArgs grpn ctx args) +emitLet rns grpr grpn rec d vcs ctx bnd + | Direct <- d = + internalBug $ "unsupported compound direct let: " ++ show bnd + | Indirect w <- d = + \esect -> + f + <$> emitSection rns grpr grpn rec (Block ctx) bnd + <*> record (pushCtx vcs ctx) w esect + where + f s (w, Lam _ f bd) = + let cix = (CIx grpr grpn w) + in Let s cix f bd + +-- Translate from ANF prim ops to machine code operations. The +-- machine code operations are divided with respect to more detailed +-- information about expected number and types of arguments. +emitPOp :: ANF.POp -> Args -> Instr +-- Integral +emitPOp ANF.ADDI = emitP2 ADDI +emitPOp ANF.ADDN = emitP2 ADDN +emitPOp ANF.SUBI = emitP2 SUBI +emitPOp ANF.SUBN = emitP2 SUBN +emitPOp ANF.MULI = emitP2 MULI +emitPOp ANF.MULN = emitP2 MULN +emitPOp ANF.DIVI = emitP2 DIVI +emitPOp ANF.DIVN = emitP2 DIVN +emitPOp ANF.MODI = emitP2 MODI -- TODO: think about how these behave +emitPOp ANF.MODN = emitP2 MODN -- TODO: think about how these behave +emitPOp ANF.POWI = emitP2 POWI +emitPOp ANF.POWN = emitP2 POWN +emitPOp ANF.SHLI = emitP2 SHLI +emitPOp ANF.SHLN = emitP2 SHLN -- Note: left shift behaves uniformly +emitPOp ANF.SHRI = emitP2 SHRI +emitPOp ANF.SHRN = emitP2 SHRN +emitPOp ANF.LEQI = emitP2 LEQI +emitPOp ANF.LEQN = emitP2 LEQN +emitPOp ANF.EQLI = emitP2 EQLI +emitPOp ANF.EQLN = emitP2 EQLN +emitPOp ANF.SGNI = emitP1 SGNI +emitPOp ANF.NEGI = emitP1 NEGI +emitPOp ANF.INCI = emitP1 INCI +emitPOp ANF.INCN = emitP1 INCN +emitPOp ANF.DECI = emitP1 DECI +emitPOp ANF.DECN = emitP1 DECN +emitPOp ANF.TZRO = emitP1 TZRO +emitPOp ANF.LZRO = emitP1 LZRO +emitPOp ANF.POPC = emitP1 POPC +emitPOp ANF.ANDN = emitP2 ANDN +emitPOp ANF.ANDI = emitP2 ANDI +emitPOp ANF.IORN = emitP2 IORN +emitPOp ANF.IORI = emitP2 IORI +emitPOp ANF.XORI = emitP2 XORI +emitPOp ANF.XORN = emitP2 XORN +emitPOp ANF.COMN = emitP1 COMN +emitPOp ANF.COMI = emitP1 COMI +-- Float +emitPOp ANF.ADDF = emitP2 ADDF +emitPOp ANF.SUBF = emitP2 SUBF +emitPOp ANF.MULF = emitP2 MULF +emitPOp ANF.DIVF = emitP2 DIVF +emitPOp ANF.LEQF = emitP2 LEQF +emitPOp ANF.EQLF = emitP2 EQLF +emitPOp ANF.MINF = emitP2 MINF +emitPOp ANF.MAXF = emitP2 MAXF +emitPOp ANF.POWF = emitP2 POWF +emitPOp ANF.EXPF = emitP1 EXPF +emitPOp ANF.ABSF = emitP1 ABSF +emitPOp ANF.SQRT = emitP1 SQRT +emitPOp ANF.LOGF = emitP1 LOGF +emitPOp ANF.LOGB = emitP2 LOGB +emitPOp ANF.CEIL = emitP1 CEIL +emitPOp ANF.FLOR = emitP1 FLOR +emitPOp ANF.TRNF = emitP1 TRNF +emitPOp ANF.RNDF = emitP1 RNDF +emitPOp ANF.COSF = emitP1 COSF +emitPOp ANF.SINF = emitP1 SINF +emitPOp ANF.TANF = emitP1 TANF +emitPOp ANF.COSH = emitP1 COSH +emitPOp ANF.SINH = emitP1 SINH +emitPOp ANF.TANH = emitP1 TANH +emitPOp ANF.ACOS = emitP1 ACOS +emitPOp ANF.ATAN = emitP1 ATAN +emitPOp ANF.ASIN = emitP1 ASIN +emitPOp ANF.ACSH = emitP1 ACSH +emitPOp ANF.ASNH = emitP1 ASNH +emitPOp ANF.ATNH = emitP1 ATNH +emitPOp ANF.ATN2 = emitP2 ATN2 +-- conversions +emitPOp ANF.ITOF = emitP1 ITOF +emitPOp ANF.NTOF = emitP1 NTOF +emitPOp ANF.ITOT = emitBP1 ITOT +emitPOp ANF.NTOT = emitBP1 NTOT +emitPOp ANF.FTOT = emitBP1 FTOT +emitPOp ANF.TTON = emitBP1 TTON +emitPOp ANF.TTOI = emitBP1 TTOI +emitPOp ANF.TTOF = emitBP1 TTOF +emitPOp ANF.CAST = emitP2 CAST +-- text +emitPOp ANF.CATT = emitBP2 CATT +emitPOp ANF.TAKT = emitBP2 TAKT +emitPOp ANF.DRPT = emitBP2 DRPT +emitPOp ANF.IXOT = emitBP2 IXOT +emitPOp ANF.SIZT = emitBP1 SIZT +emitPOp ANF.UCNS = emitBP1 UCNS +emitPOp ANF.USNC = emitBP1 USNC +emitPOp ANF.EQLT = emitBP2 EQLT +emitPOp ANF.LEQT = emitBP2 LEQT +emitPOp ANF.PAKT = emitBP1 PAKT +emitPOp ANF.UPKT = emitBP1 UPKT +-- sequence +emitPOp ANF.CATS = emitBP2 CATS +emitPOp ANF.TAKS = emitBP2 TAKS +emitPOp ANF.DRPS = emitBP2 DRPS +emitPOp ANF.SIZS = emitBP1 SIZS +emitPOp ANF.CONS = emitBP2 CONS +emitPOp ANF.SNOC = emitBP2 SNOC +emitPOp ANF.IDXS = emitBP2 IDXS +emitPOp ANF.VWLS = emitBP1 VWLS +emitPOp ANF.VWRS = emitBP1 VWRS +emitPOp ANF.SPLL = emitBP2 SPLL +emitPOp ANF.SPLR = emitBP2 SPLR +-- bytes +emitPOp ANF.PAKB = emitBP1 PAKB +emitPOp ANF.UPKB = emitBP1 UPKB +emitPOp ANF.TAKB = emitBP2 TAKB +emitPOp ANF.DRPB = emitBP2 DRPB +emitPOp ANF.IXOB = emitBP2 IXOB +emitPOp ANF.IDXB = emitBP2 IDXB +emitPOp ANF.SIZB = emitBP1 SIZB +emitPOp ANF.FLTB = emitBP1 FLTB +emitPOp ANF.CATB = emitBP2 CATB +-- universal comparison +emitPOp ANF.EQLU = emitBP2 EQLU +emitPOp ANF.CMPU = emitBP2 CMPU +-- code operations +emitPOp ANF.MISS = emitBP1 MISS +emitPOp ANF.CACH = emitBP1 CACH +emitPOp ANF.LKUP = emitBP1 LKUP +emitPOp ANF.TLTT = emitBP1 TLTT +emitPOp ANF.CVLD = emitBP1 CVLD +emitPOp ANF.LOAD = emitBP1 LOAD +emitPOp ANF.VALU = emitBP1 VALU +emitPOp ANF.SDBX = emitBP2 SDBX +emitPOp ANF.SDBL = emitBP1 SDBL +emitPOp ANF.SDBV = emitBP2 SDBV +-- error call +emitPOp ANF.EROR = emitBP2 THRO +emitPOp ANF.TRCE = emitBP2 TRCE +emitPOp ANF.DBTX = emitBP1 DBTX +-- non-prim translations +emitPOp ANF.BLDS = Seq +emitPOp ANF.FORK = \case + VArg1 i -> Fork i + _ -> internalBug "fork takes exactly one boxed argument" +emitPOp ANF.ATOM = \case + VArg1 i -> Atomically i + _ -> internalBug "atomically takes exactly one boxed argument" +emitPOp ANF.PRNT = \case + VArg1 i -> Print i + _ -> internalBug "print takes exactly one boxed argument" +emitPOp ANF.INFO = \case + ZArgs -> Info "debug" + _ -> internalBug "info takes no arguments" +emitPOp ANF.TFRC = \case + VArg1 i -> TryForce i + _ -> internalBug "tryEval takes exactly one boxed argument" + +-- handled in emitSection because Die is not an instruction + +-- Emit machine code for ANF IO operations. These are all translated +-- to 'foreing function' calls, but there is a special case for the +-- standard handle access function, because it does not yield an +-- explicit error. +emitFOp :: ANF.FOp -> Args -> Instr +emitFOp fop = ForeignCall True (fromIntegral $ fromEnum fop) + +-- Helper functions for packing the variable argument representation +-- into the indexes stored in prim op instructions +emitP1 :: UPrim1 -> Args -> Instr +emitP1 p (VArg1 i) = UPrim1 p i +emitP1 p a = + internalBug $ + "wrong number of args for unary unboxed primop: " + ++ show (p, a) + +emitP2 :: UPrim2 -> Args -> Instr +emitP2 p (VArg2 i j) = UPrim2 p i j +emitP2 p a = + internalBug $ + "wrong number of args for binary unboxed primop: " + ++ show (p, a) + +emitBP1 :: BPrim1 -> Args -> Instr +emitBP1 p (VArg1 i) = BPrim1 p i +emitBP1 p a = + internalBug $ + "wrong number of args for unary boxed primop: " + ++ show (p, a) + +emitBP2 :: BPrim2 -> Args -> Instr +emitBP2 p (VArg2 i j) = BPrim2 p i j +emitBP2 p a = + internalBug $ + "wrong number of args for binary boxed primop: " + ++ show (p, a) + +emitDataMatching :: + (Var v) => + Reference -> + RefNums -> + Reference -> + Word64 -> + RCtx v -> + Ctx v -> + EnumMap CTag ([Mem], ANormal v) -> + Maybe (ANormal v) -> + Emit Branch +emitDataMatching r rns grpr grpn rec ctx cs df = + TestW <$> edf <*> traverse (emitCase rns grpr grpn rec ctx) (coerce cs) + where + -- Note: this is not really accurate. A default data case needs + -- stack space corresponding to the actual data that shows up there. + -- However, we currently don't use default cases for data. + edf + | Just co <- df = emitSection rns grpr grpn rec ctx co + | otherwise = countCtx ctx $ Die ("missing data case for hash " <> show r) + +-- Emits code corresponding to an unboxed sum match. +-- The match is against a tag on the stack, and cases introduce +-- variables to the middle of the context, because the fields were +-- already there, but it was unknown how many there were until +-- branching on the tag. +emitSumMatching :: + (Var v) => + RefNums -> + Reference -> + Word64 -> + RCtx v -> + Ctx v -> + v -> + Int -> + EnumMap Word64 ([Mem], ANormal v) -> + Emit Section +emitSumMatching rns grpr grpn rec ctx v i cs = + MatchW i edf <$> traverse (emitSumCase rns grpr grpn rec ctx v) cs + where + edf = Die "uncovered unboxed sum case" + +emitRequestMatching :: + (Var v) => + RefNums -> + Reference -> + Word64 -> + RCtx v -> + Ctx v -> + EnumMap Word64 (EnumMap CTag ([Mem], ANormal v)) -> + ANormal v -> + Emit (Section, EnumMap Word64 Branch) +emitRequestMatching rns grpr grpn rec ctx hs df = (,) <$> pur <*> tops + where + pur = emitCase rns grpr grpn rec ctx ([BX], df) + tops = traverse f (coerce hs) + f cs = TestW edf <$> traverse (emitCase rns grpr grpn rec ctx) cs + edf = Die "unhandled ability" + +emitLitMatching :: + (Var v) => + (Traversable f) => + (Int -> Section -> f Section -> Section) -> + String -> + RefNums -> + Reference -> + Word64 -> + RCtx v -> + Ctx v -> + Int -> + f (ANormal v) -> + Maybe (ANormal v) -> + Emit Section +emitLitMatching con err rns grpr grpn rec ctx i cs df = + con i <$> edf <*> traverse (emitCase rns grpr grpn rec ctx . ([],)) cs + where + edf + | Just co <- df = emitSection rns grpr grpn rec ctx co + | otherwise = countCtx ctx $ Die err + +emitCase :: + (Var v) => + RefNums -> + Reference -> + Word64 -> + RCtx v -> + Ctx v -> + ([Mem], ANormal v) -> + Emit Section +emitCase rns grpr grpn rec ctx (ccs, TAbss vs bo) = + emitSection rns grpr grpn rec (pushCtx (zip vs ccs) ctx) bo + +emitSumCase :: + (Var v) => + RefNums -> + Reference -> + Word64 -> + RCtx v -> + Ctx v -> + v -> + ([Mem], ANormal v) -> + Emit Section +emitSumCase rns grpr grpn rec ctx v (ccs, TAbss vs bo) = + emitSection rns grpr grpn rec (sumCtx ctx v $ zip vs ccs) bo + +litToMLit :: ANF.Lit -> MLit +litToMLit (ANF.I i) = MI (fromIntegral i) +litToMLit (ANF.N n) = MN n +litToMLit (ANF.C c) = MC c +litToMLit (ANF.F d) = MD d +litToMLit (ANF.T t) = MT t +litToMLit (ANF.LM r) = MM r +litToMLit (ANF.LY r) = MY r + +-- | Emit a literal as a machine literal of the correct boxed/unboxed format. +emitLit :: ANF.Lit -> Instr +emitLit = Lit . litToMLit + +-- Emits some fix-up code for calling functions. Some of the +-- variables in scope come from the top-level let rec, but these +-- are definitions, not values on the stack. These definitions cannot +-- be passed directly as function arguments, and must have a +-- corresponding stack entry allocated first. So, this function inserts +-- these allocations and passes the appropriate context into the +-- provided continuation. +emitClosures :: + (Var v) => + Reference -> + Word64 -> + RCtx v -> + Ctx v -> + [v] -> + (Ctx v -> Args -> Emit Section) -> + Emit Section +emitClosures grpr grpn rec ctx args k = + allocate ctx args $ \ctx -> k ctx $ emitArgs grpn ctx args + where + allocate ctx [] k = k ctx + allocate ctx (a : as) k + | Just _ <- ctxResolve ctx a = allocate ctx as k + | Just n <- rctxResolve rec a = + let cix = (CIx grpr grpn n) + in Ins (Name (Env cix cix) ZArgs) <$> allocate (Var a BX ctx) as k + | otherwise = + internalBug $ "emitClosures: unknown reference: " ++ show a ++ show grpr + +emitArgs :: (Var v) => Word64 -> Ctx v -> [v] -> Args +emitArgs grpn ctx args + | Just l <- traverse (ctxResolve ctx) args = demuxArgs l + | otherwise = + internalBug $ + "emitArgs[" + ++ show grpn + ++ "]: " + ++ "could not resolve argument variables: " + ++ show args + +-- Turns a list of stack positions and calling conventions into the +-- argument format expected in the machine code. +demuxArgs :: [(Int, Mem)] -> Args +demuxArgs = \case + [] -> ZArgs + [(i, _)] -> VArg1 i + [(i, _), (j, _)] -> VArg2 i j + args -> VArgN $ PA.primArrayFromList (fst <$> args) + +combDeps :: GComb val comb -> [Word64] +combDeps (Lam _ _ s) = sectionDeps s +combDeps (CachedVal {}) = [] + +combTypes :: GComb any comb -> [Word64] +combTypes (Lam _ _ s) = sectionTypes s +combTypes (CachedVal {}) = [] + +sectionDeps :: GSection comb -> [Word64] +sectionDeps (App _ (Env (CIx _ w _) _) _) = [w] +sectionDeps (Call _ (CIx _ w _) _ _) = [w] +sectionDeps (Match _ br) = branchDeps br +sectionDeps (DMatch _ _ br) = branchDeps br +sectionDeps (RMatch _ pu br) = + sectionDeps pu ++ foldMap branchDeps br +sectionDeps (NMatch _ _ br) = branchDeps br +sectionDeps (Ins i s) + | Name (Env (CIx _ w _) _) _ <- i = w : sectionDeps s + | otherwise = sectionDeps s +sectionDeps (Let s (CIx _ w _) _ b) = + w : sectionDeps s ++ sectionDeps b +sectionDeps _ = [] + +sectionTypes :: GSection comb -> [Word64] +sectionTypes (Ins i s) = instrTypes i ++ sectionTypes s +sectionTypes (Let s _ _ b) = sectionTypes s ++ sectionTypes b +sectionTypes (Match _ br) = branchTypes br +sectionTypes (DMatch _ _ br) = branchTypes br +sectionTypes (NMatch _ _ br) = branchTypes br +sectionTypes (RMatch _ pu br) = + sectionTypes pu ++ foldMap branchTypes br +sectionTypes _ = [] + +instrTypes :: GInstr comb -> [Word64] +instrTypes (Pack _ (PackedTag w) _) = [w `shiftR` 16] +instrTypes (Reset ws) = setToList ws +instrTypes (Capture w) = [w] +instrTypes (SetDyn w _) = [w] +instrTypes _ = [] + +branchDeps :: GBranch comb -> [Word64] +branchDeps (Test1 _ s1 d) = sectionDeps s1 ++ sectionDeps d +branchDeps (Test2 _ s1 _ s2 d) = + sectionDeps s1 ++ sectionDeps s2 ++ sectionDeps d +branchDeps (TestW d m) = + sectionDeps d ++ foldMap sectionDeps m +branchDeps (TestT d m) = + sectionDeps d ++ foldMap sectionDeps m + +branchTypes :: GBranch comb -> [Word64] +branchTypes (Test1 _ s1 d) = sectionTypes s1 ++ sectionTypes d +branchTypes (Test2 _ s1 _ s2 d) = + sectionTypes s1 ++ sectionTypes s2 ++ sectionTypes d +branchTypes (TestW d m) = + sectionTypes d ++ foldMap sectionTypes m +branchTypes (TestT d m) = + sectionTypes d ++ foldMap sectionTypes m + +indent :: Int -> ShowS +indent ind = showString (replicate (ind * 2) ' ') + +prettyCombs :: + Word64 -> + EnumMap Word64 Comb -> + ShowS +prettyCombs w es = + foldr + (\(i, c) r -> prettyComb w i c . showString "\n" . r) + id + (mapToList es) + +prettyComb :: (Show val, Show comb) => Word64 -> Word64 -> GComb val comb -> ShowS +prettyComb w i = \case + (Lam a _ s) -> + shows w + . showString ":" + . shows i + . showString ":" + . shows a + . showString "\n" + . prettySection 2 s + (CachedVal a b) -> + shows w + . showString ":" + . shows i + . showString ":" + . shows a + . showString "\n" + . shows b + +prettySection :: (Show comb) => Int -> GSection comb -> ShowS +prettySection ind sec = + indent ind . case sec of + App _ r as -> + showString "App " + . prettyGRef 12 r + . showString " " + . prettyArgs as + Call _ i _ as -> + showString "Call " . prettyCIx i . showString " " . prettyArgs as + Jump i as -> + showString "Jump " . shows i . showString " " . prettyArgs as + Match i bs -> + showString "Match " + . shows i + . showString "\n" + . prettyBranches (ind + 1) bs + Yield as -> showString "Yield " . prettyArgs as + Ins i nx -> + prettyIns i . showString "\n" . prettySection ind nx + Let s _ _ b -> + showString "Let\n" + . prettySection (ind + 2) s + . showString "\n" + . prettySection ind b + Die s -> showString $ "Die " ++ s + Exit -> showString "Exit" + DMatch _ i bs -> + showString "DMatch " + . shows i + . showString "\n" + . prettyBranches (ind + 1) bs + NMatch _ i bs -> + showString "NMatch " + . shows i + . showString "\n" + . prettyBranches (ind + 1) bs + RMatch i pu bs -> + showString "RMatch " + . shows i + . showString "\nPUR ->\n" + . prettySection (ind + 1) pu + . foldr (\p r -> rqc p . r) id (mapToList bs) + where + rqc (i, e) = + showString "\n" + . shows i + . showString " ->\n" + . prettyBranches (ind + 1) e + +prettyCIx :: CombIx -> ShowS +prettyCIx (CIx r _ n) = + prettyRef r . if n == 0 then id else showString "-" . shows n + +prettyRef :: Reference -> ShowS +prettyRef = showString . Text.unpack . showShort 10 + +prettyGRef :: Int -> GRef comb -> ShowS +prettyGRef p r = + showParen (p > 10) $ case r of + Stk i -> showString "Stk " . shows i + Dyn w -> showString "Dyn " . shows w + Env cix _ -> showString "Env " . prettyCIx cix + +prettyBranches :: (Show comb) => Int -> GBranch comb -> ShowS +prettyBranches ind bs = + case bs of + Test1 i e df -> pdf df . picase i e + Test2 i ei j ej df -> pdf df . picase i ei . picase j ej + TestW df m -> + pdf df . foldr (\(i, e) r -> picase i e . r) id (mapToList m) + TestT df m -> + pdf df . foldr (\(i, e) r -> ptcase i e . r) id (M.toList m) + where + pdf e = indent ind . showString "DFLT ->\n" . prettySection (ind + 1) e + ptcase t e = + showString "\n" + . indent ind + . shows t + . showString " ->\n" + . prettySection (ind + 1) e + picase i e = + showString "\n" + . indent ind + . shows i + . showString " ->\n" + . prettySection (ind + 1) e + +prettyIns :: (Show comb) => GInstr comb -> ShowS +prettyIns (Pack r i as) = + showString "Pack " + . prettyRef r + . (' ' :) + . shows i + . (' ' :) + . prettyArgs as +prettyIns (Lit l) = + showString "Lit " . showsPrec 11 l +prettyIns (Name r as) = + showString "Name " + . prettyGRef 12 r + . (' ' :) + . prettyArgs as +prettyIns i = shows i + +prettyArgs :: Args -> ShowS +prettyArgs ZArgs = showString "ZArgs" +prettyArgs v = showParen True $ shows v diff --git a/unison-runtime/src/Unison/Runtime/MCode/Serialize.hs b/unison-runtime/src/Unison/Runtime/MCode/Serialize.hs new file mode 100644 index 0000000000..0dcc2cd2cf --- /dev/null +++ b/unison-runtime/src/Unison/Runtime/MCode/Serialize.hs @@ -0,0 +1,416 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PatternSynonyms #-} + +module Unison.Runtime.MCode.Serialize + ( putComb, + getComb, + putCombIx, + getCombIx, + ) +where + +import Data.Bytes.Get +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Bytes.VarInt +import Data.Void (Void) +import Data.Word (Word64) +import GHC.Exts (IsList (..)) +import Unison.Runtime.ANF (PackedTag (..)) +import Unison.Runtime.Array (PrimArray) +import Unison.Runtime.MCode hiding (MatchT) +import Unison.Runtime.Serialize +import Unison.Util.Text qualified as Util.Text +import Prelude hiding (getChar, putChar) + +data CombT = LamT | CachedClosureT + +instance Tag CombT where + tag2word LamT = 0 + tag2word CachedClosureT = 1 + + word2tag 0 = pure LamT + word2tag 1 = pure CachedClosureT + word2tag n = unknownTag "CombT" n + +putPackedTag :: (MonadPut m) => PackedTag -> m () +putPackedTag (PackedTag w) = pWord w + +getPackedTag :: (MonadGet m) => m PackedTag +getPackedTag = PackedTag <$> gWord + +putComb :: (MonadPut m) => (clos -> m ()) -> GComb clos comb -> m () +putComb pClos = \case + (Lam a f body) -> + putTag LamT *> pInt a *> pInt f *> putSection body + (CachedVal w v) -> + putTag CachedClosureT *> putNat w *> pClos v + +getComb :: (MonadGet m) => m (GComb Void CombIx) +getComb = + getTag >>= \case + LamT -> + Lam <$> gInt <*> gInt <*> getSection + CachedClosureT -> error "getComb: Unexpected serialized Cached Closure" + +data SectionT + = AppT + | CallT + | JumpT + | MatchT + | YieldT + | InsT + | LetT + | DieT + | ExitT + | DMatchT + | NMatchT + | RMatchT + +instance Tag SectionT where + tag2word AppT = 0 + tag2word CallT = 1 + tag2word JumpT = 2 + tag2word MatchT = 3 + tag2word YieldT = 4 + tag2word InsT = 5 + tag2word LetT = 6 + tag2word DieT = 7 + tag2word ExitT = 8 + tag2word DMatchT = 9 + tag2word NMatchT = 10 + tag2word RMatchT = 11 + + word2tag 0 = pure AppT + word2tag 1 = pure CallT + word2tag 2 = pure JumpT + word2tag 3 = pure MatchT + word2tag 4 = pure YieldT + word2tag 5 = pure InsT + word2tag 6 = pure LetT + word2tag 7 = pure DieT + word2tag 8 = pure ExitT + word2tag 9 = pure DMatchT + word2tag 10 = pure NMatchT + word2tag 11 = pure RMatchT + word2tag i = unknownTag "SectionT" i + +putSection :: (MonadPut m) => GSection cix -> m () +putSection = \case + App b r a -> putTag AppT *> serialize b *> putRef r *> putArgs a + Call b cix _comb a -> putTag CallT *> serialize b *> putCombIx cix *> putArgs a + Jump i a -> putTag JumpT *> pInt i *> putArgs a + Match i b -> putTag MatchT *> pInt i *> putBranch b + Yield a -> putTag YieldT *> putArgs a + Ins i s -> putTag InsT *> putInstr i *> putSection s + Let s ci f bd -> + putTag LetT + *> putSection s + *> putCombIx ci + *> pInt f + *> putSection bd + Die s -> putTag DieT *> serialize s + Exit -> putTag ExitT + DMatch mr i b -> putTag DMatchT *> putMaybe mr putReference *> pInt i *> putBranch b + NMatch mr i b -> putTag NMatchT *> putMaybe mr putReference *> pInt i *> putBranch b + RMatch i pu bs -> + putTag RMatchT + *> pInt i + *> putSection pu + *> putEnumMap pWord putBranch bs + +getSection :: (MonadGet m) => m Section +getSection = + getTag >>= \case + AppT -> App <$> deserialize <*> getRef <*> getArgs + CallT -> do + skipCheck <- deserialize + cix <- getCombIx + args <- getArgs + pure $ Call skipCheck cix cix args + JumpT -> Jump <$> gInt <*> getArgs + MatchT -> Match <$> gInt <*> getBranch + YieldT -> Yield <$> getArgs + InsT -> Ins <$> getInstr <*> getSection + LetT -> + Let <$> getSection <*> getCombIx <*> gInt <*> getSection + DieT -> Die <$> deserialize + ExitT -> pure Exit + DMatchT -> DMatch <$> getMaybe getReference <*> gInt <*> getBranch + NMatchT -> NMatch <$> getMaybe getReference <*> gInt <*> getBranch + RMatchT -> + RMatch <$> gInt <*> getSection <*> getEnumMap gWord getBranch + +data InstrT + = UPrim1T + | UPrim2T + | BPrim1T + | BPrim2T + | ForeignCallT + | SetDynT + | CaptureT + | NameT + | InfoT + | PackT + | LitT + | PrintT + | ResetT + | ForkT + | AtomicallyT + | SeqT + | TryForceT + +instance Tag InstrT where + tag2word UPrim1T = 0 + tag2word UPrim2T = 1 + tag2word BPrim1T = 2 + tag2word BPrim2T = 3 + tag2word ForeignCallT = 4 + tag2word SetDynT = 5 + tag2word CaptureT = 6 + tag2word NameT = 7 + tag2word InfoT = 8 + tag2word PackT = 9 + tag2word LitT = 10 + tag2word PrintT = 11 + tag2word ResetT = 12 + tag2word ForkT = 13 + tag2word AtomicallyT = 14 + tag2word SeqT = 15 + tag2word TryForceT = 16 + + word2tag 0 = pure UPrim1T + word2tag 1 = pure UPrim2T + word2tag 2 = pure BPrim1T + word2tag 3 = pure BPrim2T + word2tag 4 = pure ForeignCallT + word2tag 5 = pure SetDynT + word2tag 6 = pure CaptureT + word2tag 7 = pure NameT + word2tag 8 = pure InfoT + word2tag 9 = pure PackT + word2tag 10 = pure LitT + word2tag 11 = pure PrintT + word2tag 12 = pure ResetT + word2tag 13 = pure ForkT + word2tag 14 = pure AtomicallyT + word2tag 15 = pure SeqT + word2tag 16 = pure TryForceT + word2tag n = unknownTag "InstrT" n + +putInstr :: (MonadPut m) => GInstr cix -> m () +putInstr = \case + (UPrim1 up i) -> putTag UPrim1T *> putTag up *> pInt i + (UPrim2 up i j) -> putTag UPrim2T *> putTag up *> pInt i *> pInt j + (BPrim1 bp i) -> putTag BPrim1T *> putTag bp *> pInt i + (BPrim2 bp i j) -> putTag BPrim2T *> putTag bp *> pInt i *> pInt j + (ForeignCall b w a) -> putTag ForeignCallT *> serialize b *> pWord w *> putArgs a + (SetDyn w i) -> putTag SetDynT *> pWord w *> pInt i + (Capture w) -> putTag CaptureT *> pWord w + (Name r a) -> putTag NameT *> putRef r *> putArgs a + (Info s) -> putTag InfoT *> serialize s + (Pack r w a) -> putTag PackT *> putReference r *> putPackedTag w *> putArgs a + (Lit l) -> putTag LitT *> putLit l + (Print i) -> putTag PrintT *> pInt i + (Reset s) -> putTag ResetT *> putEnumSet pWord s + (Fork i) -> putTag ForkT *> pInt i + (Atomically i) -> putTag AtomicallyT *> pInt i + (Seq a) -> putTag SeqT *> putArgs a + (TryForce i) -> putTag TryForceT *> pInt i + +getInstr :: (MonadGet m) => m Instr +getInstr = + getTag >>= \case + UPrim1T -> UPrim1 <$> getTag <*> gInt + UPrim2T -> UPrim2 <$> getTag <*> gInt <*> gInt + BPrim1T -> BPrim1 <$> getTag <*> gInt + BPrim2T -> BPrim2 <$> getTag <*> gInt <*> gInt + ForeignCallT -> ForeignCall <$> deserialize <*> gWord <*> getArgs + SetDynT -> SetDyn <$> gWord <*> gInt + CaptureT -> Capture <$> gWord + NameT -> Name <$> getRef <*> getArgs + InfoT -> Info <$> deserialize + PackT -> Pack <$> getReference <*> getPackedTag <*> getArgs + LitT -> Lit <$> getLit + PrintT -> Print <$> gInt + ResetT -> Reset <$> getEnumSet gWord + ForkT -> Fork <$> gInt + AtomicallyT -> Atomically <$> gInt + SeqT -> Seq <$> getArgs + TryForceT -> TryForce <$> gInt + +data ArgsT + = ZArgsT + | Arg1T + | Arg2T + | ArgRT + | ArgNT + | ArgVT + +instance Tag ArgsT where + tag2word ZArgsT = 0 + tag2word Arg1T = 1 + tag2word Arg2T = 2 + tag2word ArgRT = 3 + tag2word ArgNT = 4 + tag2word ArgVT = 5 + + word2tag 0 = pure ZArgsT + word2tag 1 = pure Arg1T + word2tag 2 = pure Arg2T + word2tag 3 = pure ArgRT + word2tag 4 = pure ArgNT + word2tag 5 = pure ArgVT + word2tag n = unknownTag "ArgsT" n + +putArgs :: (MonadPut m) => Args -> m () +putArgs ZArgs = putTag ZArgsT +putArgs (VArg1 i) = putTag Arg1T *> pInt i +putArgs (VArg2 i j) = putTag Arg2T *> pInt i *> pInt j +putArgs (VArgR i j) = putTag ArgRT *> pInt i *> pInt j +putArgs (VArgN pa) = putTag ArgNT *> putIntArr pa +putArgs (VArgV i) = putTag ArgVT *> pInt i + +getArgs :: (MonadGet m) => m Args +getArgs = + getTag >>= \case + ZArgsT -> pure ZArgs + Arg1T -> VArg1 <$> gInt + Arg2T -> VArg2 <$> gInt <*> gInt + ArgRT -> VArgR <$> gInt <*> gInt + ArgNT -> VArgN <$> getIntArr + ArgVT -> VArgV <$> gInt + +data RefT = StkT | EnvT | DynT + +instance Tag RefT where + tag2word StkT = 0 + tag2word EnvT = 1 + tag2word DynT = 2 + + word2tag 0 = pure StkT + word2tag 1 = pure EnvT + word2tag 2 = pure DynT + word2tag n = unknownTag "RefT" n + +putRef :: (MonadPut m) => GRef cix -> m () +putRef (Stk i) = putTag StkT *> pInt i +putRef (Env cix _) = putTag EnvT *> putCombIx cix +putRef (Dyn i) = putTag DynT *> pWord i + +getRef :: (MonadGet m) => m Ref +getRef = + getTag >>= \case + StkT -> Stk <$> gInt + EnvT -> do + cix <- getCombIx + pure $ Env cix cix + DynT -> Dyn <$> gWord + +putCombIx :: (MonadPut m) => CombIx -> m () +putCombIx (CIx r n i) = putReference r *> pWord n *> pWord i + +getCombIx :: (MonadGet m) => m CombIx +getCombIx = CIx <$> getReference <*> gWord <*> gWord + +data MLitT = MIT | MNT | MCT | MDT | MTT | MMT | MYT + +instance Tag MLitT where + tag2word MIT = 0 + tag2word MNT = 1 + tag2word MCT = 2 + tag2word MDT = 3 + tag2word MTT = 4 + tag2word MMT = 5 + tag2word MYT = 6 + + word2tag 0 = pure MIT + word2tag 1 = pure MNT + word2tag 2 = pure MCT + word2tag 3 = pure MDT + word2tag 4 = pure MTT + word2tag 5 = pure MMT + word2tag 6 = pure MYT + word2tag n = unknownTag "MLitT" n + +putLit :: (MonadPut m) => MLit -> m () +putLit (MI i) = putTag MIT *> pInt i +putLit (MN n) = putTag MNT *> pWord n +putLit (MC c) = putTag MCT *> putChar c +putLit (MD d) = putTag MDT *> putFloat d +putLit (MT t) = putTag MTT *> putText (Util.Text.toText t) +putLit (MM r) = putTag MMT *> putReferent r +putLit (MY r) = putTag MYT *> putReference r + +getLit :: (MonadGet m) => m MLit +getLit = + getTag >>= \case + MIT -> MI <$> gInt + MNT -> MN <$> gWord + MCT -> MC <$> getChar + MDT -> MD <$> getFloat + MTT -> MT . Util.Text.fromText <$> getText + MMT -> MM <$> getReferent + MYT -> MY <$> getReference + +data BranchT = Test1T | Test2T | TestWT | TestTT + +instance Tag BranchT where + tag2word Test1T = 0 + tag2word Test2T = 1 + tag2word TestWT = 2 + tag2word TestTT = 3 + + word2tag 0 = pure Test1T + word2tag 1 = pure Test2T + word2tag 2 = pure TestWT + word2tag 3 = pure TestTT + word2tag n = unknownTag "BranchT" n + +putBranch :: (MonadPut m) => GBranch cix -> m () +putBranch (Test1 w s d) = + putTag Test1T *> pWord w *> putSection s *> putSection d +putBranch (Test2 a sa b sb d) = + putTag Test2T + *> pWord a + *> putSection sa + *> pWord b + *> putSection sb + *> putSection d +putBranch (TestW d m) = + putTag TestWT *> putSection d *> putEnumMap pWord putSection m +putBranch (TestT d m) = + putTag TestTT *> putSection d *> putMap (putText . Util.Text.toText) putSection m + +getBranch :: (MonadGet m) => m Branch +getBranch = + getTag >>= \case + Test1T -> Test1 <$> gWord <*> getSection <*> getSection + Test2T -> + Test2 + <$> gWord + <*> getSection + <*> gWord + <*> getSection + <*> getSection + TestWT -> TestW <$> getSection <*> getEnumMap gWord getSection + TestTT -> TestT <$> getSection <*> getMap (Util.Text.fromText <$> getText) getSection + +gInt :: (MonadGet m) => m Int +gInt = unVarInt <$> deserialize + +pInt :: (MonadPut m) => Int -> m () +pInt i = serialize (VarInt i) + +gWord :: (MonadGet m) => m Word64 +gWord = unVarInt <$> deserialize + +pWord :: (MonadPut m) => Word64 -> m () +pWord w = serialize (VarInt w) + +putIntArr :: (MonadPut m) => PrimArray Int -> m () +putIntArr pa = putFoldable pInt $ toList pa + +getIntArr :: (MonadGet m) => m (PrimArray Int) +getIntArr = fromList <$> getList gInt diff --git a/unison-runtime/src/Unison/Runtime/Machine.hs b/unison-runtime/src/Unison/Runtime/Machine.hs new file mode 100644 index 0000000000..22b4add374 --- /dev/null +++ b/unison-runtime/src/Unison/Runtime/Machine.hs @@ -0,0 +1,2581 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} + +module Unison.Runtime.Machine where + +import Control.Concurrent (ThreadId) +import Control.Concurrent.STM as STM +import Control.Exception +import Control.Lens +import Data.Bits +import Data.Functor.Classes (Eq1 (..), Ord1 (..)) +import Data.Map.Strict qualified as M +import Data.Ord (comparing) +import Data.Sequence qualified as Sq +import Data.Set qualified as S +import Data.Set qualified as Set +import Data.Text qualified as DTx +import Data.Text.IO qualified as Tx +import Data.Traversable +import GHC.Conc as STM (unsafeIOToSTM) +import Unison.Builtin.Decls (exceptionRef, ioFailureRef) +import Unison.Builtin.Decls qualified as Rf +import Unison.ConstructorReference qualified as CR +import Unison.Prelude hiding (Text) +import Unison.Reference + ( Reference, + Reference' (Builtin), + isBuiltin, + toShortHash, + ) +import Unison.Referent (Referent, pattern Con, pattern Ref) +import Unison.Runtime.ANF as ANF + ( Cacheability (..), + Code (..), + CompileExn (..), + PackedTag (..), + SuperGroup, + codeGroup, + foldGroup, + foldGroupLinks, + maskTags, + packTags, + valueLinks, + ) +import Unison.Runtime.ANF qualified as ANF +import Unison.Runtime.Array as PA +import Unison.Runtime.Builtin +import Unison.Runtime.Exception +import Unison.Runtime.Foreign +import Unison.Runtime.Foreign.Function +import Unison.Runtime.MCode +import Unison.Runtime.Stack +import Unison.Runtime.TypeTags qualified as TT +import Unison.ShortHash qualified as SH +import Unison.Symbol (Symbol) +import Unison.Type qualified as Rf +import Unison.Util.Bytes qualified as By +import Unison.Util.EnumContainers as EC +import Unison.Util.Monoid qualified as Monoid +import Unison.Util.Pretty (toPlainUnbroken) +import Unison.Util.Text qualified as Util.Text +import UnliftIO (IORef) +import UnliftIO qualified +import UnliftIO.Concurrent qualified as UnliftIO + +{- ORMOLU_DISABLE -} +#ifdef STACK_CHECK +import Unison.Debug qualified as Debug +import System.IO.Unsafe (unsafePerformIO) +#endif +{- ORMOLU_ENABLE -} + +-- | A ref storing every currently active thread. +-- This is helpful for cleaning up orphaned threads when the main process +-- completes. +-- +-- We track threads when running in a host process like UCM, +-- otherwise, in one-off environments 'Nothing' is used and we don't bother tracking forked threads since they'll be +-- cleaned up automatically on process termination. +type ActiveThreads = Maybe (IORef (Set ThreadId)) + +type Tag = Word64 + +-- dynamic environment +type DEnv = EnumMap Word64 Val + +type MCombs = RCombs Val + +type Combs = GCombs Void CombIx + +type MSection = RSection Val + +type MBranch = RBranch Val + +type MInstr = RInstr Val + +type MComb = RComb Val + +type MRef = RRef Val + +data Tracer + = NoTrace + | MsgTrace String String String + | SimpleTrace String + +-- code caching environment +data CCache = CCache + { foreignFuncs :: EnumMap Word64 ForeignFunc, + sandboxed :: Bool, + tracer :: Bool -> Val -> Tracer, + -- Combinators in their original form, where they're easier to serialize into SCache + srcCombs :: TVar (EnumMap Word64 Combs), + combs :: TVar (EnumMap Word64 MCombs), + combRefs :: TVar (EnumMap Word64 Reference), + -- Combs which we're allowed to cache after evaluating + cacheableCombs :: TVar (EnumSet Word64), + tagRefs :: TVar (EnumMap Word64 Reference), + freshTm :: TVar Word64, + freshTy :: TVar Word64, + intermed :: TVar (M.Map Reference (SuperGroup Symbol)), + refTm :: TVar (M.Map Reference Word64), + refTy :: TVar (M.Map Reference Word64), + sandbox :: TVar (M.Map Reference (Set Reference)) + } + +refNumsTm :: CCache -> IO (M.Map Reference Word64) +refNumsTm cc = readTVarIO (refTm cc) + +refNumsTy :: CCache -> IO (M.Map Reference Word64) +refNumsTy cc = readTVarIO (refTy cc) + +refNumTm :: CCache -> Reference -> IO Word64 +refNumTm cc r = + refNumsTm cc >>= \case + (M.lookup r -> Just w) -> pure w + _ -> die $ "refNumTm: unknown reference: " ++ show r + +refNumTy :: CCache -> Reference -> IO Word64 +refNumTy cc r = + refNumsTy cc >>= \case + (M.lookup r -> Just w) -> pure w + _ -> die $ "refNumTy: unknown reference: " ++ show r + +refNumTy' :: CCache -> Reference -> IO (Maybe Word64) +refNumTy' cc r = M.lookup r <$> refNumsTy cc + +baseCCache :: Bool -> IO CCache +baseCCache sandboxed = do + CCache ffuncs sandboxed noTrace + <$> newTVarIO srcCombs + <*> newTVarIO combs + <*> newTVarIO builtinTermBackref + <*> newTVarIO cacheableCombs + <*> newTVarIO builtinTypeBackref + <*> newTVarIO ftm + <*> newTVarIO fty + <*> newTVarIO mempty + <*> newTVarIO builtinTermNumbering + <*> newTVarIO builtinTypeNumbering + <*> newTVarIO baseSandboxInfo + where + cacheableCombs = mempty + ffuncs | sandboxed = sandboxedForeigns | otherwise = builtinForeigns + noTrace _ _ = NoTrace + ftm = 1 + maximum builtinTermNumbering + fty = 1 + maximum builtinTypeNumbering + + rns = emptyRNs {dnum = refLookup "ty" builtinTypeNumbering} + + srcCombs :: EnumMap Word64 Combs + srcCombs = + numberedTermLookup + & mapWithKey + (\k v -> let r = builtinTermBackref ! k in emitComb @Symbol rns r k mempty (0, v)) + combs :: EnumMap Word64 MCombs + combs = + srcCombs + & absurdCombs + & resolveCombs Nothing + +info :: (Show a) => String -> a -> IO () +info ctx x = infos ctx (show x) + +infos :: String -> String -> IO () +infos ctx s = putStrLn $ ctx ++ ": " ++ s + +stk'info :: Stack -> IO () +stk'info s@(Stack _ _ sp _ _) = do + let prn i + | i < 0 = return () + | otherwise = bpeekOff s i >>= print >> prn (i - 1) + prn sp + +-- Entry point for evaluating a section +eval0 :: CCache -> ActiveThreads -> MSection -> IO () +eval0 !env !activeThreads !co = do + stk <- alloc + cmbs <- readTVarIO $ combs env + (denv, k) <- + topDEnv cmbs <$> readTVarIO (refTy env) <*> readTVarIO (refTm env) + eval env denv activeThreads stk (k KE) dummyRef co + +mCombVal :: CombIx -> MComb -> Val +mCombVal cix (RComb (Comb comb)) = + BoxedVal (PAp cix comb nullSeg) +mCombVal _ (RComb (CachedVal _ clo)) = clo + +topDEnv :: + EnumMap Word64 MCombs -> + M.Map Reference Word64 -> + M.Map Reference Word64 -> + (DEnv, K -> K) +topDEnv combs rfTy rfTm + | Just n <- M.lookup exceptionRef rfTy, + rcrf <- Builtin (DTx.pack "raise"), + Just j <- M.lookup rcrf rfTm, + cix <- CIx rcrf j 0, + clo <- mCombVal cix $ rCombSection combs cix = + ( EC.mapSingleton n clo, + Mark 0 (EC.setSingleton n) mempty + ) +topDEnv _ _ _ = (mempty, id) + +-- Entry point for evaluating a numbered combinator. +-- An optional callback for the base of the stack may be supplied. +-- +-- This is the entry point actually used in the interactive +-- environment currently. +apply0 :: + Maybe (Stack -> IO ()) -> + CCache -> + ActiveThreads -> + Word64 -> + IO () +apply0 !callback !env !threadTracker !i = do + stk <- alloc + cmbrs <- readTVarIO $ combRefs env + cmbs <- readTVarIO $ combs env + (denv, kf) <- + topDEnv cmbs <$> readTVarIO (refTy env) <*> readTVarIO (refTm env) + r <- case EC.lookup i cmbrs of + Just r -> pure r + Nothing -> die "apply0: missing reference to entry point" + let entryCix = (CIx r i 0) + case unRComb $ rCombSection cmbs entryCix of + Comb entryComb -> do + apply env denv threadTracker stk (kf k0) True ZArgs . BoxedVal $ + PAp entryCix entryComb nullSeg + -- if it's cached, we can just finish + CachedVal _ val -> bump stk >>= \stk -> poke stk val + where + k0 = maybe KE (CB . Hook) callback + +-- Apply helper currently used for forking. Creates the new stacks +-- necessary to evaluate a closure with the provided information. +apply1 :: + (Stack -> IO ()) -> + CCache -> + ActiveThreads -> + Val -> + IO () +apply1 callback env threadTracker clo = do + stk <- alloc + apply env mempty threadTracker stk k0 True ZArgs $ clo + where + k0 = CB $ Hook callback + +-- Entry point for evaluating a saved continuation. +-- +-- The continuation must be from an evaluation context expecting a +-- unit value. +jump0 :: + (Stack -> IO ()) -> + CCache -> + ActiveThreads -> + Closure -> + IO () +jump0 !callback !env !activeThreads !clo = do + stk <- alloc + cmbs <- readTVarIO $ combs env + (denv, kf) <- + topDEnv cmbs <$> readTVarIO (refTy env) <*> readTVarIO (refTm env) + stk <- bump stk + bpoke stk (Enum Rf.unitRef TT.unitTag) + jump env denv activeThreads stk (kf k0) (VArg1 0) clo + where + k0 = CB (Hook callback) + +unitValue :: Closure +unitValue = Enum Rf.unitRef TT.unitTag + +lookupDenv :: Word64 -> DEnv -> Val +lookupDenv p denv = fromMaybe (BoxedVal BlackHole) $ EC.lookup p denv + +litToVal :: MLit -> Val +litToVal = \case + MT t -> BoxedVal $ Foreign (Wrap Rf.textRef t) + MM r -> BoxedVal $ Foreign (Wrap Rf.termLinkRef r) + MY r -> BoxedVal $ Foreign (Wrap Rf.typeLinkRef r) + MI i -> IntVal i + MN n -> NatVal n + MC c -> CharVal c + MD d -> DoubleVal d +{-# INLINE litToVal #-} + +{- ORMOLU_DISABLE -} +#ifdef STACK_CHECK +debugger :: (Show a) => Stack -> String -> a -> Bool +debugger stk msg a = unsafePerformIO $ do + dumpStack stk + Debug.debugLogM Debug.Interpreter (msg ++ ": " ++ show a) + pure False + +dumpStack :: Stack -> IO () +dumpStack stk@(Stack ap fp sp _ustk _bstk) + | sp - fp < 0 = Debug.debugLogM Debug.Interpreter "Stack before 👇: Empty" + | otherwise = do + stkLocals <- for [0 .. ((sp - fp) - 1)] $ \i -> do + peekOff stk i + Debug.debugM Debug.Interpreter "Stack frame locals 👇:" stkLocals + stkArgs <- for [0 .. ((fp - ap) - 1)] $ \i -> do + peekOff stk (i + (sp - fp)) + Debug.debugM Debug.Interpreter "Stack args 👇:" stkArgs +#endif +{- ORMOLU_ENABLE -} + +-- | Execute an instruction +exec :: + CCache -> + DEnv -> + ActiveThreads -> + Stack -> + K -> + Reference -> + MInstr -> + IO (DEnv, Stack, K) +{- ORMOLU_DISABLE -} +#ifdef STACK_CHECK +exec !_ !_ !_ !stk !_ !_ instr + | debugger stk "exec" instr = undefined +#endif +{- ORMOLU_ENABLE -} +exec !_ !denv !_activeThreads !stk !k _ (Info tx) = do + info tx stk + info tx k + pure (denv, stk, k) +exec !env !denv !_activeThreads !stk !k _ (Name r args) = do + v <- resolve env denv stk r + stk <- name stk args v + pure (denv, stk, k) +exec !_ !denv !_activeThreads !stk !k _ (SetDyn p i) = do + val <- peekOff stk i + pure (EC.mapInsert p val denv, stk, k) +exec !_ !denv !_activeThreads !stk !k _ (Capture p) = do + (cap, denv, stk, k) <- splitCont denv stk k p + stk <- bump stk + poke stk cap + pure (denv, stk, k) +exec !_ !denv !_activeThreads !stk !k _ (UPrim1 op i) = do + stk <- uprim1 stk op i + pure (denv, stk, k) +exec !_ !denv !_activeThreads !stk !k _ (UPrim2 op i j) = do + stk <- uprim2 stk op i j + pure (denv, stk, k) +exec !env !denv !_activeThreads !stk !k _ (BPrim1 MISS i) + | sandboxed env = die "attempted to use sandboxed operation: isMissing" + | otherwise = do + clink <- bpeekOff stk i + let link = case unwrapForeign $ marshalToForeign clink of + Ref r -> r + _ -> error "exec:BPrim1:MISS: Expected Ref" + m <- readTVarIO (intermed env) + stk <- bump stk + pokeTag stk $ if (link `M.member` m) then 1 else 0 + pure (denv, stk, k) +exec !env !denv !_activeThreads !stk !k _ (BPrim1 CACH i) + | sandboxed env = die "attempted to use sandboxed operation: cache" + | otherwise = do + arg <- peekOffS stk i + news <- decodeCacheArgument arg + unknown <- cacheAdd news env + stk <- bump stk + pokeS + stk + (Sq.fromList $ boxedVal . Foreign . Wrap Rf.termLinkRef . Ref <$> unknown) + pure (denv, stk, k) +exec !env !denv !_activeThreads !stk !k _ (BPrim1 CVLD i) + | sandboxed env = die "attempted to use sandboxed operation: validate" + | otherwise = do + arg <- peekOffS stk i + news <- decodeCacheArgument arg + codeValidate (second codeGroup <$> news) env >>= \case + Nothing -> do + stk <- bump stk + pokeTag stk 0 + pure (denv, stk, k) + Just (Failure ref msg clo) -> do + stk <- bumpn stk 3 + bpoke stk (Foreign $ Wrap Rf.typeLinkRef ref) + pokeOffBi stk 1 msg + bpokeOff stk 2 clo + stk <- bump stk + pokeTag stk 1 + pure (denv, stk, k) +exec !env !denv !_activeThreads !stk !k _ (BPrim1 LKUP i) + | sandboxed env = die "attempted to use sandboxed operation: lookup" + | otherwise = do + clink <- bpeekOff stk i + let link = case unwrapForeign $ marshalToForeign clink of + Ref r -> r + _ -> error "exec:BPrim1:LKUP: Expected Ref" + m <- readTVarIO (intermed env) + rfn <- readTVarIO (refTm env) + cach <- readTVarIO (cacheableCombs env) + stk <- bump stk + stk <- case M.lookup link m of + Nothing + | Just w <- M.lookup link builtinTermNumbering, + Just sn <- EC.lookup w numberedTermLookup -> do + pokeBi stk (CodeRep (ANF.Rec [] sn) Uncacheable) + stk <- bump stk + stk <$ pokeTag stk 1 + | otherwise -> stk <$ pokeTag stk 0 + Just sg -> do + let ch + | Just n <- M.lookup link rfn, + EC.member n cach = + Cacheable + | otherwise = Uncacheable + pokeBi stk (CodeRep sg ch) + stk <- bump stk + stk <$ pokeTag stk 1 + pure (denv, stk, k) +exec !_ !denv !_activeThreads !stk !k _ (BPrim1 TLTT i) = do + clink <- bpeekOff stk i + let shortHash = case unwrapForeign $ marshalToForeign clink of + Ref r -> toShortHash r + Con r _ -> CR.toShortHash r + let sh = Util.Text.fromText . SH.toText $ shortHash + stk <- bump stk + pokeBi stk sh + pure (denv, stk, k) +exec !env !denv !_activeThreads !stk !k _ (BPrim1 LOAD i) + | sandboxed env = die "attempted to use sandboxed operation: load" + | otherwise = do + v <- peekOffBi stk i + stk <- bumpn stk 2 + reifyValue env v >>= \case + Left miss -> do + pokeOffS stk 1 $ + Sq.fromList $ + boxedVal . Foreign . Wrap Rf.termLinkRef . Ref <$> miss + pokeTag stk 0 + Right x -> do + pokeOff stk 1 x + pokeTag stk 1 + pure (denv, stk, k) +exec !env !denv !_activeThreads !stk !k _ (BPrim1 VALU i) = do + m <- readTVarIO (tagRefs env) + c <- peekOff stk i + stk <- bump stk + pokeBi stk =<< reflectValue m c + pure (denv, stk, k) +exec !env !denv !_activeThreads !stk !k _ (BPrim1 DBTX i) + | sandboxed env = + die "attempted to use sandboxed operation: Debug.toText" + | otherwise = do + val <- peekOff stk i + stk <- bump stk + stk <- case tracer env False val of + NoTrace -> stk <$ pokeTag stk 0 + MsgTrace _ _ tx -> do + pokeBi stk (Util.Text.pack tx) + stk <- bump stk + stk <$ pokeTag stk 1 + SimpleTrace tx -> do + pokeBi stk (Util.Text.pack tx) + stk <- bump stk + stk <$ pokeTag stk 2 + pure (denv, stk, k) +exec !env !denv !_activeThreads !stk !k _ (BPrim1 SDBL i) + | sandboxed env = + die "attempted to use sandboxed operation: sandboxLinks" + | otherwise = do + tl <- peekOffBi stk i + stk <- bump stk + pokeS stk . encodeSandboxListResult =<< sandboxList env tl + pure (denv, stk, k) +exec !_ !denv !_activeThreads !stk !k _ (BPrim1 op i) = do + stk <- bprim1 stk op i + pure (denv, stk, k) +exec !env !denv !_activeThreads !stk !k _ (BPrim2 SDBX i j) = do + s <- peekOffS stk i + c <- bpeekOff stk j + l <- decodeSandboxArgument s + b <- checkSandboxing env l c + stk <- bump stk + pokeBool stk $ b + pure (denv, stk, k) +exec !env !denv !_activeThreads !stk !k _ (BPrim2 SDBV i j) + | sandboxed env = + die "attempted to use sandboxed operation: Value.validateSandboxed" + | otherwise = do + s <- peekOffS stk i + v <- peekOffBi stk j + l <- decodeSandboxArgument s + res <- checkValueSandboxing env l v + stk <- bump stk + bpoke stk $ encodeSandboxResult res + pure (denv, stk, k) +exec !_ !denv !_activeThreads !stk !k _ (BPrim2 EQLU i j) = do + x <- peekOff stk i + y <- peekOff stk j + stk <- bump stk + pokeBool stk $ universalEq (==) x y + pure (denv, stk, k) +exec !_ !denv !_activeThreads !stk !k _ (BPrim2 CMPU i j) = do + x <- peekOff stk i + y <- peekOff stk j + stk <- bump stk + pokeI stk . fromEnum $ universalCompare compare x y + pure (denv, stk, k) +exec !_ !_ !_activeThreads !stk !k r (BPrim2 THRO i j) = do + name <- peekOffBi @Util.Text.Text stk i + x <- peekOff stk j + throwIO (BU (traceK r k) (Util.Text.toText name) x) +exec !env !denv !_activeThreads !stk !k _ (BPrim2 TRCE i j) + | sandboxed env = die "attempted to use sandboxed operation: trace" + | otherwise = do + tx <- peekOffBi stk i + clo <- peekOff stk j + case tracer env True clo of + NoTrace -> pure () + SimpleTrace str -> do + putStrLn $ "trace: " ++ Util.Text.unpack tx + putStrLn str + MsgTrace msg ugl pre -> do + putStrLn $ "trace: " ++ Util.Text.unpack tx + putStrLn "" + putStrLn msg + putStrLn "\nraw structure:\n" + putStrLn ugl + putStrLn "partial decompilation:\n" + putStrLn pre + pure (denv, stk, k) +exec !_ !denv !_trackThreads !stk !k _ (BPrim2 op i j) = do + stk <- bprim2 stk op i j + pure (denv, stk, k) +exec !_ !denv !_activeThreads !stk !k _ (Pack r t args) = do + clo <- buildData stk r t args + stk <- bump stk + bpoke stk clo + pure (denv, stk, k) +exec !_ !denv !_activeThreads !stk !k _ (Print i) = do + t <- peekOffBi stk i + Tx.putStrLn (Util.Text.toText t) + pure (denv, stk, k) +exec !_ !denv !_activeThreads !stk !k _ (Lit ml) = do + stk <- bump stk + poke stk $ litToVal ml + pure (denv, stk, k) +exec !_ !denv !_activeThreads !stk !k _ (Reset ps) = do + (stk, a) <- saveArgs stk + pure (denv, stk, Mark a ps clos k) + where + clos = EC.restrictKeys denv ps +exec !_ !denv !_activeThreads !stk !k _ (Seq as) = do + l <- closureArgs stk as + stk <- bump stk + pokeS stk $ Sq.fromList l + pure (denv, stk, k) +exec !env !denv !_activeThreads !stk !k _ (ForeignCall _ w args) + | Just (FF arg res ev) <- EC.lookup w (foreignFuncs env) = + (denv,,k) + <$> (arg stk args >>= ev >>= res stk) + | otherwise = + die $ "reference to unknown foreign function: " ++ show w +exec !env !denv !activeThreads !stk !k _ (Fork i) + | sandboxed env = die "attempted to use sandboxed operation: fork" + | otherwise = do + tid <- forkEval env activeThreads =<< peekOff stk i + stk <- bump stk + bpoke stk . Foreign . Wrap Rf.threadIdRef $ tid + pure (denv, stk, k) +exec !env !denv !activeThreads !stk !k _ (Atomically i) + | sandboxed env = die $ "attempted to use sandboxed operation: atomically" + | otherwise = do + v <- peekOff stk i + stk <- bump stk + atomicEval env activeThreads (poke stk) v + pure (denv, stk, k) +exec !env !denv !activeThreads !stk !k _ (TryForce i) + | sandboxed env = die $ "attempted to use sandboxed operation: tryForce" + | otherwise = do + v <- peekOff stk i + stk <- bump stk -- Bump the boxed stack to make a slot for the result, which will be written in the callback if we succeed. + ev <- Control.Exception.try $ nestEval env activeThreads (poke stk) v + stk <- encodeExn stk ev + pure (denv, stk, k) +{-# INLINE exec #-} + +encodeExn :: + Stack -> + Either SomeException () -> + IO Stack +encodeExn stk exc = do + case exc of + Right () -> do + stk <- bump stk + stk <$ pokeTag stk 1 + Left exn -> do + -- If we hit an exception, we have one unused slot on the stack + -- from where the result _would_ have been placed. + -- So here we bump one less than it looks like we should, and re-use + -- that slot. + stk <- bumpn stk 3 + pokeTag stk 0 + bpokeOff stk 1 $ Foreign (Wrap Rf.typeLinkRef link) + pokeOffBi stk 2 msg + stk <$ pokeOff stk 3 extra + where + disp e = Util.Text.pack $ show e + (link, msg, extra) + | Just (ioe :: IOException) <- fromException exn = + (Rf.ioFailureRef, disp ioe, boxedVal unitValue) + | Just re <- fromException exn = case re of + PE _stk msg -> + (Rf.runtimeFailureRef, Util.Text.pack $ toPlainUnbroken msg, boxedVal unitValue) + BU _ tx val -> (Rf.runtimeFailureRef, Util.Text.fromText tx, val) + | Just (ae :: ArithException) <- fromException exn = + (Rf.arithmeticFailureRef, disp ae, boxedVal unitValue) + | Just (nae :: NestedAtomically) <- fromException exn = + (Rf.stmFailureRef, disp nae, boxedVal unitValue) + | Just (be :: BlockedIndefinitelyOnSTM) <- fromException exn = + (Rf.stmFailureRef, disp be, boxedVal unitValue) + | Just (be :: BlockedIndefinitelyOnMVar) <- fromException exn = + (Rf.ioFailureRef, disp be, boxedVal unitValue) + | Just (ie :: AsyncException) <- fromException exn = + (Rf.threadKilledFailureRef, disp ie, boxedVal unitValue) + | otherwise = (Rf.miscFailureRef, disp exn, boxedVal unitValue) + +numValue :: Maybe Reference -> Val -> IO Word64 +numValue _ (UnboxedVal v _) = pure (fromIntegral @Int @Word64 v) +numValue mr clo = + die $ + "numValue: bad closure: " + ++ show clo + ++ maybe "" (\r -> "\nexpected type: " ++ show r) mr + +-- | Evaluate a section +eval :: + CCache -> + DEnv -> + ActiveThreads -> + Stack -> + K -> + Reference -> + MSection -> + IO () +{- ORMOLU_DISABLE -} +#ifdef STACK_CHECK +eval !_ !_ !_ !stk !_ !_ section + | debugger stk "eval" section = undefined +#endif +{- ORMOLU_ENABLE -} +eval !env !denv !activeThreads !stk !k r (Match i (TestT df cs)) = do + t <- peekOffBi stk i + eval env denv activeThreads stk k r $ selectTextBranch t df cs +eval !env !denv !activeThreads !stk !k r (Match i br) = do + n <- peekOffN stk i + eval env denv activeThreads stk k r $ selectBranch n br +eval !env !denv !activeThreads !stk !k r (DMatch mr i br) = do + (t, stk) <- dumpDataNoTag mr stk =<< peekOff stk i + eval env denv activeThreads stk k r $ + selectBranch (maskTags t) br +eval !env !denv !activeThreads !stk !k r (NMatch _mr i br) = do + n <- peekOffN stk i + eval env denv activeThreads stk k r $ selectBranch n br +eval !env !denv !activeThreads !stk !k r (RMatch i pu br) = do + (t, stk) <- dumpDataNoTag Nothing stk =<< peekOff stk i + if t == PackedTag 0 + then eval env denv activeThreads stk k r pu + else case ANF.unpackTags t of + (ANF.rawTag -> e, ANF.rawTag -> t) + | Just ebs <- EC.lookup e br -> + eval env denv activeThreads stk k r $ selectBranch t ebs + | otherwise -> unhandledErr "eval" env e +eval !env !denv !activeThreads !stk !k _ (Yield args) + | asize stk > 0, + VArg1 i <- args = + peekOff stk i >>= apply env denv activeThreads stk k False ZArgs + | otherwise = do + stk <- moveArgs stk args + stk <- frameArgs stk + yield env denv activeThreads stk k +eval !env !denv !activeThreads !stk !k _ (App ck r args) = + resolve env denv stk r + >>= apply env denv activeThreads stk k ck args +eval !env !denv !activeThreads !stk !k _ (Call ck combIx rcomb args) = + enter env denv activeThreads stk k (combRef combIx) ck args rcomb +eval !env !denv !activeThreads !stk !k _ (Jump i args) = + bpeekOff stk i >>= jump env denv activeThreads stk k args +eval !env !denv !activeThreads !stk !k r (Let nw cix f sect) = do + (stk, fsz, asz) <- saveFrame stk + eval + env + denv + activeThreads + stk + (Push fsz asz cix f sect k) + r + nw +eval !env !denv !activeThreads !stk !k r (Ins i nx) = do + (denv, stk, k) <- exec env denv activeThreads stk k r i + eval env denv activeThreads stk k r nx +eval !_ !_ !_ !_activeThreads !_ _ Exit = pure () +eval !_ !_ !_ !_activeThreads !_ _ (Die s) = die s +{-# NOINLINE eval #-} + +forkEval :: CCache -> ActiveThreads -> Val -> IO ThreadId +forkEval env activeThreads clo = + do + threadId <- + UnliftIO.forkFinally + (apply1 err env activeThreads clo) + (const cleanupThread) + trackThread threadId + pure threadId + where + err :: Stack -> IO () + err _ = pure () + trackThread :: ThreadId -> IO () + trackThread threadID = do + case activeThreads of + Nothing -> pure () + Just activeThreads -> UnliftIO.atomicModifyIORef' activeThreads (\ids -> (Set.insert threadID ids, ())) + cleanupThread :: IO () + cleanupThread = do + case activeThreads of + Nothing -> pure () + Just activeThreads -> do + myThreadId <- UnliftIO.myThreadId + UnliftIO.atomicModifyIORef' activeThreads (\ids -> (Set.delete myThreadId ids, ())) +{-# INLINE forkEval #-} + +nestEval :: CCache -> ActiveThreads -> (Val -> IO ()) -> Val -> IO () +nestEval env activeThreads write val = apply1 readBack env activeThreads val + where + readBack stk = peek stk >>= write +{-# INLINE nestEval #-} + +atomicEval :: CCache -> ActiveThreads -> (Val -> IO ()) -> Val -> IO () +atomicEval env activeThreads write val = + atomically . unsafeIOToSTM $ nestEval env activeThreads write val +{-# INLINE atomicEval #-} + +-- fast path application +enter :: + CCache -> + DEnv -> + ActiveThreads -> + Stack -> + K -> + Reference -> + Bool -> + Args -> + MComb -> + IO () +enter !env !denv !activeThreads !stk !k !cref !sck !args = \case + (RComb (Lam a f entry)) -> do + -- check for stack check _skip_ + stk <- if sck then pure stk else ensure stk f + stk <- moveArgs stk args + stk <- acceptArgs stk a + eval env denv activeThreads stk k cref entry + (RComb (CachedVal _ val)) -> do + stk <- discardFrame stk + stk <- bump stk + poke stk val + yield env denv activeThreads stk k +{-# INLINE enter #-} + +-- fast path by-name delaying +name :: Stack -> Args -> Val -> IO Stack +name !stk !args = \case + BoxedVal (PAp cix comb seg) -> do + seg <- closeArgs I stk seg args + stk <- bump stk + bpoke stk $ PAp cix comb seg + pure stk + v -> die $ "naming non-function: " ++ show v +{-# INLINE name #-} + +-- slow path application +apply :: + CCache -> + DEnv -> + ActiveThreads -> + Stack -> + K -> + Bool -> + Args -> + Val -> + IO () +{- ORMOLU_DISABLE -} +#ifdef STACK_CHECK +apply !_env !_denv !_activeThreads !stk !_k !_ck !args !val + | debugger stk "apply" (args, val) = undefined +#endif +{- ORMOLU_ENABLE -} +apply !env !denv !activeThreads !stk !k !ck !args !val = + case val of + BoxedVal (PAp cix@(CIx combRef _ _) comb seg) -> + case comb of + LamI a f entry + | ck || a <= ac -> do + stk <- ensure stk f + stk <- moveArgs stk args + stk <- dumpSeg stk seg A + stk <- acceptArgs stk a + eval env denv activeThreads stk k combRef entry + | otherwise -> do + seg <- closeArgs C stk seg args + stk <- discardFrame =<< frameArgs stk + stk <- bump stk + bpoke stk $ PAp cix comb seg + yield env denv activeThreads stk k + where + ac = asize stk + countArgs args + scount seg + v -> zeroArgClosure v + where + zeroArgClosure :: Val -> IO () + zeroArgClosure v + | ZArgs <- args, + asize stk == 0 = do + stk <- discardFrame stk + stk <- bump stk + poke stk v + yield env denv activeThreads stk k + | otherwise = die $ "applying non-function: " ++ show v +{-# INLINE apply #-} + +jump :: + CCache -> + DEnv -> + ActiveThreads -> + Stack -> + K -> + Args -> + Closure -> + IO () +jump !env !denv !activeThreads !stk !k !args clo = case clo of + Captured sk0 a seg -> do + let (p, sk) = adjust sk0 + seg <- closeArgs K stk seg args + stk <- discardFrame stk + stk <- dumpSeg stk seg $ F (countArgs args) a + stk <- adjustArgs stk p + repush env activeThreads stk denv sk k + _ -> die "jump: non-cont" + where + -- Adjusts a repushed continuation to account for pending arguments. If + -- there are any frames in the pushed continuation, the nearest one needs to + -- record the additional pending arguments. + -- + -- If the repushed continuation has no frames, then the arguments are still + -- pending, and the result stacks need to be adjusted. + adjust :: K -> (SZ, K) + adjust (Mark a rs denv k) = + (0, Mark (a + asize stk) rs denv k) + adjust (Push n a cix f rsect k) = + (0, Push n (a + asize stk) cix f rsect k) + adjust k = (asize stk, k) +{-# INLINE jump #-} + +repush :: + CCache -> + ActiveThreads -> + Stack -> + DEnv -> + K -> + K -> + IO () +repush !env !activeThreads !stk = go + where + go !denv KE !k = yield env denv activeThreads stk k + go !denv (Mark a ps cs sk) !k = go denv' sk $ Mark a ps cs' k + where + denv' = cs <> EC.withoutKeys denv ps + cs' = EC.restrictKeys denv ps + go !denv (Push n a cix f rsect sk) !k = + go denv sk $ Push n a cix f rsect k + go !_ (CB _) !_ = die "repush: impossible" +{-# INLINE repush #-} + +moveArgs :: + Stack -> + Args -> + IO Stack +moveArgs !stk ZArgs = do + stk <- discardFrame stk + pure stk +moveArgs !stk (VArg1 i) = do + stk <- prepareArgs stk (Arg1 i) + pure stk +moveArgs !stk (VArg2 i j) = do + stk <- prepareArgs stk (Arg2 i j) + pure stk +moveArgs !stk (VArgR i l) = do + stk <- prepareArgs stk (ArgR i l) + pure stk +moveArgs !stk (VArgN as) = do + stk <- prepareArgs stk (ArgN as) + pure stk +moveArgs !stk (VArgV i) = do + stk <- + if l > 0 + then prepareArgs stk (ArgR 0 l) + else discardFrame stk + pure stk + where + l = fsize stk - i +{-# INLINE moveArgs #-} + +closureArgs :: Stack -> Args -> IO [Val] +closureArgs !_ ZArgs = pure [] +closureArgs !stk (VArg1 i) = do + x <- peekOff stk i + pure [x] +closureArgs !stk (VArg2 i j) = do + x <- peekOff stk i + y <- peekOff stk j + pure [x, y] +closureArgs !stk (VArgR i l) = + for (take l [i ..]) (peekOff stk) +closureArgs !stk (VArgN bs) = + for (PA.primArrayToList bs) (peekOff stk) +closureArgs !_ _ = + error "closure arguments can only be boxed." +{-# INLINE closureArgs #-} + +-- | Pack some number of args into a data type of the provided ref/tag type. +buildData :: + Stack -> Reference -> PackedTag -> Args -> IO Closure +buildData !_ !r !t ZArgs = pure $ Enum r t +buildData !stk !r !t (VArg1 i) = do + v <- peekOff stk i + pure $ Data1 r t v +buildData !stk !r !t (VArg2 i j) = do + v1 <- peekOff stk i + v2 <- peekOff stk j + pure $ Data2 r t v1 v2 +buildData !stk !r !t (VArgR i l) = do + seg <- augSeg I stk nullSeg (Just $ ArgR i l) + pure $ DataG r t seg +buildData !stk !r !t (VArgN as) = do + seg <- augSeg I stk nullSeg (Just $ ArgN as) + pure $ DataG r t seg +buildData !stk !r !t (VArgV i) = do + seg <- + if l > 0 + then augSeg I stk nullSeg (Just $ ArgR 0 l) + else pure nullSeg + pure $ DataG r t seg + where + l = fsize stk - i +{-# INLINE buildData #-} + +-- Dumps a data type closure to the stack without writing its tag. +-- Instead, the tag is returned for direct case analysis. +dumpDataNoTag :: + Maybe Reference -> + Stack -> + Val -> + IO (PackedTag, Stack) +dumpDataNoTag !mr !stk = \case + -- Normally we want to avoid dumping unboxed values since it's unnecessary, but sometimes we don't know the type of + -- the incoming value and end up dumping unboxed values, so we just push them back to the stack as-is. e.g. in type-casts/coercions + val@(UnboxedVal _ t) -> do + stk <- bump stk + poke stk val + pure (unboxedPackedTag t, stk) + BoxedVal clos -> case clos of + (Enum _ t) -> pure (t, stk) + (Data1 _ t x) -> do + stk <- bump stk + poke stk x + pure (t, stk) + (Data2 _ t x y) -> do + stk <- bumpn stk 2 + pokeOff stk 1 y + poke stk x + pure (t, stk) + (DataG _ t seg) -> do + stk <- dumpSeg stk seg S + pure (t, stk) + clo -> + die $ + "dumpDataNoTag: bad closure: " + ++ show clo + ++ maybe "" (\r -> "\nexpected type: " ++ show r) mr + where + unboxedPackedTag :: UnboxedTypeTag -> PackedTag + unboxedPackedTag = \case + CharTag -> TT.charTag + FloatTag -> TT.floatTag + IntTag -> TT.intTag + NatTag -> TT.natTag +{-# INLINE dumpDataNoTag #-} + +-- Note: although the representation allows it, it is impossible +-- to under-apply one sort of argument while over-applying the +-- other. Thus, it is unnecessary to worry about doing tricks to +-- only grab a certain number of arguments. +closeArgs :: + Augment -> + Stack -> + Seg -> + Args -> + IO Seg +closeArgs mode !stk !seg args = augSeg mode stk seg as + where + as = case args of + ZArgs -> Nothing + VArg1 i -> Just $ Arg1 i + VArg2 i j -> Just $ Arg2 i j + VArgR i l -> Just $ ArgR i l + VArgN as -> Just $ ArgN as + VArgV i -> a + where + a + | l > 0 = Just $ ArgR 0 l + | otherwise = Nothing + l = fsize stk - i + +peekForeign :: Stack -> Int -> IO a +peekForeign stk i = + bpeekOff stk i >>= \case + Foreign x -> pure $ unwrapForeign x + _ -> die "bad foreign argument" +{-# INLINE peekForeign #-} + +uprim1 :: Stack -> UPrim1 -> Int -> IO Stack +uprim1 !stk DECI !i = do + m <- peekOffI stk i + stk <- bump stk + pokeI stk (m - 1) + pure stk +uprim1 !stk DECN !i = do + m <- peekOffN stk i + stk <- bump stk + pokeN stk (m - 1) + pure stk +uprim1 !stk INCI !i = do + m <- peekOffI stk i + stk <- bump stk + pokeI stk (m + 1) + pure stk +uprim1 !stk INCN !i = do + m <- peekOffN stk i + stk <- bump stk + pokeN stk (m + 1) + pure stk +uprim1 !stk NEGI !i = do + m <- upeekOff stk i + stk <- bump stk + pokeI stk (-m) + pure stk +uprim1 !stk SGNI !i = do + m <- upeekOff stk i + stk <- bump stk + pokeI stk (signum m) + pure stk +uprim1 !stk ABSF !i = do + d <- peekOffD stk i + stk <- bump stk + pokeD stk (abs d) + pure stk +uprim1 !stk CEIL !i = do + d <- peekOffD stk i + stk <- bump stk + pokeI stk (ceiling d) + pure stk +uprim1 !stk FLOR !i = do + d <- peekOffD stk i + stk <- bump stk + pokeI stk (floor d) + pure stk +uprim1 !stk TRNF !i = do + d <- peekOffD stk i + stk <- bump stk + pokeI stk (truncate d) + pure stk +uprim1 !stk RNDF !i = do + d <- peekOffD stk i + stk <- bump stk + pokeI stk (round d) + pure stk +uprim1 !stk EXPF !i = do + d <- peekOffD stk i + stk <- bump stk + pokeD stk (exp d) + pure stk +uprim1 !stk LOGF !i = do + d <- peekOffD stk i + stk <- bump stk + pokeD stk (log d) + pure stk +uprim1 !stk SQRT !i = do + d <- peekOffD stk i + stk <- bump stk + pokeD stk (sqrt d) + pure stk +uprim1 !stk COSF !i = do + d <- peekOffD stk i + stk <- bump stk + pokeD stk (cos d) + pure stk +uprim1 !stk SINF !i = do + d <- peekOffD stk i + stk <- bump stk + pokeD stk (sin d) + pure stk +uprim1 !stk TANF !i = do + d <- peekOffD stk i + stk <- bump stk + pokeD stk (tan d) + pure stk +uprim1 !stk COSH !i = do + d <- peekOffD stk i + stk <- bump stk + pokeD stk (cosh d) + pure stk +uprim1 !stk SINH !i = do + d <- peekOffD stk i + stk <- bump stk + pokeD stk (sinh d) + pure stk +uprim1 !stk TANH !i = do + d <- peekOffD stk i + stk <- bump stk + pokeD stk (tanh d) + pure stk +uprim1 !stk ACOS !i = do + d <- peekOffD stk i + stk <- bump stk + pokeD stk (acos d) + pure stk +uprim1 !stk ASIN !i = do + d <- peekOffD stk i + stk <- bump stk + pokeD stk (asin d) + pure stk +uprim1 !stk ATAN !i = do + d <- peekOffD stk i + stk <- bump stk + pokeD stk (atan d) + pure stk +uprim1 !stk ASNH !i = do + d <- peekOffD stk i + stk <- bump stk + pokeD stk (asinh d) + pure stk +uprim1 !stk ACSH !i = do + d <- peekOffD stk i + stk <- bump stk + pokeD stk (acosh d) + pure stk +uprim1 !stk ATNH !i = do + d <- peekOffD stk i + stk <- bump stk + pokeD stk (atanh d) + pure stk +uprim1 !stk ITOF !i = do + n <- upeekOff stk i + stk <- bump stk + pokeD stk (fromIntegral n) + pure stk +uprim1 !stk NTOF !i = do + n <- peekOffN stk i + stk <- bump stk + pokeD stk (fromIntegral n) + pure stk +uprim1 !stk LZRO !i = do + n <- peekOffN stk i + stk <- bump stk + unsafePokeIasN stk (countLeadingZeros n) + pure stk +uprim1 !stk TZRO !i = do + n <- peekOffN stk i + stk <- bump stk + unsafePokeIasN stk (countTrailingZeros n) + pure stk +uprim1 !stk POPC !i = do + n <- peekOffN stk i + stk <- bump stk + unsafePokeIasN stk (popCount n) + pure stk +uprim1 !stk COMN !i = do + n <- peekOffN stk i + stk <- bump stk + pokeN stk (complement n) + pure stk +uprim1 !stk COMI !i = do + n <- peekOffI stk i + stk <- bump stk + pokeI stk (complement n) + pure stk +{-# INLINE uprim1 #-} + +uprim2 :: Stack -> UPrim2 -> Int -> Int -> IO Stack +uprim2 !stk ADDI !i !j = do + m <- upeekOff stk i + n <- upeekOff stk j + stk <- bump stk + pokeI stk (m + n) + pure stk +uprim2 !stk ADDN !i !j = do + m <- peekOffN stk i + n <- peekOffN stk j + stk <- bump stk + pokeN stk (m + n) + pure stk +uprim2 !stk SUBI !i !j = do + m <- upeekOff stk i + n <- upeekOff stk j + stk <- bump stk + pokeI stk (m - n) + pure stk +uprim2 !stk SUBN !i !j = do + m <- peekOffI stk i + n <- peekOffI stk j + stk <- bump stk + pokeI stk (m - n) + pure stk +uprim2 !stk MULI !i !j = do + m <- upeekOff stk i + n <- upeekOff stk j + stk <- bump stk + pokeI stk (m * n) + pure stk +uprim2 !stk MULN !i !j = do + m <- peekOffN stk i + n <- peekOffN stk j + stk <- bump stk + pokeN stk (m * n) + pure stk +uprim2 !stk DIVI !i !j = do + m <- upeekOff stk i + n <- upeekOff stk j + stk <- bump stk + pokeI stk (m `div` n) + pure stk +uprim2 !stk MODI !i !j = do + m <- upeekOff stk i + n <- upeekOff stk j + stk <- bump stk + pokeI stk (m `mod` n) + pure stk +uprim2 !stk SHLI !i !j = do + m <- upeekOff stk i + n <- upeekOff stk j + stk <- bump stk + pokeI stk (m `shiftL` n) + pure stk +uprim2 !stk SHLN !i !j = do + m <- peekOffN stk i + n <- upeekOff stk j + stk <- bump stk + pokeN stk (m `shiftL` n) + pure stk +uprim2 !stk SHRI !i !j = do + m <- upeekOff stk i + n <- upeekOff stk j + stk <- bump stk + pokeI stk (m `shiftR` n) + pure stk +uprim2 !stk SHRN !i !j = do + m <- peekOffN stk i + n <- upeekOff stk j + stk <- bump stk + pokeN stk (m `shiftR` n) + pure stk +uprim2 !stk POWI !i !j = do + m <- upeekOff stk i + n <- peekOffN stk j + stk <- bump stk + pokeI stk (m ^ n) + pure stk +uprim2 !stk POWN !i !j = do + m <- peekOffN stk i + n <- peekOffN stk j + stk <- bump stk + pokeN stk (m ^ n) + pure stk +uprim2 !stk EQLI !i !j = do + m <- upeekOff stk i + n <- upeekOff stk j + stk <- bump stk + pokeBool stk $ m == n + pure stk +uprim2 !stk EQLN !i !j = do + m <- peekOffN stk i + n <- peekOffN stk j + stk <- bump stk + pokeBool stk $ m == n + pure stk +uprim2 !stk LEQI !i !j = do + m <- upeekOff stk i + n <- upeekOff stk j + stk <- bump stk + pokeBool stk $ m <= n + pure stk +uprim2 !stk LEQN !i !j = do + m <- peekOffN stk i + n <- peekOffN stk j + stk <- bump stk + pokeBool stk $ m <= n + pure stk +uprim2 !stk DIVN !i !j = do + m <- peekOffN stk i + n <- peekOffN stk j + stk <- bump stk + pokeN stk (m `div` n) + pure stk +uprim2 !stk MODN !i !j = do + m <- peekOffN stk i + n <- peekOffN stk j + stk <- bump stk + pokeN stk (m `mod` n) + pure stk +uprim2 !stk ADDF !i !j = do + x <- peekOffD stk i + y <- peekOffD stk j + stk <- bump stk + pokeD stk (x + y) + pure stk +uprim2 !stk SUBF !i !j = do + x <- peekOffD stk i + y <- peekOffD stk j + stk <- bump stk + pokeD stk (x - y) + pure stk +uprim2 !stk MULF !i !j = do + x <- peekOffD stk i + y <- peekOffD stk j + stk <- bump stk + pokeD stk (x * y) + pure stk +uprim2 !stk DIVF !i !j = do + x <- peekOffD stk i + y <- peekOffD stk j + stk <- bump stk + pokeD stk (x / y) + pure stk +uprim2 !stk LOGB !i !j = do + x <- peekOffD stk i + y <- peekOffD stk j + stk <- bump stk + pokeD stk (logBase x y) + pure stk +uprim2 !stk POWF !i !j = do + x <- peekOffD stk i + y <- peekOffD stk j + stk <- bump stk + pokeD stk (x ** y) + pure stk +uprim2 !stk MAXF !i !j = do + x <- peekOffD stk i + y <- peekOffD stk j + stk <- bump stk + pokeD stk (max x y) + pure stk +uprim2 !stk MINF !i !j = do + x <- peekOffD stk i + y <- peekOffD stk j + stk <- bump stk + pokeD stk (min x y) + pure stk +uprim2 !stk EQLF !i !j = do + x <- peekOffD stk i + y <- peekOffD stk j + stk <- bump stk + pokeBool stk $ x == y + pure stk +uprim2 !stk LEQF !i !j = do + x <- peekOffD stk i + y <- peekOffD stk j + stk <- bump stk + pokeBool stk $ x <= y + pure stk +uprim2 !stk ATN2 !i !j = do + x <- peekOffD stk i + y <- peekOffD stk j + stk <- bump stk + pokeD stk (atan2 x y) + pure stk +uprim2 !stk ANDN !i !j = do + x <- peekOffN stk i + y <- peekOffN stk j + stk <- bump stk + pokeN stk (x .&. y) + pure stk +uprim2 !stk ANDI !i !j = do + x <- peekOffI stk i + y <- peekOffI stk j + stk <- bump stk + pokeI stk (x .&. y) + pure stk +uprim2 !stk IORN !i !j = do + x <- peekOffN stk i + y <- peekOffN stk j + stk <- bump stk + pokeN stk (x .|. y) + pure stk +uprim2 !stk IORI !i !j = do + x <- peekOffI stk i + y <- peekOffI stk j + stk <- bump stk + pokeI stk (x .|. y) + pure stk +uprim2 !stk XORN !i !j = do + x <- peekOffN stk i + y <- peekOffN stk j + stk <- bump stk + pokeN stk (xor x y) + pure stk +uprim2 !stk XORI !i !j = do + x <- peekOffI stk i + y <- peekOffI stk j + stk <- bump stk + pokeI stk (xor x y) + pure stk +uprim2 !stk CAST !vi !ti = do + newTypeTag <- peekOffI stk ti + v <- upeekOff stk vi + stk <- bump stk + poke stk $ UnboxedVal v (unboxedTypeTagFromInt newTypeTag) + pure stk +{-# INLINE uprim2 #-} + +bprim1 :: + Stack -> + BPrim1 -> + Int -> + IO Stack +bprim1 !stk SIZT i = do + t <- peekOffBi stk i + stk <- bump stk + unsafePokeIasN stk $ Util.Text.size t + pure stk +bprim1 !stk SIZS i = do + s <- peekOffS stk i + stk <- bump stk + unsafePokeIasN stk $ Sq.length s + pure stk +bprim1 !stk ITOT i = do + n <- upeekOff stk i + stk <- bump stk + pokeBi stk . Util.Text.pack $ show n + pure stk +bprim1 !stk NTOT i = do + n <- peekOffN stk i + stk <- bump stk + pokeBi stk . Util.Text.pack $ show n + pure stk +bprim1 !stk FTOT i = do + f <- peekOffD stk i + stk <- bump stk + pokeBi stk . Util.Text.pack $ show f + pure stk +bprim1 !stk USNC i = + peekOffBi stk i >>= \t -> case Util.Text.unsnoc t of + Nothing -> do + stk <- bump stk + pokeTag stk 0 + pure stk + Just (t, c) -> do + stk <- bumpn stk 3 + pokeOffC stk 2 $ c -- char value + pokeOffBi stk 1 t -- remaining text + pokeTag stk 1 -- 'Just' tag + pure stk +bprim1 !stk UCNS i = + peekOffBi stk i >>= \t -> case Util.Text.uncons t of + Nothing -> do + stk <- bump stk + pokeTag stk 0 + pure stk + Just (c, t) -> do + stk <- bumpn stk 3 + pokeOffBi stk 2 t -- remaining text + pokeOffC stk 1 $ c -- char value + pokeTag stk 1 -- 'Just' tag + pure stk +bprim1 !stk TTOI i = + peekOffBi stk i >>= \t -> case readm $ Util.Text.unpack t of + Just n + | fromIntegral (minBound :: Int) <= n, + n <= fromIntegral (maxBound :: Int) -> do + stk <- bumpn stk 2 + pokeTag stk 1 + pokeOffI stk 1 (fromInteger n) + pure stk + _ -> do + stk <- bump stk + pokeTag stk 0 + pure stk + where + readm ('+' : s) = readMaybe s + readm s = readMaybe s +bprim1 !stk TTON i = + peekOffBi stk i >>= \t -> case readMaybe $ Util.Text.unpack t of + Just n + | 0 <= n, + n <= fromIntegral (maxBound :: Word) -> do + stk <- bumpn stk 2 + pokeTag stk 1 + pokeOffN stk 1 (fromInteger n) + pure stk + _ -> do + stk <- bump stk + pokeTag stk 0 + pure stk +bprim1 !stk TTOF i = + peekOffBi stk i >>= \t -> case readMaybe $ Util.Text.unpack t of + Nothing -> do + stk <- bump stk + pokeTag stk 0 + pure stk + Just f -> do + stk <- bumpn stk 2 + pokeTag stk 1 + pokeOffD stk 1 f + pure stk +bprim1 !stk VWLS i = + peekOffS stk i >>= \case + Sq.Empty -> do + stk <- bump stk + pokeTag stk 0 -- 'Empty' tag + pure stk + x Sq.:<| xs -> do + stk <- bumpn stk 3 + pokeOffS stk 2 xs -- remaining seq + pokeOff stk 1 x -- head + pokeTag stk 1 -- ':<|' tag + pure stk +bprim1 !stk VWRS i = + peekOffS stk i >>= \case + Sq.Empty -> do + stk <- bump stk + pokeTag stk 0 -- 'Empty' tag + pure stk + xs Sq.:|> x -> do + stk <- bumpn stk 3 + pokeOff stk 2 x -- last + pokeOffS stk 1 xs -- remaining seq + pokeTag stk 1 -- ':|>' tag + pure stk +bprim1 !stk PAKT i = do + s <- peekOffS stk i + stk <- bump stk + pokeBi stk . Util.Text.pack . toList $ val2char <$> s + pure stk + where + val2char :: Val -> Char + val2char (CharVal c) = c + val2char c = error $ "pack text: non-character closure: " ++ show c +bprim1 !stk UPKT i = do + t <- peekOffBi stk i + stk <- bump stk + pokeS stk + . Sq.fromList + . fmap CharVal + . Util.Text.unpack + $ t + pure stk +bprim1 !stk PAKB i = do + s <- peekOffS stk i + stk <- bump stk + pokeBi stk . By.fromWord8s . fmap val2w8 $ toList s + pure stk + where + -- TODO: Should we have a tag for bytes specifically? + val2w8 :: Val -> Word8 + val2w8 (NatVal n) = toEnum . fromEnum $ n + val2w8 c = error $ "pack bytes: non-natural closure: " ++ show c +bprim1 !stk UPKB i = do + b <- peekOffBi stk i + stk <- bump stk + pokeS stk . Sq.fromList . fmap (NatVal . toEnum @Word64 . fromEnum @Word8) $ + By.toWord8s b + pure stk +bprim1 !stk SIZB i = do + b <- peekOffBi stk i + stk <- bump stk + unsafePokeIasN stk $ By.size b + pure stk +bprim1 !stk FLTB i = do + b <- peekOffBi stk i + stk <- bump stk + pokeBi stk $ By.flatten b + pure stk +-- impossible +bprim1 !stk MISS _ = pure stk +bprim1 !stk CACH _ = pure stk +bprim1 !stk LKUP _ = pure stk +bprim1 !stk CVLD _ = pure stk +bprim1 !stk TLTT _ = pure stk +bprim1 !stk LOAD _ = pure stk +bprim1 !stk VALU _ = pure stk +bprim1 !stk DBTX _ = pure stk +bprim1 !stk SDBL _ = pure stk +{-# INLINE bprim1 #-} + +bprim2 :: + Stack -> + BPrim2 -> + Int -> + Int -> + IO Stack +bprim2 !stk IXOT i j = do + x <- peekOffBi stk i + y <- peekOffBi stk j + case Util.Text.indexOf x y of + Nothing -> do + stk <- bump stk + pokeTag stk 0 + pure stk + Just i -> do + stk <- bumpn stk 2 + pokeTag stk 1 + pokeOffN stk 1 i + pure stk +bprim2 !stk IXOB i j = do + x <- peekOffBi stk i + y <- peekOffBi stk j + case By.indexOf x y of + Nothing -> do + stk <- bump stk + pokeTag stk 0 + pure stk + Just i -> do + stk <- bumpn stk 2 + pokeTag stk 1 + pokeOffN stk 1 i + pure stk +bprim2 !stk DRPT i j = do + n <- upeekOff stk i + t <- peekOffBi stk j + stk <- bump stk + -- Note; if n < 0, the Nat argument was greater than the maximum + -- signed integer. As an approximation, just return the empty + -- string, as a string larger than this would require an absurd + -- amount of memory. + pokeBi stk $ if n < 0 then Util.Text.empty else Util.Text.drop n t + pure stk +bprim2 !stk CATT i j = do + x <- peekOffBi stk i + y <- peekOffBi stk j + stk <- bump stk + pokeBi stk $ (x <> y :: Util.Text.Text) + pure stk +bprim2 !stk TAKT i j = do + n <- upeekOff stk i + t <- peekOffBi stk j + stk <- bump stk + -- Note: if n < 0, the Nat argument was greater than the maximum + -- signed integer. As an approximation, we just return the original + -- string, because it's unlikely such a large string exists. + pokeBi stk $ if n < 0 then t else Util.Text.take n t + pure stk +bprim2 !stk EQLT i j = do + x <- peekOffBi @Util.Text.Text stk i + y <- peekOffBi stk j + stk <- bump stk + pokeBool stk $ x == y + pure stk +bprim2 !stk LEQT i j = do + x <- peekOffBi @Util.Text.Text stk i + y <- peekOffBi stk j + stk <- bump stk + pokeBool stk $ x <= y + pure stk +bprim2 !stk LEST i j = do + x <- peekOffBi @Util.Text.Text stk i + y <- peekOffBi stk j + stk <- bump stk + pokeBool stk $ x < y + pure stk +bprim2 !stk DRPS i j = do + n <- upeekOff stk i + s <- peekOffS stk j + stk <- bump stk + -- Note: if n < 0, then the Nat argument was larger than the largest + -- signed integer. Seq actually doesn't handle this well, despite it + -- being possible to build (lazy) sequences this large. So, + -- approximate by yielding the empty sequence. + pokeS stk $ if n < 0 then Sq.empty else Sq.drop n s + pure stk +bprim2 !stk TAKS i j = do + n <- upeekOff stk i + s <- peekOffS stk j + stk <- bump stk + -- Note: if n < 0, then the Nat argument was greater than the + -- largest signed integer. It is possible to build such large + -- sequences, but the internal size will actually be wrong then. So, + -- we just return the original sequence as an approximation. + pokeS stk $ if n < 0 then s else Sq.take n s + pure stk +bprim2 !stk CONS i j = do + x <- peekOff stk i + s <- peekOffS stk j + stk <- bump stk + pokeS stk $ x Sq.<| s + pure stk +bprim2 !stk SNOC i j = do + s <- peekOffS stk i + x <- peekOff stk j + stk <- bump stk + pokeS stk $ s Sq.|> x + pure stk +bprim2 !stk CATS i j = do + x <- peekOffS stk i + y <- peekOffS stk j + stk <- bump stk + pokeS stk $ x Sq.>< y + pure stk +bprim2 !stk IDXS i j = do + n <- upeekOff stk i + s <- peekOffS stk j + case Sq.lookup n s of + Nothing -> do + stk <- bump stk + pokeTag stk 0 + pure stk + Just x -> do + stk <- bump stk + poke stk x + stk <- bump stk + pokeTag stk 1 + pure stk +bprim2 !stk SPLL i j = do + n <- upeekOff stk i + s <- peekOffS stk j + if Sq.length s < n + then do + stk <- bump stk + pokeTag stk 0 + pure stk + else do + stk <- bumpn stk 2 + let (l, r) = Sq.splitAt n s + pokeOffS stk 1 r + pokeS stk l + stk <- bump stk + pokeTag stk 1 + pure stk +bprim2 !stk SPLR i j = do + n <- upeekOff stk i + s <- peekOffS stk j + if Sq.length s < n + then do + stk <- bump stk + pokeTag stk 0 + pure stk + else do + stk <- bumpn stk 2 + let (l, r) = Sq.splitAt (Sq.length s - n) s + pokeOffS stk 1 r + pokeS stk l + stk <- bump stk + pokeTag stk 1 + pure stk +bprim2 !stk TAKB i j = do + n <- upeekOff stk i + b <- peekOffBi stk j + stk <- bump stk + -- If n < 0, the Nat argument was larger than the maximum signed + -- integer. Building a value this large would reuire an absurd + -- amount of memory, so just assume n is larger. + pokeBi stk $ if n < 0 then b else By.take n b + pure stk +bprim2 !stk DRPB i j = do + n <- upeekOff stk i + b <- peekOffBi stk j + stk <- bump stk + -- See above for n < 0 + pokeBi stk $ if n < 0 then By.empty else By.drop n b + pure stk +bprim2 !stk IDXB i j = do + n <- upeekOff stk i + b <- peekOffBi stk j + stk <- bump stk + stk <- case By.at n b of + Nothing -> stk <$ pokeTag stk 0 + Just x -> do + pokeByte stk x + stk <- bump stk + stk <$ pokeTag stk 1 + pure stk +bprim2 !stk CATB i j = do + l <- peekOffBi stk i + r <- peekOffBi stk j + stk <- bump stk + pokeBi stk (l <> r :: By.Bytes) + pure stk +bprim2 !stk THRO _ _ = pure stk -- impossible +bprim2 !stk TRCE _ _ = pure stk -- impossible +bprim2 !stk EQLU _ _ = pure stk -- impossible +bprim2 !stk CMPU _ _ = pure stk -- impossible +bprim2 !stk SDBX _ _ = pure stk -- impossible +bprim2 !stk SDBV _ _ = pure stk -- impossible +{-# INLINE bprim2 #-} + +yield :: + CCache -> + DEnv -> + ActiveThreads -> + Stack -> + K -> + IO () +yield !env !denv !activeThreads !stk !k = leap denv k + where + leap !denv0 (Mark a ps cs k) = do + let denv = cs <> EC.withoutKeys denv0 ps + val = denv0 EC.! EC.findMin ps + v <- peek stk + stk <- bump stk + bpoke stk $ Data1 Rf.effectRef (PackedTag 0) v + stk <- adjustArgs stk a + apply env denv activeThreads stk k False (VArg1 0) val + leap !denv (Push fsz asz (CIx ref _ _) f nx k) = do + stk <- restoreFrame stk fsz asz + stk <- ensure stk f + eval env denv activeThreads stk k ref nx + leap _ (CB (Hook f)) = f stk + leap _ KE = pure () +{-# INLINE yield #-} + +selectTextBranch :: + Util.Text.Text -> MSection -> M.Map Util.Text.Text MSection -> MSection +selectTextBranch t df cs = M.findWithDefault df t cs +{-# INLINE selectTextBranch #-} + +selectBranch :: Tag -> MBranch -> MSection +selectBranch t (Test1 u y n) + | t == u = y + | otherwise = n +selectBranch t (Test2 u cu v cv e) + | t == u = cu + | t == v = cv + | otherwise = e +selectBranch t (TestW df cs) = lookupWithDefault df t cs +selectBranch _ (TestT {}) = error "impossible" +{-# INLINE selectBranch #-} + +-- Splits off a portion of the continuation up to a given prompt. +-- +-- The main procedure walks along the 'code' stack `k`, keeping track of how +-- many cells of the data stacks need to be captured. Then the `finish` function +-- performs the actual splitting of the data stacks together with some tweaking. +-- +-- Some special attention is required for pending arguments for over-applied +-- functions. They are part of the continuation, so how many there are at the +-- time of capture is recorded in the `Captured` closure, so that information +-- can be restored later. Also, the `Mark` frame that is popped off as part of +-- this operation potentially exposes pending arguments beyond the delimited +-- region, so those are restored in the `finish` function. +splitCont :: + DEnv -> + Stack -> + K -> + Word64 -> + IO (Val, DEnv, Stack, K) +splitCont !denv !stk !k !p = + walk denv asz KE k + where + asz = asize stk + walk :: EnumMap Word64 Val -> SZ -> K -> K -> IO (Val, EnumMap Word64 Val, Stack, K) + walk !denv !sz !ck KE = + die "fell off stack" >> finish denv sz 0 ck KE + walk !denv !sz !ck (CB _) = + die "fell off stack" >> finish denv sz 0 ck KE + walk !denv !sz !ck (Mark a ps cs k) + | EC.member p ps = finish denv' sz a ck k + | otherwise = walk denv' (sz + a) (Mark a ps cs' ck) k + where + denv' = cs <> EC.withoutKeys denv ps + cs' = EC.restrictKeys denv ps + walk !denv !sz !ck (Push n a br p brSect k) = + walk + denv + (sz + n + a) + (Push n a br p brSect ck) + k + + finish :: EnumMap Word64 Val -> SZ -> SZ -> K -> K -> (IO (Val, EnumMap Word64 Val, Stack, K)) + finish !denv !sz !a !ck !k = do + (seg, stk) <- grab stk sz + stk <- adjustArgs stk a + return (BoxedVal $ Captured ck asz seg, denv, stk, k) +{-# INLINE splitCont #-} + +discardCont :: + DEnv -> + Stack -> + K -> + Word64 -> + IO (DEnv, Stack, K) +discardCont denv stk k p = + splitCont denv stk k p + <&> \(_, denv, stk, k) -> (denv, stk, k) +{-# INLINE discardCont #-} + +resolve :: CCache -> DEnv -> Stack -> MRef -> IO Val +resolve _ _ _ (Env cix mcomb) = pure $ mCombVal cix mcomb +resolve _ _ stk (Stk i) = peekOff stk i +resolve env denv _ (Dyn i) = case EC.lookup i denv of + Just val -> pure val + Nothing -> unhandledErr "resolve" env i + +unhandledErr :: String -> CCache -> Word64 -> IO a +unhandledErr fname env i = + readTVarIO (tagRefs env) >>= \rs -> case EC.lookup i rs of + Just r -> bomb (show r) + Nothing -> bomb (show i) + where + bomb sh = die $ fname ++ ": unhandled ability request: " ++ sh + +rCombSection :: EnumMap Word64 MCombs -> CombIx -> MComb +rCombSection combs (CIx r n i) = + case EC.lookup n combs of + Just cmbs -> case EC.lookup i cmbs of + Just cmb -> RComb cmb + Nothing -> error $ "unknown section `" ++ show i ++ "` of combinator `" ++ show n ++ "`. Reference: " ++ show r + Nothing -> error $ "unknown combinator `" ++ show n ++ "`. Reference: " ++ show r + +resolveSection :: CCache -> Section -> IO MSection +resolveSection cc section = do + rcombs <- readTVarIO (combs cc) + pure $ rCombSection rcombs <$> section + +dummyRef :: Reference +dummyRef = Builtin (DTx.pack "dummy") + +reserveIds :: Word64 -> TVar Word64 -> IO Word64 +reserveIds n free = atomically . stateTVar free $ \i -> (i, i + n) + +updateMap :: (Semigroup s) => s -> TVar s -> STM s +updateMap new0 r = do + new <- evaluateSTM new0 + stateTVar r $ \old -> + let total = new <> old in (total, total) + +refLookup :: String -> M.Map Reference Word64 -> Reference -> Word64 +refLookup s m r + | Just w <- M.lookup r m = w + | otherwise = + error $ "refLookup:" ++ s ++ ": unknown reference: " ++ show r + +decodeCacheArgument :: + USeq -> IO [(Reference, Code)] +decodeCacheArgument s = for (toList s) $ \case + (Val _unboxed (Data2 _ _ (BoxedVal (Foreign x)) (BoxedVal (Data2 _ _ (BoxedVal (Foreign y)) _)))) -> + case unwrapForeign x of + Ref r -> pure (r, unwrapForeign y) + _ -> die "decodeCacheArgument: Con reference" + _ -> die "decodeCacheArgument: unrecognized value" + +decodeSandboxArgument :: USeq -> IO [Reference] +decodeSandboxArgument s = fmap join . for (toList s) $ \case + Val _ (Foreign x) -> case unwrapForeign x of + Ref r -> pure [r] + _ -> pure [] -- constructor + _ -> die "decodeSandboxArgument: unrecognized value" + +encodeSandboxListResult :: [Reference] -> Sq.Seq Val +encodeSandboxListResult = + Sq.fromList . fmap (boxedVal . Foreign . Wrap Rf.termLinkRef . Ref) + +encodeSandboxResult :: Either [Reference] [Reference] -> Closure +encodeSandboxResult (Left rfs) = + encodeLeft . boxedVal . Foreign . Wrap Rf.listRef $ encodeSandboxListResult rfs +encodeSandboxResult (Right rfs) = + encodeRight . boxedVal . Foreign . Wrap Rf.listRef $ encodeSandboxListResult rfs + +encodeLeft :: Val -> Closure +encodeLeft = Data1 Rf.eitherRef TT.leftTag + +encodeRight :: Val -> Closure +encodeRight = Data1 Rf.eitherRef TT.rightTag + +addRefs :: + TVar Word64 -> + TVar (M.Map Reference Word64) -> + TVar (EnumMap Word64 Reference) -> + S.Set Reference -> + STM (M.Map Reference Word64) +addRefs vfrsh vfrom vto rs = do + from0 <- readTVar vfrom + let new = S.filter (`M.notMember` from0) rs + sz = fromIntegral $ S.size new + frsh <- stateTVar vfrsh $ \i -> (i, i + sz) + let newl = S.toList new + from = M.fromList (zip newl [frsh ..]) <> from0 + nto = mapFromList (zip [frsh ..] newl) + writeTVar vfrom from + modifyTVar vto (nto <>) + pure from + +codeValidate :: + [(Reference, SuperGroup Symbol)] -> + CCache -> + IO (Maybe (Failure Closure)) +codeValidate tml cc = do + rty0 <- readTVarIO (refTy cc) + fty <- readTVarIO (freshTy cc) + let f b r + | b, M.notMember r rty0 = S.singleton r + | otherwise = mempty + ntys0 = (foldMap . foldMap) (foldGroupLinks f) tml + ntys = M.fromList $ zip (S.toList ntys0) [fty ..] + rty = ntys <> rty0 + ftm <- readTVarIO (freshTm cc) + rtm0 <- readTVarIO (refTm cc) + let rs = fst <$> tml + rtm = rtm0 `M.withoutKeys` S.fromList rs + rns = RN (refLookup "ty" rty) (refLookup "tm" rtm) (const Nothing) + combinate (n, (r, g)) = evaluate $ emitCombs rns r n g + (Nothing <$ traverse_ combinate (zip [ftm ..] tml)) + `catch` \(CE cs perr) -> + let msg = Util.Text.pack $ toPlainUnbroken perr + extra = Foreign . Wrap Rf.textRef . Util.Text.pack $ show cs + in pure . Just $ Failure ioFailureRef msg extra + +sandboxList :: CCache -> Referent -> IO [Reference] +sandboxList cc (Ref r) = do + sands <- readTVarIO $ sandbox cc + pure . maybe [] S.toList $ M.lookup r sands +sandboxList _ _ = pure [] + +checkSandboxing :: + CCache -> + [Reference] -> + Closure -> + IO Bool +checkSandboxing cc allowed0 c = do + sands <- readTVarIO $ sandbox cc + let f r + | Just rs <- M.lookup r sands = + rs `S.difference` allowed + | otherwise = mempty + pure $ S.null (closureTermRefs f c) + where + allowed = S.fromList allowed0 + +-- Checks a Value for sandboxing. A Left result indicates that some +-- dependencies of the Value are unknown. A Right result indicates +-- builtins transitively referenced by the Value that are disallowed. +checkValueSandboxing :: + CCache -> + [Reference] -> + ANF.Value -> + IO (Either [Reference] [Reference]) +checkValueSandboxing cc allowed0 v = do + sands <- readTVarIO $ sandbox cc + have <- readTVarIO $ intermed cc + let f False r + | Nothing <- M.lookup r have, + not (isBuiltin r) = + (S.singleton r, mempty) + | Just rs <- M.lookup r sands = + (mempty, rs `S.difference` allowed) + f _ _ = (mempty, mempty) + case valueLinks f v of + (miss, sbx) + | S.null miss -> pure . Right $ S.toList sbx + | otherwise -> pure . Left $ S.toList miss + where + allowed = S.fromList allowed0 + +-- Just evaluating to force exceptions. Shouldn't actually be that +-- unsafe. +evaluateSTM :: a -> STM a +evaluateSTM x = unsafeIOToSTM (evaluate x) + +cacheAdd0 :: + S.Set Reference -> + [(Reference, Code)] -> + [(Reference, Set Reference)] -> + CCache -> + IO () +cacheAdd0 ntys0 termSuperGroups sands cc = do + let toAdd = M.fromList (termSuperGroups <&> second codeGroup) + (unresolvedCacheableCombs, unresolvedNonCacheableCombs) <- atomically $ do + have <- readTVar (intermed cc) + let new = M.difference toAdd have + let sz = fromIntegral $ M.size new + let rgs = M.toList new + let rs = fst <$> rgs + int <- updateMap new (intermed cc) + rty <- addRefs (freshTy cc) (refTy cc) (tagRefs cc) ntys0 + ntm <- stateTVar (freshTm cc) $ \i -> (i, i + sz) + rtm <- updateMap (M.fromList $ zip rs [ntm ..]) (refTm cc) + -- check for missing references + let arities = fmap (head . ANF.arities) int <> builtinArities + rns = RN (refLookup "ty" rty) (refLookup "tm" rtm) (flip M.lookup arities) + combinate :: Word64 -> (Reference, SuperGroup Symbol) -> (Word64, EnumMap Word64 Comb) + combinate n (r, g) = + (n, emitCombs rns r n g) + let combRefUpdates = (mapFromList $ zip [ntm ..] rs) + let combIdFromRefMap = (M.fromList $ zip rs [ntm ..]) + let newCacheableCombs = + termSuperGroups + & mapMaybe + ( \case + (ref, CodeRep _ Cacheable) -> + M.lookup ref combIdFromRefMap + _ -> Nothing + ) + & EC.setFromList + newCombRefs <- updateMap combRefUpdates (combRefs cc) + (unresolvedNewCombs, unresolvedCacheableCombs, unresolvedNonCacheableCombs, updatedCombs) <- stateTVar (combs cc) \oldCombs -> + let unresolvedNewCombs :: EnumMap Word64 (GCombs any CombIx) + unresolvedNewCombs = absurdCombs . mapFromList $ zipWith combinate [ntm ..] rgs + (unresolvedCacheableCombs, unresolvedNonCacheableCombs) = + EC.mapToList unresolvedNewCombs & foldMap \(w, gcombs) -> + if EC.member w newCacheableCombs + then (EC.mapSingleton w gcombs, mempty) + else (mempty, EC.mapSingleton w gcombs) + newCombs :: EnumMap Word64 MCombs + newCombs = resolveCombs (Just oldCombs) $ unresolvedNewCombs + updatedCombs = newCombs <> oldCombs + in ((unresolvedNewCombs, unresolvedCacheableCombs, unresolvedNonCacheableCombs, updatedCombs), updatedCombs) + nsc <- updateMap unresolvedNewCombs (srcCombs cc) + nsn <- updateMap (M.fromList sands) (sandbox cc) + ncc <- updateMap newCacheableCombs (cacheableCombs cc) + -- Now that the code cache is primed with everything we need, + -- we can pre-evaluate the top-level constants. + pure $ int `seq` rtm `seq` newCombRefs `seq` updatedCombs `seq` nsn `seq` ncc `seq` nsc `seq` (unresolvedCacheableCombs, unresolvedNonCacheableCombs) + preEvalTopLevelConstants unresolvedCacheableCombs unresolvedNonCacheableCombs cc + +preEvalTopLevelConstants :: (EnumMap Word64 (GCombs Val CombIx)) -> (EnumMap Word64 (GCombs Val CombIx)) -> CCache -> IO () +preEvalTopLevelConstants cacheableCombs newCombs cc = do + activeThreads <- Just <$> UnliftIO.newIORef mempty + evaluatedCacheableCombsVar <- newTVarIO mempty + for_ (EC.mapToList cacheableCombs) \(w, _) -> do + let hook stk = do + val <- peek stk + atomically $ do + modifyTVar evaluatedCacheableCombsVar $ EC.mapInsert w (EC.mapSingleton 0 $ CachedVal w val) + apply0 (Just hook) cc activeThreads w + + evaluatedCacheableCombs <- readTVarIO evaluatedCacheableCombsVar + let allNew = evaluatedCacheableCombs <> newCombs + -- Rewrite all the inlined combinator references to point to the + -- new cached versions. + atomically $ modifyTVar (combs cc) (\existingCombs -> (resolveCombs (Just $ EC.mapDifference existingCombs allNew) allNew) <> existingCombs) + +expandSandbox :: + Map Reference (Set Reference) -> + [(Reference, SuperGroup Symbol)] -> + [(Reference, Set Reference)] +expandSandbox sand0 groups = fixed mempty + where + f sand False r = fromMaybe mempty $ M.lookup r sand + f _ True _ = mempty + + h sand (r, foldGroupLinks (f sand) -> s) + | S.null s = Nothing + | otherwise = Just (r, s) + + fixed extra + | extra == extra' = new + | otherwise = fixed extra' + where + new = mapMaybe (h $ extra <> sand0) groups + extra' = M.fromList new + +cacheAdd :: + [(Reference, Code)] -> + CCache -> + IO [Reference] +cacheAdd l cc = do + rtm <- readTVarIO (refTm cc) + rty <- readTVarIO (refTy cc) + sand <- readTVarIO (sandbox cc) + let known = M.keysSet rtm <> S.fromList (view _1 <$> l) + f b r + | not b, S.notMember r known = Const (S.singleton r, mempty) + | b, M.notMember r rty = Const (mempty, S.singleton r) + | otherwise = Const (mempty, mempty) + (missing, tys) = + getConst $ (foldMap . foldMap . foldGroup) (foldGroupLinks f) l + l'' = filter (\(r, _) -> M.notMember r rtm) l + l' = map (second codeGroup) l'' + if S.null missing + then [] <$ cacheAdd0 tys l'' (expandSandbox sand l') cc + else pure $ S.toList missing + +reflectValue :: EnumMap Word64 Reference -> Val -> IO ANF.Value +reflectValue rty = goV + where + err s = "reflectValue: cannot prepare value for serialization: " ++ s + refTy w + | Just r <- EC.lookup w rty = pure r + | otherwise = + die $ err "unknown type reference" + + goIx (CIx r _ i) = ANF.GR r i + + goV :: Val -> IO ANF.Value + goV = \case + -- For back-compatibility we reflect all Unboxed values into boxed literals, we could change this in the future, + -- but there's not much of a big reason to. + + NatVal n -> pure . ANF.BLit $ ANF.Pos n + IntVal n + | n >= 0 -> pure . ANF.BLit $ ANF.Pos (fromIntegral n) + | otherwise -> pure . ANF.BLit $ ANF.Neg (fromIntegral (abs n)) + DoubleVal f -> pure . ANF.BLit $ ANF.Float f + CharVal c -> pure . ANF.BLit $ ANF.Char c + val@(Val _ clos) -> + case clos of + (PApV cix _rComb args) -> + ANF.Partial (goIx cix) <$> traverse goV args + (DataC r t segs) -> + ANF.Data r (maskTags t) <$> traverse goV segs + (CapV k _ segs) -> + ANF.Cont <$> traverse goV segs <*> goK k + (Foreign f) -> ANF.BLit <$> goF f + BlackHole -> die $ err "black hole" + UnboxedTypeTag {} -> die $ err $ "unknown unboxed value" <> show val + + goK (CB _) = die $ err "callback continuation" + goK KE = pure ANF.KE + goK (Mark a ps de k) = do + ps <- traverse refTy (EC.setToList ps) + de <- traverse (\(k, v) -> (,) <$> refTy k <*> goV v) (mapToList de) + ANF.Mark (fromIntegral a) ps (M.fromList de) <$> goK k + goK (Push f a cix _ _rsect k) = + ANF.Push + (fromIntegral f) + (fromIntegral a) + (goIx cix) + <$> goK k + + goF f + | Just t <- maybeUnwrapBuiltin f = + pure (ANF.Text t) + | Just b <- maybeUnwrapBuiltin f = + pure (ANF.Bytes b) + | Just s <- maybeUnwrapForeign Rf.listRef f = + ANF.List <$> traverse goV s + | Just l <- maybeUnwrapForeign Rf.termLinkRef f = + pure (ANF.TmLink l) + | Just l <- maybeUnwrapForeign Rf.typeLinkRef f = + pure (ANF.TyLink l) + | Just v <- maybeUnwrapForeign Rf.valueRef f = + pure (ANF.Quote v) + | Just g <- maybeUnwrapForeign Rf.codeRef f = + pure (ANF.Code g) + | Just a <- maybeUnwrapForeign Rf.ibytearrayRef f = + pure (ANF.BArr a) + | Just a <- maybeUnwrapForeign Rf.iarrayRef f = + ANF.Arr <$> traverse goV a + | otherwise = die $ err $ "foreign value: " <> (show f) + +reifyValue :: CCache -> ANF.Value -> IO (Either [Reference] Val) +reifyValue cc val = do + erc <- + atomically $ do + combs <- readTVar (combs cc) + rtm <- readTVar (refTm cc) + case S.toList $ S.filter (`M.notMember` rtm) tmLinks of + [] -> do + newTy <- addRefs (freshTy cc) (refTy cc) (tagRefs cc) tyLinks + pure . Right $ (combs, newTy, rtm) + l -> pure (Left l) + traverse (\rfs -> reifyValue0 rfs val) erc + where + f False r = (mempty, S.singleton r) + f True r = (S.singleton r, mempty) + (tyLinks, tmLinks) = valueLinks f val + +reifyValue0 :: + (EnumMap Word64 MCombs, M.Map Reference Word64, M.Map Reference Word64) -> + ANF.Value -> + IO Val +reifyValue0 (combs, rty, rtm) = goV + where + err s = "reifyValue: cannot restore value: " ++ s + refTy r + | Just w <- M.lookup r rty = pure w + | otherwise = die . err $ "unknown type reference: " ++ show r + refTm r + | Just w <- M.lookup r rtm = pure w + | otherwise = die . err $ "unknown term reference: " ++ show r + goIx :: ANF.GroupRef -> IO (CombIx, MComb) + goIx (ANF.GR r i) = + refTm r <&> \n -> + let cix = (CIx r n i) + in (cix, rCombSection combs cix) + + goV :: ANF.Value -> IO Val + goV (ANF.Partial gr vs) = + goIx gr >>= \case + (cix, RComb (Comb rcomb)) -> boxedVal . PApV cix rcomb <$> traverse goV vs + (_, RComb (CachedVal _ val)) + | [] <- vs -> pure val + | otherwise -> die . err $ msg + where + msg = "reifyValue0: non-trivial partial application to cached value" + goV (ANF.Data r t0 vs) = do + t <- flip packTags (fromIntegral t0) . fromIntegral <$> refTy r + boxedVal . DataC r t <$> traverse goV vs + goV (ANF.Cont vs k) = do + k' <- goK k + vs' <- traverse goV vs + pure . boxedVal $ cv k' vs' + where + cv k s = CapV k a s + where + ksz = frameDataSize k + a = fromIntegral $ length s - ksz + goV (ANF.BLit l) = goL l + + goK ANF.KE = pure KE + goK (ANF.Mark a ps de k) = + mrk + <$> traverse refTy ps + <*> traverse (\(k, v) -> (,) <$> refTy k <*> (goV v)) (M.toList de) + <*> goK k + where + mrk ps de k = + Mark (fromIntegral a) (setFromList ps) (mapFromList de) k + goK (ANF.Push f a gr k) = + goIx gr >>= \case + (cix, RComb (Lam _ fr sect)) -> + Push + (fromIntegral f) + (fromIntegral a) + cix + fr + sect + <$> goK k + (CIx r _ _, _) -> + die . err $ + "tried to reify a continuation with a cached value resumption" + ++ show r + + goL :: ANF.BLit -> IO Val + goL (ANF.Text t) = pure . boxedVal . Foreign $ Wrap Rf.textRef t + goL (ANF.List l) = boxedVal . Foreign . Wrap Rf.listRef <$> traverse goV l + goL (ANF.TmLink r) = pure . boxedVal . Foreign $ Wrap Rf.termLinkRef r + goL (ANF.TyLink r) = pure . boxedVal . Foreign $ Wrap Rf.typeLinkRef r + goL (ANF.Bytes b) = pure . boxedVal . Foreign $ Wrap Rf.bytesRef b + goL (ANF.Quote v) = pure . boxedVal . Foreign $ Wrap Rf.valueRef v + goL (ANF.Code g) = pure . boxedVal . Foreign $ Wrap Rf.codeRef g + goL (ANF.BArr a) = pure . boxedVal . Foreign $ Wrap Rf.ibytearrayRef a + goL (ANF.Char c) = pure $ CharVal c + goL (ANF.Pos w) = + -- TODO: Should this be a Nat or an Int? + pure $ NatVal w + goL (ANF.Neg w) = pure $ IntVal (negate (fromIntegral w :: Int)) + goL (ANF.Float d) = pure $ DoubleVal d + goL (ANF.Arr a) = boxedVal . Foreign . Wrap Rf.iarrayRef <$> traverse goV a + +-- Universal comparison functions + +closureNum :: Closure -> Int +closureNum PAp {} = 0 +closureNum DataC {} = 1 +closureNum Captured {} = 2 +closureNum Foreign {} = 3 +closureNum UnboxedTypeTag {} = 4 +closureNum BlackHole {} = 5 + +universalEq :: + (Foreign -> Foreign -> Bool) -> + Val -> + Val -> + Bool +universalEq frn = eqVal + where + eql :: (a -> b -> Bool) -> [a] -> [b] -> Bool + eql cm l r = length l == length r && and (zipWith cm l r) + eqVal :: Val -> Val -> Bool + eqVal (UnboxedVal v1 t1) (UnboxedVal v2 t2) = matchUnboxedTypes t1 t2 && v1 == v2 + eqVal (BoxedVal x) (BoxedVal y) = eqc x y + eqVal _ _ = False + eqc :: Closure -> Closure -> Bool + eqc (DataC _ ct1 [w1]) (DataC _ ct2 [w2]) = + matchTags ct1 ct2 && eqVal w1 w2 + eqc (DataC _ ct1 vs1) (DataC _ ct2 vs2) = + ct1 == ct2 + && eqValList vs1 vs2 + eqc (PApV cix1 _ segs1) (PApV cix2 _ segs2) = + cix1 == cix2 + && eqValList segs1 segs2 + eqc (CapV k1 a1 vs1) (CapV k2 a2 vs2) = + eqK k1 k2 + && a1 == a2 + && eqValList vs1 vs2 + eqc (Foreign fl) (Foreign fr) + | Just al <- maybeUnwrapForeign @(PA.Array Val) Rf.iarrayRef fl, + Just ar <- maybeUnwrapForeign @(PA.Array Val) Rf.iarrayRef fr = + arrayEq eqVal al ar + | Just sl <- maybeUnwrapForeign @(Seq Val) Rf.listRef fl, + Just sr <- maybeUnwrapForeign @(Seq Val) Rf.listRef fr = + length sl == length sr && and (Sq.zipWith eqVal sl sr) + | otherwise = frn fl fr + eqc c d = closureNum c == closureNum d + + eqValList :: [Val] -> [Val] -> Bool + eqValList vs1 vs2 = eql eqVal vs1 vs2 + + eqK :: K -> K -> Bool + eqK KE KE = True + eqK (CB cb) (CB cb') = cb == cb' + eqK (Mark a ps m k) (Mark a' ps' m' k') = + a == a' && ps == ps' && liftEq eqVal m m' && eqK k k' + eqK (Push f a ci _ _sect k) (Push f' a' ci' _ _sect' k') = + f == f' && a == a' && ci == ci' && eqK k k' + eqK _ _ = False + +-- serialization doesn't necessarily preserve Int tags, so be +-- more accepting for those. +matchTags :: PackedTag -> PackedTag -> Bool +matchTags ct1 ct2 = + ct1 == ct2 + || (ct1 == TT.intTag && ct2 == TT.natTag) + || (ct1 == TT.natTag && ct2 == TT.intTag) + +-- serialization doesn't necessarily preserve Int tags, so be +-- more accepting for those. +matchUnboxedTypes :: UnboxedTypeTag -> UnboxedTypeTag -> Bool +matchUnboxedTypes ct1 ct2 = + ct1 == ct2 + || (ct1 == IntTag && ct2 == NatTag) + || (ct1 == NatTag && ct2 == IntTag) + +arrayEq :: (a -> a -> Bool) -> PA.Array a -> PA.Array a -> Bool +arrayEq eqc l r + | PA.sizeofArray l /= PA.sizeofArray r = False + | otherwise = go (PA.sizeofArray l - 1) + where + go i + | i < 0 = True + | otherwise = eqc (PA.indexArray l i) (PA.indexArray r i) && go (i - 1) + +-- IEEE floating point layout is such that comparison as integers +-- somewhat works. Positive floating values map to positive integers +-- and negatives map to negatives. The corner cases are: +-- +-- 1. If both numbers are negative, ordering is flipped. +-- 2. There is both +0 and -0, with -0 being represented as the +-- minimum signed integer. +-- 3. NaN does weird things. +-- +-- So, the strategy here is to compare normally if one argument is +-- positive, since positive numbers compare normally to others. +-- Otherwise, the sign bit is cleared and the numbers are compared +-- backwards. Clearing the sign bit maps -0 to +0 and maps a negative +-- number to its absolute value (including infinities). The multiple +-- NaN values are just handled according to bit patterns, rather than +-- IEEE specified behavior. +-- +-- Transitivity is somewhat non-obvious for this implementation. +-- +-- if i <= j and j <= k +-- if j > 0 then k > 0, so all 3 comparisons use `compare` +-- if k > 0 then k > i, since i <= j <= 0 +-- if all 3 are <= 0, all 3 comparisons use the alternate +-- comparison, which is transitive via `compare` +compareAsFloat :: Int -> Int -> Ordering +compareAsFloat i j + | i > 0 || j > 0 = compare i j + | otherwise = compare (clear j) (clear i) + where + clear k = clearBit k 64 + +universalCompare :: + (Foreign -> Foreign -> Ordering) -> + Val -> + Val -> + Ordering +universalCompare frn = cmpVal False + where + cmpVal :: Bool -> Val -> Val -> Ordering + cmpVal tyEq = \cases + (BoxedVal c1) (BoxedVal c2) -> cmpc tyEq c1 c2 + (UnboxedVal {}) (BoxedVal {}) -> LT + (BoxedVal {}) (UnboxedVal {}) -> GT + (NatVal i) (NatVal j) -> compare i j + (UnboxedVal v1 t1) (UnboxedVal v2 t2) -> cmpUnboxed tyEq (t1, v1) (t2, v2) + cmpl :: (a -> b -> Ordering) -> [a] -> [b] -> Ordering + cmpl cm l r = + compare (length l) (length r) <> fold (zipWith cm l r) + cmpc :: Bool -> Closure -> Closure -> Ordering + cmpc tyEq = \cases + (DataC rf1 ct1 vs1) (DataC rf2 ct2 vs2) -> + (if tyEq && ct1 /= ct2 then compare rf1 rf2 else EQ) + <> compare (maskTags ct1) (maskTags ct2) + -- when comparing corresponding `Any` values, which have + -- existentials inside check that type references match + <> cmpValList (tyEq || rf1 == Rf.anyRef) vs1 vs2 + (PApV cix1 _ segs1) (PApV cix2 _ segs2) -> + compare cix1 cix2 + <> cmpValList tyEq segs1 segs2 + (CapV k1 a1 vs1) (CapV k2 a2 vs2) -> + cmpK tyEq k1 k2 + <> compare a1 a2 + <> cmpValList True vs1 vs2 + (Foreign fl) (Foreign fr) + | Just sl <- maybeUnwrapForeign @(Seq Val) Rf.listRef fl, + Just sr <- maybeUnwrapForeign @(Seq Val) Rf.listRef fr -> + fold (Sq.zipWith (cmpVal tyEq) sl sr) + <> compare (length sl) (length sr) + | Just al <- maybeUnwrapForeign @(PA.Array Val) Rf.iarrayRef fl, + Just ar <- maybeUnwrapForeign @(PA.Array Val) Rf.iarrayRef fr -> + arrayCmp (cmpVal tyEq) al ar + | otherwise -> frn fl fr + (UnboxedTypeTag t1) (UnboxedTypeTag t2) -> compare t1 t2 + (BlackHole) (BlackHole) -> EQ + c d -> comparing closureNum c d + + cmpUnboxed :: Bool -> (UnboxedTypeTag, Int) -> (UnboxedTypeTag, Int) -> Ordering + cmpUnboxed tyEq = \cases + -- Need to cast to Nat or else maxNat == -1 and it flips comparisons of large Nats. + -- TODO: Investigate whether bit-twiddling is faster than using Haskell's fromIntegral. + (IntTag, n1) (IntTag, n2) -> compare n1 n2 + (NatTag, n1) (NatTag, n2) -> compare (fromIntegral n1 :: Word64) (fromIntegral n2 :: Word64) + (NatTag, n1) (IntTag, n2) + | n2 < 0 -> GT + | otherwise -> compare (fromIntegral n1 :: Word64) (fromIntegral n2 :: Word64) + (IntTag, n1) (NatTag, n2) + | n1 < 0 -> LT + | otherwise -> compare (fromIntegral n1 :: Word64) (fromIntegral n2 :: Word64) + (FloatTag, n1) (FloatTag, n2) -> compareAsFloat n1 n2 + (t1, v1) (t2, v2) -> + Monoid.whenM tyEq (compare t1 t2) + <> compare v1 v2 + + cmpValList :: Bool -> [Val] -> [Val] -> Ordering + cmpValList tyEq vs1 vs2 = cmpl (cmpVal tyEq) vs1 vs2 + + cmpK :: Bool -> K -> K -> Ordering + cmpK tyEq = \cases + KE KE -> EQ + (CB cb) (CB cb') -> compare cb cb' + (Mark a ps m k) (Mark a' ps' m' k') -> + compare a a' + <> compare ps ps' + <> liftCompare (cmpVal tyEq) m m' + <> cmpK tyEq k k' + (Push f a ci _ _sect k) (Push f' a' ci' _ _sect' k') -> + compare f f' + <> compare a a' + <> compare ci ci' + <> cmpK tyEq k k' + KE _ -> LT + _ KE -> GT + (CB {}) _ -> LT + _ (CB {}) -> GT + (Mark {}) _ -> LT + _ (Mark {}) -> GT + +arrayCmp :: + (a -> a -> Ordering) -> + PA.Array a -> + PA.Array a -> + Ordering +arrayCmp cmpVal l r = + comparing PA.sizeofArray l r <> go (PA.sizeofArray l - 1) + where + go i + | i < 0 = EQ + | otherwise = cmpVal (PA.indexArray l i) (PA.indexArray r i) <> go (i - 1) diff --git a/parser-typechecker/src/Unison/Runtime/Pattern.hs b/unison-runtime/src/Unison/Runtime/Pattern.hs similarity index 100% rename from parser-typechecker/src/Unison/Runtime/Pattern.hs rename to unison-runtime/src/Unison/Runtime/Pattern.hs diff --git a/unison-runtime/src/Unison/Runtime/Serialize.hs b/unison-runtime/src/Unison/Runtime/Serialize.hs new file mode 100644 index 0000000000..cd6cf61b0b --- /dev/null +++ b/unison-runtime/src/Unison/Runtime/Serialize.hs @@ -0,0 +1,559 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Unison.Runtime.Serialize where + +import Control.Monad (replicateM) +import Data.Bits (Bits) +import Data.ByteString qualified as B +import Data.Bytes.Get hiding (getBytes) +import Data.Bytes.Get qualified as Ser +import Data.Bytes.Put +import Data.Bytes.Serial +import Data.Bytes.Signed (Unsigned) +import Data.Bytes.VarInt +import Data.Foldable (traverse_) +import Data.Int (Int64) +import Data.Map.Strict as Map (Map, fromList, toList) +import Data.Text (Text) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Data.Vector.Primitive qualified as BA +import Data.Word (Word64, Word8) +import GHC.Exts as IL (IsList (..)) +import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..)) +import Unison.ConstructorType qualified as CT +import Unison.Hash (Hash) +import Unison.Hash qualified as Hash +import Unison.Reference (Id' (..), Reference, Reference' (Builtin, DerivedId), pattern Derived) +import Unison.Referent (Referent, pattern Con, pattern Ref) +import Unison.Runtime.Array qualified as PA +import Unison.Runtime.Exception +import Unison.Runtime.MCode + ( BPrim1 (..), + BPrim2 (..), + UPrim1 (..), + UPrim2 (..), + ) +import Unison.Util.Bytes qualified as Bytes +import Unison.Util.EnumContainers as EC + +unknownTag :: (MonadGet m) => String -> Word8 -> m a +unknownTag t w = + remaining >>= \r -> + exn $ + "unknown " + ++ t + ++ " word: " + ++ show w + ++ " (" + ++ show (fromIntegral @_ @Int r) + ++ " bytes remaining)" + +class Tag t where + tag2word :: t -> Word8 + word2tag :: (MonadGet m) => Word8 -> m t + +putTag :: (MonadPut m) => (Tag t) => t -> m () +putTag = putWord8 . tag2word + +getTag :: (MonadGet m) => (Tag t) => m t +getTag = word2tag =<< getWord8 + +-- Some basics, moved over from V1 serialization +putChar :: (MonadPut m) => Char -> m () +putChar = serialize . VarInt . fromEnum + +getChar :: (MonadGet m) => m Char +getChar = toEnum . unVarInt <$> deserialize + +putFloat :: (MonadPut m) => Double -> m () +putFloat = serializeBE + +getFloat :: (MonadGet m) => m Double +getFloat = deserializeBE + +putBool :: (MonadPut m) => Bool -> m () +putBool b = putWord8 (if b then 1 else 0) + +getBool :: (MonadGet m) => m Bool +getBool = d =<< getWord8 + where + d 0 = pure False + d 1 = pure True + d n = exn $ "getBool: bad tag: " ++ show n + +putNat :: (MonadPut m) => Word64 -> m () +putNat = putWord64be + +getNat :: (MonadGet m) => m Word64 +getNat = getWord64be + +putInt :: (MonadPut m) => Int64 -> m () +putInt = serializeBE + +getInt :: (MonadGet m) => m Int64 +getInt = deserializeBE + +putLength :: + ( MonadPut m, + Integral n, + Integral (Unsigned n), + Bits n, + Bits (Unsigned n) + ) => + n -> + m () +putLength = serialize . VarInt + +getLength :: + ( MonadGet m, + Integral n, + Integral (Unsigned n), + Bits n, + Bits (Unsigned n) + ) => + m n +getLength = unVarInt <$> deserialize + +-- Checks for negatives, in case you put an Integer, which does not +-- behave properly for negative numbers. +putPositive :: + (MonadPut m, Bits n, Bits (Unsigned n), Integral n, Integral (Unsigned n)) => + n -> + m () +putPositive n + | n < 0 = exn $ "putPositive: negative number: " ++ show (toInteger n) + | otherwise = serialize (VarInt n) + +-- Reads as an Integer, then checks that the result will fit in the +-- result type. +getPositive :: forall m n. (Bounded n, Integral n, MonadGet m) => m n +getPositive = validate . unVarInt =<< deserialize + where + mx0 :: n + mx0 = maxBound + mx :: Integer + mx = fromIntegral mx0 + + validate :: Integer -> m n + validate n + | n <= mx = pure $ fromIntegral n + | otherwise = fail $ "getPositive: overflow: " ++ show n + +putFoldable :: + (Foldable f, MonadPut m) => (a -> m ()) -> f a -> m () +putFoldable putA as = do + putLength (length as) + traverse_ putA as + +putMap :: (MonadPut m) => (a -> m ()) -> (b -> m ()) -> Map a b -> m () +putMap putA putB m = putFoldable (putPair putA putB) (Map.toList m) + +getList :: (MonadGet m) => m a -> m [a] +getList a = getLength >>= (`replicateM` a) + +getMap :: (MonadGet m, Ord a) => m a -> m b -> m (Map a b) +getMap getA getB = Map.fromList <$> getList (getPair getA getB) + +putEnumMap :: + (MonadPut m) => + (EnumKey k) => + (k -> m ()) -> + (v -> m ()) -> + EnumMap k v -> + m () +putEnumMap pk pv m = putFoldable (putPair pk pv) (mapToList m) + +getEnumMap :: (MonadGet m) => (EnumKey k) => m k -> m v -> m (EnumMap k v) +getEnumMap gk gv = mapFromList <$> getList (getPair gk gv) + +putEnumSet :: (MonadPut m) => (EnumKey k) => (k -> m ()) -> EnumSet k -> m () +putEnumSet pk s = putLength (setSize s) *> traverseSet_ pk s + +getEnumSet :: (MonadGet m) => (EnumKey k) => m k -> m (EnumSet k) +getEnumSet gk = setFromList <$> getList gk + +putMaybe :: (MonadPut m) => Maybe a -> (a -> m ()) -> m () +putMaybe Nothing _ = putWord8 0 +putMaybe (Just a) putA = putWord8 1 *> putA a + +getMaybe :: (MonadGet m) => m a -> m (Maybe a) +getMaybe getA = + getWord8 >>= \tag -> case tag of + 0 -> pure Nothing + 1 -> Just <$> getA + _ -> unknownTag "Maybe" tag + +putPair :: (MonadPut m) => (a -> m ()) -> (b -> m ()) -> (a, b) -> m () +putPair putA putB (a, b) = putA a *> putB b + +getPair :: (MonadGet m) => m a -> m b -> m (a, b) +getPair = liftA2 (,) + +getBytes :: (MonadGet m) => m Bytes.Bytes +getBytes = Bytes.fromChunks <$> getList getBlock + +putBytes :: (MonadPut m) => Bytes.Bytes -> m () +putBytes = putFoldable putBlock . Bytes.chunks + +getByteArray :: (MonadGet m) => m PA.ByteArray +getByteArray = PA.byteArrayFromList <$> getList getWord8 + +putByteArray :: (MonadPut m) => PA.ByteArray -> m () +putByteArray a = putFoldable putWord8 (IL.toList a) + +getArray :: (MonadGet m) => m a -> m (PA.Array a) +getArray getThing = PA.arrayFromList <$> getList getThing + +putArray :: (MonadPut m) => (a -> m ()) -> PA.Array a -> m () +putArray putThing a = putFoldable putThing (IL.toList a) + +getBlock :: (MonadGet m) => m Bytes.Chunk +getBlock = getLength >>= fmap Bytes.byteStringToChunk . getByteString + +putBlock :: (MonadPut m) => Bytes.Chunk -> m () +putBlock b = putLength (BA.length b) *> putByteString (Bytes.chunkToByteString b) + +putHash :: (MonadPut m) => Hash -> m () +putHash h = do + let bs = Hash.toByteString h + putLength (B.length bs) + putByteString bs + +getHash :: (MonadGet m) => m Hash +getHash = do + len <- getLength + bs <- B.copy <$> Ser.getBytes len + pure $ Hash.fromByteString bs + +putReferent :: (MonadPut m) => Referent -> m () +putReferent = \case + Ref r -> do + putWord8 0 + putReference r + Con r ct -> do + putWord8 1 + putConstructorReference r + putConstructorType ct + +getReferent :: (MonadGet m) => m Referent +getReferent = do + tag <- getWord8 + case tag of + 0 -> Ref <$> getReference + 1 -> Con <$> getConstructorReference <*> getConstructorType + _ -> unknownTag "getReferent" tag + +getConstructorType :: (MonadGet m) => m CT.ConstructorType +getConstructorType = + getWord8 >>= \case + 0 -> pure CT.Data + 1 -> pure CT.Effect + t -> unknownTag "getConstructorType" t + +putConstructorType :: (MonadPut m) => CT.ConstructorType -> m () +putConstructorType = \case + CT.Data -> putWord8 0 + CT.Effect -> putWord8 1 + +putText :: (MonadPut m) => Text -> m () +putText text = do + let bs = encodeUtf8 text + putLength $ B.length bs + putByteString bs + +getText :: (MonadGet m) => m Text +getText = do + len <- getLength + bs <- B.copy <$> Ser.getBytes len + pure $ decodeUtf8 bs + +putReference :: (MonadPut m) => Reference -> m () +putReference r = case r of + Builtin name -> do + putWord8 0 + putText name + Derived hash i -> do + putWord8 1 + putHash hash + putLength i + +getReference :: (MonadGet m) => m Reference +getReference = do + tag <- getWord8 + case tag of + 0 -> Builtin <$> getText + 1 -> DerivedId <$> (Id <$> getHash <*> getLength) + _ -> unknownTag "Reference" tag + +putConstructorReference :: (MonadPut m) => ConstructorReference -> m () +putConstructorReference (ConstructorReference r i) = do + putReference r + putLength i + +getConstructorReference :: (MonadGet m) => m ConstructorReference +getConstructorReference = + ConstructorReference <$> getReference <*> getLength + +instance Tag UPrim1 where + tag2word DECI = 0 + tag2word DECN = 1 + tag2word INCI = 2 + tag2word INCN = 3 + tag2word NEGI = 4 + tag2word SGNI = 5 + tag2word LZRO = 6 + tag2word TZRO = 7 + tag2word COMN = 8 + tag2word COMI = 9 + tag2word POPC = 10 + tag2word ABSF = 11 + tag2word EXPF = 12 + tag2word LOGF = 13 + tag2word SQRT = 14 + tag2word COSF = 15 + tag2word ACOS = 16 + tag2word COSH = 17 + tag2word ACSH = 18 + tag2word SINF = 19 + tag2word ASIN = 20 + tag2word SINH = 21 + tag2word ASNH = 22 + tag2word TANF = 23 + tag2word ATAN = 24 + tag2word TANH = 25 + tag2word ATNH = 26 + tag2word ITOF = 27 + tag2word NTOF = 28 + tag2word CEIL = 29 + tag2word FLOR = 30 + tag2word TRNF = 31 + tag2word RNDF = 32 + + word2tag 0 = pure DECI + word2tag 1 = pure DECN + word2tag 2 = pure INCI + word2tag 3 = pure INCN + word2tag 4 = pure NEGI + word2tag 5 = pure SGNI + word2tag 6 = pure LZRO + word2tag 7 = pure TZRO + word2tag 8 = pure COMN + word2tag 9 = pure COMI + word2tag 10 = pure POPC + word2tag 11 = pure ABSF + word2tag 12 = pure EXPF + word2tag 13 = pure LOGF + word2tag 14 = pure SQRT + word2tag 15 = pure COSF + word2tag 16 = pure ACOS + word2tag 17 = pure COSH + word2tag 18 = pure ACSH + word2tag 19 = pure SINF + word2tag 20 = pure ASIN + word2tag 21 = pure SINH + word2tag 22 = pure ASNH + word2tag 23 = pure TANF + word2tag 24 = pure ATAN + word2tag 25 = pure TANH + word2tag 26 = pure ATNH + word2tag 27 = pure ITOF + word2tag 28 = pure NTOF + word2tag 29 = pure CEIL + word2tag 30 = pure FLOR + word2tag 31 = pure TRNF + word2tag 32 = pure RNDF + word2tag n = unknownTag "UPrim1" n + +instance Tag UPrim2 where + tag2word ADDI = 0 + tag2word ADDN = 1 + tag2word SUBI = 2 + tag2word SUBN = 3 + tag2word MULI = 4 + tag2word MULN = 5 + tag2word DIVI = 6 + tag2word MODI = 7 + tag2word DIVN = 8 + tag2word MODN = 9 + tag2word SHLI = 10 + tag2word SHLN = 11 + tag2word SHRI = 12 + tag2word SHRN = 13 + tag2word POWI = 14 + tag2word POWN = 15 + tag2word EQLI = 16 + tag2word EQLN = 17 + tag2word LEQI = 18 + tag2word LEQN = 19 + tag2word ANDN = 20 + tag2word ANDI = 21 + tag2word IORN = 22 + tag2word IORI = 23 + tag2word XORN = 24 + tag2word XORI = 25 + tag2word EQLF = 26 + tag2word LEQF = 27 + tag2word ADDF = 28 + tag2word SUBF = 29 + tag2word MULF = 30 + tag2word DIVF = 31 + tag2word ATN2 = 32 + tag2word POWF = 33 + tag2word LOGB = 34 + tag2word MAXF = 35 + tag2word MINF = 36 + tag2word CAST = 37 + + word2tag 0 = pure ADDI + word2tag 1 = pure ADDN + word2tag 2 = pure SUBI + word2tag 3 = pure SUBN + word2tag 4 = pure MULI + word2tag 5 = pure MULN + word2tag 6 = pure DIVI + word2tag 7 = pure MODI + word2tag 8 = pure DIVN + word2tag 9 = pure MODN + word2tag 10 = pure SHLI + word2tag 11 = pure SHLN + word2tag 12 = pure SHRI + word2tag 13 = pure SHRN + word2tag 14 = pure POWI + word2tag 15 = pure POWN + word2tag 16 = pure EQLI + word2tag 17 = pure EQLN + word2tag 18 = pure LEQI + word2tag 19 = pure LEQN + word2tag 20 = pure ANDN + word2tag 21 = pure ANDI + word2tag 22 = pure IORN + word2tag 23 = pure IORI + word2tag 24 = pure XORN + word2tag 25 = pure XORI + word2tag 26 = pure EQLF + word2tag 27 = pure LEQF + word2tag 28 = pure ADDF + word2tag 29 = pure SUBF + word2tag 30 = pure MULF + word2tag 31 = pure DIVF + word2tag 32 = pure ATN2 + word2tag 33 = pure POWF + word2tag 34 = pure LOGB + word2tag 35 = pure MAXF + word2tag 36 = pure MINF + word2tag 37 = pure CAST + word2tag n = unknownTag "UPrim2" n + +instance Tag BPrim1 where + tag2word SIZT = 0 + tag2word USNC = 1 + tag2word UCNS = 2 + tag2word ITOT = 3 + tag2word NTOT = 4 + tag2word FTOT = 5 + tag2word TTOI = 6 + tag2word TTON = 7 + tag2word TTOF = 8 + tag2word PAKT = 9 + tag2word UPKT = 10 + tag2word VWLS = 11 + tag2word VWRS = 12 + tag2word SIZS = 13 + tag2word PAKB = 14 + tag2word UPKB = 15 + tag2word SIZB = 16 + tag2word FLTB = 17 + tag2word MISS = 18 + tag2word CACH = 19 + tag2word LKUP = 20 + tag2word LOAD = 21 + tag2word CVLD = 22 + tag2word VALU = 23 + tag2word TLTT = 24 + tag2word DBTX = 25 + tag2word SDBL = 26 + + word2tag 0 = pure SIZT + word2tag 1 = pure USNC + word2tag 2 = pure UCNS + word2tag 3 = pure ITOT + word2tag 4 = pure NTOT + word2tag 5 = pure FTOT + word2tag 6 = pure TTOI + word2tag 7 = pure TTON + word2tag 8 = pure TTOF + word2tag 9 = pure PAKT + word2tag 10 = pure UPKT + word2tag 11 = pure VWLS + word2tag 12 = pure VWRS + word2tag 13 = pure SIZS + word2tag 14 = pure PAKB + word2tag 15 = pure UPKB + word2tag 16 = pure SIZB + word2tag 17 = pure FLTB + word2tag 18 = pure MISS + word2tag 19 = pure CACH + word2tag 20 = pure LKUP + word2tag 21 = pure LOAD + word2tag 22 = pure CVLD + word2tag 23 = pure VALU + word2tag 24 = pure TLTT + word2tag 25 = pure DBTX + word2tag 26 = pure SDBL + word2tag n = unknownTag "BPrim1" n + +instance Tag BPrim2 where + tag2word EQLU = 0 + tag2word CMPU = 1 + tag2word DRPT = 2 + tag2word CATT = 3 + tag2word TAKT = 4 + tag2word EQLT = 5 + tag2word LEQT = 6 + tag2word LEST = 7 + tag2word DRPS = 8 + tag2word CATS = 9 + tag2word TAKS = 10 + tag2word CONS = 11 + tag2word SNOC = 12 + tag2word IDXS = 13 + tag2word SPLL = 14 + tag2word SPLR = 15 + tag2word TAKB = 16 + tag2word DRPB = 17 + tag2word IDXB = 18 + tag2word CATB = 19 + tag2word THRO = 20 + tag2word TRCE = 21 + tag2word SDBX = 22 + tag2word IXOT = 23 + tag2word IXOB = 24 + tag2word SDBV = 25 + + word2tag 0 = pure EQLU + word2tag 1 = pure CMPU + word2tag 2 = pure DRPT + word2tag 3 = pure CATT + word2tag 4 = pure TAKT + word2tag 5 = pure EQLT + word2tag 6 = pure LEQT + word2tag 7 = pure LEST + word2tag 8 = pure DRPS + word2tag 9 = pure CATS + word2tag 10 = pure TAKS + word2tag 11 = pure CONS + word2tag 12 = pure SNOC + word2tag 13 = pure IDXS + word2tag 14 = pure SPLL + word2tag 15 = pure SPLR + word2tag 16 = pure TAKB + word2tag 17 = pure DRPB + word2tag 18 = pure IDXB + word2tag 19 = pure CATB + word2tag 20 = pure THRO + word2tag 21 = pure TRCE + word2tag 22 = pure SDBX + word2tag 23 = pure IXOT + word2tag 24 = pure IXOB + word2tag 25 = pure SDBV + word2tag n = unknownTag "BPrim2" n diff --git a/parser-typechecker/src/Unison/Runtime/SparseVector.hs b/unison-runtime/src/Unison/Runtime/SparseVector.hs similarity index 100% rename from parser-typechecker/src/Unison/Runtime/SparseVector.hs rename to unison-runtime/src/Unison/Runtime/SparseVector.hs diff --git a/unison-runtime/src/Unison/Runtime/Stack.hs b/unison-runtime/src/Unison/Runtime/Stack.hs new file mode 100644 index 0000000000..ebc9ef33dd --- /dev/null +++ b/unison-runtime/src/Unison/Runtime/Stack.hs @@ -0,0 +1,1175 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} + +module Unison.Runtime.Stack + ( K (..), + GClosure (..), + Closure + ( .., + DataC, + PApV, + CapV, + PAp, + Enum, + Data1, + Data2, + DataG, + Captured, + Foreign, + BlackHole, + UnboxedTypeTag + ), + UnboxedTypeTag (..), + unboxedTypeTagToInt, + unboxedTypeTagFromInt, + IxClosure, + Callback (..), + Augment (..), + Dump (..), + Stack (..), + Off, + SZ, + FP, + Seg, + USeg, + BSeg, + SegList, + Val + ( .., + CharVal, + NatVal, + DoubleVal, + IntVal, + UnboxedVal, + BoxedVal + ), + emptyVal, + boxedVal, + USeq, + traceK, + frameDataSize, + marshalToForeign, + unull, + bnull, + nullSeg, + peekD, + peekOffD, + peekC, + peekOffC, + poke, + pokeD, + pokeOffD, + pokeC, + pokeOffC, + pokeBool, + pokeTag, + peekTag, + peekTagOff, + peekI, + peekOffI, + peekN, + peekOffN, + pokeN, + pokeOffN, + pokeI, + pokeOffI, + pokeByte, + peekBi, + peekOffBi, + pokeBi, + pokeOffBi, + peekOffS, + pokeS, + pokeOffS, + frameView, + scount, + closureTermRefs, + dumpAP, + dumpFP, + alloc, + peek, + upeek, + bpeek, + peekOff, + upeekOff, + bpeekOff, + bpoke, + bpokeOff, + pokeOff, + upokeT, + upokeOffT, + unsafePokeIasN, + bump, + bumpn, + grab, + ensure, + duplicate, + discardFrame, + saveFrame, + saveArgs, + restoreFrame, + prepareArgs, + acceptArgs, + frameArgs, + augSeg, + dumpSeg, + adjustArgs, + fsize, + asize, + + -- * Unboxed type tags + natTypeTag, + intTypeTag, + charTypeTag, + floatTypeTag, + ) +where + +import Control.Monad.Primitive +import Data.Char qualified as Char +import Data.Kind (Constraint) +import Data.Primitive (sizeOf) +import Data.Primitive.ByteArray qualified as BA +import Data.Word +import GHC.Exts as L (IsList (..)) +import Unison.Prelude +import Unison.Reference (Reference) +import Unison.Runtime.ANF (PackedTag) +import Unison.Runtime.Array +import Unison.Runtime.Foreign +import Unison.Runtime.MCode +import Unison.Type qualified as Ty +import Unison.Util.EnumContainers as EC +import Prelude hiding (words) + +{- ORMOLU_DISABLE -} +#ifdef STACK_CHECK +import Data.Text.IO (hPutStrLn) +import UnliftIO (stderr, throwIO) +import GHC.Stack (CallStack, callStack) + +type DebugCallStack = (HasCallStack :: Constraint) + +unboxedSentinel :: Int +unboxedSentinel = -99 + +boxedSentinel :: Closure +boxedSentinel = (Closure GUnboxedSentinel) + +assertBumped :: HasCallStack => Stack -> Off -> IO () +assertBumped (Stack _ _ sp ustk bstk) i = do + u <- readByteArray ustk (sp - i) + b :: BVal <- readArray bstk (sp - i) + when (u /= unboxedSentinel || not (isBoxedSentinel b)) do + error $ "Expected stack slot to have been bumped, but it was:" <> show (Val u b) + where + isBoxedSentinel :: Closure -> Bool + isBoxedSentinel (Closure GUnboxedSentinel) = True + isBoxedSentinel _ = False + +assertUnboxed :: HasCallStack => Stack -> Off -> IO () +assertUnboxed (Stack _ _ sp ustk bstk) i = do + (u :: Int) <- readByteArray ustk (sp - i) + b <- readArray bstk (sp - i) + case b of + UnboxedTypeTag _ -> pure () + _ -> error $ "Expected stack val to be unboxed, but it was:" <> show (Val u b) + +pokeSentinelOff :: Stack -> Off -> IO () +pokeSentinelOff (Stack _ _ sp ustk bstk) off = do + writeByteArray ustk (sp - off) unboxedSentinel + writeArray bstk (sp - off) boxedSentinel +#else +-- Don't track callstacks in production, it's expensive +type DebugCallStack = (() :: Constraint) +#endif +{- ORMOLU_ENABLE -} + +newtype Callback = Hook (Stack -> IO ()) + +instance Eq Callback where _ == _ = True + +instance Ord Callback where compare _ _ = EQ + +-- Evaluation stack +data K + = KE + | -- callback hook + CB Callback + | -- mark continuation with a prompt + Mark + !Int -- pending args + !(EnumSet Word64) + !(EnumMap Word64 Val) + !K + | -- save information about a frame for later resumption + Push + !Int -- frame size + !Int -- pending args + !CombIx -- resumption section reference + !Int -- stack guard + !(RSection Val) -- resumption section + !K + +newtype Closure = Closure {unClosure :: (GClosure (RComb Val))} + deriving stock (Show) + +-- | Implementation for Unison sequences. +type USeq = Seq Val + +type IxClosure = GClosure CombIx + +-- Don't re-order these, the ord instance affects Universal.compare +data UnboxedTypeTag + = CharTag + | FloatTag + | IntTag + | NatTag + deriving stock (Show, Eq, Ord) + +unboxedTypeTagToInt :: UnboxedTypeTag -> Int +unboxedTypeTagToInt = \case + CharTag -> 0 + FloatTag -> 1 + IntTag -> 2 + NatTag -> 3 + +unboxedTypeTagFromInt :: (HasCallStack) => Int -> UnboxedTypeTag +unboxedTypeTagFromInt = \case + 0 -> CharTag + 1 -> FloatTag + 2 -> IntTag + 3 -> NatTag + _ -> error "intToUnboxedTypeTag: invalid tag" + +{- ORMOLU_DISABLE -} +data GClosure comb + = GPAp + !CombIx + {-# UNPACK #-} !(GCombInfo comb) + {-# UNPACK #-} !Seg -- args + | GEnum !Reference !PackedTag + | GData1 !Reference !PackedTag !Val + | GData2 !Reference !PackedTag !Val !Val + | GDataG !Reference !PackedTag {-# UNPACK #-} !Seg + | -- code cont, arg size, u/b data stacks + GCaptured !K !Int {-# UNPACK #-} !Seg + | GForeign !Foreign + | -- The type tag for the value in the corresponding unboxed stack slot. + -- We should consider adding separate constructors for common builtin type tags. + -- GHC will optimize nullary constructors into singletons. + GUnboxedTypeTag !UnboxedTypeTag + | GBlackHole +#ifdef STACK_CHECK + | GUnboxedSentinel +#endif + deriving stock (Show, Functor, Foldable, Traversable) +{- ORMOLU_ENABLE -} + +pattern PAp :: CombIx -> GCombInfo (RComb Val) -> Seg -> Closure +pattern PAp cix comb seg = Closure (GPAp cix comb seg) + +pattern Enum :: Reference -> PackedTag -> Closure +pattern Enum r t = Closure (GEnum r t) + +pattern Data1 r t i = Closure (GData1 r t i) + +pattern Data2 r t i j = Closure (GData2 r t i j) + +pattern DataG r t seg = Closure (GDataG r t seg) + +pattern Captured k a seg = Closure (GCaptured k a seg) + +pattern Foreign x = Closure (GForeign x) + +pattern BlackHole = Closure GBlackHole + +pattern UnboxedTypeTag t <- Closure (GUnboxedTypeTag t) + where + UnboxedTypeTag t = case t of + CharTag -> charTypeTag + FloatTag -> floatTypeTag + IntTag -> intTypeTag + NatTag -> natTypeTag + +{-# COMPLETE PAp, Enum, Data1, Data2, DataG, Captured, Foreign, UnboxedTypeTag, BlackHole #-} + +{-# COMPLETE DataC, PAp, Captured, Foreign, BlackHole, UnboxedTypeTag #-} + +{-# COMPLETE DataC, PApV, Captured, Foreign, BlackHole, UnboxedTypeTag #-} + +{-# COMPLETE DataC, PApV, CapV, Foreign, BlackHole, UnboxedTypeTag #-} + +-- We can avoid allocating a closure for common type tags on each poke by having shared top-level closures for them. +natTypeTag :: Closure +natTypeTag = (Closure (GUnboxedTypeTag NatTag)) +{-# NOINLINE natTypeTag #-} + +intTypeTag :: Closure +intTypeTag = (Closure (GUnboxedTypeTag IntTag)) +{-# NOINLINE intTypeTag #-} + +charTypeTag :: Closure +charTypeTag = (Closure (GUnboxedTypeTag CharTag)) +{-# NOINLINE charTypeTag #-} + +floatTypeTag :: Closure +floatTypeTag = (Closure (GUnboxedTypeTag FloatTag)) +{-# NOINLINE floatTypeTag #-} + +traceK :: Reference -> K -> [(Reference, Int)] +traceK begin = dedup (begin, 1) + where + dedup p (Mark _ _ _ k) = dedup p k + dedup p@(cur, n) (Push _ _ (CIx r _ _) _ _ k) + | cur == r = dedup (cur, 1 + n) k + | otherwise = p : dedup (r, 1) k + dedup p _ = [p] + +splitData :: Closure -> Maybe (Reference, PackedTag, SegList) +splitData = \case + (Enum r t) -> Just (r, t, []) + (Data1 r t u) -> Just (r, t, [u]) + (Data2 r t i j) -> Just (r, t, [i, j]) + (DataG r t seg) -> Just (r, t, segToList seg) + _ -> Nothing + +-- | Converts a list of integers representing an unboxed segment back into the +-- appropriate segment. Segments are stored backwards in the runtime, so this +-- reverses the list. +useg :: [Int] -> USeg +useg ws = case L.fromList $ reverse ws of + PrimArray ba -> ByteArray ba + +-- | Converts a boxed segment to a list of closures. The segments are stored +-- backwards, so this reverses the contents. +bsegToList :: BSeg -> [Closure] +bsegToList = reverse . L.toList + +-- | Converts a list of closures back to a boxed segment. Segments are stored +-- backwards, so this reverses the contents. +bseg :: [Closure] -> BSeg +bseg = L.fromList . reverse + +formData :: Reference -> PackedTag -> SegList -> Closure +formData r t [] = Enum r t +formData r t [v1] = Data1 r t v1 +formData r t [v1, v2] = Data2 r t v1 v2 +formData r t segList = DataG r t (segFromList segList) + +frameDataSize :: K -> Int +frameDataSize = go 0 + where + go sz KE = sz + go sz (CB _) = sz + go sz (Mark a _ _ k) = go (sz + a) k + go sz (Push f a _ _ _ k) = + go (sz + f + a) k + +pattern DataC :: Reference -> PackedTag -> SegList -> Closure +pattern DataC rf ct segs <- + (splitData -> Just (rf, ct, segs)) + where + DataC rf ct segs = formData rf ct segs + +matchCharVal :: Val -> Maybe Char +matchCharVal = \case + (UnboxedVal u CharTag) -> Just (Char.chr u) + _ -> Nothing + +pattern CharVal :: Char -> Val +pattern CharVal c <- (matchCharVal -> Just c) + where + CharVal c = Val (Char.ord c) charTypeTag + +matchNatVal :: Val -> Maybe Word64 +matchNatVal = \case + (UnboxedVal u NatTag) -> Just (fromIntegral u) + _ -> Nothing + +pattern NatVal :: Word64 -> Val +pattern NatVal n <- (matchNatVal -> Just n) + where + NatVal n = Val (fromIntegral n) natTypeTag + +matchDoubleVal :: Val -> Maybe Double +matchDoubleVal = \case + (UnboxedVal u FloatTag) -> Just (intToDouble u) + _ -> Nothing + +pattern DoubleVal :: Double -> Val +pattern DoubleVal d <- (matchDoubleVal -> Just d) + where + DoubleVal d = Val (doubleToInt d) floatTypeTag + +matchIntVal :: Val -> Maybe Int +matchIntVal = \case + (UnboxedVal u IntTag) -> Just u + _ -> Nothing + +pattern IntVal :: Int -> Val +pattern IntVal i <- (matchIntVal -> Just i) + where + IntVal i = Val i intTypeTag + +doubleToInt :: Double -> Int +doubleToInt d = indexByteArray (BA.byteArrayFromList [d]) 0 +{-# INLINE doubleToInt #-} + +intToDouble :: Int -> Double +intToDouble w = indexByteArray (BA.byteArrayFromList [w]) 0 +{-# INLINE intToDouble #-} + +type SegList = [Val] + +pattern PApV :: CombIx -> RCombInfo Val -> SegList -> Closure +pattern PApV cix rcomb segs <- + PAp cix rcomb (segToList -> segs) + where + PApV cix rcomb segs = PAp cix rcomb (segFromList segs) + +pattern CapV :: K -> Int -> SegList -> Closure +pattern CapV k a segs <- Captured k a (segToList -> segs) + where + CapV k a segList = Captured k a (segFromList segList) + +-- | Converts from the efficient stack form of a segment to the list representation. Segments are stored backwards, +-- so this reverses the contents +segToList :: Seg -> SegList +segToList (u, b) = + zipWith Val (ints u) (bsegToList b) + +-- | Converts an unboxed segment to a list of integers for a more interchangeable +-- representation. The segments are stored in backwards order, so this reverses +-- the contents. +ints :: ByteArray -> [Int] +ints ba = fmap (indexByteArray ba) [n - 1, n - 2 .. 0] + where + n = sizeofByteArray ba `div` 8 + +-- | Converts from the list representation of a segment to the efficient stack form. Segments are stored backwards, +-- so this reverses the contents. +segFromList :: SegList -> Seg +segFromList xs = + xs + & foldMap + ( \(Val unboxed boxed) -> ([unboxed], [boxed]) + ) + & \(us, bs) -> (useg us, bseg bs) + +marshalToForeign :: (HasCallStack) => Closure -> Foreign +marshalToForeign (Foreign x) = x +marshalToForeign c = + error $ "marshalToForeign: unhandled closure: " ++ show c + +type Off = Int + +type SZ = Int + +type FP = Int + +type UA = MutableByteArray (PrimState IO) + +type BA = MutableArray (PrimState IO) Closure + +intSize :: Int +intSize = sizeOf (0 :: Int) + +words :: Int -> Int +words n = n `div` intSize + +bytes :: Int -> Int +bytes n = n * intSize + +type Arrs = (UA, BA) + +argOnto :: Arrs -> Off -> Arrs -> Off -> Args' -> IO Int +argOnto (srcUstk, srcBstk) srcSp (dstUstk, dstBstk) dstSp args = do + -- Both new cp's should be the same, so we can just return one. + _cp <- uargOnto srcUstk srcSp dstUstk dstSp args + cp <- bargOnto srcBstk srcSp dstBstk dstSp args + pure cp + +-- The Caller must ensure that when setting the unboxed stack, the equivalent +-- boxed stack is zeroed out to BlackHole where necessary. +uargOnto :: UA -> Off -> UA -> Off -> Args' -> IO Int +uargOnto stk sp cop cp0 (Arg1 i) = do + (x :: Int) <- readByteArray stk (sp - i) + writeByteArray cop cp x + pure cp + where + cp = cp0 + 1 +uargOnto stk sp cop cp0 (Arg2 i j) = do + (x :: Int) <- readByteArray stk (sp - i) + (y :: Int) <- readByteArray stk (sp - j) + writeByteArray cop cp x + writeByteArray cop (cp - 1) y + pure cp + where + cp = cp0 + 2 +uargOnto stk sp cop cp0 (ArgN v) = do + buf <- + if overwrite + then newByteArray $ bytes sz + else pure cop + let loop i + | i < 0 = return () + | otherwise = do + (x :: Int) <- readByteArray stk (sp - indexPrimArray v i) + writeByteArray buf (boff - i) x + loop $ i - 1 + loop $ sz - 1 + when overwrite $ + copyMutableByteArray cop (bytes $ cp0 + 1) buf 0 (bytes sz) + pure cp + where + cp = cp0 + sz + sz = sizeofPrimArray v + overwrite = sameMutableByteArray stk cop + boff | overwrite = sz - 1 | otherwise = cp0 + sz +uargOnto stk sp cop cp0 (ArgR i l) = do + moveByteArray cop cbp stk sbp (bytes l) + pure $ cp0 + l + where + cbp = bytes $ cp0 + 1 + sbp = bytes $ sp - i - l + 1 + +bargOnto :: BA -> Off -> BA -> Off -> Args' -> IO Int +bargOnto stk sp cop cp0 (Arg1 i) = do + x <- readArray stk (sp - i) + writeArray cop cp x + pure cp + where + cp = cp0 + 1 +bargOnto stk sp cop cp0 (Arg2 i j) = do + x <- readArray stk (sp - i) + y <- readArray stk (sp - j) + writeArray cop cp x + writeArray cop (cp - 1) y + pure cp + where + cp = cp0 + 2 +bargOnto stk sp cop cp0 (ArgN v) = do + buf <- + if overwrite + then newArray sz $ BlackHole + else pure cop + let loop i + | i < 0 = return () + | otherwise = do + x <- readArray stk $ sp - indexPrimArray v i + writeArray buf (boff - i) x + loop $ i - 1 + loop $ sz - 1 + + when overwrite $ + copyMutableArray cop (cp0 + 1) buf 0 sz + pure cp + where + cp = cp0 + sz + sz = sizeofPrimArray v + overwrite = stk == cop + boff | overwrite = sz - 1 | otherwise = cp0 + sz +bargOnto stk sp cop cp0 (ArgR i l) = do + copyMutableArray cop (cp0 + 1) stk (sp - i - l + 1) l + pure $ cp0 + l + +data Dump = A | F Int Int | S + +dumpAP :: Int -> Int -> Int -> Dump -> Int +dumpAP _ fp sz d@(F _ a) = dumpFP fp sz d - a +dumpAP ap _ _ _ = ap + +dumpFP :: Int -> Int -> Dump -> Int +dumpFP fp _ S = fp +dumpFP fp sz A = fp + sz +dumpFP fp sz (F n _) = fp + sz - n + +-- closure augmentation mode +-- instruction, kontinuation, call +data Augment = I | K | C + +data Stack = Stack + { ap :: !Int, -- arg pointer + fp :: !Int, -- frame pointer + sp :: !Int, -- stack pointer + ustk :: {-# UNPACK #-} !(MutableByteArray (PrimState IO)), + bstk :: {-# UNPACK #-} !(MutableArray (PrimState IO) Closure) + } + +instance Show Stack where + show (Stack ap fp sp _ _) = + "Stack " ++ show ap ++ " " ++ show fp ++ " " ++ show sp + +type UVal = Int + +-- | A runtime value, which is either a boxed or unboxed value, but we may not know which. +data Val = Val {getUnboxedVal :: !UVal, getBoxedVal :: !BVal} + -- The Eq instance for Val is deliberately omitted because you need to take into account the fact that if a Val is boxed, the + -- unboxed side is garbage and should not be compared. + -- See universalEq. + deriving (Show) + +-- | A nulled out value you can use when filling empty arrays, etc. +emptyVal :: Val +emptyVal = Val (-1) BlackHole + +pattern UnboxedVal :: Int -> UnboxedTypeTag -> Val +pattern UnboxedVal v t = (Val v (UnboxedTypeTag t)) + +valToBoxed :: Val -> Maybe Closure +valToBoxed UnboxedVal {} = Nothing +valToBoxed (Val _ b) = Just b + +-- | Matches a Val which is known to be boxed, and returns the closure portion. +pattern BoxedVal :: Closure -> Val +pattern BoxedVal b <- (valToBoxed -> Just b) + where + BoxedVal b = Val (-1) b + +{-# COMPLETE UnboxedVal, BoxedVal #-} + +-- | Lift a boxed val into an Val +boxedVal :: BVal -> Val +boxedVal = Val 0 + +type USeg = ByteArray + +type BVal = Closure + +type BSeg = Array Closure + +type Seg = (USeg, BSeg) + +alloc :: IO Stack +alloc = do + ustk <- newByteArray 4096 + bstk <- newArray 512 BlackHole + pure $ Stack {ap = -1, fp = -1, sp = -1, ustk, bstk} +{-# INLINE alloc #-} + +{- ORMOLU_DISABLE -} +peek :: DebugCallStack => Stack -> IO Val +peek stk@(Stack _ _ sp ustk _) = do + -- Can't use upeek here because in stack-check mode it will assert that the stack slot is unboxed. + u <- readByteArray ustk sp + b <- bpeek stk + pure (Val u b) +{-# INLINE peek #-} + +peekI :: DebugCallStack => Stack -> IO Int +peekI _stk@(Stack _ _ sp ustk _) = do +#ifdef STACK_CHECK + assertUnboxed _stk 0 +#endif + readByteArray ustk sp +{-# INLINE peekI #-} + +peekOffI :: DebugCallStack => Stack -> Off -> IO Int +peekOffI _stk@(Stack _ _ sp ustk _) i = do +#ifdef STACK_CHECK + assertUnboxed _stk i +#endif + readByteArray ustk (sp - i) +{-# INLINE peekOffI #-} + +bpeek :: DebugCallStack => Stack -> IO BVal +bpeek (Stack _ _ sp _ bstk) = readArray bstk sp +{-# INLINE bpeek #-} + +upeek :: DebugCallStack => Stack -> IO UVal +upeek _stk@(Stack _ _ sp ustk _) = do +#ifdef STACK_CHECK + assertUnboxed _stk 0 +#endif + readByteArray ustk sp +{-# INLINE upeek #-} + +peekOff :: DebugCallStack => Stack -> Off -> IO Val +peekOff stk@(Stack _ _ sp ustk _) i = do + -- Can't use upeekOff here because in stack-check mode it will assert that the stack slot is unboxed. + u <- readByteArray ustk (sp - i) + b <- bpeekOff stk i + pure $ Val u b +{-# INLINE peekOff #-} + +bpeekOff :: DebugCallStack => Stack -> Off -> IO BVal +bpeekOff (Stack _ _ sp _ bstk) i = readArray bstk (sp - i) +{-# INLINE bpeekOff #-} + +upeekOff :: DebugCallStack => Stack -> Off -> IO UVal +upeekOff _stk@(Stack _ _ sp ustk _) i = do +#ifdef STACK_CHECK + assertUnboxed _stk i +#endif + readByteArray ustk (sp - i) +{-# INLINE upeekOff #-} + +upokeT :: DebugCallStack => Stack -> UVal -> BVal -> IO () +upokeT !stk@(Stack _ _ sp ustk _) !u !t = do + bpoke stk t + writeByteArray ustk sp u +{-# INLINE upokeT #-} + +poke :: DebugCallStack => Stack -> Val -> IO () +poke _stk@(Stack _ _ sp ustk bstk) (Val u b) = do +#ifdef STACK_CHECK + assertBumped _stk 0 +#endif + writeByteArray ustk sp u + writeArray bstk sp b +{-# INLINE poke #-} + +-- | Sometimes we get back an int from a foreign call which we want to use as a Nat. +-- If we know it's positive and smaller than 2^63 then we can safely store the Int directly as a Nat without +-- checks. +unsafePokeIasN :: DebugCallStack => Stack -> Int -> IO () +unsafePokeIasN stk n = do + upokeT stk n natTypeTag +{-# INLINE unsafePokeIasN #-} + +-- | Store an unboxed tag to later match on. +-- Often used to indicate the constructor of a data type that's been unpacked onto the stack, +-- or some tag we're about to branch on. +pokeTag :: DebugCallStack => Stack -> Int -> IO () +pokeTag = + -- For now we just use ints, but maybe should have a separate type for tags so we can detect if we're leaking them. + pokeI +{-# INLINE pokeTag #-} + +peekTag :: DebugCallStack => Stack -> IO Int +peekTag = peekI +{-# INLINE peekTag #-} + +peekTagOff :: DebugCallStack => Stack -> Off -> IO Int +peekTagOff = peekOffI +{-# INLINE peekTagOff #-} + +pokeBool :: DebugCallStack => Stack -> Bool -> IO () +pokeBool stk b = + -- Currently this is implemented as a tag, which is branched on to put a packed bool constructor on the stack, but + -- we'll want to change it to have its own unboxed type tag eventually. + pokeTag stk $ if b then 1 else 0 +{-# INLINE pokeBool #-} + +-- | Store a boxed value. +-- We don't bother nulling out the unboxed stack, +-- it's extra work and there's nothing to garbage collect. +bpoke :: DebugCallStack => Stack -> BVal -> IO () +bpoke _stk@(Stack _ _ sp _ bstk) b = do +#ifdef STACK_CHECK + assertBumped _stk 0 +#endif + writeArray bstk sp b +{-# INLINE bpoke #-} + +pokeOff :: DebugCallStack => Stack -> Off -> Val -> IO () +pokeOff stk i (Val u t) = do + bpokeOff stk i t + writeByteArray (ustk stk) (sp stk - i) u +{-# INLINE pokeOff #-} + +upokeOffT :: DebugCallStack => Stack -> Off -> UVal -> BVal -> IO () +upokeOffT stk i u t = do + bpokeOff stk i t + writeByteArray (ustk stk) (sp stk - i) u +{-# INLINE upokeOffT #-} + +bpokeOff :: DebugCallStack => Stack -> Off -> BVal -> IO () +bpokeOff _stk@(Stack _ _ sp _ bstk) i b = do +#ifdef STACK_CHECK + assertBumped _stk i +#endif + writeArray bstk (sp - i) b +{-# INLINE bpokeOff #-} + +-- | Eats up arguments +grab :: Stack -> SZ -> IO (Seg, Stack) +grab (Stack _ fp sp ustk bstk) sze = do + uSeg <- ugrab + bSeg <- bgrab + pure $ ((uSeg, bSeg), Stack (fp - sze) (fp - sze) (sp - sze) ustk bstk) + where + ugrab = do + mut <- newByteArray bsz + copyMutableByteArray mut 0 ustk (bfp - bsz) bsz + seg <- unsafeFreezeByteArray mut + moveByteArray ustk (bfp - bsz) ustk bfp fsz + pure seg + where + bsz = bytes sze + bfp = bytes $ fp + 1 + fsz = bytes $ sp - fp + bgrab = do + seg <- unsafeFreezeArray =<< cloneMutableArray bstk (fp + 1 - sze) sze + copyMutableArray bstk (fp + 1 - sze) bstk (fp + 1) fsz + pure seg + where + fsz = sp - fp +{-# INLINE grab #-} + +ensure :: Stack -> SZ -> IO Stack +ensure stk@(Stack ap fp sp ustk bstk) sze + | sze <= 0 = pure stk + | sp + sze + 1 < bsz = pure stk + | otherwise = do + bstk' <- newArray (bsz + bext) BlackHole + copyMutableArray bstk' 0 bstk 0 (sp + 1) + ustk' <- resizeMutableByteArray ustk (usz + uext) + pure $ Stack ap fp sp ustk' bstk' + where + usz = sizeofMutableByteArray ustk + bsz = sizeofMutableArray bstk + bext + | sze > 1280 = sze + 512 + | otherwise = 1280 + uext + | bytes sze > 10240 = bytes sze + 4096 + | otherwise = 10240 +{-# INLINE ensure #-} + +bump :: Stack -> IO Stack +bump (Stack ap fp sp ustk bstk) = do + let stk' = Stack ap fp (sp + 1) ustk bstk +#ifdef STACK_CHECK + pokeSentinelOff stk' 0 +#endif + pure stk' +{-# INLINE bump #-} + +bumpn :: Stack -> SZ -> IO Stack +bumpn (Stack ap fp sp ustk bstk) n = do + let stk' = Stack ap fp (sp + n) ustk bstk +#ifdef STACK_CHECK + for_ [0..n-1] $ \i -> + pokeSentinelOff stk' i +#endif + pure stk' +{-# INLINE bumpn #-} + +duplicate :: Stack -> IO Stack +duplicate (Stack ap fp sp ustk bstk) = do + ustk' <- dupUStk + bstk' <- dupBStk + pure $ Stack ap fp sp ustk' bstk' + where + dupUStk = do + let sz = sizeofMutableByteArray ustk + b <- newByteArray sz + copyMutableByteArray b 0 ustk 0 sz + pure b + dupBStk = do + cloneMutableArray bstk 0 (sizeofMutableArray bstk) +{-# INLINE duplicate #-} + +discardFrame :: Stack -> IO Stack +discardFrame (Stack ap fp _ ustk bstk) = pure $ Stack ap fp fp ustk bstk +{-# INLINE discardFrame #-} + +saveFrame :: Stack -> IO (Stack, SZ, SZ) +saveFrame (Stack ap fp sp ustk bstk) = pure (Stack sp sp sp ustk bstk, sp - fp, fp - ap) +{-# INLINE saveFrame #-} + +saveArgs :: Stack -> IO (Stack, SZ) +saveArgs (Stack ap fp sp ustk bstk) = pure (Stack fp fp sp ustk bstk, fp - ap) +{-# INLINE saveArgs #-} + +restoreFrame :: Stack -> SZ -> SZ -> IO Stack +restoreFrame (Stack _ fp0 sp ustk bstk) fsz asz = pure $ Stack ap fp sp ustk bstk + where + fp = fp0 - fsz + ap = fp - asz +{-# INLINE restoreFrame #-} + +prepareArgs :: Stack -> Args' -> IO Stack +prepareArgs (Stack ap fp sp ustk bstk) = \case + ArgR i l + | fp + l + i == sp -> + pure $ Stack ap (sp - i) (sp - i) ustk bstk + args -> do + sp <- argOnto (ustk, bstk) sp (ustk, bstk) fp args + pure $ Stack ap sp sp ustk bstk +{-# INLINE prepareArgs #-} + +acceptArgs :: Stack -> Int -> IO Stack +acceptArgs (Stack ap fp sp ustk bstk) n = pure $ Stack ap (fp - n) sp ustk bstk +{-# INLINE acceptArgs #-} + +frameArgs :: Stack -> IO Stack +frameArgs (Stack ap _ sp ustk bstk) = pure $ Stack ap ap sp ustk bstk +{-# INLINE frameArgs #-} + +augSeg :: Augment -> Stack -> Seg -> Maybe Args' -> IO Seg +augSeg mode (Stack ap fp sp ustk bstk) (useg, bseg) margs = do + useg' <- unboxedSeg + bseg' <- boxedSeg + pure (useg', bseg') + where + bpsz + | I <- mode = 0 + | otherwise = fp - ap + unboxedSeg = do + cop <- newByteArray $ ssz + upsz + asz + copyByteArray cop soff useg 0 ssz + copyMutableByteArray cop 0 ustk (bytes $ ap + 1) upsz + for_ margs $ uargOnto ustk sp cop (words poff + bpsz - 1) + unsafeFreezeByteArray cop + where + ssz = sizeofByteArray useg + (poff, soff) + | K <- mode = (ssz, 0) + | otherwise = (0, upsz + asz) + upsz = bytes bpsz + asz = case margs of + Nothing -> bytes 0 + Just (Arg1 _) -> bytes 1 + Just (Arg2 _ _) -> bytes 2 + Just (ArgN v) -> bytes $ sizeofPrimArray v + Just (ArgR _ l) -> bytes l + boxedSeg = do + cop <- newArray (ssz + bpsz + asz) BlackHole + copyArray cop soff bseg 0 ssz + copyMutableArray cop poff bstk (ap + 1) bpsz + for_ margs $ bargOnto bstk sp cop (poff + bpsz - 1) + unsafeFreezeArray cop + where + ssz = sizeofArray bseg + (poff, soff) + | K <- mode = (ssz, 0) + | otherwise = (0, bpsz + asz) + asz = case margs of + Nothing -> 0 + Just (Arg1 _) -> 1 + Just (Arg2 _ _) -> 2 + Just (ArgN v) -> sizeofPrimArray v + Just (ArgR _ l) -> l +{-# INLINE augSeg #-} + +dumpSeg :: Stack -> Seg -> Dump -> IO Stack +dumpSeg (Stack ap fp sp ustk bstk) (useg, bseg) mode = do + dumpUSeg + dumpBSeg + pure $ Stack ap' fp' sp' ustk bstk + where + sz = sizeofArray bseg + sp' = sp + sz + fp' = dumpFP fp sz mode + ap' = dumpAP ap fp sz mode + dumpUSeg = do + let ssz = sizeofByteArray useg + let bsp = bytes $ sp + 1 + copyByteArray ustk bsp useg 0 ssz + dumpBSeg = do + copyArray bstk (sp + 1) bseg 0 sz +{-# INLINE dumpSeg #-} + +adjustArgs :: Stack -> SZ -> IO Stack +adjustArgs (Stack ap fp sp ustk bstk) sz = pure $ Stack (ap - sz) fp sp ustk bstk +{-# INLINE adjustArgs #-} + +fsize :: Stack -> SZ +fsize (Stack _ fp sp _ _) = sp - fp +{-# INLINE fsize #-} + +asize :: Stack -> SZ +asize (Stack ap fp _ _ _) = fp - ap +{-# INLINE asize #-} + +peekN :: Stack -> IO Word64 +peekN _stk@(Stack _ _ sp ustk _) = do +#ifdef STACK_CHECK + assertUnboxed _stk 0 +#endif + readByteArray ustk sp +{-# INLINE peekN #-} + +peekD :: Stack -> IO Double +peekD _stk@(Stack _ _ sp ustk _) = do +#ifdef STACK_CHECK + assertUnboxed _stk 0 +#endif + readByteArray ustk sp +{-# INLINE peekD #-} + +peekC :: Stack -> IO Char +peekC stk = do + Char.chr <$> peekI stk +{-# INLINE peekC #-} + +peekOffN :: Stack -> Int -> IO Word64 +peekOffN _stk@(Stack _ _ sp ustk _) i = do +#ifdef STACK_CHECK + assertUnboxed _stk i +#endif + readByteArray ustk (sp - i) +{-# INLINE peekOffN #-} + +peekOffD :: Stack -> Int -> IO Double +peekOffD _stk@(Stack _ _ sp ustk _) i = do +#ifdef STACK_CHECK + assertUnboxed _stk i +#endif + readByteArray ustk (sp - i) +{-# INLINE peekOffD #-} + +peekOffC :: Stack -> Int -> IO Char +peekOffC _stk@(Stack _ _ sp ustk _) i = do +#ifdef STACK_CHECK + assertUnboxed _stk i +#endif + Char.chr <$> readByteArray ustk (sp - i) +{-# INLINE peekOffC #-} + +{- ORMOLU_ENABLE -} + +pokeN :: Stack -> Word64 -> IO () +pokeN stk@(Stack _ _ sp ustk _) n = do + bpoke stk natTypeTag + writeByteArray ustk sp n +{-# INLINE pokeN #-} + +pokeD :: Stack -> Double -> IO () +pokeD stk@(Stack _ _ sp ustk _) d = do + bpoke stk floatTypeTag + writeByteArray ustk sp d +{-# INLINE pokeD #-} + +pokeC :: Stack -> Char -> IO () +pokeC stk@(Stack _ _ sp ustk _) c = do + bpoke stk charTypeTag + writeByteArray ustk sp (Char.ord c) +{-# INLINE pokeC #-} + +-- | Note: This is for poking an unboxed value that has the UNISON type 'int', not just any unboxed data. +pokeI :: Stack -> Int -> IO () +pokeI stk@(Stack _ _ sp ustk _) i = do + bpoke stk intTypeTag + writeByteArray ustk sp i +{-# INLINE pokeI #-} + +pokeByte :: Stack -> Word8 -> IO () +pokeByte stk b = do + -- NOTE: currently we just store bytes as Word64s, but we should have a separate type runtime type tag for them. + pokeN stk (fromIntegral b) +{-# INLINE pokeByte #-} + +pokeOffN :: Stack -> Int -> Word64 -> IO () +pokeOffN stk@(Stack _ _ sp ustk _) i n = do + bpokeOff stk i natTypeTag + writeByteArray ustk (sp - i) n +{-# INLINE pokeOffN #-} + +pokeOffD :: Stack -> Int -> Double -> IO () +pokeOffD stk@(Stack _ _ sp ustk _) i d = do + bpokeOff stk i floatTypeTag + writeByteArray ustk (sp - i) d +{-# INLINE pokeOffD #-} + +pokeOffI :: Stack -> Int -> Int -> IO () +pokeOffI stk@(Stack _ _ sp ustk _) i n = do + bpokeOff stk i intTypeTag + writeByteArray ustk (sp - i) n +{-# INLINE pokeOffI #-} + +pokeOffC :: Stack -> Int -> Char -> IO () +pokeOffC stk i c = do + upokeOffT stk i (Char.ord c) charTypeTag +{-# INLINE pokeOffC #-} + +pokeBi :: (BuiltinForeign b) => Stack -> b -> IO () +pokeBi stk x = bpoke stk (Foreign $ wrapBuiltin x) +{-# INLINE pokeBi #-} + +pokeOffBi :: (BuiltinForeign b) => Stack -> Int -> b -> IO () +pokeOffBi stk i x = bpokeOff stk i (Foreign $ wrapBuiltin x) +{-# INLINE pokeOffBi #-} + +peekBi :: (BuiltinForeign b) => Stack -> IO b +peekBi stk = unwrapForeign . marshalToForeign <$> bpeek stk +{-# INLINE peekBi #-} + +peekOffBi :: (BuiltinForeign b) => Stack -> Int -> IO b +peekOffBi stk i = unwrapForeign . marshalToForeign <$> bpeekOff stk i +{-# INLINE peekOffBi #-} + +peekOffS :: Stack -> Int -> IO USeq +peekOffS stk i = + unwrapForeign . marshalToForeign <$> bpeekOff stk i +{-# INLINE peekOffS #-} + +pokeS :: Stack -> USeq -> IO () +pokeS stk s = bpoke stk (Foreign $ Wrap Ty.listRef s) +{-# INLINE pokeS #-} + +pokeOffS :: Stack -> Int -> USeq -> IO () +pokeOffS stk i s = bpokeOff stk i (Foreign $ Wrap Ty.listRef s) +{-# INLINE pokeOffS #-} + +unull :: USeg +unull = byteArrayFromListN 0 ([] :: [Int]) + +bnull :: BSeg +bnull = fromListN 0 [] + +nullSeg :: Seg +nullSeg = (unull, bnull) + +instance Show K where + show k = "[" ++ go "" k + where + go _ KE = "]" + go _ (CB _) = "]" + go com (Push f a ci _g _rsect k) = + com ++ show (f, a, ci) ++ go "," k + go com (Mark a ps _ k) = + com ++ "M " ++ show a ++ " " ++ show ps ++ go "," k + +frameView :: Stack -> IO () +frameView stk = putStr "|" >> gof False 0 + where + fsz = fsize stk + asz = asize stk + gof delim n + | n >= fsz = putStr "|" >> goa False 0 + | otherwise = do + when delim $ putStr "," + putStr . show =<< peekOff stk n + gof True (n + 1) + goa delim n + | n >= asz = putStrLn "|.." + | otherwise = do + when delim $ putStr "," + putStr . show =<< peekOff stk (fsz + n) + goa True (n + 1) + +scount :: Seg -> Int +scount (_, bseg) = bscount bseg + where + bscount :: BSeg -> Int + bscount seg = sizeofArray seg + +closureTermRefs :: (Monoid m) => (Reference -> m) -> (Closure -> m) +closureTermRefs f = \case + PAp (CIx r _ _) _ (_useg, bseg) -> + f r <> foldMap (closureTermRefs f) bseg + (DataC _ _ vs) -> + vs & foldMap \case + BoxedVal c -> closureTermRefs f c + UnboxedVal {} -> mempty + (Captured k _ (_useg, bseg)) -> + contTermRefs f k <> foldMap (closureTermRefs f) bseg + (Foreign fo) + | Just (cs :: USeq) <- maybeUnwrapForeign Ty.listRef fo -> + foldMap (\(Val _i clos) -> closureTermRefs f clos) cs + _ -> mempty + +contTermRefs :: (Monoid m) => (Reference -> m) -> K -> m +contTermRefs f (Mark _ _ m k) = + ( m & foldMap \case + BoxedVal clo -> closureTermRefs f clo + _ -> mempty + ) + <> contTermRefs f k +contTermRefs f (Push _ _ (CIx r _ _) _ _ k) = + f r <> contTermRefs f k +contTermRefs _ _ = mempty diff --git a/unison-runtime/src/Unison/Runtime/TypeTags.hs b/unison-runtime/src/Unison/Runtime/TypeTags.hs new file mode 100644 index 0000000000..8bccb00f81 --- /dev/null +++ b/unison-runtime/src/Unison/Runtime/TypeTags.hs @@ -0,0 +1,144 @@ +module Unison.Runtime.TypeTags + ( Tag (..), + RTag (..), + CTag (..), + PackedTag (..), + packTags, + unpackTags, + maskTags, + floatTag, + natTag, + intTag, + charTag, + unitTag, + leftTag, + rightTag, + ) +where + +import Control.Exception (throw) +import Data.Bits (shiftL, shiftR, (.&.), (.|.)) +import Data.List hiding (and, or) +import Data.Map qualified as Map +import GHC.Stack (CallStack, callStack) +import U.Codebase.Reference (Reference) +import Unison.Builtin.Decls qualified as Ty +import Unison.Prelude +import Unison.Runtime.Builtin.Types (builtinTypeNumbering) +import Unison.Type qualified as Ty +import Unison.Util.EnumContainers as EC +import Unison.Util.Pretty qualified as Pretty +import Prelude hiding (abs, and, or, seq) +import Prelude qualified + +-- For internal errors +data CompileExn = CE CallStack (Pretty.Pretty Pretty.ColorText) + deriving (Show) + +instance Exception CompileExn + +internalBug :: (HasCallStack) => String -> a +internalBug = throw . CE callStack . Pretty.lit . fromString + +-- Types representing components that will go into the runtime tag of +-- a data type value. RTags correspond to references, while CTags +-- correspond to constructors. +newtype RTag = RTag Word64 + deriving stock (Eq, Ord, Show, Read) + deriving newtype (EC.EnumKey) + +newtype CTag = CTag Word16 + deriving stock (Eq, Ord, Show, Read) + deriving newtype (EC.EnumKey) + +-- | A combined tag, which is a packed representation of an RTag and a CTag +newtype PackedTag = PackedTag Word64 + deriving stock (Eq, Ord, Show, Read) + deriving newtype (EC.EnumKey) + +class Tag t where rawTag :: t -> Word64 + +instance Tag RTag where rawTag (RTag w) = w + +instance Tag CTag where rawTag (CTag w) = fromIntegral w + +packTags :: RTag -> CTag -> PackedTag +packTags (RTag rt) (CTag ct) = PackedTag (ri .|. ci) + where + ri = rt `shiftL` 16 + ci = fromIntegral ct + +unpackTags :: PackedTag -> (RTag, CTag) +unpackTags (PackedTag w) = (RTag $ w `shiftR` 16, CTag . fromIntegral $ w .&. 0xFFFF) + +-- Masks a packed tag to extract just the constructor tag portion +maskTags :: PackedTag -> Word64 +maskTags (PackedTag w) = (w .&. 0xFFFF) + +ensureRTag :: (Ord n, Show n, Num n) => String -> n -> r -> r +ensureRTag s n x + | n > 0xFFFFFFFFFFFF = + internalBug $ s ++ "@RTag: too large: " ++ show n + | otherwise = x + +ensureCTag :: (Ord n, Show n, Num n) => String -> n -> r -> r +ensureCTag s n x + | n > 0xFFFF = + internalBug $ s ++ "@CTag: too large: " ++ show n + | otherwise = x + +instance Enum RTag where + toEnum i = ensureRTag "toEnum" i . RTag $ toEnum i + fromEnum (RTag w) = fromEnum w + +instance Enum CTag where + toEnum i = ensureCTag "toEnum" i . CTag $ toEnum i + fromEnum (CTag w) = fromEnum w + +instance Num RTag where + fromInteger i = ensureRTag "fromInteger" i . RTag $ fromInteger i + (+) = internalBug "RTag: +" + (*) = internalBug "RTag: *" + abs = internalBug "RTag: abs" + signum = internalBug "RTag: signum" + negate = internalBug "RTag: negate" + +instance Num CTag where + fromInteger i = ensureCTag "fromInteger" i . CTag $ fromInteger i + (+) = internalBug "CTag: +" + (*) = internalBug "CTag: *" + abs = internalBug "CTag: abs" + signum = internalBug "CTag: signum" + negate = internalBug "CTag: negate" + +floatTag :: PackedTag +floatTag = mkSimpleTag "floatTag" Ty.floatRef + +natTag :: PackedTag +natTag = mkSimpleTag "natTag" Ty.natRef + +intTag :: PackedTag +intTag = mkSimpleTag "intTag" Ty.intRef + +charTag :: PackedTag +charTag = mkSimpleTag "charTag" Ty.charRef + +unitTag :: PackedTag +unitTag = mkSimpleTag "unitTag" Ty.unitRef + +leftTag, rightTag :: PackedTag +(leftTag, rightTag) + | Just n <- Map.lookup Ty.eitherRef builtinTypeNumbering, + et <- toEnum (fromIntegral n), + lt <- toEnum (fromIntegral Ty.eitherLeftId), + rt <- toEnum (fromIntegral Ty.eitherRightId) = + (packTags et lt, packTags et rt) + | otherwise = error "internal error: either tags" + +-- | Construct a tag for a single-constructor builtin type +mkSimpleTag :: String -> Reference -> PackedTag +mkSimpleTag msg r + | Just n <- Map.lookup r builtinTypeNumbering, + rt <- toEnum (fromIntegral n) = + packTags rt 0 + | otherwise = internalBug $ "internal error: " <> msg diff --git a/parser-typechecker/src/Unison/Runtime/Vector.hs b/unison-runtime/src/Unison/Runtime/Vector.hs similarity index 100% rename from parser-typechecker/src/Unison/Runtime/Vector.hs rename to unison-runtime/src/Unison/Runtime/Vector.hs diff --git a/parser-typechecker/src/Unison/Runtime/docs.markdown b/unison-runtime/src/Unison/Runtime/docs.markdown similarity index 100% rename from parser-typechecker/src/Unison/Runtime/docs.markdown rename to unison-runtime/src/Unison/Runtime/docs.markdown diff --git a/unison-runtime/tests/Suite.hs b/unison-runtime/tests/Suite.hs new file mode 100644 index 0000000000..7d8f033dea --- /dev/null +++ b/unison-runtime/tests/Suite.hs @@ -0,0 +1,35 @@ +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + +module Main where + +import EasyTest +import System.Environment (getArgs) +import System.IO +import System.IO.CodePage (withCP65001) +import Unison.Test.Runtime.ANF qualified as ANF +import Unison.Test.Runtime.ANF.Serialization qualified as ANF.Serialization +import Unison.Test.Runtime.Crypto.Rsa qualified as Rsa +import Unison.Test.Runtime.MCode qualified as MCode +import Unison.Test.Runtime.MCode.Serialization qualified as MCode.Serialization +import Unison.Test.UnisonSources qualified as UnisonSources + +test :: Test () +test = + tests + [ ANF.test, + ANF.Serialization.test, + MCode.test, + MCode.Serialization.test, + Rsa.test, + UnisonSources.test + ] + +main :: IO () +main = withCP65001 do + args <- getArgs + mapM_ (`hSetEncoding` utf8) [stdout, stdin, stderr] + case args of + [] -> runOnly "" test + [prefix] -> runOnly prefix test + [seed, prefix] -> rerunOnly (read seed) prefix test diff --git a/unison-runtime/tests/Unison/Test/Common.hs b/unison-runtime/tests/Unison/Test/Common.hs new file mode 100644 index 0000000000..e1d880002c --- /dev/null +++ b/unison-runtime/tests/Unison/Test/Common.hs @@ -0,0 +1,93 @@ +module Unison.Test.Common + ( hqLength, + t, + tm, + parseAndSynthesizeAsFile, + parsingEnv, + ) +where + +import Control.Monad.Writer (tell) +import Data.Functor.Identity (Identity (..)) +import Data.Sequence (Seq) +import Text.Megaparsec.Error qualified as MPE +import Unison.ABT qualified as ABT +import Unison.Builtin qualified as B +import Unison.FileParsers qualified as FP +import Unison.Parser.Ann (Ann (..)) +import Unison.Parsers qualified as Parsers +import Unison.PrintError (prettyParseError) +import Unison.Result (Note, Result) +import Unison.Result qualified as Result +import Unison.Symbol (Symbol) +import Unison.Syntax.Parser qualified as Parser +import Unison.Syntax.TermParser qualified as TermParser +import Unison.Syntax.TypeParser qualified as TypeParser +import Unison.Term qualified as Term +import Unison.Type qualified as Type +import Unison.UnisonFile (TypecheckedUnisonFile, UnisonFile) +import Unison.Util.Pretty qualified as Pr +import Unison.Var (Var) + +type Term v = Term.Term v Ann + +type Type v = Type.Type v Ann + +hqLength :: Int +hqLength = 10 + +t :: String -> Type Symbol +t s = + ABT.amap (const Intrinsic) + -- . either (error . show ) id + -- . Type.bindSomeNames B.names0 + . either (error . showParseError s) tweak + . runIdentity + $ Parser.run (Parser.root TypeParser.valueType) s parsingEnv + where + tweak = Type.generalizeLowercase mempty + +tm :: String -> Term Symbol +tm s = + either (error . showParseError s) id + -- . Term.bindSomeNames mempty B.names0 + -- . either (error . showParseError s) id + . runIdentity + $ Parser.run (Parser.root TermParser.term) s parsingEnv + +showParseError :: + (Var v) => + String -> + MPE.ParseError Parser.Input (Parser.Error v) -> + String +showParseError s = Pr.toANSI 60 . prettyParseError s + +parseAndSynthesizeAsFile :: + [Type Symbol] -> + FilePath -> + String -> + Result + (Seq (Note Symbol Ann)) + (Either (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)) +parseAndSynthesizeAsFile ambient filename s = do + file <- Result.fromParsing (runIdentity (Parsers.parseFile filename s parsingEnv)) + let typecheckingEnv = + runIdentity $ + FP.computeTypecheckingEnvironment + (FP.ShouldUseTndr'Yes parsingEnv) + ambient + (\_deps -> pure B.typeLookup) + file + case FP.synthesizeFile typecheckingEnv file of + Result.Result notes Nothing -> tell notes >> pure (Left file) + Result.Result _ (Just typecheckedFile) -> pure (Right typecheckedFile) + +parsingEnv :: Parser.ParsingEnv Identity +parsingEnv = + Parser.ParsingEnv + { uniqueNames = mempty, + uniqueTypeGuid = \_ -> pure Nothing, + names = B.names, + maybeNamespace = Nothing, + localNamespacePrefixedTypesAndConstructors = mempty + } diff --git a/unison-runtime/tests/Unison/Test/Gen.hs b/unison-runtime/tests/Unison/Test/Gen.hs new file mode 100644 index 0000000000..f66ea4e342 --- /dev/null +++ b/unison-runtime/tests/Unison/Test/Gen.hs @@ -0,0 +1,51 @@ +-- | Hedgehog generators for common unison types. +module Unison.Test.Gen where + +import Data.Text qualified as Text +import Hedgehog hiding (Rec, Test, test) +import Hedgehog.Gen qualified as Gen +import Hedgehog.Range qualified as Range +import Unison.ConstructorReference +import Unison.ConstructorType qualified as CT +import Unison.Hash (Hash) +import Unison.Hash qualified as Hash +import Unison.Prelude +import Unison.Reference qualified as Reference +import Unison.Referent qualified as Referent +import Unison.Util.Text qualified as Unison.Text + +genSmallWord64 :: Gen Word64 +genSmallWord64 = Gen.word64 (Range.linear 0 100) + +genSmallInt :: Gen Int +genSmallInt = Gen.int (Range.linear 0 100) + +genReference :: Gen Reference.Reference +genReference = + Gen.choice + [ Reference.ReferenceBuiltin <$> genSmallText, + Reference.ReferenceDerived <$> genRefId + ] + where + genRefId :: Gen (Reference.Id' Hash) + genRefId = Reference.Id <$> genHash <*> genSmallWord64 + +-- This can generate invalid hashes, but that's not really an issue for testing serialization. +genHash :: Gen Hash +genHash = Hash.fromByteString <$> Gen.bytes (Range.singleton 32) + +genReferent :: Gen Referent.Referent +genReferent = + Gen.choice + [ Referent.Ref <$> genReference, + Referent.Con <$> genConstructorReference <*> genConstructorType + ] + where + genConstructorType = Gen.choice [pure CT.Data, pure CT.Effect] + genConstructorReference = ConstructorReference <$> genReference <*> genSmallWord64 + +genSmallText :: Gen Text +genSmallText = Gen.text (Range.linear 2 4) Gen.alphaNum + +genUText :: Gen Unison.Text.Text +genUText = Unison.Text.pack . Text.unpack <$> genSmallText diff --git a/unison-runtime/tests/Unison/Test/Runtime/ANF.hs b/unison-runtime/tests/Unison/Test/Runtime/ANF.hs new file mode 100644 index 0000000000..992fbc0230 --- /dev/null +++ b/unison-runtime/tests/Unison/Test/Runtime/ANF.hs @@ -0,0 +1,224 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE PatternGuards #-} + +module Unison.Test.Runtime.ANF where + +import Control.Monad.Reader (ReaderT (..)) +import Control.Monad.State (evalState) +import Data.Map qualified as Map +import Data.Set qualified as Set +import Data.Word (Word64) +import EasyTest +import Unison.ABT qualified as ABT +import Unison.ABT.Normalized (Term (TAbs)) +import Unison.ConstructorReference (GConstructorReference (..)) +import Unison.Pattern qualified as P +import Unison.Reference (Reference, Reference' (Builtin)) +import Unison.Runtime.ANF as ANF +import Unison.Runtime.MCode (RefNums (..), emitCombs) +import Unison.Term qualified as Term +import Unison.Test.Common +import Unison.Type as Ty +import Unison.Util.EnumContainers as EC +import Unison.Util.Text qualified as Util.Text +import Unison.Var as Var + +-- testSNF s = ok +-- where +-- t0 = tm s +-- snf = toSuperNormal (const 0) t0 + +simpleRefs :: Reference -> RTag +simpleRefs r + | r == Ty.natRef = 0 + | r == Ty.intRef = 1 + | r == Ty.floatRef = 2 + | r == Ty.booleanRef = 3 + | r == Ty.textRef = 4 + | r == Ty.charRef = 5 + | otherwise = 100 + +runANF :: (Var v) => ANFM v a -> a +runANF m = evalState (runReaderT m Set.empty) (0, 1, []) + +testANF :: String -> Test () +testANF s + | t0 == denormalize anf = ok + | otherwise = crash $ show $ denormalize anf + where + t0 = const () `Term.amap` tm s + anf = snd . runANF $ anfTerm t0 + +testLift :: String -> Test () +testLift s = case cs of !_ -> ok + where + cs = + emitCombs (RN (const 0) (const 0) (const Nothing)) (Builtin "Test") 0 + . superNormalize + . (\(ll, _, _, _) -> ll) + . lamLift mempty + $ tm s + +denormalizeLit :: (Var v) => Lit -> Term.Term0 v +denormalizeLit (I i) = Term.int () i +denormalizeLit (N n) = Term.nat () n +denormalizeLit (F f) = Term.float () f +denormalizeLit (T t) = Term.text () (Util.Text.toText t) +denormalizeLit (C c) = Term.char () c +denormalizeLit (LM r) = Term.termLink () r +denormalizeLit (LY r) = Term.typeLink () r + +denormalize :: (Var v) => ANormal v -> Term.Term0 v +denormalize (TVar v) = Term.var () v +denormalize (TLit l) = denormalizeLit l +denormalize (TBLit l) = denormalizeLit l +denormalize (THnd _ _ _) = + error "denormalize handler" +-- = Term.match () (denormalize b) $ denormalizeHandler h +denormalize (TShift _ _ _) = + error "denormalize shift" +denormalize (TLet _ v _ bn bo) + | typeOf v == ANFBlank = ABT.subst v dbn dbo + | otherwise = Term.let1_ False [(v, dbn)] dbo + where + dbn = denormalize bn + dbo = denormalize bo +denormalize (TName _ _ _ _) = + error "can't denormalize by-name bindings" +denormalize (TMatch v cs) = + Term.match () (ABT.var v) $ denormalizeMatch cs +denormalize (TApp f args) + | FCon r 0 <- f, + r `elem` [Ty.natRef, Ty.intRef], + [v] <- args = + Term.var () v +denormalize (TApp f args) = Term.apps' df (Term.var () <$> args) + where + df = case f of + FVar v -> Term.var () v + FComb _ -> error "FComb" + FCon r n -> + Term.constructor () (ConstructorReference r (fromIntegral $ rawTag n)) + FReq r n -> + Term.request () (ConstructorReference r (fromIntegral $ rawTag n)) + FPrim _ -> error "FPrim" + FCont _ -> error "denormalize FCont" +denormalize (TFrc _) = error "denormalize TFrc" + +denormalizeRef :: RTag -> Reference +denormalizeRef r + | 0 <- rawTag r = Ty.natRef + | 1 <- rawTag r = Ty.intRef + | 2 <- rawTag r = Ty.floatRef + | 3 <- rawTag r = Ty.booleanRef + | 4 <- rawTag r = Ty.textRef + | 5 <- rawTag r = Ty.charRef + | otherwise = error "denormalizeRef" + +backReference :: Word64 -> Reference +backReference _ = error "backReference" + +denormalizeMatch :: + (Var v) => Branched (ANormal v) -> [Term.MatchCase () (Term.Term0 v)] +denormalizeMatch b + | MatchEmpty <- b = [] + | MatchIntegral m df <- b = + (dcase (ipat @Word64 @Integer Ty.intRef) <$> mapToList m) ++ dfcase df + | MatchText m df <- b = + (dcase (const @_ @Integer $ P.Text () . Util.Text.toText) <$> Map.toList m) ++ dfcase df + | MatchData r cs Nothing <- b, + [(0, ([UN], zb))] <- mapToList cs, + TAbs i (TMatch j (MatchIntegral m df)) <- zb, + i == j = + (dcase (ipat @Word64 @Integer r) <$> mapToList m) ++ dfcase df + | MatchData r m df <- b = + (dcase (dpat r) . fmap snd <$> mapToList m) ++ dfcase df + | MatchRequest hs df <- b = denormalizeHandler hs df + | MatchNumeric _ cs df <- b = + (dcase (ipat @Word64 @Integer Ty.intRef) <$> mapToList cs) ++ dfcase df + | MatchSum _ <- b = error "MatchSum not a compilation target" + where + dfcase (Just d) = + [Term.MatchCase (P.Unbound ()) Nothing $ denormalize d] + dfcase Nothing = [] + + dcase p (t, br) = Term.MatchCase (p n t) Nothing dbr + where + (n, dbr) = denormalizeBranch br + + ipat :: (Integral a) => Reference -> p -> a -> P.Pattern () + ipat r _ i + | r == Ty.natRef = P.Nat () $ fromIntegral i + | otherwise = P.Int () $ fromIntegral i + dpat r n t = P.Constructor () (ConstructorReference r (fromIntegral (fromEnum t))) (replicate n $ P.Var ()) + +denormalizeBranch :: + (Num a, Var v) => + Term ANormalF v -> + (a, ABT.Term (Term.F v () ()) v ()) +denormalizeBranch (TAbs v br) = (n + 1, ABT.abs v dbr) + where + (n, dbr) = denormalizeBranch br +denormalizeBranch tm = (0, denormalize tm) + +denormalizeHandler :: + (Var v) => + Map.Map Reference (EnumMap CTag ([Mem], ANormal v)) -> + ANormal v -> + [Term.MatchCase () (Term.Term0 v)] +denormalizeHandler cs df = dcs + where + dcs = Map.foldMapWithKey rf cs <> dfc + dfc = + [ Term.MatchCase + (P.EffectPure () (P.Var ())) + Nothing + db + ] + where + (_, db) = denormalizeBranch @Int df + rf r rcs = foldMapWithKey (cf r) rcs + cf r t b = + [ Term.MatchCase + ( P.EffectBind + () + (ConstructorReference r (fromIntegral (fromEnum t))) + (replicate n $ P.Var ()) + (P.Var ()) + ) + Nothing + db + ] + where + (n, db) = denormalizeBranch (snd b) + +test :: Test () +test = + scope "anf" . tests $ + [ scope "lift" . tests $ + [ testLift + "let\n\ + \ g = m x -> ##Nat.+ x m\n\ + \ m -> g m m", + testLift + "m n -> let\n\ + \ f acc i = match i with\n\ + \ 0 -> acc\n\ + \ _ -> f (##Nat.+ acc n) (##Nat.sub i 1)\n\ + \ f 0 m" + ], + scope "denormalize" . tests $ + [ testANF "1", + testANF "1 + 2", + testANF + "match x with\n\ + \ +1 -> foo\n\ + \ +2 -> bar\n\ + \ +3 -> baz", + testANF + "1 + match x with\n\ + \ +1 -> foo\n\ + \ +2 -> bar", + testANF "(match x with +3 -> foo) + (match x with +2 -> foo)" + ] + ] diff --git a/unison-runtime/tests/Unison/Test/Runtime/ANF/Serialization.hs b/unison-runtime/tests/Unison/Test/Runtime/ANF/Serialization.hs new file mode 100644 index 0000000000..92b206ea56 --- /dev/null +++ b/unison-runtime/tests/Unison/Test/Runtime/ANF/Serialization.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Round trip tests for ANF serialization. +module Unison.Test.Runtime.ANF.Serialization (Unison.Test.Runtime.ANF.Serialization.test) where + +import Data.Bytes.Get (runGetS) +import Data.Bytes.Put (runPutS) +import Data.Primitive.Array (Array) +import Data.Primitive.Array qualified as Array +import Data.Primitive.ByteArray (ByteArray) +import Data.Primitive.ByteArray qualified as ByteArray +import Data.Primitive.Types (Prim) +import Data.Serialize.Get (Get) +import Data.Serialize.Put (Put) +import EasyTest qualified as EasyTest +import Hedgehog hiding (Rec, Test, test) +import Hedgehog.Gen qualified as Gen +import Hedgehog.Range qualified as Range +import Unison.Prelude +import Unison.Runtime.ANF +import Unison.Runtime.ANF.Serialize +import Unison.Test.Gen +import Unison.Util.Bytes qualified as Util.Bytes + +test :: EasyTest.Test () +test = + void . EasyTest.scope "anf.serialization" $ do + success <- + EasyTest.io $ + checkParallel $ + Group + "roundtrip" + [ ("value", valueRoundtrip) + ] + EasyTest.expect success + +genUBytes :: Gen Util.Bytes.Bytes +genUBytes = Util.Bytes.fromByteString <$> Gen.bytes (Range.linear 0 4) + +genGroupRef :: Gen GroupRef +genGroupRef = GR <$> genReference <*> genSmallWord64 + +genValList :: Gen ValList +genValList = Gen.list (Range.linear 0 4) genValue + +genCont :: Gen Cont +genCont = do + Gen.choice + [ pure KE, + Mark <$> genSmallWord64 <*> Gen.list (Range.linear 0 4) genReference <*> Gen.map (Range.linear 0 4) ((,) <$> genReference <*> genValue) <*> genCont, + Push <$> genSmallWord64 <*> genSmallWord64 <*> genGroupRef <*> genCont + ] + +genArray :: Range Int -> Gen a -> Gen (Array a) +genArray range gen = + Array.arrayFromList <$> Gen.list range gen + +genByteArray :: (Prim p) => Gen p -> Gen ByteArray +genByteArray genP = do + ByteArray.byteArrayFromList <$> Gen.list (Range.linear 0 20) genP + +genBLit :: Gen BLit +genBLit = + Gen.choice + [ Text <$> genUText, + List <$> Gen.seq (Range.linear 0 4) genValue, + TmLink <$> genReferent, + TyLink <$> genReference, + Bytes <$> genUBytes, + Quote <$> genValue, + -- Code is not yet included, generating valid ANF terms is complex. + -- , Code <$> genCode + BArr <$> genByteArray genSmallWord64, + Pos <$> genSmallWord64, + Neg <$> genSmallWord64, + Char <$> Gen.unicode, + Float <$> Gen.double (Range.linearFrac 0 100), + Arr <$> genArray (Range.linear 0 4) genValue + ] + +genValue :: Gen Value +genValue = Gen.sized \n -> do + -- Limit amount of recursion to avoid infinitely deep values + let gValList + | n > 1 = Gen.small genValList + | otherwise = pure [] + Gen.choice + [ Partial <$> genGroupRef <*> gValList, + Data <$> genReference <*> genSmallWord64 <*> gValList, + Cont <$> gValList <*> genCont, + BLit <$> genBLit + ] + +valueRoundtrip :: Property +valueRoundtrip = + getPutRoundtrip getValue putValue genValue + +getPutRoundtrip :: (Eq a, Show a) => (Version -> Get a) -> (Version -> a -> Put) -> Gen a -> Property +getPutRoundtrip get put builder = + property $ do + v <- forAll builder + version <- forAll versionToTest + let bytes = runPutS (put version v) + runGetS (get version) bytes === Right v + where + versionToTest = do + Gen.choice + [ Transfer <$> Gen.enum 4 valueVersion, + Hash <$> Gen.enum 4 valueVersion + ] diff --git a/parser-typechecker/tests/Unison/Test/Runtime/Crypto/Rsa.hs b/unison-runtime/tests/Unison/Test/Runtime/Crypto/Rsa.hs similarity index 100% rename from parser-typechecker/tests/Unison/Test/Runtime/Crypto/Rsa.hs rename to unison-runtime/tests/Unison/Test/Runtime/Crypto/Rsa.hs diff --git a/unison-runtime/tests/Unison/Test/Runtime/MCode.hs b/unison-runtime/tests/Unison/Test/Runtime/MCode.hs new file mode 100644 index 0000000000..daaf61ea69 --- /dev/null +++ b/unison-runtime/tests/Unison/Test/Runtime/MCode.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE TypeApplications #-} + +module Unison.Test.Runtime.MCode where + +import Control.Concurrent.STM +import Data.Map.Strict qualified as Map +import EasyTest +import Unison.Reference (Reference, Reference' (Builtin)) +import Unison.Runtime.ANF + ( Cacheability (..), + Code (..), + SuperGroup (..), + lamLift, + superNormalize, + ) +import Unison.Runtime.Machine + ( CCache (..), + apply0, + baseCCache, + cacheAdd, + ) +import Unison.Runtime.Pattern +import Unison.Symbol (Symbol) +import Unison.Term (unannotate) +import Unison.Test.Common (tm) + +dummyRef :: Reference +dummyRef = Builtin "dummy" + +mainRef :: Reference +mainRef = Builtin "main" + +modifyTVarTest :: TVar a -> (a -> a) -> Test () +modifyTVarTest v f = io . atomically $ modifyTVar v f + +testEval0 :: [(Reference, SuperGroup Symbol)] -> SuperGroup Symbol -> Test () +testEval0 env main = + ok << io do + cc <- baseCCache False + _ <- cacheAdd ((fmap . fmap) uncacheable $ (mainRef, main) : env) cc + rtm <- readTVarIO (refTm cc) + apply0 Nothing cc Nothing (rtm Map.! mainRef) + where + (<<) = flip (>>) + uncacheable sg = CodeRep sg Uncacheable + +multRec :: String +multRec = + "let\n\ + \ n = 5\n\ + \ f acc i = match i with\n\ + \ 0 -> acc\n\ + \ _ -> f (##Nat.+ acc n) (##Nat.sub i 1)\n\ + \ if (##Nat.== (f 0 1000) 5000) then () else ##bug ()" + +testEval :: String -> Test () +testEval s = testEval0 (fmap superNormalize <$> ctx) (superNormalize ll) + where + (ll, _, ctx, _) = + lamLift mempty + . splitPatterns builtinDataSpec + . unannotate + $ tm s + +nested :: String +nested = + "let\n\ + \ x = match 2 with\n\ + \ 0 -> ##Nat.+ 0 1\n\ + \ m@n -> n\n\ + \ if (##Nat.== x 2) then () else ##bug ()" + +matching'arguments :: String +matching'arguments = + "let\n\ + \ f x y z = y\n\ + \ g x = f x\n\ + \ blorf = let\n\ + \ a = 0\n\ + \ b = 1\n\ + \ d = 2\n\ + \ h = g a b\n\ + \ c = 2\n\ + \ h c\n\ + \ if (##Nat.== blorf 1) then () else ##bug ()" + +test :: Test () +test = + scope "mcode" . tests $ + [ scope "2=2" $ testEval "if (##Nat.== 2 2) then () else ##bug ()", + scope "2=1+1" $ testEval "if (##Nat.== 2 (##Nat.+ 1 1)) then () else ##bug ()", + scope "2=3-1" $ testEval "if (##Nat.== 2 (##Nat.sub 3 1)) then () else ##bug ()", + scope "5*5=25" $ + testEval "if (##Nat.== (##Nat.* 5 5) 25) then () else ##bug ()", + scope "5*1000=5000" $ + testEval "if (##Nat.== (##Nat.* 5 1000) 5000) then () else ##bug ()", + scope "5*1000=5000 rec" $ testEval multRec, + scope "nested" $ + testEval nested, + scope "matching arguments" $ + testEval matching'arguments + ] diff --git a/unison-runtime/tests/Unison/Test/Runtime/MCode/Serialization.hs b/unison-runtime/tests/Unison/Test/Runtime/MCode/Serialization.hs new file mode 100644 index 0000000000..1b95a96b40 --- /dev/null +++ b/unison-runtime/tests/Unison/Test/Runtime/MCode/Serialization.hs @@ -0,0 +1,198 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Round trip tests runtime serialization +module Unison.Test.Runtime.MCode.Serialization (Unison.Test.Runtime.MCode.Serialization.test) where + +import Data.Bytes.Get (runGetS) +import Data.Bytes.Put (runPutS) +import Data.Primitive (Prim, PrimArray, primArrayFromList) +import Data.Serialize.Get (Get) +import Data.Serialize.Put (Put) +import EasyTest qualified as EasyTest +import Hedgehog hiding (Rec, Test, test) +import Hedgehog.Gen qualified as Gen +import Hedgehog.Range qualified as Range +import Unison.Prelude +import Unison.Runtime.Interface +import Unison.Runtime.MCode (Args (..), BPrim1, BPrim2, Branch, Comb, CombIx (..), GBranch (..), GComb (..), GCombInfo (..), GInstr (..), GRef (..), GSection (..), Instr, MLit (..), Ref, Section, UPrim1, UPrim2) +import Unison.Runtime.Machine (Combs) +import Unison.Runtime.TypeTags (PackedTag (..)) +import Unison.Test.Gen +import Unison.Util.EnumContainers (EnumMap, EnumSet) +import Unison.Util.EnumContainers qualified as EC + +test :: EasyTest.Test () +test = + void . EasyTest.scope "mcode.serialization" $ do + success <- + EasyTest.io $ + checkParallel $ + Group + "roundtrip" + [ ("SCache", sCacheRoundtrip) + ] + EasyTest.expect success + +genEnumMap :: (EC.EnumKey k) => Gen k -> Gen v -> Gen (EnumMap k v) +genEnumMap genK genV = EC.mapFromList <$> Gen.list (Range.linear 0 10) ((,) <$> genK <*> genV) + +genEnumSet :: Gen Word64 -> Gen (EnumSet Word64) +genEnumSet gen = EC.setFromList <$> Gen.list (Range.linear 0 10) gen + +genCombs :: Gen Combs +genCombs = genEnumMap genSmallWord64 genComb + +genPrimArray :: (Prim a) => Gen a -> Gen (PrimArray a) +genPrimArray gen = primArrayFromList <$> Gen.list (Range.linear 0 10) gen + +genArgs :: Gen Args +genArgs = + Gen.choice + [ pure ZArgs, + VArg1 <$> genSmallInt, + VArg2 <$> genSmallInt <*> genSmallInt, + VArgR <$> genSmallInt <*> genSmallInt, + VArgN <$> genPrimArray genSmallInt, + VArgV <$> genSmallInt + ] + +genCombIx :: Gen CombIx +genCombIx = + CIx + <$> genReference + <*> genSmallWord64 + <*> genSmallWord64 + +genGRef :: Gen Ref +genGRef = + Gen.choice + [ Stk <$> genSmallInt, + -- For Env, we discard the comb when serializing and replace it with the CombIx anyways, so we do + -- the same during generation to prevent false negatives in roundtrip tests. + do + cix <- genCombIx + pure $ Env cix cix, + Dyn <$> genSmallWord64 + ] + +genBranch :: Gen Branch +genBranch = + Gen.choice + [ Test1 <$> genSmallWord64 <*> genSection <*> genSection, + Test2 <$> genSmallWord64 <*> genSection <*> genSmallWord64 <*> genSection <*> genSection, + TestW <$> genSection <*> genEnumMap genSmallWord64 genSection, + TestT <$> genSection <*> Gen.map (Range.linear 0 10) ((,) <$> genUText <*> genSection) + ] + +genUPrim1 :: Gen UPrim1 +genUPrim1 = Gen.enumBounded + +genUPrim2 :: Gen UPrim2 +genUPrim2 = Gen.enumBounded + +genBPrim1 :: Gen BPrim1 +genBPrim1 = Gen.enumBounded + +genBPrim2 :: Gen BPrim2 +genBPrim2 = Gen.enumBounded + +genMLit :: Gen MLit +genMLit = + Gen.choice + [ MI <$> genSmallInt, + MD <$> Gen.double (Range.linearFrac 0 100), + MT <$> genUText, + MM <$> genReferent, + MY <$> genReference + ] + +genPackedTag :: Gen PackedTag +genPackedTag = PackedTag <$> genSmallWord64 + +genInstr :: Gen Instr +genInstr = + Gen.choice + [ UPrim1 <$> genUPrim1 <*> genSmallInt, + UPrim2 <$> genUPrim2 <*> genSmallInt <*> genSmallInt, + BPrim1 <$> genBPrim1 <*> genSmallInt, + BPrim2 <$> genBPrim2 <*> genSmallInt <*> genSmallInt, + ForeignCall <$> Gen.bool <*> genSmallWord64 <*> genArgs, + SetDyn <$> genSmallWord64 <*> genSmallInt, + Capture <$> genSmallWord64, + Name <$> genGRef <*> genArgs, + Info <$> Gen.string (Range.linear 0 10) Gen.alphaNum, + Pack <$> genReference <*> genPackedTag <*> genArgs, + Lit <$> genMLit, + Print <$> genSmallInt, + Reset <$> genEnumSet genSmallWord64, + Fork <$> genSmallInt, + Atomically <$> genSmallInt, + Seq <$> genArgs, + TryForce <$> genSmallInt + ] + +genSection :: Gen Section +genSection = do + Gen.recursive + Gen.choice + [ Yield <$> genArgs, + Die <$> Gen.string (Range.linear 0 10) Gen.alphaNum, + pure Exit + ] + [ App <$> Gen.bool <*> genGRef <*> genArgs, + do + b <- Gen.bool + cix <- genCombIx + args <- genArgs + -- For Call, we discard the comb when serializing and replace it with the CombIx anyways, so we do + -- the same during generation to prevent false negatives in roundtrip tests. + pure $ Call b cix cix args, + Match <$> genSmallInt <*> genBranch, + Ins <$> genInstr <*> genSection, + Let <$> genSection <*> genCombIx <*> genSmallInt <*> genSection, + DMatch <$> Gen.maybe genReference <*> genSmallInt <*> genBranch, + NMatch <$> Gen.maybe genReference <*> genSmallInt <*> genBranch, + RMatch <$> genSmallInt <*> genSection <*> genEnumMap genSmallWord64 genBranch + ] + +genCombInfo :: Gen (GCombInfo CombIx) +genCombInfo = + LamI + <$> Gen.int (Range.linear 0 10) + <*> Gen.int (Range.linear 0 10) + <*> genSection + +genComb :: Gen Comb +genComb = + Gen.choice + [ Comb <$> genCombInfo + -- We omit cached closures from roundtrip tests since we don't currently serialize cached closure results + -- CachedClosure + ] + +genStoredCache :: Gen StoredCache +genStoredCache = + SCache + <$> (genEnumMap genSmallWord64 genCombs) + <*> (genEnumMap genSmallWord64 genReference) + <*> (genEnumSet genSmallWord64) + <*> (genEnumMap genSmallWord64 genReference) + <*> genSmallWord64 + <*> genSmallWord64 + <*> + -- We don't yet generate supergroups because generating valid ones is difficult. + mempty + <*> (Gen.map (Range.linear 0 10) ((,) <$> genReference <*> genSmallWord64)) + <*> (Gen.map (Range.linear 0 10) ((,) <$> genReference <*> genSmallWord64)) + <*> (Gen.map (Range.linear 0 10) ((,) <$> genReference <*> (Gen.set (Range.linear 0 10) genReference))) + +sCacheRoundtrip :: Property +sCacheRoundtrip = + getPutRoundtrip getStoredCache (putStoredCache) genStoredCache + +getPutRoundtrip :: (Eq a, Show a) => Get a -> (a -> Put) -> Gen a -> Property +getPutRoundtrip get put builder = + property $ do + v <- forAll builder + let bytes = runPutS (put v) + runGetS get bytes === Right v diff --git a/parser-typechecker/tests/Unison/Test/UnisonSources.hs b/unison-runtime/tests/Unison/Test/UnisonSources.hs similarity index 99% rename from parser-typechecker/tests/Unison/Test/UnisonSources.hs rename to unison-runtime/tests/Unison/Test/UnisonSources.hs index e618ac8fb9..0f7cb980c5 100644 --- a/parser-typechecker/tests/Unison/Test/UnisonSources.hs +++ b/unison-runtime/tests/Unison/Test/UnisonSources.hs @@ -10,7 +10,7 @@ import System.FilePath (joinPath, replaceExtension, splitPath) import System.FilePath.Find (always, extension, find, (==?)) import Unison.Builtin qualified as Builtin import Unison.Codebase.Runtime (Runtime, evaluateWatches) -import Unison.NamesWithHistory qualified as Names +import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) import Unison.Parsers qualified as Parsers import Unison.Prelude diff --git a/unison-runtime/unison-runtime.cabal b/unison-runtime/unison-runtime.cabal new file mode 100644 index 0000000000..cc6e59bc6a --- /dev/null +++ b/unison-runtime/unison-runtime.cabal @@ -0,0 +1,223 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.37.0. +-- +-- see: https://github.com/sol/hpack + +name: unison-runtime +version: 0.0.0 +homepage: https://github.com/unisonweb/unison#readme +bug-reports: https://github.com/unisonweb/unison/issues +copyright: Copyright (C) 2013-2024 Unison Computing, PBC and contributors +license: MIT +license-file: LICENSE +build-type: Simple + +source-repository head + type: git + location: https://github.com/unisonweb/unison + +flag arraychecks + manual: True + default: False + +flag stackchecks + manual: True + default: False + +library + exposed-modules: + Unison.Codebase.Execute + Unison.Runtime.ANF + Unison.Runtime.ANF.Rehash + Unison.Runtime.ANF.Serialize + Unison.Runtime.Array + Unison.Runtime.Builtin + Unison.Runtime.Builtin.Types + Unison.Runtime.Crypto.Rsa + Unison.Runtime.Debug + Unison.Runtime.Decompile + Unison.Runtime.Exception + Unison.Runtime.Foreign + Unison.Runtime.Foreign.Function + Unison.Runtime.Interface + Unison.Runtime.IOSource + Unison.Runtime.Machine + Unison.Runtime.MCode + Unison.Runtime.MCode.Serialize + Unison.Runtime.Pattern + Unison.Runtime.Serialize + Unison.Runtime.SparseVector + Unison.Runtime.Stack + Unison.Runtime.TypeTags + Unison.Runtime.Vector + hs-source-dirs: + src + default-extensions: + ApplicativeDo + BangPatterns + BlockArguments + DeriveAnyClass + DeriveFunctor + DeriveGeneric + DeriveTraversable + DerivingStrategies + DerivingVia + DoAndIfThenElse + DuplicateRecordFields + FlexibleContexts + FlexibleInstances + GeneralizedNewtypeDeriving + ImportQualifiedPost + LambdaCase + MultiParamTypeClasses + NamedFieldPuns + OverloadedLabels + OverloadedRecordDot + OverloadedStrings + PatternSynonyms + RankNTypes + ScopedTypeVariables + StandaloneDeriving + TupleSections + TypeApplications + TypeFamilies + ViewPatterns + ghc-options: -Wall -funbox-strict-fields -O2 + build-depends: + asn1-encoding + , asn1-types + , atomic-primops + , base + , binary + , bytes + , bytestring + , cereal + , clock + , containers >=0.6.3 + , crypton-x509 + , crypton-x509-store + , crypton-x509-system + , cryptonite + , data-default + , data-memocombinators + , deepseq + , directory + , exceptions + , filepath + , iproute + , lens + , memory + , mmorph + , mtl + , murmur-hash + , network + , network-simple + , network-udp + , pem + , primitive + , process + , raw-strings-qq + , safe-exceptions + , stm + , tagged + , temporary + , text + , time + , tls + , unison-codebase-sqlite + , unison-core + , unison-core1 + , unison-hash + , unison-parser-typechecker + , unison-prelude + , unison-pretty-printer + , unison-syntax + , unison-util-bytes + , unison-util-recursion + , unliftio + , vector + default-language: Haskell2010 + if flag(arraychecks) + cpp-options: -DARRAY_CHECK + if flag(stackchecks) + cpp-options: -DSTACK_CHECK + +test-suite runtime-tests + type: exitcode-stdio-1.0 + main-is: Suite.hs + other-modules: + Unison.Test.Common + Unison.Test.Gen + Unison.Test.Runtime.ANF + Unison.Test.Runtime.ANF.Serialization + Unison.Test.Runtime.Crypto.Rsa + Unison.Test.Runtime.MCode + Unison.Test.Runtime.MCode.Serialization + Unison.Test.UnisonSources + Paths_unison_runtime + hs-source-dirs: + tests + default-extensions: + ApplicativeDo + BangPatterns + BlockArguments + DeriveAnyClass + DeriveFunctor + DeriveGeneric + DeriveTraversable + DerivingStrategies + DerivingVia + DoAndIfThenElse + DuplicateRecordFields + FlexibleContexts + FlexibleInstances + GeneralizedNewtypeDeriving + ImportQualifiedPost + LambdaCase + MultiParamTypeClasses + NamedFieldPuns + OverloadedLabels + OverloadedRecordDot + OverloadedStrings + PatternSynonyms + RankNTypes + ScopedTypeVariables + StandaloneDeriving + TupleSections + TypeApplications + TypeFamilies + ViewPatterns + ghc-options: -Wall -funbox-strict-fields -O2 -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0 + build-depends: + base + , bytes + , cereal + , code-page + , containers + , cryptonite + , directory + , easytest + , filemanip + , filepath + , hedgehog + , hex-text + , lens + , megaparsec + , mtl + , primitive + , stm + , text + , unison-core1 + , unison-hash + , unison-parser-typechecker + , unison-prelude + , unison-pretty-printer + , unison-runtime + , unison-syntax + , unison-util-bytes + default-language: Haskell2010 + if flag(arraychecks) + cpp-options: -DARRAY_CHECK + if flag(stackchecks) + cpp-options: -DSTACK_CHECK diff --git a/unison-share-api/package.yaml b/unison-share-api/package.yaml index 795268354f..acbb020908 100644 --- a/unison-share-api/package.yaml +++ b/unison-share-api/package.yaml @@ -39,13 +39,10 @@ dependencies: - fuzzyfind - http-media - http-types - - jose - - jwt - lens - lucid - memory - mtl - - mwc-random - nonempty-containers - openapi3 - regex-tdfa @@ -54,7 +51,6 @@ dependencies: - servant-docs - servant-openapi3 - servant-server - - servant-auth - text - transformers - unison-codebase @@ -68,13 +64,12 @@ dependencies: - unison-parser-typechecker - unison-prelude - unison-pretty-printer - - unison-util-base32hex + - unison-runtime - unison-util-relation - unison-share-projects-api - unison-sqlite - unison-syntax - unliftio - - unordered-containers - uri-encode - utf8-string - vector diff --git a/unison-share-api/src/Unison/Server/Backend.hs b/unison-share-api/src/Unison/Server/Backend.hs index 6bea3c704a..f40a85b248 100644 --- a/unison-share-api/src/Unison/Server/Backend.hs +++ b/unison-share-api/src/Unison/Server/Backend.hs @@ -111,6 +111,7 @@ import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.Editor.DisplayObject import Unison.Codebase.Editor.DisplayObject qualified as DisplayObject +import Unison.Codebase.Execute qualified as Codebase import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path import Unison.Codebase.Runtime qualified as Rt @@ -801,7 +802,7 @@ evalDocRef rt codebase r = do eval errsVar (Term.amap (const mempty) -> tm) = do -- We use an empty ppe for evalutation, it's only used for adding additional context to errors. let evalPPE = PPE.empty - let codeLookup = Codebase.toCodeLookup codebase + let codeLookup = Codebase.codebaseToCodeLookup codebase let cache r = fmap Term.unannotate <$> Codebase.runTransaction codebase (Codebase.lookupWatchCache codebase r) r <- fmap hush . liftIO $ Rt.evaluateTerm' codeLookup cache evalPPE rt tm -- Only cache watches when we're not in readonly mode diff --git a/unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs b/unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs index d69f0ac8a3..abef221e37 100644 --- a/unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs +++ b/unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs @@ -35,10 +35,24 @@ diffSyntaxText (AnnotatedText fromST) (AnnotatedText toST) = where -- We special-case situations where the name of a definition changed but its hash didn't; -- and cases where the name didn't change but the hash did. - -- So, we treat these elements as equal then detect them in a post-processing step. + -- + -- The diff algorithm only understands whether items are equal or not, so in order to add this special behavior we + -- treat these special cases as equal, then we can detect and expand them in a post-processing step. diffEq :: AT.Segment Syntax.Element -> AT.Segment Syntax.Element -> Bool diffEq (AT.Segment {segment = fromSegment, annotation = fromAnnotation}) (AT.Segment {segment = toSegment, annotation = toAnnotation}) = - fromSegment == toSegment || fromAnnotation == toAnnotation + fromSegment == toSegment + || case (fromAnnotation, toAnnotation) of + (Nothing, _) -> False + (_, Nothing) -> False + (Just a, Just b) -> + case a of + -- The set of annotations we want to special-case + Syntax.TypeReference {} -> a == b + Syntax.TermReference {} -> a == b + Syntax.DataConstructorReference {} -> a == b + Syntax.AbilityConstructorReference {} -> a == b + Syntax.HashQualifier {} -> a == b + _ -> False expandSpecialCases :: [Diff.Diff [AT.Segment (Syntax.Element)]] -> [SemanticSyntaxDiff] expandSpecialCases xs = @@ -53,11 +67,28 @@ diffSyntaxText (AnnotatedText fromST) (AnnotatedText toST) = ( \next acc -> case (acc, next) of (Both xs : rest, Left seg) -> Both (seg : xs) : rest (_, Left seg) -> Both [seg] : acc - (_, Right diff) -> diff : acc + (_, Right diff) -> diff ++ acc ) - detectSpecialCase :: AT.Segment Syntax.Element -> AT.Segment Syntax.Element -> Either (AT.Segment Syntax.Element) SemanticSyntaxDiff + detectSpecialCase :: AT.Segment Syntax.Element -> AT.Segment Syntax.Element -> Either (AT.Segment Syntax.Element) [SemanticSyntaxDiff] detectSpecialCase fromSegment toSegment | fromSegment == toSegment = Left fromSegment - | AT.annotation fromSegment == AT.annotation toSegment = Right (SegmentChange (AT.segment fromSegment, AT.segment toSegment) (AT.annotation fromSegment)) - | AT.segment fromSegment == AT.segment toSegment = Right (AnnotationChange (AT.segment fromSegment) (AT.annotation fromSegment, AT.annotation toSegment)) - | otherwise = error "diffSyntaxText: found Syntax Elements in 'both' which have nothing in common." + | AT.annotation fromSegment == AT.annotation toSegment = Right [SegmentChange (AT.segment fromSegment, AT.segment toSegment) (AT.annotation fromSegment)] + -- We only emit an annotation change if it's a change in just the hash of the element (optionally the KIND of hash reference can change too). + | AT.segment fromSegment == AT.segment toSegment, + Just _fromHash <- AT.annotation fromSegment >>= elementHash, + Just _toHash <- AT.annotation toSegment >>= elementHash = + Right [AnnotationChange (AT.segment fromSegment) (AT.annotation fromSegment, AT.annotation toSegment)] + | otherwise = + -- the annotation changed, but it's not a recognized hash change. + -- This can happen in certain special cases, e.g. a paren changed from being a syntax element into being part + -- of a unit. + -- We just emit both as old/new segments. + Right [Old [fromSegment], New [toSegment]] + where + elementHash :: Syntax.Element -> Maybe Syntax.UnisonHash + elementHash = \case + Syntax.TypeReference hash -> Just hash + Syntax.TermReference hash -> Just hash + Syntax.DataConstructorReference hash -> Just hash + Syntax.AbilityConstructorReference hash -> Just hash + _ -> Nothing diff --git a/unison-share-api/unison-share-api.cabal b/unison-share-api/unison-share-api.cabal index d0a49365b1..5226322629 100644 --- a/unison-share-api/unison-share-api.cabal +++ b/unison-share-api/unison-share-api.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.0. +-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack @@ -103,19 +103,15 @@ library , fuzzyfind , http-media , http-types - , jose - , jwt , lens , lucid , memory , mtl - , mwc-random , nonempty-containers , openapi3 , regex-tdfa , serialise , servant - , servant-auth , servant-docs , servant-openapi3 , servant-server @@ -132,13 +128,12 @@ library , unison-parser-typechecker , unison-prelude , unison-pretty-printer + , unison-runtime , unison-share-projects-api , unison-sqlite , unison-syntax - , unison-util-base32hex , unison-util-relation , unliftio - , unordered-containers , uri-encode , utf8-string , vector @@ -208,19 +203,15 @@ test-suite unison-share-api-tests , hedgehog , http-media , http-types - , jose - , jwt , lens , lucid , memory , mtl - , mwc-random , nonempty-containers , openapi3 , regex-tdfa , serialise , servant - , servant-auth , servant-docs , servant-openapi3 , servant-server @@ -237,14 +228,13 @@ test-suite unison-share-api-tests , unison-parser-typechecker , unison-prelude , unison-pretty-printer + , unison-runtime , unison-share-api , unison-share-projects-api , unison-sqlite , unison-syntax - , unison-util-base32hex , unison-util-relation , unliftio - , unordered-containers , uri-encode , utf8-string , vector diff --git a/unison-share-projects-api/package.yaml b/unison-share-projects-api/package.yaml index 39545662ed..10694036b6 100644 --- a/unison-share-projects-api/package.yaml +++ b/unison-share-projects-api/package.yaml @@ -11,7 +11,6 @@ library: dependencies: - aeson - base - - containers - jose - jwt - lens @@ -21,7 +20,6 @@ dependencies: - unison-hash - unison-hash-orphans-aeson - unison-prelude - - unordered-containers ghc-options: -Wall diff --git a/unison-share-projects-api/unison-share-projects-api.cabal b/unison-share-projects-api/unison-share-projects-api.cabal index 3460047cc3..1ed58ed848 100644 --- a/unison-share-projects-api/unison-share-projects-api.cabal +++ b/unison-share-projects-api/unison-share-projects-api.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -54,7 +54,6 @@ library build-depends: aeson , base - , containers , jose , jwt , lens @@ -64,5 +63,4 @@ library , unison-hash , unison-hash-orphans-aeson , unison-prelude - , unordered-containers default-language: Haskell2010 diff --git a/unison-src/builtin-tests/base.md b/unison-src/builtin-tests/base.md index 70443ad0f7..572869b922 100644 --- a/unison-src/builtin-tests/base.md +++ b/unison-src/builtin-tests/base.md @@ -4,7 +4,7 @@ otherwise it may reuse a previously cached codebase. Thus, make sure the contents of this file define the contents of the cache (e.g. don't pull `latest`.) -```ucm +``` ucm scratch/main> pull @unison/base/releases/2.5.0 .base scratch/main> builtins.mergeio scratch/main> undo diff --git a/unison-src/builtin-tests/interpreter-tests.output.md b/unison-src/builtin-tests/interpreter-tests.output.md index 7ba9ed8bb7..8f313d114f 100644 --- a/unison-src/builtin-tests/interpreter-tests.output.md +++ b/unison-src/builtin-tests/interpreter-tests.output.md @@ -4,6 +4,18 @@ If you want to add or update tests, you can create a branch of that project, and Before merging the PR on Github, we'll merge your branch on Share and restore `runtime_tests_version` to /main or maybe a release. +``` ucm :hide:error +scratch/main> this is a hack to trigger an error, in order to swallow any error on the next line. + +scratch/main> we delete the project to avoid any merge conflicts or complaints from ucm. + +scratch/main> delete.project runtime-tests +``` + +``` ucm :hide +scratch/main> clone @unison/runtime-tests/releases/0.0.1 runtime-tests/selected +``` + ``` ucm runtime-tests/selected> run tests @@ -12,5 +24,4 @@ runtime-tests/selected> run tests runtime-tests/selected> run tests.interpreter.only () - ``` diff --git a/unison-src/builtin-tests/interpreter-tests.sh b/unison-src/builtin-tests/interpreter-tests.sh index 969c3ec754..f792b5a2fd 100755 --- a/unison-src/builtin-tests/interpreter-tests.sh +++ b/unison-src/builtin-tests/interpreter-tests.sh @@ -1,11 +1,13 @@ -#!/bin/bash +#!/usr/bin/env bash set -ex -ucm=$(stack exec -- which unison) -echo "$ucm" +if [ -z "$1" ]; then + ucm=$(stack exec -- which unison) +else + ucm="$1" +fi -runtime_tests_version="@unison/runtime-tests/main" -echo $runtime_tests_version +runtime_tests_version="@unison/runtime-tests/releases/0.0.1" codebase=${XDG_CACHE_HOME:-"$HOME/.cache"}/unisonlanguage/runtime-tests.unison @@ -13,5 +15,4 @@ runtime_tests_version="$runtime_tests_version" \ envsubst '$runtime_tests_version' \ < unison-src/builtin-tests/interpreter-tests.tpl.md \ > unison-src/builtin-tests/interpreter-tests.md -echo "$ucm" transcript.fork -C $codebase -S $codebase unison-src/builtin-tests/interpreter-tests.md time "$ucm" transcript.fork -C $codebase -S $codebase unison-src/builtin-tests/interpreter-tests.md diff --git a/unison-src/builtin-tests/interpreter-tests.tpl.md b/unison-src/builtin-tests/interpreter-tests.tpl.md index 9e34968a78..5ad0d23052 100644 --- a/unison-src/builtin-tests/interpreter-tests.tpl.md +++ b/unison-src/builtin-tests/interpreter-tests.tpl.md @@ -4,16 +4,16 @@ If you want to add or update tests, you can create a branch of that project, and Before merging the PR on Github, we'll merge your branch on Share and restore `runtime_tests_version` to /main or maybe a release. -```ucm:hide:error +``` ucm :hide:error scratch/main> this is a hack to trigger an error, in order to swallow any error on the next line. scratch/main> we delete the project to avoid any merge conflicts or complaints from ucm. scratch/main> delete.project runtime-tests ``` -```ucm:hide +``` ucm :hide scratch/main> clone ${runtime_tests_version} runtime-tests/selected ``` -```ucm +``` ucm runtime-tests/selected> run tests runtime-tests/selected> run tests.interpreter.only ``` diff --git a/unison-src/builtin-tests/jit-tests.sh b/unison-src/builtin-tests/jit-tests.sh index 8e29209dc1..1cba258c06 100755 --- a/unison-src/builtin-tests/jit-tests.sh +++ b/unison-src/builtin-tests/jit-tests.sh @@ -8,7 +8,7 @@ if [ -z "$1" ]; then exit 1 fi -runtime_tests_version="@unison/runtime-tests/main" +runtime_tests_version="@unison/runtime-tests/releases/0.0.1" echo $runtime_tests_version codebase=${XDG_CACHE_HOME:-"$HOME/.cache"}/unisonlanguage/runtime-tests.unison diff --git a/unison-src/builtin-tests/jit-tests.tpl.md b/unison-src/builtin-tests/jit-tests.tpl.md index ea4a65793d..b0d06a24a9 100644 --- a/unison-src/builtin-tests/jit-tests.tpl.md +++ b/unison-src/builtin-tests/jit-tests.tpl.md @@ -4,16 +4,16 @@ If you want to add or update tests, you can create a branch of that project, and Before merging the PR on Github, we'll merge your branch on Share and restore `runtime_tests_version` to /main or maybe a release. -```ucm:hide:error +``` ucm :hide:error scratch/main> this is a hack to trigger an error, in order to swallow any error on the next line. scratch/main> we delete the project to avoid any merge conflicts or complaints from ucm. scratch/main> delete.project runtime-tests ``` -```ucm:hide +``` ucm :hide scratch/main> clone ${runtime_tests_version} runtime-tests/selected ``` -```ucm +``` ucm runtime-tests/selected> run.native tests runtime-tests/selected> run.native tests.jit.only ``` @@ -21,7 +21,7 @@ runtime-tests/selected> run.native tests.jit.only Per Dan: It's testing a flaw in how we were sending code from a scratch file to the native runtime, when that happened multiple times. Related to the verifiable refs and recursive functions. -```unison +``` unison foo = do go : Nat ->{Exception} () go = cases @@ -30,7 +30,7 @@ foo = do go 1000 ``` -```ucm +``` ucm scratch/main> run.native foo scratch/main> run.native foo ``` @@ -39,6 +39,6 @@ This can also only be tested by separately running this test, because it is exercising the protocol that ucm uses to talk to the jit during an exception. -```ucm:error +``` ucm :error runtime-tests/selected> run.native testBug ``` diff --git a/unison-src/tests/type-application.u b/unison-src/tests/type-application.u index 87b673809d..345bcc2aee 100644 --- a/unison-src/tests/type-application.u +++ b/unison-src/tests/type-application.u @@ -3,6 +3,7 @@ structural ability Foo where foo : {Foo} Nat structural type Wrap a = Wrap Nat +structural type C = C (Wrap {}) -- constrain Wrap kind blah : Wrap {Foo} -> Nat blah = cases diff --git a/unison-src/transcripts-manual/benchmarks.md b/unison-src/transcripts-manual/benchmarks.md index 2a3fe38a66..c1ae19d148 100644 --- a/unison-src/transcripts-manual/benchmarks.md +++ b/unison-src/transcripts-manual/benchmarks.md @@ -1,96 +1,96 @@ -```ucm:hide +``` ucm :hide scratch/main> pull unison.public.base.releases.M4d base scratch/main> pull runarorama.public.sort.data sort ``` -```unison:hide +``` unison :hide benchmarkFilePath = FilePath "unison-src/transcripts-manual/benchmarks/output.bench.txt" archiveFilePath = FilePath "unison-src/transcripts-manual/benchmarks/output" timeit : Text -> '{IO,Exception} a ->{IO,Exception} a -timeit label a = +timeit label a = before = !realtime r = !a after = !realtime elapsed = Duration.between before after elapsedText = Duration.toText elapsed - go file = + go file = putText file ("\n" ++ label ++ " " ++ Int.toText (Duration.countMicroseconds elapsed) ++ " # " ++ elapsedText) printLine ("\n\n ******** \n") printLine (label ++ " took " ++ elapsedText) bracket '(FilePath.open benchmarkFilePath FileMode.Append) Handle.close go r -prepare = do - -- if benchmarkFilePath exists, move it to blah-.txt for archive purposes +prepare = do + -- if benchmarkFilePath exists, move it to blah-.txt for archive purposes use Text ++ if FilePath.exists benchmarkFilePath then createDirectory archiveFilePath now = OffsetDateTime.toText (atUTC !realtime) - timestamped = FilePath.toText archiveFilePath ++ "/" ++ now ++ "-bench.txt" + timestamped = FilePath.toText archiveFilePath ++ "/" ++ now ++ "-bench.txt" renameFile benchmarkFilePath (FilePath timestamped) - else + else () ``` -```ucm:hide +``` ucm :hide scratch/main> add scratch/main> run prepare ``` ## Benchmarks -```ucm +``` ucm scratch/main> load unison-src/transcripts-manual/benchmarks/each.u scratch/main> run main ``` -```ucm +``` ucm scratch/main> load unison-src/transcripts-manual/benchmarks/listmap.u scratch/main> run main ``` -```ucm +``` ucm scratch/main> load unison-src/transcripts-manual/benchmarks/listfilter.u scratch/main> run main ``` -```ucm +``` ucm scratch/main> load unison-src/transcripts-manual/benchmarks/random.u scratch/main> run main ``` -```ucm +``` ucm scratch/main> load unison-src/transcripts-manual/benchmarks/simpleloop.u scratch/main> run main ``` -```ucm +``` ucm scratch/main> load unison-src/transcripts-manual/benchmarks/fibonacci.u scratch/main> run main ``` -```ucm +``` ucm scratch/main> load unison-src/transcripts-manual/benchmarks/map.u scratch/main> run main ``` -```ucm +``` ucm scratch/main> load unison-src/transcripts-manual/benchmarks/natmap.u scratch/main> run main ``` -```ucm +``` ucm scratch/main> load unison-src/transcripts-manual/benchmarks/stm.u scratch/main> run main ``` -```ucm +``` ucm scratch/main> load unison-src/transcripts-manual/benchmarks/tmap.u scratch/main> run main ``` -```ucm +``` ucm scratch/main> load unison-src/transcripts-manual/benchmarks/array-sort.u scratch/main> run main -``` \ No newline at end of file +``` diff --git a/unison-src/transcripts-manual/docs.to-html.md b/unison-src/transcripts-manual/docs.to-html.md index 282de4e5e5..8b1fa6b688 100644 --- a/unison-src/transcripts-manual/docs.to-html.md +++ b/unison-src/transcripts-manual/docs.to-html.md @@ -1,8 +1,8 @@ -```ucm +``` ucm test-html-docs/main> builtins.mergeio lib.builtins ``` -```unison +``` unison {{A doc directly in the namespace.}} some.ns.direct = 1 @@ -13,7 +13,7 @@ some.ns.pretty.deeply.nested = 2 some.outside = 3 ``` -```ucm +``` ucm test-html-docs/main> add test-html-docs/main> docs.to-html some.ns unison-src/transcripts-manual/docs.to-html ``` diff --git a/unison-src/transcripts-manual/docs.to-html.output.md b/unison-src/transcripts-manual/docs.to-html.output.md index 5c938806be..45528703fa 100644 --- a/unison-src/transcripts-manual/docs.to-html.output.md +++ b/unison-src/transcripts-manual/docs.to-html.output.md @@ -2,8 +2,8 @@ test-html-docs/main> builtins.mergeio lib.builtins Done. - ``` + ``` unison {{A doc directly in the namespace.}} some.ns.direct = 1 @@ -15,14 +15,13 @@ some.ns.pretty.deeply.nested = 2 some.outside = 3 ``` -``` ucm - +``` ucm :added-by-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`: some.ns.direct : Nat @@ -31,13 +30,13 @@ some.outside = 3 some.ns.pretty.deeply.nested.doc : Doc2 some.outside : Nat some.outside.doc : Doc2 - ``` + ``` ucm test-html-docs/main> add ⍟ I've added these definitions: - + some.ns.direct : Nat some.ns.direct.doc : Doc2 some.ns.pretty.deeply.nested : Nat @@ -46,5 +45,4 @@ test-html-docs/main> add some.outside.doc : Doc2 test-html-docs/main> docs.to-html some.ns unison-src/transcripts-manual/docs.to-html - ``` diff --git a/unison-src/transcripts-manual/gen-racket-libs.md b/unison-src/transcripts-manual/gen-racket-libs.md index 311d056641..261c8688b1 100644 --- a/unison-src/transcripts-manual/gen-racket-libs.md +++ b/unison-src/transcripts-manual/gen-racket-libs.md @@ -1,17 +1,16 @@ - When we start out, `./scheme-libs/racket` contains a bunch of library files that we'll need. They define the Unison builtins for Racket. Next, we'll download the jit project and generate a few Racket files from it. -```ucm -jit-setup/main> lib.install @unison/internal/releases/0.0.18 +``` ucm +jit-setup/main> lib.install @unison/internal/releases/0.0.25 ``` -```unison +``` unison go = generateSchemeBoot "scheme-libs/racket" ``` -```ucm +``` ucm jit-setup/main> run go ``` diff --git a/unison-src/transcripts-manual/gen-racket-libs.output.md b/unison-src/transcripts-manual/gen-racket-libs.output.md index 178d4b6f4e..d3bbb3946f 100644 --- a/unison-src/transcripts-manual/gen-racket-libs.output.md +++ b/unison-src/transcripts-manual/gen-racket-libs.output.md @@ -3,12 +3,12 @@ When we start out, `./scheme-libs/racket` contains a bunch of library files that Next, we'll download the jit project and generate a few Racket files from it. ``` ucm -jit-setup/main> lib.install @unison/internal/releases/0.0.18 +jit-setup/main> lib.install @unison/internal/releases/0.0.25 - Downloaded 14949 entities. + Downloaded 14942 entities. - I installed @unison/internal/releases/0.0.18 as - unison_internal_0_0_18. + I installed @unison/internal/releases/0.0.25 as + unison_internal_0_0_25. ``` ``` unison @@ -39,14 +39,13 @@ complement of unison libraries for a given combination of ucm version and @unison/internal version. To set up racket to use these files, we need to create a package with -them. This is accomplished by running. +them. This is accomplished by running: ``` -raco pkg install -t dir unison +raco pkg install -t dir scheme-libs/racket/unison ``` -in the directory where the `unison` directory is located. Then the -runtime executable can be built with +After, the runtime executable can be built with ``` raco exe scheme-libs/racket/unison-runtime.rkt diff --git a/unison-src/transcripts-manual/remote-tab-completion.md b/unison-src/transcripts-manual/remote-tab-completion.md index 55b4adeec1..c144ed5634 100644 --- a/unison-src/transcripts-manual/remote-tab-completion.md +++ b/unison-src/transcripts-manual/remote-tab-completion.md @@ -2,6 +2,6 @@ Note: this makes a network call to share to get completions -```ucm +``` ucm scratch/main> debug.tab-complete pull unison.pub ``` diff --git a/unison-src/transcripts-manual/remote-tab-completion.output.md b/unison-src/transcripts-manual/remote-tab-completion.output.md index 27906fa2f6..a662ebd566 100644 --- a/unison-src/transcripts-manual/remote-tab-completion.output.md +++ b/unison-src/transcripts-manual/remote-tab-completion.output.md @@ -2,7 +2,7 @@ Note: this makes a network call to share to get completions -```ucm +``` ucm .> debug.tab-complete pull unison.pub unison.public diff --git a/unison-src/transcripts-manual/rewrites.md b/unison-src/transcripts-manual/rewrites.md index 891cf53bd1..f77c87502a 100644 --- a/unison-src/transcripts-manual/rewrites.md +++ b/unison-src/transcripts-manual/rewrites.md @@ -1,5 +1,4 @@ - -```ucm:hide +``` ucm :hide scratch/main> builtins.mergeio scratch/main> load unison-src/transcripts-using-base/base.u scratch/main> add @@ -9,7 +8,7 @@ scratch/main> add Here's a scratch file with some rewrite rules: -```unison:hide +``` unison :hide ex1 = List.map (x -> x + 1) [1,2,3,4,5,6,7] eitherToOptional e a = @@ -36,25 +35,25 @@ rule2 x = @rewrite signature Optional ==> Optional2 Let's rewrite these: -```ucm +``` ucm scratch/main> rewrite rule1 scratch/main> rewrite eitherToOptional ``` -```ucm:hide +``` ucm :hide scratch/main> load scratch/main> add ``` After adding to the codebase, here's the rewritten source: -```ucm +``` ucm scratch/main> view ex1 Either.mapRight rule1 ``` Another example, showing that we can rewrite to definitions that only exist in the file: -```unison:hide +``` unison :hide unique ability Woot1 where woot1 : () -> Nat unique ability Woot2 where woot2 : () -> Nat @@ -74,24 +73,24 @@ blah2 = 456 Let's apply the rewrite `woot1to2`: -```ucm +``` ucm scratch/main> rewrite woot1to2 ``` -```ucm:hide +``` ucm :hide scratch/main> load scratch/main> add ``` After adding the rewritten form to the codebase, here's the rewritten `Woot1` to `Woot2`: -```ucm +``` ucm scratch/main> view wootEx ``` This example shows that rewrite rules can to refer to term definitions that only exist in the file: -```unison:hide +``` unison :hide foo1 = b = "b" 123 @@ -110,7 +109,7 @@ sameFileEx = foo1 ``` -```ucm:hide +``` ucm :hide scratch/main> rewrite rule scratch/main> load scratch/main> add @@ -118,13 +117,13 @@ scratch/main> add After adding the rewritten form to the codebase, here's the rewritten definitions: -```ucm +``` ucm scratch/main> view foo1 foo2 sameFileEx ``` ## Capture avoidance -```unison:hide +``` unison :hide bar1 = b = "bar" 123 @@ -144,19 +143,19 @@ sameFileEx = In the above example, `bar2` is locally bound by the rule, so when applied, it should not refer to the `bar2` top level binding. -```ucm +``` ucm scratch/main> rewrite rule ``` Instead, it should be an unbound free variable, which doesn't typecheck: -```ucm:error +``` ucm :error scratch/main> load ``` In this example, the `a` is locally bound by the rule, so it shouldn't capture the `a = 39494` binding which is in scope at the point of the replacement: -```unison:hide +``` unison :hide bar2 = a = 39494 233 @@ -166,32 +165,32 @@ rule a = @rewrite term 233 ==> a ``` -```ucm +``` ucm scratch/main> rewrite rule ``` The `a` introduced will be freshened to not capture the `a` in scope, so it remains as an unbound variable and is a type error: -```ucm:error +``` ucm :error scratch/main> load ``` ## Structural find -```unison:hide +``` unison :hide eitherEx = Left ("hello", "there") ``` -```ucm:hide +``` ucm :hide scratch/main> add ``` -```unison:hide +``` unison :hide findEitherEx x = @rewrite term Left ("hello", x) ==> Left ("hello" Text.++ x) findEitherFailure = @rewrite signature a . Either Failure a ==> () ``` -```ucm +``` ucm scratch/main> sfind findEitherEx scratch/main> sfind findEitherFailure scratch/main> find 1-5 diff --git a/unison-src/transcripts-manual/rewrites.output.md b/unison-src/transcripts-manual/rewrites.output.md index 26cd59b494..3f0a21e692 100644 --- a/unison-src/transcripts-manual/rewrites.output.md +++ b/unison-src/transcripts-manual/rewrites.output.md @@ -1,8 +1,16 @@ +``` ucm :hide +scratch/main> builtins.mergeio + +scratch/main> load unison-src/transcripts-using-base/base.u + +scratch/main> add +``` + ## Structural find and replace Here's a scratch file with some rewrite rules: -``` unison +``` unison :hide ex1 = List.map (x -> x + 1) [1,2,3,4,5,6,7] eitherToOptional e a = @@ -33,22 +41,22 @@ Let's rewrite these: scratch/main> rewrite rule1 ☝️ - + I found and replaced matches in these definitions: ex1 - + The rewritten file has been added to the top of scratch.u scratch/main> rewrite eitherToOptional ☝️ - + I found and replaced matches in these definitions: Either.mapRight - - The rewritten file has been added to the top of scratch.u + The rewritten file has been added to the top of scratch.u ``` -``` unison:added-by-ucm scratch.u + +``` unison :added-by-ucm scratch.u -- | Rewrote using: -- | Modified definition(s): ex1 @@ -78,7 +86,7 @@ type Optional2 a = Some2 a | None2 rule2 x = @rewrite signature Optional ==> Optional2 ``` -``` unison:added-by-ucm scratch.u +``` unison :added-by-ucm scratch.u -- | Rewrote using: -- | Modified definition(s): Either.mapRight @@ -108,6 +116,12 @@ type Optional2 a = Some2 a | None2 rule2 x = @rewrite signature Optional ==> Optional2 ``` +``` ucm :hide +scratch/main> load + +scratch/main> add +``` + After adding to the codebase, here's the rewritten source: ``` ucm @@ -117,10 +131,10 @@ scratch/main> view ex1 Either.mapRight rule1 Either.mapRight f = cases None -> None Some a -> Some (f a) - + ex1 : [Nat] ex1 = List.map Nat.increment [1, 2, 3, 4, 5, 6, 7] - + rule1 : (i ->{g} o) -> Nat @@ -132,11 +146,11 @@ scratch/main> view ex1 Either.mapRight rule1 @rewrite term x + 1 ==> Nat.increment x term a -> f a ==> f - ``` + Another example, showing that we can rewrite to definitions that only exist in the file: -``` unison +``` unison :hide unique ability Woot1 where woot1 : () -> Nat unique ability Woot2 where woot2 : () -> Nat @@ -160,13 +174,13 @@ Let's apply the rewrite `woot1to2`: scratch/main> rewrite woot1to2 ☝️ - + I found and replaced matches in these definitions: wootEx - - The rewritten file has been added to the top of scratch.u + The rewritten file has been added to the top of scratch.u ``` -``` unison:added-by-ucm scratch.u + +``` unison :added-by-ucm scratch.u -- | Rewrote using: -- | Modified definition(s): wootEx @@ -190,6 +204,12 @@ blah = 123 blah2 = 456 ``` +``` ucm :hide +scratch/main> load + +scratch/main> add +``` + After adding the rewritten form to the codebase, here's the rewritten `Woot1` to `Woot2`: ``` ucm @@ -199,11 +219,11 @@ scratch/main> view wootEx wootEx a = _ = woot2() blah2 - ``` + This example shows that rewrite rules can to refer to term definitions that only exist in the file: -``` unison +``` unison :hide foo1 = b = "b" 123 @@ -222,6 +242,14 @@ sameFileEx = foo1 ``` +``` ucm :hide +scratch/main> rewrite rule + +scratch/main> load + +scratch/main> add +``` + After adding the rewritten form to the codebase, here's the rewritten definitions: ``` ucm @@ -231,21 +259,21 @@ scratch/main> view foo1 foo2 sameFileEx foo1 = b = "b" 123 - + foo2 : Nat foo2 = a = "a" 233 - + sameFileEx : Nat sameFileEx = _ = "ex" foo2 - ``` + ## Capture avoidance -``` unison +``` unison :hide bar1 = b = "bar" 123 @@ -269,13 +297,13 @@ In the above example, `bar2` is locally bound by the rule, so when applied, it s scratch/main> rewrite rule ☝️ - + I found and replaced matches in these definitions: sameFileEx - - The rewritten file has been added to the top of scratch.u + The rewritten file has been added to the top of scratch.u ``` -``` unison:added-by-ucm scratch.u + +``` unison :added-by-ucm scratch.u -- | Rewrote using: -- | Modified definition(s): sameFileEx @@ -299,28 +327,28 @@ sameFileEx = Instead, it should be an unbound free variable, which doesn't typecheck: -``` ucm +``` ucm :error scratch/main> load Loading changes detected in scratch.u. I couldn't figure out what bar21 refers to here: - + 19 | bar21 - + I also don't know what type it should be. - + Some common causes of this error include: * Your current namespace is too deep to contain the definition in its subtree * The definition is part of a library which hasn't been added to this project * You have a typo in the name - ``` + In this example, the `a` is locally bound by the rule, so it shouldn't capture the `a = 39494` binding which is in scope at the point of the replacement: -``` unison +``` unison :hide bar2 = a = 39494 233 @@ -334,13 +362,13 @@ rule a = @rewrite scratch/main> rewrite rule ☝️ - + I found and replaced matches in these definitions: bar2 - - The rewritten file has been added to the top of scratch.u + The rewritten file has been added to the top of scratch.u ``` -``` unison:added-by-ucm scratch.u + +``` unison :added-by-ucm scratch.u -- | Rewrote using: -- | Modified definition(s): bar2 @@ -356,32 +384,36 @@ rule a = The `a` introduced will be freshened to not capture the `a` in scope, so it remains as an unbound variable and is a type error: -``` ucm +``` ucm :error scratch/main> load Loading changes detected in scratch.u. I couldn't figure out what a1 refers to here: - + 6 | a1 - + I also don't know what type it should be. - + Some common causes of this error include: * Your current namespace is too deep to contain the definition in its subtree * The definition is part of a library which hasn't been added to this project * You have a typo in the name - ``` + ## Structural find -``` unison +``` unison :hide eitherEx = Left ("hello", "there") ``` -``` unison +``` ucm :hide +scratch/main> add +``` + +``` unison :hide findEitherEx x = @rewrite term Left ("hello", x) ==> Left ("hello" Text.++ x) findEitherFailure = @rewrite signature a . Either Failure a ==> () ``` @@ -390,25 +422,25 @@ findEitherFailure = @rewrite signature a . Either Failure a ==> () scratch/main> sfind findEitherEx 🔎 - + These definitions from the current namespace (excluding `lib`) have matches: - + 1. eitherEx - + Tip: Try `edit 1` to bring this into your scratch file. scratch/main> sfind findEitherFailure 🔎 - + These definitions from the current namespace (excluding `lib`) have matches: - + 1. catch 2. printText 3. reraise 4. toEither 5. toEither.handler - + Tip: Try `edit 1` or `edit 1-5` to bring these into your scratch file. @@ -421,6 +453,4 @@ scratch/main> find 1-5 4. Exception.toEither.handler : Request {Exception} a -> Either Failure a 5. printText : Text ->{IO} Either Failure () - - ``` diff --git a/unison-src/transcripts-manual/scheme.md b/unison-src/transcripts-manual/scheme.md index 35aae31b26..5a65057371 100644 --- a/unison-src/transcripts-manual/scheme.md +++ b/unison-src/transcripts-manual/scheme.md @@ -1,12 +1,12 @@ This transcript executes very slowly, because the compiler has an entire copy of base (and other stuff) within it. -```ucm:hide +``` ucm :hide scratch/main> builtins.merge scratch/main> pull.without-history unison.public.base.trunk base ``` -```unison +``` unison stdOut = stdHandle StdOut print txt = @@ -54,7 +54,7 @@ multiAddUp : '{IO,Exception} () multiAddUp = repeat 35 '(printAddUp 3000000) ``` -```ucm +``` ucm scratch/main> add scratch/main> run singleAddUp scratch/main> run.native multiAddUp diff --git a/unison-src/transcripts-round-trip/main.md b/unison-src/transcripts-round-trip/main.md index a7d7b01f3e..fc9e320c04 100644 --- a/unison-src/transcripts-round-trip/main.md +++ b/unison-src/transcripts-round-trip/main.md @@ -1,52 +1,52 @@ This transcript verifies that the pretty-printer produces code that can be successfully parsed, for a variety of examples. Terms or types that fail to round-trip can be added to either `reparses-with-same-hash.u` or `reparses.u` as regression tests. -```ucm:hide +``` ucm :hide scratch/main> builtins.mergeio lib.builtins scratch/a1> builtins.mergeio lib.builtins scratch/a2> builtins.mergeio lib.builtins ``` -```ucm:hide +``` ucm :hide scratch/a1> load unison-src/transcripts-round-trip/reparses-with-same-hash.u scratch/a1> add ``` -```unison +``` unison x = () ``` -```ucm:hide +``` ucm :hide scratch/a1> find ``` So we can see the pretty-printed output: -```ucm -scratch/a1> edit 1-1000 +``` ucm +scratch/a1> edit.new 1-1000 ``` -```ucm:hide +``` ucm :hide scratch/a1> delete.namespace.force lib.builtins ``` -```ucm:hide +``` ucm :hide scratch/a2> load ``` -```ucm:hide +``` ucm :hide scratch/a2> add scratch/a2> delete.namespace.force lib.builtins ``` This diff should be empty if the two namespaces are equivalent. If it's nonempty, the diff will show us the hashes that differ. -```ucm:error +``` ucm :error scratch/main> diff.namespace /a1: /a2: ``` Now check that definitions in 'reparses.u' at least parse on round trip: -```ucm:hide +``` ucm :hide scratch/a3> builtins.mergeio lib.builtins scratch/a3> load unison-src/transcripts-round-trip/reparses.u scratch/a3> add @@ -54,19 +54,19 @@ scratch/a3> add This just makes 'roundtrip.u' the latest scratch file. -```unison:hide +``` unison :hide x = () ``` -```ucm:hide +``` ucm :hide scratch/a3> find ``` -```ucm -scratch/a3> edit 1-5000 +``` ucm +scratch/a3> edit.new 1-5000 ``` -```ucm:hide +``` ucm :hide scratch/a3_new> builtins.mergeio lib.builtins scratch/a3_new> load scratch/a3_new> add @@ -76,18 +76,18 @@ scratch/a3_new> delete.namespace.force lib.builtins These are currently all expected to have different hashes on round trip. -```ucm +``` ucm scratch/main> diff.namespace /a3_new: /a3: ``` ## Other regression tests not covered by above -### Builtins should appear commented out in the edit command +### Builtins should appear commented out in the edit.new command Regression test for https://github.com/unisonweb/unison/pull/3548 -```ucm +``` ucm scratch/regressions> alias.term ##Nat.+ plus -scratch/regressions> edit plus +scratch/regressions> edit.new plus scratch/regressions> load ``` diff --git a/unison-src/transcripts-round-trip/main.output.md b/unison-src/transcripts-round-trip/main.output.md index def5266331..967044686b 100644 --- a/unison-src/transcripts-round-trip/main.output.md +++ b/unison-src/transcripts-round-trip/main.output.md @@ -1,36 +1,53 @@ This transcript verifies that the pretty-printer produces code that can be successfully parsed, for a variety of examples. Terms or types that fail to round-trip can be added to either `reparses-with-same-hash.u` or `reparses.u` as regression tests. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins + +scratch/a1> builtins.mergeio lib.builtins + +scratch/a2> builtins.mergeio lib.builtins +``` + +``` ucm :hide +scratch/a1> load unison-src/transcripts-round-trip/reparses-with-same-hash.u + +scratch/a1> add +``` + ``` unison x = () ``` -``` ucm - +``` ucm :added-by-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`: x : () +``` +``` ucm :hide +scratch/a1> find ``` + So we can see the pretty-printed output: ``` ucm -scratch/a1> edit 1-1000 +scratch/a1> edit.new 1-1000 ☝️ - - I added 110 definitions to the top of scratch.u - + + I added 111 definitions to the top of scratch.u + You can edit them there, then run `update` to replace the definitions currently in this namespace. - ``` -````` unison:added-by-ucm scratch.u + +````` unison :added-by-ucm scratch.u structural ability Abort where abort : {Abort} a structural ability Ask a where ask : {Ask a} a @@ -122,6 +139,46 @@ ex3a = a = do qux3 + qux3 () +fixity : '('()) +fixity = + do + use Nat * + + (===) = (==) + f <| x = f x + (<<) f g x = f (g x) + (>>) f g x = g (f x) + id x = x + (do + (%) = Nat.mod + ($) = (+) + c = 1 * (2 + 3) * 4 + plus = 1 + 2 + 3 + plus2 = 1 + (2 + 3) + d = true && (false || true) + z = true || false && true + e = 1 + 2 >= 3 + 4 + f = 9 % 2 === 0 + g = 0 == 9 % 2 + h = 2 * (10 $ 20) + i1 = 1 * 2 $ (3 * 4) $ 5 + i2 = (1 * 2 $ 3) * 4 $ 5 + oo = (2 * 10 $ 20) * 30 $ 40 + ffffffffffffffffffff x = x + 1 + gg x = x * 2 + j = 10 |> ffffffffffffffffffff |> gg |> gg |> gg |> gg |> gg + k = ffffffffffffffffffff << gg << ffffffffffffffffffff <| 10 + l = 10 |> (ffffffffffffffffffff >> gg >> ffffffffffffffffffff) + zzz = 1 + 2 * 3 < 4 + 5 * 6 && 7 + 8 * 9 > 10 + 11 * 12 + zz = + (1 * 2 + 3 * 3 < 4 + 5 * 6 && 7 + 8 * 9 > 10 + 11 * 12) + === (1 + 3 * 3 < 4 + 5 * 6 && 7 + 8 * 9 > 10 + 11 * 12) + zzzz = + 1 * 2 + 3 * 3 < 4 + 5 * 6 + && 7 + 8 * 9 > 10 + 11 * 12 === 1 + 3 * 3 < 4 + 5 * 6 + && 7 + 8 * 9 > 10 + 11 * 12 + ()) + |> id + fix_1035 : Text fix_1035 = use Text ++ @@ -510,7 +567,7 @@ nested_fences : Doc2 nested_fences = {{ ```` raw - ```unison + ``` unison r = "boopydoo" ``` ```` @@ -590,8 +647,8 @@ softhang22 = softhang2 [0, 1, 2, 3, 4, 5] cases softhang23 : 'Nat softhang23 = do - use Nat + catchAll do + use Nat + x = 1 y = 2 x + y @@ -768,34 +825,60 @@ UUID.randomUUIDBytes = do a |> f = f a ````` +``` ucm :hide +scratch/a1> delete.namespace.force lib.builtins +``` + +``` ucm :hide +scratch/a2> load +``` + +``` ucm :hide +scratch/a2> add + +scratch/a2> delete.namespace.force lib.builtins +``` + This diff should be empty if the two namespaces are equivalent. If it's nonempty, the diff will show us the hashes that differ. -``` ucm +``` ucm :error scratch/main> diff.namespace /a1: /a2: The namespaces are identical. - ``` + Now check that definitions in 'reparses.u' at least parse on round trip: +``` ucm :hide +scratch/a3> builtins.mergeio lib.builtins + +scratch/a3> load unison-src/transcripts-round-trip/reparses.u + +scratch/a3> add +``` + This just makes 'roundtrip.u' the latest scratch file. -``` unison +``` unison :hide x = () ``` +``` ucm :hide +scratch/a3> find +``` + ``` ucm -scratch/a3> edit 1-5000 +scratch/a3> edit.new 1-5000 ☝️ - + I added 2 definitions to the top of scratch.u - + You can edit them there, then run `update` to replace the definitions currently in this namespace. - ``` -```` unison:added-by-ucm scratch.u + +```` unison :added-by-ucm scratch.u explanationOfThisFile : Text explanationOfThisFile = """ @@ -817,21 +900,33 @@ sloppyDocEval = }} ```` +``` ucm :hide +scratch/a3_new> builtins.mergeio lib.builtins + +scratch/a3_new> load + +scratch/a3_new> add + +scratch/a3> delete.namespace.force lib.builtins + +scratch/a3_new> delete.namespace.force lib.builtins +``` + These are currently all expected to have different hashes on round trip. ``` ucm scratch/main> diff.namespace /a3_new: /a3: Updates: - + 1. sloppyDocEval : Doc2 ↓ 2. sloppyDocEval : Doc2 - ``` + ## Other regression tests not covered by above -### Builtins should appear commented out in the edit command +### Builtins should appear commented out in the edit.new command Regression test for https://github.com/unisonweb/unison/pull/3548 @@ -840,12 +935,12 @@ scratch/regressions> alias.term ##Nat.+ plus Done. -scratch/regressions> edit plus +scratch/regressions> edit.new plus ☝️ - + I added 1 definitions to the top of scratch.u - + You can edit them there, then run `update` to replace the definitions currently in this namespace. @@ -854,9 +949,8 @@ scratch/regressions> load Loading changes detected in scratch.u. I loaded scratch.u and didn't find anything. - ``` -``` unison:added-by-ucm scratch.u + +``` unison :added-by-ucm scratch.u -- builtin plus : ##Nat -> ##Nat -> ##Nat ``` - diff --git a/unison-src/transcripts-round-trip/reparses-with-same-hash.u b/unison-src/transcripts-round-trip/reparses-with-same-hash.u index 5d75eff442..948d9118b7 100644 --- a/unison-src/transcripts-round-trip/reparses-with-same-hash.u +++ b/unison-src/transcripts-round-trip/reparses-with-same-hash.u @@ -1,4 +1,3 @@ - -- A very simple example to start simplestPossibleExample = 1 + 1 @@ -128,7 +127,7 @@ somethingVeryLong = let nested_fences : Doc2 nested_fences = {{ ```` raw - ```unison + ``` unison r = "boopydoo" ``` ```` }} @@ -544,12 +543,12 @@ fix_4384e = id x = x {{ {{ docExampleBlock 0 (id id id id id id id id id id id id id id id id id id id id id (x -> 0)) }} }} -fnApplicationSyntax = +fnApplicationSyntax = Environment.default = do 1 + 1 oog = do 2 + 2 blah : Nat -> Float -> Nat - blah x y = x + 1 - _ = blah Environment.default() 1.0 + blah x y = x + 1 + _ = blah Environment.default() 1.0 blah oog() (Float.max 1.0 2.0) fix_4727 = {{ `` 0xs900dc0ffee `` }} @@ -594,3 +593,35 @@ fix_4729c = {{ }}) {{ This is a callout with a title }} ``` }} + +fixity = do + (===) = (##Universal.==) + (<|) f x = f x + (<<) f g x = f (g x) + (>>) f g x = g (f x) + id x = x + (do + (%) = Nat.mod + ($) = (Nat.+) + c = 1 * (2 + 3) * 4 + plus = 1 Nat.+ 2 Nat.+ 3 + plus2 = 1 Nat.+ (2 Nat.+ 3) + d = true && let false || true + z = true || false && true + e = 1 + 2 >= (3 + 4) + f = 9 % 2 === 0 + g = 0 == (9 % 2) + h = 2 * (10 $ 20) + i1 = 1 * 2 $ (3 * 4) $ 5 + i2 = 1 * 2 $ 3 * 4 $ 5 + oo = (((2 * 10) $ 20) * 30) $ 40 + ffffffffffffffffffff x = x + 1 + gg x = x * 2 + j = 10 |> ffffffffffffffffffff |> gg |> gg |> gg |> gg |> gg + k = ffffffffffffffffffff << gg << ffffffffffffffffffff <| 10 + l = 10 |> (ffffffffffffffffffff >> gg >> ffffffffffffffffffff) + zzz = ((1 + (2 * 3)) < (4 + (5 * 6))) && ((((7 + (8 * 9)) > ((10 + (11 * 12)))))) + zz = (1 * 2 + 3 * 3 < (4 + 5 * 6) && ((7 + 8 * 9) > (10 + 11 * 12))) === (1 + 3 * 3 < (4 + 5 * 6) && (7 + 8 * 9 > (10 + 11 * 12))) + zzzz = 1 * 2 + 3 * 3 < 4 + 5 * 6 && 7 + 8 * 9 > 10 + 11 * 12 === 1 + 3 * 3 < 4 + 5 * 6 && 7 + 8 * 9 > 10 + 11 * 12 + () + ) |> id diff --git a/unison-src/transcripts-using-base/_base.md b/unison-src/transcripts-using-base/_base.md index 8c4d8c707c..9ce21e6118 100644 --- a/unison-src/transcripts-using-base/_base.md +++ b/unison-src/transcripts-using-base/_base.md @@ -9,7 +9,7 @@ transcripts which contain less boilerplate. ## Usage -```ucm:hide +``` ucm :hide scratch/main> builtins.mergeio scratch/main> load unison-src/transcripts-using-base/base.u scratch/main> add @@ -17,20 +17,20 @@ scratch/main> add The test shows that `hex (fromHex str) == str` as expected. -```unison:hide +``` unison :hide test> hex.tests.ex1 = checks let s = "3984af9b" [hex (fromHex s) == s] ``` -```ucm:hide +``` ucm :hide scratch/main> test ``` Lets do some basic testing of our test harness to make sure its working. -```unison +``` unison testAutoClean : '{io2.IO}[Result] testAutoClean _ = go: '{Stream Result, Exception, io2.IO, TempDirs} Text @@ -49,7 +49,7 @@ testAutoClean _ = Left (Failure _ t _) -> results :+ (Fail t) ``` -```ucm +``` ucm scratch/main> add scratch/main> io.test testAutoClean ``` diff --git a/unison-src/transcripts-using-base/_base.output.md b/unison-src/transcripts-using-base/_base.output.md index eaad4fb38e..52910967b2 100644 --- a/unison-src/transcripts-using-base/_base.output.md +++ b/unison-src/transcripts-using-base/_base.output.md @@ -9,14 +9,26 @@ transcripts which contain less boilerplate. ## Usage +``` ucm :hide +scratch/main> builtins.mergeio + +scratch/main> load unison-src/transcripts-using-base/base.u + +scratch/main> add +``` + The test shows that `hex (fromHex str) == str` as expected. -``` unison +``` unison :hide test> hex.tests.ex1 = checks let s = "3984af9b" [hex (fromHex s) == s] ``` +``` ucm :hide +scratch/main> test +``` + Lets do some basic testing of our test harness to make sure its working. @@ -39,35 +51,33 @@ testAutoClean _ = Left (Failure _ t _) -> results :+ (Fail t) ``` -``` ucm - +``` ucm :added-by-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`: testAutoClean : '{IO} [Result] - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + testAutoClean : '{IO} [Result] scratch/main> io.test testAutoClean New test results: - + 1. testAutoClean ◉ our temporary directory should exist ◉ our temporary directory should no longer exist - + ✅ 2 test(s) passing - - Tip: Use view 1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/all-base-hashes.md b/unison-src/transcripts-using-base/all-base-hashes.md index bb0f27c2cd..57baf3d629 100644 --- a/unison-src/transcripts-using-base/all-base-hashes.md +++ b/unison-src/transcripts-using-base/all-base-hashes.md @@ -1,5 +1,5 @@ This transcript is intended to make visible accidental changes to the hashing algorithm. -```ucm +``` ucm scratch/main> find.verbose ``` diff --git a/unison-src/transcripts-using-base/all-base-hashes.output.md b/unison-src/transcripts-using-base/all-base-hashes.output.md index 0b656ef0c3..d60d5ae872 100644 --- a/unison-src/transcripts-using-base/all-base-hashes.output.md +++ b/unison-src/transcripts-using-base/all-base-hashes.output.md @@ -2982,6 +2982,4 @@ scratch/main> find.verbose 855. -- #lcmj2envm11lrflvvcl290lplhvbccv82utoej0lg0eomhmsf2vrv8af17k6if7ff98fp1b13rkseng3fng4stlr495c8dn3gn4k400 |> : a -> (a ->{g} t) ->{g} t - - ``` diff --git a/unison-src/transcripts-using-base/binary-encoding-nats.md b/unison-src/transcripts-using-base/binary-encoding-nats.md index 2eee6caf58..0cd604c8e4 100644 --- a/unison-src/transcripts-using-base/binary-encoding-nats.md +++ b/unison-src/transcripts-using-base/binary-encoding-nats.md @@ -1,4 +1,4 @@ -```unison +``` unison unique type EncDec = EncDec Text (Nat -> Bytes) (Bytes -> Optional (Nat, Bytes)) BE64 = EncDec "64 bit Big Endian" encodeNat64be decodeNat64be @@ -53,7 +53,7 @@ testABunchOfNats _ = (runTest (testNat 0)) ``` -```ucm +``` ucm scratch/main> add scratch/main> io.test testABunchOfNats ``` diff --git a/unison-src/transcripts-using-base/binary-encoding-nats.output.md b/unison-src/transcripts-using-base/binary-encoding-nats.output.md index da9bc7a95a..e9c27c3b8f 100644 --- a/unison-src/transcripts-using-base/binary-encoding-nats.output.md +++ b/unison-src/transcripts-using-base/binary-encoding-nats.output.md @@ -53,14 +53,13 @@ testABunchOfNats _ = (runTest (testNat 0)) ``` -``` ucm - +``` ucm :added-by-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`: type EncDec @@ -73,13 +72,13 @@ testABunchOfNats _ = testABunchOfNats : ∀ _. _ ->{IO} [Result] testNat : Nat -> '{IO, Stream Result} () testRoundTrip : Nat -> EncDec ->{IO, Stream Result} () - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + type EncDec BE16 : EncDec BE32 : EncDec @@ -94,7 +93,7 @@ scratch/main> add scratch/main> io.test testABunchOfNats New test results: - + 1. testABunchOfNats ◉ successfully decoded 4294967295 using 64 bit Big Endian ◉ consumed all input ◉ successfully decoded 4294967295 using 64 bit Little Endian @@ -163,9 +162,8 @@ scratch/main> io.test testABunchOfNats ◉ consumed all input ◉ successfully decoded 0 using 16 bit Little Endian ◉ consumed all input - + ✅ 68 test(s) passing - - Tip: Use view 1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/codeops.md b/unison-src/transcripts-using-base/codeops.md index 1e2797769b..5b6bfaf28e 100644 --- a/unison-src/transcripts-using-base/codeops.md +++ b/unison-src/transcripts-using-base/codeops.md @@ -1,10 +1,9 @@ - Test for code serialization operations. Define a function, serialize it, then deserialize it back to an actual function. Also ask for its dependencies for display later. -```unison +``` unison save : a -> Bytes save x = Value.serialize (Value.value x) @@ -152,11 +151,11 @@ swapped name link = rejected ("swapped " ++ name) rco ``` -```ucm +``` ucm scratch/main> add ``` -```unison +``` unison structural ability Zap where zap : Three Nat Nat Nat @@ -235,13 +234,13 @@ This simply runs some functions to make sure there isn't a crash. Once we gain the ability to capture output in a transcript, it can be modified to actual show that the serialization works. -```ucm +``` ucm scratch/main> add scratch/main> io.test tests scratch/main> io.test badLoad ``` -```unison +``` unison codeTests : '{io2.IO} [Result] codeTests = '[ idempotence "idem f" (termLink f) @@ -277,12 +276,12 @@ codeTests = ] ``` -```ucm +``` ucm scratch/main> add scratch/main> io.test codeTests ``` -```unison +``` unison validateTest : Link.Term ->{IO} Result validateTest l = match Code.lookup l with None -> Fail "Couldn't look up link" @@ -308,7 +307,7 @@ vtests _ = ] ``` -```ucm +``` ucm scratch/main> add scratch/main> io.test vtests ``` diff --git a/unison-src/transcripts-using-base/codeops.output.md b/unison-src/transcripts-using-base/codeops.output.md index 6e51f371d1..fa807df00f 100644 --- a/unison-src/transcripts-using-base/codeops.output.md +++ b/unison-src/transcripts-using-base/codeops.output.md @@ -151,14 +151,13 @@ swapped name link = rejected ("swapped " ++ name) rco ``` -``` ucm - +``` ucm :added-by-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`: structural type Three a b c @@ -196,13 +195,13 @@ swapped name link = verify : Text -> [(Link.Term, Code)] ->{Throw Text} () - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + structural type Three a b c Code.get : Link.Term ->{IO, Throw Text} Code Code.load : Bytes ->{IO, Throw Text} Code @@ -238,8 +237,8 @@ scratch/main> add verify : Text -> [(Link.Term, Code)] ->{Throw Text} () - ``` + ``` unison structural ability Zap where zap : Three Nat Nat Nat @@ -315,14 +314,13 @@ badLoad _ = Left _ -> [Fail "Exception"] ``` -``` ucm - +``` ucm :added-by-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`: structural ability Zap @@ -336,8 +334,8 @@ badLoad _ = rotate : Three Nat Nat Nat -> Three Nat Nat Nat tests : '{IO} [Result] zapper : Three Nat Nat Nat -> Request {Zap} r -> r - ``` + This simply runs some functions to make sure there isn't a crash. Once we gain the ability to capture output in a transcript, it can be modified to actual show that the serialization works. @@ -346,7 +344,7 @@ to actual show that the serialization works. scratch/main> add ⍟ I've added these definitions: - + structural ability Zap badLoad : '{IO} [Result] bigFun : Nat -> Nat -> Nat -> Nat @@ -362,7 +360,7 @@ scratch/main> add scratch/main> io.test tests New test results: - + 1. tests ◉ (ext f) passed ◉ (ext h) passed ◉ (ident compound) passed @@ -376,22 +374,22 @@ scratch/main> io.test tests ◉ (ident termlink) passed ◉ (ident bool) passed ◉ (ident bytes) passed - + ✅ 13 test(s) passing - + Tip: Use view 1 to view the source of a test. scratch/main> io.test badLoad New test results: - + 1. badLoad ◉ serialized77 - + ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` + ``` unison codeTests : '{io2.IO} [Result] codeTests = @@ -428,30 +426,29 @@ codeTests = ] ``` -``` ucm - +``` ucm :added-by-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`: codeTests : '{IO} [Result] - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + codeTests : '{IO} [Result] scratch/main> io.test codeTests New test results: - + 1. codeTests ◉ (idem f) passed ◉ (idem h) passed ◉ (idem rotate) passed @@ -482,12 +479,12 @@ scratch/main> io.test codeTests ◉ (rejected swapped mututal0) passed ◉ (rejected swapped mututal1) passed ◉ (rejected swapped mututal2) passed - + ✅ 30 test(s) passing - - Tip: Use view 1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` + ``` unison validateTest : Link.Term ->{IO} Result validateTest l = match Code.lookup l with @@ -514,32 +511,31 @@ vtests _ = ] ``` -``` ucm - +``` ucm :added-by-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`: validateTest : Link.Term ->{IO} Result vtests : '{IO} [Result] - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + validateTest : Link.Term ->{IO} Result vtests : '{IO} [Result] scratch/main> io.test vtests New test results: - + 1. vtests ◉ validated ◉ validated ◉ validated @@ -548,9 +544,8 @@ scratch/main> io.test vtests ◉ validated ◉ validated ◉ validated - + ✅ 8 test(s) passing - - Tip: Use view 1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/doc.md b/unison-src/transcripts-using-base/doc.md index 52973ddb3e..d80e60ce58 100644 --- a/unison-src/transcripts-using-base/doc.md +++ b/unison-src/transcripts-using-base/doc.md @@ -13,7 +13,7 @@ Unison documentation is written in Unison and has some neat features: Documentation blocks start with `{{` and end with a matching `}}`. You can introduce doc blocks anywhere you'd use an expression, and you can also have anonymous documentation blocks immediately before a top-level term or type. -```unison +``` unison name = {{Alice}} d1 = {{ Hello there {{name}}! }} @@ -32,7 +32,7 @@ Notice that an anonymous documentation block `{{ ... }}` before a definition `Im You can preview what docs will look like when rendered to the console using the `display` or `docs` commands: -```ucm +``` ucm scratch/main> display d1 scratch/main> docs ImportantConstant scratch/main> docs DayOfWeek @@ -44,11 +44,11 @@ The `docs ImportantConstant` command will look for `ImportantConstant.doc` in th First, we'll load the `syntax.u` file which has examples of all the syntax: -```ucm +``` ucm scratch/main> load ./unison-src/transcripts-using-base/doc.md.files/syntax.u ``` -```ucm:hide +``` ucm :hide scratch/main> add ``` @@ -56,7 +56,7 @@ Now we can review different portions of the guide. we'll show both the pretty-printed source using `view` and the rendered output using `display`: -```ucm +``` ucm scratch/main> view basicFormatting scratch/main> display basicFormatting scratch/main> view lists @@ -73,7 +73,7 @@ scratch/main> display otherElements Lastly, it's common to build longer documents including subdocuments via `{{ subdoc }}`. We can stitch together the full syntax guide in this way: -```ucm +``` ucm scratch/main> view doc.guide scratch/main> display doc.guide ``` diff --git a/unison-src/transcripts-using-base/doc.output.md b/unison-src/transcripts-using-base/doc.output.md index 850929abab..aca445303c 100644 --- a/unison-src/transcripts-using-base/doc.output.md +++ b/unison-src/transcripts-using-base/doc.output.md @@ -28,14 +28,13 @@ The 7 days of the week, defined as: unique type time.DayOfWeek = Sun | Mon | Tue | Wed | Thu | Fri | Sat ``` -``` ucm - +``` ucm :added-by-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`: type time.DayOfWeek @@ -44,8 +43,8 @@ unique type time.DayOfWeek = Sun | Mon | Tue | Wed | Thu | Fri | Sat d1 : Doc2 name : Doc2 time.DayOfWeek.doc : Doc2 - ``` + Notice that an anonymous documentation block `{{ ... }}` before a definition `ImportantConstant` is just syntax sugar for `ImportantConstant.doc = {{ ... }}`. You can preview what docs will look like when rendered to the console using the `display` or `docs` commands: @@ -62,10 +61,10 @@ scratch/main> docs ImportantConstant scratch/main> docs DayOfWeek The 7 days of the week, defined as: - - type DayOfWeek = Sun | Mon | Tue | Wed | Thu | Fri | Sat + type DayOfWeek = Sun | Mon | Tue | Wed | Thu | Fri | Sat ``` + The `docs ImportantConstant` command will look for `ImportantConstant.doc` in the file or codebase. You can do this instead of explicitly linking docs to definitions. ## Syntax guide @@ -82,7 +81,7 @@ scratch/main> load ./unison-src/transcripts-using-base/doc.md.files/syntax.u ./unison-src/transcripts-using-base/doc.md.files/syntax.u. If you do an `add` or `update`, here's how your codebase would change: - + ⍟ These new definitions are ok to `add`: basicFormatting : Doc2 @@ -93,13 +92,17 @@ scratch/main> load ./unison-src/transcripts-using-base/doc.md.files/syntax.u nonUnisonCodeBlocks : Doc2 otherElements : Doc2 sqr : Nat -> Nat +``` +``` ucm :hide +scratch/main> add ``` + Now we can review different portions of the guide. we'll show both the pretty-printed source using `view` and the rendered output using `display`: -``` ucm +```` ucm scratch/main> view basicFormatting basicFormatting : Doc2 @@ -133,26 +136,26 @@ scratch/main> view basicFormatting scratch/main> display basicFormatting # Basic formatting - + Paragraphs are separated by one or more blanklines. Sections have a title and 0 or more paragraphs or other section elements. - + Text can be bold, *italicized*, ~~strikethrough~~, or `monospaced` (or `monospaced`). - + You can link to Unison terms, types, and external URLs: - + * An external url * Some is a term link; Optional is a type link * A named type link and a named term link. Term links are handy for linking to other documents! - + You can use `{{ .. }}` to escape out to regular Unison syntax, for instance __not bold__. This is useful for creating documents programmatically or just including other documents. - + *Next up:* lists scratch/main> view lists @@ -201,7 +204,7 @@ scratch/main> view lists scratch/main> display lists # Lists - + # Bulleted lists Bulleted lists can use `+`, `-`, or `*` for the bullets @@ -213,7 +216,7 @@ scratch/main> display lists * C * C1 * C2 - + # Numbered lists 1. A @@ -275,27 +278,27 @@ scratch/main> view evaluation scratch/main> display evaluation # Evaluation - + Expressions can be evaluated inline, for instance `2`. - + Blocks of code can be evaluated as well, for instance: - + id x = x id (sqr 10) ⧨ 100 - + also: - + match 1 with 1 -> "hi" _ -> "goodbye" ⧨ "hi" - + To include a typechecked snippet of code without evaluating it, you can do: - + use Nat * cube : Nat -> Nat cube x = x * x * x @@ -344,37 +347,37 @@ scratch/main> view includingSource scratch/main> display includingSource # Including Unison source code - + Unison definitions can be included in docs. For instance: - + structural type Optional a = Some a | None sqr : Nat -> Nat sqr x = use Nat * x * x - + Some rendering targets also support folded source: - + structural type Optional a = Some a | None sqr : Nat -> Nat sqr x = use Nat * x * x - + You can also include just a signature, inline, with `sqr : Nat -> Nat`, or you can include one or more signatures as a block: - + sqr : Nat -> Nat Nat.+ : Nat -> Nat -> Nat - + Or alternately: - + List.map : (a ->{e} b) -> [a] ->{e} [b] - + # Inline snippets You can include typechecked code snippets inline, for @@ -423,10 +426,10 @@ scratch/main> view nonUnisonCodeBlocks scratch/main> display nonUnisonCodeBlocks # Non-Unison code blocks - + Use three or more single quotes to start a block with no syntax highlighting: - + ``` raw _____ _ | | |___|_|___ ___ ___ @@ -434,15 +437,15 @@ scratch/main> display nonUnisonCodeBlocks |_____|_|_|_|___|___|_|_| ``` - + You can use three or more backticks plus a language name for blocks with syntax highlighting: - + ``` Haskell -- A fenced code block which isn't parsed by Unison reverse = foldl (flip (:)) [] ``` - + ``` Scala // A fenced code block which isn't parsed by Unison def reverse[A](xs: List[A]) = @@ -511,44 +514,44 @@ scratch/main> display otherElements There are also asides, callouts, tables, tooltips, and more. These don't currently have special syntax; just use the `{{ }}` syntax to call these functions directly. - + docAside : Doc2 -> Doc2 - + docCallout : Optional Doc2 -> Doc2 -> Doc2 - + docBlockquote : Doc2 -> Doc2 - + docTooltip : Doc2 -> Doc2 -> Doc2 - + docTable : [[Doc2]] -> Doc2 - + This is an aside. ( Some extra detail that doesn't belong in main text. ) - + | This is an important callout, with no icon. - + | 🌻 | | This is an important callout, with an icon. The text wraps | onto multiple lines. - + > "And what is the use of a book," thought Alice, "without > pictures or conversation?" > > *Lewis Carroll, Alice's Adventures in Wonderland* - + Hover over me - + a b A longer paragraph that will split onto multiple lines, such that this row occupies multiple lines in the rendered table. Some text More text Zounds! +```` -``` Lastly, it's common to build longer documents including subdocuments via `{{ subdoc }}`. We can stitch together the full syntax guide in this way: -``` ucm +```` ucm scratch/main> view doc.guide doc.guide : Doc2 @@ -572,7 +575,7 @@ scratch/main> view doc.guide scratch/main> display doc.guide # Unison computable documentation - + # Basic formatting Paragraphs are separated by one or more blanklines. @@ -595,7 +598,7 @@ scratch/main> display doc.guide other documents. *Next up:* lists - + # Lists # Bulleted lists @@ -632,7 +635,7 @@ scratch/main> display doc.guide * In this nested list. 2. Take shower. 3. Get dressed. - + # Evaluation Expressions can be evaluated inline, for instance `2`. @@ -658,7 +661,7 @@ scratch/main> display doc.guide use Nat * cube : Nat -> Nat cube x = x * x * x - + # Including Unison source code Unison definitions can be included in docs. For instance: @@ -702,7 +705,7 @@ scratch/main> display doc.guide * If your snippet expression is just a single function application, you can put it in double backticks, like so: `sqr x`. This is equivalent to `sqr x`. - + # Non-Unison code blocks Use three or more single quotes to start a block with no @@ -729,7 +732,7 @@ scratch/main> display doc.guide def reverse[A](xs: List[A]) = xs.foldLeft(Nil : List[A])((acc,a) => a +: acc) ``` - + There are also asides, callouts, tables, tooltips, and more. These don't currently have special syntax; just use the `{{ }}` syntax to call these functions directly. @@ -766,7 +769,6 @@ scratch/main> display doc.guide row occupies multiple lines in the rendered table. Some text More text Zounds! +```` -``` 🌻 THE END - diff --git a/unison-src/transcripts-using-base/failure-tests.md b/unison-src/transcripts-using-base/failure-tests.md index 5f69a8c2a0..bb11bfc323 100644 --- a/unison-src/transcripts-using-base/failure-tests.md +++ b/unison-src/transcripts-using-base/failure-tests.md @@ -6,7 +6,7 @@ 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. -```unison +``` unison test1 : '{IO, Exception} [Result] test1 = do _ = fromUtf8 0xsee @@ -18,14 +18,14 @@ test2 = do [Ok "test2"] ``` -```ucm +``` ucm scratch/main> add ``` -```ucm:error +``` ucm :error scratch/main> io.test test1 ``` -```ucm:error +``` ucm :error scratch/main> io.test test2 ``` diff --git a/unison-src/transcripts-using-base/failure-tests.output.md b/unison-src/transcripts-using-base/failure-tests.output.md index 0efdd87b38..5087b2d934 100644 --- a/unison-src/transcripts-using-base/failure-tests.output.md +++ b/unison-src/transcripts-using-base/failure-tests.output.md @@ -18,55 +18,53 @@ test2 = do [Ok "test2"] ``` -``` ucm - +``` ucm :added-by-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`: test1 : '{IO, Exception} [Result] test2 : '{IO, Exception} [Result] - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + test1 : '{IO, Exception} [Result] test2 : '{IO, Exception} [Result] - ``` -``` ucm + +``` ucm :error scratch/main> io.test test1 💔💥 - + The program halted with an unhandled exception: - + Failure (typeLink IOFailure) "Cannot decode byte '\\xee': Data.Text.Encoding: Invalid UTF-8 stream" (Any ()) - + Stack trace: ##raise - ``` -``` ucm + +``` ucm :error scratch/main> io.test test2 💔💥 - + The program halted with an unhandled exception: - + Failure (typeLink RuntimeFailure) "builtin.bug" (Any "whoa") - + Stack trace: ##raise - ``` diff --git a/unison-src/transcripts-using-base/fix2049.output.md b/unison-src/transcripts-using-base/fix2049.output.md index e69de29bb2..8b13789179 100644 --- a/unison-src/transcripts-using-base/fix2049.output.md +++ b/unison-src/transcripts-using-base/fix2049.output.md @@ -0,0 +1 @@ + diff --git a/unison-src/transcripts-using-base/fix2158-1.md b/unison-src/transcripts-using-base/fix2158-1.md index 16721569e5..9b97784678 100644 --- a/unison-src/transcripts-using-base/fix2158-1.md +++ b/unison-src/transcripts-using-base/fix2158-1.md @@ -1,13 +1,13 @@ This transcript tests an ability check failure regression. -```unison +``` unison structural ability Async t g where fork : '{Async t g, g} a -> t a await : t a -> a Async.parMap : (a ->{Async t g, g} b) -> [a] ->{Async t g} [b] -Async.parMap f as = - tasks = List.map (a -> fork '(f a)) as +Async.parMap f as = + tasks = List.map (a -> fork '(f a)) as List.map await tasks ``` diff --git a/unison-src/transcripts-using-base/fix2158-1.output.md b/unison-src/transcripts-using-base/fix2158-1.output.md index 9a692bb3de..d3d4ce972e 100644 --- a/unison-src/transcripts-using-base/fix2158-1.output.md +++ b/unison-src/transcripts-using-base/fix2158-1.output.md @@ -6,27 +6,26 @@ structural ability Async t g where await : t a -> a Async.parMap : (a ->{Async t g, g} b) -> [a] ->{Async t g} [b] -Async.parMap f as = - tasks = List.map (a -> fork '(f a)) as +Async.parMap f as = + tasks = List.map (a -> fork '(f a)) as List.map await tasks ``` -``` ucm - +``` ucm :added-by-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`: structural ability Async t g Async.parMap : (a ->{g, Async t g} b) -> [a] ->{Async t g} [b] - ``` + The issue was that certain ability processing was happing in less optimal order. `g` appears both as an ability used and as a parameter to `Async`. However, the latter occurrence is more strict. Unifying @@ -39,4 +38,3 @@ order they occurred, and during inference it happened that `g` occurred in the row before `Async t g`. Processing the stricter parts first is better, becauase it can solve things more precisely and avoid ambiguities relating to subtyping. - diff --git a/unison-src/transcripts-using-base/fix2297.md b/unison-src/transcripts-using-base/fix2297.md index 26c2108d2a..bddfae0199 100644 --- a/unison-src/transcripts-using-base/fix2297.md +++ b/unison-src/transcripts-using-base/fix2297.md @@ -1,7 +1,7 @@ This tests a case where a function was somehow discarding abilities. -```unison:error +``` unison :error structural ability Trivial where trivial : () diff --git a/unison-src/transcripts-using-base/fix2297.output.md b/unison-src/transcripts-using-base/fix2297.output.md index 949cdd89e9..69dae77fac 100644 --- a/unison-src/transcripts-using-base/fix2297.output.md +++ b/unison-src/transcripts-using-base/fix2297.output.md @@ -1,6 +1,6 @@ This tests a case where a function was somehow discarding abilities. -``` unison +``` unison :error structural ability Trivial where trivial : () @@ -24,13 +24,10 @@ wat = handleTrivial testAction -- Somehow this completely forgets about Excepti > handleTrivial testAction ``` -``` ucm - +``` ucm :added-by-ucm Loading changes detected in scratch.u. The expression in red needs the {IO} ability, but this location does not have access to any abilities. - - 19 | wat = handleTrivial testAction -- Somehow this completely forgets about Exception and IO - + 19 | wat = handleTrivial testAction -- Somehow this completely forgets about Exception and IO ``` diff --git a/unison-src/transcripts-using-base/fix2358.md b/unison-src/transcripts-using-base/fix2358.md index 1c543349e4..2a262f2882 100644 --- a/unison-src/transcripts-using-base/fix2358.md +++ b/unison-src/transcripts-using-base/fix2358.md @@ -1,7 +1,6 @@ - Tests a former error due to bad calling conventions on delay.impl -```unison +``` unison timingApp2 : '{IO, Exception} () timingApp2 _ = printLine "Hello" @@ -9,6 +8,6 @@ timingApp2 _ = printLine "World" ``` -```ucm +``` ucm scratch/main> run timingApp2 ``` diff --git a/unison-src/transcripts-using-base/fix2358.output.md b/unison-src/transcripts-using-base/fix2358.output.md index 7e71541b74..73f94c3761 100644 --- a/unison-src/transcripts-using-base/fix2358.output.md +++ b/unison-src/transcripts-using-base/fix2358.output.md @@ -8,22 +8,20 @@ timingApp2 _ = printLine "World" ``` -``` ucm - +``` ucm :added-by-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`: timingApp2 : '{IO, Exception} () - ``` + ``` ucm scratch/main> run timingApp2 () - ``` diff --git a/unison-src/transcripts-using-base/fix3166.md b/unison-src/transcripts-using-base/fix3166.md index 5c6a9e3124..bacaa4aa40 100644 --- a/unison-src/transcripts-using-base/fix3166.md +++ b/unison-src/transcripts-using-base/fix3166.md @@ -1,7 +1,7 @@ This file tests some obscure issues involved with abilities and over-applied functions. -```unison +``` unison Stream.fromList : [a] -> '{Stream a} () Stream.fromList l _ = _ = List.map (x -> emit x) l @@ -31,7 +31,7 @@ increment n = 1 + n Stream.toList s2 ``` -```unison +``` unison structural ability E where eff : () -> () @@ -51,7 +51,7 @@ foo _ = > h foo 337 ``` -```unison +``` unison structural ability Over where over : Nat ->{Over} (Nat -> Nat) diff --git a/unison-src/transcripts-using-base/fix3166.output.md b/unison-src/transcripts-using-base/fix3166.output.md index 9e33e14563..a370eeb8e4 100644 --- a/unison-src/transcripts-using-base/fix3166.output.md +++ b/unison-src/transcripts-using-base/fix3166.output.md @@ -31,14 +31,13 @@ increment n = 1 + n Stream.toList s2 ``` -``` ucm - +``` ucm :added-by-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`: Stream.fromList : [a] -> '{Stream a} () @@ -49,19 +48,19 @@ increment n = 1 + n -> Request {Stream a} r -> '{Stream b} r increment : Nat -> Nat - + Now evaluating any watch expressions (lines starting with `>`)... Ctrl+C cancels. 19 | > Stream.toList (Stream.map increment (Stream.fromList [1,2,3])) ⧩ [2, 3, 4] - + 22 | s1 = do emit 10 ⧩ [100, 200, 300, 400] - ``` + ``` unison structural ability E where eff : () -> () @@ -82,29 +81,28 @@ foo _ = > h foo 337 ``` -``` ucm - +``` ucm :added-by-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`: structural ability E foo : '{E} (Nat -> Nat) h : '{E} (Nat -> r) -> Nat -> r hh : Request {E} (Nat -> r) -> Nat -> r - + Now evaluating any watch expressions (lines starting with `>`)... Ctrl+C cancels. 17 | > h foo 337 ⧩ 7 - ``` + ``` unison structural ability Over where over : Nat ->{Over} (Nat -> Nat) @@ -126,26 +124,24 @@ hmm = > hmm ``` -``` ucm - +``` ucm :added-by-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`: structural ability Over delegated : ∀ _. _ -> Nat -> Nat hd : Request {g, Over} x -> x hmm : Nat - + Now evaluating any watch expressions (lines starting with `>`)... Ctrl+C cancels. 18 | > hmm ⧩ 16794 - ``` diff --git a/unison-src/transcripts-using-base/fix3542.md b/unison-src/transcripts-using-base/fix3542.md index 98487e8240..4d15f90e1b 100644 --- a/unison-src/transcripts-using-base/fix3542.md +++ b/unison-src/transcripts-using-base/fix3542.md @@ -1,4 +1,4 @@ -```unison +``` unison arrayList v n = do use ImmutableByteArray read8 ma = Scope.bytearrayOf v n diff --git a/unison-src/transcripts-using-base/fix3542.output.md b/unison-src/transcripts-using-base/fix3542.output.md index 976f1c0636..df71ed5a37 100644 --- a/unison-src/transcripts-using-base/fix3542.output.md +++ b/unison-src/transcripts-using-base/fix3542.output.md @@ -13,23 +13,21 @@ arrayList v n = do > Scope.run '(catch (arrayList 7 8)) ``` -``` ucm - +``` ucm :added-by-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`: arrayList : Nat -> Nat -> '{Exception, Scope s} [Nat] - + Now evaluating any watch expressions (lines starting with `>`)... Ctrl+C cancels. 12 | > Scope.run '(catch (arrayList 7 8)) ⧩ Right [7, 7, 7, 7, 7, 7, 7, 7] - ``` diff --git a/unison-src/transcripts-using-base/fix3939.md b/unison-src/transcripts-using-base/fix3939.md index e9634ee2fc..3595bfb929 100644 --- a/unison-src/transcripts-using-base/fix3939.md +++ b/unison-src/transcripts-using-base/fix3939.md @@ -1,11 +1,11 @@ -```unison +``` unison {{ A simple doc. }} meh = 9 ``` -```ucm +``` ucm scratch/main> add scratch/main> find meh scratch/main> docs 1 diff --git a/unison-src/transcripts-using-base/fix3939.output.md b/unison-src/transcripts-using-base/fix3939.output.md index 9240c712f9..c9e6d16bc6 100644 --- a/unison-src/transcripts-using-base/fix3939.output.md +++ b/unison-src/transcripts-using-base/fix3939.output.md @@ -5,25 +5,24 @@ A simple doc. meh = 9 ``` -``` ucm - +``` ucm :added-by-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`: meh : Nat meh.doc : Doc2 - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + meh : Nat meh.doc : Doc2 @@ -31,10 +30,8 @@ scratch/main> find meh 1. meh : Nat 2. meh.doc : Doc2 - scratch/main> docs 1 A simple doc. - ``` diff --git a/unison-src/transcripts-using-base/fix4746.md b/unison-src/transcripts-using-base/fix4746.md index c391953994..bc79eddbe9 100644 --- a/unison-src/transcripts-using-base/fix4746.md +++ b/unison-src/transcripts-using-base/fix4746.md @@ -1,7 +1,7 @@ Test case for a variable capture problem during let floating. The encloser wasn't accounting for variables bound by matches. -```unison +``` unison ability Issue t where one : '{Issue t} () -> {Issue t} () two : '{Issue t} () -> {Issue t} () diff --git a/unison-src/transcripts-using-base/fix4746.output.md b/unison-src/transcripts-using-base/fix4746.output.md index 8887e34743..8a93ee1c0b 100644 --- a/unison-src/transcripts-using-base/fix4746.output.md +++ b/unison-src/transcripts-using-base/fix4746.output.md @@ -35,26 +35,24 @@ run s = () ``` -``` ucm - +``` ucm :added-by-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`: ability Issue t run : '{Issue t} () -> '{Stream Text} () works : Nat -> Nat x : '{Issue t} () ->{Issue t} () - + Now evaluating any watch expressions (lines starting with `>`)... Ctrl+C cancels. 26 | > Stream.toList <| run do ⧩ ["one", "two", "three", "done"] - ``` diff --git a/unison-src/transcripts-using-base/fix5129.md b/unison-src/transcripts-using-base/fix5129.md index a1e8ad3450..fc7fd4d230 100644 --- a/unison-src/transcripts-using-base/fix5129.md +++ b/unison-src/transcripts-using-base/fix5129.md @@ -1,11 +1,11 @@ -```ucm:hide +``` ucm :hide scratch/main> builtins.mergeio lib.builtins ``` Checks for some bad type checking behavior. Some ability subtyping was too lenient when higher-order functions were involved. -```unison:error +``` unison :error foreach : (a ->{g} ()) -> [a] ->{g} () foreach f = cases [] -> () @@ -28,7 +28,7 @@ go = do This comes from issue #3513 -```unison:error +``` unison :error (<<) : (b ->{e} c) -> (a ->{e} b) -> a ->{e} c (<<) f g x = f (g x) diff --git a/unison-src/transcripts-using-base/fix5129.output.md b/unison-src/transcripts-using-base/fix5129.output.md index 3d07942a78..ce5c89a5de 100644 --- a/unison-src/transcripts-using-base/fix5129.output.md +++ b/unison-src/transcripts-using-base/fix5129.output.md @@ -1,7 +1,11 @@ +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + Checks for some bad type checking behavior. Some ability subtyping was too lenient when higher-order functions were involved. -``` unison +``` unison :error foreach : (a ->{g} ()) -> [a] ->{g} () foreach f = cases [] -> () @@ -22,25 +26,23 @@ go = do foreach forkIt [thunk] ``` -``` ucm - +``` ucm :added-by-ucm Loading changes detected in scratch.u. I found an ability mismatch when checking the application - + 18 | foreach forkIt [thunk] - - + + When trying to match [Unit ->{𝕖75, IO, Exception} Unit] with [Unit ->{IO} Unit] the left hand side contained extra abilities: {𝕖75, Exception} - - ``` + This comes from issue \#3513 -``` unison +``` unison :error (<<) : (b ->{e} c) -> (a ->{e} b) -> a ->{e} c (<<) f g x = f (g x) @@ -56,18 +58,15 @@ fancyTryEval : '{g, IO, Exception} a ->{g, IO, Exception} a fancyTryEval = reraise << catchAll.impl ``` -``` ucm - +``` ucm :added-by-ucm Loading changes detected in scratch.u. The expression in red - + needs the abilities: {g76} but was assumed to only require: {IO, Exception} - + This is likely a result of using an un-annotated function as an argument with concrete abilities. Try adding an annotation to the function definition whose body is red. - - 13 | fancyTryEval = reraise << catchAll.impl - + 13 | fancyTryEval = reraise << catchAll.impl ``` diff --git a/unison-src/transcripts-using-base/hashing.md b/unison-src/transcripts-using-base/hashing.md index f7d6a2bdd8..ebef9fa745 100644 --- a/unison-src/transcripts-using-base/hashing.md +++ b/unison-src/transcripts-using-base/hashing.md @@ -2,7 +2,7 @@ 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 +``` ucm scratch/main> ls builtin.Bytes ``` Notice the `fromBase16` and `toBase16` functions. Here's some convenience functions for converting `Bytes` to and from base-16 `Text`. @@ -11,7 +11,7 @@ Notice the `fromBase16` and `toBase16` functions. Here's some convenience functi Here's a few usage examples: -```unison +``` unison ex1 = fromHex "2947db" |> crypto.hashBytes Sha3_512 |> hex @@ -42,13 +42,13 @@ ex5 = crypto.hmac Sha2_256 mysecret f |> hex And here's the full API: -```ucm +``` ucm scratch/main> find-in builtin.crypto ``` Note that the universal versions of `hash` and `hmac` are currently unimplemented and will bomb at runtime: -```unison +``` unison > hash Sha3_256 (fromHex "3849238492") ``` @@ -56,7 +56,7 @@ Note that the universal versions of `hash` and `hmac` are currently unimplemente Here are some test vectors (taken from [here](https://www.di-mgt.com.au/sha_testvectors.html) and [here](https://en.wikipedia.org/wiki/BLAKE_(hash_function))) for the various hashing algorithms: -```unison:hide +``` unison :hide ex alg input expected = checks [hashBytes alg (ascii input) == fromHex expected] test> sha3_512.tests.ex1 = @@ -188,11 +188,11 @@ test> crypto.hash.numTests = checks (List.map t (range 0 20)) ``` -```ucm:hide +``` ucm :hide scratch/main> add ``` -```ucm +``` ucm scratch/main> test ``` @@ -200,7 +200,7 @@ scratch/main> test These test vectors are taken from [RFC 4231](https://tools.ietf.org/html/rfc4231#section-4.3). -```unison +``` unison ex' alg secret msg expected = checks [hmacBytes alg (fromHex secret) (ascii msg) == fromHex expected] test> hmac_sha2_256.tests.ex1 = @@ -231,7 +231,7 @@ test> hmac_sha2_512.tests.ex2 = Test vectors here pulled from [Wikipedia's writeup](https://en.wikipedia.org/wiki/MD5). -```unison +``` unison ex alg input expected = checks [hashBytes alg (ascii input) == fromHex expected] test> md5.tests.ex1 = @@ -250,10 +250,10 @@ test> md5.tests.ex3 = "e4d909c290d0fb1ca068ffaddf22cbd0" ``` -```ucm:hide +``` ucm :hide scratch/main> add ``` -```ucm +``` ucm scratch/main> test ``` diff --git a/unison-src/transcripts-using-base/hashing.output.md b/unison-src/transcripts-using-base/hashing.output.md index 3bede2577e..4bf5506a8b 100644 --- a/unison-src/transcripts-using-base/hashing.output.md +++ b/unison-src/transcripts-using-base/hashing.output.md @@ -37,8 +37,8 @@ scratch/main> ls builtin.Bytes 30. toBase64UrlUnpadded (Bytes -> Bytes) 31. toList (Bytes -> [Nat]) 32. zlib/ (2 terms) - ``` + Notice the `fromBase16` and `toBase16` functions. Here's some convenience functions for converting `Bytes` to and from base-16 `Text`. ## API overview @@ -74,14 +74,13 @@ ex5 = crypto.hmac Sha2_256 mysecret f |> hex > ex5 ``` -``` ucm - +``` ucm :added-by-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`: ex1 : Text @@ -92,31 +91,31 @@ ex5 = crypto.hmac Sha2_256 mysecret f |> hex f : x -> x (also named id) mysecret : Bytes - + Now evaluating any watch expressions (lines starting with `>`)... Ctrl+C cancels. 22 | > ex1 ⧩ "f3c342040674c50ab45cb1874b6dbc81447af5958201ed4127e03b56725664d7cc44b88b9afadb371898fcaf5d0adeff60837ef93b514f99da43539d79820c99" - + 23 | > ex2 ⧩ "84bb437497f26fc33c51e57e64c37958c3918d50dfe75b91c661a85c2f8f8304" - + 24 | > ex3 ⧩ "c692fc54df921f7fa51aad9178327c5a097784b02212d571fb40facdfff881fd" - + 25 | > ex4 ⧩ "764a6e91271bce6ce8d8f49d551ba0e586a1e20d8bc2df0dff3117fcd9a11d9a" - + 26 | > ex5 ⧩ "abd0e845a5544ced19b1c05df18a05c10b252a355957b18b99b33970d5217de6" - ``` + And here's the full API: ``` ucm @@ -150,36 +149,34 @@ scratch/main> find-in builtin.crypto -> Bytes -> Bytes -> Either Failure Boolean - - ``` + Note that the universal versions of `hash` and `hmac` are currently unimplemented and will bomb at runtime: ``` unison > hash Sha3_256 (fromHex "3849238492") ``` -``` ucm - +``` ucm :added-by-ucm Loading changes detected in scratch.u. ✅ - + scratch.u changed. - + Now evaluating any watch expressions (lines starting with `>`)... Ctrl+C cancels. 1 | > hash Sha3_256 (fromHex "3849238492") ⧩ 0xs1259de8ec2c8b925dce24f591ed5cc1d1a5dc01cf88cf8f2343fc9728e124af4 - ``` + ## Hashing tests Here are some test vectors (taken from [here](https://www.di-mgt.com.au/sha_testvectors.html) and [here](https://en.wikipedia.org/wiki/BLAKE_\(hash_function\))) for the various hashing algorithms: -``` unison +``` unison :hide ex alg input expected = checks [hashBytes alg (ascii input) == fromHex expected] test> sha3_512.tests.ex1 = @@ -311,11 +308,15 @@ test> crypto.hash.numTests = checks (List.map t (range 0 20)) ``` +``` ucm :hide +scratch/main> add +``` + ``` ucm scratch/main> test Cached test results (`help testcache` to learn more) - + 1. blake2b_512.tests.ex1 ◉ Passed 2. blake2b_512.tests.ex2 ◉ Passed 3. blake2b_512.tests.ex3 ◉ Passed @@ -341,12 +342,12 @@ scratch/main> test 23. sha3_512.tests.ex2 ◉ Passed 24. sha3_512.tests.ex3 ◉ Passed 25. sha3_512.tests.ex4 ◉ Passed - + ✅ 25 test(s) passing - - Tip: Use view 1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` + ## HMAC tests These test vectors are taken from [RFC 4231](https://tools.ietf.org/html/rfc4231#section-4.3). @@ -378,14 +379,13 @@ test> hmac_sha2_512.tests.ex2 = "164b7a7bfcf819e2e395fbe73b56e0a387bd64222e831fd610270cd7ea2505549758bf75c05a994a6d034f65f8f0e6fdcaeab1a34d4a6b4b636e070a38bce737" ``` -``` ucm - +``` ucm :added-by-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`: ex' : HashAlgorithm @@ -397,27 +397,27 @@ test> hmac_sha2_512.tests.ex2 = hmac_sha2_256.tests.ex2 : [Result] hmac_sha2_512.tests.ex1 : [Result] hmac_sha2_512.tests.ex2 : [Result] - + Now evaluating any watch expressions (lines starting with `>`)... Ctrl+C cancels. 4 | ex' Sha2_256 ✅ Passed Passed - + 9 | ex' Sha2_512 ✅ Passed Passed - + 15 | ex' Sha2_256 ✅ Passed Passed - + 21 | ex' Sha2_512 ✅ Passed Passed - ``` + ## MD5 tests Test vectors here pulled from [Wikipedia's writeup](https://en.wikipedia.org/wiki/MD5). @@ -441,14 +441,13 @@ test> md5.tests.ex3 = "e4d909c290d0fb1ca068ffaddf22cbd0" ``` -``` ucm - +``` ucm :added-by-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: - + ⊡ Previously added definitions will be ignored: ex ⍟ These new definitions are ok to `add`: @@ -456,28 +455,32 @@ test> md5.tests.ex3 = md5.tests.ex1 : [Result] md5.tests.ex2 : [Result] md5.tests.ex3 : [Result] - + Now evaluating any watch expressions (lines starting with `>`)... Ctrl+C cancels. 4 | ex Md5 ✅ Passed Passed - + 9 | ex Md5 ✅ Passed Passed - + 14 | ex Md5 ✅ Passed Passed +``` +``` ucm :hide +scratch/main> add ``` + ``` ucm scratch/main> test Cached test results (`help testcache` to learn more) - + 1. blake2b_512.tests.ex1 ◉ Passed 2. blake2b_512.tests.ex2 ◉ Passed 3. blake2b_512.tests.ex3 ◉ Passed @@ -506,9 +509,8 @@ scratch/main> test 26. sha3_512.tests.ex2 ◉ Passed 27. sha3_512.tests.ex3 ◉ Passed 28. sha3_512.tests.ex4 ◉ Passed - + ✅ 28 test(s) passing - - Tip: Use view 1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/io.output.md b/unison-src/transcripts-using-base/io.output.md index f74a437365..3113905f23 100644 --- a/unison-src/transcripts-using-base/io.output.md +++ b/unison-src/transcripts-using-base/io.output.md @@ -9,20 +9,20 @@ You can skip the section which is just needed to make the transcript self-contai TempDirs/autoCleaned is an ability/hanlder which allows you to easily create a scratch directory which will automatically get cleaned up. -```unison +``` unison ``` ## Basic File Functions ### Creating/Deleting/Renaming Directories -Tests: createDirectory, - isDirectory, - fileExists, +Tests: createDirectory, + isDirectory, + fileExists, renameDirectory, deleteDirectory -```unison +``` unison testCreateRename : '{io2.IO} [Result] testCreateRename _ = test = 'let @@ -47,28 +47,28 @@ testCreateRename _ = runTest test ``` -```ucm +``` ucm 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`: - + testCreateRename : '{IO} [Result] ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: - + testCreateRename : '{IO} [Result] .> io.test testCreateRename New test results: - + ◉ testCreateRename create a foo directory ◉ testCreateRename directory should exist ◉ testCreateRename foo should no longer exist @@ -76,9 +76,9 @@ testCreateRename _ = ◉ testCreateRename bar should now exist ◉ testCreateRename removeDirectory works recursively ◉ testCreateRename removeDirectory works recursively - + ✅ 7 test(s) passing - + Tip: Use view testCreateRename to view the source of a test. ``` @@ -88,7 +88,7 @@ Tests: openFile closeFile isFileOpen -```unison +``` unison testOpenClose : '{io2.IO} [Result] testOpenClose _ = test = 'let @@ -102,33 +102,33 @@ testOpenClose _ = runTest test ``` -```ucm +``` ucm 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`: - + testOpenClose : '{IO} [Result] ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: - + testOpenClose : '{IO} [Result] .> io.test testOpenClose New test results: - + ◉ testOpenClose file should be open ◉ testOpenClose file should be closed - + ✅ 2 test(s) passing - + Tip: Use view testOpenClose to view the source of a test. ``` @@ -142,7 +142,7 @@ Tests: openFile seekHandle getBytes -```unison +``` unison testSeek : '{io2.IO} [Result] testSeek _ = test = 'let @@ -191,54 +191,54 @@ testAppend _ = runTest test ``` -```ucm +``` ucm 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`: - + testAppend : '{IO} [Result] testSeek : '{IO} [Result] ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: - + testAppend : '{IO} [Result] testSeek : '{IO} [Result] .> io.test testSeek New test results: - + ◉ testSeek seeked ◉ testSeek readable file should be seekable ◉ testSeek shouldn't be the EOF ◉ testSeek we should be at position 0 ◉ testSeek we should be at position 1 ◉ testSeek should be able to read our temporary file after seeking - + ✅ 6 test(s) passing - + Tip: Use view testSeek to view the source of a test. .> io.test testAppend New test results: - + ◉ testAppend should be able to read our temporary file - + ✅ 1 test(s) passing - + Tip: Use view testAppend to view the source of a test. ``` ### SystemTime -```unison +``` unison testSystemTime : '{io2.IO} [Result] testSystemTime _ = test = 'let @@ -248,32 +248,32 @@ testSystemTime _ = runTest test ``` -```ucm +``` ucm 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`: - + testSystemTime : '{IO} [Result] ``` -```ucm +``` ucm .> add ⍟ I've added these definitions: - + testSystemTime : '{IO} [Result] .> io.test testSystemTime New test results: - + ◉ testSystemTime systemTime should be sane - + ✅ 1 test(s) passing - + Tip: Use view testSystemTime to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/mvar.md b/unison-src/transcripts-using-base/mvar.md index 81be1ed79b..67eccd7a4d 100644 --- a/unison-src/transcripts-using-base/mvar.md +++ b/unison-src/transcripts-using-base/mvar.md @@ -10,7 +10,7 @@ primitives can be built, such as Futures, Run at most once initializer blocks, Queues, etc. -```unison +``` unison eitherCk : (a -> Boolean) -> Either e a -> Boolean eitherCk f = cases Left _ -> false @@ -50,8 +50,7 @@ testMvars _ = runTest test ``` -```ucm +``` ucm scratch/main> add scratch/main> io.test testMvars ``` - diff --git a/unison-src/transcripts-using-base/mvar.output.md b/unison-src/transcripts-using-base/mvar.output.md index c0bfdac99c..7e18b62f4b 100644 --- a/unison-src/transcripts-using-base/mvar.output.md +++ b/unison-src/transcripts-using-base/mvar.output.md @@ -50,32 +50,31 @@ testMvars _ = runTest test ``` -``` ucm - +``` ucm :added-by-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`: eitherCk : (a ->{g} Boolean) -> Either e a ->{g} Boolean testMvars : '{IO} [Result] - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + eitherCk : (a ->{g} Boolean) -> Either e a ->{g} Boolean testMvars : '{IO} [Result] scratch/main> io.test testMvars New test results: - + 1. testMvars ◉ ma should not be empty ◉ should read what you sow ◉ should reap what you sow @@ -89,9 +88,8 @@ scratch/main> io.test testMvars ◉ ma2 should be empty ◉ tryTake should fail when empty ◉ tryRead should fail when empty - + ✅ 13 test(s) passing - - Tip: Use view 1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/nat-coersion.md b/unison-src/transcripts-using-base/nat-coersion.md index ca5ad40f2a..a055c40bab 100644 --- a/unison-src/transcripts-using-base/nat-coersion.md +++ b/unison-src/transcripts-using-base/nat-coersion.md @@ -1,4 +1,4 @@ -```unison +``` unison testNat: Nat -> Optional Int -> Optional Float -> {Stream Result}() testNat n expectInt expectFloat = @@ -32,7 +32,7 @@ test = 'let runTest testABunchOfNats ``` -```ucm +``` ucm scratch/main> add scratch/main> io.test test ``` diff --git a/unison-src/transcripts-using-base/nat-coersion.output.md b/unison-src/transcripts-using-base/nat-coersion.output.md index 14d5c66855..1fe0ce8e34 100644 --- a/unison-src/transcripts-using-base/nat-coersion.output.md +++ b/unison-src/transcripts-using-base/nat-coersion.output.md @@ -1,4 +1,5 @@ ``` unison + testNat: Nat -> Optional Int -> Optional Float -> {Stream Result}() testNat n expectInt expectFloat = float = Float.fromRepresentation n @@ -31,14 +32,13 @@ test = 'let runTest testABunchOfNats ``` -``` ucm - +``` ucm :added-by-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`: test : '{IO} [Result] @@ -46,13 +46,13 @@ test = 'let -> Optional Int -> Optional Float ->{Stream Result} () - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + test : '{IO} [Result] testNat : Nat -> Optional Int @@ -62,7 +62,7 @@ scratch/main> add scratch/main> io.test test New test results: - + 1. test ◉ expected 0.0 got 0.0 ◉ round trip though float, expected 0 got 0 ◉ expected 0 got 0 @@ -77,9 +77,8 @@ scratch/main> io.test test ◉ round trip though float, expected 4607182418800017409 got 4607182418800017409 ◉ expected 4607182418800017409 got 4607182418800017409 ◉ round trip though Int, expected 4607182418800017409 got 4607182418800017409 - + ✅ 14 test(s) passing - - Tip: Use view 1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/net.md b/unison-src/transcripts-using-base/net.md index 067f9b9a45..20e604b0a2 100644 --- a/unison-src/transcripts-using-base/net.md +++ b/unison-src/transcripts-using-base/net.md @@ -1,4 +1,4 @@ -```unison:hide +``` unison :hide serverSocket = compose2 reraise IO.serverSocket.impl socketPort = compose reraise socketPort.impl listen = compose reraise listen.impl @@ -9,7 +9,7 @@ socketReceive = compose2 reraise socketReceive.impl socketAccept = compose reraise socketAccept.impl ``` -```ucm:hide +``` ucm :hide scratch/main> add ``` @@ -92,14 +92,14 @@ testDefaultPort _ = runTest test ``` -```ucm +``` ucm scratch/main> add scratch/main> io.test testDefaultPort ``` This example demonstrates connecting a TCP client socket to a TCP server socket. A thread is started for both client and server. The server socket asks for any availalbe port (by passing "0" as the port number). The server thread then queries for the actual assigned port number, and puts that into an MVar which the client thread can read. The client thread then reads a string from the server and reports it back to the main thread via a different MVar. -```unison +``` unison serverThread: MVar Nat -> Text -> '{io2.IO}() serverThread portVar toSend = 'let @@ -147,7 +147,7 @@ testTcpConnect = 'let runTest test ``` -```ucm +``` ucm scratch/main> add scratch/main> io.test testTcpConnect diff --git a/unison-src/transcripts-using-base/net.output.md b/unison-src/transcripts-using-base/net.output.md index 4ffc0528bc..7d6e6ba63c 100644 --- a/unison-src/transcripts-using-base/net.output.md +++ b/unison-src/transcripts-using-base/net.output.md @@ -1,4 +1,4 @@ -``` unison +``` unison :hide serverSocket = compose2 reraise IO.serverSocket.impl socketPort = compose reraise socketPort.impl listen = compose reraise listen.impl @@ -9,6 +9,10 @@ socketReceive = compose2 reraise socketReceive.impl socketAccept = compose reraise socketAccept.impl ``` +``` ucm :hide +scratch/main> add +``` + # Tests for network related builtins ### Creating server sockets @@ -92,26 +96,25 @@ testDefaultPort _ = runTest test ``` -``` ucm - +``` ucm :added-by-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`: testDefaultHost : '{IO} [Result] testDefaultPort : '{IO} [Result] testExplicitHost : '{IO} [Result] - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + testDefaultHost : '{IO} [Result] testDefaultPort : '{IO} [Result] testExplicitHost : '{IO} [Result] @@ -119,19 +122,20 @@ scratch/main> add scratch/main> io.test testDefaultPort New test results: - + 1. testDefaultPort ◉ successfully created socket ◉ port should be > 1024 ◉ port should be < 65536 - + ✅ 3 test(s) passing - - Tip: Use view 1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` + This example demonstrates connecting a TCP client socket to a TCP server socket. A thread is started for both client and server. The server socket asks for any availalbe port (by passing "0" as the port number). The server thread then queries for the actual assigned port number, and puts that into an MVar which the client thread can read. The client thread then reads a string from the server and reports it back to the main thread via a different MVar. ``` unison + serverThread: MVar Nat -> Text -> '{io2.IO}() serverThread portVar toSend = 'let go : '{io2.IO, Exception}() @@ -179,26 +183,25 @@ testTcpConnect = 'let ``` -``` ucm - +``` ucm :added-by-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`: clientThread : MVar Nat -> MVar Text -> '{IO} () serverThread : MVar Nat -> Text -> '{IO} () testTcpConnect : '{IO} [Result] - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + clientThread : MVar Nat -> MVar Text -> '{IO} () serverThread : MVar Nat -> Text -> '{IO} () testTcpConnect : '{IO} [Result] @@ -206,11 +209,10 @@ scratch/main> add scratch/main> io.test testTcpConnect New test results: - + 1. testTcpConnect ◉ should have reaped what we've sown - + ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/random-deserial.md b/unison-src/transcripts-using-base/random-deserial.md index 2c6ff77de5..70846ca59c 100644 --- a/unison-src/transcripts-using-base/random-deserial.md +++ b/unison-src/transcripts-using-base/random-deserial.md @@ -1,4 +1,4 @@ -```unison +``` unison directory = "unison-src/transcripts-using-base/serialized-cases/" availableCases : '{IO,Exception} [Text] @@ -26,14 +26,14 @@ shuffle = runTestCase : Text ->{Exception,IO} (Text, Test.Result) runTestCase name = sfile = directory ++ name ++ ".v4.ser" - lsfile = directory ++ name ++ ".v3.ser" + ls3file = directory ++ name ++ ".v3.ser" ofile = directory ++ name ++ ".out" hfile = directory ++ name ++ ".v4.hash" p@(f, i) = loadSelfContained sfile - pl@(fl, il) = - if fileExists lsfile - then loadSelfContained lsfile + pl3@(fl3, il3) = + if fileExists ls3file + then loadSelfContained ls3file else p o = fromUtf8 (readFile ofile) h = readFile hfile @@ -43,8 +43,8 @@ runTestCase name = then Fail (name ++ " output mismatch") else if not (toBase32 (crypto.hash Sha3_512 p) == h) then Fail (name ++ " hash mismatch") - else if not (fl il == f i) - then Fail (name ++ " legacy mismatch") + else if not (fl3 il3 == f i) + then Fail (name ++ " legacy v3 mismatch") else Ok name (name, result) @@ -55,7 +55,7 @@ serialTests = do List.map snd (bSort (List.map runTestCase cs)) ``` -```ucm +``` ucm scratch/main> add scratch/main> io.test serialTests ``` diff --git a/unison-src/transcripts-using-base/random-deserial.output.md b/unison-src/transcripts-using-base/random-deserial.output.md index 6c68e978ec..9b02b35804 100644 --- a/unison-src/transcripts-using-base/random-deserial.output.md +++ b/unison-src/transcripts-using-base/random-deserial.output.md @@ -26,14 +26,14 @@ shuffle = runTestCase : Text ->{Exception,IO} (Text, Test.Result) runTestCase name = sfile = directory ++ name ++ ".v4.ser" - lsfile = directory ++ name ++ ".v3.ser" + ls3file = directory ++ name ++ ".v3.ser" ofile = directory ++ name ++ ".out" hfile = directory ++ name ++ ".v4.hash" p@(f, i) = loadSelfContained sfile - pl@(fl, il) = - if fileExists lsfile - then loadSelfContained lsfile + pl3@(fl3, il3) = + if fileExists ls3file + then loadSelfContained ls3file else p o = fromUtf8 (readFile ofile) h = readFile hfile @@ -43,8 +43,8 @@ runTestCase name = then Fail (name ++ " output mismatch") else if not (toBase32 (crypto.hash Sha3_512 p) == h) then Fail (name ++ " hash mismatch") - else if not (fl il == f i) - then Fail (name ++ " legacy mismatch") + else if not (fl3 il3 == f i) + then Fail (name ++ " legacy v3 mismatch") else Ok name (name, result) @@ -55,14 +55,13 @@ serialTests = do List.map snd (bSort (List.map runTestCase cs)) ``` -``` ucm - +``` ucm :added-by-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`: availableCases : '{IO, Exception} [Text] @@ -71,13 +70,13 @@ serialTests = do runTestCase : Text ->{IO, Exception} (Text, Result) serialTests : '{IO, Exception} [Result] shuffle : Nat -> [a] -> [a] - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + availableCases : '{IO, Exception} [Text] directory : Text gen : Nat -> Nat -> (Nat, Nat) @@ -88,15 +87,14 @@ scratch/main> add scratch/main> io.test serialTests New test results: - + 1. serialTests ◉ case-00 ◉ case-01 ◉ case-02 ◉ case-03 ◉ case-04 - + ✅ 5 test(s) passing - - Tip: Use view 1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/ref-promise.md b/unison-src/transcripts-using-base/ref-promise.md index 3c2575951c..29029e6d3a 100644 --- a/unison-src/transcripts-using-base/ref-promise.md +++ b/unison-src/transcripts-using-base/ref-promise.md @@ -3,7 +3,7 @@ Ref support a CAS operation that can be used as a building block to change state atomically without locks. -```unison +``` unison casTest: '{io2.IO} [Result] casTest = do test = do @@ -18,14 +18,14 @@ casTest = do runTest test ``` -```ucm +``` ucm scratch/main> add scratch/main> io.test casTest ``` Promise is a simple one-shot awaitable condition. -```unison +``` unison promiseSequentialTest : '{IO} [Result] promiseSequentialTest = do test = do @@ -53,7 +53,7 @@ promiseConcurrentTest = do runTest test ``` -```ucm +``` ucm scratch/main> add scratch/main> io.test promiseSequentialTest scratch/main> io.test promiseConcurrentTest @@ -61,7 +61,7 @@ scratch/main> io.test promiseConcurrentTest CAS can be used to write an atomic update function. -```unison +``` unison atomicUpdate : Ref {IO} a -> (a -> a) ->{IO} () atomicUpdate ref f = ticket = Ref.readForCas ref @@ -69,14 +69,14 @@ atomicUpdate ref f = if Ref.cas ref ticket value then () else atomicUpdate ref f ``` -```ucm +``` ucm scratch/main> add ``` Promise can be used to write an operation that spawns N concurrent tasks and collects their results -```unison +``` unison spawnN : Nat -> '{IO} a ->{IO} [a] spawnN n fa = use Nat eq drop @@ -90,7 +90,7 @@ spawnN n fa = map Promise.read (go n []) ``` -```ucm +``` ucm scratch/main> add ``` @@ -98,11 +98,11 @@ We can use these primitives to write a more interesting example, where multiple threads repeatedly update an atomic counter, we check that the value of the counter is correct after all threads are done. -```unison +``` unison fullTest : '{IO} [Result] fullTest = do use Nat * + eq drop - + numThreads = 100 iterations = 100 expected = numThreads * iterations @@ -112,17 +112,17 @@ fullTest = do thread n = if eq n 0 then () - else + else atomicUpdate state (v -> v + 1) thread (drop n 1) void (spawnN numThreads '(thread iterations)) result = Ref.read state check "The state of the counter is consistent "(eq result expected) - + runTest test ``` -```ucm +``` ucm scratch/main> add scratch/main> io.test fullTest ``` diff --git a/unison-src/transcripts-using-base/ref-promise.output.md b/unison-src/transcripts-using-base/ref-promise.output.md index b44e98bb9f..6ee80cacd3 100644 --- a/unison-src/transcripts-using-base/ref-promise.output.md +++ b/unison-src/transcripts-using-base/ref-promise.output.md @@ -18,38 +18,37 @@ casTest = do runTest test ``` -``` ucm - +``` ucm :added-by-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`: casTest : '{IO} [Result] - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + casTest : '{IO} [Result] scratch/main> io.test casTest New test results: - + 1. casTest ◉ CAS is successful is there were no conflicting writes ◉ CAS fails when there was an intervening write - + ✅ 2 test(s) passing - - Tip: Use view 1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` + Promise is a simple one-shot awaitable condition. ``` unison @@ -80,50 +79,49 @@ promiseConcurrentTest = do runTest test ``` -``` ucm - +``` ucm :added-by-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`: promiseConcurrentTest : '{IO} [Result] promiseSequentialTest : '{IO} [Result] - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + promiseConcurrentTest : '{IO} [Result] promiseSequentialTest : '{IO} [Result] scratch/main> io.test promiseSequentialTest New test results: - + 1. promiseSequentialTest ◉ Should read a value that's been written ◉ Promise can only be written to once - + ✅ 2 test(s) passing - + Tip: Use view 1 to view the source of a test. scratch/main> io.test promiseConcurrentTest New test results: - + 1. promiseConcurrentTest ◉ Reads awaits for completion of the Promise - + ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` + CAS can be used to write an atomic update function. ``` unison @@ -134,27 +132,26 @@ atomicUpdate ref f = if Ref.cas ref ticket value then () else atomicUpdate ref f ``` -``` ucm - +``` ucm :added-by-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`: atomicUpdate : Ref {IO} a -> (a -> a) ->{IO} () - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - - atomicUpdate : Ref {IO} a -> (a -> a) ->{IO} () + atomicUpdate : Ref {IO} a -> (a -> a) ->{IO} () ``` + Promise can be used to write an operation that spawns N concurrent tasks and collects their results @@ -173,27 +170,26 @@ spawnN n fa = map Promise.read (go n []) ``` -``` ucm - +``` ucm :added-by-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`: spawnN : Nat -> '{IO} a ->{IO} [a] - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - - spawnN : Nat -> '{IO} a ->{IO} [a] + spawnN : Nat -> '{IO} a ->{IO} [a] ``` + We can use these primitives to write a more interesting example, where multiple threads repeatedly update an atomic counter, we check that the value of the counter is correct after all threads are done. @@ -202,7 +198,7 @@ the value of the counter is correct after all threads are done. fullTest : '{IO} [Result] fullTest = do use Nat * + eq drop - + numThreads = 100 iterations = 100 expected = numThreads * iterations @@ -212,44 +208,42 @@ fullTest = do thread n = if eq n 0 then () - else + else atomicUpdate state (v -> v + 1) thread (drop n 1) void (spawnN numThreads '(thread iterations)) result = Ref.read state check "The state of the counter is consistent "(eq result expected) - + runTest test ``` -``` ucm - +``` ucm :added-by-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`: fullTest : '{IO} [Result] - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + fullTest : '{IO} [Result] scratch/main> io.test fullTest New test results: - + 1. fullTest ◉ The state of the counter is consistent - + ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/serial-test-00.md b/unison-src/transcripts-using-base/serial-test-00.md index 21860243e3..4c5f5bb79c 100644 --- a/unison-src/transcripts-using-base/serial-test-00.md +++ b/unison-src/transcripts-using-base/serial-test-00.md @@ -1,4 +1,4 @@ -```unison +``` unison structural type Tree a = Leaf | Node (Tree a) a (Tree a) foldMap : r -> (r -> r -> r) -> (a -> r) -> Tree a -> r @@ -67,7 +67,7 @@ mkTestCase = do saveTestCase "case-00" "v4" f tup ``` -```ucm +``` ucm scratch/main> add scratch/main> run mkTestCase ``` diff --git a/unison-src/transcripts-using-base/serial-test-00.output.md b/unison-src/transcripts-using-base/serial-test-00.output.md index ce996f93ba..a116fcc248 100644 --- a/unison-src/transcripts-using-base/serial-test-00.output.md +++ b/unison-src/transcripts-using-base/serial-test-00.output.md @@ -67,14 +67,13 @@ mkTestCase = do saveTestCase "case-00" "v4" f tup ``` -``` ucm - +``` ucm :added-by-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`: structural type Tree a @@ -92,13 +91,13 @@ mkTestCase = do tree1 : Tree Nat tree2 : Tree Nat tree3 : Tree Text - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + structural type Tree a evaluate : (Tree Nat -> Nat) -> (Tree Text -> Text) @@ -118,5 +117,4 @@ scratch/main> add scratch/main> run mkTestCase () - ``` diff --git a/unison-src/transcripts-using-base/serial-test-01.md b/unison-src/transcripts-using-base/serial-test-01.md index bc5f84af0d..eb0a6fdfa7 100644 --- a/unison-src/transcripts-using-base/serial-test-01.md +++ b/unison-src/transcripts-using-base/serial-test-01.md @@ -1,4 +1,4 @@ -```unison +``` unison l1 = [1.0,2.0,3.0] l2 = [+1,+2,+3] l3 = [?a, ?b, ?c] @@ -15,7 +15,7 @@ mkTestCase = do saveTestCase "case-01" "v4" combines (l1, l2, l3) ``` -```ucm +``` ucm scratch/main> add scratch/main> run mkTestCase ``` diff --git a/unison-src/transcripts-using-base/serial-test-01.output.md b/unison-src/transcripts-using-base/serial-test-01.output.md index a6654a2547..d7deff53f2 100644 --- a/unison-src/transcripts-using-base/serial-test-01.output.md +++ b/unison-src/transcripts-using-base/serial-test-01.output.md @@ -15,14 +15,13 @@ mkTestCase = do saveTestCase "case-01" "v4" combines (l1, l2, l3) ``` -``` ucm - +``` ucm :added-by-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`: combines : ([Float], [Int], [Char]) -> Text @@ -30,13 +29,13 @@ mkTestCase = do l2 : [Int] l3 : [Char] mkTestCase : '{IO, Exception} () - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + combines : ([Float], [Int], [Char]) -> Text l1 : [Float] l2 : [Int] @@ -46,5 +45,4 @@ scratch/main> add scratch/main> run mkTestCase () - ``` diff --git a/unison-src/transcripts-using-base/serial-test-02.md b/unison-src/transcripts-using-base/serial-test-02.md index 15518165a0..827d36f3ce 100644 --- a/unison-src/transcripts-using-base/serial-test-02.md +++ b/unison-src/transcripts-using-base/serial-test-02.md @@ -1,4 +1,4 @@ -```unison +``` unison structural ability Exit a where exit : a -> b @@ -29,7 +29,7 @@ mkTestCase = do ``` -```ucm +``` ucm scratch/main> add scratch/main> run mkTestCase ``` diff --git a/unison-src/transcripts-using-base/serial-test-02.output.md b/unison-src/transcripts-using-base/serial-test-02.output.md index 102fea092b..9b91fe1aac 100644 --- a/unison-src/transcripts-using-base/serial-test-02.output.md +++ b/unison-src/transcripts-using-base/serial-test-02.output.md @@ -29,14 +29,13 @@ mkTestCase = do ``` -``` ucm - +``` ucm :added-by-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`: structural ability Exit a @@ -46,13 +45,13 @@ mkTestCase = do mkTestCase : '{IO, Exception} () prod : [Nat] -> Nat products : ([Nat], [Nat], [Nat]) -> Text - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + structural ability Exit a l1 : [Nat] l2 : [Nat] @@ -64,5 +63,4 @@ scratch/main> add scratch/main> run mkTestCase () - ``` diff --git a/unison-src/transcripts-using-base/serial-test-03.md b/unison-src/transcripts-using-base/serial-test-03.md index 2e66f687d9..fb68b0458b 100644 --- a/unison-src/transcripts-using-base/serial-test-03.md +++ b/unison-src/transcripts-using-base/serial-test-03.md @@ -1,4 +1,4 @@ -```unison +``` unison structural ability DC r where shift : ((a -> r) -> r) -> a @@ -43,7 +43,7 @@ mkTestCase = do saveTestCase "case-03" "v4" finish trip ``` -```ucm +``` ucm scratch/main> add scratch/main> run mkTestCase ``` diff --git a/unison-src/transcripts-using-base/serial-test-03.output.md b/unison-src/transcripts-using-base/serial-test-03.output.md index a20eafe7f6..72c15ebbdf 100644 --- a/unison-src/transcripts-using-base/serial-test-03.output.md +++ b/unison-src/transcripts-using-base/serial-test-03.output.md @@ -43,14 +43,13 @@ mkTestCase = do saveTestCase "case-03" "v4" finish trip ``` -``` ucm - +``` ucm :added-by-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`: structural ability DC r @@ -65,13 +64,13 @@ mkTestCase = do mkTestCase : '{IO, Exception} () reset : '{DC r} r -> r suspSum : [Nat] -> Delayed Nat - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + structural ability DC r structural type Delayed r feed : Nat -> Delayed r -> r @@ -87,5 +86,4 @@ scratch/main> add scratch/main> run mkTestCase () - ``` diff --git a/unison-src/transcripts-using-base/serial-test-04.md b/unison-src/transcripts-using-base/serial-test-04.md index 212b59c9e0..67c699e267 100644 --- a/unison-src/transcripts-using-base/serial-test-04.md +++ b/unison-src/transcripts-using-base/serial-test-04.md @@ -1,4 +1,4 @@ -```unison +``` unison mutual0 = cases 0 -> "okay" @@ -13,7 +13,7 @@ mkTestCase = do saveTestCase "case-04" "v4" mutual1 5 ``` -```ucm +``` ucm scratch/main> add scratch/main> run mkTestCase ``` diff --git a/unison-src/transcripts-using-base/serial-test-04.output.md b/unison-src/transcripts-using-base/serial-test-04.output.md index 990ce14799..9e45041b57 100644 --- a/unison-src/transcripts-using-base/serial-test-04.output.md +++ b/unison-src/transcripts-using-base/serial-test-04.output.md @@ -1,4 +1,5 @@ ``` unison + mutual0 = cases 0 -> "okay" n -> @@ -12,26 +13,25 @@ mkTestCase = do saveTestCase "case-04" "v4" mutual1 5 ``` -``` ucm - +``` ucm :added-by-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`: mkTestCase : '{IO, Exception} () mutual0 : Nat -> Text mutual1 : Nat -> Text - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + mkTestCase : '{IO, Exception} () mutual0 : Nat -> Text mutual1 : Nat -> Text @@ -39,5 +39,4 @@ scratch/main> add scratch/main> run mkTestCase () - ``` diff --git a/unison-src/transcripts-using-base/serialized-cases/case-00.v3.ser b/unison-src/transcripts-using-base/serialized-cases/case-00.v3.ser deleted file mode 100644 index c2c2a191f1..0000000000 --- a/unison-src/transcripts-using-base/serialized-cases/case-00.v3.ser +++ /dev/null @@ -1 +0,0 @@ -AAAAAAYBAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAABAGAIDAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAAAAEAYCAAASCABEJQL3GHBIMDX5JPPWYFOZ223DZ3ITSUCKHECCW76BTMFCNHASHQAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAACAMDAABABAEAQCBQAAQAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAQAAAAQCAIDAEAQCCYAAEAQCAYBAEQQAJCMC6ZRYKDA57KL35WBLWOWWY6O2E4VASRZAQVX7QM3BITJYER4AACAMBIEAIFQAAQBAEBQABYBAIFQAAYBAEBQCAJBAASEYF5TDQUGB36UXX3MCXM5NNR45UJZKBFDSBBLP7AZWCRGTQJDYAAEBADQMAQLAACACAIDAAEAEAIAAMAASAQDAAAACAKAAAX7CUYLIPZBB2NU3HFA3VZZPIBMNKJFWD2AXSYRTBZ7VTXTVE3DR23R7ZB6XCZEAZ5QURR4XOHRYMYNJA3D2NV64JQ6S7RHTD2M2AQAAAAAAAAAAAAAAAAAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAAAAEAYCAAASCABY54MKDAPBPRJ7CPHBAK36YKBIALXQMXI22MHCH6OX3RZNMAPIFEAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAACAMDAAAIBAEAACAKAAAX7CUYLIPZBB2NU3HFA3VZZPIBMNKJFWD2AXSYRTBZ7VTXTVE3DR23R7ZB6XCZEAZ5QURR4XOHRYMYNJA3D2NV64JQ6S7RHTD2M2AQAAAAAAAAAAAAAAAAAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAAAAEAYCAAASCAEJOCTGNW2P26UFUL4ED6HHI6AMSK5UTY4X2ML63KIV5WR6XGRQ4AAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAACAMDAAAYBAEAQMAAEAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAACAACAEAQMAAEAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAACAACAEAQMAAEAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAACAACAEAQMAAEAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAACAACAEAQMAAEAFAAAL7RKMFUH4QQ5G2NTSQN244XUAWGVES3B5ALZMIZQ472Z3Z2SNRY5NY74Q7LRMSAM6YKIY6LXDY4GMGUQNR5G27OEYPJPYTZR5GNAIAACAAABMAA4AIBAMAAUAIHBMAA2AIBAMAAWAIGBMAAYAIBAMAAYAIFBMAAWAIBAMAAYAIEBIAQCBYDAEUAWAABAEAQGAIABJHGC5BOORXVIZLYOQAQICYAAIAQCAYBAADVIZLYOQXCWKYCAEAAUAIBA4BQELBABMAAGAIBAMAQAB2UMV4HILRLFMBACAALAACACAIDAEAAUTTBOQXHI32UMV4HIAIHBMAAKAIBAMAQAB2UMV4HILRLFMBACAAKAEAQOAYCFQQAWAAGAEAQGAIAA5KGK6DUFYVSWAQBAAFQABYBAEBQCAAKJZQXILTUN5KGK6DUAEFAWAAIAEAQGAIAA5KGK6DUFYVSWAQBAAFACAIHAMBCYIALAAEQCAIDAEAAOVDFPB2C4KZLAIAQACYABIAQCAYBAADVIZLYOQXCWKYCAAGQUAIBA4BQCKIDAEAAOVDFPB2C4KZLAIAQAAAAAAAAAAIBIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAAAAAAAAAAAAAAAAAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAAAQDAUAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAAAQAAEQQBCLQUZTNWT6XVBNC7BA7RZ2HQDESXNE6HF6TC7W2SFPNUPVZUMHAAAAAAAAAAAAAAAAAAIAACIIAERGBPMY4FBQO7VF563AV3HLLMPHNCOKQJI4QIK37YGNQUJU4CI6AAAAAAAAAAAAAAAAAGAABEEADR3YYUGA6C7CT6E6OCAVX5QUCQAXPAZORVUYOEP45PXDS2YA6QKIAAAAAAAAAAAAAAAAAAAAAKTTBOQXCWAAAAAAAAAAAAAAAAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAAAAAAJBAASEYF5TDQUGB36UXX3MCXM5NNR45UJZKBFDSBBLP7AZWCRGTQJDYAAAAAAAAAAAAAAAAAYAAEQQAOHPDCQYDYL4KPYTZYICW7WCQKAC54DF2GWTBYR7TV64OLLAD2BJAAAAAAAAAAAAAAAAAAAAAB2UMV4HILRLFMAAAAAAAAAAAAAAAABQAAABAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAABACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAACAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAEAAGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAIAAMAQCQFLNOASV6MR5HG6P3HFFKN2IW7E4DK75AL4PFVOBRGHLB55BOHFMRTBHEHGBWKEQOK5SZZZ7AXGFJUNVTX7PRKUK2DUMTL4ERO7HQAPYAAAAAAAAAAAAAAAAAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAABAAAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAIAAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAEAAGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAYAAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAEAAGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAABAAAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAAAAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAAAAIAQCQFLNOASV6MR5HG6P3HFFKN2IW7E4DK75AL4PFVOBRGHLB55BOHFMRTBHEHGBWKEQOK5SZZZ7AXGFJUNVTX7PRKUK2DUMTL4ERO7HQAPYAAAAAAAAAAAAAAQAAYBAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAABAABQCAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAACAADAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAAAAAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAIAACAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAAAAAAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAACAABAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAABAABQCAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAAAAAAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAGAABAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAABAABQCAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAAAAAAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAIAABAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAAAAAAACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAAAAAAQCQFLNOASV6MR5HG6P3HFFKN2IW7E4DK75AL4PFVOBRGHLB55BOHFMRTBHEHGBWKEQOK5SZZZ7AXGFJUNVTX7PRKUK2DUMTL4ERO7HQAPYAAAAAAAAAAAAAAQAAYBAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAABAABQCAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAACAADAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAAAAAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAA4AACAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAAAAAAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAMAABAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAABAABQCAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAAAAAAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAQAABAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAABAABQCAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAAAAAAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAASAABAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAAAAAAACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAAFAAAQCQFLNOASV6MR5HG6P3HFFKN2IW7E4DK75AL4PFVOBRGHLB55BOHFMRTBHEHGBWKEQOK5SZZZ7AXGFJUNVTX7PRKUK2DUMTL4ERO7HQAPYAAAAAAAAAAAAAAAAAABAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAABACAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAACAADAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAEAAGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAIAAMAQCQFLNOASV6MR5HG6P3HFFKN2IW7E4DK75AL4PFVOBRGHLB55BOHFMRTBHEHGBWKEQOK5SZZZ7AXGFJUNVTX7PRKUK2DUMTL4ERO7HQAPYAAAAAAAAAAAAAAAAAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAABAAAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAIAAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAEAAGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAYAAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAEAAGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAABAAAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAAAAAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAABIAACAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAACAADAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAEAAGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAIAAMAQCQFLNOASV6MR5HG6P3HFFKN2IW7E4DK75AL4PFVOBRGHLB55BOHFMRTBHEHGBWKEQOK5SZZZ7AXGFJUNVTX7PRKUK2DUMTL4ERO7HQAPYAAAAAAAAAAAAAAAAAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAABAAAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAIAAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAEAAGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAYAAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAEAAGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAABAAAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAAAAAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAAAACAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAACAADAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAEAAGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAIAAMAQCQFLNOASV6MR5HG6P3HFFKN2IW7E4DK75AL4PFVOBRGHLB55BOHFMRTBHEHGBWKEQOK5SZZZ7AXGFJUNVTX7PRKUK2DUMTL4ERO7HQAPYAAAAAAAAAAAAAAAAAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAADQAAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAABQAAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAEAAGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAACAAAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAEAAGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAACIAAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAAAAAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAUAACAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAAAAAAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAAAAEAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAIAAMAQCQFLNOASV6MR5HG6P3HFFKN2IW7E4DK75AL4PFVOBRGHLB55BOHFMRTBHEHGBWKEQOK5SZZZ7AXGFJUNVTX7PRKUK2DUMTL4ERO7HQAPYAAAAAAAAAAAAAAQAAYBAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAAAAAAAGAAFNBSWY3DPAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAAAAAAYAAEQACAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAACAADAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAEAAGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAABQABDHN5XWIAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAABQAA3CPFSQCAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAAAAAAAEAUAABP6FJQWQ7SCDU3JWOKBXLTS6QCY2USLMHUBPFRDGDT7LHPHKJWHDVXD7SD5OFSIBT3BJDDZO4PDQZQ2SBWHU3L5YTB5F7CPGHUZUBAAAAAAAAAAAAAAAAAAAIBIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAAAAAAAAAAAAAAAAAQCQAAF7YVGC2D6IIOTNGZZIG5OOL2ALDKSJNQ6QF4WEMYOP5M545JGY4OW4P6IPVYWJAGPMFEMPF3R4ODGDKIGY6TNPXCMHUX4J4Y6TGQEAAAAAAAAAAAAAAAAAA= \ No newline at end of file diff --git a/unison-src/transcripts-using-base/serialized-cases/case-00.v5.hash b/unison-src/transcripts-using-base/serialized-cases/case-00.v5.hash new file mode 100644 index 0000000000..181c564dc3 --- /dev/null +++ b/unison-src/transcripts-using-base/serialized-cases/case-00.v5.hash @@ -0,0 +1 @@ +Z6EW6IDZJXHDMNGTVSKYLMZVG47ORYF4O6JDQXQGQFJP476SLM75FXFOYI27OJHMIX5OIHKQ6LXWLYQ5LDGEYWEXK6GQPP6JKH6SVMI= \ No newline at end of file diff --git a/unison-src/transcripts-using-base/serialized-cases/case-00.v5.ser b/unison-src/transcripts-using-base/serialized-cases/case-00.v5.ser new file mode 100644 index 0000000000..afdd5055e3 --- /dev/null +++ b/unison-src/transcripts-using-base/serialized-cases/case-00.v5.ser @@ -0,0 +1 @@ +AAAAABIBAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIBQCAYBAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIBQEAABEEACITAXWMOCQYHP2S67NQK5TVVWHTWRHFIEUOIEFN74DGYKE2OBEPAAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAABAGBQAAQAQCAIBAYAAIAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAIAAAAIBAEBQCAIBBMAACAIBAMAQCIIAERGBPMY4FBQO7VF563AV3HLLMPHNCOKQJI4QIK37YGNQUJU4CI6AABAGAUCAECYAAIAQCAYAA4AQECYAAMAQCAYBAEQQAJCMC6ZRYKDA57KL35WBLWOWWY6O2E4VASRZAQVX7QM3BITJYER4AACAQBYGAIFQABABAEBQACACAEAAGAAJAIBQAAAAAEAUAABP6FJQWQ7SCDU3JWOKBXLTS6QCY2USLMHUBPFRDGDT7LHPHKJWHDVXD7SD5OFSIBT3BJDDZO4PDQZQ2SBWHU3L5YTB5F7CPGHUZUBAAAAAAAAAAAAAAAAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAQDAIAACIIAHDXRRIMB4F6FH4J44EBLP3BIFABO6BS5DLJQ4I7Z27OHFVQB5AUQAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAACAMDAAAIBAEAAAAIBIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAAAAAAAAAAAAAAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAABAGAQAAEQQBCLQUZTNWT6XVBNC7BA7RZ2HQDESXNE6HF6TC7W2SFPNUPVZUMHAAAAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAEAYGAABQCAIBAYAAIAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAEAAEAIBAYAAIAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAEAAEAIBAYAAIAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAEAAEAIBAYAAIAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAEAAEAIBAYAAIAKAAAX7CUYLIPZBB2NU3HFA3VZZPIBMNKJFWD2AXSYRTBZ7VTXTVE3DR23R7ZB6XCZEAZ5QURR4XOHRYMYNJA3D2NV64JQ6S7RHTD2M2AQAAEAAACYABYAQCAYABIAQOCYABUAQCAYABMAQMCYABQAQCAYABQAQKCYABMAQCAYABQAQICQBAEDQGAJIBMAACAIBAMAQACSOMF2C45DPKRSXQ5ABAQFQAAQBAEBQCAAHKRSXQ5BOFMVQEAIABIAQCBYDAIWCACYAAMAQCAYBAADVIZLYOQXCWKYCAEAAWAAEAEAQGAIABJHGC5BOORXVIZLYOQAQOCYAAUAQCAYBAADVIZLYOQXCWKYCAEAAUAIBA4BQELBABMAAMAIBAMAQAB2UMV4HILRLFMBACAALAADQCAIDAEAAUTTBOQXHI32UMV4HIAIKBMAAQAIBAMAQAB2UMV4HILRLFMBACAAKAEAQOAYCFQQAWAAJAEAQGAIAA5KGK6DUFYVSWAQBAAFQACQBAEBQCAAHKRSXQ5BOFMVQEAANBIAQCBYDAEUQGAIAA5KGK6DUFYVSWAQBAAAAAAAAAAAACAKAAAX7CUYLIPZBB2NU3HFA3VZZPIBMNKJFWD2AXSYRTBZ7VTXTVE3DR23R7ZB6XCZEAZ5QURR4XOHRYMYNJA3D2NV64JQ6S7RHTD2M2AQAAAAAAAAAAAAAAAABAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIBQKAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAACAAASCAEJOCTGNW2P26UFUL4ED6HHI6AMSK5UTY4X2ML63KIV5WR6XGRQ4AAAAAAAAAAAAAAAAIAACIIAERGBPMY4FBQO7VF563AV3HLLMPHNCOKQJI4QIK37YGNQUJU4CI6AAAAAAAAAAAAAAABQAAJBAA4O6GFBQHQXYU7RHTQQFN7MFAUAF3YGLUNNGDRD7HL5Y4WWAHUCSAAAAAAAAAAAAAAAAAAAAVHGC5BOFMAAAAAAAAAAAAAAAMEAAAABEEACITAXWMOCQYHP2S67NQK5TVVWHTWRHFIEUOIEFN74DGYKE2OBEPAAAAAAAAAAAAAAAAYAAEQQAOHPDCQYDYL4KPYTZYICW7WCQKAC54DF2GWTBYR7TV64OLLAD2BJAAAAAAAAAAAAAAAAAAAAOVDFPB2C4KZLAAAAAAAAAAAAAAADAAAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAQBAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIAQCQFLNOASV6MR5HG6P3HFFKN2IW7E4DK75AL4PFVOBRGHLB55BOHFMRTBHEHGBWKEQOK5SZZZ7AXGFJUNVTX7PRKUK2DUMTL4ERO7HQAPYAAAAAAAAAAAAAAQGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAIDAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAAAAGCACAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAAAAGCABAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAEBQCAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAAAAADBABQCAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAACAYBAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAAAAABQQBABAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAAAAAAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAEAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAIDAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAEBQCAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAACAYBAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAAAAABQQAQBAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAAAAABQQAIBAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAABAMAQCQFLNOASV6MR5HG6P3HFFKN2IW7E4DK75AL4PFVOBRGHLB55BOHFMRTBHEHGBWKEQOK5SZZZ7AXGFJUNVTX7PRKUK2DUMTL4ERO7HQAPYAAAAAAAAAAAAAAAAAYIAMAQCQFLNOASV6MR5HG6P3HFFKN2IW7E4DK75AL4PFVOBRGHLB55BOHFMRTBHEHGBWKEQOK5SZZZ7AXGFJUNVTX7PRKUK2DUMTL4ERO7HQAPYAAAAAAAAAAAAAAQGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAMEAIAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAMEAAAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAIDAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAEBQCAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAACAYBAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAAAAABQQBYBAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAAAAABQQBQBAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAABAMAQCQFLNOASV6MR5HG6P3HFFKN2IW7E4DK75AL4PFVOBRGHLB55BOHFMRTBHEHGBWKEQOK5SZZZ7AXGFJUNVTX7PRKUK2DUMTL4ERO7HQAPYAAAAAAAAAAAAAAAAAYIBAAQCQFLNOASV6MR5HG6P3HFFKN2IW7E4DK75AL4PFVOBRGHLB55BOHFMRTBHEHGBWKEQOK5SZZZ7AXGFJUNVTX7PRKUK2DUMTL4ERO7HQAPYAAAAAAAAAAAAAAQGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAMEASAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAMEAKAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAABACAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAACAYBAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAABAMAQCQFLNOASV6MR5HG6P3HFFKN2IW7E4DK75AL4PFVOBRGHLB55BOHFMRTBHEHGBWKEQOK5SZZZ7AXGFJUNVTX7PRKUK2DUMTL4ERO7HQAPYAAAAAAAAAAAAAAQGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAMEAEAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAMEACAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAIDAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAAAAGCADAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAEBQCAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAAAAADBACACAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAAAAADBAFACAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAACAYBAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAABAMAQCQFLNOASV6MR5HG6P3HFFKN2IW7E4DK75AL4PFVOBRGHLB55BOHFMRTBHEHGBWKEQOK5SZZZ7AXGFJUNVTX7PRKUK2DUMTL4ERO7HQAPYAAAAAAAAAAAAAAQGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAMEAEAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAMEACAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAIDAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAAAAGCADAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAEBQCAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAAAAADBACACAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAAAAADBAAACAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAACAYBAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAABAMAQCQFLNOASV6MR5HG6P3HFFKN2IW7E4DK75AL4PFVOBRGHLB55BOHFMRTBHEHGBWKEQOK5SZZZ7AXGFJUNVTX7PRKUK2DUMTL4ERO7HQAPYAAAAAAAAAAAAAAQGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAMEAOAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAAAAMEAMAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAIDAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAAAAGCAIAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAEBQCAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAAAAADBAEQCAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAAAAADBACQCAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAAAAABAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIAQCQFLNOASV6MR5HG6P3HFFKN2IW7E4DK75AL4PFVOBRGHLB55BOHFMRTBHEHGBWKEQOK5SZZZ7AXGFJUNVTX7PRKUK2DUMTL4ERO7HQAPYAAAAAAAAAAAAAAQGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAIDAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAAAAGAAFNBSWY3DPAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAAAAGAABEAAQCQFLNOASV6MR5HG6P3HFFKN2IW7E4DK75AL4PFVOBRGHLB55BOHFMRTBHEHGBWKEQOK5SZZZ7AXGFJUNVTX7PRKUK2DUMTL4ERO7HQAPYAAAAAAAAAAAAAAQGAIBICVWXAJK7GI6TTPH5TSSVG5ELPSOBVP6QF6HS2XAYTDVQ66QXDSWIZQTSDTA3FCIHFOZM447QLTCU2G2Z37XYVKFNB2GJV6CIXPTYAH4AAAAAAAAAAAAAAIDAEAUBK3LQEVPTEPJZXT6ZZJKTOSFXZHA2X7IC7DZNLQMJR2YPPILRZLEMYJZBZQNSREDSXMWOOPYFZRKNDNM5734KVCWQ5DE27BELXZ4AD6AAAAAAAAAAAAAAAAAGAAEM5XW6ZABAFAKW24BFL4ZD2ON47WOKKU3URN6JYGV72AXY6LK4DCMOWD32C4OKZDGCOIOMDMUJA4V3FTTT6BOMKTI3LHP67CVIVUHIZGXYJC56PAA7QAAAAAAAAAAAAAAAABQAA3CPFSQCAKAVNVYCKXZSHU43Z7M4UVJXJC34TQNL7UBPR4WVYGEY5MHXUFY4VSGME4Q4YGZISBZLWLHHH4C4YVGRWWO756FKRLIORSNPQSF346AB7AAAAAAAAAAAAAAAAABAFAAAL7RKMFUH4QQ5G2NTSQN244XUAWGVES3B5ALZMIZQ472Z3Z2SNRY5NY74Q7LRMSAM6YKIY6LXDY4GMGUQNR5G27OEYPJPYTZR5GNAIAAAAAAAAAAAAAAAAAQCQAAF7YVGC2D6IIOTNGZZIG5OOL2ALDKSJNQ6QF4WEMYOP5M545JGY4OW4P6IPVYWJAGPMFEMPF3R4ODGDKIGY6TNPXCMHUX4J4Y6TGQEAAAAAAAAAAAAAAAAAIBIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAAAAAAAAAAAAAA \ No newline at end of file diff --git a/unison-src/transcripts-using-base/serialized-cases/case-01.v3.ser b/unison-src/transcripts-using-base/serialized-cases/case-01.v3.ser deleted file mode 100644 index de087d1496..0000000000 --- a/unison-src/transcripts-using-base/serialized-cases/case-01.v3.ser +++ /dev/null @@ -1 +0,0 @@ -AAAAAAYBAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAABAGAIEAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAAAAEAYCAAASCABZFLRYPNZZRJMJUCYY6M4NSX5WH6MF6JAGXDI4HSXGNYHXQRGT5MAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAACAMDAABABAEAQCCYAAMAQCAYBAADUY2LTOQXGC5ACAABQMAAEAFALZN4S4OANDE4CHA7E4R6TLLNDKTMO27HHZB2OLDWY3AGZJGZ72KIKUMEV73X2VZQOFL7PW7OHRSHQ5NZL6B2OWFIK4WNPU4PLOBOK6IAAEAABAEFQAAIBAEBQABACAMAAUAIAA4AQAAAAAAAAAAABBIAQCAYDAABU4YLUAAAQACYAAIAQCAYBAACU4YLUFYVQEBIAAMAQCIIAHEVOHB5XHGFFRGQLDDZTRWK7WY7ZQXZEA24NDQ6K4ZXA66CE2PVQABAJBABQAAIAAEBAAAIBIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAAAAAAAAAAAAAAAAAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAAAQDAIAACIIAQYMIPCBVBNP3S5SFG3T6BWR6EJOIV6XGQRUTMQ63KF5YYLGD7VSAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAAAAIBQMAABAEDAABABIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAQAAQBAEDAABABIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAQAAQBAEDAABABIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAQAAQBAEDAABABIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAQAAALAAAQCAIDAEAAORTMN5QXILRLAAFACAAHAIAAAAAAAAAAAAAKAEAQGAYAAVDGY33BOQAACAALAAGQCAIDAEASCAGHFNRMQEP5G2FCRDWLLUNLMZHPE3SDCI7UBZVD25TA6YYJ6OKN3IAAGAQABAFQAAQBAEBQCAAFJFXHILRLAAFACAAHAAAAAAAAAAAAAAAKAEAQGAYAANEW45AAAEAAWAAMAEAQGAIBEEAMOK3CZAI72NUKFCHMWXI2WZSO6JXEGER7IDTKHV3GB5RQT44U3WQAAMBAACQLAABQCAIDAEASCAEUDIV2ECRTIY7TAIXLDHZPSJJP6UFOC5SYSJ7RS4QYOWIOZPZIIIAAACQBAEDQGAALAAFQCAIDAEASCAGHFNRMQEP5G2FCRDWLLUNLMZHPE3SDCI7UBZVD25TA6YYJ6OKN3IAAGAIABMFACAIHAMASQCYAAQAQCAYBAAGEM3DPMF2C45DPKRSXQ5ABBAFQABIBAEBQCAAHKRSXQ5BOFMVQEAIABIAQCBYDAIWCACYAAYAQCAYBAADVIZLYOQXCWKYCAEAAWAAHAEAQGAIABJEW45BOORXVIZLYOQAQQCYABAAQCAYBAADVIZLYOQXCWKYCAEAAUAIBA4BQGLBAEIFQACIBAEBQCAAHKRSXQ5BOFMVQEAIABMAAUAIBAMAQAB2UMV4HILRLFMBAACIKAEAQOAYCEIUQGAIAA5KGK6DUFYVSWAQBAAAAAAAAAEAUAABP6FJQWQ7SCDU3JWOKBXLTS6QCY2USLMHUBPFRDGDT7LHPHKJWHDVXD7SD5OFSIBT3BJDDZO4PDQZQ2SBWHU3L5YTB5F7CPGHUZUBAAAAAAAAAAAAAAAAAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAAAAIBQEAABEEAJIGRLUIFDGRR7GAROWGPS7ESS75IK4F3FRET7DFZBQ5MQ5S7SQQQAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAAAAEAYGAABACAILAAAQCAIDAEAAWQ3IMFZC45DPKRSXQ5ABAABQCAAHKRSXQ5BOFMVQEAQAAEAUAABP6FJQWQ7SCDU3JWOKBXLTS6QCY2USLMHUBPFRDGDT7LHPHKJWHDVXD7SD5OFSIBT3BJDDZO4PDQZQ2SBWHU3L5YTB5F7CPGHUZUBAAAAAAAAAAAAAAAAAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAAAAIBQEAABEEAMOK3CZAI72NUKFCHMWXI2WZSO6JXEGER7IDTKHV3GB5RQT44U3WQAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAAAAEAYGAABQCAIBBIAQABYBAAAAAAAAAAAAACQBAEBQGAADJZQXIAABAABQCAJBAA4SVY4HW44YUWE2BMMPGOGZL63D7GC7EQDLRUODZLTG4D3YITJ6WAAEAICAGAABAFAAAL7RKMFUH4QQ5G2NTSQN244XUAWGVES3B5ALZMIZQ472Z3Z2SNRY5NY74Q7LRMSAM6YKIY6LXDY4GMGUQNR5G27OEYPJPYTZR5GNAIAAAAAAAAAAAAAAAAAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAACAMCQCAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAACAAASCAEGDCDYQNILL64XMRJW47QNUPRCLSFPVZUENE3EHW2RPOGCZQ75MQAAAAAAAAAAAAAAAAAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAACAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAAAAEAYBAMAQABKGNRXWC5AAAAAAAAAAAAAACP7QAAAAAAAAAAAACAAFIZWG6YLUAAAAAAAAAAAAAAKAAAAAAAAAAAAAAAIAAVDGY33BOQAAAAAAAAAAAAABIAEAAAAAAAAAAAABAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAABAGAIDAEAAGSLOOQAAAAAAAAAAAAABAAAAAAAAAAAACAABAABUS3TUAAAAAAAAAAAAAAIAAAAAAAAAAABAAAIAANEW45AAAAAAAAAAAAAACAAAAAAAAAAAAMAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAACAMAQGAIAARBWQYLSAAAAAAAAAAAAAAIAAAAAAAAAABQQAAIAARBWQYLSAAAAAAAAAAAAAAIAAAAAAAAAABRAAAIAARBWQYLSAAAAAAAAAAAAAAIAAAAAAAAAABRQAAIBIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAAAAAAAAAAAAAAAAAQCQAAF7YVGC2D6IIOTNGZZIG5OOL2ALDKSJNQ6QF4WEMYOP5M545JGY4OW4P6IPVYWJAGPMFEMPF3R4ODGDKIGY6TNPXCMHUX4J4Y6TGQEAAAAAAAAAAAAAAAAAABAFAAAL7RKMFUH4QQ5G2NTSQN244XUAWGVES3B5ALZMIZQ472Z3Z2SNRY5NY74Q7LRMSAM6YKIY6LXDY4GMGUQNR5G27OEYPJPYTZR5GNAIAAAAAAAAAAAAAAAAAA==== \ No newline at end of file diff --git a/unison-src/transcripts-using-base/serialized-cases/case-01.v5.hash b/unison-src/transcripts-using-base/serialized-cases/case-01.v5.hash new file mode 100644 index 0000000000..d576afd225 --- /dev/null +++ b/unison-src/transcripts-using-base/serialized-cases/case-01.v5.hash @@ -0,0 +1 @@ +F5QWFLMAWQDYCMOPDCCTYLWJ2HOBGUG2G5YLWHSAFGDXSHGYQIWDSN6PVWC2RJXIGB7ZBSZVIJ6OENKGWAEZIV3CLQ2AWL3WKITPDXA= \ No newline at end of file diff --git a/unison-src/transcripts-using-base/serialized-cases/case-01.v5.ser b/unison-src/transcripts-using-base/serialized-cases/case-01.v5.ser new file mode 100644 index 0000000000..071ca615cb --- /dev/null +++ b/unison-src/transcripts-using-base/serialized-cases/case-01.v5.ser @@ -0,0 +1 @@ +AAAAABIBAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIBQCBABAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIBQEAABEEAFG5MMPCUOP3IIQXASYKKG2MIJ2XJ3B7MGFL6E44DZUAQUNLQVKHIAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAABAGBQAAMAQCAIKAEAQYAIAAAAAAAAAAAAAGAIBEEAO7KOJ7HCZGJXDGV7GZE7OLVCVEIO5QE4Y6TLY67FZSQS6DUK2SVYAAQAQGAQAAAAQCQAAF7YVGC2D6IIOTNGZZIG5OOL2ALDKSJNQ6QF4WEMYOP5M545JGY4OW4P6IPVYWJAGPMFEMPF3R4ODGDKIGY6TNPXCMHUX4J4Y6TGQEAAAAAAAAAAAAAAAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAACAMBAAAJBACAVWVMCTIBA5P5JFQIRMCJBBMWMLBPXDOTQRHHF76XEAPI46LZWWAABAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIBQMAABAEDAABABIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAQAAQBAEDAABABIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAQAAQBAEDAABABIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAQAAQBAEDAABABIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAQAAALAAAQCAIDAEAAORTMN5QXILRLAAFACAIMAIAAAAAAAAAAAAALAAGQCAIDAEASCACTOWGHRKHH5UEILQJMFFDNGEE5LU5Q7WDCV7COOB42AIKGVYKVDUAAGAIAA4FQAAQBAEBQCAAFJFXHILRLAAFACAIMAAAAAAAAAAAAAAALAAGACAIDAEASCACTOWGHRKHH5UEILQJMFFDNGEE5LU5Q7WDCV7COOB42AIKGVYKVDUAAGAIABAFQAAYBAEBQCAJBACKBUK5CBIZUMPZQELVRT4XZEUX7KCXBOZMJE7YZOIMHLEHMX4UEEAAABIAQCBYDAAFQACYBAEBQCAJBABJXLDDYVDT62CEFYEWCSRWTCCOV2OYP3BRK7RHHA6NAEFDK4FKR2AADAEAASCQBAEDQGAJIBMAAIAIBAMAQADCGNRXWC5BOORXVIZLYOQAQOCYAAUAQCAYBAADVIZLYOQXCWKYCAEAAUAIBA4BQELBABMAAMAIBAMAQAB2UMV4HILRLFMBACAALAADQCAIDAEAAUSLOOQXHI32UMV4HIAIIBMAAQAIBAMAQAB2UMV4HILRLFMBACAAKAEAQOAYDFQQCECYABEAQCAYBAADVIZLYOQXCWKYCAEAAWAAKAEAQGAIAA5KGK6DUFYVSWAQABEFACAIHAMBCEKIDAEAAOVDFPB2C4KZLAIAQAAAAAAAAAAIBIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAAAAAAAAAAAAAAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAABAGAQAAEQQBFA2FORAUM2GH4YCF2YZ6L4SKL7VBLQXMWESP4MXEGDVSDWL6KCCAAAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAEAYGAABACAILAAAQCAIDAEAAWQ3IMFZC45DPKRSXQ5ABAABQCAAHKRSXQ5BOFMVQEAQAAAAQCQAAF7YVGC2D6IIOTNGZZIG5OOL2ALDKSJNQ6QF4WEMYOP5M545JGY4OW4P6IPVYWJAGPMFEMPF3R4ODGDKIGY6TNPXCMHUX4J4Y6TGQEAAAAAAAAAAAAAAAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAACAMBAAAJBADX2TSPZYWJSNYZVPZWJH3S5IVJCDXMBHGHU26HXZOMUEXQ5CWUVOAABAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIBQMAAEAEAQCAILAABQCAIDAEAAOTDJON2C4YLUAIAAGBQAAQAUBPFXSLRYBUMTQI4D4TSH2NNNUNKNR3L447EHJZMO3DMA3FE3H7JJBKRQSX7O7KXGBYVP5635Y6GI6DVXFPYHJ2YVBLSZV6TR5NYFZLZAAAQAAEAQWAABAEAQGAAEAIBQACQBAEGACAAAAAAAAAAAAEFQAAQBAEBQCAAFJZQXILRLAICAAAYBAEQQB35JZH44LEZG4M2X43ET5ZOUKURB3WATTD2NPD34XGKCLYORLKKXAACAQBYCAAAQAAICAAAACAKAAAX7CUYLIPZBB2NU3HFA3VZZPIBMNKJFWD2AXSYRTBZ7VTXTVE3DR23R7ZB6XCZEAZ5QURR4XOHRYMYNJA3D2NV64JQ6S7RHTD2M2AQAAAAAAAAAAAAAAAABAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIBQKAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAACAAASCAEBLNKYFGQCB272SLARCYESCCZMYWC7OG5HBCOOL75OIA6RZ4XTNMAAAAAAAAAAAAAAAAAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAEAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAACAMAQGAYLH7YAAAAAAAAAAAYLIAAAAAAAAAAAAAYLIAEAAAAAAAAAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAACAMAQGAYIAEBQQAQDBABQCAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAQDAEBQGCTBAMFGEAYKMMAQCQAAF7YVGC2D6IIOTNGZZIG5OOL2ALDKSJNQ6QF4WEMYOP5M545JGY4OW4P6IPVYWJAGPMFEMPF3R4ODGDKIGY6TNPXCMHUX4J4Y6TGQEAAAAAAAAAAAAAAAAAIBIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAAAAAAAAAAAAAAAEAUAABP6FJQWQ7SCDU3JWOKBXLTS6QCY2USLMHUBPFRDGDT7LHPHKJWHDVXD7SD5OFSIBT3BJDDZO4PDQZQ2SBWHU3L5YTB5F7CPGHUZUBAAAAAAAAAAAAAAAAA==== \ No newline at end of file diff --git a/unison-src/transcripts-using-base/serialized-cases/case-02.v3.ser b/unison-src/transcripts-using-base/serialized-cases/case-02.v3.ser deleted file mode 100644 index 4a1d4e2237..0000000000 --- a/unison-src/transcripts-using-base/serialized-cases/case-02.v3.ser +++ /dev/null @@ -1 +0,0 @@ -AAAAAAYBAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAABAGAIFAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAAAAEAYCAAASCAABWEQKZVTA34OQNVOLD4GRH72HLOHCHQEYO4JJPWXD6HBMRKR6L4AACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAACAMDAAAQBAEFQAAQBAEBQCAAKJRUXG5BOOZUWK53MAEAAMAAEAFADPJIFOASFNIGUEE6ABTI5E6ON24BBMZ7CAQAE3AN2OXOWNV3ET5LZKZZWA57Q7DDA5SHTB4NDM7M4HPYI6EFBI7M72VZDNJCL63URRAAAEAACAEAQMAIEAABU4YLUAEAACAAGAAAACAAAAAAAAAAAAAFACAAHAEAAAAAAAAAAAAAKAEAQGAYAANHGC5AAAEAAGBABIAZR522FFIW2QNIQTV45PSZZV4R5VXT52UC5SIS3TTQZ6XJ36SN6JLO6DPP44KYTTAVNI6ERW7OAEWHHJ63TJMEDFONVPC3T6QZVW3NHAAAACAABBMAACAIBAMAQABKOMF2C4KQCAUBAGAIBEEAADMJAVTLGBXY5A3K4WHYNCP7UOW4OEPAJQ5YSS7NOH4OCZCVD4XYAAIAAEAABAAAQEAABAFAAAL7RKMFUH4QQ5G2NTSQN244XUAWGVES3B5ALZMIZQ472Z3Z2SNRY5NY74Q7LRMSAM6YKIY6LXDY4GMGUQNR5G27OEYPJPYTZR5GNAIAAAAAAAAAAAAAAAAAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAACAMBAAAJBABINM6WVR5VXSHZHLHI7QKDZ4EYHDZDXV7CQVDPR6N6TR75XWQLOAAABAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAABAGBQAAEAQWAABAEAQGAIBEEAGIJEYGWCVEET6QTADG3PYT3IZ4NY6GSPWISPD4BLO2G6RVUBTCMYAAAEACIIARH76IQRIUZMLQUQ3OMILAPHXZJGRFJ5Z4JQMMVNZZFXO2M4JFZNQAAIBAMAACAIAAEAUAABP6FJQWQ7SCDU3JWOKBXLTS6QCY2USLMHUBPFRDGDT7LHPHKJWHDVXD7SD5OFSIBT3BJDDZO4PDQZQ2SBWHU3L5YTB5F7CPGHUZUBAAAAAAAAAAAAAAAAAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAAAAIBQEAABEEAGIJEYGWCVEET6QTADG3PYT3IZ4NY6GSPWISPD4BLO2G6RVUBTCMYAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAAAAEAYGAEAQCBQAAIAQCQBTD3VUKKRNVA2RBHLZ27FTTLZD3LPH3VIF3ERFXHHBT5OTX5E34SW54G67ZYVRHGBK2R4JDN64AJMOOT5XGSYIGK43K6FXH5BTLNW2OAABAAAQCBIBIAZR522FFIW2QNIQTV45PSZZV4R5VXT52UC5SIS3TTQZ6XJ36SN6JLO6DPP44KYTTAVNI6ERW7OAEWHHJ63TJMEDFONVPC3T6QZVW3NHAAEAACDKOVWXAQ3PNZ2ACAABAIAQAAIBBEAQABABAFADGHXLIUVC3KBVCCOXTV6LHGXSHWW6PXKQLWJCLOOODH25HP2JXZFN3YN57TRLCOMCVVDYSG35YASY45H3ONFQQMVZWV4LOP2DGW3NU4AAAAQBAEAUAABP6FJQWQ7SCDU3JWOKBXLTS6QCY2USLMHUBPFRDGDT7LHPHKJWHDVXD7SD5OFSIBT3BJDDZO4PDQZQ2SBWHU3L5YTB5F7CPGHUZUBAAAAAAAAAAAAAAAAAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAAAAIBQEAABEEAIT77EIIUKMWFYKINXGEFQHT34UTISU646EYGGKW44S3XNGOES4WYAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAAAAEAYGAAAQCCQBAADQCAAAAAAAAAAAAAFACAIDAMAAGTTBOQAACAADAEASCAABWEQKZVTA34OQNVOLD4GRH72HLOHCHQEYO4JJPWXD6HBMRKR6L4AAEAACAEAUAABP6FJQWQ7SCDU3JWOKBXLTS6QCY2USLMHUBPFRDGDT7LHPHKJWHDVXD7SD5OFSIBT3BJDDZO4PDQZQ2SBWHU3L5YTB5F7CPGHUZUBAAAAAAAAAAAAAAAAAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAAAAIBQEAABEEALTMJU3MI3LHRHUSEX3BATWO6NXEOBXKBFJ7AUAVPNE63A5X3SXEAAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAAAAEAYGAAAQCBQAAQAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAIAAIAQCBQAAQAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAIAAIAQCBQAAQAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAIAAIAQCBQAAQAUAABP6FJQWQ7SCDU3JWOKBXLTS6QCY2USLMHUBPFRDGDT7LHPHKJWHDVXD7SD5OFSIBT3BJDDZO4PDQZQ2SBWHU3L5YTB5F7CPGHUZUBAAAIAAAFQACYBAEBQCAJBABINM6WVR5VXSHZHLHI7QKDZ4EYHDZDXV7CQVDPR6N6TR75XWQLOAAABAUFQACQBAEBQCAJBABINM6WVR5VXSHZHLHI7QKDZ4EYHDZDXV7CQVDPR6N6TR75XWQLOAAABAQFQACIBAEBQCAJBABINM6WVR5VXSHZHLHI7QKDZ4EYHDZDXV7CQVDPR6N6TR75XWQLOAAABAMFACAIHAMASQCYAAEAQCAYBAAFE4YLUFZ2G6VDFPB2ACAYLAABACAIDAEAAOVDFPB2C4KZLAIAQACQBAEDQGARMEAFQAAYBAEBQCAAHKRSXQ5BOFMVQEAIABMAAIAIBAMAQACSOMF2C45DPKRSXQ5ABAYFQABIBAEBQCAAHKRSXQ5BOFMVQEAIABIAQCBYDAMWCAIQLAADACAIDAEAAOVDFPB2C4KZLAIAQACYAA4AQCAYBAAFE4YLUFZ2G6VDFPB2ACCILAAEACAIDAEAAOVDFPB2C4KZLAIAQACQBAEDQGARCFEBQCAAHKRSXQ5BOFMVQEAIAAAAAAAABAFAAAL7RKMFUH4QQ5G2NTSQN244XUAWGVES3B5ALZMIZQ472Z3Z2SNRY5NY74Q7LRMSAM6YKIY6LXDY4GMGUQNR5G27OEYPJPYTZR5GNAIAAAAAAAAAAAAAAAAAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAACAMCQCAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAACAAASCAFZWE2NWENVTYT2JCL5QQJ3HPG3SHA3VASU7QKAKXWSPNQO35ZLSAAAAAAAAAAAAAAAAAAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAACAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAAAAEAYBAUAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAIAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAGAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAACQAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAA4AACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAAJAAAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAAAQDAEEQCAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAABAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAQAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAAAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAABQAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAQAACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAAFAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAABQAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAOAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAAEAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAAAAIBQCCABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAAAQAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAIAACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAAEAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAACAAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAABAAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAABQAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAUAACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAAGAAAQCQAAF7YVGC2D6IIOTNGZZIG5OOL2ALDKSJNQ6QF4WEMYOP5M545JGY4OW4P6IPVYWJAGPMFEMPF3R4ODGDKIGY6TNPXCMHUX4J4Y6TGQEAAAAAAAAAAAAAAAAAABAFAAAL7RKMFUH4QQ5G2NTSQN244XUAWGVES3B5ALZMIZQ472Z3Z2SNRY5NY74Q7LRMSAM6YKIY6LXDY4GMGUQNR5G27OEYPJPYTZR5GNAIAAAAAAAAAAAAAAAAAACAKAAAX7CUYLIPZBB2NU3HFA3VZZPIBMNKJFWD2AXSYRTBZ7VTXTVE3DR23R7ZB6XCZEAZ5QURR4XOHRYMYNJA3D2NV64JQ6S7RHTD2M2AQAAAAAAAAAAAAAAAAA \ No newline at end of file diff --git a/unison-src/transcripts-using-base/serialized-cases/case-02.v5.hash b/unison-src/transcripts-using-base/serialized-cases/case-02.v5.hash new file mode 100644 index 0000000000..f7f6926bc2 --- /dev/null +++ b/unison-src/transcripts-using-base/serialized-cases/case-02.v5.hash @@ -0,0 +1 @@ +OKXJPQQY4QXSCGDHM2LSUTSIKWE7W5PS6CSYCKBOEOBTRKHOKWTH6QZP7HEVWPEJC5CWGWB54ZPI7YB36F37MXN7ISPCP5JGX26NRBQ= \ No newline at end of file diff --git a/unison-src/transcripts-using-base/serialized-cases/case-02.v5.ser b/unison-src/transcripts-using-base/serialized-cases/case-02.v5.ser new file mode 100644 index 0000000000..0257e72254 --- /dev/null +++ b/unison-src/transcripts-using-base/serialized-cases/case-02.v5.ser @@ -0,0 +1 @@ +AAAAABIBAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIBQCBIBAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIBQEAABEEAAYIUEFZ4JEHYKKJOYXA3U4QEFR2C7BDWZX43W26BCDHYJLM2O2UYAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAABAGBQAAIAQCCYAAIAQCAYBAAFEY2LTOQXHM2LFO5WACAAGAACACQBXUUCXAJCWUDKCCPAAZUOSPHG5OAQWM7RAIACNQG5HLXLG25SJ6V4VM43AO7YPRRQOZDZQ6GRWPWODX4EPCCQUPWP5K4RWURF7N2IYQAACAABACAIGAEDAAA2OMF2ACAAAAAAAAAAAAAFACAIMAEAAAAAAAAAAAAADAQAUAMY65NCSULNIGUIJ26OXZM426I623Z65KBOZEJNZZYM7LU57JG7EVXPBXX6OFMJZQKWUPCI3PXACLDTU7NZUWCBSXG2XRNZ7IM23NWTQAAABAAAQWAABAEAQGAIAAVHGC5BOFIBAIAIDAEASCAAMEKCC46ESD4FFEXMLQN2OICCY5BPQR3M36N3NPARBT4EVWNHNKMAAEAABAEAACAQAAAAQCQAAF7YVGC2D6IIOTNGZZIG5OOL2ALDKSJNQ6QF4WEMYOP5M545JGY4OW4P6IPVYWJAGPMFEMPF3R4ODGDKIGY6TNPXCMHUX4J4Y6TGQEAAAAAAAAAAAAAAAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAACAMBAAAJBAAQQUM3BJ2CBV2DRYDFJVT73O4QXWQ2FFGAQ65UETP5ZKJGMQUOPIAABAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIBQMAABAEDAABABIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAQAAQBAEDAABABIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAQAAQBAEDAABABIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAQAAQBAEDAABABIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAQAAALAAFQCAIDAEASCAHMBCFOX4WLK3FQIFDLLBB3ZZQPJHUEKONSUX2NJGCJJSHMAWVAHQAACBILAAFACAIDAEASCAHMBCFOX4WLK3FQIFDLLBB3ZZQPJHUEKONSUX2NJGCJJSHMAWVAHQAACBALAAEQCAIDAEASCAHMBCFOX4WLK3FQIFDLLBB3ZZQPJHUEKONSUX2NJGCJJSHMAWVAHQAACAYKAEAQOAYBFAFQAAIBAEBQCAAKJZQXILTUN5KGK6DUAEBQWAACAEAQGAIAA5KGK6DUFYVSWAQBAAFACAIHAMBCYIALAABQCAIDAEAAOVDFPB2C4KZLAIAQACYAAQAQCAYBAAFE4YLUFZ2G6VDFPB2ACBQLAACQCAIDAEAAOVDFPB2C4KZLAIAQACQBAEDQGAZMEARAWAAGAEAQGAIAA5KGK6DUFYVSWAQBAAFQABYBAEBQCAAKJZQXILTUN5KGK6DUAEEQWAAIAEAQGAIAA5KGK6DUFYVSWAQBAAFACAIHAMBCEKIDAEAAOVDFPB2C4KZLAIAQAAAAAAAAAAIBIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAAAAAAAAAAAAAAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAABAGAQAAEQQAZBETA2YKUQSP2CMAM3N7CPNDHRXDY2J6ZCJ4PQFN3I32GWQGMJTAAAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAEAYGAEAQCBQAAIAQCQBTD3VUKKRNVA2RBHLZ27FTTLZD3LPH3VIF3ERFXHHBT5OTX5E34SW54G67ZYVRHGBK2R4JDN64AJMOOT5XGSYIGK43K6FXH5BTLNW2OAABAAAQCBIBIAZR522FFIW2QNIQTV45PSZZV4R5VXT52UC5SIS3TTQZ6XJ36SN6JLO6DPP44KYTTAVNI6ERW7OAEWHHJ63TJMEDFONVPC3T6QZVW3NHAAEAACDKOVWXAQ3PNZ2ACAABAIAQAAIBBEAQABABAFADGHXLIUVC3KBVCCOXTV6LHGXSHWW6PXKQLWJCLOOODH25HP2JXZFN3YN57TRLCOMCVVDYSG35YASY45H3ONFQQMVZWV4LOP2DGW3NU4AAAAQBAAAQCQAAF7YVGC2D6IIOTNGZZIG5OOL2ALDKSJNQ6QF4WEMYOP5M545JGY4OW4P6IPVYWJAGPMFEMPF3R4ODGDKIGY6TNPXCMHUX4J4Y6TGQEAAAAAAAAAAAAAAAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAACAMBAAAJBABTRHHJSOELTLHBAUQWOZQU2H5SUAC5SDOJNUSQDJ2NEYRSZ4RBDQAABAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIBQMAABAEFACAIMAEAAAAAAAAAAAAADAEASCAAMEKCC46ESD4FFEXMLQN2OICCY5BPQR3M36N3NPARBT4EVWNHNKMAAEAABAAAQCQAAF7YVGC2D6IIOTNGZZIG5OOL2ALDKSJNQ6QF4WEMYOP5M545JGY4OW4P6IPVYWJAGPMFEMPF3R4ODGDKIGY6TNPXCMHUX4J4Y6TGQEAAAAAAAAAAAAAAAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAACAMBAAAJBADWARCXL6LFVNSYECRVVQQ544YHUT2CFHGZKL5GUTBEUZDWALKQDYAABAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIBQMAABAEFQAAIBAEBQCAJBABSCJGBVQVJBE7UEYAZW36E62GPDOHRUT5SETY7AK3WRXUNNAMYTGAAABAASCADHCOOTE4IXGWOCBJBM5TBJUP3FIAF3EG4S3JFAGTU2JRDFTZCCHAAACAIDAAAQCAAAAEAUAABP6FJQWQ7SCDU3JWOKBXLTS6QCY2USLMHUBPFRDGDT7LHPHKJWHDVXD7SD5OFSIBT3BJDDZO4PDQZQ2SBWHU3L5YTB5F7CPGHUZUBAAAAAAAAAAAAAAAAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAQDAUAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAEAABEEACCCRTMFHIIGXIOHAMVGWP7N3SC62DIUUYCD3WQSN7XFJEZSCRZ5AAAAAAAAAAAAAAAAABAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAEAYBAUBQQAIDBABQGCAFAMEAOAYIBEAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAEAYBBEBQQAIDBABAGCAAAMEAGAYIAQBQQBIDBADAGCAHAMEAQAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAACAMAQQAYIAEBQQAQDBACAGCAIAMEBAAYIAMBQQBIDBADACAKAAAX7CUYLIPZBB2NU3HFA3VZZPIBMNKJFWD2AXSYRTBZ7VTXTVE3DR23R7ZB6XCZEAZ5QURR4XOHRYMYNJA3D2NV64JQ6S7RHTD2M2AQAAAAAAAAAAAAAAAABAFAAAL7RKMFUH4QQ5G2NTSQN244XUAWGVES3B5ALZMIZQ472Z3Z2SNRY5NY74Q7LRMSAM6YKIY6LXDY4GMGUQNR5G27OEYPJPYTZR5GNAIAAAAAAAAAAAAAAAAAQCQAAF7YVGC2D6IIOTNGZZIG5OOL2ALDKSJNQ6QF4WEMYOP5M545JGY4OW4P6IPVYWJAGPMFEMPF3R4ODGDKIGY6TNPXCMHUX4J4Y6TGQEAAAAAAAAAAAAAAAA=== \ No newline at end of file diff --git a/unison-src/transcripts-using-base/serialized-cases/case-03.v3.ser b/unison-src/transcripts-using-base/serialized-cases/case-03.v3.ser deleted file mode 100644 index 435e66ff65..0000000000 --- a/unison-src/transcripts-using-base/serialized-cases/case-03.v3.ser +++ /dev/null @@ -1 +0,0 @@ -AAAAAAYBAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAABAGAIJAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAAAAEAYCAAASCAAHJ5GLRMTZGDAIHWCMVBFQVOID3O6JTDETEG5MZHC3C6AJRBEBWIAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAACAMDACAIBAYAAEAIBIA3WMQZC4T2RMC6ZEPP5ZNKMTP4JLD42EUQESFNU3ZE6XBO7H47OFPSHSSWYEB4EGRHQJHTH3DUE6CIUQVPAYYPKIKPJNB4DEW52A7H2AAAQAAIBAUAUAN3GIMROJ5IWBPMSHX64WVGJX6EVR6NCKICJCW2N4SPLQXPT6PXCXZDZJLMCA6CDITYETZT5R2CPBEKIKXQMMHVEFHUWQ6BSLO5APT5AACAABBVHK3LQINXW45ABAAFQAAIBAEBQCAJBAADU6TFYWJ4TBQED3BGKQSYKXEB5XPEZRSJSDOWMTRNRPAEYQSA3EAIBAABQAAYBAAAQAAIBBEAQABABAFADOZSDELSPKFQL3ER57XFVJSN7RFMPTISSASIVWTPET24F347T5YV6I6KK3AQHQQ2E6BE6M7MOQTYJCSCV4DDB5JBJ5FUHQMS3XID47IAAAAQBAEAUAABP6FJQWQ7SCDU3JWOKBXLTS6QCY2USLMHUBPFRDGDT7LHPHKJWHDVXD7SD5OFSIBT3BJDDZO4PDQZQ2SBWHU3L5YTB5F7CPGHUZUBAAAAAAAAAAAAAAAAAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAAAAIBQEAABEEAAOT2MXCZHSMGAQPMEZKCLBK4QHW54TGGJGIN2ZSOFWF4ATCCIDMQBAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAAAAEAYGAABACAILAAAQCAIDAEASCAAHJ5GLRMTZGDAIHWCMVBFQVOID3O6JTDETEG5MZHC3C6AJRBEBWIAAACABEEANR5YMZ4O453FLTU6EFVRUUPWHXYW6TUZGJMG5CJVPJJYYAJA5VZIAAIBACAYAAEAQAAIBIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAAAAAAAAAAAAAAAAAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAAAQDAIAACIIAFUTEOAMPWV2QO7URYOGW3IWLDUJYIBKZCECC27ZRNLNBHED7DH6QAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAAAAIBQMAACAEAQWAABAEAQGAIBEEALXH4JMVTQID2LYZDNY3BE27ZGPCN3RF5B7BBRYHCBOA6XAK6MCPAAAIAQAAYDAFAELKAEKPNPXNQI6W6YSDGGZGXWUNYSTAHMSM6JVRCZOWLR4AATVNPYCLZDPEOQXITARNPEUEFDJ3J63DOWUMUEQ22II25H2OTZMS7VLYAACAIAAEAUAABP6FJQWQ7SCDU3JWOKBXLTS6QCY2USLMHUBPFRDGDT7LHPHKJWHDVXD7SD5OFSIBT3BJDDZO4PDQZQ2SBWHU3L5YTB5F7CPGHUZUBAAAAAAAAAAAAAAAAAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAAAAIBQEAABEEADALIIXAMWTUJRTIMNDOK5OFVUPWKYC237QOO6OFNL6GQ2KOIKP3AAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAAAAEAYGAABACAIKAEAAOAIAAAAAAAAAAAAAUAIBAMBQAA2OMF2AAAIABMAACAIBAMAQCIIA4WGJEFVRN4PBIRD4R2ZSHRLGVUIFAJNAEQCRO37MI7IHJM6JQ3EAAAQAAMBQGAKAIWUAIU627O3AR5N5REGMNSNPNI3RFGAOZEZ4TLCFS5MXDYABHK27QEXSG6I5BORGBC26JIIKGTWT5WG5NIZIJBVUQRV2PU5HSZF7KXQAAAAQAAIBIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAAAAAAAAAAAAAAAAAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAAAQDAIAACIIAGXO4NCLJE6O5KYIZMT7TW5V3WRSBNWAXMPEJLR5JCA7WKSGWLQSAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAAAAIBQMAACAEAQMAAEAFAELKAEKPNPXNQI6W6YSDGGZGXWUNYSTAHMSM6JVRCZOWLR4AATVNPYCLZDPEOQXITARNPEUEFDJ3J63DOWUMUEQ22II25H2OTZMS7VLYAAEAABAEAQAAIBAEFQAAIBAEBQAAABAIBQCAJBAA253RUJNETZ3VLBDFSP6O3WXO2GIFWYC5R4RFOHVEID6ZKI2ZOCIAACAMAAAAIBIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAAAAAAAAAAAAAAAAAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAAAQDAIAACIIAVMQSQXYFSDZ7NIPEJPI7XUFYIE43FEMQEHYQS7CWAIXJ3OT7IEAAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAAAAIBQMAABAEDAABABIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAQAAQBAEDAABABIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAQAAQBAEDAABABIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAQAAQBAEDAABABIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAQAAAKAEAAOAIAAAAAAAAAAABAUAIBAMBQAA2OMF2AAAIABMAAWAIBAMAQCIIAGXO4NCLJE6O5KYIZMT7TW5V3WRSBNWAXMPEJLR5JCA7WKSGWLQSAAAQAA4FACAAHAEAAAAAAAAAAAAQKAEAQGAYAANHGC5AAAEAAWAAKAEAQGAIBEEADLXOGRFUSPHOVMEMWJ7Z3O253IZAW3ALWHSEVY6URAP3FJDLFYJAAAIAAQCQBAADQCAAAAAAAAAAAAIFACAIDAMAAGTTBOQAACAALAAEQCAIDAEASCABV3XDIS2JHTXKWCGLE745XNO5UMQLNQF3DZCK4PKIQH5SURVS4EQAAEAAJBIAQCBYDAEUAWAABAEAQGAIABJHGC5BOORXVIZLYOQAQOCYAAIAQCAYBAADVIZLYOQXCWKYCAEAAUAIBA4BQELBABMAAGAIBAMAQAB2UMV4HILRLFMBACAALAACACAIDAEAAUTTBOQXHI32UMV4HIAIIBMAAKAIBAMAQAB2UMV4HILRLFMBACAAKAEAQOAYDFQQCECYAAYAQCAYBAADVIZLYOQXCWKYCAEAAWAAHAEAQGAIABJHGC5BOORXVIZLYOQAQSCYABAAQCAYBAADVIZLYOQXCWKYCAEAAUAIBA4BQEIRJAMAQAB2UMV4HILRLFMBACAAAAAAAAAIBIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAAAAAAAAAAAAAAAAAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAAAQDAIAACIIAXOPYSZLHAQHUXRSG3RWCJV7SM6E3XCL2D6CDDQOEC4B5OAV4YE6AAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAAAAIBQMAADAEAQCCYAAEAQCAYBAACU4YLUFYVQEAQAAMAAEAIAAEAUAABP6FJQWQ7SCDU3JWOKBXLTS6QCY2USLMHUBPFRDGDT7LHPHKJWHDVXD7SD5OFSIBT3BJDDZO4PDQZQ2SBWHU3L5YTB5F7CPGHUZUBAAAAAAAAAAAAAAAAAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAAAAIBQEAABEEANR5YMZ4O453FLTU6EFVRUUPWHXYW6TUZGJMG5CJVPJJYYAJA5VZIAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAAAAEAYGAABACAIDAAAQCAABAFAAAL7RKMFUH4QQ5G2NTSQN244XUAWGVES3B5ALZMIZQ472Z3Z2SNRY5NY74Q7LRMSAM6YKIY6LXDY4GMGUQNR5G27OEYPJPYTZR5GNAIAAAAAAAAAAAAAAAAAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAACAMBAAAJBADSYZEQWWFXR4FCEPSHLGI6FM2WRAUBFUASAKF3P5RD5A5FTZGDMQAABAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAABAGBQAAIAQCCYAAUAQCAYBAAFEY2LTOQXHM2LFO5WACAAGAACACQBXUUCXAJCWUDKCCPAAZUOSPHG5OAQWM7RAIACNQG5HLXLG25SJ6V4VM43AO7YPRRQOZDZQ6GRWPWODX4EPCCQUPWP5K4RWURF7N2IYQAACAABACAIKAEAAOAIAAAAAAAAAAAAAUAIBAMBQAA2OMF2AAAIABMAAIAIBAMAQADCVNZUXMZLSONQWYLR5HUBAGAAGAACAAB2CN5XWYZLBNYAQAAALAAAQCAIDAEAAKTTBOQXCWAQHAQBQCAJBADSYZEQWWFXR4FCEPSHLGI6FM2WRAUBFUASAKF3P5RD5A5FTZGDMQAACAACACCYAAIAQCAYBAEQQALJGI4AY7NLVA57JDQ4NNWRMWHITQQCVSEIEFV7TC2W2COIH6GP5AAAQOCYAAMAQCAYEAFADOZSDELSPKFQL3ER57XFVJSN7RFMPTISSASIVWTPET24F347T5YV6I6KK3AQHQQ2E6BE6M7MOQTYJCSCV4DDB5JBJ5FUHQMS3XID47IAAAAIAAMAQCIIA4WGJEFVRN4PBIRD4R2ZSHRLGVUIFAJNAEQCRO37MI7IHJM6JQ3EAAAQAAUAQAAICAAAQCQAAF7YVGC2D6IIOTNGZZIG5OOL2ALDKSJNQ6QF4WEMYOP5M545JGY4OW4P6IPVYWJAGPMFEMPF3R4ODGDKIGY6TNPXCMHUX4J4Y6TGQEAAAAAAAAAAAAAAAAAABAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAABAGBIBAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAABAAAJBACVSCKC7AWIPH5VB4RF5D66QXBATTMURSAQ7CCL4KYBC5HN2P5AQAAAAAAAAAAAAAAAAAAABAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAABACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAACAEAUARNIARJ5V65WBD233CIMY3E262RXCKMA5SJTZGWELF2ZOHQACOVV7AJPEN4R2C5CMCFV4SQQUNHNH3MN22RSQSDLJBDLU7J2PFSL6VPAAAAAAAAAAAAAAEAACAABEEALXH4JMVTQID2LYZDNY3BE27ZGPCN3RF5B7BBRYHCBOA6XAK6MCPAAAAAAAAAAAAAAAAACAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAGAAAAEQQAB2PJS4LE6JQYCB5QTFIJMFLSA63XSMYZEZBXLGJYWYXQCMIJANSAEAAAAAAAAAAAAAAAEAAACDKOVWXAQ3PNZ2AAAAAAAAAAAAAAAAQEBAAAAAAAAAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFQAAJBAAWSMRYBR62XKB36SHBY23NCZMORHBAFLEIQILL7GFVNUE4QP4M72AAAAAAAAAAAAAAAAAIBAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAABQAAIAA5BG633MMVQW4AAAAAAAAAAAAEAAAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAAAACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAAAAABQCCABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAABQAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAQAACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAAAAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAABIAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAMAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAAAAAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAA4AACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAAIAAAQCQBXUUCXAJCWUDKCCPAAZUOSPHG5OAQWM7RAIACNQG5HLXLG25SJ6V4VM43AO7YPRRQOZDZQ6GRWPWODX4EPCCQUPWP5K4RWURF7N2IYQAAAAAAAAAAAAAAAAAQBAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAAAAAAYBBAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAYAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAIAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAAAAAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAUAACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAAGAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAAAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAOAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAAEAAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAMAAGAIJAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAAAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAABQAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAQAACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAAAAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAABIAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAMAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAAAAAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAA4AACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAAIAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAAAAMAQWAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAEAACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAACAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAAAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAGAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAACAAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAAAACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAAFAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAABQAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAAAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAADQAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAABAAACAKAAAX7CUYLIPZBB2NU3HFA3VZZPIBMNKJFWD2AXSYRTBZ7VTXTVE3DR23R7ZB6XCZEAZ5QURR4XOHRYMYNJA3D2NV64JQ6S7RHTD2M2AQAAAAAAAAAAAAAAAAAAIAAAAAAAAAAAAIAAAAAAAAAAABQAAAAAAAAAAAAAAAAAAAAAAAAAAJBAAYC2CFYDFU5CMM2DDI3SXLRNND5SWAWW74DTXTRLK7RUGSTSCT6YAAAAAAAAAAAAAAQEAAAAAAAAAAAAMAAAAAAAAAAACAAAAAAAAAAAAAAAAAAAAAAAAAAAEQQBZMMSILLC3Y6CRCHZDVTEPCWNLIQKAS2AJAFC5X6YR6QOSZ4TBWIAAAAAAAAAAAAAAYAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAAAAEAIBIBC2QBCT3L53MCHVXWEQZRWJV5VDOEUYB3ETHSNMIWLVS4PAAE5LL6AS6I3ZDUF2EYELLZFBBI2O2PWY3VVDFBEGWSCGXJ6TU6LEX5K6AAAAAAAAAAAAAAIAAEAACIIAXOPYSZLHAQHUXRSG3RWCJV7SM6E3XCL2D6CDDQOEC4B5OAV4YE6AAAAAAAAAAAAAAAAAEAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAIAAAAJBAADU6TFYWJ4TBQED3BGKQSYKXEB5XPEZRSJSDOWMTRNRPAEYQSA3EAIAAAAAAAAAAAAAAAIAAAEGU5LNOBBW63TUAAAAAAAAAAAAAAABAICAAAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAALAAASCABNEZDQDD5VOUDX5EODRVW2FSY5COCAKWIRAQWX6MLK3IJZA7YZ7UAAAAAAAAAAAAAAAAAQCAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAACAAAQAB2CN5XWYZLBNYAAAAAAAAAAAAIAAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAAAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAAAADAEEQCAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAADAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAAAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAACAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAAAAAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAUAACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAAAAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAABAAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAAAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAADAAAIBIA32KBLQERLKBVBBHQAM2HJHTTOXAILGPYQEABGYDOTV3VTNOZE7K6KWONQHP4HYYYHMR4YPDI3H3HB36CHRBIKH3H6VOI3KIS7W5EMIAAAAAAAAAAAAAAAAAIAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAAAAMAQSAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAMAACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAAAAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAIAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAAAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAACQAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAAAACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAAEAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAAAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAMAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAABAAAYBBIAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAAAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAGAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAAAAAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAEAACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAAAAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAABIAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAAAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAACAAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAAAACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAAGAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAAAAMAQWAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAIAACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAAAAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAYAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAAAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAAAQAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAAAACAADJZQXIAAAAAAAAAAAAAAQAAAAAAAAAAAFAAAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAAAAAAEAAGTTBOQAAAAAAAAAAAAABAAAAAAAAAAAAIAABAABU4YLUAAAAAAAAAAAAAAIAAAAAAAAAAAAAAAIAANHGC5AAAAAAAAAAAAAACAAAAAAAAAAAAYAACAKAAAX7CUYLIPZBB2NU3HFA3VZZPIBMNKJFWD2AXSYRTBZ7VTXTVE3DR23R7ZB6XCZEAZ5QURR4XOHRYMYNJA3D2NV64JQ6S7RHTD2M2AQAAAAAAAAAAAAAAAAAAIAAAAAAAAAAAAIAAAAAAAAAAABQAAAAAAAAAAAAAAAAAAAAAAAAAAJBAAYC2CFYDFU5CMM2DDI3SXLRNND5SWAWW74DTXTRLK7RUGSTSCT6YAAAAAAAAAAAAAAQEAAAAAAAAAAAAMAAAAAAAAAAACAAAAAAAAAAAAAAAAAAAAAAAAAAAEQQBZMMSILLC3Y6CRCHZDVTEPCWNLIQKAS2AJAFC5X6YR6QOSZ4TBWIAAAAAAAAAAAAAAYAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAAAAEAIBIBC2QBCT3L53MCHVXWEQZRWJV5VDOEUYB3ETHSNMIWLVS4PAAE5LL6AS6I3ZDUF2EYELLZFBBI2O2PWY3VVDFBEGWSCGXJ6TU6LEX5K6AAAAAAAAAAAAAAAAAEAQAA2OMF2AAAAAAAAAAAAAAEAAAAAAAAAAALIAAEAUAABP6FJQWQ7SCDU3JWOKBXLTS6QCY2USLMHUBPFRDGDT7LHPHKJWHDVXD7SD5OFSIBT3BJDDZO4PDQZQ2SBWHU3L5YTB5F7CPGHUZUBAAAAAAAAAAAAAAAAAAAIBIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAAAAAAAAAAAAAAAAAQCQAAF7YVGC2D6IIOTNGZZIG5OOL2ALDKSJNQ6QF4WEMYOP5M545JGY4OW4P6IPVYWJAGPMFEMPF3R4ODGDKIGY6TNPXCMHUX4J4Y6TGQEAAAAAAAAAAAAAAAAAA= \ No newline at end of file diff --git a/unison-src/transcripts-using-base/serialized-cases/case-03.v5.hash b/unison-src/transcripts-using-base/serialized-cases/case-03.v5.hash new file mode 100644 index 0000000000..3b39c4aee9 --- /dev/null +++ b/unison-src/transcripts-using-base/serialized-cases/case-03.v5.hash @@ -0,0 +1 @@ +DLSO2TFPG5363MWC7FDSUW55VYA7P7CI4DBRFLWGPSUTF6YR45QPIPBSJPANZH44MGVYRSSMTPXODLDUFCO6JF43V3IPU4DRDU7JKII= \ No newline at end of file diff --git a/unison-src/transcripts-using-base/serialized-cases/case-03.v5.ser b/unison-src/transcripts-using-base/serialized-cases/case-03.v5.ser new file mode 100644 index 0000000000..f0188e6737 --- /dev/null +++ b/unison-src/transcripts-using-base/serialized-cases/case-03.v5.ser @@ -0,0 +1 @@ +AAAAABIBAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIBQCCIBAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIBQEAABEEAAOT2MXCZHSMGAQPMEZKCLBK4QHW54TGGJGIN2ZSOFWF4ATCCIDMQAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAABAGBQBAEAQMAACAEAUAN3GIMROJ5IWBPMSHX64WVGJX6EVR6NCKICJCW2N4SPLQXPT6PXCXZDZJLMCA6CDITYETZT5R2CPBEKIKXQMMHVEFHUWQ6BSLO5APT5AAAIAAEAQKAKAG5TEGIXE6ULAXWJD37OLKTE37CKY7GRFEBERLNG6JHVYLXZ7H3RL4R4UVWBAPBBUJ4CJ4Z6Y5BHQSFEFLYGGD2SCT2LIPAZFXOQHZ6QABAAAQ2TVNVYEG33OOQAQACYAAEAQCAYBAEQQAB2PJS4LE6JQYCB5QTFIJMFLSA63XSMYZEZBXLGJYWYXQCMIJANSAEAQAAYAAMAQAAIAAEAQSAIAAQAQCQBXMZBSFZHVCYF5SI673S2UZG7YSWHZUJJAJEK3JXSJ5OC56PZ64K7EPFFNQIDYINCPASPGPWHIJ4ERJBK6BRQ6UQU6S2DYGJN3UB6PUAAAAIAQAAIBIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAAAAAAAAAAAAAAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAABAGAQAAEQQAB2PJS4LE6JQYCB5QTFIJMFLSA63XSMYZEZBXLGJYWYXQCMIJANSAEAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAEAYGAABACAILAAAQCAIDAEASCAAHJ5GLRMTZGDAIHWCMVBFQVOID3O6JTDETEG5MZHC3C6AJRBEBWIAAACABEEANR5YMZ4O453FLTU6EFVRUUPWHXYW6TUZGJMG5CJVPJJYYAJA5VZIAAIBACAYAAEAQAAABAFAAAL7RKMFUH4QQ5G2NTSQN244XUAWGVES3B5ALZMIZQ472Z3Z2SNRY5NY74Q7LRMSAM6YKIY6LXDY4GMGUQNR5G27OEYPJPYTZR5GNAIAAAAAAAAAAAAAAAAAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAEAYCAAASCABD4J3OKKBTZLPQBBAFHIQYPQADAQXNC3RHA5YKBV72ZGYDNKNQSIAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAQDAYAAEAIBBMAAKAIBAMAQACSMNFZXILTWNFSXO3ABAADAABABIA32KBLQERLKBVBBHQAM2HJHTTOXAILGPYQEABGYDOTV3VTNOZE7K6KWONQHP4HYYYHMR4YPDI3H3HB36CHRBIKH3H6VOI3KIS7W5EMIAABAAAQBAEFACAIMAEAAAAAAAAAAAAALAACACAIDAEAAYVLONF3GK4TTMFWC4PJ5AIBAABQAAQAAOQTPN5WGKYLOAEAAACYAAEAQCAYBAACU4YLUFYVQEBQDAMAQCIIAEPRHNZJIGPFN6AEEAU5CDB6AAMCC5ULOE4DXBIGX7LE3ANVJWCJAAAQAAMAQWAACAEAQGAIBEEAC2JSHAGH3K5IHP2I4HDLNULFR2E4EAVMRCBBNP4YWVWQTSB7RT7IAAEDAWAADAEAQGBABIA3WMQZC4T2RMC6ZEPP5ZNKMTP4JLD42EUQESFNU3ZE6XBO7H47OFPSHSSWYEB4EGRHQJHTH3DUE6CIUQVPAYYPKIKPJNB4DEW52A7H2AAAACAADAEASCABD4J3OKKBTZLPQBBAFHIQYPQADAQXNC3RHA5YKBV72ZGYDNKNQSIAAEAAEAEAACAQAAAAQCQAAF7YVGC2D6IIOTNGZZIG5OOL2ALDKSJNQ6QF4WEMYOP5M545JGY4OW4P6IPVYWJAGPMFEMPF3R4ODGDKIGY6TNPXCMHUX4J4Y6TGQEAAAAAAAAAAAAAAAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAACAMBAAAJBAAWSMRYBR62XKB36SHBY23NCZMORHBAFLEIQILL7GFVNUE4QP4M72AABAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIBQMAACAEAQWAABAEAQGAIBEEALXH4JMVTQID2LYZDNY3BE27ZGPCN3RF5B7BBRYHCBOA6XAK6MCPAAAIAQAAYDAFAELKAEKPNPXNQI6W6YSDGGZGXWUNYSTAHMSM6JVRCZOWLR4AATVNPYCLZDPEOQXITARNPEUEFDJ3J63DOWUMUEQ22II25H2OTZMS7VLYAACAIAAAAQCQAAF7YVGC2D6IIOTNGZZIG5OOL2ALDKSJNQ6QF4WEMYOP5M545JGY4OW4P6IPVYWJAGPMFEMPF3R4ODGDKIGY6TNPXCMHUX4J4Y6TGQEAAAAAAAAAAAAAAAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAACAMBAAAJBAA253RUJNETZ3VLBDFSP6O3WXO2GIFWYC5R4RFOHVEID6ZKI2ZOCIAABAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIBQMAACAEAQMAAEAFAELKAEKPNPXNQI6W6YSDGGZGXWUNYSTAHMSM6JVRCZOWLR4AATVNPYCLZDPEOQXITARNPEUEFDJ3J63DOWUMUEQ22II25H2OTZMS7VLYAAEAABAEAQAAIBAEFQAAIBAEBQAAABAIBQCAJBAA253RUJNETZ3VLBDFSP6O3WXO2GIFWYC5R4RFOHVEID6ZKI2ZOCIAACAMAAAAABAFAAAL7RKMFUH4QQ5G2NTSQN244XUAWGVES3B5ALZMIZQ472Z3Z2SNRY5NY74Q7LRMSAM6YKIY6LXDY4GMGUQNR5G27OEYPJPYTZR5GNAIAAAAAAAAAAAAAAAAAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAEAYCAAASCAC23KGP4O2QVLBIVRGK3KNMAXLIWJNNACUZJTSDXUCUCGLJWAODNUAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAQDAYAACAIGAACACQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAABAABACAIGAACACQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAABAABACAIGAACACQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAABAABACAIGAACACQAAF7YVGC2D6IIOTNGZZIG5OOL2ALDKSJNQ6QF4WEMYOP5M545JGY4OW4P6IPVYWJAGPMFEMPF3R4ODGDKIGY6TNPXCMHUX4J4Y6TGQEAABAAAAUAIBBQAQAAAAAAAAAAACBMAAWAIBAMAQCIIAGXO4NCLJE6O5KYIZMT7TW5V3WRSBNWAXMPEJLR5JCA7WKSGWLQSAAAQAAYFACAIMAEAAAAAAAAAAAAQLAAFACAIDAEASCABV3XDIS2JHTXKWCGLE745XNO5UMQLNQF3DZCK4PKIQH5SURVS4EQAAEAAGBIAQCDABAAAAAAAAAAAAECYABEAQCAYBAEQQANO5Y2EWSJ452VQRSZH7HN3LXNDEC3MBOY6ISXD2SEB7MVENMXBEAABAABQKAEAQOAYBFAFQAAIBAEBQCAAKJZQXILTUN5KGK6DUAECQWAACAEAQGAIAA5KGK6DUFYVSWAQBAAFACAIHAMBCYIALAABQCAIDAEAAOVDFPB2C4KZLAIAQACYAAQAQCAYBAAFE4YLUFZ2G6VDFPB2ACBYLAACQCAIDAEAAOVDFPB2C4KZLAIAQACQBAEDQGAZMEARAWAAGAEAQGAIAA5KGK6DUFYVSWAQBAAFQABYBAEBQCAAKJZQXILTUN5KGK6DUAEEQWAAIAEAQGAIAA5KGK6DUFYVSWAQBAAFACAIHAMBCEKIDAEAAOVDFPB2C4KZLAIAQAAAAAAAAAAIBIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAAAAAAAAAAAAAAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAABAGAQAAEQQBO47RFSWOBAPJPDENXDMETL7EZ4JXOEXUH4EGHA4IFYD24BLZQJ4AAAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAEAYGAABQCAIBBMAACAIBAMAQABKOMF2C4KYCAIAAGAACAEAAAAIBIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAAAAAAAAAAAAAAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAABAGAQAAEQQBWHXBTHR3TXMVOOTYQWWGSR6Y67C32OTEZFQ3UJGV5FHDABEDWXFAAAQCQAVMBCUJUWZXIISNQY3J4HHF4UCTG2VI2OTKVWAQFVZWYX3T5MXS6LWV44LU2USLVE3FHYGV7SNVPQ5CN26L4NIXDELTBDOENZ644M7KAAAAAAAAAAAAAAAEAYGAABACAIDAAAQCAAAAEAUAABP6FJQWQ7SCDU3JWOKBXLTS6QCY2USLMHUBPFRDGDT7LHPHKJWHDVXD7SD5OFSIBT3BJDDZO4PDQZQ2SBWHU3L5YTB5F7CPGHUZUBAAAAAAAAAAAAAAAAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAQDAIAACIIA56Y5WAMUIZRITDKODUPJXHBCZSTKHCBX3KEPA7VOBOBEFIG6PEJQAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAACAMDAAAQBAEFACAIMAEAAAAAAAAAAAAALAAAQCAIDAEASCABD4J3OKKBTZLPQBBAFHIQYPQADAQXNC3RHA5YKBV72ZGYDNKNQSIAAEAACAMBQCQCFVACFHWX3WYEPLPMJBTDMTL3KG4JJQDWJGPE2YRMXLFY6AAJ2WX4BF4RXSHILUJQIWXSKCCRU5U7NRXLKGKCINNEENOT5HJ4WJP2V4AAAAEAAAAIBIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAAAAAAAAAAAAAAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAABAGBIBAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIAACIIALLNIZ7R3KCVMFCWEZLNJVQC5NCZFVUAKTFGOIO6QKQIZNGYBYNWQAAAAAAAAAAAAAAAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAQBAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIAQCQCFVACFHWX3WYEPLPMJBTDMTL3KG4JJQDWJGPE2YRMXLFY6AAJ2WX4BF4RXSHILUJQIWXSKCCRU5U7NRXLKGKCINNEENOT5HJ4WJP2V4AAAAAAAAAAAAAAQCAABEEALXH4JMVTQID2LYZDNY3BE27ZGPCN3RF5B7BBRYHCBOA6XAK6MCPAAAAAAAAAAAAAAAAQDBABQAAJBAADU6TFYWJ4TBQED3BGKQSYKXEB5XPEZRSJSDOWMTRNRPAEYQSA3EAIAAAAAAAAAAAAACAAABBVHK3LQINXW45AAAAAAAAAAAAAACAQLAAASCABNEZDQDD5VOUDX5EODRVW2FSY5COCAKWIRAQWX6MLK3IJZA7YZ7UAAAAAAAAAAAAAAAEBQQAYBAADUE33PNRSWC3QAAAAAAAAAAAAQAAYIAABQQAADAEEAGCADAMEAIAYIAABQQBIDBADAGCAAAMEAOAYIBAAQCQBXUUCXAJCWUDKCCPAAZUOSPHG5OAQWM7RAIACNQG5HLXLG25SJ6V4VM43AO7YPRRQOZDZQ6GRWPWODX4EPCCQUPWP5K4RWURF7N2IYQAAAAAAAAAAAAAAAEAYIAABQCCADBABQGCAEAMEAAAYIAUBQQBQDBAAAGCAHAMEAQAYIAMBQCCIDBAAAGCADAMEAIAYIAABQQBIDBADAGCAAAMEAOAYIBABQQAADAEFQGCABAMEAEAYIAABQQAYDBACAGCAAAMEAKAYIAYBQQAADBADQGCAIAEAUAABP6FJQWQ7SCDU3JWOKBXLTS6QCY2USLMHUBPFRDGDT7LHPHKJWHDVXD7SD5OFSIBT3BJDDZO4PDQZQ2SBWHU3L5YTB5F7CPGHUZUBAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAMAAAAAAAAAAAAABEEAO7MO3AGKEMYUJRVHB2HU3TQRMZJVDRA35VCHQP2XAXASCUDPHSEYAAAAAAAAAAAAACAQAAAAAAAAAAAEAAAAAAAAAAAAAAEQQAI7CO3SSQM6K34AIIBJ2EGD4AAYEF3IW4JYHOCQNP6WJWA3KTMESAAAAAAAAAAAAAAYAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAABACAKAIWUAIU627O3AR5N5REGMNSNPNI3RFGAOZEZ4TLCFS5MXDYABHK27QEXSG6I5BORGBC26JIIKGTWT5WG5NIZIJBVUQRV2PU5HSZF7KXQAAAAAAAAAAAAACAIAAEQQBO47RFSWOBAPJPDENXDMETL7EZ4JXOEXUH4EGHA4IFYD24BLZQJ4AAAAAAAAAAAAAAACAMEAEAABEEAAOT2MXCZHSMGAQPMEZKCLBK4QHW54TGGJGIN2ZSOFWF4ATCCIDMQBAAAAAAAAAAAAAAIAAAEGU5LNOBBW63TUAAAAAAAAAAAAAAICBMAACIIAFUTEOAMPWV2QO7URYOGW3IWLDUJYIBKZCECC27ZRNLNBHED7DH6QAAAAAAAAAAAAAAAQGCACAEAAOQTPN5WGKYLOAAAAAAAAAAAACAADBAAAGCAAAMAQSAYIAMBQQAADBAAQGCAAAMEAKAYIAABQQBADBAAAGCAGAEAUAN5FAVYCIVVA2QQTYAGNDUTZZXLQEFTH4ICAATMBXJ252ZWXMSPVPFLHGYDX6D4MMDWI6MHRUNT5TQ57BDYQUFD5T7KXENVEJP3OSGEAAAAAAAAAAAAAAABAGCAAAMAQSAYIAMBQQAADBAAQGCAAAMEAKAYIAABQQBADBAAAGCAGAMEAEAYBBIBQQAADBABQGCAAAMEACAYIAABQQBIDBAAAGCAEAMEAAAYIAYBQQAADAEFQGCACAMEAAAYIAMBQQAADBAAQGCAAAMEAKAYIAABQQBADBAAAGCAGAEAUAABP6FJQWQ7SCDU3JWOKBXLTS6QCY2USLMHUBPFRDGDT7LHPHKJWHDVXD7SD5OFSIBT3BJDDZO4PDQZQ2SBWHU3L5YTB5F7CPGHUZUBAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAMAAAAAAAAAAAAABEEAO7MO3AGKEMYUJRVHB2HU3TQRMZJVDRA35VCHQP2XAXASCUDPHSEYAAAAAAAAAAAAACAQAAAAAAAAAAAEAAAAAAAAAAAAAAEQQAI7CO3SSQM6K34AIIBJ2EGD4AAYEF3IW4JYHOCQNP6WJWA3KTMESAAAAAAAAAAAAAAYAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAABACAKAIWUAIU627O3AR5N5REGMNSNPNI3RFGAOZEZ4TLCFS5MXDYABHK27QEXSG6I5BORGBC26JIIKGTWT5WG5NIZIJBVUQRV2PU5HSZF7KXQAAAAAAAAAAAAAAAIDBAWQCAKAAAX7CUYLIPZBB2NU3HFA3VZZPIBMNKJFWD2AXSYRTBZ7VTXTVE3DR23R7ZB6XCZEAZ5QURR4XOHRYMYNJA3D2NV64JQ6S7RHTD2M2AQAAAAAAAAAAAAAAAABAFAAAL7RKMFUH4QQ5G2NTSQN244XUAWGVES3B5ALZMIZQ472Z3Z2SNRY5NY74Q7LRMSAM6YKIY6LXDY4GMGUQNR5G27OEYPJPYTZR5GNAIAAAAAAAAAAAAAAAAAQCQAAF7YVGC2D6IIOTNGZZIG5OOL2ALDKSJNQ6QF4WEMYOP5M545JGY4OW4P6IPVYWJAGPMFEMPF3R4ODGDKIGY6TNPXCMHUX4J4Y6TGQEAAAAAAAAAAAAAAAA=== \ No newline at end of file diff --git a/unison-src/transcripts-using-base/serialized-cases/case-04.v5.hash b/unison-src/transcripts-using-base/serialized-cases/case-04.v5.hash new file mode 100644 index 0000000000..acb9258d45 --- /dev/null +++ b/unison-src/transcripts-using-base/serialized-cases/case-04.v5.hash @@ -0,0 +1 @@ +EXAQLMU6IKGAY7DNOHND5VUQQAQPIJN3IVCF5DISOOEVLRQZ3Q2CZOYEVDMY7MYQX2CG6CJFH2HQD6XOMKHQNK5JUZB3G7RZQNREQRQ= \ No newline at end of file diff --git a/unison-src/transcripts-using-base/serialized-cases/case-04.v5.ser b/unison-src/transcripts-using-base/serialized-cases/case-04.v5.ser new file mode 100644 index 0000000000..bcced67760 --- /dev/null +++ b/unison-src/transcripts-using-base/serialized-cases/case-04.v5.ser @@ -0,0 +1 @@ +AAAAABIBAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIBQCBIBAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIBQEAABEEADVNOCW62AVOZXJ6CMCXMWMTBLF4FFUTLGYPNRXF3BZCNXIDIOZNIAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAABAGBQAAEAQMAAGAABU4YLUAEAAAAAAAAAAAAAHAMCG623BPEAQWAACAEAQGAIBEEAG57PICSIFU224UOLFTG2BAWCL4E7NVW2SJJUAWDIJO7R3YJCNHYQAAAFACAIMAEAAAAAAAAAAAAILAAAQCAIDAEAAQTTBOQXGI4TPOABAEAADAEASCAB2WXBLPNAKXM3U7BGBLWLGJQVS6CS2JVTMHWY3S5Q4RG3UBUHMWUAQCAAAAEAUAABP6FJQWQ7SCDU3JWOKBXLTS6QCY2USLMHUBPFRDGDT7LHPHKJWHDVXD7SD5OFSIBT3BJDDZO4PDQZQ2SBWHU3L5YTB5F7CPGHUZUBAAAAAAAAAAAAAAAAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAQDAIAACIIAHK24FN5UBK5TOT4EYFOZMZGCWLYKLJGWNQ63DOLWDSE3OQGQ5S2QCAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAACAMDAAAIBAMAQCIIAHK24FN5UBK5TOT4EYFOZMZGCWLYKLJGWNQ63DOLWDSE3OQGQ5S2QAAIAAAAQCQAAF7YVGC2D6IIOTNGZZIG5OOL2ALDKSJNQ6QF4WEMYOP5M545JGY4OW4P6IPVYWJAGPMFEMPF3R4ODGDKIGY6TNPXCMHUX4J4Y6TGQEAAAAAAAAAAAAAAAAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAACAMBAAAJBABXP32AUSBNGWXFDSZMZWQIFQS7BH3NNWUSKNAFQ2CLX4O6CITJ6EAABAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIBQMAAABMAACAIBAMAQCIIA74Z3E7TZQYDVD277KYVK5NAJDGFSKNDJXTUKC63K45WJSDPTGK4QAAALAABACAIDAEABGSKPFZXXAZLOIZUWYZJONFWXA3BOOYZQAAYBAEQQB3YGQKCYHD3UZXVHZGINUEURDHPZAHALBT23ILWELMAMPRQ2D7NPAABACAAAAEAUAABP6FJQWQ7SCDU3JWOKBXLTS6QCY2USLMHUBPFRDGDT7LHPHKJWHDVXD7SD5OFSIBT3BJDDZO4PDQZQ2SBWHU3L5YTB5F7CPGHUZUBAAAAAAAAAAAAAAAAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAQDAIAACIIA54DIFBMDR52M32T4TEG2CKIRTX4QDQFQZ5NUF3CFWAGHYYNB7WXQAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAACAMDAABABAEAQCCYAAEAQCAYAAIBACAADAACACAAAAEAUAABP6FJQWQ7SCDU3JWOKBXLTS6QCY2USLMHUBPFRDGDT7LHPHKJWHDVXD7SD5OFSIBT3BJDDZO4PDQZQ2SBWHU3L5YTB5F7CPGHUZUBAAAAAAAAAAAAAAAAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAQDAIAACIIA74Z3E7TZQYDVD277KYVK5NAJDGFSKNDJXTUKC63K45WJSDPTGK4QAAIBIAKWARKE2LM3UEJGYMNU6DTS6KBJTNKUNHJVK3AIC243ML5Z6WLZPF3K6OF2NKJF2SNST4DK7ZG2XYORG5PF6GULRSFZQRXCG47OOGPVAAAAAAAAAAAAAAACAMDAAAIBAYAAIAKAAYHWPACBPYWKJKM2NKSLWVRBTSNVST2AI6PHPF4OJ5445524FEGZP6XTZUG4DBW2Y2I4CYBXK5ONOIRUUGROEFVJFPSLQVSNSU5EE7IAAIAACAIBAAAQCAIDAQAUAJOA7BYABDTZGHSVVPMSW7MJOX2SYXXFOHDKQRESSFMT3HFUDFIO5UOEVZ4JCZAQQL53EGN2XPGLX432KM4VDDP52DPQXQ7AQNTICXPAAAABAAAAAAIBIAAC74KTBNB7EEHJWTM4UDOXHF5AFRVJEWYPIC6LCGMHH6WO6OUTMOHLOH7EH24LEQDHWCSGHS5Y6HBTBVEDMPJWX3RGD2L6E6MPJTICAAAAAAAAAAAAAAAAAEAUAFLAIVCNFWN2CETMGG2PBZZPFAUZWVKGTU2VNQEBNONWF647LF4XS5VPHC5GVES5JGZJ6BVP4TNL4HITOXS7DKFYZC4YI3RDOPXHDH2QAAAAAAAAAAAAAABAGBIBAFABKYCFITJNTOQRE3BRWTYOOLZIFGNVKRU5GVLMBALLTNRPXH2ZPF4XNLZYXJVJEXKJWKPQNL7E3K7B2E3V4XY2ROGIXGCG4I3T5ZYZ6UAAAAAAAAAAAAAAAIAACIIAHK24FN5UBK5TOT4EYFOZMZGCWLYKLJGWNQ63DOLWDSE3OQGQ5S2QCAAAAAAAAAAAAAAACAKACVQEKRGS3G5BCJWDDNHQ44XSQKM3KVDJ2NKWYCAWXG3C7OPVS6LZO2XTROTKSJOUTMU7A2X6JWV6DUJXLZPRVC4MROMENYRXH3TRT5IAAAAAAAAAAAAAAAQDBACQCAKAAAX7CUYLIPZBB2NU3HFA3VZZPIBMNKJFWD2AXSYRTBZ7VTXTVE3DR23R7ZB6XCZEAZ5QURR4XOHRYMYNJA3D2NV64JQ6S7RHTD2M2AQAAAAAAAAAAAAAAAABAFAAAL7RKMFUH4QQ5G2NTSQN244XUAWGVES3B5ALZMIZQ472Z3Z2SNRY5NY74Q7LRMSAM6YKIY6LXDY4GMGUQNR5G27OEYPJPYTZR5GNAIAAAAAAAAAAAAAAAA====== \ No newline at end of file diff --git a/unison-src/transcripts-using-base/stm.md b/unison-src/transcripts-using-base/stm.md index 1a036fd260..eedf47bf37 100644 --- a/unison-src/transcripts-using-base/stm.md +++ b/unison-src/transcripts-using-base/stm.md @@ -1,6 +1,6 @@ Loops that access a shared counter variable, accessed in transactions. Some thread delaying is just accomplished by counting in a loop. -```unison +``` unison count : Nat -> () count = cases 0 -> () @@ -27,13 +27,13 @@ body k out v = atomically '(TVar.write out (Some n)) ``` -```ucm +``` ucm scratch/main> add ``` Test case. -```unison +``` unison spawn : Nat ->{io2.IO} Result spawn k = let out1 = TVar.newIO None @@ -66,7 +66,7 @@ tests : '{io2.IO} [Result] tests = '(map spawn nats) ``` -```ucm +``` ucm scratch/main> add scratch/main> io.test tests ``` diff --git a/unison-src/transcripts-using-base/stm.output.md b/unison-src/transcripts-using-base/stm.output.md index 2e7724f9e3..3edffadcf8 100644 --- a/unison-src/transcripts-using-base/stm.output.md +++ b/unison-src/transcripts-using-base/stm.output.md @@ -28,33 +28,32 @@ body k out v = atomically '(TVar.write out (Some n)) ``` -``` ucm - +``` ucm :added-by-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`: body : Nat -> TVar (Optional Nat) -> TVar Nat ->{IO} () count : Nat -> () inc : TVar Nat ->{IO} Nat loop : '{IO} Nat -> Nat -> Nat ->{IO} Nat - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + body : Nat -> TVar (Optional Nat) -> TVar Nat ->{IO} () count : Nat -> () inc : TVar Nat ->{IO} Nat loop : '{IO} Nat -> Nat -> Nat ->{IO} Nat - ``` + Test case. ``` unison @@ -90,27 +89,26 @@ tests : '{io2.IO} [Result] tests = '(map spawn nats) ``` -``` ucm - +``` ucm :added-by-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`: display : Nat -> Nat -> Nat -> Text nats : [Nat] spawn : Nat ->{IO} Result tests : '{IO} [Result] - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + display : Nat -> Nat -> Nat -> Text nats : [Nat] spawn : Nat ->{IO} Result @@ -119,7 +117,7 @@ scratch/main> add scratch/main> io.test tests New test results: - + 1. tests ◉ verified ◉ verified ◉ verified @@ -130,9 +128,8 @@ scratch/main> io.test tests ◉ verified ◉ verified ◉ verified - + ✅ 10 test(s) passing - - Tip: Use view 1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/test-watch-dependencies.md b/unison-src/transcripts-using-base/test-watch-dependencies.md index 3e7558da3e..603b8d2016 100644 --- a/unison-src/transcripts-using-base/test-watch-dependencies.md +++ b/unison-src/transcripts-using-base/test-watch-dependencies.md @@ -4,36 +4,36 @@ https://github.com/unisonweb/unison/issues/2195 We add a simple definition. -```unison:hide +``` unison :hide x = 999 ``` -```ucm:hide +``` ucm :hide scratch/main> add ``` Now, we update that definition and define a test-watch which depends on it. -```unison +``` unison x = 1000 test> mytest = checks [x + 1 == 1001] ``` We expect this 'add' to fail because the test is blocked by the update to `x`. -```ucm:error +``` ucm :error scratch/main> add ``` --- -```unison +``` unison y = 42 test> useY = checks [y + 1 == 43] ``` This should correctly identify `y` as a dependency and add that too. -```ucm +``` ucm scratch/main> add useY ``` diff --git a/unison-src/transcripts-using-base/test-watch-dependencies.output.md b/unison-src/transcripts-using-base/test-watch-dependencies.output.md index a321643568..c4f43b9263 100644 --- a/unison-src/transcripts-using-base/test-watch-dependencies.output.md +++ b/unison-src/transcripts-using-base/test-watch-dependencies.output.md @@ -4,10 +4,14 @@ https://github.com/unisonweb/unison/issues/2195 We add a simple definition. -``` unison +``` unison :hide x = 999 ``` +``` ucm :hide +scratch/main> add +``` + Now, we update that definition and define a test-watch which depends on it. ``` unison @@ -15,14 +19,13 @@ x = 1000 test> mytest = checks [x + 1 == 1001] ``` -``` ucm - +``` ucm :added-by-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`: mytest : [Result] @@ -31,29 +34,29 @@ test> mytest = checks [x + 1 == 1001] new definition: x : Nat - + Now evaluating any watch expressions (lines starting with `>`)... Ctrl+C cancels. 2 | test> mytest = checks [x + 1 == 1001] ✅ Passed Passed - ``` + We expect this 'add' to fail because the test is blocked by the update to `x`. -``` ucm +``` ucm :error scratch/main> add x These definitions failed: - + Reason needs update x : Nat blocked mytest : [Result] - - Tip: Use `help filestatus` to learn more. + Tip: Use `help filestatus` to learn more. ``` + ----- ``` unison @@ -61,35 +64,33 @@ y = 42 test> useY = checks [y + 1 == 43] ``` -``` ucm - +``` ucm :added-by-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`: useY : [Result] y : Nat - + Now evaluating any watch expressions (lines starting with `>`)... Ctrl+C cancels. 2 | test> useY = checks [y + 1 == 43] ✅ Passed Passed - ``` + This should correctly identify `y` as a dependency and add that too. ``` ucm scratch/main> add useY ⍟ I've added these definitions: - + useY : [Result] y : Nat - ``` diff --git a/unison-src/transcripts-using-base/thread.md b/unison-src/transcripts-using-base/thread.md index 9811d192ce..31f16e2635 100644 --- a/unison-src/transcripts-using-base/thread.md +++ b/unison-src/transcripts-using-base/thread.md @@ -1,6 +1,6 @@ Lets just make sure we can start a thread -```unison +``` unison otherThread : '{io2.IO}() otherThread = 'let watch "I'm the other Thread" () @@ -18,12 +18,12 @@ testBasicFork = 'let See if we can get another thread to stuff a value into a MVar -```ucm:hide +``` ucm :hide scratch/main> add scratch/main> io.test testBasicFork ``` -```unison +``` unison thread1 : Nat -> MVar Nat -> '{io2.IO}() thread1 x mv = 'let go = 'let @@ -47,12 +47,12 @@ testBasicMultiThreadMVar = 'let ``` -```ucm +``` ucm scratch/main> add scratch/main> io.test testBasicMultiThreadMVar ``` -```unison +``` unison sendingThread: Nat -> MVar Nat -> '{io2.IO}() sendingThread toSend mv = 'let go = 'let @@ -90,7 +90,7 @@ testTwoThreads = 'let ``` -```ucm +``` ucm scratch/main> add scratch/main> io.test testTwoThreads ``` diff --git a/unison-src/transcripts-using-base/thread.output.md b/unison-src/transcripts-using-base/thread.output.md index 863d749698..8f4924e69d 100644 --- a/unison-src/transcripts-using-base/thread.output.md +++ b/unison-src/transcripts-using-base/thread.output.md @@ -16,22 +16,27 @@ testBasicFork = 'let ``` -``` ucm - +``` ucm :added-by-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`: otherThread : '{IO} () testBasicFork : '{IO} [Result] - ``` + See if we can get another thread to stuff a value into a MVar +``` ucm :hide +scratch/main> add + +scratch/main> io.test testBasicFork +``` + ``` unison thread1 : Nat -> MVar Nat -> '{io2.IO}() thread1 x mv = 'let @@ -56,39 +61,38 @@ testBasicMultiThreadMVar = 'let ``` -``` ucm - +``` ucm :added-by-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`: testBasicMultiThreadMVar : '{IO} [Result] thread1 : Nat -> MVar Nat -> '{IO} () - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + testBasicMultiThreadMVar : '{IO} [Result] thread1 : Nat -> MVar Nat -> '{IO} () scratch/main> io.test testBasicMultiThreadMVar New test results: - + 1. testBasicMultiThreadMVar ◉ other thread should have incremented - + ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` + ``` unison sendingThread: Nat -> MVar Nat -> '{io2.IO}() sendingThread toSend mv = 'let @@ -127,27 +131,26 @@ testTwoThreads = 'let ``` -``` ucm - +``` ucm :added-by-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`: receivingThread : MVar Nat -> MVar Text -> '{IO} () sendingThread : Nat -> MVar Nat -> '{IO} () (also named thread1) testTwoThreads : '{IO} [Result] - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + receivingThread : MVar Nat -> MVar Text -> '{IO} () sendingThread : Nat -> MVar Nat -> '{IO} () (also named thread1) @@ -156,11 +159,10 @@ scratch/main> add scratch/main> io.test testTwoThreads New test results: - + 1. testTwoThreads ◉ - + ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/tls.md b/unison-src/transcripts-using-base/tls.md index 71b473837a..b17afb3b94 100644 --- a/unison-src/transcripts-using-base/tls.md +++ b/unison-src/transcripts-using-base/tls.md @@ -1,6 +1,6 @@ # Tests for TLS builtins -```unison:hide +``` 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 @@ -11,7 +11,7 @@ self_signed_cert_pem2 = "-----BEGIN CERTIFICATE-----\nMIIDVTCCAj2gAwIBAgIUdMNT5s not_a_cert = "-----BEGIN SCHERMIFICATE-----\n-----END SCHERMIFICATE-----" ``` -```ucm:hide +``` ucm :hide scratch/main> add ``` @@ -19,7 +19,7 @@ scratch/main> add First lets make sure we can load our cert and private key -```unison +``` unison this_should_work=match (decodeCert.impl (toUtf8 self_signed_cert_pem2) with Left (Failure _ t _) -> [Fail t] Right _ -> [Ok "succesfully decoded self_signed_pem"] @@ -31,7 +31,7 @@ this_should_not_work=match (decodeCert.impl (toUtf8 not_a_cert) with what_should_work _ = this_should_work ++ this_should_not_work ``` -```ucm +``` ucm scratch/main> add scratch/main> io.test what_should_work ``` @@ -44,7 +44,7 @@ We'll create a server and a client, and start threads for each. The server will report the port it is bound to via a passed MVar which the client can read. -```unison +``` unison serverThread: MVar Nat -> Text -> '{io2.IO}() serverThread portVar toSend = 'let go: '{io2.IO, Exception}() @@ -190,7 +190,7 @@ testCNReject _ = runTest test ``` -```ucm +``` ucm scratch/main> add scratch/main> io.test testConnectSelfSigned scratch/main> io.test testCAReject diff --git a/unison-src/transcripts-using-base/tls.output.md b/unison-src/transcripts-using-base/tls.output.md index 76b9be2782..a475223453 100644 --- a/unison-src/transcripts-using-base/tls.output.md +++ b/unison-src/transcripts-using-base/tls.output.md @@ -1,6 +1,6 @@ # Tests for TLS builtins -``` unison +``` 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 @@ -11,6 +11,10 @@ self_signed_cert_pem2 = "-----BEGIN CERTIFICATE-----\nMIIDVTCCAj2gAwIBAgIUdMNT5s not_a_cert = "-----BEGIN SCHERMIFICATE-----\n-----END SCHERMIFICATE-----" ``` +``` ucm :hide +scratch/main> add +``` + # Using an alternative certificate store First lets make sure we can load our cert and private key @@ -27,26 +31,25 @@ this_should_not_work=match (decodeCert.impl (toUtf8 not_a_cert) with what_should_work _ = this_should_work ++ this_should_not_work ``` -``` ucm - +``` ucm :added-by-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`: this_should_not_work : [Result] this_should_work : [Result] what_should_work : ∀ _. _ -> [Result] - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + this_should_not_work : [Result] this_should_work : [Result] what_should_work : ∀ _. _ -> [Result] @@ -54,15 +57,15 @@ scratch/main> add scratch/main> io.test what_should_work New test results: - + 1. what_should_work ◉ succesfully decoded self_signed_pem ◉ failed - + ✅ 2 test(s) passing - - Tip: Use view 1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` + Test handshaking a client/server a local TCP connection using our self-signed cert. @@ -217,14 +220,13 @@ testCNReject _ = runTest test ``` -``` ucm - +``` ucm :added-by-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`: serverThread : MVar Nat -> Text -> '{IO} () @@ -235,13 +237,13 @@ testCNReject _ = -> MVar Nat -> '{IO, Exception} Text testConnectSelfSigned : '{IO} [Result] - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + serverThread : MVar Nat -> Text -> '{IO} () testCAReject : '{IO} [Result] testCNReject : '{IO} [Result] @@ -254,31 +256,30 @@ scratch/main> add scratch/main> io.test testConnectSelfSigned New test results: - + 1. testConnectSelfSigned ◉ should have reaped what we've sown - + ✅ 1 test(s) passing - + Tip: Use view 1 to view the source of a test. scratch/main> io.test testCAReject New test results: - + 1. testCAReject ◉ correctly rejected self-signed cert - + ✅ 1 test(s) passing - + Tip: Use view 1 to view the source of a test. scratch/main> io.test testCNReject New test results: - + 1. testCNReject ◉ correctly rejected self-signed cert - + ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. + Tip: Use view 1 to view the source of a test. ``` diff --git a/unison-src/transcripts-using-base/utf8.md b/unison-src/transcripts-using-base/utf8.md index 4bf0586575..ac21f96263 100644 --- a/unison-src/transcripts-using-base/utf8.md +++ b/unison-src/transcripts-using-base/utf8.md @@ -2,13 +2,13 @@ Test for new Text -> Bytes conversions explicitly using UTF-8 as the encoding Unison has function for converting between `Text` and a UTF-8 `Bytes` encoding of the Text. -```ucm +``` ucm scratch/main> find Utf8 ``` ascii characters are encoded as single bytes (in the range 0-127). -```unison +``` unison ascii: Text ascii = "ABCDE" @@ -18,7 +18,7 @@ ascii = "ABCDE" non-ascii characters are encoded as multiple bytes. -```unison +``` unison greek: Text greek = "ΑΒΓΔΕ" @@ -27,7 +27,7 @@ greek = "ΑΒΓΔΕ" We can check that encoding and then decoding should give us back the same `Text` we started with -```unison +``` unison checkRoundTrip: Text -> [Result] checkRoundTrip t = bytes = toUtf8 t @@ -42,7 +42,7 @@ test> greekTest = checkRoundTrip greek If we try to decode an invalid set of bytes, we get back `Text` explaining the decoding error: -```unison +``` unison greek_bytes = Bytes.fromList [206, 145, 206, 146, 206, 147, 206, 148, 206] diff --git a/unison-src/transcripts-using-base/utf8.output.md b/unison-src/transcripts-using-base/utf8.output.md index f5bf210754..75404e1eb4 100644 --- a/unison-src/transcripts-using-base/utf8.output.md +++ b/unison-src/transcripts-using-base/utf8.output.md @@ -8,9 +8,8 @@ scratch/main> find Utf8 1. builtin.Text.toUtf8 : Text -> Bytes 2. Text.fromUtf8 : Bytes ->{Exception} Text 3. builtin.Text.fromUtf8.impl : Bytes -> Either Failure Text - - ``` + ascii characters are encoded as single bytes (in the range 0-127). ``` unison @@ -21,27 +20,26 @@ ascii = "ABCDE" ``` -``` ucm - +``` ucm :added-by-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 names already exist. You can `update` them to your new definition: ascii : Text - + Now evaluating any watch expressions (lines starting with `>`)... Ctrl+C cancels. 4 | > toUtf8 ascii ⧩ 0xs4142434445 - ``` + non-ascii characters are encoded as multiple bytes. ``` unison @@ -51,26 +49,25 @@ greek = "ΑΒΓΔΕ" > toUtf8 greek ``` -``` ucm - +``` ucm :added-by-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`: greek : Text - + Now evaluating any watch expressions (lines starting with `>`)... Ctrl+C cancels. 4 | > toUtf8 greek ⧩ 0xsce91ce92ce93ce94ce95 - ``` + We can check that encoding and then decoding should give us back the same `Text` we started with ``` unison @@ -86,28 +83,27 @@ greek = "ΑΒΓΔΕ" test> greekTest = checkRoundTrip greek ``` -``` ucm - +``` ucm :added-by-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`: checkRoundTrip : Text -> [Result] greek : Text greekTest : [Result] - + Now evaluating any watch expressions (lines starting with `>`)... Ctrl+C cancels. 10 | test> greekTest = checkRoundTrip greek ✅ Passed Passed - ``` + If we try to decode an invalid set of bytes, we get back `Text` explaining the decoding error: ``` unison @@ -121,23 +117,21 @@ greek_bytes = Bytes.fromList [206, 145, 206, 146, 206, 147, 206, 148, 206] ``` -``` ucm - +``` ucm :added-by-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`: greek_bytes : Bytes - + Now evaluating any watch expressions (lines starting with `>`)... Ctrl+C cancels. 5 | > match fromUtf8.impl (drop 1 greek_bytes) with ⧩ "Cannot decode byte '\\x91': Data.Text.Encoding: Invalid UTF-8 stream" - ``` diff --git a/unison-src/transcripts/abilities.output.md b/unison-src/transcripts/abilities.output.md deleted file mode 100644 index aa162e135b..0000000000 --- a/unison-src/transcripts/abilities.output.md +++ /dev/null @@ -1,41 +0,0 @@ -Some random ability stuff to ensure things work. - -``` unison -unique ability A where - one : Nat ->{A} Nat - two : Nat -> Nat ->{A} Nat - three : Nat -> Nat -> Nat ->{A} Nat - four : Nat ->{A} (Nat -> Nat -> Nat -> Nat) - -ha : Request {A} r -> r -ha = cases - { x } -> x - { one i -> c } -> handle c (i+1) with ha - { two i j -> c } -> handle c (i+j) with ha - { three i j k -> c } -> handle c (i+j+k) with ha - { four i -> c } -> handle c (j k l -> i+j+k+l) with ha -``` - -``` 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`: - - ability A - ha : Request {A} r -> r - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - ability A - ha : Request {A} r -> r - -``` diff --git a/unison-src/transcripts/ability-order-doesnt-affect-hash.md b/unison-src/transcripts/ability-order-doesnt-affect-hash.md deleted file mode 100644 index 2e00cc0c22..0000000000 --- a/unison-src/transcripts/ability-order-doesnt-affect-hash.md +++ /dev/null @@ -1,20 +0,0 @@ -The order of a set of abilities is normalized before hashing. - -```unison -unique ability Foo where - foo : () - -unique ability Bar where - bar : () - -term1 : () ->{Foo, Bar} () -term1 _ = () - -term2 : () ->{Bar, Foo} () -term2 _ = () -``` - -```ucm -scratch/main> add -scratch/main> names term1 -``` diff --git a/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md b/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md deleted file mode 100644 index d897322a99..0000000000 --- a/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md +++ /dev/null @@ -1,49 +0,0 @@ -The order of a set of abilities is normalized before hashing. - -``` unison -unique ability Foo where - foo : () - -unique ability Bar where - bar : () - -term1 : () ->{Foo, Bar} () -term1 _ = () - -term2 : () ->{Bar, Foo} () -term2 _ = () -``` - -``` 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`: - - ability Bar - ability Foo - term1 : '{Bar, Foo} () - term2 : '{Bar, Foo} () - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - ability Bar - ability Foo - term1 : '{Bar, Foo} () - term2 : '{Bar, Foo} () - -scratch/main> names term1 - - Term - Hash: #8hum58rlih - Names: term1 term2 - -``` diff --git a/unison-src/transcripts/ability-term-conflicts-on-update.md b/unison-src/transcripts/ability-term-conflicts-on-update.md deleted file mode 100644 index 6a1a316a50..0000000000 --- a/unison-src/transcripts/ability-term-conflicts-on-update.md +++ /dev/null @@ -1,93 +0,0 @@ -# Regression test for updates which conflict with an existing ability constructor - -https://github.com/unisonweb/unison/issues/2786 - -```ucm:hide -scratch/main> builtins.merge lib.builtins -``` - -First we add an ability to the codebase. -Note that this will create the name `Channels.send` as an ability constructor. - -```unison -unique ability Channels where - send : a -> {Channels} () -``` - -```ucm -scratch/main> add -``` - -Now we update the ability, changing the name of the constructor, _but_, we simultaneously -add a new top-level term with the same name as the constructor which is being -removed from Channels. - -```unison -unique ability Channels where - sends : [a] -> {Channels} () - -Channels.send : a -> () -Channels.send a = () - -thing : '{Channels} () -thing _ = send 1 -``` - -These should fail with a term/ctor conflict since we exclude the ability from the update. - -```ucm:error -scratch/main> update.old patch Channels.send -scratch/main> update.old patch thing -``` - -If however, `Channels.send` and `thing` _depend_ on `Channels`, updating them should succeed since it pulls in the ability as a dependency. - -```unison -unique ability Channels where - sends : [a] -> {Channels} () - -Channels.send : a -> () -Channels.send a = sends [a] - -thing : '{Channels} () -thing _ = send 1 -``` - -These updates should succeed since `Channels` is a dependency. - -```ucm -scratch/main> update.old.preview patch Channels.send -scratch/main> update.old.preview patch thing -``` - -We should also be able to successfully update the whole thing. - -```ucm -scratch/main> update.old -``` - -# Constructor-term conflict - -```ucm:hide -scratch/main2> builtins.merge lib.builtins -``` - - -```unison -X.x = 1 -``` - -```ucm -scratch/main2> add -``` - -```unison -structural ability X where - x : () -``` - -This should fail with a ctor/term conflict. - -```ucm:error -scratch/main2> add -``` diff --git a/unison-src/transcripts/ability-term-conflicts-on-update.output.md b/unison-src/transcripts/ability-term-conflicts-on-update.output.md deleted file mode 100644 index f5580e7b80..0000000000 --- a/unison-src/transcripts/ability-term-conflicts-on-update.output.md +++ /dev/null @@ -1,228 +0,0 @@ -# Regression test for updates which conflict with an existing ability constructor - -https://github.com/unisonweb/unison/issues/2786 - -First we add an ability to the codebase. -Note that this will create the name `Channels.send` as an ability constructor. - -``` unison -unique ability Channels where - send : a -> {Channels} () -``` - -``` 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`: - - ability Channels - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - ability Channels - -``` -Now we update the ability, changing the name of the constructor, *but*, we simultaneously -add a new top-level term with the same name as the constructor which is being -removed from Channels. - -``` unison -unique ability Channels where - sends : [a] -> {Channels} () - -Channels.send : a -> () -Channels.send a = () - -thing : '{Channels} () -thing _ = send 1 -``` - -``` 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`: - - Channels.send : a -> () - thing : '{Channels} () - - ⍟ These names already exist. You can `update` them to your - new definition: - - ability Channels - -``` -These should fail with a term/ctor conflict since we exclude the ability from the update. - -``` ucm -scratch/main> update.old patch Channels.send - - x These definitions failed: - - Reason - term/ctor collision Channels.send : a -> () - - Tip: Use `help filestatus` to learn more. - -scratch/main> update.old patch thing - - ⍟ I've added these definitions: - - Channels.send : a -> () - thing : '{Channels} () - - ⍟ I've updated these names to your new definition: - - ability Channels - -``` -If however, `Channels.send` and `thing` *depend* on `Channels`, updating them should succeed since it pulls in the ability as a dependency. - -``` unison -unique ability Channels where - sends : [a] -> {Channels} () - -Channels.send : a -> () -Channels.send a = sends [a] - -thing : '{Channels} () -thing _ = send 1 -``` - -``` 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: - - ⊡ Previously added definitions will be ignored: Channels - - ⍟ These names already exist. You can `update` them to your - new definition: - - Channels.send : a ->{Channels} () - thing : '{Channels} () - -``` -These updates should succeed since `Channels` is a dependency. - -``` ucm -scratch/main> update.old.preview patch Channels.send - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⊡ Previously added definitions will be ignored: Channels - - ⍟ These names already exist. You can `update` them to your - new definition: - - Channels.send : a ->{Channels} () - -scratch/main> update.old.preview patch thing - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⊡ Previously added definitions will be ignored: Channels - - ⍟ These names already exist. You can `update` them to your - new definition: - - Channels.send : a ->{Channels} () - thing : '{Channels} () - -``` -We should also be able to successfully update the whole thing. - -``` ucm -scratch/main> update.old - - ⊡ Ignored previously added definitions: Channels - - ⍟ I've updated these names to your new definition: - - Channels.send : a ->{Channels} () - thing : '{Channels} () - -``` -# Constructor-term conflict - -``` unison -X.x = 1 -``` - -``` 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`: - - X.x : Nat - -``` -``` ucm -scratch/main2> add - - ⍟ I've added these definitions: - - X.x : Nat - -``` -``` unison -structural ability X where - x : () -``` - -``` 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: - - x These definitions would fail on `add` or `update`: - - Reason - blocked structural ability X - ctor/term collision X.x - - Tip: Use `help filestatus` to learn more. - -``` -This should fail with a ctor/term conflict. - -``` ucm -scratch/main2> add - - x These definitions failed: - - Reason - blocked structural ability X - ctor/term collision X.x - - Tip: Use `help filestatus` to learn more. - -``` diff --git a/unison-src/transcripts/add-run.md b/unison-src/transcripts/add-run.md deleted file mode 100644 index 07fe99216d..0000000000 --- a/unison-src/transcripts/add-run.md +++ /dev/null @@ -1,129 +0,0 @@ -# add.run - -## Basic usage - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -even : Nat -> Boolean -even x = if x == 0 then true else odd (drop x 1) - -odd : Nat -> Boolean -odd x = if x == 0 then false else even (drop x 1) - -is2even : 'Boolean -is2even = '(even 2) -``` - -it errors if there isn't a previous run - -```ucm:error -scratch/main> add.run foo -``` - -```ucm -scratch/main> run is2even -``` - -it errors if the desired result name conflicts with a name in the -unison file -```ucm:error -scratch/main> add.run is2even -``` - -otherwise, the result is successfully persisted -```ucm -scratch/main> add.run foo.bar.baz -``` - -```ucm -scratch/main> view foo.bar.baz -``` - -## It resolves references within the unison file - -```unison -z b = b Nat.+ 12 -y a b = a Nat.+ b Nat.+ z 10 - - - - -main : '{IO, Exception} (Nat -> Nat -> Nat) -main _ = y -``` - -```ucm -scratch/main> run main -scratch/main> add.run result -``` - -## It resolves references within the codebase - -```unison -inc : Nat -> Nat -inc x = x + 1 -``` - -```ucm -scratch/main> add inc -``` - -```unison -main : '(Nat -> Nat) -main _ x = inc x -``` - -```ucm -scratch/main> run main -scratch/main> add.run natfoo -scratch/main> view natfoo -``` - -## It captures scratch file dependencies at run time - -```unison -x = 1 -y = x + x -main = 'y -``` - -```ucm -scratch/main> run main -``` - - -```unison -x = 50 -``` - -this saves 2 to xres, rather than 100 -```ucm -scratch/main> add.run xres -scratch/main> view xres -``` - -## It fails with a message if add cannot complete cleanly - -```unison -main = '5 -``` - -```ucm:error -scratch/main> run main -scratch/main> add.run xres -``` - -## It works with absolute names - -```unison -main = '5 -``` - -```ucm -scratch/main> run main -scratch/main> add.run .an.absolute.name -scratch/main> view .an.absolute.name -``` diff --git a/unison-src/transcripts/add-run.output.md b/unison-src/transcripts/add-run.output.md deleted file mode 100644 index 76e52470c4..0000000000 --- a/unison-src/transcripts/add-run.output.md +++ /dev/null @@ -1,311 +0,0 @@ -# add.run - -## Basic usage - -``` unison -even : Nat -> Boolean -even x = if x == 0 then true else odd (drop x 1) - -odd : Nat -> Boolean -odd x = if x == 0 then false else even (drop x 1) - -is2even : 'Boolean -is2even = '(even 2) -``` - -``` 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`: - - even : Nat -> Boolean - is2even : 'Boolean - odd : Nat -> Boolean - -``` -it errors if there isn't a previous run - -``` ucm -scratch/main> add.run foo - - ⚠️ - - There is no previous evaluation to save. Use `run` to evaluate - something before attempting to save it. - -``` -``` ucm -scratch/main> run is2even - - true - -``` -it errors if the desired result name conflicts with a name in the -unison file - -``` ucm -scratch/main> add.run is2even - - ⚠️ - - Cannot save the last run result into `is2even` because that - name conflicts with a name in the scratch file. - -``` -otherwise, the result is successfully persisted - -``` ucm -scratch/main> add.run foo.bar.baz - - ⍟ I've added these definitions: - - foo.bar.baz : Boolean - -``` -``` ucm -scratch/main> view foo.bar.baz - - foo.bar.baz : Boolean - foo.bar.baz = true - -``` -## It resolves references within the unison file - -``` unison -z b = b Nat.+ 12 -y a b = a Nat.+ b Nat.+ z 10 - - - - -main : '{IO, Exception} (Nat -> Nat -> Nat) -main _ = y -``` - -``` 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`: - - main : '{IO, Exception} (Nat -> Nat -> Nat) - y : Nat -> Nat -> Nat - z : Nat -> Nat - -``` -``` ucm -scratch/main> run main - - a b -> a Nat.+ b Nat.+ z 10 - -scratch/main> add.run result - - ⍟ I've added these definitions: - - result : Nat -> Nat -> Nat - z : Nat -> Nat - -``` -## It resolves references within the codebase - -``` unison -inc : Nat -> Nat -inc x = x + 1 -``` - -``` 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`: - - inc : Nat -> Nat - -``` -``` ucm -scratch/main> add inc - - ⍟ I've added these definitions: - - inc : Nat -> Nat - -``` -``` unison -main : '(Nat -> Nat) -main _ x = inc x -``` - -``` 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`: - - main : '(Nat -> Nat) - -``` -``` ucm -scratch/main> run main - - inc - -scratch/main> add.run natfoo - - ⍟ I've added these definitions: - - natfoo : Nat -> Nat - -scratch/main> view natfoo - - natfoo : Nat -> Nat - natfoo = inc - -``` -## It captures scratch file dependencies at run time - -``` unison -x = 1 -y = x + x -main = 'y -``` - -``` 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`: - - main : 'Nat - x : Nat - y : Nat - -``` -``` ucm -scratch/main> run main - - 2 - -``` -``` unison -x = 50 -``` - -``` 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`: - - x : Nat - -``` -this saves 2 to xres, rather than 100 - -``` ucm -scratch/main> add.run xres - - ⍟ I've added these definitions: - - xres : Nat - -scratch/main> view xres - - xres : Nat - xres = 2 - -``` -## It fails with a message if add cannot complete cleanly - -``` unison -main = '5 -``` - -``` 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`: - - main : 'Nat - -``` -``` ucm -scratch/main> run main - - 5 - -scratch/main> add.run xres - - x These definitions failed: - - Reason - needs update xres : Nat - - Tip: Use `help filestatus` to learn more. - -``` -## It works with absolute names - -``` unison -main = '5 -``` - -``` 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`: - - main : 'Nat - -``` -``` ucm -scratch/main> run main - - 5 - -scratch/main> add.run .an.absolute.name - - ⍟ I've added these definitions: - - .an.absolute.name : Nat - -scratch/main> view .an.absolute.name - - .an.absolute.name : Nat - .an.absolute.name = 5 - -``` diff --git a/unison-src/transcripts/add-test-watch-roundtrip.md b/unison-src/transcripts/add-test-watch-roundtrip.md deleted file mode 100644 index 9b1cacf477..0000000000 --- a/unison-src/transcripts/add-test-watch-roundtrip.md +++ /dev/null @@ -1,15 +0,0 @@ -```ucm:hide -scratch/main> builtins.mergeio -``` - -```unison:hide -test> foo : [Test.Result] -foo = [] -``` - -Apparently when we add a test watch, we add a type annotation to it, even if it already has one. We don't want this to happen though! - -```ucm -scratch/main> add -scratch/main> view foo -``` diff --git a/unison-src/transcripts/add-test-watch-roundtrip.output.md b/unison-src/transcripts/add-test-watch-roundtrip.output.md deleted file mode 100644 index 5366a47342..0000000000 --- a/unison-src/transcripts/add-test-watch-roundtrip.output.md +++ /dev/null @@ -1,21 +0,0 @@ -``` unison -test> foo : [Test.Result] -foo = [] -``` - -Apparently when we add a test watch, we add a type annotation to it, even if it already has one. We don't want this to happen though\! - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - foo : [Result] - -scratch/main> view foo - - foo : [Result] - foo : [Result] - foo = [] - -``` diff --git a/unison-src/transcripts/addupdatemessages.md b/unison-src/transcripts/addupdatemessages.md deleted file mode 100644 index 9c7daea43f..0000000000 --- a/unison-src/transcripts/addupdatemessages.md +++ /dev/null @@ -1,63 +0,0 @@ -# Adds and updates - -Let's set up some definitions to start: - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -x = 1 -y = 2 - -structural type X = One Nat -structural type Y = Two Nat Nat -``` - -Expected: `x` and `y`, `X`, and `Y` exist as above. UCM tells you this. - -```ucm -scratch/main> add -``` - -Let's add an alias for `1` and `One`: - -```unison -z = 1 - -structural type Z = One Nat -``` - -Expected: `z` is now `1`. UCM tells you that this definition is also called `x`. -Also, `Z` is an alias for `X`. - -```ucm -scratch/main> add -``` - -Let's update something that has an alias (to a value that doesn't have a name already): - -```unison -x = 3 -structural type X = Three Nat Nat Nat -``` - -Expected: `x` is now `3` and `X` has constructor `Three`. UCM tells you the old definitions were also called `z` and `Z` and these names have also been updated. - -```ucm -scratch/main> update -``` - -Update it to something that already exists with a different name: - -```unison -x = 2 -structural type X = Two Nat Nat -``` - -Expected: `x` is now `2` and `X` is `Two`. UCM says the old definition was also named `z/Z`, and was also updated. And it says the new definition is also named `y/Y`. - -```ucm -scratch/main> update -``` - diff --git a/unison-src/transcripts/addupdatemessages.output.md b/unison-src/transcripts/addupdatemessages.output.md deleted file mode 100644 index cbf0552713..0000000000 --- a/unison-src/transcripts/addupdatemessages.output.md +++ /dev/null @@ -1,153 +0,0 @@ -# Adds and updates - -Let's set up some definitions to start: - -``` unison -x = 1 -y = 2 - -structural type X = One Nat -structural type Y = Two Nat Nat -``` - -``` 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`: - - structural type X - structural type Y - x : Nat - y : Nat - -``` -Expected: `x` and `y`, `X`, and `Y` exist as above. UCM tells you this. - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - structural type X - structural type Y - x : Nat - y : Nat - -``` -Let's add an alias for `1` and `One`: - -``` unison -z = 1 - -structural type Z = One Nat -``` - -``` 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`: - - structural type Z - (also named X) - z : Nat - (also named x) - -``` -Expected: `z` is now `1`. UCM tells you that this definition is also called `x`. -Also, `Z` is an alias for `X`. - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - structural type Z - (also named X) - z : Nat - (also named x) - -``` -Let's update something that has an alias (to a value that doesn't have a name already): - -``` unison -x = 3 -structural type X = Three Nat Nat Nat -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - structural type X - (The old definition is also named Z.) - x : Nat - (The old definition is also named z.) - -``` -Expected: `x` is now `3` and `X` has constructor `Three`. UCM tells you the old definitions were also called `z` and `Z` and these names have also been updated. - -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Everything typechecks, so I'm saving the results... - - Done. - -``` -Update it to something that already exists with a different name: - -``` unison -x = 2 -structural type X = Two Nat Nat -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - structural type X - (also named Y) - x : Nat - (also named y) - -``` -Expected: `x` is now `2` and `X` is `Two`. UCM says the old definition was also named `z/Z`, and was also updated. And it says the new definition is also named `y/Y`. - -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -``` diff --git a/unison-src/transcripts/alias-many.md b/unison-src/transcripts/alias-many.md index 57450c64dc..4cc88d489a 100644 --- a/unison-src/transcripts/alias-many.md +++ b/unison-src/transcripts/alias-many.md @@ -1,7 +1,7 @@ -```ucm:hide +``` ucm :hide scratch/main> builtins.merge lib.builtins ``` -```unison:hide:all +``` unison :hide:all List.adjacentPairs : [a] -> [(a, a)] List.adjacentPairs as = go xs acc = @@ -94,7 +94,7 @@ List.takeWhile p xs = _ -> acc go xs [] ``` -```ucm:hide +``` ucm :hide scratch/main> add ``` @@ -112,7 +112,7 @@ scratch/main> help alias.many Let's try it! -```ucm +``` ucm scratch/main> alias.many List.adjacentPairs List.all List.any List.chunk List.chunksOf List.dropWhile List.first List.init List.intersperse List.isEmpty List.last List.replicate List.splitAt List.tail List.takeWhile mylib scratch/main> find-in mylib ``` diff --git a/unison-src/transcripts/alias-many.output.md b/unison-src/transcripts/alias-many.output.md index 4924cee59c..a4cf25a46b 100644 --- a/unison-src/transcripts/alias-many.output.md +++ b/unison-src/transcripts/alias-many.output.md @@ -1,3 +1,11 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtins +``` + +``` ucm :hide +scratch/main> add +``` + The `alias.many` command can be used to copy definitions from the current namespace into your curated one. The names that will be used in the target namespace are the names you specify, relative to the current namespace: @@ -16,9 +24,9 @@ Let's try it\! scratch/main> alias.many List.adjacentPairs List.all List.any List.chunk List.chunksOf List.dropWhile List.first List.init List.intersperse List.isEmpty List.last List.replicate List.splitAt List.tail List.takeWhile mylib Here's what changed in mylib : - + Added definitions: - + 1. List.adjacentPairs : [a] -> [(a, a)] 2. List.all : (a ->{g} Boolean) -> [a] @@ -38,7 +46,7 @@ scratch/main> alias.many List.adjacentPairs List.all List.any List.chunk List.ch 13. List.splitAt : Nat -> [a] -> ([a], [a]) 14. List.tail : [a] -> Optional [a] 15. List.takeWhile : (a ->{𝕖} Boolean) -> [a] ->{𝕖} [a] - + Tip: You can use `undo` or use a hash from `reflog` to undo this change. @@ -59,8 +67,6 @@ scratch/main> find-in mylib 13. List.splitAt : Nat -> [a] -> ([a], [a]) 14. List.tail : [a] -> Optional [a] 15. List.takeWhile : (a ->{𝕖} Boolean) -> [a] ->{𝕖} [a] - - ``` -Thanks, `alias.many`\! +Thanks, `alias.many`\! diff --git a/unison-src/transcripts/alias-term.md b/unison-src/transcripts/alias-term.md deleted file mode 100644 index 1e1bb95ec6..0000000000 --- a/unison-src/transcripts/alias-term.md +++ /dev/null @@ -1,27 +0,0 @@ -`alias.term` makes a new name for a term. - -```ucm:hide -project/main> builtins.mergeio lib.builtins -``` - -```ucm -project/main> alias.term lib.builtins.bug foo -project/main> ls -``` - -It won't create a conflicted name, though. - -```ucm:error -project/main> alias.term lib.builtins.todo foo -``` - -```ucm -project/main> ls -``` - -You can use `debug.alias.term.force` for that. - -```ucm -project/main> debug.alias.term.force lib.builtins.todo foo -project/main> ls -``` diff --git a/unison-src/transcripts/alias-term.output.md b/unison-src/transcripts/alias-term.output.md deleted file mode 100644 index 2c120239e2..0000000000 --- a/unison-src/transcripts/alias-term.output.md +++ /dev/null @@ -1,44 +0,0 @@ -`alias.term` makes a new name for a term. - -``` ucm -project/main> alias.term lib.builtins.bug foo - - Done. - -project/main> ls - - 1. foo (a -> b) - 2. lib/ (643 terms, 92 types) - -``` -It won't create a conflicted name, though. - -``` ucm -project/main> alias.term lib.builtins.todo foo - - ⚠️ - - A term by that name already exists. - -``` -``` ucm -project/main> ls - - 1. foo (a -> b) - 2. lib/ (643 terms, 92 types) - -``` -You can use `debug.alias.term.force` for that. - -``` ucm -project/main> debug.alias.term.force lib.builtins.todo foo - - Done. - -project/main> ls - - 1. foo (a -> b) - 2. foo (a -> b) - 3. lib/ (643 terms, 92 types) - -``` diff --git a/unison-src/transcripts/alias-type.md b/unison-src/transcripts/alias-type.md deleted file mode 100644 index b167daa2cc..0000000000 --- a/unison-src/transcripts/alias-type.md +++ /dev/null @@ -1,28 +0,0 @@ -`alias.type` makes a new name for a type. - -```ucm:hide -project/main> builtins.mergeio lib.builtins -``` - -```ucm -project/main> alias.type lib.builtins.Nat Foo -project/main> ls -``` - -It won't create a conflicted name, though. - -```ucm:error -project/main> alias.type lib.builtins.Int Foo -``` - -```ucm -project/main> ls -``` - -You can use `debug.alias.type.force` for that. - -```ucm -project/main> debug.alias.type.force lib.builtins.Int Foo -project/main> ls -``` - diff --git a/unison-src/transcripts/alias-type.output.md b/unison-src/transcripts/alias-type.output.md deleted file mode 100644 index 79a2fbcd7a..0000000000 --- a/unison-src/transcripts/alias-type.output.md +++ /dev/null @@ -1,44 +0,0 @@ -`alias.type` makes a new name for a type. - -``` ucm -project/main> alias.type lib.builtins.Nat Foo - - Done. - -project/main> ls - - 1. Foo (builtin type) - 2. lib/ (643 terms, 92 types) - -``` -It won't create a conflicted name, though. - -``` ucm -project/main> alias.type lib.builtins.Int Foo - - ⚠️ - - A type by that name already exists. - -``` -``` ucm -project/main> ls - - 1. Foo (builtin type) - 2. lib/ (643 terms, 92 types) - -``` -You can use `debug.alias.type.force` for that. - -``` ucm -project/main> debug.alias.type.force lib.builtins.Int Foo - - Done. - -project/main> ls - - 1. Foo (builtin type) - 2. Foo (builtin type) - 3. lib/ (643 terms, 92 types) - -``` diff --git a/unison-src/transcripts/anf-tests.md b/unison-src/transcripts/anf-tests.md deleted file mode 100644 index 2a15836eb2..0000000000 --- a/unison-src/transcripts/anf-tests.md +++ /dev/null @@ -1,34 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -This tests a variable related bug in the ANF compiler. - -The nested let would get flattened out, resulting in: - - bar = result - -which would be handled by renaming. However, the _context_ portion of -the rest of the code was not being renamed correctly, so `bar` would -remain in the definition of `baz`. - -```unison -foo _ = - id x = x - void x = () - bar = let - void (Debug.watch "hello" "hello") - result = 5 - void (Debug.watch "goodbye" "goodbye") - result - baz = id bar - baz - -> !foo -``` - -```ucm -scratch/main> add -``` - diff --git a/unison-src/transcripts/anf-tests.output.md b/unison-src/transcripts/anf-tests.output.md deleted file mode 100644 index f58ad3bc0d..0000000000 --- a/unison-src/transcripts/anf-tests.output.md +++ /dev/null @@ -1,55 +0,0 @@ -This tests a variable related bug in the ANF compiler. - -The nested let would get flattened out, resulting in: - -``` -bar = result -``` - -which would be handled by renaming. However, the *context* portion of -the rest of the code was not being renamed correctly, so `bar` would -remain in the definition of `baz`. - -``` unison -foo _ = - id x = x - void x = () - bar = let - void (Debug.watch "hello" "hello") - result = 5 - void (Debug.watch "goodbye" "goodbye") - result - baz = id bar - baz - -> !foo -``` - -``` 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 - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 12 | > !foo - ⧩ - 5 - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - foo : ∀ _. _ -> Nat - -``` diff --git a/unison-src/transcripts/any-extract.md b/unison-src/transcripts/any-extract.md deleted file mode 100644 index e65b36606f..0000000000 --- a/unison-src/transcripts/any-extract.md +++ /dev/null @@ -1,23 +0,0 @@ -# Unit tests for Any.unsafeExtract - -```ucm:hide -scratch/main> builtins.mergeio -scratch/main> load unison-src/transcripts-using-base/base.u -scratch/main> add -``` - -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 = - use Nat != - checks [1 == Any.unsafeExtract (Any 1), - not (1 == Any.unsafeExtract (Any 2)), - (Some 1) == Any.unsafeExtract (Any (Some 1)) - ] -``` - -```ucm -scratch/main> add -``` diff --git a/unison-src/transcripts/any-extract.output.md b/unison-src/transcripts/any-extract.output.md deleted file mode 100644 index 342ef3fbbc..0000000000 --- a/unison-src/transcripts/any-extract.output.md +++ /dev/null @@ -1,41 +0,0 @@ -# Unit tests for Any.unsafeExtract - -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 = - use Nat != - checks [1 == Any.unsafeExtract (Any 1), - not (1 == Any.unsafeExtract (Any 2)), - (Some 1) == Any.unsafeExtract (Any (Some 1)) - ] -``` - -``` 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`: - - Any.unsafeExtract.works : [Result] - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 3 | checks [1 == Any.unsafeExtract (Any 1), - - ✅ Passed Passed - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - Any.unsafeExtract.works : [Result] - -``` diff --git a/unison-src/transcripts/api-doc-rendering.md b/unison-src/transcripts/api-doc-rendering.md deleted file mode 100644 index eb0d956949..0000000000 --- a/unison-src/transcripts/api-doc-rendering.md +++ /dev/null @@ -1,94 +0,0 @@ -# Doc rendering - -```ucm:hide -scratch/main> builtins.mergeio -``` - -```unison:hide -structural type Maybe a = Nothing | Just a -otherTerm = "text" - -otherDoc : (Text -> Doc2) -> Doc2 -otherDoc mkMsg = {{ -This doc should be embedded. - -{{mkMsg "message"}} - -}} - -{{ -# Heading - -## Heading 2 - -Term Link: {otherTerm} - -Type Link: {type Maybe} - -Term source: - -@source{term} - -Term signature: - -@signature{term} - -* List item - -1. Numbered list item - -> Block quote - - Code block - -Inline code: - -`` 1 + 2 `` - -`"doesn't typecheck" + 1` - -[Link](https://unison-lang.org) - -![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png) - -**Bold** - -*Italic* - -~~Strikethrough~~ - -Horizontal rule - ---- - -Table - -| Header 1 | Header 2 | -| -------- | -------- | -| Cell 1 | Cell 2 | -| Cell 3 | Cell 4 | - - -Video - -{{ Special (Embed (Any (Video [(MediaSource "test.mp4" None)] [("poster", "test.png")]))) }} - -Transclusion/evaluation: - -{{otherDoc (a -> Word a )}} - -}} -term = 42 -``` - -```ucm:hide -scratch/main> add -``` - -```ucm -scratch/main> display term.doc -``` - -```api -GET /api/projects/scratch/branches/main/getDefinition?names=term -``` diff --git a/unison-src/transcripts/api-doc-rendering.output.md b/unison-src/transcripts/api-doc-rendering.output.md deleted file mode 100644 index 1ecf4f86a3..0000000000 --- a/unison-src/transcripts/api-doc-rendering.output.md +++ /dev/null @@ -1,944 +0,0 @@ -# Doc rendering - -``` unison -structural type Maybe a = Nothing | Just a -otherTerm = "text" - -otherDoc : (Text -> Doc2) -> Doc2 -otherDoc mkMsg = {{ -This doc should be embedded. - -{{mkMsg "message"}} - -}} - -{{ -# Heading - -## Heading 2 - -Term Link: {otherTerm} - -Type Link: {type Maybe} - -Term source: - -@source{term} - -Term signature: - -@signature{term} - -* List item - -1. Numbered list item - -> Block quote - - Code block - -Inline code: - -`` 1 + 2 `` - -`"doesn't typecheck" + 1` - -[Link](https://unison-lang.org) - -![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png) - -**Bold** - -*Italic* - -~~Strikethrough~~ - -Horizontal rule - ---- - -Table - -| Header 1 | Header 2 | -| -------- | -------- | -| Cell 1 | Cell 2 | -| Cell 3 | Cell 4 | - - -Video - -{{ Special (Embed (Any (Video [(MediaSource "test.mp4" None)] [("poster", "test.png")]))) }} - -Transclusion/evaluation: - -{{otherDoc (a -> Word a )}} - -}} -term = 42 -``` - -``` ucm -scratch/main> display term.doc - - # Heading - - # Heading 2 - - Term Link: otherTerm - - Type Link: Maybe - - Term source: - - term : Nat - term = 42 - - Term signature: - - term : Nat - - * List item - - 1. Numbered list item - - > Block quote - - Code block - - Inline code: - - `1 Nat.+ 2` - - `"doesn't typecheck" + 1` - - Link - - ![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png) - - Bold - - Italic - - ~~Strikethrough~~ - - Horizontal rule - - --- - - Table - - | Header 1 | Header 2 | | -------- | -------- | | Cell 1 | - Cell 2 | | Cell 3 | Cell 4 | - - Video - - - {{ embed {{ - Video - [MediaSource "test.mp4" Nothing] - [("poster", "test.png")] }} }} - - - Transclusion/evaluation: - - This doc should be embedded. - - message - -``` -``` api -GET /api/projects/scratch/branches/main/getDefinition?names=term -{ - "missingDefinitions": [], - "termDefinitions": { - "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8": { - "bestTermName": "term", - "defnTermTag": "Plain", - "signature": [ - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ], - "termDefinition": { - "contents": [ - { - "annotation": { - "contents": "term", - "tag": "HashQualifier" - }, - "segment": "term" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "term", - "tag": "HashQualifier" - }, - "segment": "term" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "42" - } - ], - "tag": "UserObject" - }, - "termDocs": [ - [ - "doc", - "#kjfaflbrgl89j2uq4ruubejakm6s02cp3m61ufu7rv7tkbd4nmkvcn1fciue53v0msir9t7ds111ab9er8qfa06gsa9ddfrdfgc99mo", - { - "contents": [ - { - "contents": [ - { - "contents": "Heading", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - [ - { - "contents": [ - { - "contents": [ - { - "contents": "Heading", - "tag": "Word" - }, - { - "contents": "2", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - [ - { - "contents": [ - { - "contents": "Term", - "tag": "Word" - }, - { - "contents": "Link:", - "tag": "Word" - }, - { - "contents": { - "contents": [ - { - "annotation": { - "contents": "#k5gpql9cbdfau6lf1aja24joc3sfctvjor8esu8bemn0in3l148otb0t3vebgqrt6qml302h62bbfeftg65gec1v8ouin5m6v2969d8", - "tag": "TermReference" - }, - "segment": "otherTerm" - } - ], - "tag": "Link" - }, - "tag": "Special" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Type", - "tag": "Word" - }, - { - "contents": "Link:", - "tag": "Word" - }, - { - "contents": { - "contents": [ - { - "annotation": { - "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", - "tag": "TypeReference" - }, - "segment": "Maybe" - } - ], - "tag": "Link" - }, - "tag": "Special" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Term", - "tag": "Word" - }, - { - "contents": "source:", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - { - "contents": [ - "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - { - "contents": [ - [ - { - "annotation": { - "contents": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "tag": "TermReference" - }, - "segment": "term" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": ": " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ], - [ - { - "annotation": { - "contents": "term", - "tag": "HashQualifier" - }, - "segment": "term" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "term", - "tag": "HashQualifier" - }, - "segment": "term" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "42" - } - ] - ], - "tag": "UserObject" - } - ], - "tag": "Term" - } - ], - "tag": "Source" - }, - "tag": "Special" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Term", - "tag": "Word" - }, - { - "contents": "signature:", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - [ - { - "annotation": { - "contents": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "tag": "TermReference" - }, - "segment": "term" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": ": " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ] - ], - "tag": "Signature" - }, - "tag": "Special" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": [ - { - "contents": "List", - "tag": "Word" - }, - { - "contents": "item", - "tag": "Word" - } - ], - "tag": "Paragraph" - } - ], - "tag": "BulletedList" - }, - { - "contents": [ - 1, - [ - { - "contents": [ - { - "contents": "Numbered", - "tag": "Word" - }, - { - "contents": "list", - "tag": "Word" - }, - { - "contents": "item", - "tag": "Word" - } - ], - "tag": "Paragraph" - } - ] - ], - "tag": "NumberedList" - }, - { - "contents": [ - { - "contents": ">", - "tag": "Word" - }, - { - "contents": "Block", - "tag": "Word" - }, - { - "contents": "quote", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Code", - "tag": "Word" - }, - { - "contents": "block", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Inline", - "tag": "Word" - }, - { - "contents": "code:", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "1" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat.+", - "tag": "TermReference" - }, - "segment": "Nat.+" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "2" - } - ], - "tag": "Example" - }, - "tag": "Special" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": "\"doesn't typecheck\" + 1", - "tag": "Word" - }, - "tag": "Code" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": [ - { - "contents": [ - { - "contents": "Link", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": { - "contents": "https://unison-lang.org", - "tag": "Word" - }, - "tag": "Group" - } - ], - "tag": "NamedLink" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png)", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - { - "contents": "Bold", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - "tag": "Bold" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - { - "contents": "Italic", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - "tag": "Bold" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - { - "contents": "Strikethrough", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - "tag": "Strikethrough" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Horizontal", - "tag": "Word" - }, - { - "contents": "rule", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "---", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Table", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "Header", - "tag": "Word" - }, - { - "contents": "1", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "Header", - "tag": "Word" - }, - { - "contents": "2", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "--------", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "--------", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "Cell", - "tag": "Word" - }, - { - "contents": "1", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "Cell", - "tag": "Word" - }, - { - "contents": "2", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "Cell", - "tag": "Word" - }, - { - "contents": "3", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - }, - { - "contents": "Cell", - "tag": "Word" - }, - { - "contents": "4", - "tag": "Word" - }, - { - "contents": "|", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Video", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": { - "contents": [ - [ - { - "mediaSourceMimeType": null, - "mediaSourceUrl": "test.mp4" - } - ], - { - "poster": "test.png" - } - ], - "tag": "Video" - }, - "tag": "Special" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "Transclusion/evaluation:", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": [ - { - "contents": [ - { - "contents": "This", - "tag": "Word" - }, - { - "contents": "doc", - "tag": "Word" - }, - { - "contents": "should", - "tag": "Word" - }, - { - "contents": "be", - "tag": "Word" - }, - { - "contents": "embedded.", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - { - "contents": [ - { - "contents": "message", - "tag": "Word" - } - ], - "tag": "Paragraph" - } - ], - "tag": "UntitledSection" - } - ], - "tag": "Paragraph" - } - ] - ], - "tag": "Section" - } - ] - ], - "tag": "Section" - } - ] - ], - "termNames": [ - "term" - ] - } - }, - "typeDefinitions": {} -} -``` - diff --git a/unison-src/transcripts/api-find.md b/unison-src/transcripts/api-find.md deleted file mode 100644 index f11d98bfcb..0000000000 --- a/unison-src/transcripts/api-find.md +++ /dev/null @@ -1,26 +0,0 @@ -# find api - -```unison -rachel.filesystem.x = 42 -ross.httpClient.y = 43 -joey.httpServer.z = 44 -joey.yaml.zz = 45 -``` - -```ucm -scratch/main> add -``` - -```api --- Namespace segment prefix search -GET /api/projects/scratch/branches/main/find?query=http - --- Namespace segment suffix search -GET /api/projects/scratch/branches/main/find?query=Server - --- Substring search -GET /api/projects/scratch/branches/main/find?query=lesys - --- Cross-segment search -GET /api/projects/scratch/branches/main/find?query=joey.http -``` diff --git a/unison-src/transcripts/api-find.output.md b/unison-src/transcripts/api-find.output.md deleted file mode 100644 index 2d062550b9..0000000000 --- a/unison-src/transcripts/api-find.output.md +++ /dev/null @@ -1,256 +0,0 @@ -# find api - -``` unison -rachel.filesystem.x = 42 -ross.httpClient.y = 43 -joey.httpServer.z = 44 -joey.yaml.zz = 45 -``` - -``` 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`: - - joey.httpServer.z : ##Nat - joey.yaml.zz : ##Nat - rachel.filesystem.x : ##Nat - ross.httpClient.y : ##Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - joey.httpServer.z : ##Nat - joey.yaml.zz : ##Nat - rachel.filesystem.x : ##Nat - ross.httpClient.y : ##Nat - -``` -``` api --- Namespace segment prefix search -GET /api/projects/scratch/branches/main/find?query=http -[ - [ - { - "result": { - "segments": [ - { - "contents": "ross.", - "tag": "Gap" - }, - { - "contents": "http", - "tag": "Match" - }, - { - "contents": "Client.y", - "tag": "Gap" - } - ] - }, - "score": 156 - }, - { - "contents": { - "bestFoundTermName": "y", - "namedTerm": { - "termHash": "#emomp74i93h6ps0b5sukke0tci0ooba3f9jk21qm919a7act9u7asani84c0mqbdk4lcjrdvr9olpedp23p6df78r4trqlg0cciadc8", - "termName": "ross.httpClient.y", - "termTag": "Plain", - "termType": [ - { - "annotation": { - "contents": "##Nat", - "tag": "HashQualifier" - }, - "segment": "##Nat" - } - ] - } - }, - "tag": "FoundTermResult" - } - ], - [ - { - "result": { - "segments": [ - { - "contents": "joey.", - "tag": "Gap" - }, - { - "contents": "http", - "tag": "Match" - }, - { - "contents": "Server.z", - "tag": "Gap" - } - ] - }, - "score": 156 - }, - { - "contents": { - "bestFoundTermName": "z", - "namedTerm": { - "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", - "termName": "joey.httpServer.z", - "termTag": "Plain", - "termType": [ - { - "annotation": { - "contents": "##Nat", - "tag": "HashQualifier" - }, - "segment": "##Nat" - } - ] - } - }, - "tag": "FoundTermResult" - } - ] -] --- Namespace segment suffix search -GET /api/projects/scratch/branches/main/find?query=Server -[ - [ - { - "result": { - "segments": [ - { - "contents": "joey.http", - "tag": "Gap" - }, - { - "contents": "Server", - "tag": "Match" - }, - { - "contents": ".z", - "tag": "Gap" - } - ] - }, - "score": 223 - }, - { - "contents": { - "bestFoundTermName": "z", - "namedTerm": { - "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", - "termName": "joey.httpServer.z", - "termTag": "Plain", - "termType": [ - { - "annotation": { - "contents": "##Nat", - "tag": "HashQualifier" - }, - "segment": "##Nat" - } - ] - } - }, - "tag": "FoundTermResult" - } - ] -] --- Substring search -GET /api/projects/scratch/branches/main/find?query=lesys -[ - [ - { - "result": { - "segments": [ - { - "contents": "rachel.fi", - "tag": "Gap" - }, - { - "contents": "lesys", - "tag": "Match" - }, - { - "contents": "tem.x", - "tag": "Gap" - } - ] - }, - "score": 175 - }, - { - "contents": { - "bestFoundTermName": "x", - "namedTerm": { - "termHash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "termName": "rachel.filesystem.x", - "termTag": "Plain", - "termType": [ - { - "annotation": { - "contents": "##Nat", - "tag": "HashQualifier" - }, - "segment": "##Nat" - } - ] - } - }, - "tag": "FoundTermResult" - } - ] -] --- Cross-segment search -GET /api/projects/scratch/branches/main/find?query=joey.http -[ - [ - { - "result": { - "segments": [ - { - "contents": "joey.http", - "tag": "Match" - }, - { - "contents": "Server.z", - "tag": "Gap" - } - ] - }, - "score": 300 - }, - { - "contents": { - "bestFoundTermName": "z", - "namedTerm": { - "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", - "termName": "joey.httpServer.z", - "termTag": "Plain", - "termType": [ - { - "annotation": { - "contents": "##Nat", - "tag": "HashQualifier" - }, - "segment": "##Nat" - } - ] - } - }, - "tag": "FoundTermResult" - } - ] -] -``` - diff --git a/unison-src/transcripts/api-getDefinition.md b/unison-src/transcripts/api-getDefinition.md deleted file mode 100644 index 94f2341e74..0000000000 --- a/unison-src/transcripts/api-getDefinition.md +++ /dev/null @@ -1,50 +0,0 @@ -# Get Definitions Test - -```ucm:hide -scratch/main> builtins.mergeio lib.builtins -``` - -```unison:hide -nested.names.x.doc = {{ Documentation }} -nested.names.x = 42 -``` - -```ucm:hide -scratch/main> add -``` - -```api --- Should NOT find names by suffix -GET /api/projects/scratch/branches/main/getDefinition?names=x - --- Term names should strip relativeTo prefix. -GET /api/projects/scratch/branches/main/getDefinition?names=names.x&relativeTo=nested - --- Should find definitions by hash, names should be relative -GET /api/projects/scratch/branches/main/getDefinition?names=%23qkhkl0n238&relativeTo=nested -``` - -```unison:hide -doctest.thing.doc = {{ The correct docs for the thing }} -doctest.thing = "A thing" -doctest.thingalias.doc = {{ Docs for the alias, should not be displayed }} -doctest.thingalias = "A thing" -doctest.otherstuff.thing.doc = {{ A doc for a different term with the same name, should not be displayed }} -doctest.otherstuff.thing = "A different thing" -``` - -```ucm:hide -scratch/main> add -``` - -Only docs for the term we request should be returned, even if there are other term docs with the same suffix. - -```api -GET /api/projects/scratch/branches/main/getDefinition?names=thing&relativeTo=doctest -``` - -If we request a doc, the api should return the source, but also the rendered doc should appear in the 'termDocs' list. - -```api -GET /api/projects/scratch/branches/main/getDefinition?names=thing.doc&relativeTo=doctest -``` diff --git a/unison-src/transcripts/api-getDefinition.output.md b/unison-src/transcripts/api-getDefinition.output.md deleted file mode 100644 index edf49323c5..0000000000 --- a/unison-src/transcripts/api-getDefinition.output.md +++ /dev/null @@ -1,515 +0,0 @@ -# Get Definitions Test - -``` unison -nested.names.x.doc = {{ Documentation }} -nested.names.x = 42 -``` - -``` api --- Should NOT find names by suffix -GET /api/projects/scratch/branches/main/getDefinition?names=x -{ - "missingDefinitions": [ - "x" - ], - "termDefinitions": {}, - "typeDefinitions": {} -} --- Term names should strip relativeTo prefix. -GET /api/projects/scratch/branches/main/getDefinition?names=names.x&relativeTo=nested -{ - "missingDefinitions": [], - "termDefinitions": { - "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8": { - "bestTermName": "x", - "defnTermTag": "Plain", - "signature": [ - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ], - "termDefinition": { - "contents": [ - { - "annotation": { - "contents": "x", - "tag": "HashQualifier" - }, - "segment": "x" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "x", - "tag": "HashQualifier" - }, - "segment": "x" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "42" - } - ], - "tag": "UserObject" - }, - "termDocs": [ - [ - "doc", - "#ulr9f75rpcrv79d7sfo2ep2tvbntu3e360lfomird2bdpj4bnea230e8o5j0b9our8vggocpa7eck3pus14fcfajlttat1bg71t6rbg", - { - "contents": [ - { - "contents": "Documentation", - "tag": "Word" - } - ], - "tag": "Paragraph" - } - ] - ], - "termNames": [ - "nested.names.x" - ] - } - }, - "typeDefinitions": {} -} --- Should find definitions by hash, names should be relative -GET /api/projects/scratch/branches/main/getDefinition?names=%23qkhkl0n238&relativeTo=nested -{ - "missingDefinitions": [], - "termDefinitions": { - "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8": { - "bestTermName": "x", - "defnTermTag": "Plain", - "signature": [ - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ], - "termDefinition": { - "contents": [ - { - "annotation": { - "contents": "x", - "tag": "HashQualifier" - }, - "segment": "x" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "x", - "tag": "HashQualifier" - }, - "segment": "x" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "42" - } - ], - "tag": "UserObject" - }, - "termDocs": [ - [ - "doc", - "#ulr9f75rpcrv79d7sfo2ep2tvbntu3e360lfomird2bdpj4bnea230e8o5j0b9our8vggocpa7eck3pus14fcfajlttat1bg71t6rbg", - { - "contents": [ - { - "contents": "Documentation", - "tag": "Word" - } - ], - "tag": "Paragraph" - } - ] - ], - "termNames": [ - "nested.names.x" - ] - } - }, - "typeDefinitions": {} -} -``` - -``` unison -doctest.thing.doc = {{ The correct docs for the thing }} -doctest.thing = "A thing" -doctest.thingalias.doc = {{ Docs for the alias, should not be displayed }} -doctest.thingalias = "A thing" -doctest.otherstuff.thing.doc = {{ A doc for a different term with the same name, should not be displayed }} -doctest.otherstuff.thing = "A different thing" -``` - -Only docs for the term we request should be returned, even if there are other term docs with the same suffix. - -``` api -GET /api/projects/scratch/branches/main/getDefinition?names=thing&relativeTo=doctest -{ - "missingDefinitions": [], - "termDefinitions": { - "#jksc1s5kud95ro5ivngossullt2oavsd41s3u48bch67jf3gknru5j6hmjslonkd5sdqs8mr8k4rrnef8fodngbg4sm7u6au564ekjg": { - "bestTermName": "doctest.thing", - "defnTermTag": "Plain", - "signature": [ - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - } - ], - "termDefinition": { - "contents": [ - { - "annotation": { - "contents": "doctest.thing", - "tag": "HashQualifier" - }, - "segment": "doctest.thing" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "doctest.thing", - "tag": "HashQualifier" - }, - "segment": "doctest.thing" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TextLiteral" - }, - "segment": "\"A thing\"" - } - ], - "tag": "UserObject" - }, - "termDocs": [ - [ - "doctest.thing.doc", - "#t9qfdoiuskj4n9go8cftj1r83s43s3o7sppafm5vr0bq5feieb7ap0cie5ed2qsf9g3ig448vffhnajinq81pnnkila1jp2epa7f26o", - { - "contents": [ - { - "contents": "The", - "tag": "Word" - }, - { - "contents": "correct", - "tag": "Word" - }, - { - "contents": "docs", - "tag": "Word" - }, - { - "contents": "for", - "tag": "Word" - }, - { - "contents": "the", - "tag": "Word" - }, - { - "contents": "thing", - "tag": "Word" - } - ], - "tag": "Paragraph" - } - ] - ], - "termNames": [ - "doctest.thing", - "doctest.thingalias" - ] - } - }, - "typeDefinitions": {} -} -``` - -If we request a doc, the api should return the source, but also the rendered doc should appear in the 'termDocs' list. - -``` api -GET /api/projects/scratch/branches/main/getDefinition?names=thing.doc&relativeTo=doctest -{ - "missingDefinitions": [], - "termDefinitions": { - "#t9qfdoiuskj4n9go8cftj1r83s43s3o7sppafm5vr0bq5feieb7ap0cie5ed2qsf9g3ig448vffhnajinq81pnnkila1jp2epa7f26o": { - "bestTermName": "doctest.thing.doc", - "defnTermTag": "Doc", - "signature": [ - { - "annotation": { - "contents": "#ej86si0ur1lsjade71dojr25phk9bbom9rdks6dltolos5tjivakujcriqe02npba53n9gd7tkh8bmv08ttjb9t35lq2ch5heshqcs0", - "tag": "TypeReference" - }, - "segment": "Doc2" - } - ], - "termDefinition": { - "contents": [ - { - "annotation": { - "contents": "doctest.thing.doc", - "tag": "HashQualifier" - }, - "segment": "doctest.thing.doc" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "#ej86si0ur1lsjade71dojr25phk9bbom9rdks6dltolos5tjivakujcriqe02npba53n9gd7tkh8bmv08ttjb9t35lq2ch5heshqcs0", - "tag": "TypeReference" - }, - "segment": "Doc2" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "doctest.thing.doc", - "tag": "HashQualifier" - }, - "segment": "doctest.thing.doc" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "DocDelimiter" - }, - "segment": "{{" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": null, - "segment": "The" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": null, - "segment": "correct" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": null, - "segment": "docs" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": null, - "segment": "for" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": null, - "segment": "the" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": null, - "segment": "thing" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "DocDelimiter" - }, - "segment": "}}" - } - ], - "tag": "UserObject" - }, - "termDocs": [ - [ - "doctest.thing.doc", - "#t9qfdoiuskj4n9go8cftj1r83s43s3o7sppafm5vr0bq5feieb7ap0cie5ed2qsf9g3ig448vffhnajinq81pnnkila1jp2epa7f26o", - { - "contents": [ - { - "contents": "The", - "tag": "Word" - }, - { - "contents": "correct", - "tag": "Word" - }, - { - "contents": "docs", - "tag": "Word" - }, - { - "contents": "for", - "tag": "Word" - }, - { - "contents": "the", - "tag": "Word" - }, - { - "contents": "thing", - "tag": "Word" - } - ], - "tag": "Paragraph" - } - ] - ], - "termNames": [ - "doctest.thing.doc" - ] - } - }, - "typeDefinitions": {} -} -``` - diff --git a/unison-src/transcripts/api-list-projects-branches.md b/unison-src/transcripts/api-list-projects-branches.md deleted file mode 100644 index 872cca22a7..0000000000 --- a/unison-src/transcripts/api-list-projects-branches.md +++ /dev/null @@ -1,24 +0,0 @@ -# List Projects And Branches Test - -```ucm:hide -scratch/main> project.create-empty project-one -scratch/main> project.create-empty project-two -scratch/main> project.create-empty project-three -project-one/main> branch branch-one -project-one/main> branch branch-two -project-one/main> branch branch-three -``` - -```api --- Should list all projects -GET /api/projects - --- Should list projects starting with project-t -GET /api/projects?prefix=project-t - --- Should list all branches -GET /api/projects/project-one/branches - --- Should list all branches beginning with branch-t -GET /api/projects/project-one/branches?prefix=branch-t -``` diff --git a/unison-src/transcripts/api-list-projects-branches.output.md b/unison-src/transcripts/api-list-projects-branches.output.md deleted file mode 100644 index 0971ab5fc5..0000000000 --- a/unison-src/transcripts/api-list-projects-branches.output.md +++ /dev/null @@ -1,57 +0,0 @@ -# List Projects And Branches Test - -``` api --- Should list all projects -GET /api/projects -[ - { - "projectName": "project-one" - }, - { - "projectName": "project-three" - }, - { - "projectName": "project-two" - }, - { - "projectName": "scratch" - } -] --- Should list projects starting with project-t -GET /api/projects?prefix=project-t -[ - { - "projectName": "project-three" - }, - { - "projectName": "project-two" - } -] --- Should list all branches -GET /api/projects/project-one/branches -[ - { - "branchName": "branch-one" - }, - { - "branchName": "branch-three" - }, - { - "branchName": "branch-two" - }, - { - "branchName": "main" - } -] --- Should list all branches beginning with branch-t -GET /api/projects/project-one/branches?prefix=branch-t -[ - { - "branchName": "branch-three" - }, - { - "branchName": "branch-two" - } -] -``` - diff --git a/unison-src/transcripts/api-namespace-details.md b/unison-src/transcripts/api-namespace-details.md deleted file mode 100644 index 2d50bdae93..0000000000 --- a/unison-src/transcripts/api-namespace-details.md +++ /dev/null @@ -1,23 +0,0 @@ -# Namespace Details Test - -```ucm:hide -scratch/main> builtins.mergeio -``` - -```unison -{{ Documentation }} -nested.names.x = 42 - -nested.names.readme = {{ -Here's a *README*! -}} -``` - -```ucm -scratch/main> add -``` - -```api --- Should find names by suffix -GET /api/projects/scratch/branches/main/namespaces/nested.names -``` diff --git a/unison-src/transcripts/api-namespace-details.output.md b/unison-src/transcripts/api-namespace-details.output.md deleted file mode 100644 index 3ba09740f7..0000000000 --- a/unison-src/transcripts/api-namespace-details.output.md +++ /dev/null @@ -1,82 +0,0 @@ -# Namespace Details Test - -``` unison -{{ Documentation }} -nested.names.x = 42 - -nested.names.readme = {{ -Here's a *README*! -}} -``` - -``` 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`: - - nested.names.readme : Doc2 - nested.names.x : Nat - nested.names.x.doc : Doc2 - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - nested.names.readme : Doc2 - nested.names.x : Nat - nested.names.x.doc : Doc2 - -``` -``` api --- Should find names by suffix -GET /api/projects/scratch/branches/main/namespaces/nested.names -{ - "fqn": "nested.names", - "hash": "#6tnmlu9knsce0u2991u6fvcmf4v44fdf0aiqtmnq7mjj0gi5sephg3lf12iv3odr5rc7vlgq75ciborrd3625c701bdmdomia2gcm3o", - "readme": { - "contents": [ - { - "contents": "Here's", - "tag": "Word" - }, - { - "contents": "a", - "tag": "Word" - }, - { - "contents": { - "contents": [ - { - "contents": { - "contents": [ - { - "contents": "README", - "tag": "Word" - } - ], - "tag": "Paragraph" - }, - "tag": "Bold" - }, - { - "contents": "!", - "tag": "Word" - } - ], - "tag": "Join" - }, - "tag": "Group" - } - ], - "tag": "Paragraph" - } -} -``` - diff --git a/unison-src/transcripts/api-namespace-list.md b/unison-src/transcripts/api-namespace-list.md deleted file mode 100644 index c3dbbeed13..0000000000 --- a/unison-src/transcripts/api-namespace-list.md +++ /dev/null @@ -1,22 +0,0 @@ -# Namespace list api - -```ucm:hide -scratch/main> builtins.mergeio -``` - -```unison -{{ Documentation }} -nested.names.x = 42 - -nested.names.readme = {{ I'm a readme! }} -``` - -```ucm -scratch/main> add -``` - -```api -GET /api/projects/scratch/branches/main/list?namespace=nested.names - -GET /api/projects/scratch/branches/main/list?namespace=names&relativeTo=nested -``` diff --git a/unison-src/transcripts/api-namespace-list.output.md b/unison-src/transcripts/api-namespace-list.output.md deleted file mode 100644 index 56a6e09498..0000000000 --- a/unison-src/transcripts/api-namespace-list.output.md +++ /dev/null @@ -1,135 +0,0 @@ -# Namespace list api - -``` unison -{{ Documentation }} -nested.names.x = 42 - -nested.names.readme = {{ I'm a readme! }} -``` - -``` 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`: - - nested.names.readme : Doc2 - nested.names.x : Nat - nested.names.x.doc : Doc2 - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - nested.names.readme : Doc2 - nested.names.x : Nat - nested.names.x.doc : Doc2 - -``` -``` api -GET /api/projects/scratch/branches/main/list?namespace=nested.names -{ - "namespaceListingChildren": [ - { - "contents": { - "termHash": "#ddmmatmmiqsts2ku0i02kntd0s7rvcui4nn1cusio8thp9oqhbtilvcnhen52ibv43kr5q83f5er5q9h56s807k17tnelnrac7cch8o", - "termName": "readme", - "termTag": "Doc", - "termType": [ - { - "annotation": { - "contents": "#ej86si0ur1", - "tag": "HashQualifier" - }, - "segment": "#ej86si0ur1" - } - ] - }, - "tag": "TermObject" - }, - { - "contents": { - "termHash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "termName": "x", - "termTag": "Plain", - "termType": [ - { - "annotation": { - "contents": "##Nat", - "tag": "HashQualifier" - }, - "segment": "##Nat" - } - ] - }, - "tag": "TermObject" - }, - { - "contents": { - "namespaceHash": "#n1egracfeljprftoktbjcase2hs4f4p8idbhs5ujipl42agld1810hrq9t7p7ped16aagni2cm1fjcjhho770jh80ipthhmg0cnsur0", - "namespaceName": "x", - "namespaceSize": 1 - }, - "tag": "Subnamespace" - } - ], - "namespaceListingFQN": "nested.names", - "namespaceListingHash": "#oms19b4f9s3c8tb5skeb8jii95ij35n3hdg038pu6rv5b0fikqe4gd7lnu6a1i6aq5tdh2opdo4s0sfrupvk6vfkr9lf0n752gbl8o0" -} -GET /api/projects/scratch/branches/main/list?namespace=names&relativeTo=nested -{ - "namespaceListingChildren": [ - { - "contents": { - "termHash": "#ddmmatmmiqsts2ku0i02kntd0s7rvcui4nn1cusio8thp9oqhbtilvcnhen52ibv43kr5q83f5er5q9h56s807k17tnelnrac7cch8o", - "termName": "readme", - "termTag": "Doc", - "termType": [ - { - "annotation": { - "contents": "#ej86si0ur1", - "tag": "HashQualifier" - }, - "segment": "#ej86si0ur1" - } - ] - }, - "tag": "TermObject" - }, - { - "contents": { - "termHash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "termName": "x", - "termTag": "Plain", - "termType": [ - { - "annotation": { - "contents": "##Nat", - "tag": "HashQualifier" - }, - "segment": "##Nat" - } - ] - }, - "tag": "TermObject" - }, - { - "contents": { - "namespaceHash": "#n1egracfeljprftoktbjcase2hs4f4p8idbhs5ujipl42agld1810hrq9t7p7ped16aagni2cm1fjcjhho770jh80ipthhmg0cnsur0", - "namespaceName": "x", - "namespaceSize": 1 - }, - "tag": "Subnamespace" - } - ], - "namespaceListingFQN": "nested.names", - "namespaceListingHash": "#oms19b4f9s3c8tb5skeb8jii95ij35n3hdg038pu6rv5b0fikqe4gd7lnu6a1i6aq5tdh2opdo4s0sfrupvk6vfkr9lf0n752gbl8o0" -} -``` - diff --git a/unison-src/transcripts/api-summaries.md b/unison-src/transcripts/api-summaries.md deleted file mode 100644 index 6bbc793a9f..0000000000 --- a/unison-src/transcripts/api-summaries.md +++ /dev/null @@ -1,80 +0,0 @@ -# Definition Summary APIs - -```ucm:hide -scratch/main> builtins.mergeio -``` - - -```unison:hide -nat : Nat -nat = 42 -doc : Doc2 -doc = {{ Hello }} -test> mytest = [Test.Result.Ok "ok"] -func : Text -> Text -func x = x ++ "hello" - -funcWithLongType : Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -funcWithLongType a b c d e f g h = a ++ b ++ c ++ d ++ e ++ f ++ g ++ h - -structural type Thing = This Nat | That -structural type Maybe a = Nothing | Just a - -structural ability Stream s where - send : s -> () -``` - -```ucm:hide -scratch/main> add -scratch/main> alias.type ##Nat Nat -scratch/main> alias.term ##IO.putBytes.impl.v3 putBytesImpl -``` - -## Term Summary APIs - -```api --- term -GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary?name=nat - --- term without name uses hash -GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary - --- doc -GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@icfnhas71n8q5rm7rmpe51hh7bltsr7rb4lv7qadc4cbsifu1mhonlqj2d7836iar2ptc648q9p4u7hf40ijvld574421b6u8gpu0lo/summary?name=doc - --- test -GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@u17p9803hdibisou6rlr1sjbccdossgh7vtkd03ovlvnsl2n91lq94sqhughc62tnrual2jlrfk922sebp4nm22o7m5u9j40emft8r8/summary?name=mytest - --- function -GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@6ee6j48hk3eovokflkgbmpbfr3oqj4hedqn8ocg3i4i0ko8j7nls7njjirmnh4k2bg8h95seaot798uuloqk62u2ttiqoceulkbmq2o/summary?name=func - --- constructor -GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0@d0/summary?name=Thing.This - --- Long type signature -GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?name=funcWithLongType - --- Long type signature with render width -GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?renderWidth=20&name=funcWithLongType - --- Builtin Term -GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@@IO.putBytes.impl.v3/summary?name=putBytesImpl -``` - -## Type Summary APIs - -```api --- data -GET /api/projects/scratch/branches/main/definitions/types/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0/summary?name=Thing - --- data with type args -GET /api/projects/scratch/branches/main/definitions/types/by-hash/@nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg/summary?name=Maybe - --- ability -GET /api/projects/scratch/branches/main/definitions/types/by-hash/@rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8/summary?name=Stream - --- builtin type -GET /api/projects/scratch/branches/main/definitions/types/by-hash/@@Nat/summary?name=Nat -``` - - diff --git a/unison-src/transcripts/api-summaries.output.md b/unison-src/transcripts/api-summaries.output.md deleted file mode 100644 index 7ea0a5d197..0000000000 --- a/unison-src/transcripts/api-summaries.output.md +++ /dev/null @@ -1,829 +0,0 @@ -# Definition Summary APIs - -``` unison -nat : Nat -nat = 42 -doc : Doc2 -doc = {{ Hello }} -test> mytest = [Test.Result.Ok "ok"] -func : Text -> Text -func x = x ++ "hello" - -funcWithLongType : Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -funcWithLongType a b c d e f g h = a ++ b ++ c ++ d ++ e ++ f ++ g ++ h - -structural type Thing = This Nat | That -structural type Maybe a = Nothing | Just a - -structural ability Stream s where - send : s -> () -``` - -## Term Summary APIs - -``` api --- term -GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary?name=nat -{ - "displayName": "nat", - "hash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "summary": { - "contents": [ - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ], - "tag": "UserObject" - }, - "tag": "Plain" -} --- term without name uses hash -GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary -{ - "displayName": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "hash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", - "summary": { - "contents": [ - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ], - "tag": "UserObject" - }, - "tag": "Plain" -} --- doc -GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@icfnhas71n8q5rm7rmpe51hh7bltsr7rb4lv7qadc4cbsifu1mhonlqj2d7836iar2ptc648q9p4u7hf40ijvld574421b6u8gpu0lo/summary?name=doc -{ - "displayName": "doc", - "hash": "#icfnhas71n8q5rm7rmpe51hh7bltsr7rb4lv7qadc4cbsifu1mhonlqj2d7836iar2ptc648q9p4u7hf40ijvld574421b6u8gpu0lo", - "summary": { - "contents": [ - { - "annotation": { - "contents": "#ej86si0ur1lsjade71dojr25phk9bbom9rdks6dltolos5tjivakujcriqe02npba53n9gd7tkh8bmv08ttjb9t35lq2ch5heshqcs0", - "tag": "TypeReference" - }, - "segment": "Doc2" - } - ], - "tag": "UserObject" - }, - "tag": "Doc" -} --- test -GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@u17p9803hdibisou6rlr1sjbccdossgh7vtkd03ovlvnsl2n91lq94sqhughc62tnrual2jlrfk922sebp4nm22o7m5u9j40emft8r8/summary?name=mytest -{ - "displayName": "mytest", - "hash": "#u17p9803hdibisou6rlr1sjbccdossgh7vtkd03ovlvnsl2n91lq94sqhughc62tnrual2jlrfk922sebp4nm22o7m5u9j40emft8r8", - "summary": { - "contents": [ - { - "annotation": { - "tag": "DelimiterChar" - }, - "segment": "[" - }, - { - "annotation": { - "contents": "#aql7qk3iud6vs4cvu43aimopoosgk0fnipibdkc3so13adencmibgfn0u5c01r0adei55nkl3ttsjhl8gbj7tr4gnpj63g64ftbq6s0", - "tag": "TypeReference" - }, - "segment": "Result" - }, - { - "annotation": { - "tag": "DelimiterChar" - }, - "segment": "]" - } - ], - "tag": "UserObject" - }, - "tag": "Test" -} --- function -GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@6ee6j48hk3eovokflkgbmpbfr3oqj4hedqn8ocg3i4i0ko8j7nls7njjirmnh4k2bg8h95seaot798uuloqk62u2ttiqoceulkbmq2o/summary?name=func -{ - "displayName": "func", - "hash": "#6ee6j48hk3eovokflkgbmpbfr3oqj4hedqn8ocg3i4i0ko8j7nls7njjirmnh4k2bg8h95seaot798uuloqk62u2ttiqoceulkbmq2o", - "summary": { - "contents": [ - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - } - ], - "tag": "UserObject" - }, - "tag": "Plain" -} --- constructor -GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0@d0/summary?name=Thing.This -{ - "displayName": "Thing.This", - "hash": "#altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0#0", - "summary": { - "contents": [ - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "#altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0", - "tag": "TypeReference" - }, - "segment": "Thing" - } - ], - "tag": "UserObject" - }, - "tag": "DataConstructor" -} --- Long type signature -GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?name=funcWithLongType -{ - "displayName": "funcWithLongType", - "hash": "#ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8", - "summary": { - "contents": [ - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - } - ], - "tag": "UserObject" - }, - "tag": "Plain" -} --- Long type signature with render width -GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?renderWidth=20&name=funcWithLongType -{ - "displayName": "funcWithLongType", - "hash": "#ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8", - "summary": { - "contents": [ - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - } - ], - "tag": "UserObject" - }, - "tag": "Plain" -} --- Builtin Term -GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@@IO.putBytes.impl.v3/summary?name=putBytesImpl -{ - "displayName": "putBytesImpl", - "hash": "##IO.putBytes.impl.v3", - "summary": { - "contents": [ - { - "annotation": { - "contents": "##Handle", - "tag": "TypeReference" - }, - "segment": "Handle" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Bytes", - "tag": "TypeReference" - }, - "segment": "Bytes" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TypeOperator" - }, - "segment": "->" - }, - { - "annotation": { - "tag": "AbilityBraces" - }, - "segment": "{" - }, - { - "annotation": { - "contents": "##IO", - "tag": "TypeReference" - }, - "segment": "IO" - }, - { - "annotation": { - "tag": "AbilityBraces" - }, - "segment": "}" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "#0o7mf021foma9acqdaibmlh1jidlijq08uf7f5se9tssttqs546pfunjpk6s31mqoq8s2o1natede8hkk6he45l95fibglidikt44v8", - "tag": "TypeReference" - }, - "segment": "Either" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "#r29dja8j9dmjjp45trccchaata8eo1h6d6haar1eai74pq1jt4m7u3ldhlq79f7phfo57eq4bau39vqotl2h63k7ff1m5sj5o9ajuf8", - "tag": "TypeReference" - }, - "segment": "Failure" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": null, - "segment": "(" - }, - { - "annotation": null, - "segment": ")" - } - ], - "tag": "BuiltinObject" - }, - "tag": "Plain" -} -``` - -## Type Summary APIs - -``` api --- data -GET /api/projects/scratch/branches/main/definitions/types/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0/summary?name=Thing -{ - "displayName": "Thing", - "hash": "#altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0", - "summary": { - "contents": [ - { - "annotation": { - "tag": "DataTypeModifier" - }, - "segment": "structural" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "DataTypeKeyword" - }, - "segment": "type" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "Thing", - "tag": "HashQualifier" - }, - "segment": "Thing" - } - ], - "tag": "UserObject" - }, - "tag": "Data" -} --- data with type args -GET /api/projects/scratch/branches/main/definitions/types/by-hash/@nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg/summary?name=Maybe -{ - "displayName": "Maybe", - "hash": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", - "summary": { - "contents": [ - { - "annotation": { - "tag": "DataTypeModifier" - }, - "segment": "structural" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "DataTypeKeyword" - }, - "segment": "type" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "Maybe", - "tag": "HashQualifier" - }, - "segment": "Maybe" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "DataTypeParams" - }, - "segment": "a" - } - ], - "tag": "UserObject" - }, - "tag": "Data" -} --- ability -GET /api/projects/scratch/branches/main/definitions/types/by-hash/@rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8/summary?name=Stream -{ - "displayName": "Stream", - "hash": "#rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8", - "summary": { - "contents": [ - { - "annotation": { - "tag": "DataTypeModifier" - }, - "segment": "structural" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "DataTypeKeyword" - }, - "segment": "ability" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "Stream", - "tag": "HashQualifier" - }, - "segment": "Stream" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "DataTypeParams" - }, - "segment": "s" - } - ], - "tag": "UserObject" - }, - "tag": "Ability" -} --- builtin type -GET /api/projects/scratch/branches/main/definitions/types/by-hash/@@Nat/summary?name=Nat -{ - "displayName": "Nat", - "hash": "##Nat", - "summary": { - "contents": [ - { - "annotation": null, - "segment": "Nat" - } - ], - "tag": "BuiltinObject" - }, - "tag": "Data" -} -``` - diff --git a/unison-src/transcripts/block-on-required-update.md b/unison-src/transcripts/block-on-required-update.md deleted file mode 100644 index 3b339e6fe7..0000000000 --- a/unison-src/transcripts/block-on-required-update.md +++ /dev/null @@ -1,28 +0,0 @@ -# Block on required update - -Should block an `add` if it requires an update on an in-file dependency. - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -x = 1 -``` - -```ucm -scratch/main> add -``` - -Update `x`, and add a new `y` which depends on the update - -```unison -x = 10 -y = x + 1 -``` - -Try to add only the new `y`. This should fail because it requires an update to `x`, but we only ran an 'add'. - -```ucm:error -scratch/main> add y -``` diff --git a/unison-src/transcripts/block-on-required-update.output.md b/unison-src/transcripts/block-on-required-update.output.md deleted file mode 100644 index 20560c94c4..0000000000 --- a/unison-src/transcripts/block-on-required-update.output.md +++ /dev/null @@ -1,68 +0,0 @@ -# Block on required update - -Should block an `add` if it requires an update on an in-file dependency. - -``` unison -x = 1 -``` - -``` 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`: - - x : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - x : Nat - -``` -Update `x`, and add a new `y` which depends on the update - -``` unison -x = 10 -y = x + 1 -``` - -``` 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`: - - y : Nat - - ⍟ These names already exist. You can `update` them to your - new definition: - - x : Nat - -``` -Try to add only the new `y`. This should fail because it requires an update to `x`, but we only ran an 'add'. - -``` ucm -scratch/main> add y - - x These definitions failed: - - Reason - needs update x : Nat - blocked y : Nat - - Tip: Use `help filestatus` to learn more. - -``` diff --git a/unison-src/transcripts/blocks.md b/unison-src/transcripts/blocks.md deleted file mode 100644 index b89ab45850..0000000000 --- a/unison-src/transcripts/blocks.md +++ /dev/null @@ -1,177 +0,0 @@ -## Blocks and scoping - -```ucm:hide -scratch/main> builtins.merge -``` - -### Names introduced by a block shadow names introduced in outer scopes - -For example: - -```unison -ex thing = - thing y = y - -- refers to `thing` in this block - -- not the argument to `ex` - bar x = thing x + 1 - bar 42 - -> ex "hello" -``` - -### Whether a block shadows outer names doesn't depend on the order of bindings in the block - -The `thing` reference in `bar` refers to the one declared locally in the block that `bar` is part of. This is true even if the declaration which shadows the outer name appears later in the block, for instance: - -```unison -ex thing = - bar x = thing x + 1 - thing y = y - bar 42 - -> ex "hello" -``` - -### Blocks use lexical scoping and can only reference definitions in parent scopes or in the same block - -This is just the normal lexical scoping behavior. For example: - -```unison -ex thing = - bar x = thing x + 1 -- references outer `thing` - baz z = - thing y = y -- shadows the outer `thing` - thing z -- references the inner `thing` - bar 42 - -> ex (x -> x * 100) -``` - -Here's another example, showing that bindings cannot reference bindings declared in blocks nested in the _body_ (the final expression) of a block: - -```unison -ex thing = - bar x = thing x + 1 -- refers to outer thing - let - thing y = y - bar 42 - -> ex (x -> x * 100) -``` - -### Blocks can define one or more functions which are recursive or mutually recursive - -We call these groups of definitions that reference each other in a block _cycles_. For instance: - -```unison -sumTo n = - -- A recursive function, defined inside a block - go acc n = - if n == 0 then acc - else go (acc + n) (drop n 1) - go 0 n - -ex n = - -- Two mutually recursive functions, defined in a block - ping x = pong (x + 1) - pong x = ping (x + 2) - ping 42 -``` - -The `go` function is a one-element cycle (it reference itself), and `ping` and `pong` form a two-element cycle. - -### Cyclic references or forward reference must be guarded - -For instance, this works: - -```unison -ex n = - ping x = pong + 1 + x - pong = 42 - ping 0 -``` - -Since the forward reference to `pong` appears inside `ping`. - -This, however, will not compile: - -```unison:error -ex n = - pong = ping + 1 - ping = 42 - pong -``` - -This also won't compile; it's a cyclic reference that isn't guarded: - -```unison:error -ex n = - loop = loop - loop -``` - -This, however, will compile. This also shows that `'expr` is another way of guarding a definition. - -```unison -ex n = - loop = '(!loop) - !loop -``` - -Just don't try to run it as it's an infinite loop! - -### Cyclic definitions in a block don't have access to any abilities - -The reason is it's unclear what the order should be of any requests that are made. It can also be viewed of a special case of the restriction that elements of a cycle must all be guarded. Here's an example: - -```unison:error -structural ability SpaceAttack where - launchMissiles : Text -> Nat - -ex n = - zap1 = launchMissiles "neptune" + zap2 - zap2 = launchMissiles "pluto" + zap1 - zap1 -``` - -### The _body_ of recursive functions can certainly access abilities - -For instance, this works fine: - -```unison -structural ability SpaceAttack where - launchMissiles : Text -> Nat - -ex n = - zap1 planet = launchMissiles planet + zap2 planet - zap2 planet = launchMissiles planet + zap1 planet - zap1 "pluto" -``` - -### Unrelated definitions not part of a cycle and are moved after the cycle - -For instance, `zap` here isn't considered part of the cycle (it doesn't reference `ping` or `pong`), so this typechecks fine: - -```unison -structural ability SpaceAttack where - launchMissiles : Text -> Nat - -ex n = - ping x = pong (x + 1) - zap = launchMissiles "neptune" - pong x = ping (x + 2) - ping 42 -``` - -This is actually parsed as if you moved `zap` after the cycle it find itself a part of: - -```unison -structural ability SpaceAttack where - launchMissiles : Text -> Nat - -ex n = - ping x = pong (x + 1) - pong x = ping (x + 2) - zap = launchMissiles "neptune" - ping 42 -``` diff --git a/unison-src/transcripts/blocks.output.md b/unison-src/transcripts/blocks.output.md deleted file mode 100644 index f52ca4f259..0000000000 --- a/unison-src/transcripts/blocks.output.md +++ /dev/null @@ -1,365 +0,0 @@ -## Blocks and scoping - -### Names introduced by a block shadow names introduced in outer scopes - -For example: - -``` unison -ex thing = - thing y = y - -- refers to `thing` in this block - -- not the argument to `ex` - bar x = thing x + 1 - bar 42 - -> ex "hello" -``` - -``` 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`: - - ex : thing -> Nat - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 8 | > ex "hello" - ⧩ - 43 - -``` -### Whether a block shadows outer names doesn't depend on the order of bindings in the block - -The `thing` reference in `bar` refers to the one declared locally in the block that `bar` is part of. This is true even if the declaration which shadows the outer name appears later in the block, for instance: - -``` unison -ex thing = - bar x = thing x + 1 - thing y = y - bar 42 - -> ex "hello" -``` - -``` 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`: - - ex : thing -> Nat - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 6 | > ex "hello" - ⧩ - 43 - -``` -### Blocks use lexical scoping and can only reference definitions in parent scopes or in the same block - -This is just the normal lexical scoping behavior. For example: - -``` unison -ex thing = - bar x = thing x + 1 -- references outer `thing` - baz z = - thing y = y -- shadows the outer `thing` - thing z -- references the inner `thing` - bar 42 - -> ex (x -> x * 100) -``` - -``` 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`: - - ex : (Nat ->{g} Nat) ->{g} Nat - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 8 | > ex (x -> x * 100) - ⧩ - 4201 - -``` -Here's another example, showing that bindings cannot reference bindings declared in blocks nested in the *body* (the final expression) of a block: - -``` unison -ex thing = - bar x = thing x + 1 -- refers to outer thing - let - thing y = y - bar 42 - -> ex (x -> x * 100) -``` - -``` 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`: - - ex : (Nat ->{g} Nat) ->{g} Nat - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 7 | > ex (x -> x * 100) - ⧩ - 4201 - -``` -### Blocks can define one or more functions which are recursive or mutually recursive - -We call these groups of definitions that reference each other in a block *cycles*. For instance: - -``` unison -sumTo n = - -- A recursive function, defined inside a block - go acc n = - if n == 0 then acc - else go (acc + n) (drop n 1) - go 0 n - -ex n = - -- Two mutually recursive functions, defined in a block - ping x = pong (x + 1) - pong x = ping (x + 2) - ping 42 -``` - -``` 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`: - - ex : n -> r - sumTo : Nat -> Nat - -``` -The `go` function is a one-element cycle (it reference itself), and `ping` and `pong` form a two-element cycle. - -### Cyclic references or forward reference must be guarded - -For instance, this works: - -``` unison -ex n = - ping x = pong + 1 + x - pong = 42 - ping 0 -``` - -``` 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`: - - ex : n -> Nat - -``` -Since the forward reference to `pong` appears inside `ping`. - -This, however, will not compile: - -``` unison -ex n = - pong = ping + 1 - ping = 42 - pong -``` - -``` ucm - - Loading changes detected in scratch.u. - - These definitions depend on each other cyclically but aren't guarded by a lambda: pong8 - 2 | pong = ping + 1 - 3 | ping = 42 - - -``` -This also won't compile; it's a cyclic reference that isn't guarded: - -``` unison -ex n = - loop = loop - loop -``` - -``` ucm - - Loading changes detected in scratch.u. - - These definitions depend on each other cyclically but aren't guarded by a lambda: loop8 - 2 | loop = loop - - -``` -This, however, will compile. This also shows that `'expr` is another way of guarding a definition. - -``` unison -ex n = - loop = '(!loop) - !loop -``` - -``` 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`: - - ex : n -> r - -``` -Just don't try to run it as it's an infinite loop\! - -### Cyclic definitions in a block don't have access to any abilities - -The reason is it's unclear what the order should be of any requests that are made. It can also be viewed of a special case of the restriction that elements of a cycle must all be guarded. Here's an example: - -``` unison -structural ability SpaceAttack where - launchMissiles : Text -> Nat - -ex n = - zap1 = launchMissiles "neptune" + zap2 - zap2 = launchMissiles "pluto" + zap1 - zap1 -``` - -``` ucm - - Loading changes detected in scratch.u. - - The expression in red needs the {SpaceAttack} ability, but this location does not have access to any abilities. - - 5 | zap1 = launchMissiles "neptune" + zap2 - - -``` -### The *body* of recursive functions can certainly access abilities - -For instance, this works fine: - -``` unison -structural ability SpaceAttack where - launchMissiles : Text -> Nat - -ex n = - zap1 planet = launchMissiles planet + zap2 planet - zap2 planet = launchMissiles planet + zap1 planet - zap1 "pluto" -``` - -``` 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`: - - structural ability SpaceAttack - ex : n ->{SpaceAttack} Nat - -``` -### Unrelated definitions not part of a cycle and are moved after the cycle - -For instance, `zap` here isn't considered part of the cycle (it doesn't reference `ping` or `pong`), so this typechecks fine: - -``` unison -structural ability SpaceAttack where - launchMissiles : Text -> Nat - -ex n = - ping x = pong (x + 1) - zap = launchMissiles "neptune" - pong x = ping (x + 2) - ping 42 -``` - -``` 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`: - - structural ability SpaceAttack - ex : n ->{SpaceAttack} r - -``` -This is actually parsed as if you moved `zap` after the cycle it find itself a part of: - -``` unison -structural ability SpaceAttack where - launchMissiles : Text -> Nat - -ex n = - ping x = pong (x + 1) - pong x = ping (x + 2) - zap = launchMissiles "neptune" - ping 42 -``` - -``` 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`: - - structural ability SpaceAttack - ex : n ->{SpaceAttack} r - -``` diff --git a/unison-src/transcripts/boolean-op-pretty-print-2819.md b/unison-src/transcripts/boolean-op-pretty-print-2819.md deleted file mode 100644 index b788c78334..0000000000 --- a/unison-src/transcripts/boolean-op-pretty-print-2819.md +++ /dev/null @@ -1,18 +0,0 @@ -Regression test for https://github.com/unisonweb/unison/pull/2819 - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -hangExample : Boolean -hangExample = - ("a long piece of text to hang the line" == "") - && ("a long piece of text to hang the line" == "") -``` - -```ucm -scratch/main> add -scratch/main> view hangExample -``` - diff --git a/unison-src/transcripts/boolean-op-pretty-print-2819.output.md b/unison-src/transcripts/boolean-op-pretty-print-2819.output.md deleted file mode 100644 index b840f4bbc0..0000000000 --- a/unison-src/transcripts/boolean-op-pretty-print-2819.output.md +++ /dev/null @@ -1,37 +0,0 @@ -Regression test for https://github.com/unisonweb/unison/pull/2819 - -``` unison -hangExample : Boolean -hangExample = - ("a long piece of text to hang the line" == "") - && ("a long piece of text to hang the line" == "") -``` - -``` 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`: - - hangExample : Boolean - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - hangExample : Boolean - -scratch/main> view hangExample - - hangExample : Boolean - hangExample = - ("a long piece of text to hang the line" == "") - && ("a long piece of text to hang the line" == "") - -``` diff --git a/unison-src/transcripts/branch-command.md b/unison-src/transcripts/branch-command.md deleted file mode 100644 index d48e3c259a..0000000000 --- a/unison-src/transcripts/branch-command.md +++ /dev/null @@ -1,61 +0,0 @@ -The `branch` command creates a new branch. - -```ucm:hide -scratch/main> project.create-empty foo -scratch/main> project.create-empty bar -``` - -First, we'll create a term to include in the branches. - -```unison:hide -someterm = 18 -``` - -```ucm -scratch/main> builtins.merge lib.builtins -scratch/main> add -``` - -Now, the `branch` demo: - -`branch` can create a branch from a different branch in the same project, from a different branch in a different -project. It can also create an empty branch. - -```ucm -foo/main> branch topic1 -foo/main> branch /topic2 -foo/main> branch foo/topic3 -foo/main> branch main topic4 -foo/main> branch main /topic5 -foo/main> branch main foo/topic6 -foo/main> branch /main topic7 -foo/main> branch /main /topic8 -foo/main> branch /main foo/topic9 -foo/main> branch foo/main topic10 -foo/main> branch foo/main /topic11 -scratch/main> branch foo/main foo/topic12 - -foo/main> branch bar/topic -bar/main> branch foo/main topic2 -bar/main> branch foo/main /topic3 -scratch/main> branch foo/main bar/topic4 - -foo/main> branch.empty empty1 -foo/main> branch.empty /empty2 -foo/main> branch.empty foo/empty3 -scratch/main> branch.empty foo/empty4 -``` - -The `branch` command can create branches named `releases/drafts/*` (because why not). - -```ucm -foo/main> branch releases/drafts/1.2.3 -foo/main> switch /releases/drafts/1.2.3 -``` - -The `branch` command can't create branches named `releases/*` nor `releases/drafts/*`. - -```ucm:error -foo/main> branch releases/1.2.3 -foo/main> switch /releases/1.2.3 -``` diff --git a/unison-src/transcripts/branch-command.output.md b/unison-src/transcripts/branch-command.output.md deleted file mode 100644 index 6a78b8e723..0000000000 --- a/unison-src/transcripts/branch-command.output.md +++ /dev/null @@ -1,182 +0,0 @@ -The `branch` command creates a new branch. - -First, we'll create a term to include in the branches. - -``` unison -someterm = 18 -``` - -``` ucm -scratch/main> builtins.merge lib.builtins - - Done. - -scratch/main> add - - ⍟ I've added these definitions: - - someterm : Nat - -``` -Now, the `branch` demo: - -`branch` can create a branch from a different branch in the same project, from a different branch in a different -project. It can also create an empty branch. - -``` ucm -foo/main> branch topic1 - - Done. I've created the topic1 branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic1`. - -foo/main> branch /topic2 - - Done. I've created the topic2 branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic2`. - -foo/main> branch foo/topic3 - - Done. I've created the topic3 branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic3`. - -foo/main> branch main topic4 - - Done. I've created the topic4 branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic4`. - -foo/main> branch main /topic5 - - Done. I've created the topic5 branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic5`. - -foo/main> branch main foo/topic6 - - Done. I've created the topic6 branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic6`. - -foo/main> branch /main topic7 - - Done. I've created the topic7 branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic7`. - -foo/main> branch /main /topic8 - - Done. I've created the topic8 branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic8`. - -foo/main> branch /main foo/topic9 - - Done. I've created the topic9 branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic9`. - -foo/main> branch foo/main topic10 - - Done. I've created the topic10 branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic10`. - -foo/main> branch foo/main /topic11 - - Done. I've created the topic11 branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic11`. - -scratch/main> branch foo/main foo/topic12 - - Done. I've created the topic12 branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic12`. - -foo/main> branch bar/topic - - Done. I've created the bar/topic branch based off foo/main. - -bar/main> branch foo/main topic2 - - Done. I've created the bar/topic2 branch based off foo/main. - -bar/main> branch foo/main /topic3 - - Done. I've created the bar/topic3 branch based off foo/main. - -scratch/main> branch foo/main bar/topic4 - - Done. I've created the bar/topic4 branch based off foo/main. - -foo/main> branch.empty empty1 - - Done. I've created an empty branch foo/empty1. - - Tip: Use `merge /somebranch` to initialize this branch. - -foo/main> branch.empty /empty2 - - Done. I've created an empty branch foo/empty2. - - Tip: Use `merge /somebranch` to initialize this branch. - -foo/main> branch.empty foo/empty3 - - Done. I've created an empty branch foo/empty3. - - Tip: Use `merge /somebranch` to initialize this branch. - -scratch/main> branch.empty foo/empty4 - - Done. I've created an empty branch foo/empty4. - - Tip: Use `merge /somebranch` to initialize this branch. - -``` -The `branch` command can create branches named `releases/drafts/*` (because why not). - -``` ucm -foo/main> branch releases/drafts/1.2.3 - - Done. I've created the releases/drafts/1.2.3 branch based off - of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /releases/drafts/1.2.3`. - -foo/main> switch /releases/drafts/1.2.3 - -``` -The `branch` command can't create branches named `releases/*` nor `releases/drafts/*`. - -``` ucm -foo/main> branch releases/1.2.3 - - Branch names like releases/1.2.3 are reserved for releases. - - Tip: to download an existing release, try - `clone /releases/1.2.3`. - - Tip: to draft a new release, try `release.draft 1.2.3`. - -foo/main> switch /releases/1.2.3 - - foo/releases/1.2.3 does not exist. - -``` diff --git a/unison-src/transcripts/branch-relative-path.md b/unison-src/transcripts/branch-relative-path.md deleted file mode 100644 index 77de247037..0000000000 --- a/unison-src/transcripts/branch-relative-path.md +++ /dev/null @@ -1,25 +0,0 @@ -```unison -foo = 5 -foo.bar = 1 -``` - -```ucm -p0/main> add -``` - -```unison -bonk = 5 -donk.bonk = 1 -``` - -```ucm -p1/main> add -p1/main> fork p0/main: zzz -p1/main> find zzz -p1/main> fork p0/main:foo yyy -p1/main> find yyy -p0/main> fork p1/main: p0/main:p1 -p0/main> ls p1 -p0/main> ls p1.zzz -p0/main> ls p1.yyy -``` diff --git a/unison-src/transcripts/branch-relative-path.output.md b/unison-src/transcripts/branch-relative-path.output.md deleted file mode 100644 index e9e33b5ad9..0000000000 --- a/unison-src/transcripts/branch-relative-path.output.md +++ /dev/null @@ -1,97 +0,0 @@ -``` unison -foo = 5 -foo.bar = 1 -``` - -``` 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 - foo.bar : ##Nat - -``` -``` ucm -p0/main> add - - ⍟ I've added these definitions: - - foo : ##Nat - foo.bar : ##Nat - -``` -``` unison -bonk = 5 -donk.bonk = 1 -``` - -``` 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`: - - bonk : ##Nat - (also named foo) - donk.bonk : ##Nat - (also named foo.bar) - -``` -``` ucm -p1/main> add - - ⍟ I've added these definitions: - - bonk : ##Nat - donk.bonk : ##Nat - -p1/main> fork p0/main: zzz - - Done. - -p1/main> find zzz - - 1. zzz.foo : ##Nat - 2. zzz.foo.bar : ##Nat - - -p1/main> fork p0/main:foo yyy - - Done. - -p1/main> find yyy - - 1. yyy.bar : ##Nat - - -p0/main> fork p1/main: p0/main:p1 - - Done. - -p0/main> ls p1 - - 1. bonk (##Nat) - 2. donk/ (1 term) - 3. yyy/ (1 term) - 4. zzz/ (2 terms) - -p0/main> ls p1.zzz - - 1. foo (##Nat) - 2. foo/ (1 term) - -p0/main> ls p1.yyy - - 1. bar (##Nat) - -``` diff --git a/unison-src/transcripts/bug-fix-4354.md b/unison-src/transcripts/bug-fix-4354.md deleted file mode 100644 index 1ea7f595dd..0000000000 --- a/unison-src/transcripts/bug-fix-4354.md +++ /dev/null @@ -1,13 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -bonk : forall a. a -> a -bonk x = - zonk : forall a. a -> a - zonk z = z - honk : a - honk = x - x -``` diff --git a/unison-src/transcripts/bug-fix-4354.output.md b/unison-src/transcripts/bug-fix-4354.output.md deleted file mode 100644 index 110aca0022..0000000000 --- a/unison-src/transcripts/bug-fix-4354.output.md +++ /dev/null @@ -1,23 +0,0 @@ -``` unison -bonk : forall a. a -> a -bonk x = - zonk : forall a. a -> a - zonk z = z - honk : a - honk = x - x -``` - -``` 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`: - - bonk : a -> a - -``` diff --git a/unison-src/transcripts/bug-strange-closure.md b/unison-src/transcripts/bug-strange-closure.md deleted file mode 100644 index 75c4064db3..0000000000 --- a/unison-src/transcripts/bug-strange-closure.md +++ /dev/null @@ -1,34 +0,0 @@ - -```ucm:hide -scratch/main> builtins.mergeio lib.builtins -scratch/main> load unison-src/transcripts-using-base/doc.md.files/syntax.u -``` - -We can display the guide before and after adding it to the codebase: - -```ucm -scratch/main> display doc.guide -scratch/main> add -scratch/main> display doc.guide -``` - -But we can't display this due to a decompilation problem. - -```unison -rendered = Pretty.get (docFormatConsole doc.guide) -``` - -```ucm -scratch/main> display rendered -scratch/main> add -scratch/main> display rendered -scratch/main> undo -``` - -And then this sometimes generates a GHC crash "strange closure error" but doesn't seem deterministic. - -```unison -rendered = Pretty.get (docFormatConsole doc.guide) - -> rendered -``` diff --git a/unison-src/transcripts/bug-strange-closure.output.md b/unison-src/transcripts/bug-strange-closure.output.md deleted file mode 100644 index bad237d05f..0000000000 --- a/unison-src/transcripts/bug-strange-closure.output.md +++ /dev/null @@ -1,4523 +0,0 @@ -We can display the guide before and after adding it to the codebase: - -``` ucm -scratch/main> display doc.guide - - # Unison computable documentation - - # Basic formatting - - Paragraphs are separated by one or more blanklines. - Sections have a title and 0 or more paragraphs or other - section elements. - - Text can be bold, *italicized*, ~~strikethrough~~, or - `monospaced` (or `monospaced`). - - You can link to Unison terms, types, and external URLs: - - * An external url - * Some is a term link; Optional is a type link - * A named type link and a named term link. Term links are - handy for linking to other documents! - - You can use `{{ .. }}` to escape out to regular Unison - syntax, for instance __not bold__. This is useful for - creating documents programmatically or just including - other documents. - - *Next up:* lists - - # Lists - - # Bulleted lists - - Bulleted lists can use `+`, `-`, or `*` for the bullets - (though the choice will be normalized away by the - pretty-printer). They can be nested, to any depth: - - * A - * B - * C - * C1 - * C2 - - # Numbered lists - - 1. A - 2. B - 3. C - - The first number of the list determines the starting - number in the rendered output. The other numbers are - ignored: - - 10. A - 11. B - 12. C - - Numbered lists can be nested as well, and combined with - bulleted lists: - - 1. Wake up. - * What am I doing here? - * In this nested list. - 2. Take shower. - 3. Get dressed. - - # Evaluation - - Expressions can be evaluated inline, for instance `2`. - - Blocks of code can be evaluated as well, for instance: - - id x = x - id (sqr 10) - ⧨ - 100 - - also: - - match 1 with - 1 -> "hi" - _ -> "goodbye" - ⧨ - "hi" - - To include a typechecked snippet of code without - evaluating it, you can do: - - use Nat * - cube : Nat -> Nat - cube x = x * x * x - - # Including Unison source code - - Unison definitions can be included in docs. For instance: - - structural type Optional a = Some a | None - - sqr : Nat -> Nat - sqr x = - use Nat * - x * x - - Some rendering targets also support folded source: - - structural type Optional a = Some a | None - - sqr : Nat -> Nat - sqr x = - use Nat * - x * x - - You can also include just a signature, inline, with - `sqr : Nat -> Nat`, or you can include one or more - signatures as a block: - - sqr : Nat -> Nat - - Nat.+ : Nat -> Nat -> Nat - - Or alternately: - - List.map : (a ->{e} b) -> [a] ->{e} [b] - - # Inline snippets - - You can include typechecked code snippets inline, for - instance: - - * `f x Nat.+ sqr 1` - the `2` says to ignore the first - two arguments when rendering. In richer renderers, the - `sqr` link will be clickable. - * If your snippet expression is just a single function - application, you can put it in double backticks, like - so: `sqr x`. This is equivalent to `sqr x`. - - # Non-Unison code blocks - - Use three or more single quotes to start a block with no - syntax highlighting: - - ``` raw - _____ _ - | | |___|_|___ ___ ___ - | | | | |_ -| . | | - |_____|_|_|_|___|___|_|_| - - ``` - - You can use three or more backticks plus a language name - for blocks with syntax highlighting: - - ``` Haskell - -- A fenced code block which isn't parsed by Unison - reverse = foldl (flip (:)) [] - ``` - - ``` Scala - // A fenced code block which isn't parsed by Unison - def reverse[A](xs: List[A]) = - xs.foldLeft(Nil : List[A])((acc,a) => a +: acc) - ``` - - There are also asides, callouts, tables, tooltips, and more. - These don't currently have special syntax; just use the - `{{ }}` syntax to call these functions directly. - - docAside : Doc2 -> Doc2 - - docCallout : Optional Doc2 -> Doc2 -> Doc2 - - docBlockquote : Doc2 -> Doc2 - - docTooltip : Doc2 -> Doc2 -> Doc2 - - docTable : [[Doc2]] -> Doc2 - - This is an aside. ( - Some extra detail that doesn't belong in main text. ) - - | This is an important callout, with no icon. - - | 🌻 - | - | This is an important callout, with an icon. The text - | wraps onto multiple lines. - - > "And what is the use of a book," thought Alice, "without - > pictures or conversation?" - > - > *Lewis Carroll, Alice's Adventures in Wonderland* - - Hover over me - - a b A longer paragraph that will split - onto multiple lines, such that this - row occupies multiple lines in the - rendered table. - Some text More text Zounds! - -scratch/main> add - - ⍟ I've added these definitions: - - basicFormatting : Doc2 - doc.guide : Doc2 - evaluation : Doc2 - includingSource : Doc2 - lists : Doc2 - nonUnisonCodeBlocks : Doc2 - otherElements : Doc2 - sqr : Nat -> Nat - -scratch/main> display doc.guide - - # Unison computable documentation - - # Basic formatting - - Paragraphs are separated by one or more blanklines. - Sections have a title and 0 or more paragraphs or other - section elements. - - Text can be bold, *italicized*, ~~strikethrough~~, or - `monospaced` (or `monospaced`). - - You can link to Unison terms, types, and external URLs: - - * An external url - * Some is a term link; Optional is a type link - * A named type link and a named term link. Term links are - handy for linking to other documents! - - You can use `{{ .. }}` to escape out to regular Unison - syntax, for instance __not bold__. This is useful for - creating documents programmatically or just including - other documents. - - *Next up:* lists - - # Lists - - # Bulleted lists - - Bulleted lists can use `+`, `-`, or `*` for the bullets - (though the choice will be normalized away by the - pretty-printer). They can be nested, to any depth: - - * A - * B - * C - * C1 - * C2 - - # Numbered lists - - 1. A - 2. B - 3. C - - The first number of the list determines the starting - number in the rendered output. The other numbers are - ignored: - - 10. A - 11. B - 12. C - - Numbered lists can be nested as well, and combined with - bulleted lists: - - 1. Wake up. - * What am I doing here? - * In this nested list. - 2. Take shower. - 3. Get dressed. - - # Evaluation - - Expressions can be evaluated inline, for instance `2`. - - Blocks of code can be evaluated as well, for instance: - - id x = x - id (sqr 10) - ⧨ - 100 - - also: - - match 1 with - 1 -> "hi" - _ -> "goodbye" - ⧨ - "hi" - - To include a typechecked snippet of code without - evaluating it, you can do: - - use Nat * - cube : Nat -> Nat - cube x = x * x * x - - # Including Unison source code - - Unison definitions can be included in docs. For instance: - - structural type Optional a = Some a | None - - sqr : Nat -> Nat - sqr x = - use Nat * - x * x - - Some rendering targets also support folded source: - - structural type Optional a = Some a | None - - sqr : Nat -> Nat - sqr x = - use Nat * - x * x - - You can also include just a signature, inline, with - `sqr : Nat -> Nat`, or you can include one or more - signatures as a block: - - sqr : Nat -> Nat - - Nat.+ : Nat -> Nat -> Nat - - Or alternately: - - List.map : (a ->{e} b) -> [a] ->{e} [b] - - # Inline snippets - - You can include typechecked code snippets inline, for - instance: - - * `f x Nat.+ sqr 1` - the `2` says to ignore the first - two arguments when rendering. In richer renderers, the - `sqr` link will be clickable. - * If your snippet expression is just a single function - application, you can put it in double backticks, like - so: `sqr x`. This is equivalent to `sqr x`. - - # Non-Unison code blocks - - Use three or more single quotes to start a block with no - syntax highlighting: - - ``` raw - _____ _ - | | |___|_|___ ___ ___ - | | | | |_ -| . | | - |_____|_|_|_|___|___|_|_| - - ``` - - You can use three or more backticks plus a language name - for blocks with syntax highlighting: - - ``` Haskell - -- A fenced code block which isn't parsed by Unison - reverse = foldl (flip (:)) [] - ``` - - ``` Scala - // A fenced code block which isn't parsed by Unison - def reverse[A](xs: List[A]) = - xs.foldLeft(Nil : List[A])((acc,a) => a +: acc) - ``` - - There are also asides, callouts, tables, tooltips, and more. - These don't currently have special syntax; just use the - `{{ }}` syntax to call these functions directly. - - docAside : Doc2 -> Doc2 - - docCallout : Optional Doc2 -> Doc2 -> Doc2 - - docBlockquote : Doc2 -> Doc2 - - docTooltip : Doc2 -> Doc2 -> Doc2 - - docTable : [[Doc2]] -> Doc2 - - This is an aside. ( - Some extra detail that doesn't belong in main text. ) - - | This is an important callout, with no icon. - - | 🌻 - | - | This is an important callout, with an icon. The text - | wraps onto multiple lines. - - > "And what is the use of a book," thought Alice, "without - > pictures or conversation?" - > - > *Lewis Carroll, Alice's Adventures in Wonderland* - - Hover over me - - a b A longer paragraph that will split - onto multiple lines, such that this - row occupies multiple lines in the - rendered table. - Some text More text Zounds! - -``` -But we can't display this due to a decompilation problem. - -``` unison -rendered = Pretty.get (docFormatConsole doc.guide) -``` - -``` 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`: - - rendered : Annotated () (Either SpecialForm ConsoleText) - -``` -``` ucm -scratch/main> display rendered - - # Unison computable documentation - - # Basic formatting - - Paragraphs are separated by one or more blanklines. - Sections have a title and 0 or more paragraphs or other - section elements. - - Text can be bold, *italicized*, ~~strikethrough~~, or - `monospaced` (or `monospaced`). - - You can link to Unison terms, types, and external URLs: - - * An external url - * Some is a term link; Optional is a type link - * A named type link and a named term link. Term links are - handy for linking to other documents! - - You can use `{{ .. }}` to escape out to regular Unison - syntax, for instance __not bold__. This is useful for - creating documents programmatically or just including - other documents. - - *Next up:* lists - - # Lists - - # Bulleted lists - - Bulleted lists can use `+`, `-`, or `*` for the bullets - (though the choice will be normalized away by the - pretty-printer). They can be nested, to any depth: - - * A - * B - * C - * C1 - * C2 - - # Numbered lists - - 1. A - 2. B - 3. C - - The first number of the list determines the starting - number in the rendered output. The other numbers are - ignored: - - 10. A - 11. B - 12. C - - Numbered lists can be nested as well, and combined with - bulleted lists: - - 1. Wake up. - * What am I doing here? - * In this nested list. - 2. Take shower. - 3. Get dressed. - - # Evaluation - - Expressions can be evaluated inline, for instance `2`. - - Blocks of code can be evaluated as well, for instance: - - id x = x - id (sqr 10) - ⧨ - 100 - - also: - - match 1 with - 1 -> "hi" - _ -> "goodbye" - ⧨ - "hi" - - To include a typechecked snippet of code without - evaluating it, you can do: - - use Nat * - cube : Nat -> Nat - cube x = x * x * x - - # Including Unison source code - - Unison definitions can be included in docs. For instance: - - structural type Optional a = Some a | None - - sqr : Nat -> Nat - sqr x = - use Nat * - x * x - - Some rendering targets also support folded source: - - structural type Optional a = Some a | None - - sqr : Nat -> Nat - sqr x = - use Nat * - x * x - - You can also include just a signature, inline, with - `sqr : Nat -> Nat`, or you can include one or more - signatures as a block: - - sqr : Nat -> Nat - - Nat.+ : Nat -> Nat -> Nat - - Or alternately: - - List.map : (a ->{e} b) -> [a] ->{e} [b] - - # Inline snippets - - You can include typechecked code snippets inline, for - instance: - - * `f x Nat.+ sqr 1` - the `2` says to ignore the first - two arguments when rendering. In richer renderers, the - `sqr` link will be clickable. - * If your snippet expression is just a single function - application, you can put it in double backticks, like - so: `sqr x`. This is equivalent to `sqr x`. - - # Non-Unison code blocks - - Use three or more single quotes to start a block with no - syntax highlighting: - - ``` raw - _____ _ - | | |___|_|___ ___ ___ - | | | | |_ -| . | | - |_____|_|_|_|___|___|_|_| - - ``` - - You can use three or more backticks plus a language name - for blocks with syntax highlighting: - - ``` Haskell - -- A fenced code block which isn't parsed by Unison - reverse = foldl (flip (:)) [] - ``` - - ``` Scala - // A fenced code block which isn't parsed by Unison - def reverse[A](xs: List[A]) = - xs.foldLeft(Nil : List[A])((acc,a) => a +: acc) - ``` - - There are also asides, callouts, tables, tooltips, and more. - These don't currently have special syntax; just use the - `{{ }}` syntax to call these functions directly. - - docAside : Doc2 -> Doc2 - - docCallout : Optional Doc2 -> Doc2 -> Doc2 - - docBlockquote : Doc2 -> Doc2 - - docTooltip : Doc2 -> Doc2 -> Doc2 - - docTable : [[Doc2]] -> Doc2 - - This is an aside. ( - Some extra detail that doesn't belong in main text. ) - - | This is an important callout, with no icon. - - | 🌻 - | - | This is an important callout, with an icon. The text - | wraps onto multiple lines. - - > "And what is the use of a book," thought Alice, "without - > pictures or conversation?" - > - > *Lewis Carroll, Alice's Adventures in Wonderland* - - Hover over me - - a b A longer paragraph that will split - onto multiple lines, such that this - row occupies multiple lines in the - rendered table. - Some text More text Zounds! - -scratch/main> add - - ⍟ I've added these definitions: - - rendered : Annotated () (Either SpecialForm ConsoleText) - -scratch/main> display rendered - - # Unison computable documentation - - # Basic formatting - - Paragraphs are separated by one or more blanklines. - Sections have a title and 0 or more paragraphs or other - section elements. - - Text can be bold, *italicized*, ~~strikethrough~~, or - `monospaced` (or `monospaced`). - - You can link to Unison terms, types, and external URLs: - - * An external url - * Some is a term link; Optional is a type link - * A named type link and a named term link. Term links are - handy for linking to other documents! - - You can use `{{ .. }}` to escape out to regular Unison - syntax, for instance __not bold__. This is useful for - creating documents programmatically or just including - other documents. - - *Next up:* lists - - # Lists - - # Bulleted lists - - Bulleted lists can use `+`, `-`, or `*` for the bullets - (though the choice will be normalized away by the - pretty-printer). They can be nested, to any depth: - - * A - * B - * C - * C1 - * C2 - - # Numbered lists - - 1. A - 2. B - 3. C - - The first number of the list determines the starting - number in the rendered output. The other numbers are - ignored: - - 10. A - 11. B - 12. C - - Numbered lists can be nested as well, and combined with - bulleted lists: - - 1. Wake up. - * What am I doing here? - * In this nested list. - 2. Take shower. - 3. Get dressed. - - # Evaluation - - Expressions can be evaluated inline, for instance `2`. - - Blocks of code can be evaluated as well, for instance: - - id x = x - id (sqr 10) - ⧨ - 100 - - also: - - match 1 with - 1 -> "hi" - _ -> "goodbye" - ⧨ - "hi" - - To include a typechecked snippet of code without - evaluating it, you can do: - - use Nat * - cube : Nat -> Nat - cube x = x * x * x - - # Including Unison source code - - Unison definitions can be included in docs. For instance: - - structural type Optional a = Some a | None - - sqr : Nat -> Nat - sqr x = - use Nat * - x * x - - Some rendering targets also support folded source: - - structural type Optional a = Some a | None - - sqr : Nat -> Nat - sqr x = - use Nat * - x * x - - You can also include just a signature, inline, with - `sqr : Nat -> Nat`, or you can include one or more - signatures as a block: - - sqr : Nat -> Nat - - Nat.+ : Nat -> Nat -> Nat - - Or alternately: - - List.map : (a ->{e} b) -> [a] ->{e} [b] - - # Inline snippets - - You can include typechecked code snippets inline, for - instance: - - * `f x Nat.+ sqr 1` - the `2` says to ignore the first - two arguments when rendering. In richer renderers, the - `sqr` link will be clickable. - * If your snippet expression is just a single function - application, you can put it in double backticks, like - so: `sqr x`. This is equivalent to `sqr x`. - - # Non-Unison code blocks - - Use three or more single quotes to start a block with no - syntax highlighting: - - ``` raw - _____ _ - | | |___|_|___ ___ ___ - | | | | |_ -| . | | - |_____|_|_|_|___|___|_|_| - - ``` - - You can use three or more backticks plus a language name - for blocks with syntax highlighting: - - ``` Haskell - -- A fenced code block which isn't parsed by Unison - reverse = foldl (flip (:)) [] - ``` - - ``` Scala - // A fenced code block which isn't parsed by Unison - def reverse[A](xs: List[A]) = - xs.foldLeft(Nil : List[A])((acc,a) => a +: acc) - ``` - - There are also asides, callouts, tables, tooltips, and more. - These don't currently have special syntax; just use the - `{{ }}` syntax to call these functions directly. - - docAside : Doc2 -> Doc2 - - docCallout : Optional Doc2 -> Doc2 -> Doc2 - - docBlockquote : Doc2 -> Doc2 - - docTooltip : Doc2 -> Doc2 -> Doc2 - - docTable : [[Doc2]] -> Doc2 - - This is an aside. ( - Some extra detail that doesn't belong in main text. ) - - | This is an important callout, with no icon. - - | 🌻 - | - | This is an important callout, with an icon. The text - | wraps onto multiple lines. - - > "And what is the use of a book," thought Alice, "without - > pictures or conversation?" - > - > *Lewis Carroll, Alice's Adventures in Wonderland* - - Hover over me - - a b A longer paragraph that will split - onto multiple lines, such that this - row occupies multiple lines in the - rendered table. - Some text More text Zounds! - -scratch/main> undo - - Here are the changes I undid - - Added definitions: - - 1. rendered : Annotated () (Either SpecialForm ConsoleText) - -``` -And then this sometimes generates a GHC crash "strange closure error" but doesn't seem deterministic. - -``` unison -rendered = Pretty.get (docFormatConsole doc.guide) - -> rendered -``` - -``` 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`: - - rendered : Annotated () (Either SpecialForm ConsoleText) - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 3 | > rendered - ⧩ - Annotated.Group - () - (Annotated.Append - () - [ Indent - () - (Lit () (Right (Plain "# "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (ConsoleText.Bold (Plain "Unison"))) - , Lit - () - (Right - (ConsoleText.Bold - (Plain "computable"))) - , Lit - () - (Right - (ConsoleText.Bold - (Plain "documentation"))) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Group - () - (Annotated.Append - () - [ Indent - () - (Lit () (Right (Plain "# "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (ConsoleText.Bold - (Plain "Basic"))) - , Lit - () - (Right - (ConsoleText.Bold - (Plain "formatting"))) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain "Paragraphs")) - , Lit - () (Right (Plain "are")) - , Lit - () - (Right - (Plain "separated")) - , Lit - () (Right (Plain "by")) - , Lit - () (Right (Plain "one")) - , Lit - () (Right (Plain "or")) - , Lit - () - (Right (Plain "more")) - , Lit - () - (Right - (Plain "blanklines.")) - , Lit - () - (Right - (Plain "Sections")) - , Lit - () - (Right (Plain "have")) - , Lit () (Right (Plain "a")) - , Lit - () - (Right (Plain "title")) - , Lit - () (Right (Plain "and")) - , Lit () (Right (Plain "0")) - , Lit - () (Right (Plain "or")) - , Lit - () - (Right (Plain "more")) - , Lit - () - (Right - (Plain "paragraphs")) - , Lit - () (Right (Plain "or")) - , Lit - () - (Right (Plain "other")) - , Lit - () - (Right (Plain "section")) - , Lit - () - (Right - (Plain "elements.")) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right (Plain "Text")) - , Lit - () (Right (Plain "can")) - , Lit - () (Right (Plain "be")) - , Annotated.Group - () - (Annotated.Append - () - [ Wrap - () - (Lit - () - (Right - (ConsoleText.Bold - (Plain - "bold")))) - , Lit - () - (Right (Plain ",")) - ]) - , Annotated.Group - () - (Annotated.Append - () - [ Annotated.Group - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain "*")) - , Wrap - () - (Lit - () - (Right - (Plain - "italicized"))) - , Lit - () - (Right - (Plain "*")) - ]) - , Lit - () - (Right (Plain ",")) - ]) - , Annotated.Group - () - (Annotated.Append - () - [ Annotated.Group - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain - "~~")) - , Wrap - () - (Lit - () - (Right - (Plain - "strikethrough"))) - , Lit - () - (Right - (Plain - "~~")) - ]) - , Lit - () - (Right (Plain ",")) - ]) - , Lit - () (Right (Plain "or")) - , Annotated.Group - () - (Annotated.Append - () - [ Lit - () - (Right (Plain "`")) - , Lit - () - (Right - (Plain - "monospaced")) - , Lit - () - (Right (Plain "`")) - ]) - , Lit - () (Right (Plain "(or")) - , Annotated.Group - () - (Annotated.Append - () - [ Annotated.Group - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain "`")) - , Lit - () - (Right - (Plain - "monospaced")) - , Lit - () - (Right - (Plain "`")) - ]) - , Lit - () - (Right - (Plain ").")) - ]) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () (Right (Plain "You")) - , Lit - () (Right (Plain "can")) - , Lit - () - (Right (Plain "link")) - , Lit - () (Right (Plain "to")) - , Lit - () - (Right (Plain "Unison")) - , Lit - () - (Right (Plain "terms,")) - , Lit - () - (Right (Plain "types,")) - , Lit - () (Right (Plain "and")) - , Lit - () - (Right - (Plain "external")) - , Lit - () - (Right (Plain "URLs:")) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Annotated.Group - () - (Annotated.Append - () - [ Indent - () - (Lit - () - (Right (Plain "* "))) - (Lit - () - (Right (Plain " "))) - (Wrap - () - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (Underline - (Plain - "An"))) - , Lit - () - (Right - (Underline - (Plain - "external"))) - , Lit - () - (Right - (Underline - (Plain - "url"))) - ]))) - , Lit - () (Right (Plain "\n")) - , Indent - () - (Lit - () - (Right (Plain "* "))) - (Lit - () - (Right (Plain " "))) - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Left - (SpecialForm.Link - (Right - (Term.Term - (Any - (do - Some)))))) - , Lit - () - (Right - (Plain "is")) - , Lit - () - (Right - (Plain "a")) - , Lit - () - (Right - (Plain "term")) - , Lit - () - (Right - (Plain "link;")) - , Lit - () - (Left - (SpecialForm.Link - (Left - (typeLink Optional)))) - , Lit - () - (Right - (Plain "is")) - , Lit - () - (Right - (Plain "a")) - , Lit - () - (Right - (Plain "type")) - , Lit - () - (Right - (Plain "link")) - ])) - , Lit - () (Right (Plain "\n")) - , Indent - () - (Lit - () - (Right (Plain "* "))) - (Lit - () - (Right (Plain " "))) - (Wrap - () - (Annotated.Append - () - [ Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (Underline - (Plain - "A"))) - , Lit - () - (Right - (Underline - (Plain - "named"))) - , Lit - () - (Right - (Underline - (Plain - "type"))) - , Lit - () - (Right - (Underline - (Plain - "link"))) - ]) - , Lit - () - (Right - (Plain "and")) - , Annotated.Group - () - (Annotated.Append - () - [ Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (Underline - (Plain - "a"))) - , Lit - () - (Right - (Underline - (Plain - "named"))) - , Lit - () - (Right - (Underline - (Plain - "term"))) - , Lit - () - (Right - (Underline - (Plain - "link"))) - ]) - , Lit - () - (Right - (Plain - ".")) - ]) - , Lit - () - (Right - (Plain "Term")) - , Lit - () - (Right - (Plain "links")) - , Lit - () - (Right - (Plain "are")) - , Lit - () - (Right - (Plain "handy")) - , Lit - () - (Right - (Plain "for")) - , Lit - () - (Right - (Plain - "linking")) - , Lit - () - (Right - (Plain "to")) - , Lit - () - (Right - (Plain "other")) - , Lit - () - (Right - (Plain - "documents!")) - ])) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () (Right (Plain "You")) - , Lit - () (Right (Plain "can")) - , Lit - () (Right (Plain "use")) - , Annotated.Group - () - (Annotated.Append - () - [ Lit - () - (Right (Plain "`")) - , Lit - () - (Right - (Plain - "{{ .. }}")) - , Lit - () - (Right (Plain "`")) - ]) - , Lit - () (Right (Plain "to")) - , Lit - () - (Right (Plain "escape")) - , Lit - () (Right (Plain "out")) - , Lit - () (Right (Plain "to")) - , Lit - () - (Right (Plain "regular")) - , Lit - () - (Right (Plain "Unison")) - , Lit - () - (Right (Plain "syntax,")) - , Lit - () (Right (Plain "for")) - , Lit - () - (Right - (Plain "instance")) - , Annotated.Group - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain - "__not bold__")) - , Lit - () - (Right (Plain ".")) - ]) - , Lit - () - (Right (Plain "This")) - , Lit - () (Right (Plain "is")) - , Lit - () - (Right (Plain "useful")) - , Lit - () (Right (Plain "for")) - , Lit - () - (Right - (Plain "creating")) - , Lit - () - (Right - (Plain "documents")) - , Lit - () - (Right - (Plain - "programmatically")) - , Lit - () (Right (Plain "or")) - , Lit - () - (Right (Plain "just")) - , Lit - () - (Right - (Plain "including")) - , Lit - () - (Right (Plain "other")) - , Lit - () - (Right - (Plain "documents.")) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Annotated.Group - () - (Annotated.Append - () - [ Lit - () - (Right (Plain "*")) - , Lit - () - (Right - (Plain "Next")) - ]) - , Annotated.Group - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain "up:")) - , Lit - () - (Right (Plain "*")) - ]) - , Lit - () - (Left - (SpecialForm.Link - (Right - (Term.Term - (Any (do lists)))))) - ]))) - ])))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Group - () - (Annotated.Append - () - [ Indent - () - (Lit () (Right (Plain "# "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Lit - () - (Right - (ConsoleText.Bold - (Plain "Lists")))))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Annotated.Group - () - (Annotated.Append - () - [ Indent - () - (Lit - () - (Right (Plain "# "))) - (Lit - () - (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (ConsoleText.Bold - (Plain - "Bulleted"))) - , Lit - () - (Right - (ConsoleText.Bold - (Plain - "lists"))) - ]))) - , Lit - () (Right (Plain "\n")) - , Lit - () (Right (Plain "\n")) - , Indent - () - (Lit - () - (Right (Plain " "))) - (Lit - () - (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain - "Bulleted")) - , Lit - () - (Right - (Plain - "lists")) - , Lit - () - (Right - (Plain "can")) - , Lit - () - (Right - (Plain "use")) - , Annotated.Group - () - (Annotated.Append - () - [ Annotated.Group - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain - "`")) - , Lit - () - (Right - (Plain - "+")) - , Lit - () - (Right - (Plain - "`")) - ]) - , Lit - () - (Right - (Plain - ",")) - ]) - , Annotated.Group - () - (Annotated.Append - () - [ Annotated.Group - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain - "`")) - , Lit - () - (Right - (Plain - "-")) - , Lit - () - (Right - (Plain - "`")) - ]) - , Lit - () - (Right - (Plain - ",")) - ]) - , Lit - () - (Right - (Plain "or")) - , Annotated.Group - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain - "`")) - , Lit - () - (Right - (Plain - "*")) - , Lit - () - (Right - (Plain - "`")) - ]) - , Lit - () - (Right - (Plain "for")) - , Lit - () - (Right - (Plain "the")) - , Lit - () - (Right - (Plain - "bullets")) - , Lit - () - (Right - (Plain - "(though")) - , Lit - () - (Right - (Plain "the")) - , Lit - () - (Right - (Plain - "choice")) - , Lit - () - (Right - (Plain - "will")) - , Lit - () - (Right - (Plain "be")) - , Lit - () - (Right - (Plain - "normalized")) - , Lit - () - (Right - (Plain - "away")) - , Lit - () - (Right - (Plain "by")) - , Lit - () - (Right - (Plain "the")) - , Lit - () - (Right - (Plain - "pretty-printer).")) - , Lit - () - (Right - (Plain - "They")) - , Lit - () - (Right - (Plain "can")) - , Lit - () - (Right - (Plain "be")) - , Lit - () - (Right - (Plain - "nested,")) - , Lit - () - (Right - (Plain "to")) - , Lit - () - (Right - (Plain "any")) - , Lit - () - (Right - (Plain - "depth:")) - ]))) - , Lit - () (Right (Plain "\n")) - , Lit - () (Right (Plain "\n")) - , Indent - () - (Lit - () - (Right (Plain " "))) - (Lit - () - (Right (Plain " "))) - (Annotated.Group - () - (Annotated.Group - () - (Annotated.Append - () - [ Indent - () - (Lit - () - (Right - (Plain - "* "))) - (Lit - () - (Right - (Plain - " "))) - (Wrap - () - (Lit - () - (Right - (Plain - "A")))) - , Lit - () - (Right - (Plain "\n")) - , Indent - () - (Lit - () - (Right - (Plain - "* "))) - (Lit - () - (Right - (Plain - " "))) - (Wrap - () - (Lit - () - (Right - (Plain - "B")))) - , Lit - () - (Right - (Plain "\n")) - , Indent - () - (Lit - () - (Right - (Plain - "* "))) - (Lit - () - (Right - (Plain - " "))) - (Annotated.Append - () - [ Wrap - () - (Lit - () - (Right - (Plain - "C"))) - , Lit - () - (Right - (Plain - "\n")) - , Annotated.Group - () - (Annotated.Append - () - [ Indent - () - (Lit - ( - ) - (Right - (Plain - "* "))) - (Lit - ( - ) - (Right - (Plain - " "))) - (Wrap - ( - ) - (Lit - ( - ) - (Right - (Plain - "C1")))) - , Lit - () - (Right - (Plain - "\n")) - , Indent - () - (Lit - ( - ) - (Right - (Plain - "* "))) - (Lit - ( - ) - (Right - (Plain - " "))) - (Wrap - ( - ) - (Lit - ( - ) - (Right - (Plain - "C2")))) - ]) - ]) - ]))) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Annotated.Group - () - (Annotated.Append - () - [ Indent - () - (Lit - () - (Right (Plain "# "))) - (Lit - () - (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (ConsoleText.Bold - (Plain - "Numbered"))) - , Lit - () - (Right - (ConsoleText.Bold - (Plain - "lists"))) - ]))) - , Lit - () (Right (Plain "\n")) - , Lit - () (Right (Plain "\n")) - , Indent - () - (Lit - () - (Right (Plain " "))) - (Lit - () - (Right (Plain " "))) - (Annotated.Group - () - (Annotated.Group - () - (Annotated.Append - () - [ Indent - () - (Lit - () - (Right - (Plain - "1. "))) - (Lit - () - (Right - (Plain - " "))) - (Wrap - () - (Lit - () - (Right - (Plain - "A")))) - , Lit - () - (Right - (Plain "\n")) - , Indent - () - (Lit - () - (Right - (Plain - "2. "))) - (Lit - () - (Right - (Plain - " "))) - (Wrap - () - (Lit - () - (Right - (Plain - "B")))) - , Lit - () - (Right - (Plain "\n")) - , Indent - () - (Lit - () - (Right - (Plain - "3. "))) - (Lit - () - (Right - (Plain - " "))) - (Wrap - () - (Lit - () - (Right - (Plain - "C")))) - ]))) - , Lit - () (Right (Plain "\n")) - , Lit - () (Right (Plain "\n")) - , Indent - () - (Lit - () - (Right (Plain " "))) - (Lit - () - (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain "The")) - , Lit - () - (Right - (Plain - "first")) - , Lit - () - (Right - (Plain - "number")) - , Lit - () - (Right - (Plain "of")) - , Lit - () - (Right - (Plain "the")) - , Lit - () - (Right - (Plain - "list")) - , Lit - () - (Right - (Plain - "determines")) - , Lit - () - (Right - (Plain "the")) - , Lit - () - (Right - (Plain - "starting")) - , Lit - () - (Right - (Plain - "number")) - , Lit - () - (Right - (Plain "in")) - , Lit - () - (Right - (Plain "the")) - , Lit - () - (Right - (Plain - "rendered")) - , Lit - () - (Right - (Plain - "output.")) - , Lit - () - (Right - (Plain "The")) - , Lit - () - (Right - (Plain - "other")) - , Lit - () - (Right - (Plain - "numbers")) - , Lit - () - (Right - (Plain "are")) - , Lit - () - (Right - (Plain - "ignored:")) - ]))) - , Lit - () (Right (Plain "\n")) - , Lit - () (Right (Plain "\n")) - , Indent - () - (Lit - () - (Right (Plain " "))) - (Lit - () - (Right (Plain " "))) - (Annotated.Group - () - (Annotated.Group - () - (Annotated.Append - () - [ Indent - () - (Lit - () - (Right - (Plain - "10. "))) - (Lit - () - (Right - (Plain - " "))) - (Wrap - () - (Lit - () - (Right - (Plain - "A")))) - , Lit - () - (Right - (Plain "\n")) - , Indent - () - (Lit - () - (Right - (Plain - "11. "))) - (Lit - () - (Right - (Plain - " "))) - (Wrap - () - (Lit - () - (Right - (Plain - "B")))) - , Lit - () - (Right - (Plain "\n")) - , Indent - () - (Lit - () - (Right - (Plain - "12. "))) - (Lit - () - (Right - (Plain - " "))) - (Wrap - () - (Lit - () - (Right - (Plain - "C")))) - ]))) - , Lit - () (Right (Plain "\n")) - , Lit - () (Right (Plain "\n")) - , Indent - () - (Lit - () - (Right (Plain " "))) - (Lit - () - (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain - "Numbered")) - , Lit - () - (Right - (Plain - "lists")) - , Lit - () - (Right - (Plain "can")) - , Lit - () - (Right - (Plain "be")) - , Lit - () - (Right - (Plain - "nested")) - , Lit - () - (Right - (Plain "as")) - , Lit - () - (Right - (Plain - "well,")) - , Lit - () - (Right - (Plain "and")) - , Lit - () - (Right - (Plain - "combined")) - , Lit - () - (Right - (Plain - "with")) - , Lit - () - (Right - (Plain - "bulleted")) - , Lit - () - (Right - (Plain - "lists:")) - ]))) - , Lit - () (Right (Plain "\n")) - , Lit - () (Right (Plain "\n")) - , Indent - () - (Lit - () - (Right (Plain " "))) - (Lit - () - (Right (Plain " "))) - (Annotated.Group - () - (Annotated.Group - () - (Annotated.Append - () - [ Indent - () - (Lit - () - (Right - (Plain - "1. "))) - (Lit - () - (Right - (Plain - " "))) - (Annotated.Append - () - [ Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain - "Wake")) - , Lit - () - (Right - (Plain - "up.")) - ]) - , Lit - () - (Right - (Plain - "\n")) - , Annotated.Group - () - (Annotated.Append - () - [ Indent - () - (Lit - ( - ) - (Right - (Plain - "* "))) - (Lit - ( - ) - (Right - (Plain - " "))) - (Wrap - ( - ) - (Annotated.Append - ( - ) - [ Lit - ( - ) - (Right - (Plain - "What")) - , Lit - ( - ) - (Right - (Plain - "am")) - , Lit - ( - ) - (Right - (Plain - "I")) - , Lit - ( - ) - (Right - (Plain - "doing")) - , Lit - ( - ) - (Right - (Plain - "here?")) - ])) - , Lit - () - (Right - (Plain - "\n")) - , Indent - () - (Lit - ( - ) - (Right - (Plain - "* "))) - (Lit - ( - ) - (Right - (Plain - " "))) - (Wrap - ( - ) - (Annotated.Append - ( - ) - [ Lit - ( - ) - (Right - (Plain - "In")) - , Lit - ( - ) - (Right - (Plain - "this")) - , Lit - ( - ) - (Right - (Plain - "nested")) - , Lit - ( - ) - (Right - (Plain - "list.")) - ])) - ]) - ]) - , Lit - () - (Right - (Plain "\n")) - , Indent - () - (Lit - () - (Right - (Plain - "2. "))) - (Lit - () - (Right - (Plain - " "))) - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain - "Take")) - , Lit - () - (Right - (Plain - "shower.")) - ])) - , Lit - () - (Right - (Plain "\n")) - , Indent - () - (Lit - () - (Right - (Plain - "3. "))) - (Lit - () - (Right - (Plain - " "))) - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain - "Get")) - , Lit - () - (Right - (Plain - "dressed.")) - ])) - ]))) - ]))) - ])))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Group - () - (Annotated.Append - () - [ Indent - () - (Lit () (Right (Plain "# "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Lit - () - (Right - (ConsoleText.Bold - (Plain "Evaluation")))))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain "Expressions")) - , Lit - () (Right (Plain "can")) - , Lit - () (Right (Plain "be")) - , Lit - () - (Right - (Plain "evaluated")) - , Lit - () - (Right (Plain "inline,")) - , Lit - () (Right (Plain "for")) - , Lit - () - (Right - (Plain "instance")) - , Annotated.Group - () - (Annotated.Append - () - [ Lit - () - (Left - (EvalInline - (Term.Term - (Any - (do - 1 - Nat.+ 1))))) - , Lit - () - (Right (Plain ".")) - ]) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right (Plain "Blocks")) - , Lit - () (Right (Plain "of")) - , Lit - () - (Right (Plain "code")) - , Lit - () (Right (Plain "can")) - , Lit - () (Right (Plain "be")) - , Lit - () - (Right - (Plain "evaluated")) - , Lit - () (Right (Plain "as")) - , Lit - () - (Right (Plain "well,")) - , Lit - () (Right (Plain "for")) - , Lit - () - (Right - (Plain "instance:")) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () (Lit - () (Left - (Eval - (Term.Term - (Any - (do - id x = x - id (sqr 10)))))))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Lit - () (Right (Plain "also:"))))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () (Lit - () (Left - (Eval - (Term.Term - (Any - (do match 1 with - 1 -> "hi" - _ -> "goodbye"))))))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () (Right (Plain "To")) - , Lit - () - (Right (Plain "include")) - , Lit () (Right (Plain "a")) - , Lit - () - (Right - (Plain "typechecked")) - , Lit - () - (Right (Plain "snippet")) - , Lit - () (Right (Plain "of")) - , Lit - () - (Right (Plain "code")) - , Lit - () - (Right (Plain "without")) - , Lit - () - (Right - (Plain "evaluating")) - , Lit - () (Right (Plain "it,")) - , Lit - () (Right (Plain "you")) - , Lit - () (Right (Plain "can")) - , Lit - () (Right (Plain "do:")) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () (Lit - () (Left - (ExampleBlock - 0 (Term.Term - (Any - (do - use Nat * - cube : Nat -> Nat - cube x = x * x * x - ()))))))) - ])))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Group - () - (Annotated.Append - () - [ Indent - () - (Lit () (Right (Plain "# "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (ConsoleText.Bold - (Plain "Including"))) - , Lit - () - (Right - (ConsoleText.Bold - (Plain "Unison"))) - , Lit - () - (Right - (ConsoleText.Bold - (Plain "source"))) - , Lit - () - (Right - (ConsoleText.Bold - (Plain "code"))) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right (Plain "Unison")) - , Lit - () - (Right - (Plain "definitions")) - , Lit - () (Right (Plain "can")) - , Lit - () (Right (Plain "be")) - , Lit - () - (Right - (Plain "included")) - , Lit - () (Right (Plain "in")) - , Lit - () - (Right (Plain "docs.")) - , Lit - () (Right (Plain "For")) - , Lit - () - (Right - (Plain "instance:")) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Lit - () - (Left - (SpecialForm.Source - [ ( Left - (typeLink Optional) - , [] - ) - , ( Right - (Term.Term - (Any (do sqr))) - , [] - ) - ]))))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right (Plain "Some")) - , Lit - () - (Right - (Plain "rendering")) - , Lit - () - (Right (Plain "targets")) - , Lit - () - (Right (Plain "also")) - , Lit - () - (Right (Plain "support")) - , Lit - () - (Right (Plain "folded")) - , Lit - () - (Right (Plain "source:")) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Lit - () - (Left - (FoldedSource - [ ( Left - (typeLink Optional) - , [] - ) - , ( Right - (Term.Term - (Any (do sqr))) - , [] - ) - ]))))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () (Right (Plain "You")) - , Lit - () (Right (Plain "can")) - , Lit - () - (Right (Plain "also")) - , Lit - () - (Right (Plain "include")) - , Lit - () - (Right (Plain "just")) - , Lit () (Right (Plain "a")) - , Lit - () - (Right - (Plain "signature,")) - , Lit - () - (Right (Plain "inline,")) - , Lit - () - (Right (Plain "with")) - , Annotated.Group - () - (Annotated.Append - () - [ Lit - () - (Left - (SignatureInline - (Term.Term - (Any - (do sqr))))) - , Lit - () - (Right (Plain ",")) - ]) - , Lit - () (Right (Plain "or")) - , Lit - () (Right (Plain "you")) - , Lit - () (Right (Plain "can")) - , Lit - () - (Right (Plain "include")) - , Lit - () (Right (Plain "one")) - , Lit - () (Right (Plain "or")) - , Lit - () - (Right (Plain "more")) - , Lit - () - (Right - (Plain "signatures")) - , Lit - () (Right (Plain "as")) - , Lit () (Right (Plain "a")) - , Lit - () - (Right (Plain "block:")) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Lit - () - (Left - (SpecialForm.Signature - [ Term.Term - (Any (do sqr)) - , Term.Term - (Any (do (Nat.+))) - ]))))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () (Right (Plain "Or")) - , Lit - () - (Right - (Plain "alternately:")) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Lit - () - (Left - (SpecialForm.Signature - [ Term.Term - (Any (do List.map)) - ]))))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Annotated.Group - () - (Annotated.Append - () - [ Indent - () - (Lit - () - (Right (Plain "# "))) - (Lit - () - (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (ConsoleText.Bold - (Plain - "Inline"))) - , Lit - () - (Right - (ConsoleText.Bold - (Plain - "snippets"))) - ]))) - , Lit - () (Right (Plain "\n")) - , Lit - () (Right (Plain "\n")) - , Indent - () - (Lit - () - (Right (Plain " "))) - (Lit - () - (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain "You")) - , Lit - () - (Right - (Plain "can")) - , Lit - () - (Right - (Plain - "include")) - , Lit - () - (Right - (Plain - "typechecked")) - , Lit - () - (Right - (Plain - "code")) - , Lit - () - (Right - (Plain - "snippets")) - , Lit - () - (Right - (Plain - "inline,")) - , Lit - () - (Right - (Plain "for")) - , Lit - () - (Right - (Plain - "instance:")) - ]))) - , Lit - () (Right (Plain "\n")) - , Lit - () (Right (Plain "\n")) - , Indent - () - (Lit - () - (Right (Plain " "))) - (Lit - () - (Right (Plain " "))) - (Annotated.Group - () - (Annotated.Group - () - (Annotated.Append - () - [ Indent - () - (Lit - () - (Right - (Plain - "* "))) - (Lit - () - (Right - (Plain - " "))) - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Left - (Example - 2 - (Term.Term - (Any - (do - f - x -> - f - x - Nat.+ sqr - 1))))) - , Lit - () - (Right - (Plain - "-")) - , Lit - () - (Right - (Plain - "the")) - , Annotated.Group - () - (Annotated.Append - () - [ Lit - ( - ) - (Right - (Plain - "`")) - , Lit - ( - ) - (Right - (Plain - "2")) - , Lit - ( - ) - (Right - (Plain - "`")) - ]) - , Lit - () - (Right - (Plain - "says")) - , Lit - () - (Right - (Plain - "to")) - , Lit - () - (Right - (Plain - "ignore")) - , Lit - () - (Right - (Plain - "the")) - , Lit - () - (Right - (Plain - "first")) - , Lit - () - (Right - (Plain - "two")) - , Lit - () - (Right - (Plain - "arguments")) - , Lit - () - (Right - (Plain - "when")) - , Lit - () - (Right - (Plain - "rendering.")) - , Lit - () - (Right - (Plain - "In")) - , Lit - () - (Right - (Plain - "richer")) - , Lit - () - (Right - (Plain - "renderers,")) - , Lit - () - (Right - (Plain - "the")) - , Annotated.Group - () - (Annotated.Append - () - [ Lit - ( - ) - (Right - (Plain - "`")) - , Lit - ( - ) - (Right - (Plain - "sqr")) - , Lit - ( - ) - (Right - (Plain - "`")) - ]) - , Lit - () - (Right - (Plain - "link")) - , Lit - () - (Right - (Plain - "will")) - , Lit - () - (Right - (Plain - "be")) - , Lit - () - (Right - (Plain - "clickable.")) - ])) - , Lit - () - (Right - (Plain "\n")) - , Indent - () - (Lit - () - (Right - (Plain - "* "))) - (Lit - () - (Right - (Plain - " "))) - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain - "If")) - , Lit - () - (Right - (Plain - "your")) - , Lit - () - (Right - (Plain - "snippet")) - , Lit - () - (Right - (Plain - "expression")) - , Lit - () - (Right - (Plain - "is")) - , Lit - () - (Right - (Plain - "just")) - , Lit - () - (Right - (Plain - "a")) - , Lit - () - (Right - (Plain - "single")) - , Lit - () - (Right - (Plain - "function")) - , Lit - () - (Right - (Plain - "application,")) - , Lit - () - (Right - (Plain - "you")) - , Lit - () - (Right - (Plain - "can")) - , Lit - () - (Right - (Plain - "put")) - , Lit - () - (Right - (Plain - "it")) - , Lit - () - (Right - (Plain - "in")) - , Lit - () - (Right - (Plain - "double")) - , Lit - () - (Right - (Plain - "backticks,")) - , Lit - () - (Right - (Plain - "like")) - , Lit - () - (Right - (Plain - "so:")) - , Annotated.Group - () - (Annotated.Append - () - [ Lit - ( - ) - (Left - (Example - 1 - (Term.Term - (Any - (do - x -> - sqr - x))))) - , Lit - ( - ) - (Right - (Plain - ".")) - ]) - , Lit - () - (Right - (Plain - "This")) - , Lit - () - (Right - (Plain - "is")) - , Lit - () - (Right - (Plain - "equivalent")) - , Lit - () - (Right - (Plain - "to")) - , Annotated.Group - () - (Annotated.Append - () - [ Lit - ( - ) - (Left - (Example - 1 - (Term.Term - (Any - (do - x -> - sqr - x))))) - , Lit - ( - ) - (Right - (Plain - ".")) - ]) - ])) - ]))) - ]))) - ])))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Group - () - (Annotated.Append - () - [ Indent - () - (Lit () (Right (Plain "# "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (ConsoleText.Bold - (Plain "Non-Unison"))) - , Lit - () - (Right - (ConsoleText.Bold - (Plain "code"))) - , Lit - () - (Right - (ConsoleText.Bold - (Plain "blocks"))) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () (Right (Plain "Use")) - , Lit - () - (Right (Plain "three")) - , Lit - () (Right (Plain "or")) - , Lit - () - (Right (Plain "more")) - , Lit - () - (Right (Plain "single")) - , Lit - () - (Right (Plain "quotes")) - , Lit - () (Right (Plain "to")) - , Lit - () - (Right (Plain "start")) - , Lit () (Right (Plain "a")) - , Lit - () - (Right (Plain "block")) - , Lit - () - (Right (Plain "with")) - , Lit - () (Right (Plain "no")) - , Lit - () - (Right (Plain "syntax")) - , Lit - () - (Right - (Plain "highlighting:")) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Group - () - (Annotated.Append - () - [ Lit - () - (Right (Plain "``` ")) - , Annotated.Group - () - (Lit - () - (Right (Plain "raw"))) - , Lit - () - (Right (Plain "\n")) - , Lit - () - (Right - (Plain - " _____ _ \n | | |___|_|___ ___ ___ \n | | | | |_ -| . | |\n |_____|_|_|_|___|___|_|_|\n ")) - , Lit - () - (Right (Plain "\n")) - , Lit - () - (Right (Plain "```")) - ])))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () (Right (Plain "You")) - , Lit - () (Right (Plain "can")) - , Lit - () (Right (Plain "use")) - , Lit - () - (Right (Plain "three")) - , Lit - () (Right (Plain "or")) - , Lit - () - (Right (Plain "more")) - , Lit - () - (Right - (Plain "backticks")) - , Lit - () - (Right (Plain "plus")) - , Lit () (Right (Plain "a")) - , Lit - () - (Right - (Plain "language")) - , Lit - () - (Right (Plain "name")) - , Lit - () (Right (Plain "for")) - , Lit - () - (Right (Plain "blocks")) - , Lit - () - (Right (Plain "with")) - , Lit - () - (Right (Plain "syntax")) - , Lit - () - (Right - (Plain "highlighting:")) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Annotated.Group - () - (Annotated.Append - () - [ Lit - () - (Right (Plain "``` ")) - , Annotated.Group - () - (Lit - () - (Right - (Plain "Haskell"))) - , Lit - () (Right (Plain "\n")) - , Lit - () - (Right - (Plain - "-- A fenced code block which isn't parsed by Unison\nreverse = foldl (flip (:)) []")) - , Lit - () (Right (Plain "\n")) - , Lit - () (Right (Plain "```")) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Annotated.Group - () - (Annotated.Append - () - [ Lit - () - (Right (Plain "``` ")) - , Annotated.Group - () - (Lit - () - (Right (Plain "Scala"))) - , Lit - () (Right (Plain "\n")) - , Lit - () - (Right - (Plain - "// A fenced code block which isn't parsed by Unison\ndef reverse[A](xs: List[A]) = \n xs.foldLeft(Nil : List[A])((acc,a) => a +: acc)")) - , Lit - () (Right (Plain "\n")) - , Lit - () (Right (Plain "```")) - ]))) - ])))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Indent - () - (Lit () (Right (Plain " "))) - (Lit () (Right (Plain " "))) - (Annotated.Group - () - (Wrap - () - (Annotated.Group - () - (Annotated.Append - () - [ Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () (Right (Plain "There")) - , Lit () (Right (Plain "are")) - , Lit - () (Right (Plain "also")) - , Lit - () - (Right (Plain "asides,")) - , Lit - () - (Right (Plain "callouts,")) - , Lit - () - (Right (Plain "tables,")) - , Lit - () - (Right (Plain "tooltips,")) - , Lit () (Right (Plain "and")) - , Lit - () (Right (Plain "more.")) - , Lit - () (Right (Plain "These")) - , Lit - () (Right (Plain "don't")) - , Lit - () - (Right (Plain "currently")) - , Lit - () (Right (Plain "have")) - , Lit - () - (Right (Plain "special")) - , Lit - () - (Right (Plain "syntax;")) - , Lit - () (Right (Plain "just")) - , Lit () (Right (Plain "use")) - , Lit () (Right (Plain "the")) - , Annotated.Group - () - (Annotated.Append - () - [ Lit - () - (Right (Plain "`")) - , Lit - () - (Right - (Plain "{{ }}")) - , Lit - () - (Right (Plain "`")) - ]) - , Lit - () - (Right (Plain "syntax")) - , Lit () (Right (Plain "to")) - , Lit - () (Right (Plain "call")) - , Lit - () (Right (Plain "these")) - , Lit - () - (Right (Plain "functions")) - , Lit - () - (Right (Plain "directly.")) - ])) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Annotated.Group - () - (Wrap - () - (Lit - () - (Left - (SpecialForm.Signature - [ Term.Term - (Any (do docAside)) - , Term.Term - (Any (do docCallout)) - , Term.Term - (Any - (do docBlockquote)) - , Term.Term - (Any (do docTooltip)) - , Term.Term - (Any (do docTable)) - ])))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () (Right (Plain "This")) - , Lit () (Right (Plain "is")) - , Lit () (Right (Plain "an")) - , Lit - () - (Right (Plain "aside.")) - , Lit - () - (Right - (Foreground - BrightBlack - (Plain "("))) - , Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (Foreground - BrightBlack - (Plain "Some"))) - , Lit - () - (Right - (Foreground - BrightBlack - (Plain "extra"))) - , Lit - () - (Right - (Foreground - BrightBlack - (Plain "detail"))) - , Lit - () - (Right - (Foreground - BrightBlack - (Plain "that"))) - , Lit - () - (Right - (Foreground - BrightBlack - (Plain "doesn't"))) - , Lit - () - (Right - (Foreground - BrightBlack - (Plain "belong"))) - , Lit - () - (Right - (Foreground - BrightBlack - (Plain "in"))) - , Lit - () - (Right - (Foreground - BrightBlack - (Plain "main"))) - , Lit - () - (Right - (Foreground - BrightBlack - (Plain "text."))) - ]) - , Lit - () - (Right - (Foreground - BrightBlack - (Plain ")"))) - ])) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Annotated.Group - () - (Wrap - () - (Annotated.Group - () - (Indent - () - (Lit - () (Right (Plain " | "))) - (Lit - () (Right (Plain " | "))) - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain "This")) - , Lit - () - (Right (Plain "is")) - , Lit - () - (Right (Plain "an")) - , Lit - () - (Right - (Plain "important")) - , Lit - () - (Right - (Plain "callout,")) - , Lit - () - (Right - (Plain "with")) - , Lit - () - (Right (Plain "no")) - , Lit - () - (Right - (Plain "icon.")) - ]))))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Annotated.Group - () - (Wrap - () - (Annotated.Group - () - (Indent - () - (Lit - () (Right (Plain " | "))) - (Lit - () (Right (Plain " | "))) - (Annotated.Append - () - [ Wrap - () - (Lit - () - (Right - (ConsoleText.Bold - (Plain "🌻")))) - , Lit - () - (Right (Plain "\n")) - , Lit - () (Right (Plain "")) - , Lit - () - (Right (Plain "\n")) - , Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain "This")) - , Lit - () - (Right - (Plain "is")) - , Lit - () - (Right - (Plain "an")) - , Lit - () - (Right - (Plain - "important")) - , Lit - () - (Right - (Plain - "callout,")) - , Lit - () - (Right - (Plain "with")) - , Lit - () - (Right - (Plain "an")) - , Lit - () - (Right - (Plain "icon.")) - , Lit - () - (Right - (Plain "The")) - , Lit - () - (Right - (Plain "text")) - , Lit - () - (Right - (Plain "wraps")) - , Lit - () - (Right - (Plain "onto")) - , Lit - () - (Right - (Plain - "multiple")) - , Lit - () - (Right - (Plain - "lines.")) - ]) - ])))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Annotated.Group - () - (Wrap - () - (Annotated.Group - () - (Indent - () - (Lit () (Right (Plain "> "))) - (Lit () (Right (Plain "> "))) - (Annotated.Group - () - (Annotated.Append - () - [ Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain - "\"And")) - , Lit - () - (Right - (Plain - "what")) - , Lit - () - (Right - (Plain - "is")) - , Lit - () - (Right - (Plain - "the")) - , Lit - () - (Right - (Plain - "use")) - , Lit - () - (Right - (Plain - "of")) - , Lit - () - (Right - (Plain "a")) - , Lit - () - (Right - (Plain - "book,\"")) - , Lit - () - (Right - (Plain - "thought")) - , Lit - () - (Right - (Plain - "Alice,")) - , Lit - () - (Right - (Plain - "\"without")) - , Lit - () - (Right - (Plain - "pictures")) - , Lit - () - (Right - (Plain - "or")) - , Lit - () - (Right - (Plain - "conversation?\"")) - ])) - , Lit - () - (Right (Plain "\n")) - , Lit - () - (Right (Plain "\n")) - , Annotated.Group - () - (Wrap - () - (Annotated.Append - () - [ Annotated.Group - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain - "*")) - , Lit - () - (Right - (Plain - "Lewis")) - ]) - , Lit - () - (Right - (Plain - "Carroll,")) - , Lit - () - (Right - (Plain - "Alice's")) - , Lit - () - (Right - (Plain - "Adventures")) - , Lit - () - (Right - (Plain - "in")) - , Annotated.Group - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain - "Wonderland")) - , Lit - () - (Right - (Plain - "*")) - ]) - ])) - ]))))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Annotated.Group - () - (Wrap - () - (Wrap - () - (Annotated.Append - () - [ Lit - () - (Right (Plain "Hover")) - , Lit - () - (Right (Plain "over")) - , Lit - () (Right (Plain "me")) - ]))) - , Lit () (Right (Plain "\n")) - , Lit () (Right (Plain "\n")) - , Annotated.Group - () - (Wrap - () - (Annotated.Table - () - [ [ Wrap - () - (Lit - () (Right (Plain "a"))) - , Wrap - () - (Lit - () (Right (Plain "b"))) - , Wrap - () - (Annotated.Append - () - [ Lit - () - (Right (Plain "A")) - , Lit - () - (Right - (Plain "longer")) - , Lit - () - (Right - (Plain - "paragraph")) - , Lit - () - (Right - (Plain "that")) - , Lit - () - (Right - (Plain "will")) - , Lit - () - (Right - (Plain "split")) - , Lit - () - (Right - (Plain "onto")) - , Lit - () - (Right - (Plain - "multiple")) - , Lit - () - (Right - (Plain "lines,")) - , Lit - () - (Right - (Plain "such")) - , Lit - () - (Right - (Plain "that")) - , Lit - () - (Right - (Plain "this")) - , Lit - () - (Right - (Plain "row")) - , Lit - () - (Right - (Plain - "occupies")) - , Lit - () - (Right - (Plain - "multiple")) - , Lit - () - (Right - (Plain "lines")) - , Lit - () - (Right - (Plain "in")) - , Lit - () - (Right - (Plain "the")) - , Lit - () - (Right - (Plain - "rendered")) - , Lit - () - (Right - (Plain "table.")) - ]) - ] - , [ Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain "Some")) - , Lit - () - (Right - (Plain "text")) - ]) - , Wrap - () - (Annotated.Append - () - [ Lit - () - (Right - (Plain "More")) - , Lit - () - (Right - (Plain "text")) - ]) - , Wrap - () - (Lit - () - (Right - (Plain "Zounds!"))) - ] - ])) - ])))) - ]) - -``` diff --git a/unison-src/transcripts/builtins-merge.md b/unison-src/transcripts/builtins-merge.md deleted file mode 100644 index 942dd4b0d3..0000000000 --- a/unison-src/transcripts/builtins-merge.md +++ /dev/null @@ -1,6 +0,0 @@ -The `builtins.merge` command adds the known builtins to the specified subnamespace within the current namespace. - -```ucm -scratch/main> builtins.merge builtins -scratch/main> ls builtins -``` diff --git a/unison-src/transcripts/builtins-merge.output.md b/unison-src/transcripts/builtins-merge.output.md deleted file mode 100644 index 8147375776..0000000000 --- a/unison-src/transcripts/builtins-merge.output.md +++ /dev/null @@ -1,91 +0,0 @@ -The `builtins.merge` command adds the known builtins to the specified subnamespace within the current namespace. - -``` ucm -scratch/main> builtins.merge builtins - - Done. - -scratch/main> ls builtins - - 1. Any (builtin type) - 2. Any/ (2 terms) - 3. Boolean (builtin type) - 4. Boolean/ (1 term) - 5. Bytes (builtin type) - 6. Bytes/ (34 terms) - 7. Char (builtin type) - 8. Char/ (22 terms, 1 type) - 9. ClientSockAddr (builtin type) - 10. Code (builtin type) - 11. Code/ (9 terms) - 12. Debug/ (3 terms) - 13. Doc (type) - 14. Doc/ (6 terms) - 15. Either (type) - 16. Either/ (2 terms) - 17. Exception (type) - 18. Exception/ (1 term) - 19. Float (builtin type) - 20. Float/ (38 terms) - 21. Handle/ (1 term) - 22. ImmutableArray (builtin type) - 23. ImmutableArray/ (3 terms) - 24. ImmutableByteArray (builtin type) - 25. ImmutableByteArray/ (8 terms) - 26. Int (builtin type) - 27. Int/ (31 terms) - 28. IsPropagated (type) - 29. IsPropagated/ (1 term) - 30. IsTest (type) - 31. IsTest/ (1 term) - 32. Link (type) - 33. Link/ (3 terms, 2 types) - 34. List (builtin type) - 35. List/ (10 terms) - 36. ListenSocket (builtin type) - 37. MutableArray (builtin type) - 38. MutableArray/ (6 terms) - 39. MutableByteArray (builtin type) - 40. MutableByteArray/ (14 terms) - 41. Nat (builtin type) - 42. Nat/ (28 terms) - 43. Optional (type) - 44. Optional/ (2 terms) - 45. Pattern (builtin type) - 46. Pattern/ (9 terms) - 47. Ref (builtin type) - 48. Ref/ (2 terms) - 49. Request (builtin type) - 50. RewriteCase (type) - 51. RewriteCase/ (1 term) - 52. RewriteSignature (type) - 53. RewriteSignature/ (1 term) - 54. RewriteTerm (type) - 55. RewriteTerm/ (1 term) - 56. Rewrites (type) - 57. Rewrites/ (1 term) - 58. Scope (builtin type) - 59. Scope/ (6 terms) - 60. SeqView (type) - 61. SeqView/ (2 terms) - 62. Socket/ (1 term) - 63. Test/ (2 terms, 1 type) - 64. Text (builtin type) - 65. Text/ (34 terms) - 66. ThreadId/ (1 term) - 67. Tuple (type) - 68. Tuple/ (1 term) - 69. UDPSocket (builtin type) - 70. Unit (type) - 71. Unit/ (1 term) - 72. Universal/ (7 terms) - 73. Value (builtin type) - 74. Value/ (5 terms) - 75. bug (a -> b) - 76. crypto/ (17 terms, 2 types) - 77. io2/ (146 terms, 32 types) - 78. metadata/ (2 terms) - 79. todo (a -> b) - 80. unsafe/ (1 term) - -``` diff --git a/unison-src/transcripts/builtins.md b/unison-src/transcripts/builtins.md deleted file mode 100644 index 6834b85eb1..0000000000 --- a/unison-src/transcripts/builtins.md +++ /dev/null @@ -1,462 +0,0 @@ -# Unit tests for builtin functions - -```ucm:hide -scratch/main> builtins.mergeio -scratch/main> load unison-src/transcripts-using-base/base.u -scratch/main> add -``` - -This transcript defines unit tests for builtin functions. There's a single `scratch/main> test` execution at the end that will fail the transcript with a nice report if any of the tests fail. - -## `Int` functions - -```unison:hide -use Int - --- used for some take/drop tests later -bigN = Nat.shiftLeft 1 63 - --- Note: you can make the tests more fine-grained if you --- want to be able to tell which one is failing -test> Int.tests.arithmetic = - checks [ - eq (+1 + +1) +2, - +10 - +4 == +6, - eq (+11 * +6) +66, - eq (+11 * +6) +66, - +10 / +3 == +3, - +10 / +5 == +2, - mod +10 +3 == +1, - mod +10 +2 == +0, - mod -13 +3 == +2, - mod -13 -3 == -1, - mod -13 -5 == -3, - mod -13 +5 == +2, - negate +99 == -99, - increment +99 == +100, - not (isEven +99), - isEven +100, - isOdd +105, - not (isOdd +108), - signum +99 == +1, - signum -3949 == -1, - signum +0 == +0, - gt +42 -1, - lt +42 +1000, - lteq +43 +43, - lteq +43 +44, - gteq +43 +43, - gteq +43 +41 - ] - -test> Int.tests.bitTwiddling = - checks [ - and +5 +4 == +4, - and +5 +1 == +1, - or +4 +1 == +5, - xor +5 +1 == +4, - complement -1 == +0, - popCount +1 == 1, - popCount +2 == 1, - popCount +4 == 1, - popCount +5 == 2, - popCount -1 == 64, - leadingZeros +1 == 63, - trailingZeros +1 == 0, - leadingZeros +2 == 62, - trailingZeros +2 == 1, - pow +2 6 == +64, - shiftLeft +1 6 == +64, - shiftRight +64 6 == +1 - ] - -test> Int.tests.conversions = - checks [ - truncate0 -2438344 == 0, - truncate0 +999 == 999, - toText +0 == "0", - toText +10 == "10", - toText -1039 == "-1039", - fromText "+0" == Some +0, - fromText "a8f9djasdlfkj" == None, - fromText "3940" == Some +3940, - fromText "1000000000000000000000000000" == None, - fromText "-1000000000000000000000000000" == None, - toFloat +9394 == 9394.0, - toFloat -20349 == -20349.0 - ] -``` - -```ucm:hide -scratch/main> add -``` - -## `Nat` functions - -```unison:hide -use Nat - -test> Nat.tests.arithmetic = - checks [ - eq (1 + 1) 2, - drop 10 4 == 6, - sub 10 12 == -2, - eq (11 * 6) 66, - 10 / 3 == 3, - 10 / 5 == 2, - mod 10 3 == 1, - mod 10 2 == 0, - 18446744073709551615 / 2 == 9223372036854775807, - mod 18446744073709551615 2 == 1, - increment 99 == 100, - not (isEven 99), - isEven 100, - isOdd 105, - not (isOdd 108), - gt 42 1, - lt 42 1000, - lteq 43 43, - lteq 43 44, - gteq 43 43, - gteq 43 41, - ] - -test> Nat.tests.bitTwiddling = - checks [ - and 5 4 == 4, - and 5 1 == 1, - or 4 1 == 5, - xor 5 1 == 4, - complement (complement 0) == 0, - popCount 1 == 1, - popCount 2 == 1, - popCount 4 == 1, - popCount 5 == 2, - popCount (complement 0) == 64, - leadingZeros 1 == 63, - trailingZeros 1 == 0, - leadingZeros 2 == 62, - trailingZeros 2 == 1, - pow 2 6 == 64, - shiftLeft 1 6 == 64, - shiftRight 64 6 == 1 - ] - -test> Nat.tests.conversions = - checks [ - toFloat 2438344 == 2438344.0, - toFloat 0 == 0.0, - toText 0 == "0", - toText 32939 == "32939", - toText 10 == "10", - fromText "ooga" == None, - fromText "90" == Some 90, - fromText "-1" == None, - fromText "100000000000000000000000000" == None, - unsnoc "abc" == Some ("ab", ?c), - uncons "abc" == Some (?a, "bc"), - unsnoc "" == None, - uncons "" == None, - Text.fromCharList (Text.toCharList "abc") == "abc", - Bytes.fromList (Bytes.toList 0xsACE0BA5E) == 0xsACE0BA5E - ] -``` - -```ucm:hide -scratch/main> add -``` - -## `Boolean` functions -```unison:hide -test> Boolean.tests.orTable = - checks [ - true || true == true, - true || false == true, - false || true == true, - false || false == false - ] -test> Boolean.tests.andTable = - checks [ - true && true == true, - false && true == false, - true && false == false, - false && false == false - ] -test> Boolean.tests.notTable = - checks [ - not true == false, - not false == true - ] -``` - -```ucm:hide -scratch/main> add -``` - -## `Text` functions - -```unison:hide -test> Text.tests.takeDropAppend = - checks [ - "yabba" ++ "dabba" == "yabbadabba", - Text.take 0 "yabba" == "", - Text.take 2 "yabba" == "ya", - Text.take 99 "yabba" == "yabba", - Text.drop 0 "yabba" == "yabba", - Text.drop 2 "yabba" == "bba", - Text.drop 99 "yabba" == "", - Text.take bigN "yabba" == "yabba", - Text.drop bigN "yabba" == "" - ] - -test> Text.tests.repeat = - checks [ - Text.repeat 4 "o" == "oooo", - Text.repeat 0 "o" == "" - ] - -test> Text.tests.alignment = - checks [ - Text.alignLeftWith 5 ?\s "a" == "a ", - Text.alignRightWith 5 ?_ "ababa" == "ababa", - Text.alignRightWith 5 ?_ "ab" == "___ab" - ] - -test> Text.tests.literalsEq = checks [":)" == ":)"] - -test> Text.tests.patterns = - use Pattern many or run isMatch capture join replicate - use Text.patterns literal digit letter anyChar space punctuation notCharIn charIn charRange notCharRange eof - l = literal - checks [ - run digit "1abc" == Some ([], "abc"), - run (capture (many digit)) "11234abc" == Some (["11234"], "abc"), - run (many letter) "abc11234abc" == Some ([], "11234abc"), - run (join [many space, capture (many anyChar)]) " abc123" == Some (["abc123"], ""), - run (many punctuation) "!!!!,,,..." == Some ([], ""), - run (charIn [?0,?1]) "0" == Some ([], ""), - run (notCharIn [?0,?1]) "0" == None, - run (many (notCharIn [?0,?1])) "asjdfskdfjlskdjflskdjf011" == Some ([], "011"), - run (capture (many (charRange ?a ?z))) "hi123" == Some (["hi"], "123"), - run (capture (many (notCharRange ?, ?,))) "abc123," == Some (["abc123"], ","), - run (capture (many (notCharIn [?,,]))) "abracadabra,123" == Some (["abracadabra"], ",123"), - run (capture (many (or digit letter))) "11234abc,remainder" == Some (["11234abc"], ",remainder"), - run (capture (replicate 1 5 (or digit letter))) "1a2ba aaa" == Some (["1a2ba"], " aaa"), - run (captureAs "foo" (many (or digit letter))) "11234abc,remainder" == Some (["foo"], ",remainder"), - run (join [(captureAs "foo" (many digit)), captureAs "bar" (many letter)]) "11234abc,remainder" == Some (["foo", "bar"], ",remainder"), - -- Regression test for: https://github.com/unisonweb/unison/issues/3530 - run (capture (replicate 0 1 (join [literal "a", literal "b"]))) "ac" == Some ([""], "ac"), - isMatch (join [many letter, eof]) "aaaaabbbb" == true, - isMatch (join [many letter, eof]) "aaaaabbbb1" == false, - isMatch (join [l "abra", many (l "cadabra")]) "abracadabracadabra" == true, - - ] - - -test> Text.tests.indexOf = - haystack = "01020304" ++ "05060708" ++ "090a0b0c01" - needle1 = "01" - needle2 = "02" - needle3 = "0304" - needle4 = "05" - needle5 = "0405" - needle6 = "0c" - needle7 = haystack - needle8 = "lopez" - needle9 = "" - checks [ - Text.indexOf needle1 haystack == Some 0, - Text.indexOf needle2 haystack == Some 2, - Text.indexOf needle3 haystack == Some 4, - Text.indexOf needle4 haystack == Some 8, - Text.indexOf needle5 haystack == Some 6, - Text.indexOf needle6 haystack == Some 22, - Text.indexOf needle7 haystack == Some 0, - Text.indexOf needle8 haystack == None, - Text.indexOf needle9 haystack == Some 0, - ] - -test> Text.tests.indexOfEmoji = - haystack = "clap 👏 your 👏 hands 👏 if 👏 you 👏 love 👏 unison" - needle1 = "👏" - needle2 = "👏 " - checks [ - Text.indexOf needle1 haystack == Some 5, - Text.indexOf needle2 haystack == Some 5, - ] - -``` - -```ucm:hide -scratch/main> add -``` - -## `Bytes` functions - -```unison:hide -test> Bytes.tests.at = - bs = Bytes.fromList [77, 13, 12] - checks [ - Bytes.at 1 bs == Some 13, - Bytes.at 0 bs == Some 77, - Bytes.at 99 bs == None, - Bytes.take bigN bs == bs, - Bytes.drop bigN bs == empty - ] - -test> Bytes.tests.compression = - roundTrip b = - (Bytes.zlib.decompress (Bytes.zlib.compress b) == Right b) - && (Bytes.gzip.decompress (Bytes.gzip.compress b) == Right b) - - checks [ - roundTrip 0xs2093487509823745709827345789023457892345, - roundTrip 0xs00000000000000000000000000000000000000000000, - roundTrip 0xs, - roundTrip 0xs11111111111111111111111111, - roundTrip 0xsffffffffffffffffffffffffffffff, - roundTrip 0xs222222222fffffffffffffffffffffffffffffff, - -- these fail due to bad checksums and/or headers - isLeft (zlib.decompress 0xs2093487509823745709827345789023457892345), - isLeft (gzip.decompress 0xs201209348750982374593939393939709827345789023457892345) - ] - -test> Bytes.tests.fromBase64UrlUnpadded = - checks [Exception.catch - '(fromUtf8 - (raiseMessage () (Bytes.fromBase64UrlUnpadded (toUtf8 "aGVsbG8gd29ybGQ")))) == Right "hello world" - , isLeft (Bytes.fromBase64UrlUnpadded (toUtf8 "aGVsbG8gd29ybGQ="))] - -test> Bytes.tests.indexOf = - haystack = 0xs01020304 ++ 0xs05060708 ++ 0xs090a0b0c01 - needle1 = 0xs01 - needle2 = 0xs02 - needle3 = 0xs0304 - needle4 = 0xs05 - needle5 = 0xs0405 - needle6 = 0xs0c - needle7 = haystack - needle8 = 0xsffffff - checks [ - Bytes.indexOf needle1 haystack == Some 0, - Bytes.indexOf needle2 haystack == Some 1, - Bytes.indexOf needle3 haystack == Some 2, - Bytes.indexOf needle4 haystack == Some 4, - Bytes.indexOf needle5 haystack == Some 3, - Bytes.indexOf needle6 haystack == Some 11, - Bytes.indexOf needle7 haystack == Some 0, - Bytes.indexOf needle8 haystack == None, - - ] - -``` - -```ucm:hide -scratch/main> add -``` - -## `List` comparison - -```unison:hide -test> checks [ - compare [] [1,2,3] == -1, - compare [1,2,3] [1,2,3,4] == -1, - compare [1,2,3,4] [1,2,3] == +1, - compare [1,2,3] [1,2,3] == +0, - compare [3] [1,2,3] == +1, - compare [1,2,3] [1,2,4] == -1, - compare [1,2,2] [1,2,1,2] == +1, - compare [1,2,3,4] [3,2,1] == -1 - ] -``` - -```ucm:hide -scratch/main> add -``` - -Other list functions -```unison:hide -test> checks [ - List.take bigN [1,2,3] == [1,2,3], - List.drop bigN [1,2,3] == [] - ] -``` - -## `Any` functions - -```unison -> [Any "hi", Any (41 + 1)] - -test> Any.test1 = checks [(Any "hi" == Any "hi")] -test> Any.test2 = checks [(not (Any "hi" == Any 42))] -``` - -```ucm:hide -scratch/main> add -``` - -## Sandboxing functions - -```unison -openFile1 t = openFile t -openFile2 t = openFile1 t - -validateSandboxedSimpl ok v = - match Value.validateSandboxed ok v with - Right [] -> true - _ -> false - -openFiles = - [ not (validateSandboxed [] openFile) - , not (validateSandboxed [] openFile1) - , not (validateSandboxed [] openFile2) - ] - -test> Sandbox.test1 = checks [validateSandboxed [] "hello"] -test> Sandbox.test2 = checks openFiles -test> Sandbox.test3 = checks [validateSandboxed [termLink openFile.impl] -openFile] -``` - -```ucm:hide -scratch/main> add -``` - -```unison -openFilesIO = do - checks - [ not (validateSandboxedSimpl [] (value openFile)) - , not (validateSandboxedSimpl [] (value openFile1)) - , not (validateSandboxedSimpl [] (value openFile2)) - , sandboxLinks (termLink openFile) - == sandboxLinks (termLink openFile1) - , sandboxLinks (termLink openFile1) - == sandboxLinks (termLink openFile2) - ] -``` - -```ucm -scratch/main> add -scratch/main> io.test openFilesIO -``` - -## Universal hash functions - -Just exercises the function - -```unison -> Universal.murmurHash 1 -test> Universal.murmurHash.tests = checks [Universal.murmurHash [1,2,3] == Universal.murmurHash [1,2,3]] -``` - -```ucm:hide -scratch/main> add -``` - -## Run the tests - -Now that all the tests have been added to the codebase, let's view the test report. This will fail the transcript (with a nice message) if any of the tests are failing. - -```ucm -scratch/main> test -``` diff --git a/unison-src/transcripts/builtins.output.md b/unison-src/transcripts/builtins.output.md deleted file mode 100644 index 3a4538f30a..0000000000 --- a/unison-src/transcripts/builtins.output.md +++ /dev/null @@ -1,576 +0,0 @@ -# Unit tests for builtin functions - -This transcript defines unit tests for builtin functions. There's a single `scratch/main> test` execution at the end that will fail the transcript with a nice report if any of the tests fail. - -## `Int` functions - -``` unison -use Int - --- used for some take/drop tests later -bigN = Nat.shiftLeft 1 63 - --- Note: you can make the tests more fine-grained if you --- want to be able to tell which one is failing -test> Int.tests.arithmetic = - checks [ - eq (+1 + +1) +2, - +10 - +4 == +6, - eq (+11 * +6) +66, - eq (+11 * +6) +66, - +10 / +3 == +3, - +10 / +5 == +2, - mod +10 +3 == +1, - mod +10 +2 == +0, - mod -13 +3 == +2, - mod -13 -3 == -1, - mod -13 -5 == -3, - mod -13 +5 == +2, - negate +99 == -99, - increment +99 == +100, - not (isEven +99), - isEven +100, - isOdd +105, - not (isOdd +108), - signum +99 == +1, - signum -3949 == -1, - signum +0 == +0, - gt +42 -1, - lt +42 +1000, - lteq +43 +43, - lteq +43 +44, - gteq +43 +43, - gteq +43 +41 - ] - -test> Int.tests.bitTwiddling = - checks [ - and +5 +4 == +4, - and +5 +1 == +1, - or +4 +1 == +5, - xor +5 +1 == +4, - complement -1 == +0, - popCount +1 == 1, - popCount +2 == 1, - popCount +4 == 1, - popCount +5 == 2, - popCount -1 == 64, - leadingZeros +1 == 63, - trailingZeros +1 == 0, - leadingZeros +2 == 62, - trailingZeros +2 == 1, - pow +2 6 == +64, - shiftLeft +1 6 == +64, - shiftRight +64 6 == +1 - ] - -test> Int.tests.conversions = - checks [ - truncate0 -2438344 == 0, - truncate0 +999 == 999, - toText +0 == "0", - toText +10 == "10", - toText -1039 == "-1039", - fromText "+0" == Some +0, - fromText "a8f9djasdlfkj" == None, - fromText "3940" == Some +3940, - fromText "1000000000000000000000000000" == None, - fromText "-1000000000000000000000000000" == None, - toFloat +9394 == 9394.0, - toFloat -20349 == -20349.0 - ] -``` - -## `Nat` functions - -``` unison -use Nat - -test> Nat.tests.arithmetic = - checks [ - eq (1 + 1) 2, - drop 10 4 == 6, - sub 10 12 == -2, - eq (11 * 6) 66, - 10 / 3 == 3, - 10 / 5 == 2, - mod 10 3 == 1, - mod 10 2 == 0, - 18446744073709551615 / 2 == 9223372036854775807, - mod 18446744073709551615 2 == 1, - increment 99 == 100, - not (isEven 99), - isEven 100, - isOdd 105, - not (isOdd 108), - gt 42 1, - lt 42 1000, - lteq 43 43, - lteq 43 44, - gteq 43 43, - gteq 43 41, - ] - -test> Nat.tests.bitTwiddling = - checks [ - and 5 4 == 4, - and 5 1 == 1, - or 4 1 == 5, - xor 5 1 == 4, - complement (complement 0) == 0, - popCount 1 == 1, - popCount 2 == 1, - popCount 4 == 1, - popCount 5 == 2, - popCount (complement 0) == 64, - leadingZeros 1 == 63, - trailingZeros 1 == 0, - leadingZeros 2 == 62, - trailingZeros 2 == 1, - pow 2 6 == 64, - shiftLeft 1 6 == 64, - shiftRight 64 6 == 1 - ] - -test> Nat.tests.conversions = - checks [ - toFloat 2438344 == 2438344.0, - toFloat 0 == 0.0, - toText 0 == "0", - toText 32939 == "32939", - toText 10 == "10", - fromText "ooga" == None, - fromText "90" == Some 90, - fromText "-1" == None, - fromText "100000000000000000000000000" == None, - unsnoc "abc" == Some ("ab", ?c), - uncons "abc" == Some (?a, "bc"), - unsnoc "" == None, - uncons "" == None, - Text.fromCharList (Text.toCharList "abc") == "abc", - Bytes.fromList (Bytes.toList 0xsACE0BA5E) == 0xsACE0BA5E - ] -``` - -## `Boolean` functions - -``` unison -test> Boolean.tests.orTable = - checks [ - true || true == true, - true || false == true, - false || true == true, - false || false == false - ] -test> Boolean.tests.andTable = - checks [ - true && true == true, - false && true == false, - true && false == false, - false && false == false - ] -test> Boolean.tests.notTable = - checks [ - not true == false, - not false == true - ] -``` - -## `Text` functions - -``` unison -test> Text.tests.takeDropAppend = - checks [ - "yabba" ++ "dabba" == "yabbadabba", - Text.take 0 "yabba" == "", - Text.take 2 "yabba" == "ya", - Text.take 99 "yabba" == "yabba", - Text.drop 0 "yabba" == "yabba", - Text.drop 2 "yabba" == "bba", - Text.drop 99 "yabba" == "", - Text.take bigN "yabba" == "yabba", - Text.drop bigN "yabba" == "" - ] - -test> Text.tests.repeat = - checks [ - Text.repeat 4 "o" == "oooo", - Text.repeat 0 "o" == "" - ] - -test> Text.tests.alignment = - checks [ - Text.alignLeftWith 5 ?\s "a" == "a ", - Text.alignRightWith 5 ?_ "ababa" == "ababa", - Text.alignRightWith 5 ?_ "ab" == "___ab" - ] - -test> Text.tests.literalsEq = checks [":)" == ":)"] - -test> Text.tests.patterns = - use Pattern many or run isMatch capture join replicate - use Text.patterns literal digit letter anyChar space punctuation notCharIn charIn charRange notCharRange eof - l = literal - checks [ - run digit "1abc" == Some ([], "abc"), - run (capture (many digit)) "11234abc" == Some (["11234"], "abc"), - run (many letter) "abc11234abc" == Some ([], "11234abc"), - run (join [many space, capture (many anyChar)]) " abc123" == Some (["abc123"], ""), - run (many punctuation) "!!!!,,,..." == Some ([], ""), - run (charIn [?0,?1]) "0" == Some ([], ""), - run (notCharIn [?0,?1]) "0" == None, - run (many (notCharIn [?0,?1])) "asjdfskdfjlskdjflskdjf011" == Some ([], "011"), - run (capture (many (charRange ?a ?z))) "hi123" == Some (["hi"], "123"), - run (capture (many (notCharRange ?, ?,))) "abc123," == Some (["abc123"], ","), - run (capture (many (notCharIn [?,,]))) "abracadabra,123" == Some (["abracadabra"], ",123"), - run (capture (many (or digit letter))) "11234abc,remainder" == Some (["11234abc"], ",remainder"), - run (capture (replicate 1 5 (or digit letter))) "1a2ba aaa" == Some (["1a2ba"], " aaa"), - run (captureAs "foo" (many (or digit letter))) "11234abc,remainder" == Some (["foo"], ",remainder"), - run (join [(captureAs "foo" (many digit)), captureAs "bar" (many letter)]) "11234abc,remainder" == Some (["foo", "bar"], ",remainder"), - -- Regression test for: https://github.com/unisonweb/unison/issues/3530 - run (capture (replicate 0 1 (join [literal "a", literal "b"]))) "ac" == Some ([""], "ac"), - isMatch (join [many letter, eof]) "aaaaabbbb" == true, - isMatch (join [many letter, eof]) "aaaaabbbb1" == false, - isMatch (join [l "abra", many (l "cadabra")]) "abracadabracadabra" == true, - - ] - - -test> Text.tests.indexOf = - haystack = "01020304" ++ "05060708" ++ "090a0b0c01" - needle1 = "01" - needle2 = "02" - needle3 = "0304" - needle4 = "05" - needle5 = "0405" - needle6 = "0c" - needle7 = haystack - needle8 = "lopez" - needle9 = "" - checks [ - Text.indexOf needle1 haystack == Some 0, - Text.indexOf needle2 haystack == Some 2, - Text.indexOf needle3 haystack == Some 4, - Text.indexOf needle4 haystack == Some 8, - Text.indexOf needle5 haystack == Some 6, - Text.indexOf needle6 haystack == Some 22, - Text.indexOf needle7 haystack == Some 0, - Text.indexOf needle8 haystack == None, - Text.indexOf needle9 haystack == Some 0, - ] - -test> Text.tests.indexOfEmoji = - haystack = "clap 👏 your 👏 hands 👏 if 👏 you 👏 love 👏 unison" - needle1 = "👏" - needle2 = "👏 " - checks [ - Text.indexOf needle1 haystack == Some 5, - Text.indexOf needle2 haystack == Some 5, - ] - -``` - -## `Bytes` functions - -``` unison -test> Bytes.tests.at = - bs = Bytes.fromList [77, 13, 12] - checks [ - Bytes.at 1 bs == Some 13, - Bytes.at 0 bs == Some 77, - Bytes.at 99 bs == None, - Bytes.take bigN bs == bs, - Bytes.drop bigN bs == empty - ] - -test> Bytes.tests.compression = - roundTrip b = - (Bytes.zlib.decompress (Bytes.zlib.compress b) == Right b) - && (Bytes.gzip.decompress (Bytes.gzip.compress b) == Right b) - - checks [ - roundTrip 0xs2093487509823745709827345789023457892345, - roundTrip 0xs00000000000000000000000000000000000000000000, - roundTrip 0xs, - roundTrip 0xs11111111111111111111111111, - roundTrip 0xsffffffffffffffffffffffffffffff, - roundTrip 0xs222222222fffffffffffffffffffffffffffffff, - -- these fail due to bad checksums and/or headers - isLeft (zlib.decompress 0xs2093487509823745709827345789023457892345), - isLeft (gzip.decompress 0xs201209348750982374593939393939709827345789023457892345) - ] - -test> Bytes.tests.fromBase64UrlUnpadded = - checks [Exception.catch - '(fromUtf8 - (raiseMessage () (Bytes.fromBase64UrlUnpadded (toUtf8 "aGVsbG8gd29ybGQ")))) == Right "hello world" - , isLeft (Bytes.fromBase64UrlUnpadded (toUtf8 "aGVsbG8gd29ybGQ="))] - -test> Bytes.tests.indexOf = - haystack = 0xs01020304 ++ 0xs05060708 ++ 0xs090a0b0c01 - needle1 = 0xs01 - needle2 = 0xs02 - needle3 = 0xs0304 - needle4 = 0xs05 - needle5 = 0xs0405 - needle6 = 0xs0c - needle7 = haystack - needle8 = 0xsffffff - checks [ - Bytes.indexOf needle1 haystack == Some 0, - Bytes.indexOf needle2 haystack == Some 1, - Bytes.indexOf needle3 haystack == Some 2, - Bytes.indexOf needle4 haystack == Some 4, - Bytes.indexOf needle5 haystack == Some 3, - Bytes.indexOf needle6 haystack == Some 11, - Bytes.indexOf needle7 haystack == Some 0, - Bytes.indexOf needle8 haystack == None, - - ] - -``` - -## `List` comparison - -``` unison -test> checks [ - compare [] [1,2,3] == -1, - compare [1,2,3] [1,2,3,4] == -1, - compare [1,2,3,4] [1,2,3] == +1, - compare [1,2,3] [1,2,3] == +0, - compare [3] [1,2,3] == +1, - compare [1,2,3] [1,2,4] == -1, - compare [1,2,2] [1,2,1,2] == +1, - compare [1,2,3,4] [3,2,1] == -1 - ] -``` - -Other list functions - -``` unison -test> checks [ - List.take bigN [1,2,3] == [1,2,3], - List.drop bigN [1,2,3] == [] - ] -``` - -## `Any` functions - -``` unison -> [Any "hi", Any (41 + 1)] - -test> Any.test1 = checks [(Any "hi" == Any "hi")] -test> Any.test2 = checks [(not (Any "hi" == Any 42))] -``` - -``` 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`: - - Any.test1 : [Result] - Any.test2 : [Result] - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 1 | > [Any "hi", Any (41 + 1)] - ⧩ - [Any "hi", Any 42] - - 3 | test> Any.test1 = checks [(Any "hi" == Any "hi")] - - ✅ Passed Passed - - 4 | test> Any.test2 = checks [(not (Any "hi" == Any 42))] - - ✅ Passed Passed - -``` -## Sandboxing functions - -``` unison -openFile1 t = openFile t -openFile2 t = openFile1 t - -validateSandboxedSimpl ok v = - match Value.validateSandboxed ok v with - Right [] -> true - _ -> false - -openFiles = - [ not (validateSandboxed [] openFile) - , not (validateSandboxed [] openFile1) - , not (validateSandboxed [] openFile2) - ] - -test> Sandbox.test1 = checks [validateSandboxed [] "hello"] -test> Sandbox.test2 = checks openFiles -test> Sandbox.test3 = checks [validateSandboxed [termLink openFile.impl] -openFile] -``` - -``` 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`: - - Sandbox.test1 : [Result] - Sandbox.test2 : [Result] - Sandbox.test3 : [Result] - openFile1 : Text - -> FileMode - ->{IO, Exception} Handle - openFile2 : Text - -> FileMode - ->{IO, Exception} Handle - openFiles : [Boolean] - validateSandboxedSimpl : [Link.Term] - -> Value - ->{IO} Boolean - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 15 | test> Sandbox.test1 = checks [validateSandboxed [] "hello"] - - ✅ Passed Passed - - 16 | test> Sandbox.test2 = checks openFiles - - ✅ Passed Passed - - 17 | test> Sandbox.test3 = checks [validateSandboxed [termLink openFile.impl] - - ✅ Passed Passed - -``` -``` unison -openFilesIO = do - checks - [ not (validateSandboxedSimpl [] (value openFile)) - , not (validateSandboxedSimpl [] (value openFile1)) - , not (validateSandboxedSimpl [] (value openFile2)) - , sandboxLinks (termLink openFile) - == sandboxLinks (termLink openFile1) - , sandboxLinks (termLink openFile1) - == sandboxLinks (termLink openFile2) - ] -``` - -``` 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`: - - openFilesIO : '{IO} [Result] - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - openFilesIO : '{IO} [Result] - -scratch/main> io.test openFilesIO - - New test results: - - 1. openFilesIO ◉ Passed - - ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` -## Universal hash functions - -Just exercises the function - -``` unison -> Universal.murmurHash 1 -test> Universal.murmurHash.tests = checks [Universal.murmurHash [1,2,3] == Universal.murmurHash [1,2,3]] -``` - -``` 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`: - - Universal.murmurHash.tests : [Result] - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 1 | > Universal.murmurHash 1 - ⧩ - 1208954131003843843 - - 2 | test> Universal.murmurHash.tests = checks [Universal.murmurHash [1,2,3] == Universal.murmurHash [1,2,3]] - - ✅ Passed Passed - -``` -## Run the tests - -Now that all the tests have been added to the codebase, let's view the test report. This will fail the transcript (with a nice message) if any of the tests are failing. - -``` ucm -scratch/main> test - - Cached test results (`help testcache` to learn more) - - 1. Any.test1 ◉ Passed - 2. Any.test2 ◉ Passed - 3. Boolean.tests.andTable ◉ Passed - 4. Boolean.tests.notTable ◉ Passed - 5. Boolean.tests.orTable ◉ Passed - 6. Bytes.tests.at ◉ Passed - 7. Bytes.tests.compression ◉ Passed - 8. Bytes.tests.fromBase64UrlUnpadded ◉ Passed - 9. Bytes.tests.indexOf ◉ Passed - 10. Int.tests.arithmetic ◉ Passed - 11. Int.tests.bitTwiddling ◉ Passed - 12. Int.tests.conversions ◉ Passed - 13. Nat.tests.arithmetic ◉ Passed - 14. Nat.tests.bitTwiddling ◉ Passed - 15. Nat.tests.conversions ◉ Passed - 16. Sandbox.test1 ◉ Passed - 17. Sandbox.test2 ◉ Passed - 18. Sandbox.test3 ◉ Passed - 19. test.rtjqan7bcs ◉ Passed - 20. Text.tests.alignment ◉ Passed - 21. Text.tests.indexOf ◉ Passed - 22. Text.tests.indexOfEmoji ◉ Passed - 23. Text.tests.literalsEq ◉ Passed - 24. Text.tests.patterns ◉ Passed - 25. Text.tests.repeat ◉ Passed - 26. Text.tests.takeDropAppend ◉ Passed - 27. Universal.murmurHash.tests ◉ Passed - - ✅ 27 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` diff --git a/unison-src/transcripts/bytesFromList.md b/unison-src/transcripts/bytesFromList.md deleted file mode 100644 index 1abb998791..0000000000 --- a/unison-src/transcripts/bytesFromList.md +++ /dev/null @@ -1,11 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -This should render as `Bytes.fromList [1,2,3,4]`, not `##Bytes.fromSequence [1,2,3,4]`: - -```unison -> Bytes.fromList [1,2,3,4] -``` - diff --git a/unison-src/transcripts/bytesFromList.output.md b/unison-src/transcripts/bytesFromList.output.md deleted file mode 100644 index b4a9782215..0000000000 --- a/unison-src/transcripts/bytesFromList.output.md +++ /dev/null @@ -1,22 +0,0 @@ -This should render as `Bytes.fromList [1,2,3,4]`, not `##Bytes.fromSequence [1,2,3,4]`: - -``` unison -> Bytes.fromList [1,2,3,4] -``` - -``` ucm - - Loading changes detected in scratch.u. - - ✅ - - scratch.u changed. - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 1 | > Bytes.fromList [1,2,3,4] - ⧩ - 0xs01020304 - -``` diff --git a/unison-src/transcripts/check763.md b/unison-src/transcripts/check763.md deleted file mode 100644 index 8b32045144..0000000000 --- a/unison-src/transcripts/check763.md +++ /dev/null @@ -1,17 +0,0 @@ -Regression test for https://github.com/unisonweb/unison/issues/763 - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -(+-+) : Nat -> Nat -> Nat -(+-+) x y = x * y -``` - -```ucm -scratch/main> add -scratch/main> move.term +-+ boppitybeep -scratch/main> move.term boppitybeep +-+ -``` - diff --git a/unison-src/transcripts/check763.output.md b/unison-src/transcripts/check763.output.md deleted file mode 100644 index 7975553f1d..0000000000 --- a/unison-src/transcripts/check763.output.md +++ /dev/null @@ -1,36 +0,0 @@ -Regression test for https://github.com/unisonweb/unison/issues/763 - -``` unison -(+-+) : Nat -> Nat -> Nat -(+-+) x y = x * y -``` - -``` 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`: - - +-+ : Nat -> Nat -> Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - +-+ : Nat -> Nat -> Nat - -scratch/main> move.term +-+ boppitybeep - - Done. - -scratch/main> move.term boppitybeep +-+ - - Done. - -``` diff --git a/unison-src/transcripts/check873.md b/unison-src/transcripts/check873.md deleted file mode 100644 index b70937821d..0000000000 --- a/unison-src/transcripts/check873.md +++ /dev/null @@ -1,17 +0,0 @@ -See [this ticket](https://github.com/unisonweb/unison/issues/873); the point being, this shouldn't crash the runtime. :) - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -(-) = builtin.Nat.sub -``` - -```ucm -scratch/main> add -``` - -```unison -baz x = x - 1 -``` diff --git a/unison-src/transcripts/check873.output.md b/unison-src/transcripts/check873.output.md deleted file mode 100644 index fa6f046e80..0000000000 --- a/unison-src/transcripts/check873.output.md +++ /dev/null @@ -1,44 +0,0 @@ -See [this ticket](https://github.com/unisonweb/unison/issues/873); the point being, this shouldn't crash the runtime. :) - -``` unison -(-) = builtin.Nat.sub -``` - -``` 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`: - - - : Nat -> Nat -> Int - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - - : Nat -> Nat -> Int - -``` -``` unison -baz x = x - 1 -``` - -``` 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`: - - baz : Nat -> Int - -``` diff --git a/unison-src/transcripts/constructor-applied-to-unit.md b/unison-src/transcripts/constructor-applied-to-unit.md deleted file mode 100644 index fc598a883f..0000000000 --- a/unison-src/transcripts/constructor-applied-to-unit.md +++ /dev/null @@ -1,11 +0,0 @@ -```ucm:hide -scratch/main> alias.type ##Nat Nat -scratch/main> alias.term ##Any.Any Any -``` - -```unison -structural type Zoink a b c = Zoink a b c - -> Any () -> [ Zoink [0,1,2,3,4,5] [6,3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,3] () ] -``` diff --git a/unison-src/transcripts/constructor-applied-to-unit.output.md b/unison-src/transcripts/constructor-applied-to-unit.output.md deleted file mode 100644 index e12d3f1d43..0000000000 --- a/unison-src/transcripts/constructor-applied-to-unit.output.md +++ /dev/null @@ -1,56 +0,0 @@ -``` unison -structural type Zoink a b c = Zoink a b c - -> Any () -> [ Zoink [0,1,2,3,4,5] [6,3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,3] () ] -``` - -``` 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`: - - structural type Zoink a b c - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 3 | > Any () - ⧩ - Any () - - 4 | > [ Zoink [0,1,2,3,4,5] [6,3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,3] () ] - ⧩ - [ Zoink - [0, 1, 2, 3, 4, 5] - [ 6 - , 3 - , 3 - , 3 - , 3 - , 3 - , 3 - , 3 - , 3 - , 3 - , 3 - , 4 - , 4 - , 4 - , 4 - , 4 - , 4 - , 4 - , 4 - , 4 - , 3 - ] - () - ] - -``` diff --git a/unison-src/transcripts/contrabilities.md b/unison-src/transcripts/contrabilities.md deleted file mode 100644 index 5d1fdcb647..0000000000 --- a/unison-src/transcripts/contrabilities.md +++ /dev/null @@ -1,8 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -f : (() -> a) -> Nat -f x = 42 -``` diff --git a/unison-src/transcripts/contrabilities.output.md b/unison-src/transcripts/contrabilities.output.md deleted file mode 100644 index ef0f98dffa..0000000000 --- a/unison-src/transcripts/contrabilities.output.md +++ /dev/null @@ -1,18 +0,0 @@ -``` unison -f : (() -> a) -> Nat -f x = 42 -``` - -``` 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`: - - f : '{g} a -> Nat - -``` diff --git a/unison-src/transcripts/create-author.md b/unison-src/transcripts/create-author.md deleted file mode 100644 index af06558660..0000000000 --- a/unison-src/transcripts/create-author.md +++ /dev/null @@ -1,10 +0,0 @@ -```ucm:hide -scratch/main> builtins.mergeio -``` - -Demonstrating `create.author`: - -```ucm -scratch/main> create.author alicecoder "Alice McGee" -scratch/main> find alicecoder -``` diff --git a/unison-src/transcripts/create-author.output.md b/unison-src/transcripts/create-author.output.md deleted file mode 100644 index caa4d2740d..0000000000 --- a/unison-src/transcripts/create-author.output.md +++ /dev/null @@ -1,21 +0,0 @@ -Demonstrating `create.author`: - -``` ucm -scratch/main> create.author alicecoder "Alice McGee" - - Added definitions: - - 1. metadata.authors.alicecoder : Author - 2. metadata.copyrightHolders.alicecoder : CopyrightHolder - 3. metadata.authors.alicecoder.guid : GUID - - Tip: Add License values for alicecoder under metadata. - -scratch/main> find alicecoder - - 1. metadata.authors.alicecoder : Author - 2. metadata.copyrightHolders.alicecoder : CopyrightHolder - 3. metadata.authors.alicecoder.guid : GUID - - -``` diff --git a/unison-src/transcripts/cycle-update-1.md b/unison-src/transcripts/cycle-update-1.md deleted file mode 100644 index b60bc763e4..0000000000 --- a/unison-src/transcripts/cycle-update-1.md +++ /dev/null @@ -1,27 +0,0 @@ -Update a member of a cycle, but retain the cycle. - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -ping : 'Nat -ping _ = !pong + 1 - -pong : 'Nat -pong _ = !ping + 2 -``` - -```ucm -scratch/main> add -``` - -```unison -ping : 'Nat -ping _ = !pong + 3 -``` - -```ucm -scratch/main> update -scratch/main> view ping pong -``` diff --git a/unison-src/transcripts/cycle-update-1.output.md b/unison-src/transcripts/cycle-update-1.output.md deleted file mode 100644 index b5dd6e69aa..0000000000 --- a/unison-src/transcripts/cycle-update-1.output.md +++ /dev/null @@ -1,77 +0,0 @@ -Update a member of a cycle, but retain the cycle. - -``` unison -ping : 'Nat -ping _ = !pong + 1 - -pong : 'Nat -pong _ = !ping + 2 -``` - -``` 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`: - - ping : 'Nat - pong : 'Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - ping : 'Nat - pong : 'Nat - -``` -``` unison -ping : 'Nat -ping _ = !pong + 3 -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - ping : 'Nat - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Everything typechecks, so I'm saving the results... - - Done. - -scratch/main> view ping pong - - ping : 'Nat - ping _ = - use Nat + - pong() + 3 - - pong : 'Nat - pong _ = - use Nat + - ping() + 2 - -``` diff --git a/unison-src/transcripts/cycle-update-2.md b/unison-src/transcripts/cycle-update-2.md deleted file mode 100644 index 0feb63afc2..0000000000 --- a/unison-src/transcripts/cycle-update-2.md +++ /dev/null @@ -1,27 +0,0 @@ -Update a member of a cycle with a type-preserving update, but sever the cycle. - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -ping : 'Nat -ping _ = !pong + 1 - -pong : 'Nat -pong _ = !ping + 2 -``` - -```ucm -scratch/main> add -``` - -```unison -ping : 'Nat -ping _ = 3 -``` - -```ucm -scratch/main> update -scratch/main> view ping pong -``` diff --git a/unison-src/transcripts/cycle-update-2.output.md b/unison-src/transcripts/cycle-update-2.output.md deleted file mode 100644 index b9bdc363fd..0000000000 --- a/unison-src/transcripts/cycle-update-2.output.md +++ /dev/null @@ -1,75 +0,0 @@ -Update a member of a cycle with a type-preserving update, but sever the cycle. - -``` unison -ping : 'Nat -ping _ = !pong + 1 - -pong : 'Nat -pong _ = !ping + 2 -``` - -``` 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`: - - ping : 'Nat - pong : 'Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - ping : 'Nat - pong : 'Nat - -``` -``` unison -ping : 'Nat -ping _ = 3 -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - ping : 'Nat - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Everything typechecks, so I'm saving the results... - - Done. - -scratch/main> view ping pong - - ping : 'Nat - ping _ = 3 - - pong : 'Nat - pong _ = - use Nat + - ping() + 2 - -``` diff --git a/unison-src/transcripts/cycle-update-3.md b/unison-src/transcripts/cycle-update-3.md deleted file mode 100644 index b5e1e05551..0000000000 --- a/unison-src/transcripts/cycle-update-3.md +++ /dev/null @@ -1,27 +0,0 @@ -Update a member of a cycle with a type-changing update, thus severing the cycle. - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -ping : 'Nat -ping _ = !pong + 1 - -pong : 'Nat -pong _ = !ping + 2 -``` - -```ucm -scratch/main> add -``` - -```unison -ping : Nat -ping = 3 -``` - -```ucm -scratch/main> update.old -scratch/main> view ping pong -``` diff --git a/unison-src/transcripts/cycle-update-3.output.md b/unison-src/transcripts/cycle-update-3.output.md deleted file mode 100644 index 15b0e26624..0000000000 --- a/unison-src/transcripts/cycle-update-3.output.md +++ /dev/null @@ -1,70 +0,0 @@ -Update a member of a cycle with a type-changing update, thus severing the cycle. - -``` unison -ping : 'Nat -ping _ = !pong + 1 - -pong : 'Nat -pong _ = !ping + 2 -``` - -``` 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`: - - ping : 'Nat - pong : 'Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - ping : 'Nat - pong : 'Nat - -``` -``` unison -ping : Nat -ping = 3 -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - ping : Nat - -``` -``` ucm -scratch/main> update.old - - ⍟ I've updated these names to your new definition: - - ping : Nat - -scratch/main> view ping pong - - ping : Nat - ping = 3 - - pong : 'Nat - pong _ = - use Nat + - #4t465jk908.1() + 2 - -``` diff --git a/unison-src/transcripts/cycle-update-4.md b/unison-src/transcripts/cycle-update-4.md deleted file mode 100644 index ae389489b9..0000000000 --- a/unison-src/transcripts/cycle-update-4.md +++ /dev/null @@ -1,30 +0,0 @@ -`update` properly discovers and establishes new cycles. - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -ping : 'Nat -ping _ = 1 - -pong : 'Nat -pong _ = !ping + 2 -``` - -```ucm -scratch/main> add -``` - -```unison -ping : 'Nat -ping _ = !clang + 1 - -clang : 'Nat -clang _ = !pong + 3 -``` - -```ucm -scratch/main> update.old ping -scratch/main> view ping pong clang -``` diff --git a/unison-src/transcripts/cycle-update-4.output.md b/unison-src/transcripts/cycle-update-4.output.md deleted file mode 100644 index 2fec74ba80..0000000000 --- a/unison-src/transcripts/cycle-update-4.output.md +++ /dev/null @@ -1,89 +0,0 @@ -`update` properly discovers and establishes new cycles. - -``` unison -ping : 'Nat -ping _ = 1 - -pong : 'Nat -pong _ = !ping + 2 -``` - -``` 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`: - - ping : 'Nat - pong : 'Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - ping : 'Nat - pong : 'Nat - -``` -``` unison -ping : 'Nat -ping _ = !clang + 1 - -clang : 'Nat -clang _ = !pong + 3 -``` - -``` 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`: - - clang : 'Nat - - ⍟ These names already exist. You can `update` them to your - new definition: - - ping : 'Nat - -``` -``` ucm -scratch/main> update.old ping - - ⍟ I've added these definitions: - - clang : 'Nat - - ⍟ I've updated these names to your new definition: - - ping : 'Nat - pong : 'Nat - -scratch/main> view ping pong clang - - clang : 'Nat - clang _ = - use Nat + - pong() + 3 - - ping : 'Nat - ping _ = - use Nat + - clang() + 1 - - pong : 'Nat - pong _ = - use Nat + - ping() + 2 - -``` diff --git a/unison-src/transcripts/debug-definitions.md b/unison-src/transcripts/debug-definitions.md deleted file mode 100644 index 0d10165f54..0000000000 --- a/unison-src/transcripts/debug-definitions.md +++ /dev/null @@ -1,28 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -```unison:hide -x = 30 - -y : Nat -y = - z = x + 2 - z + 10 - -structural type Optional a = Some a | None - -ability Ask a where - ask : a -``` - -```ucm -scratch/main> add -scratch/main> debug.term.abt Nat.+ -scratch/main> debug.term.abt y -scratch/main> debug.term.abt Some -scratch/main> debug.term.abt ask -scratch/main> debug.type.abt Nat -scratch/main> debug.type.abt Optional -scratch/main> debug.type.abt Ask -``` diff --git a/unison-src/transcripts/debug-definitions.output.md b/unison-src/transcripts/debug-definitions.output.md deleted file mode 100644 index 9c4bb349c5..0000000000 --- a/unison-src/transcripts/debug-definitions.output.md +++ /dev/null @@ -1,154 +0,0 @@ -``` unison -x = 30 - -y : Nat -y = - z = x + 2 - z + 10 - -structural type Optional a = Some a | None - -ability Ask a where - ask : a -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - ability Ask a - structural type Optional a - (also named builtin.Optional) - x : Nat - y : Nat - -scratch/main> debug.term.abt Nat.+ - - Builtin term: ##Nat.+ - -scratch/main> debug.term.abt y - - (let Ref(ReferenceBuiltin "Nat.+") Ref(ReferenceDerived (Id "qpo3o788girkkbb43uf6ggqberfduhtnqbt7096eojlrp27jieco09mdasb7b0b06ej9hj60a00nnbbdo8he0b4e0m7vtopifiuhdig" 0)) 2 in (User "z". Ref(ReferenceBuiltin "Nat.+") (Var User "z") 10)):ReferenceBuiltin "Nat" - -scratch/main> debug.term.abt Some - - Constructor #0 of the following type: - DataDeclaration - { modifier = Structural - , annotation = External - , bound = - [ User "a" ] - , constructors' = - [ - ( External - , User "Constructor0" - , - ( User "a". Var User "a" -> ReferenceDerived - ( Id "nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg" 0 ) - ( Var User "a" ) - ) - ) - , - ( External - , User "Constructor1" - , - ( User "a". ReferenceDerived - ( Id "nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg" 0 ) - ( Var User "a" ) - ) - ) - ] - } - -scratch/main> debug.term.abt ask - - Constructor #0 of the following type: - EffectDeclaration - { toDataDecl = DataDeclaration - { modifier = Unique "a1ns7cunv2dvjmum0q8jbc54g6811cbh" - , annotation = External - , bound = - [ User "a" ] - , constructors' = - [ - ( External - , User "Constructor0" - , - ( User "a". - ( - { - [ ReferenceDerived - ( Id "d8m1kmiscgfrl5n9ruvq1432lntfntl7nnao45qlk2uqhparm0uq2im0kbspu6u6kv65hd0i5oljq9m4b78peh5ekpma7gkihtsmfh0" 0 ) - ( Var User "a" ) - ] - } Var User "a" - ) - ) - ) - ] - } - } - -scratch/main> debug.type.abt Nat - - Builtin type: ##Nat - -scratch/main> debug.type.abt Optional - - DataDeclaration - { modifier = Structural - , annotation = External - , bound = - [ User "a" ] - , constructors' = - [ - ( External - , User "Constructor0" - , - ( User "a". Var User "a" -> ReferenceDerived - ( Id "nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg" 0 ) - ( Var User "a" ) - ) - ) - , - ( External - , User "Constructor1" - , - ( User "a". ReferenceDerived - ( Id "nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg" 0 ) - ( Var User "a" ) - ) - ) - ] - } - -scratch/main> debug.type.abt Ask - - EffectDeclaration - { toDataDecl = DataDeclaration - { modifier = Unique "a1ns7cunv2dvjmum0q8jbc54g6811cbh" - , annotation = External - , bound = - [ User "a" ] - , constructors' = - [ - ( External - , User "Constructor0" - , - ( User "a". - ( - { - [ ReferenceDerived - ( Id "d8m1kmiscgfrl5n9ruvq1432lntfntl7nnao45qlk2uqhparm0uq2im0kbspu6u6kv65hd0i5oljq9m4b78peh5ekpma7gkihtsmfh0" 0 ) - ( Var User "a" ) - ] - } Var User "a" - ) - ) - ) - ] - } - } - -``` diff --git a/unison-src/transcripts/debug-name-diffs.md b/unison-src/transcripts/debug-name-diffs.md deleted file mode 100644 index 5d4970e599..0000000000 --- a/unison-src/transcripts/debug-name-diffs.md +++ /dev/null @@ -1,19 +0,0 @@ -```unison -a.b.one = 1 -a.two = 2 - -a.x.three = 3 -a.x.four = 4 - -structural type a.x.Foo = Foo | Bar -structural type a.b.Baz = Boo -``` - -```ucm -scratch/main> add -scratch/main> delete.term.verbose a.b.one -scratch/main> alias.term a.two a.newtwo -scratch/main> move.namespace a.x a.y -scratch/main> history -scratch/main> debug.name-diff 4 1 -``` diff --git a/unison-src/transcripts/debug-name-diffs.output.md b/unison-src/transcripts/debug-name-diffs.output.md deleted file mode 100644 index b9b0742e53..0000000000 --- a/unison-src/transcripts/debug-name-diffs.output.md +++ /dev/null @@ -1,110 +0,0 @@ -``` unison -a.b.one = 1 -a.two = 2 - -a.x.three = 3 -a.x.four = 4 - -structural type a.x.Foo = Foo | Bar -structural type a.b.Baz = Boo -``` - -``` 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`: - - structural type a.b.Baz - structural type a.x.Foo - a.b.one : ##Nat - a.two : ##Nat - a.x.four : ##Nat - a.x.three : ##Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - structural type a.b.Baz - structural type a.x.Foo - a.b.one : ##Nat - a.two : ##Nat - a.x.four : ##Nat - a.x.three : ##Nat - -scratch/main> delete.term.verbose a.b.one - - Removed definitions: - - 1. a.b.one : ##Nat - - Tip: You can use `undo` or use a hash from `reflog` to undo - this change. - -scratch/main> alias.term a.two a.newtwo - - Done. - -scratch/main> move.namespace a.x a.y - - Done. - -scratch/main> history - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #tteooc9j2d - - > Moves: - - Original name New name - a.x.Foo a.y.Foo - a.x.Foo.Bar a.y.Foo.Bar - a.x.Foo.Foo a.y.Foo.Foo - a.x.four a.y.four - a.x.three a.y.three - - ⊙ 2. #bicrtgqj12 - - + Adds / updates: - - a.newtwo - - = Copies: - - Original name New name(s) - a.two a.newtwo - - ⊙ 3. #bofp4huk1j - - - Deletes: - - a.b.one - - □ 4. #gss5s88mo3 (start of history) - -scratch/main> debug.name-diff 4 1 - - Kind Name Change Ref - Term a.newtwo Added #dcgdua2lj6upd1ah5v0qp09gjsej0d77d87fu6qn8e2qrssnlnmuinoio46hiu53magr7qn8vnqke8ndt0v76700o5u8gcvo7st28jg - Term a.y.four Added #vcfbbslncd2qloc03kalgsmufl3j5es6cehcrbmlj6t78d4uk5j9gpa3hhf2opln1u2kiepg5n2cn49ianf2oig0mi4c2ldn1r9lf40 - Term a.y.three Added #f3lgjvjqoocpt8v6kdgd2bgthh11a7md3qdp9rf5datccmo580btjd5bt5dro3irqs0is7vm7s1dphddjbtufch620te7ef7canmjj8 - Term a.y.Foo.Bar Added #6kbe32g06nqg93cqub6ohqc4ql4o49ntgnunifds0t75qre6lacnbsr3evn8bkivj68ecbvmhkbak4dbg4fqertcpgb396rmo34tnh0#d1 - Term a.y.Foo.Foo Added #6kbe32g06nqg93cqub6ohqc4ql4o49ntgnunifds0t75qre6lacnbsr3evn8bkivj68ecbvmhkbak4dbg4fqertcpgb396rmo34tnh0#d0 - Term a.b.one Removed #gjmq673r1vrurfotlnirv7vutdhm6sa3s02em5g22kk606mv6duvv8be402dv79312i4a0onepq5bo7citsodvq2g720nttj0ee9p0g - Term a.x.four Removed #vcfbbslncd2qloc03kalgsmufl3j5es6cehcrbmlj6t78d4uk5j9gpa3hhf2opln1u2kiepg5n2cn49ianf2oig0mi4c2ldn1r9lf40 - Term a.x.three Removed #f3lgjvjqoocpt8v6kdgd2bgthh11a7md3qdp9rf5datccmo580btjd5bt5dro3irqs0is7vm7s1dphddjbtufch620te7ef7canmjj8 - Term a.x.Foo.Bar Removed #6kbe32g06nqg93cqub6ohqc4ql4o49ntgnunifds0t75qre6lacnbsr3evn8bkivj68ecbvmhkbak4dbg4fqertcpgb396rmo34tnh0#d1 - Term a.x.Foo.Foo Removed #6kbe32g06nqg93cqub6ohqc4ql4o49ntgnunifds0t75qre6lacnbsr3evn8bkivj68ecbvmhkbak4dbg4fqertcpgb396rmo34tnh0#d0 - Type a.y.Foo Added #6kbe32g06nqg93cqub6ohqc4ql4o49ntgnunifds0t75qre6lacnbsr3evn8bkivj68ecbvmhkbak4dbg4fqertcpgb396rmo34tnh0 - Type a.x.Foo Removed #6kbe32g06nqg93cqub6ohqc4ql4o49ntgnunifds0t75qre6lacnbsr3evn8bkivj68ecbvmhkbak4dbg4fqertcpgb396rmo34tnh0 - -``` diff --git a/unison-src/transcripts/deep-names.output.md b/unison-src/transcripts/deep-names.output.md deleted file mode 100644 index 9756abc509..0000000000 --- a/unison-src/transcripts/deep-names.output.md +++ /dev/null @@ -1,108 +0,0 @@ -First we'll set up two libraries, and then we'll use them in some projects and show what `names` are deep-loaded for them. - -Our two "libraries": - -``` unison -text.a = 1 -text.b = 2 -text.c = 3 - -http.x = 6 -http.y = 7 -http.z = 8 -``` - -Our `app1` project includes the text library twice and the http library twice as direct dependencies. - -``` ucm -scratch/app1> fork text lib.text_v1 - - Done. - -scratch/app1> fork text lib.text_v2 - - Done. - -scratch/app1> delete.namespace text - - Done. - -scratch/app1> fork http lib.http_v3 - - Done. - -scratch/app1> fork http lib.http_v4 - - Done. - -scratch/app1> delete.namespace http - - Done. - -``` -As such, we see two copies of `a` and two copies of `x` via these direct dependencies. - -``` ucm -scratch/app1> names a - - Term - Hash: #gjmq673r1v - Names: lib.text_v1.a lib.text_v2.a - -scratch/app1> names x - - Term - Hash: #nsmc4p1ra4 - Names: lib.http_v3.x lib.http_v4.x - -``` -Our `app2` project includes the `http` library twice as direct dependencies, and once as an indirect dependency via `webutil`. -It also includes the `text` library twice as indirect dependencies via `webutil` - -``` ucm -scratch/app2> fork http lib.http_v1 - - Done. - -scratch/app2> fork http lib.http_v2 - - Done. - -scratch/app2> fork text lib.webutil.lib.text_v1 - - Done. - -scratch/app2> fork text lib.webutil.lib.text_v2 - - Done. - -scratch/app2> fork http lib.webutil.lib.http - - Done. - -scratch/app2> delete.namespace http - - Done. - -scratch/app2> delete.namespace text - - Done. - -``` -Now we see two copies of `x` via direct dependencies on `http`, and one copy of `a` via indirect dependency on `text` via `webutil`. -We see neither the second indirect copy of `a` nor the indirect copy of `x` via webutil because we already have names for them. - -``` ucm -scratch/app2> names a - - Term - Hash: #gjmq673r1v - Names: lib.webutil.lib.text_v1.a - -scratch/app2> names x - - Term - Hash: #nsmc4p1ra4 - Names: lib.http_v1.x lib.http_v2.x - -``` diff --git a/unison-src/transcripts/definition-diff-api.md b/unison-src/transcripts/definition-diff-api.md deleted file mode 100644 index f8d21d0687..0000000000 --- a/unison-src/transcripts/definition-diff-api.md +++ /dev/null @@ -1,40 +0,0 @@ -```ucm -diffs/main> builtins.merge -``` - -```unison -term = - _ = "Here's some text" - 1 + 1 - -type Type = Type Nat -``` - -```ucm -diffs/main> add -diffs/main> branch.create new -``` - -```unison -term = - _ = "Here's some different text" - 1 + 2 - -type Type a = Type a Text -``` - -```ucm -diffs/new> update -``` - -Diff terms - -```api -GET /api/projects/diffs/diff/terms?oldBranchRef=main&newBranchRef=new&oldTerm=term&newTerm=term -``` - -Diff types - -```api -GET /api/projects/diffs/diff/types?oldBranchRef=main&newBranchRef=new&oldType=Type&newType=Type -``` diff --git a/unison-src/transcripts/definition-diff-api.output.md b/unison-src/transcripts/definition-diff-api.output.md deleted file mode 100644 index 1670f2b05d..0000000000 --- a/unison-src/transcripts/definition-diff-api.output.md +++ /dev/null @@ -1,810 +0,0 @@ -``` ucm -diffs/main> builtins.merge - - Done. - -``` -``` unison -term = - _ = "Here's some text" - 1 + 1 - -type Type = Type Nat -``` - -``` 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`: - - type Type - term : Nat - -``` -``` ucm -diffs/main> add - - ⍟ I've added these definitions: - - type Type - term : Nat - -diffs/main> branch.create new - - Done. I've created the new branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /new`. - -``` -``` unison -term = - _ = "Here's some different text" - 1 + 2 - -type Type a = Type a Text -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - type Type a - term : Nat - -``` -``` ucm -diffs/new> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -``` -Diff terms - -``` api -GET /api/projects/diffs/diff/terms?oldBranchRef=main&newBranchRef=new&oldTerm=term&newTerm=term -{ - "diff": { - "contents": [ - { - "diffTag": "both", - "elements": [ - { - "annotation": { - "contents": "term", - "tag": "HashQualifier" - }, - "segment": "term" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "term", - "tag": "HashQualifier" - }, - "segment": "term" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "UseKeyword" - }, - "segment": "use " - }, - { - "annotation": { - "tag": "UsePrefix" - }, - "segment": "Nat" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "UseSuffix" - }, - "segment": "+" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "_", - "tag": "HashQualifier" - }, - "segment": "_" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": " " - } - ] - }, - { - "annotation": { - "tag": "TextLiteral" - }, - "diffTag": "segmentChange", - "fromSegment": "\"Here's some text\"", - "toSegment": "\"Here's some different text\"" - }, - { - "diffTag": "both", - "elements": [ - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "1" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat.+", - "tag": "TermReference" - }, - "segment": "+" - }, - { - "annotation": null, - "segment": " " - } - ] - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "diffTag": "segmentChange", - "fromSegment": "1", - "toSegment": "2" - } - ], - "tag": "UserObject" - }, - "diffKind": "diff", - "newBranchRef": "new", - "newTerm": { - "bestTermName": "term", - "defnTermTag": "Plain", - "signature": [ - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ], - "termDefinition": { - "contents": [ - { - "annotation": { - "contents": "term", - "tag": "HashQualifier" - }, - "segment": "term" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "term", - "tag": "HashQualifier" - }, - "segment": "term" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "UseKeyword" - }, - "segment": "use " - }, - { - "annotation": { - "tag": "UsePrefix" - }, - "segment": "Nat" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "UseSuffix" - }, - "segment": "+" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "_", - "tag": "HashQualifier" - }, - "segment": "_" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TextLiteral" - }, - "segment": "\"Here's some different text\"" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "1" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat.+", - "tag": "TermReference" - }, - "segment": "+" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "2" - } - ], - "tag": "UserObject" - }, - "termDocs": [], - "termNames": [ - "term" - ] - }, - "oldBranchRef": "main", - "oldTerm": { - "bestTermName": "term", - "defnTermTag": "Plain", - "signature": [ - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ], - "termDefinition": { - "contents": [ - { - "annotation": { - "contents": "term", - "tag": "HashQualifier" - }, - "segment": "term" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "term", - "tag": "HashQualifier" - }, - "segment": "term" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "UseKeyword" - }, - "segment": "use " - }, - { - "annotation": { - "tag": "UsePrefix" - }, - "segment": "Nat" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "UseSuffix" - }, - "segment": "+" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "_", - "tag": "HashQualifier" - }, - "segment": "_" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "TextLiteral" - }, - "segment": "\"Here's some text\"" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "1" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat.+", - "tag": "TermReference" - }, - "segment": "+" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "NumericLiteral" - }, - "segment": "1" - } - ], - "tag": "UserObject" - }, - "termDocs": [], - "termNames": [ - "term" - ] - }, - "project": "diffs" -} -``` - -Diff types - -``` api -GET /api/projects/diffs/diff/types?oldBranchRef=main&newBranchRef=new&oldType=Type&newType=Type -{ - "diff": { - "contents": [ - { - "diffTag": "both", - "elements": [ - { - "annotation": { - "tag": "DataTypeKeyword" - }, - "segment": "type" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "Type", - "tag": "HashQualifier" - }, - "segment": "Type" - } - ] - }, - { - "diffTag": "new", - "elements": [ - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "DataTypeParams" - }, - "segment": "a" - } - ] - }, - { - "diffTag": "both", - "elements": [ - { - "annotation": { - "tag": "DelimiterChar" - }, - "segment": " = " - } - ] - }, - { - "diffTag": "annotationChange", - "fromAnnotation": { - "contents": "#0tc9e438eurvtevfa6k9pg04qvv66is75hs8iqejkuoaef140g8vvu92hc1ks4gamgc3i1ukgdn0blchp3038l43vffijpsbjh14igo#d0", - "tag": "TermReference" - }, - "segment": "Type", - "toAnnotation": { - "contents": "#mft8mne9i92b6k4m512rn2608rsp6ilq4ejufeof6mbh5aintes4tih1fo93fospmu2t3f0h67uu0mrk2qj75o7k0lj1juefhaidt4g#d0", - "tag": "TermReference" - } - }, - { - "diffTag": "both", - "elements": [ - { - "annotation": null, - "segment": " " - } - ] - }, - { - "diffTag": "old", - "elements": [ - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ] - }, - { - "diffTag": "new", - "elements": [ - { - "annotation": { - "tag": "Var" - }, - "segment": "a" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - } - ] - } - ], - "tag": "UserObject" - }, - "diffKind": "diff", - "newBranchRef": "new", - "newType": { - "bestTypeName": "Type", - "defnTypeTag": "Data", - "typeDefinition": { - "contents": [ - { - "annotation": { - "tag": "DataTypeKeyword" - }, - "segment": "type" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "Type", - "tag": "HashQualifier" - }, - "segment": "Type" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "DataTypeParams" - }, - "segment": "a" - }, - { - "annotation": { - "tag": "DelimiterChar" - }, - "segment": " = " - }, - { - "annotation": { - "contents": "#mft8mne9i92b6k4m512rn2608rsp6ilq4ejufeof6mbh5aintes4tih1fo93fospmu2t3f0h67uu0mrk2qj75o7k0lj1juefhaidt4g#d0", - "tag": "TermReference" - }, - "segment": "Type" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "Var" - }, - "segment": "a" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - } - ], - "tag": "UserObject" - }, - "typeDocs": [], - "typeNames": [ - "Type" - ] - }, - "oldBranchRef": "main", - "oldType": { - "bestTypeName": "Type", - "defnTypeTag": "Data", - "typeDefinition": { - "contents": [ - { - "annotation": { - "tag": "DataTypeKeyword" - }, - "segment": "type" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "Type", - "tag": "HashQualifier" - }, - "segment": "Type" - }, - { - "annotation": { - "tag": "DelimiterChar" - }, - "segment": " = " - }, - { - "annotation": { - "contents": "#0tc9e438eurvtevfa6k9pg04qvv66is75hs8iqejkuoaef140g8vvu92hc1ks4gamgc3i1ukgdn0blchp3038l43vffijpsbjh14igo#d0", - "tag": "TermReference" - }, - "segment": "Type" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Nat", - "tag": "TypeReference" - }, - "segment": "Nat" - } - ], - "tag": "UserObject" - }, - "typeDocs": [], - "typeNames": [ - "Type" - ] - }, - "project": "diffs" -} -``` - diff --git a/unison-src/transcripts/delete-namespace-dependents-check.md b/unison-src/transcripts/delete-namespace-dependents-check.md deleted file mode 100644 index 72aacc311d..0000000000 --- a/unison-src/transcripts/delete-namespace-dependents-check.md +++ /dev/null @@ -1,22 +0,0 @@ - - -# Delete namespace dependents check - -This is a regression test, previously `delete.namespace` allowed a delete as long as the deletions had a name _anywhere_ in your codebase, it should only check the current project branch. - -```ucm:hide -myproject/main> builtins.merge -``` - -```unison -sub.dependency = 123 - -dependent = dependency + 99 -``` - -```ucm:error -myproject/main> add -myproject/main> branch /new -myproject/new> delete.namespace sub -myproject/new> view dependent -``` diff --git a/unison-src/transcripts/delete-namespace-dependents-check.output.md b/unison-src/transcripts/delete-namespace-dependents-check.output.md deleted file mode 100644 index 1343731033..0000000000 --- a/unison-src/transcripts/delete-namespace-dependents-check.output.md +++ /dev/null @@ -1,62 +0,0 @@ - - -# Delete namespace dependents check - -This is a regression test, previously `delete.namespace` allowed a delete as long as the deletions had a name *anywhere* in your codebase, it should only check the current project branch. - -``` unison -sub.dependency = 123 - -dependent = dependency + 99 -``` - -``` 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`: - - dependent : Nat - sub.dependency : Nat - -``` -``` ucm -myproject/main> add - - ⍟ I've added these definitions: - - dependent : Nat - sub.dependency : Nat - -myproject/main> branch /new - - Done. I've created the new branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /new`. - -myproject/new> delete.namespace sub - - ⚠️ - - I didn't delete the namespace because the following - definitions are still in use. - - Dependency Referenced In - dependency 1. dependent - - If you want to proceed anyways and leave those definitions - without names, use delete.namespace.force - -myproject/new> view dependent - - dependent : Nat - dependent = - use Nat + - dependency + 99 - -``` diff --git a/unison-src/transcripts/delete-namespace.md b/unison-src/transcripts/delete-namespace.md deleted file mode 100644 index 5bbdda79e6..0000000000 --- a/unison-src/transcripts/delete-namespace.md +++ /dev/null @@ -1,61 +0,0 @@ -# delete.namespace.force - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison:hide -no_dependencies.thing = "no dependents on this term" - -dependencies.term1 = 1 -dependencies.term2 = 2 - -dependents.usage1 = dependencies.term1 + dependencies.term2 -dependents.usage2 = dependencies.term1 * dependencies.term2 -``` - -```ucm:hide -scratch/main> add -``` - -Deleting a namespace with no external dependencies should succeed. - -```ucm -scratch/main> delete.namespace no_dependencies -``` - -Deleting a namespace with external dependencies should fail and list all dependents. - -```ucm:error -scratch/main> delete.namespace dependencies -``` - -Deleting a namespace with external dependencies should succeed when using `delete.namespace.force` - -```ucm -scratch/main> delete.namespace.force dependencies -``` - -I should be able to view an affected dependency by number - -```ucm -scratch/main> view 2 -``` - -Deleting the root namespace should require confirmation if not forced. - -```ucm -scratch/main> delete.namespace . -scratch/main> delete.namespace . --- Should have an empty history -scratch/main> history . -``` - -Deleting the root namespace shouldn't require confirmation if forced. - -```ucm -scratch/main> delete.namespace.force . --- Should have an empty history -scratch/main> history . -``` - diff --git a/unison-src/transcripts/delete-namespace.output.md b/unison-src/transcripts/delete-namespace.output.md deleted file mode 100644 index ef7c2a5307..0000000000 --- a/unison-src/transcripts/delete-namespace.output.md +++ /dev/null @@ -1,120 +0,0 @@ -# delete.namespace.force - -``` unison -no_dependencies.thing = "no dependents on this term" - -dependencies.term1 = 1 -dependencies.term2 = 2 - -dependents.usage1 = dependencies.term1 + dependencies.term2 -dependents.usage2 = dependencies.term1 * dependencies.term2 -``` - -Deleting a namespace with no external dependencies should succeed. - -``` ucm -scratch/main> delete.namespace no_dependencies - - Done. - -``` -Deleting a namespace with external dependencies should fail and list all dependents. - -``` ucm -scratch/main> delete.namespace dependencies - - ⚠️ - - I didn't delete the namespace because the following - definitions are still in use. - - Dependency Referenced In - term2 1. dependents.usage1 - 2. dependents.usage2 - - term1 3. dependents.usage1 - 4. dependents.usage2 - - If you want to proceed anyways and leave those definitions - without names, use delete.namespace.force - -``` -Deleting a namespace with external dependencies should succeed when using `delete.namespace.force` - -``` ucm -scratch/main> delete.namespace.force dependencies - - Done. - - ⚠️ - - Of the things I deleted, the following are still used in the - following definitions. They now contain un-named references. - - Dependency Referenced In - term2 1. dependents.usage1 - 2. dependents.usage2 - - term1 3. dependents.usage1 - 4. dependents.usage2 - -``` -I should be able to view an affected dependency by number - -``` ucm -scratch/main> view 2 - - dependents.usage2 : Nat - dependents.usage2 = - use Nat * - #gjmq673r1v * #dcgdua2lj6 - -``` -Deleting the root namespace should require confirmation if not forced. - -``` ucm -scratch/main> delete.namespace . - - ⚠️ - - Are you sure you want to clear away everything? - You could use `project.create` to switch to a new project - instead, or delete the current branch with `delete.branch` - -scratch/main> delete.namespace . - - Okay, I deleted everything except the history. Use `undo` to - undo, or `builtins.merge` to restore the absolute basics to - the current path. - --- Should have an empty history -scratch/main> history . - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #sg60bvjo91 (start of history) - -``` -Deleting the root namespace shouldn't require confirmation if forced. - -``` ucm -scratch/main> delete.namespace.force . - - Okay, I deleted everything except the history. Use `undo` to - undo, or `builtins.merge` to restore the absolute basics to - the current path. - --- Should have an empty history -scratch/main> history . - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #sg60bvjo91 (start of history) - -``` diff --git a/unison-src/transcripts/delete-project-branch.md b/unison-src/transcripts/delete-project-branch.md deleted file mode 100644 index 923df54ba1..0000000000 --- a/unison-src/transcripts/delete-project-branch.md +++ /dev/null @@ -1,42 +0,0 @@ -Deleting the branch you are on takes you to its parent (though this is impossible to see in a transcript, since we set -your working directory with each command). - -```ucm -foo/main> branch topic -foo/topic> delete.branch /topic -``` - -A branch need not be preceded by a forward slash. - -```ucm -foo/main> branch topic -foo/topic> delete.branch topic -``` - -You can precede the branch name by a project name. - -```ucm -foo/main> branch topic -scratch/main> delete.branch foo/topic -``` - -You can delete the only branch in a project. - -```ucm -foo/main> delete.branch /main -``` - -You can delete the last branch in the project, a new one will be created. - -```ucm -scratch/main> delete.branch scratch/main -scratch/main> branches -``` - -If the the last branch isn't /main, then /main will be created. - -```ucm -scratch/main2> delete.branch /main -scratch/main2> delete.branch /main2 -scratch/other> branches -``` diff --git a/unison-src/transcripts/delete-project-branch.output.md b/unison-src/transcripts/delete-project-branch.output.md deleted file mode 100644 index 9423a7ed2c..0000000000 --- a/unison-src/transcripts/delete-project-branch.output.md +++ /dev/null @@ -1,72 +0,0 @@ -Deleting the branch you are on takes you to its parent (though this is impossible to see in a transcript, since we set -your working directory with each command). - -``` ucm -foo/main> branch topic - - Done. I've created the topic branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic`. - -foo/topic> delete.branch /topic - -``` -A branch need not be preceded by a forward slash. - -``` ucm -foo/main> branch topic - - Done. I've created the topic branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic`. - -foo/topic> delete.branch topic - -``` -You can precede the branch name by a project name. - -``` ucm -foo/main> branch topic - - Done. I've created the topic branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic`. - -scratch/main> delete.branch foo/topic - -``` -You can delete the only branch in a project. - -``` ucm -foo/main> delete.branch /main - -``` -You can delete the last branch in the project, a new one will be created. - -``` ucm -scratch/main> delete.branch scratch/main - -scratch/main> branches - - Branch Remote branch - 1. main - 2. main2 - -``` -If the the last branch isn't /main, then /main will be created. - -``` ucm -scratch/main2> delete.branch /main - -scratch/main2> delete.branch /main2 - -scratch/other> branches - - Branch Remote branch - 1. main - 2. other - -``` diff --git a/unison-src/transcripts/delete-project.md b/unison-src/transcripts/delete-project.md deleted file mode 100644 index 35774b7e81..0000000000 --- a/unison-src/transcripts/delete-project.md +++ /dev/null @@ -1,19 +0,0 @@ -# delete.project - -```ucm -scratch/main> project.create-empty foo -scratch/main> project.create-empty bar --- I can delete the project I'm currently on -scratch/main> delete.project scratch -foo/main> projects --- I can delete a different project -foo/main> delete.project bar -foo/main> projects --- I can delete the last project, a new scratch project will be created -foo/main> delete.project foo -project/main> projects --- If the last project is scratch, a scratch2 project will be created. -scratch/main> delete.project project -scratch/main> delete.project scratch -project/main> projects -``` diff --git a/unison-src/transcripts/delete-project.output.md b/unison-src/transcripts/delete-project.output.md deleted file mode 100644 index 37d8b2e350..0000000000 --- a/unison-src/transcripts/delete-project.output.md +++ /dev/null @@ -1,69 +0,0 @@ -# delete.project - -``` ucm -scratch/main> project.create-empty foo - - 🎉 I've created the project foo. - - 🎨 Type `ui` to explore this project's code in your browser. - 🔭 Discover libraries at https://share.unison-lang.org - 📖 Use `help-topic projects` to learn more about projects. - - Write your first Unison code with UCM: - - 1. Open scratch.u. - 2. Write some Unison code and save the file. - 3. In UCM, type `add` to save it to your new project. - - 🎉 🥳 Happy coding! - -scratch/main> project.create-empty bar - - 🎉 I've created the project bar. - - 🎨 Type `ui` to explore this project's code in your browser. - 🔭 Discover libraries at https://share.unison-lang.org - 📖 Use `help-topic projects` to learn more about projects. - - Write your first Unison code with UCM: - - 1. Open scratch.u. - 2. Write some Unison code and save the file. - 3. In UCM, type `add` to save it to your new project. - - 🎉 🥳 Happy coding! - --- I can delete the project I'm currently on -scratch/main> delete.project scratch - -foo/main> projects - - 1. bar - 2. foo - --- I can delete a different project -foo/main> delete.project bar - -foo/main> projects - - 1. foo - --- I can delete the last project, a new scratch project will be created -foo/main> delete.project foo - -project/main> projects - - 1. project - 2. scratch - --- If the last project is scratch, a scratch2 project will be created. -scratch/main> delete.project project - -scratch/main> delete.project scratch - -project/main> projects - - 1. project - 2. scratch2 - -``` diff --git a/unison-src/transcripts/delete-silent.md b/unison-src/transcripts/delete-silent.md deleted file mode 100644 index 5a5037e9f1..0000000000 --- a/unison-src/transcripts/delete-silent.md +++ /dev/null @@ -1,15 +0,0 @@ -```ucm:error -scratch/main> delete foo -``` - -```unison:hide -foo = 1 -structural type Foo = Foo () -``` - -```ucm -scratch/main> add -scratch/main> delete foo -scratch/main> delete.type Foo -scratch/main> delete.term Foo.Foo -``` diff --git a/unison-src/transcripts/delete-silent.output.md b/unison-src/transcripts/delete-silent.output.md deleted file mode 100644 index 49c5a0860d..0000000000 --- a/unison-src/transcripts/delete-silent.output.md +++ /dev/null @@ -1,35 +0,0 @@ -``` ucm -scratch/main> delete foo - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - foo - -``` -``` unison -foo = 1 -structural type Foo = Foo () -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - structural type Foo - foo : ##Nat - -scratch/main> delete foo - - Done. - -scratch/main> delete.type Foo - - Done. - -scratch/main> delete.term Foo.Foo - - Done. - -``` diff --git a/unison-src/transcripts/delete.md b/unison-src/transcripts/delete.md deleted file mode 100644 index 9c1b8efd1a..0000000000 --- a/unison-src/transcripts/delete.md +++ /dev/null @@ -1,183 +0,0 @@ -# Delete - -```ucm:hide -scratch/main> builtins.merge lib.builtins -``` - -The delete command can delete both terms and types. - -First, let's make sure it complains when we try to delete a name that doesn't -exist. - -```ucm:error -scratch/main> delete.verbose foo -``` - -Now for some easy cases. Deleting an unambiguous term, then deleting an -unambiguous type. - -```unison:hide -foo = 1 -structural type Foo = Foo () -``` - -```ucm -scratch/main> add -scratch/main> delete.verbose foo -scratch/main> delete.verbose Foo -scratch/main> delete.verbose Foo.Foo -``` - -How about an ambiguous term? - -```unison:hide -a.foo = 1 -a.bar = 2 -``` - -```ucm -scratch/main> add -scratch/main> debug.alias.term.force a.bar a.foo -``` - -A delete should remove both versions of the term. - -```ucm -scratch/main> delete.verbose a.foo -scratch/main> ls a -``` - -Let's repeat all that on a type, for completeness. - -```unison:hide -structural type a.Foo = Foo () -structural type a.Bar = Bar -``` - -```ucm -scratch/main> add -scratch/main> debug.alias.type.force a.Bar a.Foo -scratch/main> delete.verbose a.Foo -scratch/main> delete.verbose a.Foo.Foo -``` - -Finally, let's try to delete a term and a type with the same name. - -```unison:hide -foo = 1 -structural type foo = Foo () -``` - -```ucm -scratch/main> add -scratch/main> delete.verbose foo -``` - -We want to be able to delete multiple terms at once - -```unison:hide -a = "a" -b = "b" -c = "c" -``` - -```ucm -scratch/main> add -scratch/main> delete.verbose a b c -``` - -We can delete terms and types in the same invocation of delete - -```unison:hide -structural type Foo = Foo () -a = "a" -b = "b" -c = "c" -``` - -```ucm -scratch/main> add -scratch/main> delete.verbose a b c Foo -scratch/main> delete.verbose Foo.Foo -``` - -We can delete a type and its constructors - -```unison:hide -structural type Foo = Foo () -``` - -```ucm -scratch/main> add -scratch/main> delete.verbose Foo Foo.Foo -``` - -You should not be able to delete terms which are referenced by other terms - -```unison:hide -a = 1 -b = 2 -c = 3 -d = a + b + c -``` - -```ucm:error -scratch/main> add -scratch/main> delete.verbose a b c -``` - -But you should be able to delete all terms which reference each other in a single command - -```unison:hide -e = 11 -f = 12 + e -g = 13 + f -h = e + f + g -``` - -```ucm -scratch/main> add -scratch/main> delete.verbose e f g h -``` - -You should be able to delete a type and all the functions that reference it in a single command - -```unison:hide -structural type Foo = Foo Nat - -incrementFoo : Foo -> Nat -incrementFoo = cases - (Foo n) -> n + 1 -``` - -```ucm -scratch/main> add -scratch/main> delete.verbose Foo Foo.Foo incrementFoo -``` - -If you mess up on one of the names of your command, delete short circuits - -```unison:hide -e = 11 -f = 12 + e -g = 13 + f -h = e + f + g -``` - -```ucm:error -scratch/main> add -scratch/main> delete.verbose e f gg -``` - -Cyclical terms which are guarded by a lambda are allowed to be deleted - -```unison:hide -ping _ = 1 Nat.+ !pong -pong _ = 4 Nat.+ !ping -``` - -```ucm -scratch/main> add -scratch/main> delete.verbose ping -scratch/main> view pong -``` diff --git a/unison-src/transcripts/delete.output.md b/unison-src/transcripts/delete.output.md deleted file mode 100644 index 6107a7fd04..0000000000 --- a/unison-src/transcripts/delete.output.md +++ /dev/null @@ -1,430 +0,0 @@ -# Delete - -The delete command can delete both terms and types. - -First, let's make sure it complains when we try to delete a name that doesn't -exist. - -``` ucm -scratch/main> delete.verbose foo - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - foo - -``` -Now for some easy cases. Deleting an unambiguous term, then deleting an -unambiguous type. - -``` unison -foo = 1 -structural type Foo = Foo () -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - structural type Foo - foo : Nat - -scratch/main> delete.verbose foo - - Removed definitions: - - 1. foo : Nat - - Tip: You can use `undo` or use a hash from `reflog` to undo - this change. - -scratch/main> delete.verbose Foo - - Removed definitions: - - 1. structural type Foo - - Tip: You can use `undo` or use a hash from `reflog` to undo - this change. - -scratch/main> delete.verbose Foo.Foo - - Removed definitions: - - 1. Foo.Foo : '#089vmor9c5 - - Tip: You can use `undo` or use a hash from `reflog` to undo - this change. - -``` -How about an ambiguous term? - -``` unison -a.foo = 1 -a.bar = 2 -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - a.bar : Nat - a.foo : Nat - -scratch/main> debug.alias.term.force a.bar a.foo - - Done. - -``` -A delete should remove both versions of the term. - -``` ucm -scratch/main> delete.verbose a.foo - - Removed definitions: - - 1. a.foo#gjmq673r1v : Nat - - Name changes: - - Original Changes - 2. a.bar ┐ 3. a.foo#dcgdua2lj6 (removed) - 4. a.foo#dcgdua2lj6 ┘ - - Tip: You can use `undo` or use a hash from `reflog` to undo - this change. - -scratch/main> ls a - - 1. bar (Nat) - -``` -Let's repeat all that on a type, for completeness. - -``` unison -structural type a.Foo = Foo () -structural type a.Bar = Bar -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - structural type a.Bar - (also named lib.builtins.Unit) - structural type a.Foo - -scratch/main> debug.alias.type.force a.Bar a.Foo - - Done. - -scratch/main> delete.verbose a.Foo - - Removed definitions: - - 1. structural type a.Foo#089vmor9c5 - - Name changes: - - Original Changes - 2. a.Bar ┐ 3. a.Foo#00nv2kob8f (removed) - 4. lib.builtins.Unit │ - 5. a.Foo#00nv2kob8f ┘ - - Tip: You can use `undo` or use a hash from `reflog` to undo - this change. - -scratch/main> delete.verbose a.Foo.Foo - - Removed definitions: - - 1. a.Foo.Foo : '#089vmor9c5 - - Tip: You can use `undo` or use a hash from `reflog` to undo - this change. - -``` -Finally, let's try to delete a term and a type with the same name. - -``` unison -foo = 1 -structural type foo = Foo () -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - structural type foo - foo : Nat - -scratch/main> delete.verbose foo - - Removed definitions: - - 1. structural type foo - 2. foo : Nat - - Tip: You can use `undo` or use a hash from `reflog` to undo - this change. - -``` -We want to be able to delete multiple terms at once - -``` unison -a = "a" -b = "b" -c = "c" -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - a : Text - b : Text - c : Text - -scratch/main> delete.verbose a b c - - Removed definitions: - - 1. a : Text - 2. b : Text - 3. c : Text - - Tip: You can use `undo` or use a hash from `reflog` to undo - this change. - -``` -We can delete terms and types in the same invocation of delete - -``` unison -structural type Foo = Foo () -a = "a" -b = "b" -c = "c" -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - structural type Foo - a : Text - b : Text - c : Text - -scratch/main> delete.verbose a b c Foo - - Removed definitions: - - 1. structural type Foo - 2. a : Text - 3. b : Text - 4. c : Text - - Tip: You can use `undo` or use a hash from `reflog` to undo - this change. - -scratch/main> delete.verbose Foo.Foo - - Name changes: - - Original Changes - 1. Foo.Foo ┐ 2. Foo.Foo (removed) - 3. foo.Foo ┘ - - Tip: You can use `undo` or use a hash from `reflog` to undo - this change. - -``` -We can delete a type and its constructors - -``` unison -structural type Foo = Foo () -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - structural type Foo - -scratch/main> delete.verbose Foo Foo.Foo - - Removed definitions: - - 1. structural type Foo - - Name changes: - - Original Changes - 2. Foo.Foo ┐ 3. Foo.Foo (removed) - 4. foo.Foo ┘ - - Tip: You can use `undo` or use a hash from `reflog` to undo - this change. - -``` -You should not be able to delete terms which are referenced by other terms - -``` unison -a = 1 -b = 2 -c = 3 -d = a + b + c -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - a : Nat - b : Nat - (also named a.bar) - c : Nat - d : Nat - -scratch/main> delete.verbose a b c - - ⚠️ - - I didn't delete the following definitions because they are - still in use: - - Dependency Referenced In - c 1. d - - a 2. d - -``` -But you should be able to delete all terms which reference each other in a single command - -``` unison -e = 11 -f = 12 + e -g = 13 + f -h = e + f + g -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - e : Nat - f : Nat - g : Nat - h : Nat - -scratch/main> delete.verbose e f g h - - Removed definitions: - - 1. e : Nat - 2. f : Nat - 3. g : Nat - 4. h : Nat - - Tip: You can use `undo` or use a hash from `reflog` to undo - this change. - -``` -You should be able to delete a type and all the functions that reference it in a single command - -``` unison -structural type Foo = Foo Nat - -incrementFoo : Foo -> Nat -incrementFoo = cases - (Foo n) -> n + 1 -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - structural type Foo - incrementFoo : Foo -> Nat - -scratch/main> delete.verbose Foo Foo.Foo incrementFoo - - Removed definitions: - - 1. structural type Foo - 2. Foo.Foo : Nat -> Foo - 3. incrementFoo : Foo -> Nat - - Tip: You can use `undo` or use a hash from `reflog` to undo - this change. - -``` -If you mess up on one of the names of your command, delete short circuits - -``` unison -e = 11 -f = 12 + e -g = 13 + f -h = e + f + g -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - e : Nat - f : Nat - g : Nat - h : Nat - -scratch/main> delete.verbose e f gg - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - gg - -``` -Cyclical terms which are guarded by a lambda are allowed to be deleted - -``` unison -ping _ = 1 Nat.+ !pong -pong _ = 4 Nat.+ !ping -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - ping : 'Nat - pong : 'Nat - -scratch/main> delete.verbose ping - - Removed definitions: - - 1. ping : 'Nat - - Tip: You can use `undo` or use a hash from `reflog` to undo - this change. - -scratch/main> view pong - - pong : 'Nat - pong _ = - use Nat + - 4 + #l9uq1dpl5v.1() - -``` diff --git a/unison-src/transcripts/dependents-dependencies-debugfile.md b/unison-src/transcripts/dependents-dependencies-debugfile.md deleted file mode 100644 index 30692285ee..0000000000 --- a/unison-src/transcripts/dependents-dependencies-debugfile.md +++ /dev/null @@ -1,38 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -### `debug.file` -I can use `debug.file` to see the hashes of the last typechecked file. - -Given this .u file: -```unison:hide -structural type outside.A = A Nat outside.B -structural type outside.B = B Int -outside.c = 3 -outside.d = c < (p + 1) - -structural type inside.M = M outside.A -inside.p = c -inside.q x = x + p * p -inside.r = d -``` -```ucm -scratch/main> debug.file -``` - -This will help me make progress in some situations when UCM is being deficient or broken. - -### `dependents` / `dependencies` -But wait, there's more. I can check the dependencies and dependents of a definition: -```ucm -scratch/main> add -scratch/main> dependents q -scratch/main> dependencies q -scratch/main> dependencies B -scratch/main> dependencies d -scratch/main> dependents d -scratch/main> -``` - -We don't have an index for dependents of constructors, but iirc if you ask for that, it will show you dependents of the structural type that provided the constructor. diff --git a/unison-src/transcripts/dependents-dependencies-debugfile.output.md b/unison-src/transcripts/dependents-dependencies-debugfile.output.md deleted file mode 100644 index a02c491694..0000000000 --- a/unison-src/transcripts/dependents-dependencies-debugfile.output.md +++ /dev/null @@ -1,117 +0,0 @@ -### `debug.file` - -I can use `debug.file` to see the hashes of the last typechecked file. - -Given this .u file: - -``` unison -structural type outside.A = A Nat outside.B -structural type outside.B = B Int -outside.c = 3 -outside.d = c < (p + 1) - -structural type inside.M = M outside.A -inside.p = c -inside.q x = x + p * p -inside.r = d -``` - -``` ucm -scratch/main> debug.file - - type inside.M#h37a56c5ep - type outside.A#6l6krl7n4l - type outside.B#eo6rj0lj1b - inside.p#htoo5rnb54 - inside.q#vtdbqaojv6 - inside.r#nkgohbke6n - outside.c#f3lgjvjqoo - outside.d#ukd7tu6kds - -``` -This will help me make progress in some situations when UCM is being deficient or broken. - -### `dependents` / `dependencies` - -But wait, there's more. I can check the dependencies and dependents of a definition: - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - structural type inside.M - structural type outside.A - structural type outside.B - inside.p : Nat - inside.q : Nat -> Nat - inside.r : Boolean - outside.c : Nat - outside.d : Boolean - -scratch/main> dependents q - - q has no dependents. - -scratch/main> dependencies q - - Dependencies of: q - - Types: - - 1. Nat - - Terms: - - 2. Nat.* - 3. Nat.+ - 4. p - - Tip: Try `view 4` to see the source of any numbered item in - the above list. - -scratch/main> dependencies B - - Dependencies of: type B, B - - Types: - - 1. B - 2. Int - - Tip: Try `view 2` to see the source of any numbered item in - the above list. - -scratch/main> dependencies d - - Dependencies of: d - - Types: - - 1. Boolean - 2. Nat - - Terms: - - 3. < - 4. c - 5. Nat.+ - 6. p - - Tip: Try `view 6` to see the source of any numbered item in - the above list. - -scratch/main> dependents d - - Dependents of: d - - Terms: - - 1. r - - Tip: Try `view 1` to see the source of any numbered item in - the above list. - -``` -We don't have an index for dependents of constructors, but iirc if you ask for that, it will show you dependents of the structural type that provided the constructor. - diff --git a/unison-src/transcripts/destructuring-binds.md b/unison-src/transcripts/destructuring-binds.md deleted file mode 100644 index 2c8cf5a770..0000000000 --- a/unison-src/transcripts/destructuring-binds.md +++ /dev/null @@ -1,79 +0,0 @@ -# Destructuring binds - -```ucm:hide -scratch/main> builtins.merge -``` - -Here's a couple examples: - -```unison -ex0 : Nat -> Nat -ex0 n = - (a, _, (c,d)) = ("uno", "dos", (n, 7)) - c + d - -ex1 : (a,b,(Nat,Nat)) -> Nat -ex1 tup = - (a, b, (c,d)) = tup - c + d -``` - -```ucm -scratch/main> add -scratch/main> view ex0 ex1 -``` - -Notice that `ex0` is printed using the `cases` syntax (but `ex1` is not). The pretty-printer currently prefers the `cases` syntax if definition can be printed using either destructuring bind or `cases`. - -A destructuring bind is just syntax for a single branch pattern match. Notice that Unison detects this function as an alias of `ex1`: - -```unison -ex2 : (a,b,(Nat,Nat)) -> Nat -ex2 tup = match tup with - (a, b, (c,d)) -> c + d -``` - -## Corner cases - -Destructuring binds can't be recursive: the left-hand side bound variables aren't available on the right hand side. For instance, this doesn't typecheck: - -```unison:error -ex4 = - (a,b) = (a Nat.+ b, 19) - "Doesn't typecheck" -``` - -Even though the parser accepts any pattern on the LHS of a bind, it looks pretty weird to see things like `12 = x`, so we avoid showing a destructuring bind when the LHS is a "literal" pattern (like `42` or "hi"). Again these examples wouldn't compile with coverage checking. - -```unison -ex5 : 'Text -ex5 _ = match 99 + 1 with - 12 -> "Hi" - _ -> "Bye" - -ex5a : 'Text -ex5a _ = match (99 + 1, "hi") with - (x, "hi") -> "Not printed as a destructuring bind." - _ -> "impossible" -``` - -```ucm -scratch/main> add -scratch/main> view ex5 ex5a -``` - -Notice how it prints both an ordinary match. - -Also, for clarity, the pretty-printer shows a single-branch match if the match shadows free variables of the scrutinee, for example: - -```unison:hide -ex6 x = match x with - (x, y) -> x Nat.+ y -``` - -For clarity, the pretty-printer leaves this alone, even though in theory it could be written `(x,y) = x; x + y`: - -```ucm -scratch/main> add -scratch/main> view ex6 -``` diff --git a/unison-src/transcripts/destructuring-binds.output.md b/unison-src/transcripts/destructuring-binds.output.md deleted file mode 100644 index 371864ee95..0000000000 --- a/unison-src/transcripts/destructuring-binds.output.md +++ /dev/null @@ -1,177 +0,0 @@ -# Destructuring binds - -Here's a couple examples: - -``` unison -ex0 : Nat -> Nat -ex0 n = - (a, _, (c,d)) = ("uno", "dos", (n, 7)) - c + d - -ex1 : (a,b,(Nat,Nat)) -> Nat -ex1 tup = - (a, b, (c,d)) = tup - c + d -``` - -``` 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`: - - ex0 : Nat -> Nat - ex1 : (a, b, (Nat, Nat)) -> Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - ex0 : Nat -> Nat - ex1 : (a, b, (Nat, Nat)) -> Nat - -scratch/main> view ex0 ex1 - - ex0 : Nat -> Nat - ex0 n = - use Nat + - (a, _, (c, d)) = ("uno", "dos", (n, 7)) - c + d - - ex1 : (a, b, (Nat, Nat)) -> Nat - ex1 = cases (a, b, (c, d)) -> c Nat.+ d - -``` -Notice that `ex0` is printed using the `cases` syntax (but `ex1` is not). The pretty-printer currently prefers the `cases` syntax if definition can be printed using either destructuring bind or `cases`. - -A destructuring bind is just syntax for a single branch pattern match. Notice that Unison detects this function as an alias of `ex1`: - -``` unison -ex2 : (a,b,(Nat,Nat)) -> Nat -ex2 tup = match tup with - (a, b, (c,d)) -> c + d -``` - -``` 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`: - - ex2 : (a, b, (Nat, Nat)) -> Nat - (also named ex1) - -``` -## Corner cases - -Destructuring binds can't be recursive: the left-hand side bound variables aren't available on the right hand side. For instance, this doesn't typecheck: - -``` unison -ex4 = - (a,b) = (a Nat.+ b, 19) - "Doesn't typecheck" -``` - -``` ucm - - Loading changes detected in scratch.u. - - I couldn't figure out what a refers to here: - - 2 | (a,b) = (a Nat.+ b, 19) - - I think its type should be: - - Nat - - Some common causes of this error include: - * Your current namespace is too deep to contain the - definition in its subtree - * The definition is part of a library which hasn't been - added to this project - * You have a typo in the name - -``` -Even though the parser accepts any pattern on the LHS of a bind, it looks pretty weird to see things like `12 = x`, so we avoid showing a destructuring bind when the LHS is a "literal" pattern (like `42` or "hi"). Again these examples wouldn't compile with coverage checking. - -``` unison -ex5 : 'Text -ex5 _ = match 99 + 1 with - 12 -> "Hi" - _ -> "Bye" - -ex5a : 'Text -ex5a _ = match (99 + 1, "hi") with - (x, "hi") -> "Not printed as a destructuring bind." - _ -> "impossible" -``` - -``` 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`: - - ex5 : 'Text - ex5a : 'Text - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - ex5 : 'Text - ex5a : 'Text - -scratch/main> view ex5 ex5a - - ex5 : 'Text - ex5 _ = match 99 Nat.+ 1 with - 12 -> "Hi" - _ -> "Bye" - - ex5a : 'Text - ex5a _ = match (99 Nat.+ 1, "hi") with - (x, "hi") -> "Not printed as a destructuring bind." - _ -> "impossible" - -``` -Notice how it prints both an ordinary match. - -Also, for clarity, the pretty-printer shows a single-branch match if the match shadows free variables of the scrutinee, for example: - -``` unison -ex6 x = match x with - (x, y) -> x Nat.+ y -``` - -For clarity, the pretty-printer leaves this alone, even though in theory it could be written `(x,y) = x; x + y`: - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - ex6 : (Nat, Nat) -> Nat - -scratch/main> view ex6 - - ex6 : (Nat, Nat) -> Nat - ex6 = cases (x, y) -> x Nat.+ y - -``` diff --git a/unison-src/transcripts/diff-namespace.md b/unison-src/transcripts/diff-namespace.md deleted file mode 100644 index bdffd37231..0000000000 --- a/unison-src/transcripts/diff-namespace.md +++ /dev/null @@ -1,225 +0,0 @@ -```ucm:hide -scratch/b1> builtins.merge lib.builtins -scratch/b2> builtins.merge lib.builtins -scratch/nsx> builtins.merge lib.builtins -scratch/main> builtins.merge lib.builtins -scratch/ns1> builtins.merge lib.builtins -``` - -```unison:hide -x = 23 -fslkdjflskdjflksjdf = 663 -``` - -```ucm -scratch/b1> add -``` - -```unison:hide -x = 23 -fslkdjflskdjflksjdf = 23 -abc = 23 -``` - -```ucm -scratch/b2> add -scratch/b1> debug.alias.term.force .x .fslkdjflskdjflksjdf -``` - -```ucm -scratch/main> diff.namespace /b1: /b2: -``` -Things we want to test: - -* Diffing identical namespaces -* Adds, removes, updates - * Adds with multiple names -* Moved and copied definitions - * Moves that have more that 1 initial or final name -* ... terms and types -* New patches, modified patches, deleted patches, moved patches -* With and without propagated updates - -```unison:hide -fromJust = 1 -b = 2 -bdependent = b -c = 3 -helloWorld = "Hello, world!" - -structural type A a = A () -structural ability X a1 a2 where x : () -``` - -```ucm -scratch/ns1> add -scratch/ns1> alias.term fromJust fromJust' -scratch/ns1> alias.term helloWorld helloWorld2 -scratch/ns1> branch /ns2 -``` - -Here's what we've done so far: - -```ucm:error -scratch/main> diff.namespace .nothing /ns1: -``` - -```ucm:error -scratch/main> diff.namespace /ns1: /ns2: -``` - -```unison:hide -junk = "asldkfjasldkfj" -``` - -```ucm -scratch/ns1> add -scratch/ns1> debug.alias.term.force junk fromJust -scratch/ns1> delete.term junk -``` - -```unison:hide -fromJust = 99 -b = 999999999 -d = 4 -e = 5 -f = 6 -unique type Y a b = Y a b -``` - -```ucm -scratch/ns2> update -scratch/main> diff.namespace /ns1: /ns2: -scratch/ns2> alias.term d d' -scratch/ns2> alias.type A A' -scratch/ns2> alias.term A.A A'.A -scratch/ns2> alias.type X X' -scratch/ns2> alias.term X.x X'.x -scratch/main> diff.namespace /ns1: /ns2: -scratch/ns1> alias.type X X2 -scratch/ns1> alias.term X.x X2.x -scratch/ns2> alias.type A' A'' -scratch/ns2> alias.term A'.A A''.A -scratch/ns2> branch /ns3 -scratch/ns2> alias.term fromJust' yoohoo -scratch/ns2> delete.term.verbose fromJust' -scratch/main> diff.namespace /ns3: /ns2: -``` -```unison:hide -bdependent = "banana" -``` -```ucm -scratch/ns3> update -scratch/main> diff.namespace /ns2: /ns3: -``` - - -## Two different auto-propagated changes creating a name conflict - -Currently, the auto-propagated name-conflicted definitions are not explicitly -shown, only their also-conflicted dependency is shown. - -```unison:hide -a = 333 -b = a + 1 - -forconflicts = 777 -``` - -```ucm -scratch/nsx> add -scratch/nsx> branch /nsy -scratch/nsx> branch /nsz -``` - -```unison:hide -a = 444 -``` - -```ucm -scratch/nsy> update -``` - -```unison:hide -a = 555 -``` - -```ucm -scratch/nsz> update -scratch/nsy> branch /nsw -scratch/nsw> debug.alias.term.force .forconflicts .a -scratch/nsw> debug.alias.term.force .forconflicts .b -``` - -```ucm -scratch/main> diff.namespace /nsx: /nsw: -scratch/nsw> view a -scratch/nsw> view b -``` - -## Should be able to diff a namespace hash from history. - -```unison -x = 1 -``` - -```ucm -scratch/hashdiff> add -``` - -```unison -y = 2 -``` - -```ucm -scratch/hashdiff> add -scratch/hashdiff> history -scratch/hashdiff> diff.namespace 2 1 -``` - -## - -Updates: -- 1 to 1 - -New name conflicts: -- updates where RHS has multiple hashes (excluding when RHS=LHS) - - 1. foo#jk19sm5bf8 : Nat - do we want to force a hashqualified? Arya thinks so - ↓ - 2. ┌ foo#0ja1qfpej6 : Nat - 3. └ foo#jk19sm5bf8 : Nat - -Resolved name conflicts: -- updates where LHS had multiple hashes and RHS has one - - 4. ┌ bar#0ja1qfpej6 : Nat - 5. └ bar#jk19sm5bf8 : Nat - ↓ - 6. bar#jk19sm5bf8 : Nat - -## Display issues to fixup - -- [d] Do we want to surface new edit conflicts in patches? -- [t] two different auto-propagated changes creating a name conflict should show - up somewhere besides the auto-propagate count -- [t] Things look screwy when the type signature doesn't fit and has to get broken - up into multiple lines. Maybe just disallow that? -- [d] Delete blank line in between copies / renames entries if all entries are 1 to 1 - see todo in the code -- [x] incorrectly calculated bracket alignment on hashqualified "Name changes" (delete.output.md) -- [x] just handle deletion of isPropagated in propagate function, leave HandleInput alone (assuming this does the trick) -- [x] might want unqualified names to be qualified sometimes: -- [x] if a name is updated to a not-yet-named reference, it's shown as both an update and an add -- [x] similarly, if a conflicted name is resolved by deleting the last name to - a reference, I (arya) suspect it will show up as a Remove -- [d] Maybe group and/or add headings to the types, constructors, terms -- [x] add tagging of propagated updates to test propagated updates output -- [x] missing old names in deletion ppe (delete.output.md) (superseded by \#1143) -- [x] delete.term has some bonkers output -- [x] Make a decision about how we want to show constructors in the diff -- [x] 12.patch patch needs a space -- [x] This looks like garbage -- [x] Extra 2 blank lines at the end of the add section -- [x] Fix alignment issues with buildTable, convert to column3M (to be written) -- [x] adding an alias is showing up as an Add and a Copy; should just show as Copy -- [x] removing one of multiple aliases appears in removes + moves + copies section -- [x] some overlapping cases between Moves and Copies^ -- [x] Maybe don't list the type signature twice for aliases? diff --git a/unison-src/transcripts/diff-namespace.output.md b/unison-src/transcripts/diff-namespace.output.md deleted file mode 100644 index d26daa5323..0000000000 --- a/unison-src/transcripts/diff-namespace.output.md +++ /dev/null @@ -1,572 +0,0 @@ -``` unison -x = 23 -fslkdjflskdjflksjdf = 663 -``` - -``` ucm -scratch/b1> add - - ⍟ I've added these definitions: - - fslkdjflskdjflksjdf : Nat - x : Nat - -``` -``` unison -x = 23 -fslkdjflskdjflksjdf = 23 -abc = 23 -``` - -``` ucm -scratch/b2> add - - ⍟ I've added these definitions: - - abc : Nat - fslkdjflskdjflksjdf : Nat - x : Nat - -scratch/b1> debug.alias.term.force .x .fslkdjflskdjflksjdf - - Done. - -``` -``` ucm -scratch/main> diff.namespace /b1: /b2: - - Resolved name conflicts: - - 1. ┌ fslkdjflskdjflksjdf#sekb3fdsvb : Nat - 2. └ fslkdjflskdjflksjdf#u520d1t9kc : Nat - ↓ - 3. fslkdjflskdjflksjdf#u520d1t9kc : Nat - - Name changes: - - Original Changes - 4. x ┐ 5. abc (added) - 6. fslkdjflskdjflksjdf#u520d1t9kc ┘ 7. fslkdjflskdjflksjdf (added) - 8. fslkdjflskdjflksjdf#u520d1t9kc (removed) - -``` -Things we want to test: - - - Diffing identical namespaces - - Adds, removes, updates - - Adds with multiple names - - Moved and copied definitions - - Moves that have more that 1 initial or final name - - ... terms and types - - New patches, modified patches, deleted patches, moved patches - - With and without propagated updates - -``` unison -fromJust = 1 -b = 2 -bdependent = b -c = 3 -helloWorld = "Hello, world!" - -structural type A a = A () -structural ability X a1 a2 where x : () -``` - -``` ucm -scratch/ns1> add - - ⍟ I've added these definitions: - - structural type A a - structural ability X a1 a2 - b : Nat - bdependent : Nat - c : Nat - fromJust : Nat - helloWorld : Text - -scratch/ns1> alias.term fromJust fromJust' - - Done. - -scratch/ns1> alias.term helloWorld helloWorld2 - - Done. - -scratch/ns1> branch /ns2 - - Done. I've created the ns2 branch based off of ns1. - - Tip: To merge your work back into the ns1 branch, first - `switch /ns1` then `merge /ns2`. - -``` -Here's what we've done so far: - -``` ucm -scratch/main> diff.namespace .nothing /ns1: - - ⚠️ - - The namespace scratch/main:.nothing is empty. Was there a typo? - -``` -``` ucm -scratch/main> diff.namespace /ns1: /ns2: - - The namespaces are identical. - -``` -``` unison -junk = "asldkfjasldkfj" -``` - -``` ucm -scratch/ns1> add - - ⍟ I've added these definitions: - - junk : Text - -scratch/ns1> debug.alias.term.force junk fromJust - - Done. - -scratch/ns1> delete.term junk - - Done. - -``` -``` unison -fromJust = 99 -b = 999999999 -d = 4 -e = 5 -f = 6 -unique type Y a b = Y a b -``` - -``` ucm -scratch/ns2> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Everything typechecks, so I'm saving the results... - - Done. - -scratch/main> diff.namespace /ns1: /ns2: - - Resolved name conflicts: - - 1. ┌ fromJust#gjmq673r1v : Nat - 2. └ fromJust#rnbo52q2sh : Text - ↓ - 3. fromJust#6gn1k53ie0 : Nat - - Updates: - - 4. b : Nat - ↓ - 5. b : Nat - - 6. bdependent : Nat - ↓ - 7. bdependent : Nat - - Added definitions: - - 8. type Y a b - 9. Y.Y : a -> b -> Y a b - 10. d : Nat - 11. e : Nat - 12. f : Nat - - Name changes: - - Original Changes - 13. fromJust' ┐ 14. fromJust#gjmq673r1v (removed) - 15. fromJust#gjmq673r1v ┘ - -scratch/ns2> alias.term d d' - - Done. - -scratch/ns2> alias.type A A' - - Done. - -scratch/ns2> alias.term A.A A'.A - - Done. - -scratch/ns2> alias.type X X' - - Done. - -scratch/ns2> alias.term X.x X'.x - - Done. - -scratch/main> diff.namespace /ns1: /ns2: - - Resolved name conflicts: - - 1. ┌ fromJust#gjmq673r1v : Nat - 2. └ fromJust#rnbo52q2sh : Text - ↓ - 3. fromJust#6gn1k53ie0 : Nat - - Updates: - - 4. b : Nat - ↓ - 5. b : Nat - - 6. bdependent : Nat - ↓ - 7. bdependent : Nat - - Added definitions: - - 8. type Y a b - 9. Y.Y : a -> b -> Y a b - 10. ┌ d : Nat - 11. └ d' : Nat - 12. e : Nat - 13. f : Nat - - Name changes: - - Original Changes - 14. A 15. A' (added) - - 16. X 17. X' (added) - - 18. A.A 19. A'.A (added) - - 20. fromJust' ┐ 21. fromJust#gjmq673r1v (removed) - 22. fromJust#gjmq673r1v ┘ - - 23. X.x 24. X'.x (added) - -scratch/ns1> alias.type X X2 - - Done. - -scratch/ns1> alias.term X.x X2.x - - Done. - -scratch/ns2> alias.type A' A'' - - Done. - -scratch/ns2> alias.term A'.A A''.A - - Done. - -scratch/ns2> branch /ns3 - - Done. I've created the ns3 branch based off of ns2. - - Tip: To merge your work back into the ns2 branch, first - `switch /ns2` then `merge /ns3`. - -scratch/ns2> alias.term fromJust' yoohoo - - Done. - -scratch/ns2> delete.term.verbose fromJust' - - Name changes: - - Original Changes - 1. fromJust' ┐ 2. fromJust' (removed) - 3. yoohoo ┘ - - Tip: You can use `undo` or use a hash from `reflog` to undo - this change. - -scratch/main> diff.namespace /ns3: /ns2: - - Name changes: - - Original Changes - 1. fromJust' 2. yoohoo (added) - 3. fromJust' (removed) - -``` -``` unison -bdependent = "banana" -``` - -``` ucm -scratch/ns3> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -scratch/main> diff.namespace /ns2: /ns3: - - Updates: - - 1. bdependent : Nat - ↓ - 2. bdependent : Text - - Name changes: - - Original Changes - 3. yoohoo 4. fromJust' (added) - 5. yoohoo (removed) - -``` -## Two different auto-propagated changes creating a name conflict - -Currently, the auto-propagated name-conflicted definitions are not explicitly -shown, only their also-conflicted dependency is shown. - -``` unison -a = 333 -b = a + 1 - -forconflicts = 777 -``` - -``` ucm -scratch/nsx> add - - ⍟ I've added these definitions: - - a : Nat - b : Nat - forconflicts : Nat - -scratch/nsx> branch /nsy - - Done. I've created the nsy branch based off of nsx. - - Tip: To merge your work back into the nsx branch, first - `switch /nsx` then `merge /nsy`. - -scratch/nsx> branch /nsz - - Done. I've created the nsz branch based off of nsx. - - Tip: To merge your work back into the nsx branch, first - `switch /nsx` then `merge /nsz`. - -``` -``` unison -a = 444 -``` - -``` ucm -scratch/nsy> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Everything typechecks, so I'm saving the results... - - Done. - -``` -``` unison -a = 555 -``` - -``` ucm -scratch/nsz> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Everything typechecks, so I'm saving the results... - - Done. - -scratch/nsy> branch /nsw - - Done. I've created the nsw branch based off of nsy. - - Tip: To merge your work back into the nsy branch, first - `switch /nsy` then `merge /nsw`. - -scratch/nsw> debug.alias.term.force .forconflicts .a - - Done. - -scratch/nsw> debug.alias.term.force .forconflicts .b - - Done. - -``` -``` ucm -scratch/main> diff.namespace /nsx: /nsw: - - New name conflicts: - - 1. a#uiiiv8a86s : Nat - ↓ - 2. ┌ a#mdl4vqtu00 : Nat - 3. └ a#r3msrbpp1v : Nat - - 4. b#lhigeb1let : Nat - ↓ - 5. ┌ b#r3msrbpp1v : Nat - 6. └ b#unkqhuu66p : Nat - - Name changes: - - Original Changes - 7. forconflicts 8. a#r3msrbpp1v (added) - 9. b#r3msrbpp1v (added) - -scratch/nsw> view a - - a#mdl4vqtu00 : Nat - a#mdl4vqtu00 = 444 - - a#r3msrbpp1v : Nat - a#r3msrbpp1v = 777 - -scratch/nsw> view b - - b#r3msrbpp1v : Nat - b#r3msrbpp1v = 777 - - b#unkqhuu66p : Nat - b#unkqhuu66p = - use Nat + - a#mdl4vqtu00 + 1 - -``` -## Should be able to diff a namespace hash from history. - -``` unison -x = 1 -``` - -``` 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`: - - x : Nat - -``` -``` ucm -scratch/hashdiff> add - - ⍟ I've added these definitions: - - x : ##Nat - -``` -``` unison -y = 2 -``` - -``` 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`: - - y : ##Nat - -``` -``` ucm -scratch/hashdiff> add - - ⍟ I've added these definitions: - - y : ##Nat - -scratch/hashdiff> history - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #ru1hnjofdj - - + Adds / updates: - - y - - □ 2. #i52j9fd57b (start of history) - -scratch/hashdiff> diff.namespace 2 1 - - Added definitions: - - 1. y : ##Nat - -``` -## - -Updates: -- 1 to 1 - -New name conflicts: -- updates where RHS has multiple hashes (excluding when RHS=LHS) - -1. foo\#jk19sm5bf8 : Nat - do we want to force a hashqualified? Arya thinks so - ↓ -2. ┌ foo\#0ja1qfpej6 : Nat -3. └ foo\#jk19sm5bf8 : Nat - -Resolved name conflicts: -- updates where LHS had multiple hashes and RHS has one - -4. ┌ bar\#0ja1qfpej6 : Nat -5. └ bar\#jk19sm5bf8 : Nat - ↓ -6. bar\#jk19sm5bf8 : Nat - -## Display issues to fixup - - - \[d\] Do we want to surface new edit conflicts in patches? - - \[t\] two different auto-propagated changes creating a name conflict should show - up somewhere besides the auto-propagate count - - \[t\] Things look screwy when the type signature doesn't fit and has to get broken - up into multiple lines. Maybe just disallow that? - - \[d\] Delete blank line in between copies / renames entries if all entries are 1 to 1 - see todo in the code - - \[x\] incorrectly calculated bracket alignment on hashqualified "Name changes" (delete.output.md) - - \[x\] just handle deletion of isPropagated in propagate function, leave HandleInput alone (assuming this does the trick) - - \[x\] might want unqualified names to be qualified sometimes: - - \[x\] if a name is updated to a not-yet-named reference, it's shown as both an update and an add - - \[x\] similarly, if a conflicted name is resolved by deleting the last name to - a reference, I (arya) suspect it will show up as a Remove - - \[d\] Maybe group and/or add headings to the types, constructors, terms - - \[x\] add tagging of propagated updates to test propagated updates output - - \[x\] missing old names in deletion ppe (delete.output.md) (superseded by \#1143) - - \[x\] delete.term has some bonkers output - - \[x\] Make a decision about how we want to show constructors in the diff - - \[x\] 12.patch patch needs a space - - \[x\] This looks like garbage - - \[x\] Extra 2 blank lines at the end of the add section - - \[x\] Fix alignment issues with buildTable, convert to column3M (to be written) - - \[x\] adding an alias is showing up as an Add and a Copy; should just show as Copy - - \[x\] removing one of multiple aliases appears in removes + moves + copies section - - \[x\] some overlapping cases between Moves and Copies^ - - \[x\] Maybe don't list the type signature twice for aliases? - diff --git a/unison-src/transcripts/doc-formatting.md b/unison-src/transcripts/doc-formatting.md deleted file mode 100644 index 1f5a638084..0000000000 --- a/unison-src/transcripts/doc-formatting.md +++ /dev/null @@ -1,254 +0,0 @@ -This transcript explains a few minor details about doc parsing and pretty-printing, both from a user point of view and with some implementation notes. The later stuff is meant more as unit testing than for human consumption. (The ucm `add` commands and their output are hidden for brevity.) - -Docs can be used as inline code comments. - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -foo : Nat -> Nat -foo n = - _ = [: do the thing :] - n + 1 -``` - -```ucm:hide -scratch/main> add -``` -```ucm -scratch/main> view foo -``` - -Note that `@` and `:]` must be escaped within docs. - -```unison -escaping = [: Docs look [: like \@this \:] :] -``` - -```ucm:hide -scratch/main> add -``` -```ucm -scratch/main> view escaping -``` - -(Alas you can't have `\@` or `\:]` in your doc, as there's currently no way to 'unescape' them.) - -```unison --- Note that -- comments are preserved within doc literals. -commented = [: - example: - - -- a comment - f x = x + 1 -:] -``` - -```ucm:hide -scratch/main> add -``` -```ucm -scratch/main> view commented -``` - -### Indenting, and paragraph reflow - -Handling of indenting in docs between the parser and pretty-printer is a bit fiddly. - -```unison --- The leading and trailing spaces are stripped from the stored Doc by the --- lexer, and one leading and trailing space is inserted again on view/edit --- by the pretty-printer. -doc1 = [: hi :] -``` - -```ucm:hide -scratch/main> add -``` -```ucm -scratch/main> view doc1 -``` - -```unison --- Lines (apart from the first line, i.e. the bit between the [: and the --- first newline) are unindented until at least one of --- them hits the left margin (by a post-processing step in the parser). --- You may not notice this because the pretty-printer indents them again on --- view/edit. -doc2 = [: hello - - foo - - bar - and the rest. :] -``` - -```ucm:hide -scratch/main> add -``` -```ucm -scratch/main> view doc2 -``` - -```unison -doc3 = [: When Unison identifies a paragraph, it removes any newlines from it before storing it, and then reflows the paragraph text to fit the display window on display/view/edit. - -For these purposes, a paragraph is any sequence of non-empty lines that have zero indent (after the unindenting mentioned above.) - - - So this is not a paragraph, even - though you might want it to be. - - And this text | as a paragraph - is not treated | either. - -Note that because of the special treatment of the first line mentioned above, where its leading space is removed, it is always treated as a paragraph. - :] -``` - -```ucm:hide -scratch/main> add -``` -```ucm -scratch/main> view doc3 -``` - -```unison -doc4 = [: Here's another example of some paragraphs. - - All these lines have zero indent. - - - Apart from this one. :] -``` - -```ucm:hide -scratch/main> add -``` -```ucm -scratch/main> view doc4 -``` - -```unison --- The special treatment of the first line does mean that the following --- is pretty-printed not so prettily. To fix that we'd need to get the --- lexer to help out with interpreting doc literal indentation (because --- it knows what columns the `[:` was in.) -doc5 = [: - foo - - bar - and the rest. :] -``` - -```ucm:hide -scratch/main> add -``` -```ucm -scratch/main> view doc5 -``` - -```unison --- You can do the following to avoid that problem. -doc6 = [: - - foo - - bar - and the rest. - :] -``` - -```ucm:hide -scratch/main> add -``` -```ucm -scratch/main> view doc6 -``` - -### More testing - -```unison --- Check empty doc works. -empty = [::] - -expr = foo 1 -``` -```ucm:hide -scratch/main> add -``` -```ucm -scratch/main> view empty -``` - -```unison -test1 = [: -The internal logic starts to get hairy when you use the \@ features, for example referencing a name like @List.take. Internally, the text between each such usage is its own blob (blob ends here --> @List.take), so paragraph reflow has to be aware of multiple blobs to do paragraph reflow (or, more accurately, to do the normalization step where newlines with a paragraph are removed.) - -Para to reflow: lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor ending in ref @List.take - -@List.take starting para lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor. - -Middle of para: lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor @List.take lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor. - - - non-para line (@List.take) with ref @List.take - Another non-para line - @List.take starting non-para line - - - non-para line with ref @List.take -before a para-line lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor. - - - non-para line followed by a para line starting with ref -@List.take lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor. - -a para-line ending with ref lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor @List.take - - non-para line - -para line lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor - @List.take followed by non-para line starting with ref. - -@[signature] List.take - -@[source] foo - -@[evaluate] expr - -@[include] doc1 - --- note the leading space below - @[signature] List.take - -:] -``` -```ucm:hide -scratch/main> add -``` -```ucm -scratch/main> view test1 -``` - -```unison --- Regression test for #1363 - preservation of spaces after @ directives in first line when unindenting -reg1363 = [: `@List.take foo` bar - baz :] -``` -```ucm:hide -scratch/main> add -``` -```ucm -scratch/main> view reg1363 -``` - -```unison --- Demonstrate doc display when whitespace follows a @[source] or @[evaluate] --- whose output spans multiple lines. - -test2 = [: - Take a look at this: - @[source] foo ▶ bar -:] -``` -```ucm:hide -scratch/main> add -``` -View is fine. -```ucm -scratch/main> view test2 -``` -But note it's not obvious how display should best be handling this. At the moment it just does the simplest thing: -```ucm -scratch/main> display test2 -``` diff --git a/unison-src/transcripts/doc-formatting.output.md b/unison-src/transcripts/doc-formatting.output.md deleted file mode 100644 index 9a8d60c8bd..0000000000 --- a/unison-src/transcripts/doc-formatting.output.md +++ /dev/null @@ -1,537 +0,0 @@ -This transcript explains a few minor details about doc parsing and pretty-printing, both from a user point of view and with some implementation notes. The later stuff is meant more as unit testing than for human consumption. (The ucm `add` commands and their output are hidden for brevity.) - -Docs can be used as inline code comments. - -``` unison -foo : Nat -> Nat -foo n = - _ = [: do the thing :] - n + 1 -``` - -``` 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 -> Nat - -``` -``` ucm -scratch/main> view foo - - foo : Nat -> Nat - foo n = - use Nat + - _ = [: do the thing :] - n + 1 - -``` -Note that `@` and `:]` must be escaped within docs. - -``` unison -escaping = [: Docs look [: like \@this \:] :] -``` - -``` 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`: - - escaping : Doc - -``` -``` ucm -scratch/main> view escaping - - escaping : Doc - escaping = [: Docs look [: like \@this \:] :] - -``` -(Alas you can't have `\@` or `\:]` in your doc, as there's currently no way to 'unescape' them.) - -``` unison --- Note that -- comments are preserved within doc literals. -commented = [: - example: - - -- a comment - f x = x + 1 -:] -``` - -``` 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`: - - commented : Doc - -``` -``` ucm -scratch/main> view commented - - commented : Doc - commented = - [: example: - - -- a comment f x = x + 1 - :] - -``` -### Indenting, and paragraph reflow - -Handling of indenting in docs between the parser and pretty-printer is a bit fiddly. - -``` unison --- The leading and trailing spaces are stripped from the stored Doc by the --- lexer, and one leading and trailing space is inserted again on view/edit --- by the pretty-printer. -doc1 = [: hi :] -``` - -``` 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`: - - doc1 : Doc - -``` -``` ucm -scratch/main> view doc1 - - doc1 : Doc - doc1 = [: hi :] - -``` -``` unison --- Lines (apart from the first line, i.e. the bit between the [: and the --- first newline) are unindented until at least one of --- them hits the left margin (by a post-processing step in the parser). --- You may not notice this because the pretty-printer indents them again on --- view/edit. -doc2 = [: hello - - foo - - bar - and the rest. :] -``` - -``` 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`: - - doc2 : Doc - -``` -``` ucm -scratch/main> view doc2 - - doc2 : Doc - doc2 = - [: hello - - foo - - bar - and the rest. :] - -``` -``` unison -doc3 = [: When Unison identifies a paragraph, it removes any newlines from it before storing it, and then reflows the paragraph text to fit the display window on display/view/edit. - -For these purposes, a paragraph is any sequence of non-empty lines that have zero indent (after the unindenting mentioned above.) - - - So this is not a paragraph, even - though you might want it to be. - - And this text | as a paragraph - is not treated | either. - -Note that because of the special treatment of the first line mentioned above, where its leading space is removed, it is always treated as a paragraph. - :] -``` - -``` 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`: - - doc3 : Doc - -``` -``` ucm -scratch/main> view doc3 - - doc3 : Doc - doc3 = - [: When Unison identifies a paragraph, it removes any - newlines from it before storing it, and then reflows the - paragraph text to fit the display window on - display/view/edit. - - For these purposes, a paragraph is any sequence of non-empty - lines that have zero indent (after the unindenting mentioned - above.) - - - So this is not a paragraph, even - though you might want it to be. - - And this text | as a paragraph - is not treated | either. - - Note that because of the special treatment of the first line - mentioned above, where its leading space is removed, it is - always treated as a paragraph. - :] - -``` -``` unison -doc4 = [: Here's another example of some paragraphs. - - All these lines have zero indent. - - - Apart from this one. :] -``` - -``` 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`: - - doc4 : Doc - -``` -``` ucm -scratch/main> view doc4 - - doc4 : Doc - doc4 = - [: Here's another example of some paragraphs. - - All these lines have zero indent. - - - Apart from this one. :] - -``` -``` unison --- The special treatment of the first line does mean that the following --- is pretty-printed not so prettily. To fix that we'd need to get the --- lexer to help out with interpreting doc literal indentation (because --- it knows what columns the `[:` was in.) -doc5 = [: - foo - - bar - and the rest. :] -``` - -``` 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`: - - doc5 : Doc - -``` -``` ucm -scratch/main> view doc5 - - doc5 : Doc - doc5 = - [: - foo - - bar - and the rest. :] - -``` -``` unison --- You can do the following to avoid that problem. -doc6 = [: - - foo - - bar - and the rest. - :] -``` - -``` 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`: - - doc6 : Doc - -``` -``` ucm -scratch/main> view doc6 - - doc6 : Doc - doc6 = - [: - foo - - bar - and the rest. - :] - -``` -### More testing - -``` unison --- Check empty doc works. -empty = [::] - -expr = foo 1 -``` - -``` 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`: - - empty : Doc - expr : Nat - -``` -``` ucm -scratch/main> view empty - - empty : Doc - empty = [: :] - -``` -``` unison -test1 = [: -The internal logic starts to get hairy when you use the \@ features, for example referencing a name like @List.take. Internally, the text between each such usage is its own blob (blob ends here --> @List.take), so paragraph reflow has to be aware of multiple blobs to do paragraph reflow (or, more accurately, to do the normalization step where newlines with a paragraph are removed.) - -Para to reflow: lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor ending in ref @List.take - -@List.take starting para lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor. - -Middle of para: lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor @List.take lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor. - - - non-para line (@List.take) with ref @List.take - Another non-para line - @List.take starting non-para line - - - non-para line with ref @List.take -before a para-line lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor. - - - non-para line followed by a para line starting with ref -@List.take lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor. - -a para-line ending with ref lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor @List.take - - non-para line - -para line lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor - @List.take followed by non-para line starting with ref. - -@[signature] List.take - -@[source] foo - -@[evaluate] expr - -@[include] doc1 - --- note the leading space below - @[signature] List.take - -:] -``` - -``` 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`: - - test1 : Doc - -``` -``` ucm -scratch/main> view test1 - - test1 : Doc - test1 = - [: The internal logic starts to get hairy when you use the - \@ features, for example referencing a name like @List.take. - Internally, the text between each such usage is its own blob - (blob ends here --> @List.take), so paragraph reflow has to - be aware of multiple blobs to do paragraph reflow (or, more - accurately, to do the normalization step where newlines with - a paragraph are removed.) - - Para to reflow: lorem ipsum dolor lorem ipsum dolor lorem - ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum - dolor lorem ipsum dolor ending in ref @List.take - - @List.take starting para lorem ipsum dolor lorem ipsum dolor - lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem - ipsum dolor lorem ipsum dolor. - - Middle of para: lorem ipsum dolor lorem ipsum dolor lorem - ipsum dolor @List.take lorem ipsum dolor lorem ipsum dolor - lorem ipsum dolor lorem ipsum dolor. - - - non-para line (@List.take) with ref @List.take - Another non-para line - @List.take starting non-para line - - - non-para line with ref @List.take - before a para-line lorem ipsum dolor lorem ipsum dolor lorem - ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum - dolor lorem ipsum dolor lorem ipsum dolor. - - - non-para line followed by a para line starting with ref - @List.take lorem ipsum dolor lorem ipsum dolor lorem ipsum - dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor - lorem ipsum dolor lorem ipsum dolor. - - a para-line ending with ref lorem ipsum dolor lorem ipsum - dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor - lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor @List.take - - non-para line - - para line lorem ipsum dolor lorem ipsum dolor lorem ipsum - dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor - lorem ipsum dolor lorem ipsum dolor - @List.take followed by non-para line starting with ref. - - @[signature] List.take - - @[source] foo - - @[evaluate] expr - - @[include] doc1 - - -- note the leading space below - @[signature] List.take - - :] - -``` -``` unison --- Regression test for #1363 - preservation of spaces after @ directives in first line when unindenting -reg1363 = [: `@List.take foo` bar - baz :] -``` - -``` 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`: - - reg1363 : Doc - -``` -``` ucm -scratch/main> view reg1363 - - reg1363 : Doc - reg1363 = [: `@List.take foo` bar baz :] - -``` -``` unison --- Demonstrate doc display when whitespace follows a @[source] or @[evaluate] --- whose output spans multiple lines. - -test2 = [: - Take a look at this: - @[source] foo ▶ bar -:] -``` - -``` 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`: - - test2 : Doc - -``` -View is fine. - -``` ucm -scratch/main> view test2 - - test2 : Doc - test2 = - [: Take a look at this: - @[source] foo ▶ bar - :] - -``` -But note it's not obvious how display should best be handling this. At the moment it just does the simplest thing: - -``` ucm -scratch/main> display test2 - - Take a look at this: - foo : Nat -> Nat - foo n = - use Nat + - _ = [: do the thing :] - n + 1 ▶ bar - - -``` diff --git a/unison-src/transcripts/doc-type-link-keywords.output.md b/unison-src/transcripts/doc-type-link-keywords.output.md deleted file mode 100644 index e1b04a715c..0000000000 --- a/unison-src/transcripts/doc-type-link-keywords.output.md +++ /dev/null @@ -1,45 +0,0 @@ -Regression test to ensure that `type` and `ability` in embedded doc links are -lexed properly when they occur at the start of identifiers. - -That is, `{abilityPatterns}` should be a link to the **term** `abilityPatterns`, -not the ability `Patterns`; the lexer should see this as a single identifier. - -See https://github.com/unisonweb/unison/issues/2642 for an example. - -``` unison -abilityPatterns : () -abilityPatterns = () - -structural ability Patterns where p : () - -typeLabels : Nat -typeLabels = 5 - -structural type Labels = Labels - -docs.example1 = {{A doc that links to the {abilityPatterns} term}} -docs.example2 = {{A doc that links to the {ability Patterns} ability}} -docs.example3 = {{A doc that links to the {typeLabels} term}} -docs.example4 = {{A doc that links to the {type Labels} type}} -``` - -Now we check that each doc links to the object of the correct name: - -``` ucm -scratch/main> display docs.example1 - - A doc that links to the abilityPatterns term - -scratch/main> display docs.example2 - - A doc that links to the Patterns ability - -scratch/main> display docs.example3 - - A doc that links to the typeLabels term - -scratch/main> display docs.example4 - - A doc that links to the Labels type - -``` diff --git a/unison-src/transcripts/doc1.md b/unison-src/transcripts/doc1.md deleted file mode 100644 index 6f8459395c..0000000000 --- a/unison-src/transcripts/doc1.md +++ /dev/null @@ -1,83 +0,0 @@ -# Documenting Unison code - -```ucm:hide -scratch/main> builtins.merge lib.builtins -``` - -Unison documentation is written in Unison. Documentation is a value of the following type: - -```ucm -scratch/main> view lib.builtins.Doc -``` - -You can create these `Doc` values with ordinary code, or you can use the special syntax. A value of structural type `Doc` can be created via syntax like: - -```unison -doc1 = [: This is some documentation. - -It can span multiple lines. - -Can link to definitions like @List.drop or @List - -:] -``` - -Syntax: - -`[:` starts a documentation block; `:]` finishes it. Within the block: - -* Links to definitions are done with `@List`. `\@` (and `\:]`) if you want to escape. -* `@[signature] List.take` expands to the type signature of `List.take` -* `@[source] List.map` expands to the full source of `List.map` -* `@[include] someOtherDoc`, inserts a value `someOtherDoc : Doc` here. -* `@[evaluate] someDefinition` expands to the result of evaluating `someDefinition`, which must be a pre-existing definition in the codebase (can't be an arbitrary expression). - -### An example - -We are going to document `List.take` using some verbiage and a few examples. First we have to add the examples to the codebase: - -```unison -List.take.ex1 = take 0 [1,2,3,4,5] -List.take.ex2 = take 2 [1,2,3,4,5] -``` - -```ucm -scratch/main> add -``` - -And now let's write our docs and reference these examples: - -```unison -List.take.doc = [: -`@List.take n xs` returns the first `n` elements of `xs`. (No need to add line breaks manually. The display command will do wrapping of text for you. Indent any lines where you don't want it to do this.) - -## Examples: - - @[source] List.take.ex1 - 🔽 - @List.take.ex1 = @[evaluate] List.take.ex1 - - - @[source] List.take.ex2 - 🔽 - @List.take.ex2 = @[evaluate] List.take.ex2 -:] -``` - -Let's add it to the codebase. - -```ucm -scratch/main> add -``` - -We can view it with `docs`, which shows the `Doc` value that is associated with a definition. - -```ucm -scratch/main> docs List.take -``` - -Note that if we view the source of the documentation, the various references are *not* expanded. - -```ucm -scratch/main> view List.take -``` diff --git a/unison-src/transcripts/doc1.output.md b/unison-src/transcripts/doc1.output.md deleted file mode 100644 index 3c15677bab..0000000000 --- a/unison-src/transcripts/doc1.output.md +++ /dev/null @@ -1,159 +0,0 @@ -# Documenting Unison code - -Unison documentation is written in Unison. Documentation is a value of the following type: - -``` ucm -scratch/main> view lib.builtins.Doc - - type lib.builtins.Doc - = Blob Text - | Link Link - | Source Link - | Signature Term - | Evaluate Term - | Join [lib.builtins.Doc] - -``` -You can create these `Doc` values with ordinary code, or you can use the special syntax. A value of structural type `Doc` can be created via syntax like: - -``` unison -doc1 = [: This is some documentation. - -It can span multiple lines. - -Can link to definitions like @List.drop or @List - -:] -``` - -``` 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`: - - doc1 : Doc - -``` -Syntax: - -`[:` starts a documentation block; `:]` finishes it. Within the block: - - - Links to definitions are done with `@List`. `\@` (and `\:]`) if you want to escape. - - `@[signature] List.take` expands to the type signature of `List.take` - - `@[source] List.map` expands to the full source of `List.map` - - `@[include] someOtherDoc`, inserts a value `someOtherDoc : Doc` here. - - `@[evaluate] someDefinition` expands to the result of evaluating `someDefinition`, which must be a pre-existing definition in the codebase (can't be an arbitrary expression). - -### An example - -We are going to document `List.take` using some verbiage and a few examples. First we have to add the examples to the codebase: - -``` unison -List.take.ex1 = take 0 [1,2,3,4,5] -List.take.ex2 = take 2 [1,2,3,4,5] -``` - -``` 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`: - - List.take.ex1 : [Nat] - List.take.ex2 : [Nat] - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - List.take.ex1 : [Nat] - List.take.ex2 : [Nat] - -``` -And now let's write our docs and reference these examples: - -``` unison -List.take.doc = [: -`@List.take n xs` returns the first `n` elements of `xs`. (No need to add line breaks manually. The display command will do wrapping of text for you. Indent any lines where you don't want it to do this.) - -## Examples: - - @[source] List.take.ex1 - 🔽 - @List.take.ex1 = @[evaluate] List.take.ex1 - - - @[source] List.take.ex2 - 🔽 - @List.take.ex2 = @[evaluate] List.take.ex2 -:] -``` - -``` 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`: - - List.take.doc : Doc - -``` -Let's add it to the codebase. - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - List.take.doc : Doc - -``` -We can view it with `docs`, which shows the `Doc` value that is associated with a definition. - -``` ucm -scratch/main> docs List.take - - `List.take n xs` returns the first `n` elements of `xs`. (No - need to add line breaks manually. The display command will do - wrapping of text for you. Indent any lines where you don't - want it to do this.) - - ## Examples: - - List.take.ex1 : [Nat] - List.take.ex1 = List.take 0 [1, 2, 3, 4, 5] - 🔽 - ex1 = [] - - - List.take.ex2 : [Nat] - List.take.ex2 = List.take 2 [1, 2, 3, 4, 5] - 🔽 - ex2 = [1, 2] - - -``` -Note that if we view the source of the documentation, the various references are *not* expanded. - -``` ucm -scratch/main> view List.take - - builtin lib.builtins.List.take : - lib.builtins.Nat -> [a] -> [a] - -``` diff --git a/unison-src/transcripts/doc2.md b/unison-src/transcripts/doc2.md deleted file mode 100644 index 32cb274290..0000000000 --- a/unison-src/transcripts/doc2.md +++ /dev/null @@ -1,118 +0,0 @@ -# Test parsing and round-trip of doc2 syntax elements - -```ucm:hide -scratch/main> builtins.mergeio -``` - -```unison:hide -otherDoc : a -> Doc2 -otherDoc _ = {{ yo }} - -otherTerm : Nat -otherTerm = 99 - -fulldoc : Doc2 -fulldoc = - use Nat + - {{ -Heres some text with a -soft line break - -hard line break - -Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code block `1 + 2` - -Should print with appropriate fences for the contents: - -`No fancy quotes` - -'' There are `backticks` in here '' - -''' There are `backticks` and ''quotes'' in here ''' - -# Heading - -## Heading 2 - -Term Link: {otherTerm} - -Type Link: {type Optional} - -Term source: - -@source{term} - -Term signature: - -@signature{term} - -* List item - -Inline code: - -`` 1 + 2 `` - -` "doesn't typecheck" + 1 ` - -[Link](https://unison-lang.org) - -![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png) - -Horizontal rule - ---- - -Video - -{{ -Special - (Embed - (Any (Video [MediaSource "test.mp4" None] [("poster", "test.png")]))) -}} - -Transclusion/evaluation: - -{{ otherDoc (a -> Word a) }} - ---- - -The following markdown features aren't supported by the Doc format yet, but maybe will someday - - -> Block quote - - -Table - -| Header 1 | Header 2 | -| -------- | -------- | -| Cell 1 | Cell 2 | - - - Indented Code block - -''' - Exact whitespace should be preserved across multiple updates. Don't mess with the logo! - - _____ _ - | | |___|_|___ ___ ___ - | | | | |_ -| . | | - |_____|_|_|_|___|___|_|_| - - Line with no whitespace: - - Should have one full trailing newline below here: - -''' - -Inline '' text literal with 1 space of padding '' in the middle of a sentence. - - -}} -``` - -Format it to check that everything pretty-prints in a valid way. - -```ucm -scratch/main> debug.format -``` diff --git a/unison-src/transcripts/doc2.output.md b/unison-src/transcripts/doc2.output.md deleted file mode 100644 index dc8330c537..0000000000 --- a/unison-src/transcripts/doc2.output.md +++ /dev/null @@ -1,217 +0,0 @@ -# Test parsing and round-trip of doc2 syntax elements - -``` unison -otherDoc : a -> Doc2 -otherDoc _ = {{ yo }} - -otherTerm : Nat -otherTerm = 99 - -fulldoc : Doc2 -fulldoc = - use Nat + - {{ -Heres some text with a -soft line break - -hard line break - -Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code block `1 + 2` - -Should print with appropriate fences for the contents: - -`No fancy quotes` - -'' There are `backticks` in here '' - -''' There are `backticks` and ''quotes'' in here ''' - -# Heading - -## Heading 2 - -Term Link: {otherTerm} - -Type Link: {type Optional} - -Term source: - -@source{term} - -Term signature: - -@signature{term} - -* List item - -Inline code: - -`` 1 + 2 `` - -` "doesn't typecheck" + 1 ` - -[Link](https://unison-lang.org) - -![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png) - -Horizontal rule - ---- - -Video - -{{ -Special - (Embed - (Any (Video [MediaSource "test.mp4" None] [("poster", "test.png")]))) -}} - -Transclusion/evaluation: - -{{ otherDoc (a -> Word a) }} - ---- - -The following markdown features aren't supported by the Doc format yet, but maybe will someday - - -> Block quote - - -Table - -| Header 1 | Header 2 | -| -------- | -------- | -| Cell 1 | Cell 2 | - - - Indented Code block - -''' - Exact whitespace should be preserved across multiple updates. Don't mess with the logo! - - _____ _ - | | |___|_|___ ___ ___ - | | | | |_ -| . | | - |_____|_|_|_|___|___|_|_| - - Line with no whitespace: - - Should have one full trailing newline below here: - -''' - -Inline '' text literal with 1 space of padding '' in the middle of a sentence. - - -}} -``` - -Format it to check that everything pretty-prints in a valid way. - -``` ucm -scratch/main> debug.format - -``` -``` unison:added-by-ucm scratch.u -otherDoc : a -> Doc2 -otherDoc _ = {{ yo }} - -otherTerm : Nat -otherTerm = 99 - -fulldoc : Doc2 -fulldoc = - use Nat + - {{ - Heres some text with a soft line break - - hard line break - - Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code - block `1 + 2` - - Should print with appropriate fences for the contents: - - `No fancy quotes` - - '' There are `backticks` in here '' - - ''' There are `backticks` and ''quotes'' in here ''' - - # Heading - - ## Heading 2 - - Term Link: {otherTerm} - - Type Link: {type Optional} - - Term source: - - @source{term} - - Term signature: - - @signature{term} - - * List item - - Inline code: - - `` 1 + 2 `` - - ` "doesn't typecheck" + 1 ` - - [Link](https://unison-lang.org) - - ![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png) - - Horizontal rule - - --- - - Video - - {{ - Special - (Embed - (Any (Video [MediaSource "test.mp4" None] [("poster", "test.png")]))) - }} - - Transclusion/evaluation: - - {{ otherDoc (a -> Word a) }} - - --- - - The following markdown features aren't supported by the Doc format yet, - but maybe will someday - - > Block quote - - Table - - | Header 1 | Header 2 | | -------- | -------- | | Cell 1 | Cell 2 | - - Indented Code block - - ''' - Exact whitespace should be preserved across multiple updates. Don't mess with the logo! - - _____ _ - | | |___|_|___ ___ ___ - | | | | |_ -| . | | - |_____|_|_|_|___|___|_|_| - - Line with no whitespace: - - Should have one full trailing newline below here: - - ''' - - Inline ` text literal with 1 space of padding ` in the middle of a - sentence. - }} -``` - diff --git a/unison-src/transcripts/doc2markdown.md b/unison-src/transcripts/doc2markdown.md deleted file mode 100644 index 89b068a297..0000000000 --- a/unison-src/transcripts/doc2markdown.md +++ /dev/null @@ -1,111 +0,0 @@ -```ucm:hide -scratch/main> builtins.mergeio -``` - -```unison:hide -otherDoc : a -> Doc2 -otherDoc _ = {{ yo }} - -otherTerm : Nat -otherTerm = 99 - -fulldoc : Doc2 -fulldoc = - use Nat + - {{ -Heres some text with a -soft line break - -hard line break - -Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code block ''1 + 2'' - -# Heading - -## Heading 2 - -Term Link: {otherTerm} - -Type Link: {type Optional} - -Term source: - -@source{term} - -Term signature: - -@signature{term} - -* List item - -Inline code: - -`` 1 + 2 `` - -` "doesn't typecheck" + 1 ` - -[Link](https://unison-lang.org) - -![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png) - -Horizontal rule - ---- - -Video - -{{ -Special - (Embed - (Any (Video [MediaSource "test.mp4" None] [("poster", "test.png")]))) -}} - -Transclusion/evaluation: - -{{ otherDoc (a -> Word a) }} - ---- - -The following markdown features aren't supported by the Doc format yet, but maybe will someday - - -> Block quote - - -Table - -| Header 1 | Header 2 | -| -------- | -------- | -| Cell 1 | Cell 2 | - - - Indented Code block - - -}} -``` - -```ucm:hide -scratch/main> add -``` - -```ucm -scratch/main> debug.doc-to-markdown fulldoc -``` - -You can add docs to a term or type with a top-level doc literal above the binding: - -```unison -{{ This is a term doc }} -myTerm = 10 - --- Regression tests for https://github.com/unisonweb/unison/issues/4634 -{{ This is a type doc }} -type MyType = MyType - -{{ This is a unique type doc }} -unique type MyUniqueType = MyUniqueType - -{{ This is a structural type doc }} -structural type MyStructuralType = MyStructuralType -``` diff --git a/unison-src/transcripts/doc2markdown.output.md b/unison-src/transcripts/doc2markdown.output.md deleted file mode 100644 index d8a6b69428..0000000000 --- a/unison-src/transcripts/doc2markdown.output.md +++ /dev/null @@ -1,197 +0,0 @@ -``` unison -otherDoc : a -> Doc2 -otherDoc _ = {{ yo }} - -otherTerm : Nat -otherTerm = 99 - -fulldoc : Doc2 -fulldoc = - use Nat + - {{ -Heres some text with a -soft line break - -hard line break - -Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code block ''1 + 2'' - -# Heading - -## Heading 2 - -Term Link: {otherTerm} - -Type Link: {type Optional} - -Term source: - -@source{term} - -Term signature: - -@signature{term} - -* List item - -Inline code: - -`` 1 + 2 `` - -` "doesn't typecheck" + 1 ` - -[Link](https://unison-lang.org) - -![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png) - -Horizontal rule - ---- - -Video - -{{ -Special - (Embed - (Any (Video [MediaSource "test.mp4" None] [("poster", "test.png")]))) -}} - -Transclusion/evaluation: - -{{ otherDoc (a -> Word a) }} - ---- - -The following markdown features aren't supported by the Doc format yet, but maybe will someday - - -> Block quote - - -Table - -| Header 1 | Header 2 | -| -------- | -------- | -| Cell 1 | Cell 2 | - - - Indented Code block - - -}} -``` - -``` ucm -scratch/main> debug.doc-to-markdown fulldoc - - Heres some text with a soft line break - - hard line break - - Here's a cool **BOLD** _italic_ ~~strikethrough~~ thing with an inline code block `1 + 2` - - # Heading - - ## Heading 2 - - Term Link: `otherTerm` - - Type Link: `Optional` - - Term source: - - ```unison - term : '{g} a -> Doc2.Term - term a = Term.Term (Any a) - ``` - - - - Term signature: - - ```unison - term : '{g} a -> Doc2.Term - ``` - - - - - List item - - Inline code: - - `1 Nat.+ 2` - - ` "doesn't typecheck" + 1 ` - - [Link](https://unison-lang.org) - - ![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png) - - Horizontal rule - - --- - - Video - - ![](test.mp4) - - Transclusion/evaluation: - - yo - - - - --- - - The following markdown features aren't supported by the Doc format yet, but maybe will someday - - > Block quote - - Table - - | Header 1 | Header 2 | | -------- | -------- | | Cell 1 | Cell 2 | - - Indented Code block - - - - -``` -You can add docs to a term or type with a top-level doc literal above the binding: - -``` unison -{{ This is a term doc }} -myTerm = 10 - --- Regression tests for https://github.com/unisonweb/unison/issues/4634 -{{ This is a type doc }} -type MyType = MyType - -{{ This is a unique type doc }} -unique type MyUniqueType = MyUniqueType - -{{ This is a structural type doc }} -structural type MyStructuralType = MyStructuralType -``` - -``` 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`: - - structural type MyStructuralType - (also named builtin.Unit) - type MyType - type MyUniqueType - MyStructuralType.doc : Doc2 - MyType.doc : Doc2 - MyUniqueType.doc : Doc2 - myTerm : Nat - myTerm.doc : Doc2 - -``` diff --git a/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.md b/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.md deleted file mode 100644 index d74ca38e19..0000000000 --- a/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.md +++ /dev/null @@ -1,19 +0,0 @@ -If `foo#old` exists in old, and `foo#new` exists in new, you might think `upgrade old new` would rewrite references to -`#old` with references to `#new`. And it will... !!unless!! `#old` still exists in new. - -```ucm:hide -foo/main> builtins.merge lib.builtin -``` - -```unison -lib.old.foo = 18 -lib.new.other = 18 -lib.new.foo = 19 -mything = lib.old.foo + lib.old.foo -``` - -```ucm -foo/main> add -foo/main> upgrade old new -foo/main> view mything -``` diff --git a/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.output.md b/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.output.md deleted file mode 100644 index 9e369c57ca..0000000000 --- a/unison-src/transcripts/dont-upgrade-refs-that-exist-in-old.output.md +++ /dev/null @@ -1,48 +0,0 @@ -If `foo#old` exists in old, and `foo#new` exists in new, you might think `upgrade old new` would rewrite references to -`#old` with references to `#new`. And it will... \!\!unless\!\! `#old` still exists in new. - -``` unison -lib.old.foo = 18 -lib.new.other = 18 -lib.new.foo = 19 -mything = lib.old.foo + lib.old.foo -``` - -``` 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`: - - lib.new.foo : Nat - lib.new.other : Nat - lib.old.foo : Nat - mything : Nat - -``` -``` ucm -foo/main> add - - ⍟ I've added these definitions: - - lib.new.foo : Nat - lib.new.other : Nat - lib.old.foo : Nat - mything : Nat - -foo/main> upgrade old new - - I upgraded old to new, and removed old. - -foo/main> view mything - - mything : Nat - mything = - use Nat + - other + other - -``` diff --git a/unison-src/transcripts/duplicate-names.md b/unison-src/transcripts/duplicate-names.md deleted file mode 100644 index d40cc9e821..0000000000 --- a/unison-src/transcripts/duplicate-names.md +++ /dev/null @@ -1,54 +0,0 @@ -# Duplicate names in scratch file. - -```ucm:hide -scratch/main> builtins.merge -``` - -Term and ability constructor collisions should cause a parse error. - -```unison:error -structural ability Stream where - send : a -> () - -Stream.send : a -> () -Stream.send _ = () -``` - -Term and type constructor collisions should cause a parse error. - -```unison:error -structural type X = x - -X.x : a -> () -X.x _ = () -``` - -Ability and type constructor collisions should cause a parse error. - -```unison:error -structural type X = x -structural ability X where - x : () -``` - -Field accessors and terms with the same name should cause a parse error. - -```unison:error -structural type X = {x : ()} -X.x.modify = () -X.x.set = () -X.x = () -``` - -Types and terms with the same name are allowed. - -```unison -structural type X = Z - -X = () -``` - -```ucm -scratch/main> add -scratch/main> view X -``` diff --git a/unison-src/transcripts/duplicate-names.output.md b/unison-src/transcripts/duplicate-names.output.md deleted file mode 100644 index 7e1e838515..0000000000 --- a/unison-src/transcripts/duplicate-names.output.md +++ /dev/null @@ -1,143 +0,0 @@ -# Duplicate names in scratch file. - -Term and ability constructor collisions should cause a parse error. - -``` unison -structural ability Stream where - send : a -> () - -Stream.send : a -> () -Stream.send _ = () -``` - -``` ucm - - Loading changes detected in scratch.u. - - ❗️ - - I found multiple bindings with the name Stream.send: - 2 | send : a -> () - 3 | - 4 | Stream.send : a -> () - 5 | Stream.send _ = () - - -``` -Term and type constructor collisions should cause a parse error. - -``` unison -structural type X = x - -X.x : a -> () -X.x _ = () -``` - -``` ucm - - Loading changes detected in scratch.u. - - ❗️ - - I found multiple bindings with the name X.x: - 1 | structural type X = x - 2 | - 3 | X.x : a -> () - 4 | X.x _ = () - - -``` -Ability and type constructor collisions should cause a parse error. - -``` unison -structural type X = x -structural ability X where - x : () -``` - -``` ucm - - Loading changes detected in scratch.u. - - I found two types called X: - - 1 | structural type X = x - 2 | structural ability X where - 3 | x : () - - -``` -Field accessors and terms with the same name should cause a parse error. - -``` unison -structural type X = {x : ()} -X.x.modify = () -X.x.set = () -X.x = () -``` - -``` ucm - - Loading changes detected in scratch.u. - - ❗️ - - I found multiple bindings with the name X.x: - 1 | structural type X = {x : ()} - 2 | X.x.modify = () - 3 | X.x.set = () - 4 | X.x = () - - - I found multiple bindings with the name X.x.modify: - 1 | structural type X = {x : ()} - 2 | X.x.modify = () - - - I found multiple bindings with the name X.x.set: - 1 | structural type X = {x : ()} - 2 | X.x.modify = () - 3 | X.x.set = () - - -``` -Types and terms with the same name are allowed. - -``` unison -structural type X = Z - -X = () -``` - -``` 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`: - - structural type X - (also named builtin.Unit) - X : () - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - structural type X - (also named builtin.Unit) - X : () - -scratch/main> view X - - structural type X = Z - - X : () - X = () - -``` diff --git a/unison-src/transcripts/duplicate-term-detection.md b/unison-src/transcripts/duplicate-term-detection.md deleted file mode 100644 index 3df20584b7..0000000000 --- a/unison-src/transcripts/duplicate-term-detection.md +++ /dev/null @@ -1,42 +0,0 @@ -# Duplicate Term Detection - -```ucm:hide -scratch/main> builtins.merge -``` - - -Trivial duplicate terms should be detected: - -```unison:error -x = 1 -x = 2 -``` - -Equivalent duplicate terms should be detected: - -```unison:error -x = 1 -x = 1 -``` - -Duplicates from record accessors/setters should be detected - -```unison:error -structural type Record = {x: Nat, y: Nat} -Record.x = 1 -Record.x.set = 2 -Record.x.modify = 2 -``` - -Duplicate terms and constructors should be detected: - -```unison:error -structural type SumType = X - -SumType.X = 1 - -structural ability AnAbility where - thing : Nat -> () - -AnAbility.thing = 2 -``` diff --git a/unison-src/transcripts/duplicate-term-detection.output.md b/unison-src/transcripts/duplicate-term-detection.output.md deleted file mode 100644 index b726a6a94d..0000000000 --- a/unison-src/transcripts/duplicate-term-detection.output.md +++ /dev/null @@ -1,106 +0,0 @@ -# Duplicate Term Detection - -Trivial duplicate terms should be detected: - -``` unison -x = 1 -x = 2 -``` - -``` ucm - - Loading changes detected in scratch.u. - - ❗️ - - I found multiple bindings with the name x: - 1 | x = 1 - 2 | x = 2 - - -``` -Equivalent duplicate terms should be detected: - -``` unison -x = 1 -x = 1 -``` - -``` ucm - - Loading changes detected in scratch.u. - - ❗️ - - I found multiple bindings with the name x: - 1 | x = 1 - 2 | x = 1 - - -``` -Duplicates from record accessors/setters should be detected - -``` unison -structural type Record = {x: Nat, y: Nat} -Record.x = 1 -Record.x.set = 2 -Record.x.modify = 2 -``` - -``` ucm - - Loading changes detected in scratch.u. - - ❗️ - - I found multiple bindings with the name Record.x: - 1 | structural type Record = {x: Nat, y: Nat} - 2 | Record.x = 1 - - - I found multiple bindings with the name Record.x.modify: - 1 | structural type Record = {x: Nat, y: Nat} - 2 | Record.x = 1 - 3 | Record.x.set = 2 - 4 | Record.x.modify = 2 - - - I found multiple bindings with the name Record.x.set: - 1 | structural type Record = {x: Nat, y: Nat} - 2 | Record.x = 1 - 3 | Record.x.set = 2 - - -``` -Duplicate terms and constructors should be detected: - -``` unison -structural type SumType = X - -SumType.X = 1 - -structural ability AnAbility where - thing : Nat -> () - -AnAbility.thing = 2 -``` - -``` ucm - - Loading changes detected in scratch.u. - - ❗️ - - I found multiple bindings with the name AnAbility.thing: - 6 | thing : Nat -> () - 7 | - 8 | AnAbility.thing = 2 - - - I found multiple bindings with the name SumType.X: - 1 | structural type SumType = X - 2 | - 3 | SumType.X = 1 - - -``` diff --git a/unison-src/transcripts/ed25519.md b/unison-src/transcripts/ed25519.md deleted file mode 100644 index b7f7860c98..0000000000 --- a/unison-src/transcripts/ed25519.md +++ /dev/null @@ -1,27 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison - -up = 0xs0123456789abcdef -down = 0xsfedcba9876543210 - -secret = 0xs3885da624f4430c01326d96764da85647d403dae1fcdc9856c51037f9c647032 - -public = 0xsb14dbcf139c0e73d942a184b419e4f4fab726102bfe2b65c060b113bb379c77c - - -message = up ++ down ++ up ++ down ++ down ++ up ++ down ++ up - -signature = crypto.Ed25519.sign.impl secret public message - -sigOkay = match signature with - Left err -> Left err - Right sg -> crypto.Ed25519.verify.impl public message sg - -> signature -> sigOkay -``` - diff --git a/unison-src/transcripts/ed25519.output.md b/unison-src/transcripts/ed25519.output.md deleted file mode 100644 index 0647c3199f..0000000000 --- a/unison-src/transcripts/ed25519.output.md +++ /dev/null @@ -1,52 +0,0 @@ -``` unison -up = 0xs0123456789abcdef -down = 0xsfedcba9876543210 - -secret = 0xs3885da624f4430c01326d96764da85647d403dae1fcdc9856c51037f9c647032 - -public = 0xsb14dbcf139c0e73d942a184b419e4f4fab726102bfe2b65c060b113bb379c77c - - -message = up ++ down ++ up ++ down ++ down ++ up ++ down ++ up - -signature = crypto.Ed25519.sign.impl secret public message - -sigOkay = match signature with - Left err -> Left err - Right sg -> crypto.Ed25519.verify.impl public message sg - -> signature -> sigOkay -``` - -``` 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`: - - down : Bytes - message : Bytes - public : Bytes - secret : Bytes - sigOkay : Either Failure Boolean - signature : Either Failure Bytes - up : Bytes - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 17 | > signature - ⧩ - Right - 0xs0b76988ce7e5147d36597d2a526ec7b8e178b3ae29083598c33c9fbcdf0f84b4ff2f8c5409123dd9a0c54447861c07e21296500a98540f5d5f15d927eaa6d30a - - 18 | > sigOkay - ⧩ - Right true - -``` diff --git a/unison-src/transcripts/edit-command.md b/unison-src/transcripts/edit-command.md deleted file mode 100644 index 106b28fea4..0000000000 --- a/unison-src/transcripts/edit-command.md +++ /dev/null @@ -1,21 +0,0 @@ -```ucm -scratch/main> builtins.merge -``` - -```unison /private/tmp/scratch.u -foo = 123 - -bar = 456 - -mytest = [Ok "ok"] -``` - -```ucm -scratch/main> add -scratch/main> edit foo bar -scratch/main> edit mytest -``` - -```ucm:error -scratch/main> edit missing -``` diff --git a/unison-src/transcripts/edit-command.output.md b/unison-src/transcripts/edit-command.output.md deleted file mode 100644 index e13d5cea9c..0000000000 --- a/unison-src/transcripts/edit-command.output.md +++ /dev/null @@ -1,82 +0,0 @@ -``` ucm -scratch/main> builtins.merge - - Done. - -``` -``` unison ---- -title: /private/tmp/scratch.u ---- -foo = 123 - -bar = 456 - -mytest = [Ok "ok"] - -``` - -``` ucm - - Loading changes detected in /private/tmp/scratch.u. - - I found and typechecked these definitions in - /private/tmp/scratch.u. If you do an `add` or `update`, here's - how your codebase would change: - - ⍟ These new definitions are ok to `add`: - - bar : Nat - foo : Nat - mytest : [Result] - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - bar : Nat - foo : Nat - mytest : [Result] - -scratch/main> edit foo bar - - ☝️ - - I added 2 definitions to the top of /private/tmp/scratch.u - - You can edit them there, then run `update` to replace the - definitions currently in this namespace. - -scratch/main> edit mytest - - ☝️ - - I added 1 definitions to the top of /private/tmp/scratch.u - - You can edit them there, then run `update` to replace the - definitions currently in this namespace. - -``` -``` unison:added-by-ucm /private/tmp/scratch.u -bar : Nat -bar = 456 - -foo : Nat -foo = 123 -``` - -``` unison:added-by-ucm /private/tmp/scratch.u -test> mytest = [Ok "ok"] -``` - -``` ucm -scratch/main> edit missing - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - missing - -``` diff --git a/unison-src/transcripts/edit-namespace.md b/unison-src/transcripts/edit-namespace.md deleted file mode 100644 index ad50bc1b0d..0000000000 --- a/unison-src/transcripts/edit-namespace.md +++ /dev/null @@ -1,38 +0,0 @@ -```ucm:hide -project/main> builtins.mergeio lib.builtin -``` - -```unison -{{ ping doc }} -nested.cycle.ping n = n Nat.+ pong n - -{{ pong doc }} -nested.cycle.pong n = n Nat.+ ping n - -toplevel = "hi" - -simple.x = 10 -simple.y = 20 - --- Shouldn't edit things in lib -lib.project.ignoreMe = 30 - --- Shouldn't render record accessors -unique type Foo = { bar : Nat, baz : Nat } -``` - -```ucm -project/main> add -``` - -`edit.namespace` edits the whole namespace (minus the top-level `lib`). - -```ucm -project/main> edit.namespace -``` - -`edit.namespace` can also accept explicit paths - -```ucm -project/main> edit.namespace nested simple -``` diff --git a/unison-src/transcripts/edit-namespace.output.md b/unison-src/transcripts/edit-namespace.output.md deleted file mode 100644 index 452a5d3889..0000000000 --- a/unison-src/transcripts/edit-namespace.output.md +++ /dev/null @@ -1,147 +0,0 @@ -``` unison -{{ ping doc }} -nested.cycle.ping n = n Nat.+ pong n - -{{ pong doc }} -nested.cycle.pong n = n Nat.+ ping n - -toplevel = "hi" - -simple.x = 10 -simple.y = 20 - --- Shouldn't edit things in lib -lib.project.ignoreMe = 30 - --- Shouldn't render record accessors -unique type Foo = { bar : Nat, baz : Nat } -``` - -``` 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`: - - type Foo - Foo.bar : Foo -> Nat - Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo - Foo.bar.set : Nat -> Foo -> Foo - Foo.baz : Foo -> Nat - Foo.baz.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo - Foo.baz.set : Nat -> Foo -> Foo - lib.project.ignoreMe : Nat - nested.cycle.ping : Nat -> Nat - nested.cycle.ping.doc : Doc2 - nested.cycle.pong : Nat -> Nat - nested.cycle.pong.doc : Doc2 - simple.x : Nat - simple.y : Nat - toplevel : Text - -``` -``` ucm -project/main> add - - ⍟ I've added these definitions: - - type Foo - Foo.bar : Foo -> Nat - Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo - Foo.bar.set : Nat -> Foo -> Foo - Foo.baz : Foo -> Nat - Foo.baz.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo - Foo.baz.set : Nat -> Foo -> Foo - lib.project.ignoreMe : Nat - nested.cycle.ping : Nat -> Nat - nested.cycle.ping.doc : Doc2 - nested.cycle.pong : Nat -> Nat - nested.cycle.pong.doc : Doc2 - simple.x : Nat - simple.y : Nat - toplevel : Text - -``` -`edit.namespace` edits the whole namespace (minus the top-level `lib`). - -``` ucm -project/main> edit.namespace - - ☝️ - - I added 8 definitions to the top of scratch.u - - You can edit them there, then run `update` to replace the - definitions currently in this namespace. - -``` -``` unison:added-by-ucm scratch.u -type Foo = { bar : Nat, baz : Nat } - -nested.cycle.ping : Nat -> Nat -nested.cycle.ping n = - use Nat + - n + nested.cycle.pong n - -nested.cycle.ping.doc : Doc2 -nested.cycle.ping.doc = {{ ping doc }} - -nested.cycle.pong : Nat -> Nat -nested.cycle.pong n = - use Nat + - n + nested.cycle.ping n - -nested.cycle.pong.doc : Doc2 -nested.cycle.pong.doc = {{ pong doc }} - -simple.x : Nat -simple.x = 10 - -simple.y : Nat -simple.y = 20 - -toplevel : Text -toplevel = "hi" -``` - -`edit.namespace` can also accept explicit paths - -``` ucm -project/main> edit.namespace nested simple - - ☝️ - - I added 6 definitions to the top of scratch.u - - You can edit them there, then run `update` to replace the - definitions currently in this namespace. - -``` -``` unison:added-by-ucm scratch.u -nested.cycle.ping : Nat -> Nat -nested.cycle.ping n = - use Nat + - n + nested.cycle.pong n - -nested.cycle.ping.doc : Doc2 -nested.cycle.ping.doc = {{ ping doc }} - -nested.cycle.pong : Nat -> Nat -nested.cycle.pong n = - use Nat + - n + nested.cycle.ping n - -nested.cycle.pong.doc : Doc2 -nested.cycle.pong.doc = {{ pong doc }} - -simple.x : Nat -simple.x = 10 - -simple.y : Nat -simple.y = 20 -``` - diff --git a/unison-src/transcripts/empty-namespaces.md b/unison-src/transcripts/empty-namespaces.md deleted file mode 100644 index ff9cb042dc..0000000000 --- a/unison-src/transcripts/empty-namespaces.md +++ /dev/null @@ -1,77 +0,0 @@ -# Empty namespace behaviours - -```unison:hide -mynamespace.x = 1 -``` - -```ucm:hide -scratch/main> add -scratch/main> delete.namespace mynamespace -``` - -The deleted namespace shouldn't appear in `ls` output. -```ucm:error -scratch/main> ls -``` -```ucm:error -scratch/main> find.verbose -``` -```ucm:error -scratch/main> find mynamespace -``` - -## history - -The history of the namespace should be empty. - -```ucm -scratch/main> history mynamespace -``` - -Add and then delete a term to add some history to a deleted namespace. - -```unison:hide -deleted.x = 1 -stuff.thing = 2 -``` - -```ucm:hide -scratch/main> add -scratch/main> delete.namespace deleted -``` - -## fork - -I should be allowed to fork over a deleted namespace - -```ucm -scratch/main> fork stuff deleted -``` - -The history from the `deleted` namespace should have been overwritten by the history from `stuff`. - -```ucm -scratch/main> history stuff -scratch/main> history deleted -``` - -## move.namespace - -```unison:hide -moveoverme.x = 1 -moveme.y = 2 -``` - -```ucm:hide -scratch/main> add -``` - -I should be able to move a namespace over-top of a deleted namespace. -The history should be that of the moved namespace. - -```ucm -scratch/main> delete.namespace moveoverme -scratch/main> history moveme -scratch/main> move.namespace moveme moveoverme -scratch/main> history moveoverme -``` diff --git a/unison-src/transcripts/empty-namespaces.output.md b/unison-src/transcripts/empty-namespaces.output.md deleted file mode 100644 index b1b647ecda..0000000000 --- a/unison-src/transcripts/empty-namespaces.output.md +++ /dev/null @@ -1,140 +0,0 @@ -# Empty namespace behaviours - -``` unison -mynamespace.x = 1 -``` - -The deleted namespace shouldn't appear in `ls` output. - -``` ucm -scratch/main> ls - - nothing to show - -``` -``` ucm -scratch/main> find.verbose - - ☝️ - - I couldn't find matches in this namespace, searching in - 'lib'... - - 😶 - - No results. Check your spelling, or try using tab completion - to supply command arguments. - - `debug.find.global` can be used to search outside the current - namespace. - -``` -``` ucm -scratch/main> find mynamespace - - ☝️ - - I couldn't find matches in this namespace, searching in - 'lib'... - - 😶 - - No results. Check your spelling, or try using tab completion - to supply command arguments. - - `debug.find.global` can be used to search outside the current - namespace. - -``` -## history - -The history of the namespace should be empty. - -``` ucm -scratch/main> history mynamespace - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #sg60bvjo91 (start of history) - -``` -Add and then delete a term to add some history to a deleted namespace. - -``` unison -deleted.x = 1 -stuff.thing = 2 -``` - -## fork - -I should be allowed to fork over a deleted namespace - -``` ucm -scratch/main> fork stuff deleted - - Done. - -``` -The history from the `deleted` namespace should have been overwritten by the history from `stuff`. - -``` ucm -scratch/main> history stuff - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #q2dq4tsno1 (start of history) - -scratch/main> history deleted - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #q2dq4tsno1 (start of history) - -``` -## move.namespace - -``` unison -moveoverme.x = 1 -moveme.y = 2 -``` - -I should be able to move a namespace over-top of a deleted namespace. -The history should be that of the moved namespace. - -``` ucm -scratch/main> delete.namespace moveoverme - - Done. - -scratch/main> history moveme - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #c5uisu4kll (start of history) - -scratch/main> move.namespace moveme moveoverme - - Done. - -scratch/main> history moveoverme - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #c5uisu4kll (start of history) - -``` diff --git a/unison-src/transcripts/emptyCodebase.md b/unison-src/transcripts/emptyCodebase.md deleted file mode 100644 index 03b4e44e9e..0000000000 --- a/unison-src/transcripts/emptyCodebase.md +++ /dev/null @@ -1,27 +0,0 @@ -# The empty codebase - -The Unison codebase, when first initialized, contains no definitions in its namespace. - -Not even `Nat` or `+`! - -BEHOLD!!! - -```ucm:error -scratch/main> ls -``` - -Technically, the definitions all exist, but they have no names. `builtins.merge` brings them into existence, under the current namespace: - -```ucm -scratch/main> builtins.merge lib.builtins -scratch/main> ls lib -``` - -And for a limited time, you can get even more builtin goodies: - -```ucm -scratch/main> builtins.mergeio lib.builtinsio -scratch/main> ls lib -``` - -More typically, you'd start out by pulling `base`. diff --git a/unison-src/transcripts/emptyCodebase.output.md b/unison-src/transcripts/emptyCodebase.output.md deleted file mode 100644 index 86c4b63ff2..0000000000 --- a/unison-src/transcripts/emptyCodebase.output.md +++ /dev/null @@ -1,41 +0,0 @@ -# The empty codebase - -The Unison codebase, when first initialized, contains no definitions in its namespace. - -Not even `Nat` or `+`\! - -BEHOLD\!\!\! - -``` ucm -scratch/main> ls - - nothing to show - -``` -Technically, the definitions all exist, but they have no names. `builtins.merge` brings them into existence, under the current namespace: - -``` ucm -scratch/main> builtins.merge lib.builtins - - Done. - -scratch/main> ls lib - - 1. builtins/ (469 terms, 74 types) - -``` -And for a limited time, you can get even more builtin goodies: - -``` ucm -scratch/main> builtins.mergeio lib.builtinsio - - Done. - -scratch/main> ls lib - - 1. builtins/ (469 terms, 74 types) - 2. builtinsio/ (643 terms, 92 types) - -``` -More typically, you'd start out by pulling `base`. - diff --git a/unison-src/transcripts/error-messages.md b/unison-src/transcripts/error-messages.md deleted file mode 100644 index 8490e491a2..0000000000 --- a/unison-src/transcripts/error-messages.md +++ /dev/null @@ -1,121 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -This file contains programs with parse errors and type errors, for visual inspection of error message quality and to check for regressions or changes to error reporting. - -## Parse errors - -Some basic errors of literals. - -### Floating point literals - -```unison:error -x = 1. -- missing some digits after the decimal -``` - -```unison:error -x = 1e -- missing an exponent -``` - -```unison:error -x = 1e- -- missing an exponent -``` - -```unison:error -x = 1E+ -- missing an exponent -``` - -### Hex, octal, and bytes literals - -```unison:error -x = 0xoogabooga -- invalid hex chars -``` - -```unison:error -x = 0o987654321 -- 9 and 8 are not valid octal char -``` - -```unison:error -x = 0xsf -- odd number of hex chars in a bytes literal -``` - -```unison:error -x = 0xsnotvalidhexchars -- invalid hex chars in a bytes literal -``` - -### Layout errors - -```unison:error -foo = else -- not matching if -``` - -```unison:error -foo = then -- unclosed -``` - -```unison:error -foo = with -- unclosed -``` - -### Matching - -```unison:error --- No cases -foo = match 1 with -``` - -```unison:error -foo = match 1 with - 2 -- no right-hand-side -``` - -```unison:error --- Mismatched arities -foo = cases - 1, 2 -> () - 3 -> () -``` - -```unison:error --- Missing a '->' -x = match Some a with - None -> - 1 - Some _ - 2 -``` - -```unison:error --- Missing patterns -x = match Some a with - None -> 1 - -> 2 - -> 3 -``` - -```unison:error --- Guards following an unguarded case -x = match Some a with - None -> 1 - | true -> 2 -``` - -### Watches - -```unison:error --- Empty watch -> -``` - -### Keywords - -```unison:error -use.keyword.in.namespace = 1 -``` - -```unison:error --- reserved operator -a ! b = 1 -``` diff --git a/unison-src/transcripts/error-messages.output.md b/unison-src/transcripts/error-messages.output.md deleted file mode 100644 index 03e7e652ac..0000000000 --- a/unison-src/transcripts/error-messages.output.md +++ /dev/null @@ -1,378 +0,0 @@ -This file contains programs with parse errors and type errors, for visual inspection of error message quality and to check for regressions or changes to error reporting. - -## Parse errors - -Some basic errors of literals. - -### Floating point literals - -``` unison -x = 1. -- missing some digits after the decimal -``` - -``` ucm - - Loading changes detected in scratch.u. - - This number isn't valid syntax: - - 1 | x = 1. -- missing some digits after the decimal - - I was expecting some digits after the `.` , for example: `1.0` - or `1.1e37`. - -``` -``` unison -x = 1e -- missing an exponent -``` - -``` ucm - - Loading changes detected in scratch.u. - - This number isn't valid syntax: - - 1 | x = 1e -- missing an exponent - - I was expecting some digits for the exponent, for example: - `1e37`. - -``` -``` unison -x = 1e- -- missing an exponent -``` - -``` ucm - - Loading changes detected in scratch.u. - - This number isn't valid syntax: - - 1 | x = 1e- -- missing an exponent - - I was expecting some digits for the exponent, for example: - `1e-37`. - -``` -``` unison -x = 1E+ -- missing an exponent -``` - -``` ucm - - Loading changes detected in scratch.u. - - This number isn't valid syntax: - - 1 | x = 1E+ -- missing an exponent - - I was expecting some digits for the exponent, for example: - `1e+37`. - -``` -### Hex, octal, and bytes literals - -``` unison -x = 0xoogabooga -- invalid hex chars -``` - -``` ucm - - Loading changes detected in scratch.u. - - This number isn't valid syntax: - - 1 | x = 0xoogabooga -- invalid hex chars - - I was expecting only hexidecimal characters (one of - 0123456789abcdefABCDEF) after the 0x. - -``` -``` unison -x = 0o987654321 -- 9 and 8 are not valid octal char -``` - -``` ucm - - Loading changes detected in scratch.u. - - This number isn't valid syntax: - - 1 | x = 0o987654321 -- 9 and 8 are not valid octal char - - I was expecting only octal characters (one of 01234567) after - the 0o. - -``` -``` unison -x = 0xsf -- odd number of hex chars in a bytes literal -``` - -``` ucm - - Loading changes detected in scratch.u. - - This bytes literal isn't valid syntax: 0xsf - - 1 | x = 0xsf -- odd number of hex chars in a bytes literal - - I was expecting an even number of hexidecimal characters (one - of 0123456789abcdefABCDEF) after the 0xs. - -``` -``` unison -x = 0xsnotvalidhexchars -- invalid hex chars in a bytes literal -``` - -``` ucm - - Loading changes detected in scratch.u. - - This bytes literal isn't valid syntax: 0xsnotvalidhexchars - - 1 | x = 0xsnotvalidhexchars -- invalid hex chars in a bytes literal - - I was expecting an even number of hexidecimal characters (one - of 0123456789abcdefABCDEF) after the 0xs. - -``` -### Layout errors - -``` unison -foo = else -- not matching if -``` - -``` ucm - - Loading changes detected in scratch.u. - - I found a closing 'else' here without a matching 'then'. - - 1 | foo = else -- not matching if - - -``` -``` unison -foo = then -- unclosed -``` - -``` ucm - - Loading changes detected in scratch.u. - - I found a closing 'then' here without a matching 'if'. - - 1 | foo = then -- unclosed - - -``` -``` unison -foo = with -- unclosed -``` - -``` ucm - - Loading changes detected in scratch.u. - - I found a closing 'with' here without a matching 'handle' or 'match'. - - 1 | foo = with -- unclosed - - -``` -### Matching - -``` unison --- No cases -foo = match 1 with -``` - -``` ucm - - Loading changes detected in scratch.u. - - 😶 - - I expected some patterns after a match / with or cases but I - didn't find any. - - 2 | foo = match 1 with - - -``` -``` unison -foo = match 1 with - 2 -- no right-hand-side -``` - -``` ucm - - Loading changes detected in scratch.u. - - I got confused here: - - 3 | - - I was surprised to find an end of section here. - I was expecting one of these instead: - - * "," - * case match - * pattern guard - -``` -``` unison --- Mismatched arities -foo = cases - 1, 2 -> () - 3 -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - 😶 - - Not all the branches of this pattern matching have the same - number of arguments. I was assuming they'd all have 2 - arguments (based on the previous patterns) but this one has - 1 arguments: - 4 | 3 -> () - - -``` -``` unison --- Missing a '->' -x = match Some a with - None -> - 1 - Some _ - 2 -``` - -``` ucm - - Loading changes detected in scratch.u. - - I got confused here: - - 7 | - - I was surprised to find an end of section here. - I was expecting one of these instead: - - * "," - * blank - * case match - * false - * pattern guard - * true - -``` -``` unison --- Missing patterns -x = match Some a with - None -> 1 - -> 2 - -> 3 -``` - -``` ucm - - Loading changes detected in scratch.u. - - I got confused here: - - 4 | -> 2 - - - I was surprised to find a -> here. - I was expecting one of these instead: - - * end of input - * newline or semicolon - -``` -``` unison --- Guards following an unguarded case -x = match Some a with - None -> 1 - | true -> 2 -``` - -``` ucm - - Loading changes detected in scratch.u. - - I got confused here: - - 4 | | true -> 2 - - - I was surprised to find a '|' here. - I was expecting one of these instead: - - * end of input - * newline or semicolon - -``` -### Watches - -``` unison --- Empty watch -> -``` - -``` ucm - - Loading changes detected in scratch.u. - - I expected a non-empty watch expression and not just ">" - - 2 | > - - -``` -### Keywords - -``` unison -use.keyword.in.namespace = 1 -``` - -``` ucm - - Loading changes detected in scratch.u. - - The identifier `namespace` used here is a reserved keyword: - - 1 | use.keyword.in.namespace = 1 - - You can avoid this problem either by renaming the identifier - or wrapping it in backticks (like `namespace` ). - -``` -``` unison --- reserved operator -a ! b = 1 -``` - -``` ucm - - Loading changes detected in scratch.u. - - This looks like the start of an expression here - - 2 | a ! b = 1 - - but at the file top-level, I expect one of the following: - - - A binding, like a = 42 OR - a : Nat - a = 42 - - A watch expression, like > a + 1 - - An `ability` declaration, like unique ability Foo where ... - - A `type` declaration, like structural type Optional a = None | Some a - - -``` diff --git a/unison-src/transcripts/errors/code-block-parse-error.md b/unison-src/transcripts/errors/code-block-parse-error.md new file mode 100644 index 0000000000..da296b4b68 --- /dev/null +++ b/unison-src/transcripts/errors/code-block-parse-error.md @@ -0,0 +1,3 @@ +``` ucm +foo/bar% this uses the wrong delimiter before the UCM command +``` diff --git a/unison-src/transcripts/errors/code-block-parse-error.output.md b/unison-src/transcripts/errors/code-block-parse-error.output.md new file mode 100644 index 0000000000..ab6626d668 --- /dev/null +++ b/unison-src/transcripts/errors/code-block-parse-error.output.md @@ -0,0 +1,6 @@ +:2:8: + | +2 | foo/bar% this uses the wrong delimiter before the UCM command + | ^ +unexpected '%' +expecting '>' diff --git a/unison-src/transcripts/errors/dont-hide-unexpected-ucm-errors.md b/unison-src/transcripts/errors/dont-hide-unexpected-ucm-errors.md new file mode 100644 index 0000000000..e84a409d72 --- /dev/null +++ b/unison-src/transcripts/errors/dont-hide-unexpected-ucm-errors.md @@ -0,0 +1,20 @@ +Since this code block is expecting an error, we still hide it. It seems unusual to want to hide an error, but maybe it’s just too verbose or something. This follows the author’s intent. + +``` ucm :hide :error +scratch/main> help pull +scratch/main> not.a.command +``` + +For comparison, here’s what we get without `:hide`. + +``` ucm :error +scratch/main> help pull +scratch/main> not.a.command +``` + +Even though this code block has `:hide` on it, we should still see the error output, because it wasn’t expecting an error. But we should continue to hide the output _before_ the error. + +``` ucm :hide +scratch/main> help pull +scratch/main> not.a.command +``` diff --git a/unison-src/transcripts/errors/dont-hide-unexpected-ucm-errors.output.md b/unison-src/transcripts/errors/dont-hide-unexpected-ucm-errors.output.md new file mode 100644 index 0000000000..218f5288a2 --- /dev/null +++ b/unison-src/transcripts/errors/dont-hide-unexpected-ucm-errors.output.md @@ -0,0 +1,59 @@ +Since this code block is expecting an error, we still hide it. It seems unusual to want to hide an error, but maybe it’s just too verbose or something. This follows the author’s intent. + +``` ucm :hide:error +scratch/main> help pull + +scratch/main> not.a.command +``` + +For comparison, here’s what we get without `:hide`. + +``` ucm :error +scratch/main> help pull + + pull + The `pull` command merges a remote namespace into a local + branch + + `pull @unison/base/main` merges the branch + `main` of the Unison + Share hosted project + `@unison/base` into + the current branch + `pull @unison/base/main my-base/topic` merges the branch + `main` of the Unison + Share hosted project + `@unison/base` into + the branch `topic` of + the local `my-base` + project + + where `remote` is a project or project branch, such as: + Project (defaults to the /main branch) `@unison/base` + Project Branch `@unison/base/feature` + Contributor Branch `@unison/base/@johnsmith/feature` + Project Release `@unison/base/releases/1.0.0` + +scratch/main> not.a.command + + ⚠️ + I don't know how to not.a.command. Type `help` or `?` to get + help. +``` + +Even though this code block has `:hide` on it, we should still see the error output, because it wasn’t expecting an error. But we should continue to hide the output *before* the error. + +``` ucm :hide +scratch/main> help pull +scratch/main> not.a.command +``` + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + +``` +⚠️ +I don't know how to not.a.command. Type `help` or `?` to get +help. +``` diff --git a/unison-src/transcripts/errors/dont-hide-unexpected-unison-errors.md b/unison-src/transcripts/errors/dont-hide-unexpected-unison-errors.md new file mode 100644 index 0000000000..a903e385be --- /dev/null +++ b/unison-src/transcripts/errors/dont-hide-unexpected-unison-errors.md @@ -0,0 +1,17 @@ +Since this code block is expecting an error, we still hide it. It seems unusual to want to hide an error, but maybe it’s just too verbose or something. This follows the author’s intent. + +``` unison :hide :error +x + x + +``` + +For comparison, here is what we get without the `:hide`. + +``` unison :error +x + x + +``` + +Even though this code block has `:hide` on it, we should still see the error output, because it wasn’t expecting an error. + +``` unison :hide +x + x + +``` diff --git a/unison-src/transcripts/errors/dont-hide-unexpected-unison-errors.output.md b/unison-src/transcripts/errors/dont-hide-unexpected-unison-errors.output.md new file mode 100644 index 0000000000..b0874d13e7 --- /dev/null +++ b/unison-src/transcripts/errors/dont-hide-unexpected-unison-errors.output.md @@ -0,0 +1,55 @@ +Since this code block is expecting an error, we still hide it. It seems unusual to want to hide an error, but maybe it’s just too verbose or something. This follows the author’s intent. + +``` unison :hide:error +x + x + +``` + +For comparison, here is what we get without the `:hide`. + +``` unison :error +x + x + +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I got confused here: + + 1 | x + x + + + + I was surprised to find a x here. + I was expecting one of these instead: + + * ability + * namespace + * newline or semicolon + * type + * use +``` + +Even though this code block has `:hide` on it, we should still see the error output, because it wasn’t expecting an error. + +``` unison :hide +x + x + +``` + +🛑 + +The transcript failed due to an error in the stanza above. The error is: + +``` +I got confused here: + + 1 | x + x + + + +I was surprised to find a x here. +I was expecting one of these instead: + +* ability +* namespace +* newline or semicolon +* type +* use +``` diff --git a/unison-src/transcripts/errors/info-string-parse-error.md b/unison-src/transcripts/errors/info-string-parse-error.md new file mode 100644 index 0000000000..641a51a0ab --- /dev/null +++ b/unison-src/transcripts/errors/info-string-parse-error.md @@ -0,0 +1,3 @@ +``` ucm :hode +doesn’t matter that this isn’t a valid UCM command, because we should have failed to parse “hode” above +``` diff --git a/unison-src/transcripts/errors/info-string-parse-error.output.md b/unison-src/transcripts/errors/info-string-parse-error.output.md new file mode 100644 index 0000000000..7c6ea84d4b --- /dev/null +++ b/unison-src/transcripts/errors/info-string-parse-error.output.md @@ -0,0 +1,6 @@ +:1:9: + | +1 | ``` ucm :hode + | ^ +unexpected ':' +expecting ":added-by-ucm", ":error", ":hide", ":hide:all", or newline diff --git a/unison-src/transcripts/errors/invalid-api-requests.md b/unison-src/transcripts/errors/invalid-api-requests.md index 12cfe78660..34ead03b81 100644 --- a/unison-src/transcripts/errors/invalid-api-requests.md +++ b/unison-src/transcripts/errors/invalid-api-requests.md @@ -1,3 +1,3 @@ -``` api:error +``` api DELETE /something/important ``` diff --git a/unison-src/transcripts/errors/invalid-api-requests.output.md b/unison-src/transcripts/errors/invalid-api-requests.output.md new file mode 100644 index 0000000000..1326224e62 --- /dev/null +++ b/unison-src/transcripts/errors/invalid-api-requests.output.md @@ -0,0 +1,6 @@ +:2:1: + | +2 | DELETE /something/important + | ^^^ +unexpected "DEL" +expecting " ", " ", "--", "GET", end of input, or newline diff --git a/unison-src/transcripts/errors/missing-result-typed.md b/unison-src/transcripts/errors/missing-result-typed.md index c61c2ccef7..0e6e52b806 100644 --- a/unison-src/transcripts/errors/missing-result-typed.md +++ b/unison-src/transcripts/errors/missing-result-typed.md @@ -1,17 +1,15 @@ - ### Transcript parser hidden errors -When an error is encountered in a `unison:hide:all` block +When an error is encountered in a `unison :hide:all` block then the transcript parser should print the stanza and surface a helpful message. -```ucm:hide +``` ucm :hide scratch/main> builtins.merge ``` -```unison:hide:all +``` unison :hide:all a : Nat -a = +a = b = 24 ``` - diff --git a/unison-src/transcripts/errors/missing-result-typed.output.md b/unison-src/transcripts/errors/missing-result-typed.output.md index 2357371eca..87c2308bec 100644 --- a/unison-src/transcripts/errors/missing-result-typed.output.md +++ b/unison-src/transcripts/errors/missing-result-typed.output.md @@ -1,27 +1,29 @@ ### Transcript parser hidden errors -When an error is encountered in a `unison:hide:all` block +When an error is encountered in a `unison :hide:all` block then the transcript parser should print the stanza and surface a helpful message. -``` unison +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison :hide:all a : Nat -a = +a = b = 24 ``` - - 🛑 The transcript failed due to an error in the stanza above. The error is: +``` +The last element of a block must be an expression, but this is a +definition: - The last element of a block must be an expression, but this is - a definition: - - 3 | b = 24 - - Try adding an expression at the end of the block. - It should be of type Nat. + 3 | b = 24 +Try adding an expression at the end of the block. +It should be of type Nat. +``` diff --git a/unison-src/transcripts/errors/missing-result.md b/unison-src/transcripts/errors/missing-result.md index f11fb2f546..f177ee81c8 100644 --- a/unison-src/transcripts/errors/missing-result.md +++ b/unison-src/transcripts/errors/missing-result.md @@ -1,12 +1,10 @@ - ### Transcript parser hidden errors -When an error is encountered in a `unison:hide:all` block +When an error is encountered in a `unison :hide:all` block then the transcript parser should print the stanza and surface a helpful message. -```unison:hide:all -x = +``` unison :hide:all +x = y = 24 ``` - diff --git a/unison-src/transcripts/errors/missing-result.output.md b/unison-src/transcripts/errors/missing-result.output.md index 608f5c589e..fb0ab98c9f 100644 --- a/unison-src/transcripts/errors/missing-result.output.md +++ b/unison-src/transcripts/errors/missing-result.output.md @@ -1,25 +1,23 @@ ### Transcript parser hidden errors -When an error is encountered in a `unison:hide:all` block +When an error is encountered in a `unison :hide:all` block then the transcript parser should print the stanza and surface a helpful message. -``` unison -x = +``` unison :hide:all +x = y = 24 ``` - - 🛑 The transcript failed due to an error in the stanza above. The error is: +``` +The last element of a block must be an expression, but this is a +definition: - The last element of a block must be an expression, but this is - a definition: - - 2 | y = 24 - - Try adding an expression at the end of the block. + 2 | y = 24 +Try adding an expression at the end of the block. +``` diff --git a/unison-src/transcripts/errors/no-abspath-in-ucm.md b/unison-src/transcripts/errors/no-abspath-in-ucm.md index a982bb9855..81b0cd09be 100644 --- a/unison-src/transcripts/errors/no-abspath-in-ucm.md +++ b/unison-src/transcripts/errors/no-abspath-in-ucm.md @@ -1,4 +1,4 @@ -``` ucm:error +``` ucm :error scratch/main> builtins.merge -- As of 0.5.25, we no longer allow loose code paths for UCM commands. .> ls diff --git a/unison-src/transcripts/errors/no-abspath-in-ucm.output.md b/unison-src/transcripts/errors/no-abspath-in-ucm.output.md new file mode 100644 index 0000000000..4b38721ad7 --- /dev/null +++ b/unison-src/transcripts/errors/no-abspath-in-ucm.output.md @@ -0,0 +1,6 @@ +:4:1: + | +4 | .> ls + | ^^ +unexpected ".>" +expecting " ", " ", '@', comment (delimited with “--”), end of input, or newline diff --git a/unison-src/transcripts/errors/ucm-hide-all-error.md b/unison-src/transcripts/errors/ucm-hide-all-error.md index 5952056f48..7444155923 100644 --- a/unison-src/transcripts/errors/ucm-hide-all-error.md +++ b/unison-src/transcripts/errors/ucm-hide-all-error.md @@ -1,12 +1,11 @@ - ### Transcript parser hidden errors Dangerous scary words! -When an expected error is not encountered in a `ucm:hide:all` block +When an expected error is not encountered in a `ucm :hide:all` block then the transcript parser should print the stanza and surface a helpful message. -```ucm:hide:all:error +``` ucm :hide:all:error scratch/main> history ``` diff --git a/unison-src/transcripts/errors/ucm-hide-all-error.output.md b/unison-src/transcripts/errors/ucm-hide-all-error.output.md index de409c16f8..c416257ade 100644 --- a/unison-src/transcripts/errors/ucm-hide-all-error.output.md +++ b/unison-src/transcripts/errors/ucm-hide-all-error.output.md @@ -2,16 +2,14 @@ Dangerous scary words\! -When an expected error is not encountered in a `ucm:hide:all` block +When an expected error is not encountered in a `ucm :hide:all` block then the transcript parser should print the stanza and surface a helpful message. -``` ucm +``` ucm :hide:all:error scratch/main> history ``` - - 🛑 The transcript was expecting an error in the stanza above, but did not encounter one. diff --git a/unison-src/transcripts/errors/ucm-hide-all.md b/unison-src/transcripts/errors/ucm-hide-all.md index dd4b963dfa..cb79d26753 100644 --- a/unison-src/transcripts/errors/ucm-hide-all.md +++ b/unison-src/transcripts/errors/ucm-hide-all.md @@ -1,12 +1,11 @@ - ### Transcript parser hidden errors Dangerous scary words! -When an error is encountered in a `ucm:hide:all` block +When an error is encountered in a `ucm :hide:all` block then the transcript parser should print the stanza and surface a helpful message. -```ucm:hide:all +``` ucm :hide:all scratch/main> move.namespace foo bar ``` diff --git a/unison-src/transcripts/errors/ucm-hide-all.output.md b/unison-src/transcripts/errors/ucm-hide-all.output.md index 34b9b974a4..2753dd7f11 100644 --- a/unison-src/transcripts/errors/ucm-hide-all.output.md +++ b/unison-src/transcripts/errors/ucm-hide-all.output.md @@ -2,22 +2,20 @@ Dangerous scary words\! -When an error is encountered in a `ucm:hide:all` block +When an error is encountered in a `ucm :hide:all` block then the transcript parser should print the stanza and surface a helpful message. -``` ucm +``` ucm :hide:all scratch/main> move.namespace foo bar ``` - - 🛑 The transcript failed due to an error in the stanza above. The error is: +``` +⚠️ - ⚠️ - - The namespace foo doesn't exist. - +The namespace foo doesn't exist. +``` diff --git a/unison-src/transcripts/errors/ucm-hide-error.md b/unison-src/transcripts/errors/ucm-hide-error.md index 9b338dfd96..802b495d49 100644 --- a/unison-src/transcripts/errors/ucm-hide-error.md +++ b/unison-src/transcripts/errors/ucm-hide-error.md @@ -1,12 +1,11 @@ - ### Transcript parser hidden errors Dangerous scary words! -When an expected error is not encountered in a `ucm:hide` block +When an expected error is not encountered in a `ucm :hide` block then the transcript parser should print the stanza and surface a helpful message. -```ucm:hide:error +``` ucm :hide:error scratch/main> history ``` diff --git a/unison-src/transcripts/errors/ucm-hide-error.output.md b/unison-src/transcripts/errors/ucm-hide-error.output.md index 893baf53e5..e2045b6ee5 100644 --- a/unison-src/transcripts/errors/ucm-hide-error.output.md +++ b/unison-src/transcripts/errors/ucm-hide-error.output.md @@ -2,16 +2,14 @@ Dangerous scary words\! -When an expected error is not encountered in a `ucm:hide` block +When an expected error is not encountered in a `ucm :hide` block then the transcript parser should print the stanza and surface a helpful message. -``` ucm +``` ucm :hide:error scratch/main> history ``` - - 🛑 The transcript was expecting an error in the stanza above, but did not encounter one. diff --git a/unison-src/transcripts/errors/ucm-hide.md b/unison-src/transcripts/errors/ucm-hide.md index 470c610b52..8cca437cc3 100644 --- a/unison-src/transcripts/errors/ucm-hide.md +++ b/unison-src/transcripts/errors/ucm-hide.md @@ -1,12 +1,11 @@ - ### Transcript parser hidden errors Dangerous scary words! -When an error is encountered in a `ucm:hide` block +When an error is encountered in a `ucm :hide` block then the transcript parser should print the stanza and surface a helpful message. -```ucm:hide +``` ucm :hide scratch/main> move.namespace foo bar ``` diff --git a/unison-src/transcripts/errors/ucm-hide.output.md b/unison-src/transcripts/errors/ucm-hide.output.md index 2058708696..c42cd9294f 100644 --- a/unison-src/transcripts/errors/ucm-hide.output.md +++ b/unison-src/transcripts/errors/ucm-hide.output.md @@ -2,22 +2,20 @@ Dangerous scary words\! -When an error is encountered in a `ucm:hide` block +When an error is encountered in a `ucm :hide` block then the transcript parser should print the stanza and surface a helpful message. -``` ucm +``` ucm :hide scratch/main> move.namespace foo bar ``` - - 🛑 The transcript failed due to an error in the stanza above. The error is: +``` +⚠️ - ⚠️ - - The namespace foo doesn't exist. - +The namespace foo doesn't exist. +``` diff --git a/unison-src/transcripts/errors/unison-hide-all-error.md b/unison-src/transcripts/errors/unison-hide-all-error.md index 0364b35fdf..e35de94e1d 100644 --- a/unison-src/transcripts/errors/unison-hide-all-error.md +++ b/unison-src/transcripts/errors/unison-hide-all-error.md @@ -1,10 +1,9 @@ - ### Transcript parser hidden errors -When an expected error is not encountered in a `unison:hide:all:error` block +When an expected error is not encountered in a `unison :hide:all:error` block then the transcript parser should print the stanza and surface a helpful message. -```unison:hide:all:error +``` unison :hide:all:error myVal = 3 -``` \ No newline at end of file +``` diff --git a/unison-src/transcripts/errors/unison-hide-all-error.output.md b/unison-src/transcripts/errors/unison-hide-all-error.output.md index fbb8a35d63..3652dfebe5 100644 --- a/unison-src/transcripts/errors/unison-hide-all-error.output.md +++ b/unison-src/transcripts/errors/unison-hide-all-error.output.md @@ -1,15 +1,13 @@ ### Transcript parser hidden errors -When an expected error is not encountered in a `unison:hide:all:error` block +When an expected error is not encountered in a `unison :hide:all:error` block then the transcript parser should print the stanza and surface a helpful message. -``` unison +``` unison :hide:all:error myVal = 3 ``` - - 🛑 The transcript was expecting an error in the stanza above, but did not encounter one. diff --git a/unison-src/transcripts/errors/unison-hide-all.md b/unison-src/transcripts/errors/unison-hide-all.md index b722caad70..48907e75e7 100644 --- a/unison-src/transcripts/errors/unison-hide-all.md +++ b/unison-src/transcripts/errors/unison-hide-all.md @@ -1,10 +1,9 @@ - ### Transcript parser hidden errors -When an error is encountered in a `unison:hide:all` block +When an error is encountered in a `unison :hide:all` block then the transcript parser should print the stanza and surface a helpful message. -```unison:hide:all +``` unison :hide:all g 3 ``` diff --git a/unison-src/transcripts/errors/unison-hide-all.output.md b/unison-src/transcripts/errors/unison-hide-all.output.md index a093b5f5ec..c27b7dd28f 100644 --- a/unison-src/transcripts/errors/unison-hide-all.output.md +++ b/unison-src/transcripts/errors/unison-hide-all.output.md @@ -1,31 +1,28 @@ ### Transcript parser hidden errors -When an error is encountered in a `unison:hide:all` block +When an error is encountered in a `unison :hide:all` block then the transcript parser should print the stanza and surface a helpful message. -``` unison +``` unison :hide:all g 3 ``` - - 🛑 The transcript failed due to an error in the stanza above. The error is: +``` +This looks like the start of an expression here - This looks like the start of an expression here - - 1 | g 3 - - but at the file top-level, I expect one of the following: - - - A binding, like g = 42 OR - g : Nat - g = 42 - - A watch expression, like > g + 1 - - An `ability` declaration, like unique ability Foo where ... - - A `type` declaration, like structural type Optional a = None | Some a - + 1 | g 3 +but at the file top-level, I expect one of the following: + + - A binding, like g = 42 OR + g : Nat + g = 42 + - A watch expression, like > g + 1 + - An `ability` declaration, like unique ability Foo where ... + - A `type` declaration, like structural type Optional a = None | Some a +``` diff --git a/unison-src/transcripts/errors/unison-hide-error.md b/unison-src/transcripts/errors/unison-hide-error.md index 1ab6e675d3..29eb056f83 100644 --- a/unison-src/transcripts/errors/unison-hide-error.md +++ b/unison-src/transcripts/errors/unison-hide-error.md @@ -1,10 +1,9 @@ - ### Transcript parser hidden errors -When an expected error is not encountered in a `unison:hide:error` block +When an expected error is not encountered in a `unison :hide:error` block then the transcript parser should print the stanza and surface a helpful message. -```unison:hide:error +``` unison :hide:error myVal = 3 -``` \ No newline at end of file +``` diff --git a/unison-src/transcripts/errors/unison-hide-error.output.md b/unison-src/transcripts/errors/unison-hide-error.output.md index bde72516fe..3a9477e8f8 100644 --- a/unison-src/transcripts/errors/unison-hide-error.output.md +++ b/unison-src/transcripts/errors/unison-hide-error.output.md @@ -1,15 +1,13 @@ ### Transcript parser hidden errors -When an expected error is not encountered in a `unison:hide:error` block +When an expected error is not encountered in a `unison :hide:error` block then the transcript parser should print the stanza and surface a helpful message. -``` unison +``` unison :hide:error myVal = 3 ``` - - 🛑 The transcript was expecting an error in the stanza above, but did not encounter one. diff --git a/unison-src/transcripts/errors/unison-hide.md b/unison-src/transcripts/errors/unison-hide.md index 52b5ef4000..4a920cfe2b 100644 --- a/unison-src/transcripts/errors/unison-hide.md +++ b/unison-src/transcripts/errors/unison-hide.md @@ -1,10 +1,9 @@ - ### Transcript parser hidden errors -When an error is encountered in a `unison:hide` block +When an error is encountered in a `unison :hide` block then the transcript parser should print the stanza and surface a helpful message. -```unison:hide +``` unison :hide g 3 ``` diff --git a/unison-src/transcripts/errors/unison-hide.output.md b/unison-src/transcripts/errors/unison-hide.output.md index 1a8a9c78a9..f9a48fb687 100644 --- a/unison-src/transcripts/errors/unison-hide.output.md +++ b/unison-src/transcripts/errors/unison-hide.output.md @@ -1,31 +1,28 @@ ### Transcript parser hidden errors -When an error is encountered in a `unison:hide` block +When an error is encountered in a `unison :hide` block then the transcript parser should print the stanza and surface a helpful message. -``` unison +``` unison :hide g 3 ``` - - 🛑 The transcript failed due to an error in the stanza above. The error is: +``` +This looks like the start of an expression here - This looks like the start of an expression here - - 1 | g 3 - - but at the file top-level, I expect one of the following: - - - A binding, like g = 42 OR - g : Nat - g = 42 - - A watch expression, like > g + 1 - - An `ability` declaration, like unique ability Foo where ... - - A `type` declaration, like structural type Optional a = None | Some a - + 1 | g 3 +but at the file top-level, I expect one of the following: + + - A binding, like g = 42 OR + g : Nat + g = 42 + - A watch expression, like > g + 1 + - An `ability` declaration, like unique ability Foo where ... + - A `type` declaration, like structural type Optional a = None | Some a +``` diff --git a/unison-src/transcripts/escape-sequences.md b/unison-src/transcripts/escape-sequences.md deleted file mode 100644 index fc7955ff3d..0000000000 --- a/unison-src/transcripts/escape-sequences.md +++ /dev/null @@ -1,5 +0,0 @@ -```unison -> "Rúnar" -> "῎Ανδρα μοι ἔννεπε, Μοῦσα, πολύτροπον" -> "古池や蛙飛びこむ水の音" -``` diff --git a/unison-src/transcripts/escape-sequences.output.md b/unison-src/transcripts/escape-sequences.output.md deleted file mode 100644 index 955b6e8fe6..0000000000 --- a/unison-src/transcripts/escape-sequences.output.md +++ /dev/null @@ -1,30 +0,0 @@ -``` unison -> "Rúnar" -> "῎Ανδρα μοι ἔννεπε, Μοῦσα, πολύτροπον" -> "古池や蛙飛びこむ水の音" -``` - -``` ucm - - Loading changes detected in scratch.u. - - ✅ - - scratch.u changed. - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 1 | > "Rúnar" - ⧩ - "Rúnar" - - 2 | > "῎Ανδρα μοι ἔννεπε, Μοῦσα, πολύτροπον" - ⧩ - "῎Ανδρα μοι ἔννεπε, Μοῦσα, πολύτροπον" - - 3 | > "古池や蛙飛びこむ水の音" - ⧩ - "古池や蛙飛びこむ水の音" - -``` diff --git a/unison-src/transcripts/find-by-type.md b/unison-src/transcripts/find-by-type.md deleted file mode 100644 index ec6dd3f954..0000000000 --- a/unison-src/transcripts/find-by-type.md +++ /dev/null @@ -1,27 +0,0 @@ -```ucm:hide -scratch/main> alias.type ##Text builtin.Text -``` - -```unison:hide -unique type A = A Text - -foo : A -foo = A "foo!" - -bar : Text -> A -bar = A - -baz : A -> Text -baz = cases - A t -> t -``` - -```ucm -scratch/main> add -scratch/main> find : Text -> A -scratch/main> find : A -> Text -scratch/main> find : A -``` -```ucm:error -scratch/main> find : Text -``` diff --git a/unison-src/transcripts/find-by-type.output.md b/unison-src/transcripts/find-by-type.output.md deleted file mode 100644 index c45fcd6a88..0000000000 --- a/unison-src/transcripts/find-by-type.output.md +++ /dev/null @@ -1,55 +0,0 @@ -``` unison -unique type A = A Text - -foo : A -foo = A "foo!" - -bar : Text -> A -bar = A - -baz : A -> Text -baz = cases - A t -> t -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type A - bar : Text -> A - baz : A -> Text - foo : A - -scratch/main> find : Text -> A - - 1. bar : Text -> A - 2. A.A : Text -> A - - -scratch/main> find : A -> Text - - 1. baz : A -> Text - - -scratch/main> find : A - - 1. foo : A - - -``` -``` ucm -scratch/main> find : Text - - ☝️ - - I couldn't find exact type matches, resorting to fuzzy - matching... - - 1. bar : Text -> A - 2. baz : A -> Text - 3. A.A : Text -> A - - -``` diff --git a/unison-src/transcripts/find-command.md b/unison-src/transcripts/find-command.md deleted file mode 100644 index 56958476a5..0000000000 --- a/unison-src/transcripts/find-command.md +++ /dev/null @@ -1,43 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge 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:hide -scratch/main> add -``` - -```ucm -scratch/main> find foo -scratch/main> view 1 -scratch/main> find.all foo -scratch/main> view 1 -``` - -```ucm -scratch/main> find-in cat foo -scratch/main> view 1 -scratch/main> find-in.all cat foo -scratch/main> view 1 -``` - -Finding within a namespace - -```ucm -scratch/main> find bar -scratch/other> debug.find.global bar -scratch/main> find-in somewhere bar -``` - -```ucm:error -scratch/main> find baz -``` diff --git a/unison-src/transcripts/find-command.output.md b/unison-src/transcripts/find-command.output.md deleted file mode 100644 index 4d3af86ad6..0000000000 --- a/unison-src/transcripts/find-command.output.md +++ /dev/null @@ -1,99 +0,0 @@ -``` unison -foo = 1 -lib.foo = 2 -lib.bar = 3 -cat.foo = 4 -cat.lib.foo = 5 -cat.lib.bar = 6 -somewhere.bar = 7 -``` - -``` ucm -scratch/main> find foo - - 1. cat.foo : Nat - 2. foo : Nat - - -scratch/main> view 1 - - cat.foo : Nat - cat.foo = 4 - -scratch/main> find.all foo - - 1. cat.foo : Nat - 2. cat.lib.foo : Nat - 3. lib.foo : Nat - 4. foo : Nat - - -scratch/main> view 1 - - cat.foo : Nat - cat.foo = 4 - -``` -``` ucm -scratch/main> find-in cat foo - - 1. foo : Nat - - -scratch/main> view 1 - - cat.foo : Nat - cat.foo = 4 - -scratch/main> find-in.all cat foo - - 1. lib.foo : Nat - 2. foo : Nat - - -scratch/main> view 1 - - cat.lib.foo : Nat - cat.lib.foo = 5 - -``` -Finding within a namespace - -``` ucm -scratch/main> find bar - - 1. somewhere.bar : Nat - - -scratch/other> debug.find.global bar - - Found results in scratch/main - - 1. .cat.lib.bar : Nat - 2. .lib.bar : Nat - 3. .somewhere.bar : Nat - - -scratch/main> find-in somewhere bar - - 1. bar : Nat - - -``` -``` ucm -scratch/main> find baz - - ☝️ - - I couldn't find matches in this namespace, searching in - 'lib'... - - 😶 - - No results. Check your spelling, or try using tab completion - to supply command arguments. - - `debug.find.global` can be used to search outside the current - namespace. - -``` diff --git a/unison-src/transcripts/fix-1381-excess-propagate.md b/unison-src/transcripts/fix-1381-excess-propagate.md deleted file mode 100644 index e7314c9bd7..0000000000 --- a/unison-src/transcripts/fix-1381-excess-propagate.md +++ /dev/null @@ -1,28 +0,0 @@ -We were seeing an issue where (it seemed) that every namespace that was visited during a propagate would get a new history node, even when it didn't contain any dependents. - -Example: -```unison:hide -a = "a term" -X.foo = "a namespace" -``` - -```ucm -scratch/main> add -``` - -Here is an update which should not affect `X`: -```unison:hide -a = "an update" -``` -```ucm -scratch/main> update -``` - -As of the time of this writing, the history for `X` should be a single node, `#4eeuo5bsfr`; -```ucm -scratch/main> history X -``` -however, as of release/M1i, we saw an extraneous node appear. If your `ucm` is fixed, you won't see it below: -```ucm:error -scratch/main> history #7nl6ppokhg -``` diff --git a/unison-src/transcripts/fix-1381-excess-propagate.output.md b/unison-src/transcripts/fix-1381-excess-propagate.output.md deleted file mode 100644 index edc30e9f25..0000000000 --- a/unison-src/transcripts/fix-1381-excess-propagate.output.md +++ /dev/null @@ -1,56 +0,0 @@ -We were seeing an issue where (it seemed) that every namespace that was visited during a propagate would get a new history node, even when it didn't contain any dependents. - -Example: - -``` unison -a = "a term" -X.foo = "a namespace" -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - X.foo : ##Text - a : ##Text - -``` -Here is an update which should not affect `X`: - -``` unison -a = "an update" -``` - -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -``` -As of the time of this writing, the history for `X` should be a single node, `#4eeuo5bsfr`; - -``` ucm -scratch/main> history X - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #das1se4g2i (start of history) - -``` -however, as of release/M1i, we saw an extraneous node appear. If your `ucm` is fixed, you won't see it below: - -``` ucm -scratch/main> history #7nl6ppokhg - - 😶 - - I don't know of a namespace with that hash. - -``` diff --git a/unison-src/transcripts/fix-2258-if-as-list-element.output.md b/unison-src/transcripts/fix-2258-if-as-list-element.output.md deleted file mode 100644 index 0e136a6bee..0000000000 --- a/unison-src/transcripts/fix-2258-if-as-list-element.output.md +++ /dev/null @@ -1,62 +0,0 @@ -Tests that `if` statements can appear as list and tuple elements. - -``` unison -> [ if true then 1 else 0 ] - -> [ if true then 1 else 0, 1] - -> [1, if true then 1 else 0] - -> (if true then 1 else 0, 0) - -> (0, if true then 1 else 0) - -> (1) - -> (1,2) - -> (1,2,3) - -> [1,2,3] - -> [] - -> [1] - -> [1,2] - -> [1,2,3] - -> [ - 1, - 2, - 3 - ] - -> [ - 1, - 2, - 3,] - -> (1,2,3,) - -> (1, - 2,) - -structural ability Zoot where zoot : () - -Zoot.handler : Request {Zoot} a -> a -Zoot.handler = cases - { a } -> a - { zoot -> k } -> handle !k with Zoot.handler - -fst = cases (x,_) -> x - -> List.size - [ if true then (x y -> y) - else handle (x y -> x) with fst (Zoot.handler, 42), - cases a, b -> a Nat.+ b, -- multi-arg cases lambda - cases x, y -> x Nat.+ y - ] -``` - diff --git a/unison-src/transcripts/fix-big-list-crash.output.md b/unison-src/transcripts/fix-big-list-crash.output.md deleted file mode 100644 index f6db0fb0bb..0000000000 --- a/unison-src/transcripts/fix-big-list-crash.output.md +++ /dev/null @@ -1,24 +0,0 @@ -#### Big list crash - -Big lists have been observed to crash, while in the garbage collection step. - -``` unison -unique type Direction = U | D | L | R - -x = [(R,1005),(U,563),(R,417),(U,509),(L,237),(U,555),(R,397),(U,414),(L,490),(U,336),(L,697),(D,682),(L,180),(U,951),(L,189),(D,547),(R,697),(U,583),(L,172),(D,859),(L,370),(D,114),(L,519),(U,829),(R,389),(U,608),(R,66),(D,634),(L,320),(D,49),(L,931),(U,137),(L,349),(D,689),(L,351),(D,829),(R,819),(D,138),(L,118),(D,849),(R,230),(U,858),(L,509),(D,311),(R,815),(U,217),(R,359),(U,840),(R,77),(U,230),(R,361),(U,322),(R,300),(D,646),(R,348),(U,815),(R,793),(D,752),(R,967),(U,128),(R,948),(D,499),(R,359),(U,572),(L,566),(U,815),(R,630),(D,290),(L,829),(D,736),(R,358),(U,778),(R,891),(U,941),(R,544),(U,889),(L,920),(U,913),(L,447),(D,604),(R,538),(U,818),(L,215),(D,437),(R,447),(U,576),(R,452),(D,794),(R,864),(U,269),(L,325),(D,35),(L,268),(D,639),(L,101),(U,777),(L,776),(U,958),(R,105),(U,517),(R,667),(D,423),(R,603),(U,469),(L,125),(D,919),(R,879),(U,994),(R,665),(D,377),(R,456),(D,570),(L,685),(U,291),(R,261),(U,846),(R,840),(U,418),(L,974),(D,270),(L,312),(D,426),(R,621),(D,334),(L,855),(D,378),(R,694),(U,845),(R,481),(U,895),(L,362),(D,840),(L,712),(U,57),(R,276),(D,643),(R,566),(U,348),(R,361),(D,144),(L,287),(D,864),(L,556),(U,610),(L,927),(U,322),(R,271),(D,90),(L,741),(U,446),(R,181),(D,527),(R,56),(U,805),(L,907),(D,406),(L,286),(U,873),(L,79),(D,280),(L,153),(D,377),(R,253),(D,61),(R,475),(D,804),(R,788),(U,393),(L,660),(U,314),(R,489),(D,491),(L,234),(D,712),(L,253),(U,651),(L,777),(D,726),(R,146),(U,47),(R,630),(U,517),(R,226),(U,624),(L,834),(D,153),(L,513),(U,799),(R,287),(D,868),(R,982),(U,390),(L,296),(D,373),(R,9),(U,994),(R,105),(D,673),(L,657),(D,868),(R,738),(D,277),(R,374),(U,828),(R,860),(U,247),(R,484),(U,986),(L,723),(D,847),(L,578),(U,487),(L,51),(D,865),(L,328),(D,199),(R,812),(D,726),(R,355),(D,463),(R,761),(U,69),(R,508),(D,753),(L,81),(D,50),(L,345),(D,66),(L,764),(D,466),(L,975),(U,619),(R,59),(D,788),(L,737),(D,360),(R,14),(D,253),(L,512),(D,417),(R,828),(D,188),(L,394),(U,212),(R,658),(U,369),(R,920),(U,927),(L,339),(U,552),(R,856),(D,458),(R,407),(U,41),(L,930),(D,460),(R,809),(U,467),(L,410),(D,800),(L,135),(D,596),(R,678),(D,4),(L,771),(D,637),(L,876),(U,192),(L,406),(D,136),(R,666),(U,730),(R,711),(D,291),(L,586),(U,845),(R,606),(U,2),(L,228),(D,759),(R,244),(U,946),(R,948),(U,160),(R,397),(U,134),(R,188),(U,850),(R,623),(D,315),(L,219),(D,450),(R,489),(U,374),(R,299),(D,474),(L,767),(D,679),(L,160),(D,403),(L,708)] -``` - -``` 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`: - - type Direction - x : [(Direction, Nat)] - -``` diff --git a/unison-src/transcripts/fix-ls.md b/unison-src/transcripts/fix-ls.md deleted file mode 100644 index 5bb9b950e3..0000000000 --- a/unison-src/transcripts/fix-ls.md +++ /dev/null @@ -1,15 +0,0 @@ -```ucm -test-ls/main> builtins.merge -``` - -```unison -foo.bar.add x y = x Int.+ y - -foo.bar.subtract x y = x Int.- y -``` - -```ucm -test-ls/main> add -test-ls/main> ls foo -test-ls/main> ls 1 -``` diff --git a/unison-src/transcripts/fix-ls.output.md b/unison-src/transcripts/fix-ls.output.md deleted file mode 100644 index b99f0f5877..0000000000 --- a/unison-src/transcripts/fix-ls.output.md +++ /dev/null @@ -1,44 +0,0 @@ -``` ucm -test-ls/main> builtins.merge - - Done. - -``` -``` unison -foo.bar.add x y = x Int.+ y - -foo.bar.subtract x y = x Int.- y -``` - -``` 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.bar.add : Int -> Int -> Int - foo.bar.subtract : Int -> Int -> Int - -``` -``` ucm -test-ls/main> add - - ⍟ I've added these definitions: - - foo.bar.add : Int -> Int -> Int - foo.bar.subtract : Int -> Int -> Int - -test-ls/main> ls foo - - 1. bar/ (2 terms) - -test-ls/main> ls 1 - - 1. add (Int -> Int -> Int) - 2. subtract (Int -> Int -> Int) - -``` diff --git a/unison-src/transcripts/fix1063.md b/unison-src/transcripts/fix1063.md deleted file mode 100644 index 03ea62be7e..0000000000 --- a/unison-src/transcripts/fix1063.md +++ /dev/null @@ -1,19 +0,0 @@ -Tests that functions named `.` are rendered correctly. - -```ucm:hide -scratch/main> builtins.merge -``` - -``` unison -(`.`) f g x = f (g x) - -use Boolean not - -noop = not `.` not -``` - -``` ucm -scratch/main> add -scratch/main> view noop -``` - diff --git a/unison-src/transcripts/fix1063.output.md b/unison-src/transcripts/fix1063.output.md deleted file mode 100644 index 57ab0b23d8..0000000000 --- a/unison-src/transcripts/fix1063.output.md +++ /dev/null @@ -1,40 +0,0 @@ -Tests that functions named `.` are rendered correctly. - -``` unison -(`.`) f g x = f (g x) - -use Boolean not - -noop = not `.` not -``` - -``` 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`: - - `.` : (i1 ->{g1} o) -> (i ->{g} i1) -> i ->{g1, g} o - noop : Boolean -> Boolean - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - `.` : (i1 ->{g1} o) -> (i ->{g} i1) -> i ->{g1, g} o - noop : Boolean -> Boolean - -scratch/main> view noop - - noop : Boolean -> Boolean - noop = - use Boolean not - not `.` not - -``` diff --git a/unison-src/transcripts/fix1327.md b/unison-src/transcripts/fix1327.md deleted file mode 100644 index 45c1e11e92..0000000000 --- a/unison-src/transcripts/fix1327.md +++ /dev/null @@ -1,15 +0,0 @@ -```unison -foo = 4 - -bar = 5 -``` - -`alias.many` should be able to consume the numbered args produced by `ls`. Previously, `ls` would produce absolute paths, but `alias.many` required relative ones. - -Now `ls` returns a pair of the absolute search directory and the result relative to that search directory, so it can be used in both absolute and relative contexts. - -```ucm -scratch/main> add -scratch/main> ls -scratch/main> alias.many 1-2 .ns1_nohistory -``` diff --git a/unison-src/transcripts/fix1327.output.md b/unison-src/transcripts/fix1327.output.md deleted file mode 100644 index 9e0234725a..0000000000 --- a/unison-src/transcripts/fix1327.output.md +++ /dev/null @@ -1,50 +0,0 @@ -``` unison -foo = 4 - -bar = 5 -``` - -``` 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`: - - bar : ##Nat - foo : ##Nat - -``` -`alias.many` should be able to consume the numbered args produced by `ls`. Previously, `ls` would produce absolute paths, but `alias.many` required relative ones. - -Now `ls` returns a pair of the absolute search directory and the result relative to that search directory, so it can be used in both absolute and relative contexts. - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - bar : ##Nat - foo : ##Nat - -scratch/main> ls - - 1. bar (##Nat) - 2. foo (##Nat) - -scratch/main> alias.many 1-2 .ns1_nohistory - - Here's what changed in .ns1_nohistory : - - Added definitions: - - 1. bar : ##Nat - 2. foo : ##Nat - - Tip: You can use `undo` or use a hash from `reflog` to undo - this change. - -``` diff --git a/unison-src/transcripts/fix1334.output.md b/unison-src/transcripts/fix1334.output.md deleted file mode 100644 index dfadcbe0ad..0000000000 --- a/unison-src/transcripts/fix1334.output.md +++ /dev/null @@ -1,16 +0,0 @@ -Previously, the `alias.term` and `alias.type` would fail if the source argument was hash-only, and there was no way to create an alias for a definition that didn't already have a name. Also, the `replace.term` and `replace.type` *only* worked on hashes, and they had to be *full* hashes. - -With this PR, the source of an alias can be a short hash (even of a definition that doesn't currently have a name in the namespace) along with a name or hash-qualified name from the current namespace as usual. - -Let's make some hash-only aliases, now that we can. :mad-with-power-emoji: - -``` ucm -scratch/main> alias.type ##Nat Cat - - Done. - -scratch/main> alias.term ##Nat.+ please_fix_763.+ - - Done. - -``` diff --git a/unison-src/transcripts/fix1390.md b/unison-src/transcripts/fix1390.md deleted file mode 100644 index 2ef5e8ac97..0000000000 --- a/unison-src/transcripts/fix1390.md +++ /dev/null @@ -1,28 +0,0 @@ - -```ucm -scratch/main> builtins.merge -``` - -```unison --- List.map : (a -> b) -> [a] -> [b] -List.map f = - go acc = cases - [] -> acc - h +: t -> go (acc :+ f h) t - go [] -``` - -```ucm -scratch/main> add -scratch/main> view List.map -``` - -```unison -List.map2 : (g -> g2) -> [g] -> [g2] -List.map2 f = - unused = "just to give this a different hash" - go acc = cases - [] -> acc - h +: t -> go (acc :+ f h) t - go [] -``` diff --git a/unison-src/transcripts/fix1390.output.md b/unison-src/transcripts/fix1390.output.md deleted file mode 100644 index 340a34e2ca..0000000000 --- a/unison-src/transcripts/fix1390.output.md +++ /dev/null @@ -1,68 +0,0 @@ -``` ucm -scratch/main> builtins.merge - - Done. - -``` -``` unison --- List.map : (a -> b) -> [a] -> [b] -List.map f = - go acc = cases - [] -> acc - h +: t -> go (acc :+ f h) t - go [] -``` - -``` 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`: - - List.map : (i ->{g} o) -> [i] ->{g} [o] - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - List.map : (i ->{g} o) -> [i] ->{g} [o] - -scratch/main> view List.map - - List.map : (i ->{g} o) -> [i] ->{g} [o] - List.map f = - go acc = cases - [] -> acc - h +: t -> go (acc :+ f h) t - go [] - -``` -``` unison -List.map2 : (g -> g2) -> [g] -> [g2] -List.map2 f = - unused = "just to give this a different hash" - go acc = cases - [] -> acc - h +: t -> go (acc :+ f h) t - go [] -``` - -``` 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`: - - List.map2 : (g ->{h} g2) -> [g] ->{h} [g2] - -``` diff --git a/unison-src/transcripts/fix1421.md b/unison-src/transcripts/fix1421.md deleted file mode 100644 index 8117928aa4..0000000000 --- a/unison-src/transcripts/fix1421.md +++ /dev/null @@ -1,8 +0,0 @@ - ```ucm - scratch/main> alias.type ##Nat Nat - scratch/main> alias.term ##Nat.+ Nat.+ - ``` - ```unison - unique type A = A Nat - unique type B = B Nat Nat - ``` diff --git a/unison-src/transcripts/fix1421.output.md b/unison-src/transcripts/fix1421.output.md deleted file mode 100644 index 0f52e9a36e..0000000000 --- a/unison-src/transcripts/fix1421.output.md +++ /dev/null @@ -1,29 +0,0 @@ -``` ucm -scratch/main> alias.type ##Nat Nat - - Done. - -scratch/main> alias.term ##Nat.+ Nat.+ - - Done. - -``` -``` unison -unique type A = A Nat -unique type B = B Nat Nat -``` - -``` 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`: - - type A - type B - -``` diff --git a/unison-src/transcripts/fix1532.md b/unison-src/transcripts/fix1532.md deleted file mode 100644 index fc835cc46c..0000000000 --- a/unison-src/transcripts/fix1532.md +++ /dev/null @@ -1,40 +0,0 @@ -```ucm -scratch/main> builtins.merge -``` - -First, lets create two namespaces. `foo` and `bar`, and add some definitions. - -```unison -foo.x = 42 -foo.y = 100 -bar.z = x + y -``` - -```ucm -scratch/main> add -``` - -Let's see what we have created... - -```ucm -scratch/main> ls -``` - -Now, if we try deleting the namespace `foo`, we get an error, as expected. - -```ucm:error -scratch/main> delete.namespace foo -``` - -Any numbered arguments should refer to `bar.z`. - -```ucm -scratch/main> debug.numberedArgs -``` - -We can then delete the dependent term, and then delete `foo`. - -```ucm -scratch/main> delete.term 1 -scratch/main> delete.namespace foo -``` diff --git a/unison-src/transcripts/fix1532.output.md b/unison-src/transcripts/fix1532.output.md deleted file mode 100644 index 0412312d87..0000000000 --- a/unison-src/transcripts/fix1532.output.md +++ /dev/null @@ -1,89 +0,0 @@ -``` ucm -scratch/main> builtins.merge - - Done. - -``` -First, lets create two namespaces. `foo` and `bar`, and add some definitions. - -``` unison -foo.x = 42 -foo.y = 100 -bar.z = x + y -``` - -``` 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`: - - bar.z : Nat - foo.x : Nat - foo.y : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - bar.z : Nat - foo.x : Nat - foo.y : Nat - -``` -Let's see what we have created... - -``` ucm -scratch/main> ls - - 1. bar/ (1 term) - 2. builtin/ (469 terms, 74 types) - 3. foo/ (2 terms) - -``` -Now, if we try deleting the namespace `foo`, we get an error, as expected. - -``` ucm -scratch/main> delete.namespace foo - - ⚠️ - - I didn't delete the namespace because the following - definitions are still in use. - - Dependency Referenced In - x 1. bar.z - - y 2. bar.z - - If you want to proceed anyways and leave those definitions - without names, use delete.namespace.force - -``` -Any numbered arguments should refer to `bar.z`. - -``` ucm -scratch/main> debug.numberedArgs - - 1. bar.z - 2. bar.z - -``` -We can then delete the dependent term, and then delete `foo`. - -``` ucm -scratch/main> delete.term 1 - - Done. - -scratch/main> delete.namespace foo - - Done. - -``` diff --git a/unison-src/transcripts/fix1578.md b/unison-src/transcripts/fix1578.md deleted file mode 100644 index 809af6c161..0000000000 --- a/unison-src/transcripts/fix1578.md +++ /dev/null @@ -1,112 +0,0 @@ -This transcript shows how suffix-based name resolution works when definitions in the file share a suffix with definitions already in the codebase. - -## Setup - -```ucm:hide -scratch/main> builtins.merge -``` - -As setup, we'll add a data type `Day` and a definition `foo.bar : Nat`. - -```unison:hide -unique type Day = Sun | Mon | Tue | Wed | Thu | Fri | Sat - -foo.bar : Nat -foo.bar = 23 -``` - -```ucm:hide -scratch/main> add -``` - -Suffix-based name resolution prefers to use names locally defined in the current file, then checks for matches in the codebase. Here are the precise rules, which will be explained below with examples: - -* If a symbol, `s`, is a suffix of exactly one definition `d` in the file, then `s` refers to `d`. -* Otherwise, if `s` is a suffix of exactly one definition `d` in the codebase, then `s` refers to `d`. -* Otherwise, if `s` is a suffix of multiple definitions in the file or the codebase, then (at least for terms) type-directed name resolution will be attempted to figure out which definition `s` refers to. - -## Example 1: local file term definitions shadow codebase term definitions - -This should typecheck, using the file's `bar : Text` rather than the codebase `foo.bar : Nat`: - -```unison:hide -use Text ++ - -bar : Text -bar = "hello" - -baz = bar ++ ", world!" -``` - -## Example 2: any locally unique term suffix shadows codebase term definitions - -This should also typecheck, using the file's `oog.bar`. This shows you can refer to a definition in the file by any suffix that is unique to definitions in the file (even if that suffix may match other definitions in the _codebase_). See example 4 below for overriding this behavior. - -```unison:hide -use Text ++ - -oog.bar = "hello" - -baz = bar ++ ", world!" -``` - -This subtle test establishes that we aren't using type-directed name resolution (TDNR) for the local term references in the file. If this were using TDNR, it would fail with an ambiguity as there's nothing that pins down the expected type of `bar` here: - -```unison:hide -use Text ++ - -oog.bar = "hello" - -baz = (bar, 42) -``` - -This subtle test establishes that locally introduced variables (within a function, say) correctly shadow definitions introduced at the file top level: - -```unison:hide -use Text ++ - -oog.bar = "hello" - -baz : [Int] -> ([Int], Nat) -baz bar = (bar, 42) -- here, `bar` refers to the parameter -``` - -## Example 3: Local type and constructor definitions shadow codebase definitions - -This should also typecheck, using the local `Sun`, and not `Day.Sun` which exists in the codebase, and the local `Day`, not the codebase `Day`. - -```unison:hide -structural type Zoot = Zonk | Sun - -structural type Day = Day Int - -use Zoot Zonk - -flip : Zoot -> Zoot -flip = cases - Sun -> Zonk - Zonk -> Sun - -day1 : Day -day1 = Day +1 -``` - -## Example 4: Refering to codebase definitions via a unique suffix - -Even though local definitions are preferred, you can refer to definitions in the codebase via any unique suffix that doesn't also exist in the file. - -```unison:hide -structural type Zoot = Zonk | Sun - -use Zoot Zonk - -blah = cases - Day.Sun -> Day.Tue - day -> day - -blah2 = - -- imports work too if you get tired of typing Day.Sun over and over - use Day Sun - cases Sun -> Wed - day -> day -``` diff --git a/unison-src/transcripts/fix1578.output.md b/unison-src/transcripts/fix1578.output.md deleted file mode 100644 index 0645dae519..0000000000 --- a/unison-src/transcripts/fix1578.output.md +++ /dev/null @@ -1,105 +0,0 @@ -This transcript shows how suffix-based name resolution works when definitions in the file share a suffix with definitions already in the codebase. - -## Setup - -As setup, we'll add a data type `Day` and a definition `foo.bar : Nat`. - -``` unison -unique type Day = Sun | Mon | Tue | Wed | Thu | Fri | Sat - -foo.bar : Nat -foo.bar = 23 -``` - -Suffix-based name resolution prefers to use names locally defined in the current file, then checks for matches in the codebase. Here are the precise rules, which will be explained below with examples: - - - If a symbol, `s`, is a suffix of exactly one definition `d` in the file, then `s` refers to `d`. - - Otherwise, if `s` is a suffix of exactly one definition `d` in the codebase, then `s` refers to `d`. - - Otherwise, if `s` is a suffix of multiple definitions in the file or the codebase, then (at least for terms) type-directed name resolution will be attempted to figure out which definition `s` refers to. - -## Example 1: local file term definitions shadow codebase term definitions - -This should typecheck, using the file's `bar : Text` rather than the codebase `foo.bar : Nat`: - -``` unison -use Text ++ - -bar : Text -bar = "hello" - -baz = bar ++ ", world!" -``` - -## Example 2: any locally unique term suffix shadows codebase term definitions - -This should also typecheck, using the file's `oog.bar`. This shows you can refer to a definition in the file by any suffix that is unique to definitions in the file (even if that suffix may match other definitions in the *codebase*). See example 4 below for overriding this behavior. - -``` unison -use Text ++ - -oog.bar = "hello" - -baz = bar ++ ", world!" -``` - -This subtle test establishes that we aren't using type-directed name resolution (TDNR) for the local term references in the file. If this were using TDNR, it would fail with an ambiguity as there's nothing that pins down the expected type of `bar` here: - -``` unison -use Text ++ - -oog.bar = "hello" - -baz = (bar, 42) -``` - -This subtle test establishes that locally introduced variables (within a function, say) correctly shadow definitions introduced at the file top level: - -``` unison -use Text ++ - -oog.bar = "hello" - -baz : [Int] -> ([Int], Nat) -baz bar = (bar, 42) -- here, `bar` refers to the parameter -``` - -## Example 3: Local type and constructor definitions shadow codebase definitions - -This should also typecheck, using the local `Sun`, and not `Day.Sun` which exists in the codebase, and the local `Day`, not the codebase `Day`. - -``` unison -structural type Zoot = Zonk | Sun - -structural type Day = Day Int - -use Zoot Zonk - -flip : Zoot -> Zoot -flip = cases - Sun -> Zonk - Zonk -> Sun - -day1 : Day -day1 = Day +1 -``` - -## Example 4: Refering to codebase definitions via a unique suffix - -Even though local definitions are preferred, you can refer to definitions in the codebase via any unique suffix that doesn't also exist in the file. - -``` unison -structural type Zoot = Zonk | Sun - -use Zoot Zonk - -blah = cases - Day.Sun -> Day.Tue - day -> day - -blah2 = - -- imports work too if you get tired of typing Day.Sun over and over - use Day Sun - cases Sun -> Wed - day -> day -``` - diff --git a/unison-src/transcripts/fix1696.md b/unison-src/transcripts/fix1696.md deleted file mode 100644 index 4abb83f185..0000000000 --- a/unison-src/transcripts/fix1696.md +++ /dev/null @@ -1,22 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison:error -structural ability Ask where ask : Nat - -ability Zoot where - zoot : Nat - -Ask.provide : '{Zoot} Nat -> '{Ask} r -> r -Ask.provide answer asker = - h = cases - {r} -> r - {Ask.ask -> resume} -> handle resume !answer with h - handle !asker with h - -dialog = Ask.provide 'zoot '("Awesome number: " ++ Nat.toText Ask.ask ++ "!") - -> dialog -``` diff --git a/unison-src/transcripts/fix1696.output.md b/unison-src/transcripts/fix1696.output.md deleted file mode 100644 index 772f10e6c2..0000000000 --- a/unison-src/transcripts/fix1696.output.md +++ /dev/null @@ -1,28 +0,0 @@ -``` unison -structural ability Ask where ask : Nat - -ability Zoot where - zoot : Nat - -Ask.provide : '{Zoot} Nat -> '{Ask} r -> r -Ask.provide answer asker = - h = cases - {r} -> r - {Ask.ask -> resume} -> handle resume !answer with h - handle !asker with h - -dialog = Ask.provide 'zoot '("Awesome number: " ++ Nat.toText Ask.ask ++ "!") - -> dialog -``` - -``` ucm - - Loading changes detected in scratch.u. - - The expression in red needs the {Zoot} ability, but this location does not have access to any abilities. - - 13 | dialog = Ask.provide 'zoot '("Awesome number: " ++ Nat.toText Ask.ask ++ "!") - - -``` diff --git a/unison-src/transcripts/fix1709.md b/unison-src/transcripts/fix1709.md deleted file mode 100644 index 9b0e868d02..0000000000 --- a/unison-src/transcripts/fix1709.md +++ /dev/null @@ -1,15 +0,0 @@ -```unison -id x = x - -id2 x = - z = 384849 - id x -``` - -```ucm -scratch/main> add -``` - -```unison -> id2 "hi" -``` diff --git a/unison-src/transcripts/fix1709.output.md b/unison-src/transcripts/fix1709.output.md deleted file mode 100644 index 7159b5b54b..0000000000 --- a/unison-src/transcripts/fix1709.output.md +++ /dev/null @@ -1,51 +0,0 @@ -``` unison -id x = x - -id2 x = - z = 384849 - id x -``` - -``` 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`: - - id : x -> x - id2 : x -> x - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - id : x -> x - id2 : x -> x - -``` -``` unison -> id2 "hi" -``` - -``` ucm - - Loading changes detected in scratch.u. - - ✅ - - scratch.u changed. - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 1 | > id2 "hi" - ⧩ - "hi" - -``` diff --git a/unison-src/transcripts/fix1731.md b/unison-src/transcripts/fix1731.md deleted file mode 100644 index 82efd3cce9..0000000000 --- a/unison-src/transcripts/fix1731.md +++ /dev/null @@ -1,22 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison:hide -structural ability CLI where - print : Text ->{CLI} () - input : {CLI} Text -``` - -```ucm:hide -scratch/main> add -``` - -The `input` here should parse as a wildcard, not as `CLI.input`. - -```unison -repro : Text -> () -repro = cases - input -> () -``` diff --git a/unison-src/transcripts/fix1731.output.md b/unison-src/transcripts/fix1731.output.md deleted file mode 100644 index be55bbb4b2..0000000000 --- a/unison-src/transcripts/fix1731.output.md +++ /dev/null @@ -1,27 +0,0 @@ -``` unison -structural ability CLI where - print : Text ->{CLI} () - input : {CLI} Text -``` - -The `input` here should parse as a wildcard, not as `CLI.input`. - -``` unison -repro : Text -> () -repro = cases - input -> () -``` - -``` 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`: - - repro : Text -> () - -``` diff --git a/unison-src/transcripts/fix1800.md b/unison-src/transcripts/fix1800.md deleted file mode 100644 index 533d95d847..0000000000 --- a/unison-src/transcripts/fix1800.md +++ /dev/null @@ -1,64 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison:hide -printLine : Text ->{IO} () -printLine msg = - _ = putBytes.impl (stdHandle StdOut) (Text.toUtf8 (msg ++ "\n")) - () - --- An unannotated main function -main1 = '(printLine "\nhello world!") - --- Another variation -main2 _ = printLine "🌹" - --- An annotated main function -main3 : '{IO} () -main3 _ = printLine "🦄 ☁️ 🌈" -``` - -Testing a few variations here: - -* Should be able to run annotated and unannotated main functions in the current file. -* Should be able to run annotated and unannotated main functions from the codebase. - -```ucm -scratch/main> run main1 -scratch/main> run main2 -scratch/main> run main3 -scratch/main> add -scratch/main> rename.term main1 code.main1 -scratch/main> rename.term main2 code.main2 -scratch/main> rename.term main3 code.main3 -``` - -The renaming just ensures that when running `code.main1`, it has to get that main from the codebase rather than the scratch file: - -```ucm -scratch/main> run code.main1 -scratch/main> run code.main2 -scratch/main> run code.main3 -``` - -Now testing a few variations that should NOT typecheck. - -```unison:hide -main4 : Nat ->{IO} Nat -main4 n = n - -main5 : Nat ->{IO} () -main5 _ = () -``` - -This shouldn't work since `main4` and `main5` don't have the right type. - -```ucm:error -scratch/main> run main4 -``` - -```ucm:error -scratch/main> run main5 -``` diff --git a/unison-src/transcripts/fix1800.output.md b/unison-src/transcripts/fix1800.output.md deleted file mode 100644 index 97f93ed409..0000000000 --- a/unison-src/transcripts/fix1800.output.md +++ /dev/null @@ -1,113 +0,0 @@ -``` unison -printLine : Text ->{IO} () -printLine msg = - _ = putBytes.impl (stdHandle StdOut) (Text.toUtf8 (msg ++ "\n")) - () - --- An unannotated main function -main1 = '(printLine "\nhello world!") - --- Another variation -main2 _ = printLine "🌹" - --- An annotated main function -main3 : '{IO} () -main3 _ = printLine "🦄 ☁️ 🌈" -``` - -Testing a few variations here: - - - Should be able to run annotated and unannotated main functions in the current file. - - Should be able to run annotated and unannotated main functions from the codebase. - -``` ucm -scratch/main> run main1 - - () - -scratch/main> run main2 - - () - -scratch/main> run main3 - - () - -scratch/main> add - - ⍟ I've added these definitions: - - main1 : '{IO} () - main2 : ∀ _. _ ->{IO} () - main3 : '{IO} () - printLine : Text ->{IO} () - -scratch/main> rename.term main1 code.main1 - - Done. - -scratch/main> rename.term main2 code.main2 - - Done. - -scratch/main> rename.term main3 code.main3 - - Done. - -``` -The renaming just ensures that when running `code.main1`, it has to get that main from the codebase rather than the scratch file: - -``` ucm -scratch/main> run code.main1 - - () - -scratch/main> run code.main2 - - () - -scratch/main> run code.main3 - - () - -``` -Now testing a few variations that should NOT typecheck. - -``` unison -main4 : Nat ->{IO} Nat -main4 n = n - -main5 : Nat ->{IO} () -main5 _ = () -``` - -This shouldn't work since `main4` and `main5` don't have the right type. - -``` ucm -scratch/main> run main4 - - 😶 - - I found this function: - - main4 : Nat ->{IO} Nat - - but in order for me to `run` it needs to be a subtype of: - - main4 : '{IO, Exception} result - -``` -``` ucm -scratch/main> run main5 - - 😶 - - I found this function: - - main5 : Nat ->{IO} () - - but in order for me to `run` it needs to be a subtype of: - - main5 : '{IO, Exception} result - -``` diff --git a/unison-src/transcripts/fix1844.md b/unison-src/transcripts/fix1844.md deleted file mode 100644 index 41c189867c..0000000000 --- a/unison-src/transcripts/fix1844.md +++ /dev/null @@ -1,11 +0,0 @@ - -```unison -structural type One a = One a -unique type Woot a b c = Woot a b c -unique type Z = Z - -snoc k aN = match k with - One a0 -> Woot (One a0) (One aN) 99 - -> snoc (One 1) 2 -``` diff --git a/unison-src/transcripts/fix1844.output.md b/unison-src/transcripts/fix1844.output.md deleted file mode 100644 index 0f6f428178..0000000000 --- a/unison-src/transcripts/fix1844.output.md +++ /dev/null @@ -1,34 +0,0 @@ -``` unison -structural type One a = One a -unique type Woot a b c = Woot a b c -unique type Z = Z - -snoc k aN = match k with - One a0 -> Woot (One a0) (One aN) 99 - -> snoc (One 1) 2 -``` - -``` 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`: - - structural type One a - type Woot a b c - type Z - snoc : One a -> aN -> Woot (One a) (One aN) ##Nat - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 8 | > snoc (One 1) 2 - ⧩ - Woot (One 1) (One 2) 99 - -``` diff --git a/unison-src/transcripts/fix1926.md b/unison-src/transcripts/fix1926.md deleted file mode 100644 index 0ebe0e3c8f..0000000000 --- a/unison-src/transcripts/fix1926.md +++ /dev/null @@ -1,15 +0,0 @@ -```ucm -scratch/main> builtins.merge -``` - -```unison -> 'sq - -sq = 2934892384 -``` - -```unison -> 'sq - -sq = 2934892384 -``` diff --git a/unison-src/transcripts/fix1926.output.md b/unison-src/transcripts/fix1926.output.md deleted file mode 100644 index 1c940cc22f..0000000000 --- a/unison-src/transcripts/fix1926.output.md +++ /dev/null @@ -1,58 +0,0 @@ -``` ucm -scratch/main> builtins.merge - - Done. - -``` -``` unison -> 'sq - -sq = 2934892384 -``` - -``` 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`: - - sq : Nat - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 1 | > 'sq - ⧩ - do sq - -``` -``` unison -> 'sq - -sq = 2934892384 -``` - -``` 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`: - - sq : Nat - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 1 | > 'sq - ⧩ - do sq - -``` diff --git a/unison-src/transcripts/fix2026.md b/unison-src/transcripts/fix2026.md deleted file mode 100644 index df2a51f457..0000000000 --- a/unison-src/transcripts/fix2026.md +++ /dev/null @@ -1,44 +0,0 @@ -```ucm:hide -scratch/main> builtins.mergeio -``` - -```unison -structural ability Exception where raise : Failure -> x - -ex = unsafeRun! '(printLine "hello world") - -printLine : Text ->{IO, Exception} () -printLine t = - putText stdOut t - putText stdOut "\n" - -stdOut : Handle -stdOut = stdHandle StdOut - -compose2 : (c ->{𝕖1} d) -> (a ->{𝕖2} b ->{𝕖3} c) -> a -> b ->{𝕖1,𝕖2,𝕖3} d -compose2 f g x y = f (g x y) - -putBytes : Handle -> Bytes ->{IO, Exception} () -putBytes = compose2 toException putBytes.impl - -toException : Either Failure a ->{Exception} a -toException = cases - Left e -> raise e - Right a -> a - -putText : Handle -> Text ->{IO, Exception} () -putText h t = putBytes h (toUtf8 t) - -Exception.unsafeRun! : '{Exception, g} a -> '{g} a -Exception.unsafeRun! e _ = - h : Request {Exception} a -> a - h = cases - {Exception.raise fail -> _ } -> - bug fail - {a} -> a - handle !e with h -``` - -```ucm -scratch/main> run ex -``` \ No newline at end of file diff --git a/unison-src/transcripts/fix2026.output.md b/unison-src/transcripts/fix2026.output.md deleted file mode 100644 index 254fcb72c7..0000000000 --- a/unison-src/transcripts/fix2026.output.md +++ /dev/null @@ -1,71 +0,0 @@ -``` unison -structural ability Exception where raise : Failure -> x - -ex = unsafeRun! '(printLine "hello world") - -printLine : Text ->{IO, Exception} () -printLine t = - putText stdOut t - putText stdOut "\n" - -stdOut : Handle -stdOut = stdHandle StdOut - -compose2 : (c ->{𝕖1} d) -> (a ->{𝕖2} b ->{𝕖3} c) -> a -> b ->{𝕖1,𝕖2,𝕖3} d -compose2 f g x y = f (g x y) - -putBytes : Handle -> Bytes ->{IO, Exception} () -putBytes = compose2 toException putBytes.impl - -toException : Either Failure a ->{Exception} a -toException = cases - Left e -> raise e - Right a -> a - -putText : Handle -> Text ->{IO, Exception} () -putText h t = putBytes h (toUtf8 t) - -Exception.unsafeRun! : '{Exception, g} a -> '{g} a -Exception.unsafeRun! e _ = - h : Request {Exception} a -> a - h = cases - {Exception.raise fail -> _ } -> - bug fail - {a} -> a - handle !e with h -``` - -``` 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`: - - structural ability Exception - (also named builtin.Exception) - Exception.unsafeRun! : '{g, Exception} a -> '{g} a - compose2 : (c ->{𝕖1} d) - -> (a ->{𝕖2} b ->{𝕖3} c) - -> a - -> b - ->{𝕖1, 𝕖2, 𝕖3} d - ex : '{IO} () - printLine : Text ->{IO, Exception} () - putBytes : Handle - -> Bytes - ->{IO, Exception} () - putText : Handle -> Text ->{IO, Exception} () - stdOut : Handle - toException : Either Failure a ->{Exception} a - -``` -``` ucm -scratch/main> run ex - - () - -``` diff --git a/unison-src/transcripts/fix2027.md b/unison-src/transcripts/fix2027.md deleted file mode 100644 index 2a386ae315..0000000000 --- a/unison-src/transcripts/fix2027.md +++ /dev/null @@ -1,55 +0,0 @@ - - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -structural ability Exception where raise : Failure -> x - -reraise = cases - Left e -> raise e - Right a -> a - -structural type Either a b = Left a | Right b - -putBytes h bs = reraise (putBytes.impl h bs) - -toException : Either Failure a ->{Exception} a -toException = cases - Left e -> raise e - Right a -> a - -putText : Handle -> Text ->{IO, Exception} () -putText h t = putBytes h (toUtf8 t) - -bugFail = cases - Failure typ _ _ -> bug (Failure typ "problem" (Any ())) - -Exception.unsafeRun! : '{Exception, g} a -> '{g} a -Exception.unsafeRun! e _ = - h : Request {Exception} a -> a - h = cases - {Exception.raise fail -> _ } -> - bugFail fail - {a} -> a - handle !e with h - -socketSend s bytes = reraise (socketSend.impl s bytes) -closeSocket s = reraise (closeSocket.impl s) -serverSocket host port = reraise (IO.serverSocket.impl host port) - -hello : Text -> Text -> {IO, Exception} () -hello host port = - socket = serverSocket (Some host) port - msg = toUtf8 "Hello there" - socketSend socket msg - closeSocket socket - -myServer = unsafeRun! '(hello "127.0.0.1" "0") - -``` - -```ucm:error -scratch/main> run myServer -``` diff --git a/unison-src/transcripts/fix2027.output.md b/unison-src/transcripts/fix2027.output.md deleted file mode 100644 index 3d224d6446..0000000000 --- a/unison-src/transcripts/fix2027.output.md +++ /dev/null @@ -1,94 +0,0 @@ -``` unison -structural ability Exception where raise : Failure -> x - -reraise = cases - Left e -> raise e - Right a -> a - -structural type Either a b = Left a | Right b - -putBytes h bs = reraise (putBytes.impl h bs) - -toException : Either Failure a ->{Exception} a -toException = cases - Left e -> raise e - Right a -> a - -putText : Handle -> Text ->{IO, Exception} () -putText h t = putBytes h (toUtf8 t) - -bugFail = cases - Failure typ _ _ -> bug (Failure typ "problem" (Any ())) - -Exception.unsafeRun! : '{Exception, g} a -> '{g} a -Exception.unsafeRun! e _ = - h : Request {Exception} a -> a - h = cases - {Exception.raise fail -> _ } -> - bugFail fail - {a} -> a - handle !e with h - -socketSend s bytes = reraise (socketSend.impl s bytes) -closeSocket s = reraise (closeSocket.impl s) -serverSocket host port = reraise (IO.serverSocket.impl host port) - -hello : Text -> Text -> {IO, Exception} () -hello host port = - socket = serverSocket (Some host) port - msg = toUtf8 "Hello there" - socketSend socket msg - closeSocket socket - -myServer = unsafeRun! '(hello "127.0.0.1" "0") - -``` - -``` 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`: - - structural type Either a b - (also named builtin.Either) - 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 -scratch/main> run myServer - - 💔💥 - - I've encountered a call to builtin.bug with the following - value: - - Failure (typeLink IOFailure) "problem" (Any ()) - - Stack trace: - bug - #8ppr1tt4q2 - -``` diff --git a/unison-src/transcripts/fix2049.md b/unison-src/transcripts/fix2049.md deleted file mode 100644 index c0cfc4fdb2..0000000000 --- a/unison-src/transcripts/fix2049.md +++ /dev/null @@ -1,79 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -id x = x - -structural ability Stream a where - emit : a -> () - -Stream.foldl : (x ->{g} a ->{g} x) -> x -> '{g, Stream a} r -> '{g} x -Stream.foldl f z str _ = - h acc = cases - { emit x -> k } -> handle !k with h (f acc x) - { _ } -> acc - handle !str with h z - -Stream.range : Nat -> Nat -> '{Stream Nat} () -Stream.range m n = do - f : Nat ->{Stream Nat} () - f k = if k < n then emit k ; f (k+1) else () - f m - -unique type Fold' g a b x = Fold' (x -> {g} a -> {g} x) x (x -> {g} b) - -unique type Fold g a b = Fold (∀ g2 r. (∀ x. Fold' g a b x -> {g2} r) -> {g2} r) - -Fold.fromFold' : Fold' g a b x -> Fold g a b -Fold.fromFold' fold = Fold.Fold (f -> f fold) - -Fold.mkFold : (t -> {g} a -> {g} t) -> t -> (t -> {g} b) -> Fold g a b -Fold.mkFold step init extract = - Fold.fromFold' (Fold'.Fold' step init extract) - -folds.all : (a -> {g} Boolean) -> Fold g a Boolean -folds.all predicate = - Fold.mkFold (b -> a -> b && (predicate a)) true id - -Fold.Stream.fold : Fold g a b -> '{g, Stream a} r -> '{g} b -Fold.Stream.fold = - run: Fold' g a b x -> '{g, Stream a} r -> '{g} b - run = - cases Fold'.Fold' step init extract -> - stream -> _ -> extract !(foldl step init stream) - cases - Fold f -> stream -> f (f' -> run f' stream) - -> folds.all.tests.stream = - pred = n -> (Nat.gt n 2) - res : 'Boolean - 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 -scratch/main> add -scratch/main> io.test tests -``` diff --git a/unison-src/transcripts/fix2049.output.md b/unison-src/transcripts/fix2049.output.md deleted file mode 100644 index a9354446f8..0000000000 --- a/unison-src/transcripts/fix2049.output.md +++ /dev/null @@ -1,143 +0,0 @@ -``` unison -id x = x - -structural ability Stream a where - emit : a -> () - -Stream.foldl : (x ->{g} a ->{g} x) -> x -> '{g, Stream a} r -> '{g} x -Stream.foldl f z str _ = - h acc = cases - { emit x -> k } -> handle !k with h (f acc x) - { _ } -> acc - handle !str with h z - -Stream.range : Nat -> Nat -> '{Stream Nat} () -Stream.range m n = do - f : Nat ->{Stream Nat} () - f k = if k < n then emit k ; f (k+1) else () - f m - -unique type Fold' g a b x = Fold' (x -> {g} a -> {g} x) x (x -> {g} b) - -unique type Fold g a b = Fold (∀ g2 r. (∀ x. Fold' g a b x -> {g2} r) -> {g2} r) - -Fold.fromFold' : Fold' g a b x -> Fold g a b -Fold.fromFold' fold = Fold.Fold (f -> f fold) - -Fold.mkFold : (t -> {g} a -> {g} t) -> t -> (t -> {g} b) -> Fold g a b -Fold.mkFold step init extract = - Fold.fromFold' (Fold'.Fold' step init extract) - -folds.all : (a -> {g} Boolean) -> Fold g a Boolean -folds.all predicate = - Fold.mkFold (b -> a -> b && (predicate a)) true id - -Fold.Stream.fold : Fold g a b -> '{g, Stream a} r -> '{g} b -Fold.Stream.fold = - run: Fold' g a b x -> '{g, Stream a} r -> '{g} b - run = - cases Fold'.Fold' step init extract -> - stream -> _ -> extract !(foldl step init stream) - cases - Fold f -> stream -> f (f' -> run f' stream) - -> folds.all.tests.stream = - pred = n -> (Nat.gt n 2) - res : 'Boolean - res = Fold.Stream.fold (folds.all pred) (Stream.range 1 5) - !res Universal.== false -``` - -``` 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`: - - type Fold g a b - type Fold' g a b x - structural ability Stream a - Fold.Stream.fold : Fold g a b - -> '{g, Stream a} r - -> '{g} b - Fold.fromFold' : Fold' g a b x -> Fold g a b - Fold.mkFold : (t ->{g} a ->{g} t) - -> t - -> (t ->{g} b) - -> Fold g a b - Stream.foldl : (x ->{g} a ->{g} x) - -> x - -> '{g, Stream a} r - -> '{g} x - Stream.range : Nat -> Nat -> '{Stream Nat} () - folds.all : (a ->{g} Boolean) -> Fold g a Boolean - id : x -> x - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 44 | pred = n -> (Nat.gt n 2) - ⧩ - 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 -scratch/main> add - - ⍟ I've added these definitions: - - catcher : '{IO} () ->{IO} Result - tests : ∀ _. _ ->{IO} [Result] - -scratch/main> io.test tests - - New test results: - - 1. tests ◉ caught - ◉ caught - ◉ got the right answer - - ✅ 3 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` diff --git a/unison-src/transcripts/fix2053.md b/unison-src/transcripts/fix2053.md deleted file mode 100644 index 71f36094cb..0000000000 --- a/unison-src/transcripts/fix2053.md +++ /dev/null @@ -1,7 +0,0 @@ -```ucm:hide -scratch/main> builtins.mergeio -``` - -```ucm -scratch/main> display List.map -``` diff --git a/unison-src/transcripts/fix2053.output.md b/unison-src/transcripts/fix2053.output.md deleted file mode 100644 index ae97366dfb..0000000000 --- a/unison-src/transcripts/fix2053.output.md +++ /dev/null @@ -1,12 +0,0 @@ -``` ucm -scratch/main> display List.map - - f a -> - let - use Nat + - go i as acc = match List.at i as with - None -> acc - Some a -> go (i + 1) as (acc :+ f a) - go 0 a [] - -``` diff --git a/unison-src/transcripts/fix2156.md b/unison-src/transcripts/fix2156.md deleted file mode 100644 index f18d03fd13..0000000000 --- a/unison-src/transcripts/fix2156.md +++ /dev/null @@ -1,14 +0,0 @@ - -Tests for a case where bad eta reduction was causing erroneous watch -output/caching. - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -sqr : Nat -> Nat -sqr n = n * n - -> sqr -``` diff --git a/unison-src/transcripts/fix2156.output.md b/unison-src/transcripts/fix2156.output.md deleted file mode 100644 index 4a15b1accb..0000000000 --- a/unison-src/transcripts/fix2156.output.md +++ /dev/null @@ -1,30 +0,0 @@ -Tests for a case where bad eta reduction was causing erroneous watch -output/caching. - -``` unison -sqr : Nat -> Nat -sqr n = n * n - -> sqr -``` - -``` 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`: - - sqr : Nat -> Nat - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 4 | > sqr - ⧩ - n -> n Nat.* n - -``` diff --git a/unison-src/transcripts/fix2167.md b/unison-src/transcripts/fix2167.md deleted file mode 100644 index 5d0381f70e..0000000000 --- a/unison-src/transcripts/fix2167.md +++ /dev/null @@ -1,28 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -This is just a simple transcript to regression check an ability -inference/checking issue. - -```unison -structural ability R t where - die : () -> x - near.impl : Nat -> Either () [Nat] - -R.near n = match near.impl n with - Left e -> die () - Right a -> a - -R.near1 region loc = match R.near 42 with - [loc] -> loc - ls -> R.die () -``` - -The issue was that abilities with parameters like this were sometimes -causing failures like this because the variable in the parameter would -escape to a scope where it no longer made sense. Then solving would -fail because the type was invalid. - -The fix was to avoid dropping certain existential variables out of -scope. diff --git a/unison-src/transcripts/fix2167.output.md b/unison-src/transcripts/fix2167.output.md deleted file mode 100644 index d4e630f596..0000000000 --- a/unison-src/transcripts/fix2167.output.md +++ /dev/null @@ -1,40 +0,0 @@ -This is just a simple transcript to regression check an ability -inference/checking issue. - -``` unison -structural ability R t where - die : () -> x - near.impl : Nat -> Either () [Nat] - -R.near n = match near.impl n with - Left e -> die () - Right a -> a - -R.near1 region loc = match R.near 42 with - [loc] -> loc - ls -> R.die () -``` - -``` 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`: - - structural ability R t - R.near : Nat ->{R t} [Nat] - R.near1 : region -> loc ->{R t} Nat - -``` -The issue was that abilities with parameters like this were sometimes -causing failures like this because the variable in the parameter would -escape to a scope where it no longer made sense. Then solving would -fail because the type was invalid. - -The fix was to avoid dropping certain existential variables out of -scope. - diff --git a/unison-src/transcripts/fix2187.md b/unison-src/transcripts/fix2187.md deleted file mode 100644 index 2d0eb3fe7a..0000000000 --- a/unison-src/transcripts/fix2187.md +++ /dev/null @@ -1,19 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -```unison - -lexicalScopeEx: [Text] -lexicalScopeEx = - parent = "outer" - inner1 = let - child1 = "child1" - inner2 : [Text] - inner2 = let - child2 = "child2" - [parent, child1, child2] - inner2 - inner1 - -``` diff --git a/unison-src/transcripts/fix2187.output.md b/unison-src/transcripts/fix2187.output.md deleted file mode 100644 index 12a1aab7ff..0000000000 --- a/unison-src/transcripts/fix2187.output.md +++ /dev/null @@ -1,28 +0,0 @@ -``` unison -lexicalScopeEx: [Text] -lexicalScopeEx = - parent = "outer" - inner1 = let - child1 = "child1" - inner2 : [Text] - inner2 = let - child2 = "child2" - [parent, child1, child2] - inner2 - inner1 - -``` - -``` 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`: - - lexicalScopeEx : [Text] - -``` diff --git a/unison-src/transcripts/fix2231.md b/unison-src/transcripts/fix2231.md deleted file mode 100644 index 2fe2660b13..0000000000 --- a/unison-src/transcripts/fix2231.md +++ /dev/null @@ -1,29 +0,0 @@ -This transcript contains some cases that were problematic with the new -type checker. They were likely not discovered earlier because they -involve combining types inferred with the older strategy with the new -inference algorithm. Some code can be given multiple possible types, -and while they are all valid and some may be equivalently general, -the choices may not work equally well with the type checking -strategies. - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -(<<) : (b ->{e} c) -> (a ->{e} b) -> a ->{e} c -(<<) f g x = f (g x) - -f = atan << tan - -foldl : (b ->{e} a ->{e} b) -> b -> [a] ->{e} b -foldl f a = cases - [] -> a - x +: xs -> foldl f (f a x) xs - -txt = foldl (Text.++) "" ["a", "b", "c"] -``` - -```ucm -scratch/main> add -``` diff --git a/unison-src/transcripts/fix2231.output.md b/unison-src/transcripts/fix2231.output.md deleted file mode 100644 index d0e410477d..0000000000 --- a/unison-src/transcripts/fix2231.output.md +++ /dev/null @@ -1,49 +0,0 @@ -This transcript contains some cases that were problematic with the new -type checker. They were likely not discovered earlier because they -involve combining types inferred with the older strategy with the new -inference algorithm. Some code can be given multiple possible types, -and while they are all valid and some may be equivalently general, -the choices may not work equally well with the type checking -strategies. - -``` unison -(<<) : (b ->{e} c) -> (a ->{e} b) -> a ->{e} c -(<<) f g x = f (g x) - -f = atan << tan - -foldl : (b ->{e} a ->{e} b) -> b -> [a] ->{e} b -foldl f a = cases - [] -> a - x +: xs -> foldl f (f a x) xs - -txt = foldl (Text.++) "" ["a", "b", "c"] -``` - -``` 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`: - - << : (b ->{e} c) -> (a ->{e} b) -> a ->{e} c - f : Float -> Float - foldl : (b ->{e} a ->{e} b) -> b -> [a] ->{e} b - txt : Text - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - << : (b ->{e} c) -> (a ->{e} b) -> a ->{e} c - f : Float -> Float - foldl : (b ->{e} a ->{e} b) -> b -> [a] ->{e} b - txt : Text - -``` diff --git a/unison-src/transcripts/fix2238.md b/unison-src/transcripts/fix2238.md deleted file mode 100644 index 37a948c0f0..0000000000 --- a/unison-src/transcripts/fix2238.md +++ /dev/null @@ -1,18 +0,0 @@ - -```ucm:hide -scratch/main> builtins.mergeio -``` - -This should not typecheck - the inline `@eval` expression uses abilities. - -```unison:error -structural ability Abort where abort : x - -ex = {{ @eval{abort} }} -``` - -This file should also not typecheck - it has a triple backticks block that uses abilities. - -```ucm:error -scratch/main> load unison-src/transcripts/fix2238.u -``` diff --git a/unison-src/transcripts/fix2238.output.md b/unison-src/transcripts/fix2238.output.md deleted file mode 100644 index 0958d7182d..0000000000 --- a/unison-src/transcripts/fix2238.output.md +++ /dev/null @@ -1,31 +0,0 @@ -This should not typecheck - the inline `@eval` expression uses abilities. - -``` unison -structural ability Abort where abort : x - -ex = {{ @eval{abort} }} -``` - -``` ucm - - Loading changes detected in scratch.u. - - The expression in red needs the {Abort} ability, but this location does not have access to any abilities. - - 3 | ex = {{ @eval{abort} }} - - -``` -This file should also not typecheck - it has a triple backticks block that uses abilities. - -``` ucm -scratch/main> load unison-src/transcripts/fix2238.u - - Loading changes detected in unison-src/transcripts/fix2238.u. - - The expression in red needs the {Abort} ability, but this location does not have access to any abilities. - - 7 | abort + 1 - - -``` diff --git a/unison-src/transcripts/fix2238.u b/unison-src/transcripts/fix2238.u deleted file mode 100644 index 19e81357ee..0000000000 --- a/unison-src/transcripts/fix2238.u +++ /dev/null @@ -1,9 +0,0 @@ - -structural ability Abort where abort : x - -ex = {{ - -``` -abort + 1 -``` -}} diff --git a/unison-src/transcripts/fix2244.md b/unison-src/transcripts/fix2244.md deleted file mode 100644 index e1dba0b05e..0000000000 --- a/unison-src/transcripts/fix2244.md +++ /dev/null @@ -1,13 +0,0 @@ -```ucm:hide -scratch/main> builtins.mergeio -``` - -Ensure closing token is emitted by closing brace in doc eval block. - -```ucm -scratch/main> load ./unison-src/transcripts/fix2244.u -``` - -```ucm:hide -scratch/main> add -``` diff --git a/unison-src/transcripts/fix2244.output.md b/unison-src/transcripts/fix2244.output.md deleted file mode 100644 index 2341d1a265..0000000000 --- a/unison-src/transcripts/fix2244.output.md +++ /dev/null @@ -1,17 +0,0 @@ -Ensure closing token is emitted by closing brace in doc eval block. - -``` ucm -scratch/main> load ./unison-src/transcripts/fix2244.u - - Loading changes detected in - ./unison-src/transcripts/fix2244.u. - - I found and typechecked these definitions in - ./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`: - - x : Doc2 - -``` diff --git a/unison-src/transcripts/fix2244.u b/unison-src/transcripts/fix2244.u deleted file mode 100644 index 2d947ceb19..0000000000 --- a/unison-src/transcripts/fix2244.u +++ /dev/null @@ -1,11 +0,0 @@ -x = {{ - -``` -let - x = 1 - y = 2 - x + y -``` - -}} - diff --git a/unison-src/transcripts/fix2254.md b/unison-src/transcripts/fix2254.md deleted file mode 100644 index 36ed00e6b0..0000000000 --- a/unison-src/transcripts/fix2254.md +++ /dev/null @@ -1,94 +0,0 @@ - -```ucm:hide -scratch/a> builtins.merge lib.builtins -``` - -This transcript checks that updates to data types propagate successfully to dependent types and dependent terms that do pattern matching. First let's create some types and terms: - -```unison:hide -unique type A a b c d - = A a - | B b - | C c - | D d - -structural type NeedsA a b = NeedsA (A a b Nat Nat) - | Zoink Text - -f : A Nat Nat Nat Nat -> Nat -f = cases - A n -> n - _ -> 42 - -f2 a = - n = f a - n + 1 - -f3 : NeedsA Nat Nat -> Nat -f3 = cases - NeedsA a -> f a + 20 - _ -> 0 - -g : A Nat Nat Nat Nat -> Nat -g = cases - D n -> n - _ -> 43 -``` - -We'll make our edits in a new branch. - -```ucm -scratch/a> add -scratch/a> branch /a2 -scratch/a2> -``` - -First let's edit the `A` type, adding another constructor `E`. Note that the functions written against the old type have a wildcard in their pattern match, so they should work fine after the update. - -```unison:hide -unique type A a b c d - = A a - | B b - | C c - | D d - | E a d -``` - -Let's do the update now, and verify that the definitions all look good and there's nothing `todo`: - -```ucm -scratch/a2> update -scratch/a2> view A NeedsA f f2 f3 g -scratch/a2> todo -``` - -## Record updates - -Here's a test of updating a record: - -```ucm:hide -scratch/r1> builtins.merge lib.builtins -``` - - -```unison -structural type Rec = { uno : Nat, dos : Nat } - -combine r = uno r + dos r -``` - -```ucm -scratch/r1> add -scratch/r1> branch r2 -``` - -```unison -structural type Rec = { uno : Nat, dos : Nat, tres : Text } -``` - -And checking that after updating this record, there's nothing `todo`: - -```ucm -scratch/r2> update -scratch/r2> todo -``` diff --git a/unison-src/transcripts/fix2254.output.md b/unison-src/transcripts/fix2254.output.md deleted file mode 100644 index 05a1009e49..0000000000 --- a/unison-src/transcripts/fix2254.output.md +++ /dev/null @@ -1,219 +0,0 @@ -This transcript checks that updates to data types propagate successfully to dependent types and dependent terms that do pattern matching. First let's create some types and terms: - -``` unison -unique type A a b c d - = A a - | B b - | C c - | D d - -structural type NeedsA a b = NeedsA (A a b Nat Nat) - | Zoink Text - -f : A Nat Nat Nat Nat -> Nat -f = cases - A n -> n - _ -> 42 - -f2 a = - n = f a - n + 1 - -f3 : NeedsA Nat Nat -> Nat -f3 = cases - NeedsA a -> f a + 20 - _ -> 0 - -g : A Nat Nat Nat Nat -> Nat -g = cases - D n -> n - _ -> 43 -``` - -We'll make our edits in a new branch. - -``` ucm -scratch/a> add - - ⍟ I've added these definitions: - - type A a b c d - structural type NeedsA a b - f : A Nat Nat Nat Nat -> Nat - f2 : A Nat Nat Nat Nat -> Nat - f3 : NeedsA Nat Nat -> Nat - g : A Nat Nat Nat Nat -> Nat - -scratch/a> branch /a2 - - Done. I've created the a2 branch based off of a. - - Tip: To merge your work back into the a branch, first - `switch /a` then `merge /a2`. - -``` -First let's edit the `A` type, adding another constructor `E`. Note that the functions written against the old type have a wildcard in their pattern match, so they should work fine after the update. - -``` unison -unique type A a b c d - = A a - | B b - | C c - | D d - | E a d -``` - -Let's do the update now, and verify that the definitions all look good and there's nothing `todo`: - -``` ucm -scratch/a2> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Everything typechecks, so I'm saving the results... - - Done. - -scratch/a2> view A NeedsA f f2 f3 g - - type A a b c d - = A a - | D d - | E a d - | B b - | C c - - structural type NeedsA a b - = NeedsA (A a b Nat Nat) - | Zoink Text - - f : A Nat Nat Nat Nat -> Nat - f = cases - A n -> n - _ -> 42 - - f2 : A Nat Nat Nat Nat -> Nat - f2 a = - use Nat + - n = f a - n + 1 - - f3 : NeedsA Nat Nat -> Nat - f3 = cases - NeedsA a -> f a Nat.+ 20 - _ -> 0 - - g : A Nat Nat Nat Nat -> Nat - g = cases - D n -> n - _ -> 43 - -scratch/a2> todo - - You have no pending todo items. Good work! ✅ - -``` -## Record updates - -Here's a test of updating a record: - -``` unison -structural type Rec = { uno : Nat, dos : Nat } - -combine r = uno r + dos r -``` - -``` 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`: - - structural type Rec - Rec.dos : Rec -> Nat - Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.dos.set : Nat -> Rec -> Rec - Rec.uno : Rec -> Nat - Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.uno.set : Nat -> Rec -> Rec - combine : Rec -> Nat - -``` -``` ucm -scratch/r1> add - - ⍟ I've added these definitions: - - structural type Rec - Rec.dos : Rec -> Nat - Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.dos.set : Nat -> Rec -> Rec - Rec.uno : Rec -> Nat - Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.uno.set : Nat -> Rec -> Rec - combine : Rec -> Nat - -scratch/r1> branch r2 - - Done. I've created the r2 branch based off of r1. - - Tip: To merge your work back into the r1 branch, first - `switch /r1` then `merge /r2`. - -``` -``` unison -structural type Rec = { uno : Nat, dos : Nat, tres : Text } -``` - -``` 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`: - - Rec.tres : Rec -> Text - Rec.tres.modify : (Text ->{g} Text) -> Rec ->{g} Rec - Rec.tres.set : Text -> Rec -> Rec - - ⍟ These names already exist. You can `update` them to your - new definition: - - structural type Rec - Rec.dos : Rec -> Nat - Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.dos.set : Nat -> Rec -> Rec - Rec.uno : Rec -> Nat - Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec - Rec.uno.set : Nat -> Rec -> Rec - -``` -And checking that after updating this record, there's nothing `todo`: - -``` ucm -scratch/r2> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Everything typechecks, so I'm saving the results... - - Done. - -scratch/r2> todo - - You have no pending todo items. Good work! ✅ - -``` diff --git a/unison-src/transcripts/fix2268.md b/unison-src/transcripts/fix2268.md deleted file mode 100644 index 0892d924e7..0000000000 --- a/unison-src/transcripts/fix2268.md +++ /dev/null @@ -1,20 +0,0 @@ -Tests for a TDNR case that wasn't working. The code wasn't 'relaxing' -inferred types that didn't contain arrows, so effects that just yield -a value weren't getting disambiguated. - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -unique ability A where - a : Nat - -unique ability B where - a : Char - -test : () -> Nat -test _ = - x = a - toNat x -``` diff --git a/unison-src/transcripts/fix2268.output.md b/unison-src/transcripts/fix2268.output.md deleted file mode 100644 index 79da655962..0000000000 --- a/unison-src/transcripts/fix2268.output.md +++ /dev/null @@ -1,32 +0,0 @@ -Tests for a TDNR case that wasn't working. The code wasn't 'relaxing' -inferred types that didn't contain arrows, so effects that just yield -a value weren't getting disambiguated. - -``` unison -unique ability A where - a : Nat - -unique ability B where - a : Char - -test : () -> Nat -test _ = - x = a - toNat x -``` - -``` 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`: - - ability A - ability B - test : '{B} Nat - -``` diff --git a/unison-src/transcripts/fix2334.md b/unison-src/transcripts/fix2334.md deleted file mode 100644 index 9044000b5e..0000000000 --- a/unison-src/transcripts/fix2334.md +++ /dev/null @@ -1,20 +0,0 @@ - -Tests an issue where pattern matching matrices involving built-in -types was discarding default cases in some branches. - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -f = cases - 0, 0 -> 0 - _, 1 -> 2 - 1, _ -> 3 - _, _ -> 1 - -> f 0 0 -> f 1 0 -> f 0 1 -> f 1 1 -``` diff --git a/unison-src/transcripts/fix2334.output.md b/unison-src/transcripts/fix2334.output.md deleted file mode 100644 index ab20adb8e7..0000000000 --- a/unison-src/transcripts/fix2334.output.md +++ /dev/null @@ -1,48 +0,0 @@ -Tests an issue where pattern matching matrices involving built-in -types was discarding default cases in some branches. - -``` unison -f = cases - 0, 0 -> 0 - _, 1 -> 2 - 1, _ -> 3 - _, _ -> 1 - -> f 0 0 -> f 1 0 -> f 0 1 -> f 1 1 -``` - -``` 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`: - - f : Nat -> Nat -> Nat - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 7 | > f 0 0 - ⧩ - 0 - - 8 | > f 1 0 - ⧩ - 3 - - 9 | > f 0 1 - ⧩ - 2 - - 10 | > f 1 1 - ⧩ - 2 - -``` diff --git a/unison-src/transcripts/fix2344.md b/unison-src/transcripts/fix2344.md deleted file mode 100644 index 2593c2f18e..0000000000 --- a/unison-src/transcripts/fix2344.md +++ /dev/null @@ -1,22 +0,0 @@ - -Checks a corner case with type checking involving destructuring binds. - -The binds were causing some sequences of lets to be unnecessarily -recursive. - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -unique ability Nate where - nate: (Boolean, Nat) - antiNate: () - - -sneezy: (Nat -> {d} a) -> '{Nate,d} a -sneezy dee _ = - (_,_) = nate - antiNate - dee 1 -``` diff --git a/unison-src/transcripts/fix2344.output.md b/unison-src/transcripts/fix2344.output.md deleted file mode 100644 index 1d57076149..0000000000 --- a/unison-src/transcripts/fix2344.output.md +++ /dev/null @@ -1,32 +0,0 @@ -Checks a corner case with type checking involving destructuring binds. - -The binds were causing some sequences of lets to be unnecessarily -recursive. - -``` unison -unique ability Nate where - nate: (Boolean, Nat) - antiNate: () - - -sneezy: (Nat -> {d} a) -> '{Nate,d} a -sneezy dee _ = - (_,_) = nate - antiNate - dee 1 -``` - -``` 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`: - - ability Nate - sneezy : (Nat ->{d} a) -> '{d, Nate} a - -``` diff --git a/unison-src/transcripts/fix2350.md b/unison-src/transcripts/fix2350.md deleted file mode 100644 index 667b8a419e..0000000000 --- a/unison-src/transcripts/fix2350.md +++ /dev/null @@ -1,26 +0,0 @@ - -This tests an issue where ability variables were being defaulted over -eagerly. In general, we want to avoid collecting up variables from the -use of definitions with types like: - - T ->{e} U - -Since this type works for every `e`, it is, 'pure;' and we might as -well have `e = {}`, since `{}` is a subrow of every other row. -However, if `e` isn't just a quantified variable, but one involved in -ongoing inference, it's undesirable to default it. Previously there -was a check to see if `e` occurred in the context. However, the wanted -abilities being collected aren't in the context, so types like: - - T ->{S e} U ->{e} V - -were a corner case. We would add `S e` to the wanted abilities, then -not realize that `e` shouldn't be defaulted. - -```unison -unique ability Storage d g where - save.impl : a ->{Storage d g} ('{g} (d a)) - -save : a ->{Storage d g, g} (d a) -save a = !(save.impl a) -``` diff --git a/unison-src/transcripts/fix2350.output.md b/unison-src/transcripts/fix2350.output.md deleted file mode 100644 index cb0cf5de75..0000000000 --- a/unison-src/transcripts/fix2350.output.md +++ /dev/null @@ -1,44 +0,0 @@ -This tests an issue where ability variables were being defaulted over -eagerly. In general, we want to avoid collecting up variables from the -use of definitions with types like: - -``` -T ->{e} U -``` - -Since this type works for every `e`, it is, 'pure;' and we might as -well have `e = {}`, since `{}` is a subrow of every other row. -However, if `e` isn't just a quantified variable, but one involved in -ongoing inference, it's undesirable to default it. Previously there -was a check to see if `e` occurred in the context. However, the wanted -abilities being collected aren't in the context, so types like: - -``` -T ->{S e} U ->{e} V -``` - -were a corner case. We would add `S e` to the wanted abilities, then -not realize that `e` shouldn't be defaulted. - -``` unison -unique ability Storage d g where - save.impl : a ->{Storage d g} ('{g} (d a)) - -save : a ->{Storage d g, g} (d a) -save a = !(save.impl a) -``` - -``` 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`: - - ability Storage d g - save : a ->{g, Storage d g} d a - -``` diff --git a/unison-src/transcripts/fix2353.md b/unison-src/transcripts/fix2353.md deleted file mode 100644 index f9662633cd..0000000000 --- a/unison-src/transcripts/fix2353.md +++ /dev/null @@ -1,16 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -use builtin Scope -unique ability Async t g where async : {g} Nat -unique ability Exception where raise : Nat -> x - -pure.run : a -> (forall t . '{Async t g} a) ->{Exception, g} a -pure.run a0 a = - a' : forall s . '{Scope s, Exception, g} a - a' = 'a0 -- typechecks - -- make sure this builtin can still be referenced - Scope.run a' -``` diff --git a/unison-src/transcripts/fix2353.output.md b/unison-src/transcripts/fix2353.output.md deleted file mode 100644 index a6a8be6b6c..0000000000 --- a/unison-src/transcripts/fix2353.output.md +++ /dev/null @@ -1,28 +0,0 @@ -``` unison -use builtin Scope -unique ability Async t g where async : {g} Nat -unique ability Exception where raise : Nat -> x - -pure.run : a -> (forall t . '{Async t g} a) ->{Exception, g} a -pure.run a0 a = - a' : forall s . '{Scope s, Exception, g} a - a' = 'a0 -- typechecks - -- make sure this builtin can still be referenced - Scope.run a' -``` - -``` 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`: - - ability Async t g - ability Exception - pure.run : a -> (∀ t. '{Async t g} a) ->{g, Exception} a - -``` diff --git a/unison-src/transcripts/fix2354.md b/unison-src/transcripts/fix2354.md deleted file mode 100644 index f8a637022d..0000000000 --- a/unison-src/transcripts/fix2354.md +++ /dev/null @@ -1,14 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -Tests that delaying an un-annotated higher-rank type gives a normal -type error, rather than an internal compiler error. - -```unison:error -f : (forall a . a -> a) -> Nat -f id = id 0 - -x = 'f -``` diff --git a/unison-src/transcripts/fix2354.output.md b/unison-src/transcripts/fix2354.output.md deleted file mode 100644 index 226d20bc54..0000000000 --- a/unison-src/transcripts/fix2354.output.md +++ /dev/null @@ -1,28 +0,0 @@ -Tests that delaying an un-annotated higher-rank type gives a normal -type error, rather than an internal compiler error. - -``` unison -f : (forall a . a -> a) -> Nat -f id = id 0 - -x = 'f -``` - -``` ucm - - Loading changes detected in scratch.u. - - I found a value of type: (a1 ->{𝕖} a1) ->{𝕖} Nat - where I expected to find: (a -> 𝕣1) -> 𝕣 - - 1 | f : (forall a . a -> a) -> Nat - 2 | f id = id 0 - 3 | - 4 | x = 'f - - from right here: - - 1 | f : (forall a . a -> a) -> Nat - - -``` diff --git a/unison-src/transcripts/fix2355.md b/unison-src/transcripts/fix2355.md deleted file mode 100644 index a9b22fc3f3..0000000000 --- a/unison-src/transcripts/fix2355.md +++ /dev/null @@ -1,25 +0,0 @@ - -Tests for a loop that was previously occurring in the type checker. - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison:error -structural ability A t g where - fork : '{g, A t g} a -> t a - await : t a -> a - empty! : t a - put : a -> t a -> () - -example : '{A t {}} Nat -example = 'let - r = A.empty! - go u = - t = A.fork '(go (u + 1)) - A.await t - - go 0 - t2 = A.fork '(A.put 10 r) - A.await r -``` diff --git a/unison-src/transcripts/fix2355.output.md b/unison-src/transcripts/fix2355.output.md deleted file mode 100644 index b162860a9f..0000000000 --- a/unison-src/transcripts/fix2355.output.md +++ /dev/null @@ -1,41 +0,0 @@ -Tests for a loop that was previously occurring in the type checker. - -``` unison -structural ability A t g where - fork : '{g, A t g} a -> t a - await : t a -> a - empty! : t a - put : a -> t a -> () - -example : '{A t {}} Nat -example = 'let - r = A.empty! - go u = - t = A.fork '(go (u + 1)) - A.await t - - go 0 - t2 = A.fork '(A.put 10 r) - A.await r -``` - -``` ucm - - Loading changes detected in scratch.u. - - I tried to infer a cyclic ability. - - The expression in red was inferred to require the ability: - - {A t25 {𝕖36, 𝕖18}} - - where `𝕖18` is its overall abilities. - - I need a type signature to help figure this out. - - 10 | go u = - 11 | t = A.fork '(go (u + 1)) - 12 | A.await t - - -``` diff --git a/unison-src/transcripts/fix2378.md b/unison-src/transcripts/fix2378.md deleted file mode 100644 index 586e6335c3..0000000000 --- a/unison-src/transcripts/fix2378.md +++ /dev/null @@ -1,44 +0,0 @@ - -Tests for an ability failure that was caused by order dependence of -checking wanted vs. provided abilities. It was necessary to re-check -rows until a fixed point is reached. - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -unique ability C c where - new : c a - receive : c a -> a - send : a -> c a -> () - -unique ability A t g where - fork : '{A t g, g, Exception} a -> t a - await : t a -> a - -unique ability Ex where raise : () -> x - -Ex.catch : '{Ex, g} a ->{g} Either () a -Ex.catch _ = todo "Exception.catch" - -C.pure.run : (forall c . '{C c, g} r) ->{Ex, g} r -C.pure.run _ = todo "C.pure.run" - -A.pure.run : (forall t . '{A t g, g} a) ->{Ex,g} a -A.pure.run _ = todo "A.pure.run" - -ex : '{C c, A t {C c}} Nat -ex _ = - c = C.new - x = A.fork 'let - a = receive c - a + 10 - y = A.fork 'let - send 0 c - () - A.await x - -x : '{} (Either () Nat) -x _ = Ex.catch '(C.pure.run '(A.pure.run ex)) -``` diff --git a/unison-src/transcripts/fix2378.output.md b/unison-src/transcripts/fix2378.output.md deleted file mode 100644 index 0c63239cc5..0000000000 --- a/unison-src/transcripts/fix2378.output.md +++ /dev/null @@ -1,60 +0,0 @@ -Tests for an ability failure that was caused by order dependence of -checking wanted vs. provided abilities. It was necessary to re-check -rows until a fixed point is reached. - -``` unison -unique ability C c where - new : c a - receive : c a -> a - send : a -> c a -> () - -unique ability A t g where - fork : '{A t g, g, Exception} a -> t a - await : t a -> a - -unique ability Ex where raise : () -> x - -Ex.catch : '{Ex, g} a ->{g} Either () a -Ex.catch _ = todo "Exception.catch" - -C.pure.run : (forall c . '{C c, g} r) ->{Ex, g} r -C.pure.run _ = todo "C.pure.run" - -A.pure.run : (forall t . '{A t g, g} a) ->{Ex,g} a -A.pure.run _ = todo "A.pure.run" - -ex : '{C c, A t {C c}} Nat -ex _ = - c = C.new - x = A.fork 'let - a = receive c - a + 10 - y = A.fork 'let - send 0 c - () - A.await x - -x : '{} (Either () Nat) -x _ = Ex.catch '(C.pure.run '(A.pure.run ex)) -``` - -``` 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`: - - ability A t g - ability C c - ability Ex - A.pure.run : (∀ t. '{g, A t g} a) ->{g, Ex} a - C.pure.run : (∀ c. '{g, C c} r) ->{g, Ex} r - Ex.catch : '{g, Ex} a ->{g} Either () a - ex : '{C c, A t {C c}} Nat - x : 'Either () Nat - -``` diff --git a/unison-src/transcripts/fix2423.md b/unison-src/transcripts/fix2423.md deleted file mode 100644 index 72b3450557..0000000000 --- a/unison-src/transcripts/fix2423.md +++ /dev/null @@ -1,31 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -structural ability Split where - skip! : x - both : a -> a -> a - -Split.append : '{Split, g} a -> '{Split, g} a -> '{Split, g} a -Split.append s1 s2 _ = force (both s1 s2) - -force a = !a - -Split.zipSame : '{Split, g} a -> '{Split, g} b -> '{Split, g} (a, b) -Split.zipSame sa sb _ = - go : '{Split,g2} y -> Request {Split} x ->{Split,g2} (x,y) - go sb = cases - { a } -> (a, !sb) - { skip! -> _ } -> skip! - { both la ra -> k } -> - handle !sb with cases - { _ } -> skip! - { skip! -> k } -> skip! - { both lb rb -> k2 } -> - force (Split.append - (zipSame '(k la) '(k2 lb)) - (zipSame '(k ra) '(k2 rb))) - - handle !sa with go sb -``` diff --git a/unison-src/transcripts/fix2423.output.md b/unison-src/transcripts/fix2423.output.md deleted file mode 100644 index 40d2fa6509..0000000000 --- a/unison-src/transcripts/fix2423.output.md +++ /dev/null @@ -1,48 +0,0 @@ -``` unison -structural ability Split where - skip! : x - both : a -> a -> a - -Split.append : '{Split, g} a -> '{Split, g} a -> '{Split, g} a -Split.append s1 s2 _ = force (both s1 s2) - -force a = !a - -Split.zipSame : '{Split, g} a -> '{Split, g} b -> '{Split, g} (a, b) -Split.zipSame sa sb _ = - go : '{Split,g2} y -> Request {Split} x ->{Split,g2} (x,y) - go sb = cases - { a } -> (a, !sb) - { skip! -> _ } -> skip! - { both la ra -> k } -> - handle !sb with cases - { _ } -> skip! - { skip! -> k } -> skip! - { both lb rb -> k2 } -> - force (Split.append - (zipSame '(k la) '(k2 lb)) - (zipSame '(k ra) '(k2 rb))) - - handle !sa with go sb -``` - -``` 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`: - - structural ability Split - Split.append : '{g, Split} a - -> '{g, Split} a - -> '{g, Split} a - Split.zipSame : '{g, Split} a - -> '{g, Split} b - -> '{g, Split} (a, b) - force : '{g} o ->{g} o - -``` diff --git a/unison-src/transcripts/fix2474.md b/unison-src/transcripts/fix2474.md deleted file mode 100644 index e84cd4a9e7..0000000000 --- a/unison-src/transcripts/fix2474.md +++ /dev/null @@ -1,34 +0,0 @@ -Tests an issue with a lack of generality of handlers. - -In general, a set of cases: - - { e ... -> k } - -should be typed in the following way: - - 1. The scrutinee has type `Request {E, g} r -> s` where `E` is all - the abilities being handled. `g` is a slack variable, because all - abilities that are used in the handled expression pass through - the handler. Previously this was being inferred as merely - `Request {E} r -> s` - 2. The continuation variable `k` should have type `o ->{E, g} r`, - matching the above types (`o` is the result type of `e`). - Previously this was being checked as `o ->{E0} r`, where `E0` is - the ability that contains `e`. - -```ucm -scratch/main> builtins.merge -``` - -```unison -structural ability Stream a where - emit : a -> () - -Stream.uncons : '{Stream a, g} r ->{g} Either r (a, '{Stream a, g} r) -Stream.uncons s = - go : Request {Stream a,g} r -> Either r (a, '{Stream a,g} r) - go = cases - { r } -> Left r - { Stream.emit a -> tl } -> Right (a, tl : '{Stream a,g} r) - handle !s with go -``` diff --git a/unison-src/transcripts/fix2474.output.md b/unison-src/transcripts/fix2474.output.md deleted file mode 100644 index 519f0d2b30..0000000000 --- a/unison-src/transcripts/fix2474.output.md +++ /dev/null @@ -1,54 +0,0 @@ -Tests an issue with a lack of generality of handlers. - -In general, a set of cases: - -``` -{ e ... -> k } -``` - -should be typed in the following way: - -1. The scrutinee has type `Request {E, g} r -> s` where `E` is all - the abilities being handled. `g` is a slack variable, because all - abilities that are used in the handled expression pass through - the handler. Previously this was being inferred as merely - `Request {E} r -> s` -2. The continuation variable `k` should have type `o ->{E, g} r`, - matching the above types (`o` is the result type of `e`). - Previously this was being checked as `o ->{E0} r`, where `E0` is - the ability that contains `e`. - -``` ucm -scratch/main> builtins.merge - - Done. - -``` -``` unison -structural ability Stream a where - emit : a -> () - -Stream.uncons : '{Stream a, g} r ->{g} Either r (a, '{Stream a, g} r) -Stream.uncons s = - go : Request {Stream a,g} r -> Either r (a, '{Stream a,g} r) - go = cases - { r } -> Left r - { Stream.emit a -> tl } -> Right (a, tl : '{Stream a,g} r) - handle !s with go -``` - -``` 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`: - - structural ability Stream a - Stream.uncons : '{g, Stream a} r - ->{g} Either r (a, '{g, Stream a} r) - -``` diff --git a/unison-src/transcripts/fix2628.md b/unison-src/transcripts/fix2628.md deleted file mode 100644 index cef5bd4a98..0000000000 --- a/unison-src/transcripts/fix2628.md +++ /dev/null @@ -1,15 +0,0 @@ -```ucm:hide -scratch/main> alias.type ##Nat lib.base.Nat -``` - -```unison:hide -unique type foo.bar.baz.MyRecord = { - value : Nat -} -``` - -```ucm -scratch/main> add - -scratch/main> find : Nat -> MyRecord -``` diff --git a/unison-src/transcripts/fix2628.output.md b/unison-src/transcripts/fix2628.output.md deleted file mode 100644 index 87aa68a672..0000000000 --- a/unison-src/transcripts/fix2628.output.md +++ /dev/null @@ -1,26 +0,0 @@ -``` unison -unique type foo.bar.baz.MyRecord = { - value : Nat -} -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type foo.bar.baz.MyRecord - foo.bar.baz.MyRecord.value : MyRecord -> Nat - foo.bar.baz.MyRecord.value.modify : (Nat ->{g} Nat) - -> MyRecord - ->{g} MyRecord - foo.bar.baz.MyRecord.value.set : Nat - -> MyRecord - -> MyRecord - -scratch/main> find : Nat -> MyRecord - - 1. foo.bar.baz.MyRecord.MyRecord : Nat -> MyRecord - - -``` diff --git a/unison-src/transcripts/fix2663.md b/unison-src/transcripts/fix2663.md deleted file mode 100644 index ee6a5b749a..0000000000 --- a/unison-src/transcripts/fix2663.md +++ /dev/null @@ -1,23 +0,0 @@ -Tests a variable capture problem. - -After pattern compilation, the match would end up: - - T p1 p3 p3 - -and z would end up referring to the first p3 rather than the second. - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -structural type Trip = T Nat Nat Nat - -bad : Nat -> (Nat, Nat) -bad x = match Some (Some x) with - Some (Some x) -> match T 3 4 5 with - T _ _ z -> (x, z) - _ -> (0,0) - -> bad 2 -``` diff --git a/unison-src/transcripts/fix2663.output.md b/unison-src/transcripts/fix2663.output.md deleted file mode 100644 index 2e12426d9b..0000000000 --- a/unison-src/transcripts/fix2663.output.md +++ /dev/null @@ -1,43 +0,0 @@ -Tests a variable capture problem. - -After pattern compilation, the match would end up: - -``` -T p1 p3 p3 -``` - -and z would end up referring to the first p3 rather than the second. - -``` unison -structural type Trip = T Nat Nat Nat - -bad : Nat -> (Nat, Nat) -bad x = match Some (Some x) with - Some (Some x) -> match T 3 4 5 with - T _ _ z -> (x, z) - _ -> (0,0) - -> bad 2 -``` - -``` 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`: - - structural type Trip - bad : Nat -> (Nat, Nat) - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 9 | > bad 2 - ⧩ - (2, 5) - -``` diff --git a/unison-src/transcripts/fix2693.md b/unison-src/transcripts/fix2693.md deleted file mode 100644 index 2bd2a0082e..0000000000 --- a/unison-src/transcripts/fix2693.md +++ /dev/null @@ -1,28 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -loop : List Nat -> Nat -> List Nat -loop l = cases - 0 -> l - n -> loop (n +: l) (drop n 1) - -range : Nat -> List Nat -range = loop [] -``` - -```ucm -scratch/main> add -``` - -```unison -> range 2000 -``` - -Should be cached: - -```unison -> range 2000 -``` diff --git a/unison-src/transcripts/fix2693.output.md b/unison-src/transcripts/fix2693.output.md deleted file mode 100644 index e5414c32a8..0000000000 --- a/unison-src/transcripts/fix2693.output.md +++ /dev/null @@ -1,4075 +0,0 @@ -``` unison -loop : List Nat -> Nat -> List Nat -loop l = cases - 0 -> l - n -> loop (n +: l) (drop n 1) - -range : Nat -> List Nat -range = loop [] -``` - -``` 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`: - - loop : [Nat] -> Nat -> [Nat] - range : Nat -> [Nat] - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - loop : [Nat] -> Nat -> [Nat] - range : Nat -> [Nat] - -``` -``` unison -> range 2000 -``` - -``` ucm - - Loading changes detected in scratch.u. - - ✅ - - scratch.u changed. - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 1 | > range 2000 - ⧩ - [ 1 - , 2 - , 3 - , 4 - , 5 - , 6 - , 7 - , 8 - , 9 - , 10 - , 11 - , 12 - , 13 - , 14 - , 15 - , 16 - , 17 - , 18 - , 19 - , 20 - , 21 - , 22 - , 23 - , 24 - , 25 - , 26 - , 27 - , 28 - , 29 - , 30 - , 31 - , 32 - , 33 - , 34 - , 35 - , 36 - , 37 - , 38 - , 39 - , 40 - , 41 - , 42 - , 43 - , 44 - , 45 - , 46 - , 47 - , 48 - , 49 - , 50 - , 51 - , 52 - , 53 - , 54 - , 55 - , 56 - , 57 - , 58 - , 59 - , 60 - , 61 - , 62 - , 63 - , 64 - , 65 - , 66 - , 67 - , 68 - , 69 - , 70 - , 71 - , 72 - , 73 - , 74 - , 75 - , 76 - , 77 - , 78 - , 79 - , 80 - , 81 - , 82 - , 83 - , 84 - , 85 - , 86 - , 87 - , 88 - , 89 - , 90 - , 91 - , 92 - , 93 - , 94 - , 95 - , 96 - , 97 - , 98 - , 99 - , 100 - , 101 - , 102 - , 103 - , 104 - , 105 - , 106 - , 107 - , 108 - , 109 - , 110 - , 111 - , 112 - , 113 - , 114 - , 115 - , 116 - , 117 - , 118 - , 119 - , 120 - , 121 - , 122 - , 123 - , 124 - , 125 - , 126 - , 127 - , 128 - , 129 - , 130 - , 131 - , 132 - , 133 - , 134 - , 135 - , 136 - , 137 - , 138 - , 139 - , 140 - , 141 - , 142 - , 143 - , 144 - , 145 - , 146 - , 147 - , 148 - , 149 - , 150 - , 151 - , 152 - , 153 - , 154 - , 155 - , 156 - , 157 - , 158 - , 159 - , 160 - , 161 - , 162 - , 163 - , 164 - , 165 - , 166 - , 167 - , 168 - , 169 - , 170 - , 171 - , 172 - , 173 - , 174 - , 175 - , 176 - , 177 - , 178 - , 179 - , 180 - , 181 - , 182 - , 183 - , 184 - , 185 - , 186 - , 187 - , 188 - , 189 - , 190 - , 191 - , 192 - , 193 - , 194 - , 195 - , 196 - , 197 - , 198 - , 199 - , 200 - , 201 - , 202 - , 203 - , 204 - , 205 - , 206 - , 207 - , 208 - , 209 - , 210 - , 211 - , 212 - , 213 - , 214 - , 215 - , 216 - , 217 - , 218 - , 219 - , 220 - , 221 - , 222 - , 223 - , 224 - , 225 - , 226 - , 227 - , 228 - , 229 - , 230 - , 231 - , 232 - , 233 - , 234 - , 235 - , 236 - , 237 - , 238 - , 239 - , 240 - , 241 - , 242 - , 243 - , 244 - , 245 - , 246 - , 247 - , 248 - , 249 - , 250 - , 251 - , 252 - , 253 - , 254 - , 255 - , 256 - , 257 - , 258 - , 259 - , 260 - , 261 - , 262 - , 263 - , 264 - , 265 - , 266 - , 267 - , 268 - , 269 - , 270 - , 271 - , 272 - , 273 - , 274 - , 275 - , 276 - , 277 - , 278 - , 279 - , 280 - , 281 - , 282 - , 283 - , 284 - , 285 - , 286 - , 287 - , 288 - , 289 - , 290 - , 291 - , 292 - , 293 - , 294 - , 295 - , 296 - , 297 - , 298 - , 299 - , 300 - , 301 - , 302 - , 303 - , 304 - , 305 - , 306 - , 307 - , 308 - , 309 - , 310 - , 311 - , 312 - , 313 - , 314 - , 315 - , 316 - , 317 - , 318 - , 319 - , 320 - , 321 - , 322 - , 323 - , 324 - , 325 - , 326 - , 327 - , 328 - , 329 - , 330 - , 331 - , 332 - , 333 - , 334 - , 335 - , 336 - , 337 - , 338 - , 339 - , 340 - , 341 - , 342 - , 343 - , 344 - , 345 - , 346 - , 347 - , 348 - , 349 - , 350 - , 351 - , 352 - , 353 - , 354 - , 355 - , 356 - , 357 - , 358 - , 359 - , 360 - , 361 - , 362 - , 363 - , 364 - , 365 - , 366 - , 367 - , 368 - , 369 - , 370 - , 371 - , 372 - , 373 - , 374 - , 375 - , 376 - , 377 - , 378 - , 379 - , 380 - , 381 - , 382 - , 383 - , 384 - , 385 - , 386 - , 387 - , 388 - , 389 - , 390 - , 391 - , 392 - , 393 - , 394 - , 395 - , 396 - , 397 - , 398 - , 399 - , 400 - , 401 - , 402 - , 403 - , 404 - , 405 - , 406 - , 407 - , 408 - , 409 - , 410 - , 411 - , 412 - , 413 - , 414 - , 415 - , 416 - , 417 - , 418 - , 419 - , 420 - , 421 - , 422 - , 423 - , 424 - , 425 - , 426 - , 427 - , 428 - , 429 - , 430 - , 431 - , 432 - , 433 - , 434 - , 435 - , 436 - , 437 - , 438 - , 439 - , 440 - , 441 - , 442 - , 443 - , 444 - , 445 - , 446 - , 447 - , 448 - , 449 - , 450 - , 451 - , 452 - , 453 - , 454 - , 455 - , 456 - , 457 - , 458 - , 459 - , 460 - , 461 - , 462 - , 463 - , 464 - , 465 - , 466 - , 467 - , 468 - , 469 - , 470 - , 471 - , 472 - , 473 - , 474 - , 475 - , 476 - , 477 - , 478 - , 479 - , 480 - , 481 - , 482 - , 483 - , 484 - , 485 - , 486 - , 487 - , 488 - , 489 - , 490 - , 491 - , 492 - , 493 - , 494 - , 495 - , 496 - , 497 - , 498 - , 499 - , 500 - , 501 - , 502 - , 503 - , 504 - , 505 - , 506 - , 507 - , 508 - , 509 - , 510 - , 511 - , 512 - , 513 - , 514 - , 515 - , 516 - , 517 - , 518 - , 519 - , 520 - , 521 - , 522 - , 523 - , 524 - , 525 - , 526 - , 527 - , 528 - , 529 - , 530 - , 531 - , 532 - , 533 - , 534 - , 535 - , 536 - , 537 - , 538 - , 539 - , 540 - , 541 - , 542 - , 543 - , 544 - , 545 - , 546 - , 547 - , 548 - , 549 - , 550 - , 551 - , 552 - , 553 - , 554 - , 555 - , 556 - , 557 - , 558 - , 559 - , 560 - , 561 - , 562 - , 563 - , 564 - , 565 - , 566 - , 567 - , 568 - , 569 - , 570 - , 571 - , 572 - , 573 - , 574 - , 575 - , 576 - , 577 - , 578 - , 579 - , 580 - , 581 - , 582 - , 583 - , 584 - , 585 - , 586 - , 587 - , 588 - , 589 - , 590 - , 591 - , 592 - , 593 - , 594 - , 595 - , 596 - , 597 - , 598 - , 599 - , 600 - , 601 - , 602 - , 603 - , 604 - , 605 - , 606 - , 607 - , 608 - , 609 - , 610 - , 611 - , 612 - , 613 - , 614 - , 615 - , 616 - , 617 - , 618 - , 619 - , 620 - , 621 - , 622 - , 623 - , 624 - , 625 - , 626 - , 627 - , 628 - , 629 - , 630 - , 631 - , 632 - , 633 - , 634 - , 635 - , 636 - , 637 - , 638 - , 639 - , 640 - , 641 - , 642 - , 643 - , 644 - , 645 - , 646 - , 647 - , 648 - , 649 - , 650 - , 651 - , 652 - , 653 - , 654 - , 655 - , 656 - , 657 - , 658 - , 659 - , 660 - , 661 - , 662 - , 663 - , 664 - , 665 - , 666 - , 667 - , 668 - , 669 - , 670 - , 671 - , 672 - , 673 - , 674 - , 675 - , 676 - , 677 - , 678 - , 679 - , 680 - , 681 - , 682 - , 683 - , 684 - , 685 - , 686 - , 687 - , 688 - , 689 - , 690 - , 691 - , 692 - , 693 - , 694 - , 695 - , 696 - , 697 - , 698 - , 699 - , 700 - , 701 - , 702 - , 703 - , 704 - , 705 - , 706 - , 707 - , 708 - , 709 - , 710 - , 711 - , 712 - , 713 - , 714 - , 715 - , 716 - , 717 - , 718 - , 719 - , 720 - , 721 - , 722 - , 723 - , 724 - , 725 - , 726 - , 727 - , 728 - , 729 - , 730 - , 731 - , 732 - , 733 - , 734 - , 735 - , 736 - , 737 - , 738 - , 739 - , 740 - , 741 - , 742 - , 743 - , 744 - , 745 - , 746 - , 747 - , 748 - , 749 - , 750 - , 751 - , 752 - , 753 - , 754 - , 755 - , 756 - , 757 - , 758 - , 759 - , 760 - , 761 - , 762 - , 763 - , 764 - , 765 - , 766 - , 767 - , 768 - , 769 - , 770 - , 771 - , 772 - , 773 - , 774 - , 775 - , 776 - , 777 - , 778 - , 779 - , 780 - , 781 - , 782 - , 783 - , 784 - , 785 - , 786 - , 787 - , 788 - , 789 - , 790 - , 791 - , 792 - , 793 - , 794 - , 795 - , 796 - , 797 - , 798 - , 799 - , 800 - , 801 - , 802 - , 803 - , 804 - , 805 - , 806 - , 807 - , 808 - , 809 - , 810 - , 811 - , 812 - , 813 - , 814 - , 815 - , 816 - , 817 - , 818 - , 819 - , 820 - , 821 - , 822 - , 823 - , 824 - , 825 - , 826 - , 827 - , 828 - , 829 - , 830 - , 831 - , 832 - , 833 - , 834 - , 835 - , 836 - , 837 - , 838 - , 839 - , 840 - , 841 - , 842 - , 843 - , 844 - , 845 - , 846 - , 847 - , 848 - , 849 - , 850 - , 851 - , 852 - , 853 - , 854 - , 855 - , 856 - , 857 - , 858 - , 859 - , 860 - , 861 - , 862 - , 863 - , 864 - , 865 - , 866 - , 867 - , 868 - , 869 - , 870 - , 871 - , 872 - , 873 - , 874 - , 875 - , 876 - , 877 - , 878 - , 879 - , 880 - , 881 - , 882 - , 883 - , 884 - , 885 - , 886 - , 887 - , 888 - , 889 - , 890 - , 891 - , 892 - , 893 - , 894 - , 895 - , 896 - , 897 - , 898 - , 899 - , 900 - , 901 - , 902 - , 903 - , 904 - , 905 - , 906 - , 907 - , 908 - , 909 - , 910 - , 911 - , 912 - , 913 - , 914 - , 915 - , 916 - , 917 - , 918 - , 919 - , 920 - , 921 - , 922 - , 923 - , 924 - , 925 - , 926 - , 927 - , 928 - , 929 - , 930 - , 931 - , 932 - , 933 - , 934 - , 935 - , 936 - , 937 - , 938 - , 939 - , 940 - , 941 - , 942 - , 943 - , 944 - , 945 - , 946 - , 947 - , 948 - , 949 - , 950 - , 951 - , 952 - , 953 - , 954 - , 955 - , 956 - , 957 - , 958 - , 959 - , 960 - , 961 - , 962 - , 963 - , 964 - , 965 - , 966 - , 967 - , 968 - , 969 - , 970 - , 971 - , 972 - , 973 - , 974 - , 975 - , 976 - , 977 - , 978 - , 979 - , 980 - , 981 - , 982 - , 983 - , 984 - , 985 - , 986 - , 987 - , 988 - , 989 - , 990 - , 991 - , 992 - , 993 - , 994 - , 995 - , 996 - , 997 - , 998 - , 999 - , 1000 - , 1001 - , 1002 - , 1003 - , 1004 - , 1005 - , 1006 - , 1007 - , 1008 - , 1009 - , 1010 - , 1011 - , 1012 - , 1013 - , 1014 - , 1015 - , 1016 - , 1017 - , 1018 - , 1019 - , 1020 - , 1021 - , 1022 - , 1023 - , 1024 - , 1025 - , 1026 - , 1027 - , 1028 - , 1029 - , 1030 - , 1031 - , 1032 - , 1033 - , 1034 - , 1035 - , 1036 - , 1037 - , 1038 - , 1039 - , 1040 - , 1041 - , 1042 - , 1043 - , 1044 - , 1045 - , 1046 - , 1047 - , 1048 - , 1049 - , 1050 - , 1051 - , 1052 - , 1053 - , 1054 - , 1055 - , 1056 - , 1057 - , 1058 - , 1059 - , 1060 - , 1061 - , 1062 - , 1063 - , 1064 - , 1065 - , 1066 - , 1067 - , 1068 - , 1069 - , 1070 - , 1071 - , 1072 - , 1073 - , 1074 - , 1075 - , 1076 - , 1077 - , 1078 - , 1079 - , 1080 - , 1081 - , 1082 - , 1083 - , 1084 - , 1085 - , 1086 - , 1087 - , 1088 - , 1089 - , 1090 - , 1091 - , 1092 - , 1093 - , 1094 - , 1095 - , 1096 - , 1097 - , 1098 - , 1099 - , 1100 - , 1101 - , 1102 - , 1103 - , 1104 - , 1105 - , 1106 - , 1107 - , 1108 - , 1109 - , 1110 - , 1111 - , 1112 - , 1113 - , 1114 - , 1115 - , 1116 - , 1117 - , 1118 - , 1119 - , 1120 - , 1121 - , 1122 - , 1123 - , 1124 - , 1125 - , 1126 - , 1127 - , 1128 - , 1129 - , 1130 - , 1131 - , 1132 - , 1133 - , 1134 - , 1135 - , 1136 - , 1137 - , 1138 - , 1139 - , 1140 - , 1141 - , 1142 - , 1143 - , 1144 - , 1145 - , 1146 - , 1147 - , 1148 - , 1149 - , 1150 - , 1151 - , 1152 - , 1153 - , 1154 - , 1155 - , 1156 - , 1157 - , 1158 - , 1159 - , 1160 - , 1161 - , 1162 - , 1163 - , 1164 - , 1165 - , 1166 - , 1167 - , 1168 - , 1169 - , 1170 - , 1171 - , 1172 - , 1173 - , 1174 - , 1175 - , 1176 - , 1177 - , 1178 - , 1179 - , 1180 - , 1181 - , 1182 - , 1183 - , 1184 - , 1185 - , 1186 - , 1187 - , 1188 - , 1189 - , 1190 - , 1191 - , 1192 - , 1193 - , 1194 - , 1195 - , 1196 - , 1197 - , 1198 - , 1199 - , 1200 - , 1201 - , 1202 - , 1203 - , 1204 - , 1205 - , 1206 - , 1207 - , 1208 - , 1209 - , 1210 - , 1211 - , 1212 - , 1213 - , 1214 - , 1215 - , 1216 - , 1217 - , 1218 - , 1219 - , 1220 - , 1221 - , 1222 - , 1223 - , 1224 - , 1225 - , 1226 - , 1227 - , 1228 - , 1229 - , 1230 - , 1231 - , 1232 - , 1233 - , 1234 - , 1235 - , 1236 - , 1237 - , 1238 - , 1239 - , 1240 - , 1241 - , 1242 - , 1243 - , 1244 - , 1245 - , 1246 - , 1247 - , 1248 - , 1249 - , 1250 - , 1251 - , 1252 - , 1253 - , 1254 - , 1255 - , 1256 - , 1257 - , 1258 - , 1259 - , 1260 - , 1261 - , 1262 - , 1263 - , 1264 - , 1265 - , 1266 - , 1267 - , 1268 - , 1269 - , 1270 - , 1271 - , 1272 - , 1273 - , 1274 - , 1275 - , 1276 - , 1277 - , 1278 - , 1279 - , 1280 - , 1281 - , 1282 - , 1283 - , 1284 - , 1285 - , 1286 - , 1287 - , 1288 - , 1289 - , 1290 - , 1291 - , 1292 - , 1293 - , 1294 - , 1295 - , 1296 - , 1297 - , 1298 - , 1299 - , 1300 - , 1301 - , 1302 - , 1303 - , 1304 - , 1305 - , 1306 - , 1307 - , 1308 - , 1309 - , 1310 - , 1311 - , 1312 - , 1313 - , 1314 - , 1315 - , 1316 - , 1317 - , 1318 - , 1319 - , 1320 - , 1321 - , 1322 - , 1323 - , 1324 - , 1325 - , 1326 - , 1327 - , 1328 - , 1329 - , 1330 - , 1331 - , 1332 - , 1333 - , 1334 - , 1335 - , 1336 - , 1337 - , 1338 - , 1339 - , 1340 - , 1341 - , 1342 - , 1343 - , 1344 - , 1345 - , 1346 - , 1347 - , 1348 - , 1349 - , 1350 - , 1351 - , 1352 - , 1353 - , 1354 - , 1355 - , 1356 - , 1357 - , 1358 - , 1359 - , 1360 - , 1361 - , 1362 - , 1363 - , 1364 - , 1365 - , 1366 - , 1367 - , 1368 - , 1369 - , 1370 - , 1371 - , 1372 - , 1373 - , 1374 - , 1375 - , 1376 - , 1377 - , 1378 - , 1379 - , 1380 - , 1381 - , 1382 - , 1383 - , 1384 - , 1385 - , 1386 - , 1387 - , 1388 - , 1389 - , 1390 - , 1391 - , 1392 - , 1393 - , 1394 - , 1395 - , 1396 - , 1397 - , 1398 - , 1399 - , 1400 - , 1401 - , 1402 - , 1403 - , 1404 - , 1405 - , 1406 - , 1407 - , 1408 - , 1409 - , 1410 - , 1411 - , 1412 - , 1413 - , 1414 - , 1415 - , 1416 - , 1417 - , 1418 - , 1419 - , 1420 - , 1421 - , 1422 - , 1423 - , 1424 - , 1425 - , 1426 - , 1427 - , 1428 - , 1429 - , 1430 - , 1431 - , 1432 - , 1433 - , 1434 - , 1435 - , 1436 - , 1437 - , 1438 - , 1439 - , 1440 - , 1441 - , 1442 - , 1443 - , 1444 - , 1445 - , 1446 - , 1447 - , 1448 - , 1449 - , 1450 - , 1451 - , 1452 - , 1453 - , 1454 - , 1455 - , 1456 - , 1457 - , 1458 - , 1459 - , 1460 - , 1461 - , 1462 - , 1463 - , 1464 - , 1465 - , 1466 - , 1467 - , 1468 - , 1469 - , 1470 - , 1471 - , 1472 - , 1473 - , 1474 - , 1475 - , 1476 - , 1477 - , 1478 - , 1479 - , 1480 - , 1481 - , 1482 - , 1483 - , 1484 - , 1485 - , 1486 - , 1487 - , 1488 - , 1489 - , 1490 - , 1491 - , 1492 - , 1493 - , 1494 - , 1495 - , 1496 - , 1497 - , 1498 - , 1499 - , 1500 - , 1501 - , 1502 - , 1503 - , 1504 - , 1505 - , 1506 - , 1507 - , 1508 - , 1509 - , 1510 - , 1511 - , 1512 - , 1513 - , 1514 - , 1515 - , 1516 - , 1517 - , 1518 - , 1519 - , 1520 - , 1521 - , 1522 - , 1523 - , 1524 - , 1525 - , 1526 - , 1527 - , 1528 - , 1529 - , 1530 - , 1531 - , 1532 - , 1533 - , 1534 - , 1535 - , 1536 - , 1537 - , 1538 - , 1539 - , 1540 - , 1541 - , 1542 - , 1543 - , 1544 - , 1545 - , 1546 - , 1547 - , 1548 - , 1549 - , 1550 - , 1551 - , 1552 - , 1553 - , 1554 - , 1555 - , 1556 - , 1557 - , 1558 - , 1559 - , 1560 - , 1561 - , 1562 - , 1563 - , 1564 - , 1565 - , 1566 - , 1567 - , 1568 - , 1569 - , 1570 - , 1571 - , 1572 - , 1573 - , 1574 - , 1575 - , 1576 - , 1577 - , 1578 - , 1579 - , 1580 - , 1581 - , 1582 - , 1583 - , 1584 - , 1585 - , 1586 - , 1587 - , 1588 - , 1589 - , 1590 - , 1591 - , 1592 - , 1593 - , 1594 - , 1595 - , 1596 - , 1597 - , 1598 - , 1599 - , 1600 - , 1601 - , 1602 - , 1603 - , 1604 - , 1605 - , 1606 - , 1607 - , 1608 - , 1609 - , 1610 - , 1611 - , 1612 - , 1613 - , 1614 - , 1615 - , 1616 - , 1617 - , 1618 - , 1619 - , 1620 - , 1621 - , 1622 - , 1623 - , 1624 - , 1625 - , 1626 - , 1627 - , 1628 - , 1629 - , 1630 - , 1631 - , 1632 - , 1633 - , 1634 - , 1635 - , 1636 - , 1637 - , 1638 - , 1639 - , 1640 - , 1641 - , 1642 - , 1643 - , 1644 - , 1645 - , 1646 - , 1647 - , 1648 - , 1649 - , 1650 - , 1651 - , 1652 - , 1653 - , 1654 - , 1655 - , 1656 - , 1657 - , 1658 - , 1659 - , 1660 - , 1661 - , 1662 - , 1663 - , 1664 - , 1665 - , 1666 - , 1667 - , 1668 - , 1669 - , 1670 - , 1671 - , 1672 - , 1673 - , 1674 - , 1675 - , 1676 - , 1677 - , 1678 - , 1679 - , 1680 - , 1681 - , 1682 - , 1683 - , 1684 - , 1685 - , 1686 - , 1687 - , 1688 - , 1689 - , 1690 - , 1691 - , 1692 - , 1693 - , 1694 - , 1695 - , 1696 - , 1697 - , 1698 - , 1699 - , 1700 - , 1701 - , 1702 - , 1703 - , 1704 - , 1705 - , 1706 - , 1707 - , 1708 - , 1709 - , 1710 - , 1711 - , 1712 - , 1713 - , 1714 - , 1715 - , 1716 - , 1717 - , 1718 - , 1719 - , 1720 - , 1721 - , 1722 - , 1723 - , 1724 - , 1725 - , 1726 - , 1727 - , 1728 - , 1729 - , 1730 - , 1731 - , 1732 - , 1733 - , 1734 - , 1735 - , 1736 - , 1737 - , 1738 - , 1739 - , 1740 - , 1741 - , 1742 - , 1743 - , 1744 - , 1745 - , 1746 - , 1747 - , 1748 - , 1749 - , 1750 - , 1751 - , 1752 - , 1753 - , 1754 - , 1755 - , 1756 - , 1757 - , 1758 - , 1759 - , 1760 - , 1761 - , 1762 - , 1763 - , 1764 - , 1765 - , 1766 - , 1767 - , 1768 - , 1769 - , 1770 - , 1771 - , 1772 - , 1773 - , 1774 - , 1775 - , 1776 - , 1777 - , 1778 - , 1779 - , 1780 - , 1781 - , 1782 - , 1783 - , 1784 - , 1785 - , 1786 - , 1787 - , 1788 - , 1789 - , 1790 - , 1791 - , 1792 - , 1793 - , 1794 - , 1795 - , 1796 - , 1797 - , 1798 - , 1799 - , 1800 - , 1801 - , 1802 - , 1803 - , 1804 - , 1805 - , 1806 - , 1807 - , 1808 - , 1809 - , 1810 - , 1811 - , 1812 - , 1813 - , 1814 - , 1815 - , 1816 - , 1817 - , 1818 - , 1819 - , 1820 - , 1821 - , 1822 - , 1823 - , 1824 - , 1825 - , 1826 - , 1827 - , 1828 - , 1829 - , 1830 - , 1831 - , 1832 - , 1833 - , 1834 - , 1835 - , 1836 - , 1837 - , 1838 - , 1839 - , 1840 - , 1841 - , 1842 - , 1843 - , 1844 - , 1845 - , 1846 - , 1847 - , 1848 - , 1849 - , 1850 - , 1851 - , 1852 - , 1853 - , 1854 - , 1855 - , 1856 - , 1857 - , 1858 - , 1859 - , 1860 - , 1861 - , 1862 - , 1863 - , 1864 - , 1865 - , 1866 - , 1867 - , 1868 - , 1869 - , 1870 - , 1871 - , 1872 - , 1873 - , 1874 - , 1875 - , 1876 - , 1877 - , 1878 - , 1879 - , 1880 - , 1881 - , 1882 - , 1883 - , 1884 - , 1885 - , 1886 - , 1887 - , 1888 - , 1889 - , 1890 - , 1891 - , 1892 - , 1893 - , 1894 - , 1895 - , 1896 - , 1897 - , 1898 - , 1899 - , 1900 - , 1901 - , 1902 - , 1903 - , 1904 - , 1905 - , 1906 - , 1907 - , 1908 - , 1909 - , 1910 - , 1911 - , 1912 - , 1913 - , 1914 - , 1915 - , 1916 - , 1917 - , 1918 - , 1919 - , 1920 - , 1921 - , 1922 - , 1923 - , 1924 - , 1925 - , 1926 - , 1927 - , 1928 - , 1929 - , 1930 - , 1931 - , 1932 - , 1933 - , 1934 - , 1935 - , 1936 - , 1937 - , 1938 - , 1939 - , 1940 - , 1941 - , 1942 - , 1943 - , 1944 - , 1945 - , 1946 - , 1947 - , 1948 - , 1949 - , 1950 - , 1951 - , 1952 - , 1953 - , 1954 - , 1955 - , 1956 - , 1957 - , 1958 - , 1959 - , 1960 - , 1961 - , 1962 - , 1963 - , 1964 - , 1965 - , 1966 - , 1967 - , 1968 - , 1969 - , 1970 - , 1971 - , 1972 - , 1973 - , 1974 - , 1975 - , 1976 - , 1977 - , 1978 - , 1979 - , 1980 - , 1981 - , 1982 - , 1983 - , 1984 - , 1985 - , 1986 - , 1987 - , 1988 - , 1989 - , 1990 - , 1991 - , 1992 - , 1993 - , 1994 - , 1995 - , 1996 - , 1997 - , 1998 - , 1999 - , 2000 - ] - -``` -Should be cached: - -``` unison -> range 2000 -``` - -``` ucm - - Loading changes detected in scratch.u. - - ✅ - - scratch.u changed. - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 1 | > range 2000 - ⧩ - [ 1 - , 2 - , 3 - , 4 - , 5 - , 6 - , 7 - , 8 - , 9 - , 10 - , 11 - , 12 - , 13 - , 14 - , 15 - , 16 - , 17 - , 18 - , 19 - , 20 - , 21 - , 22 - , 23 - , 24 - , 25 - , 26 - , 27 - , 28 - , 29 - , 30 - , 31 - , 32 - , 33 - , 34 - , 35 - , 36 - , 37 - , 38 - , 39 - , 40 - , 41 - , 42 - , 43 - , 44 - , 45 - , 46 - , 47 - , 48 - , 49 - , 50 - , 51 - , 52 - , 53 - , 54 - , 55 - , 56 - , 57 - , 58 - , 59 - , 60 - , 61 - , 62 - , 63 - , 64 - , 65 - , 66 - , 67 - , 68 - , 69 - , 70 - , 71 - , 72 - , 73 - , 74 - , 75 - , 76 - , 77 - , 78 - , 79 - , 80 - , 81 - , 82 - , 83 - , 84 - , 85 - , 86 - , 87 - , 88 - , 89 - , 90 - , 91 - , 92 - , 93 - , 94 - , 95 - , 96 - , 97 - , 98 - , 99 - , 100 - , 101 - , 102 - , 103 - , 104 - , 105 - , 106 - , 107 - , 108 - , 109 - , 110 - , 111 - , 112 - , 113 - , 114 - , 115 - , 116 - , 117 - , 118 - , 119 - , 120 - , 121 - , 122 - , 123 - , 124 - , 125 - , 126 - , 127 - , 128 - , 129 - , 130 - , 131 - , 132 - , 133 - , 134 - , 135 - , 136 - , 137 - , 138 - , 139 - , 140 - , 141 - , 142 - , 143 - , 144 - , 145 - , 146 - , 147 - , 148 - , 149 - , 150 - , 151 - , 152 - , 153 - , 154 - , 155 - , 156 - , 157 - , 158 - , 159 - , 160 - , 161 - , 162 - , 163 - , 164 - , 165 - , 166 - , 167 - , 168 - , 169 - , 170 - , 171 - , 172 - , 173 - , 174 - , 175 - , 176 - , 177 - , 178 - , 179 - , 180 - , 181 - , 182 - , 183 - , 184 - , 185 - , 186 - , 187 - , 188 - , 189 - , 190 - , 191 - , 192 - , 193 - , 194 - , 195 - , 196 - , 197 - , 198 - , 199 - , 200 - , 201 - , 202 - , 203 - , 204 - , 205 - , 206 - , 207 - , 208 - , 209 - , 210 - , 211 - , 212 - , 213 - , 214 - , 215 - , 216 - , 217 - , 218 - , 219 - , 220 - , 221 - , 222 - , 223 - , 224 - , 225 - , 226 - , 227 - , 228 - , 229 - , 230 - , 231 - , 232 - , 233 - , 234 - , 235 - , 236 - , 237 - , 238 - , 239 - , 240 - , 241 - , 242 - , 243 - , 244 - , 245 - , 246 - , 247 - , 248 - , 249 - , 250 - , 251 - , 252 - , 253 - , 254 - , 255 - , 256 - , 257 - , 258 - , 259 - , 260 - , 261 - , 262 - , 263 - , 264 - , 265 - , 266 - , 267 - , 268 - , 269 - , 270 - , 271 - , 272 - , 273 - , 274 - , 275 - , 276 - , 277 - , 278 - , 279 - , 280 - , 281 - , 282 - , 283 - , 284 - , 285 - , 286 - , 287 - , 288 - , 289 - , 290 - , 291 - , 292 - , 293 - , 294 - , 295 - , 296 - , 297 - , 298 - , 299 - , 300 - , 301 - , 302 - , 303 - , 304 - , 305 - , 306 - , 307 - , 308 - , 309 - , 310 - , 311 - , 312 - , 313 - , 314 - , 315 - , 316 - , 317 - , 318 - , 319 - , 320 - , 321 - , 322 - , 323 - , 324 - , 325 - , 326 - , 327 - , 328 - , 329 - , 330 - , 331 - , 332 - , 333 - , 334 - , 335 - , 336 - , 337 - , 338 - , 339 - , 340 - , 341 - , 342 - , 343 - , 344 - , 345 - , 346 - , 347 - , 348 - , 349 - , 350 - , 351 - , 352 - , 353 - , 354 - , 355 - , 356 - , 357 - , 358 - , 359 - , 360 - , 361 - , 362 - , 363 - , 364 - , 365 - , 366 - , 367 - , 368 - , 369 - , 370 - , 371 - , 372 - , 373 - , 374 - , 375 - , 376 - , 377 - , 378 - , 379 - , 380 - , 381 - , 382 - , 383 - , 384 - , 385 - , 386 - , 387 - , 388 - , 389 - , 390 - , 391 - , 392 - , 393 - , 394 - , 395 - , 396 - , 397 - , 398 - , 399 - , 400 - , 401 - , 402 - , 403 - , 404 - , 405 - , 406 - , 407 - , 408 - , 409 - , 410 - , 411 - , 412 - , 413 - , 414 - , 415 - , 416 - , 417 - , 418 - , 419 - , 420 - , 421 - , 422 - , 423 - , 424 - , 425 - , 426 - , 427 - , 428 - , 429 - , 430 - , 431 - , 432 - , 433 - , 434 - , 435 - , 436 - , 437 - , 438 - , 439 - , 440 - , 441 - , 442 - , 443 - , 444 - , 445 - , 446 - , 447 - , 448 - , 449 - , 450 - , 451 - , 452 - , 453 - , 454 - , 455 - , 456 - , 457 - , 458 - , 459 - , 460 - , 461 - , 462 - , 463 - , 464 - , 465 - , 466 - , 467 - , 468 - , 469 - , 470 - , 471 - , 472 - , 473 - , 474 - , 475 - , 476 - , 477 - , 478 - , 479 - , 480 - , 481 - , 482 - , 483 - , 484 - , 485 - , 486 - , 487 - , 488 - , 489 - , 490 - , 491 - , 492 - , 493 - , 494 - , 495 - , 496 - , 497 - , 498 - , 499 - , 500 - , 501 - , 502 - , 503 - , 504 - , 505 - , 506 - , 507 - , 508 - , 509 - , 510 - , 511 - , 512 - , 513 - , 514 - , 515 - , 516 - , 517 - , 518 - , 519 - , 520 - , 521 - , 522 - , 523 - , 524 - , 525 - , 526 - , 527 - , 528 - , 529 - , 530 - , 531 - , 532 - , 533 - , 534 - , 535 - , 536 - , 537 - , 538 - , 539 - , 540 - , 541 - , 542 - , 543 - , 544 - , 545 - , 546 - , 547 - , 548 - , 549 - , 550 - , 551 - , 552 - , 553 - , 554 - , 555 - , 556 - , 557 - , 558 - , 559 - , 560 - , 561 - , 562 - , 563 - , 564 - , 565 - , 566 - , 567 - , 568 - , 569 - , 570 - , 571 - , 572 - , 573 - , 574 - , 575 - , 576 - , 577 - , 578 - , 579 - , 580 - , 581 - , 582 - , 583 - , 584 - , 585 - , 586 - , 587 - , 588 - , 589 - , 590 - , 591 - , 592 - , 593 - , 594 - , 595 - , 596 - , 597 - , 598 - , 599 - , 600 - , 601 - , 602 - , 603 - , 604 - , 605 - , 606 - , 607 - , 608 - , 609 - , 610 - , 611 - , 612 - , 613 - , 614 - , 615 - , 616 - , 617 - , 618 - , 619 - , 620 - , 621 - , 622 - , 623 - , 624 - , 625 - , 626 - , 627 - , 628 - , 629 - , 630 - , 631 - , 632 - , 633 - , 634 - , 635 - , 636 - , 637 - , 638 - , 639 - , 640 - , 641 - , 642 - , 643 - , 644 - , 645 - , 646 - , 647 - , 648 - , 649 - , 650 - , 651 - , 652 - , 653 - , 654 - , 655 - , 656 - , 657 - , 658 - , 659 - , 660 - , 661 - , 662 - , 663 - , 664 - , 665 - , 666 - , 667 - , 668 - , 669 - , 670 - , 671 - , 672 - , 673 - , 674 - , 675 - , 676 - , 677 - , 678 - , 679 - , 680 - , 681 - , 682 - , 683 - , 684 - , 685 - , 686 - , 687 - , 688 - , 689 - , 690 - , 691 - , 692 - , 693 - , 694 - , 695 - , 696 - , 697 - , 698 - , 699 - , 700 - , 701 - , 702 - , 703 - , 704 - , 705 - , 706 - , 707 - , 708 - , 709 - , 710 - , 711 - , 712 - , 713 - , 714 - , 715 - , 716 - , 717 - , 718 - , 719 - , 720 - , 721 - , 722 - , 723 - , 724 - , 725 - , 726 - , 727 - , 728 - , 729 - , 730 - , 731 - , 732 - , 733 - , 734 - , 735 - , 736 - , 737 - , 738 - , 739 - , 740 - , 741 - , 742 - , 743 - , 744 - , 745 - , 746 - , 747 - , 748 - , 749 - , 750 - , 751 - , 752 - , 753 - , 754 - , 755 - , 756 - , 757 - , 758 - , 759 - , 760 - , 761 - , 762 - , 763 - , 764 - , 765 - , 766 - , 767 - , 768 - , 769 - , 770 - , 771 - , 772 - , 773 - , 774 - , 775 - , 776 - , 777 - , 778 - , 779 - , 780 - , 781 - , 782 - , 783 - , 784 - , 785 - , 786 - , 787 - , 788 - , 789 - , 790 - , 791 - , 792 - , 793 - , 794 - , 795 - , 796 - , 797 - , 798 - , 799 - , 800 - , 801 - , 802 - , 803 - , 804 - , 805 - , 806 - , 807 - , 808 - , 809 - , 810 - , 811 - , 812 - , 813 - , 814 - , 815 - , 816 - , 817 - , 818 - , 819 - , 820 - , 821 - , 822 - , 823 - , 824 - , 825 - , 826 - , 827 - , 828 - , 829 - , 830 - , 831 - , 832 - , 833 - , 834 - , 835 - , 836 - , 837 - , 838 - , 839 - , 840 - , 841 - , 842 - , 843 - , 844 - , 845 - , 846 - , 847 - , 848 - , 849 - , 850 - , 851 - , 852 - , 853 - , 854 - , 855 - , 856 - , 857 - , 858 - , 859 - , 860 - , 861 - , 862 - , 863 - , 864 - , 865 - , 866 - , 867 - , 868 - , 869 - , 870 - , 871 - , 872 - , 873 - , 874 - , 875 - , 876 - , 877 - , 878 - , 879 - , 880 - , 881 - , 882 - , 883 - , 884 - , 885 - , 886 - , 887 - , 888 - , 889 - , 890 - , 891 - , 892 - , 893 - , 894 - , 895 - , 896 - , 897 - , 898 - , 899 - , 900 - , 901 - , 902 - , 903 - , 904 - , 905 - , 906 - , 907 - , 908 - , 909 - , 910 - , 911 - , 912 - , 913 - , 914 - , 915 - , 916 - , 917 - , 918 - , 919 - , 920 - , 921 - , 922 - , 923 - , 924 - , 925 - , 926 - , 927 - , 928 - , 929 - , 930 - , 931 - , 932 - , 933 - , 934 - , 935 - , 936 - , 937 - , 938 - , 939 - , 940 - , 941 - , 942 - , 943 - , 944 - , 945 - , 946 - , 947 - , 948 - , 949 - , 950 - , 951 - , 952 - , 953 - , 954 - , 955 - , 956 - , 957 - , 958 - , 959 - , 960 - , 961 - , 962 - , 963 - , 964 - , 965 - , 966 - , 967 - , 968 - , 969 - , 970 - , 971 - , 972 - , 973 - , 974 - , 975 - , 976 - , 977 - , 978 - , 979 - , 980 - , 981 - , 982 - , 983 - , 984 - , 985 - , 986 - , 987 - , 988 - , 989 - , 990 - , 991 - , 992 - , 993 - , 994 - , 995 - , 996 - , 997 - , 998 - , 999 - , 1000 - , 1001 - , 1002 - , 1003 - , 1004 - , 1005 - , 1006 - , 1007 - , 1008 - , 1009 - , 1010 - , 1011 - , 1012 - , 1013 - , 1014 - , 1015 - , 1016 - , 1017 - , 1018 - , 1019 - , 1020 - , 1021 - , 1022 - , 1023 - , 1024 - , 1025 - , 1026 - , 1027 - , 1028 - , 1029 - , 1030 - , 1031 - , 1032 - , 1033 - , 1034 - , 1035 - , 1036 - , 1037 - , 1038 - , 1039 - , 1040 - , 1041 - , 1042 - , 1043 - , 1044 - , 1045 - , 1046 - , 1047 - , 1048 - , 1049 - , 1050 - , 1051 - , 1052 - , 1053 - , 1054 - , 1055 - , 1056 - , 1057 - , 1058 - , 1059 - , 1060 - , 1061 - , 1062 - , 1063 - , 1064 - , 1065 - , 1066 - , 1067 - , 1068 - , 1069 - , 1070 - , 1071 - , 1072 - , 1073 - , 1074 - , 1075 - , 1076 - , 1077 - , 1078 - , 1079 - , 1080 - , 1081 - , 1082 - , 1083 - , 1084 - , 1085 - , 1086 - , 1087 - , 1088 - , 1089 - , 1090 - , 1091 - , 1092 - , 1093 - , 1094 - , 1095 - , 1096 - , 1097 - , 1098 - , 1099 - , 1100 - , 1101 - , 1102 - , 1103 - , 1104 - , 1105 - , 1106 - , 1107 - , 1108 - , 1109 - , 1110 - , 1111 - , 1112 - , 1113 - , 1114 - , 1115 - , 1116 - , 1117 - , 1118 - , 1119 - , 1120 - , 1121 - , 1122 - , 1123 - , 1124 - , 1125 - , 1126 - , 1127 - , 1128 - , 1129 - , 1130 - , 1131 - , 1132 - , 1133 - , 1134 - , 1135 - , 1136 - , 1137 - , 1138 - , 1139 - , 1140 - , 1141 - , 1142 - , 1143 - , 1144 - , 1145 - , 1146 - , 1147 - , 1148 - , 1149 - , 1150 - , 1151 - , 1152 - , 1153 - , 1154 - , 1155 - , 1156 - , 1157 - , 1158 - , 1159 - , 1160 - , 1161 - , 1162 - , 1163 - , 1164 - , 1165 - , 1166 - , 1167 - , 1168 - , 1169 - , 1170 - , 1171 - , 1172 - , 1173 - , 1174 - , 1175 - , 1176 - , 1177 - , 1178 - , 1179 - , 1180 - , 1181 - , 1182 - , 1183 - , 1184 - , 1185 - , 1186 - , 1187 - , 1188 - , 1189 - , 1190 - , 1191 - , 1192 - , 1193 - , 1194 - , 1195 - , 1196 - , 1197 - , 1198 - , 1199 - , 1200 - , 1201 - , 1202 - , 1203 - , 1204 - , 1205 - , 1206 - , 1207 - , 1208 - , 1209 - , 1210 - , 1211 - , 1212 - , 1213 - , 1214 - , 1215 - , 1216 - , 1217 - , 1218 - , 1219 - , 1220 - , 1221 - , 1222 - , 1223 - , 1224 - , 1225 - , 1226 - , 1227 - , 1228 - , 1229 - , 1230 - , 1231 - , 1232 - , 1233 - , 1234 - , 1235 - , 1236 - , 1237 - , 1238 - , 1239 - , 1240 - , 1241 - , 1242 - , 1243 - , 1244 - , 1245 - , 1246 - , 1247 - , 1248 - , 1249 - , 1250 - , 1251 - , 1252 - , 1253 - , 1254 - , 1255 - , 1256 - , 1257 - , 1258 - , 1259 - , 1260 - , 1261 - , 1262 - , 1263 - , 1264 - , 1265 - , 1266 - , 1267 - , 1268 - , 1269 - , 1270 - , 1271 - , 1272 - , 1273 - , 1274 - , 1275 - , 1276 - , 1277 - , 1278 - , 1279 - , 1280 - , 1281 - , 1282 - , 1283 - , 1284 - , 1285 - , 1286 - , 1287 - , 1288 - , 1289 - , 1290 - , 1291 - , 1292 - , 1293 - , 1294 - , 1295 - , 1296 - , 1297 - , 1298 - , 1299 - , 1300 - , 1301 - , 1302 - , 1303 - , 1304 - , 1305 - , 1306 - , 1307 - , 1308 - , 1309 - , 1310 - , 1311 - , 1312 - , 1313 - , 1314 - , 1315 - , 1316 - , 1317 - , 1318 - , 1319 - , 1320 - , 1321 - , 1322 - , 1323 - , 1324 - , 1325 - , 1326 - , 1327 - , 1328 - , 1329 - , 1330 - , 1331 - , 1332 - , 1333 - , 1334 - , 1335 - , 1336 - , 1337 - , 1338 - , 1339 - , 1340 - , 1341 - , 1342 - , 1343 - , 1344 - , 1345 - , 1346 - , 1347 - , 1348 - , 1349 - , 1350 - , 1351 - , 1352 - , 1353 - , 1354 - , 1355 - , 1356 - , 1357 - , 1358 - , 1359 - , 1360 - , 1361 - , 1362 - , 1363 - , 1364 - , 1365 - , 1366 - , 1367 - , 1368 - , 1369 - , 1370 - , 1371 - , 1372 - , 1373 - , 1374 - , 1375 - , 1376 - , 1377 - , 1378 - , 1379 - , 1380 - , 1381 - , 1382 - , 1383 - , 1384 - , 1385 - , 1386 - , 1387 - , 1388 - , 1389 - , 1390 - , 1391 - , 1392 - , 1393 - , 1394 - , 1395 - , 1396 - , 1397 - , 1398 - , 1399 - , 1400 - , 1401 - , 1402 - , 1403 - , 1404 - , 1405 - , 1406 - , 1407 - , 1408 - , 1409 - , 1410 - , 1411 - , 1412 - , 1413 - , 1414 - , 1415 - , 1416 - , 1417 - , 1418 - , 1419 - , 1420 - , 1421 - , 1422 - , 1423 - , 1424 - , 1425 - , 1426 - , 1427 - , 1428 - , 1429 - , 1430 - , 1431 - , 1432 - , 1433 - , 1434 - , 1435 - , 1436 - , 1437 - , 1438 - , 1439 - , 1440 - , 1441 - , 1442 - , 1443 - , 1444 - , 1445 - , 1446 - , 1447 - , 1448 - , 1449 - , 1450 - , 1451 - , 1452 - , 1453 - , 1454 - , 1455 - , 1456 - , 1457 - , 1458 - , 1459 - , 1460 - , 1461 - , 1462 - , 1463 - , 1464 - , 1465 - , 1466 - , 1467 - , 1468 - , 1469 - , 1470 - , 1471 - , 1472 - , 1473 - , 1474 - , 1475 - , 1476 - , 1477 - , 1478 - , 1479 - , 1480 - , 1481 - , 1482 - , 1483 - , 1484 - , 1485 - , 1486 - , 1487 - , 1488 - , 1489 - , 1490 - , 1491 - , 1492 - , 1493 - , 1494 - , 1495 - , 1496 - , 1497 - , 1498 - , 1499 - , 1500 - , 1501 - , 1502 - , 1503 - , 1504 - , 1505 - , 1506 - , 1507 - , 1508 - , 1509 - , 1510 - , 1511 - , 1512 - , 1513 - , 1514 - , 1515 - , 1516 - , 1517 - , 1518 - , 1519 - , 1520 - , 1521 - , 1522 - , 1523 - , 1524 - , 1525 - , 1526 - , 1527 - , 1528 - , 1529 - , 1530 - , 1531 - , 1532 - , 1533 - , 1534 - , 1535 - , 1536 - , 1537 - , 1538 - , 1539 - , 1540 - , 1541 - , 1542 - , 1543 - , 1544 - , 1545 - , 1546 - , 1547 - , 1548 - , 1549 - , 1550 - , 1551 - , 1552 - , 1553 - , 1554 - , 1555 - , 1556 - , 1557 - , 1558 - , 1559 - , 1560 - , 1561 - , 1562 - , 1563 - , 1564 - , 1565 - , 1566 - , 1567 - , 1568 - , 1569 - , 1570 - , 1571 - , 1572 - , 1573 - , 1574 - , 1575 - , 1576 - , 1577 - , 1578 - , 1579 - , 1580 - , 1581 - , 1582 - , 1583 - , 1584 - , 1585 - , 1586 - , 1587 - , 1588 - , 1589 - , 1590 - , 1591 - , 1592 - , 1593 - , 1594 - , 1595 - , 1596 - , 1597 - , 1598 - , 1599 - , 1600 - , 1601 - , 1602 - , 1603 - , 1604 - , 1605 - , 1606 - , 1607 - , 1608 - , 1609 - , 1610 - , 1611 - , 1612 - , 1613 - , 1614 - , 1615 - , 1616 - , 1617 - , 1618 - , 1619 - , 1620 - , 1621 - , 1622 - , 1623 - , 1624 - , 1625 - , 1626 - , 1627 - , 1628 - , 1629 - , 1630 - , 1631 - , 1632 - , 1633 - , 1634 - , 1635 - , 1636 - , 1637 - , 1638 - , 1639 - , 1640 - , 1641 - , 1642 - , 1643 - , 1644 - , 1645 - , 1646 - , 1647 - , 1648 - , 1649 - , 1650 - , 1651 - , 1652 - , 1653 - , 1654 - , 1655 - , 1656 - , 1657 - , 1658 - , 1659 - , 1660 - , 1661 - , 1662 - , 1663 - , 1664 - , 1665 - , 1666 - , 1667 - , 1668 - , 1669 - , 1670 - , 1671 - , 1672 - , 1673 - , 1674 - , 1675 - , 1676 - , 1677 - , 1678 - , 1679 - , 1680 - , 1681 - , 1682 - , 1683 - , 1684 - , 1685 - , 1686 - , 1687 - , 1688 - , 1689 - , 1690 - , 1691 - , 1692 - , 1693 - , 1694 - , 1695 - , 1696 - , 1697 - , 1698 - , 1699 - , 1700 - , 1701 - , 1702 - , 1703 - , 1704 - , 1705 - , 1706 - , 1707 - , 1708 - , 1709 - , 1710 - , 1711 - , 1712 - , 1713 - , 1714 - , 1715 - , 1716 - , 1717 - , 1718 - , 1719 - , 1720 - , 1721 - , 1722 - , 1723 - , 1724 - , 1725 - , 1726 - , 1727 - , 1728 - , 1729 - , 1730 - , 1731 - , 1732 - , 1733 - , 1734 - , 1735 - , 1736 - , 1737 - , 1738 - , 1739 - , 1740 - , 1741 - , 1742 - , 1743 - , 1744 - , 1745 - , 1746 - , 1747 - , 1748 - , 1749 - , 1750 - , 1751 - , 1752 - , 1753 - , 1754 - , 1755 - , 1756 - , 1757 - , 1758 - , 1759 - , 1760 - , 1761 - , 1762 - , 1763 - , 1764 - , 1765 - , 1766 - , 1767 - , 1768 - , 1769 - , 1770 - , 1771 - , 1772 - , 1773 - , 1774 - , 1775 - , 1776 - , 1777 - , 1778 - , 1779 - , 1780 - , 1781 - , 1782 - , 1783 - , 1784 - , 1785 - , 1786 - , 1787 - , 1788 - , 1789 - , 1790 - , 1791 - , 1792 - , 1793 - , 1794 - , 1795 - , 1796 - , 1797 - , 1798 - , 1799 - , 1800 - , 1801 - , 1802 - , 1803 - , 1804 - , 1805 - , 1806 - , 1807 - , 1808 - , 1809 - , 1810 - , 1811 - , 1812 - , 1813 - , 1814 - , 1815 - , 1816 - , 1817 - , 1818 - , 1819 - , 1820 - , 1821 - , 1822 - , 1823 - , 1824 - , 1825 - , 1826 - , 1827 - , 1828 - , 1829 - , 1830 - , 1831 - , 1832 - , 1833 - , 1834 - , 1835 - , 1836 - , 1837 - , 1838 - , 1839 - , 1840 - , 1841 - , 1842 - , 1843 - , 1844 - , 1845 - , 1846 - , 1847 - , 1848 - , 1849 - , 1850 - , 1851 - , 1852 - , 1853 - , 1854 - , 1855 - , 1856 - , 1857 - , 1858 - , 1859 - , 1860 - , 1861 - , 1862 - , 1863 - , 1864 - , 1865 - , 1866 - , 1867 - , 1868 - , 1869 - , 1870 - , 1871 - , 1872 - , 1873 - , 1874 - , 1875 - , 1876 - , 1877 - , 1878 - , 1879 - , 1880 - , 1881 - , 1882 - , 1883 - , 1884 - , 1885 - , 1886 - , 1887 - , 1888 - , 1889 - , 1890 - , 1891 - , 1892 - , 1893 - , 1894 - , 1895 - , 1896 - , 1897 - , 1898 - , 1899 - , 1900 - , 1901 - , 1902 - , 1903 - , 1904 - , 1905 - , 1906 - , 1907 - , 1908 - , 1909 - , 1910 - , 1911 - , 1912 - , 1913 - , 1914 - , 1915 - , 1916 - , 1917 - , 1918 - , 1919 - , 1920 - , 1921 - , 1922 - , 1923 - , 1924 - , 1925 - , 1926 - , 1927 - , 1928 - , 1929 - , 1930 - , 1931 - , 1932 - , 1933 - , 1934 - , 1935 - , 1936 - , 1937 - , 1938 - , 1939 - , 1940 - , 1941 - , 1942 - , 1943 - , 1944 - , 1945 - , 1946 - , 1947 - , 1948 - , 1949 - , 1950 - , 1951 - , 1952 - , 1953 - , 1954 - , 1955 - , 1956 - , 1957 - , 1958 - , 1959 - , 1960 - , 1961 - , 1962 - , 1963 - , 1964 - , 1965 - , 1966 - , 1967 - , 1968 - , 1969 - , 1970 - , 1971 - , 1972 - , 1973 - , 1974 - , 1975 - , 1976 - , 1977 - , 1978 - , 1979 - , 1980 - , 1981 - , 1982 - , 1983 - , 1984 - , 1985 - , 1986 - , 1987 - , 1988 - , 1989 - , 1990 - , 1991 - , 1992 - , 1993 - , 1994 - , 1995 - , 1996 - , 1997 - , 1998 - , 1999 - , 2000 - ] - -``` diff --git a/unison-src/transcripts/fix2712.md b/unison-src/transcripts/fix2712.md deleted file mode 100644 index 4483f00bd1..0000000000 --- a/unison-src/transcripts/fix2712.md +++ /dev/null @@ -1,27 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -unique type Map k v = Tip | Bin Nat k v (Map k v) (Map k v) - -mapWithKey : (k ->{e} a ->{e} b) -> Map k a ->{e} Map k b -mapWithKey f m = Tip -``` - -```ucm -scratch/main> add -``` - -```unison - -naiomi = - susan: Nat -> Nat -> () - susan a b = () - - pam: Map Nat Nat - pam = Tip - - mapWithKey susan pam - -``` diff --git a/unison-src/transcripts/fix2712.output.md b/unison-src/transcripts/fix2712.output.md deleted file mode 100644 index 4181235105..0000000000 --- a/unison-src/transcripts/fix2712.output.md +++ /dev/null @@ -1,55 +0,0 @@ -``` unison -unique type Map k v = Tip | Bin Nat k v (Map k v) (Map k v) - -mapWithKey : (k ->{e} a ->{e} b) -> Map k a ->{e} Map k b -mapWithKey f m = Tip -``` - -``` 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`: - - type Map k v - mapWithKey : (k ->{e} a ->{e} b) -> Map k a ->{e} Map k b - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Map k v - mapWithKey : (k ->{e} a ->{e} b) -> Map k a ->{e} Map k b - -``` -``` unison -naiomi = - susan: Nat -> Nat -> () - susan a b = () - - pam: Map Nat Nat - pam = Tip - - mapWithKey susan pam - -``` - -``` 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`: - - naiomi : Map Nat () - -``` diff --git a/unison-src/transcripts/fix2795.md b/unison-src/transcripts/fix2795.md deleted file mode 100644 index 1e2ca1764d..0000000000 --- a/unison-src/transcripts/fix2795.md +++ /dev/null @@ -1,5 +0,0 @@ -```ucm -scratch/main> builtins.mergeio -scratch/main> load unison-src/transcripts/fix2795/docs.u -scratch/main> display test -``` diff --git a/unison-src/transcripts/fix2795.output.md b/unison-src/transcripts/fix2795.output.md deleted file mode 100644 index 39da527ba0..0000000000 --- a/unison-src/transcripts/fix2795.output.md +++ /dev/null @@ -1,31 +0,0 @@ -``` ucm -scratch/main> builtins.mergeio - - Done. - -scratch/main> load unison-src/transcripts/fix2795/docs.u - - Loading changes detected in - unison-src/transcripts/fix2795/docs.u. - - I found and typechecked these definitions in - unison-src/transcripts/fix2795/docs.u. If you do an `add` or - `update`, here's how your codebase would change: - - ⍟ These new definitions are ok to `add`: - - t1 : Text - test : Doc2 - -scratch/main> display test - - t : Text - t = "hi" - t - ⧨ - "hi" - - t1 : Text - t1 = "hi" - -``` diff --git a/unison-src/transcripts/fix2795/docs.u b/unison-src/transcripts/fix2795/docs.u deleted file mode 100644 index c5bb69aa6e..0000000000 --- a/unison-src/transcripts/fix2795/docs.u +++ /dev/null @@ -1,12 +0,0 @@ -test = {{ - ``` - t : Text - t = "hi" - - t - ``` - @source{t1} - -}} - -t1 = "hi" diff --git a/unison-src/transcripts/fix2826.md b/unison-src/transcripts/fix2826.md deleted file mode 100644 index d2ad94cd51..0000000000 --- a/unison-src/transcripts/fix2826.md +++ /dev/null @@ -1,23 +0,0 @@ -```ucm -scratch/main> builtins.mergeio -``` - -Supports fences that are longer than three backticks. - -````unison - -doc = {{ - @typecheck ``` - x = 3 - ``` -}} - -```` - -And round-trips properly. - -```ucm -scratch/main> add -scratch/main> edit doc -scratch/main> load scratch.u -``` diff --git a/unison-src/transcripts/fix2826.output.md b/unison-src/transcripts/fix2826.output.md deleted file mode 100644 index cf691c1b62..0000000000 --- a/unison-src/transcripts/fix2826.output.md +++ /dev/null @@ -1,66 +0,0 @@ -``` ucm -scratch/main> builtins.mergeio - - Done. - -``` -Supports fences that are longer than three backticks. - -```` unison -doc = {{ - @typecheck ``` - x = 3 - ``` -}} - -```` - -``` 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`: - - doc : Doc2 - -``` -And round-trips properly. - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - doc : Doc2 - -scratch/main> edit doc - - ☝️ - - I added 1 definitions to the top of scratch.u - - You can edit them there, then run `update` to replace the - definitions currently in this namespace. - -scratch/main> load scratch.u - - Loading changes detected in scratch.u. - - I found and typechecked the definitions in scratch.u. This - file has been previously added to the codebase. - -``` -```` unison:added-by-ucm scratch.u -doc : Doc2 -doc = - {{ - @typecheck ``` - x = 3 - ``` - }} -```` - diff --git a/unison-src/transcripts/fix2840.md b/unison-src/transcripts/fix2840.md index 518f90c45e..6c6ac6abe9 100644 --- a/unison-src/transcripts/fix2840.md +++ b/unison-src/transcripts/fix2840.md @@ -1,12 +1,12 @@ This bugfix addresses an issue where embedded Unison code in UCM was expected to be present in the active codebase when the `display` command was used render `Doc` values. -```ucm:hide +``` ucm :hide scratch/main> builtins.merge ``` First, a few \[hidden] definitions necessary for typechecking a simple Doc2. -```unison:hide:all +``` unison :hide:all structural type Optional a = None | Some a unique[b7a4fb87e34569319591130bf3ec6e24c9955b6a] type Doc2 @@ -62,18 +62,18 @@ syntax.docParagraph = Paragraph syntax.docWord = Word ``` -```ucm +``` ucm scratch/main> add ``` Next, define and display a simple Doc: -```unison:hide +``` unison :hide README = {{ Hi }} ``` -```ucm +``` ucm scratch/main> display README ``` diff --git a/unison-src/transcripts/fix2840.output.md b/unison-src/transcripts/fix2840.output.md index 020c4b1a4d..e8e54f3085 100644 --- a/unison-src/transcripts/fix2840.output.md +++ b/unison-src/transcripts/fix2840.output.md @@ -1,12 +1,16 @@ This bugfix addresses an issue where embedded Unison code in UCM was expected to be present in the active codebase when the `display` command was used render `Doc` values. +``` ucm :hide +scratch/main> builtins.merge +``` + First, a few \[hidden\] definitions necessary for typechecking a simple Doc2. ``` ucm scratch/main> add ⍟ I've added these definitions: - + type Doc2 type Doc2.SpecialForm type Doc2.Term @@ -15,11 +19,11 @@ scratch/main> add syntax.docParagraph : [Doc2] -> Doc2 syntax.docUntitledSection : [Doc2] -> Doc2 syntax.docWord : Text -> Doc2 - ``` + Next, define and display a simple Doc: -``` unison +``` unison :hide README = {{ Hi }} @@ -29,8 +33,8 @@ Hi scratch/main> display README Hi - ``` + Previously, the error was: ``` @@ -39,4 +43,3 @@ Previously, the error was: ``` but as of this PR, it's okay. - diff --git a/unison-src/transcripts/fix2970.md b/unison-src/transcripts/fix2970.md deleted file mode 100644 index efcd59f181..0000000000 --- a/unison-src/transcripts/fix2970.md +++ /dev/null @@ -1,10 +0,0 @@ -Also fixes #1519 (it's the same issue). - -```ucm -scratch/main> builtins.merge -``` - -```unison -foo.+.doc : Nat -foo.+.doc = 10 -``` diff --git a/unison-src/transcripts/fix2970.output.md b/unison-src/transcripts/fix2970.output.md deleted file mode 100644 index 7f5bddca1b..0000000000 --- a/unison-src/transcripts/fix2970.output.md +++ /dev/null @@ -1,26 +0,0 @@ -Also fixes \#1519 (it's the same issue). - -``` ucm -scratch/main> builtins.merge - - Done. - -``` -``` unison -foo.+.doc : Nat -foo.+.doc = 10 -``` - -``` 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.+.doc : Nat - -``` diff --git a/unison-src/transcripts/fix3037.md b/unison-src/transcripts/fix3037.md deleted file mode 100644 index af8fed9816..0000000000 --- a/unison-src/transcripts/fix3037.md +++ /dev/null @@ -1,32 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -Tests for an unsound case of ability checking that was erroneously being -accepted before. In certain cases, abilities were able to be added to rows in -invariant positions. - -```unison:error -structural type Runner g = Runner (forall a. '{g} a -> {} a) - -pureRunner : Runner {} -pureRunner = Runner base.force - --- this compiles, but shouldn't the effect type parameter on Runner be invariant? -runner : Runner {IO} -runner = pureRunner -``` - -Application version: - -```unison:error -structural type A g = A (forall a. '{g} a ->{} a) - -anA : A {} -anA = A base.force - -h : A {IO} -> () -h _ = () - -> h anA -``` diff --git a/unison-src/transcripts/fix3037.output.md b/unison-src/transcripts/fix3037.output.md deleted file mode 100644 index aebd61c502..0000000000 --- a/unison-src/transcripts/fix3037.output.md +++ /dev/null @@ -1,64 +0,0 @@ -Tests for an unsound case of ability checking that was erroneously being -accepted before. In certain cases, abilities were able to be added to rows in -invariant positions. - -``` unison -structural type Runner g = Runner (forall a. '{g} a -> {} a) - -pureRunner : Runner {} -pureRunner = Runner base.force - --- this compiles, but shouldn't the effect type parameter on Runner be invariant? -runner : Runner {IO} -runner = pureRunner -``` - -``` ucm - - Loading changes detected in scratch.u. - - I found an ability mismatch when checking the expression in red - - 3 | pureRunner : Runner {} - 4 | pureRunner = Runner base.force - 5 | - 6 | -- this compiles, but shouldn't the effect type parameter on Runner be invariant? - 7 | runner : Runner {IO} - 8 | runner = pureRunner - - - When trying to match Runner {} with Runner {IO} the right hand - side contained extra abilities: {IO} - - - -``` -Application version: - -``` unison -structural type A g = A (forall a. '{g} a ->{} a) - -anA : A {} -anA = A base.force - -h : A {IO} -> () -h _ = () - -> h anA -``` - -``` ucm - - Loading changes detected in scratch.u. - - I found an ability mismatch when checking the application - - 9 | > h anA - - - When trying to match A {} with A {IO} the right hand side - contained extra abilities: {IO} - - - -``` diff --git a/unison-src/transcripts/fix3171.md b/unison-src/transcripts/fix3171.md deleted file mode 100644 index ad166c7f5e..0000000000 --- a/unison-src/transcripts/fix3171.md +++ /dev/null @@ -1,14 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -Tests an case where decompiling could cause function arguments to occur in the -opposite order for partially applied functions. - -```unison -f : Nat -> Nat -> Nat -> () -> Nat -f x y z _ = x + y * z - -> f 1 2 -> f 1 2 3 -``` diff --git a/unison-src/transcripts/fix3171.output.md b/unison-src/transcripts/fix3171.output.md deleted file mode 100644 index 8778f0442e..0000000000 --- a/unison-src/transcripts/fix3171.output.md +++ /dev/null @@ -1,35 +0,0 @@ -Tests an case where decompiling could cause function arguments to occur in the -opposite order for partially applied functions. - -``` unison -f : Nat -> Nat -> Nat -> () -> Nat -f x y z _ = x + y * z - -> f 1 2 -> f 1 2 3 -``` - -``` 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`: - - f : Nat -> Nat -> Nat -> 'Nat - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 4 | > f 1 2 - ⧩ - z _ -> 1 Nat.+ 2 Nat.* z - - 5 | > f 1 2 3 - ⧩ - _ -> 1 Nat.+ 2 Nat.* 3 - -``` diff --git a/unison-src/transcripts/fix3196.md b/unison-src/transcripts/fix3196.md deleted file mode 100644 index 46755570e5..0000000000 --- a/unison-src/transcripts/fix3196.md +++ /dev/null @@ -1,32 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -Tests ability checking in scenarios where one side is concrete and the other is -a variable. This was supposed to be covered, but the method wasn't actually -symmetric, so doing `equate l r` might work, but not `equate r l`. - -Below were cases that caused the failing order. - -```unison -structural type W es = W - -unique ability Zoot where - zoot : () - -woot : W {g} -> '{g, Zoot} a ->{Zoot} a -woot w a = todo () - -ex = do - w = (W : W {Zoot}) - woot w do bug "why don't you typecheck?" - -w1 : W {Zoot} -w1 = W - -w2 : W {g} -> W {g} -w2 = cases W -> W - -> w2 w1 -``` diff --git a/unison-src/transcripts/fix3196.output.md b/unison-src/transcripts/fix3196.output.md deleted file mode 100644 index 3b8f046472..0000000000 --- a/unison-src/transcripts/fix3196.output.md +++ /dev/null @@ -1,53 +0,0 @@ -Tests ability checking in scenarios where one side is concrete and the other is -a variable. This was supposed to be covered, but the method wasn't actually -symmetric, so doing `equate l r` might work, but not `equate r l`. - -Below were cases that caused the failing order. - -``` unison -structural type W es = W - -unique ability Zoot where - zoot : () - -woot : W {g} -> '{g, Zoot} a ->{Zoot} a -woot w a = todo () - -ex = do - w = (W : W {Zoot}) - woot w do bug "why don't you typecheck?" - -w1 : W {Zoot} -w1 = W - -w2 : W {g} -> W {g} -w2 = cases W -> W - -> w2 w1 -``` - -``` 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`: - - structural type W es - ability Zoot - ex : '{Zoot} r - w1 : W {Zoot} - w2 : W {g} -> W {g} - woot : W {g} -> '{g, Zoot} a ->{Zoot} a - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 19 | > w2 w1 - ⧩ - W - -``` diff --git a/unison-src/transcripts/fix3215.md b/unison-src/transcripts/fix3215.md deleted file mode 100644 index a0d1715a14..0000000000 --- a/unison-src/transcripts/fix3215.md +++ /dev/null @@ -1,21 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -Tests a case where concrete abilities were appearing multiple times in an -inferred type. This was due to the pre-pass that figures out which abilities -are being matched on. It was just concatenating the ability for each pattern -into a list, and not checking whether there were duplicates. - -```unison -structural ability T where - nat : Nat - int : Int - flo : Float - -f = cases - {nat -> k} -> 5 - {int -> k} -> 5 - {flo -> k} -> 5 - {x} -> 5 -``` diff --git a/unison-src/transcripts/fix3215.output.md b/unison-src/transcripts/fix3215.output.md deleted file mode 100644 index 2f5128ffbc..0000000000 --- a/unison-src/transcripts/fix3215.output.md +++ /dev/null @@ -1,32 +0,0 @@ -Tests a case where concrete abilities were appearing multiple times in an -inferred type. This was due to the pre-pass that figures out which abilities -are being matched on. It was just concatenating the ability for each pattern -into a list, and not checking whether there were duplicates. - -``` unison -structural ability T where - nat : Nat - int : Int - flo : Float - -f = cases - {nat -> k} -> 5 - {int -> k} -> 5 - {flo -> k} -> 5 - {x} -> 5 -``` - -``` 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`: - - structural ability T - f : Request {g, T} x -> Nat - -``` diff --git a/unison-src/transcripts/fix3244.md b/unison-src/transcripts/fix3244.md deleted file mode 100644 index e07581e2e2..0000000000 --- a/unison-src/transcripts/fix3244.md +++ /dev/null @@ -1,21 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -This tests an previously erroneous case in the pattern compiler. It was assuming -that the variables bound in a guard matched the variables bound in the rest of -the branch exactly, but apparently this needn't be the case. - -```unison - -foo t = - (x, _) = t - f w = w + x - - match t with - (x, y) - | y < 5 -> f x - | otherwise -> x + y - -> foo (10,20) -``` diff --git a/unison-src/transcripts/fix3244.output.md b/unison-src/transcripts/fix3244.output.md deleted file mode 100644 index 00899d4c5a..0000000000 --- a/unison-src/transcripts/fix3244.output.md +++ /dev/null @@ -1,37 +0,0 @@ -This tests an previously erroneous case in the pattern compiler. It was assuming -that the variables bound in a guard matched the variables bound in the rest of -the branch exactly, but apparently this needn't be the case. - -``` unison -foo t = - (x, _) = t - f w = w + x - - match t with - (x, y) - | y < 5 -> f x - | otherwise -> x + y - -> foo (10,20) -``` - -``` 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, Nat) -> Nat - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 10 | > foo (10,20) - ⧩ - 30 - -``` diff --git a/unison-src/transcripts/fix3265.md b/unison-src/transcripts/fix3265.md deleted file mode 100644 index 5b06551112..0000000000 --- a/unison-src/transcripts/fix3265.md +++ /dev/null @@ -1,41 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -Tests cases that produced bad decompilation output previously. There -are three cases that need to be 'fixed up.' - 1. lambda expressions with free variables need to be beta reduced - 2. let defined functions need to have arguments removed and - occurrences rewritten. - 3. let-rec defined functions need to have arguments removed, but - it is a more complicated process. - -```unison -> Any (w x -> let - f0 y = match y with - 0 -> x - n -> 1 + f1 (drop y 1) - f1 y = match y with - 0 -> w + x - n -> 1 + f0 (drop y 1) - f2 x = f2 x - f3 y = 1 + y + f2 x - g h = h 1 + x - g (z -> x + f0 z)) -``` - -Also check for some possible corner cases. - -`f` should not have its `x` argument eliminated, because it doesn't -always occur with `x` as the first argument, but if we aren't careful, -we might do that, because we find the first occurrence of `f`, and -discard its arguments, where `f` also occurs. - -```unison -> Any (x -> let - f x y = match y with - 0 -> 0 - _ -> f x (f y (drop y 1)) - - f x 20) -``` diff --git a/unison-src/transcripts/fix3265.output.md b/unison-src/transcripts/fix3265.output.md deleted file mode 100644 index 1f70863dc7..0000000000 --- a/unison-src/transcripts/fix3265.output.md +++ /dev/null @@ -1,90 +0,0 @@ -Tests cases that produced bad decompilation output previously. There -are three cases that need to be 'fixed up.' - -1. lambda expressions with free variables need to be beta reduced -2. let defined functions need to have arguments removed and - occurrences rewritten. -3. let-rec defined functions need to have arguments removed, but - it is a more complicated process. - -``` unison -> Any (w x -> let - f0 y = match y with - 0 -> x - n -> 1 + f1 (drop y 1) - f1 y = match y with - 0 -> w + x - n -> 1 + f0 (drop y 1) - f2 x = f2 x - f3 y = 1 + y + f2 x - g h = h 1 + x - g (z -> x + f0 z)) -``` - -``` ucm - - Loading changes detected in scratch.u. - - ✅ - - scratch.u changed. - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 1 | > Any (w x -> let - ⧩ - Any - (w x -> - let - use Nat + drop - f1 y = match y with - 0 -> w + x - n -> 1 + f0 (drop y 1) - f0 y = match y with - 0 -> x - n -> 1 + f1 (drop y 1) - f2 x = f2 x - f3 x y = 1 + y + f2 x - g h = h 1 + x - g (z -> x + f0 z)) - -``` -Also check for some possible corner cases. - -`f` should not have its `x` argument eliminated, because it doesn't -always occur with `x` as the first argument, but if we aren't careful, -we might do that, because we find the first occurrence of `f`, and -discard its arguments, where `f` also occurs. - -``` unison -> Any (x -> let - f x y = match y with - 0 -> 0 - _ -> f x (f y (drop y 1)) - - f x 20) -``` - -``` ucm - - Loading changes detected in scratch.u. - - ✅ - - scratch.u changed. - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 1 | > Any (x -> let - ⧩ - Any - (x -> - let - f x y = match y with - 0 -> 0 - _ -> f x (f y (Nat.drop y 1)) - f x 20) - -``` diff --git a/unison-src/transcripts/fix3634.md b/unison-src/transcripts/fix3634.md deleted file mode 100644 index fd1654739a..0000000000 --- a/unison-src/transcripts/fix3634.md +++ /dev/null @@ -1,21 +0,0 @@ -```ucm:hide -scratch/main> builtins.mergeio -``` - - -```unison -structural type M a = N | J a - -d = {{ - -{{ docExample 0 '(x -> J x) }} - -{J} - -}} -``` - -```ucm -scratch/main> add -scratch/main> display d -``` \ No newline at end of file diff --git a/unison-src/transcripts/fix3634.output.md b/unison-src/transcripts/fix3634.output.md deleted file mode 100644 index ac92ec60c2..0000000000 --- a/unison-src/transcripts/fix3634.output.md +++ /dev/null @@ -1,43 +0,0 @@ -``` unison -structural type M a = N | J a - -d = {{ - -{{ docExample 0 '(x -> J x) }} - -{J} - -}} -``` - -``` 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`: - - structural type M a - (also named builtin.Optional) - d : Doc2 - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - structural type M a - (also named builtin.Optional) - d : Doc2 - -scratch/main> display d - - `x -> J x` - - J - -``` diff --git a/unison-src/transcripts/fix3678.md b/unison-src/transcripts/fix3678.md deleted file mode 100644 index 59ecfe787e..0000000000 --- a/unison-src/transcripts/fix3678.md +++ /dev/null @@ -1,14 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -Array comparison was indexing out of bounds. - -```unison -arr = Scope.run do - ma = Scope.arrayOf "asdf" 0 - freeze! ma - -> compare arr arr -``` diff --git a/unison-src/transcripts/fix3678.output.md b/unison-src/transcripts/fix3678.output.md deleted file mode 100644 index 321c493f21..0000000000 --- a/unison-src/transcripts/fix3678.output.md +++ /dev/null @@ -1,30 +0,0 @@ -Array comparison was indexing out of bounds. - -``` unison -arr = Scope.run do - ma = Scope.arrayOf "asdf" 0 - freeze! ma - -> compare arr arr -``` - -``` 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`: - - arr : ImmutableArray Text - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 5 | > compare arr arr - ⧩ - +0 - -``` diff --git a/unison-src/transcripts/fix3752.md b/unison-src/transcripts/fix3752.md deleted file mode 100644 index 90fc207437..0000000000 --- a/unison-src/transcripts/fix3752.md +++ /dev/null @@ -1,22 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -These were failing to type check before, because id was not -generalized. - -```unison - -foo = do - id x = - _ = 1 - x - id () - id "hello" - -bar = do - id x = x - id () - id "hello" -``` - diff --git a/unison-src/transcripts/fix3752.output.md b/unison-src/transcripts/fix3752.output.md deleted file mode 100644 index b22b33408e..0000000000 --- a/unison-src/transcripts/fix3752.output.md +++ /dev/null @@ -1,31 +0,0 @@ -These were failing to type check before, because id was not -generalized. - -``` unison -foo = do - id x = - _ = 1 - x - id () - id "hello" - -bar = do - id x = x - id () - id "hello" -``` - -``` 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`: - - bar : 'Text - foo : 'Text - -``` diff --git a/unison-src/transcripts/fix3759.md b/unison-src/transcripts/fix3759.md deleted file mode 100644 index 212bae6659..0000000000 --- a/unison-src/transcripts/fix3759.md +++ /dev/null @@ -1,57 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison:hide -unique type codebase.Foo = Foo - -Woot.state : Nat -Woot.state = 42 - -Woot.frobnicate : Nat -Woot.frobnicate = 43 -``` - -```ucm:hide -scratch/main> add -``` - -```unison -unique type Oog.Foo = Foo Text - -unique ability Blah where - foo : Foo -> () - -unique type Something = { state : Text } - -oog = do - foo (Foo "hi" : Oog.Foo) - -ex = do - s = Something "hello" - state s ++ " world!" - --- check that using locally unique suffix shadows the `Foo` in codebase -fn1 : Foo -> Foo -> Nat -fn1 = cases Foo a, Foo b -> Text.size a Nat.+ Text.size b - --- check that using local fully qualified name works fine -fn2 : Oog.Foo -> Oog.Foo -> Text -fn2 = cases Foo a, Foo b -> a Text.++ b - --- check that using fully qualified name works fine -fn3 : codebase.Foo -> codebase.Foo -> Text -fn3 = cases codebase.Foo.Foo, codebase.Foo.Foo -> "!!!!!!" - -> fn3 codebase.Foo.Foo codebase.Foo.Foo - --- now checking that terms fully qualified names work fine -blah.frobnicate = "Yay!" - -> Something.state (Something "hi") -> Woot.state + 1 -> Woot.frobnicate + 2 -> frobnicate Text.++ " 🎉" -> blah.frobnicate Text.++ " 🎉" -``` \ No newline at end of file diff --git a/unison-src/transcripts/fix3759.output.md b/unison-src/transcripts/fix3759.output.md deleted file mode 100644 index 1102f45357..0000000000 --- a/unison-src/transcripts/fix3759.output.md +++ /dev/null @@ -1,104 +0,0 @@ -``` unison -unique type codebase.Foo = Foo - -Woot.state : Nat -Woot.state = 42 - -Woot.frobnicate : Nat -Woot.frobnicate = 43 -``` - -``` unison -unique type Oog.Foo = Foo Text - -unique ability Blah where - foo : Foo -> () - -unique type Something = { state : Text } - -oog = do - foo (Foo "hi" : Oog.Foo) - -ex = do - s = Something "hello" - state s ++ " world!" - --- check that using locally unique suffix shadows the `Foo` in codebase -fn1 : Foo -> Foo -> Nat -fn1 = cases Foo a, Foo b -> Text.size a Nat.+ Text.size b - --- check that using local fully qualified name works fine -fn2 : Oog.Foo -> Oog.Foo -> Text -fn2 = cases Foo a, Foo b -> a Text.++ b - --- check that using fully qualified name works fine -fn3 : codebase.Foo -> codebase.Foo -> Text -fn3 = cases codebase.Foo.Foo, codebase.Foo.Foo -> "!!!!!!" - -> fn3 codebase.Foo.Foo codebase.Foo.Foo - --- now checking that terms fully qualified names work fine -blah.frobnicate = "Yay!" - -> Something.state (Something "hi") -> Woot.state + 1 -> Woot.frobnicate + 2 -> frobnicate Text.++ " 🎉" -> blah.frobnicate Text.++ " 🎉" -``` - -``` 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`: - - ability Blah - type Oog.Foo - type Something - Something.state : Something -> Text - Something.state.modify : (Text ->{g} Text) - -> Something - ->{g} Something - Something.state.set : Text -> Something -> Something - blah.frobnicate : Text - ex : 'Text - fn1 : Oog.Foo -> Oog.Foo -> Nat - fn2 : Oog.Foo -> Oog.Foo -> Text - fn3 : codebase.Foo - -> codebase.Foo - -> Text - oog : '{Blah} () - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 27 | > fn3 codebase.Foo.Foo codebase.Foo.Foo - ⧩ - "!!!!!!" - - 32 | > Something.state (Something "hi") - ⧩ - "hi" - - 33 | > Woot.state + 1 - ⧩ - 43 - - 34 | > Woot.frobnicate + 2 - ⧩ - 45 - - 35 | > frobnicate Text.++ " 🎉" - ⧩ - "Yay! 🎉" - - 36 | > blah.frobnicate Text.++ " 🎉" - ⧩ - "Yay! 🎉" - -``` diff --git a/unison-src/transcripts/fix3773.md b/unison-src/transcripts/fix3773.md deleted file mode 100644 index 991db6991f..0000000000 --- a/unison-src/transcripts/fix3773.md +++ /dev/null @@ -1,13 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -foo = - _ = 1 - _ = 22 - 42 - -> foo + 20 -``` \ No newline at end of file diff --git a/unison-src/transcripts/fix3773.output.md b/unison-src/transcripts/fix3773.output.md deleted file mode 100644 index 360dd25783..0000000000 --- a/unison-src/transcripts/fix3773.output.md +++ /dev/null @@ -1,29 +0,0 @@ -``` unison -foo = - _ = 1 - _ = 22 - 42 - -> foo + 20 -``` - -``` 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 - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 6 | > foo + 20 - ⧩ - 62 - -``` diff --git a/unison-src/transcripts/fix3977.md b/unison-src/transcripts/fix3977.md deleted file mode 100644 index fc1fc1c718..0000000000 --- a/unison-src/transcripts/fix3977.md +++ /dev/null @@ -1,17 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -Pretty-printing previously didn’t compensate for extra characters on a line that was about to be wrapped, resulting in a line-break without sufficient indentation. Now pretty-printing indents based on the starting column of the wrapped expression, not simply “prevIndent + 2”. - -```unison:hide -failure msg context = Failure (typeLink Unit) msg (Any context) - -foo = Left (failure ("a loooooooooooooooooooooooooooooooooong" ++ "message with concatenation") ()) -``` - -```ucm -scratch/main> add -scratch/main> edit foo -scratch/main> load scratch.u -``` diff --git a/unison-src/transcripts/fix3977.output.md b/unison-src/transcripts/fix3977.output.md deleted file mode 100644 index d4451d8c94..0000000000 --- a/unison-src/transcripts/fix3977.output.md +++ /dev/null @@ -1,44 +0,0 @@ -Pretty-printing previously didn’t compensate for extra characters on a line that was about to be wrapped, resulting in a line-break without sufficient indentation. Now pretty-printing indents based on the starting column of the wrapped expression, not simply “prevIndent + 2”. - -``` unison -failure msg context = Failure (typeLink Unit) msg (Any context) - -foo = Left (failure ("a loooooooooooooooooooooooooooooooooong" ++ "message with concatenation") ()) -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - failure : Text -> context -> Failure - foo : Either Failure b - -scratch/main> edit foo - - ☝️ - - I added 1 definitions to the top of scratch.u - - You can edit them there, then run `update` to replace the - definitions currently in this namespace. - -scratch/main> load scratch.u - - Loading changes detected in scratch.u. - - I found and typechecked the definitions in scratch.u. This - file has been previously added to the codebase. - -``` -``` unison:added-by-ucm scratch.u -foo : Either Failure b -foo = - use Text ++ - Left - (failure - ("a loooooooooooooooooooooooooooooooooong" - ++ "message with concatenation") - ()) -``` - diff --git a/unison-src/transcripts/fix4172.md b/unison-src/transcripts/fix4172.md deleted file mode 100644 index faaa934756..0000000000 --- a/unison-src/transcripts/fix4172.md +++ /dev/null @@ -1,31 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -debug a = match Debug.toText a with - None -> "" - Some (Left a) -> a - Some (Right a) -> a - -test> t1 = if bool then [Ok "Yay"] - else [Fail (debug [1,2,3])] -bool = true - -allowDebug = debug [1,2,3] -``` - -```ucm -scratch/main> add -scratch/main> test -``` - -```unison -bool = false -``` - -```ucm:error -scratch/main> update.old -scratch/main> test -``` diff --git a/unison-src/transcripts/fix4172.output.md b/unison-src/transcripts/fix4172.output.md deleted file mode 100644 index b94add30ab..0000000000 --- a/unison-src/transcripts/fix4172.output.md +++ /dev/null @@ -1,99 +0,0 @@ -``` unison -debug a = match Debug.toText a with - None -> "" - Some (Left a) -> a - Some (Right a) -> a - -test> t1 = if bool then [Ok "Yay"] - else [Fail (debug [1,2,3])] -bool = true - -allowDebug = debug [1,2,3] -``` - -``` 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`: - - allowDebug : Text - bool : Boolean - debug : a -> Text - t1 : [Result] - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 6 | test> t1 = if bool then [Ok "Yay"] - - ✅ Passed Yay - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - allowDebug : Text - bool : Boolean - debug : a -> Text - t1 : [Result] - -scratch/main> test - - Cached test results (`help testcache` to learn more) - - 1. t1 ◉ Yay - - ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` -``` unison -bool = false -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - bool : Boolean - -``` -``` ucm -scratch/main> update.old - - ⍟ I've updated these names to your new definition: - - bool : Boolean - -scratch/main> test - - ✅ - - - - - - New test results: - - 1. t1 ✗ [1, 2, 3] - - 🚫 1 test(s) failing - - Tip: Use view 1 to view the source of a test. - -``` diff --git a/unison-src/transcripts/fix4280.md b/unison-src/transcripts/fix4280.md deleted file mode 100644 index d994a42595..0000000000 --- a/unison-src/transcripts/fix4280.md +++ /dev/null @@ -1,12 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -foo.bar._baz = 5 - -bonk : Nat -bonk = - use foo.bar _baz - _baz -``` diff --git a/unison-src/transcripts/fix4280.output.md b/unison-src/transcripts/fix4280.output.md deleted file mode 100644 index 65561ba2a5..0000000000 --- a/unison-src/transcripts/fix4280.output.md +++ /dev/null @@ -1,23 +0,0 @@ -``` unison -foo.bar._baz = 5 - -bonk : Nat -bonk = - use foo.bar _baz - _baz -``` - -``` 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`: - - bonk : Nat - foo.bar._baz : Nat - -``` diff --git a/unison-src/transcripts/fix4397.md b/unison-src/transcripts/fix4397.md deleted file mode 100644 index 9f81185ccf..0000000000 --- a/unison-src/transcripts/fix4397.md +++ /dev/null @@ -1,8 +0,0 @@ -```unison:error -structural type Foo f - = Foo (f ()) -unique type Baz = Baz (Foo Bar) - -unique type Bar - = Bar Baz -``` diff --git a/unison-src/transcripts/fix4397.output.md b/unison-src/transcripts/fix4397.output.md deleted file mode 100644 index 5d62c12276..0000000000 --- a/unison-src/transcripts/fix4397.output.md +++ /dev/null @@ -1,20 +0,0 @@ -``` unison -structural type Foo f - = Foo (f ()) -unique type Baz = Baz (Foo Bar) - -unique type Bar - = Bar Baz -``` - -``` ucm - - Loading changes detected in scratch.u. - - Kind mismatch arising from - 3 | unique type Baz = Baz (Foo Bar) - - Foo expects an argument of kind: Type -> Type; however, it - is applied to Bar which has kind: Type. - -``` diff --git a/unison-src/transcripts/fix4415.md b/unison-src/transcripts/fix4415.md deleted file mode 100644 index 5db9b53517..0000000000 --- a/unison-src/transcripts/fix4415.md +++ /dev/null @@ -1,5 +0,0 @@ - -```unison -unique type Foo = Foo -unique type sub.Foo = -``` diff --git a/unison-src/transcripts/fix4415.output.md b/unison-src/transcripts/fix4415.output.md deleted file mode 100644 index b17f16ddc4..0000000000 --- a/unison-src/transcripts/fix4415.output.md +++ /dev/null @@ -1,19 +0,0 @@ -``` unison -unique type Foo = Foo -unique type sub.Foo = -``` - -``` 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`: - - type Foo - type sub.Foo - -``` diff --git a/unison-src/transcripts/fix4424.md b/unison-src/transcripts/fix4424.md deleted file mode 100644 index 8fb4d14bab..0000000000 --- a/unison-src/transcripts/fix4424.md +++ /dev/null @@ -1,27 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -Some basics: - -```unison:hide -unique type Cat.Dog = Mouse Nat -unique type Rat.Dog = Bird - -countCat = cases - Cat.Dog.Mouse x -> Bird -``` - -```ucm -scratch/main> add -``` - -Now I want to add a constructor. - -```unison:hide -unique type Rat.Dog = Bird | Mouse -``` - -```ucm -scratch/main> update -``` diff --git a/unison-src/transcripts/fix4424.output.md b/unison-src/transcripts/fix4424.output.md deleted file mode 100644 index 2c7c4b4b63..0000000000 --- a/unison-src/transcripts/fix4424.output.md +++ /dev/null @@ -1,39 +0,0 @@ -Some basics: - -``` unison -unique type Cat.Dog = Mouse Nat -unique type Rat.Dog = Bird - -countCat = cases - Cat.Dog.Mouse x -> Bird -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Cat.Dog - type Rat.Dog - countCat : Cat.Dog -> Rat.Dog - -``` -Now I want to add a constructor. - -``` unison -unique type Rat.Dog = Bird | Mouse -``` - -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Everything typechecks, so I'm saving the results... - - Done. - -``` diff --git a/unison-src/transcripts/fix4482.md b/unison-src/transcripts/fix4482.md deleted file mode 100644 index 380d693c87..0000000000 --- a/unison-src/transcripts/fix4482.md +++ /dev/null @@ -1,16 +0,0 @@ -```ucm:hide -myproj/main> builtins.merge -``` - -```unison -lib.foo0.lib.bonk1.bar = 203 -lib.foo0.baz = 1 -lib.foo1.zonk = 204 -lib.foo1.lib.bonk2.qux = 1 -mybar = bar + bar -``` - -```ucm:error -myproj/main> add -myproj/main> upgrade foo0 foo1 -``` diff --git a/unison-src/transcripts/fix4482.output.md b/unison-src/transcripts/fix4482.output.md deleted file mode 100644 index 5f641c2047..0000000000 --- a/unison-src/transcripts/fix4482.output.md +++ /dev/null @@ -1,63 +0,0 @@ -``` unison -lib.foo0.lib.bonk1.bar = 203 -lib.foo0.baz = 1 -lib.foo1.zonk = 204 -lib.foo1.lib.bonk2.qux = 1 -mybar = bar + bar -``` - -``` 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`: - - lib.foo0.baz : Nat - lib.foo0.lib.bonk1.bar : Nat - lib.foo1.lib.bonk2.qux : Nat - lib.foo1.zonk : Nat - mybar : Nat - -``` -``` ucm -myproj/main> add - - ⍟ I've added these definitions: - - lib.foo0.baz : Nat - lib.foo0.lib.bonk1.bar : Nat - lib.foo1.lib.bonk2.qux : Nat - lib.foo1.zonk : Nat - mybar : Nat - -myproj/main> upgrade foo0 foo1 - - I couldn't automatically upgrade foo0 to foo1. However, I've - added the definitions that need attention to the top of - scratch.u. - - When you're done, you can run - - upgrade.commit - - to merge your changes back into main and delete the temporary - branch. Or, if you decide to cancel the upgrade instead, you - can run - - delete.branch /upgrade-foo0-to-foo1 - - to delete the temporary branch and switch back to main. - -``` -``` unison:added-by-ucm scratch.u -mybar : Nat -mybar = - use Nat + - use lib.foo0.lib.bonk1 bar - bar + bar -``` - diff --git a/unison-src/transcripts/fix4498.md b/unison-src/transcripts/fix4498.md deleted file mode 100644 index 5e8918b300..0000000000 --- a/unison-src/transcripts/fix4498.md +++ /dev/null @@ -1,16 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -lib.dep0.bonk.foo = 5 -lib.dep0.zonk.foo = "hi" -lib.dep0.lib.dep1.foo = 6 -myterm = foo + 2 -``` - -```ucm -scratch/main> add -scratch/main> view myterm -``` - diff --git a/unison-src/transcripts/fix4498.output.md b/unison-src/transcripts/fix4498.output.md deleted file mode 100644 index 49cc9735f2..0000000000 --- a/unison-src/transcripts/fix4498.output.md +++ /dev/null @@ -1,41 +0,0 @@ -``` unison -lib.dep0.bonk.foo = 5 -lib.dep0.zonk.foo = "hi" -lib.dep0.lib.dep1.foo = 6 -myterm = foo + 2 -``` - -``` 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`: - - lib.dep0.bonk.foo : Nat - lib.dep0.lib.dep1.foo : Nat - lib.dep0.zonk.foo : Text - myterm : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - lib.dep0.bonk.foo : Nat - lib.dep0.lib.dep1.foo : Nat - lib.dep0.zonk.foo : Text - myterm : Nat - -scratch/main> view myterm - - myterm : Nat - myterm = - use Nat + - bonk.foo + 2 - -``` diff --git a/unison-src/transcripts/fix4515.md b/unison-src/transcripts/fix4515.md deleted file mode 100644 index 8cae1afc2b..0000000000 --- a/unison-src/transcripts/fix4515.md +++ /dev/null @@ -1,25 +0,0 @@ -```ucm:hide -myproject/main> builtins.merge -``` - -```unison -unique type Foo = Foo1 -unique type Bar = X Foo -unique type Baz = X Foo - -useBar : Bar -> Nat -useBar = cases - Bar.X _ -> 1 -``` - -```ucm -myproject/main> add -``` - -```unison -unique type Foo = Foo1 | Foo2 -``` - -```ucm -myproject/main> update -``` diff --git a/unison-src/transcripts/fix4515.output.md b/unison-src/transcripts/fix4515.output.md deleted file mode 100644 index 9e4b3ee657..0000000000 --- a/unison-src/transcripts/fix4515.output.md +++ /dev/null @@ -1,68 +0,0 @@ -``` unison -unique type Foo = Foo1 -unique type Bar = X Foo -unique type Baz = X Foo - -useBar : Bar -> Nat -useBar = cases - Bar.X _ -> 1 -``` - -``` 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`: - - type Bar - type Baz - type Foo - useBar : Bar -> Nat - -``` -``` ucm -myproject/main> add - - ⍟ I've added these definitions: - - type Bar - type Baz - type Foo - useBar : Bar -> Nat - -``` -``` unison -unique type Foo = Foo1 | Foo2 -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - type Foo - -``` -``` ucm -myproject/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Everything typechecks, so I'm saving the results... - - Done. - -``` diff --git a/unison-src/transcripts/fix4528.md b/unison-src/transcripts/fix4528.md deleted file mode 100644 index c6c540c959..0000000000 --- a/unison-src/transcripts/fix4528.md +++ /dev/null @@ -1,15 +0,0 @@ -```ucm:hide -foo/main> builtins.merge -``` - -```unison -structural type Foo = MkFoo Nat - -main : () -> Foo -main _ = MkFoo 5 -``` - -```ucm -foo/main> add -foo/main> run main -``` diff --git a/unison-src/transcripts/fix4528.output.md b/unison-src/transcripts/fix4528.output.md deleted file mode 100644 index 0266eef0a2..0000000000 --- a/unison-src/transcripts/fix4528.output.md +++ /dev/null @@ -1,34 +0,0 @@ -``` unison -structural type Foo = MkFoo Nat - -main : () -> Foo -main _ = MkFoo 5 -``` - -``` 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`: - - structural type Foo - main : 'Foo - -``` -``` ucm -foo/main> add - - ⍟ I've added these definitions: - - structural type Foo - main : 'Foo - -foo/main> run main - - MkFoo 5 - -``` diff --git a/unison-src/transcripts/fix4556.md b/unison-src/transcripts/fix4556.md deleted file mode 100644 index 1a0bbe25d7..0000000000 --- a/unison-src/transcripts/fix4556.md +++ /dev/null @@ -1,22 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -thing = 3 -foo.hello = 5 + thing -bar.hello = 5 + thing -hey = foo.hello -``` - -```ucm -scratch/main> add -``` - -```unison -thing = 2 -``` - -```ucm -scratch/main> update -``` diff --git a/unison-src/transcripts/fix4556.output.md b/unison-src/transcripts/fix4556.output.md deleted file mode 100644 index 23bdc3a9f2..0000000000 --- a/unison-src/transcripts/fix4556.output.md +++ /dev/null @@ -1,65 +0,0 @@ -``` unison -thing = 3 -foo.hello = 5 + thing -bar.hello = 5 + thing -hey = foo.hello -``` - -``` 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`: - - bar.hello : Nat - foo.hello : Nat - hey : Nat - thing : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - bar.hello : Nat - foo.hello : Nat - hey : Nat - thing : Nat - -``` -``` unison -thing = 2 -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - thing : Nat - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Everything typechecks, so I'm saving the results... - - Done. - -``` diff --git a/unison-src/transcripts/fix4592.md b/unison-src/transcripts/fix4592.md deleted file mode 100644 index 1118a281fb..0000000000 --- a/unison-src/transcripts/fix4592.md +++ /dev/null @@ -1,8 +0,0 @@ -```ucm:hide -scratch/main> builtins.mergeio -``` - -```unison -doc = {{ {{ bug "bug" - 52 }} }} -``` diff --git a/unison-src/transcripts/fix4592.output.md b/unison-src/transcripts/fix4592.output.md deleted file mode 100644 index a6a05b76d6..0000000000 --- a/unison-src/transcripts/fix4592.output.md +++ /dev/null @@ -1,18 +0,0 @@ -``` unison -doc = {{ {{ bug "bug" - 52 }} }} -``` - -``` 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`: - - doc : Doc2 - -``` diff --git a/unison-src/transcripts/fix4618.md b/unison-src/transcripts/fix4618.md deleted file mode 100644 index 1d69f1ac52..0000000000 --- a/unison-src/transcripts/fix4618.md +++ /dev/null @@ -1,21 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -foo = 5 -unique type Bugs.Zonk = Bugs -``` - -```ucm -scratch/main> add -``` - -```unison -foo = 4 -unique type Bugs = -``` - -```ucm -scratch/main> update -``` diff --git a/unison-src/transcripts/fix4618.output.md b/unison-src/transcripts/fix4618.output.md deleted file mode 100644 index a364ddc8f1..0000000000 --- a/unison-src/transcripts/fix4618.output.md +++ /dev/null @@ -1,60 +0,0 @@ -``` unison -foo = 5 -unique type Bugs.Zonk = Bugs -``` - -``` 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`: - - type Bugs.Zonk - foo : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Bugs.Zonk - foo : Nat - -``` -``` unison -foo = 4 -unique type Bugs = -``` - -``` 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`: - - type Bugs - - ⍟ These names already exist. You can `update` them to your - new definition: - - foo : Nat - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -``` diff --git a/unison-src/transcripts/fix4722.md b/unison-src/transcripts/fix4722.md deleted file mode 100644 index 983e324f74..0000000000 --- a/unison-src/transcripts/fix4722.md +++ /dev/null @@ -1,40 +0,0 @@ - -Tests an improvement to type checking related to abilities. - -`foo` below typechecks fine as long as all the branches are _checked_ -against their expected type. However, it's annoying to have to -annotate them. The old code was checking a match by just synthesizing -and subtyping, but we can instead check a match by pushing the -expected type into each case, allowing top-level annotations to act -like annotations on each case. - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -ability X a where yield : {X a} () -ability Y where y : () - -type Foo b a = One a -type Bar a - = Leaf a - | Branch (Bar a) (Bar a) - -f : (a -> ()) -> '{g, X a} () -> '{g, X a} () -> '{g, X a} () -f _ x y = y - -abra : a -> '{Y, X z} r -abra = bug "" - -cadabra : (y -> z) -> '{g, X y} r -> '{g, X z} r -cadabra = bug "" - -foo : Bar (Optional b) -> '{Y, X (Foo z ('{Y} r))} () -foo = cases - Leaf a -> match a with - None -> abra a - Some _ -> cadabra One (abra a) - Branch l r -> - f (_ -> ()) (foo l) (foo r) -``` diff --git a/unison-src/transcripts/fix4722.output.md b/unison-src/transcripts/fix4722.output.md deleted file mode 100644 index faa963b196..0000000000 --- a/unison-src/transcripts/fix4722.output.md +++ /dev/null @@ -1,59 +0,0 @@ -Tests an improvement to type checking related to abilities. - -`foo` below typechecks fine as long as all the branches are *checked* -against their expected type. However, it's annoying to have to -annotate them. The old code was checking a match by just synthesizing -and subtyping, but we can instead check a match by pushing the -expected type into each case, allowing top-level annotations to act -like annotations on each case. - -``` unison -ability X a where yield : {X a} () -ability Y where y : () - -type Foo b a = One a -type Bar a - = Leaf a - | Branch (Bar a) (Bar a) - -f : (a -> ()) -> '{g, X a} () -> '{g, X a} () -> '{g, X a} () -f _ x y = y - -abra : a -> '{Y, X z} r -abra = bug "" - -cadabra : (y -> z) -> '{g, X y} r -> '{g, X z} r -cadabra = bug "" - -foo : Bar (Optional b) -> '{Y, X (Foo z ('{Y} r))} () -foo = cases - Leaf a -> match a with - None -> abra a - Some _ -> cadabra One (abra a) - Branch l r -> - f (_ -> ()) (foo l) (foo r) -``` - -``` 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`: - - type Bar a - type Foo b a - ability X a - ability Y - abra : a -> '{Y, X z} r - cadabra : (y ->{h} z) -> '{g, X y} r -> '{g, X z} r - f : (a ->{h} ()) - -> '{g, X a} () - -> '{g, X a} () - -> '{g, X a} () - foo : Bar (Optional b) -> '{Y, X (Foo z ('{Y} r))} () - -``` diff --git a/unison-src/transcripts/fix4780.md b/unison-src/transcripts/fix4780.md deleted file mode 100644 index f1ebdad567..0000000000 --- a/unison-src/transcripts/fix4780.md +++ /dev/null @@ -1,10 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -Just a simple test case to see whether partially applied -builtins decompile properly. - -```unison -> (+) 2 -``` diff --git a/unison-src/transcripts/fix4780.output.md b/unison-src/transcripts/fix4780.output.md deleted file mode 100644 index 5fefbd4ccf..0000000000 --- a/unison-src/transcripts/fix4780.output.md +++ /dev/null @@ -1,23 +0,0 @@ -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 - -``` diff --git a/unison-src/transcripts/fix4898.md b/unison-src/transcripts/fix4898.md deleted file mode 100644 index 6d618d82b0..0000000000 --- a/unison-src/transcripts/fix4898.md +++ /dev/null @@ -1,17 +0,0 @@ -```ucm -scratch/main> builtins.merge -``` - -```unison -double : Int -> Int -double x = x + x - -redouble : Int -> Int -redouble x = double x + double x -``` - -```ucm -scratch/main> add -scratch/main> dependents double -scratch/main> delete.term 1 -``` diff --git a/unison-src/transcripts/fix4898.output.md b/unison-src/transcripts/fix4898.output.md deleted file mode 100644 index 9bacabb90d..0000000000 --- a/unison-src/transcripts/fix4898.output.md +++ /dev/null @@ -1,52 +0,0 @@ -``` ucm -scratch/main> builtins.merge - - Done. - -``` -``` unison -double : Int -> Int -double x = x + x - -redouble : Int -> Int -redouble x = double x + double x -``` - -``` 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`: - - double : Int -> Int - redouble : Int -> Int - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - double : Int -> Int - redouble : Int -> Int - -scratch/main> dependents double - - Dependents of: double - - Terms: - - 1. redouble - - Tip: Try `view 1` to see the source of any numbered item in - the above list. - -scratch/main> delete.term 1 - - Done. - -``` diff --git a/unison-src/transcripts/fix5055.md b/unison-src/transcripts/fix5055.md deleted file mode 100644 index b5c377d381..0000000000 --- a/unison-src/transcripts/fix5055.md +++ /dev/null @@ -1,15 +0,0 @@ -```ucm -test-5055/main> builtins.merge -``` - -```unison -foo.add x y = x Int.+ y - -foo.subtract x y = x Int.- y -``` - -```ucm -test-5055/main> add -test-5055/main> ls foo -test-5055/main> view 1 -``` diff --git a/unison-src/transcripts/fix5055.output.md b/unison-src/transcripts/fix5055.output.md deleted file mode 100644 index 005e47585e..0000000000 --- a/unison-src/transcripts/fix5055.output.md +++ /dev/null @@ -1,47 +0,0 @@ -``` ucm -test-5055/main> builtins.merge - - Done. - -``` -``` unison -foo.add x y = x Int.+ y - -foo.subtract x y = x Int.- y -``` - -``` 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.add : Int -> Int -> Int - foo.subtract : Int -> Int -> Int - -``` -``` ucm -test-5055/main> add - - ⍟ I've added these definitions: - - foo.add : Int -> Int -> Int - foo.subtract : Int -> Int -> Int - -test-5055/main> ls foo - - 1. add (Int -> Int -> Int) - 2. subtract (Int -> Int -> Int) - -test-5055/main> view 1 - - foo.add : Int -> Int -> Int - foo.add x y = - use Int + - x + y - -``` diff --git a/unison-src/transcripts/fix5076.md b/unison-src/transcripts/fix5076.md deleted file mode 100644 index d2c4b5a7b2..0000000000 --- a/unison-src/transcripts/fix5076.md +++ /dev/null @@ -1,12 +0,0 @@ -```ucm:hide -scratch/main> builtins.mergeio -``` - -Nested call to code lexer wasn’t terminating inline examples containing blocks properly. - -```unison -x = {{ - ``let "me"`` live - ``do "me"`` in - }} -``` diff --git a/unison-src/transcripts/fix5076.output.md b/unison-src/transcripts/fix5076.output.md deleted file mode 100644 index f92954cd23..0000000000 --- a/unison-src/transcripts/fix5076.output.md +++ /dev/null @@ -1,22 +0,0 @@ -Nested call to code lexer wasn’t terminating inline examples containing blocks properly. - -``` unison -x = {{ - ``let "me"`` live - ``do "me"`` in - }} -``` - -``` 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`: - - x : Doc2 - -``` diff --git a/unison-src/transcripts/fix5080.md b/unison-src/transcripts/fix5080.md deleted file mode 100644 index 5c343603de..0000000000 --- a/unison-src/transcripts/fix5080.md +++ /dev/null @@ -1,18 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtins -``` - -```unison -test> fix5080.tests.success = [Ok "success"] -test> fix5080.tests.failure = [Fail "fail"] -``` - -```ucm:error -scratch/main> add -scratch/main> test -``` - -```ucm -scratch/main> delete.term 2 -scratch/main> test -``` diff --git a/unison-src/transcripts/fix5080.output.md b/unison-src/transcripts/fix5080.output.md deleted file mode 100644 index f64f9c84ff..0000000000 --- a/unison-src/transcripts/fix5080.output.md +++ /dev/null @@ -1,67 +0,0 @@ -``` unison -test> fix5080.tests.success = [Ok "success"] -test> fix5080.tests.failure = [Fail "fail"] -``` - -``` 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`: - - fix5080.tests.failure : [Result] - fix5080.tests.success : [Result] - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 1 | test> fix5080.tests.success = [Ok "success"] - - ✅ Passed success - - 2 | test> fix5080.tests.failure = [Fail "fail"] - - 🚫 FAILED fail - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - fix5080.tests.failure : [Result] - fix5080.tests.success : [Result] - -scratch/main> test - - Cached test results (`help testcache` to learn more) - - 1. fix5080.tests.success ◉ success - - 2. fix5080.tests.failure ✗ fail - - 🚫 1 test(s) failing, ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` -``` ucm -scratch/main> delete.term 2 - - Done. - -scratch/main> test - - Cached test results (`help testcache` to learn more) - - 1. fix5080.tests.success ◉ success - - ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` diff --git a/unison-src/transcripts/fix5141.output.md b/unison-src/transcripts/fix5141.output.md deleted file mode 100644 index ab031fee02..0000000000 --- a/unison-src/transcripts/fix5141.output.md +++ /dev/null @@ -1,6 +0,0 @@ - - diff --git a/unison-src/transcripts/fix5168.md b/unison-src/transcripts/fix5168.md deleted file mode 100644 index 2eda5f0215..0000000000 --- a/unison-src/transcripts/fix5168.md +++ /dev/null @@ -1,4 +0,0 @@ -The `edit` seems to suppress a following ```` ```unison ```` block: -```unison -b = 2 -``` diff --git a/unison-src/transcripts/fix5168.output.md b/unison-src/transcripts/fix5168.output.md deleted file mode 100644 index 5a7c35e339..0000000000 --- a/unison-src/transcripts/fix5168.output.md +++ /dev/null @@ -1,19 +0,0 @@ -The `edit` seems to suppress a following ` ```unison ` block: - -``` unison -b = 2 -``` - -``` 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`: - - b : ##Nat - -``` diff --git a/unison-src/transcripts/fix614.md b/unison-src/transcripts/fix614.md deleted file mode 100644 index 3bc69c27c9..0000000000 --- a/unison-src/transcripts/fix614.md +++ /dev/null @@ -1,54 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -This transcript demonstrates that Unison forces actions in blocks to have a return type of `()`. - -This works, as expected: - -```unison -structural ability Stream a where emit : a -> () - -ex1 = do - Stream.emit 1 - Stream.emit 2 - 42 -``` - -```ucm:hide -scratch/main> add -``` - -This does not typecheck, we've accidentally underapplied `Stream.emit`: - -```unison:error -ex2 = do - Stream.emit - 42 -``` - -We can explicitly ignore an unused result like so: - -```unison -ex3 = do - _ = Stream.emit - () -``` - -Using a helper function like `void` also works fine: - -```unison -void x = () - -ex4 = - void [1,2,3] - () -``` - -One more example: - -```unison:error -ex4 = - [1,2,3] -- no good - () -``` diff --git a/unison-src/transcripts/fix614.output.md b/unison-src/transcripts/fix614.output.md deleted file mode 100644 index 97ec65e00a..0000000000 --- a/unison-src/transcripts/fix614.output.md +++ /dev/null @@ -1,120 +0,0 @@ -This transcript demonstrates that Unison forces actions in blocks to have a return type of `()`. - -This works, as expected: - -``` unison -structural ability Stream a where emit : a -> () - -ex1 = do - Stream.emit 1 - Stream.emit 2 - 42 -``` - -``` 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`: - - structural ability Stream a - ex1 : '{Stream Nat} Nat - -``` -This does not typecheck, we've accidentally underapplied `Stream.emit`: - -``` unison -ex2 = do - Stream.emit - 42 -``` - -``` ucm - - Loading changes detected in scratch.u. - - I found a value of type: a ->{Stream a} Unit - where I expected to find: Unit - - 2 | Stream.emit - 3 | 42 - - Hint: Actions within a block must have type Unit. - Use _ = to ignore a result. - -``` -We can explicitly ignore an unused result like so: - -``` unison -ex3 = do - _ = Stream.emit - () -``` - -``` 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`: - - ex3 : '() - -``` -Using a helper function like `void` also works fine: - -``` unison -void x = () - -ex4 = - void [1,2,3] - () -``` - -``` 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`: - - ex4 : () - void : x -> () - -``` -One more example: - -``` unison -ex4 = - [1,2,3] -- no good - () -``` - -``` ucm - - Loading changes detected in scratch.u. - - I found a value of type: [Nat] - where I expected to find: Unit - - 2 | [1,2,3] -- no good - 3 | () - - from right here: - - 2 | [1,2,3] -- no good - - Hint: Actions within a block must have type Unit. - Use _ = to ignore a result. - -``` diff --git a/unison-src/transcripts/fix689.md b/unison-src/transcripts/fix689.md deleted file mode 100644 index a75468b281..0000000000 --- a/unison-src/transcripts/fix689.md +++ /dev/null @@ -1,13 +0,0 @@ -Tests the fix for https://github.com/unisonweb/unison/issues/689 - -```ucm:hide -scratch/main> builtins.merge -``` - -``` unison -structural ability SystemTime where - systemTime : ##Nat - -tomorrow = '(SystemTime.systemTime + 24 * 60 * 60) -``` - diff --git a/unison-src/transcripts/fix689.output.md b/unison-src/transcripts/fix689.output.md deleted file mode 100644 index ed8ea04102..0000000000 --- a/unison-src/transcripts/fix689.output.md +++ /dev/null @@ -1,23 +0,0 @@ -Tests the fix for https://github.com/unisonweb/unison/issues/689 - -``` unison -structural ability SystemTime where - systemTime : ##Nat - -tomorrow = '(SystemTime.systemTime + 24 * 60 * 60) -``` - -``` 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`: - - structural ability SystemTime - tomorrow : '{SystemTime} Nat - -``` diff --git a/unison-src/transcripts/fix693.md b/unison-src/transcripts/fix693.md deleted file mode 100644 index f45d2eab15..0000000000 --- a/unison-src/transcripts/fix693.md +++ /dev/null @@ -1,57 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -structural ability X t where - x : t -> a -> a - -structural ability Abort where - abort : a -``` - -```ucm -scratch/main> add -``` - -This code should not type check. The match on X.x ought to introduce a -skolem variable `a` such that `c : a` and the continuation has type -`a ->{X} b`. Thus, `handle c with h : Optional a`, which is not the -correct result type. - -```unison:error -h0 : Request {X t} b -> Optional b -h0 req = match req with - { X.x _ c -> _ } -> handle c with h0 - { d } -> Some d -``` - -This code should not check because `t` does not match `b`. - -```unison:error -h1 : Request {X t} b -> Optional b -h1 req = match req with - { X.x t _ -> _ } -> handle t with h1 - { d } -> Some d -``` - -This code should not check for reasons similar to the first example, -but with the continuation rather than a parameter. - -```unison:error -h2 : Request {Abort} r -> r -h2 req = match req with - { Abort.abort -> k } -> handle k 5 with h2 - { r } -> r -``` - -This should work fine. - -```unison -h3 : Request {X b, Abort} b -> Optional b -h3 = cases - { r } -> Some r - { Abort.abort -> _ } -> None - { X.x b _ -> _ } -> Some b -``` diff --git a/unison-src/transcripts/fix693.output.md b/unison-src/transcripts/fix693.output.md deleted file mode 100644 index 35e07bec56..0000000000 --- a/unison-src/transcripts/fix693.output.md +++ /dev/null @@ -1,136 +0,0 @@ -``` unison -structural ability X t where - x : t -> a -> a - -structural ability Abort where - abort : a -``` - -``` 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`: - - structural ability Abort - structural ability X t - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - structural ability Abort - structural ability X t - -``` -This code should not type check. The match on X.x ought to introduce a -skolem variable `a` such that `c : a` and the continuation has type -`a ->{X} b`. Thus, `handle c with h : Optional a`, which is not the -correct result type. - -``` unison -h0 : Request {X t} b -> Optional b -h0 req = match req with - { X.x _ c -> _ } -> handle c with h0 - { d } -> Some d -``` - -``` ucm - - Loading changes detected in scratch.u. - - Each case of a match / with expression need to have the same - type. - - Here, one is: Optional b - and another is: Optional a - - - 3 | { X.x _ c -> _ } -> handle c with h0 - - from these spots, respectively: - - 1 | h0 : Request {X t} b -> Optional b - - -``` -This code should not check because `t` does not match `b`. - -``` unison -h1 : Request {X t} b -> Optional b -h1 req = match req with - { X.x t _ -> _ } -> handle t with h1 - { d } -> Some d -``` - -``` ucm - - Loading changes detected in scratch.u. - - Each case of a match / with expression need to have the same - type. - - Here, one is: Optional b - and another is: Optional t - - - 3 | { X.x t _ -> _ } -> handle t with h1 - - from these spots, respectively: - - 1 | h1 : Request {X t} b -> Optional b - - -``` -This code should not check for reasons similar to the first example, -but with the continuation rather than a parameter. - -``` unison -h2 : Request {Abort} r -> r -h2 req = match req with - { Abort.abort -> k } -> handle k 5 with h2 - { r } -> r -``` - -``` ucm - - Loading changes detected in scratch.u. - - The 1st argument to `k` - - has type: Nat - but I expected: a - - 3 | { Abort.abort -> k } -> handle k 5 with h2 - - -``` -This should work fine. - -``` unison -h3 : Request {X b, Abort} b -> Optional b -h3 = cases - { r } -> Some r - { Abort.abort -> _ } -> None - { X.x b _ -> _ } -> Some b -``` - -``` 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`: - - h3 : Request {X b, Abort} b -> Optional b - -``` diff --git a/unison-src/transcripts/fix845.md b/unison-src/transcripts/fix845.md deleted file mode 100644 index 99e4262455..0000000000 --- a/unison-src/transcripts/fix845.md +++ /dev/null @@ -1,57 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -Add `List.zonk` to the codebase: - -```unison -List.zonk : [a] -> [a] -List.zonk xs = xs - -Text.zonk : Text -> Text -Text.zonk txt = txt ++ "!! " -``` - -```ucm:hide -scratch/main> add -``` - -Now, typecheck a file with a reference to `Blah.zonk` (which doesn't exist in the codebase). This should fail: - -```unison:error --- should not typecheck as there's no `Blah.zonk` in the codebase -> Blah.zonk [1,2,3] -``` - -Here's another example, just checking that TDNR works for definitions in the same file: - -```unison -foo.bar.baz = 42 - -qux.baz = "hello" - -ex = baz ++ ", world!" - -> ex -``` - -Here's another example, checking that TDNR works when multiple codebase definitions have matching names: - -```unison -ex = zonk "hi" - -> ex -``` - -Last example, showing that TDNR works when there are multiple matching names in both the file and the codebase: - -```unison -woot.zonk = "woot" -woot2.zonk = 9384 - -ex = zonk "hi" -- should resolve to Text.zonk, from the codebase - ++ zonk -- should resolve to the local `woot.zonk` from this file - -> ex -``` diff --git a/unison-src/transcripts/fix845.output.md b/unison-src/transcripts/fix845.output.md deleted file mode 100644 index c192583c63..0000000000 --- a/unison-src/transcripts/fix845.output.md +++ /dev/null @@ -1,147 +0,0 @@ -Add `List.zonk` to the codebase: - -``` unison -List.zonk : [a] -> [a] -List.zonk xs = xs - -Text.zonk : Text -> Text -Text.zonk txt = txt ++ "!! " -``` - -``` 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`: - - List.zonk : [a] -> [a] - Text.zonk : Text -> Text - -``` -Now, typecheck a file with a reference to `Blah.zonk` (which doesn't exist in the codebase). This should fail: - -``` unison --- should not typecheck as there's no `Blah.zonk` in the codebase -> Blah.zonk [1,2,3] -``` - -``` ucm - - Loading changes detected in scratch.u. - - I couldn't figure out what Blah.zonk refers to here: - - 2 | > Blah.zonk [1,2,3] - - I think its type should be: - - [Nat] -> o - - Some common causes of this error include: - * Your current namespace is too deep to contain the - definition in its subtree - * The definition is part of a library which hasn't been - added to this project - * You have a typo in the name - -``` -Here's another example, just checking that TDNR works for definitions in the same file: - -``` unison -foo.bar.baz = 42 - -qux.baz = "hello" - -ex = baz ++ ", world!" - -> ex -``` - -``` 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`: - - ex : Text - foo.bar.baz : Nat - qux.baz : Text - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 7 | > ex - ⧩ - "hello, world!" - -``` -Here's another example, checking that TDNR works when multiple codebase definitions have matching names: - -``` unison -ex = zonk "hi" - -> ex -``` - -``` 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`: - - ex : Text - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 3 | > ex - ⧩ - "hi!! " - -``` -Last example, showing that TDNR works when there are multiple matching names in both the file and the codebase: - -``` unison -woot.zonk = "woot" -woot2.zonk = 9384 - -ex = zonk "hi" -- should resolve to Text.zonk, from the codebase - ++ zonk -- should resolve to the local `woot.zonk` from this file - -> ex -``` - -``` 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`: - - ex : Text - woot.zonk : Text - woot2.zonk : Nat - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 7 | > ex - ⧩ - "hi!! woot" - -``` diff --git a/unison-src/transcripts/fix849.md b/unison-src/transcripts/fix849.md deleted file mode 100644 index 63c40e8212..0000000000 --- a/unison-src/transcripts/fix849.md +++ /dev/null @@ -1,12 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -See [this ticket](https://github.com/unisonweb/unison/issues/849). - -```unison -x = 42 - -> x -``` diff --git a/unison-src/transcripts/fix849.output.md b/unison-src/transcripts/fix849.output.md deleted file mode 100644 index c6c5c13904..0000000000 --- a/unison-src/transcripts/fix849.output.md +++ /dev/null @@ -1,28 +0,0 @@ -See [this ticket](https://github.com/unisonweb/unison/issues/849). - -``` unison -x = 42 - -> x -``` - -``` 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`: - - x : Nat - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 3 | > x - ⧩ - 42 - -``` diff --git a/unison-src/transcripts/fix942.md b/unison-src/transcripts/fix942.md deleted file mode 100644 index 5cbf16ffb1..0000000000 --- a/unison-src/transcripts/fix942.md +++ /dev/null @@ -1,37 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -First we add some code: - -```unison -x = 0 -y = x + 1 -z = y + 2 -``` - -```ucm -scratch/main> add -``` - -Now we edit `x` to be `7`, which should make `z` equal `10`: - -```unison -x = 7 -``` - -```ucm -scratch/main> update -scratch/main> view x y z -``` - -Uh oh! `z` is still referencing the old version. Just to confirm: - -```unison -test> t1 = if z == 3 then [Fail "nooo!!!"] else [Ok "great"] -``` - -```ucm -scratch/main> add -scratch/main> test -``` diff --git a/unison-src/transcripts/fix942.output.md b/unison-src/transcripts/fix942.output.md deleted file mode 100644 index 13dd97532b..0000000000 --- a/unison-src/transcripts/fix942.output.md +++ /dev/null @@ -1,125 +0,0 @@ -First we add some code: - -``` unison -x = 0 -y = x + 1 -z = y + 2 -``` - -``` 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`: - - x : Nat - y : Nat - z : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - x : Nat - y : Nat - z : Nat - -``` -Now we edit `x` to be `7`, which should make `z` equal `10`: - -``` unison -x = 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 names already exist. You can `update` them to your - new definition: - - x : Nat - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Everything typechecks, so I'm saving the results... - - Done. - -scratch/main> view x y z - - x : Nat - x = 7 - - y : Nat - y = - use Nat + - x + 1 - - z : Nat - z = - use Nat + - y + 2 - -``` -Uh oh\! `z` is still referencing the old version. Just to confirm: - -``` unison -test> t1 = if z == 3 then [Fail "nooo!!!"] else [Ok "great"] -``` - -``` 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`: - - t1 : [Result] - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 1 | test> t1 = if z == 3 then [Fail "nooo!!!"] else [Ok "great"] - - ✅ Passed great - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - t1 : [Result] - -scratch/main> test - - Cached test results (`help testcache` to learn more) - - 1. t1 ◉ great - - ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` diff --git a/unison-src/transcripts/fix987.md b/unison-src/transcripts/fix987.md deleted file mode 100644 index 5eb2a73bbc..0000000000 --- a/unison-src/transcripts/fix987.md +++ /dev/null @@ -1,37 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -First we'll add a definition: - -```unison -structural ability DeathStar where - attack : Text -> () - -spaceAttack1 x = - y = attack "saturn" - z = attack "neptune" - "All done" -``` - -Add it to the codebase: - -```ucm -scratch/main> add -``` - -Now we'll try to add a different definition that runs the actions in a different order. This should work fine: - -```unison -spaceAttack2 x = - z = attack "neptune" - y = attack "saturn" - "All done" -``` - -```ucm -scratch/main> add -``` - -Previously, this would fail because the hashing algorithm was being given one big let rec block whose binding order was normalized. diff --git a/unison-src/transcripts/fix987.output.md b/unison-src/transcripts/fix987.output.md deleted file mode 100644 index a128fa6c0a..0000000000 --- a/unison-src/transcripts/fix987.output.md +++ /dev/null @@ -1,69 +0,0 @@ -First we'll add a definition: - -``` unison -structural ability DeathStar where - attack : Text -> () - -spaceAttack1 x = - y = attack "saturn" - z = attack "neptune" - "All done" -``` - -``` 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`: - - structural ability DeathStar - spaceAttack1 : x ->{DeathStar} Text - -``` -Add it to the codebase: - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - structural ability DeathStar - spaceAttack1 : x ->{DeathStar} Text - -``` -Now we'll try to add a different definition that runs the actions in a different order. This should work fine: - -``` unison -spaceAttack2 x = - z = attack "neptune" - y = attack "saturn" - "All done" -``` - -``` 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`: - - spaceAttack2 : x ->{DeathStar} Text - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - spaceAttack2 : x ->{DeathStar} Text - -``` -Previously, this would fail because the hashing algorithm was being given one big let rec block whose binding order was normalized. - diff --git a/unison-src/transcripts/formatter.md b/unison-src/transcripts/formatter.md deleted file mode 100644 index d2a921b2fc..0000000000 --- a/unison-src/transcripts/formatter.md +++ /dev/null @@ -1,102 +0,0 @@ -```ucm:hide -scratch/main> builtins.mergeio -``` - -```unison:hide -{{ # Doc -This is a *doc*! - -term link {x} - -type link {type Optional} - -}} -x : - Nat - -> Nat -x y = - x = 1 + 1 - x + y --- Should keep comments after - --- symbolyDefinition -(<|>) : Nat -> Nat -> (Nat, Nat) -(<|>) a b = (a, b) - -symbolyEndOfBlock = - x = 1 - (+:) - - --- Test for a previous regression that added extra brackets. -oneLiner = {{ one liner }} --- After - --- Before -explicit.doc = {{ -# Here's a top-level doc - -With a paragraph - -Or two -}} --- After - -{{ A doc before an ability }} -ability Thing where - more : Nat -> Text -> Nat - doThing : Nat -> Int - - -{{ Ability with single constructor }} -structural ability Ask a where - ask : {Ask a} a - --- Regression test for: https://github.com/unisonweb/unison/issues/4666 -provide : a -> '{Ask a} r -> r -provide a action = - h = cases - {ask -> resume} -> handle resume a with h - {r} -> r - handle !action with h - -{{ -A Doc before a type -}} -structural type Optional a = More Text - | Some - | Other a - | None Nat - -{{ A doc before a type with no type-vars }} -type Two = One Nat | Two Text - --- Regression for https://github.com/unisonweb/unison/issues/4669 - -multilineBold = {{ - -**This paragraph is really really really really really long and spans multiple lines -with a strike-through block** - -_This paragraph is really really really really really long and spans multiple lines -with a strike-through block_ - -~This paragraph is really really really really really long and spans multiple lines -with a strike-through block~ - -}} -``` - -```ucm -scratch/main> debug.format -``` - -Formatter should leave things alone if the file doesn't typecheck. - -```unison:error -brokenDoc = {{ hello }} + 1 -``` - -```ucm -scratch/main> debug.format -``` diff --git a/unison-src/transcripts/formatter.output.md b/unison-src/transcripts/formatter.output.md deleted file mode 100644 index 54c9a12327..0000000000 --- a/unison-src/transcripts/formatter.output.md +++ /dev/null @@ -1,205 +0,0 @@ -``` unison -{{ # Doc -This is a *doc*! - -term link {x} - -type link {type Optional} - -}} -x : - Nat - -> Nat -x y = - x = 1 + 1 - x + y --- Should keep comments after - --- symbolyDefinition -(<|>) : Nat -> Nat -> (Nat, Nat) -(<|>) a b = (a, b) - -symbolyEndOfBlock = - x = 1 - (+:) - - --- Test for a previous regression that added extra brackets. -oneLiner = {{ one liner }} --- After - --- Before -explicit.doc = {{ -# Here's a top-level doc - -With a paragraph - -Or two -}} --- After - -{{ A doc before an ability }} -ability Thing where - more : Nat -> Text -> Nat - doThing : Nat -> Int - - -{{ Ability with single constructor }} -structural ability Ask a where - ask : {Ask a} a - --- Regression test for: https://github.com/unisonweb/unison/issues/4666 -provide : a -> '{Ask a} r -> r -provide a action = - h = cases - {ask -> resume} -> handle resume a with h - {r} -> r - handle !action with h - -{{ -A Doc before a type -}} -structural type Optional a = More Text - | Some - | Other a - | None Nat - -{{ A doc before a type with no type-vars }} -type Two = One Nat | Two Text - --- Regression for https://github.com/unisonweb/unison/issues/4669 - -multilineBold = {{ - -**This paragraph is really really really really really long and spans multiple lines -with a strike-through block** - -_This paragraph is really really really really really long and spans multiple lines -with a strike-through block_ - -~This paragraph is really really really really really long and spans multiple lines -with a strike-through block~ - -}} -``` - -``` ucm -scratch/main> debug.format - -``` -``` unison:added-by-ucm scratch.u -x.doc = - {{ - # Doc This is a **doc**! - - term link {x} - - type link {type Optional} - }} -x : Nat -> Nat -x y = - use Nat + - x = 1 + 1 - x + y --- Should keep comments after - --- symbolyDefinition -(<|>) : Nat -> Nat -> (Nat, Nat) -a <|> b = (a, b) - -symbolyEndOfBlock = - x = 1 - (+:) - - --- Test for a previous regression that added extra brackets. -oneLiner = {{ one liner }} --- After - --- Before -explicit.doc = - {{ - # Here's a top-level doc - - With a paragraph - - Or two - }} --- After - -Thing.doc = {{ A doc before an ability }} -ability Thing where - more : Nat -> Text ->{Thing} Nat - doThing : Nat ->{Thing} Int - - -Ask.doc = {{ Ability with single constructor }} -structural ability Ask a where ask : {Ask a} a - --- Regression test for: https://github.com/unisonweb/unison/issues/4666 -provide : a -> '{Ask a} r -> r -provide a action = - h = cases - { ask -> resume } -> handle resume a with h - { r } -> r - handle action() with h - -Optional.doc = {{ A Doc before a type }} -structural type Optional a = More Text | Some | Other a | None Nat - -Two.doc = {{ A doc before a type with no type-vars }} -type Two = One Nat | Two Text - --- Regression for https://github.com/unisonweb/unison/issues/4669 - -multilineBold = - {{ - **This paragraph is really really really really really long and spans - multiple lines with a strike-through block** - - __This paragraph is really really really really really long and spans - multiple lines with a strike-through block__ - - ~~This paragraph is really really really really really long and spans - multiple lines with a strike-through block~~ - }} -``` - -Formatter should leave things alone if the file doesn't typecheck. - -``` unison -brokenDoc = {{ hello }} + 1 -``` - -``` ucm - - Loading changes detected in scratch.u. - - I couldn't figure out what + refers to here: - - 1 | brokenDoc = {{ hello }} + 1 - - The name + is ambiguous. I tried to resolve it by type but no - term with that name would pass typechecking. I think its type - should be: - - Doc2 -> Nat -> o - - If that's not what you expected, you may have a type error - somewhere else in your code. - Help me out by using a more specific name here or adding a - type annotation. - - I found some terms in scope with matching names but different - types. If one of these is what you meant, try using its full - name: - - (Float.+) : Float -> Float -> Float - (Int.+) : Int -> Int -> Int - (Nat.+) : Nat -> Nat -> Nat - -``` -``` ucm -scratch/main> debug.format - -``` diff --git a/unison-src/transcripts/fuzzy-options.md b/unison-src/transcripts/fuzzy-options.md deleted file mode 100644 index e460ce923a..0000000000 --- a/unison-src/transcripts/fuzzy-options.md +++ /dev/null @@ -1,45 +0,0 @@ -# Test that the options selector for fuzzy finding is working as expected for different argument types. - -If an argument is required but doesn't have a fuzzy resolver, the command should just print the help. - - -```ucm:error --- The second argument of move.term is a 'new-name' and doesn't have a fuzzy resolver -scratch/main> move.term -``` - -If a fuzzy resolver doesn't have any options available it should print a message instead of -opening an empty fuzzy-select. - -```ucm:error -scratch/empty> view -``` - - -```unison:hide -optionOne = 1 - -nested.optionTwo = 2 -``` - -Definition args - -```ucm -scratch/main> add -scratch/main> debug.fuzzy-options view _ -``` - - -Namespace args - -```ucm -scratch/main> add -scratch/main> debug.fuzzy-options find-in _ -``` - -Project Branch args - -```ucm -myproject/main> branch mybranch -scratch/main> debug.fuzzy-options switch _ -``` diff --git a/unison-src/transcripts/fuzzy-options.output.md b/unison-src/transcripts/fuzzy-options.output.md deleted file mode 100644 index d83fd4341b..0000000000 --- a/unison-src/transcripts/fuzzy-options.output.md +++ /dev/null @@ -1,80 +0,0 @@ -# Test that the options selector for fuzzy finding is working as expected for different argument types. - -If an argument is required but doesn't have a fuzzy resolver, the command should just print the help. - -``` ucm --- The second argument of move.term is a 'new-name' and doesn't have a fuzzy resolver -scratch/main> move.term - -`move.term foo bar` renames `foo` to `bar`. - -``` -If a fuzzy resolver doesn't have any options available it should print a message instead of -opening an empty fuzzy-select. - -``` ucm -scratch/empty> view - -⚠️ - -Sorry, I was expecting an argument for the definition to view, and I couldn't find any to suggest to you. 😅 - -``` -``` unison -optionOne = 1 - -nested.optionTwo = 2 -``` - -Definition args - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - nested.optionTwo : ##Nat - optionOne : ##Nat - -scratch/main> debug.fuzzy-options view _ - - Select a definition to view: - * optionOne - * nested.optionTwo - -``` -Namespace args - -``` ucm -scratch/main> add - - ⊡ Ignored previously added definitions: nested.optionTwo - optionOne - -scratch/main> debug.fuzzy-options find-in _ - - Select a namespace: - * nested - -``` -Project Branch args - -``` ucm -myproject/main> branch mybranch - - Done. I've created the mybranch branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /mybranch`. - -scratch/main> debug.fuzzy-options switch _ - - Select a project or branch to switch to: - * myproject/main - * myproject/mybranch - * scratch/empty - * scratch/main - * myproject - * scratch - -``` diff --git a/unison-src/transcripts/generic-parse-errors.md b/unison-src/transcripts/generic-parse-errors.md deleted file mode 100644 index b22b2f039a..0000000000 --- a/unison-src/transcripts/generic-parse-errors.md +++ /dev/null @@ -1,26 +0,0 @@ -Just a bunch of random parse errors to test the error formatting. - -```unison:error -x = - foo.123 -``` - -```unison:error -namespace.blah = 1 -``` - -```unison:error -x = 1 ] -``` - -```unison:error -x = a.#abc -``` - -```unison:error -x = "hi -``` - -```unison:error -y : a -``` diff --git a/unison-src/transcripts/generic-parse-errors.output.md b/unison-src/transcripts/generic-parse-errors.output.md deleted file mode 100644 index 081548ea11..0000000000 --- a/unison-src/transcripts/generic-parse-errors.output.md +++ /dev/null @@ -1,127 +0,0 @@ -Just a bunch of random parse errors to test the error formatting. - -``` unison -x = - foo.123 -``` - -``` ucm - - Loading changes detected in scratch.u. - - I got confused here: - - 2 | foo.123 - - - I was surprised to find a 1 here. - I was expecting one of these instead: - - * end of input - * hash (ex: #af3sj3) - * identifier (ex: abba1, snake_case, .foo.bar#xyz, .foo.++#xyz, or 🌻) - -``` -``` unison -namespace.blah = 1 -``` - -``` ucm - - Loading changes detected in scratch.u. - - The identifier `namespace` used here is a reserved keyword: - - 1 | namespace.blah = 1 - - You can avoid this problem either by renaming the identifier - or wrapping it in backticks (like `namespace` ). - -``` -``` unison -x = 1 ] -``` - -``` ucm - - Loading changes detected in scratch.u. - - I found a closing ']' here without a matching '['. - - 1 | x = 1 ] - - -``` -``` unison -x = a.#abc -``` - -``` ucm - - Loading changes detected in scratch.u. - - I got confused here: - - 1 | x = a.#abc - - - I was surprised to find a '.' here. - I was expecting one of these instead: - - * and - * bang - * do - * false - * force - * handle - * if - * infixApp - * let - * newline or semicolon - * or - * quote - * termLink - * true - * tuple - * typeLink - -``` -``` unison -x = "hi -``` - -``` ucm - - Loading changes detected in scratch.u. - - I got confused here: - - 2 | - - I was surprised to find an end of input here. - I was expecting one of these instead: - - * " - * \s - * literal character - -``` -``` unison -y : a -``` - -``` ucm - - Loading changes detected in scratch.u. - - I got confused here: - - 2 | - - I was surprised to find an end of section here. - I was expecting one of these instead: - - * -> - * newline or semicolon - -``` diff --git a/unison-src/transcripts/hello.md b/unison-src/transcripts/hello.md index 4c72096ffa..7f5937a353 100644 --- a/unison-src/transcripts/hello.md +++ b/unison-src/transcripts/hello.md @@ -1,7 +1,6 @@ - # Hello! -```ucm:hide +``` ucm :hide scratch/main> builtins.merge ``` @@ -26,13 +25,13 @@ Take a look at [the elaborated output](hello.output.md) to see what this file lo In the `unison` fenced block, you can give an (optional) file name (defaults to `scratch.u`), like so: -```unison myfile.u +``` unison myfile.u x = 42 ``` Let's go ahead and add that to the codebase, then make sure it's there: -```ucm +``` ucm scratch/main> add scratch/main> view x ``` @@ -43,19 +42,19 @@ If `view` returned no results, the transcript would fail at this point. You may not always want to view the output of typechecking and evaluation every time, in which case, you can add `:hide` to the block. For instance: -```unison:hide +``` unison :hide y = 99 ``` This works for `ucm` blocks as well. -```ucm:hide +``` ucm :hide scratch/main> rename.term x answerToUltimateQuestionOfLife ``` -Doing `unison:hide:all` hides the block altogether, both input and output - this is useful for doing behind-the-scenes control of `ucm`'s state. +Doing `unison :hide:all` hides the block altogether, both input and output - this is useful for doing behind-the-scenes control of `ucm`'s state. -```unison:hide:all +``` unison :hide:all > [: you won't see me :] ``` @@ -63,7 +62,7 @@ Doing `unison:hide:all` hides the block altogether, both input and output - this Sometimes, you have a block which you are _expecting_ to fail, perhaps because you're illustrating how something would be a type error. Adding `:error` to the block will check for this. For instance, this program has a type error: -```unison:error +``` unison :error hmm : .builtin.Nat hmm = "Not, in fact, a number" ``` diff --git a/unison-src/transcripts/hello.output.md b/unison-src/transcripts/hello.output.md index b486a40213..c7564924b7 100644 --- a/unison-src/transcripts/hello.output.md +++ b/unison-src/transcripts/hello.output.md @@ -1,5 +1,9 @@ # Hello\! +``` ucm :hide +scratch/main> builtins.merge +``` + This markdown file is also a Unison transcript file. Transcript files are an easy way to create self-documenting Unison programs, libraries, and tutorials. The format is just a regular markdown file with some fenced code blocks that are typechecked and elaborated by `ucm`. For example, you can call this transcript via: @@ -21,78 +25,74 @@ Take a look at [the elaborated output](hello.output.md) to see what this file lo In the `unison` fenced block, you can give an (optional) file name (defaults to `scratch.u`), like so: -``` unison ---- -title: myfile.u ---- +``` unison myfile.u x = 42 - ``` -``` ucm - +``` ucm :added-by-ucm Loading changes detected in myfile.u. I found and typechecked these definitions in myfile.u. If you do an `add` or `update`, here's how your codebase would change: - + ⍟ These new definitions are ok to `add`: x : Nat - ``` + Let's go ahead and add that to the codebase, then make sure it's there: ``` ucm scratch/main> add ⍟ I've added these definitions: - + x : Nat scratch/main> view x x : Nat x = 42 - ``` + If `view` returned no results, the transcript would fail at this point. ## Hiding output You may not always want to view the output of typechecking and evaluation every time, in which case, you can add `:hide` to the block. For instance: -``` unison +``` unison :hide y = 99 ``` This works for `ucm` blocks as well. -Doing `unison:hide:all` hides the block altogether, both input and output - this is useful for doing behind-the-scenes control of `ucm`'s state. +``` ucm :hide +scratch/main> rename.term x answerToUltimateQuestionOfLife +``` + +Doing `unison :hide:all` hides the block altogether, both input and output - this is useful for doing behind-the-scenes control of `ucm`'s state. ## Expecting failures Sometimes, you have a block which you are *expecting* to fail, perhaps because you're illustrating how something would be a type error. Adding `:error` to the block will check for this. For instance, this program has a type error: -``` unison +``` unison :error hmm : .builtin.Nat hmm = "Not, in fact, a number" ``` -``` ucm - +``` ucm :added-by-ucm Loading changes detected in scratch.u. I found a value of type: Text where I expected to find: Nat - + 1 | hmm : .builtin.Nat 2 | hmm = "Not, in fact, a number" - + from right here: - - 2 | hmm = "Not, in fact, a number" - + 2 | hmm = "Not, in fact, a number" ``` diff --git a/unison-src/transcripts/help.md b/unison-src/transcripts/help.md deleted file mode 100644 index 79ffa1846d..0000000000 --- a/unison-src/transcripts/help.md +++ /dev/null @@ -1,14 +0,0 @@ -# Shows `help` output - -```ucm -scratch/main> help -scratch/main> help-topics -scratch/main> help-topic filestatus -scratch/main> help-topic messages.disallowedAbsolute -scratch/main> help-topic namespaces -scratch/main> help-topic projects -scratch/main> help-topic remotes -scratch/main> help-topic testcache -``` - -We should add a command to show help for hidden commands also. diff --git a/unison-src/transcripts/help.output.md b/unison-src/transcripts/help.output.md deleted file mode 100644 index 13f3c63820..0000000000 --- a/unison-src/transcripts/help.output.md +++ /dev/null @@ -1,998 +0,0 @@ -# Shows `help` output - -``` ucm -scratch/main> help - - add - `add` adds to the codebase all the definitions from the most recently typechecked file. - - add.preview - `add.preview` previews additions to the codebase from the most recently typechecked file. This command only displays cached typechecking results. Use `load` to reparse & typecheck the file if the context has changed. - - add.run - `add.run name` adds to the codebase the result of the most recent `run` command as `name`. - - alias.many (or copy) - `alias.many [relative2...] ` creates - aliases `relative1`, `relative2`, ... in the namespace - `namespace`. - `alias.many foo.foo bar.bar .quux` creates aliases - `.quux.foo.foo` and `.quux.bar.bar`. - - alias.term - `alias.term foo bar` introduces `bar` with the same definition as `foo`. - - alias.type - `alias.type Foo Bar` introduces `Bar` with the same definition as `Foo`. - - api - `api` provides details about the API. - - auth.login - Obtain an authentication session with Unison Share. - `auth.login`authenticates ucm with Unison Share. - - back (or popd) - `back` undoes the last `switch` command. - - branch (or branch.create, create.branch) - `branch foo` forks the current project branch to a new - branch `foo` - `branch /bar foo` forks the branch `bar` of the current - project to a new branch `foo` - - branch.empty (or branch.create-empty, create.empty-branch) - Create a new empty branch. - - branch.rename (or rename.branch) - `branch.rename foo` renames the current branch to `foo` - - branches (or list.branch, ls.branch, branch.list) - `branches` lists all branches in the current project - `branches foo` lists all branches in the project `foo` - - clear - `clear` Clears the screen. - - clone - `clone @unison/json/topic json/my-topic` creates - `json/my-topic` from - the remote branch - `@unison/json/topic` - `clone @unison/base base/` creates `base/main` - from the remote - branch - `@unison/base/main` - `clone @unison/base /main2` creates the branch - `main2` in the - current project from - the remote branch - `@unison/base/main` - `clone /main /main2` creates the branch - `main2` in the - current project from - the remote branch - `main` of the - current project's - associated remote - (see - `help-topics remotes`) - `clone /main my-fork/` creates - `my-fork/main` from - the branch `main` of - the current - project's associated - remote (see - `help-topics remotes`) - - compile (or compile.output) - `compile main file` Outputs a stand alone file that can be - directly loaded and executed by unison. - Said execution will have the effect of - running `!main`. - - create.author - `create.author alicecoder "Alice McGee"` creates `alicecoder` - values in `metadata.authors` and `metadata.copyrightHolders.` - - debug.clear-cache - Clear the watch expression cache - - debug.doc-to-markdown - `debug.doc-to-markdown term.doc` Render a doc to markdown. - - debug.doctor - Analyze your codebase for errors and inconsistencies. - - debug.dump-namespace - Dump the namespace to a text file - - debug.dump-namespace-simple - Dump the namespace to a text file - - debug.file - View details about the most recent successfully typechecked file. - - debug.find.global - `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'). - debug.find.global foo Iteratively searches all - projects and branches and - lists all definitions with a - name similar to 'foo'. Note - that this is a very slow - operation. - - debug.names.global - `debug.names.global foo` Iteratively search across all - projects and branches for names matching `foo`. Note that this - is expected to be quite slow and is primarily for debugging - issues with your codebase. - - debug.numberedArgs - Dump the contents of the numbered args state. - - delete - `delete foo` removes the term or type name `foo` from the namespace. - `delete foo bar` removes the term or type name `foo` and `bar` from the namespace. - - delete.branch (or branch.delete) - `delete.branch foo/bar` deletes the branch `bar` in the - project `foo` - `delete.branch /bar` deletes the branch `bar` in the - current project - - delete.namespace - `delete.namespace ` deletes the namespace `foo` - - delete.namespace.force - `delete.namespace.force ` deletes the namespace `foo`,deletion will proceed even if other code depends on definitions in foo. - - delete.project (or project.delete) - `delete.project foo` deletes the local project `foo` - - delete.term - `delete.term foo` removes the term name `foo` from the namespace. - `delete.term foo bar` removes the term name `foo` and `bar` from the namespace. - - delete.term.verbose - `delete.term.verbose foo` removes the term name `foo` from the namespace. - `delete.term.verbose foo bar` removes the term name `foo` and `bar` from the namespace. - - delete.type - `delete.type foo` removes the type name `foo` from the namespace. - `delete.type foo bar` removes the type name `foo` and `bar` from the namespace. - - delete.type.verbose - `delete.type.verbose foo` removes the type name `foo` from the namespace. - `delete.type.verbose foo bar` removes the type name `foo` and `bar` from the namespace. - - delete.verbose - `delete.verbose foo` removes the term or type name `foo` from the namespace. - `delete.verbose foo bar` removes the term or type name `foo` and `bar` from the namespace. - - dependencies - List the dependencies of the specified definition. - - dependents - List the named dependents of the specified definition. - - deprecated.cd (or deprecated.namespace) - Moves your perspective to a different namespace. Deprecated for now because too many important things depend on your perspective selection. - - `deprecated.cd foo.bar` descends into foo.bar from the - current namespace. - `deprecated.cd .cat.dog` sets the current namespace to the - absolute namespace .cat.dog. - `deprecated.cd ..` moves to the parent of the current - namespace. E.g. moves from - '.cat.dog' to '.cat' - `deprecated.cd` invokes a search to select which - namespace to move to, which requires - that `fzf` can be found within your - PATH. - - deprecated.root-reflog - `deprecated.root-reflog` lists the changes that have affected the root namespace. This has been deprecated in favor of `reflog` which shows the reflog for the current project. - - diff.namespace - `diff.namespace before after` shows how the namespace `after` - differs from the namespace - `before` - `diff.namespace before` shows how the current namespace - differs from the namespace - `before` - - display - `display foo` prints a rendered version of the term `foo`. - `display` without arguments invokes a search to select a definition to display, which requires that `fzf` can be found within your PATH. - - display.to - `display.to foo` prints a rendered version of the - term `foo` to the given file. - - docs - `docs foo` shows documentation for the definition `foo`. - `docs` without arguments invokes a search to select which definition to view documentation for, which requires that `fzf` can be found within your PATH. - - docs.to-html - `docs.to-html .path.to.ns doc-dir` Render - all docs - contained - within - the - namespace - `.path.to.ns`, - no matter - how deep, - to html - files in - `doc-dir` - in the - directory - UCM was - run from. - `docs.to-html project0/branch0:a.path /tmp/doc-dir` Renders - all docs - anywhere - in the - namespace - `a.path` - from - `branch0` - of - `project0` - to html - in - `/tmp/doc-dir`. - - edit - `edit foo` prepends the definition of `foo` to the top of the most recently saved file. - `edit` without arguments invokes a search to select a definition for editing, which requires that `fzf` can be found within your PATH. - - edit.namespace - `edit.namespace` will load all terms and types contained within the current namespace into your scratch file. This includes definitions in namespaces, but excludes libraries. - `edit.namespace ns1 ns2 ...` loads the terms and types contained within the provided namespaces. - - find - `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'). - debug.find.global foo Iteratively searches all - projects and branches and - lists all definitions with a - name similar to 'foo'. Note - that this is a very slow - operation. - - find-in - `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'). - debug.find.global foo Iteratively searches all - projects and branches and - lists all definitions with a - name similar to 'foo'. Note - that this is a very slow - operation. - - find-in.all - `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'). - debug.find.global foo Iteratively searches all - projects and branches and - lists all definitions with a - name similar to 'foo'. Note - that this is a very slow - operation. - - find.all - `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'). - debug.find.global foo Iteratively searches all - projects and branches and - lists all definitions with a - name similar to 'foo'. Note - that this is a very slow - operation. - - find.all.verbose - `find.all.verbose` searches for definitions like `find.all`, but includes hashes and aliases in the results. - - find.verbose - `find.verbose` searches for definitions like `find`, but includes hashes and aliases in the results. - - fork (or copy.namespace) - `fork src dest` creates - the - namespace - `dest` as - a copy of - `src`. - `fork project0/branch0:a.path project1/branch1:foo` creates - the - namespace - `foo` in - `branch1` - of - `project1` - as a copy - of - `a.path` - in - `project0/branch0`. - `fork srcproject/srcbranch dest` creates - the - namespace - `dest` as - a copy of - the - branch - `srcbranch` - of - `srcproject`. - - help (or ?) - `help` shows general help and `help ` shows help for one command. - - help-topics (or help-topic) - `help-topics` lists all topics and `help-topics ` shows an explanation of that topic. - - history - `history` Shows the history of the current - path. - `history .foo` Shows history of the path .foo. - `history #9dndk3kbsk13nbpeu` Shows the history of the - namespace with the given hash. - The full hash must be provided. - - io.test (or test.io) - `io.test mytest` Runs `!mytest`, where `mytest` is a delayed - test that can use the `IO` and `Exception` - abilities. - - io.test.all (or test.io.all) - `io.test.all` runs unit tests for the current branch that use - IO - - lib.install (or install.lib) - The `lib.install` command installs a dependency into the `lib` - namespace. - - `lib.install @unison/base/releases/latest` installs the - latest release of - `@unison/base` - `lib.install @unison/base/releases/3.0.0` installs version - 3.0.0 of - `@unison/base` - `lib.install @unison/base/topic` installs the - `topic` branch of - `@unison/base` - - list (or ls, dir) - `list` lists definitions and namespaces at the current - level of the current namespace. - `list foo` lists the 'foo' namespace. - `list .foo` lists the '.foo' namespace. - - load - `load` parses, typechecks, and evaluates the - most recent scratch file. - `load ` parses, typechecks, and evaluates the - given scratch file. - - merge - `merge /branch` merges `branch` into the current branch - - merge.commit (or commit.merge) - `merge.commit` merges a temporary branch created by the - `merge` command back into its parent branch, and removes the - temporary branch. - - For example, if you've done `merge topic` from main, then - `merge.commit` is equivalent to doing - - * switch /main - * merge /merge-topic-into-main - * delete.branch /merge-topic-into-main - - move (or rename) - `move foo bar` renames the term, type, and namespace foo to bar. - - move.namespace (or rename.namespace) - `move.namespace foo bar` renames the path `foo` to `bar`. - - move.term (or rename.term) - `move.term foo bar` renames `foo` to `bar`. - - move.type (or rename.type) - `move.type foo bar` renames `foo` to `bar`. - - names - `names foo` List all known names for `foo` in the current - branch. - - namespace.dependencies - List the external dependencies of the specified namespace. - - project.create (or create.project) - `project.create` creates a project with a random name - `project.create foo` creates a project named `foo` - - project.reflog (or reflog.project) - `project.reflog` lists all the changes that have affected any branches in the current project. - `project.reflog myproject` lists all the changes that have affected any branches in myproject. - - project.rename (or rename.project) - `project.rename foo` renames the current project to `foo` - - projects (or list.project, ls.project, project.list) - List projects. - - pull - The `pull` command merges a remote namespace into a local - branch - - `pull @unison/base/main` merges the branch - `main` of the Unison - Share hosted project - `@unison/base` into - the current branch - `pull @unison/base/main my-base/topic` merges the branch - `main` of the Unison - Share hosted project - `@unison/base` into - the branch `topic` of - the local `my-base` - project - - where `remote` is a project or project branch, such as: - Project (defaults to the /main branch) `@unison/base` - Project Branch `@unison/base/feature` - Contributor Branch `@unison/base/@johnsmith/feature` - Project Release `@unison/base/releases/1.0.0` - - pull.without-history - The `pull.without-history` command merges a remote namespace - into a local branch without including the remote's history. - This usually results in smaller codebase sizes. - - `pull.without-history @unison/base/main` merges - the - branch - `main` - of the - Unison - Share - hosted - project - `@unison/base` - into - the - current - branch - `pull.without-history @unison/base/main my-base/topic` merges - the - branch - `main` - of the - Unison - Share - hosted - project - `@unison/base` - into - the - branch - `topic` - of the - local - `my-base` - project - - where `remote` is a project or project branch, such as: - Project (defaults to the /main branch) `@unison/base` - Project Branch `@unison/base/feature` - Contributor Branch `@unison/base/@johnsmith/feature` - Project Release `@unison/base/releases/1.0.0` - - push - The `push` command merges a local project or namespace into a - remote project or namespace. - - `push ` publishes the contents of a local - namespace or branch into a remote - namespace or branch. - `push ` publishes the current namespace or - branch into a remote namespace or - branch - `push` publishes the current namespace or - branch. Remote mappings for - namespaces are configured in your - `.unisonConfig` at the key - `RemoteMappings.` where - `` is the current - namespace. Remote mappings for - branches default to the branch that - you cloned from or pushed to - initially. Otherwise, it is pushed to - @/ - - where `remote` is a project or project branch, such as: - Project (defaults to the /main branch) `@unison/base` - Project Branch `@unison/base/feature` - Contributor Branch `@unison/base/@johnsmith/feature` - - push.create - The `push.create` command pushes a local namespace to an empty - remote namespace. - - `push.create remote local` pushes the contents of the local - namespace `local` into the empty - remote namespace `remote`. - `push.create remote` publishes the current namespace - into the empty remote namespace - `remote` - `push.create` publishes the current namespace - into the remote namespace - configured in your `.unisonConfig` - at the key - `RemoteMappings.` where - `` is the current - namespace, then publishes the - current namespace to that - location. - - where `remote` is a project or project branch, such as: - Project (defaults to the /main branch) `@unison/base` - Project Branch `@unison/base/feature` - Contributor Branch `@unison/base/@johnsmith/feature` - - quit (or exit, :q) - Exits the Unison command line interface. - - reflog (or reflog.branch, branch.reflog) - `reflog` lists all the changes that have affected the current branch. - `reflog /mybranch` lists all the changes that have affected /mybranch. - - reflog.global - `reflog.global` lists all recent changes across all projects and branches. - - release.draft (or draft.release) - Draft a release. - - reset - `reset #pvfd222s8n` reset the current namespace to the - hash `#pvfd222s8n` - `reset foo` reset the current namespace to the - state of the `foo` namespace. - `reset #pvfd222s8n /topic` reset the branch `topic` of the - current project to the causal - `#pvfd222s8n`. - - If you make a mistake using reset, consult the `reflog` - command and use another `reset` command to return to a - previous state. - - rewrite (or sfind.replace) - `rewrite rule1` rewrites definitions in the latest scratch file. - - The argument `rule1` must refer to a `@rewrite` block or a - function that immediately returns a `@rewrite` block. It can - be in the codebase or scratch file. An example: - - rule1 x = @rewrite term x + 1 ==> Nat.increment x - - Here, `x` will stand in for any expression wherever this - rewrite is applied, so this rule will match `(42+10+11) + 1` - and replace it with `Nat.increment (42+10+11)`. - - See https://unison-lang.org/learn/structured-find to learn more. - - Also see the related command `rewrite.find` - - rewrite.find (or sfind) - `rewrite.find rule1` finds definitions that match any of the - left side(s) of `rule` in the current namespace. - - The argument `rule1` must refer to a `@rewrite` block or a - function that immediately returns a `@rewrite` block. It can - be in the codebase or scratch file. An example: - - -- right of ==> is ignored by this command - rule1 x = @rewrite term x + 1 ==> () - - Here, `x` will stand in for any expression, so this rule will - match `(42+10+11) + 1`. - - See https://unison-lang.org/learn/structured-find to learn more. - - Also see the related command `rewrite` - - run - `run mymain args...` Runs `!mymain`, where `mymain` is - searched for in the most recent - typechecked file, or in the codebase. - Any provided arguments will be passed as - program arguments as though they were - provided at the command line when - running mymain as an executable. - - run.native - `run.native main args` Executes !main using native - compilation via scheme. - - switch - `switch` opens an interactive selector to pick a - project and branch - `switch foo/bar` switches to the branch `bar` in the project - `foo` - `switch foo/` switches to the last branch you visited in - the project `foo` - `switch /bar` switches to the branch `bar` in the current - project - - test - `test` runs unit tests for the current branch - `test foo` runs unit tests for the current branch defined in - namespace `foo` - - test.all - `test.all` runs unit tests for the current branch (including the `lib` namespace). - - todo - `todo` lists the current namespace's outstanding issues, - including conflicted names, dependencies with missing names, - and merge precondition violations. - - ui - `ui` opens the Local UI in the default browser. - - undo - `undo` reverts the most recent change to the codebase. - - update - Adds everything in the most recently typechecked file to the - namespace, replacing existing definitions having the same - name, and attempts to update all the existing dependents - accordingly. If the process can't be completed automatically, - the dependents will be added back to the scratch file for your - review. - - update.old - `update.old` works like `add`, except that if a definition in - the file has the same name as an existing definition, the name - gets updated to point to the new definition. If the old - definition has any dependents, `update` will add those - dependents to a refactoring session, specified by an optional - patch.`update.old` adds all definitions in - the .u file, noting replacements - in the default patch for the - current namespace. - `update.old ` adds all definitions in the .u - file, noting replacements in the - specified patch. - `update.old foo bar` adds `foo`, `bar`, and their - dependents from the .u file, - noting any replacements into the - specified patch. - - update.old.nopatch - `update.old.nopatch` works like `update.old`, except it - doesn't add a patch entry for any updates. Use this when you - want to make changes to definitions without pushing those - changes to dependents beyond your codebase. An example is when - updating docs, or when updating a term you just added.`update.old.nopatch` updates - all definitions in the .u file. - `update.old.nopatch foo bar` updates `foo`, `bar`, and their - dependents from the .u file. - - update.old.preview - `update.old.preview` previews updates to the codebase from the most recently typechecked file. This command only displays cached typechecking results. Use `load` to reparse & typecheck the file if the context has changed. - - upgrade - `upgrade old new` upgrades library dependency `lib.old` to - `lib.new`, and, if successful, deletes `lib.old`. - - upgrade.commit (or commit.upgrade) - `upgrade.commit` merges a temporary branch created by the - `upgrade` command back into its parent branch, and removes the - temporary branch. - - For example, if you've done `upgrade foo bar` from main, then - `upgrade.commit` is equivalent to doing - - * switch /main - * merge /upgrade-foo-to-bar - * delete.branch /upgrade-foo-to-bar - - version - Print the version of unison you're running - - view - `view foo` shows definitions named `foo` within your current - namespace. - `view` without arguments invokes a search to select - definitions to view, which requires that `fzf` can be found - within your PATH. - - Supports glob syntax, where ? acts a wildcard, so - `view List.?` will show `List.map`, `List.filter`, etc, but - not `List.map.doc` (since ? only matches 1 name segment). - - view.global - `view.global foo` prints definitions of `foo` within your codebase. - `view.global` without arguments invokes a search to select definitions to view, which requires that `fzf` can be found within your PATH. - -scratch/main> help-topics - - 🌻 - - Here's a list of topics I can tell you more about: - - filestatus - messages.disallowedAbsolute - namespaces - projects - remotes - testcache - - Example: use `help-topics filestatus` to learn more about that topic. - -scratch/main> help-topic filestatus - - 📓 - - Here's a list of possible status messages you might see for - definitions in a .u file. - - needs update A definition with the same name as an - existing definition. Doing `update` - instead of `add` will turn this failure - into a successful update. - - term/ctor collision A definition with the same name as an - existing constructor for some data type. - Rename your definition or the data type - before trying again to `add` or `update`. - - ctor/term collision A type defined in the file has a - constructor that's named the same as an - existing term. Rename that term or your - constructor before trying again to `add` - or `update`. - - blocked This definition was blocked because it - dependended on a definition with a failed - status. - - extra dependency This definition was added because it was - a dependency of a definition explicitly - selected. - -scratch/main> help-topic messages.disallowedAbsolute - - 🤖 - - Although I can understand absolute (ex: .foo.bar) or relative - (ex: util.math.sqrt) references to existing definitions - (help namespaces to learn more), I can't yet handle giving new - definitions with absolute names in a .u file. - - As a workaround, you can give definitions with a relative name - temporarily (like `exports.blah.foo`) and then use `move.*`. - -scratch/main> help-topic namespaces - - 🧐 - - There are two kinds of namespaces, absolute, such as (.foo.bar - or .base.math.+) and relative, such as (math.sqrt or - util.List.++). - - Relative names are converted to absolute names by prepending - the current namespace. For example, if your Unison prompt - reads: - - .foo.bar> - - and your .u file looks like: - - x = 41 - - then doing an add will create the definition with the absolute - name .foo.bar.x = 41 - - and you can refer to x by its absolute name .foo.bar.x - elsewhere in your code. For instance: - - answerToLifeTheUniverseAndEverything = .foo.bar.x + 1 - -scratch/main> help-topic projects - - A project is a versioned collection of code that can be - edited, published, and depended on other projects. Unison - projects are analogous to Git repositories. - - project.create create a new project - projects list all your projects - branch create a new workstream - branches list all your branches - merge merge one branch into another - switch switch to a project or branch - push upload your changes to Unison Share - pull download code(/changes/updates) from Unison Share - clone download a Unison Share project or branch for contribution - - Tip: Use `help project.create` to learn more. - - For full documentation, see - https://unison-lang.org/learn/projects - -scratch/main> help-topic remotes - - 🤖 - - Local projects may be associated with at most one remote - project on Unison Share. When this relationship is - established, it becomes the default argument for a number of - share commands. For example, running `push` or `pull` in a - project with no arguments will push to or pull from the - associated remote, if it exists. - - This association is created automatically on when a project is - created by `clone`. If the project was created locally then - the relationship will be established on the first `push`. - -scratch/main> help-topic testcache - - 🎈 - - Unison caches the results of test> watch expressions. Since - these expressions are pure and always yield the same result - when evaluated, there's no need to run them more than once! - - A test is rerun only if it has changed, or if one of the - definitions it depends on has changed. - -``` -We should add a command to show help for hidden commands also. - diff --git a/unison-src/transcripts/higher-rank.md b/unison-src/transcripts/higher-rank.md deleted file mode 100644 index bf9efcf678..0000000000 --- a/unison-src/transcripts/higher-rank.md +++ /dev/null @@ -1,82 +0,0 @@ - -This transcript does some testing of higher-rank types. Regression tests related to higher-rank types can be added here. - -```ucm:hide -scratch/main> alias.type ##Nat Nat -scratch/main> alias.type ##Text Text -scratch/main> alias.type ##IO IO -``` - -In this example, a higher-rank function is defined, `f`. No annotation is needed at the call-site of `f`, because the lambda is being checked against the polymorphic type `forall a . a -> a`, rather than inferred: - -```unison -f : (forall a . a -> a) -> (Nat, Text) -f id = (id 1, id "hi") - -> f (x -> x) -``` - -Another example, involving abilities. Here the ability-polymorphic function is instantiated with two different ability lists, `{}` and `{IO}`: - -```unison -f : (forall a g . '{g} a -> '{g} a) -> () -> () -f id _ = - _ = (id ('1 : '{} Nat), id ('("hi") : '{IO} Text)) - () -``` - -Here's an example, showing that polymorphic functions can be fields of a constructor, and the functions remain polymorphic even when the field is bound to a name during pattern matching: - -```unison -unique type Functor f = Functor (forall a b . (a -> b) -> f a -> f b) - -Functor.map : Functor f -> (forall a b . (a -> b) -> f a -> f b) -Functor.map = cases Functor f -> f - -Functor.blah : Functor f -> () -Functor.blah = cases Functor f -> - g : forall a b . (a -> b) -> f a -> f b - g = f - () -``` - -This example is similar, but involves abilities: - -```unison -unique ability Remote t where doRemoteStuff : t () -unique type Loc = Loc (forall t a . '{Remote t} a ->{Remote t} t a) - -Loc.blah : Loc -> () -Loc.blah = cases Loc f -> - f0 : '{Remote tx} ax ->{Remote tx} tx ax - f0 = f - () - --- In this case, no annotation is needed since the lambda --- is checked against a polymorphic type -Loc.transform : (forall t a . '{Remote t} a -> '{Remote t} a) - -> Loc -> Loc -Loc.transform nt = cases Loc f -> Loc (a -> f (nt a)) - --- In this case, the annotation is needed since f' is inferred --- on its own it won't infer the higher-rank type -Loc.transform2 : (forall t a . '{Remote t} a -> '{Remote t} a) - -> Loc -> Loc -Loc.transform2 nt = cases Loc f -> - f' : forall t a . '{Remote t} a ->{Remote t} t a - f' a = f (nt a) - Loc f' -``` - -## Types with polymorphic fields - -```unison:hide -structural type HigherRanked = HigherRanked (forall a. a -> a) -``` - -We should be able to add and view records with higher-rank fields. - -```ucm -scratch/main> add -scratch/main> view HigherRanked -``` diff --git a/unison-src/transcripts/higher-rank.output.md b/unison-src/transcripts/higher-rank.output.md deleted file mode 100644 index 449617d84f..0000000000 --- a/unison-src/transcripts/higher-rank.output.md +++ /dev/null @@ -1,153 +0,0 @@ -This transcript does some testing of higher-rank types. Regression tests related to higher-rank types can be added here. - -In this example, a higher-rank function is defined, `f`. No annotation is needed at the call-site of `f`, because the lambda is being checked against the polymorphic type `forall a . a -> a`, rather than inferred: - -``` unison -f : (forall a . a -> a) -> (Nat, Text) -f id = (id 1, id "hi") - -> f (x -> x) -``` - -``` 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`: - - f : (∀ a. a ->{g} a) ->{g} (Nat, Text) - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 4 | > f (x -> x) - ⧩ - (1, "hi") - -``` -Another example, involving abilities. Here the ability-polymorphic function is instantiated with two different ability lists, `{}` and `{IO}`: - -``` unison -f : (forall a g . '{g} a -> '{g} a) -> () -> () -f id _ = - _ = (id ('1 : '{} Nat), id ('("hi") : '{IO} Text)) - () -``` - -``` 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`: - - f : (∀ a g. '{g} a ->{h} '{g} a) -> '{h} () - -``` -Here's an example, showing that polymorphic functions can be fields of a constructor, and the functions remain polymorphic even when the field is bound to a name during pattern matching: - -``` unison -unique type Functor f = Functor (forall a b . (a -> b) -> f a -> f b) - -Functor.map : Functor f -> (forall a b . (a -> b) -> f a -> f b) -Functor.map = cases Functor f -> f - -Functor.blah : Functor f -> () -Functor.blah = cases Functor f -> - g : forall a b . (a -> b) -> f a -> f b - g = f - () -``` - -``` 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`: - - type Functor f - Functor.blah : Functor f -> () - Functor.map : Functor f - -> (∀ a b. (a -> b) -> f a -> f b) - -``` -This example is similar, but involves abilities: - -``` unison -unique ability Remote t where doRemoteStuff : t () -unique type Loc = Loc (forall t a . '{Remote t} a ->{Remote t} t a) - -Loc.blah : Loc -> () -Loc.blah = cases Loc f -> - f0 : '{Remote tx} ax ->{Remote tx} tx ax - f0 = f - () - --- In this case, no annotation is needed since the lambda --- is checked against a polymorphic type -Loc.transform : (forall t a . '{Remote t} a -> '{Remote t} a) - -> Loc -> Loc -Loc.transform nt = cases Loc f -> Loc (a -> f (nt a)) - --- In this case, the annotation is needed since f' is inferred --- on its own it won't infer the higher-rank type -Loc.transform2 : (forall t a . '{Remote t} a -> '{Remote t} a) - -> Loc -> Loc -Loc.transform2 nt = cases Loc f -> - f' : forall t a . '{Remote t} a ->{Remote t} t a - f' a = f (nt a) - Loc f' -``` - -``` 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`: - - type Loc - ability Remote t - Loc.blah : Loc -> () - Loc.transform : (∀ t a. '{Remote t} a -> '{Remote t} a) - -> Loc - -> Loc - Loc.transform2 : (∀ t a. '{Remote t} a -> '{Remote t} a) - -> Loc - -> Loc - -``` -## Types with polymorphic fields - -``` unison -structural type HigherRanked = HigherRanked (forall a. a -> a) -``` - -We should be able to add and view records with higher-rank fields. - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - structural type HigherRanked - -scratch/main> view HigherRanked - - structural type HigherRanked = HigherRanked (∀ a. a -> a) - -``` diff --git a/unison-src/transcripts/abilities.md b/unison-src/transcripts/idempotent/abilities.md similarity index 81% rename from unison-src/transcripts/abilities.md rename to unison-src/transcripts/idempotent/abilities.md index a45ee504dd..20d0f9745b 100644 --- a/unison-src/transcripts/abilities.md +++ b/unison-src/transcripts/idempotent/abilities.md @@ -1,11 +1,10 @@ - -```ucm:hide +``` ucm :hide scratch/main> builtins.merge ``` Some random ability stuff to ensure things work. -```unison +``` unison :hide unique ability A where one : Nat ->{A} Nat @@ -22,6 +21,11 @@ ha = cases { four i -> c } -> handle c (j k l -> i+j+k+l) with ha ``` -```ucm +``` ucm scratch/main> add + + ⍟ I've added these definitions: + + ability A + ha : Request {A} r -> r ``` diff --git a/unison-src/transcripts/idempotent/ability-order-doesnt-affect-hash.md b/unison-src/transcripts/idempotent/ability-order-doesnt-affect-hash.md new file mode 100644 index 0000000000..3656daaba2 --- /dev/null +++ b/unison-src/transcripts/idempotent/ability-order-doesnt-affect-hash.md @@ -0,0 +1,32 @@ +The order of a set of abilities is normalized before hashing. + +``` unison :hide +unique ability Foo where + foo : () + +unique ability Bar where + bar : () + +term1 : () ->{Foo, Bar} () +term1 _ = () + +term2 : () ->{Bar, Foo} () +term2 _ = () +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + ability Bar + ability Foo + term1 : '{Bar, Foo} () + term2 : '{Bar, Foo} () + +scratch/main> names term1 + + Term + Hash: #8hum58rlih + Names: term1 term2 +``` diff --git a/unison-src/transcripts/idempotent/ability-term-conflicts-on-update.md b/unison-src/transcripts/idempotent/ability-term-conflicts-on-update.md new file mode 100644 index 0000000000..83ecb5c59d --- /dev/null +++ b/unison-src/transcripts/idempotent/ability-term-conflicts-on-update.md @@ -0,0 +1,230 @@ +# Regression test for updates which conflict with an existing ability constructor + +https://github.com/unisonweb/unison/issues/2786 + +``` ucm :hide +scratch/main> builtins.merge lib.builtins +``` + +First we add an ability to the codebase. +Note that this will create the name `Channels.send` as an ability constructor. + +``` unison +unique ability Channels where + send : a -> {Channels} () +``` + +``` ucm :added-by-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`: + + ability Channels +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + ability Channels +``` + +Now we update the ability, changing the name of the constructor, *but*, we simultaneously +add a new top-level term with the same name as the constructor which is being +removed from Channels. + +``` unison +unique ability Channels where + sends : [a] -> {Channels} () + +Channels.send : a -> () +Channels.send a = () + +thing : '{Channels} () +thing _ = send 1 +``` + +``` ucm :added-by-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`: + + Channels.send : a -> () + thing : '{Channels} () + + ⍟ These names already exist. You can `update` them to your + new definition: + + ability Channels +``` + +These should fail with a term/ctor conflict since we exclude the ability from the update. + +``` ucm :error +scratch/main> update.old patch Channels.send + + x These definitions failed: + + Reason + term/ctor collision Channels.send : a -> () + + Tip: Use `help filestatus` to learn more. + +scratch/main> update.old patch thing + + ⍟ I've added these definitions: + + Channels.send : a -> () + thing : '{Channels} () + + ⍟ I've updated these names to your new definition: + + ability Channels +``` + +If however, `Channels.send` and `thing` *depend* on `Channels`, updating them should succeed since it pulls in the ability as a dependency. + +``` unison +unique ability Channels where + sends : [a] -> {Channels} () + +Channels.send : a -> () +Channels.send a = sends [a] + +thing : '{Channels} () +thing _ = send 1 +``` + +``` ucm :added-by-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: + + ⊡ Previously added definitions will be ignored: Channels + + ⍟ These names already exist. You can `update` them to your + new definition: + + Channels.send : a ->{Channels} () + thing : '{Channels} () +``` + +These updates should succeed since `Channels` is a dependency. + +``` ucm +scratch/main> update.old.preview patch Channels.send + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⊡ Previously added definitions will be ignored: Channels + + ⍟ These names already exist. You can `update` them to your + new definition: + + Channels.send : a ->{Channels} () + +scratch/main> update.old.preview patch thing + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⊡ Previously added definitions will be ignored: Channels + + ⍟ These names already exist. You can `update` them to your + new definition: + + Channels.send : a ->{Channels} () + thing : '{Channels} () +``` + +We should also be able to successfully update the whole thing. + +``` ucm +scratch/main> update.old + + ⊡ Ignored previously added definitions: Channels + + ⍟ I've updated these names to your new definition: + + Channels.send : a ->{Channels} () + thing : '{Channels} () +``` + +# Constructor-term conflict + +``` ucm :hide +scratch/main2> builtins.merge lib.builtins +``` + +``` unison +X.x = 1 +``` + +``` ucm :added-by-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`: + + X.x : Nat +``` + +``` ucm +scratch/main2> add + + ⍟ I've added these definitions: + + X.x : Nat +``` + +``` unison +structural ability X where + x : () +``` + +``` ucm :added-by-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: + + x These definitions would fail on `add` or `update`: + + Reason + blocked structural ability X + ctor/term collision X.x + + Tip: Use `help filestatus` to learn more. +``` + +This should fail with a ctor/term conflict. + +``` ucm :error +scratch/main2> add + + x These definitions failed: + + Reason + blocked structural ability X + ctor/term collision X.x + + Tip: Use `help filestatus` to learn more. +``` diff --git a/unison-src/transcripts/idempotent/add-run.md b/unison-src/transcripts/idempotent/add-run.md new file mode 100644 index 0000000000..46e1ffccfc --- /dev/null +++ b/unison-src/transcripts/idempotent/add-run.md @@ -0,0 +1,244 @@ +# add.run + +## Basic usage + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison :hide +even : Nat -> Boolean +even x = if x == 0 then true else odd (drop x 1) + +odd : Nat -> Boolean +odd x = if x == 0 then false else even (drop x 1) + +is2even : 'Boolean +is2even = '(even 2) +``` + +it errors if there isn't a previous run + +``` ucm :error +scratch/main> add.run foo + + ⚠️ + + There is no previous evaluation to save. Use `run` to evaluate + something before attempting to save it. +``` + +``` ucm +scratch/main> run is2even + + true +``` + +it errors if the desired result name conflicts with a name in the +unison file + +``` ucm :error +scratch/main> add.run is2even + + ⚠️ + + Cannot save the last run result into `is2even` because that + name conflicts with a name in the scratch file. +``` + +otherwise, the result is successfully persisted + +``` ucm +scratch/main> add.run foo.bar.baz + + ⍟ I've added these definitions: + + foo.bar.baz : Boolean +``` + +``` ucm +scratch/main> view foo.bar.baz + + foo.bar.baz : Boolean + foo.bar.baz = true +``` + +## It resolves references within the unison file + +``` unison +z b = b Nat.+ 12 +y a b = a Nat.+ b Nat.+ z 10 + + + + +main : '{IO, Exception} (Nat -> Nat -> Nat) +main _ = y +``` + +``` ucm :added-by-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`: + + main : '{IO, Exception} (Nat -> Nat -> Nat) + y : Nat -> Nat -> Nat + z : Nat -> Nat +``` + +``` ucm +scratch/main> run main + + a b -> a Nat.+ b Nat.+ z 10 + +scratch/main> add.run result + + ⍟ I've added these definitions: + + result : Nat -> Nat -> Nat + z : Nat -> Nat +``` + +## It resolves references within the codebase + +``` unison +inc : Nat -> Nat +inc x = x + 1 +``` + +``` ucm :added-by-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`: + + inc : Nat -> Nat +``` + +``` ucm +scratch/main> add inc + + ⍟ I've added these definitions: + + inc : Nat -> Nat +``` + +``` unison :hide +main : '(Nat -> Nat) +main _ x = inc x +``` + +``` ucm +scratch/main> run main + + inc + +scratch/main> add.run natfoo + + ⍟ I've added these definitions: + + natfoo : Nat -> Nat + +scratch/main> view natfoo + + natfoo : Nat -> Nat + natfoo = inc +``` + +## It captures scratch file dependencies at run time + +``` unison +x = 1 +y = x + x +main = 'y +``` + +``` ucm :added-by-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`: + + main : 'Nat + x : Nat + y : Nat +``` + +``` ucm +scratch/main> run main + + 2 +``` + +``` unison :hide +x = 50 +``` + +this saves 2 to xres, rather than 100 + +``` ucm +scratch/main> add.run xres + + ⍟ I've added these definitions: + + xres : Nat + +scratch/main> view xres + + xres : Nat + xres = 2 +``` + +## It fails with a message if add cannot complete cleanly + +``` unison :hide +main = '5 +``` + +``` ucm :error +scratch/main> run main + + 5 + +scratch/main> add.run xres + + x These definitions failed: + + Reason + needs update xres : Nat + + Tip: Use `help filestatus` to learn more. +``` + +## It works with absolute names + +``` unison :hide +main = '5 +``` + +``` ucm +scratch/main> run main + + 5 + +scratch/main> add.run .an.absolute.name + + ⍟ I've added these definitions: + + .an.absolute.name : Nat + +scratch/main> view .an.absolute.name + + .an.absolute.name : Nat + .an.absolute.name = 5 +``` diff --git a/unison-src/transcripts/idempotent/add-test-watch-roundtrip.md b/unison-src/transcripts/idempotent/add-test-watch-roundtrip.md new file mode 100644 index 0000000000..846cd1537d --- /dev/null +++ b/unison-src/transcripts/idempotent/add-test-watch-roundtrip.md @@ -0,0 +1,24 @@ +``` ucm :hide +scratch/main> builtins.mergeio +``` + +``` unison :hide +test> foo : [Test.Result] +foo = [] +``` + +Apparently when we add a test watch, we add a type annotation to it, even if it already has one. We don't want this to happen though\! + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + foo : [Result] + +scratch/main> view foo + + foo : [Result] + foo : [Result] + foo = [] +``` diff --git a/unison-src/transcripts/idempotent/addupdatemessages.md b/unison-src/transcripts/idempotent/addupdatemessages.md new file mode 100644 index 0000000000..a91b32bfa3 --- /dev/null +++ b/unison-src/transcripts/idempotent/addupdatemessages.md @@ -0,0 +1,152 @@ +# Adds and updates + +Let's set up some definitions to start: + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +x = 1 +y = 2 + +structural type X = One Nat +structural type Y = Two Nat Nat +``` + +``` ucm :added-by-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`: + + structural type X + structural type Y + x : Nat + y : Nat +``` + +Expected: `x` and `y`, `X`, and `Y` exist as above. UCM tells you this. + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural type X + structural type Y + x : Nat + y : Nat +``` + +Let's add an alias for `1` and `One`: + +``` unison +z = 1 + +structural type Z = One Nat +``` + +``` ucm :added-by-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`: + + structural type Z + (also named X) + z : Nat + (also named x) +``` + +Expected: `z` is now `1`. UCM tells you that this definition is also called `x`. +Also, `Z` is an alias for `X`. + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural type Z + (also named X) + z : Nat + (also named x) +``` + +Let's update something that has an alias (to a value that doesn't have a name already): + +``` unison +x = 3 +structural type X = Three Nat Nat Nat +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + structural type X + (The old definition is also named Z.) + x : Nat + (The old definition is also named z.) +``` + +Expected: `x` is now `3` and `X` has constructor `Three`. UCM tells you the old definitions were also called `z` and `Z` and these names have also been updated. + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. +``` + +Update it to something that already exists with a different name: + +``` unison +x = 2 +structural type X = Two Nat Nat +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + structural type X + (also named Y) + x : Nat + (also named y) +``` + +Expected: `x` is now `2` and `X` is `Two`. UCM says the old definition was also named `z/Z`, and was also updated. And it says the new definition is also named `y/Y`. + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. +``` diff --git a/unison-src/transcripts/idempotent/alias-term.md b/unison-src/transcripts/idempotent/alias-term.md new file mode 100644 index 0000000000..553afa52b3 --- /dev/null +++ b/unison-src/transcripts/idempotent/alias-term.md @@ -0,0 +1,47 @@ +`alias.term` makes a new name for a term. + +``` ucm :hide +project/main> builtins.mergeio lib.builtins +``` + +``` ucm +project/main> alias.term lib.builtins.bug foo + + Done. + +project/main> ls + + 1. foo (a -> b) + 2. lib/ (643 terms, 92 types) +``` + +It won't create a conflicted name, though. + +``` ucm :error +project/main> alias.term lib.builtins.todo foo + + ⚠️ + + A term by that name already exists. +``` + +``` ucm +project/main> ls + + 1. foo (a -> b) + 2. lib/ (643 terms, 92 types) +``` + +You can use `debug.alias.term.force` for that. + +``` ucm +project/main> debug.alias.term.force lib.builtins.todo foo + + Done. + +project/main> ls + + 1. foo (a -> b) + 2. foo (a -> b) + 3. lib/ (643 terms, 92 types) +``` diff --git a/unison-src/transcripts/idempotent/alias-type.md b/unison-src/transcripts/idempotent/alias-type.md new file mode 100644 index 0000000000..98a7de829b --- /dev/null +++ b/unison-src/transcripts/idempotent/alias-type.md @@ -0,0 +1,47 @@ +`alias.type` makes a new name for a type. + +``` ucm :hide +project/main> builtins.mergeio lib.builtins +``` + +``` ucm +project/main> alias.type lib.builtins.Nat Foo + + Done. + +project/main> ls + + 1. Foo (builtin type) + 2. lib/ (643 terms, 92 types) +``` + +It won't create a conflicted name, though. + +``` ucm :error +project/main> alias.type lib.builtins.Int Foo + + ⚠️ + + A type by that name already exists. +``` + +``` ucm +project/main> ls + + 1. Foo (builtin type) + 2. lib/ (643 terms, 92 types) +``` + +You can use `debug.alias.type.force` for that. + +``` ucm +project/main> debug.alias.type.force lib.builtins.Int Foo + + Done. + +project/main> ls + + 1. Foo (builtin type) + 2. Foo (builtin type) + 3. lib/ (643 terms, 92 types) +``` diff --git a/unison-src/transcripts/idempotent/anf-tests.md b/unison-src/transcripts/idempotent/anf-tests.md new file mode 100644 index 0000000000..18cca0ade1 --- /dev/null +++ b/unison-src/transcripts/idempotent/anf-tests.md @@ -0,0 +1,57 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +This tests a variable related bug in the ANF compiler. + +The nested let would get flattened out, resulting in: + +``` +bar = result +``` + +which would be handled by renaming. However, the *context* portion of +the rest of the code was not being renamed correctly, so `bar` would +remain in the definition of `baz`. + +``` unison +foo _ = + id x = x + void x = () + bar = let + void (Debug.watch "hello" "hello") + result = 5 + void (Debug.watch "goodbye" "goodbye") + result + baz = id bar + baz + +> !foo +``` + +``` ucm :added-by-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 + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 12 | > !foo + ⧩ + 5 +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + foo : ∀ _. _ -> Nat +``` diff --git a/unison-src/transcripts/idempotent/any-extract.md b/unison-src/transcripts/idempotent/any-extract.md new file mode 100644 index 0000000000..a6621b64ba --- /dev/null +++ b/unison-src/transcripts/idempotent/any-extract.md @@ -0,0 +1,48 @@ +# Unit tests for Any.unsafeExtract + +``` ucm :hide +scratch/main> builtins.mergeio + +scratch/main> load unison-src/transcripts-using-base/base.u + +scratch/main> add +``` + +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 = + use Nat != + checks [1 == Any.unsafeExtract (Any 1), + not (1 == Any.unsafeExtract (Any 2)), + (Some 1) == Any.unsafeExtract (Any (Some 1)) + ] +``` + +``` ucm :added-by-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`: + + Any.unsafeExtract.works : [Result] + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 4 | checks [1 == Any.unsafeExtract (Any 1), + + ✅ Passed Passed +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + Any.unsafeExtract.works : [Result] +``` diff --git a/unison-src/transcripts/idempotent/api-doc-rendering.md b/unison-src/transcripts/idempotent/api-doc-rendering.md new file mode 100644 index 0000000000..a4ed862c42 --- /dev/null +++ b/unison-src/transcripts/idempotent/api-doc-rendering.md @@ -0,0 +1,951 @@ +# Doc rendering + +``` ucm :hide +scratch/main> builtins.mergeio +``` + +``` unison :hide +structural type Maybe a = Nothing | Just a +otherTerm = "text" + +otherDoc : (Text -> Doc2) -> Doc2 +otherDoc mkMsg = {{ +This doc should be embedded. + +{{mkMsg "message"}} + +}} + +{{ +# Heading + +## Heading 2 + +Term Link: {otherTerm} + +Type Link: {type Maybe} + +Term source: + +@source{term} + +Term signature: + +@signature{term} + +* List item + +1. Numbered list item + +> Block quote + + Code block + +Inline code: + +`` 1 + 2 `` + +`"doesn't typecheck" + 1` + +[Link](https://unison-lang.org) + +![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png) + +**Bold** + +*Italic* + +~~Strikethrough~~ + +Horizontal rule + +--- + +Table + +| Header 1 | Header 2 | +| -------- | -------- | +| Cell 1 | Cell 2 | +| Cell 3 | Cell 4 | + + +Video + +{{ Special (Embed (Any (Video [(MediaSource "test.mp4" None)] [("poster", "test.png")]))) }} + +Transclusion/evaluation: + +{{otherDoc (a -> Word a )}} + +}} +term = 42 +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> display term.doc + + # Heading + + # Heading 2 + + Term Link: otherTerm + + Type Link: Maybe + + Term source: + + term : Nat + term = 42 + + Term signature: + + term : Nat + + * List item + + 1. Numbered list item + + > Block quote + + Code block + + Inline code: + + `1 Nat.+ 2` + + `"doesn't typecheck" + 1` + + Link + + ![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png) + + Bold + + Italic + + ~~Strikethrough~~ + + Horizontal rule + + --- + + Table + + | Header 1 | Header 2 | | -------- | -------- | | Cell 1 | + Cell 2 | | Cell 3 | Cell 4 | + + Video + + + {{ embed {{ + Video + [MediaSource "test.mp4" Nothing] + [("poster", "test.png")] }} }} + + + Transclusion/evaluation: + + This doc should be embedded. + + message +``` + +``` api +GET /api/projects/scratch/branches/main/getDefinition?names=term + { + "missingDefinitions": [], + "termDefinitions": { + "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8": { + "bestTermName": "term", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "42" + } + ], + "tag": "UserObject" + }, + "termDocs": [ + [ + "doc", + "#kjfaflbrgl89j2uq4ruubejakm6s02cp3m61ufu7rv7tkbd4nmkvcn1fciue53v0msir9t7ds111ab9er8qfa06gsa9ddfrdfgc99mo", + { + "contents": [ + { + "contents": [ + { + "contents": "Heading", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + [ + { + "contents": [ + { + "contents": [ + { + "contents": "Heading", + "tag": "Word" + }, + { + "contents": "2", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + [ + { + "contents": [ + { + "contents": "Term", + "tag": "Word" + }, + { + "contents": "Link:", + "tag": "Word" + }, + { + "contents": { + "contents": [ + { + "annotation": { + "contents": "#k5gpql9cbdfau6lf1aja24joc3sfctvjor8esu8bemn0in3l148otb0t3vebgqrt6qml302h62bbfeftg65gec1v8ouin5m6v2969d8", + "tag": "TermReference" + }, + "segment": "otherTerm" + } + ], + "tag": "Link" + }, + "tag": "Special" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Type", + "tag": "Word" + }, + { + "contents": "Link:", + "tag": "Word" + }, + { + "contents": { + "contents": [ + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", + "tag": "TypeReference" + }, + "segment": "Maybe" + } + ], + "tag": "Link" + }, + "tag": "Special" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Term", + "tag": "Word" + }, + { + "contents": "source:", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": [ + "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + { + "contents": [ + [ + { + "annotation": { + "contents": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + "tag": "TermReference" + }, + "segment": "term" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": ": " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + [ + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "42" + } + ] + ], + "tag": "UserObject" + } + ], + "tag": "Term" + } + ], + "tag": "Source" + }, + "tag": "Special" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Term", + "tag": "Word" + }, + { + "contents": "signature:", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + [ + { + "annotation": { + "contents": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + "tag": "TermReference" + }, + "segment": "term" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": ": " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ] + ], + "tag": "Signature" + }, + "tag": "Special" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": [ + { + "contents": "List", + "tag": "Word" + }, + { + "contents": "item", + "tag": "Word" + } + ], + "tag": "Paragraph" + } + ], + "tag": "BulletedList" + }, + { + "contents": [ + 1, + [ + { + "contents": [ + { + "contents": "Numbered", + "tag": "Word" + }, + { + "contents": "list", + "tag": "Word" + }, + { + "contents": "item", + "tag": "Word" + } + ], + "tag": "Paragraph" + } + ] + ], + "tag": "NumberedList" + }, + { + "contents": [ + { + "contents": ">", + "tag": "Word" + }, + { + "contents": "Block", + "tag": "Word" + }, + { + "contents": "quote", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Code", + "tag": "Word" + }, + { + "contents": "block", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Inline", + "tag": "Word" + }, + { + "contents": "code:", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.+", + "tag": "TermReference" + }, + "segment": "Nat.+" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "2" + } + ], + "tag": "Example" + }, + "tag": "Special" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": "\"doesn't typecheck\" + 1", + "tag": "Word" + }, + "tag": "Code" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": [ + { + "contents": [ + { + "contents": "Link", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": { + "contents": "https://unison-lang.org", + "tag": "Word" + }, + "tag": "Group" + } + ], + "tag": "NamedLink" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png)", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": "Bold", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + "tag": "Bold" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": "Italic", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + "tag": "Bold" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": "Strikethrough", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + "tag": "Strikethrough" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Horizontal", + "tag": "Word" + }, + { + "contents": "rule", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "---", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Table", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "Header", + "tag": "Word" + }, + { + "contents": "1", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "Header", + "tag": "Word" + }, + { + "contents": "2", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "--------", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "--------", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "Cell", + "tag": "Word" + }, + { + "contents": "1", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "Cell", + "tag": "Word" + }, + { + "contents": "2", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "Cell", + "tag": "Word" + }, + { + "contents": "3", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + }, + { + "contents": "Cell", + "tag": "Word" + }, + { + "contents": "4", + "tag": "Word" + }, + { + "contents": "|", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Video", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": { + "contents": [ + [ + { + "mediaSourceMimeType": null, + "mediaSourceUrl": "test.mp4" + } + ], + { + "poster": "test.png" + } + ], + "tag": "Video" + }, + "tag": "Special" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "Transclusion/evaluation:", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": [ + { + "contents": [ + { + "contents": "This", + "tag": "Word" + }, + { + "contents": "doc", + "tag": "Word" + }, + { + "contents": "should", + "tag": "Word" + }, + { + "contents": "be", + "tag": "Word" + }, + { + "contents": "embedded.", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + { + "contents": [ + { + "contents": "message", + "tag": "Word" + } + ], + "tag": "Paragraph" + } + ], + "tag": "UntitledSection" + } + ], + "tag": "Paragraph" + } + ] + ], + "tag": "Section" + } + ] + ], + "tag": "Section" + } + ] + ], + "termNames": [ + "term" + ] + } + }, + "typeDefinitions": {} + } +``` diff --git a/unison-src/transcripts/idempotent/api-find.md b/unison-src/transcripts/idempotent/api-find.md new file mode 100644 index 0000000000..33fab9d0bb --- /dev/null +++ b/unison-src/transcripts/idempotent/api-find.md @@ -0,0 +1,254 @@ +# find api + +``` unison +rachel.filesystem.x = 42 +ross.httpClient.y = 43 +joey.httpServer.z = 44 +joey.yaml.zz = 45 +``` + +``` ucm :added-by-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`: + + joey.httpServer.z : ##Nat + joey.yaml.zz : ##Nat + rachel.filesystem.x : ##Nat + ross.httpClient.y : ##Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + joey.httpServer.z : ##Nat + joey.yaml.zz : ##Nat + rachel.filesystem.x : ##Nat + ross.httpClient.y : ##Nat +``` + +``` api +-- Namespace segment prefix search +GET /api/projects/scratch/branches/main/find?query=http + [ + [ + { + "result": { + "segments": [ + { + "contents": "ross.", + "tag": "Gap" + }, + { + "contents": "http", + "tag": "Match" + }, + { + "contents": "Client.y", + "tag": "Gap" + } + ] + }, + "score": 156 + }, + { + "contents": { + "bestFoundTermName": "y", + "namedTerm": { + "termHash": "#emomp74i93h6ps0b5sukke0tci0ooba3f9jk21qm919a7act9u7asani84c0mqbdk4lcjrdvr9olpedp23p6df78r4trqlg0cciadc8", + "termName": "ross.httpClient.y", + "termTag": "Plain", + "termType": [ + { + "annotation": { + "contents": "##Nat", + "tag": "HashQualifier" + }, + "segment": "##Nat" + } + ] + } + }, + "tag": "FoundTermResult" + } + ], + [ + { + "result": { + "segments": [ + { + "contents": "joey.", + "tag": "Gap" + }, + { + "contents": "http", + "tag": "Match" + }, + { + "contents": "Server.z", + "tag": "Gap" + } + ] + }, + "score": 156 + }, + { + "contents": { + "bestFoundTermName": "z", + "namedTerm": { + "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", + "termName": "joey.httpServer.z", + "termTag": "Plain", + "termType": [ + { + "annotation": { + "contents": "##Nat", + "tag": "HashQualifier" + }, + "segment": "##Nat" + } + ] + } + }, + "tag": "FoundTermResult" + } + ] + ] +-- Namespace segment suffix search +GET /api/projects/scratch/branches/main/find?query=Server + [ + [ + { + "result": { + "segments": [ + { + "contents": "joey.http", + "tag": "Gap" + }, + { + "contents": "Server", + "tag": "Match" + }, + { + "contents": ".z", + "tag": "Gap" + } + ] + }, + "score": 223 + }, + { + "contents": { + "bestFoundTermName": "z", + "namedTerm": { + "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", + "termName": "joey.httpServer.z", + "termTag": "Plain", + "termType": [ + { + "annotation": { + "contents": "##Nat", + "tag": "HashQualifier" + }, + "segment": "##Nat" + } + ] + } + }, + "tag": "FoundTermResult" + } + ] + ] +-- Substring search +GET /api/projects/scratch/branches/main/find?query=lesys + [ + [ + { + "result": { + "segments": [ + { + "contents": "rachel.fi", + "tag": "Gap" + }, + { + "contents": "lesys", + "tag": "Match" + }, + { + "contents": "tem.x", + "tag": "Gap" + } + ] + }, + "score": 175 + }, + { + "contents": { + "bestFoundTermName": "x", + "namedTerm": { + "termHash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + "termName": "rachel.filesystem.x", + "termTag": "Plain", + "termType": [ + { + "annotation": { + "contents": "##Nat", + "tag": "HashQualifier" + }, + "segment": "##Nat" + } + ] + } + }, + "tag": "FoundTermResult" + } + ] + ] +-- Cross-segment search +GET /api/projects/scratch/branches/main/find?query=joey.http + [ + [ + { + "result": { + "segments": [ + { + "contents": "joey.http", + "tag": "Match" + }, + { + "contents": "Server.z", + "tag": "Gap" + } + ] + }, + "score": 300 + }, + { + "contents": { + "bestFoundTermName": "z", + "namedTerm": { + "termHash": "#a84tg4er4kfl9k2p250vp2o1dsp5kmn9a7q8g2bo723qbtbf9sagrl28fa4q0j5f2cv4alsjik6rf487ss646qt95gbm3dd13k7e1fo", + "termName": "joey.httpServer.z", + "termTag": "Plain", + "termType": [ + { + "annotation": { + "contents": "##Nat", + "tag": "HashQualifier" + }, + "segment": "##Nat" + } + ] + } + }, + "tag": "FoundTermResult" + } + ] + ] +``` diff --git a/unison-src/transcripts/idempotent/api-getDefinition.md b/unison-src/transcripts/idempotent/api-getDefinition.md new file mode 100644 index 0000000000..3093f55514 --- /dev/null +++ b/unison-src/transcripts/idempotent/api-getDefinition.md @@ -0,0 +1,526 @@ +# Get Definitions Test + +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + +``` unison :hide +nested.names.x.doc = {{ Documentation }} +nested.names.x = 42 +``` + +``` ucm :hide +scratch/main> add +``` + +``` api +-- Should NOT find names by suffix +GET /api/projects/scratch/branches/main/getDefinition?names=x + { + "missingDefinitions": [ + "x" + ], + "termDefinitions": {}, + "typeDefinitions": {} + } +-- Term names should strip relativeTo prefix. +GET /api/projects/scratch/branches/main/getDefinition?names=names.x&relativeTo=nested + { + "missingDefinitions": [], + "termDefinitions": { + "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8": { + "bestTermName": "x", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "x", + "tag": "HashQualifier" + }, + "segment": "x" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "x", + "tag": "HashQualifier" + }, + "segment": "x" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "42" + } + ], + "tag": "UserObject" + }, + "termDocs": [ + [ + "doc", + "#ulr9f75rpcrv79d7sfo2ep2tvbntu3e360lfomird2bdpj4bnea230e8o5j0b9our8vggocpa7eck3pus14fcfajlttat1bg71t6rbg", + { + "contents": [ + { + "contents": "Documentation", + "tag": "Word" + } + ], + "tag": "Paragraph" + } + ] + ], + "termNames": [ + "nested.names.x" + ] + } + }, + "typeDefinitions": {} + } +-- Should find definitions by hash, names should be relative +GET /api/projects/scratch/branches/main/getDefinition?names=%23qkhkl0n238&relativeTo=nested + { + "missingDefinitions": [], + "termDefinitions": { + "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8": { + "bestTermName": "x", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "x", + "tag": "HashQualifier" + }, + "segment": "x" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "x", + "tag": "HashQualifier" + }, + "segment": "x" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "42" + } + ], + "tag": "UserObject" + }, + "termDocs": [ + [ + "doc", + "#ulr9f75rpcrv79d7sfo2ep2tvbntu3e360lfomird2bdpj4bnea230e8o5j0b9our8vggocpa7eck3pus14fcfajlttat1bg71t6rbg", + { + "contents": [ + { + "contents": "Documentation", + "tag": "Word" + } + ], + "tag": "Paragraph" + } + ] + ], + "termNames": [ + "nested.names.x" + ] + } + }, + "typeDefinitions": {} + } +``` + +``` unison :hide +doctest.thing.doc = {{ The correct docs for the thing }} +doctest.thing = "A thing" +doctest.thingalias.doc = {{ Docs for the alias, should not be displayed }} +doctest.thingalias = "A thing" +doctest.otherstuff.thing.doc = {{ A doc for a different term with the same name, should not be displayed }} +doctest.otherstuff.thing = "A different thing" +``` + +``` ucm :hide +scratch/main> add +``` + +Only docs for the term we request should be returned, even if there are other term docs with the same suffix. + +``` api +GET /api/projects/scratch/branches/main/getDefinition?names=thing&relativeTo=doctest + { + "missingDefinitions": [], + "termDefinitions": { + "#jksc1s5kud95ro5ivngossullt2oavsd41s3u48bch67jf3gknru5j6hmjslonkd5sdqs8mr8k4rrnef8fodngbg4sm7u6au564ekjg": { + "bestTermName": "doctest.thing", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "doctest.thing", + "tag": "HashQualifier" + }, + "segment": "doctest.thing" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "doctest.thing", + "tag": "HashQualifier" + }, + "segment": "doctest.thing" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"A thing\"" + } + ], + "tag": "UserObject" + }, + "termDocs": [ + [ + "doctest.thing.doc", + "#t9qfdoiuskj4n9go8cftj1r83s43s3o7sppafm5vr0bq5feieb7ap0cie5ed2qsf9g3ig448vffhnajinq81pnnkila1jp2epa7f26o", + { + "contents": [ + { + "contents": "The", + "tag": "Word" + }, + { + "contents": "correct", + "tag": "Word" + }, + { + "contents": "docs", + "tag": "Word" + }, + { + "contents": "for", + "tag": "Word" + }, + { + "contents": "the", + "tag": "Word" + }, + { + "contents": "thing", + "tag": "Word" + } + ], + "tag": "Paragraph" + } + ] + ], + "termNames": [ + "doctest.thing", + "doctest.thingalias" + ] + } + }, + "typeDefinitions": {} + } +``` + +If we request a doc, the api should return the source, but also the rendered doc should appear in the 'termDocs' list. + +``` api +GET /api/projects/scratch/branches/main/getDefinition?names=thing.doc&relativeTo=doctest + { + "missingDefinitions": [], + "termDefinitions": { + "#t9qfdoiuskj4n9go8cftj1r83s43s3o7sppafm5vr0bq5feieb7ap0cie5ed2qsf9g3ig448vffhnajinq81pnnkila1jp2epa7f26o": { + "bestTermName": "doctest.thing.doc", + "defnTermTag": "Doc", + "signature": [ + { + "annotation": { + "contents": "#ej86si0ur1lsjade71dojr25phk9bbom9rdks6dltolos5tjivakujcriqe02npba53n9gd7tkh8bmv08ttjb9t35lq2ch5heshqcs0", + "tag": "TypeReference" + }, + "segment": "Doc2" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "doctest.thing.doc", + "tag": "HashQualifier" + }, + "segment": "doctest.thing.doc" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#ej86si0ur1lsjade71dojr25phk9bbom9rdks6dltolos5tjivakujcriqe02npba53n9gd7tkh8bmv08ttjb9t35lq2ch5heshqcs0", + "tag": "TypeReference" + }, + "segment": "Doc2" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "doctest.thing.doc", + "tag": "HashQualifier" + }, + "segment": "doctest.thing.doc" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DocDelimiter" + }, + "segment": "{{" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "The" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "correct" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "docs" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "for" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "the" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "thing" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DocDelimiter" + }, + "segment": "}}" + } + ], + "tag": "UserObject" + }, + "termDocs": [ + [ + "doctest.thing.doc", + "#t9qfdoiuskj4n9go8cftj1r83s43s3o7sppafm5vr0bq5feieb7ap0cie5ed2qsf9g3ig448vffhnajinq81pnnkila1jp2epa7f26o", + { + "contents": [ + { + "contents": "The", + "tag": "Word" + }, + { + "contents": "correct", + "tag": "Word" + }, + { + "contents": "docs", + "tag": "Word" + }, + { + "contents": "for", + "tag": "Word" + }, + { + "contents": "the", + "tag": "Word" + }, + { + "contents": "thing", + "tag": "Word" + } + ], + "tag": "Paragraph" + } + ] + ], + "termNames": [ + "doctest.thing.doc" + ] + } + }, + "typeDefinitions": {} + } +``` diff --git a/unison-src/transcripts/idempotent/api-list-projects-branches.md b/unison-src/transcripts/idempotent/api-list-projects-branches.md new file mode 100644 index 0000000000..02d2d2541f --- /dev/null +++ b/unison-src/transcripts/idempotent/api-list-projects-branches.md @@ -0,0 +1,70 @@ +# List Projects And Branches Test + +``` ucm :hide +scratch/main> project.create-empty project-one + +scratch/main> project.create-empty project-two + +scratch/main> project.create-empty project-three + +project-one/main> branch branch-one + +project-one/main> branch branch-two + +project-one/main> branch branch-three +``` + +``` api +-- Should list all projects +GET /api/projects + [ + { + "projectName": "project-one" + }, + { + "projectName": "project-three" + }, + { + "projectName": "project-two" + }, + { + "projectName": "scratch" + } + ] +-- Should list projects starting with project-t +GET /api/projects?prefix=project-t + [ + { + "projectName": "project-three" + }, + { + "projectName": "project-two" + } + ] +-- Should list all branches +GET /api/projects/project-one/branches + [ + { + "branchName": "branch-one" + }, + { + "branchName": "branch-three" + }, + { + "branchName": "branch-two" + }, + { + "branchName": "main" + } + ] +-- Should list all branches beginning with branch-t +GET /api/projects/project-one/branches?prefix=branch-t + [ + { + "branchName": "branch-three" + }, + { + "branchName": "branch-two" + } + ] +``` diff --git a/unison-src/transcripts/idempotent/api-namespace-details.md b/unison-src/transcripts/idempotent/api-namespace-details.md new file mode 100644 index 0000000000..4cbbd01c51 --- /dev/null +++ b/unison-src/transcripts/idempotent/api-namespace-details.md @@ -0,0 +1,84 @@ +# Namespace Details Test + +``` ucm :hide +scratch/main> builtins.mergeio +``` + +``` unison +{{ Documentation }} +nested.names.x = 42 + +nested.names.readme = {{ +Here's a *README*! +}} +``` + +``` ucm :added-by-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`: + + nested.names.readme : Doc2 + nested.names.x : Nat + nested.names.x.doc : Doc2 +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + nested.names.readme : Doc2 + nested.names.x : Nat + nested.names.x.doc : Doc2 +``` + +``` api +-- Should find names by suffix +GET /api/projects/scratch/branches/main/namespaces/nested.names + { + "fqn": "nested.names", + "hash": "#6tnmlu9knsce0u2991u6fvcmf4v44fdf0aiqtmnq7mjj0gi5sephg3lf12iv3odr5rc7vlgq75ciborrd3625c701bdmdomia2gcm3o", + "readme": { + "contents": [ + { + "contents": "Here's", + "tag": "Word" + }, + { + "contents": "a", + "tag": "Word" + }, + { + "contents": { + "contents": [ + { + "contents": { + "contents": [ + { + "contents": "README", + "tag": "Word" + } + ], + "tag": "Paragraph" + }, + "tag": "Bold" + }, + { + "contents": "!", + "tag": "Word" + } + ], + "tag": "Join" + }, + "tag": "Group" + } + ], + "tag": "Paragraph" + } + } +``` diff --git a/unison-src/transcripts/idempotent/api-namespace-list.md b/unison-src/transcripts/idempotent/api-namespace-list.md new file mode 100644 index 0000000000..7287cec514 --- /dev/null +++ b/unison-src/transcripts/idempotent/api-namespace-list.md @@ -0,0 +1,137 @@ +# Namespace list api + +``` ucm :hide +scratch/main> builtins.mergeio +``` + +``` unison +{{ Documentation }} +nested.names.x = 42 + +nested.names.readme = {{ I'm a readme! }} +``` + +``` ucm :added-by-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`: + + nested.names.readme : Doc2 + nested.names.x : Nat + nested.names.x.doc : Doc2 +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + nested.names.readme : Doc2 + nested.names.x : Nat + nested.names.x.doc : Doc2 +``` + +``` api +GET /api/projects/scratch/branches/main/list?namespace=nested.names + { + "namespaceListingChildren": [ + { + "contents": { + "termHash": "#ddmmatmmiqsts2ku0i02kntd0s7rvcui4nn1cusio8thp9oqhbtilvcnhen52ibv43kr5q83f5er5q9h56s807k17tnelnrac7cch8o", + "termName": "readme", + "termTag": "Doc", + "termType": [ + { + "annotation": { + "contents": "#ej86si0ur1", + "tag": "HashQualifier" + }, + "segment": "#ej86si0ur1" + } + ] + }, + "tag": "TermObject" + }, + { + "contents": { + "termHash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + "termName": "x", + "termTag": "Plain", + "termType": [ + { + "annotation": { + "contents": "##Nat", + "tag": "HashQualifier" + }, + "segment": "##Nat" + } + ] + }, + "tag": "TermObject" + }, + { + "contents": { + "namespaceHash": "#n1egracfeljprftoktbjcase2hs4f4p8idbhs5ujipl42agld1810hrq9t7p7ped16aagni2cm1fjcjhho770jh80ipthhmg0cnsur0", + "namespaceName": "x", + "namespaceSize": 1 + }, + "tag": "Subnamespace" + } + ], + "namespaceListingFQN": "nested.names", + "namespaceListingHash": "#oms19b4f9s3c8tb5skeb8jii95ij35n3hdg038pu6rv5b0fikqe4gd7lnu6a1i6aq5tdh2opdo4s0sfrupvk6vfkr9lf0n752gbl8o0" + } +GET /api/projects/scratch/branches/main/list?namespace=names&relativeTo=nested + { + "namespaceListingChildren": [ + { + "contents": { + "termHash": "#ddmmatmmiqsts2ku0i02kntd0s7rvcui4nn1cusio8thp9oqhbtilvcnhen52ibv43kr5q83f5er5q9h56s807k17tnelnrac7cch8o", + "termName": "readme", + "termTag": "Doc", + "termType": [ + { + "annotation": { + "contents": "#ej86si0ur1", + "tag": "HashQualifier" + }, + "segment": "#ej86si0ur1" + } + ] + }, + "tag": "TermObject" + }, + { + "contents": { + "termHash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + "termName": "x", + "termTag": "Plain", + "termType": [ + { + "annotation": { + "contents": "##Nat", + "tag": "HashQualifier" + }, + "segment": "##Nat" + } + ] + }, + "tag": "TermObject" + }, + { + "contents": { + "namespaceHash": "#n1egracfeljprftoktbjcase2hs4f4p8idbhs5ujipl42agld1810hrq9t7p7ped16aagni2cm1fjcjhho770jh80ipthhmg0cnsur0", + "namespaceName": "x", + "namespaceSize": 1 + }, + "tag": "Subnamespace" + } + ], + "namespaceListingFQN": "nested.names", + "namespaceListingHash": "#oms19b4f9s3c8tb5skeb8jii95ij35n3hdg038pu6rv5b0fikqe4gd7lnu6a1i6aq5tdh2opdo4s0sfrupvk6vfkr9lf0n752gbl8o0" + } +``` diff --git a/unison-src/transcripts/idempotent/api-summaries.md b/unison-src/transcripts/idempotent/api-summaries.md new file mode 100644 index 0000000000..d10db43d61 --- /dev/null +++ b/unison-src/transcripts/idempotent/api-summaries.md @@ -0,0 +1,840 @@ +# Definition Summary APIs + +``` ucm :hide +scratch/main> builtins.mergeio +``` + +``` unison :hide +nat : Nat +nat = 42 +doc : Doc2 +doc = {{ Hello }} +test> mytest = [Test.Result.Ok "ok"] +func : Text -> Text +func x = x ++ "hello" + +funcWithLongType : Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text +funcWithLongType a b c d e f g h = a ++ b ++ c ++ d ++ e ++ f ++ g ++ h + +structural type Thing = This Nat | That +structural type Maybe a = Nothing | Just a + +structural ability Stream s where + send : s -> () +``` + +``` ucm :hide +scratch/main> add + +scratch/main> alias.type ##Nat Nat + +scratch/main> alias.term ##IO.putBytes.impl.v3 putBytesImpl +``` + +## Term Summary APIs + +``` api +-- term +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary?name=nat + { + "displayName": "nat", + "hash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + "summary": { + "contents": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "tag": "UserObject" + }, + "tag": "Plain" + } +-- term without name uses hash +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8/summary + { + "displayName": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + "hash": "#qkhkl0n238s1eqibd1ecb8605sqj1m4hpoaag177cu572otqlaf1u28c8suuuqgljdtthsjtr07rv04np05o6oa27ml9105k7uas0t8", + "summary": { + "contents": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "tag": "UserObject" + }, + "tag": "Plain" + } +-- doc +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@icfnhas71n8q5rm7rmpe51hh7bltsr7rb4lv7qadc4cbsifu1mhonlqj2d7836iar2ptc648q9p4u7hf40ijvld574421b6u8gpu0lo/summary?name=doc + { + "displayName": "doc", + "hash": "#icfnhas71n8q5rm7rmpe51hh7bltsr7rb4lv7qadc4cbsifu1mhonlqj2d7836iar2ptc648q9p4u7hf40ijvld574421b6u8gpu0lo", + "summary": { + "contents": [ + { + "annotation": { + "contents": "#ej86si0ur1lsjade71dojr25phk9bbom9rdks6dltolos5tjivakujcriqe02npba53n9gd7tkh8bmv08ttjb9t35lq2ch5heshqcs0", + "tag": "TypeReference" + }, + "segment": "Doc2" + } + ], + "tag": "UserObject" + }, + "tag": "Doc" + } +-- test +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@u17p9803hdibisou6rlr1sjbccdossgh7vtkd03ovlvnsl2n91lq94sqhughc62tnrual2jlrfk922sebp4nm22o7m5u9j40emft8r8/summary?name=mytest + { + "displayName": "mytest", + "hash": "#u17p9803hdibisou6rlr1sjbccdossgh7vtkd03ovlvnsl2n91lq94sqhughc62tnrual2jlrfk922sebp4nm22o7m5u9j40emft8r8", + "summary": { + "contents": [ + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "[" + }, + { + "annotation": { + "contents": "#aql7qk3iud6vs4cvu43aimopoosgk0fnipibdkc3so13adencmibgfn0u5c01r0adei55nkl3ttsjhl8gbj7tr4gnpj63g64ftbq6s0", + "tag": "TypeReference" + }, + "segment": "Result" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "]" + } + ], + "tag": "UserObject" + }, + "tag": "Test" + } +-- function +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@6ee6j48hk3eovokflkgbmpbfr3oqj4hedqn8ocg3i4i0ko8j7nls7njjirmnh4k2bg8h95seaot798uuloqk62u2ttiqoceulkbmq2o/summary?name=func + { + "displayName": "func", + "hash": "#6ee6j48hk3eovokflkgbmpbfr3oqj4hedqn8ocg3i4i0ko8j7nls7njjirmnh4k2bg8h95seaot798uuloqk62u2ttiqoceulkbmq2o", + "summary": { + "contents": [ + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "tag": "UserObject" + }, + "tag": "Plain" + } +-- constructor +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0@d0/summary?name=Thing.This + { + "displayName": "Thing.This", + "hash": "#altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0#0", + "summary": { + "contents": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0", + "tag": "TypeReference" + }, + "segment": "Thing" + } + ], + "tag": "UserObject" + }, + "tag": "DataConstructor" + } +-- Long type signature +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?name=funcWithLongType + { + "displayName": "funcWithLongType", + "hash": "#ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8", + "summary": { + "contents": [ + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "tag": "UserObject" + }, + "tag": "Plain" + } +-- Long type signature with render width +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8/summary?renderWidth=20&name=funcWithLongType + { + "displayName": "funcWithLongType", + "hash": "#ieskgcjjvuegpecq9pbha59ttonke7pf31keeq0jlh31ijkfq00e06fdi36ae90u24pjva6ucqdbedropjgi3g3b75nu76ll5ls8ke8", + "summary": { + "contents": [ + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "tag": "UserObject" + }, + "tag": "Plain" + } +-- Builtin Term +GET /api/projects/scratch/branches/main/definitions/terms/by-hash/@@IO.putBytes.impl.v3/summary?name=putBytesImpl + { + "displayName": "putBytesImpl", + "hash": "##IO.putBytes.impl.v3", + "summary": { + "contents": [ + { + "annotation": { + "contents": "##Handle", + "tag": "TypeReference" + }, + "segment": "Handle" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Bytes", + "tag": "TypeReference" + }, + "segment": "Bytes" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "contents": "##IO", + "tag": "TypeReference" + }, + "segment": "IO" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#0o7mf021foma9acqdaibmlh1jidlijq08uf7f5se9tssttqs546pfunjpk6s31mqoq8s2o1natede8hkk6he45l95fibglidikt44v8", + "tag": "TypeReference" + }, + "segment": "Either" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#r29dja8j9dmjjp45trccchaata8eo1h6d6haar1eai74pq1jt4m7u3ldhlq79f7phfo57eq4bau39vqotl2h63k7ff1m5sj5o9ajuf8", + "tag": "TypeReference" + }, + "segment": "Failure" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "(" + }, + { + "annotation": null, + "segment": ")" + } + ], + "tag": "BuiltinObject" + }, + "tag": "Plain" + } +``` + +## Type Summary APIs + +``` api +-- data +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0/summary?name=Thing + { + "displayName": "Thing", + "hash": "#altimqs66j3dh94dpab5pg7j5adjrndq61n803j7fg0v0ohdiut6or66bu1fiongpd45s5euiuo8ru47b928aqv8osln1ikdeg05hq0", + "summary": { + "contents": [ + { + "annotation": { + "tag": "DataTypeModifier" + }, + "segment": "structural" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "Thing", + "tag": "HashQualifier" + }, + "segment": "Thing" + } + ], + "tag": "UserObject" + }, + "tag": "Data" + } +-- data with type args +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg/summary?name=Maybe + { + "displayName": "Maybe", + "hash": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", + "summary": { + "contents": [ + { + "annotation": { + "tag": "DataTypeModifier" + }, + "segment": "structural" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "Maybe", + "tag": "HashQualifier" + }, + "segment": "Maybe" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DataTypeParams" + }, + "segment": "a" + } + ], + "tag": "UserObject" + }, + "tag": "Data" + } +-- ability +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8/summary?name=Stream + { + "displayName": "Stream", + "hash": "#rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8", + "summary": { + "contents": [ + { + "annotation": { + "tag": "DataTypeModifier" + }, + "segment": "structural" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "ability" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "Stream", + "tag": "HashQualifier" + }, + "segment": "Stream" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DataTypeParams" + }, + "segment": "s" + } + ], + "tag": "UserObject" + }, + "tag": "Ability" + } +-- builtin type +GET /api/projects/scratch/branches/main/definitions/types/by-hash/@@Nat/summary?name=Nat + { + "displayName": "Nat", + "hash": "##Nat", + "summary": { + "contents": [ + { + "annotation": null, + "segment": "Nat" + } + ], + "tag": "BuiltinObject" + }, + "tag": "Data" + } +``` diff --git a/unison-src/transcripts/idempotent/block-on-required-update.md b/unison-src/transcripts/idempotent/block-on-required-update.md new file mode 100644 index 0000000000..4f69704692 --- /dev/null +++ b/unison-src/transcripts/idempotent/block-on-required-update.md @@ -0,0 +1,69 @@ +# Block on required update + +Should block an `add` if it requires an update on an in-file dependency. + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +x = 1 +``` + +``` ucm :added-by-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`: + + x : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + x : Nat +``` + +Update `x`, and add a new `y` which depends on the update + +``` unison +x = 10 +y = x + 1 +``` + +``` ucm :added-by-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`: + + y : Nat + + ⍟ These names already exist. You can `update` them to your + new definition: + + x : Nat +``` + +Try to add only the new `y`. This should fail because it requires an update to `x`, but we only ran an 'add'. + +``` ucm :error +scratch/main> add y + + x These definitions failed: + + Reason + needs update x : Nat + blocked y : Nat + + Tip: Use `help filestatus` to learn more. +``` diff --git a/unison-src/transcripts/idempotent/blocks.md b/unison-src/transcripts/idempotent/blocks.md new file mode 100644 index 0000000000..167c580bb3 --- /dev/null +++ b/unison-src/transcripts/idempotent/blocks.md @@ -0,0 +1,352 @@ +## Blocks and scoping + +``` ucm :hide +scratch/main> builtins.merge +``` + +### Names introduced by a block shadow names introduced in outer scopes + +For example: + +``` unison +ex thing = + thing y = y + -- refers to `thing` in this block + -- not the argument to `ex` + bar x = thing x + 1 + bar 42 + +> ex "hello" +``` + +``` ucm :added-by-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`: + + ex : thing -> Nat + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 8 | > ex "hello" + ⧩ + 43 +``` + +### Whether a block shadows outer names doesn't depend on the order of bindings in the block + +The `thing` reference in `bar` refers to the one declared locally in the block that `bar` is part of. This is true even if the declaration which shadows the outer name appears later in the block, for instance: + +``` unison +ex thing = + bar x = thing x + 1 + thing y = y + bar 42 + +> ex "hello" +``` + +``` ucm :added-by-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`: + + ex : thing -> Nat + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 6 | > ex "hello" + ⧩ + 43 +``` + +### Blocks use lexical scoping and can only reference definitions in parent scopes or in the same block + +This is just the normal lexical scoping behavior. For example: + +``` unison +ex thing = + bar x = thing x + 1 -- references outer `thing` + baz z = + thing y = y -- shadows the outer `thing` + thing z -- references the inner `thing` + bar 42 + +> ex (x -> x * 100) +``` + +``` ucm :added-by-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`: + + ex : (Nat ->{g} Nat) ->{g} Nat + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 8 | > ex (x -> x * 100) + ⧩ + 4201 +``` + +Here's another example, showing that bindings cannot reference bindings declared in blocks nested in the *body* (the final expression) of a block: + +``` unison +ex thing = + bar x = thing x + 1 -- refers to outer thing + let + thing y = y + bar 42 + +> ex (x -> x * 100) +``` + +``` ucm :added-by-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`: + + ex : (Nat ->{g} Nat) ->{g} Nat + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 7 | > ex (x -> x * 100) + ⧩ + 4201 +``` + +### Blocks can define one or more functions which are recursive or mutually recursive + +We call these groups of definitions that reference each other in a block *cycles*. For instance: + +``` unison +sumTo n = + -- A recursive function, defined inside a block + go acc n = + if n == 0 then acc + else go (acc + n) (drop n 1) + go 0 n + +ex n = + -- Two mutually recursive functions, defined in a block + ping x = pong (x + 1) + pong x = ping (x + 2) + ping 42 +``` + +``` ucm :added-by-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`: + + ex : n -> r + sumTo : Nat -> Nat +``` + +The `go` function is a one-element cycle (it reference itself), and `ping` and `pong` form a two-element cycle. + +### Cyclic references or forward reference must be guarded + +For instance, this works: + +``` unison +ex n = + ping x = pong + 1 + x + pong = 42 + ping 0 +``` + +``` ucm :added-by-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`: + + ex : n -> Nat +``` + +Since the forward reference to `pong` appears inside `ping`. + +This, however, will not compile: + +``` unison :error +ex n = + pong = ping + 1 + ping = 42 + pong +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + These definitions depend on each other cyclically but aren't guarded by a lambda: pong8 + 2 | pong = ping + 1 + 3 | ping = 42 +``` + +This also won't compile; it's a cyclic reference that isn't guarded: + +``` unison :error +ex n = + loop = loop + loop +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + These definitions depend on each other cyclically but aren't guarded by a lambda: loop8 + 2 | loop = loop +``` + +This, however, will compile. This also shows that `'expr` is another way of guarding a definition. + +``` unison +ex n = + loop = '(!loop) + !loop +``` + +``` ucm :added-by-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`: + + ex : n -> r +``` + +Just don't try to run it as it's an infinite loop\! + +### Cyclic definitions in a block don't have access to any abilities + +The reason is it's unclear what the order should be of any requests that are made. It can also be viewed of a special case of the restriction that elements of a cycle must all be guarded. Here's an example: + +``` unison :error +structural ability SpaceAttack where + launchMissiles : Text -> Nat + +ex n = + zap1 = launchMissiles "neptune" + zap2 + zap2 = launchMissiles "pluto" + zap1 + zap1 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + The expression in red needs the {SpaceAttack} ability, but this location does not have access to any abilities. + + 5 | zap1 = launchMissiles "neptune" + zap2 +``` + +### The *body* of recursive functions can certainly access abilities + +For instance, this works fine: + +``` unison +structural ability SpaceAttack where + launchMissiles : Text -> Nat + +ex n = + zap1 planet = launchMissiles planet + zap2 planet + zap2 planet = launchMissiles planet + zap1 planet + zap1 "pluto" +``` + +``` ucm :added-by-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`: + + structural ability SpaceAttack + ex : n ->{SpaceAttack} Nat +``` + +### Unrelated definitions not part of a cycle and are moved after the cycle + +For instance, `zap` here isn't considered part of the cycle (it doesn't reference `ping` or `pong`), so this typechecks fine: + +``` unison +structural ability SpaceAttack where + launchMissiles : Text -> Nat + +ex n = + ping x = pong (x + 1) + zap = launchMissiles "neptune" + pong x = ping (x + 2) + ping 42 +``` + +``` ucm :added-by-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`: + + structural ability SpaceAttack + ex : n ->{SpaceAttack} r +``` + +This is actually parsed as if you moved `zap` after the cycle it find itself a part of: + +``` unison +structural ability SpaceAttack where + launchMissiles : Text -> Nat + +ex n = + ping x = pong (x + 1) + pong x = ping (x + 2) + zap = launchMissiles "neptune" + ping 42 +``` + +``` ucm :added-by-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`: + + structural ability SpaceAttack + ex : n ->{SpaceAttack} r +``` diff --git a/unison-src/transcripts/idempotent/boolean-op-pretty-print-2819.md b/unison-src/transcripts/idempotent/boolean-op-pretty-print-2819.md new file mode 100644 index 0000000000..420466b531 --- /dev/null +++ b/unison-src/transcripts/idempotent/boolean-op-pretty-print-2819.md @@ -0,0 +1,39 @@ +Regression test for https://github.com/unisonweb/unison/pull/2819 + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +hangExample : Boolean +hangExample = + ("a long piece of text to hang the line" == "") + && ("a long piece of text to hang the line" == "") +``` + +``` ucm :added-by-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`: + + hangExample : Boolean +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + hangExample : Boolean + +scratch/main> view hangExample + + hangExample : Boolean + hangExample = + "a long piece of text to hang the line" == "" + && "a long piece of text to hang the line" == "" +``` diff --git a/unison-src/transcripts/idempotent/branch-command.md b/unison-src/transcripts/idempotent/branch-command.md new file mode 100644 index 0000000000..67e97a1b4c --- /dev/null +++ b/unison-src/transcripts/idempotent/branch-command.md @@ -0,0 +1,187 @@ +The `branch` command creates a new branch. + +``` ucm :hide +scratch/main> project.create-empty foo + +scratch/main> project.create-empty bar +``` + +First, we'll create a term to include in the branches. + +``` unison :hide +someterm = 18 +``` + +``` ucm +scratch/main> builtins.merge lib.builtins + + Done. + +scratch/main> add + + ⍟ I've added these definitions: + + someterm : Nat +``` + +Now, the `branch` demo: + +`branch` can create a branch from a different branch in the same project, from a different branch in a different +project. It can also create an empty branch. + +``` ucm +foo/main> branch topic1 + + Done. I've created the topic1 branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic1`. + +foo/main> branch /topic2 + + Done. I've created the topic2 branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic2`. + +foo/main> branch foo/topic3 + + Done. I've created the topic3 branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic3`. + +foo/main> branch main topic4 + + Done. I've created the topic4 branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic4`. + +foo/main> branch main /topic5 + + Done. I've created the topic5 branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic5`. + +foo/main> branch main foo/topic6 + + Done. I've created the topic6 branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic6`. + +foo/main> branch /main topic7 + + Done. I've created the topic7 branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic7`. + +foo/main> branch /main /topic8 + + Done. I've created the topic8 branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic8`. + +foo/main> branch /main foo/topic9 + + Done. I've created the topic9 branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic9`. + +foo/main> branch foo/main topic10 + + Done. I've created the topic10 branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic10`. + +foo/main> branch foo/main /topic11 + + Done. I've created the topic11 branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic11`. + +scratch/main> branch foo/main foo/topic12 + + Done. I've created the topic12 branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic12`. + +foo/main> branch bar/topic + + Done. I've created the bar/topic branch based off foo/main. + +bar/main> branch foo/main topic2 + + Done. I've created the bar/topic2 branch based off foo/main. + +bar/main> branch foo/main /topic3 + + Done. I've created the bar/topic3 branch based off foo/main. + +scratch/main> branch foo/main bar/topic4 + + Done. I've created the bar/topic4 branch based off foo/main. + +foo/main> branch.empty empty1 + + Done. I've created an empty branch foo/empty1. + + Tip: Use `merge /somebranch` to initialize this branch. + +foo/main> branch.empty /empty2 + + Done. I've created an empty branch foo/empty2. + + Tip: Use `merge /somebranch` to initialize this branch. + +foo/main> branch.empty foo/empty3 + + Done. I've created an empty branch foo/empty3. + + Tip: Use `merge /somebranch` to initialize this branch. + +scratch/main> branch.empty foo/empty4 + + Done. I've created an empty branch foo/empty4. + + Tip: Use `merge /somebranch` to initialize this branch. +``` + +The `branch` command can create branches named `releases/drafts/*` (because why not). + +``` ucm +foo/main> branch releases/drafts/1.2.3 + + Done. I've created the releases/drafts/1.2.3 branch based off + of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /releases/drafts/1.2.3`. + +foo/main> switch /releases/drafts/1.2.3 +``` + +The `branch` command can't create branches named `releases/*` nor `releases/drafts/*`. + +``` ucm :error +foo/main> branch releases/1.2.3 + + Branch names like releases/1.2.3 are reserved for releases. + + Tip: to download an existing release, try + `clone /releases/1.2.3`. + + Tip: to draft a new release, try `release.draft 1.2.3`. + +foo/main> switch /releases/1.2.3 + + foo/releases/1.2.3 does not exist. +``` diff --git a/unison-src/transcripts/idempotent/branch-relative-path.md b/unison-src/transcripts/idempotent/branch-relative-path.md new file mode 100644 index 0000000000..67775adbb8 --- /dev/null +++ b/unison-src/transcripts/idempotent/branch-relative-path.md @@ -0,0 +1,92 @@ +``` unison +foo = 5 +foo.bar = 1 +``` + +``` ucm :added-by-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 + foo.bar : ##Nat +``` + +``` ucm +p0/main> add + + ⍟ I've added these definitions: + + foo : ##Nat + foo.bar : ##Nat +``` + +``` unison +bonk = 5 +donk.bonk = 1 +``` + +``` ucm :added-by-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`: + + bonk : ##Nat + (also named foo) + donk.bonk : ##Nat + (also named foo.bar) +``` + +``` ucm +p1/main> add + + ⍟ I've added these definitions: + + bonk : ##Nat + donk.bonk : ##Nat + +p1/main> fork p0/main: zzz + + Done. + +p1/main> find zzz + + 1. zzz.foo : ##Nat + 2. zzz.foo.bar : ##Nat + +p1/main> fork p0/main:foo yyy + + Done. + +p1/main> find yyy + + 1. yyy.bar : ##Nat + +p0/main> fork p1/main: p0/main:p1 + + Done. + +p0/main> ls p1 + + 1. bonk (##Nat) + 2. donk/ (1 term) + 3. yyy/ (1 term) + 4. zzz/ (2 terms) + +p0/main> ls p1.zzz + + 1. foo (##Nat) + 2. foo/ (1 term) + +p0/main> ls p1.yyy + + 1. bar (##Nat) +``` diff --git a/unison-src/transcripts/idempotent/bug-fix-4354.md b/unison-src/transcripts/idempotent/bug-fix-4354.md new file mode 100644 index 0000000000..878dfce1f7 --- /dev/null +++ b/unison-src/transcripts/idempotent/bug-fix-4354.md @@ -0,0 +1,25 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +bonk : forall a. a -> a +bonk x = + zonk : forall a. a -> a + zonk z = z + honk : a + honk = x + x +``` + +``` ucm :added-by-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`: + + bonk : a -> a +``` diff --git a/unison-src/transcripts/idempotent/bug-strange-closure.md b/unison-src/transcripts/idempotent/bug-strange-closure.md new file mode 100644 index 0000000000..15c5aace2d --- /dev/null +++ b/unison-src/transcripts/idempotent/bug-strange-closure.md @@ -0,0 +1,4526 @@ +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins + +scratch/main> load unison-src/transcripts-using-base/doc.md.files/syntax.u +``` + +We can display the guide before and after adding it to the codebase: + +```` ucm +scratch/main> display doc.guide + + # Unison computable documentation + + # Basic formatting + + Paragraphs are separated by one or more blanklines. + Sections have a title and 0 or more paragraphs or other + section elements. + + Text can be bold, *italicized*, ~~strikethrough~~, or + `monospaced` (or `monospaced`). + + You can link to Unison terms, types, and external URLs: + + * An external url + * Some is a term link; Optional is a type link + * A named type link and a named term link. Term links are + handy for linking to other documents! + + You can use `{{ .. }}` to escape out to regular Unison + syntax, for instance __not bold__. This is useful for + creating documents programmatically or just including + other documents. + + *Next up:* lists + + # Lists + + # Bulleted lists + + Bulleted lists can use `+`, `-`, or `*` for the bullets + (though the choice will be normalized away by the + pretty-printer). They can be nested, to any depth: + + * A + * B + * C + * C1 + * C2 + + # Numbered lists + + 1. A + 2. B + 3. C + + The first number of the list determines the starting + number in the rendered output. The other numbers are + ignored: + + 10. A + 11. B + 12. C + + Numbered lists can be nested as well, and combined with + bulleted lists: + + 1. Wake up. + * What am I doing here? + * In this nested list. + 2. Take shower. + 3. Get dressed. + + # Evaluation + + Expressions can be evaluated inline, for instance `2`. + + Blocks of code can be evaluated as well, for instance: + + id x = x + id (sqr 10) + ⧨ + 100 + + also: + + match 1 with + 1 -> "hi" + _ -> "goodbye" + ⧨ + "hi" + + To include a typechecked snippet of code without + evaluating it, you can do: + + use Nat * + cube : Nat -> Nat + cube x = x * x * x + + # Including Unison source code + + Unison definitions can be included in docs. For instance: + + structural type Optional a = Some a | None + + sqr : Nat -> Nat + sqr x = + use Nat * + x * x + + Some rendering targets also support folded source: + + structural type Optional a = Some a | None + + sqr : Nat -> Nat + sqr x = + use Nat * + x * x + + You can also include just a signature, inline, with + `sqr : Nat -> Nat`, or you can include one or more + signatures as a block: + + sqr : Nat -> Nat + + Nat.+ : Nat -> Nat -> Nat + + Or alternately: + + List.map : (a ->{e} b) -> [a] ->{e} [b] + + # Inline snippets + + You can include typechecked code snippets inline, for + instance: + + * `f x Nat.+ sqr 1` - the `2` says to ignore the first + two arguments when rendering. In richer renderers, the + `sqr` link will be clickable. + * If your snippet expression is just a single function + application, you can put it in double backticks, like + so: `sqr x`. This is equivalent to `sqr x`. + + # Non-Unison code blocks + + Use three or more single quotes to start a block with no + syntax highlighting: + + ``` raw + _____ _ + | | |___|_|___ ___ ___ + | | | | |_ -| . | | + |_____|_|_|_|___|___|_|_| + + ``` + + You can use three or more backticks plus a language name + for blocks with syntax highlighting: + + ``` Haskell + -- A fenced code block which isn't parsed by Unison + reverse = foldl (flip (:)) [] + ``` + + ``` Scala + // A fenced code block which isn't parsed by Unison + def reverse[A](xs: List[A]) = + xs.foldLeft(Nil : List[A])((acc,a) => a +: acc) + ``` + + There are also asides, callouts, tables, tooltips, and more. + These don't currently have special syntax; just use the + `{{ }}` syntax to call these functions directly. + + docAside : Doc2 -> Doc2 + + docCallout : Optional Doc2 -> Doc2 -> Doc2 + + docBlockquote : Doc2 -> Doc2 + + docTooltip : Doc2 -> Doc2 -> Doc2 + + docTable : [[Doc2]] -> Doc2 + + This is an aside. ( + Some extra detail that doesn't belong in main text. ) + + | This is an important callout, with no icon. + + | 🌻 + | + | This is an important callout, with an icon. The text + | wraps onto multiple lines. + + > "And what is the use of a book," thought Alice, "without + > pictures or conversation?" + > + > *Lewis Carroll, Alice's Adventures in Wonderland* + + Hover over me + + a b A longer paragraph that will split + onto multiple lines, such that this + row occupies multiple lines in the + rendered table. + Some text More text Zounds! + +scratch/main> add + + ⍟ I've added these definitions: + + basicFormatting : Doc2 + doc.guide : Doc2 + evaluation : Doc2 + includingSource : Doc2 + lists : Doc2 + nonUnisonCodeBlocks : Doc2 + otherElements : Doc2 + sqr : Nat -> Nat + +scratch/main> display doc.guide + + # Unison computable documentation + + # Basic formatting + + Paragraphs are separated by one or more blanklines. + Sections have a title and 0 or more paragraphs or other + section elements. + + Text can be bold, *italicized*, ~~strikethrough~~, or + `monospaced` (or `monospaced`). + + You can link to Unison terms, types, and external URLs: + + * An external url + * Some is a term link; Optional is a type link + * A named type link and a named term link. Term links are + handy for linking to other documents! + + You can use `{{ .. }}` to escape out to regular Unison + syntax, for instance __not bold__. This is useful for + creating documents programmatically or just including + other documents. + + *Next up:* lists + + # Lists + + # Bulleted lists + + Bulleted lists can use `+`, `-`, or `*` for the bullets + (though the choice will be normalized away by the + pretty-printer). They can be nested, to any depth: + + * A + * B + * C + * C1 + * C2 + + # Numbered lists + + 1. A + 2. B + 3. C + + The first number of the list determines the starting + number in the rendered output. The other numbers are + ignored: + + 10. A + 11. B + 12. C + + Numbered lists can be nested as well, and combined with + bulleted lists: + + 1. Wake up. + * What am I doing here? + * In this nested list. + 2. Take shower. + 3. Get dressed. + + # Evaluation + + Expressions can be evaluated inline, for instance `2`. + + Blocks of code can be evaluated as well, for instance: + + id x = x + id (sqr 10) + ⧨ + 100 + + also: + + match 1 with + 1 -> "hi" + _ -> "goodbye" + ⧨ + "hi" + + To include a typechecked snippet of code without + evaluating it, you can do: + + use Nat * + cube : Nat -> Nat + cube x = x * x * x + + # Including Unison source code + + Unison definitions can be included in docs. For instance: + + structural type Optional a = Some a | None + + sqr : Nat -> Nat + sqr x = + use Nat * + x * x + + Some rendering targets also support folded source: + + structural type Optional a = Some a | None + + sqr : Nat -> Nat + sqr x = + use Nat * + x * x + + You can also include just a signature, inline, with + `sqr : Nat -> Nat`, or you can include one or more + signatures as a block: + + sqr : Nat -> Nat + + Nat.+ : Nat -> Nat -> Nat + + Or alternately: + + List.map : (a ->{e} b) -> [a] ->{e} [b] + + # Inline snippets + + You can include typechecked code snippets inline, for + instance: + + * `f x Nat.+ sqr 1` - the `2` says to ignore the first + two arguments when rendering. In richer renderers, the + `sqr` link will be clickable. + * If your snippet expression is just a single function + application, you can put it in double backticks, like + so: `sqr x`. This is equivalent to `sqr x`. + + # Non-Unison code blocks + + Use three or more single quotes to start a block with no + syntax highlighting: + + ``` raw + _____ _ + | | |___|_|___ ___ ___ + | | | | |_ -| . | | + |_____|_|_|_|___|___|_|_| + + ``` + + You can use three or more backticks plus a language name + for blocks with syntax highlighting: + + ``` Haskell + -- A fenced code block which isn't parsed by Unison + reverse = foldl (flip (:)) [] + ``` + + ``` Scala + // A fenced code block which isn't parsed by Unison + def reverse[A](xs: List[A]) = + xs.foldLeft(Nil : List[A])((acc,a) => a +: acc) + ``` + + There are also asides, callouts, tables, tooltips, and more. + These don't currently have special syntax; just use the + `{{ }}` syntax to call these functions directly. + + docAside : Doc2 -> Doc2 + + docCallout : Optional Doc2 -> Doc2 -> Doc2 + + docBlockquote : Doc2 -> Doc2 + + docTooltip : Doc2 -> Doc2 -> Doc2 + + docTable : [[Doc2]] -> Doc2 + + This is an aside. ( + Some extra detail that doesn't belong in main text. ) + + | This is an important callout, with no icon. + + | 🌻 + | + | This is an important callout, with an icon. The text + | wraps onto multiple lines. + + > "And what is the use of a book," thought Alice, "without + > pictures or conversation?" + > + > *Lewis Carroll, Alice's Adventures in Wonderland* + + Hover over me + + a b A longer paragraph that will split + onto multiple lines, such that this + row occupies multiple lines in the + rendered table. + Some text More text Zounds! +```` + +But we can't display this due to a decompilation problem. + +``` unison +rendered = Pretty.get (docFormatConsole doc.guide) +``` + +``` ucm :added-by-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`: + + rendered : Annotated () (Either SpecialForm ConsoleText) +``` + +```` ucm +scratch/main> display rendered + + # Unison computable documentation + + # Basic formatting + + Paragraphs are separated by one or more blanklines. + Sections have a title and 0 or more paragraphs or other + section elements. + + Text can be bold, *italicized*, ~~strikethrough~~, or + `monospaced` (or `monospaced`). + + You can link to Unison terms, types, and external URLs: + + * An external url + * Some is a term link; Optional is a type link + * A named type link and a named term link. Term links are + handy for linking to other documents! + + You can use `{{ .. }}` to escape out to regular Unison + syntax, for instance __not bold__. This is useful for + creating documents programmatically or just including + other documents. + + *Next up:* lists + + # Lists + + # Bulleted lists + + Bulleted lists can use `+`, `-`, or `*` for the bullets + (though the choice will be normalized away by the + pretty-printer). They can be nested, to any depth: + + * A + * B + * C + * C1 + * C2 + + # Numbered lists + + 1. A + 2. B + 3. C + + The first number of the list determines the starting + number in the rendered output. The other numbers are + ignored: + + 10. A + 11. B + 12. C + + Numbered lists can be nested as well, and combined with + bulleted lists: + + 1. Wake up. + * What am I doing here? + * In this nested list. + 2. Take shower. + 3. Get dressed. + + # Evaluation + + Expressions can be evaluated inline, for instance `2`. + + Blocks of code can be evaluated as well, for instance: + + id x = x + id (sqr 10) + ⧨ + 100 + + also: + + match 1 with + 1 -> "hi" + _ -> "goodbye" + ⧨ + "hi" + + To include a typechecked snippet of code without + evaluating it, you can do: + + use Nat * + cube : Nat -> Nat + cube x = x * x * x + + # Including Unison source code + + Unison definitions can be included in docs. For instance: + + structural type Optional a = Some a | None + + sqr : Nat -> Nat + sqr x = + use Nat * + x * x + + Some rendering targets also support folded source: + + structural type Optional a = Some a | None + + sqr : Nat -> Nat + sqr x = + use Nat * + x * x + + You can also include just a signature, inline, with + `sqr : Nat -> Nat`, or you can include one or more + signatures as a block: + + sqr : Nat -> Nat + + Nat.+ : Nat -> Nat -> Nat + + Or alternately: + + List.map : (a ->{e} b) -> [a] ->{e} [b] + + # Inline snippets + + You can include typechecked code snippets inline, for + instance: + + * `f x Nat.+ sqr 1` - the `2` says to ignore the first + two arguments when rendering. In richer renderers, the + `sqr` link will be clickable. + * If your snippet expression is just a single function + application, you can put it in double backticks, like + so: `sqr x`. This is equivalent to `sqr x`. + + # Non-Unison code blocks + + Use three or more single quotes to start a block with no + syntax highlighting: + + ``` raw + _____ _ + | | |___|_|___ ___ ___ + | | | | |_ -| . | | + |_____|_|_|_|___|___|_|_| + + ``` + + You can use three or more backticks plus a language name + for blocks with syntax highlighting: + + ``` Haskell + -- A fenced code block which isn't parsed by Unison + reverse = foldl (flip (:)) [] + ``` + + ``` Scala + // A fenced code block which isn't parsed by Unison + def reverse[A](xs: List[A]) = + xs.foldLeft(Nil : List[A])((acc,a) => a +: acc) + ``` + + There are also asides, callouts, tables, tooltips, and more. + These don't currently have special syntax; just use the + `{{ }}` syntax to call these functions directly. + + docAside : Doc2 -> Doc2 + + docCallout : Optional Doc2 -> Doc2 -> Doc2 + + docBlockquote : Doc2 -> Doc2 + + docTooltip : Doc2 -> Doc2 -> Doc2 + + docTable : [[Doc2]] -> Doc2 + + This is an aside. ( + Some extra detail that doesn't belong in main text. ) + + | This is an important callout, with no icon. + + | 🌻 + | + | This is an important callout, with an icon. The text + | wraps onto multiple lines. + + > "And what is the use of a book," thought Alice, "without + > pictures or conversation?" + > + > *Lewis Carroll, Alice's Adventures in Wonderland* + + Hover over me + + a b A longer paragraph that will split + onto multiple lines, such that this + row occupies multiple lines in the + rendered table. + Some text More text Zounds! + +scratch/main> add + + ⍟ I've added these definitions: + + rendered : Annotated () (Either SpecialForm ConsoleText) + +scratch/main> display rendered + + # Unison computable documentation + + # Basic formatting + + Paragraphs are separated by one or more blanklines. + Sections have a title and 0 or more paragraphs or other + section elements. + + Text can be bold, *italicized*, ~~strikethrough~~, or + `monospaced` (or `monospaced`). + + You can link to Unison terms, types, and external URLs: + + * An external url + * Some is a term link; Optional is a type link + * A named type link and a named term link. Term links are + handy for linking to other documents! + + You can use `{{ .. }}` to escape out to regular Unison + syntax, for instance __not bold__. This is useful for + creating documents programmatically or just including + other documents. + + *Next up:* lists + + # Lists + + # Bulleted lists + + Bulleted lists can use `+`, `-`, or `*` for the bullets + (though the choice will be normalized away by the + pretty-printer). They can be nested, to any depth: + + * A + * B + * C + * C1 + * C2 + + # Numbered lists + + 1. A + 2. B + 3. C + + The first number of the list determines the starting + number in the rendered output. The other numbers are + ignored: + + 10. A + 11. B + 12. C + + Numbered lists can be nested as well, and combined with + bulleted lists: + + 1. Wake up. + * What am I doing here? + * In this nested list. + 2. Take shower. + 3. Get dressed. + + # Evaluation + + Expressions can be evaluated inline, for instance `2`. + + Blocks of code can be evaluated as well, for instance: + + id x = x + id (sqr 10) + ⧨ + 100 + + also: + + match 1 with + 1 -> "hi" + _ -> "goodbye" + ⧨ + "hi" + + To include a typechecked snippet of code without + evaluating it, you can do: + + use Nat * + cube : Nat -> Nat + cube x = x * x * x + + # Including Unison source code + + Unison definitions can be included in docs. For instance: + + structural type Optional a = Some a | None + + sqr : Nat -> Nat + sqr x = + use Nat * + x * x + + Some rendering targets also support folded source: + + structural type Optional a = Some a | None + + sqr : Nat -> Nat + sqr x = + use Nat * + x * x + + You can also include just a signature, inline, with + `sqr : Nat -> Nat`, or you can include one or more + signatures as a block: + + sqr : Nat -> Nat + + Nat.+ : Nat -> Nat -> Nat + + Or alternately: + + List.map : (a ->{e} b) -> [a] ->{e} [b] + + # Inline snippets + + You can include typechecked code snippets inline, for + instance: + + * `f x Nat.+ sqr 1` - the `2` says to ignore the first + two arguments when rendering. In richer renderers, the + `sqr` link will be clickable. + * If your snippet expression is just a single function + application, you can put it in double backticks, like + so: `sqr x`. This is equivalent to `sqr x`. + + # Non-Unison code blocks + + Use three or more single quotes to start a block with no + syntax highlighting: + + ``` raw + _____ _ + | | |___|_|___ ___ ___ + | | | | |_ -| . | | + |_____|_|_|_|___|___|_|_| + + ``` + + You can use three or more backticks plus a language name + for blocks with syntax highlighting: + + ``` Haskell + -- A fenced code block which isn't parsed by Unison + reverse = foldl (flip (:)) [] + ``` + + ``` Scala + // A fenced code block which isn't parsed by Unison + def reverse[A](xs: List[A]) = + xs.foldLeft(Nil : List[A])((acc,a) => a +: acc) + ``` + + There are also asides, callouts, tables, tooltips, and more. + These don't currently have special syntax; just use the + `{{ }}` syntax to call these functions directly. + + docAside : Doc2 -> Doc2 + + docCallout : Optional Doc2 -> Doc2 -> Doc2 + + docBlockquote : Doc2 -> Doc2 + + docTooltip : Doc2 -> Doc2 -> Doc2 + + docTable : [[Doc2]] -> Doc2 + + This is an aside. ( + Some extra detail that doesn't belong in main text. ) + + | This is an important callout, with no icon. + + | 🌻 + | + | This is an important callout, with an icon. The text + | wraps onto multiple lines. + + > "And what is the use of a book," thought Alice, "without + > pictures or conversation?" + > + > *Lewis Carroll, Alice's Adventures in Wonderland* + + Hover over me + + a b A longer paragraph that will split + onto multiple lines, such that this + row occupies multiple lines in the + rendered table. + Some text More text Zounds! + +scratch/main> undo + + Here are the changes I undid + + Added definitions: + + 1. rendered : Annotated () (Either SpecialForm ConsoleText) +```` + +And then this sometimes generates a GHC crash "strange closure error" but doesn't seem deterministic. + +``` unison +rendered = Pretty.get (docFormatConsole doc.guide) + +> rendered +``` + +```` ucm :added-by-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`: + + rendered : Annotated () (Either SpecialForm ConsoleText) + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 3 | > rendered + ⧩ + Annotated.Group + () + (Annotated.Append + () + [ Indent + () + (Lit () (Right (Plain "# "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (ConsoleText.Bold (Plain "Unison"))) + , Lit + () + (Right + (ConsoleText.Bold + (Plain "computable"))) + , Lit + () + (Right + (ConsoleText.Bold + (Plain "documentation"))) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Group + () + (Annotated.Append + () + [ Indent + () + (Lit () (Right (Plain "# "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (ConsoleText.Bold + (Plain "Basic"))) + , Lit + () + (Right + (ConsoleText.Bold + (Plain "formatting"))) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain "Paragraphs")) + , Lit + () (Right (Plain "are")) + , Lit + () + (Right + (Plain "separated")) + , Lit + () (Right (Plain "by")) + , Lit + () (Right (Plain "one")) + , Lit + () (Right (Plain "or")) + , Lit + () + (Right (Plain "more")) + , Lit + () + (Right + (Plain "blanklines.")) + , Lit + () + (Right + (Plain "Sections")) + , Lit + () + (Right (Plain "have")) + , Lit () (Right (Plain "a")) + , Lit + () + (Right (Plain "title")) + , Lit + () (Right (Plain "and")) + , Lit () (Right (Plain "0")) + , Lit + () (Right (Plain "or")) + , Lit + () + (Right (Plain "more")) + , Lit + () + (Right + (Plain "paragraphs")) + , Lit + () (Right (Plain "or")) + , Lit + () + (Right (Plain "other")) + , Lit + () + (Right (Plain "section")) + , Lit + () + (Right + (Plain "elements.")) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right (Plain "Text")) + , Lit + () (Right (Plain "can")) + , Lit + () (Right (Plain "be")) + , Annotated.Group + () + (Annotated.Append + () + [ Wrap + () + (Lit + () + (Right + (ConsoleText.Bold + (Plain + "bold")))) + , Lit + () + (Right (Plain ",")) + ]) + , Annotated.Group + () + (Annotated.Append + () + [ Annotated.Group + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain "*")) + , Wrap + () + (Lit + () + (Right + (Plain + "italicized"))) + , Lit + () + (Right + (Plain "*")) + ]) + , Lit + () + (Right (Plain ",")) + ]) + , Annotated.Group + () + (Annotated.Append + () + [ Annotated.Group + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain + "~~")) + , Wrap + () + (Lit + () + (Right + (Plain + "strikethrough"))) + , Lit + () + (Right + (Plain + "~~")) + ]) + , Lit + () + (Right (Plain ",")) + ]) + , Lit + () (Right (Plain "or")) + , Annotated.Group + () + (Annotated.Append + () + [ Lit + () + (Right (Plain "`")) + , Lit + () + (Right + (Plain + "monospaced")) + , Lit + () + (Right (Plain "`")) + ]) + , Lit + () (Right (Plain "(or")) + , Annotated.Group + () + (Annotated.Append + () + [ Annotated.Group + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain "`")) + , Lit + () + (Right + (Plain + "monospaced")) + , Lit + () + (Right + (Plain "`")) + ]) + , Lit + () + (Right + (Plain ").")) + ]) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () (Right (Plain "You")) + , Lit + () (Right (Plain "can")) + , Lit + () + (Right (Plain "link")) + , Lit + () (Right (Plain "to")) + , Lit + () + (Right (Plain "Unison")) + , Lit + () + (Right (Plain "terms,")) + , Lit + () + (Right (Plain "types,")) + , Lit + () (Right (Plain "and")) + , Lit + () + (Right + (Plain "external")) + , Lit + () + (Right (Plain "URLs:")) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Annotated.Group + () + (Annotated.Append + () + [ Indent + () + (Lit + () + (Right (Plain "* "))) + (Lit + () + (Right (Plain " "))) + (Wrap + () + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (Underline + (Plain + "An"))) + , Lit + () + (Right + (Underline + (Plain + "external"))) + , Lit + () + (Right + (Underline + (Plain + "url"))) + ]))) + , Lit + () (Right (Plain "\n")) + , Indent + () + (Lit + () + (Right (Plain "* "))) + (Lit + () + (Right (Plain " "))) + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Left + (SpecialForm.Link + (Right + (Term.Term + (Any + (do + Some)))))) + , Lit + () + (Right + (Plain "is")) + , Lit + () + (Right + (Plain "a")) + , Lit + () + (Right + (Plain "term")) + , Lit + () + (Right + (Plain "link;")) + , Lit + () + (Left + (SpecialForm.Link + (Left + (typeLink Optional)))) + , Lit + () + (Right + (Plain "is")) + , Lit + () + (Right + (Plain "a")) + , Lit + () + (Right + (Plain "type")) + , Lit + () + (Right + (Plain "link")) + ])) + , Lit + () (Right (Plain "\n")) + , Indent + () + (Lit + () + (Right (Plain "* "))) + (Lit + () + (Right (Plain " "))) + (Wrap + () + (Annotated.Append + () + [ Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (Underline + (Plain + "A"))) + , Lit + () + (Right + (Underline + (Plain + "named"))) + , Lit + () + (Right + (Underline + (Plain + "type"))) + , Lit + () + (Right + (Underline + (Plain + "link"))) + ]) + , Lit + () + (Right + (Plain "and")) + , Annotated.Group + () + (Annotated.Append + () + [ Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (Underline + (Plain + "a"))) + , Lit + () + (Right + (Underline + (Plain + "named"))) + , Lit + () + (Right + (Underline + (Plain + "term"))) + , Lit + () + (Right + (Underline + (Plain + "link"))) + ]) + , Lit + () + (Right + (Plain + ".")) + ]) + , Lit + () + (Right + (Plain "Term")) + , Lit + () + (Right + (Plain "links")) + , Lit + () + (Right + (Plain "are")) + , Lit + () + (Right + (Plain "handy")) + , Lit + () + (Right + (Plain "for")) + , Lit + () + (Right + (Plain + "linking")) + , Lit + () + (Right + (Plain "to")) + , Lit + () + (Right + (Plain "other")) + , Lit + () + (Right + (Plain + "documents!")) + ])) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () (Right (Plain "You")) + , Lit + () (Right (Plain "can")) + , Lit + () (Right (Plain "use")) + , Annotated.Group + () + (Annotated.Append + () + [ Lit + () + (Right (Plain "`")) + , Lit + () + (Right + (Plain + "{{ .. }}")) + , Lit + () + (Right (Plain "`")) + ]) + , Lit + () (Right (Plain "to")) + , Lit + () + (Right (Plain "escape")) + , Lit + () (Right (Plain "out")) + , Lit + () (Right (Plain "to")) + , Lit + () + (Right (Plain "regular")) + , Lit + () + (Right (Plain "Unison")) + , Lit + () + (Right (Plain "syntax,")) + , Lit + () (Right (Plain "for")) + , Lit + () + (Right + (Plain "instance")) + , Annotated.Group + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain + "__not bold__")) + , Lit + () + (Right (Plain ".")) + ]) + , Lit + () + (Right (Plain "This")) + , Lit + () (Right (Plain "is")) + , Lit + () + (Right (Plain "useful")) + , Lit + () (Right (Plain "for")) + , Lit + () + (Right + (Plain "creating")) + , Lit + () + (Right + (Plain "documents")) + , Lit + () + (Right + (Plain + "programmatically")) + , Lit + () (Right (Plain "or")) + , Lit + () + (Right (Plain "just")) + , Lit + () + (Right + (Plain "including")) + , Lit + () + (Right (Plain "other")) + , Lit + () + (Right + (Plain "documents.")) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Annotated.Group + () + (Annotated.Append + () + [ Lit + () + (Right (Plain "*")) + , Lit + () + (Right + (Plain "Next")) + ]) + , Annotated.Group + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain "up:")) + , Lit + () + (Right (Plain "*")) + ]) + , Lit + () + (Left + (SpecialForm.Link + (Right + (Term.Term + (Any (do lists)))))) + ]))) + ])))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Group + () + (Annotated.Append + () + [ Indent + () + (Lit () (Right (Plain "# "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Lit + () + (Right + (ConsoleText.Bold + (Plain "Lists")))))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Annotated.Group + () + (Annotated.Append + () + [ Indent + () + (Lit + () + (Right (Plain "# "))) + (Lit + () + (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (ConsoleText.Bold + (Plain + "Bulleted"))) + , Lit + () + (Right + (ConsoleText.Bold + (Plain + "lists"))) + ]))) + , Lit + () (Right (Plain "\n")) + , Lit + () (Right (Plain "\n")) + , Indent + () + (Lit + () + (Right (Plain " "))) + (Lit + () + (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain + "Bulleted")) + , Lit + () + (Right + (Plain + "lists")) + , Lit + () + (Right + (Plain "can")) + , Lit + () + (Right + (Plain "use")) + , Annotated.Group + () + (Annotated.Append + () + [ Annotated.Group + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain + "`")) + , Lit + () + (Right + (Plain + "+")) + , Lit + () + (Right + (Plain + "`")) + ]) + , Lit + () + (Right + (Plain + ",")) + ]) + , Annotated.Group + () + (Annotated.Append + () + [ Annotated.Group + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain + "`")) + , Lit + () + (Right + (Plain + "-")) + , Lit + () + (Right + (Plain + "`")) + ]) + , Lit + () + (Right + (Plain + ",")) + ]) + , Lit + () + (Right + (Plain "or")) + , Annotated.Group + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain + "`")) + , Lit + () + (Right + (Plain + "*")) + , Lit + () + (Right + (Plain + "`")) + ]) + , Lit + () + (Right + (Plain "for")) + , Lit + () + (Right + (Plain "the")) + , Lit + () + (Right + (Plain + "bullets")) + , Lit + () + (Right + (Plain + "(though")) + , Lit + () + (Right + (Plain "the")) + , Lit + () + (Right + (Plain + "choice")) + , Lit + () + (Right + (Plain + "will")) + , Lit + () + (Right + (Plain "be")) + , Lit + () + (Right + (Plain + "normalized")) + , Lit + () + (Right + (Plain + "away")) + , Lit + () + (Right + (Plain "by")) + , Lit + () + (Right + (Plain "the")) + , Lit + () + (Right + (Plain + "pretty-printer).")) + , Lit + () + (Right + (Plain + "They")) + , Lit + () + (Right + (Plain "can")) + , Lit + () + (Right + (Plain "be")) + , Lit + () + (Right + (Plain + "nested,")) + , Lit + () + (Right + (Plain "to")) + , Lit + () + (Right + (Plain "any")) + , Lit + () + (Right + (Plain + "depth:")) + ]))) + , Lit + () (Right (Plain "\n")) + , Lit + () (Right (Plain "\n")) + , Indent + () + (Lit + () + (Right (Plain " "))) + (Lit + () + (Right (Plain " "))) + (Annotated.Group + () + (Annotated.Group + () + (Annotated.Append + () + [ Indent + () + (Lit + () + (Right + (Plain + "* "))) + (Lit + () + (Right + (Plain + " "))) + (Wrap + () + (Lit + () + (Right + (Plain + "A")))) + , Lit + () + (Right + (Plain "\n")) + , Indent + () + (Lit + () + (Right + (Plain + "* "))) + (Lit + () + (Right + (Plain + " "))) + (Wrap + () + (Lit + () + (Right + (Plain + "B")))) + , Lit + () + (Right + (Plain "\n")) + , Indent + () + (Lit + () + (Right + (Plain + "* "))) + (Lit + () + (Right + (Plain + " "))) + (Annotated.Append + () + [ Wrap + () + (Lit + () + (Right + (Plain + "C"))) + , Lit + () + (Right + (Plain + "\n")) + , Annotated.Group + () + (Annotated.Append + () + [ Indent + () + (Lit + ( + ) + (Right + (Plain + "* "))) + (Lit + ( + ) + (Right + (Plain + " "))) + (Wrap + ( + ) + (Lit + ( + ) + (Right + (Plain + "C1")))) + , Lit + () + (Right + (Plain + "\n")) + , Indent + () + (Lit + ( + ) + (Right + (Plain + "* "))) + (Lit + ( + ) + (Right + (Plain + " "))) + (Wrap + ( + ) + (Lit + ( + ) + (Right + (Plain + "C2")))) + ]) + ]) + ]))) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Annotated.Group + () + (Annotated.Append + () + [ Indent + () + (Lit + () + (Right (Plain "# "))) + (Lit + () + (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (ConsoleText.Bold + (Plain + "Numbered"))) + , Lit + () + (Right + (ConsoleText.Bold + (Plain + "lists"))) + ]))) + , Lit + () (Right (Plain "\n")) + , Lit + () (Right (Plain "\n")) + , Indent + () + (Lit + () + (Right (Plain " "))) + (Lit + () + (Right (Plain " "))) + (Annotated.Group + () + (Annotated.Group + () + (Annotated.Append + () + [ Indent + () + (Lit + () + (Right + (Plain + "1. "))) + (Lit + () + (Right + (Plain + " "))) + (Wrap + () + (Lit + () + (Right + (Plain + "A")))) + , Lit + () + (Right + (Plain "\n")) + , Indent + () + (Lit + () + (Right + (Plain + "2. "))) + (Lit + () + (Right + (Plain + " "))) + (Wrap + () + (Lit + () + (Right + (Plain + "B")))) + , Lit + () + (Right + (Plain "\n")) + , Indent + () + (Lit + () + (Right + (Plain + "3. "))) + (Lit + () + (Right + (Plain + " "))) + (Wrap + () + (Lit + () + (Right + (Plain + "C")))) + ]))) + , Lit + () (Right (Plain "\n")) + , Lit + () (Right (Plain "\n")) + , Indent + () + (Lit + () + (Right (Plain " "))) + (Lit + () + (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain "The")) + , Lit + () + (Right + (Plain + "first")) + , Lit + () + (Right + (Plain + "number")) + , Lit + () + (Right + (Plain "of")) + , Lit + () + (Right + (Plain "the")) + , Lit + () + (Right + (Plain + "list")) + , Lit + () + (Right + (Plain + "determines")) + , Lit + () + (Right + (Plain "the")) + , Lit + () + (Right + (Plain + "starting")) + , Lit + () + (Right + (Plain + "number")) + , Lit + () + (Right + (Plain "in")) + , Lit + () + (Right + (Plain "the")) + , Lit + () + (Right + (Plain + "rendered")) + , Lit + () + (Right + (Plain + "output.")) + , Lit + () + (Right + (Plain "The")) + , Lit + () + (Right + (Plain + "other")) + , Lit + () + (Right + (Plain + "numbers")) + , Lit + () + (Right + (Plain "are")) + , Lit + () + (Right + (Plain + "ignored:")) + ]))) + , Lit + () (Right (Plain "\n")) + , Lit + () (Right (Plain "\n")) + , Indent + () + (Lit + () + (Right (Plain " "))) + (Lit + () + (Right (Plain " "))) + (Annotated.Group + () + (Annotated.Group + () + (Annotated.Append + () + [ Indent + () + (Lit + () + (Right + (Plain + "10. "))) + (Lit + () + (Right + (Plain + " "))) + (Wrap + () + (Lit + () + (Right + (Plain + "A")))) + , Lit + () + (Right + (Plain "\n")) + , Indent + () + (Lit + () + (Right + (Plain + "11. "))) + (Lit + () + (Right + (Plain + " "))) + (Wrap + () + (Lit + () + (Right + (Plain + "B")))) + , Lit + () + (Right + (Plain "\n")) + , Indent + () + (Lit + () + (Right + (Plain + "12. "))) + (Lit + () + (Right + (Plain + " "))) + (Wrap + () + (Lit + () + (Right + (Plain + "C")))) + ]))) + , Lit + () (Right (Plain "\n")) + , Lit + () (Right (Plain "\n")) + , Indent + () + (Lit + () + (Right (Plain " "))) + (Lit + () + (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain + "Numbered")) + , Lit + () + (Right + (Plain + "lists")) + , Lit + () + (Right + (Plain "can")) + , Lit + () + (Right + (Plain "be")) + , Lit + () + (Right + (Plain + "nested")) + , Lit + () + (Right + (Plain "as")) + , Lit + () + (Right + (Plain + "well,")) + , Lit + () + (Right + (Plain "and")) + , Lit + () + (Right + (Plain + "combined")) + , Lit + () + (Right + (Plain + "with")) + , Lit + () + (Right + (Plain + "bulleted")) + , Lit + () + (Right + (Plain + "lists:")) + ]))) + , Lit + () (Right (Plain "\n")) + , Lit + () (Right (Plain "\n")) + , Indent + () + (Lit + () + (Right (Plain " "))) + (Lit + () + (Right (Plain " "))) + (Annotated.Group + () + (Annotated.Group + () + (Annotated.Append + () + [ Indent + () + (Lit + () + (Right + (Plain + "1. "))) + (Lit + () + (Right + (Plain + " "))) + (Annotated.Append + () + [ Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain + "Wake")) + , Lit + () + (Right + (Plain + "up.")) + ]) + , Lit + () + (Right + (Plain + "\n")) + , Annotated.Group + () + (Annotated.Append + () + [ Indent + () + (Lit + ( + ) + (Right + (Plain + "* "))) + (Lit + ( + ) + (Right + (Plain + " "))) + (Wrap + ( + ) + (Annotated.Append + ( + ) + [ Lit + ( + ) + (Right + (Plain + "What")) + , Lit + ( + ) + (Right + (Plain + "am")) + , Lit + ( + ) + (Right + (Plain + "I")) + , Lit + ( + ) + (Right + (Plain + "doing")) + , Lit + ( + ) + (Right + (Plain + "here?")) + ])) + , Lit + () + (Right + (Plain + "\n")) + , Indent + () + (Lit + ( + ) + (Right + (Plain + "* "))) + (Lit + ( + ) + (Right + (Plain + " "))) + (Wrap + ( + ) + (Annotated.Append + ( + ) + [ Lit + ( + ) + (Right + (Plain + "In")) + , Lit + ( + ) + (Right + (Plain + "this")) + , Lit + ( + ) + (Right + (Plain + "nested")) + , Lit + ( + ) + (Right + (Plain + "list.")) + ])) + ]) + ]) + , Lit + () + (Right + (Plain "\n")) + , Indent + () + (Lit + () + (Right + (Plain + "2. "))) + (Lit + () + (Right + (Plain + " "))) + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain + "Take")) + , Lit + () + (Right + (Plain + "shower.")) + ])) + , Lit + () + (Right + (Plain "\n")) + , Indent + () + (Lit + () + (Right + (Plain + "3. "))) + (Lit + () + (Right + (Plain + " "))) + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain + "Get")) + , Lit + () + (Right + (Plain + "dressed.")) + ])) + ]))) + ]))) + ])))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Group + () + (Annotated.Append + () + [ Indent + () + (Lit () (Right (Plain "# "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Lit + () + (Right + (ConsoleText.Bold + (Plain "Evaluation")))))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain "Expressions")) + , Lit + () (Right (Plain "can")) + , Lit + () (Right (Plain "be")) + , Lit + () + (Right + (Plain "evaluated")) + , Lit + () + (Right (Plain "inline,")) + , Lit + () (Right (Plain "for")) + , Lit + () + (Right + (Plain "instance")) + , Annotated.Group + () + (Annotated.Append + () + [ Lit + () + (Left + (EvalInline + (Term.Term + (Any + (do + 1 + Nat.+ 1))))) + , Lit + () + (Right (Plain ".")) + ]) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right (Plain "Blocks")) + , Lit + () (Right (Plain "of")) + , Lit + () + (Right (Plain "code")) + , Lit + () (Right (Plain "can")) + , Lit + () (Right (Plain "be")) + , Lit + () + (Right + (Plain "evaluated")) + , Lit + () (Right (Plain "as")) + , Lit + () + (Right (Plain "well,")) + , Lit + () (Right (Plain "for")) + , Lit + () + (Right + (Plain "instance:")) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () (Lit + () (Left + (Eval + (Term.Term + (Any + (do + id x = x + id (sqr 10)))))))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Lit + () (Right (Plain "also:"))))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () (Lit + () (Left + (Eval + (Term.Term + (Any + (do match 1 with + 1 -> "hi" + _ -> "goodbye"))))))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () (Right (Plain "To")) + , Lit + () + (Right (Plain "include")) + , Lit () (Right (Plain "a")) + , Lit + () + (Right + (Plain "typechecked")) + , Lit + () + (Right (Plain "snippet")) + , Lit + () (Right (Plain "of")) + , Lit + () + (Right (Plain "code")) + , Lit + () + (Right (Plain "without")) + , Lit + () + (Right + (Plain "evaluating")) + , Lit + () (Right (Plain "it,")) + , Lit + () (Right (Plain "you")) + , Lit + () (Right (Plain "can")) + , Lit + () (Right (Plain "do:")) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () (Lit + () (Left + (ExampleBlock + 0 (Term.Term + (Any + (do + use Nat * + cube : Nat -> Nat + cube x = x * x * x + ()))))))) + ])))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Group + () + (Annotated.Append + () + [ Indent + () + (Lit () (Right (Plain "# "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (ConsoleText.Bold + (Plain "Including"))) + , Lit + () + (Right + (ConsoleText.Bold + (Plain "Unison"))) + , Lit + () + (Right + (ConsoleText.Bold + (Plain "source"))) + , Lit + () + (Right + (ConsoleText.Bold + (Plain "code"))) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right (Plain "Unison")) + , Lit + () + (Right + (Plain "definitions")) + , Lit + () (Right (Plain "can")) + , Lit + () (Right (Plain "be")) + , Lit + () + (Right + (Plain "included")) + , Lit + () (Right (Plain "in")) + , Lit + () + (Right (Plain "docs.")) + , Lit + () (Right (Plain "For")) + , Lit + () + (Right + (Plain "instance:")) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Lit + () + (Left + (SpecialForm.Source + [ ( Left + (typeLink Optional) + , [] + ) + , ( Right + (Term.Term + (Any (do sqr))) + , [] + ) + ]))))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right (Plain "Some")) + , Lit + () + (Right + (Plain "rendering")) + , Lit + () + (Right (Plain "targets")) + , Lit + () + (Right (Plain "also")) + , Lit + () + (Right (Plain "support")) + , Lit + () + (Right (Plain "folded")) + , Lit + () + (Right (Plain "source:")) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Lit + () + (Left + (FoldedSource + [ ( Left + (typeLink Optional) + , [] + ) + , ( Right + (Term.Term + (Any (do sqr))) + , [] + ) + ]))))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () (Right (Plain "You")) + , Lit + () (Right (Plain "can")) + , Lit + () + (Right (Plain "also")) + , Lit + () + (Right (Plain "include")) + , Lit + () + (Right (Plain "just")) + , Lit () (Right (Plain "a")) + , Lit + () + (Right + (Plain "signature,")) + , Lit + () + (Right (Plain "inline,")) + , Lit + () + (Right (Plain "with")) + , Annotated.Group + () + (Annotated.Append + () + [ Lit + () + (Left + (SignatureInline + (Term.Term + (Any + (do sqr))))) + , Lit + () + (Right (Plain ",")) + ]) + , Lit + () (Right (Plain "or")) + , Lit + () (Right (Plain "you")) + , Lit + () (Right (Plain "can")) + , Lit + () + (Right (Plain "include")) + , Lit + () (Right (Plain "one")) + , Lit + () (Right (Plain "or")) + , Lit + () + (Right (Plain "more")) + , Lit + () + (Right + (Plain "signatures")) + , Lit + () (Right (Plain "as")) + , Lit () (Right (Plain "a")) + , Lit + () + (Right (Plain "block:")) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Lit + () + (Left + (SpecialForm.Signature + [ Term.Term + (Any (do sqr)) + , Term.Term + (Any (do (Nat.+))) + ]))))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () (Right (Plain "Or")) + , Lit + () + (Right + (Plain "alternately:")) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Lit + () + (Left + (SpecialForm.Signature + [ Term.Term + (Any (do List.map)) + ]))))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Annotated.Group + () + (Annotated.Append + () + [ Indent + () + (Lit + () + (Right (Plain "# "))) + (Lit + () + (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (ConsoleText.Bold + (Plain + "Inline"))) + , Lit + () + (Right + (ConsoleText.Bold + (Plain + "snippets"))) + ]))) + , Lit + () (Right (Plain "\n")) + , Lit + () (Right (Plain "\n")) + , Indent + () + (Lit + () + (Right (Plain " "))) + (Lit + () + (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain "You")) + , Lit + () + (Right + (Plain "can")) + , Lit + () + (Right + (Plain + "include")) + , Lit + () + (Right + (Plain + "typechecked")) + , Lit + () + (Right + (Plain + "code")) + , Lit + () + (Right + (Plain + "snippets")) + , Lit + () + (Right + (Plain + "inline,")) + , Lit + () + (Right + (Plain "for")) + , Lit + () + (Right + (Plain + "instance:")) + ]))) + , Lit + () (Right (Plain "\n")) + , Lit + () (Right (Plain "\n")) + , Indent + () + (Lit + () + (Right (Plain " "))) + (Lit + () + (Right (Plain " "))) + (Annotated.Group + () + (Annotated.Group + () + (Annotated.Append + () + [ Indent + () + (Lit + () + (Right + (Plain + "* "))) + (Lit + () + (Right + (Plain + " "))) + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Left + (Example + 2 + (Term.Term + (Any + (do + f + x -> + f + x + Nat.+ sqr + 1))))) + , Lit + () + (Right + (Plain + "-")) + , Lit + () + (Right + (Plain + "the")) + , Annotated.Group + () + (Annotated.Append + () + [ Lit + ( + ) + (Right + (Plain + "`")) + , Lit + ( + ) + (Right + (Plain + "2")) + , Lit + ( + ) + (Right + (Plain + "`")) + ]) + , Lit + () + (Right + (Plain + "says")) + , Lit + () + (Right + (Plain + "to")) + , Lit + () + (Right + (Plain + "ignore")) + , Lit + () + (Right + (Plain + "the")) + , Lit + () + (Right + (Plain + "first")) + , Lit + () + (Right + (Plain + "two")) + , Lit + () + (Right + (Plain + "arguments")) + , Lit + () + (Right + (Plain + "when")) + , Lit + () + (Right + (Plain + "rendering.")) + , Lit + () + (Right + (Plain + "In")) + , Lit + () + (Right + (Plain + "richer")) + , Lit + () + (Right + (Plain + "renderers,")) + , Lit + () + (Right + (Plain + "the")) + , Annotated.Group + () + (Annotated.Append + () + [ Lit + ( + ) + (Right + (Plain + "`")) + , Lit + ( + ) + (Right + (Plain + "sqr")) + , Lit + ( + ) + (Right + (Plain + "`")) + ]) + , Lit + () + (Right + (Plain + "link")) + , Lit + () + (Right + (Plain + "will")) + , Lit + () + (Right + (Plain + "be")) + , Lit + () + (Right + (Plain + "clickable.")) + ])) + , Lit + () + (Right + (Plain "\n")) + , Indent + () + (Lit + () + (Right + (Plain + "* "))) + (Lit + () + (Right + (Plain + " "))) + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain + "If")) + , Lit + () + (Right + (Plain + "your")) + , Lit + () + (Right + (Plain + "snippet")) + , Lit + () + (Right + (Plain + "expression")) + , Lit + () + (Right + (Plain + "is")) + , Lit + () + (Right + (Plain + "just")) + , Lit + () + (Right + (Plain + "a")) + , Lit + () + (Right + (Plain + "single")) + , Lit + () + (Right + (Plain + "function")) + , Lit + () + (Right + (Plain + "application,")) + , Lit + () + (Right + (Plain + "you")) + , Lit + () + (Right + (Plain + "can")) + , Lit + () + (Right + (Plain + "put")) + , Lit + () + (Right + (Plain + "it")) + , Lit + () + (Right + (Plain + "in")) + , Lit + () + (Right + (Plain + "double")) + , Lit + () + (Right + (Plain + "backticks,")) + , Lit + () + (Right + (Plain + "like")) + , Lit + () + (Right + (Plain + "so:")) + , Annotated.Group + () + (Annotated.Append + () + [ Lit + ( + ) + (Left + (Example + 1 + (Term.Term + (Any + (do + x -> + sqr + x))))) + , Lit + ( + ) + (Right + (Plain + ".")) + ]) + , Lit + () + (Right + (Plain + "This")) + , Lit + () + (Right + (Plain + "is")) + , Lit + () + (Right + (Plain + "equivalent")) + , Lit + () + (Right + (Plain + "to")) + , Annotated.Group + () + (Annotated.Append + () + [ Lit + ( + ) + (Left + (Example + 1 + (Term.Term + (Any + (do + x -> + sqr + x))))) + , Lit + ( + ) + (Right + (Plain + ".")) + ]) + ])) + ]))) + ]))) + ])))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Group + () + (Annotated.Append + () + [ Indent + () + (Lit () (Right (Plain "# "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (ConsoleText.Bold + (Plain "Non-Unison"))) + , Lit + () + (Right + (ConsoleText.Bold + (Plain "code"))) + , Lit + () + (Right + (ConsoleText.Bold + (Plain "blocks"))) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () (Right (Plain "Use")) + , Lit + () + (Right (Plain "three")) + , Lit + () (Right (Plain "or")) + , Lit + () + (Right (Plain "more")) + , Lit + () + (Right (Plain "single")) + , Lit + () + (Right (Plain "quotes")) + , Lit + () (Right (Plain "to")) + , Lit + () + (Right (Plain "start")) + , Lit () (Right (Plain "a")) + , Lit + () + (Right (Plain "block")) + , Lit + () + (Right (Plain "with")) + , Lit + () (Right (Plain "no")) + , Lit + () + (Right (Plain "syntax")) + , Lit + () + (Right + (Plain "highlighting:")) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Group + () + (Annotated.Append + () + [ Lit + () + (Right (Plain "``` ")) + , Annotated.Group + () + (Lit + () + (Right (Plain "raw"))) + , Lit + () + (Right (Plain "\n")) + , Lit + () + (Right + (Plain + " _____ _ \n | | |___|_|___ ___ ___ \n | | | | |_ -| . | |\n |_____|_|_|_|___|___|_|_|\n ")) + , Lit + () + (Right (Plain "\n")) + , Lit + () + (Right (Plain "```")) + ])))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () (Right (Plain "You")) + , Lit + () (Right (Plain "can")) + , Lit + () (Right (Plain "use")) + , Lit + () + (Right (Plain "three")) + , Lit + () (Right (Plain "or")) + , Lit + () + (Right (Plain "more")) + , Lit + () + (Right + (Plain "backticks")) + , Lit + () + (Right (Plain "plus")) + , Lit () (Right (Plain "a")) + , Lit + () + (Right + (Plain "language")) + , Lit + () + (Right (Plain "name")) + , Lit + () (Right (Plain "for")) + , Lit + () + (Right (Plain "blocks")) + , Lit + () + (Right (Plain "with")) + , Lit + () + (Right (Plain "syntax")) + , Lit + () + (Right + (Plain "highlighting:")) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Annotated.Group + () + (Annotated.Append + () + [ Lit + () + (Right (Plain "``` ")) + , Annotated.Group + () + (Lit + () + (Right + (Plain "Haskell"))) + , Lit + () (Right (Plain "\n")) + , Lit + () + (Right + (Plain + "-- A fenced code block which isn't parsed by Unison\nreverse = foldl (flip (:)) []")) + , Lit + () (Right (Plain "\n")) + , Lit + () (Right (Plain "```")) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Annotated.Group + () + (Annotated.Append + () + [ Lit + () + (Right (Plain "``` ")) + , Annotated.Group + () + (Lit + () + (Right (Plain "Scala"))) + , Lit + () (Right (Plain "\n")) + , Lit + () + (Right + (Plain + "// A fenced code block which isn't parsed by Unison\ndef reverse[A](xs: List[A]) = \n xs.foldLeft(Nil : List[A])((acc,a) => a +: acc)")) + , Lit + () (Right (Plain "\n")) + , Lit + () (Right (Plain "```")) + ]))) + ])))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Indent + () + (Lit () (Right (Plain " "))) + (Lit () (Right (Plain " "))) + (Annotated.Group + () + (Wrap + () + (Annotated.Group + () + (Annotated.Append + () + [ Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () (Right (Plain "There")) + , Lit () (Right (Plain "are")) + , Lit + () (Right (Plain "also")) + , Lit + () + (Right (Plain "asides,")) + , Lit + () + (Right (Plain "callouts,")) + , Lit + () + (Right (Plain "tables,")) + , Lit + () + (Right (Plain "tooltips,")) + , Lit () (Right (Plain "and")) + , Lit + () (Right (Plain "more.")) + , Lit + () (Right (Plain "These")) + , Lit + () (Right (Plain "don't")) + , Lit + () + (Right (Plain "currently")) + , Lit + () (Right (Plain "have")) + , Lit + () + (Right (Plain "special")) + , Lit + () + (Right (Plain "syntax;")) + , Lit + () (Right (Plain "just")) + , Lit () (Right (Plain "use")) + , Lit () (Right (Plain "the")) + , Annotated.Group + () + (Annotated.Append + () + [ Lit + () + (Right (Plain "`")) + , Lit + () + (Right + (Plain "{{ }}")) + , Lit + () + (Right (Plain "`")) + ]) + , Lit + () + (Right (Plain "syntax")) + , Lit () (Right (Plain "to")) + , Lit + () (Right (Plain "call")) + , Lit + () (Right (Plain "these")) + , Lit + () + (Right (Plain "functions")) + , Lit + () + (Right (Plain "directly.")) + ])) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Annotated.Group + () + (Wrap + () + (Lit + () + (Left + (SpecialForm.Signature + [ Term.Term + (Any (do docAside)) + , Term.Term + (Any (do docCallout)) + , Term.Term + (Any + (do docBlockquote)) + , Term.Term + (Any (do docTooltip)) + , Term.Term + (Any (do docTable)) + ])))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () (Right (Plain "This")) + , Lit () (Right (Plain "is")) + , Lit () (Right (Plain "an")) + , Lit + () + (Right (Plain "aside.")) + , Lit + () + (Right + (Foreground + BrightBlack + (Plain "("))) + , Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (Foreground + BrightBlack + (Plain "Some"))) + , Lit + () + (Right + (Foreground + BrightBlack + (Plain "extra"))) + , Lit + () + (Right + (Foreground + BrightBlack + (Plain "detail"))) + , Lit + () + (Right + (Foreground + BrightBlack + (Plain "that"))) + , Lit + () + (Right + (Foreground + BrightBlack + (Plain "doesn't"))) + , Lit + () + (Right + (Foreground + BrightBlack + (Plain "belong"))) + , Lit + () + (Right + (Foreground + BrightBlack + (Plain "in"))) + , Lit + () + (Right + (Foreground + BrightBlack + (Plain "main"))) + , Lit + () + (Right + (Foreground + BrightBlack + (Plain "text."))) + ]) + , Lit + () + (Right + (Foreground + BrightBlack + (Plain ")"))) + ])) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Annotated.Group + () + (Wrap + () + (Annotated.Group + () + (Indent + () + (Lit + () (Right (Plain " | "))) + (Lit + () (Right (Plain " | "))) + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain "This")) + , Lit + () + (Right (Plain "is")) + , Lit + () + (Right (Plain "an")) + , Lit + () + (Right + (Plain "important")) + , Lit + () + (Right + (Plain "callout,")) + , Lit + () + (Right + (Plain "with")) + , Lit + () + (Right (Plain "no")) + , Lit + () + (Right + (Plain "icon.")) + ]))))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Annotated.Group + () + (Wrap + () + (Annotated.Group + () + (Indent + () + (Lit + () (Right (Plain " | "))) + (Lit + () (Right (Plain " | "))) + (Annotated.Append + () + [ Wrap + () + (Lit + () + (Right + (ConsoleText.Bold + (Plain "🌻")))) + , Lit + () + (Right (Plain "\n")) + , Lit + () (Right (Plain "")) + , Lit + () + (Right (Plain "\n")) + , Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain "This")) + , Lit + () + (Right + (Plain "is")) + , Lit + () + (Right + (Plain "an")) + , Lit + () + (Right + (Plain + "important")) + , Lit + () + (Right + (Plain + "callout,")) + , Lit + () + (Right + (Plain "with")) + , Lit + () + (Right + (Plain "an")) + , Lit + () + (Right + (Plain "icon.")) + , Lit + () + (Right + (Plain "The")) + , Lit + () + (Right + (Plain "text")) + , Lit + () + (Right + (Plain "wraps")) + , Lit + () + (Right + (Plain "onto")) + , Lit + () + (Right + (Plain + "multiple")) + , Lit + () + (Right + (Plain + "lines.")) + ]) + ])))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Annotated.Group + () + (Wrap + () + (Annotated.Group + () + (Indent + () + (Lit () (Right (Plain "> "))) + (Lit () (Right (Plain "> "))) + (Annotated.Group + () + (Annotated.Append + () + [ Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain + "\"And")) + , Lit + () + (Right + (Plain + "what")) + , Lit + () + (Right + (Plain + "is")) + , Lit + () + (Right + (Plain + "the")) + , Lit + () + (Right + (Plain + "use")) + , Lit + () + (Right + (Plain + "of")) + , Lit + () + (Right + (Plain "a")) + , Lit + () + (Right + (Plain + "book,\"")) + , Lit + () + (Right + (Plain + "thought")) + , Lit + () + (Right + (Plain + "Alice,")) + , Lit + () + (Right + (Plain + "\"without")) + , Lit + () + (Right + (Plain + "pictures")) + , Lit + () + (Right + (Plain + "or")) + , Lit + () + (Right + (Plain + "conversation?\"")) + ])) + , Lit + () + (Right (Plain "\n")) + , Lit + () + (Right (Plain "\n")) + , Annotated.Group + () + (Wrap + () + (Annotated.Append + () + [ Annotated.Group + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain + "*")) + , Lit + () + (Right + (Plain + "Lewis")) + ]) + , Lit + () + (Right + (Plain + "Carroll,")) + , Lit + () + (Right + (Plain + "Alice's")) + , Lit + () + (Right + (Plain + "Adventures")) + , Lit + () + (Right + (Plain + "in")) + , Annotated.Group + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain + "Wonderland")) + , Lit + () + (Right + (Plain + "*")) + ]) + ])) + ]))))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Annotated.Group + () + (Wrap + () + (Wrap + () + (Annotated.Append + () + [ Lit + () + (Right (Plain "Hover")) + , Lit + () + (Right (Plain "over")) + , Lit + () (Right (Plain "me")) + ]))) + , Lit () (Right (Plain "\n")) + , Lit () (Right (Plain "\n")) + , Annotated.Group + () + (Wrap + () + (Annotated.Table + () + [ [ Wrap + () + (Lit + () (Right (Plain "a"))) + , Wrap + () + (Lit + () (Right (Plain "b"))) + , Wrap + () + (Annotated.Append + () + [ Lit + () + (Right (Plain "A")) + , Lit + () + (Right + (Plain "longer")) + , Lit + () + (Right + (Plain + "paragraph")) + , Lit + () + (Right + (Plain "that")) + , Lit + () + (Right + (Plain "will")) + , Lit + () + (Right + (Plain "split")) + , Lit + () + (Right + (Plain "onto")) + , Lit + () + (Right + (Plain + "multiple")) + , Lit + () + (Right + (Plain "lines,")) + , Lit + () + (Right + (Plain "such")) + , Lit + () + (Right + (Plain "that")) + , Lit + () + (Right + (Plain "this")) + , Lit + () + (Right + (Plain "row")) + , Lit + () + (Right + (Plain + "occupies")) + , Lit + () + (Right + (Plain + "multiple")) + , Lit + () + (Right + (Plain "lines")) + , Lit + () + (Right + (Plain "in")) + , Lit + () + (Right + (Plain "the")) + , Lit + () + (Right + (Plain + "rendered")) + , Lit + () + (Right + (Plain "table.")) + ]) + ] + , [ Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain "Some")) + , Lit + () + (Right + (Plain "text")) + ]) + , Wrap + () + (Annotated.Append + () + [ Lit + () + (Right + (Plain "More")) + , Lit + () + (Right + (Plain "text")) + ]) + , Wrap + () + (Lit + () + (Right + (Plain "Zounds!"))) + ] + ])) + ])))) + ]) +```` diff --git a/unison-src/transcripts/idempotent/builtins-merge.md b/unison-src/transcripts/idempotent/builtins-merge.md new file mode 100644 index 0000000000..27da76caaa --- /dev/null +++ b/unison-src/transcripts/idempotent/builtins-merge.md @@ -0,0 +1,90 @@ +The `builtins.merge` command adds the known builtins to the specified subnamespace within the current namespace. + +``` ucm +scratch/main> builtins.merge builtins + + Done. + +scratch/main> ls builtins + + 1. Any (builtin type) + 2. Any/ (2 terms) + 3. Boolean (builtin type) + 4. Boolean/ (1 term) + 5. Bytes (builtin type) + 6. Bytes/ (34 terms) + 7. Char (builtin type) + 8. Char/ (22 terms, 1 type) + 9. ClientSockAddr (builtin type) + 10. Code (builtin type) + 11. Code/ (9 terms) + 12. Debug/ (3 terms) + 13. Doc (type) + 14. Doc/ (6 terms) + 15. Either (type) + 16. Either/ (2 terms) + 17. Exception (type) + 18. Exception/ (1 term) + 19. Float (builtin type) + 20. Float/ (38 terms) + 21. Handle/ (1 term) + 22. ImmutableArray (builtin type) + 23. ImmutableArray/ (3 terms) + 24. ImmutableByteArray (builtin type) + 25. ImmutableByteArray/ (8 terms) + 26. Int (builtin type) + 27. Int/ (31 terms) + 28. IsPropagated (type) + 29. IsPropagated/ (1 term) + 30. IsTest (type) + 31. IsTest/ (1 term) + 32. Link (type) + 33. Link/ (3 terms, 2 types) + 34. List (builtin type) + 35. List/ (10 terms) + 36. ListenSocket (builtin type) + 37. MutableArray (builtin type) + 38. MutableArray/ (6 terms) + 39. MutableByteArray (builtin type) + 40. MutableByteArray/ (14 terms) + 41. Nat (builtin type) + 42. Nat/ (28 terms) + 43. Optional (type) + 44. Optional/ (2 terms) + 45. Pattern (builtin type) + 46. Pattern/ (9 terms) + 47. Ref (builtin type) + 48. Ref/ (2 terms) + 49. Request (builtin type) + 50. RewriteCase (type) + 51. RewriteCase/ (1 term) + 52. RewriteSignature (type) + 53. RewriteSignature/ (1 term) + 54. RewriteTerm (type) + 55. RewriteTerm/ (1 term) + 56. Rewrites (type) + 57. Rewrites/ (1 term) + 58. Scope (builtin type) + 59. Scope/ (6 terms) + 60. SeqView (type) + 61. SeqView/ (2 terms) + 62. Socket/ (1 term) + 63. Test/ (2 terms, 1 type) + 64. Text (builtin type) + 65. Text/ (34 terms) + 66. ThreadId/ (1 term) + 67. Tuple (type) + 68. Tuple/ (1 term) + 69. UDPSocket (builtin type) + 70. Unit (type) + 71. Unit/ (1 term) + 72. Universal/ (7 terms) + 73. Value (builtin type) + 74. Value/ (5 terms) + 75. bug (a -> b) + 76. crypto/ (17 terms, 2 types) + 77. io2/ (146 terms, 32 types) + 78. metadata/ (2 terms) + 79. todo (a -> b) + 80. unsafe/ (1 term) +``` diff --git a/unison-src/transcripts/idempotent/builtins.md b/unison-src/transcripts/idempotent/builtins.md new file mode 100644 index 0000000000..e36c81246d --- /dev/null +++ b/unison-src/transcripts/idempotent/builtins.md @@ -0,0 +1,615 @@ +# Unit tests for builtin functions + +``` ucm :hide +scratch/main> builtins.mergeio + +scratch/main> load unison-src/transcripts-using-base/base.u + +scratch/main> add +``` + +This transcript defines unit tests for builtin functions. There's a single `scratch/main> test` execution at the end that will fail the transcript with a nice report if any of the tests fail. + +## `Int` functions + +``` unison :hide +use Int + +-- used for some take/drop tests later +bigN = Nat.shiftLeft 1 63 + +-- Note: you can make the tests more fine-grained if you +-- want to be able to tell which one is failing +test> Int.tests.arithmetic = + checks [ + eq (+1 + +1) +2, + +10 - +4 == +6, + eq (+11 * +6) +66, + eq (+11 * +6) +66, + +10 / +3 == +3, + +10 / +5 == +2, + mod +10 +3 == +1, + mod +10 +2 == +0, + mod -13 +3 == +2, + mod -13 -3 == -1, + mod -13 -5 == -3, + mod -13 +5 == +2, + negate +99 == -99, + increment +99 == +100, + not (isEven +99), + isEven +100, + isOdd +105, + not (isOdd +108), + signum +99 == +1, + signum -3949 == -1, + signum +0 == +0, + gt +42 -1, + lt +42 +1000, + lteq +43 +43, + lteq +43 +44, + gteq +43 +43, + gteq +43 +41 + ] + +test> Int.tests.bitTwiddling = + checks [ + and +5 +4 == +4, + and +5 +1 == +1, + or +4 +1 == +5, + xor +5 +1 == +4, + complement -1 == +0, + popCount +1 == 1, + popCount +2 == 1, + popCount +4 == 1, + popCount +5 == 2, + popCount -1 == 64, + leadingZeros +1 == 63, + trailingZeros +1 == 0, + leadingZeros +2 == 62, + trailingZeros +2 == 1, + pow +2 6 == +64, + shiftLeft +1 6 == +64, + shiftRight +64 6 == +1 + ] + +test> Int.tests.conversions = + checks [ + truncate0 -2438344 == 0, + truncate0 +999 == 999, + toText +0 == "0", + toText +10 == "10", + toText -1039 == "-1039", + fromText "+0" == Some +0, + fromText "a8f9djasdlfkj" == None, + fromText "3940" == Some +3940, + fromText "1000000000000000000000000000" == None, + fromText "-1000000000000000000000000000" == None, + toFloat +9394 == 9394.0, + toFloat -20349 == -20349.0 + ] +``` + +``` ucm :hide +scratch/main> add +``` + +## `Nat` functions + +``` unison :hide +use Nat + +test> Nat.tests.arithmetic = + checks [ + eq (1 + 1) 2, + drop 10 4 == 6, + sub 10 12 == -2, + eq (11 * 6) 66, + 10 / 3 == 3, + 10 / 5 == 2, + mod 10 3 == 1, + mod 10 2 == 0, + 18446744073709551615 / 2 == 9223372036854775807, + mod 18446744073709551615 2 == 1, + increment 99 == 100, + not (isEven 99), + isEven 100, + isOdd 105, + not (isOdd 108), + gt 42 1, + lt 42 1000, + lteq 43 43, + lteq 43 44, + gteq 43 43, + gteq 43 41, + ] + +test> Nat.tests.bitTwiddling = + checks [ + and 5 4 == 4, + and 5 1 == 1, + or 4 1 == 5, + xor 5 1 == 4, + complement (complement 0) == 0, + popCount 1 == 1, + popCount 2 == 1, + popCount 4 == 1, + popCount 5 == 2, + popCount (complement 0) == 64, + leadingZeros 1 == 63, + trailingZeros 1 == 0, + leadingZeros 2 == 62, + trailingZeros 2 == 1, + pow 2 6 == 64, + shiftLeft 1 6 == 64, + shiftRight 64 6 == 1 + ] + +test> Nat.tests.conversions = + checks [ + toFloat 2438344 == 2438344.0, + toFloat 0 == 0.0, + toText 0 == "0", + toText 32939 == "32939", + toText 10 == "10", + fromText "ooga" == None, + fromText "90" == Some 90, + fromText "-1" == None, + fromText "100000000000000000000000000" == None, + unsnoc "abc" == Some ("ab", ?c), + uncons "abc" == Some (?a, "bc"), + unsnoc "" == None, + uncons "" == None, + Text.fromCharList (Text.toCharList "abc") == "abc", + Bytes.fromList (Bytes.toList 0xsACE0BA5E) == 0xsACE0BA5E + ] +``` + +``` ucm :hide +scratch/main> add +``` + +## `Boolean` functions + +``` unison :hide +test> Boolean.tests.orTable = + checks [ + (true || true) == true, + (true || false) == true, + (false || true) == true, + (false || false) == false + ] +test> Boolean.tests.andTable = + checks [ + (true && true) == true, + (false && true) == false, + (true && false) == false, + (false && false) == false + ] +test> Boolean.tests.notTable = + checks [ + not true == false, + not false == true + ] +``` + +``` ucm :hide +scratch/main> add +``` + +## `Text` functions + +``` unison :hide +test> Text.tests.takeDropAppend = + checks [ + "yabba" ++ "dabba" == "yabbadabba", + Text.take 0 "yabba" == "", + Text.take 2 "yabba" == "ya", + Text.take 99 "yabba" == "yabba", + Text.drop 0 "yabba" == "yabba", + Text.drop 2 "yabba" == "bba", + Text.drop 99 "yabba" == "", + Text.take bigN "yabba" == "yabba", + Text.drop bigN "yabba" == "" + ] + +test> Text.tests.repeat = + checks [ + Text.repeat 4 "o" == "oooo", + Text.repeat 0 "o" == "" + ] + +test> Text.tests.alignment = + checks [ + Text.alignLeftWith 5 ?\s "a" == "a ", + Text.alignRightWith 5 ?_ "ababa" == "ababa", + Text.alignRightWith 5 ?_ "ab" == "___ab" + ] + +test> Text.tests.literalsEq = checks [":)" == ":)"] + +test> Text.tests.patterns = + use Pattern many or run isMatch capture join replicate + use Text.patterns literal digit letter anyChar space punctuation notCharIn charIn charRange notCharRange eof + l = literal + checks [ + run digit "1abc" == Some ([], "abc"), + run (capture (many digit)) "11234abc" == Some (["11234"], "abc"), + run (many letter) "abc11234abc" == Some ([], "11234abc"), + run (join [many space, capture (many anyChar)]) " abc123" == Some (["abc123"], ""), + run (many punctuation) "!!!!,,,..." == Some ([], ""), + run (charIn [?0,?1]) "0" == Some ([], ""), + run (notCharIn [?0,?1]) "0" == None, + run (many (notCharIn [?0,?1])) "asjdfskdfjlskdjflskdjf011" == Some ([], "011"), + run (capture (many (charRange ?a ?z))) "hi123" == Some (["hi"], "123"), + run (capture (many (notCharRange ?, ?,))) "abc123," == Some (["abc123"], ","), + run (capture (many (notCharIn [?,,]))) "abracadabra,123" == Some (["abracadabra"], ",123"), + run (capture (many (or digit letter))) "11234abc,remainder" == Some (["11234abc"], ",remainder"), + run (capture (replicate 1 5 (or digit letter))) "1a2ba aaa" == Some (["1a2ba"], " aaa"), + run (captureAs "foo" (many (or digit letter))) "11234abc,remainder" == Some (["foo"], ",remainder"), + run (join [(captureAs "foo" (many digit)), captureAs "bar" (many letter)]) "11234abc,remainder" == Some (["foo", "bar"], ",remainder"), + -- Regression test for: https://github.com/unisonweb/unison/issues/3530 + run (capture (replicate 0 1 (join [literal "a", literal "b"]))) "ac" == Some ([""], "ac"), + isMatch (join [many letter, eof]) "aaaaabbbb" == true, + isMatch (join [many letter, eof]) "aaaaabbbb1" == false, + isMatch (join [l "abra", many (l "cadabra")]) "abracadabracadabra" == true, + + ] + + +test> Text.tests.indexOf = + haystack = "01020304" ++ "05060708" ++ "090a0b0c01" + needle1 = "01" + needle2 = "02" + needle3 = "0304" + needle4 = "05" + needle5 = "0405" + needle6 = "0c" + needle7 = haystack + needle8 = "lopez" + needle9 = "" + checks [ + Text.indexOf needle1 haystack == Some 0, + Text.indexOf needle2 haystack == Some 2, + Text.indexOf needle3 haystack == Some 4, + Text.indexOf needle4 haystack == Some 8, + Text.indexOf needle5 haystack == Some 6, + Text.indexOf needle6 haystack == Some 22, + Text.indexOf needle7 haystack == Some 0, + Text.indexOf needle8 haystack == None, + Text.indexOf needle9 haystack == Some 0, + ] + +test> Text.tests.indexOfEmoji = + haystack = "clap 👏 your 👏 hands 👏 if 👏 you 👏 love 👏 unison" + needle1 = "👏" + needle2 = "👏 " + checks [ + Text.indexOf needle1 haystack == Some 5, + Text.indexOf needle2 haystack == Some 5, + ] + +``` + +``` ucm :hide +scratch/main> add +``` + +## `Bytes` functions + +``` unison :hide +test> Bytes.tests.at = + bs = Bytes.fromList [77, 13, 12] + checks [ + Bytes.at 1 bs == Some 13, + Bytes.at 0 bs == Some 77, + Bytes.at 99 bs == None, + Bytes.take bigN bs == bs, + Bytes.drop bigN bs == empty + ] + +test> Bytes.tests.compression = + roundTrip b = + (Bytes.zlib.decompress (Bytes.zlib.compress b) == Right b) + && (Bytes.gzip.decompress (Bytes.gzip.compress b) == Right b) + + checks [ + roundTrip 0xs2093487509823745709827345789023457892345, + roundTrip 0xs00000000000000000000000000000000000000000000, + roundTrip 0xs, + roundTrip 0xs11111111111111111111111111, + roundTrip 0xsffffffffffffffffffffffffffffff, + roundTrip 0xs222222222fffffffffffffffffffffffffffffff, + -- these fail due to bad checksums and/or headers + isLeft (zlib.decompress 0xs2093487509823745709827345789023457892345), + isLeft (gzip.decompress 0xs201209348750982374593939393939709827345789023457892345) + ] + +test> Bytes.tests.fromBase64UrlUnpadded = + checks [Exception.catch + '(fromUtf8 + (raiseMessage () (Bytes.fromBase64UrlUnpadded (toUtf8 "aGVsbG8gd29ybGQ")))) == Right "hello world" + , isLeft (Bytes.fromBase64UrlUnpadded (toUtf8 "aGVsbG8gd29ybGQ="))] + +test> Bytes.tests.indexOf = + haystack = 0xs01020304 ++ 0xs05060708 ++ 0xs090a0b0c01 + needle1 = 0xs01 + needle2 = 0xs02 + needle3 = 0xs0304 + needle4 = 0xs05 + needle5 = 0xs0405 + needle6 = 0xs0c + needle7 = haystack + needle8 = 0xsffffff + checks [ + Bytes.indexOf needle1 haystack == Some 0, + Bytes.indexOf needle2 haystack == Some 1, + Bytes.indexOf needle3 haystack == Some 2, + Bytes.indexOf needle4 haystack == Some 4, + Bytes.indexOf needle5 haystack == Some 3, + Bytes.indexOf needle6 haystack == Some 11, + Bytes.indexOf needle7 haystack == Some 0, + Bytes.indexOf needle8 haystack == None, + + ] + +``` + +``` ucm :hide +scratch/main> add +``` + +## `List` comparison + +``` unison :hide +test> checks [ + compare [] [1,2,3] == -1, + compare [1,2,3] [1,2,3,4] == -1, + compare [1,2,3,4] [1,2,3] == +1, + compare [1,2,3] [1,2,3] == +0, + compare [3] [1,2,3] == +1, + compare [1,2,3] [1,2,4] == -1, + compare [1,2,2] [1,2,1,2] == +1, + compare [1,2,3,4] [3,2,1] == -1 + ] +``` + +``` ucm :hide +scratch/main> add +``` + +Other list functions + +``` unison :hide +test> checks [ + List.take bigN [1,2,3] == [1,2,3], + List.drop bigN [1,2,3] == [] + ] +``` + +## `Any` functions + +``` unison +> [Any "hi", Any (41 + 1)] + +test> Any.test1 = checks [(Any "hi" == Any "hi")] +test> Any.test2 = checks [(not (Any "hi" == Any 42))] +``` + +``` ucm :added-by-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`: + + Any.test1 : [Result] + Any.test2 : [Result] + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | > [Any "hi", Any (41 + 1)] + ⧩ + [Any "hi", Any 42] + + 3 | test> Any.test1 = checks [(Any "hi" == Any "hi")] + + ✅ Passed Passed + + 4 | test> Any.test2 = checks [(not (Any "hi" == Any 42))] + + ✅ Passed Passed +``` + +``` ucm :hide +scratch/main> add +``` + +## Sandboxing functions + +``` unison +openFile1 t = openFile t +openFile2 t = openFile1 t + +validateSandboxedSimpl ok v = + match Value.validateSandboxed ok v with + Right [] -> true + _ -> false + +openFiles = + [ not (validateSandboxed [] openFile) + , not (validateSandboxed [] openFile1) + , not (validateSandboxed [] openFile2) + ] + +test> Sandbox.test1 = checks [validateSandboxed [] "hello"] +test> Sandbox.test2 = checks openFiles +test> Sandbox.test3 = checks [validateSandboxed [termLink openFile.impl] +openFile] +``` + +``` ucm :added-by-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`: + + Sandbox.test1 : [Result] + Sandbox.test2 : [Result] + Sandbox.test3 : [Result] + openFile1 : Text + -> FileMode + ->{IO, Exception} Handle + openFile2 : Text + -> FileMode + ->{IO, Exception} Handle + openFiles : [Boolean] + validateSandboxedSimpl : [Link.Term] + -> Value + ->{IO} Boolean + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 15 | test> Sandbox.test1 = checks [validateSandboxed [] "hello"] + + ✅ Passed Passed + + 16 | test> Sandbox.test2 = checks openFiles + + ✅ Passed Passed + + 17 | test> Sandbox.test3 = checks [validateSandboxed [termLink openFile.impl] + + ✅ Passed Passed +``` + +``` ucm :hide +scratch/main> add +``` + +``` unison +openFilesIO = do + checks + [ not (validateSandboxedSimpl [] (value openFile)) + , not (validateSandboxedSimpl [] (value openFile1)) + , not (validateSandboxedSimpl [] (value openFile2)) + , sandboxLinks (termLink openFile) + == sandboxLinks (termLink openFile1) + , sandboxLinks (termLink openFile1) + == sandboxLinks (termLink openFile2) + ] +``` + +``` ucm :added-by-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`: + + openFilesIO : '{IO} [Result] +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + openFilesIO : '{IO} [Result] + +scratch/main> io.test openFilesIO + + New test results: + + 1. openFilesIO ◉ Passed + + ✅ 1 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` + +## Universal hash functions + +Just exercises the function + +``` unison +> Universal.murmurHash 1 +test> Universal.murmurHash.tests = checks [Universal.murmurHash [1,2,3] == Universal.murmurHash [1,2,3]] +``` + +``` ucm :added-by-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`: + + Universal.murmurHash.tests : [Result] + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | > Universal.murmurHash 1 + ⧩ + 1208954131003843843 + + 2 | test> Universal.murmurHash.tests = checks [Universal.murmurHash [1,2,3] == Universal.murmurHash [1,2,3]] + + ✅ Passed Passed +``` + +``` ucm :hide +scratch/main> add +``` + +## Run the tests + +Now that all the tests have been added to the codebase, let's view the test report. This will fail the transcript (with a nice message) if any of the tests are failing. + +``` ucm +scratch/main> test + + Cached test results (`help testcache` to learn more) + + 1. Any.test1 ◉ Passed + 2. Any.test2 ◉ Passed + 3. Boolean.tests.andTable ◉ Passed + 4. Boolean.tests.notTable ◉ Passed + 5. Boolean.tests.orTable ◉ Passed + 6. Bytes.tests.at ◉ Passed + 7. Bytes.tests.compression ◉ Passed + 8. Bytes.tests.fromBase64UrlUnpadded ◉ Passed + 9. Bytes.tests.indexOf ◉ Passed + 10. Int.tests.arithmetic ◉ Passed + 11. Int.tests.bitTwiddling ◉ Passed + 12. Int.tests.conversions ◉ Passed + 13. Nat.tests.arithmetic ◉ Passed + 14. Nat.tests.bitTwiddling ◉ Passed + 15. Nat.tests.conversions ◉ Passed + 16. Sandbox.test1 ◉ Passed + 17. Sandbox.test2 ◉ Passed + 18. Sandbox.test3 ◉ Passed + 19. test.rtjqan7bcs ◉ Passed + 20. Text.tests.alignment ◉ Passed + 21. Text.tests.indexOf ◉ Passed + 22. Text.tests.indexOfEmoji ◉ Passed + 23. Text.tests.literalsEq ◉ Passed + 24. Text.tests.patterns ◉ Passed + 25. Text.tests.repeat ◉ Passed + 26. Text.tests.takeDropAppend ◉ Passed + 27. Universal.murmurHash.tests ◉ Passed + + ✅ 27 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` diff --git a/unison-src/transcripts/idempotent/bytesFromList.md b/unison-src/transcripts/idempotent/bytesFromList.md new file mode 100644 index 0000000000..4640272396 --- /dev/null +++ b/unison-src/transcripts/idempotent/bytesFromList.md @@ -0,0 +1,24 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +This should render as `Bytes.fromList [1,2,3,4]`, not `##Bytes.fromSequence [1,2,3,4]`: + +``` unison +> Bytes.fromList [1,2,3,4] +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + ✅ + + scratch.u changed. + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | > Bytes.fromList [1,2,3,4] + ⧩ + 0xs01020304 +``` diff --git a/unison-src/transcripts/idempotent/check763.md b/unison-src/transcripts/idempotent/check763.md new file mode 100644 index 0000000000..1582be2ea7 --- /dev/null +++ b/unison-src/transcripts/idempotent/check763.md @@ -0,0 +1,38 @@ +Regression test for https://github.com/unisonweb/unison/issues/763 + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +(+-+) : Nat -> Nat -> Nat +(+-+) x y = x * y +``` + +``` ucm :added-by-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`: + + +-+ : Nat -> Nat -> Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + +-+ : Nat -> Nat -> Nat + +scratch/main> move.term +-+ boppitybeep + + Done. + +scratch/main> move.term boppitybeep +-+ + + Done. +``` diff --git a/unison-src/transcripts/idempotent/check873.md b/unison-src/transcripts/idempotent/check873.md new file mode 100644 index 0000000000..713767620f --- /dev/null +++ b/unison-src/transcripts/idempotent/check873.md @@ -0,0 +1,45 @@ +See [this ticket](https://github.com/unisonweb/unison/issues/873); the point being, this shouldn't crash the runtime. :) + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +(-) = builtin.Nat.sub +``` + +``` ucm :added-by-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`: + + - : Nat -> Nat -> Int +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + - : Nat -> Nat -> Int +``` + +``` unison +baz x = x - 1 +``` + +``` ucm :added-by-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`: + + baz : Nat -> Int +``` diff --git a/unison-src/transcripts/idempotent/constructor-applied-to-unit.md b/unison-src/transcripts/idempotent/constructor-applied-to-unit.md new file mode 100644 index 0000000000..a0839b594f --- /dev/null +++ b/unison-src/transcripts/idempotent/constructor-applied-to-unit.md @@ -0,0 +1,60 @@ +``` ucm :hide +scratch/main> alias.type ##Nat Nat + +scratch/main> alias.term ##Any.Any Any +``` + +``` unison +structural type Zoink a b c = Zoink a b c + +> Any () +> [ Zoink [0,1,2,3,4,5] [6,3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,3] () ] +``` + +``` ucm :added-by-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`: + + structural type Zoink a b c + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 3 | > Any () + ⧩ + Any () + + 4 | > [ Zoink [0,1,2,3,4,5] [6,3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,3] () ] + ⧩ + [ Zoink + [0, 1, 2, 3, 4, 5] + [ 6 + , 3 + , 3 + , 3 + , 3 + , 3 + , 3 + , 3 + , 3 + , 3 + , 3 + , 4 + , 4 + , 4 + , 4 + , 4 + , 4 + , 4 + , 4 + , 4 + , 3 + ] + () + ] +``` diff --git a/unison-src/transcripts/idempotent/contrabilities.md b/unison-src/transcripts/idempotent/contrabilities.md new file mode 100644 index 0000000000..717fb877c4 --- /dev/null +++ b/unison-src/transcripts/idempotent/contrabilities.md @@ -0,0 +1,20 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +f : (() -> a) -> Nat +f x = 42 +``` + +``` ucm :added-by-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`: + + f : '{g} a -> Nat +``` diff --git a/unison-src/transcripts/idempotent/create-author.md b/unison-src/transcripts/idempotent/create-author.md new file mode 100644 index 0000000000..fa8c9adaa1 --- /dev/null +++ b/unison-src/transcripts/idempotent/create-author.md @@ -0,0 +1,23 @@ +``` ucm :hide +scratch/main> builtins.mergeio +``` + +Demonstrating `create.author`: + +``` ucm +scratch/main> create.author alicecoder "Alice McGee" + + Added definitions: + + 1. metadata.authors.alicecoder : Author + 2. metadata.copyrightHolders.alicecoder : CopyrightHolder + 3. metadata.authors.alicecoder.guid : GUID + + Tip: Add License values for alicecoder under metadata. + +scratch/main> find alicecoder + + 1. metadata.authors.alicecoder : Author + 2. metadata.copyrightHolders.alicecoder : CopyrightHolder + 3. metadata.authors.alicecoder.guid : GUID +``` diff --git a/unison-src/transcripts/idempotent/cycle-update-1.md b/unison-src/transcripts/idempotent/cycle-update-1.md new file mode 100644 index 0000000000..90cb99c8b3 --- /dev/null +++ b/unison-src/transcripts/idempotent/cycle-update-1.md @@ -0,0 +1,78 @@ +Update a member of a cycle, but retain the cycle. + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +ping : 'Nat +ping _ = !pong + 1 + +pong : 'Nat +pong _ = !ping + 2 +``` + +``` ucm :added-by-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`: + + ping : 'Nat + pong : 'Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + ping : 'Nat + pong : 'Nat +``` + +``` unison +ping : 'Nat +ping _ = !pong + 3 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + ping : 'Nat +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. + +scratch/main> view ping pong + + ping : 'Nat + ping _ = + use Nat + + pong() + 3 + + pong : 'Nat + pong _ = + use Nat + + ping() + 2 +``` diff --git a/unison-src/transcripts/idempotent/cycle-update-2.md b/unison-src/transcripts/idempotent/cycle-update-2.md new file mode 100644 index 0000000000..30c05de9f2 --- /dev/null +++ b/unison-src/transcripts/idempotent/cycle-update-2.md @@ -0,0 +1,76 @@ +Update a member of a cycle with a type-preserving update, but sever the cycle. + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +ping : 'Nat +ping _ = !pong + 1 + +pong : 'Nat +pong _ = !ping + 2 +``` + +``` ucm :added-by-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`: + + ping : 'Nat + pong : 'Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + ping : 'Nat + pong : 'Nat +``` + +``` unison +ping : 'Nat +ping _ = 3 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + ping : 'Nat +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. + +scratch/main> view ping pong + + ping : 'Nat + ping _ = 3 + + pong : 'Nat + pong _ = + use Nat + + ping() + 2 +``` diff --git a/unison-src/transcripts/idempotent/cycle-update-3.md b/unison-src/transcripts/idempotent/cycle-update-3.md new file mode 100644 index 0000000000..f9821b96b1 --- /dev/null +++ b/unison-src/transcripts/idempotent/cycle-update-3.md @@ -0,0 +1,71 @@ +Update a member of a cycle with a type-changing update, thus severing the cycle. + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +ping : 'Nat +ping _ = !pong + 1 + +pong : 'Nat +pong _ = !ping + 2 +``` + +``` ucm :added-by-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`: + + ping : 'Nat + pong : 'Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + ping : 'Nat + pong : 'Nat +``` + +``` unison +ping : Nat +ping = 3 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + ping : Nat +``` + +``` ucm +scratch/main> update.old + + ⍟ I've updated these names to your new definition: + + ping : Nat + +scratch/main> view ping pong + + ping : Nat + ping = 3 + + pong : 'Nat + pong _ = + use Nat + + #4t465jk908.1() + 2 +``` diff --git a/unison-src/transcripts/idempotent/cycle-update-4.md b/unison-src/transcripts/idempotent/cycle-update-4.md new file mode 100644 index 0000000000..8bfc423b3c --- /dev/null +++ b/unison-src/transcripts/idempotent/cycle-update-4.md @@ -0,0 +1,90 @@ +`update` properly discovers and establishes new cycles. + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +ping : 'Nat +ping _ = 1 + +pong : 'Nat +pong _ = !ping + 2 +``` + +``` ucm :added-by-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`: + + ping : 'Nat + pong : 'Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + ping : 'Nat + pong : 'Nat +``` + +``` unison +ping : 'Nat +ping _ = !clang + 1 + +clang : 'Nat +clang _ = !pong + 3 +``` + +``` ucm :added-by-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`: + + clang : 'Nat + + ⍟ These names already exist. You can `update` them to your + new definition: + + ping : 'Nat +``` + +``` ucm +scratch/main> update.old ping + + ⍟ I've added these definitions: + + clang : 'Nat + + ⍟ I've updated these names to your new definition: + + ping : 'Nat + pong : 'Nat + +scratch/main> view ping pong clang + + clang : 'Nat + clang _ = + use Nat + + pong() + 3 + + ping : 'Nat + ping _ = + use Nat + + clang() + 1 + + pong : 'Nat + pong _ = + use Nat + + ping() + 2 +``` diff --git a/unison-src/transcripts/idempotent/debug-definitions.md b/unison-src/transcripts/idempotent/debug-definitions.md new file mode 100644 index 0000000000..5bba3af74f --- /dev/null +++ b/unison-src/transcripts/idempotent/debug-definitions.md @@ -0,0 +1,157 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison :hide +x = 30 + +y : Nat +y = + z = x + 2 + z + 10 + +structural type Optional a = Some a | None + +ability Ask a where + ask : a +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + ability Ask a + structural type Optional a + (also named builtin.Optional) + x : Nat + y : Nat + +scratch/main> debug.term.abt Nat.+ + + Builtin term: ##Nat.+ + +scratch/main> debug.term.abt y + + (let Ref(ReferenceBuiltin "Nat.+") Ref(ReferenceDerived (Id "qpo3o788girkkbb43uf6ggqberfduhtnqbt7096eojlrp27jieco09mdasb7b0b06ej9hj60a00nnbbdo8he0b4e0m7vtopifiuhdig" 0)) 2 in (User "z". Ref(ReferenceBuiltin "Nat.+") (Var User "z") 10)):ReferenceBuiltin "Nat" + +scratch/main> debug.term.abt Some + + Constructor #0 of the following type: + DataDeclaration + { modifier = Structural + , annotation = External + , bound = + [ User "a" ] + , constructors' = + [ + ( External + , User "Constructor0" + , + ( User "a". Var User "a" -> ReferenceDerived + ( Id "nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg" 0 ) + ( Var User "a" ) + ) + ) + , + ( External + , User "Constructor1" + , + ( User "a". ReferenceDerived + ( Id "nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg" 0 ) + ( Var User "a" ) + ) + ) + ] + } + +scratch/main> debug.term.abt ask + + Constructor #0 of the following type: + EffectDeclaration + { toDataDecl = DataDeclaration + { modifier = Unique "a1ns7cunv2dvjmum0q8jbc54g6811cbh" + , annotation = External + , bound = + [ User "a" ] + , constructors' = + [ + ( External + , User "Constructor0" + , + ( User "a". + ( + { + [ ReferenceDerived + ( Id "d8m1kmiscgfrl5n9ruvq1432lntfntl7nnao45qlk2uqhparm0uq2im0kbspu6u6kv65hd0i5oljq9m4b78peh5ekpma7gkihtsmfh0" 0 ) + ( Var User "a" ) + ] + } Var User "a" + ) + ) + ) + ] + } + } + +scratch/main> debug.type.abt Nat + + Builtin type: ##Nat + +scratch/main> debug.type.abt Optional + + DataDeclaration + { modifier = Structural + , annotation = External + , bound = + [ User "a" ] + , constructors' = + [ + ( External + , User "Constructor0" + , + ( User "a". Var User "a" -> ReferenceDerived + ( Id "nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg" 0 ) + ( Var User "a" ) + ) + ) + , + ( External + , User "Constructor1" + , + ( User "a". ReferenceDerived + ( Id "nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg" 0 ) + ( Var User "a" ) + ) + ) + ] + } + +scratch/main> debug.type.abt Ask + + EffectDeclaration + { toDataDecl = DataDeclaration + { modifier = Unique "a1ns7cunv2dvjmum0q8jbc54g6811cbh" + , annotation = External + , bound = + [ User "a" ] + , constructors' = + [ + ( External + , User "Constructor0" + , + ( User "a". + ( + { + [ ReferenceDerived + ( Id "d8m1kmiscgfrl5n9ruvq1432lntfntl7nnao45qlk2uqhparm0uq2im0kbspu6u6kv65hd0i5oljq9m4b78peh5ekpma7gkihtsmfh0" 0 ) + ( Var User "a" ) + ] + } Var User "a" + ) + ) + ) + ] + } + } +``` diff --git a/unison-src/transcripts/idempotent/debug-name-diffs.md b/unison-src/transcripts/idempotent/debug-name-diffs.md new file mode 100644 index 0000000000..8790c7db5e --- /dev/null +++ b/unison-src/transcripts/idempotent/debug-name-diffs.md @@ -0,0 +1,108 @@ +``` unison +a.b.one = 1 +a.two = 2 + +a.x.three = 3 +a.x.four = 4 + +structural type a.x.Foo = Foo | Bar +structural type a.b.Baz = Boo +``` + +``` ucm :added-by-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`: + + structural type a.b.Baz + structural type a.x.Foo + a.b.one : ##Nat + a.two : ##Nat + a.x.four : ##Nat + a.x.three : ##Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural type a.b.Baz + structural type a.x.Foo + a.b.one : ##Nat + a.two : ##Nat + a.x.four : ##Nat + a.x.three : ##Nat + +scratch/main> delete.term.verbose a.b.one + + Removed definitions: + + 1. a.b.one : ##Nat + + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. + +scratch/main> alias.term a.two a.newtwo + + Done. + +scratch/main> move.namespace a.x a.y + + Done. + +scratch/main> history + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #tteooc9j2d + + > Moves: + + Original name New name + a.x.Foo a.y.Foo + a.x.Foo.Bar a.y.Foo.Bar + a.x.Foo.Foo a.y.Foo.Foo + a.x.four a.y.four + a.x.three a.y.three + + ⊙ 2. #bicrtgqj12 + + + Adds / updates: + + a.newtwo + + = Copies: + + Original name New name(s) + a.two a.newtwo + + ⊙ 3. #bofp4huk1j + + - Deletes: + + a.b.one + + □ 4. #gss5s88mo3 (start of history) + +scratch/main> debug.name-diff 4 1 + + Kind Name Change Ref + Term a.newtwo Added #dcgdua2lj6upd1ah5v0qp09gjsej0d77d87fu6qn8e2qrssnlnmuinoio46hiu53magr7qn8vnqke8ndt0v76700o5u8gcvo7st28jg + Term a.y.four Added #vcfbbslncd2qloc03kalgsmufl3j5es6cehcrbmlj6t78d4uk5j9gpa3hhf2opln1u2kiepg5n2cn49ianf2oig0mi4c2ldn1r9lf40 + Term a.y.three Added #f3lgjvjqoocpt8v6kdgd2bgthh11a7md3qdp9rf5datccmo580btjd5bt5dro3irqs0is7vm7s1dphddjbtufch620te7ef7canmjj8 + Term a.y.Foo.Bar Added #6kbe32g06nqg93cqub6ohqc4ql4o49ntgnunifds0t75qre6lacnbsr3evn8bkivj68ecbvmhkbak4dbg4fqertcpgb396rmo34tnh0#d1 + Term a.y.Foo.Foo Added #6kbe32g06nqg93cqub6ohqc4ql4o49ntgnunifds0t75qre6lacnbsr3evn8bkivj68ecbvmhkbak4dbg4fqertcpgb396rmo34tnh0#d0 + Term a.b.one Removed #gjmq673r1vrurfotlnirv7vutdhm6sa3s02em5g22kk606mv6duvv8be402dv79312i4a0onepq5bo7citsodvq2g720nttj0ee9p0g + Term a.x.four Removed #vcfbbslncd2qloc03kalgsmufl3j5es6cehcrbmlj6t78d4uk5j9gpa3hhf2opln1u2kiepg5n2cn49ianf2oig0mi4c2ldn1r9lf40 + Term a.x.three Removed #f3lgjvjqoocpt8v6kdgd2bgthh11a7md3qdp9rf5datccmo580btjd5bt5dro3irqs0is7vm7s1dphddjbtufch620te7ef7canmjj8 + Term a.x.Foo.Bar Removed #6kbe32g06nqg93cqub6ohqc4ql4o49ntgnunifds0t75qre6lacnbsr3evn8bkivj68ecbvmhkbak4dbg4fqertcpgb396rmo34tnh0#d1 + Term a.x.Foo.Foo Removed #6kbe32g06nqg93cqub6ohqc4ql4o49ntgnunifds0t75qre6lacnbsr3evn8bkivj68ecbvmhkbak4dbg4fqertcpgb396rmo34tnh0#d0 + Type a.y.Foo Added #6kbe32g06nqg93cqub6ohqc4ql4o49ntgnunifds0t75qre6lacnbsr3evn8bkivj68ecbvmhkbak4dbg4fqertcpgb396rmo34tnh0 + Type a.x.Foo Removed #6kbe32g06nqg93cqub6ohqc4ql4o49ntgnunifds0t75qre6lacnbsr3evn8bkivj68ecbvmhkbak4dbg4fqertcpgb396rmo34tnh0 +``` diff --git a/unison-src/transcripts/deep-names.md b/unison-src/transcripts/idempotent/deep-names.md similarity index 76% rename from unison-src/transcripts/deep-names.md rename to unison-src/transcripts/idempotent/deep-names.md index 9d6695bc47..34d842859d 100644 --- a/unison-src/transcripts/deep-names.md +++ b/unison-src/transcripts/idempotent/deep-names.md @@ -1,7 +1,8 @@ First we'll set up two libraries, and then we'll use them in some projects and show what `names` are deep-loaded for them. Our two "libraries": -```unison:hide + +``` unison :hide text.a = 1 text.b = 2 text.c = 3 @@ -11,43 +12,104 @@ http.y = 7 http.z = 8 ``` -```ucm:hide +``` ucm :hide scratch/main> add + scratch/main> branch /app1 + scratch/main> branch /app2 ``` Our `app1` project includes the text library twice and the http library twice as direct dependencies. -```ucm + +``` ucm scratch/app1> fork text lib.text_v1 + + Done. + scratch/app1> fork text lib.text_v2 + + Done. + scratch/app1> delete.namespace text + + Done. + scratch/app1> fork http lib.http_v3 + + Done. + scratch/app1> fork http lib.http_v4 + + Done. + scratch/app1> delete.namespace http + + Done. ``` As such, we see two copies of `a` and two copies of `x` via these direct dependencies. -```ucm + +``` ucm scratch/app1> names a + + Term + Hash: #gjmq673r1v + Names: lib.text_v1.a lib.text_v2.a + scratch/app1> names x + + Term + Hash: #nsmc4p1ra4 + Names: lib.http_v3.x lib.http_v4.x ``` Our `app2` project includes the `http` library twice as direct dependencies, and once as an indirect dependency via `webutil`. It also includes the `text` library twice as indirect dependencies via `webutil` -```ucm + +``` ucm scratch/app2> fork http lib.http_v1 + + Done. + scratch/app2> fork http lib.http_v2 + + Done. + scratch/app2> fork text lib.webutil.lib.text_v1 + + Done. + scratch/app2> fork text lib.webutil.lib.text_v2 + + Done. + scratch/app2> fork http lib.webutil.lib.http + + Done. + scratch/app2> delete.namespace http + + Done. + scratch/app2> delete.namespace text + + Done. ``` Now we see two copies of `x` via direct dependencies on `http`, and one copy of `a` via indirect dependency on `text` via `webutil`. We see neither the second indirect copy of `a` nor the indirect copy of `x` via webutil because we already have names for them. -```ucm + +``` ucm scratch/app2> names a + + Term + Hash: #gjmq673r1v + Names: lib.webutil.lib.text_v1.a + scratch/app2> names x + + Term + Hash: #nsmc4p1ra4 + Names: lib.http_v1.x lib.http_v2.x ``` diff --git a/unison-src/transcripts/idempotent/definition-diff-api.md b/unison-src/transcripts/idempotent/definition-diff-api.md new file mode 100644 index 0000000000..77b48abfda --- /dev/null +++ b/unison-src/transcripts/idempotent/definition-diff-api.md @@ -0,0 +1,4232 @@ +``` ucm +diffs/main> builtins.mergeio lib.builtins + + Done. + +diffs/main> alias.term lib.builtins.Nat.gt lib.builtins.Nat.> + + Done. + +diffs/main> alias.term lib.builtins.Nat.drop lib.builtins.Nat.- + + Done. +``` + +``` unison +term = + _ = "Here's some text" + 1 + 1 + +type Type = Type Nat + +ability Stream a where + emit : a -> () + +take n s = + use Nat > - + h n = cases + { emit a -> k } -> if n > 0 + then + emit a + handle k() with h (n - 1) + else None + { r } -> Some r + handle s() with h n + +id x = x +unitCase = id (x -> 1) + +``` + +``` ucm :added-by-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`: + + ability Stream a + type Type + id : x -> x + take : Nat -> '{g} t ->{g, Stream a} Optional t + term : Nat + unitCase : x -> Nat +``` + +``` ucm +diffs/main> add + + ⍟ I've added these definitions: + + ability Stream a + type Type + id : x -> x + take : Nat -> '{g} t ->{g, Stream a} Optional t + term : Nat + unitCase : x -> Nat + +diffs/main> branch.create new + + Done. I've created the new branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /new`. +``` + +``` unison +term = + _ = "Here's some different text" + 1 + 2 + +type Type a = Type a Text + +ability Stream a where + emit : a -> () + +take n s = + use Nat > - + h n = cases + { emit a -> k } -> + emit a + if n > 0 + then handle k() with h (n - 1) + else None + { r } -> Some r + if n > 0 + then handle s () with h (n - 1) + else None + +id x = x +unitCase = id (x -> (1, ())) +``` + +``` ucm :added-by-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: + + ⊡ Previously added definitions will be ignored: Stream id + + ⍟ These names already exist. You can `update` them to your + new definition: + + type Type a + take : Nat -> '{g} t ->{g, Stream a} Optional t + term : Nat + unitCase : x -> (Nat, ()) +``` + +``` ucm +diffs/new> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. +``` + +Diff terms + +``` api +GET /api/projects/diffs/diff/terms?oldBranchRef=main&newBranchRef=new&oldTerm=term&newTerm=term + { + "diff": { + "contents": [ + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "UseKeyword" + }, + "segment": "use " + }, + { + "annotation": { + "tag": "UsePrefix" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": "+" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "_", + "tag": "HashQualifier" + }, + "segment": "_" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "old", + "elements": [ + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"Here's some text\"" + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"Here's some different text\"" + } + ] + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.+", + "tag": "TermReference" + }, + "segment": "+" + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "old", + "elements": [ + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "2" + } + ] + } + ], + "tag": "UserObject" + }, + "diffKind": "diff", + "newBranchRef": "new", + "newTerm": { + "bestTermName": "term", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "UseKeyword" + }, + "segment": "use " + }, + { + "annotation": { + "tag": "UsePrefix" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": "+" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "_", + "tag": "HashQualifier" + }, + "segment": "_" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"Here's some different text\"" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.+", + "tag": "TermReference" + }, + "segment": "+" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "2" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "term" + ] + }, + "oldBranchRef": "main", + "oldTerm": { + "bestTermName": "term", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "UseKeyword" + }, + "segment": "use " + }, + { + "annotation": { + "tag": "UsePrefix" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": "+" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "_", + "tag": "HashQualifier" + }, + "segment": "_" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"Here's some text\"" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.+", + "tag": "TermReference" + }, + "segment": "+" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "term" + ] + }, + "project": "diffs" + } +``` + +More complex diff + +``` api +GET /api/projects/diffs/diff/terms?oldBranchRef=main&newBranchRef=new&oldTerm=take&newTerm=take + { + "diff": { + "contents": [ + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "contents": "take", + "tag": "HashQualifier" + }, + "segment": "take" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelayForceChar" + }, + "segment": "'" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "g" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "t" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "g" + }, + { + "annotation": null, + "segment": "," + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro", + "tag": "TypeReference" + }, + "segment": "Stream" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", + "tag": "TypeReference" + }, + "segment": "Optional" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "t" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "take", + "tag": "HashQualifier" + }, + "segment": "take" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "s" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "UseKeyword" + }, + "segment": "use " + }, + { + "annotation": { + "tag": "UsePrefix" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": "-" + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": " " + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": ">" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "h", + "tag": "HashQualifier" + }, + "segment": "h" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "cases" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "{" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro#a0", + "tag": "TermReference" + }, + "segment": "emit" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "k" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "old", + "elements": [ + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "if " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.>", + "tag": "TermReference" + }, + "segment": ">" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "0" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " then" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro#a0", + "tag": "TermReference" + }, + "segment": "emit" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "old", + "elements": [ + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "if" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.>", + "tag": "TermReference" + }, + "segment": ">" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "0" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " then" + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "handle" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "k" + }, + { + "annotation": { + "tag": "Unit" + }, + "segment": "()" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "with" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "h" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": "(" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.drop", + "tag": "TermReference" + }, + "segment": "-" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": ")" + } + ] + }, + { + "diffTag": "old", + "elements": [ + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "else" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg#d1", + "tag": "TermReference" + }, + "segment": "None" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "{" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "r" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg#d0", + "tag": "TermReference" + }, + "segment": "Some" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "r" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "if" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.>", + "tag": "TermReference" + }, + "segment": ">" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "0" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " then" + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "handle" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "s" + }, + { + "annotation": { + "tag": "Unit" + }, + "segment": "()" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "with" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "h" + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": "(" + } + ] + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.drop", + "tag": "TermReference" + }, + "segment": "-" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": ")" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "else" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg#d1", + "tag": "TermReference" + }, + "segment": "None" + } + ] + } + ], + "tag": "UserObject" + }, + "diffKind": "diff", + "newBranchRef": "new", + "newTerm": { + "bestTermName": "take", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelayForceChar" + }, + "segment": "'" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "g" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "t" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "g" + }, + { + "annotation": null, + "segment": "," + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro", + "tag": "TypeReference" + }, + "segment": "Stream" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", + "tag": "TypeReference" + }, + "segment": "Optional" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "t" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "take", + "tag": "HashQualifier" + }, + "segment": "take" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelayForceChar" + }, + "segment": "'" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "g" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "t" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "g" + }, + { + "annotation": null, + "segment": "," + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro", + "tag": "TypeReference" + }, + "segment": "Stream" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", + "tag": "TypeReference" + }, + "segment": "Optional" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "t" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "take", + "tag": "HashQualifier" + }, + "segment": "take" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "s" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "UseKeyword" + }, + "segment": "use " + }, + { + "annotation": { + "tag": "UsePrefix" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": "-" + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": " " + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": ">" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "h", + "tag": "HashQualifier" + }, + "segment": "h" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "cases" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "{" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro#a0", + "tag": "TermReference" + }, + "segment": "emit" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "k" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro#a0", + "tag": "TermReference" + }, + "segment": "emit" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "if" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.>", + "tag": "TermReference" + }, + "segment": ">" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "0" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " then" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "handle" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "k" + }, + { + "annotation": { + "tag": "Unit" + }, + "segment": "()" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "with" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "h" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": "(" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.drop", + "tag": "TermReference" + }, + "segment": "-" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": ")" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "else" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg#d1", + "tag": "TermReference" + }, + "segment": "None" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "{" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "r" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg#d0", + "tag": "TermReference" + }, + "segment": "Some" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "r" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "if" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.>", + "tag": "TermReference" + }, + "segment": ">" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "0" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " then" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "handle" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "s" + }, + { + "annotation": { + "tag": "Unit" + }, + "segment": "()" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "with" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "h" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": "(" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.drop", + "tag": "TermReference" + }, + "segment": "-" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": ")" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "else" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg#d1", + "tag": "TermReference" + }, + "segment": "None" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "take" + ] + }, + "oldBranchRef": "main", + "oldTerm": { + "bestTermName": "take", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelayForceChar" + }, + "segment": "'" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "g" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "t" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "g" + }, + { + "annotation": null, + "segment": "," + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro", + "tag": "TypeReference" + }, + "segment": "Stream" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", + "tag": "TypeReference" + }, + "segment": "Optional" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "t" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "take", + "tag": "HashQualifier" + }, + "segment": "take" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelayForceChar" + }, + "segment": "'" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "g" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "t" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "g" + }, + { + "annotation": null, + "segment": "," + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro", + "tag": "TypeReference" + }, + "segment": "Stream" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg", + "tag": "TypeReference" + }, + "segment": "Optional" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "t" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "take", + "tag": "HashQualifier" + }, + "segment": "take" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "s" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "UseKeyword" + }, + "segment": "use " + }, + { + "annotation": { + "tag": "UsePrefix" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": "-" + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": " " + }, + { + "annotation": { + "tag": "UseSuffix" + }, + "segment": ">" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "h", + "tag": "HashQualifier" + }, + "segment": "h" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "cases" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "{" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro#a0", + "tag": "TermReference" + }, + "segment": "emit" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "k" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "if " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.>", + "tag": "TermReference" + }, + "segment": ">" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "0" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " then" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#b035k0tpdv9jbs80ig29hujmv9kpkubda6or4320o5g7aj7edsudislnp2uovntgu5b0e6a18p0p7j8r2hcpr20blls7am8nll6t2ro#a0", + "tag": "TermReference" + }, + "segment": "emit" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "handle" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "k" + }, + { + "annotation": { + "tag": "Unit" + }, + "segment": "()" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "with" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "h" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": "(" + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat.drop", + "tag": "TermReference" + }, + "segment": "-" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": ")" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "else" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg#d1", + "tag": "TermReference" + }, + "segment": "None" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "{" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "r" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg#d0", + "tag": "TermReference" + }, + "segment": "Some" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "r" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "handle" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "s" + }, + { + "annotation": { + "tag": "Unit" + }, + "segment": "()" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": "with" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "h" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "n" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "take" + ] + }, + "project": "diffs" + } +``` + +Regression test for weird behavior w/r to unit and parens. + +``` api +GET /api/projects/diffs/diff/terms?oldBranchRef=main&newBranchRef=new&oldTerm=unitCase&newTerm=unitCase + { + "diff": { + "contents": [ + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "contents": "unitCase", + "tag": "HashQualifier" + }, + "segment": "unitCase" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "x" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": null, + "segment": "(" + } + ] + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": null, + "segment": "," + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "(" + }, + { + "annotation": null, + "segment": ")" + }, + { + "annotation": null, + "segment": ")" + } + ] + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "unitCase", + "tag": "HashQualifier" + }, + "segment": "unitCase" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#ttjui80dbufvf3vgaddmcr065dpgl0rtp68i5cdht6tq4t2vk3i2vg60hi77rug368qijgijf8oui27te7o5oq0t0osm6dg65c080i0", + "tag": "TermReference" + }, + "segment": "id" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": "(" + }, + { + "annotation": null, + "segment": "x" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " ->" + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "contents": "#2lg4ah6ir6t129m33d7gssnigacral39qdamo20mn6r2vefliubpeqnjhejai9ekjckv0qnu9mlu3k9nbpfhl2schec4dohn7rjhjt8", + "tag": "TypeReference" + }, + "segment": "(" + } + ] + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "contents": "#2lg4ah6ir6t129m33d7gssnigacral39qdamo20mn6r2vefliubpeqnjhejai9ekjckv0qnu9mlu3k9nbpfhl2schec4dohn7rjhjt8", + "tag": "TypeReference" + }, + "segment": ", " + }, + { + "annotation": { + "contents": "#2lg4ah6ir6t129m33d7gssnigacral39qdamo20mn6r2vefliubpeqnjhejai9ekjckv0qnu9mlu3k9nbpfhl2schec4dohn7rjhjt8", + "tag": "TypeReference" + }, + "segment": "(" + } + ] + }, + { + "diffTag": "old", + "elements": [ + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": ")" + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "contents": "#2lg4ah6ir6t129m33d7gssnigacral39qdamo20mn6r2vefliubpeqnjhejai9ekjckv0qnu9mlu3k9nbpfhl2schec4dohn7rjhjt8", + "tag": "TypeReference" + }, + "segment": ")" + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "contents": "#2lg4ah6ir6t129m33d7gssnigacral39qdamo20mn6r2vefliubpeqnjhejai9ekjckv0qnu9mlu3k9nbpfhl2schec4dohn7rjhjt8", + "tag": "TypeReference" + }, + "segment": ")" + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": ")" + } + ] + } + ], + "tag": "UserObject" + }, + "diffKind": "diff", + "newBranchRef": "new", + "newTerm": { + "bestTermName": "unitCase", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "tag": "Var" + }, + "segment": "x" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "(" + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "," + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "(" + }, + { + "annotation": null, + "segment": ")" + }, + { + "annotation": null, + "segment": ")" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "unitCase", + "tag": "HashQualifier" + }, + "segment": "unitCase" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "x" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "(" + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "," + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "(" + }, + { + "annotation": null, + "segment": ")" + }, + { + "annotation": null, + "segment": ")" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "unitCase", + "tag": "HashQualifier" + }, + "segment": "unitCase" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#ttjui80dbufvf3vgaddmcr065dpgl0rtp68i5cdht6tq4t2vk3i2vg60hi77rug368qijgijf8oui27te7o5oq0t0osm6dg65c080i0", + "tag": "TermReference" + }, + "segment": "id" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": "(" + }, + { + "annotation": null, + "segment": "x" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " ->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#2lg4ah6ir6t129m33d7gssnigacral39qdamo20mn6r2vefliubpeqnjhejai9ekjckv0qnu9mlu3k9nbpfhl2schec4dohn7rjhjt8", + "tag": "TypeReference" + }, + "segment": "(" + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + }, + { + "annotation": { + "contents": "#2lg4ah6ir6t129m33d7gssnigacral39qdamo20mn6r2vefliubpeqnjhejai9ekjckv0qnu9mlu3k9nbpfhl2schec4dohn7rjhjt8", + "tag": "TypeReference" + }, + "segment": ", " + }, + { + "annotation": { + "contents": "#2lg4ah6ir6t129m33d7gssnigacral39qdamo20mn6r2vefliubpeqnjhejai9ekjckv0qnu9mlu3k9nbpfhl2schec4dohn7rjhjt8", + "tag": "TypeReference" + }, + "segment": "(" + }, + { + "annotation": { + "contents": "#2lg4ah6ir6t129m33d7gssnigacral39qdamo20mn6r2vefliubpeqnjhejai9ekjckv0qnu9mlu3k9nbpfhl2schec4dohn7rjhjt8", + "tag": "TypeReference" + }, + "segment": ")" + }, + { + "annotation": { + "contents": "#2lg4ah6ir6t129m33d7gssnigacral39qdamo20mn6r2vefliubpeqnjhejai9ekjckv0qnu9mlu3k9nbpfhl2schec4dohn7rjhjt8", + "tag": "TypeReference" + }, + "segment": ")" + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": ")" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "unitCase" + ] + }, + "oldBranchRef": "main", + "oldTerm": { + "bestTermName": "unitCase", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "tag": "Var" + }, + "segment": "x" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "unitCase", + "tag": "HashQualifier" + }, + "segment": "unitCase" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "x" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TypeOperator" + }, + "segment": "->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "unitCase", + "tag": "HashQualifier" + }, + "segment": "unitCase" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#ttjui80dbufvf3vgaddmcr065dpgl0rtp68i5cdht6tq4t2vk3i2vg60hi77rug368qijgijf8oui27te7o5oq0t0osm6dg65c080i0", + "tag": "TermReference" + }, + "segment": "id" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": "(" + }, + { + "annotation": null, + "segment": "x" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " ->" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + }, + { + "annotation": { + "tag": "Parenthesis" + }, + "segment": ")" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "unitCase" + ] + }, + "project": "diffs" + } +``` + +Diff types + +``` api +GET /api/projects/diffs/diff/types?oldBranchRef=main&newBranchRef=new&oldType=Type&newType=Type + { + "diff": { + "contents": [ + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "Type", + "tag": "HashQualifier" + }, + "segment": "Type" + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DataTypeParams" + }, + "segment": "a" + } + ] + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": " = " + } + ] + }, + { + "diffTag": "annotationChange", + "fromAnnotation": { + "contents": "#m5hlrmkn9a3kuqabta2e9qs934em1qmkotpsh9tjvta2u86nuesbjbk2k2sprbdiljq7uqibp49vku4gfpg2u60ceiv8net1f0bu2n8#d0", + "tag": "TermReference" + }, + "segment": "Type", + "toAnnotation": { + "contents": "#uik7pl3klg4u2obtf2fattdaeldui46ohmsi0knpp5hu8tn4d5o8vp570qgh7esgap0pmq9cfrh9dfg1r8qa7qh33g45a3tric24o20#d0", + "tag": "TermReference" + } + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "old", + "elements": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ] + } + ], + "tag": "UserObject" + }, + "diffKind": "diff", + "newBranchRef": "new", + "newType": { + "bestTypeName": "Type", + "defnTypeTag": "Data", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "Type", + "tag": "HashQualifier" + }, + "segment": "Type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DataTypeParams" + }, + "segment": "a" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": " = " + }, + { + "annotation": { + "contents": "#uik7pl3klg4u2obtf2fattdaeldui46ohmsi0knpp5hu8tn4d5o8vp570qgh7esgap0pmq9cfrh9dfg1r8qa7qh33g45a3tric24o20#d0", + "tag": "TermReference" + }, + "segment": "Type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "Var" + }, + "segment": "a" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "Type" + ] + }, + "oldBranchRef": "main", + "oldType": { + "bestTypeName": "Type", + "defnTypeTag": "Data", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "Type", + "tag": "HashQualifier" + }, + "segment": "Type" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": " = " + }, + { + "annotation": { + "contents": "#m5hlrmkn9a3kuqabta2e9qs934em1qmkotpsh9tjvta2u86nuesbjbk2k2sprbdiljq7uqibp49vku4gfpg2u60ceiv8net1f0bu2n8#d0", + "tag": "TermReference" + }, + "segment": "Type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "Type" + ] + }, + "project": "diffs" + } +``` diff --git a/unison-src/transcripts/idempotent/delete-namespace-dependents-check.md b/unison-src/transcripts/idempotent/delete-namespace-dependents-check.md new file mode 100644 index 0000000000..0ded266003 --- /dev/null +++ b/unison-src/transcripts/idempotent/delete-namespace-dependents-check.md @@ -0,0 +1,64 @@ + + +# Delete namespace dependents check + +This is a regression test, previously `delete.namespace` allowed a delete as long as the deletions had a name *anywhere* in your codebase, it should only check the current project branch. + +``` ucm :hide +myproject/main> builtins.merge +``` + +``` unison +sub.dependency = 123 + +dependent = dependency + 99 +``` + +``` ucm :added-by-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`: + + dependent : Nat + sub.dependency : Nat +``` + +``` ucm :error +myproject/main> add + + ⍟ I've added these definitions: + + dependent : Nat + sub.dependency : Nat + +myproject/main> branch /new + + Done. I've created the new branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /new`. + +myproject/new> delete.namespace sub + + ⚠️ + + I didn't delete the namespace because the following + definitions are still in use. + + Dependency Referenced In + dependency 1. dependent + + If you want to proceed anyways and leave those definitions + without names, use delete.namespace.force + +myproject/new> view dependent + + dependent : Nat + dependent = + use Nat + + dependency + 99 +``` diff --git a/unison-src/transcripts/idempotent/delete-namespace.md b/unison-src/transcripts/idempotent/delete-namespace.md new file mode 100644 index 0000000000..c3afeb7cb8 --- /dev/null +++ b/unison-src/transcripts/idempotent/delete-namespace.md @@ -0,0 +1,129 @@ +# delete.namespace.force + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison :hide +no_dependencies.thing = "no dependents on this term" + +dependencies.term1 = 1 +dependencies.term2 = 2 + +dependents.usage1 = dependencies.term1 + dependencies.term2 +dependents.usage2 = dependencies.term1 * dependencies.term2 +``` + +``` ucm :hide +scratch/main> add +``` + +Deleting a namespace with no external dependencies should succeed. + +``` ucm +scratch/main> delete.namespace no_dependencies + + Done. +``` + +Deleting a namespace with external dependencies should fail and list all dependents. + +``` ucm :error +scratch/main> delete.namespace dependencies + + ⚠️ + + I didn't delete the namespace because the following + definitions are still in use. + + Dependency Referenced In + term2 1. dependents.usage1 + 2. dependents.usage2 + + term1 3. dependents.usage1 + 4. dependents.usage2 + + If you want to proceed anyways and leave those definitions + without names, use delete.namespace.force +``` + +Deleting a namespace with external dependencies should succeed when using `delete.namespace.force` + +``` ucm +scratch/main> delete.namespace.force dependencies + + Done. + + ⚠️ + + Of the things I deleted, the following are still used in the + following definitions. They now contain un-named references. + + Dependency Referenced In + term2 1. dependents.usage1 + 2. dependents.usage2 + + term1 3. dependents.usage1 + 4. dependents.usage2 +``` + +I should be able to view an affected dependency by number + +``` ucm +scratch/main> view 2 + + dependents.usage2 : Nat + dependents.usage2 = + use Nat * + #gjmq673r1v * #dcgdua2lj6 +``` + +Deleting the root namespace should require confirmation if not forced. + +``` ucm +scratch/main> delete.namespace . + + ⚠️ + + Are you sure you want to clear away everything? + You could use `project.create` to switch to a new project + instead, or delete the current branch with `delete.branch` + +scratch/main> delete.namespace . + + Okay, I deleted everything except the history. Use `undo` to + undo, or `builtins.merge` to restore the absolute basics to + the current path. + +-- Should have an empty history + +scratch/main> history . + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #sg60bvjo91 (start of history) +``` + +Deleting the root namespace shouldn't require confirmation if forced. + +``` ucm +scratch/main> delete.namespace.force . + + Okay, I deleted everything except the history. Use `undo` to + undo, or `builtins.merge` to restore the absolute basics to + the current path. + +-- Should have an empty history + +scratch/main> history . + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #sg60bvjo91 (start of history) +``` diff --git a/unison-src/transcripts/idempotent/delete-project-branch.md b/unison-src/transcripts/idempotent/delete-project-branch.md new file mode 100644 index 0000000000..62f93b38b0 --- /dev/null +++ b/unison-src/transcripts/idempotent/delete-project-branch.md @@ -0,0 +1,71 @@ +Deleting the branch you are on takes you to its parent (though this is impossible to see in a transcript, since we set +your working directory with each command). + +``` ucm +foo/main> branch topic + + Done. I've created the topic branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic`. + +foo/topic> delete.branch /topic +``` + +A branch need not be preceded by a forward slash. + +``` ucm +foo/main> branch topic + + Done. I've created the topic branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic`. + +foo/topic> delete.branch topic +``` + +You can precede the branch name by a project name. + +``` ucm +foo/main> branch topic + + Done. I've created the topic branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic`. + +scratch/main> delete.branch foo/topic +``` + +You can delete the only branch in a project. + +``` ucm +foo/main> delete.branch /main +``` + +You can delete the last branch in the project, a new one will be created. + +``` ucm +scratch/main> delete.branch scratch/main + +scratch/main> branches + + Branch Remote branch + 1. main + 2. main2 +``` + +If the the last branch isn't /main, then /main will be created. + +``` ucm +scratch/main2> delete.branch /main + +scratch/main2> delete.branch /main2 + +scratch/other> branches + + Branch Remote branch + 1. main + 2. other +``` diff --git a/unison-src/transcripts/idempotent/delete-project.md b/unison-src/transcripts/idempotent/delete-project.md new file mode 100644 index 0000000000..3a9a3b90c6 --- /dev/null +++ b/unison-src/transcripts/idempotent/delete-project.md @@ -0,0 +1,72 @@ +# delete.project + +``` ucm +scratch/main> project.create-empty foo + + 🎉 I've created the project foo. + + 🎨 Type `ui` to explore this project's code in your browser. + 🔭 Discover libraries at https://share.unison-lang.org + 📖 Use `help-topic projects` to learn more about projects. + + Write your first Unison code with UCM: + + 1. Open scratch.u. + 2. Write some Unison code and save the file. + 3. In UCM, type `add` to save it to your new project. + + 🎉 🥳 Happy coding! + +scratch/main> project.create-empty bar + + 🎉 I've created the project bar. + + 🎨 Type `ui` to explore this project's code in your browser. + 🔭 Discover libraries at https://share.unison-lang.org + 📖 Use `help-topic projects` to learn more about projects. + + Write your first Unison code with UCM: + + 1. Open scratch.u. + 2. Write some Unison code and save the file. + 3. In UCM, type `add` to save it to your new project. + + 🎉 🥳 Happy coding! + +-- I can delete the project I'm currently on + +scratch/main> delete.project scratch + +foo/main> projects + + 1. bar + 2. foo + +-- I can delete a different project + +foo/main> delete.project bar + +foo/main> projects + + 1. foo + +-- I can delete the last project, a new scratch project will be created + +foo/main> delete.project foo + +project/main> projects + + 1. project + 2. scratch + +-- If the last project is scratch, a scratch2 project will be created. + +scratch/main> delete.project project + +scratch/main> delete.project scratch + +project/main> projects + + 1. project + 2. scratch2 +``` diff --git a/unison-src/transcripts/idempotent/delete-silent.md b/unison-src/transcripts/idempotent/delete-silent.md new file mode 100644 index 0000000000..0afc953732 --- /dev/null +++ b/unison-src/transcripts/idempotent/delete-silent.md @@ -0,0 +1,34 @@ +``` ucm :error +scratch/main> delete foo + + ⚠️ + + The following names were not found in the codebase. Check your spelling. + foo +``` + +``` unison :hide +foo = 1 +structural type Foo = Foo () +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural type Foo + foo : ##Nat + +scratch/main> delete foo + + Done. + +scratch/main> delete.type Foo + + Done. + +scratch/main> delete.term Foo.Foo + + Done. +``` diff --git a/unison-src/transcripts/idempotent/delete.md b/unison-src/transcripts/idempotent/delete.md new file mode 100644 index 0000000000..45ed52aba8 --- /dev/null +++ b/unison-src/transcripts/idempotent/delete.md @@ -0,0 +1,433 @@ +# Delete + +``` ucm :hide +scratch/main> builtins.merge lib.builtins +``` + +The delete command can delete both terms and types. + +First, let's make sure it complains when we try to delete a name that doesn't +exist. + +``` ucm :error +scratch/main> delete.verbose foo + + ⚠️ + + The following names were not found in the codebase. Check your spelling. + foo +``` + +Now for some easy cases. Deleting an unambiguous term, then deleting an +unambiguous type. + +``` unison :hide +foo = 1 +structural type Foo = Foo () +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural type Foo + foo : Nat + +scratch/main> delete.verbose foo + + Removed definitions: + + 1. foo : Nat + + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. + +scratch/main> delete.verbose Foo + + Removed definitions: + + 1. structural type Foo + + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. + +scratch/main> delete.verbose Foo.Foo + + Removed definitions: + + 1. Foo.Foo : '#089vmor9c5 + + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. +``` + +How about an ambiguous term? + +``` unison :hide +a.foo = 1 +a.bar = 2 +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + a.bar : Nat + a.foo : Nat + +scratch/main> debug.alias.term.force a.bar a.foo + + Done. +``` + +A delete should remove both versions of the term. + +``` ucm +scratch/main> delete.verbose a.foo + + Removed definitions: + + 1. a.foo#gjmq673r1v : Nat + + Name changes: + + Original Changes + 2. a.bar ┐ 3. a.foo#dcgdua2lj6 (removed) + 4. a.foo#dcgdua2lj6 ┘ + + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. + +scratch/main> ls a + + 1. bar (Nat) +``` + +Let's repeat all that on a type, for completeness. + +``` unison :hide +structural type a.Foo = Foo () +structural type a.Bar = Bar +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural type a.Bar + (also named lib.builtins.Unit) + structural type a.Foo + +scratch/main> debug.alias.type.force a.Bar a.Foo + + Done. + +scratch/main> delete.verbose a.Foo + + Removed definitions: + + 1. structural type a.Foo#089vmor9c5 + + Name changes: + + Original Changes + 2. a.Bar ┐ 3. a.Foo#00nv2kob8f (removed) + 4. lib.builtins.Unit │ + 5. a.Foo#00nv2kob8f ┘ + + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. + +scratch/main> delete.verbose a.Foo.Foo + + Removed definitions: + + 1. a.Foo.Foo : '#089vmor9c5 + + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. +``` + +Finally, let's try to delete a term and a type with the same name. + +``` unison :hide +foo = 1 +structural type foo = Foo () +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural type foo + foo : Nat + +scratch/main> delete.verbose foo + + Removed definitions: + + 1. structural type foo + 2. foo : Nat + + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. +``` + +We want to be able to delete multiple terms at once + +``` unison :hide +a = "a" +b = "b" +c = "c" +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + a : Text + b : Text + c : Text + +scratch/main> delete.verbose a b c + + Removed definitions: + + 1. a : Text + 2. b : Text + 3. c : Text + + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. +``` + +We can delete terms and types in the same invocation of delete + +``` unison :hide +structural type Foo = Foo () +a = "a" +b = "b" +c = "c" +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural type Foo + a : Text + b : Text + c : Text + +scratch/main> delete.verbose a b c Foo + + Removed definitions: + + 1. structural type Foo + 2. a : Text + 3. b : Text + 4. c : Text + + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. + +scratch/main> delete.verbose Foo.Foo + + Name changes: + + Original Changes + 1. Foo.Foo ┐ 2. Foo.Foo (removed) + 3. foo.Foo ┘ + + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. +``` + +We can delete a type and its constructors + +``` unison :hide +structural type Foo = Foo () +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural type Foo + +scratch/main> delete.verbose Foo Foo.Foo + + Removed definitions: + + 1. structural type Foo + + Name changes: + + Original Changes + 2. Foo.Foo ┐ 3. Foo.Foo (removed) + 4. foo.Foo ┘ + + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. +``` + +You should not be able to delete terms which are referenced by other terms + +``` unison :hide +a = 1 +b = 2 +c = 3 +d = a + b + c +``` + +``` ucm :error +scratch/main> add + + ⍟ I've added these definitions: + + a : Nat + b : Nat + (also named a.bar) + c : Nat + d : Nat + +scratch/main> delete.verbose a b c + + ⚠️ + + I didn't delete the following definitions because they are + still in use: + + Dependency Referenced In + c 1. d + + a 2. d +``` + +But you should be able to delete all terms which reference each other in a single command + +``` unison :hide +e = 11 +f = 12 + e +g = 13 + f +h = e + f + g +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + e : Nat + f : Nat + g : Nat + h : Nat + +scratch/main> delete.verbose e f g h + + Removed definitions: + + 1. e : Nat + 2. f : Nat + 3. g : Nat + 4. h : Nat + + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. +``` + +You should be able to delete a type and all the functions that reference it in a single command + +``` unison :hide +structural type Foo = Foo Nat + +incrementFoo : Foo -> Nat +incrementFoo = cases + (Foo.Foo n) -> n + 1 +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural type Foo + incrementFoo : Foo -> Nat + +scratch/main> delete.verbose Foo Foo.Foo incrementFoo + + Removed definitions: + + 1. structural type Foo + 2. Foo.Foo : Nat -> Foo + 3. incrementFoo : Foo -> Nat + + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. +``` + +If you mess up on one of the names of your command, delete short circuits + +``` unison :hide +e = 11 +f = 12 + e +g = 13 + f +h = e + f + g +``` + +``` ucm :error +scratch/main> add + + ⍟ I've added these definitions: + + e : Nat + f : Nat + g : Nat + h : Nat + +scratch/main> delete.verbose e f gg + + ⚠️ + + The following names were not found in the codebase. Check your spelling. + gg +``` + +Cyclical terms which are guarded by a lambda are allowed to be deleted + +``` unison :hide +ping _ = 1 Nat.+ !pong +pong _ = 4 Nat.+ !ping +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + ping : 'Nat + pong : 'Nat + +scratch/main> delete.verbose ping + + Removed definitions: + + 1. ping : 'Nat + + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. + +scratch/main> view pong + + pong : 'Nat + pong _ = + use Nat + + 4 + #l9uq1dpl5v.1() +``` diff --git a/unison-src/transcripts/idempotent/dependents-dependencies-debugfile.md b/unison-src/transcripts/idempotent/dependents-dependencies-debugfile.md new file mode 100644 index 0000000000..715aefd5b9 --- /dev/null +++ b/unison-src/transcripts/idempotent/dependents-dependencies-debugfile.md @@ -0,0 +1,120 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +### `debug.file` + +I can use `debug.file` to see the hashes of the last typechecked file. + +Given this .u file: + +``` unison :hide +structural type outside.A = A Nat outside.B +structural type outside.B = B Int +outside.c = 3 +outside.d = c < (p + 1) + +structural type inside.M = M outside.A +inside.p = c +inside.q x = x + p * p +inside.r = d +``` + +``` ucm +scratch/main> debug.file + + type inside.M#h37a56c5ep + type outside.A#6l6krl7n4l + type outside.B#eo6rj0lj1b + inside.p#htoo5rnb54 + inside.q#1mqcoh3tnk + inside.r#nkgohbke6n + outside.c#f3lgjvjqoo + outside.d#ukd7tu6kds +``` + +This will help me make progress in some situations when UCM is being deficient or broken. + +### `dependents` / `dependencies` + +But wait, there's more. I can check the dependencies and dependents of a definition: + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural type inside.M + structural type outside.A + structural type outside.B + inside.p : Nat + inside.q : Nat -> Nat + inside.r : Boolean + outside.c : Nat + outside.d : Boolean + +scratch/main> dependents q + + q has no dependents. + +scratch/main> dependencies q + + Dependencies of: q + + Types: + + 1. Nat + + Terms: + + 2. Nat.* + 3. Nat.+ + 4. p + + Tip: Try `view 4` to see the source of any numbered item in + the above list. + +scratch/main> dependencies B + + Dependencies of: type B, B + + Types: + + 1. B + 2. Int + + Tip: Try `view 2` to see the source of any numbered item in + the above list. + +scratch/main> dependencies d + + Dependencies of: d + + Types: + + 1. Boolean + 2. Nat + + Terms: + + 3. < + 4. c + 5. Nat.+ + 6. p + + Tip: Try `view 6` to see the source of any numbered item in + the above list. + +scratch/main> dependents d + + Dependents of: d + + Terms: + + 1. r + + Tip: Try `view 1` to see the source of any numbered item in + the above list. +``` + +We don't have an index for dependents of constructors, but iirc if you ask for that, it will show you dependents of the structural type that provided the constructor. diff --git a/unison-src/transcripts/idempotent/destructuring-binds.md b/unison-src/transcripts/idempotent/destructuring-binds.md new file mode 100644 index 0000000000..e18e80649a --- /dev/null +++ b/unison-src/transcripts/idempotent/destructuring-binds.md @@ -0,0 +1,176 @@ +# Destructuring binds + +``` ucm :hide +scratch/main> builtins.merge +``` + +Here's a couple examples: + +``` unison +ex0 : Nat -> Nat +ex0 n = + (a, _, (c,d)) = ("uno", "dos", (n, 7)) + c + d + +ex1 : (a,b,(Nat,Nat)) -> Nat +ex1 tup = + (a, b, (c,d)) = tup + c + d +``` + +``` ucm :added-by-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`: + + ex0 : Nat -> Nat + ex1 : (a, b, (Nat, Nat)) -> Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + ex0 : Nat -> Nat + ex1 : (a, b, (Nat, Nat)) -> Nat + +scratch/main> view ex0 ex1 + + ex0 : Nat -> Nat + ex0 n = + use Nat + + (a, _, (c, d)) = ("uno", "dos", (n, 7)) + c + d + + ex1 : (a, b, (Nat, Nat)) -> Nat + ex1 = cases (a, b, (c, d)) -> c Nat.+ d +``` + +Notice that `ex0` is printed using the `cases` syntax (but `ex1` is not). The pretty-printer currently prefers the `cases` syntax if definition can be printed using either destructuring bind or `cases`. + +A destructuring bind is just syntax for a single branch pattern match. Notice that Unison detects this function as an alias of `ex1`: + +``` unison +ex2 : (a,b,(Nat,Nat)) -> Nat +ex2 tup = match tup with + (a, b, (c,d)) -> c + d +``` + +``` ucm :added-by-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`: + + ex2 : (a, b, (Nat, Nat)) -> Nat + (also named ex1) +``` + +## Corner cases + +Destructuring binds can't be recursive: the left-hand side bound variables aren't available on the right hand side. For instance, this doesn't typecheck: + +``` unison :error +ex4 = + (a,b) = (a Nat.+ b, 19) + "Doesn't typecheck" +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I couldn't figure out what a refers to here: + + 2 | (a,b) = (a Nat.+ b, 19) + + I think its type should be: + + Nat + + Some common causes of this error include: + * Your current namespace is too deep to contain the + definition in its subtree + * The definition is part of a library which hasn't been + added to this project + * You have a typo in the name +``` + +Even though the parser accepts any pattern on the LHS of a bind, it looks pretty weird to see things like `12 = x`, so we avoid showing a destructuring bind when the LHS is a "literal" pattern (like `42` or "hi"). Again these examples wouldn't compile with coverage checking. + +``` unison +ex5 : 'Text +ex5 _ = match 99 + 1 with + 12 -> "Hi" + _ -> "Bye" + +ex5a : 'Text +ex5a _ = match (99 + 1, "hi") with + (x, "hi") -> "Not printed as a destructuring bind." + _ -> "impossible" +``` + +``` ucm :added-by-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`: + + ex5 : 'Text + ex5a : 'Text +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + ex5 : 'Text + ex5a : 'Text + +scratch/main> view ex5 ex5a + + ex5 : 'Text + ex5 _ = match 99 Nat.+ 1 with + 12 -> "Hi" + _ -> "Bye" + + ex5a : 'Text + ex5a _ = match (99 Nat.+ 1, "hi") with + (x, "hi") -> "Not printed as a destructuring bind." + _ -> "impossible" +``` + +Notice how it prints both an ordinary match. + +Also, for clarity, the pretty-printer shows a single-branch match if the match shadows free variables of the scrutinee, for example: + +``` unison :hide +ex6 x = match x with + (x, y) -> x Nat.+ y +``` + +For clarity, the pretty-printer leaves this alone, even though in theory it could be written `(x,y) = x; x + y`: + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + ex6 : (Nat, Nat) -> Nat + +scratch/main> view ex6 + + ex6 : (Nat, Nat) -> Nat + ex6 = cases (x, y) -> x Nat.+ y +``` diff --git a/unison-src/transcripts/idempotent/diff-namespace.md b/unison-src/transcripts/idempotent/diff-namespace.md new file mode 100644 index 0000000000..64063922aa --- /dev/null +++ b/unison-src/transcripts/idempotent/diff-namespace.md @@ -0,0 +1,581 @@ +``` ucm :hide +scratch/b1> builtins.merge lib.builtins + +scratch/b2> builtins.merge lib.builtins + +scratch/nsx> builtins.merge lib.builtins + +scratch/main> builtins.merge lib.builtins + +scratch/ns1> builtins.merge lib.builtins +``` + +``` unison :hide +x = 23 +fslkdjflskdjflksjdf = 663 +``` + +``` ucm +scratch/b1> add + + ⍟ I've added these definitions: + + fslkdjflskdjflksjdf : Nat + x : Nat +``` + +``` unison :hide +x = 23 +fslkdjflskdjflksjdf = 23 +abc = 23 +``` + +``` ucm +scratch/b2> add + + ⍟ I've added these definitions: + + abc : Nat + fslkdjflskdjflksjdf : Nat + x : Nat + +scratch/b1> debug.alias.term.force .x .fslkdjflskdjflksjdf + + Done. +``` + +``` ucm +scratch/main> diff.namespace /b1: /b2: + + Resolved name conflicts: + + 1. ┌ fslkdjflskdjflksjdf#sekb3fdsvb : Nat + 2. └ fslkdjflskdjflksjdf#u520d1t9kc : Nat + ↓ + 3. fslkdjflskdjflksjdf#u520d1t9kc : Nat + + Name changes: + + Original Changes + 4. x ┐ 5. abc (added) + 6. fslkdjflskdjflksjdf#u520d1t9kc ┘ 7. fslkdjflskdjflksjdf (added) + 8. fslkdjflskdjflksjdf#u520d1t9kc (removed) +``` + +Things we want to test: + + - Diffing identical namespaces + - Adds, removes, updates + - Adds with multiple names + - Moved and copied definitions + - Moves that have more that 1 initial or final name + - ... terms and types + - New patches, modified patches, deleted patches, moved patches + - With and without propagated updates + +``` unison :hide +fromJust = 1 +b = 2 +bdependent = b +c = 3 +helloWorld = "Hello, world!" + +structural type A a = A () +structural ability X a1 a2 where x : () +``` + +``` ucm +scratch/ns1> add + + ⍟ I've added these definitions: + + structural type A a + structural ability X a1 a2 + b : Nat + bdependent : Nat + c : Nat + fromJust : Nat + helloWorld : Text + +scratch/ns1> alias.term fromJust fromJust' + + Done. + +scratch/ns1> alias.term helloWorld helloWorld2 + + Done. + +scratch/ns1> branch /ns2 + + Done. I've created the ns2 branch based off of ns1. + + Tip: To merge your work back into the ns1 branch, first + `switch /ns1` then `merge /ns2`. +``` + +Here's what we've done so far: + +``` ucm :error +scratch/main> diff.namespace .nothing /ns1: + + ⚠️ + + The namespace scratch/main:.nothing is empty. Was there a typo? +``` + +``` ucm :error +scratch/main> diff.namespace /ns1: /ns2: + + The namespaces are identical. +``` + +``` unison :hide +junk = "asldkfjasldkfj" +``` + +``` ucm +scratch/ns1> add + + ⍟ I've added these definitions: + + junk : Text + +scratch/ns1> debug.alias.term.force junk fromJust + + Done. + +scratch/ns1> delete.term junk + + Done. +``` + +``` unison :hide +fromJust = 99 +b = 999999999 +d = 4 +e = 5 +f = 6 +unique type Y a b = Y a b +``` + +``` ucm +scratch/ns2> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. + +scratch/main> diff.namespace /ns1: /ns2: + + Resolved name conflicts: + + 1. ┌ fromJust#gjmq673r1v : Nat + 2. └ fromJust#rnbo52q2sh : Text + ↓ + 3. fromJust#6gn1k53ie0 : Nat + + Updates: + + 4. b : Nat + ↓ + 5. b : Nat + + 6. bdependent : Nat + ↓ + 7. bdependent : Nat + + Added definitions: + + 8. type Y a b + 9. Y.Y : a -> b -> Y a b + 10. d : Nat + 11. e : Nat + 12. f : Nat + + Name changes: + + Original Changes + 13. fromJust' ┐ 14. fromJust#gjmq673r1v (removed) + 15. fromJust#gjmq673r1v ┘ + +scratch/ns2> alias.term d d' + + Done. + +scratch/ns2> alias.type A A' + + Done. + +scratch/ns2> alias.term A.A A'.A + + Done. + +scratch/ns2> alias.type X X' + + Done. + +scratch/ns2> alias.term X.x X'.x + + Done. + +scratch/main> diff.namespace /ns1: /ns2: + + Resolved name conflicts: + + 1. ┌ fromJust#gjmq673r1v : Nat + 2. └ fromJust#rnbo52q2sh : Text + ↓ + 3. fromJust#6gn1k53ie0 : Nat + + Updates: + + 4. b : Nat + ↓ + 5. b : Nat + + 6. bdependent : Nat + ↓ + 7. bdependent : Nat + + Added definitions: + + 8. type Y a b + 9. Y.Y : a -> b -> Y a b + 10. ┌ d : Nat + 11. └ d' : Nat + 12. e : Nat + 13. f : Nat + + Name changes: + + Original Changes + 14. A 15. A' (added) + + 16. X 17. X' (added) + + 18. A.A 19. A'.A (added) + + 20. fromJust' ┐ 21. fromJust#gjmq673r1v (removed) + 22. fromJust#gjmq673r1v ┘ + + 23. X.x 24. X'.x (added) + +scratch/ns1> alias.type X X2 + + Done. + +scratch/ns1> alias.term X.x X2.x + + Done. + +scratch/ns2> alias.type A' A'' + + Done. + +scratch/ns2> alias.term A'.A A''.A + + Done. + +scratch/ns2> branch /ns3 + + Done. I've created the ns3 branch based off of ns2. + + Tip: To merge your work back into the ns2 branch, first + `switch /ns2` then `merge /ns3`. + +scratch/ns2> alias.term fromJust' yoohoo + + Done. + +scratch/ns2> delete.term.verbose fromJust' + + Name changes: + + Original Changes + 1. fromJust' ┐ 2. fromJust' (removed) + 3. yoohoo ┘ + + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. + +scratch/main> diff.namespace /ns3: /ns2: + + Name changes: + + Original Changes + 1. fromJust' 2. yoohoo (added) + 3. fromJust' (removed) +``` + +``` unison :hide +bdependent = "banana" +``` + +``` ucm +scratch/ns3> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/main> diff.namespace /ns2: /ns3: + + Updates: + + 1. bdependent : Nat + ↓ + 2. bdependent : Text + + Name changes: + + Original Changes + 3. yoohoo 4. fromJust' (added) + 5. yoohoo (removed) +``` + +## Two different auto-propagated changes creating a name conflict + +Currently, the auto-propagated name-conflicted definitions are not explicitly +shown, only their also-conflicted dependency is shown. + +``` unison :hide +a = 333 +b = a + 1 + +forconflicts = 777 +``` + +``` ucm +scratch/nsx> add + + ⍟ I've added these definitions: + + a : Nat + b : Nat + forconflicts : Nat + +scratch/nsx> branch /nsy + + Done. I've created the nsy branch based off of nsx. + + Tip: To merge your work back into the nsx branch, first + `switch /nsx` then `merge /nsy`. + +scratch/nsx> branch /nsz + + Done. I've created the nsz branch based off of nsx. + + Tip: To merge your work back into the nsx branch, first + `switch /nsx` then `merge /nsz`. +``` + +``` unison :hide +a = 444 +``` + +``` ucm +scratch/nsy> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. +``` + +``` unison :hide +a = 555 +``` + +``` ucm +scratch/nsz> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. + +scratch/nsy> branch /nsw + + Done. I've created the nsw branch based off of nsy. + + Tip: To merge your work back into the nsy branch, first + `switch /nsy` then `merge /nsw`. + +scratch/nsw> debug.alias.term.force .forconflicts .a + + Done. + +scratch/nsw> debug.alias.term.force .forconflicts .b + + Done. +``` + +``` ucm +scratch/main> diff.namespace /nsx: /nsw: + + New name conflicts: + + 1. a#uiiiv8a86s : Nat + ↓ + 2. ┌ a#mdl4vqtu00 : Nat + 3. └ a#r3msrbpp1v : Nat + + 4. b#lhigeb1let : Nat + ↓ + 5. ┌ b#r3msrbpp1v : Nat + 6. └ b#unkqhuu66p : Nat + + Name changes: + + Original Changes + 7. forconflicts 8. a#r3msrbpp1v (added) + 9. b#r3msrbpp1v (added) + +scratch/nsw> view a + + a#mdl4vqtu00 : Nat + a#mdl4vqtu00 = 444 + + a#r3msrbpp1v : Nat + a#r3msrbpp1v = 777 + +scratch/nsw> view b + + b#r3msrbpp1v : Nat + b#r3msrbpp1v = 777 + + b#unkqhuu66p : Nat + b#unkqhuu66p = + use Nat + + a#mdl4vqtu00 + 1 +``` + +## Should be able to diff a namespace hash from history. + +``` unison +x = 1 +``` + +``` ucm :added-by-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`: + + x : Nat +``` + +``` ucm +scratch/hashdiff> add + + ⍟ I've added these definitions: + + x : ##Nat +``` + +``` unison +y = 2 +``` + +``` ucm :added-by-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`: + + y : ##Nat +``` + +``` ucm +scratch/hashdiff> add + + ⍟ I've added these definitions: + + y : ##Nat + +scratch/hashdiff> history + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #ru1hnjofdj + + + Adds / updates: + + y + + □ 2. #i52j9fd57b (start of history) + +scratch/hashdiff> diff.namespace 2 1 + + Added definitions: + + 1. y : ##Nat +``` + +## + +Updates: -- 1 to 1 + +New name conflicts: -- updates where RHS has multiple hashes (excluding when RHS=LHS) + +1. foo\#jk19sm5bf8 : Nat - do we want to force a hashqualified? Arya thinks so + ↓ +2. ┌ foo\#0ja1qfpej6 : Nat +3. └ foo\#jk19sm5bf8 : Nat + +Resolved name conflicts: -- updates where LHS had multiple hashes and RHS has one + +4. ┌ bar\#0ja1qfpej6 : Nat +5. └ bar\#jk19sm5bf8 : Nat + ↓ +6. bar\#jk19sm5bf8 : Nat + +## Display issues to fixup + + - \[d\] Do we want to surface new edit conflicts in patches? + - \[t\] two different auto-propagated changes creating a name conflict should show + up somewhere besides the auto-propagate count + - \[t\] Things look screwy when the type signature doesn't fit and has to get broken + up into multiple lines. Maybe just disallow that? + - \[d\] Delete blank line in between copies / renames entries if all entries are 1 to 1 + see todo in the code + - \[x\] incorrectly calculated bracket alignment on hashqualified "Name changes" (delete.output.md) + - \[x\] just handle deletion of isPropagated in propagate function, leave HandleInput alone (assuming this does the trick) + - \[x\] might want unqualified names to be qualified sometimes: + - \[x\] if a name is updated to a not-yet-named reference, it's shown as both an update and an add + - \[x\] similarly, if a conflicted name is resolved by deleting the last name to + a reference, I (arya) suspect it will show up as a Remove + - \[d\] Maybe group and/or add headings to the types, constructors, terms + - \[x\] add tagging of propagated updates to test propagated updates output + - \[x\] missing old names in deletion ppe (delete.output.md) (superseded by \#1143) + - \[x\] delete.term has some bonkers output + - \[x\] Make a decision about how we want to show constructors in the diff + - \[x\] 12.patch patch needs a space + - \[x\] This looks like garbage + - \[x\] Extra 2 blank lines at the end of the add section + - \[x\] Fix alignment issues with buildTable, convert to column3M (to be written) + - \[x\] adding an alias is showing up as an Add and a Copy; should just show as Copy + - \[x\] removing one of multiple aliases appears in removes + moves + copies section + - \[x\] some overlapping cases between Moves and Copies^ + - \[x\] Maybe don't list the type signature twice for aliases? diff --git a/unison-src/transcripts/idempotent/doc-formatting.md b/unison-src/transcripts/idempotent/doc-formatting.md new file mode 100644 index 0000000000..079b3d5af8 --- /dev/null +++ b/unison-src/transcripts/idempotent/doc-formatting.md @@ -0,0 +1,578 @@ +This transcript explains a few minor details about doc parsing and pretty-printing, both from a user point of view and with some implementation notes. The later stuff is meant more as unit testing than for human consumption. (The ucm `add` commands and their output are hidden for brevity.) + +Docs can be used as inline code comments. + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +foo : Nat -> Nat +foo n = + _ = [: do the thing :] + n + 1 +``` + +``` ucm :added-by-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 -> Nat +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> view foo + + foo : Nat -> Nat + foo n = + use Nat + + _ = [: do the thing :] + n + 1 +``` + +Note that `@` and `:]` must be escaped within docs. + +``` unison +escaping = [: Docs look [: like \@this \:] :] +``` + +``` ucm :added-by-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`: + + escaping : Doc +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> view escaping + + escaping : Doc + escaping = [: Docs look [: like \@this \:] :] +``` + +(Alas you can't have `\@` or `\:]` in your doc, as there's currently no way to 'unescape' them.) + +``` unison +-- Note that -- comments are preserved within doc literals. +commented = [: + example: + + -- a comment + f x = x + 1 +:] +``` + +``` ucm :added-by-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`: + + commented : Doc +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> view commented + + commented : Doc + commented = + [: example: + + -- a comment f x = x + 1 + :] +``` + +### Indenting, and paragraph reflow + +Handling of indenting in docs between the parser and pretty-printer is a bit fiddly. + +``` unison +-- The leading and trailing spaces are stripped from the stored Doc by the +-- lexer, and one leading and trailing space is inserted again on view/edit +-- by the pretty-printer. +doc1 = [: hi :] +``` + +``` ucm :added-by-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`: + + doc1 : Doc +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> view doc1 + + doc1 : Doc + doc1 = [: hi :] +``` + +``` unison +-- Lines (apart from the first line, i.e. the bit between the [: and the +-- first newline) are unindented until at least one of +-- them hits the left margin (by a post-processing step in the parser). +-- You may not notice this because the pretty-printer indents them again on +-- view/edit. +doc2 = [: hello + - foo + - bar + and the rest. :] +``` + +``` ucm :added-by-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`: + + doc2 : Doc +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> view doc2 + + doc2 : Doc + doc2 = + [: hello + - foo + - bar + and the rest. :] +``` + +``` unison +doc3 = [: When Unison identifies a paragraph, it removes any newlines from it before storing it, and then reflows the paragraph text to fit the display window on display/view/edit. + +For these purposes, a paragraph is any sequence of non-empty lines that have zero indent (after the unindenting mentioned above.) + + - So this is not a paragraph, even + though you might want it to be. + + And this text | as a paragraph + is not treated | either. + +Note that because of the special treatment of the first line mentioned above, where its leading space is removed, it is always treated as a paragraph. + :] +``` + +``` ucm :added-by-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`: + + doc3 : Doc +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> view doc3 + + doc3 : Doc + doc3 = + [: When Unison identifies a paragraph, it removes any + newlines from it before storing it, and then reflows the + paragraph text to fit the display window on + display/view/edit. + + For these purposes, a paragraph is any sequence of non-empty + lines that have zero indent (after the unindenting mentioned + above.) + + - So this is not a paragraph, even + though you might want it to be. + + And this text | as a paragraph + is not treated | either. + + Note that because of the special treatment of the first line + mentioned above, where its leading space is removed, it is + always treated as a paragraph. + :] +``` + +``` unison +doc4 = [: Here's another example of some paragraphs. + + All these lines have zero indent. + + - Apart from this one. :] +``` + +``` ucm :added-by-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`: + + doc4 : Doc +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> view doc4 + + doc4 : Doc + doc4 = + [: Here's another example of some paragraphs. + + All these lines have zero indent. + + - Apart from this one. :] +``` + +``` unison +-- The special treatment of the first line does mean that the following +-- is pretty-printed not so prettily. To fix that we'd need to get the +-- lexer to help out with interpreting doc literal indentation (because +-- it knows what columns the `[:` was in.) +doc5 = [: - foo + - bar + and the rest. :] +``` + +``` ucm :added-by-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`: + + doc5 : Doc +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> view doc5 + + doc5 : Doc + doc5 = + [: - foo + - bar + and the rest. :] +``` + +``` unison +-- You can do the following to avoid that problem. +doc6 = [: + - foo + - bar + and the rest. + :] +``` + +``` ucm :added-by-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`: + + doc6 : Doc +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> view doc6 + + doc6 : Doc + doc6 = + [: - foo + - bar + and the rest. + :] +``` + +### More testing + +``` unison +-- Check empty doc works. +empty = [::] + +expr = foo 1 +``` + +``` ucm :added-by-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`: + + empty : Doc + expr : Nat +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> view empty + + empty : Doc + empty = [: :] +``` + +``` unison +test1 = [: +The internal logic starts to get hairy when you use the \@ features, for example referencing a name like @List.take. Internally, the text between each such usage is its own blob (blob ends here --> @List.take), so paragraph reflow has to be aware of multiple blobs to do paragraph reflow (or, more accurately, to do the normalization step where newlines with a paragraph are removed.) + +Para to reflow: lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor ending in ref @List.take + +@List.take starting para lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor. + +Middle of para: lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor @List.take lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor. + + - non-para line (@List.take) with ref @List.take + Another non-para line + @List.take starting non-para line + + - non-para line with ref @List.take +before a para-line lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor. + + - non-para line followed by a para line starting with ref +@List.take lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor. + +a para-line ending with ref lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor @List.take + - non-para line + +para line lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor + @List.take followed by non-para line starting with ref. + +@[signature] List.take + +@[source] foo + +@[evaluate] expr + +@[include] doc1 + +-- note the leading space below + @[signature] List.take + +:] +``` + +``` ucm :added-by-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`: + + test1 : Doc +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> view test1 + + test1 : Doc + test1 = + [: The internal logic starts to get hairy when you use the + \@ features, for example referencing a name like @List.take. + Internally, the text between each such usage is its own blob + (blob ends here --> @List.take), so paragraph reflow has to + be aware of multiple blobs to do paragraph reflow (or, more + accurately, to do the normalization step where newlines with + a paragraph are removed.) + + Para to reflow: lorem ipsum dolor lorem ipsum dolor lorem + ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum + dolor lorem ipsum dolor ending in ref @List.take + + @List.take starting para lorem ipsum dolor lorem ipsum dolor + lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem + ipsum dolor lorem ipsum dolor. + + Middle of para: lorem ipsum dolor lorem ipsum dolor lorem + ipsum dolor @List.take lorem ipsum dolor lorem ipsum dolor + lorem ipsum dolor lorem ipsum dolor. + + - non-para line (@List.take) with ref @List.take + Another non-para line + @List.take starting non-para line + + - non-para line with ref @List.take + before a para-line lorem ipsum dolor lorem ipsum dolor lorem + ipsum dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum + dolor lorem ipsum dolor lorem ipsum dolor. + + - non-para line followed by a para line starting with ref + @List.take lorem ipsum dolor lorem ipsum dolor lorem ipsum + dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor + lorem ipsum dolor lorem ipsum dolor. + + a para-line ending with ref lorem ipsum dolor lorem ipsum + dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor + lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor @List.take + - non-para line + + para line lorem ipsum dolor lorem ipsum dolor lorem ipsum + dolor lorem ipsum dolor lorem ipsum dolor lorem ipsum dolor + lorem ipsum dolor lorem ipsum dolor + @List.take followed by non-para line starting with ref. + + @[signature] List.take + + @[source] foo + + @[evaluate] expr + + @[include] doc1 + + -- note the leading space below + @[signature] List.take + + :] +``` + +``` unison +-- Regression test for #1363 - preservation of spaces after @ directives in first line when unindenting +reg1363 = [: `@List.take foo` bar + baz :] +``` + +``` ucm :added-by-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`: + + reg1363 : Doc +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> view reg1363 + + reg1363 : Doc + reg1363 = [: `@List.take foo` bar baz :] +``` + +``` unison +-- Demonstrate doc display when whitespace follows a @[source] or @[evaluate] +-- whose output spans multiple lines. + +test2 = [: + Take a look at this: + @[source] foo ▶ bar +:] +``` + +``` ucm :added-by-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`: + + test2 : Doc +``` + +``` ucm :hide +scratch/main> add +``` + +View is fine. + +``` ucm +scratch/main> view test2 + + test2 : Doc + test2 = + [: Take a look at this: + @[source] foo ▶ bar + :] +``` + +But note it's not obvious how display should best be handling this. At the moment it just does the simplest thing: + +``` ucm +scratch/main> display test2 + + Take a look at this: + foo : Nat -> Nat + foo n = + use Nat + + _ = [: do the thing :] + n + 1 ▶ bar +``` diff --git a/unison-src/transcripts/doc-type-link-keywords.md b/unison-src/transcripts/idempotent/doc-type-link-keywords.md similarity index 82% rename from unison-src/transcripts/doc-type-link-keywords.md rename to unison-src/transcripts/idempotent/doc-type-link-keywords.md index 736e256dea..f44cb26737 100644 --- a/unison-src/transcripts/doc-type-link-keywords.md +++ b/unison-src/transcripts/idempotent/doc-type-link-keywords.md @@ -6,11 +6,11 @@ not the ability `Patterns`; the lexer should see this as a single identifier. See https://github.com/unisonweb/unison/issues/2642 for an example. -```ucm:hide +``` ucm :hide scratch/main> builtins.mergeio ``` -```unison:hide +``` unison :hide abilityPatterns : () abilityPatterns = () @@ -27,15 +27,26 @@ docs.example3 = {{A doc that links to the {typeLabels} term}} docs.example4 = {{A doc that links to the {type Labels} type}} ``` -```ucm:hide +``` ucm :hide scratch/main> add ``` Now we check that each doc links to the object of the correct name: -```ucm +``` ucm scratch/main> display docs.example1 + + A doc that links to the abilityPatterns term + scratch/main> display docs.example2 + + A doc that links to the Patterns ability + scratch/main> display docs.example3 + + A doc that links to the typeLabels term + scratch/main> display docs.example4 + + A doc that links to the Labels type ``` diff --git a/unison-src/transcripts/idempotent/doc1.md b/unison-src/transcripts/idempotent/doc1.md new file mode 100644 index 0000000000..85e23d20f6 --- /dev/null +++ b/unison-src/transcripts/idempotent/doc1.md @@ -0,0 +1,158 @@ +# Documenting Unison code + +``` ucm :hide +scratch/main> builtins.merge lib.builtins +``` + +Unison documentation is written in Unison. Documentation is a value of the following type: + +``` ucm +scratch/main> view lib.builtins.Doc + + type lib.builtins.Doc + = Blob Text + | Link Link + | Source Link + | Signature Term + | Evaluate Term + | Join [lib.builtins.Doc] +``` + +You can create these `Doc` values with ordinary code, or you can use the special syntax. A value of structural type `Doc` can be created via syntax like: + +``` unison +doc1 = [: This is some documentation. + +It can span multiple lines. + +Can link to definitions like @List.drop or @List + +:] +``` + +``` ucm :added-by-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`: + + doc1 : Doc +``` + +Syntax: + +`[:` starts a documentation block; `:]` finishes it. Within the block: + + - Links to definitions are done with `@List`. `\@` (and `\:]`) if you want to escape. + - `@[signature] List.take` expands to the type signature of `List.take` + - `@[source] List.map` expands to the full source of `List.map` + - `@[include] someOtherDoc`, inserts a value `someOtherDoc : Doc` here. + - `@[evaluate] someDefinition` expands to the result of evaluating `someDefinition`, which must be a pre-existing definition in the codebase (can't be an arbitrary expression). + +### An example + +We are going to document `List.take` using some verbiage and a few examples. First we have to add the examples to the codebase: + +``` unison +List.take.ex1 = take 0 [1,2,3,4,5] +List.take.ex2 = take 2 [1,2,3,4,5] +``` + +``` ucm :added-by-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`: + + List.take.ex1 : [Nat] + List.take.ex2 : [Nat] +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + List.take.ex1 : [Nat] + List.take.ex2 : [Nat] +``` + +And now let's write our docs and reference these examples: + +``` unison +List.take.doc = [: +`@List.take n xs` returns the first `n` elements of `xs`. (No need to add line breaks manually. The display command will do wrapping of text for you. Indent any lines where you don't want it to do this.) + +## Examples: + + @[source] List.take.ex1 + 🔽 + @List.take.ex1 = @[evaluate] List.take.ex1 + + + @[source] List.take.ex2 + 🔽 + @List.take.ex2 = @[evaluate] List.take.ex2 +:] +``` + +``` ucm :added-by-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`: + + List.take.doc : Doc +``` + +Let's add it to the codebase. + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + List.take.doc : Doc +``` + +We can view it with `docs`, which shows the `Doc` value that is associated with a definition. + +``` ucm +scratch/main> docs List.take + + `List.take n xs` returns the first `n` elements of `xs`. (No + need to add line breaks manually. The display command will do + wrapping of text for you. Indent any lines where you don't + want it to do this.) + + ## Examples: + + List.take.ex1 : [Nat] + List.take.ex1 = List.take 0 [1, 2, 3, 4, 5] + 🔽 + ex1 = [] + + + List.take.ex2 : [Nat] + List.take.ex2 = List.take 2 [1, 2, 3, 4, 5] + 🔽 + ex2 = [1, 2] +``` + +Note that if we view the source of the documentation, the various references are *not* expanded. + +``` ucm +scratch/main> view List.take + + builtin lib.builtins.List.take : + lib.builtins.Nat -> [a] -> [a] +``` diff --git a/unison-src/transcripts/idempotent/doc2.md b/unison-src/transcripts/idempotent/doc2.md new file mode 100644 index 0000000000..1e164c14ce --- /dev/null +++ b/unison-src/transcripts/idempotent/doc2.md @@ -0,0 +1,220 @@ +# Test parsing and round-trip of doc2 syntax elements + +``` ucm :hide +scratch/main> builtins.mergeio +``` + +``` unison :hide +otherDoc : a -> Doc2 +otherDoc _ = {{ yo }} + +otherTerm : Nat +otherTerm = 99 + +fulldoc : Doc2 +fulldoc = + use Nat + + {{ +Heres some text with a +soft line break + +hard line break + +Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code block `1 + 2` + +Should print with appropriate fences for the contents: + +`No fancy quotes` + +'' There are `backticks` in here '' + +''' There are `backticks` and ''quotes'' in here ''' + +# Heading + +## Heading 2 + +Term Link: {otherTerm} + +Type Link: {type Optional} + +Term source: + +@source{term} + +Term signature: + +@signature{term} + +* List item + +Inline code: + +`` 1 + 2 `` + +` "doesn't typecheck" + 1 ` + +[Link](https://unison-lang.org) + +![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png) + +Horizontal rule + +--- + +Video + +{{ +Special + (Embed + (Any (Video [MediaSource "test.mp4" None] [("poster", "test.png")]))) +}} + +Transclusion/evaluation: + +{{ otherDoc (a -> Word a) }} + +--- + +The following markdown features aren't supported by the Doc format yet, but maybe will someday + + +> Block quote + + +Table + +| Header 1 | Header 2 | +| -------- | -------- | +| Cell 1 | Cell 2 | + + + Indented Code block + +''' + Exact whitespace should be preserved across multiple updates. Don't mess with the logo! + + _____ _ + | | |___|_|___ ___ ___ + | | | | |_ -| . | | + |_____|_|_|_|___|___|_|_| + + Line with no whitespace: + + Should have one full trailing newline below here: + +''' + +Inline '' text literal with 1 space of padding '' in the middle of a sentence. + + +}} +``` + +Format it to check that everything pretty-prints in a valid way. + +``` ucm +scratch/main> debug.format +``` + +``` unison :added-by-ucm scratch.u +otherDoc : a -> Doc2 +otherDoc _ = {{ yo }} + +otherTerm : Nat +otherTerm = 99 + +fulldoc : Doc2 +fulldoc = + use Nat + + {{ + Heres some text with a soft line break + + hard line break + + Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code + block `1 + 2` + + Should print with appropriate fences for the contents: + + `No fancy quotes` + + '' There are `backticks` in here '' + + ''' There are `backticks` and ''quotes'' in here ''' + + # Heading + + ## Heading 2 + + Term Link: {otherTerm} + + Type Link: {type Optional} + + Term source: + + @source{term} + + Term signature: + + @signature{term} + + * List item + + Inline code: + + `` 1 + 2 `` + + ` "doesn't typecheck" + 1 ` + + [Link](https://unison-lang.org) + + ![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png) + + Horizontal rule + + --- + + Video + + {{ + Special + (Embed + (Any (Video [MediaSource "test.mp4" None] [("poster", "test.png")]))) + }} + + Transclusion/evaluation: + + {{ otherDoc (a -> Word a) }} + + --- + + The following markdown features aren't supported by the Doc format yet, + but maybe will someday + + > Block quote + + Table + + | Header 1 | Header 2 | | -------- | -------- | | Cell 1 | Cell 2 | + + Indented Code block + + ''' + Exact whitespace should be preserved across multiple updates. Don't mess with the logo! + + _____ _ + | | |___|_|___ ___ ___ + | | | | |_ -| . | | + |_____|_|_|_|___|___|_|_| + + Line with no whitespace: + + Should have one full trailing newline below here: + + ''' + + Inline ` text literal with 1 space of padding ` in the middle of a + sentence. + }} +``` diff --git a/unison-src/transcripts/idempotent/doc2markdown.md b/unison-src/transcripts/idempotent/doc2markdown.md new file mode 100644 index 0000000000..a27711ec6a --- /dev/null +++ b/unison-src/transcripts/idempotent/doc2markdown.md @@ -0,0 +1,202 @@ +``` ucm :hide +scratch/main> builtins.mergeio +``` + +``` unison :hide +otherDoc : a -> Doc2 +otherDoc _ = {{ yo }} + +otherTerm : Nat +otherTerm = 99 + +fulldoc : Doc2 +fulldoc = + use Nat + + {{ +Heres some text with a +soft line break + +hard line break + +Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code block ''1 + 2'' + +# Heading + +## Heading 2 + +Term Link: {otherTerm} + +Type Link: {type Optional} + +Term source: + +@source{term} + +Term signature: + +@signature{term} + +* List item + +Inline code: + +`` 1 + 2 `` + +` "doesn't typecheck" + 1 ` + +[Link](https://unison-lang.org) + +![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png) + +Horizontal rule + +--- + +Video + +{{ +Special + (Embed + (Any (Video [MediaSource "test.mp4" None] [("poster", "test.png")]))) +}} + +Transclusion/evaluation: + +{{ otherDoc (a -> Word a) }} + +--- + +The following markdown features aren't supported by the Doc format yet, but maybe will someday + + +> Block quote + + +Table + +| Header 1 | Header 2 | +| -------- | -------- | +| Cell 1 | Cell 2 | + + + Indented Code block + + +}} +``` + +``` ucm :hide +scratch/main> add +``` + +```` ucm +scratch/main> debug.doc-to-markdown fulldoc + + Heres some text with a soft line break + + hard line break + + Here's a cool **BOLD** _italic_ ~~strikethrough~~ thing with an inline code block `1 + 2` + + # Heading + + ## Heading 2 + + Term Link: `otherTerm` + + Type Link: `Optional` + + Term source: + + ```unison + term : '{g} a -> Doc2.Term + term a = Term.Term (Any a) + ``` + + + + Term signature: + + ```unison + term : '{g} a -> Doc2.Term + ``` + + + + - List item + + Inline code: + + `1 Nat.+ 2` + + ` "doesn't typecheck" + 1 ` + + [Link](https://unison-lang.org) + + ![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png) + + Horizontal rule + + --- + + Video + + ![](test.mp4) + + Transclusion/evaluation: + + yo + + + + --- + + The following markdown features aren't supported by the Doc format yet, but maybe will someday + + > Block quote + + Table + + | Header 1 | Header 2 | | -------- | -------- | | Cell 1 | Cell 2 | + + Indented Code block + + +```` + +You can add docs to a term or type with a top-level doc literal above the binding: + +``` unison +{{ This is a term doc }} +myTerm = 10 + +-- Regression tests for https://github.com/unisonweb/unison/issues/4634 +{{ This is a type doc }} +type MyType = MyType + +{{ This is a unique type doc }} +unique type MyUniqueType = MyUniqueType + +{{ This is a structural type doc }} +structural type MyStructuralType = MyStructuralType +``` + +``` ucm :added-by-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`: + + structural type MyStructuralType + (also named builtin.Unit) + type MyType + type MyUniqueType + MyStructuralType.doc : Doc2 + MyType.doc : Doc2 + MyUniqueType.doc : Doc2 + myTerm : Nat + myTerm.doc : Doc2 +``` diff --git a/unison-src/transcripts/idempotent/dont-upgrade-refs-that-exist-in-old.md b/unison-src/transcripts/idempotent/dont-upgrade-refs-that-exist-in-old.md new file mode 100644 index 0000000000..69f9032168 --- /dev/null +++ b/unison-src/transcripts/idempotent/dont-upgrade-refs-that-exist-in-old.md @@ -0,0 +1,50 @@ +If `foo#old` exists in old, and `foo#new` exists in new, you might think `upgrade old new` would rewrite references to +`#old` with references to `#new`. And it will... \!\!unless\!\! `#old` still exists in new. + +``` ucm :hide +foo/main> builtins.merge lib.builtin +``` + +``` unison +lib.old.foo = 18 +lib.new.other = 18 +lib.new.foo = 19 +mything = lib.old.foo + lib.old.foo +``` + +``` ucm :added-by-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`: + + lib.new.foo : Nat + lib.new.other : Nat + lib.old.foo : Nat + mything : Nat +``` + +``` ucm +foo/main> add + + ⍟ I've added these definitions: + + lib.new.foo : Nat + lib.new.other : Nat + lib.old.foo : Nat + mything : Nat + +foo/main> upgrade old new + + I upgraded old to new, and removed old. + +foo/main> view mything + + mything : Nat + mything = + use Nat + + other + other +``` diff --git a/unison-src/transcripts/idempotent/duplicate-names.md b/unison-src/transcripts/idempotent/duplicate-names.md new file mode 100644 index 0000000000..7f67014c75 --- /dev/null +++ b/unison-src/transcripts/idempotent/duplicate-names.md @@ -0,0 +1,137 @@ +# Duplicate names in scratch file. + +``` ucm :hide +scratch/main> builtins.merge +``` + +Term and ability constructor collisions should cause a parse error. + +``` unison :error +structural ability Stream where + send : a -> () + +Stream.send : a -> () +Stream.send _ = () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + ❗️ + + I found multiple bindings with the name Stream.send: + 2 | send : a -> () + 3 | + 4 | Stream.send : a -> () + 5 | Stream.send _ = () +``` + +Term and type constructor collisions should cause a parse error. + +``` unison :error +structural type X = x + +X.x : a -> () +X.x _ = () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + ❗️ + + I found multiple bindings with the name X.x: + 1 | structural type X = x + 2 | + 3 | X.x : a -> () + 4 | X.x _ = () +``` + +Ability and type constructor collisions should cause a parse error. + +``` unison :error +structural type X = x +structural ability X where + x : () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I found two types called X: + + 1 | structural type X = x + 2 | structural ability X where + 3 | x : () +``` + +Field accessors and terms with the same name should cause a parse error. + +``` unison :error +structural type X = {x : ()} +X.x.modify = () +X.x.set = () +X.x = () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + ❗️ + + I found multiple bindings with the name X.x: + 1 | structural type X = {x : ()} + 2 | X.x.modify = () + 3 | X.x.set = () + 4 | X.x = () + + + I found multiple bindings with the name X.x.modify: + 1 | structural type X = {x : ()} + 2 | X.x.modify = () + + + I found multiple bindings with the name X.x.set: + 1 | structural type X = {x : ()} + 2 | X.x.modify = () + 3 | X.x.set = () +``` + +Types and terms with the same name are allowed. + +``` unison +structural type X = Z + +X = () +``` + +``` ucm :added-by-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`: + + structural type X + (also named builtin.Unit) + X : () +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural type X + (also named builtin.Unit) + X : () + +scratch/main> view X + + structural type X = Z + + X : () + X = () +``` diff --git a/unison-src/transcripts/idempotent/duplicate-term-detection.md b/unison-src/transcripts/idempotent/duplicate-term-detection.md new file mode 100644 index 0000000000..0115bf71a1 --- /dev/null +++ b/unison-src/transcripts/idempotent/duplicate-term-detection.md @@ -0,0 +1,101 @@ +# Duplicate Term Detection + +``` ucm :hide +scratch/main> builtins.merge +``` + +Trivial duplicate terms should be detected: + +``` unison :error +x = 1 +x = 2 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + ❗️ + + I found multiple bindings with the name x: + 1 | x = 1 + 2 | x = 2 +``` + +Equivalent duplicate terms should be detected: + +``` unison :error +x = 1 +x = 1 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + ❗️ + + I found multiple bindings with the name x: + 1 | x = 1 + 2 | x = 1 +``` + +Duplicates from record accessors/setters should be detected + +``` unison :error +structural type Record = {x: Nat, y: Nat} +Record.x = 1 +Record.x.set = 2 +Record.x.modify = 2 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + ❗️ + + I found multiple bindings with the name Record.x: + 1 | structural type Record = {x: Nat, y: Nat} + 2 | Record.x = 1 + + + I found multiple bindings with the name Record.x.modify: + 1 | structural type Record = {x: Nat, y: Nat} + 2 | Record.x = 1 + 3 | Record.x.set = 2 + 4 | Record.x.modify = 2 + + + I found multiple bindings with the name Record.x.set: + 1 | structural type Record = {x: Nat, y: Nat} + 2 | Record.x = 1 + 3 | Record.x.set = 2 +``` + +Duplicate terms and constructors should be detected: + +``` unison :error +structural type SumType = X + +SumType.X = 1 + +structural ability AnAbility where + thing : Nat -> () + +AnAbility.thing = 2 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + ❗️ + + I found multiple bindings with the name AnAbility.thing: + 6 | thing : Nat -> () + 7 | + 8 | AnAbility.thing = 2 + + + I found multiple bindings with the name SumType.X: + 1 | structural type SumType = X + 2 | + 3 | SumType.X = 1 +``` diff --git a/unison-src/transcripts/idempotent/ed25519.md b/unison-src/transcripts/idempotent/ed25519.md new file mode 100644 index 0000000000..31311d9132 --- /dev/null +++ b/unison-src/transcripts/idempotent/ed25519.md @@ -0,0 +1,55 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison + +up = 0xs0123456789abcdef +down = 0xsfedcba9876543210 + +secret = 0xs3885da624f4430c01326d96764da85647d403dae1fcdc9856c51037f9c647032 + +public = 0xsb14dbcf139c0e73d942a184b419e4f4fab726102bfe2b65c060b113bb379c77c + + +message = up ++ down ++ up ++ down ++ down ++ up ++ down ++ up + +signature = crypto.Ed25519.sign.impl secret public message + +sigOkay = match signature with + Left err -> Left err + Right sg -> crypto.Ed25519.verify.impl public message sg + +> signature +> sigOkay +``` + +``` ucm :added-by-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`: + + down : Bytes + message : Bytes + public : Bytes + secret : Bytes + sigOkay : Either Failure Boolean + signature : Either Failure Bytes + up : Bytes + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 18 | > signature + ⧩ + Right + 0xs0b76988ce7e5147d36597d2a526ec7b8e178b3ae29083598c33c9fbcdf0f84b4ff2f8c5409123dd9a0c54447861c07e21296500a98540f5d5f15d927eaa6d30a + + 19 | > sigOkay + ⧩ + Right true +``` diff --git a/unison-src/transcripts/idempotent/edit-command.md b/unison-src/transcripts/idempotent/edit-command.md new file mode 100644 index 0000000000..1017033416 --- /dev/null +++ b/unison-src/transcripts/idempotent/edit-command.md @@ -0,0 +1,156 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +foo = 123 + +bar = 456 + +mytest = [Ok "ok"] +``` + +``` ucm :added-by-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`: + + bar : Nat + foo : Nat + mytest : [Result] +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bar : Nat + foo : Nat + mytest : [Result] + +scratch/main> edit.new foo bar + + ☝️ + + I added 2 definitions to the top of scratch.u + + You can edit them there, then run `update` to replace the + definitions currently in this namespace. + +scratch/main> edit.new mytest + + ☝️ + + I added 1 definitions to the top of scratch.u + + You can edit them there, then run `update` to replace the + definitions currently in this namespace. +``` + +``` unison :added-by-ucm scratch.u +bar : Nat +bar = 456 + +foo : Nat +foo = 123 +``` + +``` unison :added-by-ucm scratch.u +test> mytest = [Ok "ok"] +``` + +``` ucm :error +scratch/main> edit.new missing + + ⚠️ + + The following names were not found in the codebase. Check your spelling. + missing +``` + +``` ucm :hide +scratch/main> project.delete scratch +``` + +# `edit` + +The `edit` command adds to the current fold, and takes care not to add definitions that are already in the file. + +``` ucm :hide +scratch/main> builtins.mergeio lib.builtin +``` + +This stanza does nothing for some reason (transcript runner bug?), so we repeat it twice. + +``` unison +foo = 17 +bar = 18 +baz = 19 +``` + +``` unison +foo = 17 +bar = 18 +baz = 19 +``` + +``` ucm :added-by-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`: + + bar : Nat + baz : Nat + foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bar : Nat + baz : Nat + foo : Nat +``` + +``` unison +foo = 17 +bar = 18 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I found and typechecked the definitions in scratch.u. This + file has been previously added to the codebase. +``` + +``` ucm +scratch/main> edit bar baz + + ☝️ + + I added 1 definitions to the top of scratch.u + + You can edit them there, then run `update` to replace the + definitions currently in this namespace. +``` + +``` unison :added-by-ucm scratch.u +baz : Nat +baz = 19 +``` + +``` ucm :hide +scratch/main> project.delete scratch +``` diff --git a/unison-src/transcripts/idempotent/edit-dependents-command.md b/unison-src/transcripts/idempotent/edit-dependents-command.md new file mode 100644 index 0000000000..736197fb19 --- /dev/null +++ b/unison-src/transcripts/idempotent/edit-dependents-command.md @@ -0,0 +1,97 @@ +# `edit.dependents` + +The `edit.dependents` command is like `edit`, but it adds a definition and all of its transitive dependents to the file +(being careful not to add anything that's already there). + +``` ucm :hide +scratch/main> builtins.mergeio lib.builtin +``` + +``` unison +type Foo = Foo Nat Nat +type Bar = { bar : Foo } + +baz : Bar -> Bar +baz x = x +``` + +``` ucm :added-by-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`: + + type Bar + type Foo + Bar.bar : Bar -> Foo + Bar.bar.modify : (Foo ->{g} Foo) -> Bar ->{g} Bar + Bar.bar.set : Foo -> Bar -> Bar + baz : Bar -> Bar +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Bar + type Foo + Bar.bar : Bar -> Foo + Bar.bar.modify : (Foo ->{g} Foo) -> Bar ->{g} Bar + Bar.bar.set : Foo -> Bar -> Bar + baz : Bar -> Bar +``` + +Let's populate our scratch file with `Bar` (and its auto-generated accessors), then `edit.dependents` its dependency +`Foo`, which should add `Foo` and `baz`. + +``` unison +type Bar = { bar : Nat } +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + type Bar + Bar.bar : Bar -> Nat + Bar.bar.modify : (Nat ->{g} Nat) -> Bar ->{g} Bar + Bar.bar.set : Nat -> Bar -> Bar +``` + +``` ucm +scratch/main> edit.dependents Foo + + Loading branch... + + Identifying dependents... + + Loading dependents... + + ☝️ + + I added 2 definitions to the top of scratch.u + + You can edit them there, then run `update` to replace the + definitions currently in this namespace. +``` + +``` unison :added-by-ucm scratch.u +type Foo = Foo Nat Nat + +baz : Bar -> Bar +baz x = x +``` + +``` ucm :hide +scratch/main> project.delete scratch +``` diff --git a/unison-src/transcripts/idempotent/edit-namespace.md b/unison-src/transcripts/idempotent/edit-namespace.md new file mode 100644 index 0000000000..3e540bb147 --- /dev/null +++ b/unison-src/transcripts/idempotent/edit-namespace.md @@ -0,0 +1,149 @@ +``` ucm :hide +project/main> builtins.mergeio lib.builtin +``` + +``` unison +{{ ping doc }} +nested.cycle.ping n = n Nat.+ pong n + +{{ pong doc }} +nested.cycle.pong n = n Nat.+ ping n + +toplevel = "hi" + +simple.x = 10 +simple.y = 20 + +-- Shouldn't edit things in lib +lib.project.ignoreMe = 30 + +-- Shouldn't render record accessors +unique type Foo = { bar : Nat, baz : Nat } +``` + +``` ucm :added-by-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`: + + type Foo + Foo.bar : Foo -> Nat + Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + Foo.bar.set : Nat -> Foo -> Foo + Foo.baz : Foo -> Nat + Foo.baz.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + Foo.baz.set : Nat -> Foo -> Foo + lib.project.ignoreMe : Nat + nested.cycle.ping : Nat -> Nat + nested.cycle.ping.doc : Doc2 + nested.cycle.pong : Nat -> Nat + nested.cycle.pong.doc : Doc2 + simple.x : Nat + simple.y : Nat + toplevel : Text +``` + +``` ucm +project/main> add + + ⍟ I've added these definitions: + + type Foo + Foo.bar : Foo -> Nat + Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + Foo.bar.set : Nat -> Foo -> Foo + Foo.baz : Foo -> Nat + Foo.baz.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + Foo.baz.set : Nat -> Foo -> Foo + lib.project.ignoreMe : Nat + nested.cycle.ping : Nat -> Nat + nested.cycle.ping.doc : Doc2 + nested.cycle.pong : Nat -> Nat + nested.cycle.pong.doc : Doc2 + simple.x : Nat + simple.y : Nat + toplevel : Text +``` + +`edit.namespace` edits the whole namespace (minus the top-level `lib`). + +``` ucm +project/main> edit.namespace + + ☝️ + + I added 8 definitions to the top of scratch.u + + You can edit them there, then run `update` to replace the + definitions currently in this namespace. +``` + +``` unison :added-by-ucm scratch.u +type Foo = { bar : Nat, baz : Nat } + +nested.cycle.ping : Nat -> Nat +nested.cycle.ping n = + use Nat + + n + nested.cycle.pong n + +nested.cycle.ping.doc : Doc2 +nested.cycle.ping.doc = {{ ping doc }} + +nested.cycle.pong : Nat -> Nat +nested.cycle.pong n = + use Nat + + n + nested.cycle.ping n + +nested.cycle.pong.doc : Doc2 +nested.cycle.pong.doc = {{ pong doc }} + +simple.x : Nat +simple.x = 10 + +simple.y : Nat +simple.y = 20 + +toplevel : Text +toplevel = "hi" +``` + +`edit.namespace` can also accept explicit paths + +``` ucm +project/main> edit.namespace nested simple + + ☝️ + + I added 6 definitions to the top of scratch.u + + You can edit them there, then run `update` to replace the + definitions currently in this namespace. +``` + +``` unison :added-by-ucm scratch.u +nested.cycle.ping : Nat -> Nat +nested.cycle.ping n = + use Nat + + n + nested.cycle.pong n + +nested.cycle.ping.doc : Doc2 +nested.cycle.ping.doc = {{ ping doc }} + +nested.cycle.pong : Nat -> Nat +nested.cycle.pong n = + use Nat + + n + nested.cycle.ping n + +nested.cycle.pong.doc : Doc2 +nested.cycle.pong.doc = {{ pong doc }} + +simple.x : Nat +simple.x = 10 + +simple.y : Nat +simple.y = 20 +``` diff --git a/unison-src/transcripts/idempotent/empty-namespaces.md b/unison-src/transcripts/idempotent/empty-namespaces.md new file mode 100644 index 0000000000..680629e332 --- /dev/null +++ b/unison-src/transcripts/idempotent/empty-namespaces.md @@ -0,0 +1,155 @@ +# Empty namespace behaviours + +``` unison :hide +mynamespace.x = 1 +``` + +``` ucm :hide +scratch/main> add + +scratch/main> delete.namespace mynamespace +``` + +The deleted namespace shouldn't appear in `ls` output. + +``` ucm :error +scratch/main> ls + + nothing to show +``` + +``` ucm :error +scratch/main> find.verbose + + ☝️ + + I couldn't find matches in this namespace, searching in + 'lib'... + + 😶 + + No results. Check your spelling, or try using tab completion + to supply command arguments. + + `debug.find.global` can be used to search outside the current + namespace. +``` + +``` ucm :error +scratch/main> find mynamespace + + ☝️ + + I couldn't find matches in this namespace, searching in + 'lib'... + + 😶 + + No results. Check your spelling, or try using tab completion + to supply command arguments. + + `debug.find.global` can be used to search outside the current + namespace. +``` + +## history + +The history of the namespace should be empty. + +``` ucm +scratch/main> history mynamespace + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #sg60bvjo91 (start of history) +``` + +Add and then delete a term to add some history to a deleted namespace. + +``` unison :hide +deleted.x = 1 +stuff.thing = 2 +``` + +``` ucm :hide +scratch/main> add + +scratch/main> delete.namespace deleted +``` + +## fork + +I should be allowed to fork over a deleted namespace + +``` ucm +scratch/main> fork stuff deleted + + Done. +``` + +The history from the `deleted` namespace should have been overwritten by the history from `stuff`. + +``` ucm +scratch/main> history stuff + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #q2dq4tsno1 (start of history) + +scratch/main> history deleted + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #q2dq4tsno1 (start of history) +``` + +## move.namespace + +``` unison :hide +moveoverme.x = 1 +moveme.y = 2 +``` + +``` ucm :hide +scratch/main> add +``` + +I should be able to move a namespace over-top of a deleted namespace. +The history should be that of the moved namespace. + +``` ucm +scratch/main> delete.namespace moveoverme + + Done. + +scratch/main> history moveme + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #c5uisu4kll (start of history) + +scratch/main> move.namespace moveme moveoverme + + Done. + +scratch/main> history moveoverme + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #c5uisu4kll (start of history) +``` diff --git a/unison-src/transcripts/idempotent/emptyCodebase.md b/unison-src/transcripts/idempotent/emptyCodebase.md new file mode 100644 index 0000000000..3b2c7090e1 --- /dev/null +++ b/unison-src/transcripts/idempotent/emptyCodebase.md @@ -0,0 +1,40 @@ +# The empty codebase + +The Unison codebase, when first initialized, contains no definitions in its namespace. + +Not even `Nat` or `+`\! + +BEHOLD\!\!\! + +``` ucm :error +scratch/main> ls + + nothing to show +``` + +Technically, the definitions all exist, but they have no names. `builtins.merge` brings them into existence, under the current namespace: + +``` ucm +scratch/main> builtins.merge lib.builtins + + Done. + +scratch/main> ls lib + + 1. builtins/ (469 terms, 74 types) +``` + +And for a limited time, you can get even more builtin goodies: + +``` ucm +scratch/main> builtins.mergeio lib.builtinsio + + Done. + +scratch/main> ls lib + + 1. builtins/ (469 terms, 74 types) + 2. builtinsio/ (643 terms, 92 types) +``` + +More typically, you'd start out by pulling `base`. diff --git a/unison-src/transcripts/idempotent/error-messages.md b/unison-src/transcripts/idempotent/error-messages.md new file mode 100644 index 0000000000..27d45287c1 --- /dev/null +++ b/unison-src/transcripts/idempotent/error-messages.md @@ -0,0 +1,370 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +This file contains programs with parse errors and type errors, for visual inspection of error message quality and to check for regressions or changes to error reporting. + +## Parse errors + +Some basic errors of literals. + +### Floating point literals + +``` unison :error +x = 1. -- missing some digits after the decimal +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This number isn't valid syntax: + + 1 | x = 1. -- missing some digits after the decimal + + I was expecting some digits after the `.` , for example: `1.0` + or `1.1e37`. +``` + +``` unison :error +x = 1e -- missing an exponent +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This number isn't valid syntax: + + 1 | x = 1e -- missing an exponent + + I was expecting some digits for the exponent, for example: + `1e37`. +``` + +``` unison :error +x = 1e- -- missing an exponent +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This number isn't valid syntax: + + 1 | x = 1e- -- missing an exponent + + I was expecting some digits for the exponent, for example: + `1e-37`. +``` + +``` unison :error +x = 1E+ -- missing an exponent +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This number isn't valid syntax: + + 1 | x = 1E+ -- missing an exponent + + I was expecting some digits for the exponent, for example: + `1e+37`. +``` + +### Hex, octal, binary, and bytes literals + +``` unison :error +x = 0xoogabooga -- invalid hex chars +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This number isn't valid syntax: + + 1 | x = 0xoogabooga -- invalid hex chars + + I was expecting only hexidecimal characters (one of + 0123456789abcdefABCDEF) after the 0x. +``` + +``` unison :error +x = 0o987654321 -- 9 and 8 are not valid octal char +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This number isn't valid syntax: + + 1 | x = 0o987654321 -- 9 and 8 are not valid octal char + + I was expecting only octal characters (one of 01234567) after + the 0o. +``` + +``` unison :error +x = 0b3201 -- 3 and 2 are not valid binary chars +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This number isn't valid syntax: + + 1 | x = 0b3201 -- 3 and 2 are not valid binary chars + + I was expecting only binary characters (one of 01) after the + 0b. +``` + +``` unison :error +x = 0xsf -- odd number of hex chars in a bytes literal +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This bytes literal isn't valid syntax: 0xsf + + 1 | x = 0xsf -- odd number of hex chars in a bytes literal + + I was expecting an even number of hexidecimal characters (one + of 0123456789abcdefABCDEF) after the 0xs. +``` + +``` unison :error +x = 0xsnotvalidhexchars -- invalid hex chars in a bytes literal +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This bytes literal isn't valid syntax: 0xsnotvalidhexchars + + 1 | x = 0xsnotvalidhexchars -- invalid hex chars in a bytes literal + + I was expecting an even number of hexidecimal characters (one + of 0123456789abcdefABCDEF) after the 0xs. +``` + +### Layout errors + +``` unison :error +foo = else -- not matching if +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I found a closing 'else' here without a matching 'then'. + + 1 | foo = else -- not matching if +``` + +``` unison :error +foo = then -- unclosed +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I found a closing 'then' here without a matching 'if'. + + 1 | foo = then -- unclosed +``` + +``` unison :error +foo = with -- unclosed +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I found a closing 'with' here without a matching 'handle' or 'match'. + + 1 | foo = with -- unclosed +``` + +### Matching + +``` unison :error +-- No cases +foo = match 1 with +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Pattern match doesn't cover all possible cases: + 2 | foo = match 1 with + + + Patterns not matched: + * _ +``` + +``` unison :error +foo = match 1 with + 2 -- no right-hand-side +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I got confused here: + + 3 | + + I was surprised to find an end of section here. + I was expecting one of these instead: + + * "," + * case match + * pattern guard +``` + +``` unison :error +-- Mismatched arities +foo = cases + 1, 2 -> () + 3 -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + 😶 + + Not all the branches of this pattern matching have the same + number of arguments. I was assuming they'd all have 2 + arguments (based on the previous patterns) but this one has + 1 arguments: + 4 | 3 -> () + +``` + +``` unison :error +-- Missing a '->' +x = match Some a with + None -> + 1 + Some _ + 2 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I got confused here: + + 7 | + + I was surprised to find an end of section here. + I was expecting one of these instead: + + * "," + * blank + * case match + * false + * pattern guard + * true +``` + +``` unison :error +-- Missing patterns +x = match Some a with + None -> 1 + -> 2 + -> 3 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I got confused here: + + 4 | -> 2 + + + I was surprised to find a -> here. + I was expecting one of these instead: + + * end of input + * newline or semicolon +``` + +``` unison :error +-- Guards following an unguarded case +x = match Some a with + None -> 1 + | true -> 2 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I got confused here: + + 4 | | true -> 2 + + + I was surprised to find a '|' here. + I was expecting one of these instead: + + * end of input + * newline or semicolon +``` + +### Watches + +``` unison :error +-- Empty watch +> +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I expected a non-empty watch expression and not just ">" + + 2 | > +``` + +### Keywords + +``` unison :error +use.keyword.in.namespace = 1 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + The identifier `namespace` used here is a reserved keyword: + + 1 | use.keyword.in.namespace = 1 + + You can avoid this problem either by renaming the identifier + or wrapping it in backticks (like `namespace` ). +``` + +``` unison :error +-- reserved operator +a ! b = 1 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This looks like the start of an expression here + + 2 | a ! b = 1 + + but at the file top-level, I expect one of the following: + + - A binding, like a = 42 OR + a : Nat + a = 42 + - A watch expression, like > a + 1 + - An `ability` declaration, like unique ability Foo where ... + - A `type` declaration, like structural type Optional a = None | Some a +``` diff --git a/unison-src/transcripts/idempotent/escape-sequences.md b/unison-src/transcripts/idempotent/escape-sequences.md new file mode 100644 index 0000000000..463d97e117 --- /dev/null +++ b/unison-src/transcripts/idempotent/escape-sequences.md @@ -0,0 +1,28 @@ +``` unison +> "Rúnar" +> "῎Ανδρα μοι ἔννεπε, Μοῦσα, πολύτροπον" +> "古池や蛙飛びこむ水の音" +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + ✅ + + scratch.u changed. + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | > "Rúnar" + ⧩ + "Rúnar" + + 2 | > "῎Ανδρα μοι ἔννεπε, Μοῦσα, πολύτροπον" + ⧩ + "῎Ανδρα μοι ἔννεπε, Μοῦσα, πολύτροπον" + + 3 | > "古池や蛙飛びこむ水の音" + ⧩ + "古池や蛙飛びこむ水の音" +``` diff --git a/unison-src/transcripts/idempotent/find-by-type.md b/unison-src/transcripts/idempotent/find-by-type.md new file mode 100644 index 0000000000..156b3a7f72 --- /dev/null +++ b/unison-src/transcripts/idempotent/find-by-type.md @@ -0,0 +1,54 @@ +``` ucm :hide +scratch/main> alias.type ##Text builtin.Text +``` + +``` unison :hide +unique type A = A Text + +foo : A +foo = A "foo!" + +bar : Text -> A +bar = A + +baz : A -> Text +baz = cases + A t -> t +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type A + bar : Text -> A + baz : A -> Text + foo : A + +scratch/main> find : Text -> A + + 1. bar : Text -> A + 2. A.A : Text -> A + +scratch/main> find : A -> Text + + 1. baz : A -> Text + +scratch/main> find : A + + 1. foo : A +``` + +``` ucm :error +scratch/main> find : Text + + ☝️ + + I couldn't find exact type matches, resorting to fuzzy + matching... + + 1. bar : Text -> A + 2. baz : A -> Text + 3. A.A : Text -> A +``` diff --git a/unison-src/transcripts/idempotent/find-command.md b/unison-src/transcripts/idempotent/find-command.md new file mode 100644 index 0000000000..efe319c58a --- /dev/null +++ b/unison-src/transcripts/idempotent/find-command.md @@ -0,0 +1,99 @@ +``` ucm :hide +scratch/main> builtins.merge 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 :hide +scratch/main> add +``` + +``` ucm +scratch/main> find foo + + 1. cat.foo : Nat + 2. foo : Nat + +scratch/main> view 1 + + cat.foo : Nat + cat.foo = 4 + +scratch/main> find.all foo + + 1. cat.foo : Nat + 2. cat.lib.foo : Nat + 3. lib.foo : Nat + 4. foo : Nat + +scratch/main> view 1 + + cat.foo : Nat + cat.foo = 4 +``` + +``` ucm +scratch/main> find-in cat foo + + 1. foo : Nat + +scratch/main> view 1 + + cat.foo : Nat + cat.foo = 4 + +scratch/main> find-in.all cat foo + + 1. lib.foo : Nat + 2. foo : Nat + +scratch/main> view 1 + + cat.lib.foo : Nat + cat.lib.foo = 5 +``` + +Finding within a namespace + +``` ucm +scratch/main> find bar + + 1. somewhere.bar : Nat + +scratch/other> debug.find.global bar + + Found results in scratch/main + + 1. .cat.lib.bar : Nat + 2. .lib.bar : Nat + 3. .somewhere.bar : Nat + +scratch/main> find-in somewhere bar + + 1. bar : Nat +``` + +``` ucm :error +scratch/main> find baz + + ☝️ + + I couldn't find matches in this namespace, searching in + 'lib'... + + 😶 + + No results. Check your spelling, or try using tab completion + to supply command arguments. + + `debug.find.global` can be used to search outside the current + namespace. +``` diff --git a/unison-src/transcripts/idempotent/fix-1381-excess-propagate.md b/unison-src/transcripts/idempotent/fix-1381-excess-propagate.md new file mode 100644 index 0000000000..b724b01f05 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix-1381-excess-propagate.md @@ -0,0 +1,55 @@ +We were seeing an issue where (it seemed) that every namespace that was visited during a propagate would get a new history node, even when it didn't contain any dependents. + +Example: + +``` unison :hide +a = "a term" +X.foo = "a namespace" +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + X.foo : ##Text + a : ##Text +``` + +Here is an update which should not affect `X`: + +``` unison :hide +a = "an update" +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. +``` + +As of the time of this writing, the history for `X` should be a single node, `#4eeuo5bsfr`; + +``` ucm +scratch/main> history X + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #das1se4g2i (start of history) +``` + +however, as of release/M1i, we saw an extraneous node appear. If your `ucm` is fixed, you won't see it below: + +``` ucm :error +scratch/main> history #7nl6ppokhg + + 😶 + + I don't know of a namespace with that hash. +``` diff --git a/unison-src/transcripts/fix-2258-if-as-list-element.md b/unison-src/transcripts/idempotent/fix-2258-if-as-list-element.md similarity index 96% rename from unison-src/transcripts/fix-2258-if-as-list-element.md rename to unison-src/transcripts/idempotent/fix-2258-if-as-list-element.md index 1ebc3a2250..32224c32e3 100644 --- a/unison-src/transcripts/fix-2258-if-as-list-element.md +++ b/unison-src/transcripts/idempotent/fix-2258-if-as-list-element.md @@ -1,10 +1,10 @@ Tests that `if` statements can appear as list and tuple elements. -```ucm:hide +``` ucm :hide scratch/main> builtins.merge ``` -```unison:hide +``` unison :hide > [ if true then 1 else 0 ] > [ if true then 1 else 0, 1] @@ -63,4 +63,3 @@ fst = cases (x,_) -> x cases x, y -> x Nat.+ y ] ``` - diff --git a/unison-src/transcripts/idempotent/fix-5267.md b/unison-src/transcripts/idempotent/fix-5267.md new file mode 100644 index 0000000000..22cfd2bd71 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix-5267.md @@ -0,0 +1,82 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +lib.direct.foo = 17 +lib.direct.lib.indirect.foo = 18 + +bar : Nat +bar = direct.foo + direct.foo +``` + +``` ucm :added-by-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`: + + bar : Nat + lib.direct.foo : Nat + lib.direct.lib.indirect.foo : Nat +``` + +Here, `bar` renders as `foo + foo`, even though there are two names with suffix `foo` in scope, because one is an +indirect dependency. It used to render as `direct.foo + direct.foo`. + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bar : Nat + lib.direct.foo : Nat + lib.direct.lib.indirect.foo : Nat + +scratch/main> view bar + + bar : Nat + bar = + use Nat + + foo + foo +``` + +Same test, but for types. + +``` unison +type lib.direct.Foo = MkFoo +type lib.direct.lib.indirect.Foo = MkFoo + +type Bar = MkBar direct.Foo +``` + +``` ucm :added-by-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`: + + type Bar + type lib.direct.Foo + type lib.direct.lib.indirect.Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Bar + type lib.direct.Foo + type lib.direct.lib.indirect.Foo + +scratch/main> view Bar + + type Bar = MkBar Foo +``` diff --git a/unison-src/transcripts/idempotent/fix-5301.md b/unison-src/transcripts/idempotent/fix-5301.md new file mode 100644 index 0000000000..4e6621cb46 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix-5301.md @@ -0,0 +1,59 @@ +This transcripts demonstrates that pattern matching on a "constructor" (defined as a variable that begins with a capital +letter) that is either not found or ambiguouus fails. Previously, it would be treated as a variable binding. + +``` ucm +scratch/main> builtins.merge + + Done. +``` + +``` unison :error +type Foo = Bar Nat + +foo : Foo -> Nat +foo = cases + Bar X -> 5 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + + ❓ + + I couldn't resolve any of these symbols: + + 5 | Bar X -> 5 + + + Symbol Suggestions + + X No matches +``` + +``` unison :error +type Foo = Bar A +type A = X +type B = X + +foo : Foo -> Nat +foo = cases + Bar X -> 5 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + + ❓ + + I couldn't resolve any of these symbols: + + 7 | Bar X -> 5 + + + Symbol Suggestions + + X A.X + B.X +``` diff --git a/unison-src/transcripts/idempotent/fix-5312.md b/unison-src/transcripts/idempotent/fix-5312.md new file mode 100644 index 0000000000..870083dcad --- /dev/null +++ b/unison-src/transcripts/idempotent/fix-5312.md @@ -0,0 +1,73 @@ +This transcript demonstrates that dependents of an update are suffixified properly. Previously, `c = b.y + 1` would +render as `c = y + 1` (ambiguous). + +``` ucm +scratch/main> builtins.merge lib.builtin + + Done. +``` + +``` unison +x = 17 + +a.y = 18 +b.y = x + 1 + +c = b.y + 1 +``` + +``` ucm :added-by-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`: + + a.y : Nat + b.y : Nat + c : Nat + x : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + a.y : Nat + b.y : Nat + c : Nat + x : Nat +``` + +``` unison +x = 100 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + x : Nat +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. +``` diff --git a/unison-src/transcripts/idempotent/fix-5320.md b/unison-src/transcripts/idempotent/fix-5320.md new file mode 100644 index 0000000000..229cab0c43 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix-5320.md @@ -0,0 +1,26 @@ +``` ucm +scratch/main> builtins.merge lib.builtin + + Done. +``` + +``` unison :error +foo = cases + bar.Baz -> 5 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + + ❓ + + I couldn't resolve any of these symbols: + + 2 | bar.Baz -> 5 + + + Symbol Suggestions + + bar.Baz No matches +``` diff --git a/unison-src/transcripts/idempotent/fix-5323.md b/unison-src/transcripts/idempotent/fix-5323.md new file mode 100644 index 0000000000..7c658afc5a --- /dev/null +++ b/unison-src/transcripts/idempotent/fix-5323.md @@ -0,0 +1,52 @@ +This transcript demonstrates that dependents of an upgrade are suffixified properly. Previously, `c = b.y + 1` would +render as `c = y + 1` (ambiguous). + +``` ucm +scratch/main> builtins.merge lib.builtin + + Done. +``` + +``` unison +lib.old.x = 17 +lib.new.x = 100 + +a.y = 18 +b.y = lib.old.x + 1 + +c = b.y + 1 +``` + +``` ucm :added-by-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`: + + a.y : Nat + b.y : Nat + c : Nat + lib.new.x : Nat + lib.old.x : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + a.y : Nat + b.y : Nat + c : Nat + lib.new.x : Nat + lib.old.x : Nat +``` + +``` ucm +scratch/main> upgrade old new + + I upgraded old to new, and removed old. +``` diff --git a/unison-src/transcripts/idempotent/fix-5326.md b/unison-src/transcripts/idempotent/fix-5326.md new file mode 100644 index 0000000000..267648cb4c --- /dev/null +++ b/unison-src/transcripts/idempotent/fix-5326.md @@ -0,0 +1,242 @@ +``` ucm +scratch/main> builtins.merge lib.builtin + + Done. +``` + +``` unison +x = 1 +``` + +``` ucm :added-by-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`: + + x : Nat +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/main> branch foo + + Done. I've created the foo branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /foo`. +``` + +``` +main, foo +| +A +``` + +``` unison +x = 2 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + x : Nat +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/main> branch bar + + Done. I've created the bar branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /bar`. +``` + +``` +main, bar +| +| foo +| | +B - A +``` + +``` unison +x = 3 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + x : Nat +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. +``` + +``` +main +| +| bar foo +| | | +C - B - A +``` + +``` unison +x = 4 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + x : Nat +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. +``` + +``` +main +| +| bar foo +| | | +D - C - B - A +``` + +``` unison +y = 5 +``` + +``` ucm :added-by-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`: + + y : Nat +``` + +``` ucm +scratch/foo> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. +``` + +``` +main +| +| bar +| | +D - C - B - A + / + E + | + foo +``` + +``` ucm +scratch/main> merge /foo + + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + + I merged scratch/foo into scratch/main. +``` + +``` +main +| +| bar +| | +F - D - C - B - A + \ / + ----------- E + | + foo +``` + +``` ucm +scratch/main> merge /bar + + 😶 + + scratch/main was already up-to-date with scratch/bar. +``` + +This should be a fast-forward, but we used to get this shape instead (which fails due to conflicts), because we +incorrectly computed `LCA(main, bar)` as `A`, not `B`. + +``` +main +| +| ------------ bar +| / \| +G - F - D - C - B - A + \ / + ----------- E + | + foo +``` diff --git a/unison-src/transcripts/idempotent/fix-5340.md b/unison-src/transcripts/idempotent/fix-5340.md new file mode 100644 index 0000000000..1e13d6c1c0 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix-5340.md @@ -0,0 +1,78 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +type my.Foo = MkFoo +type lib.dep.lib.dep.Foo = MkFoo + +my.foo = 17 +lib.dep.lib.dep.foo = 18 +``` + +``` ucm :added-by-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`: + + type lib.dep.lib.dep.Foo + type my.Foo + lib.dep.lib.dep.foo : Nat + my.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type lib.dep.lib.dep.Foo + type my.Foo + lib.dep.lib.dep.foo : Nat + my.foo : Nat +``` + +These references to type `Foo` and term `foo` are unambiguous (resolving to the `my.Foo` and `my.foo` in the +file), even though indirect dependencies `lib.dep.lib.dep.Foo` and `lib.dep.lib.dep.foo` match by suffix. + +``` unison +type my.Foo = MkFoo +type Bar = MkBar Foo +``` + +``` ucm :added-by-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: + + ⊡ Previously added definitions will be ignored: my.Foo + + ⍟ These new definitions are ok to `add`: + + type Bar +``` + +``` unison +my.foo = 17 +bar = foo Nat.+ foo +``` + +``` ucm :added-by-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: + + ⊡ Previously added definitions will be ignored: my.foo + + ⍟ These new definitions are ok to `add`: + + bar : Nat +``` diff --git a/unison-src/transcripts/idempotent/fix-5357.md b/unison-src/transcripts/idempotent/fix-5357.md new file mode 100644 index 0000000000..08bbb58500 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix-5357.md @@ -0,0 +1,85 @@ +``` unison +util.ignore : a -> () +util.ignore _ = () + +foo : () +foo = + ignore 3 + ignore 4 +``` + +``` ucm :added-by-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 : () + util.ignore : a -> () +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + foo : () + util.ignore : a -> () +``` + +``` unison +lib.base.ignore : a -> () +lib.base.ignore _ = () +``` + +``` ucm :added-by-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`: + + lib.base.ignore : a -> () + (also named util.ignore) +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + lib.base.ignore : a -> () + (also named util.ignore) + +scratch/main> edit.namespace + + ☝️ + + I added 2 definitions to the top of scratch.u + + You can edit them there, then run `update` to replace the + definitions currently in this namespace. + +scratch/main> load + + Loading changes detected in scratch.u. + + I found and typechecked the definitions in scratch.u. This + file has been previously added to the codebase. +``` + +``` unison :added-by-ucm scratch.u +foo : () +foo = + use util ignore + ignore 3 + ignore 4 + +util.ignore : a -> () +util.ignore _ = () +``` diff --git a/unison-src/transcripts/idempotent/fix-5369.md b/unison-src/transcripts/idempotent/fix-5369.md new file mode 100644 index 0000000000..d947810f51 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix-5369.md @@ -0,0 +1,60 @@ +``` ucm +scratch/main> builtins.merge + + Done. +``` + +``` unison +one.foo : Nat +one.foo = 17 + +two.foo : Text +two.foo = "blah" +``` + +``` ucm :added-by-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`: + + one.foo : Nat + two.foo : Text +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + one.foo : Nat + two.foo : Text +``` + +``` unison +one.foo : Nat +one.foo = 18 + +bar : Nat +bar = foo + foo +``` + +``` ucm :added-by-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`: + + bar : Nat + + ⍟ These names already exist. You can `update` them to your + new definition: + + one.foo : Nat +``` diff --git a/unison-src/transcripts/idempotent/fix-5374.md b/unison-src/transcripts/idempotent/fix-5374.md new file mode 100644 index 0000000000..6cd2957351 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix-5374.md @@ -0,0 +1,59 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +lib.direct.foo = 17 +lib.direct.lib.indirect.foo = 18 + +thing = indirect.foo + indirect.foo +``` + +``` ucm :added-by-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`: + + lib.direct.foo : Nat + lib.direct.lib.indirect.foo : Nat + thing : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + lib.direct.foo : Nat + lib.direct.lib.indirect.foo : Nat + thing : Nat + +scratch/main> view thing + + thing : Nat + thing = + use Nat + + use indirect foo + foo + foo + +scratch/main> edit.new thing + + ☝️ + + I added 1 definitions to the top of scratch.u + + You can edit them there, then run `update` to replace the + definitions currently in this namespace. +``` + +``` unison :added-by-ucm scratch.u +thing : Nat +thing = + use Nat + + use indirect foo + foo + foo +``` diff --git a/unison-src/transcripts/idempotent/fix-5380.md b/unison-src/transcripts/idempotent/fix-5380.md new file mode 100644 index 0000000000..b9d1329db3 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix-5380.md @@ -0,0 +1,51 @@ +``` ucm +scratch/main> builtins.merge lib.builtin + + Done. +``` + +``` unison +foo : Nat +foo = 17 + +bar : Nat +bar = + qux : Nat + qux = 18 + foo + qux +``` + +``` ucm :added-by-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`: + + bar : Nat + foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bar : Nat + foo : Nat + +scratch/main> move.term foo qux + + Done. + +scratch/main> view bar + + bar : Nat + bar = + use Nat + + qux : Nat + qux = 18 + .qux + qux +``` diff --git a/unison-src/transcripts/idempotent/fix-5402.md b/unison-src/transcripts/idempotent/fix-5402.md new file mode 100644 index 0000000000..a52e697869 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix-5402.md @@ -0,0 +1,37 @@ +`namespace` + top level `use` should work. Previously, they didn't. + +``` unison +namespace foo +use bar baz +x = 10 +``` + +``` ucm :added-by-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.x : ##Nat +``` + +``` unison +use bar baz +namespace foo +x = 10 +``` + +``` ucm :added-by-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.x : ##Nat +``` diff --git a/unison-src/transcripts/idempotent/fix-5433.md b/unison-src/transcripts/idempotent/fix-5433.md new file mode 100644 index 0000000000..0151405618 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix-5433.md @@ -0,0 +1,57 @@ +This used to cause a "duplicate effects" error because we weren't de-duping ability lists after binding names. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +ability foo.Bar where + baz : () +``` + +``` ucm :added-by-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`: + + ability foo.Bar +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + ability foo.Bar +``` + +``` unison +ability foo.Bar where + baz : '{Bar} () + +hello : Request {foo.Bar} a -> () +hello = cases + { baz _ -> _ } -> () + { _ } -> () +``` + +``` ucm :added-by-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`: + + hello : Request {Bar} a -> () + + ⍟ These names already exist. You can `update` them to your + new definition: + + ability foo.Bar +``` diff --git a/unison-src/transcripts/idempotent/fix-5446.md b/unison-src/transcripts/idempotent/fix-5446.md new file mode 100644 index 0000000000..a25a26aaa4 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix-5446.md @@ -0,0 +1,38 @@ +Previously `delete.namespace` would refuse to delete a namespace if it would leave any nameless references in `lib`. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +lib.one.foo = 17 +lib.two.bar = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + lib.one.foo : Nat + lib.two.bar : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + lib.one.foo : Nat + lib.two.bar : Nat +``` + +``` ucm +scratch/main> delete.namespace lib.one + + Done. +``` diff --git a/unison-src/transcripts/idempotent/fix-5464.md b/unison-src/transcripts/idempotent/fix-5464.md new file mode 100644 index 0000000000..387a3184ac --- /dev/null +++ b/unison-src/transcripts/idempotent/fix-5464.md @@ -0,0 +1,83 @@ +``` ucm +scratch/main> builtins.merge lib.builtin + + Done. +``` + +``` unison +foo : Nat +foo = + baz = bar.baz + bar.baz + 19 + +bar.baz : Nat +bar.baz = 20 + +qux : Nat +qux = foo + foo +``` + +``` ucm :added-by-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`: + + bar.baz : Nat + foo : Nat + qux : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bar.baz : Nat + foo : Nat + qux : Nat +``` + +``` unison +foo : Nat +foo = + baz = bar.baz + bar.baz + 20 + +bar.baz : Nat +bar.baz = 20 +``` + +``` ucm :added-by-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: + + ⊡ Previously added definitions will be ignored: bar.baz + + ⍟ These names already exist. You can `update` them to your + new definition: + + foo : Nat +``` + +This update used to fail because `foo` would incorrectly print with a `use bar baz` statement, which caused references +to `bar.baz` to be captured by its locally-bound `baz`. + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. +``` diff --git a/unison-src/transcripts/fix-big-list-crash.md b/unison-src/transcripts/idempotent/fix-big-list-crash.md similarity index 88% rename from unison-src/transcripts/fix-big-list-crash.md rename to unison-src/transcripts/idempotent/fix-big-list-crash.md index 70c056515d..2f0134bd47 100644 --- a/unison-src/transcripts/fix-big-list-crash.md +++ b/unison-src/transcripts/idempotent/fix-big-list-crash.md @@ -1,13 +1,26 @@ #### Big list crash -```ucm:hide +``` ucm :hide scratch/main> builtins.merge ``` Big lists have been observed to crash, while in the garbage collection step. -```unison +``` unison unique type Direction = U | D | L | R x = [(R,1005),(U,563),(R,417),(U,509),(L,237),(U,555),(R,397),(U,414),(L,490),(U,336),(L,697),(D,682),(L,180),(U,951),(L,189),(D,547),(R,697),(U,583),(L,172),(D,859),(L,370),(D,114),(L,519),(U,829),(R,389),(U,608),(R,66),(D,634),(L,320),(D,49),(L,931),(U,137),(L,349),(D,689),(L,351),(D,829),(R,819),(D,138),(L,118),(D,849),(R,230),(U,858),(L,509),(D,311),(R,815),(U,217),(R,359),(U,840),(R,77),(U,230),(R,361),(U,322),(R,300),(D,646),(R,348),(U,815),(R,793),(D,752),(R,967),(U,128),(R,948),(D,499),(R,359),(U,572),(L,566),(U,815),(R,630),(D,290),(L,829),(D,736),(R,358),(U,778),(R,891),(U,941),(R,544),(U,889),(L,920),(U,913),(L,447),(D,604),(R,538),(U,818),(L,215),(D,437),(R,447),(U,576),(R,452),(D,794),(R,864),(U,269),(L,325),(D,35),(L,268),(D,639),(L,101),(U,777),(L,776),(U,958),(R,105),(U,517),(R,667),(D,423),(R,603),(U,469),(L,125),(D,919),(R,879),(U,994),(R,665),(D,377),(R,456),(D,570),(L,685),(U,291),(R,261),(U,846),(R,840),(U,418),(L,974),(D,270),(L,312),(D,426),(R,621),(D,334),(L,855),(D,378),(R,694),(U,845),(R,481),(U,895),(L,362),(D,840),(L,712),(U,57),(R,276),(D,643),(R,566),(U,348),(R,361),(D,144),(L,287),(D,864),(L,556),(U,610),(L,927),(U,322),(R,271),(D,90),(L,741),(U,446),(R,181),(D,527),(R,56),(U,805),(L,907),(D,406),(L,286),(U,873),(L,79),(D,280),(L,153),(D,377),(R,253),(D,61),(R,475),(D,804),(R,788),(U,393),(L,660),(U,314),(R,489),(D,491),(L,234),(D,712),(L,253),(U,651),(L,777),(D,726),(R,146),(U,47),(R,630),(U,517),(R,226),(U,624),(L,834),(D,153),(L,513),(U,799),(R,287),(D,868),(R,982),(U,390),(L,296),(D,373),(R,9),(U,994),(R,105),(D,673),(L,657),(D,868),(R,738),(D,277),(R,374),(U,828),(R,860),(U,247),(R,484),(U,986),(L,723),(D,847),(L,578),(U,487),(L,51),(D,865),(L,328),(D,199),(R,812),(D,726),(R,355),(D,463),(R,761),(U,69),(R,508),(D,753),(L,81),(D,50),(L,345),(D,66),(L,764),(D,466),(L,975),(U,619),(R,59),(D,788),(L,737),(D,360),(R,14),(D,253),(L,512),(D,417),(R,828),(D,188),(L,394),(U,212),(R,658),(U,369),(R,920),(U,927),(L,339),(U,552),(R,856),(D,458),(R,407),(U,41),(L,930),(D,460),(R,809),(U,467),(L,410),(D,800),(L,135),(D,596),(R,678),(D,4),(L,771),(D,637),(L,876),(U,192),(L,406),(D,136),(R,666),(U,730),(R,711),(D,291),(L,586),(U,845),(R,606),(U,2),(L,228),(D,759),(R,244),(U,946),(R,948),(U,160),(R,397),(U,134),(R,188),(U,850),(R,623),(D,315),(L,219),(D,450),(R,489),(U,374),(R,299),(D,474),(L,767),(D,679),(L,160),(D,403),(L,708)] ``` + +``` ucm :added-by-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`: + + type Direction + x : [(Direction, Nat)] +``` diff --git a/unison-src/transcripts/idempotent/fix-ls.md b/unison-src/transcripts/idempotent/fix-ls.md new file mode 100644 index 0000000000..e1ccc5862f --- /dev/null +++ b/unison-src/transcripts/idempotent/fix-ls.md @@ -0,0 +1,42 @@ +``` ucm +test-ls/main> builtins.merge + + Done. +``` + +``` unison +foo.bar.add x y = x Int.+ y + +foo.bar.subtract x y = x Int.- y +``` + +``` ucm :added-by-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.bar.add : Int -> Int -> Int + foo.bar.subtract : Int -> Int -> Int +``` + +``` ucm +test-ls/main> add + + ⍟ I've added these definitions: + + foo.bar.add : Int -> Int -> Int + foo.bar.subtract : Int -> Int -> Int + +test-ls/main> ls foo + + 1. bar/ (2 terms) + +test-ls/main> ls 1 + + 1. add (Int -> Int -> Int) + 2. subtract (Int -> Int -> Int) +``` diff --git a/unison-src/transcripts/idempotent/fix1063.md b/unison-src/transcripts/idempotent/fix1063.md new file mode 100644 index 0000000000..1ac4910678 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix1063.md @@ -0,0 +1,42 @@ +Tests that functions named `.` are rendered correctly. + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +(`.`) f g x = f (g x) + +use Boolean not + +noop = not `.` not +``` + +``` ucm :added-by-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`: + + `.` : (i1 ->{g1} o) -> (i ->{g} i1) -> i ->{g1, g} o + noop : Boolean -> Boolean +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + `.` : (i1 ->{g1} o) -> (i ->{g} i1) -> i ->{g1, g} o + noop : Boolean -> Boolean + +scratch/main> view noop + + noop : Boolean -> Boolean + noop = + use Boolean not + not `.` not +``` diff --git a/unison-src/transcripts/idempotent/fix1327.md b/unison-src/transcripts/idempotent/fix1327.md new file mode 100644 index 0000000000..a6f700bc83 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix1327.md @@ -0,0 +1,48 @@ +``` unison +foo = 4 + +bar = 5 +``` + +``` ucm :added-by-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`: + + bar : ##Nat + foo : ##Nat +``` + +`alias.many` should be able to consume the numbered args produced by `ls`. Previously, `ls` would produce absolute paths, but `alias.many` required relative ones. + +Now `ls` returns a pair of the absolute search directory and the result relative to that search directory, so it can be used in both absolute and relative contexts. + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bar : ##Nat + foo : ##Nat + +scratch/main> ls + + 1. bar (##Nat) + 2. foo (##Nat) + +scratch/main> alias.many 1-2 .ns1_nohistory + + Here's what changed in .ns1_nohistory : + + Added definitions: + + 1. bar : ##Nat + 2. foo : ##Nat + + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. +``` diff --git a/unison-src/transcripts/fix1334.md b/unison-src/transcripts/idempotent/fix1334.md similarity index 82% rename from unison-src/transcripts/fix1334.md rename to unison-src/transcripts/idempotent/fix1334.md index 5ab5899aeb..7d8a03e930 100644 --- a/unison-src/transcripts/fix1334.md +++ b/unison-src/transcripts/idempotent/fix1334.md @@ -1,10 +1,15 @@ -Previously, the `alias.term` and `alias.type` would fail if the source argument was hash-only, and there was no way to create an alias for a definition that didn't already have a name. Also, the `replace.term` and `replace.type` _only_ worked on hashes, and they had to be _full_ hashes. +Previously, the `alias.term` and `alias.type` would fail if the source argument was hash-only, and there was no way to create an alias for a definition that didn't already have a name. Also, the `replace.term` and `replace.type` *only* worked on hashes, and they had to be *full* hashes. With this PR, the source of an alias can be a short hash (even of a definition that doesn't currently have a name in the namespace) along with a name or hash-qualified name from the current namespace as usual. Let's make some hash-only aliases, now that we can. :mad-with-power-emoji: -```ucm +``` ucm scratch/main> alias.type ##Nat Cat + + Done. + scratch/main> alias.term ##Nat.+ please_fix_763.+ + + Done. ``` diff --git a/unison-src/transcripts/idempotent/fix1390.md b/unison-src/transcripts/idempotent/fix1390.md new file mode 100644 index 0000000000..f597292177 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix1390.md @@ -0,0 +1,65 @@ +``` ucm +scratch/main> builtins.merge + + Done. +``` + +``` unison +-- List.map : (a -> b) -> [a] -> [b] +List.map f = + go acc = cases + [] -> acc + h +: t -> go (acc :+ f h) t + go [] +``` + +``` ucm :added-by-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`: + + List.map : (i ->{g} o) -> [i] ->{g} [o] +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + List.map : (i ->{g} o) -> [i] ->{g} [o] + +scratch/main> view List.map + + List.map : (i ->{g} o) -> [i] ->{g} [o] + List.map f = + go acc = cases + [] -> acc + h +: t -> go (acc :+ f h) t + go [] +``` + +``` unison +List.map2 : (g -> g2) -> [g] -> [g2] +List.map2 f = + unused = "just to give this a different hash" + go acc = cases + [] -> acc + h +: t -> go (acc :+ f h) t + go [] +``` + +``` ucm :added-by-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`: + + List.map2 : (g ->{h} g2) -> [g] ->{h} [g2] +``` diff --git a/unison-src/transcripts/idempotent/fix1421.md b/unison-src/transcripts/idempotent/fix1421.md new file mode 100644 index 0000000000..56b592a2db --- /dev/null +++ b/unison-src/transcripts/idempotent/fix1421.md @@ -0,0 +1,27 @@ +``` ucm +scratch/main> alias.type ##Nat Nat + + Done. + +scratch/main> alias.term ##Nat.+ Nat.+ + + Done. +``` + +``` unison +unique type A = A Nat +unique type B = B Nat Nat +``` + +``` ucm :added-by-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`: + + type A + type B +``` diff --git a/unison-src/transcripts/idempotent/fix1532.md b/unison-src/transcripts/idempotent/fix1532.md new file mode 100644 index 0000000000..8a7f4dd1e8 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix1532.md @@ -0,0 +1,87 @@ +``` ucm +scratch/main> builtins.merge + + Done. +``` + +First, lets create two namespaces. `foo` and `bar`, and add some definitions. + +``` unison +foo.x = 42 +foo.y = 100 +bar.z = x + y +``` + +``` ucm :added-by-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`: + + bar.z : Nat + foo.x : Nat + foo.y : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bar.z : Nat + foo.x : Nat + foo.y : Nat +``` + +Let's see what we have created... + +``` ucm +scratch/main> ls + + 1. bar/ (1 term) + 2. builtin/ (469 terms, 74 types) + 3. foo/ (2 terms) +``` + +Now, if we try deleting the namespace `foo`, we get an error, as expected. + +``` ucm :error +scratch/main> delete.namespace foo + + ⚠️ + + I didn't delete the namespace because the following + definitions are still in use. + + Dependency Referenced In + x 1. bar.z + + y 2. bar.z + + If you want to proceed anyways and leave those definitions + without names, use delete.namespace.force +``` + +Any numbered arguments should refer to `bar.z`. + +``` ucm +scratch/main> debug.numberedArgs + + 1. bar.z + 2. bar.z +``` + +We can then delete the dependent term, and then delete `foo`. + +``` ucm +scratch/main> delete.term 1 + + Done. + +scratch/main> delete.namespace foo + + Done. +``` diff --git a/unison-src/transcripts/idempotent/fix1696.md b/unison-src/transcripts/idempotent/fix1696.md new file mode 100644 index 0000000000..44c796315f --- /dev/null +++ b/unison-src/transcripts/idempotent/fix1696.md @@ -0,0 +1,29 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison :error +structural ability Ask where ask : Nat + +ability Zoot where + zoot : Nat + +Ask.provide : '{Zoot} Nat -> '{Ask} r -> r +Ask.provide answer asker = + h = cases + {r} -> r + {Ask.ask -> resume} -> handle resume !answer with h + handle !asker with h + +dialog = Ask.provide 'zoot '("Awesome number: " ++ Nat.toText Ask.ask ++ "!") + +> dialog +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + The expression in red needs the {Zoot} ability, but this location does not have access to any abilities. + + 13 | dialog = Ask.provide 'zoot '("Awesome number: " ++ Nat.toText Ask.ask ++ "!") +``` diff --git a/unison-src/transcripts/idempotent/fix1709.md b/unison-src/transcripts/idempotent/fix1709.md new file mode 100644 index 0000000000..324e2564c5 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix1709.md @@ -0,0 +1,48 @@ +``` unison +id x = x + +id2 x = + z = 384849 + id x +``` + +``` ucm :added-by-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`: + + id : x -> x + id2 : x -> x +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + id : x -> x + id2 : x -> x +``` + +``` unison +> id2 "hi" +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + ✅ + + scratch.u changed. + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | > id2 "hi" + ⧩ + "hi" +``` diff --git a/unison-src/transcripts/idempotent/fix1731.md b/unison-src/transcripts/idempotent/fix1731.md new file mode 100644 index 0000000000..b64f221eeb --- /dev/null +++ b/unison-src/transcripts/idempotent/fix1731.md @@ -0,0 +1,33 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison :hide +structural ability CLI where + print : Text ->{CLI} () + input : {CLI} Text +``` + +``` ucm :hide +scratch/main> add +``` + +The `input` here should parse as a wildcard, not as `CLI.input`. + +``` unison +repro : Text -> () +repro = cases + input -> () +``` + +``` ucm :added-by-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`: + + repro : Text -> () +``` diff --git a/unison-src/transcripts/idempotent/fix1800.md b/unison-src/transcripts/idempotent/fix1800.md new file mode 100644 index 0000000000..f47a148448 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix1800.md @@ -0,0 +1,116 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison :hide +printLine : Text ->{IO} () +printLine msg = + _ = putBytes.impl (stdHandle StdOut) (Text.toUtf8 (msg ++ "\n")) + () + +-- An unannotated main function +main1 = '(printLine "\nhello world!") + +-- Another variation +main2 _ = printLine "🌹" + +-- An annotated main function +main3 : '{IO} () +main3 _ = printLine "🦄 ☁️ 🌈" +``` + +Testing a few variations here: + + - Should be able to run annotated and unannotated main functions in the current file. + - Should be able to run annotated and unannotated main functions from the codebase. + +``` ucm +scratch/main> run main1 + + () + +scratch/main> run main2 + + () + +scratch/main> run main3 + + () + +scratch/main> add + + ⍟ I've added these definitions: + + main1 : '{IO} () + main2 : ∀ _. _ ->{IO} () + main3 : '{IO} () + printLine : Text ->{IO} () + +scratch/main> rename.term main1 code.main1 + + Done. + +scratch/main> rename.term main2 code.main2 + + Done. + +scratch/main> rename.term main3 code.main3 + + Done. +``` + +The renaming just ensures that when running `code.main1`, it has to get that main from the codebase rather than the scratch file: + +``` ucm +scratch/main> run code.main1 + + () + +scratch/main> run code.main2 + + () + +scratch/main> run code.main3 + + () +``` + +Now testing a few variations that should NOT typecheck. + +``` unison :hide +main4 : Nat ->{IO} Nat +main4 n = n + +main5 : Nat ->{IO} () +main5 _ = () +``` + +This shouldn't work since `main4` and `main5` don't have the right type. + +``` ucm :error +scratch/main> run main4 + + 😶 + + I found this function: + + main4 : Nat ->{IO} Nat + + but in order for me to `run` it needs to be a subtype of: + + main4 : '{IO, Exception} result +``` + +``` ucm :error +scratch/main> run main5 + + 😶 + + I found this function: + + main5 : Nat ->{IO} () + + but in order for me to `run` it needs to be a subtype of: + + main5 : '{IO, Exception} result +``` diff --git a/unison-src/transcripts/idempotent/fix1844.md b/unison-src/transcripts/idempotent/fix1844.md new file mode 100644 index 0000000000..0188dd0c8a --- /dev/null +++ b/unison-src/transcripts/idempotent/fix1844.md @@ -0,0 +1,32 @@ +``` unison +structural type One a = One a +unique type Woot a b c = Woot a b c +unique type Z = Z + +snoc k aN = match k with + One a0 -> Woot (One a0) (One aN) 99 + +> snoc (One 1) 2 +``` + +``` ucm :added-by-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`: + + structural type One a + type Woot a b c + type Z + snoc : One a -> aN -> Woot (One a) (One aN) ##Nat + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 8 | > snoc (One 1) 2 + ⧩ + Woot (One 1) (One 2) 99 +``` diff --git a/unison-src/transcripts/idempotent/fix1926.md b/unison-src/transcripts/idempotent/fix1926.md new file mode 100644 index 0000000000..001e7f7ba7 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix1926.md @@ -0,0 +1,55 @@ +``` ucm +scratch/main> builtins.merge + + Done. +``` + +``` unison +> 'sq + +sq = 2934892384 +``` + +``` ucm :added-by-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`: + + sq : Nat + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | > 'sq + ⧩ + do sq +``` + +``` unison +> 'sq + +sq = 2934892384 +``` + +``` ucm :added-by-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`: + + sq : Nat + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | > 'sq + ⧩ + do sq +``` diff --git a/unison-src/transcripts/idempotent/fix2026.md b/unison-src/transcripts/idempotent/fix2026.md new file mode 100644 index 0000000000..5aa3edabf4 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2026.md @@ -0,0 +1,73 @@ +``` ucm :hide +scratch/main> builtins.mergeio +``` + +``` unison +structural ability Exception where raise : Failure -> x + +ex = unsafeRun! '(printLine "hello world") + +printLine : Text ->{IO, Exception} () +printLine t = + putText stdOut t + putText stdOut "\n" + +stdOut : Handle +stdOut = stdHandle StdOut + +compose2 : (c ->{𝕖1} d) -> (a ->{𝕖2} b ->{𝕖3} c) -> a -> b ->{𝕖1,𝕖2,𝕖3} d +compose2 f g x y = f (g x y) + +putBytes : Handle -> Bytes ->{IO, Exception} () +putBytes = compose2 toException putBytes.impl + +toException : Either Failure a ->{Exception} a +toException = cases + Left e -> raise e + Right a -> a + +putText : Handle -> Text ->{IO, Exception} () +putText h t = putBytes h (toUtf8 t) + +Exception.unsafeRun! : '{Exception, g} a -> '{g} a +Exception.unsafeRun! e _ = + h : Request {Exception} a -> a + h = cases + {Exception.raise fail -> _ } -> + bug fail + {a} -> a + handle !e with h +``` + +``` ucm :added-by-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`: + + structural ability Exception + (also named builtin.Exception) + Exception.unsafeRun! : '{g, Exception} a -> '{g} a + compose2 : (c ->{𝕖1} d) + -> (a ->{𝕖2} b ->{𝕖3} c) + -> a + -> b + ->{𝕖1, 𝕖2, 𝕖3} d + ex : '{IO} () + printLine : Text ->{IO, Exception} () + putBytes : Handle + -> Bytes + ->{IO, Exception} () + putText : Handle -> Text ->{IO, Exception} () + stdOut : Handle + toException : Either Failure a ->{Exception} a +``` + +``` ucm +scratch/main> run ex + + () +``` diff --git a/unison-src/transcripts/idempotent/fix2027.md b/unison-src/transcripts/idempotent/fix2027.md new file mode 100644 index 0000000000..3a4088f2a0 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2027.md @@ -0,0 +1,96 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +structural ability Exception where raise : Failure -> x + +reraise = cases + Left e -> raise e + Right a -> a + +structural type Either a b = Left a | Right b + +putBytes h bs = reraise (putBytes.impl h bs) + +toException : Either Failure a ->{Exception} a +toException = cases + Left e -> raise e + Right a -> a + +putText : Handle -> Text ->{IO, Exception} () +putText h t = putBytes h (toUtf8 t) + +bugFail = cases + Failure typ _ _ -> bug (Failure typ "problem" (Any ())) + +Exception.unsafeRun! : '{Exception, g} a -> '{g} a +Exception.unsafeRun! e _ = + h : Request {Exception} a -> a + h = cases + {Exception.raise fail -> _ } -> + bugFail fail + {a} -> a + handle !e with h + +socketSend s bytes = reraise (socketSend.impl s bytes) +closeSocket s = reraise (closeSocket.impl s) +serverSocket host port = reraise (IO.serverSocket.impl host port) + +hello : Text -> Text -> {IO, Exception} () +hello host port = + socket = serverSocket (Some host) port + msg = toUtf8 "Hello there" + socketSend socket msg + closeSocket socket + +myServer = unsafeRun! '(hello "127.0.0.1" "0") + +``` + +``` ucm :added-by-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`: + + structural type Either a b + (also named builtin.Either) + 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 :error +scratch/main> run myServer + + 💔💥 + + I've encountered a call to builtin.bug with the following + value: + + Failure (typeLink IOFailure) "problem" (Any ()) + + Stack trace: + bug + #8ppr1tt4q2 +``` diff --git a/unison-src/transcripts/idempotent/fix2049.md b/unison-src/transcripts/idempotent/fix2049.md new file mode 100644 index 0000000000..4c13479448 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2049.md @@ -0,0 +1,144 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +id x = x + +structural ability Stream a where + emit : a -> () + +Stream.foldl : (x ->{g} a ->{g} x) -> x -> '{g, Stream a} r -> '{g} x +Stream.foldl f z str _ = + h acc = cases + { emit x -> k } -> handle !k with h (f acc x) + { _ } -> acc + handle !str with h z + +Stream.range : Nat -> Nat -> '{Stream Nat} () +Stream.range m n = do + f : Nat ->{Stream Nat} () + f k = if k < n then emit k ; f (k+1) else () + f m + +unique type Fold' g a b x = Fold' (x -> {g} a -> {g} x) x (x -> {g} b) + +unique type Fold g a b = Fold (∀ g2 r. (∀ x. Fold' g a b x -> {g2} r) -> {g2} r) + +Fold.fromFold' : Fold' g a b x -> Fold g a b +Fold.fromFold' fold = Fold.Fold (f -> f fold) + +Fold.mkFold : (t -> {g} a -> {g} t) -> t -> (t -> {g} b) -> Fold g a b +Fold.mkFold step init extract = + Fold.fromFold' (Fold'.Fold' step init extract) + +folds.all : (a -> {g} Boolean) -> Fold g a Boolean +folds.all predicate = + Fold.mkFold (b -> a -> b && (predicate a)) true id + +Fold.Stream.fold : Fold g a b -> '{g, Stream a} r -> '{g} b +Fold.Stream.fold = + run: Fold' g a b x -> '{g, Stream a} r -> '{g} b + run = + cases Fold'.Fold' step init extract -> + stream -> _ -> extract !(foldl step init stream) + cases + Fold f -> stream -> f (f' -> run f' stream) + +> folds.all.tests.stream = + pred = n -> (Nat.gt n 2) + res : 'Boolean + res = Fold.Stream.fold (folds.all pred) (Stream.range 1 5) + !res Universal.== false +``` + +``` ucm :added-by-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`: + + type Fold g a b + type Fold' g a b x + structural ability Stream a + Fold.Stream.fold : Fold g a b + -> '{g, Stream a} r + -> '{g} b + Fold.fromFold' : Fold' g a b x -> Fold g a b + Fold.mkFold : (t ->{g} a ->{g} t) + -> t + -> (t ->{g} b) + -> Fold g a b + Stream.foldl : (x ->{g} a ->{g} x) + -> x + -> '{g, Stream a} r + -> '{g} x + Stream.range : Nat -> Nat -> '{Stream Nat} () + folds.all : (a ->{g} Boolean) -> Fold g a Boolean + id : x -> x + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 44 | pred = n -> (Nat.gt n 2) + ⧩ + 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 :added-by-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 +scratch/main> add + + ⍟ I've added these definitions: + + catcher : '{IO} () ->{IO} Result + tests : ∀ _. _ ->{IO} [Result] + +scratch/main> io.test tests + + New test results: + + 1. tests ◉ caught + ◉ caught + ◉ got the right answer + + ✅ 3 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` diff --git a/unison-src/transcripts/idempotent/fix2053.md b/unison-src/transcripts/idempotent/fix2053.md new file mode 100644 index 0000000000..2d5f1ce62e --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2053.md @@ -0,0 +1,15 @@ +``` ucm :hide +scratch/main> builtins.mergeio +``` + +``` ucm +scratch/main> display List.map + + f a -> + let + use Nat + + go i as acc = match List.at i as with + None -> acc + Some a -> go (i + 1) as (acc :+ f a) + go 0 a [] +``` diff --git a/unison-src/transcripts/idempotent/fix2156.md b/unison-src/transcripts/idempotent/fix2156.md new file mode 100644 index 0000000000..b90eebc481 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2156.md @@ -0,0 +1,32 @@ +Tests for a case where bad eta reduction was causing erroneous watch +output/caching. + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +sqr : Nat -> Nat +sqr n = n * n + +> sqr +``` + +``` ucm :added-by-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`: + + sqr : Nat -> Nat + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 4 | > sqr + ⧩ + n -> n Nat.* n +``` diff --git a/unison-src/transcripts/idempotent/fix2167.md b/unison-src/transcripts/idempotent/fix2167.md new file mode 100644 index 0000000000..04b01deb66 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2167.md @@ -0,0 +1,42 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +This is just a simple transcript to regression check an ability +inference/checking issue. + +``` unison +structural ability R t where + die : () -> x + near.impl : Nat -> Either () [Nat] + +R.near n = match near.impl n with + Left e -> die () + Right a -> a + +R.near1 region loc = match R.near 42 with + [loc] -> loc + ls -> R.die () +``` + +``` ucm :added-by-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`: + + structural ability R t + R.near : Nat ->{R t} [Nat] + R.near1 : region -> loc ->{R t} Nat +``` + +The issue was that abilities with parameters like this were sometimes +causing failures like this because the variable in the parameter would +escape to a scope where it no longer made sense. Then solving would +fail because the type was invalid. + +The fix was to avoid dropping certain existential variables out of +scope. diff --git a/unison-src/transcripts/idempotent/fix2187.md b/unison-src/transcripts/idempotent/fix2187.md new file mode 100644 index 0000000000..16d3275dc5 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2187.md @@ -0,0 +1,31 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison + +lexicalScopeEx: [Text] +lexicalScopeEx = + parent = "outer" + inner1 = let + child1 = "child1" + inner2 : [Text] + inner2 = let + child2 = "child2" + [parent, child1, child2] + inner2 + inner1 + +``` + +``` ucm :added-by-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`: + + lexicalScopeEx : [Text] +``` diff --git a/unison-src/transcripts/idempotent/fix2231.md b/unison-src/transcripts/idempotent/fix2231.md new file mode 100644 index 0000000000..871f5e2b89 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2231.md @@ -0,0 +1,51 @@ +This transcript contains some cases that were problematic with the new +type checker. They were likely not discovered earlier because they +involve combining types inferred with the older strategy with the new +inference algorithm. Some code can be given multiple possible types, +and while they are all valid and some may be equivalently general, +the choices may not work equally well with the type checking +strategies. + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +(<<) : (b ->{e} c) -> (a ->{e} b) -> a ->{e} c +(<<) f g x = f (g x) + +f = atan << tan + +foldl : (b ->{e} a ->{e} b) -> b -> [a] ->{e} b +foldl f a = cases + [] -> a + x +: xs -> foldl f (f a x) xs + +txt = foldl (Text.++) "" ["a", "b", "c"] +``` + +``` ucm :added-by-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`: + + << : (b ->{e} c) -> (a ->{e} b) -> a ->{e} c + f : Float -> Float + foldl : (b ->{e} a ->{e} b) -> b -> [a] ->{e} b + txt : Text +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + << : (b ->{e} c) -> (a ->{e} b) -> a ->{e} c + f : Float -> Float + foldl : (b ->{e} a ->{e} b) -> b -> [a] ->{e} b + txt : Text +``` diff --git a/unison-src/transcripts/idempotent/fix2238.md b/unison-src/transcripts/idempotent/fix2238.md new file mode 100644 index 0000000000..623cbdf3f2 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2238.md @@ -0,0 +1,40 @@ +``` ucm :hide +scratch/main> builtins.mergeio +``` + +This should not typecheck - the inline `@eval` expression uses abilities. + +``` unison :error +structural ability Abort where abort : x + +ex = {{ @eval{abort} }} +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + The expression in red needs the {Abort} ability, but this location does not have access to any abilities. + + 3 | ex = {{ @eval{abort} }} +``` + +This file should also not typecheck - it has a triple backticks block that uses abilities. + +```` unison :error +structural ability Abort where abort : x + +ex = {{ + +``` +abort + 1 +``` +}} +```` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + The expression in red needs the {Abort} ability, but this location does not have access to any abilities. + + 6 | abort + 1 +``` diff --git a/unison-src/transcripts/idempotent/fix2244.md b/unison-src/transcripts/idempotent/fix2244.md new file mode 100644 index 0000000000..ba3c1077fc --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2244.md @@ -0,0 +1,34 @@ +``` ucm :hide +scratch/main> builtins.mergeio +``` + +Ensure closing token is emitted by closing brace in doc eval block. + +```` unison +x = {{ + +``` +let + x = 1 + y = 2 + x + y +``` + +}} +```` + +``` ucm :added-by-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`: + + x : Doc2 +``` + +``` ucm :hide +scratch/main> add +``` diff --git a/unison-src/transcripts/idempotent/fix2254.md b/unison-src/transcripts/idempotent/fix2254.md new file mode 100644 index 0000000000..694c90acb4 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2254.md @@ -0,0 +1,224 @@ +``` ucm :hide +scratch/a> builtins.merge lib.builtins +``` + +This transcript checks that updates to data types propagate successfully to dependent types and dependent terms that do pattern matching. First let's create some types and terms: + +``` unison :hide +unique type A a b c d + = A a + | B b + | C c + | D d + +structural type NeedsA a b = NeedsA (A a b Nat Nat) + | Zoink Text + +f : A Nat Nat Nat Nat -> Nat +f = cases + A n -> n + _ -> 42 + +f2 a = + n = f a + n + 1 + +f3 : NeedsA Nat Nat -> Nat +f3 = cases + NeedsA a -> f a + 20 + _ -> 0 + +g : A Nat Nat Nat Nat -> Nat +g = cases + D n -> n + _ -> 43 +``` + +We'll make our edits in a new branch. + +``` ucm +scratch/a> add + + ⍟ I've added these definitions: + + type A a b c d + structural type NeedsA a b + f : A Nat Nat Nat Nat -> Nat + f2 : A Nat Nat Nat Nat -> Nat + f3 : NeedsA Nat Nat -> Nat + g : A Nat Nat Nat Nat -> Nat + +scratch/a> branch /a2 + + Done. I've created the a2 branch based off of a. + + Tip: To merge your work back into the a branch, first + `switch /a` then `merge /a2`. +``` + +First let's edit the `A` type, adding another constructor `E`. Note that the functions written against the old type have a wildcard in their pattern match, so they should work fine after the update. + +``` unison :hide +unique type A a b c d + = A a + | B b + | C c + | D d + | E a d +``` + +Let's do the update now, and verify that the definitions all look good and there's nothing `todo`: + +``` ucm +scratch/a2> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. + +scratch/a2> view A NeedsA f f2 f3 g + + type A a b c d + = A a + | D d + | E a d + | B b + | C c + + structural type NeedsA a b + = NeedsA (A a b Nat Nat) + | Zoink Text + + f : A Nat Nat Nat Nat -> Nat + f = cases + A n -> n + _ -> 42 + + f2 : A Nat Nat Nat Nat -> Nat + f2 a = + use Nat + + n = f a + n + 1 + + f3 : NeedsA Nat Nat -> Nat + f3 = cases + NeedsA a -> f a Nat.+ 20 + _ -> 0 + + g : A Nat Nat Nat Nat -> Nat + g = cases + D n -> n + _ -> 43 + +scratch/a2> todo + + You have no pending todo items. Good work! ✅ +``` + +## Record updates + +Here's a test of updating a record: + +``` ucm :hide +scratch/r1> builtins.merge lib.builtins +``` + +``` unison +structural type Rec = { uno : Nat, dos : Nat } + +combine r = uno r + dos r +``` + +``` ucm :added-by-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`: + + structural type Rec + Rec.dos : Rec -> Nat + Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.dos.set : Nat -> Rec -> Rec + Rec.uno : Rec -> Nat + Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.uno.set : Nat -> Rec -> Rec + combine : Rec -> Nat +``` + +``` ucm +scratch/r1> add + + ⍟ I've added these definitions: + + structural type Rec + Rec.dos : Rec -> Nat + Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.dos.set : Nat -> Rec -> Rec + Rec.uno : Rec -> Nat + Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.uno.set : Nat -> Rec -> Rec + combine : Rec -> Nat + +scratch/r1> branch r2 + + Done. I've created the r2 branch based off of r1. + + Tip: To merge your work back into the r1 branch, first + `switch /r1` then `merge /r2`. +``` + +``` unison +structural type Rec = { uno : Nat, dos : Nat, tres : Text } +``` + +``` ucm :added-by-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`: + + Rec.tres : Rec -> Text + Rec.tres.modify : (Text ->{g} Text) -> Rec ->{g} Rec + Rec.tres.set : Text -> Rec -> Rec + + ⍟ These names already exist. You can `update` them to your + new definition: + + structural type Rec + Rec.dos : Rec -> Nat + Rec.dos.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.dos.set : Nat -> Rec -> Rec + Rec.uno : Rec -> Nat + Rec.uno.modify : (Nat ->{g} Nat) -> Rec ->{g} Rec + Rec.uno.set : Nat -> Rec -> Rec +``` + +And checking that after updating this record, there's nothing `todo`: + +``` ucm +scratch/r2> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. + +scratch/r2> todo + + You have no pending todo items. Good work! ✅ +``` diff --git a/unison-src/transcripts/idempotent/fix2268.md b/unison-src/transcripts/idempotent/fix2268.md new file mode 100644 index 0000000000..afe51a4072 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2268.md @@ -0,0 +1,34 @@ +Tests for a TDNR case that wasn't working. The code wasn't 'relaxing' +inferred types that didn't contain arrows, so effects that just yield +a value weren't getting disambiguated. + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +unique ability A where + a : Nat + +unique ability B where + a : Char + +test : () -> Nat +test _ = + x = a + toNat x +``` + +``` ucm :added-by-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`: + + ability A + ability B + test : '{B} Nat +``` diff --git a/unison-src/transcripts/idempotent/fix2334.md b/unison-src/transcripts/idempotent/fix2334.md new file mode 100644 index 0000000000..c5e126d113 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2334.md @@ -0,0 +1,50 @@ +Tests an issue where pattern matching matrices involving built-in +types was discarding default cases in some branches. + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +f = cases + 0, 0 -> 0 + _, 1 -> 2 + 1, _ -> 3 + _, _ -> 1 + +> f 0 0 +> f 1 0 +> f 0 1 +> f 1 1 +``` + +``` ucm :added-by-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`: + + f : Nat -> Nat -> Nat + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 7 | > f 0 0 + ⧩ + 0 + + 8 | > f 1 0 + ⧩ + 3 + + 9 | > f 0 1 + ⧩ + 2 + + 10 | > f 1 1 + ⧩ + 2 +``` diff --git a/unison-src/transcripts/idempotent/fix2344.md b/unison-src/transcripts/idempotent/fix2344.md new file mode 100644 index 0000000000..47c0c09d67 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2344.md @@ -0,0 +1,34 @@ +Checks a corner case with type checking involving destructuring binds. + +The binds were causing some sequences of lets to be unnecessarily +recursive. + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +unique ability Nate where + nate: (Boolean, Nat) + antiNate: () + + +sneezy: (Nat -> {d} a) -> '{Nate,d} a +sneezy dee _ = + (_,_) = nate + antiNate + dee 1 +``` + +``` ucm :added-by-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`: + + ability Nate + sneezy : (Nat ->{d} a) -> '{d, Nate} a +``` diff --git a/unison-src/transcripts/idempotent/fix2350.md b/unison-src/transcripts/idempotent/fix2350.md new file mode 100644 index 0000000000..8a741ff4bf --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2350.md @@ -0,0 +1,42 @@ +This tests an issue where ability variables were being defaulted over +eagerly. In general, we want to avoid collecting up variables from the +use of definitions with types like: + +``` +T ->{e} U +``` + +Since this type works for every `e`, it is, 'pure;' and we might as +well have `e = {}`, since `{}` is a subrow of every other row. +However, if `e` isn't just a quantified variable, but one involved in +ongoing inference, it's undesirable to default it. Previously there +was a check to see if `e` occurred in the context. However, the wanted +abilities being collected aren't in the context, so types like: + +``` +T ->{S e} U ->{e} V +``` + +were a corner case. We would add `S e` to the wanted abilities, then +not realize that `e` shouldn't be defaulted. + +``` unison +unique ability Storage d g where + save.impl : a ->{Storage d g} ('{g} (d a)) + +save : a ->{Storage d g, g} (d a) +save a = !(save.impl a) +``` + +``` ucm :added-by-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`: + + ability Storage d g + save : a ->{g, Storage d g} d a +``` diff --git a/unison-src/transcripts/idempotent/fix2353.md b/unison-src/transcripts/idempotent/fix2353.md new file mode 100644 index 0000000000..2c68391d65 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2353.md @@ -0,0 +1,30 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +use builtin Scope +unique ability Async t g where async : {g} Nat +unique ability Exception where raise : Nat -> x + +pure.run : a -> (forall t . '{Async t g} a) ->{Exception, g} a +pure.run a0 a = + a' : forall s . '{Scope s, Exception, g} a + a' = 'a0 -- typechecks + -- make sure this builtin can still be referenced + Scope.run a' +``` + +``` ucm :added-by-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`: + + ability Async t g + ability Exception + pure.run : a -> (∀ t. '{Async t g} a) ->{g, Exception} a +``` diff --git a/unison-src/transcripts/idempotent/fix2354.md b/unison-src/transcripts/idempotent/fix2354.md new file mode 100644 index 0000000000..abdbbbde67 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2354.md @@ -0,0 +1,29 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +Tests that delaying an un-annotated higher-rank type gives a normal +type error, rather than an internal compiler error. + +``` unison :error +f : (forall a . a -> a) -> Nat +f id = id 0 + +x = 'f +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I found a value of type: (a1 ->{𝕖} a1) ->{𝕖} Nat + where I expected to find: (a -> 𝕣1) -> 𝕣 + + 1 | f : (forall a . a -> a) -> Nat + 2 | f id = id 0 + 3 | + 4 | x = 'f + + from right here: + + 1 | f : (forall a . a -> a) -> Nat +``` diff --git a/unison-src/transcripts/idempotent/fix2355.md b/unison-src/transcripts/idempotent/fix2355.md new file mode 100644 index 0000000000..c0d7eb8cbf --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2355.md @@ -0,0 +1,42 @@ +Tests for a loop that was previously occurring in the type checker. + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison :error +structural ability A t g where + fork : '{g, A t g} a -> t a + await : t a -> a + empty! : t a + put : a -> t a -> () + +example : '{A t {}} Nat +example = 'let + r = A.empty! + go u = + t = A.fork '(go (u + 1)) + A.await t + + go 0 + t2 = A.fork '(A.put 10 r) + A.await r +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I tried to infer a cyclic ability. + + The expression in red was inferred to require the ability: + + {A t25 {𝕖36, 𝕖18}} + + where `𝕖18` is its overall abilities. + + I need a type signature to help figure this out. + + 10 | go u = + 11 | t = A.fork '(go (u + 1)) + 12 | A.await t +``` diff --git a/unison-src/transcripts/idempotent/fix2378.md b/unison-src/transcripts/idempotent/fix2378.md new file mode 100644 index 0000000000..b9e8b28575 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2378.md @@ -0,0 +1,62 @@ +Tests for an ability failure that was caused by order dependence of +checking wanted vs. provided abilities. It was necessary to re-check +rows until a fixed point is reached. + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +unique ability C c where + new : c a + receive : c a -> a + send : a -> c a -> () + +unique ability A t g where + fork : '{A t g, g, Exception} a -> t a + await : t a -> a + +unique ability Ex where raise : () -> x + +Ex.catch : '{Ex, g} a ->{g} Either () a +Ex.catch _ = todo "Exception.catch" + +C.pure.run : (forall c . '{C c, g} r) ->{Ex, g} r +C.pure.run _ = todo "C.pure.run" + +A.pure.run : (forall t . '{A t g, g} a) ->{Ex,g} a +A.pure.run _ = todo "A.pure.run" + +ex : '{C c, A t {C c}} Nat +ex _ = + c = C.new + x = A.fork 'let + a = receive c + a + 10 + y = A.fork 'let + send 0 c + () + A.await x + +x : '{} (Either () Nat) +x _ = Ex.catch '(C.pure.run '(A.pure.run ex)) +``` + +``` ucm :added-by-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`: + + ability A t g + ability C c + ability Ex + A.pure.run : (∀ t. '{g, A t g} a) ->{g, Ex} a + C.pure.run : (∀ c. '{g, C c} r) ->{g, Ex} r + Ex.catch : '{g, Ex} a ->{g} Either () a + ex : '{C c, A t {C c}} Nat + x : 'Either () Nat +``` diff --git a/unison-src/transcripts/idempotent/fix2423.md b/unison-src/transcripts/idempotent/fix2423.md new file mode 100644 index 0000000000..6dd068d1f2 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2423.md @@ -0,0 +1,50 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +structural ability Split where + skip! : x + both : a -> a -> a + +Split.append : '{Split, g} a -> '{Split, g} a -> '{Split, g} a +Split.append s1 s2 _ = force (both s1 s2) + +force a = !a + +Split.zipSame : '{Split, g} a -> '{Split, g} b -> '{Split, g} (a, b) +Split.zipSame sa sb _ = + go : '{Split,g2} y -> Request {Split} x ->{Split,g2} (x,y) + go sb = cases + { a } -> (a, !sb) + { skip! -> _ } -> skip! + { both la ra -> k } -> + handle !sb with cases + { _ } -> skip! + { skip! -> k } -> skip! + { both lb rb -> k2 } -> + force (Split.append + (zipSame '(k la) '(k2 lb)) + (zipSame '(k ra) '(k2 rb))) + + handle !sa with go sb +``` + +``` ucm :added-by-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`: + + structural ability Split + Split.append : '{g, Split} a + -> '{g, Split} a + -> '{g, Split} a + Split.zipSame : '{g, Split} a + -> '{g, Split} b + -> '{g, Split} (a, b) + force : '{g} o ->{g} o +``` diff --git a/unison-src/transcripts/idempotent/fix2474.md b/unison-src/transcripts/idempotent/fix2474.md new file mode 100644 index 0000000000..b2c4ba25c4 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2474.md @@ -0,0 +1,52 @@ +Tests an issue with a lack of generality of handlers. + +In general, a set of cases: + +``` +{ e ... -> k } +``` + +should be typed in the following way: + +1. The scrutinee has type `Request {E, g} r -> s` where `E` is all + the abilities being handled. `g` is a slack variable, because all + abilities that are used in the handled expression pass through + the handler. Previously this was being inferred as merely + `Request {E} r -> s` +2. The continuation variable `k` should have type `o ->{E, g} r`, + matching the above types (`o` is the result type of `e`). + Previously this was being checked as `o ->{E0} r`, where `E0` is + the ability that contains `e`. + +``` ucm +scratch/main> builtins.merge + + Done. +``` + +``` unison +structural ability Stream a where + emit : a -> () + +Stream.uncons : '{Stream a, g} r ->{g} Either r (a, '{Stream a, g} r) +Stream.uncons s = + go : Request {Stream a,g} r -> Either r (a, '{Stream a,g} r) + go = cases + { r } -> Left r + { Stream.emit a -> tl } -> Right (a, tl : '{Stream a,g} r) + handle !s with go +``` + +``` ucm :added-by-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`: + + structural ability Stream a + Stream.uncons : '{g, Stream a} r + ->{g} Either r (a, '{g, Stream a} r) +``` diff --git a/unison-src/transcripts/idempotent/fix2628.md b/unison-src/transcripts/idempotent/fix2628.md new file mode 100644 index 0000000000..f7c62a4826 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2628.md @@ -0,0 +1,28 @@ +``` ucm :hide +scratch/main> alias.type ##Nat lib.base.Nat +``` + +``` unison :hide +unique type foo.bar.baz.MyRecord = { + value : Nat +} +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type foo.bar.baz.MyRecord + foo.bar.baz.MyRecord.value : MyRecord -> Nat + foo.bar.baz.MyRecord.value.modify : (Nat ->{g} Nat) + -> MyRecord + ->{g} MyRecord + foo.bar.baz.MyRecord.value.set : Nat + -> MyRecord + -> MyRecord + +scratch/main> find : Nat -> MyRecord + + 1. foo.bar.baz.MyRecord.MyRecord : Nat -> MyRecord +``` diff --git a/unison-src/transcripts/idempotent/fix2663.md b/unison-src/transcripts/idempotent/fix2663.md new file mode 100644 index 0000000000..7412c7a8ca --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2663.md @@ -0,0 +1,45 @@ +Tests a variable capture problem. + +After pattern compilation, the match would end up: + +``` +T p1 p3 p3 +``` + +and z would end up referring to the first p3 rather than the second. + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +structural type Trip = T Nat Nat Nat + +bad : Nat -> (Nat, Nat) +bad x = match Some (Some x) with + Some (Some x) -> match T 3 4 5 with + T _ _ z -> (x, z) + _ -> (0,0) + +> bad 2 +``` + +``` ucm :added-by-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`: + + structural type Trip + bad : Nat -> (Nat, Nat) + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 9 | > bad 2 + ⧩ + (2, 5) +``` diff --git a/unison-src/transcripts/idempotent/fix2693.md b/unison-src/transcripts/idempotent/fix2693.md new file mode 100644 index 0000000000..c095fe7447 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2693.md @@ -0,0 +1,4075 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +loop : List Nat -> Nat -> List Nat +loop l = cases + 0 -> l + n -> loop (n +: l) (drop n 1) + +range : Nat -> List Nat +range = loop [] +``` + +``` ucm :added-by-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`: + + loop : [Nat] -> Nat -> [Nat] + range : Nat -> [Nat] +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + loop : [Nat] -> Nat -> [Nat] + range : Nat -> [Nat] +``` + +``` unison +> range 2000 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + ✅ + + scratch.u changed. + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | > range 2000 + ⧩ + [ 1 + , 2 + , 3 + , 4 + , 5 + , 6 + , 7 + , 8 + , 9 + , 10 + , 11 + , 12 + , 13 + , 14 + , 15 + , 16 + , 17 + , 18 + , 19 + , 20 + , 21 + , 22 + , 23 + , 24 + , 25 + , 26 + , 27 + , 28 + , 29 + , 30 + , 31 + , 32 + , 33 + , 34 + , 35 + , 36 + , 37 + , 38 + , 39 + , 40 + , 41 + , 42 + , 43 + , 44 + , 45 + , 46 + , 47 + , 48 + , 49 + , 50 + , 51 + , 52 + , 53 + , 54 + , 55 + , 56 + , 57 + , 58 + , 59 + , 60 + , 61 + , 62 + , 63 + , 64 + , 65 + , 66 + , 67 + , 68 + , 69 + , 70 + , 71 + , 72 + , 73 + , 74 + , 75 + , 76 + , 77 + , 78 + , 79 + , 80 + , 81 + , 82 + , 83 + , 84 + , 85 + , 86 + , 87 + , 88 + , 89 + , 90 + , 91 + , 92 + , 93 + , 94 + , 95 + , 96 + , 97 + , 98 + , 99 + , 100 + , 101 + , 102 + , 103 + , 104 + , 105 + , 106 + , 107 + , 108 + , 109 + , 110 + , 111 + , 112 + , 113 + , 114 + , 115 + , 116 + , 117 + , 118 + , 119 + , 120 + , 121 + , 122 + , 123 + , 124 + , 125 + , 126 + , 127 + , 128 + , 129 + , 130 + , 131 + , 132 + , 133 + , 134 + , 135 + , 136 + , 137 + , 138 + , 139 + , 140 + , 141 + , 142 + , 143 + , 144 + , 145 + , 146 + , 147 + , 148 + , 149 + , 150 + , 151 + , 152 + , 153 + , 154 + , 155 + , 156 + , 157 + , 158 + , 159 + , 160 + , 161 + , 162 + , 163 + , 164 + , 165 + , 166 + , 167 + , 168 + , 169 + , 170 + , 171 + , 172 + , 173 + , 174 + , 175 + , 176 + , 177 + , 178 + , 179 + , 180 + , 181 + , 182 + , 183 + , 184 + , 185 + , 186 + , 187 + , 188 + , 189 + , 190 + , 191 + , 192 + , 193 + , 194 + , 195 + , 196 + , 197 + , 198 + , 199 + , 200 + , 201 + , 202 + , 203 + , 204 + , 205 + , 206 + , 207 + , 208 + , 209 + , 210 + , 211 + , 212 + , 213 + , 214 + , 215 + , 216 + , 217 + , 218 + , 219 + , 220 + , 221 + , 222 + , 223 + , 224 + , 225 + , 226 + , 227 + , 228 + , 229 + , 230 + , 231 + , 232 + , 233 + , 234 + , 235 + , 236 + , 237 + , 238 + , 239 + , 240 + , 241 + , 242 + , 243 + , 244 + , 245 + , 246 + , 247 + , 248 + , 249 + , 250 + , 251 + , 252 + , 253 + , 254 + , 255 + , 256 + , 257 + , 258 + , 259 + , 260 + , 261 + , 262 + , 263 + , 264 + , 265 + , 266 + , 267 + , 268 + , 269 + , 270 + , 271 + , 272 + , 273 + , 274 + , 275 + , 276 + , 277 + , 278 + , 279 + , 280 + , 281 + , 282 + , 283 + , 284 + , 285 + , 286 + , 287 + , 288 + , 289 + , 290 + , 291 + , 292 + , 293 + , 294 + , 295 + , 296 + , 297 + , 298 + , 299 + , 300 + , 301 + , 302 + , 303 + , 304 + , 305 + , 306 + , 307 + , 308 + , 309 + , 310 + , 311 + , 312 + , 313 + , 314 + , 315 + , 316 + , 317 + , 318 + , 319 + , 320 + , 321 + , 322 + , 323 + , 324 + , 325 + , 326 + , 327 + , 328 + , 329 + , 330 + , 331 + , 332 + , 333 + , 334 + , 335 + , 336 + , 337 + , 338 + , 339 + , 340 + , 341 + , 342 + , 343 + , 344 + , 345 + , 346 + , 347 + , 348 + , 349 + , 350 + , 351 + , 352 + , 353 + , 354 + , 355 + , 356 + , 357 + , 358 + , 359 + , 360 + , 361 + , 362 + , 363 + , 364 + , 365 + , 366 + , 367 + , 368 + , 369 + , 370 + , 371 + , 372 + , 373 + , 374 + , 375 + , 376 + , 377 + , 378 + , 379 + , 380 + , 381 + , 382 + , 383 + , 384 + , 385 + , 386 + , 387 + , 388 + , 389 + , 390 + , 391 + , 392 + , 393 + , 394 + , 395 + , 396 + , 397 + , 398 + , 399 + , 400 + , 401 + , 402 + , 403 + , 404 + , 405 + , 406 + , 407 + , 408 + , 409 + , 410 + , 411 + , 412 + , 413 + , 414 + , 415 + , 416 + , 417 + , 418 + , 419 + , 420 + , 421 + , 422 + , 423 + , 424 + , 425 + , 426 + , 427 + , 428 + , 429 + , 430 + , 431 + , 432 + , 433 + , 434 + , 435 + , 436 + , 437 + , 438 + , 439 + , 440 + , 441 + , 442 + , 443 + , 444 + , 445 + , 446 + , 447 + , 448 + , 449 + , 450 + , 451 + , 452 + , 453 + , 454 + , 455 + , 456 + , 457 + , 458 + , 459 + , 460 + , 461 + , 462 + , 463 + , 464 + , 465 + , 466 + , 467 + , 468 + , 469 + , 470 + , 471 + , 472 + , 473 + , 474 + , 475 + , 476 + , 477 + , 478 + , 479 + , 480 + , 481 + , 482 + , 483 + , 484 + , 485 + , 486 + , 487 + , 488 + , 489 + , 490 + , 491 + , 492 + , 493 + , 494 + , 495 + , 496 + , 497 + , 498 + , 499 + , 500 + , 501 + , 502 + , 503 + , 504 + , 505 + , 506 + , 507 + , 508 + , 509 + , 510 + , 511 + , 512 + , 513 + , 514 + , 515 + , 516 + , 517 + , 518 + , 519 + , 520 + , 521 + , 522 + , 523 + , 524 + , 525 + , 526 + , 527 + , 528 + , 529 + , 530 + , 531 + , 532 + , 533 + , 534 + , 535 + , 536 + , 537 + , 538 + , 539 + , 540 + , 541 + , 542 + , 543 + , 544 + , 545 + , 546 + , 547 + , 548 + , 549 + , 550 + , 551 + , 552 + , 553 + , 554 + , 555 + , 556 + , 557 + , 558 + , 559 + , 560 + , 561 + , 562 + , 563 + , 564 + , 565 + , 566 + , 567 + , 568 + , 569 + , 570 + , 571 + , 572 + , 573 + , 574 + , 575 + , 576 + , 577 + , 578 + , 579 + , 580 + , 581 + , 582 + , 583 + , 584 + , 585 + , 586 + , 587 + , 588 + , 589 + , 590 + , 591 + , 592 + , 593 + , 594 + , 595 + , 596 + , 597 + , 598 + , 599 + , 600 + , 601 + , 602 + , 603 + , 604 + , 605 + , 606 + , 607 + , 608 + , 609 + , 610 + , 611 + , 612 + , 613 + , 614 + , 615 + , 616 + , 617 + , 618 + , 619 + , 620 + , 621 + , 622 + , 623 + , 624 + , 625 + , 626 + , 627 + , 628 + , 629 + , 630 + , 631 + , 632 + , 633 + , 634 + , 635 + , 636 + , 637 + , 638 + , 639 + , 640 + , 641 + , 642 + , 643 + , 644 + , 645 + , 646 + , 647 + , 648 + , 649 + , 650 + , 651 + , 652 + , 653 + , 654 + , 655 + , 656 + , 657 + , 658 + , 659 + , 660 + , 661 + , 662 + , 663 + , 664 + , 665 + , 666 + , 667 + , 668 + , 669 + , 670 + , 671 + , 672 + , 673 + , 674 + , 675 + , 676 + , 677 + , 678 + , 679 + , 680 + , 681 + , 682 + , 683 + , 684 + , 685 + , 686 + , 687 + , 688 + , 689 + , 690 + , 691 + , 692 + , 693 + , 694 + , 695 + , 696 + , 697 + , 698 + , 699 + , 700 + , 701 + , 702 + , 703 + , 704 + , 705 + , 706 + , 707 + , 708 + , 709 + , 710 + , 711 + , 712 + , 713 + , 714 + , 715 + , 716 + , 717 + , 718 + , 719 + , 720 + , 721 + , 722 + , 723 + , 724 + , 725 + , 726 + , 727 + , 728 + , 729 + , 730 + , 731 + , 732 + , 733 + , 734 + , 735 + , 736 + , 737 + , 738 + , 739 + , 740 + , 741 + , 742 + , 743 + , 744 + , 745 + , 746 + , 747 + , 748 + , 749 + , 750 + , 751 + , 752 + , 753 + , 754 + , 755 + , 756 + , 757 + , 758 + , 759 + , 760 + , 761 + , 762 + , 763 + , 764 + , 765 + , 766 + , 767 + , 768 + , 769 + , 770 + , 771 + , 772 + , 773 + , 774 + , 775 + , 776 + , 777 + , 778 + , 779 + , 780 + , 781 + , 782 + , 783 + , 784 + , 785 + , 786 + , 787 + , 788 + , 789 + , 790 + , 791 + , 792 + , 793 + , 794 + , 795 + , 796 + , 797 + , 798 + , 799 + , 800 + , 801 + , 802 + , 803 + , 804 + , 805 + , 806 + , 807 + , 808 + , 809 + , 810 + , 811 + , 812 + , 813 + , 814 + , 815 + , 816 + , 817 + , 818 + , 819 + , 820 + , 821 + , 822 + , 823 + , 824 + , 825 + , 826 + , 827 + , 828 + , 829 + , 830 + , 831 + , 832 + , 833 + , 834 + , 835 + , 836 + , 837 + , 838 + , 839 + , 840 + , 841 + , 842 + , 843 + , 844 + , 845 + , 846 + , 847 + , 848 + , 849 + , 850 + , 851 + , 852 + , 853 + , 854 + , 855 + , 856 + , 857 + , 858 + , 859 + , 860 + , 861 + , 862 + , 863 + , 864 + , 865 + , 866 + , 867 + , 868 + , 869 + , 870 + , 871 + , 872 + , 873 + , 874 + , 875 + , 876 + , 877 + , 878 + , 879 + , 880 + , 881 + , 882 + , 883 + , 884 + , 885 + , 886 + , 887 + , 888 + , 889 + , 890 + , 891 + , 892 + , 893 + , 894 + , 895 + , 896 + , 897 + , 898 + , 899 + , 900 + , 901 + , 902 + , 903 + , 904 + , 905 + , 906 + , 907 + , 908 + , 909 + , 910 + , 911 + , 912 + , 913 + , 914 + , 915 + , 916 + , 917 + , 918 + , 919 + , 920 + , 921 + , 922 + , 923 + , 924 + , 925 + , 926 + , 927 + , 928 + , 929 + , 930 + , 931 + , 932 + , 933 + , 934 + , 935 + , 936 + , 937 + , 938 + , 939 + , 940 + , 941 + , 942 + , 943 + , 944 + , 945 + , 946 + , 947 + , 948 + , 949 + , 950 + , 951 + , 952 + , 953 + , 954 + , 955 + , 956 + , 957 + , 958 + , 959 + , 960 + , 961 + , 962 + , 963 + , 964 + , 965 + , 966 + , 967 + , 968 + , 969 + , 970 + , 971 + , 972 + , 973 + , 974 + , 975 + , 976 + , 977 + , 978 + , 979 + , 980 + , 981 + , 982 + , 983 + , 984 + , 985 + , 986 + , 987 + , 988 + , 989 + , 990 + , 991 + , 992 + , 993 + , 994 + , 995 + , 996 + , 997 + , 998 + , 999 + , 1000 + , 1001 + , 1002 + , 1003 + , 1004 + , 1005 + , 1006 + , 1007 + , 1008 + , 1009 + , 1010 + , 1011 + , 1012 + , 1013 + , 1014 + , 1015 + , 1016 + , 1017 + , 1018 + , 1019 + , 1020 + , 1021 + , 1022 + , 1023 + , 1024 + , 1025 + , 1026 + , 1027 + , 1028 + , 1029 + , 1030 + , 1031 + , 1032 + , 1033 + , 1034 + , 1035 + , 1036 + , 1037 + , 1038 + , 1039 + , 1040 + , 1041 + , 1042 + , 1043 + , 1044 + , 1045 + , 1046 + , 1047 + , 1048 + , 1049 + , 1050 + , 1051 + , 1052 + , 1053 + , 1054 + , 1055 + , 1056 + , 1057 + , 1058 + , 1059 + , 1060 + , 1061 + , 1062 + , 1063 + , 1064 + , 1065 + , 1066 + , 1067 + , 1068 + , 1069 + , 1070 + , 1071 + , 1072 + , 1073 + , 1074 + , 1075 + , 1076 + , 1077 + , 1078 + , 1079 + , 1080 + , 1081 + , 1082 + , 1083 + , 1084 + , 1085 + , 1086 + , 1087 + , 1088 + , 1089 + , 1090 + , 1091 + , 1092 + , 1093 + , 1094 + , 1095 + , 1096 + , 1097 + , 1098 + , 1099 + , 1100 + , 1101 + , 1102 + , 1103 + , 1104 + , 1105 + , 1106 + , 1107 + , 1108 + , 1109 + , 1110 + , 1111 + , 1112 + , 1113 + , 1114 + , 1115 + , 1116 + , 1117 + , 1118 + , 1119 + , 1120 + , 1121 + , 1122 + , 1123 + , 1124 + , 1125 + , 1126 + , 1127 + , 1128 + , 1129 + , 1130 + , 1131 + , 1132 + , 1133 + , 1134 + , 1135 + , 1136 + , 1137 + , 1138 + , 1139 + , 1140 + , 1141 + , 1142 + , 1143 + , 1144 + , 1145 + , 1146 + , 1147 + , 1148 + , 1149 + , 1150 + , 1151 + , 1152 + , 1153 + , 1154 + , 1155 + , 1156 + , 1157 + , 1158 + , 1159 + , 1160 + , 1161 + , 1162 + , 1163 + , 1164 + , 1165 + , 1166 + , 1167 + , 1168 + , 1169 + , 1170 + , 1171 + , 1172 + , 1173 + , 1174 + , 1175 + , 1176 + , 1177 + , 1178 + , 1179 + , 1180 + , 1181 + , 1182 + , 1183 + , 1184 + , 1185 + , 1186 + , 1187 + , 1188 + , 1189 + , 1190 + , 1191 + , 1192 + , 1193 + , 1194 + , 1195 + , 1196 + , 1197 + , 1198 + , 1199 + , 1200 + , 1201 + , 1202 + , 1203 + , 1204 + , 1205 + , 1206 + , 1207 + , 1208 + , 1209 + , 1210 + , 1211 + , 1212 + , 1213 + , 1214 + , 1215 + , 1216 + , 1217 + , 1218 + , 1219 + , 1220 + , 1221 + , 1222 + , 1223 + , 1224 + , 1225 + , 1226 + , 1227 + , 1228 + , 1229 + , 1230 + , 1231 + , 1232 + , 1233 + , 1234 + , 1235 + , 1236 + , 1237 + , 1238 + , 1239 + , 1240 + , 1241 + , 1242 + , 1243 + , 1244 + , 1245 + , 1246 + , 1247 + , 1248 + , 1249 + , 1250 + , 1251 + , 1252 + , 1253 + , 1254 + , 1255 + , 1256 + , 1257 + , 1258 + , 1259 + , 1260 + , 1261 + , 1262 + , 1263 + , 1264 + , 1265 + , 1266 + , 1267 + , 1268 + , 1269 + , 1270 + , 1271 + , 1272 + , 1273 + , 1274 + , 1275 + , 1276 + , 1277 + , 1278 + , 1279 + , 1280 + , 1281 + , 1282 + , 1283 + , 1284 + , 1285 + , 1286 + , 1287 + , 1288 + , 1289 + , 1290 + , 1291 + , 1292 + , 1293 + , 1294 + , 1295 + , 1296 + , 1297 + , 1298 + , 1299 + , 1300 + , 1301 + , 1302 + , 1303 + , 1304 + , 1305 + , 1306 + , 1307 + , 1308 + , 1309 + , 1310 + , 1311 + , 1312 + , 1313 + , 1314 + , 1315 + , 1316 + , 1317 + , 1318 + , 1319 + , 1320 + , 1321 + , 1322 + , 1323 + , 1324 + , 1325 + , 1326 + , 1327 + , 1328 + , 1329 + , 1330 + , 1331 + , 1332 + , 1333 + , 1334 + , 1335 + , 1336 + , 1337 + , 1338 + , 1339 + , 1340 + , 1341 + , 1342 + , 1343 + , 1344 + , 1345 + , 1346 + , 1347 + , 1348 + , 1349 + , 1350 + , 1351 + , 1352 + , 1353 + , 1354 + , 1355 + , 1356 + , 1357 + , 1358 + , 1359 + , 1360 + , 1361 + , 1362 + , 1363 + , 1364 + , 1365 + , 1366 + , 1367 + , 1368 + , 1369 + , 1370 + , 1371 + , 1372 + , 1373 + , 1374 + , 1375 + , 1376 + , 1377 + , 1378 + , 1379 + , 1380 + , 1381 + , 1382 + , 1383 + , 1384 + , 1385 + , 1386 + , 1387 + , 1388 + , 1389 + , 1390 + , 1391 + , 1392 + , 1393 + , 1394 + , 1395 + , 1396 + , 1397 + , 1398 + , 1399 + , 1400 + , 1401 + , 1402 + , 1403 + , 1404 + , 1405 + , 1406 + , 1407 + , 1408 + , 1409 + , 1410 + , 1411 + , 1412 + , 1413 + , 1414 + , 1415 + , 1416 + , 1417 + , 1418 + , 1419 + , 1420 + , 1421 + , 1422 + , 1423 + , 1424 + , 1425 + , 1426 + , 1427 + , 1428 + , 1429 + , 1430 + , 1431 + , 1432 + , 1433 + , 1434 + , 1435 + , 1436 + , 1437 + , 1438 + , 1439 + , 1440 + , 1441 + , 1442 + , 1443 + , 1444 + , 1445 + , 1446 + , 1447 + , 1448 + , 1449 + , 1450 + , 1451 + , 1452 + , 1453 + , 1454 + , 1455 + , 1456 + , 1457 + , 1458 + , 1459 + , 1460 + , 1461 + , 1462 + , 1463 + , 1464 + , 1465 + , 1466 + , 1467 + , 1468 + , 1469 + , 1470 + , 1471 + , 1472 + , 1473 + , 1474 + , 1475 + , 1476 + , 1477 + , 1478 + , 1479 + , 1480 + , 1481 + , 1482 + , 1483 + , 1484 + , 1485 + , 1486 + , 1487 + , 1488 + , 1489 + , 1490 + , 1491 + , 1492 + , 1493 + , 1494 + , 1495 + , 1496 + , 1497 + , 1498 + , 1499 + , 1500 + , 1501 + , 1502 + , 1503 + , 1504 + , 1505 + , 1506 + , 1507 + , 1508 + , 1509 + , 1510 + , 1511 + , 1512 + , 1513 + , 1514 + , 1515 + , 1516 + , 1517 + , 1518 + , 1519 + , 1520 + , 1521 + , 1522 + , 1523 + , 1524 + , 1525 + , 1526 + , 1527 + , 1528 + , 1529 + , 1530 + , 1531 + , 1532 + , 1533 + , 1534 + , 1535 + , 1536 + , 1537 + , 1538 + , 1539 + , 1540 + , 1541 + , 1542 + , 1543 + , 1544 + , 1545 + , 1546 + , 1547 + , 1548 + , 1549 + , 1550 + , 1551 + , 1552 + , 1553 + , 1554 + , 1555 + , 1556 + , 1557 + , 1558 + , 1559 + , 1560 + , 1561 + , 1562 + , 1563 + , 1564 + , 1565 + , 1566 + , 1567 + , 1568 + , 1569 + , 1570 + , 1571 + , 1572 + , 1573 + , 1574 + , 1575 + , 1576 + , 1577 + , 1578 + , 1579 + , 1580 + , 1581 + , 1582 + , 1583 + , 1584 + , 1585 + , 1586 + , 1587 + , 1588 + , 1589 + , 1590 + , 1591 + , 1592 + , 1593 + , 1594 + , 1595 + , 1596 + , 1597 + , 1598 + , 1599 + , 1600 + , 1601 + , 1602 + , 1603 + , 1604 + , 1605 + , 1606 + , 1607 + , 1608 + , 1609 + , 1610 + , 1611 + , 1612 + , 1613 + , 1614 + , 1615 + , 1616 + , 1617 + , 1618 + , 1619 + , 1620 + , 1621 + , 1622 + , 1623 + , 1624 + , 1625 + , 1626 + , 1627 + , 1628 + , 1629 + , 1630 + , 1631 + , 1632 + , 1633 + , 1634 + , 1635 + , 1636 + , 1637 + , 1638 + , 1639 + , 1640 + , 1641 + , 1642 + , 1643 + , 1644 + , 1645 + , 1646 + , 1647 + , 1648 + , 1649 + , 1650 + , 1651 + , 1652 + , 1653 + , 1654 + , 1655 + , 1656 + , 1657 + , 1658 + , 1659 + , 1660 + , 1661 + , 1662 + , 1663 + , 1664 + , 1665 + , 1666 + , 1667 + , 1668 + , 1669 + , 1670 + , 1671 + , 1672 + , 1673 + , 1674 + , 1675 + , 1676 + , 1677 + , 1678 + , 1679 + , 1680 + , 1681 + , 1682 + , 1683 + , 1684 + , 1685 + , 1686 + , 1687 + , 1688 + , 1689 + , 1690 + , 1691 + , 1692 + , 1693 + , 1694 + , 1695 + , 1696 + , 1697 + , 1698 + , 1699 + , 1700 + , 1701 + , 1702 + , 1703 + , 1704 + , 1705 + , 1706 + , 1707 + , 1708 + , 1709 + , 1710 + , 1711 + , 1712 + , 1713 + , 1714 + , 1715 + , 1716 + , 1717 + , 1718 + , 1719 + , 1720 + , 1721 + , 1722 + , 1723 + , 1724 + , 1725 + , 1726 + , 1727 + , 1728 + , 1729 + , 1730 + , 1731 + , 1732 + , 1733 + , 1734 + , 1735 + , 1736 + , 1737 + , 1738 + , 1739 + , 1740 + , 1741 + , 1742 + , 1743 + , 1744 + , 1745 + , 1746 + , 1747 + , 1748 + , 1749 + , 1750 + , 1751 + , 1752 + , 1753 + , 1754 + , 1755 + , 1756 + , 1757 + , 1758 + , 1759 + , 1760 + , 1761 + , 1762 + , 1763 + , 1764 + , 1765 + , 1766 + , 1767 + , 1768 + , 1769 + , 1770 + , 1771 + , 1772 + , 1773 + , 1774 + , 1775 + , 1776 + , 1777 + , 1778 + , 1779 + , 1780 + , 1781 + , 1782 + , 1783 + , 1784 + , 1785 + , 1786 + , 1787 + , 1788 + , 1789 + , 1790 + , 1791 + , 1792 + , 1793 + , 1794 + , 1795 + , 1796 + , 1797 + , 1798 + , 1799 + , 1800 + , 1801 + , 1802 + , 1803 + , 1804 + , 1805 + , 1806 + , 1807 + , 1808 + , 1809 + , 1810 + , 1811 + , 1812 + , 1813 + , 1814 + , 1815 + , 1816 + , 1817 + , 1818 + , 1819 + , 1820 + , 1821 + , 1822 + , 1823 + , 1824 + , 1825 + , 1826 + , 1827 + , 1828 + , 1829 + , 1830 + , 1831 + , 1832 + , 1833 + , 1834 + , 1835 + , 1836 + , 1837 + , 1838 + , 1839 + , 1840 + , 1841 + , 1842 + , 1843 + , 1844 + , 1845 + , 1846 + , 1847 + , 1848 + , 1849 + , 1850 + , 1851 + , 1852 + , 1853 + , 1854 + , 1855 + , 1856 + , 1857 + , 1858 + , 1859 + , 1860 + , 1861 + , 1862 + , 1863 + , 1864 + , 1865 + , 1866 + , 1867 + , 1868 + , 1869 + , 1870 + , 1871 + , 1872 + , 1873 + , 1874 + , 1875 + , 1876 + , 1877 + , 1878 + , 1879 + , 1880 + , 1881 + , 1882 + , 1883 + , 1884 + , 1885 + , 1886 + , 1887 + , 1888 + , 1889 + , 1890 + , 1891 + , 1892 + , 1893 + , 1894 + , 1895 + , 1896 + , 1897 + , 1898 + , 1899 + , 1900 + , 1901 + , 1902 + , 1903 + , 1904 + , 1905 + , 1906 + , 1907 + , 1908 + , 1909 + , 1910 + , 1911 + , 1912 + , 1913 + , 1914 + , 1915 + , 1916 + , 1917 + , 1918 + , 1919 + , 1920 + , 1921 + , 1922 + , 1923 + , 1924 + , 1925 + , 1926 + , 1927 + , 1928 + , 1929 + , 1930 + , 1931 + , 1932 + , 1933 + , 1934 + , 1935 + , 1936 + , 1937 + , 1938 + , 1939 + , 1940 + , 1941 + , 1942 + , 1943 + , 1944 + , 1945 + , 1946 + , 1947 + , 1948 + , 1949 + , 1950 + , 1951 + , 1952 + , 1953 + , 1954 + , 1955 + , 1956 + , 1957 + , 1958 + , 1959 + , 1960 + , 1961 + , 1962 + , 1963 + , 1964 + , 1965 + , 1966 + , 1967 + , 1968 + , 1969 + , 1970 + , 1971 + , 1972 + , 1973 + , 1974 + , 1975 + , 1976 + , 1977 + , 1978 + , 1979 + , 1980 + , 1981 + , 1982 + , 1983 + , 1984 + , 1985 + , 1986 + , 1987 + , 1988 + , 1989 + , 1990 + , 1991 + , 1992 + , 1993 + , 1994 + , 1995 + , 1996 + , 1997 + , 1998 + , 1999 + , 2000 + ] +``` + +Should be cached: + +``` unison +> range 2000 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + ✅ + + scratch.u changed. + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | > range 2000 + ⧩ + [ 1 + , 2 + , 3 + , 4 + , 5 + , 6 + , 7 + , 8 + , 9 + , 10 + , 11 + , 12 + , 13 + , 14 + , 15 + , 16 + , 17 + , 18 + , 19 + , 20 + , 21 + , 22 + , 23 + , 24 + , 25 + , 26 + , 27 + , 28 + , 29 + , 30 + , 31 + , 32 + , 33 + , 34 + , 35 + , 36 + , 37 + , 38 + , 39 + , 40 + , 41 + , 42 + , 43 + , 44 + , 45 + , 46 + , 47 + , 48 + , 49 + , 50 + , 51 + , 52 + , 53 + , 54 + , 55 + , 56 + , 57 + , 58 + , 59 + , 60 + , 61 + , 62 + , 63 + , 64 + , 65 + , 66 + , 67 + , 68 + , 69 + , 70 + , 71 + , 72 + , 73 + , 74 + , 75 + , 76 + , 77 + , 78 + , 79 + , 80 + , 81 + , 82 + , 83 + , 84 + , 85 + , 86 + , 87 + , 88 + , 89 + , 90 + , 91 + , 92 + , 93 + , 94 + , 95 + , 96 + , 97 + , 98 + , 99 + , 100 + , 101 + , 102 + , 103 + , 104 + , 105 + , 106 + , 107 + , 108 + , 109 + , 110 + , 111 + , 112 + , 113 + , 114 + , 115 + , 116 + , 117 + , 118 + , 119 + , 120 + , 121 + , 122 + , 123 + , 124 + , 125 + , 126 + , 127 + , 128 + , 129 + , 130 + , 131 + , 132 + , 133 + , 134 + , 135 + , 136 + , 137 + , 138 + , 139 + , 140 + , 141 + , 142 + , 143 + , 144 + , 145 + , 146 + , 147 + , 148 + , 149 + , 150 + , 151 + , 152 + , 153 + , 154 + , 155 + , 156 + , 157 + , 158 + , 159 + , 160 + , 161 + , 162 + , 163 + , 164 + , 165 + , 166 + , 167 + , 168 + , 169 + , 170 + , 171 + , 172 + , 173 + , 174 + , 175 + , 176 + , 177 + , 178 + , 179 + , 180 + , 181 + , 182 + , 183 + , 184 + , 185 + , 186 + , 187 + , 188 + , 189 + , 190 + , 191 + , 192 + , 193 + , 194 + , 195 + , 196 + , 197 + , 198 + , 199 + , 200 + , 201 + , 202 + , 203 + , 204 + , 205 + , 206 + , 207 + , 208 + , 209 + , 210 + , 211 + , 212 + , 213 + , 214 + , 215 + , 216 + , 217 + , 218 + , 219 + , 220 + , 221 + , 222 + , 223 + , 224 + , 225 + , 226 + , 227 + , 228 + , 229 + , 230 + , 231 + , 232 + , 233 + , 234 + , 235 + , 236 + , 237 + , 238 + , 239 + , 240 + , 241 + , 242 + , 243 + , 244 + , 245 + , 246 + , 247 + , 248 + , 249 + , 250 + , 251 + , 252 + , 253 + , 254 + , 255 + , 256 + , 257 + , 258 + , 259 + , 260 + , 261 + , 262 + , 263 + , 264 + , 265 + , 266 + , 267 + , 268 + , 269 + , 270 + , 271 + , 272 + , 273 + , 274 + , 275 + , 276 + , 277 + , 278 + , 279 + , 280 + , 281 + , 282 + , 283 + , 284 + , 285 + , 286 + , 287 + , 288 + , 289 + , 290 + , 291 + , 292 + , 293 + , 294 + , 295 + , 296 + , 297 + , 298 + , 299 + , 300 + , 301 + , 302 + , 303 + , 304 + , 305 + , 306 + , 307 + , 308 + , 309 + , 310 + , 311 + , 312 + , 313 + , 314 + , 315 + , 316 + , 317 + , 318 + , 319 + , 320 + , 321 + , 322 + , 323 + , 324 + , 325 + , 326 + , 327 + , 328 + , 329 + , 330 + , 331 + , 332 + , 333 + , 334 + , 335 + , 336 + , 337 + , 338 + , 339 + , 340 + , 341 + , 342 + , 343 + , 344 + , 345 + , 346 + , 347 + , 348 + , 349 + , 350 + , 351 + , 352 + , 353 + , 354 + , 355 + , 356 + , 357 + , 358 + , 359 + , 360 + , 361 + , 362 + , 363 + , 364 + , 365 + , 366 + , 367 + , 368 + , 369 + , 370 + , 371 + , 372 + , 373 + , 374 + , 375 + , 376 + , 377 + , 378 + , 379 + , 380 + , 381 + , 382 + , 383 + , 384 + , 385 + , 386 + , 387 + , 388 + , 389 + , 390 + , 391 + , 392 + , 393 + , 394 + , 395 + , 396 + , 397 + , 398 + , 399 + , 400 + , 401 + , 402 + , 403 + , 404 + , 405 + , 406 + , 407 + , 408 + , 409 + , 410 + , 411 + , 412 + , 413 + , 414 + , 415 + , 416 + , 417 + , 418 + , 419 + , 420 + , 421 + , 422 + , 423 + , 424 + , 425 + , 426 + , 427 + , 428 + , 429 + , 430 + , 431 + , 432 + , 433 + , 434 + , 435 + , 436 + , 437 + , 438 + , 439 + , 440 + , 441 + , 442 + , 443 + , 444 + , 445 + , 446 + , 447 + , 448 + , 449 + , 450 + , 451 + , 452 + , 453 + , 454 + , 455 + , 456 + , 457 + , 458 + , 459 + , 460 + , 461 + , 462 + , 463 + , 464 + , 465 + , 466 + , 467 + , 468 + , 469 + , 470 + , 471 + , 472 + , 473 + , 474 + , 475 + , 476 + , 477 + , 478 + , 479 + , 480 + , 481 + , 482 + , 483 + , 484 + , 485 + , 486 + , 487 + , 488 + , 489 + , 490 + , 491 + , 492 + , 493 + , 494 + , 495 + , 496 + , 497 + , 498 + , 499 + , 500 + , 501 + , 502 + , 503 + , 504 + , 505 + , 506 + , 507 + , 508 + , 509 + , 510 + , 511 + , 512 + , 513 + , 514 + , 515 + , 516 + , 517 + , 518 + , 519 + , 520 + , 521 + , 522 + , 523 + , 524 + , 525 + , 526 + , 527 + , 528 + , 529 + , 530 + , 531 + , 532 + , 533 + , 534 + , 535 + , 536 + , 537 + , 538 + , 539 + , 540 + , 541 + , 542 + , 543 + , 544 + , 545 + , 546 + , 547 + , 548 + , 549 + , 550 + , 551 + , 552 + , 553 + , 554 + , 555 + , 556 + , 557 + , 558 + , 559 + , 560 + , 561 + , 562 + , 563 + , 564 + , 565 + , 566 + , 567 + , 568 + , 569 + , 570 + , 571 + , 572 + , 573 + , 574 + , 575 + , 576 + , 577 + , 578 + , 579 + , 580 + , 581 + , 582 + , 583 + , 584 + , 585 + , 586 + , 587 + , 588 + , 589 + , 590 + , 591 + , 592 + , 593 + , 594 + , 595 + , 596 + , 597 + , 598 + , 599 + , 600 + , 601 + , 602 + , 603 + , 604 + , 605 + , 606 + , 607 + , 608 + , 609 + , 610 + , 611 + , 612 + , 613 + , 614 + , 615 + , 616 + , 617 + , 618 + , 619 + , 620 + , 621 + , 622 + , 623 + , 624 + , 625 + , 626 + , 627 + , 628 + , 629 + , 630 + , 631 + , 632 + , 633 + , 634 + , 635 + , 636 + , 637 + , 638 + , 639 + , 640 + , 641 + , 642 + , 643 + , 644 + , 645 + , 646 + , 647 + , 648 + , 649 + , 650 + , 651 + , 652 + , 653 + , 654 + , 655 + , 656 + , 657 + , 658 + , 659 + , 660 + , 661 + , 662 + , 663 + , 664 + , 665 + , 666 + , 667 + , 668 + , 669 + , 670 + , 671 + , 672 + , 673 + , 674 + , 675 + , 676 + , 677 + , 678 + , 679 + , 680 + , 681 + , 682 + , 683 + , 684 + , 685 + , 686 + , 687 + , 688 + , 689 + , 690 + , 691 + , 692 + , 693 + , 694 + , 695 + , 696 + , 697 + , 698 + , 699 + , 700 + , 701 + , 702 + , 703 + , 704 + , 705 + , 706 + , 707 + , 708 + , 709 + , 710 + , 711 + , 712 + , 713 + , 714 + , 715 + , 716 + , 717 + , 718 + , 719 + , 720 + , 721 + , 722 + , 723 + , 724 + , 725 + , 726 + , 727 + , 728 + , 729 + , 730 + , 731 + , 732 + , 733 + , 734 + , 735 + , 736 + , 737 + , 738 + , 739 + , 740 + , 741 + , 742 + , 743 + , 744 + , 745 + , 746 + , 747 + , 748 + , 749 + , 750 + , 751 + , 752 + , 753 + , 754 + , 755 + , 756 + , 757 + , 758 + , 759 + , 760 + , 761 + , 762 + , 763 + , 764 + , 765 + , 766 + , 767 + , 768 + , 769 + , 770 + , 771 + , 772 + , 773 + , 774 + , 775 + , 776 + , 777 + , 778 + , 779 + , 780 + , 781 + , 782 + , 783 + , 784 + , 785 + , 786 + , 787 + , 788 + , 789 + , 790 + , 791 + , 792 + , 793 + , 794 + , 795 + , 796 + , 797 + , 798 + , 799 + , 800 + , 801 + , 802 + , 803 + , 804 + , 805 + , 806 + , 807 + , 808 + , 809 + , 810 + , 811 + , 812 + , 813 + , 814 + , 815 + , 816 + , 817 + , 818 + , 819 + , 820 + , 821 + , 822 + , 823 + , 824 + , 825 + , 826 + , 827 + , 828 + , 829 + , 830 + , 831 + , 832 + , 833 + , 834 + , 835 + , 836 + , 837 + , 838 + , 839 + , 840 + , 841 + , 842 + , 843 + , 844 + , 845 + , 846 + , 847 + , 848 + , 849 + , 850 + , 851 + , 852 + , 853 + , 854 + , 855 + , 856 + , 857 + , 858 + , 859 + , 860 + , 861 + , 862 + , 863 + , 864 + , 865 + , 866 + , 867 + , 868 + , 869 + , 870 + , 871 + , 872 + , 873 + , 874 + , 875 + , 876 + , 877 + , 878 + , 879 + , 880 + , 881 + , 882 + , 883 + , 884 + , 885 + , 886 + , 887 + , 888 + , 889 + , 890 + , 891 + , 892 + , 893 + , 894 + , 895 + , 896 + , 897 + , 898 + , 899 + , 900 + , 901 + , 902 + , 903 + , 904 + , 905 + , 906 + , 907 + , 908 + , 909 + , 910 + , 911 + , 912 + , 913 + , 914 + , 915 + , 916 + , 917 + , 918 + , 919 + , 920 + , 921 + , 922 + , 923 + , 924 + , 925 + , 926 + , 927 + , 928 + , 929 + , 930 + , 931 + , 932 + , 933 + , 934 + , 935 + , 936 + , 937 + , 938 + , 939 + , 940 + , 941 + , 942 + , 943 + , 944 + , 945 + , 946 + , 947 + , 948 + , 949 + , 950 + , 951 + , 952 + , 953 + , 954 + , 955 + , 956 + , 957 + , 958 + , 959 + , 960 + , 961 + , 962 + , 963 + , 964 + , 965 + , 966 + , 967 + , 968 + , 969 + , 970 + , 971 + , 972 + , 973 + , 974 + , 975 + , 976 + , 977 + , 978 + , 979 + , 980 + , 981 + , 982 + , 983 + , 984 + , 985 + , 986 + , 987 + , 988 + , 989 + , 990 + , 991 + , 992 + , 993 + , 994 + , 995 + , 996 + , 997 + , 998 + , 999 + , 1000 + , 1001 + , 1002 + , 1003 + , 1004 + , 1005 + , 1006 + , 1007 + , 1008 + , 1009 + , 1010 + , 1011 + , 1012 + , 1013 + , 1014 + , 1015 + , 1016 + , 1017 + , 1018 + , 1019 + , 1020 + , 1021 + , 1022 + , 1023 + , 1024 + , 1025 + , 1026 + , 1027 + , 1028 + , 1029 + , 1030 + , 1031 + , 1032 + , 1033 + , 1034 + , 1035 + , 1036 + , 1037 + , 1038 + , 1039 + , 1040 + , 1041 + , 1042 + , 1043 + , 1044 + , 1045 + , 1046 + , 1047 + , 1048 + , 1049 + , 1050 + , 1051 + , 1052 + , 1053 + , 1054 + , 1055 + , 1056 + , 1057 + , 1058 + , 1059 + , 1060 + , 1061 + , 1062 + , 1063 + , 1064 + , 1065 + , 1066 + , 1067 + , 1068 + , 1069 + , 1070 + , 1071 + , 1072 + , 1073 + , 1074 + , 1075 + , 1076 + , 1077 + , 1078 + , 1079 + , 1080 + , 1081 + , 1082 + , 1083 + , 1084 + , 1085 + , 1086 + , 1087 + , 1088 + , 1089 + , 1090 + , 1091 + , 1092 + , 1093 + , 1094 + , 1095 + , 1096 + , 1097 + , 1098 + , 1099 + , 1100 + , 1101 + , 1102 + , 1103 + , 1104 + , 1105 + , 1106 + , 1107 + , 1108 + , 1109 + , 1110 + , 1111 + , 1112 + , 1113 + , 1114 + , 1115 + , 1116 + , 1117 + , 1118 + , 1119 + , 1120 + , 1121 + , 1122 + , 1123 + , 1124 + , 1125 + , 1126 + , 1127 + , 1128 + , 1129 + , 1130 + , 1131 + , 1132 + , 1133 + , 1134 + , 1135 + , 1136 + , 1137 + , 1138 + , 1139 + , 1140 + , 1141 + , 1142 + , 1143 + , 1144 + , 1145 + , 1146 + , 1147 + , 1148 + , 1149 + , 1150 + , 1151 + , 1152 + , 1153 + , 1154 + , 1155 + , 1156 + , 1157 + , 1158 + , 1159 + , 1160 + , 1161 + , 1162 + , 1163 + , 1164 + , 1165 + , 1166 + , 1167 + , 1168 + , 1169 + , 1170 + , 1171 + , 1172 + , 1173 + , 1174 + , 1175 + , 1176 + , 1177 + , 1178 + , 1179 + , 1180 + , 1181 + , 1182 + , 1183 + , 1184 + , 1185 + , 1186 + , 1187 + , 1188 + , 1189 + , 1190 + , 1191 + , 1192 + , 1193 + , 1194 + , 1195 + , 1196 + , 1197 + , 1198 + , 1199 + , 1200 + , 1201 + , 1202 + , 1203 + , 1204 + , 1205 + , 1206 + , 1207 + , 1208 + , 1209 + , 1210 + , 1211 + , 1212 + , 1213 + , 1214 + , 1215 + , 1216 + , 1217 + , 1218 + , 1219 + , 1220 + , 1221 + , 1222 + , 1223 + , 1224 + , 1225 + , 1226 + , 1227 + , 1228 + , 1229 + , 1230 + , 1231 + , 1232 + , 1233 + , 1234 + , 1235 + , 1236 + , 1237 + , 1238 + , 1239 + , 1240 + , 1241 + , 1242 + , 1243 + , 1244 + , 1245 + , 1246 + , 1247 + , 1248 + , 1249 + , 1250 + , 1251 + , 1252 + , 1253 + , 1254 + , 1255 + , 1256 + , 1257 + , 1258 + , 1259 + , 1260 + , 1261 + , 1262 + , 1263 + , 1264 + , 1265 + , 1266 + , 1267 + , 1268 + , 1269 + , 1270 + , 1271 + , 1272 + , 1273 + , 1274 + , 1275 + , 1276 + , 1277 + , 1278 + , 1279 + , 1280 + , 1281 + , 1282 + , 1283 + , 1284 + , 1285 + , 1286 + , 1287 + , 1288 + , 1289 + , 1290 + , 1291 + , 1292 + , 1293 + , 1294 + , 1295 + , 1296 + , 1297 + , 1298 + , 1299 + , 1300 + , 1301 + , 1302 + , 1303 + , 1304 + , 1305 + , 1306 + , 1307 + , 1308 + , 1309 + , 1310 + , 1311 + , 1312 + , 1313 + , 1314 + , 1315 + , 1316 + , 1317 + , 1318 + , 1319 + , 1320 + , 1321 + , 1322 + , 1323 + , 1324 + , 1325 + , 1326 + , 1327 + , 1328 + , 1329 + , 1330 + , 1331 + , 1332 + , 1333 + , 1334 + , 1335 + , 1336 + , 1337 + , 1338 + , 1339 + , 1340 + , 1341 + , 1342 + , 1343 + , 1344 + , 1345 + , 1346 + , 1347 + , 1348 + , 1349 + , 1350 + , 1351 + , 1352 + , 1353 + , 1354 + , 1355 + , 1356 + , 1357 + , 1358 + , 1359 + , 1360 + , 1361 + , 1362 + , 1363 + , 1364 + , 1365 + , 1366 + , 1367 + , 1368 + , 1369 + , 1370 + , 1371 + , 1372 + , 1373 + , 1374 + , 1375 + , 1376 + , 1377 + , 1378 + , 1379 + , 1380 + , 1381 + , 1382 + , 1383 + , 1384 + , 1385 + , 1386 + , 1387 + , 1388 + , 1389 + , 1390 + , 1391 + , 1392 + , 1393 + , 1394 + , 1395 + , 1396 + , 1397 + , 1398 + , 1399 + , 1400 + , 1401 + , 1402 + , 1403 + , 1404 + , 1405 + , 1406 + , 1407 + , 1408 + , 1409 + , 1410 + , 1411 + , 1412 + , 1413 + , 1414 + , 1415 + , 1416 + , 1417 + , 1418 + , 1419 + , 1420 + , 1421 + , 1422 + , 1423 + , 1424 + , 1425 + , 1426 + , 1427 + , 1428 + , 1429 + , 1430 + , 1431 + , 1432 + , 1433 + , 1434 + , 1435 + , 1436 + , 1437 + , 1438 + , 1439 + , 1440 + , 1441 + , 1442 + , 1443 + , 1444 + , 1445 + , 1446 + , 1447 + , 1448 + , 1449 + , 1450 + , 1451 + , 1452 + , 1453 + , 1454 + , 1455 + , 1456 + , 1457 + , 1458 + , 1459 + , 1460 + , 1461 + , 1462 + , 1463 + , 1464 + , 1465 + , 1466 + , 1467 + , 1468 + , 1469 + , 1470 + , 1471 + , 1472 + , 1473 + , 1474 + , 1475 + , 1476 + , 1477 + , 1478 + , 1479 + , 1480 + , 1481 + , 1482 + , 1483 + , 1484 + , 1485 + , 1486 + , 1487 + , 1488 + , 1489 + , 1490 + , 1491 + , 1492 + , 1493 + , 1494 + , 1495 + , 1496 + , 1497 + , 1498 + , 1499 + , 1500 + , 1501 + , 1502 + , 1503 + , 1504 + , 1505 + , 1506 + , 1507 + , 1508 + , 1509 + , 1510 + , 1511 + , 1512 + , 1513 + , 1514 + , 1515 + , 1516 + , 1517 + , 1518 + , 1519 + , 1520 + , 1521 + , 1522 + , 1523 + , 1524 + , 1525 + , 1526 + , 1527 + , 1528 + , 1529 + , 1530 + , 1531 + , 1532 + , 1533 + , 1534 + , 1535 + , 1536 + , 1537 + , 1538 + , 1539 + , 1540 + , 1541 + , 1542 + , 1543 + , 1544 + , 1545 + , 1546 + , 1547 + , 1548 + , 1549 + , 1550 + , 1551 + , 1552 + , 1553 + , 1554 + , 1555 + , 1556 + , 1557 + , 1558 + , 1559 + , 1560 + , 1561 + , 1562 + , 1563 + , 1564 + , 1565 + , 1566 + , 1567 + , 1568 + , 1569 + , 1570 + , 1571 + , 1572 + , 1573 + , 1574 + , 1575 + , 1576 + , 1577 + , 1578 + , 1579 + , 1580 + , 1581 + , 1582 + , 1583 + , 1584 + , 1585 + , 1586 + , 1587 + , 1588 + , 1589 + , 1590 + , 1591 + , 1592 + , 1593 + , 1594 + , 1595 + , 1596 + , 1597 + , 1598 + , 1599 + , 1600 + , 1601 + , 1602 + , 1603 + , 1604 + , 1605 + , 1606 + , 1607 + , 1608 + , 1609 + , 1610 + , 1611 + , 1612 + , 1613 + , 1614 + , 1615 + , 1616 + , 1617 + , 1618 + , 1619 + , 1620 + , 1621 + , 1622 + , 1623 + , 1624 + , 1625 + , 1626 + , 1627 + , 1628 + , 1629 + , 1630 + , 1631 + , 1632 + , 1633 + , 1634 + , 1635 + , 1636 + , 1637 + , 1638 + , 1639 + , 1640 + , 1641 + , 1642 + , 1643 + , 1644 + , 1645 + , 1646 + , 1647 + , 1648 + , 1649 + , 1650 + , 1651 + , 1652 + , 1653 + , 1654 + , 1655 + , 1656 + , 1657 + , 1658 + , 1659 + , 1660 + , 1661 + , 1662 + , 1663 + , 1664 + , 1665 + , 1666 + , 1667 + , 1668 + , 1669 + , 1670 + , 1671 + , 1672 + , 1673 + , 1674 + , 1675 + , 1676 + , 1677 + , 1678 + , 1679 + , 1680 + , 1681 + , 1682 + , 1683 + , 1684 + , 1685 + , 1686 + , 1687 + , 1688 + , 1689 + , 1690 + , 1691 + , 1692 + , 1693 + , 1694 + , 1695 + , 1696 + , 1697 + , 1698 + , 1699 + , 1700 + , 1701 + , 1702 + , 1703 + , 1704 + , 1705 + , 1706 + , 1707 + , 1708 + , 1709 + , 1710 + , 1711 + , 1712 + , 1713 + , 1714 + , 1715 + , 1716 + , 1717 + , 1718 + , 1719 + , 1720 + , 1721 + , 1722 + , 1723 + , 1724 + , 1725 + , 1726 + , 1727 + , 1728 + , 1729 + , 1730 + , 1731 + , 1732 + , 1733 + , 1734 + , 1735 + , 1736 + , 1737 + , 1738 + , 1739 + , 1740 + , 1741 + , 1742 + , 1743 + , 1744 + , 1745 + , 1746 + , 1747 + , 1748 + , 1749 + , 1750 + , 1751 + , 1752 + , 1753 + , 1754 + , 1755 + , 1756 + , 1757 + , 1758 + , 1759 + , 1760 + , 1761 + , 1762 + , 1763 + , 1764 + , 1765 + , 1766 + , 1767 + , 1768 + , 1769 + , 1770 + , 1771 + , 1772 + , 1773 + , 1774 + , 1775 + , 1776 + , 1777 + , 1778 + , 1779 + , 1780 + , 1781 + , 1782 + , 1783 + , 1784 + , 1785 + , 1786 + , 1787 + , 1788 + , 1789 + , 1790 + , 1791 + , 1792 + , 1793 + , 1794 + , 1795 + , 1796 + , 1797 + , 1798 + , 1799 + , 1800 + , 1801 + , 1802 + , 1803 + , 1804 + , 1805 + , 1806 + , 1807 + , 1808 + , 1809 + , 1810 + , 1811 + , 1812 + , 1813 + , 1814 + , 1815 + , 1816 + , 1817 + , 1818 + , 1819 + , 1820 + , 1821 + , 1822 + , 1823 + , 1824 + , 1825 + , 1826 + , 1827 + , 1828 + , 1829 + , 1830 + , 1831 + , 1832 + , 1833 + , 1834 + , 1835 + , 1836 + , 1837 + , 1838 + , 1839 + , 1840 + , 1841 + , 1842 + , 1843 + , 1844 + , 1845 + , 1846 + , 1847 + , 1848 + , 1849 + , 1850 + , 1851 + , 1852 + , 1853 + , 1854 + , 1855 + , 1856 + , 1857 + , 1858 + , 1859 + , 1860 + , 1861 + , 1862 + , 1863 + , 1864 + , 1865 + , 1866 + , 1867 + , 1868 + , 1869 + , 1870 + , 1871 + , 1872 + , 1873 + , 1874 + , 1875 + , 1876 + , 1877 + , 1878 + , 1879 + , 1880 + , 1881 + , 1882 + , 1883 + , 1884 + , 1885 + , 1886 + , 1887 + , 1888 + , 1889 + , 1890 + , 1891 + , 1892 + , 1893 + , 1894 + , 1895 + , 1896 + , 1897 + , 1898 + , 1899 + , 1900 + , 1901 + , 1902 + , 1903 + , 1904 + , 1905 + , 1906 + , 1907 + , 1908 + , 1909 + , 1910 + , 1911 + , 1912 + , 1913 + , 1914 + , 1915 + , 1916 + , 1917 + , 1918 + , 1919 + , 1920 + , 1921 + , 1922 + , 1923 + , 1924 + , 1925 + , 1926 + , 1927 + , 1928 + , 1929 + , 1930 + , 1931 + , 1932 + , 1933 + , 1934 + , 1935 + , 1936 + , 1937 + , 1938 + , 1939 + , 1940 + , 1941 + , 1942 + , 1943 + , 1944 + , 1945 + , 1946 + , 1947 + , 1948 + , 1949 + , 1950 + , 1951 + , 1952 + , 1953 + , 1954 + , 1955 + , 1956 + , 1957 + , 1958 + , 1959 + , 1960 + , 1961 + , 1962 + , 1963 + , 1964 + , 1965 + , 1966 + , 1967 + , 1968 + , 1969 + , 1970 + , 1971 + , 1972 + , 1973 + , 1974 + , 1975 + , 1976 + , 1977 + , 1978 + , 1979 + , 1980 + , 1981 + , 1982 + , 1983 + , 1984 + , 1985 + , 1986 + , 1987 + , 1988 + , 1989 + , 1990 + , 1991 + , 1992 + , 1993 + , 1994 + , 1995 + , 1996 + , 1997 + , 1998 + , 1999 + , 2000 + ] +``` diff --git a/unison-src/transcripts/idempotent/fix2712.md b/unison-src/transcripts/idempotent/fix2712.md new file mode 100644 index 0000000000..88e111877a --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2712.md @@ -0,0 +1,57 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +unique type Map k v = Tip | Bin Nat k v (Map k v) (Map k v) + +mapWithKey : (k ->{e} a ->{e} b) -> Map k a ->{e} Map k b +mapWithKey f m = Tip +``` + +``` ucm :added-by-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`: + + type Map k v + mapWithKey : (k ->{e} a ->{e} b) -> Map k a ->{e} Map k b +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Map k v + mapWithKey : (k ->{e} a ->{e} b) -> Map k a ->{e} Map k b +``` + +``` unison + +naiomi = + susan: Nat -> Nat -> () + susan a b = () + + pam: Map Nat Nat + pam = Tip + + mapWithKey susan pam + +``` + +``` ucm :added-by-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`: + + naiomi : Map Nat () +``` diff --git a/unison-src/transcripts/idempotent/fix2795.md b/unison-src/transcripts/idempotent/fix2795.md new file mode 100644 index 0000000000..ff161f91d7 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2795.md @@ -0,0 +1,46 @@ +``` ucm +scratch/main> builtins.mergeio + + Done. +``` + +```` unison +test = {{ + ``` + t : Text + t = "hi" + + t + ``` + @source{t1} + +}} + +t1 = "hi" +```` + +``` ucm :added-by-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`: + + t1 : Text + test : Doc2 +``` + +``` ucm +scratch/main> display test + + t : Text + t = "hi" + t + ⧨ + "hi" + + t1 : Text + t1 = "hi" +``` diff --git a/unison-src/transcripts/idempotent/fix2822.md b/unison-src/transcripts/idempotent/fix2822.md new file mode 100644 index 0000000000..95e396946a --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2822.md @@ -0,0 +1,138 @@ +# Inability to reference a term or type with a name that has segments starting with an underscore + +``` ucm :hide +scratch/main> builtins.mergeio +``` + +There should be no issue having terms with an underscore-led component + +``` unison +_a.blah = 2 + +b = _a.blah + 1 +``` + +``` ucm :added-by-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`: + + _a.blah : Nat + b : Nat +``` + +Or even that *are* a single “blank” component + +``` unison +_b = 2 + +x = _b + 1 +``` + +``` ucm :added-by-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`: + + _b : Nat + x : Nat +``` + +Types can also have underscore-led components. + +``` unison +unique type _a.Blah = A + +c : _a.Blah +c = A +``` + +``` ucm :added-by-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`: + + type _a.Blah + c : Blah +``` + +And we should also be able to access underscore-led fields. + +``` unison +type Hello = {_value : Nat} + +doStuff = _value.modify +``` + +``` ucm :added-by-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`: + + type Hello + Hello._value : Hello -> Nat + Hello._value.modify : (Nat ->{g} Nat) -> Hello ->{g} Hello + Hello._value.set : Nat -> Hello -> Hello + doStuff : (Nat ->{g} Nat) -> Hello ->{g} Hello +``` + +But pattern matching shouldn’t bind to underscore-led names. + +``` unison :error +dontMap f = cases + None -> false + Some _used -> f _used +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I couldn't figure out what _used refers to here: + + 3 | Some _used -> f _used + + I also don't know what type it should be. + + Some common causes of this error include: + * Your current namespace is too deep to contain the + definition in its subtree + * The definition is part of a library which hasn't been + added to this project + * You have a typo in the name +``` + +But we can use them as unbound patterns. + +``` unison +dontMap f = cases + None -> false + Some _unused -> f 2 +``` + +``` ucm :added-by-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`: + + dontMap : (Nat ->{g} Boolean) -> Optional a ->{g} Boolean +``` diff --git a/unison-src/transcripts/idempotent/fix2826.md b/unison-src/transcripts/idempotent/fix2826.md new file mode 100644 index 0000000000..29ab08d8c3 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2826.md @@ -0,0 +1,63 @@ +``` ucm :hide +scratch/main> builtins.mergeio +``` + +Supports fences that are longer than three backticks. + +```` unison + +doc = {{ + @typecheck ``` + x = 3 + ``` +}} + +```` + +``` ucm :added-by-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`: + + doc : Doc2 +``` + +And round-trips properly. + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + doc : Doc2 + +scratch/main> edit.new doc + + ☝️ + + I added 1 definitions to the top of scratch.u + + You can edit them there, then run `update` to replace the + definitions currently in this namespace. + +scratch/main> load scratch.u + + Loading changes detected in scratch.u. + + I found and typechecked the definitions in scratch.u. This + file has been previously added to the codebase. +``` + +```` unison :added-by-ucm scratch.u +doc : Doc2 +doc = + {{ + @typecheck ``` + x = 3 + ``` + }} +```` diff --git a/unison-src/transcripts/idempotent/fix2970.md b/unison-src/transcripts/idempotent/fix2970.md new file mode 100644 index 0000000000..fbae0cdc4b --- /dev/null +++ b/unison-src/transcripts/idempotent/fix2970.md @@ -0,0 +1,24 @@ +Also fixes \#1519 (it's the same issue). + +``` ucm +scratch/main> builtins.merge + + Done. +``` + +``` unison +foo.+.doc : Nat +foo.+.doc = 10 +``` + +``` ucm :added-by-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.+.doc : Nat +``` diff --git a/unison-src/transcripts/idempotent/fix3037.md b/unison-src/transcripts/idempotent/fix3037.md new file mode 100644 index 0000000000..d709d8984c --- /dev/null +++ b/unison-src/transcripts/idempotent/fix3037.md @@ -0,0 +1,63 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +Tests for an unsound case of ability checking that was erroneously being +accepted before. In certain cases, abilities were able to be added to rows in +invariant positions. + +``` unison :error +structural type Runner g = Runner (forall a. '{g} a -> {} a) + +pureRunner : Runner {} +pureRunner = Runner base.force + +-- this compiles, but shouldn't the effect type parameter on Runner be invariant? +runner : Runner {IO} +runner = pureRunner +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I found an ability mismatch when checking the expression in red + + 3 | pureRunner : Runner {} + 4 | pureRunner = Runner base.force + 5 | + 6 | -- this compiles, but shouldn't the effect type parameter on Runner be invariant? + 7 | runner : Runner {IO} + 8 | runner = pureRunner + + + When trying to match Runner {} with Runner {IO} the right hand + side contained extra abilities: {IO} + +``` + +Application version: + +``` unison :error +structural type A g = A (forall a. '{g} a ->{} a) + +anA : A {} +anA = A base.force + +h : A {IO} -> () +h _ = () + +> h anA +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I found an ability mismatch when checking the application + + 9 | > h anA + + + When trying to match A {} with A {IO} the right hand side + contained extra abilities: {IO} + +``` diff --git a/unison-src/transcripts/idempotent/fix3171.md b/unison-src/transcripts/idempotent/fix3171.md new file mode 100644 index 0000000000..b01d751fee --- /dev/null +++ b/unison-src/transcripts/idempotent/fix3171.md @@ -0,0 +1,37 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +Tests an case where decompiling could cause function arguments to occur in the +opposite order for partially applied functions. + +``` unison +f : Nat -> Nat -> Nat -> () -> Nat +f x y z _ = x + y * z + +> f 1 2 +> f 1 2 3 +``` + +``` ucm :added-by-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`: + + f : Nat -> Nat -> Nat -> 'Nat + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 4 | > f 1 2 + ⧩ + z _ -> 1 Nat.+ 2 Nat.* z + + 5 | > f 1 2 3 + ⧩ + _ -> 1 Nat.+ 2 Nat.* 3 +``` diff --git a/unison-src/transcripts/idempotent/fix3196.md b/unison-src/transcripts/idempotent/fix3196.md new file mode 100644 index 0000000000..a64b3d79f0 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix3196.md @@ -0,0 +1,59 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +Tests ability checking in scenarios where one side is concrete and the other is +a variable. This was supposed to be covered, but the method wasn't actually +symmetric, so doing `equate l r` might work, but not `equate r l`. + +Below were cases that caused the failing order. + +``` unison +structural type W es = W + +unique ability Zoot where + zoot : () + +-- here only to put a kind constraint on W +structural type C = C (W {}) + +woot : W {g} -> '{g, Zoot} a ->{Zoot} a +woot w a = todo () + +ex = do + w = (W : W {Zoot}) + woot w do bug "why don't you typecheck?" + +w1 : W {Zoot} +w1 = W + +w2 : W {g} -> W {g} +w2 = cases W -> W + +> w2 w1 +``` + +``` ucm :added-by-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`: + + structural type C + structural type W es + ability Zoot + ex : '{Zoot} r + w1 : W {Zoot} + w2 : W {g} -> W {g} + woot : W {g} -> '{g, Zoot} a ->{Zoot} a + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 22 | > w2 w1 + ⧩ + W +``` diff --git a/unison-src/transcripts/idempotent/fix3215.md b/unison-src/transcripts/idempotent/fix3215.md new file mode 100644 index 0000000000..714b93434c --- /dev/null +++ b/unison-src/transcripts/idempotent/fix3215.md @@ -0,0 +1,34 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +Tests a case where concrete abilities were appearing multiple times in an +inferred type. This was due to the pre-pass that figures out which abilities +are being matched on. It was just concatenating the ability for each pattern +into a list, and not checking whether there were duplicates. + +``` unison +structural ability T where + nat : Nat + int : Int + flo : Float + +f = cases + {nat -> k} -> 5 + {int -> k} -> 5 + {flo -> k} -> 5 + {x} -> 5 +``` + +``` ucm :added-by-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`: + + structural ability T + f : Request {g, T} x -> Nat +``` diff --git a/unison-src/transcripts/idempotent/fix3244.md b/unison-src/transcripts/idempotent/fix3244.md new file mode 100644 index 0000000000..6f0f947f4a --- /dev/null +++ b/unison-src/transcripts/idempotent/fix3244.md @@ -0,0 +1,40 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +This tests an previously erroneous case in the pattern compiler. It was assuming +that the variables bound in a guard matched the variables bound in the rest of +the branch exactly, but apparently this needn't be the case. + +``` unison + +foo t = + (x, _) = t + f w = w + x + + match t with + (x, y) + | y < 5 -> f x + | otherwise -> x + y + +> foo (10,20) +``` + +``` ucm :added-by-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, Nat) -> Nat + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 11 | > foo (10,20) + ⧩ + 30 +``` diff --git a/unison-src/transcripts/idempotent/fix3265.md b/unison-src/transcripts/idempotent/fix3265.md new file mode 100644 index 0000000000..f900a74015 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix3265.md @@ -0,0 +1,91 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +Tests cases that produced bad decompilation output previously. There +are three cases that need to be 'fixed up.' + +1. lambda expressions with free variables need to be beta reduced +2. let defined functions need to have arguments removed and + occurrences rewritten. +3. let-rec defined functions need to have arguments removed, but + it is a more complicated process. + +``` unison +> Any (w x -> let + f0 y = match y with + 0 -> x + n -> 1 + f1 (drop y 1) + f1 y = match y with + 0 -> w + x + n -> 1 + f0 (drop y 1) + f2 x = f2 x + f3 y = 1 + y + f2 x + g h = h 1 + x + g (z -> x + f0 z)) +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + ✅ + + scratch.u changed. + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | > Any (w x -> let + ⧩ + Any + (w x -> + let + use Nat + drop + f1 y = match y with + 0 -> w + x + n -> 1 + f0 (drop y 1) + f0 y = match y with + 0 -> x + n -> 1 + f1 (drop y 1) + f2 x = f2 x + f3 x y = 1 + y + f2 x + g h = h 1 + x + g (z -> x + f0 z)) +``` + +Also check for some possible corner cases. + +`f` should not have its `x` argument eliminated, because it doesn't +always occur with `x` as the first argument, but if we aren't careful, +we might do that, because we find the first occurrence of `f`, and +discard its arguments, where `f` also occurs. + +``` unison +> Any (x -> let + f x y = match y with + 0 -> 0 + _ -> f x (f y (drop y 1)) + + f x 20) +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + ✅ + + scratch.u changed. + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | > Any (x -> let + ⧩ + Any + (x -> + let + f x y = match y with + 0 -> 0 + _ -> f x (f y (Nat.drop y 1)) + f x 20) +``` diff --git a/unison-src/transcripts/idempotent/fix3424.md b/unison-src/transcripts/idempotent/fix3424.md new file mode 100644 index 0000000000..dbd2e089f6 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix3424.md @@ -0,0 +1,49 @@ +``` ucm +scratch/main> builtins.merge lib.builtins + + Done. +``` + +``` unison :hide +a = do b +b = "Hello, " ++ c ++ "!" +c = "World" +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + a : 'Text + b : Text + c : Text + +scratch/main> run a + + "Hello, World!" +``` + +``` unison :hide +a = do b +c = "Unison" +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. + +scratch/main> run a + + "Hello, Unison!" +``` + +The result should be "Hello, Unison\!". diff --git a/unison-src/transcripts/idempotent/fix3634.md b/unison-src/transcripts/idempotent/fix3634.md new file mode 100644 index 0000000000..57c398d09d --- /dev/null +++ b/unison-src/transcripts/idempotent/fix3634.md @@ -0,0 +1,45 @@ +``` ucm :hide +scratch/main> builtins.mergeio +``` + +``` unison +structural type M a = N | J a + +d = {{ + +{{ docExample 0 '(x -> J x) }} + +{J} + +}} +``` + +``` ucm :added-by-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`: + + structural type M a + (also named builtin.Optional) + d : Doc2 +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural type M a + (also named builtin.Optional) + d : Doc2 + +scratch/main> display d + + `x -> J x` + + J +``` diff --git a/unison-src/transcripts/idempotent/fix3678.md b/unison-src/transcripts/idempotent/fix3678.md new file mode 100644 index 0000000000..d2eb422079 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix3678.md @@ -0,0 +1,32 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +Array comparison was indexing out of bounds. + +``` unison +arr = Scope.run do + ma = Scope.arrayOf "asdf" 0 + freeze! ma + +> compare arr arr +``` + +``` ucm :added-by-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`: + + arr : ImmutableArray Text + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 5 | > compare arr arr + ⧩ + +0 +``` diff --git a/unison-src/transcripts/idempotent/fix3752.md b/unison-src/transcripts/idempotent/fix3752.md new file mode 100644 index 0000000000..c017e69933 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix3752.md @@ -0,0 +1,34 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +These were failing to type check before, because id was not +generalized. + +``` unison + +foo = do + id x = + _ = 1 + x + id () + id "hello" + +bar = do + id x = x + id () + id "hello" +``` + +``` ucm :added-by-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`: + + bar : 'Text + foo : 'Text +``` diff --git a/unison-src/transcripts/idempotent/fix3773.md b/unison-src/transcripts/idempotent/fix3773.md new file mode 100644 index 0000000000..52258f5ff9 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix3773.md @@ -0,0 +1,31 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +foo = + _ = 1 + _ = 22 + 42 + +> foo + 20 +``` + +``` ucm :added-by-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 + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 6 | > foo + 20 + ⧩ + 62 +``` diff --git a/unison-src/transcripts/idempotent/fix3977.md b/unison-src/transcripts/idempotent/fix3977.md new file mode 100644 index 0000000000..f779785cf4 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix3977.md @@ -0,0 +1,47 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +Pretty-printing previously didn’t compensate for extra characters on a line that was about to be wrapped, resulting in a line-break without sufficient indentation. Now pretty-printing indents based on the starting column of the wrapped expression, not simply “prevIndent + 2”. + +``` unison :hide +failure msg context = Failure (typeLink Unit) msg (Any context) + +foo = Left (failure ("a loooooooooooooooooooooooooooooooooong" ++ "message with concatenation") ()) +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + failure : Text -> context -> Failure + foo : Either Failure b + +scratch/main> edit.new foo + + ☝️ + + I added 1 definitions to the top of scratch.u + + You can edit them there, then run `update` to replace the + definitions currently in this namespace. + +scratch/main> load scratch.u + + Loading changes detected in scratch.u. + + I found and typechecked the definitions in scratch.u. This + file has been previously added to the codebase. +``` + +``` unison :added-by-ucm scratch.u +foo : Either Failure b +foo = + use Text ++ + Left + (failure + ("a loooooooooooooooooooooooooooooooooong" + ++ "message with concatenation") + ()) +``` diff --git a/unison-src/transcripts/idempotent/fix4172.md b/unison-src/transcripts/idempotent/fix4172.md new file mode 100644 index 0000000000..8a4009a499 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix4172.md @@ -0,0 +1,98 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +debug a = match Debug.toText a with + None -> "" + Some (Left a) -> a + Some (Right a) -> a + +test> t1 = if bool then [Ok "Yay"] + else [Fail (debug [1,2,3])] +bool = true + +allowDebug = debug [1,2,3] +``` + +``` ucm :added-by-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`: + + allowDebug : Text + bool : Boolean + debug : a -> Text + t1 : [Result] + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 6 | test> t1 = if bool then [Ok "Yay"] + + ✅ Passed Yay +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + allowDebug : Text + bool : Boolean + debug : a -> Text + t1 : [Result] + +scratch/main> test + + Cached test results (`help testcache` to learn more) + + 1. t1 ◉ Yay + + ✅ 1 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` + +``` unison +bool = false +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + bool : Boolean +``` + +``` ucm :error +scratch/main> update.old + + ⍟ I've updated these names to your new definition: + + bool : Boolean + +scratch/main> test + + ✅ + + + + New test results: + + 1. t1 ✗ [1, 2, 3] + + 🚫 1 test(s) failing + + Tip: Use view 1 to view the source of a test. +``` diff --git a/unison-src/transcripts/idempotent/fix4280.md b/unison-src/transcripts/idempotent/fix4280.md new file mode 100644 index 0000000000..5f5d6d2a9a --- /dev/null +++ b/unison-src/transcripts/idempotent/fix4280.md @@ -0,0 +1,25 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +foo.bar._baz = 5 + +bonk : Nat +bonk = + use foo.bar _baz + _baz +``` + +``` ucm :added-by-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`: + + bonk : Nat + foo.bar._baz : Nat +``` diff --git a/unison-src/transcripts/idempotent/fix4397.md b/unison-src/transcripts/idempotent/fix4397.md new file mode 100644 index 0000000000..6757d22342 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix4397.md @@ -0,0 +1,18 @@ +``` unison :error +structural type Foo f + = Foo (f ()) +unique type Baz = Baz (Foo Bar) + +unique type Bar + = Bar Baz +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Kind mismatch arising from + 3 | unique type Baz = Baz (Foo Bar) + + Foo expects an argument of kind: Type -> Type; however, it + is applied to Bar which has kind: Type. +``` diff --git a/unison-src/transcripts/idempotent/fix4415.md b/unison-src/transcripts/idempotent/fix4415.md new file mode 100644 index 0000000000..2f6087477e --- /dev/null +++ b/unison-src/transcripts/idempotent/fix4415.md @@ -0,0 +1,17 @@ +``` unison +unique type Foo = Foo +unique type sub.Foo = +``` + +``` ucm :added-by-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`: + + type Foo + type sub.Foo +``` diff --git a/unison-src/transcripts/idempotent/fix4424.md b/unison-src/transcripts/idempotent/fix4424.md new file mode 100644 index 0000000000..8915119bd9 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix4424.md @@ -0,0 +1,42 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +Some basics: + +``` unison :hide +unique type Cat.Dog = Mouse Nat +unique type Rat.Dog = Bird + +countCat = cases + Cat.Dog.Mouse x -> Bird +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Cat.Dog + type Rat.Dog + countCat : Cat.Dog -> Rat.Dog +``` + +Now I want to add a constructor. + +``` unison :hide +unique type Rat.Dog = Bird | Mouse +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. +``` diff --git a/unison-src/transcripts/idempotent/fix4482.md b/unison-src/transcripts/idempotent/fix4482.md new file mode 100644 index 0000000000..ef8705ba8d --- /dev/null +++ b/unison-src/transcripts/idempotent/fix4482.md @@ -0,0 +1,65 @@ +``` ucm :hide +myproj/main> builtins.merge +``` + +``` unison +lib.foo0.lib.bonk1.bar = 203 +lib.foo0.baz = 1 +lib.foo1.zonk = 204 +lib.foo1.lib.bonk2.qux = 1 +mybar = bar + bar +``` + +``` ucm :added-by-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`: + + lib.foo0.baz : Nat + lib.foo0.lib.bonk1.bar : Nat + lib.foo1.lib.bonk2.qux : Nat + lib.foo1.zonk : Nat + mybar : Nat +``` + +``` ucm :error +myproj/main> add + + ⍟ I've added these definitions: + + lib.foo0.baz : Nat + lib.foo0.lib.bonk1.bar : Nat + lib.foo1.lib.bonk2.qux : Nat + lib.foo1.zonk : Nat + mybar : Nat + +myproj/main> upgrade foo0 foo1 + + I couldn't automatically upgrade foo0 to foo1. However, I've + added the definitions that need attention to the top of + scratch.u. + + When you're done, you can run + + upgrade.commit + + to merge your changes back into main and delete the temporary + branch. Or, if you decide to cancel the upgrade instead, you + can run + + delete.branch /upgrade-foo0-to-foo1 + + to delete the temporary branch and switch back to main. +``` + +``` unison :added-by-ucm scratch.u +mybar : Nat +mybar = + use Nat + + use lib.foo0.lib.bonk1 bar + bar + bar +``` diff --git a/unison-src/transcripts/idempotent/fix4498.md b/unison-src/transcripts/idempotent/fix4498.md new file mode 100644 index 0000000000..350fa8cdf1 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix4498.md @@ -0,0 +1,43 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +lib.dep0.bonk.foo = 5 +lib.dep0.zonk.foo = "hi" +lib.dep0.lib.dep1.foo = 6 +myterm = foo + 2 +``` + +``` ucm :added-by-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`: + + lib.dep0.bonk.foo : Nat + lib.dep0.lib.dep1.foo : Nat + lib.dep0.zonk.foo : Text + myterm : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + lib.dep0.bonk.foo : Nat + lib.dep0.lib.dep1.foo : Nat + lib.dep0.zonk.foo : Text + myterm : Nat + +scratch/main> view myterm + + myterm : Nat + myterm = + use Nat + + bonk.foo + 2 +``` diff --git a/unison-src/transcripts/idempotent/fix4515.md b/unison-src/transcripts/idempotent/fix4515.md new file mode 100644 index 0000000000..534be7e156 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix4515.md @@ -0,0 +1,69 @@ +``` ucm :hide +myproject/main> builtins.merge +``` + +``` unison +unique type Foo = Foo1 +unique type Bar = X Foo +unique type Baz = X Foo + +useBar : Bar -> Nat +useBar = cases + Bar.X _ -> 1 +``` + +``` ucm :added-by-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`: + + type Bar + type Baz + type Foo + useBar : Bar -> Nat +``` + +``` ucm +myproject/main> add + + ⍟ I've added these definitions: + + type Bar + type Baz + type Foo + useBar : Bar -> Nat +``` + +``` unison +unique type Foo = Foo1 | Foo2 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + type Foo +``` + +``` ucm +myproject/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. +``` diff --git a/unison-src/transcripts/idempotent/fix4528.md b/unison-src/transcripts/idempotent/fix4528.md new file mode 100644 index 0000000000..d91b7f016e --- /dev/null +++ b/unison-src/transcripts/idempotent/fix4528.md @@ -0,0 +1,36 @@ +``` ucm :hide +foo/main> builtins.merge +``` + +``` unison +structural type Foo = MkFoo Nat + +main : () -> Foo +main _ = MkFoo 5 +``` + +``` ucm :added-by-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`: + + structural type Foo + main : 'Foo +``` + +``` ucm +foo/main> add + + ⍟ I've added these definitions: + + structural type Foo + main : 'Foo + +foo/main> run main + + MkFoo 5 +``` diff --git a/unison-src/transcripts/idempotent/fix4556.md b/unison-src/transcripts/idempotent/fix4556.md new file mode 100644 index 0000000000..6b991bddb9 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix4556.md @@ -0,0 +1,66 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +thing = 3 +foo.hello = 5 + thing +bar.hello = 5 + thing +hey = foo.hello +``` + +``` ucm :added-by-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`: + + bar.hello : Nat + foo.hello : Nat + hey : Nat + thing : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bar.hello : Nat + foo.hello : Nat + hey : Nat + thing : Nat +``` + +``` unison +thing = 2 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + thing : Nat +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. +``` diff --git a/unison-src/transcripts/idempotent/fix4592.md b/unison-src/transcripts/idempotent/fix4592.md new file mode 100644 index 0000000000..f3e903cfdd --- /dev/null +++ b/unison-src/transcripts/idempotent/fix4592.md @@ -0,0 +1,20 @@ +``` ucm :hide +scratch/main> builtins.mergeio +``` + +``` unison +doc = {{ {{ bug "bug" + 52 }} }} +``` + +``` ucm :added-by-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`: + + doc : Doc2 +``` diff --git a/unison-src/transcripts/idempotent/fix4618.md b/unison-src/transcripts/idempotent/fix4618.md new file mode 100644 index 0000000000..5e1f55a800 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix4618.md @@ -0,0 +1,61 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +foo = 5 +unique type Bugs.Zonk = Bugs +``` + +``` ucm :added-by-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`: + + type Bugs.Zonk + foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Bugs.Zonk + foo : Nat +``` + +``` unison +foo = 4 +unique type Bugs = +``` + +``` ucm :added-by-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`: + + type Bugs + + ⍟ These names already exist. You can `update` them to your + new definition: + + foo : Nat +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. +``` diff --git a/unison-src/transcripts/idempotent/fix4711.md b/unison-src/transcripts/idempotent/fix4711.md new file mode 100644 index 0000000000..9365bf01aa --- /dev/null +++ b/unison-src/transcripts/idempotent/fix4711.md @@ -0,0 +1,59 @@ +# Delayed Int literal doesn't round trip + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +thisWorks = '(+1) + +thisDoesNotWork = ['(+1)] +``` + +``` ucm :added-by-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`: + + thisDoesNotWork : ['{g} Int] + thisWorks : 'Int +``` + +Since this is fixed, `thisDoesNotWork` now does work. + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + thisDoesNotWork : ['{g} Int] + thisWorks : 'Int + +scratch/main> edit.new thisWorks thisDoesNotWork + + ☝️ + + I added 2 definitions to the top of scratch.u + + You can edit them there, then run `update` to replace the + definitions currently in this namespace. + +scratch/main> load + + Loading changes detected in scratch.u. + + I found and typechecked the definitions in scratch.u. This + file has been previously added to the codebase. +``` + +``` unison :added-by-ucm scratch.u +thisDoesNotWork : ['{g} Int] +thisDoesNotWork = [do +1] + +thisWorks : 'Int +thisWorks = do +1 +``` diff --git a/unison-src/transcripts/idempotent/fix4722.md b/unison-src/transcripts/idempotent/fix4722.md new file mode 100644 index 0000000000..cf5cbc7545 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix4722.md @@ -0,0 +1,61 @@ +Tests an improvement to type checking related to abilities. + +`foo` below typechecks fine as long as all the branches are *checked* +against their expected type. However, it's annoying to have to +annotate them. The old code was checking a match by just synthesizing +and subtyping, but we can instead check a match by pushing the +expected type into each case, allowing top-level annotations to act +like annotations on each case. + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +ability X a where yield : {X a} () +ability Y where y : () + +type Foo b a = One a +type Bar a + = Leaf a + | Branch (Bar a) (Bar a) + +f : (a -> ()) -> '{g, X a} () -> '{g, X a} () -> '{g, X a} () +f _ x y = y + +abra : a -> '{Y, X z} r +abra = bug "" + +cadabra : (y -> z) -> '{g, X y} r -> '{g, X z} r +cadabra = bug "" + +foo : Bar (Optional b) -> '{Y, X (Foo z ('{Y} r))} () +foo = cases + Leaf a -> match a with + None -> abra a + Some _ -> cadabra One (abra a) + Branch l r -> + f (_ -> ()) (foo l) (foo r) +``` + +``` ucm :added-by-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`: + + type Bar a + type Foo b a + ability X a + ability Y + abra : a -> '{Y, X z} r + cadabra : (y ->{h} z) -> '{g, X y} r -> '{g, X z} r + f : (a ->{h} ()) + -> '{g, X a} () + -> '{g, X a} () + -> '{g, X a} () + foo : Bar (Optional b) -> '{Y, X (Foo z ('{Y} r))} () +``` diff --git a/unison-src/transcripts/idempotent/fix4731.md b/unison-src/transcripts/idempotent/fix4731.md new file mode 100644 index 0000000000..3c259c5973 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix4731.md @@ -0,0 +1,92 @@ +``` unison +structural type Void = +``` + +``` ucm :added-by-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`: + + structural type Void +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural type Void +``` + +We should be able to `match` on empty types like `Void`. + +``` unison +Void.absurdly : '{e} Void ->{e} a +Void.absurdly v = match !v with +``` + +``` ucm :added-by-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`: + + Void.absurdly : '{e} Void ->{e} a +``` + +``` unison +Void.absurdly : Void -> a +Void.absurdly v = match v with +``` + +``` ucm :added-by-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`: + + Void.absurdly : Void -> a +``` + +And empty `cases` should also work. + +``` unison +Void.absurdly : Void -> a +Void.absurdly = cases +``` + +``` ucm :added-by-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`: + + Void.absurdly : Void -> a +``` + +But empty function bodies are not allowed. + +``` unison :error +Void.absurd : Void -> a +Void.absurd x = +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I expected a block after this (in red), but there wasn't one. Maybe check your indentation: + 2 | Void.absurd x = +``` diff --git a/unison-src/transcripts/idempotent/fix4780.md b/unison-src/transcripts/idempotent/fix4780.md new file mode 100644 index 0000000000..bec569e265 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix4780.md @@ -0,0 +1,25 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +Just a simple test case to see whether partially applied +builtins decompile properly. + +``` unison +> (+) 2 +``` + +``` ucm :added-by-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 +``` diff --git a/unison-src/transcripts/idempotent/fix4898.md b/unison-src/transcripts/idempotent/fix4898.md new file mode 100644 index 0000000000..f414695494 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix4898.md @@ -0,0 +1,50 @@ +``` ucm +scratch/main> builtins.merge + + Done. +``` + +``` unison +double : Int -> Int +double x = x + x + +redouble : Int -> Int +redouble x = double x + double x +``` + +``` ucm :added-by-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`: + + double : Int -> Int + redouble : Int -> Int +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + double : Int -> Int + redouble : Int -> Int + +scratch/main> dependents double + + Dependents of: double + + Terms: + + 1. redouble + + Tip: Try `view 1` to see the source of any numbered item in + the above list. + +scratch/main> delete.term 1 + + Done. +``` diff --git a/unison-src/transcripts/idempotent/fix5055.md b/unison-src/transcripts/idempotent/fix5055.md new file mode 100644 index 0000000000..55a3fc4d5d --- /dev/null +++ b/unison-src/transcripts/idempotent/fix5055.md @@ -0,0 +1,45 @@ +``` ucm +test-5055/main> builtins.merge + + Done. +``` + +``` unison +foo.add x y = x Int.+ y + +foo.subtract x y = x Int.- y +``` + +``` ucm :added-by-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.add : Int -> Int -> Int + foo.subtract : Int -> Int -> Int +``` + +``` ucm +test-5055/main> add + + ⍟ I've added these definitions: + + foo.add : Int -> Int -> Int + foo.subtract : Int -> Int -> Int + +test-5055/main> ls foo + + 1. add (Int -> Int -> Int) + 2. subtract (Int -> Int -> Int) + +test-5055/main> view 1 + + foo.add : Int -> Int -> Int + foo.add x y = + use Int + + x + y +``` diff --git a/unison-src/transcripts/idempotent/fix5076.md b/unison-src/transcripts/idempotent/fix5076.md new file mode 100644 index 0000000000..0eebc63a89 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix5076.md @@ -0,0 +1,24 @@ +``` ucm :hide +scratch/main> builtins.mergeio +``` + +Nested call to code lexer wasn’t terminating inline examples containing blocks properly. + +``` unison +x = {{ + ``let "me"`` live + ``do "me"`` in + }} +``` + +``` ucm :added-by-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`: + + x : Doc2 +``` diff --git a/unison-src/transcripts/idempotent/fix5080.md b/unison-src/transcripts/idempotent/fix5080.md new file mode 100644 index 0000000000..b71516e10d --- /dev/null +++ b/unison-src/transcripts/idempotent/fix5080.md @@ -0,0 +1,69 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtins +``` + +``` unison +test> fix5080.tests.success = [Ok "success"] +test> fix5080.tests.failure = [Fail "fail"] +``` + +``` ucm :added-by-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`: + + fix5080.tests.failure : [Result] + fix5080.tests.success : [Result] + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | test> fix5080.tests.success = [Ok "success"] + + ✅ Passed success + + 2 | test> fix5080.tests.failure = [Fail "fail"] + + 🚫 FAILED fail +``` + +``` ucm :error +scratch/main> add + + ⍟ I've added these definitions: + + fix5080.tests.failure : [Result] + fix5080.tests.success : [Result] + +scratch/main> test + + Cached test results (`help testcache` to learn more) + + 1. fix5080.tests.success ◉ success + + 2. fix5080.tests.failure ✗ fail + + 🚫 1 test(s) failing, ✅ 1 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` + +``` ucm +scratch/main> delete.term 2 + + Done. + +scratch/main> test + + Cached test results (`help testcache` to learn more) + + 1. fix5080.tests.success ◉ success + + ✅ 1 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` diff --git a/unison-src/transcripts/fix5141.md b/unison-src/transcripts/idempotent/fix5141.md similarity index 80% rename from unison-src/transcripts/fix5141.md rename to unison-src/transcripts/idempotent/fix5141.md index 0536b6e0a0..fd50da1091 100644 --- a/unison-src/transcripts/fix5141.md +++ b/unison-src/transcripts/idempotent/fix5141.md @@ -1,5 +1,5 @@ diff --git a/unison-src/transcripts/idempotent/fix5168.md b/unison-src/transcripts/idempotent/fix5168.md new file mode 100644 index 0000000000..f6b197aadc --- /dev/null +++ b/unison-src/transcripts/idempotent/fix5168.md @@ -0,0 +1,17 @@ +The `edit` seems to suppress a following ` ``` unison ` block: + +``` unison +b = 2 +``` + +``` ucm :added-by-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`: + + b : ##Nat +``` diff --git a/unison-src/transcripts/idempotent/fix5349.md b/unison-src/transcripts/idempotent/fix5349.md new file mode 100644 index 0000000000..48e16991e4 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix5349.md @@ -0,0 +1,77 @@ +``` ucm :hide +scratch/main> builtins.mergeio +``` + +Empty code blocks are invalid in Unison, but shouldn’t crash the parser. + +```` unison :error +README = {{ +``` +``` +}} +```` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I expected a block after this (in red), but there wasn't one. Maybe check your indentation: + 0 | README = {{ +``` + +``` unison :error +README = {{ {{ }} }} +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I got confused here: + + + + I was surprised to find an end of input here. + I was expecting one of these instead: + + * bang + * do + * false + * force + * handle + * if + * lambda + * let + * quote + * termLink + * true + * tuple + * typeLink +``` + +``` unison :error +README = {{ `` `` }} +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I got confused here: + + + + I was surprised to find an end of input here. + I was expecting one of these instead: + + * bang + * do + * false + * force + * handle + * if + * lambda + * let + * quote + * termLink + * true + * tuple + * typeLink +``` diff --git a/unison-src/transcripts/idempotent/fix5419.md b/unison-src/transcripts/idempotent/fix5419.md new file mode 100644 index 0000000000..b59561855f --- /dev/null +++ b/unison-src/transcripts/idempotent/fix5419.md @@ -0,0 +1,76 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +Below is an example of variable capture occuring from pattern matching. + +``` unison + +foo w = match (5, w) with + x -> + y = toText x + match 99 with _ -> () + z = toText x + (y,z) + +> foo 8 +``` + +``` ucm :added-by-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 : w + -> ( Optional (Either Text Text), + Optional (Either Text Text)) + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 9 | > foo 8 + ⧩ + (Some (Right "(5, 8)"), Some (Right "(5, 8)")) +``` + +Arguably, the root cause is flattening of nested lets like this one. + +``` unison + +bar x = + -- argument here + y = Debug.toText x + let + x = 5 + () + -- 5 here, before fix + z = Debug.toText x + (y, z) + +> bar 3 +``` + +``` ucm :added-by-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`: + + bar : x + -> ( Optional (Either Text Text), + Optional (Either Text Text)) + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 12 | > bar 3 + ⧩ + (Some (Right "3"), Some (Right "3")) +``` diff --git a/unison-src/transcripts/idempotent/fix614.md b/unison-src/transcripts/idempotent/fix614.md new file mode 100644 index 0000000000..121ae4df94 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix614.md @@ -0,0 +1,122 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +This transcript demonstrates that Unison forces actions in blocks to have a return type of `()`. + +This works, as expected: + +``` unison +structural ability Stream a where emit : a -> () + +ex1 = do + Stream.emit 1 + Stream.emit 2 + 42 +``` + +``` ucm :added-by-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`: + + structural ability Stream a + ex1 : '{Stream Nat} Nat +``` + +``` ucm :hide +scratch/main> add +``` + +This does not typecheck, we've accidentally underapplied `Stream.emit`: + +``` unison :error +ex2 = do + Stream.emit + 42 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I found a value of type: a ->{Stream a} Unit + where I expected to find: Unit + + 2 | Stream.emit + 3 | 42 + + Hint: Actions within a block must have type Unit. + Use _ = to ignore a result. +``` + +We can explicitly ignore an unused result like so: + +``` unison +ex3 = do + _ = Stream.emit + () +``` + +``` ucm :added-by-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`: + + ex3 : '() +``` + +Using a helper function like `void` also works fine: + +``` unison +void x = () + +ex4 = + void [1,2,3] + () +``` + +``` ucm :added-by-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`: + + ex4 : () + void : x -> () +``` + +One more example: + +``` unison :error +ex4 = + [1,2,3] -- no good + () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I found a value of type: [Nat] + where I expected to find: Unit + + 2 | [1,2,3] -- no good + 3 | () + + from right here: + + 2 | [1,2,3] -- no good + + Hint: Actions within a block must have type Unit. + Use _ = to ignore a result. +``` diff --git a/unison-src/transcripts/idempotent/fix689.md b/unison-src/transcripts/idempotent/fix689.md new file mode 100644 index 0000000000..c6afe171c4 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix689.md @@ -0,0 +1,25 @@ +Tests the fix for https://github.com/unisonweb/unison/issues/689 + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +structural ability SystemTime where + systemTime : ##Nat + +tomorrow = '(SystemTime.systemTime + 24 * 60 * 60) +``` + +``` ucm :added-by-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`: + + structural ability SystemTime + tomorrow : '{SystemTime} Nat +``` diff --git a/unison-src/transcripts/idempotent/fix693.md b/unison-src/transcripts/idempotent/fix693.md new file mode 100644 index 0000000000..7f28372497 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix693.md @@ -0,0 +1,131 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +structural ability X t where + x : t -> a -> a + +structural ability Abort where + abort : a +``` + +``` ucm :added-by-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`: + + structural ability Abort + structural ability X t +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural ability Abort + structural ability X t +``` + +This code should not type check. The match on X.x ought to introduce a +skolem variable `a` such that `c : a` and the continuation has type +`a ->{X} b`. Thus, `handle c with h : Optional a`, which is not the +correct result type. + +``` unison :error +h0 : Request {X t} b -> Optional b +h0 req = match req with + { X.x _ c -> _ } -> handle c with h0 + { d } -> Some d +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Each case of a match / with expression need to have the same + type. + + Here, one is: Optional b + and another is: Optional a + + + 3 | { X.x _ c -> _ } -> handle c with h0 + + from these spots, respectively: + + 1 | h0 : Request {X t} b -> Optional b +``` + +This code should not check because `t` does not match `b`. + +``` unison :error +h1 : Request {X t} b -> Optional b +h1 req = match req with + { X.x t _ -> _ } -> handle t with h1 + { d } -> Some d +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Each case of a match / with expression need to have the same + type. + + Here, one is: Optional b + and another is: Optional t + + + 3 | { X.x t _ -> _ } -> handle t with h1 + + from these spots, respectively: + + 1 | h1 : Request {X t} b -> Optional b +``` + +This code should not check for reasons similar to the first example, +but with the continuation rather than a parameter. + +``` unison :error +h2 : Request {Abort} r -> r +h2 req = match req with + { Abort.abort -> k } -> handle k 5 with h2 + { r } -> r +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + The 1st argument to `k` + + has type: Nat + but I expected: a + + 3 | { Abort.abort -> k } -> handle k 5 with h2 +``` + +This should work fine. + +``` unison +h3 : Request {X b, Abort} b -> Optional b +h3 = cases + { r } -> Some r + { Abort.abort -> _ } -> None + { X.x b _ -> _ } -> Some b +``` + +``` ucm :added-by-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`: + + h3 : Request {X b, Abort} b -> Optional b +``` diff --git a/unison-src/transcripts/idempotent/fix845.md b/unison-src/transcripts/idempotent/fix845.md new file mode 100644 index 0000000000..57c5dc7fcd --- /dev/null +++ b/unison-src/transcripts/idempotent/fix845.md @@ -0,0 +1,149 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +Add `List.zonk` to the codebase: + +``` unison +List.zonk : [a] -> [a] +List.zonk xs = xs + +Text.zonk : Text -> Text +Text.zonk txt = txt ++ "!! " +``` + +``` ucm :added-by-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`: + + List.zonk : [a] -> [a] + Text.zonk : Text -> Text +``` + +``` ucm :hide +scratch/main> add +``` + +Now, typecheck a file with a reference to `Blah.zonk` (which doesn't exist in the codebase). This should fail: + +``` unison :error +-- should not typecheck as there's no `Blah.zonk` in the codebase +> Blah.zonk [1,2,3] +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I couldn't figure out what Blah.zonk refers to here: + + 2 | > Blah.zonk [1,2,3] + + I think its type should be: + + [Nat] -> o + + Some common causes of this error include: + * Your current namespace is too deep to contain the + definition in its subtree + * The definition is part of a library which hasn't been + added to this project + * You have a typo in the name +``` + +Here's another example, just checking that TDNR works for definitions in the same file: + +``` unison +foo.bar.baz = 42 + +qux.baz = "hello" + +ex = baz ++ ", world!" + +> ex +``` + +``` ucm :added-by-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`: + + ex : Text + foo.bar.baz : Nat + qux.baz : Text + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 7 | > ex + ⧩ + "hello, world!" +``` + +Here's another example, checking that TDNR works when multiple codebase definitions have matching names: + +``` unison +ex = zonk "hi" + +> ex +``` + +``` ucm :added-by-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`: + + ex : Text + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 3 | > ex + ⧩ + "hi!! " +``` + +Last example, showing that TDNR works when there are multiple matching names in both the file and the codebase: + +``` unison +woot.zonk = "woot" +woot2.zonk = 9384 + +ex = zonk "hi" -- should resolve to Text.zonk, from the codebase + ++ zonk -- should resolve to the local `woot.zonk` from this file + +> ex +``` + +``` ucm :added-by-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`: + + ex : Text + woot.zonk : Text + woot2.zonk : Nat + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 7 | > ex + ⧩ + "hi!! woot" +``` diff --git a/unison-src/transcripts/idempotent/fix849.md b/unison-src/transcripts/idempotent/fix849.md new file mode 100644 index 0000000000..1f799f68e1 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix849.md @@ -0,0 +1,30 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +See [this ticket](https://github.com/unisonweb/unison/issues/849). + +``` unison +x = 42 + +> x +``` + +``` ucm :added-by-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`: + + x : Nat + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 3 | > x + ⧩ + 42 +``` diff --git a/unison-src/transcripts/idempotent/fix942.md b/unison-src/transcripts/idempotent/fix942.md new file mode 100644 index 0000000000..af26d19d25 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix942.md @@ -0,0 +1,125 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +First we add some code: + +``` unison +x = 0 +y = x + 1 +z = y + 2 +``` + +``` ucm :added-by-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`: + + x : Nat + y : Nat + z : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + x : Nat + y : Nat + z : Nat +``` + +Now we edit `x` to be `7`, which should make `z` equal `10`: + +``` unison +x = 7 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + x : Nat +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. + +scratch/main> view x y z + + x : Nat + x = 7 + + y : Nat + y = + use Nat + + x + 1 + + z : Nat + z = + use Nat + + y + 2 +``` + +Uh oh\! `z` is still referencing the old version. Just to confirm: + +``` unison +test> t1 = if z == 3 then [Fail "nooo!!!"] else [Ok "great"] +``` + +``` ucm :added-by-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`: + + t1 : [Result] + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | test> t1 = if z == 3 then [Fail "nooo!!!"] else [Ok "great"] + + ✅ Passed great +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + t1 : [Result] + +scratch/main> test + + Cached test results (`help testcache` to learn more) + + 1. t1 ◉ great + + ✅ 1 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` diff --git a/unison-src/transcripts/idempotent/fix987.md b/unison-src/transcripts/idempotent/fix987.md new file mode 100644 index 0000000000..e17e1d1974 --- /dev/null +++ b/unison-src/transcripts/idempotent/fix987.md @@ -0,0 +1,70 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +First we'll add a definition: + +``` unison +structural ability DeathStar where + attack : Text -> () + +spaceAttack1 x = + y = attack "saturn" + z = attack "neptune" + "All done" +``` + +``` ucm :added-by-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`: + + structural ability DeathStar + spaceAttack1 : x ->{DeathStar} Text +``` + +Add it to the codebase: + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural ability DeathStar + spaceAttack1 : x ->{DeathStar} Text +``` + +Now we'll try to add a different definition that runs the actions in a different order. This should work fine: + +``` unison +spaceAttack2 x = + z = attack "neptune" + y = attack "saturn" + "All done" +``` + +``` ucm :added-by-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`: + + spaceAttack2 : x ->{DeathStar} Text +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + spaceAttack2 : x ->{DeathStar} Text +``` + +Previously, this would fail because the hashing algorithm was being given one big let rec block whose binding order was normalized. diff --git a/unison-src/transcripts/idempotent/formatter.md b/unison-src/transcripts/idempotent/formatter.md new file mode 100644 index 0000000000..ac170b1b5e --- /dev/null +++ b/unison-src/transcripts/idempotent/formatter.md @@ -0,0 +1,207 @@ +``` ucm :hide +scratch/main> builtins.mergeio +``` + +``` unison :hide +{{ # Doc +This is a *doc*! + +term link {x} + +type link {type Optional} + +}} +x : + Nat + -> Nat +x y = + x = 1 + 1 + x + y +-- Should keep comments after + +-- symbolyDefinition +(<|>) : Nat -> Nat -> (Nat, Nat) +(<|>) a b = (a, b) + +symbolyEndOfBlock = + x = 1 + (+:) + + +-- Test for a previous regression that added extra brackets. +oneLiner = {{ one liner }} +-- After + +-- Before +explicit.doc = {{ +# Here's a top-level doc + +With a paragraph + +Or two +}} +-- After + +{{ A doc before an ability }} +ability Thing where + more : Nat -> Text -> Nat + doThing : Nat -> Int + + +{{ Ability with single constructor }} +structural ability Ask a where + ask : {Ask a} a + +-- Regression test for: https://github.com/unisonweb/unison/issues/4666 +provide : a -> '{Ask a} r -> r +provide a action = + h = cases + {ask -> resume} -> handle resume a with h + {r} -> r + handle !action with h + +{{ +A Doc before a type +}} +structural type Optional a = More Text + | Some + | Other a + | None Nat + +{{ A doc before a type with no type-vars }} +type Two = One Nat | Two Text + +-- Regression for https://github.com/unisonweb/unison/issues/4669 + +multilineBold = {{ + +**This paragraph is really really really really really long and spans multiple lines +with a strike-through block** + +_This paragraph is really really really really really long and spans multiple lines +with a strike-through block_ + +~This paragraph is really really really really really long and spans multiple lines +with a strike-through block~ + +}} +``` + +``` ucm +scratch/main> debug.format +``` + +``` unison :added-by-ucm scratch.u +x.doc = + {{ + # Doc This is a **doc**! + + term link {x} + + type link {type Optional} + }} +x : Nat -> Nat +x y = + use Nat + + x = 1 + 1 + x + y +-- Should keep comments after + +-- symbolyDefinition +(<|>) : Nat -> Nat -> (Nat, Nat) +a <|> b = (a, b) + +symbolyEndOfBlock = + x = 1 + (+:) + + +-- Test for a previous regression that added extra brackets. +oneLiner = {{ one liner }} +-- After + +-- Before +explicit.doc = + {{ + # Here's a top-level doc + + With a paragraph + + Or two + }} +-- After + +Thing.doc = {{ A doc before an ability }} +ability Thing where + more : Nat -> Text ->{Thing} Nat + doThing : Nat ->{Thing} Int + + +Ask.doc = {{ Ability with single constructor }} +structural ability Ask a where ask : {Ask a} a + +-- Regression test for: https://github.com/unisonweb/unison/issues/4666 +provide : a -> '{Ask a} r -> r +provide a action = + h = cases + { ask -> resume } -> handle resume a with h + { r } -> r + handle action() with h + +Optional.doc = {{ A Doc before a type }} +structural type Optional a = More Text | Some | Other a | None Nat + +Two.doc = {{ A doc before a type with no type-vars }} +type Two = One Nat | Two Text + +-- Regression for https://github.com/unisonweb/unison/issues/4669 + +multilineBold = + {{ + **This paragraph is really really really really really long and spans + multiple lines with a strike-through block** + + __This paragraph is really really really really really long and spans + multiple lines with a strike-through block__ + + ~~This paragraph is really really really really really long and spans + multiple lines with a strike-through block~~ + }} +``` + +Formatter should leave things alone if the file doesn't typecheck. + +``` unison :error +brokenDoc = {{ hello }} + 1 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I couldn't figure out what + refers to here: + + 1 | brokenDoc = {{ hello }} + 1 + + The name + is ambiguous. I tried to resolve it by type but no + term with that name would pass typechecking. I think its type + should be: + + Doc2 -> Nat -> o + + If that's not what you expected, you may have a type error + somewhere else in your code. + Help me out by using a more specific name here or adding a + type annotation. + + I found some terms in scope with matching names but different + types. If one of these is what you meant, try using its full + name: + + (Float.+) : Float -> Float -> Float + (Int.+) : Int -> Int -> Int + (Nat.+) : Nat -> Nat -> Nat +``` + +``` ucm +scratch/main> debug.format +``` diff --git a/unison-src/transcripts/idempotent/fuzzy-options.md b/unison-src/transcripts/idempotent/fuzzy-options.md new file mode 100644 index 0000000000..0e6ae51d30 --- /dev/null +++ b/unison-src/transcripts/idempotent/fuzzy-options.md @@ -0,0 +1,82 @@ +# Test that the options selector for fuzzy finding is working as expected for different argument types. + +If an argument is required but doesn't have a fuzzy resolver, the command should just print the help. + +``` ucm :error +-- The second argument of move.term is a 'new-name' and doesn't have a fuzzy resolver + +scratch/main> move.term + + `move.term foo bar` renames `foo` to `bar`. +``` + +If a fuzzy resolver doesn't have any options available it should print a message instead of +opening an empty fuzzy-select. + +``` ucm :error +scratch/empty> view + + ⚠️ + + Sorry, I was expecting an argument for the definition to view, and I couldn't find any to suggest to you. 😅 +``` + +``` unison :hide +optionOne = 1 + +nested.optionTwo = 2 +``` + +Definition args + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + nested.optionTwo : ##Nat + optionOne : ##Nat + +scratch/main> debug.fuzzy-options view _ + + Select a definition to view: + * optionOne + * nested.optionTwo +``` + +Namespace args + +``` ucm +scratch/main> add + + ⊡ Ignored previously added definitions: nested.optionTwo + optionOne + +scratch/main> debug.fuzzy-options find-in _ + + Select a namespace: + * nested +``` + +Project Branch args + +``` ucm +myproject/main> branch mybranch + + Done. I've created the mybranch branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /mybranch`. + +scratch/main> debug.fuzzy-options switch _ + + Select a project or branch to switch to: + * /empty + * /main + * myproject/main + * myproject/mybranch + * scratch/empty + * scratch/main + * myproject + * scratch +``` diff --git a/unison-src/transcripts/idempotent/generic-parse-errors.md b/unison-src/transcripts/idempotent/generic-parse-errors.md new file mode 100644 index 0000000000..e68aeaa8ff --- /dev/null +++ b/unison-src/transcripts/idempotent/generic-parse-errors.md @@ -0,0 +1,139 @@ +Just a bunch of random parse errors to test the error formatting. + +``` unison :error +x = + foo.123 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I got confused here: + + 2 | foo.123 + + + I was surprised to find a 1 here. + I was expecting one of these instead: + + * end of input + * hash (ex: #af3sj3) + * identifier (ex: abba1, snake_case, .foo.bar#xyz, .foo.++#xyz, or 🌻) +``` + +``` unison :error +namespace.blah = 1 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I got confused here: + + 1 | namespace.blah = 1 + + + I was surprised to find a = here. + I was expecting one of these instead: + + * ability + * bang + * binding + * do + * false + * force + * handle + * if + * lambda + * let + * newline or semicolon + * quote + * termLink + * true + * tuple + * type + * typeLink + * use +``` + +``` unison :error +x = 1 ] +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I found a closing ']' here without a matching '['. + + 1 | x = 1 ] +``` + +``` unison :error +x = a.#abc +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I got confused here: + + 1 | x = a.#abc + + + I was surprised to find a '.' here. + I was expecting one of these instead: + + * and + * bang + * do + * false + * force + * handle + * if + * infixApp + * let + * newline or semicolon + * or + * quote + * termLink + * true + * tuple + * typeLink +``` + +``` unison :error +x = "hi +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I got confused here: + + 2 | + + I was surprised to find an end of input here. + I was expecting one of these instead: + + * " + * \s + * literal character +``` + +``` unison :error +y : a +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I got confused here: + + 2 | + + I was surprised to find an end of section here. + I was expecting one of these instead: + + * -> + * newline or semicolon +``` diff --git a/unison-src/transcripts/idempotent/help.md b/unison-src/transcripts/idempotent/help.md new file mode 100644 index 0000000000..7dc5975ed0 --- /dev/null +++ b/unison-src/transcripts/idempotent/help.md @@ -0,0 +1,1024 @@ +# Shows `help` output + +``` ucm +scratch/main> help + + add + `add` adds to the codebase all the definitions from the most recently typechecked file. + + add.preview + `add.preview` previews additions to the codebase from the most recently typechecked file. This command only displays cached typechecking results. Use `load` to reparse & typecheck the file if the context has changed. + + add.run + `add.run name` adds to the codebase the result of the most recent `run` command as `name`. + + alias.many (or copy) + `alias.many [relative2...] ` creates + aliases `relative1`, `relative2`, ... in the namespace + `namespace`. + `alias.many foo.foo bar.bar .quux` creates aliases + `.quux.foo.foo` and `.quux.bar.bar`. + + alias.term + `alias.term foo bar` introduces `bar` with the same definition as `foo`. + + alias.type + `alias.type Foo Bar` introduces `Bar` with the same definition as `Foo`. + + api + `api` provides details about the API. + + auth.login + Obtain an authentication session with Unison Share. + `auth.login`authenticates ucm with Unison Share. + + back (or popd) + `back` undoes the last `switch` command. + + branch (or branch.create, create.branch) + `branch foo` forks the current project branch to a new + branch `foo` + `branch /bar foo` forks the branch `bar` of the current + project to a new branch `foo` + + branch.empty (or branch.create-empty, create.empty-branch) + Create a new empty branch. + + branch.rename (or rename.branch) + `branch.rename foo` renames the current branch to `foo` + + branches (or list.branch, ls.branch, branch.list) + `branches` lists all branches in the current project + `branches foo` lists all branches in the project `foo` + + clear + `clear` Clears the screen. + + clone + `clone @unison/json/topic json/my-topic` creates + `json/my-topic` from + the remote branch + `@unison/json/topic` + `clone @unison/base base/` creates `base/main` + from the remote + branch + `@unison/base/main` + `clone @unison/base /main2` creates the branch + `main2` in the + current project from + the remote branch + `@unison/base/main` + `clone /main /main2` creates the branch + `main2` in the + current project from + the remote branch + `main` of the + current project's + associated remote + (see + `help-topics remotes`) + `clone /main my-fork/` creates + `my-fork/main` from + the branch `main` of + the current + project's associated + remote (see + `help-topics remotes`) + + compile (or compile.output) + `compile main file` Outputs a stand alone file that can be + directly loaded and executed by unison. + Said execution will have the effect of + running `!main`. + + create.author + `create.author alicecoder "Alice McGee"` creates `alicecoder` + values in `metadata.authors` and `metadata.copyrightHolders.` + + debug.clear-cache + Clear the watch expression cache + + debug.doc-to-markdown + `debug.doc-to-markdown term.doc` Render a doc to markdown. + + debug.doctor + Analyze your codebase for errors and inconsistencies. + + debug.dump-namespace + Dump the namespace to a text file + + debug.dump-namespace-simple + Dump the namespace to a text file + + debug.file + View details about the most recent successfully typechecked file. + + debug.find.global + `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'). + debug.find.global foo Iteratively searches all + projects and branches and + lists all definitions with a + name similar to 'foo'. Note + that this is a very slow + operation. + + debug.names.global + `debug.names.global foo` Iteratively search across all + projects and branches for names matching `foo`. Note that this + is expected to be quite slow and is primarily for debugging + issues with your codebase. + + debug.numberedArgs + Dump the contents of the numbered args state. + + delete + `delete foo` removes the term or type name `foo` from the namespace. + `delete foo bar` removes the term or type name `foo` and `bar` from the namespace. + + delete.branch (or branch.delete) + `delete.branch foo/bar` deletes the branch `bar` in the + project `foo` + `delete.branch /bar` deletes the branch `bar` in the + current project + + delete.namespace + `delete.namespace ` deletes the namespace `foo` + + delete.namespace.force + `delete.namespace.force ` deletes the namespace `foo`,deletion will proceed even if other code depends on definitions in foo. + + delete.project (or project.delete) + `delete.project foo` deletes the local project `foo` + + delete.term + `delete.term foo` removes the term name `foo` from the namespace. + `delete.term foo bar` removes the term name `foo` and `bar` from the namespace. + + delete.term.verbose + `delete.term.verbose foo` removes the term name `foo` from the namespace. + `delete.term.verbose foo bar` removes the term name `foo` and `bar` from the namespace. + + delete.type + `delete.type foo` removes the type name `foo` from the namespace. + `delete.type foo bar` removes the type name `foo` and `bar` from the namespace. + + delete.type.verbose + `delete.type.verbose foo` removes the type name `foo` from the namespace. + `delete.type.verbose foo bar` removes the type name `foo` and `bar` from the namespace. + + delete.verbose + `delete.verbose foo` removes the term or type name `foo` from the namespace. + `delete.verbose foo bar` removes the term or type name `foo` and `bar` from the namespace. + + dependencies + List the dependencies of the specified definition. + + dependents + List the named dependents of the specified definition. + + deprecated.cd (or deprecated.namespace) + Moves your perspective to a different namespace. Deprecated for now because too many important things depend on your perspective selection. + + `deprecated.cd foo.bar` descends into foo.bar from the + current namespace. + `deprecated.cd .cat.dog` sets the current namespace to the + absolute namespace .cat.dog. + `deprecated.cd ..` moves to the parent of the current + namespace. E.g. moves from + '.cat.dog' to '.cat' + `deprecated.cd` invokes a search to select which + namespace to move to, which requires + that `fzf` can be found within your + PATH. + + deprecated.root-reflog + `deprecated.root-reflog` lists the changes that have affected the root namespace. This has been deprecated in favor of `reflog` which shows the reflog for the current project. + + diff.namespace + `diff.namespace before after` shows how the namespace `after` + differs from the namespace + `before` + `diff.namespace before` shows how the current namespace + differs from the namespace + `before` + + display + `display foo` prints a rendered version of the term `foo`. + `display` without arguments invokes a search to select a definition to display, which requires that `fzf` can be found within your PATH. + + display.to + `display.to foo` prints a rendered version of the + term `foo` to the given file. + + docs + `docs foo` shows documentation for the definition `foo`. + `docs` without arguments invokes a search to select which definition to view documentation for, which requires that `fzf` can be found within your PATH. + + docs.to-html + `docs.to-html .path.to.ns doc-dir` Render + all docs + contained + within + the + namespace + `.path.to.ns`, + no matter + how deep, + to html + files in + `doc-dir` + in the + directory + UCM was + run from. + `docs.to-html project0/branch0:a.path /tmp/doc-dir` Renders + all docs + anywhere + in the + namespace + `a.path` + from + `branch0` + of + `project0` + to html + in + `/tmp/doc-dir`. + + edit + `edit foo` prepends the definition of `foo` to the top of the most recently saved file. + `edit` without arguments invokes a search to select a definition for editing, which requires that `fzf` can be found within your PATH. + + edit.dependents + Like `edit`, but also includes all transitive dependents in the current project. + + edit.namespace + `edit.namespace` will load all terms and types contained within the current namespace into your scratch file. This includes definitions in namespaces, but excludes libraries. + `edit.namespace ns1 ns2 ...` loads the terms and types contained within the provided namespaces. + + edit.new + Like `edit`, but adds a new fold line below the definitions. + + find + `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'). + debug.find.global foo Iteratively searches all + projects and branches and + lists all definitions with a + name similar to 'foo'. Note + that this is a very slow + operation. + + find-in + `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'). + debug.find.global foo Iteratively searches all + projects and branches and + lists all definitions with a + name similar to 'foo'. Note + that this is a very slow + operation. + + find-in.all + `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'). + debug.find.global foo Iteratively searches all + projects and branches and + lists all definitions with a + name similar to 'foo'. Note + that this is a very slow + operation. + + find.all + `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'). + debug.find.global foo Iteratively searches all + projects and branches and + lists all definitions with a + name similar to 'foo'. Note + that this is a very slow + operation. + + find.all.verbose + `find.all.verbose` searches for definitions like `find.all`, but includes hashes and aliases in the results. + + find.verbose + `find.verbose` searches for definitions like `find`, but includes hashes and aliases in the results. + + fork (or copy.namespace) + `fork src dest` creates + the + namespace + `dest` as + a copy of + `src`. + `fork project0/branch0:a.path project1/branch1:foo` creates + the + namespace + `foo` in + `branch1` + of + `project1` + as a copy + of + `a.path` + in + `project0/branch0`. + `fork srcproject/srcbranch dest` creates + the + namespace + `dest` as + a copy of + the + branch + `srcbranch` + of + `srcproject`. + + help (or ?) + `help` shows general help and `help ` shows help for one command. + + help-topics (or help-topic) + `help-topics` lists all topics and `help-topics ` shows an explanation of that topic. + + history + `history` Shows the history of the current + path. + `history .foo` Shows history of the path .foo. + `history #9dndk3kbsk13nbpeu` Shows the history of the + namespace with the given hash. + The full hash must be provided. + + io.test (or test.io) + `io.test mytest` Runs `!mytest`, where `mytest` is a delayed + test that can use the `IO` and `Exception` + abilities. + + io.test.all (or test.io.all) + `io.test.all` runs unit tests for the current branch that use + IO + + lib.install (or install.lib) + The `lib.install` command installs a dependency into the `lib` + namespace. + + `lib.install @unison/base/releases/latest` installs the + latest release of + `@unison/base` + `lib.install @unison/base/releases/3.0.0` installs version + 3.0.0 of + `@unison/base` + `lib.install @unison/base/topic` installs the + `topic` branch of + `@unison/base` + + list (or ls, dir) + `list` lists definitions and namespaces at the current + level of the current namespace. + `list foo` lists the 'foo' namespace. + `list .foo` lists the '.foo' namespace. + + load + `load` parses, typechecks, and evaluates the + most recent scratch file. + `load ` parses, typechecks, and evaluates the + given scratch file. + + merge + `merge /branch` merges `branch` into the current branch + + merge.commit (or commit.merge) + `merge.commit` merges a temporary branch created by the + `merge` command back into its parent branch, and removes the + temporary branch. + + For example, if you've done `merge topic` from main, then + `merge.commit` is equivalent to doing + + * switch /main + * merge /merge-topic-into-main + * delete.branch /merge-topic-into-main + + move (or rename) + `move foo bar` renames the term, type, and namespace foo to bar. + + move.namespace (or rename.namespace) + `move.namespace foo bar` renames the path `foo` to `bar`. + + move.term (or rename.term) + `move.term foo bar` renames `foo` to `bar`. + + move.type (or rename.type) + `move.type foo bar` renames `foo` to `bar`. + + names + `names foo` List all known names for `foo` in the current + branch. + + namespace.dependencies + List the external dependencies of the specified namespace. + + project.create (or create.project) + `project.create` creates a project with a random name + `project.create foo` creates a project named `foo` + + project.reflog (or reflog.project) + `project.reflog` lists all the changes that have affected any branches in the current project. + `project.reflog myproject` lists all the changes that have affected any branches in myproject. + + project.rename (or rename.project) + `project.rename foo` renames the current project to `foo` + + projects (or list.project, ls.project, project.list) + List projects. + + pull + The `pull` command merges a remote namespace into a local + branch + + `pull @unison/base/main` merges the branch + `main` of the Unison + Share hosted project + `@unison/base` into + the current branch + `pull @unison/base/main my-base/topic` merges the branch + `main` of the Unison + Share hosted project + `@unison/base` into + the branch `topic` of + the local `my-base` + project + + where `remote` is a project or project branch, such as: + Project (defaults to the /main branch) `@unison/base` + Project Branch `@unison/base/feature` + Contributor Branch `@unison/base/@johnsmith/feature` + Project Release `@unison/base/releases/1.0.0` + + pull.without-history + The `pull.without-history` command merges a remote namespace + into a local branch without including the remote's history. + This usually results in smaller codebase sizes. + + `pull.without-history @unison/base/main` merges + the + branch + `main` + of the + Unison + Share + hosted + project + `@unison/base` + into + the + current + branch + `pull.without-history @unison/base/main my-base/topic` merges + the + branch + `main` + of the + Unison + Share + hosted + project + `@unison/base` + into + the + branch + `topic` + of the + local + `my-base` + project + + where `remote` is a project or project branch, such as: + Project (defaults to the /main branch) `@unison/base` + Project Branch `@unison/base/feature` + Contributor Branch `@unison/base/@johnsmith/feature` + Project Release `@unison/base/releases/1.0.0` + + push + The `push` command merges a local project or namespace into a + remote project or namespace. + + `push ` publishes the contents of a local + namespace or branch into a remote + namespace or branch. + `push ` publishes the current namespace or + branch into a remote namespace or + branch + `push` publishes the current namespace or + branch. Remote mappings for + namespaces are configured in your + `.unisonConfig` at the key + `RemoteMappings.` where + `` is the current + namespace. Remote mappings for + branches default to the branch that + you cloned from or pushed to + initially. Otherwise, it is pushed to + @/ + + where `remote` is a project or project branch, such as: + Project (defaults to the /main branch) `@unison/base` + Project Branch `@unison/base/feature` + Contributor Branch `@unison/base/@johnsmith/feature` + + push.create + The `push.create` command pushes a local namespace to an empty + remote namespace. + + `push.create remote local` pushes the contents of the local + namespace `local` into the empty + remote namespace `remote`. + `push.create remote` publishes the current namespace + into the empty remote namespace + `remote` + `push.create` publishes the current namespace + into the remote namespace + configured in your `.unisonConfig` + at the key + `RemoteMappings.` where + `` is the current + namespace, then publishes the + current namespace to that + location. + + where `remote` is a project or project branch, such as: + Project (defaults to the /main branch) `@unison/base` + Project Branch `@unison/base/feature` + Contributor Branch `@unison/base/@johnsmith/feature` + + quit (or exit, :q) + Exits the Unison command line interface. + + reflog (or reflog.branch, branch.reflog) + `reflog` lists all the changes that have affected the current branch. + `reflog /mybranch` lists all the changes that have affected /mybranch. + + reflog.global + `reflog.global` lists all recent changes across all projects and branches. + + release.draft (or draft.release) + Draft a release. + + reset + `reset #pvfd222s8n` reset the current namespace to the + hash `#pvfd222s8n` + `reset foo` reset the current namespace to the + state of the `foo` namespace. + `reset #pvfd222s8n /topic` reset the branch `topic` of the + current project to the causal + `#pvfd222s8n`. + + If you make a mistake using reset, consult the `reflog` + command and use another `reset` command to return to a + previous state. + + rewrite (or sfind.replace) + `rewrite rule1` rewrites definitions in the latest scratch file. + + The argument `rule1` must refer to a `@rewrite` block or a + function that immediately returns a `@rewrite` block. It can + be in the codebase or scratch file. An example: + + rule1 x = @rewrite term x + 1 ==> Nat.increment x + + Here, `x` will stand in for any expression wherever this + rewrite is applied, so this rule will match `(42+10+11) + 1` + and replace it with `Nat.increment (42+10+11)`. + + See https://unison-lang.org/learn/structured-find to learn more. + + Also see the related command `rewrite.find` + + rewrite.find (or sfind) + `rewrite.find rule1` finds definitions that match any of the + left side(s) of `rule` in the current namespace. + + The argument `rule1` must refer to a `@rewrite` block or a + function that immediately returns a `@rewrite` block. It can + be in the codebase or scratch file. An example: + + -- right of ==> is ignored by this command + rule1 x = @rewrite term x + 1 ==> () + + Here, `x` will stand in for any expression, so this rule will + match `(42+10+11) + 1`. + + See https://unison-lang.org/learn/structured-find to learn more. + + Also see the related command `rewrite` + + run + `run mymain args...` Runs `!mymain`, where `mymain` is + searched for in the most recent + typechecked file, or in the codebase. + Any provided arguments will be passed as + program arguments as though they were + provided at the command line when + running mymain as an executable. + + run.native + `run.native main args` Executes !main using native + compilation via scheme. + + switch + `switch` opens an interactive selector to pick a + project and branch + `switch foo/bar` switches to the branch `bar` in the project + `foo` + `switch foo/` switches to the last branch you visited in + the project `foo` + `switch /bar` switches to the branch `bar` in the current + project + + test + `test` runs unit tests for the current branch + `test foo` runs unit tests for the current branch defined in + namespace `foo` + + test.all + `test.all` runs unit tests for the current branch (including the `lib` namespace). + + text.find (or grep) + `text.find token1 "99" token2` finds terms with literals (text + or numeric) containing `token1`, `99`, and `token2`. + + Numeric literals must be quoted (ex: "42") but single words + need not be quoted. + + Use `text.find.all` to include search of `lib`. + + text.find.all (or grep.all) + `text.find.all token1 "99" token2` finds terms with literals + (text or numeric) containing `token1`, `99`, and `token2`. + + Numeric literals must be quoted (ex: "42") but single words + need not be quoted. + + Use `text.find` to exclude `lib` from search. + + todo + `todo` lists the current namespace's outstanding issues, + including conflicted names, dependencies with missing names, + and merge precondition violations. + + ui + `ui` opens the Local UI in the default browser. + + undo + `undo` reverts the most recent change to the codebase. + + unsafe.force-push (or push.unsafe-force) + Like `push`, but forcibly overwrites the remote namespace. + + update + Adds everything in the most recently typechecked file to the + namespace, replacing existing definitions having the same + name, and attempts to update all the existing dependents + accordingly. If the process can't be completed automatically, + the dependents will be added back to the scratch file for your + review. + + update.old + `update.old` works like `add`, except that if a definition in + the file has the same name as an existing definition, the name + gets updated to point to the new definition. If the old + definition has any dependents, `update` will add those + dependents to a refactoring session, specified by an optional + patch.`update.old` adds all definitions in + the .u file, noting replacements + in the default patch for the + current namespace. + `update.old ` adds all definitions in the .u + file, noting replacements in the + specified patch. + `update.old foo bar` adds `foo`, `bar`, and their + dependents from the .u file, + noting any replacements into the + specified patch. + + update.old.nopatch + `update.old.nopatch` works like `update.old`, except it + doesn't add a patch entry for any updates. Use this when you + want to make changes to definitions without pushing those + changes to dependents beyond your codebase. An example is when + updating docs, or when updating a term you just added.`update.old.nopatch` updates + all definitions in the .u file. + `update.old.nopatch foo bar` updates `foo`, `bar`, and their + dependents from the .u file. + + update.old.preview + `update.old.preview` previews updates to the codebase from the most recently typechecked file. This command only displays cached typechecking results. Use `load` to reparse & typecheck the file if the context has changed. + + upgrade + `upgrade old new` upgrades library dependency `lib.old` to + `lib.new`, and, if successful, deletes `lib.old`. + + upgrade.commit (or commit.upgrade) + `upgrade.commit` merges a temporary branch created by the + `upgrade` command back into its parent branch, and removes the + temporary branch. + + For example, if you've done `upgrade foo bar` from main, then + `upgrade.commit` is equivalent to doing + + * switch /main + * merge /upgrade-foo-to-bar + * delete.branch /upgrade-foo-to-bar + + version + Print the version of unison you're running + + view + `view foo` shows definitions named `foo` within your current + namespace. + `view` without arguments invokes a search to select + definitions to view, which requires that `fzf` can be found + within your PATH. + + Supports glob syntax, where ? acts a wildcard, so + `view List.?` will show `List.map`, `List.filter`, etc, but + not `List.map.doc` (since ? only matches 1 name segment). + + view.global + `view.global foo` prints definitions of `foo` within your codebase. + `view.global` without arguments invokes a search to select definitions to view, which requires that `fzf` can be found within your PATH. + +scratch/main> help-topics + + 🌻 + + Here's a list of topics I can tell you more about: + + filestatus + messages.disallowedAbsolute + namespaces + projects + remotes + testcache + + Example: use `help-topics filestatus` to learn more about that topic. + +scratch/main> help-topic filestatus + + 📓 + + Here's a list of possible status messages you might see for + definitions in a .u file. + + needs update A definition with the same name as an + existing definition. Doing `update` + instead of `add` will turn this failure + into a successful update. + + term/ctor collision A definition with the same name as an + existing constructor for some data type. + Rename your definition or the data type + before trying again to `add` or `update`. + + ctor/term collision A type defined in the file has a + constructor that's named the same as an + existing term. Rename that term or your + constructor before trying again to `add` + or `update`. + + blocked This definition was blocked because it + dependended on a definition with a failed + status. + + extra dependency This definition was added because it was + a dependency of a definition explicitly + selected. + +scratch/main> help-topic messages.disallowedAbsolute + + 🤖 + + Although I can understand absolute (ex: .foo.bar) or relative + (ex: util.math.sqrt) references to existing definitions + (help namespaces to learn more), I can't yet handle giving new + definitions with absolute names in a .u file. + + As a workaround, you can give definitions with a relative name + temporarily (like `exports.blah.foo`) and then use `move.*`. + +scratch/main> help-topic namespaces + + 🧐 + + There are two kinds of namespaces, absolute, such as (.foo.bar + or .base.math.+) and relative, such as (math.sqrt or + util.List.++). + + Relative names are converted to absolute names by prepending + the current namespace. For example, if your Unison prompt + reads: + + .foo.bar> + + and your .u file looks like: + + x = 41 + + then doing an add will create the definition with the absolute + name .foo.bar.x = 41 + + and you can refer to x by its absolute name .foo.bar.x + elsewhere in your code. For instance: + + answerToLifeTheUniverseAndEverything = .foo.bar.x + 1 + +scratch/main> help-topic projects + + A project is a versioned collection of code that can be + edited, published, and depended on other projects. Unison + projects are analogous to Git repositories. + + project.create create a new project + projects list all your projects + branch create a new workstream + branches list all your branches + merge merge one branch into another + switch switch to a project or branch + push upload your changes to Unison Share + pull download code(/changes/updates) from Unison Share + clone download a Unison Share project or branch for contribution + + Tip: Use `help project.create` to learn more. + + For full documentation, see + https://unison-lang.org/learn/projects + +scratch/main> help-topic remotes + + 🤖 + + Local projects may be associated with at most one remote + project on Unison Share. When this relationship is + established, it becomes the default argument for a number of + share commands. For example, running `push` or `pull` in a + project with no arguments will push to or pull from the + associated remote, if it exists. + + This association is created automatically on when a project is + created by `clone`. If the project was created locally then + the relationship will be established on the first `push`. + +scratch/main> help-topic testcache + + 🎈 + + Unison caches the results of test> watch expressions. Since + these expressions are pure and always yield the same result + when evaluated, there's no need to run them more than once! + + A test is rerun only if it has changed, or if one of the + definitions it depends on has changed. +``` + +We should add a command to show help for hidden commands also. diff --git a/unison-src/transcripts/idempotent/higher-rank.md b/unison-src/transcripts/idempotent/higher-rank.md new file mode 100644 index 0000000000..5ac44083de --- /dev/null +++ b/unison-src/transcripts/idempotent/higher-rank.md @@ -0,0 +1,156 @@ +This transcript does some testing of higher-rank types. Regression tests related to higher-rank types can be added here. + +``` ucm :hide +scratch/main> alias.type ##Nat Nat + +scratch/main> alias.type ##Text Text + +scratch/main> alias.type ##IO IO +``` + +In this example, a higher-rank function is defined, `f`. No annotation is needed at the call-site of `f`, because the lambda is being checked against the polymorphic type `forall a . a -> a`, rather than inferred: + +``` unison +f : (forall a . a -> a) -> (Nat, Text) +f id = (id 1, id "hi") + +> f (x -> x) +``` + +``` ucm :added-by-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`: + + f : (∀ a. a ->{g} a) ->{g} (Nat, Text) + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 4 | > f (x -> x) + ⧩ + (1, "hi") +``` + +Another example, involving abilities. Here the ability-polymorphic function is instantiated with two different ability lists, `{}` and `{IO}`: + +``` unison +f : (forall a g . '{g} a -> '{g} a) -> () -> () +f id _ = + _ = (id ('1 : '{} Nat), id ('("hi") : '{IO} Text)) + () +``` + +``` ucm :added-by-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`: + + f : (∀ a g. '{g} a ->{h} '{g} a) -> '{h} () +``` + +Here's an example, showing that polymorphic functions can be fields of a constructor, and the functions remain polymorphic even when the field is bound to a name during pattern matching: + +``` unison +unique type Functor f = Functor (forall a b . (a -> b) -> f a -> f b) + +Functor.map : Functor f -> (forall a b . (a -> b) -> f a -> f b) +Functor.map = cases Functor f -> f + +Functor.blah : Functor f -> () +Functor.blah = cases Functor f -> + g : forall a b . (a -> b) -> f a -> f b + g = f + () +``` + +``` ucm :added-by-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`: + + type Functor f + Functor.blah : Functor f -> () + Functor.map : Functor f + -> (∀ a b. (a -> b) -> f a -> f b) +``` + +This example is similar, but involves abilities: + +``` unison +unique ability Remote t where doRemoteStuff : t () +unique type Loc = Loc (forall t a . '{Remote t} a ->{Remote t} t a) + +Loc.blah : Loc -> () +Loc.blah = cases Loc f -> + f0 : '{Remote tx} ax ->{Remote tx} tx ax + f0 = f + () + +-- In this case, no annotation is needed since the lambda +-- is checked against a polymorphic type +Loc.transform : (forall t a . '{Remote t} a -> '{Remote t} a) + -> Loc -> Loc +Loc.transform nt = cases Loc f -> Loc (a -> f (nt a)) + +-- In this case, the annotation is needed since f' is inferred +-- on its own it won't infer the higher-rank type +Loc.transform2 : (forall t a . '{Remote t} a -> '{Remote t} a) + -> Loc -> Loc +Loc.transform2 nt = cases Loc f -> + f' : forall t a . '{Remote t} a ->{Remote t} t a + f' a = f (nt a) + Loc f' +``` + +``` ucm :added-by-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`: + + type Loc + ability Remote t + Loc.blah : Loc -> () + Loc.transform : (∀ t a. '{Remote t} a -> '{Remote t} a) + -> Loc + -> Loc + Loc.transform2 : (∀ t a. '{Remote t} a -> '{Remote t} a) + -> Loc + -> Loc +``` + +## Types with polymorphic fields + +``` unison :hide +structural type HigherRanked = HigherRanked (forall a. a -> a) +``` + +We should be able to add and view records with higher-rank fields. + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural type HigherRanked + +scratch/main> view HigherRanked + + structural type HigherRanked = HigherRanked (∀ a. a -> a) +``` diff --git a/unison-src/transcripts/input-parse-errors.md b/unison-src/transcripts/idempotent/input-parse-errors.md similarity index 80% rename from unison-src/transcripts/input-parse-errors.md rename to unison-src/transcripts/idempotent/input-parse-errors.md index fe67a06cd9..2b497f5372 100644 --- a/unison-src/transcripts/input-parse-errors.md +++ b/unison-src/transcripts/idempotent/input-parse-errors.md @@ -1,27 +1,57 @@ # demonstrating our new input parsing errors -```ucm:hide +``` ucm :hide scratch/main> builtins.merge lib.builtin ``` -```unison:hide +``` unison :hide x = 55 ``` -```ucm:hide + +``` ucm :hide scratch/main> add ``` `handleNameArg` parse error in `add` -```ucm:error + +``` ucm :error scratch/main> add . + + ⚠️ + + Sorry, I wasn’t sure how to process your request: + + 1:2: + | + 1 | . + | ^ + unexpected end of input + expecting '`' or operator (valid characters: !$%&*+-/:<=>\^|~) + + + You can run `help add` for more information on using `add`. + scratch/main> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + scratch/main> add 1 + + scratch/main> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + scratch/main> add 2 + + ⊡ Ignored previously added definitions: x ``` todo: -```haskell + +``` haskell SA.Name name -> pure name SA.NameWithBranchPrefix (Left _) name -> pure name SA.NameWithBranchPrefix (Right prefix) name -> pure $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name @@ -38,21 +68,31 @@ todo: aliasMany: skipped -- similar to `add` -```ucm:error +``` ucm :error scratch/main> update arg + + ⚠️ + + Sorry, I wasn’t sure how to process your request: + + I expected no arguments, but received one. + + You can run `help update` for more information on using + `update`. ``` aliasTerm -``` + +``` scratch/main> alias.term ##Nat.+ Nat.+ ``` aliasTermForce, aliasType, - todo: -``` + +``` aliasMany, api, diff --git a/unison-src/transcripts/idempotent/io-test-command.md b/unison-src/transcripts/idempotent/io-test-command.md new file mode 100644 index 0000000000..395ac149b3 --- /dev/null +++ b/unison-src/transcripts/idempotent/io-test-command.md @@ -0,0 +1,81 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +The `io.test` command should run all of the tests within the current namespace, excluding libs. + +``` unison :hide +-- We manually specify types so we don't need to pull in base to run IO and such +ioAndExceptionTest : '{IO, Exception} [Result] +ioAndExceptionTest = do + [Ok "Success"] + +ioTest : '{IO} [Result] +ioTest = do + [Ok "Success"] + +lib.ioAndExceptionTestInLib : '{IO, Exception} [Result] +lib.ioAndExceptionTestInLib = do + [Ok "Success"] +``` + +``` ucm :hide +scratch/main> add +``` + +Run a IO tests one by one + +``` ucm +scratch/main> io.test ioAndExceptionTest + + New test results: + + 1. ioAndExceptionTest ◉ Success + + ✅ 1 test(s) passing + + Tip: Use view 1 to view the source of a test. + +scratch/main> io.test ioTest + + New test results: + + 1. ioTest ◉ Success + + ✅ 1 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` + +`io.test` doesn't cache results + +``` ucm +scratch/main> io.test ioAndExceptionTest + + New test results: + + 1. ioAndExceptionTest ◉ Success + + ✅ 1 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` + +`io.test.all` will run all matching tests except those in the `lib` namespace. + +``` ucm +scratch/main> io.test.all + + + + + + New test results: + + 1. ioAndExceptionTest ◉ Success + 2. ioTest ◉ Success + + ✅ 2 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` diff --git a/unison-src/transcripts/idempotent/io.md b/unison-src/transcripts/idempotent/io.md new file mode 100644 index 0000000000..314a76e1b4 --- /dev/null +++ b/unison-src/transcripts/idempotent/io.md @@ -0,0 +1,727 @@ +# tests for built-in IO functions + +``` ucm :hide +scratch/main> builtins.merge + +scratch/main> builtins.mergeio + +scratch/main> load unison-src/transcripts-using-base/base.u + +scratch/main> add +``` + +Tests for IO builtins which wired to foreign haskell calls. + +## Setup + +You can skip the section which is just needed to make the transcript self-contained. + +TempDirs/autoCleaned is an ability/hanlder which allows you to easily +create a scratch directory which will automatically get cleaned up. + +``` ucm :hide +scratch/main> add +``` + +## Basic File Functions + +### Creating/Deleting/Renaming Directories + +Tests: + + - createDirectory, + - isDirectory, + - fileExists, + - renameDirectory, + - deleteDirectory + +``` unison +testCreateRename : '{io2.IO} [Result] +testCreateRename _ = + test = 'let + tempDir = newTempDir "fileio" + fooDir = tempDir ++ "/foo" + barDir = tempDir ++ "/bar" + void x = () + void (createDirectory.impl fooDir) + check "create a foo directory" (isDirectory fooDir) + check "directory should exist" (fileExists fooDir) + renameDirectory fooDir barDir + check "foo should no longer exist" (not (fileExists fooDir)) + check "directory should no longer exist" (not (fileExists fooDir)) + check "bar should now exist" (fileExists barDir) + + bazDir = barDir ++ "/baz" + void (createDirectory.impl bazDir) + void (removeDirectory.impl barDir) + + check "removeDirectory works recursively" (not (isDirectory barDir)) + check "removeDirectory works recursively" (not (isDirectory bazDir)) + + runTest test +``` + +``` ucm :added-by-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`: + + testCreateRename : '{IO} [Result] +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + testCreateRename : '{IO} [Result] + +scratch/main> io.test testCreateRename + + New test results: + + 1. testCreateRename ◉ create a foo directory + ◉ directory should exist + ◉ foo should no longer exist + ◉ directory should no longer exist + ◉ bar should now exist + ◉ removeDirectory works recursively + ◉ removeDirectory works recursively + + ✅ 7 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` + +### Opening / Closing files + +Tests: + + - openFile + - closeFile + - isFileOpen + +``` unison +testOpenClose : '{io2.IO} [Result] +testOpenClose _ = + test = 'let + tempDir = (newTempDir "seek") + fooFile = tempDir ++ "/foo" + handle1 = openFile fooFile FileMode.Write + check "file should be open" (isFileOpen handle1) + setBuffering handle1 (SizedBlockBuffering 1024) + check "file handle buffering should match what we just set." (getBuffering handle1 == SizedBlockBuffering 1024) + setBuffering handle1 (getBuffering handle1) + putBytes handle1 0xs01 + setBuffering handle1 NoBuffering + setBuffering handle1 (getBuffering handle1) + putBytes handle1 0xs23 + setBuffering handle1 BlockBuffering + setBuffering handle1 (getBuffering handle1) + putBytes handle1 0xs45 + setBuffering handle1 LineBuffering + setBuffering handle1 (getBuffering handle1) + putBytes handle1 0xs67 + closeFile handle1 + check "file should be closed" (not (isFileOpen handle1)) + + -- make sure the bytes have been written + handle2 = openFile fooFile FileMode.Read + check "bytes have been written" (getBytes handle2 4 == 0xs01234567) + closeFile handle2 + + -- checking that ReadWrite mode works fine + handle3 = openFile fooFile FileMode.ReadWrite + check "bytes have been written" (getBytes handle3 4 == 0xs01234567) + closeFile handle3 + + check "file should be closed" (not (isFileOpen handle1)) + + runTest test +``` + +``` ucm :added-by-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`: + + testOpenClose : '{IO} [Result] +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + testOpenClose : '{IO} [Result] + +scratch/main> io.test testOpenClose + + New test results: + + 1. testOpenClose ◉ file should be open + ◉ file handle buffering should match what we just set. + ◉ file should be closed + ◉ bytes have been written + ◉ bytes have been written + ◉ file should be closed + + ✅ 6 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` + +### Reading files with getSomeBytes + +Tests: + + - getSomeBytes + - putBytes + - isFileOpen + - seekHandle + +``` unison +testGetSomeBytes : '{io2.IO} [Result] +testGetSomeBytes _ = + test = 'let + tempDir = (newTempDir "getSomeBytes") + fooFile = tempDir ++ "/foo" + + testData = "0123456789" + testSize = size testData + + chunkSize = 7 + check "chunk size splits data into 2 uneven sides" ((chunkSize > (testSize / 2)) && (chunkSize < testSize)) + + + -- write testData to a temporary file + fooWrite = openFile fooFile Write + putBytes fooWrite (toUtf8 testData) + closeFile fooWrite + check "file should be closed" (not (isFileOpen fooWrite)) + + -- reopen for reading back the data in chunks + fooRead = openFile fooFile Read + + -- read first part of file + chunk1 = getSomeBytes fooRead chunkSize |> fromUtf8 + check "first chunk matches first part of testData" (chunk1 == take chunkSize testData) + + -- read rest of file + chunk2 = getSomeBytes fooRead chunkSize |> fromUtf8 + check "second chunk matches rest of testData" (chunk2 == drop chunkSize testData) + + check "should be at end of file" (isFileEOF fooRead) + + readAtEOF = getSomeBytes fooRead chunkSize + check "reading at end of file results in Bytes.empty" (readAtEOF == Bytes.empty) + + -- request many bytes from the start of the file + seekHandle fooRead AbsoluteSeek +0 + bigRead = getSomeBytes fooRead (testSize * 999) |> fromUtf8 + check "requesting many bytes results in what's available" (bigRead == testData) + + closeFile fooRead + check "file should be closed" (not (isFileOpen fooRead)) + + runTest test +``` + +``` ucm :added-by-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`: + + testGetSomeBytes : '{IO} [Result] +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + testGetSomeBytes : '{IO} [Result] + +scratch/main> io.test testGetSomeBytes + + New test results: + + 1. testGetSomeBytes ◉ chunk size splits data into 2 uneven sides + ◉ file should be closed + ◉ first chunk matches first part of testData + ◉ second chunk matches rest of testData + ◉ should be at end of file + ◉ reading at end of file results in Bytes.empty + ◉ requesting many bytes results in what's available + ◉ file should be closed + + ✅ 8 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` + +### Seeking in open files + +Tests: + + - openFile + - putBytes + - closeFile + - isSeekable + - isFileEOF + - seekHandle + - getBytes + - getLine + +``` unison +testSeek : '{io2.IO} [Result] +testSeek _ = + test = 'let + tempDir = newTempDir "seek" + emit (Ok "seeked") + fooFile = tempDir ++ "/foo" + handle1 = openFile fooFile FileMode.Append + putBytes handle1 (toUtf8 "12345678") + closeFile handle1 + + handle3 = openFile fooFile FileMode.Read + check "readable file should be seekable" (isSeekable handle3) + check "shouldn't be the EOF" (not (isFileEOF handle3)) + expectU "we should be at position 0" 0 (handlePosition handle3) + + seekHandle handle3 AbsoluteSeek +1 + expectU "we should be at position 1" 1 (handlePosition handle3) + bytes3a = getBytes handle3 1000 + text3a = Text.fromUtf8 bytes3a + expectU "should be able to read our temporary file after seeking" "2345678" text3a + closeFile handle3 + + barFile = tempDir ++ "/bar" + handle4 = openFile barFile FileMode.Append + putBytes handle4 (toUtf8 "foobar\n") + closeFile handle4 + + handle5 = openFile barFile FileMode.Read + expectU "getLine should get a line" "foobar" (getLine handle5) + closeFile handle5 + + runTest test + +testAppend : '{io2.IO} [Result] +testAppend _ = + test = 'let + tempDir = newTempDir "openFile" + fooFile = tempDir ++ "/foo" + handle1 = openFile fooFile FileMode.Write + putBytes handle1 (toUtf8 "test1") + closeFile handle1 + + handle2 = openFile fooFile FileMode.Append + putBytes handle2 (toUtf8 "test2") + closeFile handle2 + + handle3 = openFile fooFile FileMode.Read + bytes3 = getBytes handle3 1000 + text3 = Text.fromUtf8 bytes3 + + expectU "should be able to read our temporary file" "test1test2" text3 + + closeFile handle3 + + runTest test +``` + +``` ucm :added-by-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`: + + testAppend : '{IO} [Result] + testSeek : '{IO} [Result] +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + testAppend : '{IO} [Result] + testSeek : '{IO} [Result] + +scratch/main> io.test testSeek + + New test results: + + 1. testSeek ◉ seeked + ◉ readable file should be seekable + ◉ shouldn't be the EOF + ◉ we should be at position 0 + ◉ we should be at position 1 + ◉ should be able to read our temporary file after seeking + ◉ getLine should get a line + + ✅ 7 test(s) passing + + Tip: Use view 1 to view the source of a test. + +scratch/main> io.test testAppend + + New test results: + + 1. testAppend ◉ should be able to read our temporary file + + ✅ 1 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` + +### SystemTime + +``` unison +testSystemTime : '{io2.IO} [Result] +testSystemTime _ = + test = 'let + t = !systemTime + check "systemTime should be sane" ((t > 1600000000) && (t < 2000000000)) + + runTest test +``` + +``` ucm :added-by-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`: + + testSystemTime : '{IO} [Result] +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + testSystemTime : '{IO} [Result] + +scratch/main> io.test testSystemTime + + New test results: + + 1. testSystemTime ◉ systemTime should be sane + + ✅ 1 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` + +### Get temp directory + +``` unison :hide +testGetTempDirectory : '{io2.IO} [Result] +testGetTempDirectory _ = + test = 'let + tempDir = reraise !getTempDirectory.impl + check "Temp directory is directory" (isDirectory tempDir) + check "Temp directory should exist" (fileExists tempDir) + runTest test +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + testGetTempDirectory : '{IO} [Result] + +scratch/main> io.test testGetTempDirectory + + New test results: + + 1. testGetTempDirectory ◉ Temp directory is directory + ◉ Temp directory should exist + + ✅ 2 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` + +### Get current directory + +``` unison :hide +testGetCurrentDirectory : '{io2.IO} [Result] +testGetCurrentDirectory _ = + test = 'let + currentDir = reraise !getCurrentDirectory.impl + check "Current directory is directory" (isDirectory currentDir) + check "Current directory should exist" (fileExists currentDir) + runTest test +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + testGetCurrentDirectory : '{IO} [Result] + +scratch/main> io.test testGetCurrentDirectory + + New test results: + + 1. testGetCurrentDirectory ◉ Current directory is directory + ◉ Current directory should exist + + ✅ 2 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` + +### Get directory contents + +``` unison :hide +testDirContents : '{io2.IO} [Result] +testDirContents _ = + test = 'let + tempDir = newTempDir "dircontents" + c = reraise (directoryContents.impl tempDir) + check "directory size should be" (size c == 2) + check "directory contents should have current directory and parent" let + (c == [".", ".."]) || (c == ["..", "."]) + runTest test +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + testDirContents : '{IO} [Result] + +scratch/main> io.test testDirContents + + New test results: + + 1. testDirContents ◉ directory size should be + ◉ directory contents should have current directory and parent + + ✅ 2 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` + +### Read environment variables + +``` unison :hide +testGetEnv : '{io2.IO} [Result] +testGetEnv _ = + test = 'let + path = reraise (getEnv.impl "PATH") -- PATH exists on windows, mac and linux. + check "PATH environent variable should be set" (size path > 0) + match getEnv.impl "DOESNTEXIST" with + Right _ -> emit (Fail "env var shouldn't exist") + Left _ -> emit (Ok "DOESNTEXIST didn't exist") + runTest test +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + testGetEnv : '{IO} [Result] + +scratch/main> io.test testGetEnv + + New test results: + + 1. testGetEnv ◉ PATH environent variable should be set + ◉ DOESNTEXIST didn't exist + + ✅ 2 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` + +### Read command line args + +`runMeWithNoArgs`, `runMeWithOneArg`, and `runMeWithTwoArgs` raise exceptions +unless they called with the right number of arguments. + +``` unison :hide +testGetArgs.fail : Text -> Failure +testGetArgs.fail descr = Failure (typeLink IOFailure) descr !Any + +testGetArgs.runMeWithNoArgs : '{io2.IO, Exception} () +testGetArgs.runMeWithNoArgs = 'let + args = reraise !getArgs.impl + match args with + [] -> printLine "called with no args" + _ -> raise (testGetArgs.fail "called with args") + +testGetArgs.runMeWithOneArg : '{io2.IO, Exception} () +testGetArgs.runMeWithOneArg = 'let + args = reraise !getArgs.impl + match args with + [] -> raise (testGetArgs.fail "called with no args") + [_] -> printLine "called with one arg" + _ -> raise (testGetArgs.fail "called with too many args") + +testGetArgs.runMeWithTwoArgs : '{io2.IO, Exception} () +testGetArgs.runMeWithTwoArgs = 'let + args = reraise !getArgs.impl + match args with + [] -> raise (testGetArgs.fail "called with no args") + [_] -> raise (testGetArgs.fail "called with one arg") + [_, _] -> printLine "called with two args" + _ -> raise (testGetArgs.fail "called with too many args") +``` + +Test that they can be run with the right number of args. + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + testGetArgs.fail : Text -> Failure + testGetArgs.runMeWithNoArgs : '{IO, Exception} () + testGetArgs.runMeWithOneArg : '{IO, Exception} () + testGetArgs.runMeWithTwoArgs : '{IO, Exception} () + +scratch/main> run runMeWithNoArgs + + () + +scratch/main> run runMeWithOneArg foo + + () + +scratch/main> run runMeWithTwoArgs foo bar + + () +``` + +Calling our examples with the wrong number of args will error. + +``` ucm :error +scratch/main> run runMeWithNoArgs foo + + 💔💥 + + The program halted with an unhandled exception: + + Failure (typeLink IOFailure) "called with args" (Any ()) + + Stack trace: + ##raise +``` + +``` ucm :error +scratch/main> run runMeWithOneArg + + 💔💥 + + The program halted with an unhandled exception: + + Failure (typeLink IOFailure) "called with no args" (Any ()) + + Stack trace: + ##raise +``` + +``` ucm :error +scratch/main> run runMeWithOneArg foo bar + + 💔💥 + + The program halted with an unhandled exception: + + Failure + (typeLink IOFailure) "called with too many args" (Any ()) + + Stack trace: + ##raise +``` + +``` ucm :error +scratch/main> run runMeWithTwoArgs + + 💔💥 + + The program halted with an unhandled exception: + + Failure (typeLink IOFailure) "called with no args" (Any ()) + + Stack trace: + ##raise +``` + +### Get the time zone + +``` unison :hide +testTimeZone = do + (offset, summer, name) = Clock.internals.systemTimeZone +0 + _ = (offset : Int, summer : Nat, name : Text) + () +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + testTimeZone : '{IO} () + +scratch/main> run testTimeZone + + () +``` + +### Get some random bytes + +``` unison :hide +testRandom : '{io2.IO} [Result] +testRandom = do + test = do + bytes = IO.randomBytes 10 + check "randomBytes returns the right number of bytes" (size bytes == 10) + runTest test +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + testRandom : '{IO} [Result] + +scratch/main> io.test testGetEnv + + New test results: + + 1. testGetEnv ◉ PATH environent variable should be set + ◉ DOESNTEXIST didn't exist + + ✅ 2 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` diff --git a/unison-src/transcripts/keyword-identifiers.md b/unison-src/transcripts/idempotent/keyword-identifiers.md similarity index 83% rename from unison-src/transcripts/keyword-identifiers.md rename to unison-src/transcripts/idempotent/keyword-identifiers.md index 665180fb39..d8574e0995 100644 --- a/unison-src/transcripts/keyword-identifiers.md +++ b/unison-src/transcripts/idempotent/keyword-identifiers.md @@ -4,34 +4,34 @@ In particular, following a keyword with a `wordyIdChar` should be a valid identi Related issues: -- https://github.com/unisonweb/unison/issues/2091 -- https://github.com/unisonweb/unison/issues/2727 + - https://github.com/unisonweb/unison/issues/2091 + - https://github.com/unisonweb/unison/issues/2727 ## Keyword list Checks the following keywords: -- `type` -- `ability` -- `structural` -- `unique` -- `if` -- `then` -- `else` -- `forall` -- `handle` -- `with` -- `where` -- `use` -- `true` -- `false` -- `alias` -- `typeLink` -- `termLink` -- `let` -- `namespace` -- `match` -- `cases` + - `type` + - `ability` + - `structural` + - `unique` + - `if` + - `then` + - `else` + - `forall` + - `handle` + - `with` + - `where` + - `use` + - `true` + - `false` + - `alias` + - `typeLink` + - `termLink` + - `let` + - `namespace` + - `match` + - `cases` Note that although `∀` is a keyword, it cannot actually appear at the start of identifier. @@ -40,7 +40,7 @@ identifier. `type`: -```unison:hide +``` unison :hide typeFoo = 99 type1 = "I am a variable" type_ = 292 @@ -52,7 +52,7 @@ structural type type! type_ = type' type_ | type'' `ability`: -```unison:hide +``` unison :hide abilityFoo = 99 ability1 = "I am a variable" ability_ = 292 @@ -63,7 +63,7 @@ structural type ability! ability_ = ability' ability_ | ability'' `structural` -```unison:hide +``` unison :hide structuralFoo = 99 structural1 = "I am a variable" structural_ = 292 @@ -74,7 +74,7 @@ structural type structural! structural_ = structural' structural_ | structural'' `unique` -```unison:hide +``` unison :hide uniqueFoo = 99 unique1 = "I am a variable" unique_ = 292 @@ -85,7 +85,7 @@ structural type unique! unique_ = unique' unique_ | unique'' `if` -```unison:hide +``` unison :hide ifFoo = 99 if1 = "I am a variable" if_ = 292 @@ -96,7 +96,7 @@ structural type if! if_ = if' if_ | if'' `then` -```unison:hide +``` unison :hide thenFoo = 99 then1 = "I am a variable" then_ = 292 @@ -107,7 +107,7 @@ structural type then! then_ = then' then_ | then'' `else` -```unison:hide +``` unison :hide elseFoo = 99 else1 = "I am a variable" else_ = 292 @@ -118,7 +118,7 @@ structural type else! else_ = else' else_ | else'' `forall` -```unison:hide +``` unison :hide forallFoo = 99 forall1 = "I am a variable" forall_ = 292 @@ -129,7 +129,7 @@ structural type forall! forall_ = forall' forall_ | forall'' `handle` -```unison:hide +``` unison :hide handleFoo = 99 handle1 = "I am a variable" handle_ = 292 @@ -140,7 +140,7 @@ structural type handle! handle_ = handle' handle_ | handle'' `with` -```unison:hide +``` unison :hide withFoo = 99 with1 = "I am a variable" with_ = 292 @@ -151,7 +151,7 @@ structural type with! with_ = with' with_ | with'' `where` -```unison:hide +``` unison :hide whereFoo = 99 where1 = "I am a variable" where_ = 292 @@ -162,7 +162,7 @@ structural type where! where_ = where' where_ | where'' `use` -```unison:hide +``` unison :hide useFoo = 99 use1 = "I am a variable" use_ = 292 @@ -173,7 +173,7 @@ structural type use! use_ = use' use_ | use'' `true` -```unison:hide +``` unison :hide trueFoo = 99 true1 = "I am a variable" true_ = 292 @@ -184,7 +184,7 @@ structural type true! true_ = true' true_ | true'' `false` -```unison:hide +``` unison :hide falseFoo = 99 false1 = "I am a variable" false_ = 292 @@ -195,7 +195,7 @@ structural type false! false_ = false' false_ | false'' `alias` -```unison:hide +``` unison :hide aliasFoo = 99 alias1 = "I am a variable" alias_ = 292 @@ -206,7 +206,7 @@ structural type alias! alias_ = alias' alias_ | alias'' `typeLink` -```unison:hide +``` unison :hide typeLinkFoo = 99 typeLink1 = "I am a variable" typeLink_ = 292 @@ -217,7 +217,7 @@ structural type typeLink! typeLink_ = typeLink' typeLink_ | typeLink'' `termLink` -```unison:hide +``` unison :hide termLinkFoo = 99 termLink1 = "I am a variable" termLink_ = 292 @@ -228,7 +228,7 @@ structural type termLink! termLink_ = termLink' termLink_ | termLink'' `let` -```unison:hide +``` unison :hide letFoo = 99 let1 = "I am a variable" let_ = 292 @@ -239,7 +239,7 @@ structural type let! let_ = let' let_ | let'' `namespace` -```unison:hide +``` unison :hide namespaceFoo = 99 namespace1 = "I am a variable" namespace_ = 292 @@ -250,7 +250,7 @@ structural type namespace! namespace_ = namespace' namespace_ | namespace'' `match` -```unison:hide +``` unison :hide matchFoo = 99 match1 = "I am a variable" match_ = 292 @@ -261,7 +261,7 @@ structural type match! match_ = match' match_ | match'' `cases` -```unison:hide +``` unison :hide casesFoo = 99 cases1 = "I am a variable" cases_ = 292 diff --git a/unison-src/transcripts/idempotent/kind-inference.md b/unison-src/transcripts/idempotent/kind-inference.md new file mode 100644 index 0000000000..cc12acd30d --- /dev/null +++ b/unison-src/transcripts/idempotent/kind-inference.md @@ -0,0 +1,346 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +## A type param cannot have conflicting kind constraints within a single decl + +conflicting constraints on the kind of `a` in a product + +``` unison :error +unique type T a = T a (a Nat) +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Kind mismatch arising from + 1 | unique type T a = T a (a Nat) + + a doesn't expect an argument; however, it is applied to Nat. +``` + +conflicting constraints on the kind of `a` in a sum + +``` unison :error +unique type T a + = Star a + | StarStar (a Nat) +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Kind mismatch arising from + 3 | | StarStar (a Nat) + + a doesn't expect an argument; however, it is applied to Nat. +``` + +## Kinds are inferred by decl component + +Successfully infer `a` in `Ping a` to be of kind `* -> *` by +inspecting its component-mate `Pong`. + +``` unison +unique type Ping a = Ping Pong +unique type Pong = Pong (Ping Optional) +``` + +``` ucm :added-by-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`: + + type Ping a + type Pong +``` + +Catch the conflict on the kind of `a` in `Ping a`. `Ping` restricts +`a` to `*`, whereas `Pong` restricts `a` to `* -> *`. + +``` unison :error +unique type Ping a = Ping a Pong +unique type Pong = Pong (Ping Optional) +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Kind mismatch arising from + 1 | unique type Ping a = Ping a Pong + + The arrow type (->) expects arguments of kind Type; however, + it is applied to a which has kind: Type -> Type. +``` + +Successful example between mutually recursive type and ability + +``` unison +unique type Ping a = Ping (a Nat -> {Pong Nat} ()) +unique ability Pong a where + pong : Ping Optional -> () +``` + +``` ucm :added-by-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`: + + type Ping a + ability Pong a +``` + +Catch conflict between mutually recursive type and ability + +``` unison :error +unique type Ping a = Ping (a -> {Pong Nat} ()) +unique ability Pong a where + pong : Ping Optional -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Kind mismatch arising from + 3 | pong : Ping Optional -> () + + Ping expects an argument of kind: Type; however, it is + applied to Optional which has kind: Type -> Type. +``` + +Consistent instantiation of `T`'s `a` parameter in `S` + +``` unison +unique type T a = T a + +unique type S = S (T Nat) +``` + +``` ucm :added-by-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`: + + type S + type T a +``` + +Delay kind defaulting until all components are processed. Here `S` +constrains the kind of `T`'s `a` parameter, although `S` is not in +the same component as `T`. + +``` unison +unique type T a = T + +unique type S = S (T Optional) +``` + +``` ucm :added-by-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`: + + type S + type T a +``` + +Catch invalid instantiation of `T`'s `a` parameter in `S` + +``` unison :error +unique type T a = T a + +unique type S = S (T Optional) +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Kind mismatch arising from + 3 | unique type S = S (T Optional) + + T expects an argument of kind: Type; however, it is applied + to Optional which has kind: Type -> Type. +``` + +## Checking annotations + +Catch kind error in type annotation + +``` unison :error +test : Nat Nat +test = 0 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Kind mismatch arising from + 1 | test : Nat Nat + + Nat doesn't expect an argument; however, it is applied to + Nat. +``` + +Catch kind error in annotation example 2 + +``` unison :error +test : Optional -> () +test _ = () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Kind mismatch arising from + 1 | test : Optional -> () + + The arrow type (->) expects arguments of kind Type; however, + it is applied to Optional which has kind: Type -> Type. +``` + +Catch kind error in annotation example 3 + +``` unison :error +unique type T a = T (a Nat) + +test : T Nat -> () +test _ = () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Kind mismatch arising from + 3 | test : T Nat -> () + + T expects an argument of kind: Type -> Type; however, it is + applied to Nat which has kind: Type. +``` + +Catch kind error in scoped type variable annotation + +``` unison :error +unique type StarStar a = StarStar (a Nat) +unique type Star a = Star a + +test : StarStar a -> () +test _ = + buggo : Star a + buggo = bug "" + () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Kind mismatch arising from + 6 | buggo : Star a + + Star expects an argument of kind: Type; however, it is + applied to a which has kind: Type -> Type. +``` + +## Effect/type mismatch + +Effects appearing where types are expected + +``` unison :error +unique ability Foo where + foo : () + +test : Foo -> () +test _ = () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Kind mismatch arising from + 4 | test : Foo -> () + + The arrow type (->) expects arguments of kind Type; however, + it is applied to Foo which has kind: Ability. +``` + +Types appearing where effects are expected + +``` unison :error +test : {Nat} () +test _ = () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Kind mismatch arising from + 1 | test : {Nat} () + + An ability list must consist solely of abilities; however, + this list contains Nat which has kind Type. Abilities are of + kind Ability. +``` + +## Cyclic kinds + +``` unison :error +unique type T a = T (a a) +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Cannot construct infinite kind + 1 | unique type T a = T (a a) + + The above application constrains the kind of a to be + infinite, generated by the constraint k = k -> Type where k + is the kind of a. +``` + +``` unison :error +unique type T a b = T (a b) (b a) +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Cannot construct infinite kind + 1 | unique type T a b = T (a b) (b a) + + The above application constrains the kind of b to be + infinite, generated by the constraint + k = (k -> Type) -> Type where k is the kind of b. +``` + +``` unison :error +unique type Ping a = Ping (a Pong) +unique type Pong a = Pong (a Ping) +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Cannot construct infinite kind + 1 | unique type Ping a = Ping (a Pong) + + The above application constrains the kind of a to be + infinite, generated by the constraint + k = (((k -> Type) -> Type) -> Type) -> Type where k is the + kind of a. +``` diff --git a/unison-src/transcripts/idempotent/lambdacase.md b/unison-src/transcripts/idempotent/lambdacase.md new file mode 100644 index 0000000000..c85050e2ec --- /dev/null +++ b/unison-src/transcripts/idempotent/lambdacase.md @@ -0,0 +1,239 @@ +# Lambda case syntax + +``` ucm :hide +scratch/main> builtins.merge +``` + +This function takes a single argument and immediately pattern matches on it. As we'll see below, it can be written using `cases` syntax: + +``` unison +isEmpty x = match x with + [] -> true + _ -> false +``` + +``` ucm :added-by-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`: + + isEmpty : [t] -> Boolean +``` + +``` ucm :hide +scratch/main> add +``` + +Here's the same function written using `cases` syntax: + +``` unison +isEmpty2 = cases + [] -> true + _ -> false +``` + +``` ucm :added-by-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`: + + isEmpty2 : [t] -> Boolean + (also named isEmpty) +``` + +Notice that Unison detects this as an alias of `isEmpty`, and if we view `isEmpty` + +``` ucm +scratch/main> view isEmpty + + isEmpty : [t] -> Boolean + isEmpty = cases + [] -> true + _ -> false +``` + +it shows the definition using `cases` syntax opportunistically, even though the code was originally written without that syntax. + +## Multi-argument cases + +Functions that take multiple arguments and immediately match on a tuple of arguments can also be rewritten to use `cases`. Here's a version using regular `match` syntax on a tuple: + +``` unison :hide +merge : [a] -> [a] -> [a] +merge xs ys = match (xs, ys) with + ([], ys) -> ys + (xs, []) -> xs + (h +: t, h2 +: t2) -> + if h <= h2 then h +: merge t (h2 +: t2) + else h2 +: merge (h +: t) t2 +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + merge : [a] -> [a] -> [a] +``` + +And here's a version using `cases`. The patterns are separated by commas: + +``` unison +merge2 : [a] -> [a] -> [a] +merge2 = cases + [], ys -> ys + xs, [] -> xs + h +: t, h2 +: t2 -> + if h <= h2 then h +: merge2 t (h2 +: t2) + else h2 +: merge2 (h +: t) t2 +``` + +``` ucm :added-by-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`: + + merge2 : [a] -> [a] -> [a] + (also named merge) +``` + +Notice that Unison detects this as an alias of `merge`, and if we view `merge` + +``` ucm +scratch/main> view merge + + merge : [a] -> [a] -> [a] + merge = cases + [], ys -> ys + xs, [] -> xs + h +: t, h2 +: t2 -> + if h <= h2 then h +: merge t (h2 +: t2) + else h2 +: merge (h +: t) t2 +``` + +it again shows the definition using the multi-argument `cases` syntax opportunistically, even though the code was originally written without that syntax. + +Here's another example: + +``` unison +structural type B = T | F + +blah : B -> B -> Text +blah = cases + T, x -> "hi" + x, y -> "bye" + +blorf = cases + x, T -> x + x, y -> y + +> blah T F +> blah F F +> blorf T F +``` + +``` ucm :added-by-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`: + + structural type B + blah : B -> B -> Text + blorf : B -> B -> B + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 12 | > blah T F + ⧩ + "hi" + + 13 | > blah F F + ⧩ + "bye" + + 14 | > blorf T F + ⧩ + F +``` + +## Patterns with multiple guards + +``` unison +merge3 : [a] -> [a] -> [a] +merge3 = cases + [], ys -> ys + xs, [] -> xs + h +: t, h2 +: t2 | h <= h2 -> h +: merge3 t (h2 +: t2) + | otherwise -> h2 +: merge3 (h +: t) t2 +``` + +``` ucm :added-by-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`: + + merge3 : [a] -> [a] -> [a] +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + merge3 : [a] -> [a] -> [a] + +scratch/main> view merge3 + + merge3 : [a] -> [a] -> [a] + merge3 = cases + [], ys -> ys + xs, [] -> xs + h +: t, h2 +: t2 + | h <= h2 -> h +: merge3 t (h2 +: t2) + | otherwise -> h2 +: merge3 (h +: t) t2 +``` + +This is the same definition written with multiple patterns and not using the `cases` syntax; notice it is considered an alias of `merge3` above. + +``` unison +merge4 : [a] -> [a] -> [a] +merge4 a b = match (a,b) with + [], ys -> ys + xs, [] -> xs + h +: t, h2 +: t2 | h <= h2 -> h +: merge4 t (h2 +: t2) + h +: t, h2 +: t2 | otherwise -> h2 +: merge4 (h +: t) t2 +``` + +``` ucm :added-by-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`: + + merge4 : [a] -> [a] -> [a] + (also named merge3) +``` diff --git a/unison-src/transcripts/idempotent/lsp-fold-ranges.md b/unison-src/transcripts/idempotent/lsp-fold-ranges.md new file mode 100644 index 0000000000..50f3242b57 --- /dev/null +++ b/unison-src/transcripts/idempotent/lsp-fold-ranges.md @@ -0,0 +1,57 @@ +``` ucm :hide +scratch/main> builtins.mergeio +``` + +``` unison :hide + +{{ Type doc }} +structural type Optional a = + None + | Some a + +{{ + Multi line + + Term doc +}} +List.map : + (a -> b) + -> [a] + -> [b] +List.map f = cases + (x +: xs) -> f x +: List.map f xs + [] -> [] + +test> z = let + x = "hello" + y = "world" + [Ok (x ++ y)] +``` + +``` ucm +scratch/main> debug.lsp.fold-ranges + + + 《{{ Type doc }}》 + 《structural type Optional a = + None + | Some a》 + + 《{{ + Multi line + + Term doc + }}》 + 《List.map : + (a -> b) + -> [a] + -> [b] + List.map f = cases + (x +: xs) -> f x +: List.map f xs + [] -> []》 + + 《test> z = let + x = "hello" + y = "world" + [Ok (x ++ y)]》 +``` diff --git a/unison-src/transcripts/idempotent/lsp-name-completion.md b/unison-src/transcripts/idempotent/lsp-name-completion.md new file mode 100644 index 0000000000..c3af7b2e61 --- /dev/null +++ b/unison-src/transcripts/idempotent/lsp-name-completion.md @@ -0,0 +1,46 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtins +``` + +``` unison :hide +foldMap = "top-level" +nested.deeply.foldMap = "nested" +lib.base.foldMap = "lib" +lib.dep.lib.transitive.foldMap = "transitive-lib" +-- A deeply nested definition with the same hash as the top level one. +-- This should not be included in the completion results if a better name with the same hash IS included. +lib.dep.lib.transitive_same_hash.foldMap = "top-level" +foldMapWith = "partial match" + +other = "other" +``` + +``` ucm :hide +scratch/main> add +``` + +Completion should find all the `foldMap` definitions in the codebase, +sorted by number of name segments, shortest first. + +Individual LSP clients may still handle sorting differently, e.g. doing a fuzzy match over returned results, or +prioritizing exact matches over partial matches. We don't have any control over that. + +``` ucm +scratch/main> debug.lsp-name-completion foldMap + + Matching Path Name Hash + foldMap foldMap #o38ps8p4q6 + foldMapWith foldMapWith #r9rs4mcb0m + foldMap nested.deeply.foldMap #snrjegr5dk + foldMap lib.base.foldMap #jf4buul17k + foldMap lib.dep.lib.transitive.foldMap #0o01gvr3fi +``` + +Should still find the term which has a matching hash to a better name if the better name doesn't match. + +``` ucm +scratch/main> debug.lsp-name-completion transitive_same_hash.foldMap + + Matching Path Name Hash + transitive_same_hash.foldMap lib.dep.lib.transitive_same_hash.foldMap #o38ps8p4q6 +``` diff --git a/unison-src/transcripts/idempotent/move-all.md b/unison-src/transcripts/idempotent/move-all.md new file mode 100644 index 0000000000..5601aafa68 --- /dev/null +++ b/unison-src/transcripts/idempotent/move-all.md @@ -0,0 +1,204 @@ +# Tests for `move` + +``` ucm :hide +scratch/main> builtins.merge +``` + +## Happy Path - namespace, term, and type + +Create a term, type, and namespace with history + +``` unison +Foo = 2 +unique type Foo = Foo +Foo.termInA = 1 +unique type Foo.T = T +``` + +``` ucm :added-by-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`: + + type Foo + type Foo.T + Foo : Nat + Foo.termInA : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + type Foo.T + Foo : Nat + Foo.termInA : Nat +``` + +``` unison +Foo.termInA = 2 +unique type Foo.T = T1 | T2 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + type Foo.T + Foo.termInA : Nat + (also named Foo) +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. +``` + +Should be able to move the term, type, and namespace, including its types, terms, and sub-namespaces. + +``` ucm +scratch/main> move Foo Bar + + Done. + +scratch/main> ls + + 1. Bar (Nat) + 2. Bar (type) + 3. Bar/ (4 terms, 1 type) + 4. builtin/ (469 terms, 74 types) + +scratch/main> ls Bar + + 1. Foo (Bar) + 2. T (type) + 3. T/ (2 terms) + 4. termInA (Nat) + +scratch/main> history Bar + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #o7vuviel4c + + + Adds / updates: + + T T.T1 T.T2 termInA + + - Deletes: + + T.T + + □ 2. #c5cggiaumo (start of history) +``` + +## Happy Path - Just term + +``` unison +bonk = 5 +``` + +``` ucm :added-by-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`: + + bonk : Nat +``` + +``` ucm +z/main> builtins.merge + + Done. + +z/main> add + + ⍟ I've added these definitions: + + bonk : Nat + +z/main> move bonk zonk + + Done. + +z/main> ls + + 1. builtin/ (469 terms, 74 types) + 2. zonk (Nat) +``` + +## Happy Path - Just namespace + +``` unison +bonk.zonk = 5 +``` + +``` ucm :added-by-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`: + + bonk.zonk : Nat + (also named zonk) +``` + +``` ucm +a/main> builtins.merge + + Done. + +a/main> add + + ⍟ I've added these definitions: + + bonk.zonk : Nat + +a/main> move bonk zonk + + Done. + +a/main> ls + + 1. builtin/ (469 terms, 74 types) + 2. zonk/ (1 term) + +a/main> view zonk.zonk + + zonk.zonk : Nat + zonk.zonk = 5 +``` + +## Sad Path - No term, type, or namespace named src + +``` ucm :error +scratch/main> move doesntexist foo + + ⚠️ + + There is no term, type, or namespace at doesntexist. +``` diff --git a/unison-src/transcripts/idempotent/move-namespace.md b/unison-src/transcripts/idempotent/move-namespace.md new file mode 100644 index 0000000000..59a1e7ae71 --- /dev/null +++ b/unison-src/transcripts/idempotent/move-namespace.md @@ -0,0 +1,376 @@ +# Tests for `move.namespace` + +## Moving the Root + +I should be able to move the root into a sub-namespace + +``` unison :hide +foo = 1 +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + foo : ##Nat + +-- Should request confirmation + +scratch/main> move.namespace . .root.at.path + + ⚠️ + + Moves which affect the root branch cannot be undone, are you sure? + Re-run the same command to proceed. + +scratch/main> move.namespace . .root.at.path + + Done. + +scratch/main> ls + + 1. root/ (1 term) + +scratch/main> history + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #g97lh1m2v7 (start of history) +``` + +``` ucm +scratch/main> ls .root.at.path + + 1. foo (##Nat) + +scratch/main> history .root.at.path + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #08a6hgi6s4 (start of history) +``` + +I should be able to move a sub namespace *over* the root. + +``` ucm +-- Should request confirmation + +scratch/main> move.namespace .root.at.path . + + ⚠️ + + Moves which affect the root branch cannot be undone, are you sure? + Re-run the same command to proceed. + +scratch/main> move.namespace .root.at.path . + + Done. + +scratch/main> ls + + 1. foo (##Nat) + +scratch/main> history + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #08a6hgi6s4 (start of history) +``` + +``` ucm :error +-- should be empty + +scratch/main> ls .root.at.path + + nothing to show + +scratch/main> history .root.at.path + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #sg60bvjo91 (start of history) +``` + +``` ucm :hide +scratch/happy> builtins.merge lib.builtins +``` + +## Happy path + +Create a namespace and add some history to it + +``` unison +a.termInA = 1 +unique type a.T = T +``` + +``` ucm :added-by-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`: + + type a.T + a.termInA : Nat +``` + +``` ucm +scratch/happy> add + + ⍟ I've added these definitions: + + type a.T + a.termInA : Nat +``` + +``` unison +a.termInA = 2 +unique type a.T = T1 | T2 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + type a.T + a.termInA : Nat +``` + +``` ucm +scratch/happy> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. +``` + +Should be able to move the namespace, including its types, terms, and sub-namespaces. + +``` ucm +scratch/happy> move.namespace a b + + Done. + +scratch/happy> ls b + + 1. T (type) + 2. T/ (2 terms) + 3. termInA (Nat) + +scratch/happy> history b + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #rkvfe5p8fu + + + Adds / updates: + + T T.T1 T.T2 termInA + + - Deletes: + + T.T + + □ 2. #avlnmh0erc (start of history) +``` + +## Namespace history + +``` ucm :hide +scratch/history> builtins.merge lib.builtins +``` + +Create some namespaces and add some history to them + +``` unison +a.termInA = 1 +b.termInB = 10 +``` + +``` ucm :added-by-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`: + + a.termInA : Nat + b.termInB : Nat +``` + +``` ucm +scratch/history> add + + ⍟ I've added these definitions: + + a.termInA : Nat + b.termInB : Nat +``` + +``` unison +a.termInA = 2 +b.termInB = 11 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + a.termInA : Nat + b.termInB : Nat +``` + +``` ucm +scratch/history> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. +``` + +Deleting a namespace should not leave behind any history, +if we move another to that location we expect the history to simply be the history +of the moved namespace. + +``` ucm +scratch/history> delete.namespace b + + Done. + +scratch/history> move.namespace a b + + Done. + +-- Should be the history from 'a' + +scratch/history> history b + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #j0cjjqepb3 + + + Adds / updates: + + termInA + + □ 2. #m8smmmgjso (start of history) + +-- Should be empty + +scratch/history> history a + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #sg60bvjo91 (start of history) +``` + +## Moving over an existing branch + +``` ucm :hide +scratch/existing> builtins.merge lib.builtins +``` + +Create some namespace and add some history to them + +``` unison +a.termInA = 1 +b.termInB = 10 +``` + +``` ucm :added-by-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`: + + a.termInA : Nat + b.termInB : Nat +``` + +``` ucm +scratch/existing> add + + ⍟ I've added these definitions: + + a.termInA : Nat + b.termInB : Nat +``` + +``` unison +a.termInA = 2 +b.termInB = 11 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + a.termInA : Nat + b.termInB : Nat +``` + +``` ucm +scratch/existing> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/existing> move.namespace a b + + ⚠️ + + A branch existed at the destination: b so I over-wrote it. + + Tip: You can use `undo` or use a hash from `reflog` to undo + this change. + + Done. +``` diff --git a/unison-src/transcripts/idempotent/name-resolution.md b/unison-src/transcripts/idempotent/name-resolution.md new file mode 100644 index 0000000000..2354c16dce --- /dev/null +++ b/unison-src/transcripts/idempotent/name-resolution.md @@ -0,0 +1,441 @@ +# Example 1 + +We have a namespace type named `Namespace.Foo` and a file type named `File.Foo`. A reference to the type `Foo` is +ambiguous. A reference to `Namespace.Foo` or `File.Foo` work fine. + +``` ucm +scratch/main> builtins.mergeio lib.builtins + + Done. +``` + +``` unison +type Namespace.Foo = Bar +``` + +``` ucm :added-by-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`: + + type Namespace.Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Namespace.Foo +``` + +``` unison :error +type File.Foo = Baz +type UsesFoo = UsesFoo Foo +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + + ❓ + + I couldn't resolve any of these symbols: + + 2 | type UsesFoo = UsesFoo Foo + + + Symbol Suggestions + + Foo File.Foo + Namespace.Foo +``` + +``` unison +type File.Foo = Baz +type UsesFoo = UsesFoo Namespace.Foo File.Foo +``` + +``` ucm :added-by-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`: + + type File.Foo + type UsesFoo +``` + +``` ucm +scratch/main> project.delete scratch +``` + +# Example 2 + +We have a namespace type named `Foo` and a file type named `File.Foo`. A reference to the type `Foo` is not ambiguous: +it refers to the namespace type (because it is an exact match). + +``` ucm +scratch/main> builtins.mergeio lib.builtins + + Done. +``` + +``` unison +type Foo = Bar +``` + +``` ucm :added-by-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`: + + type Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo +``` + +``` unison +type File.Foo = Baz +type UsesFoo = UsesFoo Foo +``` + +``` ucm :added-by-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`: + + type File.Foo + type UsesFoo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type File.Foo + type UsesFoo + +scratch/main> view UsesFoo + + type UsesFoo = UsesFoo Foo +``` + +``` ucm +scratch/main> project.delete scratch +``` + +# Example 3 + +We have a namespace type named `Namespace.Foo` and a file type named `Foo`. A reference to the type `Foo` is not ambiguous: +it refers to the file type (because it is an exact match). + +``` ucm +scratch/main> builtins.mergeio lib.builtins + + Done. +``` + +``` unison +type Namespace.Foo = Bar +``` + +``` ucm :added-by-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`: + + type Namespace.Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Namespace.Foo +``` + +``` unison +type Foo = Baz +type UsesFoo = UsesFoo Foo +``` + +``` ucm :added-by-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`: + + type Foo + type UsesFoo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + type UsesFoo + +scratch/main> view UsesFoo + + type UsesFoo = UsesFoo Foo +``` + +``` ucm +scratch/main> project.delete scratch +``` + +# Example 4 + +We have a namespace term `ns.foo : Nat` and a file term `file.foo : Text`. A reference to the term `foo` is ambiguous, +but resolves to `ns.foo` via TDNR. + +``` ucm +scratch/main> builtins.mergeio lib.builtins + + Done. +``` + +``` unison +ns.foo : Nat +ns.foo = 42 +``` + +``` ucm :added-by-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`: + + ns.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + ns.foo : Nat +``` + +``` unison +file.foo : Text +file.foo = "foo" + +bar : Text +bar = foo ++ "bar" +``` + +``` ucm :added-by-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`: + + bar : Text + file.foo : Text +``` + +``` ucm +scratch/main> project.delete scratch +``` + +# Example 4 + +We have a namespace term `ns.foo : Nat` and a file term `file.foo : Text`. A reference to the term `foo` is ambiguous, +but resolves to `file.foo` via TDNR. + +``` ucm +scratch/main> builtins.mergeio lib.builtins + + Done. +``` + +``` unison +ns.foo : Nat +ns.foo = 42 +``` + +``` ucm :added-by-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`: + + ns.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + ns.foo : Nat +``` + +``` unison +file.foo : Text +file.foo = "foo" + +bar : Nat +bar = foo + 42 +``` + +``` ucm :added-by-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`: + + bar : Nat + file.foo : Text +``` + +``` ucm +scratch/main> project.delete scratch +``` + +# Example 4 + +We have a namespace term `ns.foo : Nat` and a file term `file.foo : Nat`. A reference to the term `foo` is ambiguous. +A reference to `ns.foo` or `file.foo` work fine. + +``` ucm +scratch/main> builtins.mergeio lib.builtins + + Done. +``` + +``` unison +ns.foo : Nat +ns.foo = 42 +``` + +``` ucm :added-by-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`: + + ns.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + ns.foo : Nat +``` + +``` unison :error +file.foo : Nat +file.foo = 43 + +bar : Nat +bar = foo + 10 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I couldn't figure out what foo refers to here: + + 5 | bar = foo + 10 + + The name foo is ambiguous. Its type should be: Nat + + I found some terms in scope that have matching names and + types. Maybe you meant one of these: + + file.foo : Nat + ns.foo : Nat +``` + +``` unison +file.foo : Nat +file.foo = 43 + +bar : Nat +bar = file.foo + ns.foo +``` + +``` ucm :added-by-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`: + + bar : Nat + file.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bar : Nat + file.foo : Nat + +scratch/main> view bar + + bar : Nat + bar = + use Nat + + file.foo + ns.foo +``` + +``` ucm +scratch/main> project.delete scratch +``` diff --git a/unison-src/transcripts/idempotent/name-segment-escape.md b/unison-src/transcripts/idempotent/name-segment-escape.md new file mode 100644 index 0000000000..4df8f773a9 --- /dev/null +++ b/unison-src/transcripts/idempotent/name-segment-escape.md @@ -0,0 +1,37 @@ +You can use a keyword or reserved operator as a name segment if you surround it with backticks. + +``` ucm :error +scratch/main> view `match` + + ⚠️ + + The following names were not found in the codebase. Check your spelling. + `match` + +scratch/main> view `=` + + ⚠️ + + The following names were not found in the codebase. Check your spelling. + `=` +``` + +You can also use backticks to expand the set of valid symbols in a symboly name segment to include these three: `.()` + +This allows you to spell `.` or `()` as name segments (which historically have appeared in the namespace). + +``` ucm :error +scratch/main> view `.` + + ⚠️ + + The following names were not found in the codebase. Check your spelling. + `.` + +scratch/main> view `()` + + ⚠️ + + The following names were not found in the codebase. Check your spelling. + `()` +``` diff --git a/unison-src/transcripts/idempotent/name-selection.md b/unison-src/transcripts/idempotent/name-selection.md new file mode 100644 index 0000000000..bc89c80b6b --- /dev/null +++ b/unison-src/transcripts/idempotent/name-selection.md @@ -0,0 +1,206 @@ +This transcript shows how the pretty-printer picks names for a hash when multiple are available. The algorithm is: + +1. Names that are "name-only" come before names that are hash qualified. So `List.map` comes before `List.map#2384a` and also `aaaa#xyz`. +2. Shorter names (in terms of segment count) come before longer ones, for instance `base.List.map` comes before `somelibrary.external.base.List.map`. +3. Otherwise if there are multiple names with a minimal number of segments, compare the names alphabetically. + +``` ucm :hide +scratch/main> builtins.merge lib.builtins + +scratch/biasing> builtins.merge lib.builtins +``` + +``` unison :hide +a.a = a.b + 1 +a.b = 0 + 1 +a.aaa.but.more.segments = 0 + 1 +``` + +Will add `a` and `b` to the codebase and give `b` a longer (in terms of segment length alias), and show that it isn't used when viewing `a`: + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + a.a : Nat + a.aaa.but.more.segments : Nat + a.b : Nat + +scratch/main> view a.a + + a.a : Nat + a.a = + use Nat + + b + 1 +``` + +Next let's introduce a conflicting symbol and show that its hash qualified name isn't used when it has an unconflicted name: + +``` unison :hide +a2.a = a2.b + 1 +a2.b = 0 + 1 +a2.aaa.but.more.segments = 0 + 1 +a2.c = 1 +a2.d = a2.c + 10 +a2.long.name.but.shortest.suffixification = 1 + +a3.a = a3.b + 1 +a3.b = 0 + 1 +a3.aaa.but.more.segments = 0 + 1 +a3.c = 2 +a3.d = a3.c + 10 +a3.long.name.but.shortest.suffixification = 1 +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + a2.a : Nat + (also named a.a) + a2.aaa.but.more.segments : Nat + (also named a.b and a.aaa.but.more.segments) + a2.b : Nat + (also named a.b and a.aaa.but.more.segments) + a2.c : Nat + a2.d : Nat + a2.long.name.but.shortest.suffixification : Nat + a3.a : Nat + (also named a.a) + a3.aaa.but.more.segments : Nat + (also named a.b and a.aaa.but.more.segments) + a3.b : Nat + (also named a.b and a.aaa.but.more.segments) + a3.c : Nat + a3.d : Nat + a3.long.name.but.shortest.suffixification : Nat + +scratch/main> debug.alias.term.force a2.c a3.c + + Done. + +scratch/main> debug.alias.term.force a2.d a3.d + + Done. +``` + +At this point, `a3` is conflicted for symbols `c` and `d`, so those are deprioritized. +The original `a2` namespace has an unconflicted definition for `c` and `d`, but since there are multiple 'c's in scope, +`a2.c` is chosen because although the suffixified version has fewer segments, its fully-qualified name has the fewest segments. + +``` ucm +scratch/main> view a b c d + + a.a : Nat + a.a = + use Nat + + b + 1 + + a.b : Nat + a.b = + use Nat + + 0 + 1 + + a2.c : Nat + a2.c = 1 + + a2.d : Nat + a2.d = + use Nat + + a2.c + 10 + + a3.c#dcgdua2lj6 : Nat + a3.c#dcgdua2lj6 = 2 + + a3.d#9ivhgvhthc : Nat + a3.d#9ivhgvhthc = + use Nat + + c#dcgdua2lj6 + 10 +``` + +## Name biasing + +``` unison +deeply.nested.term = + a + 1 + +deeply.nested.num = 10 + +a = 10 +``` + +``` ucm :added-by-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`: + + a : Nat + deeply.nested.num : Nat + deeply.nested.term : Nat +``` + +``` ucm +scratch/biasing> add + + ⍟ I've added these definitions: + + a : Nat + deeply.nested.num : Nat + deeply.nested.term : Nat + +-- Despite being saved with name `a`, + +-- the pretty printer should prefer the suffixified 'deeply.nested.num name' over the shallow 'a'. + +-- It's closer to the term being printed. + +scratch/biasing> view deeply.nested.term + + deeply.nested.term : Nat + deeply.nested.term = + use Nat + + num + 1 +``` + +Add another term with `num` suffix to force longer suffixification of `deeply.nested.num` + +``` unison +other.num = 20 +``` + +``` ucm :added-by-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`: + + other.num : Nat +``` + +``` ucm +scratch/biasing> add + + ⍟ I've added these definitions: + + other.num : Nat + +-- nested.num should be preferred over the shorter name `a` due to biasing + +-- because `deeply.nested.num` is nearby to the term being viewed. + +scratch/biasing> view deeply.nested.term + + deeply.nested.term : Nat + deeply.nested.term = + use Nat + + nested.num + 1 +``` diff --git a/unison-src/transcripts/idempotent/names.md b/unison-src/transcripts/idempotent/names.md new file mode 100644 index 0000000000..ca74561ba8 --- /dev/null +++ b/unison-src/transcripts/idempotent/names.md @@ -0,0 +1,115 @@ +# `names` command + +``` ucm +scratch/main> builtins.merge lib.builtins + + Done. +``` + +Example uses of the `names` command and output + +``` unison +-- Some names with the same value +some.place.x = 1 +some.otherplace.y = 1 +some.otherplace.x = 10 +somewhere.z = 1 +-- Some similar name with a different value +somewhere.y = 2 +``` + +``` ucm :added-by-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`: + + some.otherplace.x : Nat + some.otherplace.y : Nat + some.place.x : Nat + somewhere.y : Nat + somewhere.z : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + some.otherplace.x : Nat + some.otherplace.y : Nat + some.place.x : Nat + somewhere.y : Nat + somewhere.z : Nat +``` + +`names` searches relative to the current path. + +``` ucm +-- We can search by suffix and find all definitions named 'x', and each of their aliases respectively. + +scratch/main> names x + + Terms + Hash: #gjmq673r1v + Names: some.otherplace.y some.place.x somewhere.z + + Hash: #pi25gcdv0o + Names: some.otherplace.x + +-- We can search by hash, and see all aliases of that hash + +scratch/main> names #gjmq673r1v + + Term + Hash: #gjmq673r1v + Names: some.otherplace.y some.place.x somewhere.z + +-- Works with absolute names too + +scratch/main> names .some.place.x + + Term + Hash: #gjmq673r1v + Names: some.otherplace.y some.place.x somewhere.z +``` + +`debug.names.global` searches from the root, and absolutely qualifies results + +``` ucm +-- We can search from a different branch and find all names in the codebase named 'x', and each of their aliases respectively. + +scratch/other> debug.names.global x + + Found results in scratch/main + + Terms + Hash: #gjmq673r1v + Names: some.otherplace.y some.place.x somewhere.z + + Hash: #pi25gcdv0o + Names: some.otherplace.x + +-- We can search by hash, and see all aliases of that hash in the codebase + +scratch/other> debug.names.global #gjmq673r1v + + Found results in scratch/main + + Term + Hash: #gjmq673r1v + Names: some.otherplace.y some.place.x somewhere.z + +-- We can search using an absolute name + +scratch/other> debug.names.global .some.place.x + + Found results in scratch/main + + Term + Hash: #gjmq673r1v + Names: some.otherplace.y some.place.x somewhere.z +``` diff --git a/unison-src/transcripts/namespace-deletion-regression.md b/unison-src/transcripts/idempotent/namespace-deletion-regression.md similarity index 78% rename from unison-src/transcripts/namespace-deletion-regression.md rename to unison-src/transcripts/idempotent/namespace-deletion-regression.md index a1bc14ca3c..86e07b4d48 100644 --- a/unison-src/transcripts/namespace-deletion-regression.md +++ b/unison-src/transcripts/idempotent/namespace-deletion-regression.md @@ -7,10 +7,24 @@ If branch operations aren't performed in the correct order it's possible to end Previously the following sequence delete the current namespace unexpectedly 😬. -```ucm +``` ucm scratch/main> alias.term ##Nat.+ Nat.+ + + Done. + scratch/main> ls Nat + + 1. + (##Nat -> ##Nat -> ##Nat) + scratch/main> move.namespace Nat Nat.operators + + Done. + scratch/main> ls Nat + + 1. operators/ (1 term) + scratch/main> ls Nat.operators + + 1. + (##Nat -> ##Nat -> ##Nat) ``` diff --git a/unison-src/transcripts/idempotent/namespace-dependencies.md b/unison-src/transcripts/idempotent/namespace-dependencies.md new file mode 100644 index 0000000000..672c0b76f6 --- /dev/null +++ b/unison-src/transcripts/idempotent/namespace-dependencies.md @@ -0,0 +1,32 @@ +# namespace.dependencies command + +``` ucm +scratch/main> builtins.merge lib.builtins + + Done. +``` + +``` unison :hide +const a b = a +external.mynat = 1 +mynamespace.dependsOnText = const external.mynat 10 +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + const : a -> b -> a + external.mynat : Nat + mynamespace.dependsOnText : Nat + +scratch/main> namespace.dependencies mynamespace + + External dependency Dependents in scratch/main:.mynamespace + lib.builtins.Nat 1. dependsOnText + + const 1. dependsOnText + + external.mynat 1. dependsOnText +``` diff --git a/unison-src/transcripts/idempotent/namespace-directive.md b/unison-src/transcripts/idempotent/namespace-directive.md new file mode 100644 index 0000000000..f9eabb86c0 --- /dev/null +++ b/unison-src/transcripts/idempotent/namespace-directive.md @@ -0,0 +1,199 @@ +A `namespace foo` directive is optional, and may only appear at the top of a file. + +It affects the contents of the file as follows: + +1. All bindings like `x.y.z` are prefixed with the namespace; note that when this file is saved, the feedback mentions + the full bindings' names. + +``` ucm +scratch/main> builtins.mergeio lib.builtins + + Done. +``` + +``` unison +namespace foo + +baz : Nat +baz = 17 +``` + +``` ucm :added-by-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.baz : Nat +``` + +2. Free variables whose names exactly match bindings in the file are rewritten to refer to the prefixed binder instead. + That is, a term like `factorial = ... factorial ...` is rewritten to `foo.factorial = ... foo.factorial ...`. + +``` unison +namespace foo + +factorial : Int -> Int +factorial = cases + +0 -> +1 + n -> n * factorial (n - +1) + +longer.evil.factorial : Int -> Int +longer.evil.factorial n = n +``` + +``` ucm :added-by-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.factorial : Int -> Int + foo.longer.evil.factorial : Int -> Int +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + foo.factorial : Int -> Int + foo.longer.evil.factorial : Int -> Int + +scratch/main> view factorial + + foo.factorial : Int -> Int + foo.factorial = cases + +0 -> +1 + n -> n Int.* foo.factorial (n Int.- +1) + + foo.longer.evil.factorial : Int -> Int + foo.longer.evil.factorial n = n +``` + +Note that in the above example, we do not want the existence of a `namespace foo` directive to determine whether the +reference to the name `factorial` within the body of `factorial` is a recursive reference (good, behavior without +namespace directive, exact-name-match-wins semantics) or an ambiguous reference (bad, as would be the case if the +bindings were expanded to `foo.factorial` and `foo.longer.evil.factorial`, but the variables left alone). + +Here are a few more examples demonstrating that type names, constructor names, generated record accessor names, and +type links are all properly handled. + +``` unison +type longer.foo.Foo = Bar +type longer.foo.Baz = { qux : Nat } +``` + +``` ucm :added-by-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`: + + type longer.foo.Baz + type longer.foo.Foo + longer.foo.Baz.qux : Baz -> Nat + longer.foo.Baz.qux.modify : (Nat ->{g} Nat) + -> Baz + ->{g} Baz + longer.foo.Baz.qux.set : Nat -> Baz -> Baz +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type longer.foo.Baz + type longer.foo.Foo + longer.foo.Baz.qux : Baz -> Nat + longer.foo.Baz.qux.modify : (Nat ->{g} Nat) -> Baz ->{g} Baz + longer.foo.Baz.qux.set : Nat -> Baz -> Baz +``` + +``` unison +namespace foo + +type Foo = Bar +type Baz = { qux : Nat } + +type RefersToFoo = RefersToFoo Foo + +refersToBar = cases + Foo.Bar -> 17 + +refersToQux baz = + Baz.qux baz + Baz.qux baz + +hasTypeLink = + {{ {type Foo} }} +``` + +``` ucm :added-by-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`: + + type foo.Baz + type foo.Foo + type foo.RefersToFoo + foo.Baz.qux : foo.Baz -> Nat + foo.Baz.qux.modify : (Nat ->{g} Nat) + -> foo.Baz + ->{g} foo.Baz + foo.Baz.qux.set : Nat -> foo.Baz -> foo.Baz + foo.hasTypeLink : Doc2 + foo.refersToBar : foo.Foo -> Nat + foo.refersToQux : foo.Baz -> Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type foo.Baz + type foo.Foo + type foo.RefersToFoo + foo.Baz.qux : foo.Baz -> Nat + foo.Baz.qux.modify : (Nat ->{g} Nat) + -> foo.Baz + ->{g} foo.Baz + foo.Baz.qux.set : Nat -> foo.Baz -> foo.Baz + foo.hasTypeLink : Doc2 + foo.refersToBar : foo.Foo -> Nat + foo.refersToQux : foo.Baz -> Nat + +scratch/main> view RefersToFoo refersToBar refersToQux hasTypeLink + + type foo.RefersToFoo = RefersToFoo foo.Foo + + foo.hasTypeLink : Doc2 + foo.hasTypeLink = {{ {type foo.Foo} }} + + foo.refersToBar : foo.Foo -> Nat + foo.refersToBar = cases foo.Foo.Bar -> 17 + + foo.refersToQux : foo.Baz -> Nat + foo.refersToQux baz = + use Nat + + use foo.Baz qux + qux baz + qux baz + +scratch/main> todo + + You have no pending todo items. Good work! ✅ +``` diff --git a/unison-src/transcripts/idempotent/numbered-args.md b/unison-src/transcripts/idempotent/numbered-args.md new file mode 100644 index 0000000000..1b6166f0d4 --- /dev/null +++ b/unison-src/transcripts/idempotent/numbered-args.md @@ -0,0 +1,164 @@ +# Using numbered arguments in UCM + +``` ucm :hide +scratch/main> alias.type ##Text Text +``` + +First lets add some contents to our codebase. + +``` unison +foo = "foo" +bar = "bar" +baz = "baz" +qux = "qux" +quux = "quux" +corge = "corge" +``` + +``` ucm :added-by-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`: + + bar : Text + baz : Text + corge : Text + foo : Text + quux : Text + qux : Text +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bar : Text + baz : Text + corge : Text + foo : Text + quux : Text + qux : Text +``` + +We can get the list of things in the namespace, and UCM will give us a numbered +list: + +``` ucm +scratch/main> find + + 1. bar : Text + 2. baz : Text + 3. corge : Text + 4. foo : Text + 5. quux : Text + 6. qux : Text + 7. builtin type Text +``` + +We can ask to `view` the second element of this list: + +``` ucm +scratch/main> find + + 1. bar : Text + 2. baz : Text + 3. corge : Text + 4. foo : Text + 5. quux : Text + 6. qux : Text + 7. builtin type Text + +scratch/main> view 2 + + baz : Text + baz = "baz" +``` + +And we can `view` multiple elements by separating with spaces: + +``` ucm +scratch/main> find + + 1. bar : Text + 2. baz : Text + 3. corge : Text + 4. foo : Text + 5. quux : Text + 6. qux : Text + 7. builtin type Text + +scratch/main> view 2 3 5 + + baz : Text + baz = "baz" + + corge : Text + corge = "corge" + + quux : Text + quux = "quux" +``` + +We can also ask for a range: + +``` ucm +scratch/main> find + + 1. bar : Text + 2. baz : Text + 3. corge : Text + 4. foo : Text + 5. quux : Text + 6. qux : Text + 7. builtin type Text + +scratch/main> view 2-4 + + baz : Text + baz = "baz" + + corge : Text + corge = "corge" + + foo : Text + foo = "foo" +``` + +And we can ask for multiple ranges and use mix of ranges and numbers: + +``` ucm +scratch/main> find + + 1. bar : Text + 2. baz : Text + 3. corge : Text + 4. foo : Text + 5. quux : Text + 6. qux : Text + 7. builtin type Text + +scratch/main> view 1-3 4 5-6 + + bar : Text + bar = "bar" + + baz : Text + baz = "baz" + + corge : Text + corge = "corge" + + foo : Text + foo = "foo" + + quux : Text + quux = "quux" + + qux : Text + qux = "qux" +``` diff --git a/unison-src/transcripts/idempotent/old-fold-right.md b/unison-src/transcripts/idempotent/old-fold-right.md new file mode 100644 index 0000000000..fe321cb955 --- /dev/null +++ b/unison-src/transcripts/idempotent/old-fold-right.md @@ -0,0 +1,29 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +oldRight: (b ->{e} a ->{e} b) -> [a] ->{e} [b] +oldRight f la = bug "out" + +pecan: '{} [Text] +pecan = 'let + la = [1, 2, 3] + f: Text -> Nat -> Text + f = bug "out" + + oldRight f la +``` + +``` ucm :added-by-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`: + + oldRight : (b ->{e} a ->{e} b) -> [a] ->{e} [b] + pecan : '[Text] +``` diff --git a/unison-src/transcripts/idempotent/pattern-match-coverage.md b/unison-src/transcripts/idempotent/pattern-match-coverage.md new file mode 100644 index 0000000000..90bf569876 --- /dev/null +++ b/unison-src/transcripts/idempotent/pattern-match-coverage.md @@ -0,0 +1,1290 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +# Basics + +## non-exhaustive patterns + +``` unison :error +unique type T = A | B | C + +test : T -> () +test = cases + A -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Pattern match doesn't cover all possible cases: + 4 | test = cases + 5 | A -> () + + + Patterns not matched: + + * B + * C +``` + +``` unison :error +unique type T = A | B + +test : (T, Optional T) -> () +test = cases + (A, Some _) -> () + (A, None) -> () + (B, Some A) -> () + (B, None) -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Pattern match doesn't cover all possible cases: + 4 | test = cases + 5 | (A, Some _) -> () + 6 | (A, None) -> () + 7 | (B, Some A) -> () + 8 | (B, None) -> () + + + Patterns not matched: + * (B, Some B) +``` + +## redundant patterns + +``` unison :error +unique type T = A | B | C + +test : T -> () +test = cases + A -> () + B -> () + C -> () + _ -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This case would be ignored because it's already covered by the preceding case(s): + 8 | _ -> () + +``` + +``` unison :error +unique type T = A | B + +test : (T, Optional T) -> () +test = cases + (A, Some _) -> () + (A, None) -> () + (B, Some _) -> () + (B, None) -> () + (A, Some A) -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This case would be ignored because it's already covered by the preceding case(s): + 9 | (A, Some A) -> () + +``` + +# Uninhabited patterns + +match is complete without covering uninhabited patterns + +``` unison +unique type V = + +test : Optional (Optional V) -> () +test = cases + None -> () + Some None -> () +``` + +``` ucm :added-by-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`: + + type V + test : Optional (Optional V) -> () +``` + +uninhabited patterns are reported as redundant + +``` unison :error +unique type V = + +test0 : V -> () +test0 = cases + _ -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This case would be ignored because it's already covered by the preceding case(s): + 5 | _ -> () + +``` + +``` unison :error +unique type V = + +test : Optional (Optional V) -> () +test = cases + None -> () + Some None -> () + Some _ -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This case would be ignored because it's already covered by the preceding case(s): + 7 | Some _ -> () + +``` + +# Guards + +## Incomplete patterns due to guards should be reported + +``` unison :error +test : () -> () +test = cases + () | false -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Pattern match doesn't cover all possible cases: + 2 | test = cases + 3 | () | false -> () + + + Patterns not matched: + * () +``` + +``` unison :error +test : Optional Nat -> Nat +test = cases + None -> 0 + Some x + | isEven x -> x +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Pattern match doesn't cover all possible cases: + 2 | test = cases + 3 | None -> 0 + 4 | Some x + 5 | | isEven x -> x + + + Patterns not matched: + * Some _ +``` + +## Complete patterns with guards should be accepted + +``` unison :error +test : Optional Nat -> Nat +test = cases + None -> 0 + Some x + | isEven x -> x + | otherwise -> 0 +``` + +``` ucm :added-by-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`: + + test : Optional Nat -> Nat +``` + +# Pattern instantiation depth + +Uncovered patterns are only instantiated as deeply as necessary to +distinguish them from existing patterns. + +``` unison :error +unique type T = A | B | C + +test : Optional (Optional T) -> () +test = cases + None -> () + Some None -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Pattern match doesn't cover all possible cases: + 4 | test = cases + 5 | None -> () + 6 | Some None -> () + + + Patterns not matched: + * Some (Some _) +``` + +``` unison :error +unique type T = A | B | C + +test : Optional (Optional T) -> () +test = cases + None -> () + Some None -> () + Some (Some A) -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Pattern match doesn't cover all possible cases: + 4 | test = cases + 5 | None -> () + 6 | Some None -> () + 7 | Some (Some A) -> () + + + Patterns not matched: + + * Some (Some B) + * Some (Some C) +``` + +# Literals + +## Non-exhaustive + +Nat + +``` unison :error +test : Nat -> () +test = cases + 0 -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Pattern match doesn't cover all possible cases: + 2 | test = cases + 3 | 0 -> () + + + Patterns not matched: + * _ +``` + +Boolean + +``` unison :error +test : Boolean -> () +test = cases + true -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Pattern match doesn't cover all possible cases: + 2 | test = cases + 3 | true -> () + + + Patterns not matched: + * false +``` + +## Exhaustive + +Nat + +``` unison +test : Nat -> () +test = cases + 0 -> () + _ -> () +``` + +``` ucm :added-by-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`: + + test : Nat -> () +``` + +Boolean + +``` unison +test : Boolean -> () +test = cases + true -> () + false -> () +``` + +``` ucm :added-by-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`: + + test : Boolean -> () +``` + +# Redundant + +Nat + +``` unison :error +test : Nat -> () +test = cases + 0 -> () + 0 -> () + _ -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This case would be ignored because it's already covered by the preceding case(s): + 4 | 0 -> () + +``` + +Boolean + +``` unison :error +test : Boolean -> () +test = cases + true -> () + false -> () + _ -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This case would be ignored because it's already covered by the preceding case(s): + 5 | _ -> () + +``` + +# Sequences + +## Exhaustive + +``` unison +test : [()] -> () +test = cases + [] -> () + x +: xs -> () +``` + +``` ucm :added-by-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`: + + test : [()] -> () +``` + +## Non-exhaustive + +``` unison :error +test : [()] -> () +test = cases + [] -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Pattern match doesn't cover all possible cases: + 2 | test = cases + 3 | [] -> () + + + Patterns not matched: + * (() +: _) +``` + +``` unison :error +test : [()] -> () +test = cases + x +: xs -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Pattern match doesn't cover all possible cases: + 2 | test = cases + 3 | x +: xs -> () + + + Patterns not matched: + * [] +``` + +``` unison :error +test : [()] -> () +test = cases + xs :+ x -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Pattern match doesn't cover all possible cases: + 2 | test = cases + 3 | xs :+ x -> () + + + Patterns not matched: + * [] +``` + +``` unison :error +test : [()] -> () +test = cases + x0 +: (x1 +: xs) -> () + [] -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Pattern match doesn't cover all possible cases: + 2 | test = cases + 3 | x0 +: (x1 +: xs) -> () + 4 | [] -> () + + + Patterns not matched: + * (() +: []) +``` + +``` unison :error +test : [()] -> () +test = cases + [] -> () + x0 +: [] -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Pattern match doesn't cover all possible cases: + 2 | test = cases + 3 | [] -> () + 4 | x0 +: [] -> () + + + Patterns not matched: + * (() +: (() +: _)) +``` + +## Uninhabited + +`Cons` is not expected since `V` is uninhabited + +``` unison +unique type V = + +test : [V] -> () +test = cases + [] -> () +``` + +``` ucm :added-by-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`: + + type V + test : [V] -> () +``` + +## Length restrictions can equate cons and nil patterns + +Here the first pattern matches lists of length two or greater, the +second pattern matches lists of length 0. The third case matches when the +final element is `false`, while the fourth pattern matches when the +first element is `true`. However, the only possible list length at +the third or fourth clause is 1, so the first and final element must +be equal. Thus, the pattern match is exhaustive. + +``` unison +test : [Boolean] -> () +test = cases + [a, b] ++ xs -> () + [] -> () + xs :+ false -> () + true +: xs -> () +``` + +``` ucm :added-by-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`: + + test : [Boolean] -> () +``` + +This is the same idea as above but shows that fourth match is redundant. + +``` unison :error +test : [Boolean] -> () +test = cases + [a, b] ++ xs -> () + [] -> () + xs :+ true -> () + true +: xs -> () + _ -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This case would be ignored because it's already covered by the preceding case(s): + 6 | true +: xs -> () + +``` + +This is another similar example. The first pattern matches lists of +length 5 or greater. The second matches lists of length 4 or greater where the +first and third element are true. The third matches lists of length 4 +or greater where the final 4 elements are `true, false, true, false`. +The list must be exactly of length 4 to arrive at the second or third +clause, so the third pattern is redundant. + +``` unison :error +test : [Boolean] -> () +test = cases + [a, b, c, d, f] ++ xs -> () + [true, _, true, _] ++ _ -> () + _ ++ [true, false, true, false] -> () + _ -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This case would be ignored because it's already covered by the preceding case(s): + 5 | _ ++ [true, false, true, false] -> () + +``` + +# bugfix: Sufficient data decl map + +``` unison +unique type T = A + +unit2t : Unit -> T +unit2t = cases + () -> A +``` + +``` ucm :added-by-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`: + + type T + unit2t : 'T +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type T + unit2t : 'T +``` + +Pattern coverage checking needs the data decl map to contain all +transitive type dependencies of the scrutinee type. We do this +before typechecking begins in a roundabout way: fetching all +transitive type dependencies of references that appear in the expression. + +This test ensures that we have fetched the `T` type although there is +no data decl reference to `T` in `witht`. + +``` unison +witht : Unit +witht = match unit2t () with + x -> () +``` + +``` ucm :added-by-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`: + + witht : () +``` + +``` unison +unique type V = + +evil : Unit -> V +evil = bug "" +``` + +``` ucm :added-by-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`: + + type V + evil : 'V +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type V + evil : 'V +``` + +``` unison :error +withV : Unit +withV = match evil () with + x -> () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This case would be ignored because it's already covered by the preceding case(s): + 3 | x -> () + +``` + +``` unison +unique type SomeType = A +``` + +``` ucm :added-by-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`: + + type SomeType +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type SomeType +``` + +``` unison +unique type R = R SomeType + +get x = match x with + R y -> y +``` + +``` ucm :added-by-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`: + + type R + get : R -> SomeType +``` + +``` unison +unique type R = { someType : SomeType } +``` + +``` ucm :added-by-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`: + + type R + R.someType : R -> SomeType + R.someType.modify : (SomeType ->{g} SomeType) -> R ->{g} R + R.someType.set : SomeType -> R -> R +``` + +# Ability handlers + +## Exhaustive ability handlers are accepted + +``` unison +structural ability Abort where + abort : {Abort} a + + +result : '{e, Abort} a -> {e} a +result f = handle !f with cases + { x } -> x + { abort -> _ } -> bug "aborted" +``` + +``` ucm :added-by-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`: + + structural ability Abort + result : '{e, Abort} a ->{e} a +``` + +``` unison +structural ability Abort where + abort : {Abort} a + +unique type T = A | B + +result : '{e, Abort} T -> {e} () +result f = handle !f with cases + { T.A } -> () + { B } -> () + { abort -> _ } -> bug "aborted" +``` + +``` ucm :added-by-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`: + + structural ability Abort + result : '{e, Abort} T ->{e} () + + ⍟ These names already exist. You can `update` them to your + new definition: + + type T +``` + +``` unison +structural ability Abort where + abort : {Abort} a + +result : '{e, Abort} V -> {e} V +result f = + impl : Request {Abort} V -> V + impl = cases + { abort -> _ } -> bug "aborted" + handle !f with impl +``` + +``` ucm :added-by-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`: + + structural ability Abort + result : '{e, Abort} V ->{e} V +``` + +``` unison +structural ability Abort where + abort : {Abort} a + +structural ability Stream a where + emit : a -> {Stream a} Unit + +handleMulti : '{Stream a, Abort} r -> (Optional r, [a]) +handleMulti c = + impl xs = cases + { r } -> (Some r, xs) + { emit x -> resume } -> handle !resume with impl (xs :+ x) + { abort -> _ } -> (None, xs) + handle !c with impl [] +``` + +``` ucm :added-by-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`: + + structural ability Abort + structural ability Stream a + handleMulti : '{Abort, Stream a} r -> (Optional r, [a]) +``` + +## Non-exhaustive ability handlers are rejected + +``` unison :error +structural ability Abort where + abort : {Abort} a + abortWithMessage : Text -> {Abort} a + + +result : '{e, Abort} a -> {e} a +result f = handle !f with cases + { abort -> _ } -> bug "aborted" +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Pattern match doesn't cover all possible cases: + 7 | result f = handle !f with cases + 8 | { abort -> _ } -> bug "aborted" + + + Patterns not matched: + + * { _ } + * { abortWithMessage _ -> _ } +``` + +``` unison :error +structural ability Abort where + abort : {Abort} a + +unique type T = A | B + +result : '{e, Abort} T -> {e} () +result f = handle !f with cases + { T.A } -> () + { abort -> _ } -> bug "aborted" +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Pattern match doesn't cover all possible cases: + 7 | result f = handle !f with cases + 8 | { T.A } -> () + 9 | { abort -> _ } -> bug "aborted" + + + Patterns not matched: + * { B } +``` + +``` unison :error +unique ability Give a where + give : a -> {Give a} Unit + +unique type T = A | B + +result : '{e, Give T} r -> {e} r +result f = handle !f with cases + { x } -> x + { give T.A -> resume } -> result resume +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Pattern match doesn't cover all possible cases: + 7 | result f = handle !f with cases + 8 | { x } -> x + 9 | { give T.A -> resume } -> result resume + + + Patterns not matched: + * { give B -> _ } +``` + +``` unison :error +structural ability Abort where + abort : {Abort} a + +structural ability Stream a where + emit : a -> {Stream a} Unit + +handleMulti : '{Stream a, Abort} r -> (Optional r, [a]) +handleMulti c = + impl : [a] -> Request {Stream a, Abort} r -> (Optional r, [a]) + impl xs = cases + { r } -> (Some r, xs) + { emit x -> resume } -> handle !resume with impl (xs :+ x) + handle !c with impl [] +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Pattern match doesn't cover all possible cases: + 10 | impl xs = cases + 11 | { r } -> (Some r, xs) + 12 | { emit x -> resume } -> handle !resume with impl (xs :+ x) + + + Patterns not matched: + * { abort -> _ } +``` + +## Redundant handler cases are rejected + +``` unison :error +unique ability Give a where + give : a -> {Give a} Unit + +unique type T = A | B + +result : '{e, Give T} r -> {e} r +result f = handle !f with cases + { x } -> x + { give _ -> resume } -> result resume + { give T.A -> resume } -> result resume +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This case would be ignored because it's already covered by the preceding case(s): + 10 | { give T.A -> resume } -> result resume + +``` + +## Exhaustive ability reinterpretations are accepted + +``` unison +structural ability Abort where + abort : {Abort} a + abortWithMessage : Text -> {Abort} a + + +result : '{e, Abort} a -> {e, Abort} a +result f = handle !f with cases + { x } -> x + { abort -> _ } -> abort + { abortWithMessage msg -> _ } -> abortWithMessage ("aborting: " ++ msg) +``` + +``` ucm :added-by-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`: + + structural ability Abort + result : '{e, Abort} a ->{e, Abort} a +``` + +``` unison +structural ability Abort a where + abort : {Abort a} r + abortWithMessage : a -> {Abort a} r + +result : '{e, Abort V} a -> {e, Abort V} a +result f = + impl : Request {Abort V} r -> {Abort V} r + impl = cases + { x } -> x + { abort -> _ } -> abort + handle !f with impl +``` + +``` ucm :added-by-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`: + + structural ability Abort a + result : '{e, Abort V} a ->{e, Abort V} a +``` + +## Non-exhaustive ability reinterpretations are rejected + +``` unison :error +structural ability Abort where + abort : {Abort} a + abortWithMessage : Text -> {Abort} a + + +result : '{e, Abort} a -> {e, Abort} a +result f = handle !f with cases + { x } -> x + { abortWithMessage msg -> _ } -> abortWithMessage ("aborting: " ++ msg) +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Pattern match doesn't cover all possible cases: + 7 | result f = handle !f with cases + 8 | { x } -> x + 9 | { abortWithMessage msg -> _ } -> abortWithMessage ("aborting: " ++ msg) + + + Patterns not matched: + * { abort -> _ } +``` + +## Hacky workaround for uninhabited abilities + +Although all of the constructors of an ability might be uninhabited, +the typechecker requires at least one be specified so that it can +determine that the ability should be discharged. So, the default +pattern match coverage checking behavior of prohibiting covering any +of the cases is problematic. Instead, the pattern match coverage +checker will require that at least one constructor be given, even if +they are all uninhabited. + +The messages here aren't the best, but I don't think uninhabited +abilities will come up and get handlers written for them often. + +``` unison :error +unique ability Give a where + give : a -> {Give a} Unit + give2 : a -> {Give a} Unit + +result : '{e, Give V} r -> {e} r +result f = + impl : Request {Give V} r -> {} r + impl = cases + { x } -> x + handle !f with impl +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + Pattern match doesn't cover all possible cases: + 8 | impl = cases + 9 | { x } -> x + + + Patterns not matched: + + * { give _ -> _ } + * { give2 _ -> _ } +``` + +``` unison +unique ability Give a where + give : a -> {Give a} Unit + give2 : a -> {Give a} Unit + +result : '{e, Give V} r -> {e} r +result f = + impl : Request {Give V} r -> {} r + impl = cases + { x } -> x + { give _ -> resume } -> bug "impossible" + handle !f with impl +``` + +``` ucm :added-by-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`: + + ability Give a + result : '{e, Give V} r ->{e} r +``` + +``` unison +unique ability Give a where + give : a -> {Give a} Unit + give2 : a -> {Give a} Unit + +result : '{e, Give V} r -> {e} r +result f = + impl : Request {Give V} r -> {} r + impl = cases + { x } -> x + { give2 _ -> resume } -> bug "impossible" + handle !f with impl +``` + +``` ucm :added-by-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`: + + ability Give a + result : '{e, Give V} r ->{e} r +``` + +``` unison :error +unique ability Give a where + give : a -> {Give a} Unit + give2 : a -> {Give a} Unit + +result : '{e, Give V} r -> {e} r +result f = + impl : Request {Give V} r -> {} r + impl = cases + { x } -> x + { give _ -> resume } -> bug "impossible" + { give2 _ -> resume } -> bug "impossible" + handle !f with impl +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This case would be ignored because it's already covered by the preceding case(s): + 11 | { give2 _ -> resume } -> bug "impossible" + +``` + +``` unison :error +unique ability GiveA a where + giveA : a -> {GiveA a} Unit + giveA2 : a -> {GiveA a} Unit + +unique ability GiveB a where + giveB : a -> {GiveB a} Unit + giveB2 : a -> {GiveB a} Unit + +result : '{e, GiveA V, GiveB V} r -> {e} r +result f = + impl : Request {GiveA V, GiveB V} r -> {} r + impl = cases + { x } -> x + { giveA _ -> _ } -> bug "impossible" + { giveA2 _ -> _ } -> bug "impossible" + { giveB _ -> _ } -> bug "impossible" + { giveB2 _ -> _ } -> bug "impossible" + handle !f with impl +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + This case would be ignored because it's already covered by the preceding case(s): + 15 | { giveA2 _ -> _ } -> bug "impossible" + +``` + +``` unison +unique ability GiveA a where + giveA : a -> {GiveA a} Unit + giveA2 : a -> {GiveA a} Unit + +unique ability GiveB a where + giveB : a -> {GiveB a} Unit + giveB2 : a -> {GiveB a} Unit + +result : '{e, GiveA V, GiveB V} r -> {e} r +result f = + impl : Request {GiveA V, GiveB V} r -> {} r + impl = cases + { x } -> x + { giveA2 _ -> _ } -> bug "impossible" + { giveB _ -> _ } -> bug "impossible" + handle !f with impl +``` + +``` ucm :added-by-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`: + + ability GiveA a + ability GiveB a + result : '{e, GiveA V, GiveB V} r ->{e} r +``` diff --git a/unison-src/transcripts/idempotent/pattern-pretty-print-2345.md b/unison-src/transcripts/idempotent/pattern-pretty-print-2345.md new file mode 100644 index 0000000000..860329390d --- /dev/null +++ b/unison-src/transcripts/idempotent/pattern-pretty-print-2345.md @@ -0,0 +1,206 @@ +Regression test for https://github.com/unisonweb/unison/pull/2377 + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +structural ability Ab where + a: Nat -> () + +dopey = cases + ?0 -> () + _ -> () + +grumpy = cases + d -> () + +happy = cases + true -> () + false -> () + +sneezy = cases + +1 -> () + _ -> () + +bashful = cases + Some a -> () + _ -> () + +mouthy = cases + [] -> () + _ -> () + +pokey = cases + h +: t -> () + _ -> () + +sleepy = cases + i :+ l -> () + _ -> () + +demure = cases + [0] -> () + _ -> () + +angry = cases + a ++ [] -> () + +tremulous = cases + (0,1) -> () + _ -> () + +throaty = cases + { Ab.a a -> k } -> () + { _ } -> () + +agitated = cases + a | a == 2 -> () + _ -> () + +doc = cases + y@4 -> () + _ -> () +``` + +``` ucm :added-by-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`: + + structural ability Ab + agitated : Nat -> () + angry : [t] -> () + bashful : Optional a -> () + demure : [Nat] -> () + doc : Nat -> () + dopey : Char -> () + grumpy : ff284oqf651 -> () + happy : Boolean -> () + mouthy : [t] -> () + pokey : [t] -> () + sleepy : [t] -> () + sneezy : Int -> () + throaty : Request {g, Ab} x -> () + tremulous : (Nat, Nat) -> () +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural ability Ab + agitated : Nat -> () + angry : [t] -> () + bashful : Optional a -> () + demure : [Nat] -> () + doc : Nat -> () + dopey : Char -> () + grumpy : ff284oqf651 -> () + happy : Boolean -> () + mouthy : [t] -> () + pokey : [t] -> () + sleepy : [t] -> () + sneezy : Int -> () + throaty : Request {g, Ab} x -> () + tremulous : (Nat, Nat) -> () + +scratch/main> view dopey + + dopey : Char -> () + dopey = cases + ?0 -> () + _ -> () + +scratch/main> view grumpy + + grumpy : ff284oqf651 -> () + grumpy = cases d -> () + +scratch/main> view happy + + happy : Boolean -> () + happy = cases + true -> () + false -> () + +scratch/main> view sneezy + + sneezy : Int -> () + sneezy = cases + +1 -> () + _ -> () + +scratch/main> view bashful + + bashful : Optional a -> () + bashful = cases + Some a -> () + _ -> () + +scratch/main> view mouthy + + mouthy : [t] -> () + mouthy = cases + [] -> () + _ -> () + +scratch/main> view pokey + + pokey : [t] -> () + pokey = cases + h +: t -> () + _ -> () + +scratch/main> view sleepy + + sleepy : [t] -> () + sleepy = cases + i :+ l -> () + _ -> () + +scratch/main> view demure + + demure : [Nat] -> () + demure = cases + [0] -> () + _ -> () + +scratch/main> view angry + + angry : [t] -> () + angry = cases a ++ [] -> () + +scratch/main> view tremulous + + tremulous : (Nat, Nat) -> () + tremulous = cases + (0, 1) -> () + _ -> () + +scratch/main> view throaty + + throaty : Request {g, Ab} x -> () + throaty = cases + { Ab.a a -> k } -> () + { _ } -> () + +scratch/main> view agitated + + agitated : Nat -> () + agitated = cases + a | a == 2 -> () + _ -> () + +scratch/main> view doc + + doc : Nat -> () + doc = cases + y@4 -> () + _ -> () +``` diff --git a/unison-src/transcripts/idempotent/patternMatchTls.md b/unison-src/transcripts/idempotent/patternMatchTls.md new file mode 100644 index 0000000000..fc6517f872 --- /dev/null +++ b/unison-src/transcripts/idempotent/patternMatchTls.md @@ -0,0 +1,51 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +We had bugs in the calling conventions for both send and terminate which would +cause pattern matching on the resulting (Right ()) would cause a runtime error. + +``` unison +use builtin.io2.Tls newClient send handshake terminate + +frank: '{IO} () +frank = do + socket = assertRight (clientSocket.impl "example.com" "443") + config = ClientConfig.default "example.com" 0xs + tls = assertRight (newClient.impl config socket) + () = assertRight (handshake.impl tls) + () = assertRight (send.impl tls 0xs) + () = assertRight (terminate.impl tls) + () + +assertRight : Either a b -> b +assertRight = cases + Right x -> x + Left _ -> bug "expected a right but got a left" +``` + +``` ucm :added-by-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`: + + assertRight : Either a b -> b + frank : '{IO} () +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + assertRight : Either a b -> b + frank : '{IO} () + +scratch/main> run frank + + () +``` diff --git a/unison-src/transcripts/idempotent/patterns.md b/unison-src/transcripts/idempotent/patterns.md new file mode 100644 index 0000000000..1baa09fdda --- /dev/null +++ b/unison-src/transcripts/idempotent/patterns.md @@ -0,0 +1,35 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +Some tests of pattern behavior. + +``` unison +p1 = join [literal "blue", literal "frog"] + +> Pattern.run (many p1) "bluefrogbluegoat" +> Pattern.run (many.corrected p1) "bluefrogbluegoat" +``` + +``` ucm :added-by-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`: + + p1 : Pattern Text + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 3 | > Pattern.run (many p1) "bluefrogbluegoat" + ⧩ + Some ([], "goat") + + 4 | > Pattern.run (many.corrected p1) "bluefrogbluegoat" + ⧩ + Some ([], "bluegoat") +``` diff --git a/unison-src/transcripts/idempotent/propagate.md b/unison-src/transcripts/idempotent/propagate.md new file mode 100644 index 0000000000..c2861e3bb0 --- /dev/null +++ b/unison-src/transcripts/idempotent/propagate.md @@ -0,0 +1,175 @@ +# Propagating type edits + +``` ucm :hide +scratch/main> builtins.merge lib.builtins +``` + +We introduce a type `Foo` with a function dependent `fooToInt`. + +``` unison +unique type Foo = Foo + +fooToInt : Foo -> Int +fooToInt _ = +42 +``` + +``` ucm :added-by-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`: + + type Foo + fooToInt : Foo -> Int +``` + +And then we add it. + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + fooToInt : Foo -> Int + +scratch/main> find.verbose + + 1. -- #uj8oalgadr2f52qloufah6t8vsvbc76oqijkotek87vooih7aqu44k20hrs34kartusapghp4jmfv6g1409peklv3r6a527qpk52soo + type Foo + + 2. -- #uj8oalgadr2f52qloufah6t8vsvbc76oqijkotek87vooih7aqu44k20hrs34kartusapghp4jmfv6g1409peklv3r6a527qpk52soo#0 + Foo.Foo : Foo + + 3. -- #j6hbm1gc2ak4f46b6705q90ld4bmhoi8etq2q45j081i9jgn95fvk3p6tjg67e7sm0021035i8qikmk4p6k845l5d00u26cos5731to + fooToInt : Foo -> Int + + +scratch/main> view fooToInt + + fooToInt : Foo -> Int + fooToInt _ = +42 +``` + +Then if we change the type `Foo`... + +``` unison +unique type Foo = Foo | Bar +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + type Foo +``` + +and update the codebase to use the new type `Foo`... + +``` ucm +scratch/main> update.old + + ⍟ I've updated these names to your new definition: + + type Foo +``` + +... it should automatically propagate the type to `fooToInt`. + +``` ucm +scratch/main> view fooToInt + + fooToInt : Foo -> Int + fooToInt _ = +42 +``` + +### Preserving user type variables + +We make a term that has a dependency on another term and also a non-redundant +user-provided type signature. + +``` unison +preserve.someTerm : Optional foo -> Optional foo +preserve.someTerm x = x + +preserve.otherTerm : Optional baz -> Optional baz +preserve.otherTerm y = someTerm y +``` + +``` ucm :added-by-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`: + + preserve.otherTerm : Optional baz -> Optional baz + preserve.someTerm : Optional foo -> Optional foo +``` + +Add that to the codebase: + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + preserve.otherTerm : Optional baz -> Optional baz + preserve.someTerm : Optional foo -> Optional foo +``` + +Let's now edit the dependency: + +``` unison +preserve.someTerm : Optional x -> Optional x +preserve.someTerm _ = None +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + preserve.someTerm : Optional x -> Optional x +``` + +Update... + +``` ucm +scratch/main> update.old + + ⍟ I've updated these names to your new definition: + + preserve.someTerm : Optional x -> Optional x +``` + +Now the type of `someTerm` should be `Optional x -> Optional x` and the +type of `otherTerm` should remain the same. + +``` ucm +scratch/main> view preserve.someTerm + + preserve.someTerm : Optional x -> Optional x + preserve.someTerm _ = None + +scratch/main> view preserve.otherTerm + + preserve.otherTerm : Optional baz -> Optional baz + preserve.otherTerm y = someTerm y +``` diff --git a/unison-src/transcripts/idempotent/pull-errors.md b/unison-src/transcripts/idempotent/pull-errors.md new file mode 100644 index 0000000000..bb1746e231 --- /dev/null +++ b/unison-src/transcripts/idempotent/pull-errors.md @@ -0,0 +1,42 @@ +``` ucm :error +test/main> pull @aryairani/test-almost-empty/main lib.base_latest + + The use of `pull` to install libraries is now deprecated. + Going forward, you can use + `lib.install @aryairani/test-almost-empty/main`. + + Downloaded 2 entities. + + I installed @aryairani/test-almost-empty/main as + aryairani_test_almost_empty_main. + +test/main> pull @aryairani/test-almost-empty/main a.b + + ⚠️ + + Sorry, I wasn’t sure how to process your request: + + I think you want to merge @aryairani/test-almost-empty/main + into the a.b namespace, but the `pull` command only supports + merging into the top level of a local project branch. + + You can run `help pull` for more information on using `pull`. + +test/main> pull @aryairani/test-almost-empty/main a + + I think you want to merge @aryairani/test-almost-empty/main + into the a branch, but it doesn't exist. If you want, you can + create it with `branch.empty a`, and then `pull` again. + +test/main> pull @aryairani/test-almost-empty/main .a + + ⚠️ + + Sorry, I wasn’t sure how to process your request: + + I think you want to merge @aryairani/test-almost-empty/main + into the .a namespace, but the `pull` command only supports + merging into the top level of a local project branch. + + You can run `help pull` for more information on using `pull`. +``` diff --git a/unison-src/transcripts/idempotent/records.md b/unison-src/transcripts/idempotent/records.md new file mode 100644 index 0000000000..40ab77e278 --- /dev/null +++ b/unison-src/transcripts/idempotent/records.md @@ -0,0 +1,205 @@ +Ensure that Records keep their syntax after being added to the codebase + +``` ucm :hide +scratch/main> builtins.merge + +scratch/main> load unison-src/transcripts-using-base/base.u +``` + +## Record with 1 field + +``` unison :hide +unique type Record1 = { a : Text } +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> view Record1 + + type Record1 = { a : Text } +``` + +## Record with 2 fields + +``` unison :hide +unique type Record2 = { a : Text, b : Int } +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> view Record2 + + type Record2 = { a : Text, b : Int } +``` + +## Record with 3 fields + +``` unison :hide +unique type Record3 = { a : Text, b : Int, c : Nat } +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> view Record3 + + type Record3 = { a : Text, b : Int, c : Nat } +``` + +## Record with many fields + +``` unison :hide +unique type Record4 = + { a : Text + , b : Int + , c : Nat + , d : Bytes + , e : Text + , f : Nat + , g : [Nat] + } +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> view Record4 + + type Record4 + = { a : Text, + b : Int, + c : Nat, + d : Bytes, + e : Text, + f : Nat, + g : [Nat] } +``` + +## Record with many many fields + +``` unison :hide +unique type Record5 = { + zero : Nat, + one : [Nat], + two : [[Nat]], + three: [[[Nat]]], + four: [[[[Nat]]]], + five: [[[[[Nat]]]]], + six: [[[[[[Nat]]]]]], + seven: [[[[[[[Nat]]]]]]], + eight: [[[[[[[[Nat]]]]]]]], + nine: [[[[[[[[[Nat]]]]]]]]], + ten: [[[[[[[[[[Nat]]]]]]]]]], + eleven: [[[[[[[[[[[Nat]]]]]]]]]]], + twelve: [[[[[[[[[[[[Nat]]]]]]]]]]]], + thirteen: [[[[[[[[[[[[[Nat]]]]]]]]]]]]], + fourteen: [[[[[[[[[[[[[[Nat]]]]]]]]]]]]]], + fifteen: [[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]], + sixteen: [[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]], + seventeen: [[[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]]], + eighteen: [[[[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]]]], + nineteen: [[[[[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]]]]], + twenty: [[[[[[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]]]]]] +} +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> view Record5 + + type Record5 + = { zero : Nat, + one : [Nat], + two : [[Nat]], + three : [[[Nat]]], + four : [[[[Nat]]]], + five : [[[[[Nat]]]]], + six : [[[[[[Nat]]]]]], + seven : [[[[[[[Nat]]]]]]], + eight : [[[[[[[[Nat]]]]]]]], + nine : [[[[[[[[[Nat]]]]]]]]], + ten : [[[[[[[[[[Nat]]]]]]]]]], + eleven : [[[[[[[[[[[Nat]]]]]]]]]]], + twelve : [[[[[[[[[[[[Nat]]]]]]]]]]]], + thirteen : [[[[[[[[[[[[[Nat]]]]]]]]]]]]], + fourteen : [[[[[[[[[[[[[[Nat]]]]]]]]]]]]]], + fifteen : [[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]], + sixteen : [[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]], + seventeen : [[[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]]], + eighteen : [[[[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]]]], + nineteen : [[[[[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]]]]], + twenty : [[[[[[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]]]]]] } +``` + +## Record with user-defined type fields + +This record type has two fields whose types are user-defined (`Record4` and `UserType`). + +``` unison :hide +unique type UserType = UserType Nat + +unique type RecordWithUserType = { a : Text, b : Record4, c : UserType } +``` + +``` ucm :hide +scratch/main> add +``` + +If you `view` or `edit` it, it *should* be treated as a record type, but it does not (which is a bug) + +``` ucm +scratch/main> view RecordWithUserType + + type RecordWithUserType + = { a : Text, b : Record4, c : UserType } +``` + +## Syntax + +Trailing commas are allowed. + +``` unison +unique type Record5 = + { a : Text, + b : Int, + } +``` + +``` ucm :added-by-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`: + + Record5.a : Record5 -> Text + Record5.a.modify : (Text ->{g} Text) + -> Record5 + ->{g} Record5 + Record5.a.set : Text -> Record5 -> Record5 + Record5.b : Record5 -> Int + Record5.b.modify : (Int ->{g} Int) + -> Record5 + ->{g} Record5 + Record5.b.set : Int -> Record5 -> Record5 + + ⍟ These names already exist. You can `update` them to your + new definition: + + type Record5 +``` diff --git a/unison-src/transcripts/idempotent/reflog.md b/unison-src/transcripts/idempotent/reflog.md new file mode 100644 index 0000000000..357ffb6200 --- /dev/null +++ b/unison-src/transcripts/idempotent/reflog.md @@ -0,0 +1,136 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtins +``` + +First we make some changes to the codebase so there's data in the reflog. + +``` unison +x = 1 +``` + +``` ucm :added-by-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`: + + x : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + x : Nat +``` + +``` unison +y = 2 +``` + +``` ucm :added-by-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`: + + y : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + y : Nat + +scratch/main> branch /other + + Done. I've created the other branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /other`. + +scratch/other> alias.term y z + + Done. + +newproject/main> builtins.merge lib.builtins + + Done. + +newproject/main> alias.type lib.builtins.Nat MyNat + + Done. +``` + +Should see reflog entries from the current branch + +``` ucm +scratch/main> reflog + + Below is a record of recent changes, you can use + `reset #abcdef` to reset the current branch to a previous + state. + + Tip: Use `diff.namespace 1 7` to compare between points in + history. + + Branch Hash Description + 1. scratch/main #6mdl5gruh5 add + 2. scratch/main #3rqf1hbev7 add + 3. scratch/main #ms9lggs2rg builtins.merge scratch/main:lib.builtins + 4. scratch/main #sg60bvjo91 Project Created +``` + +Should see reflog entries from the current project + +``` ucm +scratch/main> project.reflog + + Below is a record of recent changes, you can use + `reset #abcdef` to reset the current branch to a previous + state. + + Tip: Use `diff.namespace 1 7` to compare between points in + history. + + Branch Hash Description + 1. scratch/other #148flqs4b1 alias.term scratch/other:.y scratch/other:z + 2. scratch/other #6mdl5gruh5 Branch created from scratch/main + 3. scratch/main #6mdl5gruh5 add + 4. scratch/main #3rqf1hbev7 add + 5. scratch/main #ms9lggs2rg builtins.merge scratch/main:lib.builtins + 6. scratch/main #sg60bvjo91 Project Created +``` + +Should see reflog entries from all projects + +``` ucm +scratch/main> reflog.global + + Below is a record of recent changes, you can use + `reset #abcdef` to reset the current branch to a previous + state. + + Tip: Use `diff.namespace 1 7` to compare between points in + history. + + Branch Hash Description + 1. newproject/main #2rjhs2vq43 alias.term newproject/main:lib.builtins.Nat newproject/main:... + 2. newproject/main #ms9lggs2rg builtins.merge newproject/main:lib.builtins + 3. newproject/main #sg60bvjo91 Branch Created + 4. scratch/other #148flqs4b1 alias.term scratch/other:.y scratch/other:z + 5. scratch/other #6mdl5gruh5 Branch created from scratch/main + 6. scratch/main #6mdl5gruh5 add + 7. scratch/main #3rqf1hbev7 add + 8. scratch/main #ms9lggs2rg builtins.merge scratch/main:lib.builtins + 9. scratch/main #sg60bvjo91 Project Created +``` diff --git a/unison-src/transcripts/idempotent/release-draft-command.md b/unison-src/transcripts/idempotent/release-draft-command.md new file mode 100644 index 0000000000..db40f0a607 --- /dev/null +++ b/unison-src/transcripts/idempotent/release-draft-command.md @@ -0,0 +1,62 @@ +The `release.draft` command drafts a release from the current branch. + +``` ucm :hide +foo/main> builtins.merge +``` + +Some setup: + +``` unison +someterm = 18 +``` + +``` ucm :added-by-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`: + + someterm : Nat +``` + +``` ucm +foo/main> add + + ⍟ I've added these definitions: + + someterm : Nat +``` + +Now, the `release.draft` demo: + +`release.draft` accepts a single semver argument. + +``` ucm +foo/main> release.draft 1.2.3 + + 😎 Great! I've created a draft release for you at + /releases/drafts/1.2.3. + + You can create a `ReleaseNotes : Doc` in this branch to give + an overview of the release. It'll automatically show up on + Unison Share when you publish. + + When ready to release 1.2.3 to the world, `push` the release + to Unison Share, navigate to the release, and click "Publish". + + Tip: if you get pulled away from drafting your release, you + can always get back to it with + `switch /releases/drafts/1.2.3`. +``` + +It's an error to try to create a `releases/drafts/x.y.z` branch that already exists. + +``` ucm :error +foo/main> release.draft 1.2.3 + + foo/releases/drafts/1.2.3 already exists. You can switch to it + with `switch foo/releases/drafts/1.2.3`. +``` diff --git a/unison-src/transcripts/idempotent/reset.md b/unison-src/transcripts/idempotent/reset.md new file mode 100644 index 0000000000..2cd116f87c --- /dev/null +++ b/unison-src/transcripts/idempotent/reset.md @@ -0,0 +1,205 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +def = "first value" +``` + +``` ucm :added-by-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`: + + def : Text +``` + +``` ucm :hide +scratch/main> update +``` + +``` unison :hide +def = "second value" +``` + +Can reset to a value from history by number. + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/main> history + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #5vq851j3hg + + + Adds / updates: + + def + + ⊙ 2. #ujvq6e87kp + + + Adds / updates: + + def + + □ 3. #4bigcpnl7t (start of history) + +scratch/main> reset 2 + + Done. + +scratch/main> view def + + def : Text + def = "first value" + +scratch/main> history + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #ujvq6e87kp + + + Adds / updates: + + def + + □ 2. #4bigcpnl7t (start of history) +``` + +Can reset to a value from reflog by number. + +``` ucm +scratch/main> reflog + + Below is a record of recent changes, you can use + `reset #abcdef` to reset the current branch to a previous + state. + + Tip: Use `diff.namespace 1 7` to compare between points in + history. + + Branch Hash Description + 1. scratch/main #ujvq6e87kp reset ujvq6e87kp4288eq3al9v5luctic0ocd7ug1fu0go5bicrr2vfnrb0... + 2. scratch/main #5vq851j3hg update + 3. scratch/main #ujvq6e87kp update + 4. scratch/main #4bigcpnl7t builtins.merge + 5. scratch/main #sg60bvjo91 Project Created + +-- Reset the current branch to the first history element + +scratch/main> reset 2 + + Done. + +scratch/main> view def + + def : Text + def = "second value" + +scratch/main> history + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #5vq851j3hg + + + Adds / updates: + + def + + ⊙ 2. #ujvq6e87kp + + + Adds / updates: + + def + + □ 3. #4bigcpnl7t (start of history) +``` + +# reset branch + +``` ucm +foo/main> history + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #sg60bvjo91 (start of history) +``` + +``` unison :hide +a = 5 +``` + +``` ucm +foo/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +foo/empty> reset /main: + + Done. + +foo/empty> view a + + a : ##Nat + a = 5 + +foo/empty> history + + Note: The most recent namespace hash is immediately below this + message. + + + + □ 1. #5l94rduvel (start of history) +``` + +## second argument is always interpreted as a branch + +``` unison :hide +main.a = 3 +``` + +``` ucm +foo/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +foo/main> history + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #0i64kpfccl + + + Adds / updates: + + main.a + + □ 2. #5l94rduvel (start of history) + +foo/main> reset 2 main + + Done. +``` diff --git a/unison-src/transcripts/idempotent/resolution-failures.md b/unison-src/transcripts/idempotent/resolution-failures.md new file mode 100644 index 0000000000..0dfba8378c --- /dev/null +++ b/unison-src/transcripts/idempotent/resolution-failures.md @@ -0,0 +1,121 @@ +# Resolution Errors + +This transcript tests the errors printed to the user when a name cannot be resolved. + +## Codebase Setup + +``` ucm +scratch/main> builtins.merge lib.builtins + + Done. +``` + +First we define differing types with the same name in different namespaces: + +``` unison +unique type one.AmbiguousType = one.AmbiguousType +unique type two.AmbiguousType = two.AmbiguousType + +one.ambiguousTerm = "term one" +two.ambiguousTerm = "term two" +``` + +``` ucm :added-by-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`: + + type one.AmbiguousType + type two.AmbiguousType + one.ambiguousTerm : Text + two.ambiguousTerm : Text +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type one.AmbiguousType + type two.AmbiguousType + one.ambiguousTerm : Text + two.ambiguousTerm : Text +``` + +## Tests + +Now we introduce code which isn't sufficiently qualified. +It is ambiguous which type from which namespace we mean. + +We expect the output to: + +1. Print all ambiguous usage sites separately +2. Print possible disambiguation suggestions for each unique ambiguity + +``` unison :error +-- We intentionally avoid using a constructor to ensure the constructor doesn't +-- affect type resolution. +useAmbiguousType : AmbiguousType -> () +useAmbiguousType _ = () + +useUnknownType : UnknownType -> () +useUnknownType _ = () + +-- Despite being a duplicate disambiguation, this should still be included in the annotations printout +separateAmbiguousTypeUsage : AmbiguousType -> () +separateAmbiguousTypeUsage _ = () +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + + ❓ + + I couldn't resolve any of these symbols: + + 3 | useAmbiguousType : AmbiguousType -> () + 4 | useAmbiguousType _ = () + 5 | + 6 | useUnknownType : UnknownType -> () + 7 | useUnknownType _ = () + 8 | + 9 | -- Despite being a duplicate disambiguation, this should still be included in the annotations printout + 10 | separateAmbiguousTypeUsage : AmbiguousType -> () + + + Symbol Suggestions + + AmbiguousType one.AmbiguousType + two.AmbiguousType + + UnknownType No matches +``` + +Currently, ambiguous terms are caught and handled by type directed name resolution, +but expect it to eventually be handled by the above machinery. + +``` unison :error +useAmbiguousTerm = ambiguousTerm +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I couldn't figure out what ambiguousTerm refers to here: + + 1 | useAmbiguousTerm = ambiguousTerm + + The name ambiguousTerm is ambiguous. I couldn't narrow it down + by type, as any type would work here. + + I found some terms in scope that have matching names and + types. Maybe you meant one of these: + + one.ambiguousTerm : Text + two.ambiguousTerm : Text +``` diff --git a/unison-src/transcripts/idempotent/rsa.md b/unison-src/transcripts/idempotent/rsa.md new file mode 100644 index 0000000000..900838394f --- /dev/null +++ b/unison-src/transcripts/idempotent/rsa.md @@ -0,0 +1,72 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison + +up = 0xs0123456789abcdef +down = 0xsfedcba9876543210 + +-- | Generated with: +-- openssl genrsa -out private_key.pem 1024 +-- openssl rsa -in private_key.pem -outform DER | xxd -p +secret = 0xs30820276020100300d06092a864886f70d0101010500048202603082025c02010002818100a7104b2f20725896076e629ccedbcd6907b16694c6e3d8768b5e0e685670b49616e796c588e5aafb92ef986c1a42c021fed0bdc99212c969cdab98087a0ee4c2f4acd4b6049a87a96afc45668329a3cf21a86fb13b488bbe9fefa1cd5a459014f0d0101378e9661e11b73acf54c8a91141ac90309e7fb6ed69b4e63230ab291502030100010281807cdc23a4fc3619d93f8293b728af848d0c0fdd603269d5bd7b99f760a9c22065d08693dbdcddf1f5863306133d694819e04d789aef4e95343b601507b8d9eac4492e6d7031b035c5d84eceaa9686b292712632d33b3303af84314d7920bc3d45f90d7818fc2587b129196d378ee4ed3e6b8d9010d504bb6470ff53e7c5fb17a1024100d67cbcf113d24325fcef12a778dc47c7060055290b68287649ef092558daccb61c4e7bc290740b75a29d4356dcbd66d18b0860dbff394cc8ff3d94d57617adbd024100c765d8261dd3d8e0d3caf11ab7b212eed181354215687ca6387283e4f0be16e79c8f298be0a70c7734dea78ea65128517d693cabfa4c0ff5328f2abb85d2023902403ca41dc347285e65c22251b2d9bfe5e7463217e1b7e0e5f7b3a58a7f6da4c6d60220ca6ad2ee8c42e10bf77afa83ee2af6551315800e52404db1ba7fb398b43d02410084877d85c0177933ddb12a554eb8edfa8b872c85d2c2d2ee8be019280696e19469ab81bab5c371f69d4e4be1f54b45d7fbda017870f1333e0eafb78051ee8689024061f694c12e934c44b7734f62d1b2a3d3624a4980e1b8e066d78dbabd2436654fbb9d9701425900daaafa1e031310e8a580520bb9e1c1288c669fce252bad1e65 + +-- | Generated with: +-- openssl rsa -in private_key.pem -outform DER -pubout | xxd -p +publicKey = 0xs30819f300d06092a864886f70d010101050003818d0030818902818100a7104b2f20725896076e629ccedbcd6907b16694c6e3d8768b5e0e685670b49616e796c588e5aafb92ef986c1a42c021fed0bdc99212c969cdab98087a0ee4c2f4acd4b6049a87a96afc45668329a3cf21a86fb13b488bbe9fefa1cd5a459014f0d0101378e9661e11b73acf54c8a91141ac90309e7fb6ed69b4e63230ab29150203010001 + +incorrectPublicKey = 0xs30819f300d06092a864886f70d010101050003818d0030818902818100a7104b2f20725896076e629ccedbcd6907b16694c6e3d8768b5e0e685670b49616e796c588e5aafb92ef986c1a42c021fed0bdc99212c969cdab98087a0ee4c2f4acd4b6049a87a96afc45668329a3cf21a86fb13b488bbe9fefa1cd5a459014f0d0101378e9661e11b73acf54c8a91141ac90309e7fb6ed69b4e63230ab29150203010002 + +message = up ++ down ++ up ++ down ++ down ++ up ++ down ++ up + +signature = crypto.Rsa.sign.impl secret message + +sigOkay = match signature with + Left err -> Left err + Right sg -> crypto.Rsa.verify.impl publicKey message sg + +sigKo = match signature with + Left err -> Left err + Right sg -> crypto.Rsa.verify.impl incorrectPublicKey message sg + +> signature +> sigOkay +> sigKo +``` + +``` ucm :added-by-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`: + + down : Bytes + incorrectPublicKey : Bytes + message : Bytes + publicKey : Bytes + secret : Bytes + sigKo : Either Failure Boolean + sigOkay : Either Failure Boolean + signature : Either Failure Bytes + up : Bytes + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 28 | > signature + ⧩ + Right + 0xs84b02b6bb0e1196b65378cb12b727f7b4b38e5979f0632e8a51cfab088827f6d3da4221788029f75a0a5f4d740372cfa590462888a1189bbd9de9b084f26116640e611af5a1a17229beec7fb2570887181bbdced8f0ebfec6cad6bdd318a616ba4f01c90e1436efe44b18417d18ce712a0763be834f8c76e0c39b2119b061373 + + 29 | > sigOkay + ⧩ + Right true + + 30 | > sigKo + ⧩ + Right false +``` diff --git a/unison-src/transcripts/idempotent/runtime-tests.md b/unison-src/transcripts/idempotent/runtime-tests.md new file mode 100644 index 0000000000..0ac9a0c13e --- /dev/null +++ b/unison-src/transcripts/idempotent/runtime-tests.md @@ -0,0 +1,183 @@ +# An assortment of regression tests that exercise various interesting cases within the runtime. + +``` ucm :hide +scratch/main> builtins.merge lib.builtins +``` + +``` unison +negativeCaseMatch = match -10 with + +1 -> "bad" + -10 -> "good" + +3 -> "bad" + _ -> "bad" +> negativeCaseMatch + +funcWithMoreThanTwoUnboxedArgs : Nat -> Nat -> Nat -> Nat +funcWithMoreThanTwoUnboxedArgs x y z = + x + y + z + +> funcWithMoreThanTwoUnboxedArgs 1 2 3 + +funcWithMixedArgTypes : Nat -> Text -> Nat -> Text +funcWithMixedArgTypes x y z = + Nat.toText x ++ y ++ Nat.toText z + +> funcWithMixedArgTypes 1 "hello" 2 + +unboxedAndBoxedArgsInSequences = ([1, 2, 3], ["x", "y", "z"]) +> unboxedAndBoxedArgsInSequences + +casting = (Nat.toInt 100, + Float.toRepresentation 3.14, + Float.fromRepresentation 4614253070214989087, + Int.fromRepresentation 100, + Int.toRepresentation +10, + Int.toRepresentation -10) +> casting + + +> 1 Universal.== Int.toRepresentation +1 +> [1, 2, 3] Universal.== [Int.toRepresentation +1, Int.toRepresentation +2, Int.toRepresentation +3] + +-- Float edge cases +> compare 0.0 0.0 +> compare +0.0 (-0.0) +> compare -0.0 (+0.0) +> compare -1.0 1.0 + +-- Currently, the same NaN's are equal, but different NaN's are not... +> (0.0/0.0) == (0.0/0.0) +> (0.0/0.0) == (1.0/0.0) + +> Universal.compare [] [1] +> Universal.compare [1, 2] [2, 3] +> Universal.compare [2, 3] [1, 2] + +-- Values in 'Any' are compared a bit strangely. +-- Currently we have special-cases to compare the values of Nats and Ints directly, ignoring their type, for better or +-- worse. +-- This helps to counter a different issue we have, where `load (save +10)` will load a `Nat` runtime type rather than +-- an Int, since we don't actually store the type of numerics in the ANF.Value type. +> Universal.compare (Any [1, 2]) (Any [+1, +2]) + +-- Regression test for a problem with universalCompare where Nats larger than maxInt would compare incorrectly, but only +-- when nested within other types due to how lists of constructor fields were compared. +> Universal.compare (1,()) (18446744073709551615, ()) + +-- Types in tuples should compare one by one left-to-right +> Universal.compare (1, "", 2) (1, "", 3) +> Universal.compare (1, "", 3) (1, "", 2) +``` + +``` ucm :added-by-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`: + + casting : ( Int, + Nat, + Float, + Int, + Nat, + Nat) + funcWithMixedArgTypes : Nat + -> Text + -> Nat + -> Text + funcWithMoreThanTwoUnboxedArgs : Nat -> Nat -> Nat -> Nat + negativeCaseMatch : Text + unboxedAndBoxedArgsInSequences : ([Nat], [Text]) + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 6 | > negativeCaseMatch + ⧩ + "good" + + 12 | > funcWithMoreThanTwoUnboxedArgs 1 2 3 + ⧩ + 6 + + 18 | > funcWithMixedArgTypes 1 "hello" 2 + ⧩ + "1hello2" + + 21 | > unboxedAndBoxedArgsInSequences + ⧩ + ([1, 2, 3], ["x", "y", "z"]) + + 29 | > casting + ⧩ + ( +100 + , 4614253070214989087 + , 3.14 + , +100 + , 10 + , 18446744073709551606 + ) + + 32 | > 1 Universal.== Int.toRepresentation +1 + ⧩ + true + + 33 | > [1, 2, 3] Universal.== [Int.toRepresentation +1, Int.toRepresentation +2, Int.toRepresentation +3] + ⧩ + true + + 36 | > compare 0.0 0.0 + ⧩ + +0 + + 37 | > compare +0.0 (-0.0) + ⧩ + -1 + + 38 | > compare -0.0 (+0.0) + ⧩ + +1 + + 39 | > compare -1.0 1.0 + ⧩ + -1 + + 42 | > (0.0/0.0) == (0.0/0.0) + ⧩ + true + + 43 | > (0.0/0.0) == (1.0/0.0) + ⧩ + false + + 45 | > Universal.compare [] [1] + ⧩ + -1 + + 46 | > Universal.compare [1, 2] [2, 3] + ⧩ + -1 + + 47 | > Universal.compare [2, 3] [1, 2] + ⧩ + +1 + + 54 | > Universal.compare (Any [1, 2]) (Any [+1, +2]) + ⧩ + +0 + + 58 | > Universal.compare (1,()) (18446744073709551615, ()) + ⧩ + -1 + + 61 | > Universal.compare (1, "", 2) (1, "", 3) + ⧩ + -1 + + 62 | > Universal.compare (1, "", 3) (1, "", 2) + ⧩ + +1 +``` diff --git a/unison-src/transcripts/idempotent/scope-ref.md b/unison-src/transcripts/idempotent/scope-ref.md new file mode 100644 index 0000000000..5d723e9ddc --- /dev/null +++ b/unison-src/transcripts/idempotent/scope-ref.md @@ -0,0 +1,37 @@ +A short script to test mutable references with local scope. + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +test = Scope.run 'let + r = Scope.ref 0 + Ref.write r 1 + i = Ref.read r + Ref.write r 2 + j = Ref.read r + Ref.write r 5 + (i, j, Ref.read r) + +> test +``` + +``` ucm :added-by-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`: + + test : (Nat, Nat, Nat) + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 10 | > test + ⧩ + (1, 2, 5) +``` diff --git a/unison-src/transcripts/idempotent/suffixes.md b/unison-src/transcripts/idempotent/suffixes.md new file mode 100644 index 0000000000..762ffe5448 --- /dev/null +++ b/unison-src/transcripts/idempotent/suffixes.md @@ -0,0 +1,167 @@ +# Suffix-based resolution of names + +``` ucm :hide +scratch/main> builtins.merge +``` + +Any unique name suffix can be used to refer to a definition. For instance: + +``` unison :hide +-- No imports needed even though FQN is `builtin.{Int,Nat}` +foo.bar.a : Int +foo.bar.a = +99 + +-- No imports needed even though FQN is `builtin.Optional.{None,Some}` +optional.isNone = cases + None -> true + Some _ -> false +``` + +This also affects commands like find. Notice lack of qualified names in output: + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + foo.bar.a : Int + optional.isNone : Optional a -> Boolean + +scratch/main> find take + + 1. builtin.Bytes.take : Nat -> Bytes -> Bytes + 2. builtin.List.take : Nat -> [a] -> [a] + 3. builtin.Text.take : Nat -> Text -> Text + 4. builtin.io2.MVar.take.impl : MVar a ->{IO} Either Failure a + 5. builtin.io2.MVar.tryTake : MVar a ->{IO} Optional a +``` + +The `view` and `display` commands also benefit from this: + +``` ucm +scratch/main> view List.drop + + builtin builtin.List.drop : builtin.Nat -> [a] -> [a] + +scratch/main> display bar.a + + +99 +``` + +In the signature, we don't see `base.Nat`, just `Nat`. The full declaration name is still shown for each search result though. + +Type-based search also benefits from this, we can just say `Nat` rather than `.base.Nat`: + +``` ucm +scratch/main> find : Nat -> [a] -> [a] + + 1. builtin.List.drop : Nat -> [a] -> [a] + 2. builtin.List.take : Nat -> [a] -> [a] +``` + +## Preferring names not in `lib.*.lib.*` + +Suffix-based resolution prefers names that are not in an indirect dependency. + +``` unison +cool.abra.cadabra = "my project" +lib.distributed.abra.cadabra = "direct dependency 1" +lib.distributed.baz.qux = "direct dependency 2" +lib.distributed.lib.baz.qux = "indirect dependency" +``` + +``` ucm :added-by-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`: + + cool.abra.cadabra : Text + lib.distributed.abra.cadabra : Text + lib.distributed.baz.qux : Text + lib.distributed.lib.baz.qux : Text +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + cool.abra.cadabra : Text + lib.distributed.abra.cadabra : Text + lib.distributed.baz.qux : Text + lib.distributed.lib.baz.qux : Text +``` + +``` unison :error +> abra.cadabra +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I couldn't figure out what abra.cadabra refers to here: + + 1 | > abra.cadabra + + The name abra.cadabra is ambiguous. I couldn't narrow it down + by type, as any type would work here. + + I found some terms in scope that have matching names and + types. Maybe you meant one of these: + + cool.abra.cadabra : Text + distributed.abra.cadabra : Text +``` + +``` unison +> baz.qux +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + ✅ + + scratch.u changed. + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | > baz.qux + ⧩ + "direct dependency 2" +``` + +``` ucm +scratch/main> view abra.cadabra + + cool.abra.cadabra : Text + cool.abra.cadabra = "my project" + + lib.distributed.abra.cadabra : Text + lib.distributed.abra.cadabra = "direct dependency 1" + +scratch/main> view baz.qux + + lib.distributed.baz.qux : Text + lib.distributed.baz.qux = "direct dependency 2" +``` + +Note that we can always still view indirect dependencies by using more name segments: + +``` ucm +scratch/main> view distributed.abra.cadabra + + lib.distributed.abra.cadabra : Text + lib.distributed.abra.cadabra = "direct dependency 1" + +scratch/main> names distributed.lib.baz.qux + + Term + Hash: #nhup096n2s + Names: lib.distributed.lib.baz.qux +``` diff --git a/unison-src/transcripts/idempotent/sum-type-update-conflicts.md b/unison-src/transcripts/idempotent/sum-type-update-conflicts.md new file mode 100644 index 0000000000..467ad27b61 --- /dev/null +++ b/unison-src/transcripts/idempotent/sum-type-update-conflicts.md @@ -0,0 +1,83 @@ +# Regression test for updates which conflict with an existing data constructor + +https://github.com/unisonweb/unison/issues/2786 + +``` ucm :hide +scratch/main> builtins.merge lib.builtins +``` + +First we add a sum-type to the codebase. + +``` unison +structural type X = x +``` + +``` ucm :added-by-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`: + + structural type X + (also named lib.builtins.Unit) +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural type X + (also named lib.builtins.Unit) +``` + +Now we update the type, changing the name of the constructors, *but*, we simultaneously +add a new top-level term with the same name as the old constructor. + +``` unison +structural type X = y | z + +X.x : Text +X.x = "some text that's not in the codebase" + +dependsOnX = Text.size X.x +``` + +``` ucm :added-by-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`: + + X.x : Text + dependsOnX : Nat + + ⍟ These names already exist. You can `update` them to your + new definition: + + structural type X + (The old definition is also named lib.builtins.Unit.) +``` + +This update should succeed since the conflicted constructor +is removed in the same update that the new term is being added. + +``` ucm +scratch/main> update.old + + ⍟ I've added these definitions: + + X.x : Text + dependsOnX : Nat + + ⍟ I've updated these names to your new definition: + + structural type X + (The old definition was also named lib.builtins.Unit.) +``` diff --git a/unison-src/transcripts/idempotent/switch-command.md b/unison-src/transcripts/idempotent/switch-command.md new file mode 100644 index 0000000000..2361485802 --- /dev/null +++ b/unison-src/transcripts/idempotent/switch-command.md @@ -0,0 +1,99 @@ +The `switch` command switches to an existing project or branch. + +``` ucm :hide +foo/main> builtins.merge + +bar/main> builtins.merge +``` + +Setup stuff. + +``` unison +someterm = 18 +``` + +``` ucm :added-by-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`: + + someterm : Nat +``` + +``` ucm +foo/main> add + + ⍟ I've added these definitions: + + someterm : Nat + +foo/main> branch bar + + Done. I've created the bar branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /bar`. + +foo/main> branch topic + + Done. I've created the topic branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic`. +``` + +Now, the demo. When unambiguous, `switch` switches to either a project or a branch in the current project. A branch in +the current project can be preceded by a forward slash (which makes it unambiguous). A project can be followed by a +forward slash (which makes it unambiguous). + +``` ucm +scratch/main> switch foo + +scratch/main> switch foo/topic + +foo/main> switch topic + +foo/main> switch /topic + +foo/main> switch bar/ +``` + +It's an error to try to switch to something ambiguous. + +``` ucm :error +foo/main> switch bar + + I'm not sure if you wanted to switch to the branch foo/bar or + the project bar. Could you be more specific? + + 1. /bar (the branch bar in the current project) + 2. bar/ (the project bar, with the branch left unspecified) + + Tip: use `switch 1` or `switch 2` to pick one of these. +``` + +It's an error to try to switch to something that doesn't exist, of course. + +``` ucm :error +scratch/main> switch foo/no-such-branch + + foo/no-such-branch does not exist. +``` + +``` ucm :error +scratch/main> switch no-such-project + + Neither project no-such-project nor branch /no-such-project + exists. +``` + +``` ucm :error +foo/main> switch no-such-project-or-branch + + Neither project no-such-project-or-branch nor branch + /no-such-project-or-branch exists. +``` diff --git a/unison-src/transcripts/idempotent/tab-completion.md b/unison-src/transcripts/idempotent/tab-completion.md new file mode 100644 index 0000000000..83aa787539 --- /dev/null +++ b/unison-src/transcripts/idempotent/tab-completion.md @@ -0,0 +1,240 @@ +# Tab Completion + +Test that tab completion works as expected. + +## Tab Complete Command Names + +``` ucm +scratch/main> debug.tab-complete vi + + view + view.global + +scratch/main> debug.tab-complete delete. + + delete.branch + delete.namespace + delete.namespace.force + delete.project + delete.term + delete.term.verbose + delete.type + delete.type.verbose + delete.verbose +``` + +## Tab complete terms & types + +``` unison +subnamespace.someName = 1 +subnamespace.someOtherName = 2 +subnamespace2.thing = 3 +othernamespace.someName = 4 + +unique type subnamespace.AType = A | B +``` + +``` ucm :added-by-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`: + + type subnamespace.AType + othernamespace.someName : ##Nat + subnamespace.someName : ##Nat + subnamespace.someOtherName : ##Nat + subnamespace2.thing : ##Nat +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +-- Should tab complete namespaces since they may contain terms/types + +scratch/main> debug.tab-complete view sub + + subnamespace. + subnamespace2. + +-- Should not complete things from child namespaces of the current query if there are other completions at this level + +scratch/main> debug.tab-complete view subnamespace + + subnamespace. + subnamespace2. + +-- Should complete things from child namespaces of the current query if it's dot-suffixed + +scratch/main> debug.tab-complete view subnamespace. + + * subnamespace.AType + subnamespace.AType. + * subnamespace.someName + * subnamespace.someOtherName + +-- Should complete things from child namespaces of the current query if there are no more completions at this level. + +scratch/main> debug.tab-complete view subnamespace2 + + subnamespace2. + * subnamespace2.thing + +-- Should prefix-filter by query suffix + +scratch/main> debug.tab-complete view subnamespace.some + + * subnamespace.someName + * subnamespace.someOtherName + +scratch/main> debug.tab-complete view subnamespace.someOther + + * subnamespace.someOtherName +``` + +``` unison :hide +absolute.term = "absolute" +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + absolute.term : ##Text + +-- Should tab complete absolute names + +scratch/main> debug.tab-complete view .absolute.te + + * .absolute.term +``` + +## Tab complete namespaces + +``` ucm +-- Should tab complete namespaces + +scratch/main> debug.tab-complete find-in sub + + subnamespace + subnamespace2 + +scratch/main> debug.tab-complete find-in subnamespace + + subnamespace + subnamespace2 + +scratch/main> debug.tab-complete find-in subnamespace. + + subnamespace.AType + +scratch/main> debug.tab-complete io.test sub + + subnamespace. + subnamespace2. + +scratch/main> debug.tab-complete io.test subnamespace + + subnamespace. + subnamespace2. + +scratch/main> debug.tab-complete io.test subnamespace. + + subnamespace.AType. + * subnamespace.someName + * subnamespace.someOtherName +``` + +Tab Complete Delete Subcommands + +``` unison +unique type Foo = A | B +add : a -> a +add b = b +``` + +``` ucm :added-by-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`: + + type Foo + add : a -> a +``` + +``` ucm +scratch/main> update.old + + ⍟ I've added these definitions: + + type Foo + add : a -> a + +scratch/main> debug.tab-complete delete.type Foo + + * Foo + Foo. + +scratch/main> debug.tab-complete delete.term add + + * add +``` + +## Tab complete projects and branches + +``` ucm +myproject/main> branch mybranch + + Done. I've created the mybranch branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /mybranch`. + +myproject/main> debug.tab-complete branch.delete /mybr + + /mybranch + +myproject/main> debug.tab-complete project.rename my + + myproject +``` + +Commands which complete namespaces OR branches should list both + +``` unison +mybranchsubnamespace.term = 1 +``` + +``` ucm :added-by-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`: + + mybranchsubnamespace.term : ##Nat +``` + +``` ucm +myproject/main> add + + ⍟ I've added these definitions: + + mybranchsubnamespace.term : ##Nat + +myproject/main> debug.tab-complete merge mybr + + /mybranch +``` diff --git a/unison-src/transcripts/idempotent/tdnr.md b/unison-src/transcripts/idempotent/tdnr.md new file mode 100644 index 0000000000..1a4f8214b8 --- /dev/null +++ b/unison-src/transcripts/idempotent/tdnr.md @@ -0,0 +1,1134 @@ +TDNR selects local term (in file) that typechecks over local term (in file) that doesn't. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +good.foo = 17 +bad.foo = "bar" +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + bad.foo : Text + good.foo : Nat + thing : Nat +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +TDNR selects local term (in file) that typechecks over local term (in namespace) that doesn't. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +bad.foo = "bar" +``` + +``` ucm :added-by-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`: + + bad.foo : Text +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bad.foo : Text +``` + +``` unison +good.foo = 17 +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + good.foo : Nat + thing : Nat +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +TDNR selects local term (in file) that typechecks over local term (shadowing namespace) that doesn't. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +bad.foo = "bar" +``` + +``` ucm :added-by-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`: + + bad.foo : Text +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bad.foo : Text +``` + +``` unison +good.foo = 17 +bad.foo = "baz" +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + good.foo : Nat + thing : Nat + + ⍟ These names already exist. You can `update` them to your + new definition: + + bad.foo : Text +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +TDNR selects local term (in namespace) that typechecks over local term (in file) that doesn't. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +good.foo = 17 +``` + +``` ucm :added-by-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`: + + good.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + good.foo : Nat +``` + +``` unison +bad.foo = "bar" +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + bad.foo : Text + thing : Nat +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +TDNR selects local term (in namespace) that typechecks over local term (in namespace) that doesn't. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +good.foo = 17 +bad.foo = "bar" +``` + +``` ucm :added-by-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`: + + bad.foo : Text + good.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bad.foo : Text + good.foo : Nat +``` + +``` unison +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + thing : Nat +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +TDNR selects local term (in namespace) that typechecks over local term (shadowing namespace) that doesn't. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +good.foo = 17 +bad.foo = "bar" +``` + +``` ucm :added-by-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`: + + bad.foo : Text + good.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bad.foo : Text + good.foo : Nat +``` + +``` unison +bad.foo = "baz" +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + thing : Nat + + ⍟ These names already exist. You can `update` them to your + new definition: + + bad.foo : Text +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +TDNR selects local term (shadowing namespace) that typechecks over local term (in file) that doesn't. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +good.foo = 17 +``` + +``` ucm :added-by-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`: + + good.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + good.foo : Nat +``` + +``` unison +good.foo = 18 +bad.foo = "bar" +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + bad.foo : Text + thing : Nat + + ⍟ These names already exist. You can `update` them to your + new definition: + + good.foo : Nat +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +TDNR selects local term (shadowing namespace) that typechecks over local term (in namespace) that doesn't. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +good.foo = 17 +bad.foo = "bar" +``` + +``` ucm :added-by-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`: + + bad.foo : Text + good.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bad.foo : Text + good.foo : Nat +``` + +``` unison +good.foo = 18 +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + thing : Nat + + ⍟ These names already exist. You can `update` them to your + new definition: + + good.foo : Nat +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +TDNR selects local term (shadowing namespace) that typechecks over local term (shadowing namespace) that doesn't. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +good.foo = 17 +bad.foo = "bar" +``` + +``` ucm :added-by-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`: + + bad.foo : Text + good.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bad.foo : Text + good.foo : Nat +``` + +``` unison +good.foo = 18 +bad.foo = "baz" +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + thing : Nat + + ⍟ These names already exist. You can `update` them to your + new definition: + + bad.foo : Text + good.foo : Nat +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +\=== start local over direct dep + +TDNR selects local term (in file) that typechecks over direct dependency that doesn't. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +lib.bad.foo = "bar" +``` + +``` ucm :added-by-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`: + + lib.bad.foo : Text +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + lib.bad.foo : Text +``` + +``` unison +good.foo = 17 +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + good.foo : Nat + thing : Nat +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +TDNR selects local term (in namespace) that typechecks over direct dependency that doesn't. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +good.foo = 17 +lib.bad.foo = "bar" +``` + +``` ucm :added-by-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`: + + good.foo : Nat + lib.bad.foo : Text +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + good.foo : Nat + lib.bad.foo : Text +``` + +``` unison +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + thing : Nat +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +TDNR selects local term (shadowing namespace) that typechecks over direct dependency that doesn't. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +good.foo = 17 +lib.bad.foo = "bar" +``` + +``` ucm :added-by-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`: + + good.foo : Nat + lib.bad.foo : Text +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + good.foo : Nat + lib.bad.foo : Text +``` + +``` unison +good.foo = 18 +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + thing : Nat + + ⍟ These names already exist. You can `update` them to your + new definition: + + good.foo : Nat +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +TDNR not used to select local term (in file) that typechecks over indirect dependency that also typechecks. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +lib.dep.lib.dep.foo = 217 +``` + +``` ucm :added-by-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`: + + lib.dep.lib.dep.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + lib.dep.lib.dep.foo : Nat +``` + +``` unison +good.foo = 17 +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + good.foo : Nat + thing : Nat +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +TDNR not used to select local term (in namespace) that typechecks over indirect dependency that also typechecks. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +good.foo = 17 +lib.dep.lib.dep.foo = 217 +``` + +``` ucm :added-by-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`: + + good.foo : Nat + lib.dep.lib.dep.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + good.foo : Nat + lib.dep.lib.dep.foo : Nat +``` + +``` unison +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + thing : Nat +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +TDNR not used to select local term (shadowing namespace) that typechecks over indirect dependency that also typechecks. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +good.foo = 17 +lib.dep.lib.dep.foo = 217 +``` + +``` ucm :added-by-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`: + + good.foo : Nat + lib.dep.lib.dep.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + good.foo : Nat + lib.dep.lib.dep.foo : Nat +``` + +``` unison +good.foo = 18 +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + thing : Nat + + ⍟ These names already exist. You can `update` them to your + new definition: + + good.foo : Nat +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +TDNR selects direct dependency that typechecks over local term (in file) that doesn't. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +lib.good.foo = 17 +``` + +``` ucm :added-by-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`: + + lib.good.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + lib.good.foo : Nat +``` + +``` unison +bad.foo = "bar" +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + bad.foo : Text + thing : Nat +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +TDNR selects direct dependency that typechecks over local term (in namespace) that doesn't. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +lib.good.foo = 17 +bad.foo = "bar" +``` + +``` ucm :added-by-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`: + + bad.foo : Text + lib.good.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bad.foo : Text + lib.good.foo : Nat +``` + +``` unison +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + thing : Nat +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +TDNR selects direct dependency that typechecks over local term (shadowing namespace) that doesn't. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +lib.good.foo = 17 +bad.foo = "bar" +``` + +``` ucm :added-by-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`: + + bad.foo : Text + lib.good.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bad.foo : Text + lib.good.foo : Nat +``` + +``` unison +bad.foo = "baz" +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + thing : Nat + + ⍟ These names already exist. You can `update` them to your + new definition: + + bad.foo : Text +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +TDNR selects direct dependency that typechecks over direct dependency that doesn't. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +lib.good.foo = 17 +lib.bad.foo = "bar" +``` + +``` ucm :added-by-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`: + + lib.bad.foo : Text + lib.good.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + lib.bad.foo : Text + lib.good.foo : Nat +``` + +``` unison +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + thing : Nat +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +TDNR not used to select direct dependency that typechecks over indirect dependency that also typechecks. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +lib.good.foo = 17 +lib.dep.lib.dep.foo = 217 +``` + +``` ucm :added-by-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`: + + lib.dep.lib.dep.foo : Nat + lib.good.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + lib.dep.lib.dep.foo : Nat + lib.good.foo : Nat +``` + +``` unison +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + thing : Nat +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +TDNR selects indirect dependency that typechecks over indirect dependency that doesn't. + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +lib.dep.lib.good.foo = 17 +lib.dep.lib.bad.foo = "bar" +``` + +``` ucm :added-by-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`: + + lib.dep.lib.bad.foo : Text + lib.dep.lib.good.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + lib.dep.lib.bad.foo : Text + lib.dep.lib.good.foo : Nat +``` + +``` unison +thing = foo Nat.+ foo +``` + +``` ucm :added-by-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`: + + thing : Nat +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` diff --git a/unison-src/transcripts/idempotent/test-command.md b/unison-src/transcripts/idempotent/test-command.md new file mode 100644 index 0000000000..3f3c6df0ec --- /dev/null +++ b/unison-src/transcripts/idempotent/test-command.md @@ -0,0 +1,152 @@ +Merge builtins so we get enough names for the testing stuff. + +``` ucm :hide +scratch/main> builtins.merge +``` + +The `test` command should run all of the tests in the current directory. + +``` unison +test1 : [Result] +test1 = [Ok "test1"] + +foo.test2 : [Result] +foo.test2 = [Ok "test2"] +``` + +``` ucm :added-by-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.test2 : [Result] + test1 : [Result] +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> test + + ✅ + + + + + + New test results: + + 1. foo.test2 ◉ test2 + 2. test1 ◉ test1 + + ✅ 2 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` + +Tests should be cached if unchanged. + +``` ucm +scratch/main> test + + Cached test results (`help testcache` to learn more) + + 1. foo.test2 ◉ test2 + 2. test1 ◉ test1 + + ✅ 2 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` + +`test` won't descend into the `lib` namespace, but `test.all` will. + +``` unison +lib.dep.testInLib : [Result] +lib.dep.testInLib = [Ok "testInLib"] +``` + +``` ucm :added-by-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`: + + lib.dep.testInLib : [Result] +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> test + + Cached test results (`help testcache` to learn more) + + 1. foo.test2 ◉ test2 + 2. test1 ◉ test1 + + ✅ 2 test(s) passing + + Tip: Use view 1 to view the source of a test. + +scratch/main> test.all + + + Cached test results (`help testcache` to learn more) + + 1. foo.test2 ◉ test2 + 2. test1 ◉ test1 + + ✅ 2 test(s) passing + + ✅ + + + + New test results: + + 1. lib.dep.testInLib ◉ testInLib + + ✅ 1 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` + +`test` WILL run tests within `lib` if specified explicitly. + +``` ucm +scratch/main> test lib.dep + + Cached test results (`help testcache` to learn more) + + 1. lib.dep.testInLib ◉ testInLib + + ✅ 1 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` + +`test` can be given a relative path, in which case it will only run tests found somewhere in that namespace. + +``` ucm +scratch/main> test foo + + Cached test results (`help testcache` to learn more) + + 1. foo.test2 ◉ test2 + + ✅ 1 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` diff --git a/unison-src/transcripts/idempotent/text-literals.md b/unison-src/transcripts/idempotent/text-literals.md new file mode 100644 index 0000000000..de87b7daf4 --- /dev/null +++ b/unison-src/transcripts/idempotent/text-literals.md @@ -0,0 +1,127 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +This transcript shows some syntax for raw text literals. + +``` unison +lit1 = """ +This is a raw text literal. +It can start with 3 or more ", +and is terminated by the same number of quotes. +Nothing is escaped. \n + +The initial newline, if it exists, is ignored. +The last line, if it's just whitespace up to the closing quotes, +is ignored. + +Use an extra blank line if you'd like a trailing newline. Like so: + +""" + +> lit1 +> Some lit1 + +lit2 = """" + This is a raw text literal, indented. + It can start with 3 or more ", + and is terminated by the same number of quotes. + Nothing is escaped. \n + + This doesn't terminate the literal - """ + """" + +> lit2 +> Some lit2 +``` + +``` ucm :added-by-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`: + + lit1 : Text + lit2 : Text + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 15 | > lit1 + ⧩ + """ + This is a raw text literal. + It can start with 3 or more ", + and is terminated by the same number of quotes. + Nothing is escaped. \n + + The initial newline, if it exists, is ignored. + The last line, if it's just whitespace up to the closing quotes, + is ignored. + + Use an extra blank line if you'd like a trailing newline. Like so: + + """ + + 16 | > Some lit1 + ⧩ + Some + "This is a raw text literal.\nIt can start with 3 or more \",\nand is terminated by the same number of quotes.\nNothing is escaped. \\n\n\nThe initial newline, if it exists, is ignored.\nThe last line, if it's just whitespace up to the closing quotes,\nis ignored.\n\nUse an extra blank line if you'd like a trailing newline. Like so:\n" + + 27 | > lit2 + ⧩ + """" + This is a raw text literal, indented. + It can start with 3 or more ", + and is terminated by the same number of quotes. + Nothing is escaped. \n + + This doesn't terminate the literal - """ + """" + + 28 | > Some lit2 + ⧩ + Some + "This is a raw text literal, indented.\nIt can start with 3 or more \",\nand is terminated by the same number of quotes.\nNothing is escaped. \\n\n\nThis doesn't terminate the literal - \"\"\"" +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + lit1 : Text + lit2 : Text + +scratch/main> view lit1 lit2 + + lit1 : Text + lit1 = + """ + This is a raw text literal. + It can start with 3 or more ", + and is terminated by the same number of quotes. + Nothing is escaped. \n + + The initial newline, if it exists, is ignored. + The last line, if it's just whitespace up to the closing quotes, + is ignored. + + Use an extra blank line if you'd like a trailing newline. Like so: + + """ + + lit2 : Text + lit2 = + """" + This is a raw text literal, indented. + It can start with 3 or more ", + and is terminated by the same number of quotes. + Nothing is escaped. \n + + This doesn't terminate the literal - """ + """" +``` diff --git a/unison-src/transcripts/idempotent/textfind.md b/unison-src/transcripts/idempotent/textfind.md new file mode 100644 index 0000000000..96bda8abba --- /dev/null +++ b/unison-src/transcripts/idempotent/textfind.md @@ -0,0 +1,214 @@ +# The `text.find` command + +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +The `text.find` (or `grep`) command can be used to search for text or numeric literals appearing anywhere in your project. Just supply one or more tokens to search for. Unlike regular grep over the text of your code, this ignores local variables and function names that happen to match your search tokens (use `dependents` or `find` for that purpose). It's only searching for text or numeric literals that match. + +``` ucm +scratch/main> help grep + + text.find (or grep) + `text.find token1 "99" token2` finds terms with literals (text + or numeric) containing `token1`, `99`, and `token2`. + + Numeric literals must be quoted (ex: "42") but single words + need not be quoted. + + Use `text.find.all` to include search of `lib`. +``` + +``` ucm +scratch/main> help text.find.all + + text.find.all (or grep.all) + `text.find.all token1 "99" token2` finds terms with literals + (text or numeric) containing `token1`, `99`, and `token2`. + + Numeric literals must be quoted (ex: "42") but single words + need not be quoted. + + Use `text.find` to exclude `lib` from search. +``` + +Here's an example: + +``` unison +foo = + _ = "an interesting constant" + 1 +bar = match "well hi there" with + "ooga" -> 99 + "booga" -> 23 + _ -> 0 +baz = ["an", "quaffle", "tres"] +qux = + quaffle = 99 + quaffle + 1 + +lib.foo = [Any 46, Any "hi", Any "zoink"] +lib.bar = 3 +``` + +``` ucm :added-by-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`: + + bar : Nat + baz : [Text] + foo : Nat + lib.bar : Nat + lib.foo : [Any] + qux : Nat +``` + +``` ucm :hide +scratch/main> add +``` + +``` ucm +scratch/main> grep hi + + 🔎 + + These definitions from the current namespace (excluding `lib`) have matches: + + 1. bar + + Tip: Try `edit 1` to bring this into your scratch file. + +scratch/main> view 1 + + bar : Nat + bar = match "well hi there" with + "ooga" -> 99 + "booga" -> 23 + _ -> 0 + +scratch/main> grep "hi" + + 🔎 + + These definitions from the current namespace (excluding `lib`) have matches: + + 1. bar + + Tip: Try `edit 1` to bring this into your scratch file. + +scratch/main> text.find.all hi + + 🔎 + + These definitions from the current namespace have matches: + + 1. bar + 2. lib.foo + + Tip: Try `edit 1` or `edit 1-2` to bring these into your + scratch file. + +scratch/main> view 1-5 + + bar : Nat + bar = match "well hi there" with + "ooga" -> 99 + "booga" -> 23 + _ -> 0 + + lib.foo : [Any] + lib.foo = [Any 46, Any "hi", Any "zoink"] + +scratch/main> grep oog + + 🔎 + + These definitions from the current namespace (excluding `lib`) have matches: + + 1. bar + + Tip: Try `edit 1` to bring this into your scratch file. + +scratch/main> view 1 + + bar : Nat + bar = match "well hi there" with + "ooga" -> 99 + "booga" -> 23 + _ -> 0 +``` + +``` ucm +scratch/main> grep quaffle + + 🔎 + + These definitions from the current namespace (excluding `lib`) have matches: + + 1. baz + + Tip: Try `edit 1` to bring this into your scratch file. + +scratch/main> view 1-5 + + baz : [Text] + baz = ["an", "quaffle", "tres"] + +scratch/main> text.find "interesting const" + + 🔎 + + These definitions from the current namespace (excluding `lib`) have matches: + + 1. foo + + Tip: Try `edit 1` to bring this into your scratch file. + +scratch/main> view 1-5 + + foo : Nat + foo = + _ = "an interesting constant" + 1 + +scratch/main> text.find "99" "23" + + 🔎 + + These definitions from the current namespace (excluding `lib`) have matches: + + 1. bar + + Tip: Try `edit 1` to bring this into your scratch file. + +scratch/main> view 1 + + bar : Nat + bar = match "well hi there" with + "ooga" -> 99 + "booga" -> 23 + _ -> 0 +``` + +Now some failed searches: + +``` ucm :error +scratch/main> grep lsdkfjlskdjfsd + + 😶 I couldn't find any matches. + + Tip: `text.find.all` will search `lib` as well. +``` + +Notice it gives the tip about `text.find.all`. But not here: + +``` ucm :error +scratch/main> grep.all lsdkfjlskdjfsd + + 😶 I couldn't find any matches. +``` diff --git a/unison-src/transcripts/idempotent/todo-bug-builtins.md b/unison-src/transcripts/idempotent/todo-bug-builtins.md new file mode 100644 index 0000000000..31b375e8fe --- /dev/null +++ b/unison-src/transcripts/idempotent/todo-bug-builtins.md @@ -0,0 +1,101 @@ +# The `todo` and `bug` builtin + +``` ucm :hide +scratch/main> builtins.merge +``` + +`todo` and `bug` have type `a -> b`. They take a message or a value of type `a` and crash during runtime displaying `a` in ucm. + +``` unison :error +> todo "implement me later" +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + ✅ + + scratch.u changed. + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 💔💥 + + I've encountered a call to builtin.todo with the following + value: + + "implement me later" + + Stack trace: + todo + #qe5e1lcfn8 +``` + +``` unison :error +> bug "there's a bug in my code" +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + ✅ + + scratch.u changed. + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 💔💥 + + I've encountered a call to builtin.bug with the following + value: + + "there's a bug in my code" + + Stack trace: + bug + #m67hcdcoda +``` + +## Todo + +`todo` is useful if you want to come back to a piece of code later but you want your project to compile. + +``` unison +complicatedMathStuff x = todo "Come back and to something with x here" +``` + +``` ucm :added-by-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`: + + complicatedMathStuff : x -> r +``` + +## Bug + +`bug` is used to indicate that a particular branch is not expected to execute. + +``` unison +test = match true with + true -> "Yay" + false -> bug "Wow, that's unexpected" +``` + +``` ucm :added-by-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`: + + test : Text +``` diff --git a/unison-src/transcripts/idempotent/todo.md b/unison-src/transcripts/idempotent/todo.md new file mode 100644 index 0000000000..b230464cdf --- /dev/null +++ b/unison-src/transcripts/idempotent/todo.md @@ -0,0 +1,408 @@ +# Nothing to do + +When there's nothing to do, `todo` says this: + +``` ucm +scratch/main> todo + + You have no pending todo items. Good work! ✅ +``` + +# Dependents of `todo` + +The `todo` command shows local (outside `lib`) terms that directly call `todo`. + +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + +``` unison +foo : Nat +foo = todo "implement foo" + +bar : Nat +bar = foo + foo +``` + +``` ucm :added-by-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`: + + bar : Nat + foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bar : Nat + foo : Nat + +scratch/main> todo + + These terms call `todo`: + + 1. foo +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +# Direct dependencies without names + +The `todo` command shows hashes of direct dependencies of local (outside `lib`) definitions that don't have names in +the current namespace. + +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + +``` unison +foo.bar = 15 +baz = foo.bar + foo.bar +``` + +``` ucm :added-by-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`: + + baz : Nat + foo.bar : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + baz : Nat + foo.bar : Nat + +scratch/main> delete.namespace.force foo + + Done. + + ⚠️ + + Of the things I deleted, the following are still used in the + following definitions. They now contain un-named references. + + Dependency Referenced In + bar 1. baz + +scratch/main> todo + + These terms do not have any names in the current namespace: + + 1. #1jujb8oelv +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +# Conflicted names + +The `todo` command shows conflicted names. + +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + +``` unison +foo = 16 +bar = 17 +``` + +``` ucm :added-by-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`: + + bar : Nat + foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bar : Nat + foo : Nat + +scratch/main> debug.alias.term.force foo bar + + Done. + +scratch/main> todo + + ❓ + + The term bar has conflicting definitions: + + 1. bar#14ibahkll6 + 2. bar#cq22mm4sca + + Tip: Use `move.term` or `delete.term` to resolve the + conflicts. +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +# Definitions in lib + +The `todo` command complains about terms and types directly in `lib`. + +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + +``` unison +lib.foo = 16 +``` + +``` ucm :added-by-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`: + + lib.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + lib.foo : Nat + +scratch/main> todo + + There's a type or term at the top level of the `lib` + namespace, where I only expect to find subnamespaces + representing library dependencies. Please move or remove it. +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +# Constructor aliases + +The `todo` command complains about constructor aliases. + +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + +``` unison +type Foo = One +``` + +``` ucm :added-by-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`: + + type Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + +scratch/main> alias.term Foo.One Foo.Two + + Done. + +scratch/main> todo + + The type Foo has a constructor with multiple names. + + 1. Foo.One + 2. Foo.Two + + Please delete all but one name for each constructor. +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +# Missing constructor names + +The `todo` command complains about missing constructor names. + +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + +``` unison +type Foo = Bar +``` + +``` ucm :added-by-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`: + + type Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + +scratch/main> delete.term Foo.Bar + + Done. + +scratch/main> todo + + These types have some constructors with missing names. + + 1. Foo + + You can use `view 1` and + `alias.term .` to give names + to each unnamed constructor. +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +# Nested decl aliases + +The `todo` command complains about nested decl aliases. + +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + +``` unison +structural type Foo a = One a | Two a a +structural type Foo.inner.Bar a = Uno a | Dos a a +``` + +``` ucm :added-by-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`: + + structural type Foo a + structural type Foo.inner.Bar a +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural type Foo a + structural type Foo.inner.Bar a + +scratch/main> todo + + These types are aliases, but one is nested under the other. + Please separate them or delete one copy. + + 1. Foo + 2. Foo.inner.Bar +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` + +# Stray constructors + +The `todo` command complains about stray constructors. + +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + +``` unison +type Foo = Bar +``` + +``` ucm :added-by-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`: + + type Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + +scratch/main> alias.term Foo.Bar Baz + + Done. + +scratch/main> todo + + These constructors are not nested beneath their corresponding + type names: + + 1. Baz + + For each one, please either use `move` to move if, or if it's + an extra copy, you can simply `delete` it. +``` + +``` ucm :hide +scratch/main> delete.project scratch +``` diff --git a/unison-src/transcripts/idempotent/top-level-exceptions.md b/unison-src/transcripts/idempotent/top-level-exceptions.md new file mode 100644 index 0000000000..81c18f8349 --- /dev/null +++ b/unison-src/transcripts/idempotent/top-level-exceptions.md @@ -0,0 +1,104 @@ +A simple transcript to test the use of exceptions that bubble to the top level. + +``` ucm :hide +scratch/main> builtins.merge +``` + +FYI, here are the `Exception` and `Failure` types: + +``` ucm +scratch/main> view Exception Failure + + structural ability builtin.Exception where + raise : Failure ->{builtin.Exception} x + + type builtin.io2.Failure + = Failure Type Text Any +``` + +Here's a sample program just to verify that the typechecker allows `run` to throw exceptions: + +``` unison +use builtin IO Exception Test.Result + +main : '{IO, Exception} () +main _ = () + +mytest : '{IO, Exception} [Test.Result] +mytest _ = [Ok "Great"] +``` + +``` ucm :added-by-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`: + + main : '{IO, Exception} () + mytest : '{IO, Exception} [Result] +``` + +``` ucm +scratch/main> run main + + () + +scratch/main> add + + ⍟ I've added these definitions: + + main : '{IO, Exception} () + mytest : '{IO, Exception} [Result] + +scratch/main> io.test mytest + + New test results: + + 1. mytest ◉ Great + + ✅ 1 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` + +Now a test to show the handling of uncaught exceptions: + +``` unison +main2 = '(error "oh noes!" ()) + +error : Text -> a ->{Exception} x +error msg a = + builtin.Exception.raise (Failure (typeLink RuntimeError) msg (Any a)) + +unique type RuntimeError = +``` + +``` ucm :added-by-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`: + + type RuntimeError + error : Text -> a ->{Exception} x + main2 : '{Exception} r +``` + +``` ucm :error +scratch/main> run main2 + + 💔💥 + + The program halted with an unhandled exception: + + Failure (typeLink RuntimeError) "oh noes!" (Any ()) + + Stack trace: + ##raise +``` diff --git a/unison-src/transcripts/idempotent/transcript-parser-commands.md b/unison-src/transcripts/idempotent/transcript-parser-commands.md new file mode 100644 index 0000000000..5782588136 --- /dev/null +++ b/unison-src/transcripts/idempotent/transcript-parser-commands.md @@ -0,0 +1,67 @@ +### Transcript parser operations + +``` ucm :hide +scratch/main> builtins.merge +``` + +The transcript parser is meant to parse `ucm` and `unison` blocks. + +``` unison +x = 1 +``` + +``` ucm :added-by-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`: + + x : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + x : Nat +``` + +``` unison :hide:error :scratch.u +z +``` + +``` ucm :error +scratch/main> delete foo + + ⚠️ + + The following names were not found in the codebase. Check your spelling. + foo +``` + +``` ucm :error +scratch/main> delete lineToken.call + + ⚠️ + + The following names were not found in the codebase. Check your spelling. + lineToken.call +``` + +However handling of blocks of other languages should be supported. + +``` python +some python code +``` + +``` c_cpp +some C++ code +``` + +``` c9search +some cloud9 code +``` diff --git a/unison-src/transcripts/idempotent/type-deps.md b/unison-src/transcripts/idempotent/type-deps.md new file mode 100644 index 0000000000..57b2cf602a --- /dev/null +++ b/unison-src/transcripts/idempotent/type-deps.md @@ -0,0 +1,65 @@ +# Ensure type dependencies are properly considered in slurping + +https://github.com/unisonweb/unison/pull/2821 + +``` ucm :hide +scratch/main> builtins.merge +``` + +Define a type. + +``` unison :hide +structural type Y = Y +``` + +``` ucm :hide +scratch/main> add +``` + +Now, we update `Y`, and add a new type `Z` which depends on it. + +``` unison +structural type Z = Z Y +structural type Y = Y Nat +``` + +``` ucm :added-by-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`: + + structural type Z + + ⍟ These names already exist. You can `update` them to your + new definition: + + structural type Y + (The old definition is also named builtin.Unit.) +``` + +Adding should fail for BOTH definitions, `Y` needs an update and `Z` is blocked by `Y`. + +``` ucm :error +scratch/main> add + + x These definitions failed: + + Reason + needs update structural type Y + blocked structural type Z + + Tip: Use `help filestatus` to learn more. + +-- This shouldn't exist, because it should've been blocked. + +scratch/main> view Z + + ⚠️ + + The following names were not found in the codebase. Check your spelling. + Z +``` diff --git a/unison-src/transcripts/idempotent/type-modifier-are-optional.md b/unison-src/transcripts/idempotent/type-modifier-are-optional.md new file mode 100644 index 0000000000..1af19c052b --- /dev/null +++ b/unison-src/transcripts/idempotent/type-modifier-are-optional.md @@ -0,0 +1,35 @@ +# Type modifiers are optional, `unique` is the default. + +``` ucm :hide +scratch/main> builtins.merge +``` + +Types and abilities may be prefixed with either `unique` or `structural`. When left unspecified, `unique` is assumed. + +``` unison +type Abc = Abc +unique type Def = Def +structural type Ghi = Ghi + +ability MyAbility where const : a +unique ability MyAbilityU where const : a +structural ability MyAbilityS where const : a +``` + +``` ucm :added-by-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`: + + type Abc + type Def + structural type Ghi + (also named builtin.Unit) + ability MyAbility + structural ability MyAbilityS + ability MyAbilityU +``` diff --git a/unison-src/transcripts/idempotent/undo.md b/unison-src/transcripts/idempotent/undo.md new file mode 100644 index 0000000000..fd250b350c --- /dev/null +++ b/unison-src/transcripts/idempotent/undo.md @@ -0,0 +1,199 @@ +# Undo + +Undo should pop a node off of the history of the current branch. + +``` unison :hide +x = 1 +``` + +``` ucm +scratch/main> builtins.merge lib.builtins + + Done. + +scratch/main> add + + ⍟ I've added these definitions: + + x : Nat + +scratch/main> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + +scratch/main> alias.term x y + + Done. + +scratch/main> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + 3. y (Nat) + +scratch/main> history + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #nmem6r6no1 + + + Adds / updates: + + y + + = Copies: + + Original name New name(s) + x y + + ⊙ 2. #3rqf1hbev7 + + + Adds / updates: + + x + + □ 3. #ms9lggs2rg (start of history) + +scratch/main> undo + + Here are the changes I undid + + Name changes: + + Original Changes + 1. x 2. y (added) + +scratch/main> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + +scratch/main> history + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #3rqf1hbev7 + + + Adds / updates: + + x + + □ 2. #ms9lggs2rg (start of history) +``` + +----- + +It should not be affected by changes on other branches. + +``` unison :hide +x = 1 +``` + +``` ucm +scratch/branch1> builtins.merge lib.builtins + + Done. + +scratch/branch1> add + + ⍟ I've added these definitions: + + x : Nat + +scratch/branch1> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + +scratch/branch1> alias.term x y + + Done. + +scratch/branch1> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + 3. y (Nat) + +scratch/branch1> history + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #nmem6r6no1 + + + Adds / updates: + + y + + = Copies: + + Original name New name(s) + x y + + ⊙ 2. #3rqf1hbev7 + + + Adds / updates: + + x + + □ 3. #ms9lggs2rg (start of history) + +-- Make some changes on an unrelated branch + +scratch/branch2> builtins.merge lib.builtins + + Done. + +scratch/branch2> delete.namespace lib + + Done. + +scratch/branch1> undo + + Here are the changes I undid + + Name changes: + + Original Changes + 1. x 2. y (added) + +scratch/branch1> ls + + 1. lib/ (469 terms, 74 types) + 2. x (Nat) + +scratch/branch1> history + + Note: The most recent namespace hash is immediately below this + message. + + ⊙ 1. #3rqf1hbev7 + + + Adds / updates: + + x + + □ 2. #ms9lggs2rg (start of history) +``` + +----- + +Undo should be a no-op on a newly created branch + +``` ucm :error +scratch/main> branch.create-empty new + + Done. I've created an empty branch scratch/new. + + Tip: Use `merge /somebranch` to initialize this branch. + +scratch/new> undo + + ⚠️ + + Nothing more to undo. +``` diff --git a/unison-src/transcripts/idempotent/unique-type-churn.md b/unison-src/transcripts/idempotent/unique-type-churn.md new file mode 100644 index 0000000000..25c06ea7d2 --- /dev/null +++ b/unison-src/transcripts/idempotent/unique-type-churn.md @@ -0,0 +1,135 @@ +This transcript demonstrates that unique types no longer always get a fresh GUID: they share GUIDs with already-saved +unique types of the same name. + +``` unison +unique type A = A + +unique type B = B C +unique type C = C B +``` + +``` ucm :added-by-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`: + + type A + type B + type C +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type A + type B + type C +``` + +``` unison +unique type A = A + +unique type B = B C +unique type C = C B +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I found and typechecked the definitions in scratch.u. This + file has been previously added to the codebase. +``` + +If the name stays the same, the churn is even prevented if the type is updated and then reverted to the original form. + +``` ucm +scratch/main> names A + + Type + Hash: #uj8oalgadr + Names: A + + Term + Hash: #uj8oalgadr#0 + Names: A.A +``` + +``` unison +unique type A = A () +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + type A +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/main> names A + + Type + Hash: #ufo5tuc7ho + Names: A + + Term + Hash: #ufo5tuc7ho#0 + Names: A.A +``` + +``` unison +unique type A = A +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + type A +``` + +Note that `A` is back to its original hash. + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/main> names A + + Type + Hash: #uj8oalgadr + Names: A + + Term + Hash: #uj8oalgadr#0 + Names: A.A +``` diff --git a/unison-src/transcripts/idempotent/unitnamespace.md b/unison-src/transcripts/idempotent/unitnamespace.md new file mode 100644 index 0000000000..271da4e84f --- /dev/null +++ b/unison-src/transcripts/idempotent/unitnamespace.md @@ -0,0 +1,35 @@ +``` unison +`()`.foo = "bar" +``` + +``` ucm :added-by-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 : ##Text +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + `()`.foo : ##Text + +scratch/main> find + + 1. `()`.foo : ##Text + +scratch/main> find-in `()` + + 1. foo : ##Text + +scratch/main> delete.namespace `()` + + Done. +``` diff --git a/unison-src/transcripts/idempotent/universal-cmp.md b/unison-src/transcripts/idempotent/universal-cmp.md new file mode 100644 index 0000000000..23b14dd6ed --- /dev/null +++ b/unison-src/transcripts/idempotent/universal-cmp.md @@ -0,0 +1,75 @@ +File for test cases making sure that universal equality/comparison +cases exist for built-in types. Just making sure they don't crash. + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +unique type A = A + +threadEyeDeez _ = + t1 = forkComp '() + t2 = forkComp '() + (t1 == t2, t1 < t2) +``` + +``` ucm :added-by-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`: + + type A + threadEyeDeez : ∀ _. _ ->{IO} (Boolean, Boolean) +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type A + threadEyeDeez : ∀ _. _ ->{IO} (Boolean, Boolean) + +scratch/main> run threadEyeDeez + + (false, true) +``` + +``` unison +> typeLink A == typeLink A +> typeLink Text == typeLink Text +> typeLink Text == typeLink A +> termLink threadEyeDeez == termLink threadEyeDeez +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + ✅ + + scratch.u changed. + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | > typeLink A == typeLink A + ⧩ + true + + 2 | > typeLink Text == typeLink Text + ⧩ + true + + 3 | > typeLink Text == typeLink A + ⧩ + false + + 4 | > termLink threadEyeDeez == termLink threadEyeDeez + ⧩ + true +``` diff --git a/unison-src/transcripts/idempotent/unsafe-coerce.md b/unison-src/transcripts/idempotent/unsafe-coerce.md new file mode 100644 index 0000000000..16fe412eb5 --- /dev/null +++ b/unison-src/transcripts/idempotent/unsafe-coerce.md @@ -0,0 +1,54 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +f : '{} Nat +f _ = 5 + +fc : '{IO, Exception} Nat +fc = unsafe.coerceAbilities f + +main : '{IO, Exception} [Result] +main _ = + n = !fc + if n == 5 then [Ok ""] else [Fail ""] +``` + +``` ucm :added-by-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`: + + f : 'Nat + fc : '{IO, Exception} Nat + main : '{IO, Exception} [Result] +``` + +``` ucm +scratch/main> find unsafe.coerceAbilities + + 1. builtin.unsafe.coerceAbilities : (a ->{e1} b) -> a -> b + +scratch/main> add + + ⍟ I've added these definitions: + + f : 'Nat + fc : '{IO, Exception} Nat + main : '{IO, Exception} [Result] + +scratch/main> io.test main + + New test results: + + 1. main ◉ + + ✅ 1 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` diff --git a/unison-src/transcripts/idempotent/update-ignores-lib-namespace.md b/unison-src/transcripts/idempotent/update-ignores-lib-namespace.md new file mode 100644 index 0000000000..946fe14ceb --- /dev/null +++ b/unison-src/transcripts/idempotent/update-ignores-lib-namespace.md @@ -0,0 +1,67 @@ +`update` / `patch` (anything that a patch) ignores the namespace named "lib" at the location it's applied. This follows +the project organization convention that dependencies are put in "lib"; it's much easier to apply a patch to all of +one's own code if the "lib" namespace is simply ignored. + +``` ucm :hide +scratch/main> builtins.merge +``` + +``` unison +foo = 100 +lib.foo = 100 +``` + +``` ucm :added-by-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.foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + foo : Nat + lib.foo : Nat +``` + +``` unison +foo = 200 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + foo : Nat + (The old definition is also named lib.foo.) +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/main> names foo + + Term + Hash: #9ntnotdp87 + Names: foo +``` diff --git a/unison-src/transcripts/idempotent/update-on-conflict.md b/unison-src/transcripts/idempotent/update-on-conflict.md new file mode 100644 index 0000000000..3e2392be9f --- /dev/null +++ b/unison-src/transcripts/idempotent/update-on-conflict.md @@ -0,0 +1,67 @@ +# Update on conflict + +Conflicted definitions prevent `update` from succeeding. + +``` ucm :hide +scratch/main> builtins.merge lib.builtins +``` + +``` unison +x = 1 +temp = 2 +``` + +``` ucm :added-by-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`: + + temp : Nat + x : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + temp : Nat + x : Nat + +scratch/main> debug.alias.term.force temp x + + Done. + +scratch/main> delete.term temp + + Done. +``` + +``` unison +x = 3 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + x : Nat +``` + +``` ucm :error +scratch/main> update + + This branch has more than one term with the name `x`. Please + delete or rename all but one of them, then try the update + again. +``` diff --git a/unison-src/transcripts/idempotent/update-suffixifies-properly.md b/unison-src/transcripts/idempotent/update-suffixifies-properly.md new file mode 100644 index 0000000000..f0076b6ac8 --- /dev/null +++ b/unison-src/transcripts/idempotent/update-suffixifies-properly.md @@ -0,0 +1,95 @@ +``` ucm :hide +myproject/main> builtins.merge lib.builtin +``` + +``` unison +a.x.x.x.x = 100 +b.x.x.x.x = 100 +foo = 25 +c.y.y.y.y = foo + 10 +d.y.y.y.y = foo + 10 +bar = a.x.x.x.x + c.y.y.y.y +``` + +``` ucm :added-by-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`: + + a.x.x.x.x : Nat + b.x.x.x.x : Nat + bar : Nat + c.y.y.y.y : Nat + d.y.y.y.y : Nat + foo : Nat +``` + +``` ucm +myproject/main> add + + ⍟ I've added these definitions: + + a.x.x.x.x : Nat + b.x.x.x.x : Nat + bar : Nat + c.y.y.y.y : Nat + d.y.y.y.y : Nat + foo : Nat +``` + +``` unison +foo = +30 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + foo : Int +``` + +``` ucm :error +myproject/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Typechecking failed. I've updated your scratch file with the + definitions that need fixing. Once the file is compiling, try + `update` again. +``` + +``` unison :added-by-ucm scratch.u +foo = +30 + +-- The definitions below no longer typecheck with the changes above. +-- Please fix the errors and try `update` again. + +bar : Nat +bar = + use Nat + + x + c.y.y.y.y + +c.y.y.y.y : Nat +c.y.y.y.y = + use Nat + + foo + 10 + +d.y.y.y.y : Nat +d.y.y.y.y = + use Nat + + foo + 10 + +``` diff --git a/unison-src/transcripts/idempotent/update-term-aliases-in-different-ways.md b/unison-src/transcripts/idempotent/update-term-aliases-in-different-ways.md new file mode 100644 index 0000000000..edb264cb96 --- /dev/null +++ b/unison-src/transcripts/idempotent/update-term-aliases-in-different-ways.md @@ -0,0 +1,76 @@ +``` ucm +scratch/main> builtins.merge + + Done. +``` + +``` unison +foo : Nat +foo = 5 + +bar : Nat +bar = 5 +``` + +``` ucm :added-by-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`: + + bar : Nat + foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bar : Nat + foo : Nat +``` + +``` unison +foo : Nat +foo = 6 + +bar : Nat +bar = 7 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + bar : Nat + (The old definition is also named foo.) + foo : Nat + (The old definition is also named bar.) +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/main> view foo bar + + bar : Nat + bar = 7 + + foo : Nat + foo = 6 +``` diff --git a/unison-src/transcripts/idempotent/update-term-to-different-type.md b/unison-src/transcripts/idempotent/update-term-to-different-type.md new file mode 100644 index 0000000000..668492cc63 --- /dev/null +++ b/unison-src/transcripts/idempotent/update-term-to-different-type.md @@ -0,0 +1,62 @@ +``` ucm +scratch/main> builtins.merge + + Done. +``` + +``` unison +foo : Nat +foo = 5 +``` + +``` ucm :added-by-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 +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + foo : Nat +``` + +``` unison +foo : Int +foo = +5 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + foo : Int +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/main> view foo + + foo : Int + foo = +5 +``` diff --git a/unison-src/transcripts/idempotent/update-term-with-alias.md b/unison-src/transcripts/idempotent/update-term-with-alias.md new file mode 100644 index 0000000000..53a7e0b426 --- /dev/null +++ b/unison-src/transcripts/idempotent/update-term-with-alias.md @@ -0,0 +1,71 @@ +``` ucm +scratch/main> builtins.merge + + Done. +``` + +``` unison +foo : Nat +foo = 5 + +bar : Nat +bar = 5 +``` + +``` ucm :added-by-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`: + + bar : Nat + foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bar : Nat + foo : Nat +``` + +``` unison +foo : Nat +foo = 6 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + foo : Nat + (The old definition is also named bar.) +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/main> view foo bar + + bar : Nat + bar = 5 + + foo : Nat + foo = 6 +``` diff --git a/unison-src/transcripts/idempotent/update-term-with-dependent-to-different-type.md b/unison-src/transcripts/idempotent/update-term-with-dependent-to-different-type.md new file mode 100644 index 0000000000..46f4430d0c --- /dev/null +++ b/unison-src/transcripts/idempotent/update-term-with-dependent-to-different-type.md @@ -0,0 +1,80 @@ +``` ucm +scratch/main> builtins.merge + + Done. +``` + +``` unison +foo : Nat +foo = 5 + +bar : Nat +bar = foo + 10 +``` + +``` ucm :added-by-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`: + + bar : Nat + foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bar : Nat + foo : Nat +``` + +``` unison +foo : Int +foo = +5 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + foo : Int +``` + +``` ucm :error +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Typechecking failed. I've updated your scratch file with the + definitions that need fixing. Once the file is compiling, try + `update` again. +``` + +``` unison :added-by-ucm scratch.u +foo : Int +foo = +5 + +-- The definitions below no longer typecheck with the changes above. +-- Please fix the errors and try `update` again. + +bar : Nat +bar = + use Nat + + foo + 10 + +``` diff --git a/unison-src/transcripts/idempotent/update-term-with-dependent.md b/unison-src/transcripts/idempotent/update-term-with-dependent.md new file mode 100644 index 0000000000..0fb5cba6d6 --- /dev/null +++ b/unison-src/transcripts/idempotent/update-term-with-dependent.md @@ -0,0 +1,73 @@ +``` ucm +scratch/main> builtins.merge + + Done. +``` + +``` unison +foo : Nat +foo = 5 + +bar : Nat +bar = foo + 10 +``` + +``` ucm :added-by-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`: + + bar : Nat + foo : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + bar : Nat + foo : Nat +``` + +``` unison +foo : Nat +foo = 6 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + foo : Nat +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. + +scratch/main> view bar + + bar : Nat + bar = + use Nat + + foo + 10 +``` diff --git a/unison-src/transcripts/idempotent/update-term.md b/unison-src/transcripts/idempotent/update-term.md new file mode 100644 index 0000000000..05ed53fd95 --- /dev/null +++ b/unison-src/transcripts/idempotent/update-term.md @@ -0,0 +1,62 @@ +``` ucm +scratch/main> builtins.merge + + Done. +``` + +``` unison +foo : Nat +foo = 5 +``` + +``` ucm :added-by-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 +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + foo : Nat +``` + +``` unison +foo : Nat +foo = 6 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + foo : Nat +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/main> view foo + + foo : Nat + foo = 6 +``` diff --git a/unison-src/transcripts/idempotent/update-test-to-non-test.md b/unison-src/transcripts/idempotent/update-test-to-non-test.md new file mode 100644 index 0000000000..6735428e6a --- /dev/null +++ b/unison-src/transcripts/idempotent/update-test-to-non-test.md @@ -0,0 +1,75 @@ +``` ucm +scratch/main> builtins.merge + + Done. +``` + +``` unison +test> foo = [] +``` + +``` ucm :added-by-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 : [Result] + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | test> foo = [] + +``` + +After adding the test `foo`, we expect `view` to render it like a test. (Bug: It doesn't.) + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + foo : [Result] + +scratch/main> view foo + + foo : [Result] + foo = [] +``` + +``` unison +foo = 1 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + foo : Nat +``` + +After updating `foo` to not be a test, we expect `view` to not render it like a test. + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/main> view foo + + foo : Nat + foo = 1 +``` diff --git a/unison-src/transcripts/idempotent/update-test-watch-roundtrip.md b/unison-src/transcripts/idempotent/update-test-watch-roundtrip.md new file mode 100644 index 0000000000..93eb6e5d47 --- /dev/null +++ b/unison-src/transcripts/idempotent/update-test-watch-roundtrip.md @@ -0,0 +1,66 @@ +``` ucm :hide +scratch/main> builtins.merge +``` + +Given a test that depends on another definition, + +``` unison :hide +foo n = n + 1 + +test> mynamespace.foo.test = + n = 2 + if (foo n) == 2 then [ Ok "passed" ] else [ Fail "wat" ] +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + foo : Nat -> Nat + mynamespace.foo.test : [Result] +``` + +if we change the type of the dependency, the test should show in the scratch file as a test watch. + +``` unison +foo n = "hello, world!" +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + foo : n -> Text +``` + +``` ucm :error +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Typechecking failed. I've updated your scratch file with the + definitions that need fixing. Once the file is compiling, try + `update` again. +``` + +``` unison :added-by-ucm scratch.u +foo n = "hello, world!" + +-- The definitions below no longer typecheck with the changes above. +-- Please fix the errors and try `update` again. + +test> mynamespace.foo.test = + n = 2 + if foo n == 2 then [Ok "passed"] else [Fail "wat"] + +``` diff --git a/unison-src/transcripts/idempotent/update-type-add-constructor.md b/unison-src/transcripts/idempotent/update-type-add-constructor.md new file mode 100644 index 0000000000..743bf42c9b --- /dev/null +++ b/unison-src/transcripts/idempotent/update-type-add-constructor.md @@ -0,0 +1,72 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +unique type Foo + = Bar Nat +``` + +``` ucm :added-by-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`: + + type Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo +``` + +``` unison +unique type Foo + = Bar Nat + | Baz Nat Nat +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + type Foo +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/main> view Foo + + type Foo = Bar Nat | Baz Nat Nat + +scratch/main> find.verbose + + 1. -- #2sffq4apsq1cts53njcunj63fa8ohov4eqn77q14s77ajicajh4g28sq5s5ai33f2k6oh6o67aarnlpu7u7s4la07ag2er33epalsog + type Foo + + 2. -- #2sffq4apsq1cts53njcunj63fa8ohov4eqn77q14s77ajicajh4g28sq5s5ai33f2k6oh6o67aarnlpu7u7s4la07ag2er33epalsog#0 + Foo.Bar : Nat -> Foo + + 3. -- #2sffq4apsq1cts53njcunj63fa8ohov4eqn77q14s77ajicajh4g28sq5s5ai33f2k6oh6o67aarnlpu7u7s4la07ag2er33epalsog#1 + Foo.Baz : Nat -> Nat -> Foo + +``` diff --git a/unison-src/transcripts/idempotent/update-type-add-field.md b/unison-src/transcripts/idempotent/update-type-add-field.md new file mode 100644 index 0000000000..b59d840ea0 --- /dev/null +++ b/unison-src/transcripts/idempotent/update-type-add-field.md @@ -0,0 +1,66 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +unique type Foo = Bar Nat +``` + +``` ucm :added-by-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`: + + type Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo +``` + +``` unison +unique type Foo = Bar Nat Nat +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + type Foo +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/main> view Foo + + type Foo = Bar Nat Nat + +scratch/main> find.verbose + + 1. -- #8fk6k0j208th1ia4vnjtoc5fomd6le540prec255svg71bcfga9dofrvoq1d7v6010d6b6em4q51p8st5c5juhrev72cnnel8ko3o1g + type Foo + + 2. -- #8fk6k0j208th1ia4vnjtoc5fomd6le540prec255svg71bcfga9dofrvoq1d7v6010d6b6em4q51p8st5c5juhrev72cnnel8ko3o1g#0 + Foo.Bar : Nat -> Nat -> Foo + +``` diff --git a/unison-src/transcripts/idempotent/update-type-add-new-record.md b/unison-src/transcripts/idempotent/update-type-add-new-record.md new file mode 100644 index 0000000000..b6373bd0d9 --- /dev/null +++ b/unison-src/transcripts/idempotent/update-type-add-new-record.md @@ -0,0 +1,35 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtins +``` + +``` unison +unique type Foo = { bar : Nat } +``` + +``` ucm :added-by-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`: + + type Foo + Foo.bar : Foo -> Nat + Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + Foo.bar.set : Nat -> Foo -> Foo +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/main> view Foo + + type Foo = { bar : Nat } +``` diff --git a/unison-src/transcripts/idempotent/update-type-add-record-field.md b/unison-src/transcripts/idempotent/update-type-add-record-field.md new file mode 100644 index 0000000000..46f48385a3 --- /dev/null +++ b/unison-src/transcripts/idempotent/update-type-add-record-field.md @@ -0,0 +1,99 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +unique type Foo = { bar : Nat } +``` + +``` ucm :added-by-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`: + + type Foo + Foo.bar : Foo -> Nat + Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + Foo.bar.set : Nat -> Foo -> Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + Foo.bar : Foo -> Nat + Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + Foo.bar.set : Nat -> Foo -> Foo +``` + +``` unison +unique type Foo = { bar : Nat, baz : Int } +``` + +``` ucm :added-by-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.baz : Foo -> Int + Foo.baz.modify : (Int ->{g} Int) -> Foo ->{g} Foo + Foo.baz.set : Int -> Foo -> Foo + + ⍟ These names already exist. You can `update` them to your + new definition: + + type Foo + Foo.bar : Foo -> Nat + Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + Foo.bar.set : Nat -> Foo -> Foo +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/main> view Foo + + type Foo = { bar : Nat, baz : Int } + +scratch/main> find.verbose + + 1. -- #05gh1dur4778dauh9slaofprc5356n47qpove0c1jl0birt2fcu301js8auu5vfr5bjfga9j8ikuk07ll9fu1gj3ehrp3basguhsd58 + type Foo + + 2. -- #77mi33dv8ac2s90852khi35km5gsamhnpada8mai0k36obbttgg17qld719ospcs1ht9ctolg3pjsqs6qjnl3hfmu493rgsher73sc0 + Foo.bar : Foo -> Nat + + 3. -- #7m1n2178r5u12jdnb6crcmanu2gm961kdvbjul5m6hta1s57avibsvk6p5g9efut8sennpgstbb8kf97eujbbuiplsoloa4cael7t90 + Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + + 4. -- #ghuqoel4pao6v8e7un238i3e86vv7a7pnvgaq8m9s32edm1upgv35gri2iu32ipn9r4poli56r5kr3vtjfrltem696grfl75al4jkgg + Foo.bar.set : Nat -> Foo -> Foo + + 5. -- #p8emkm2s09n3nsd8ne5f6fro0vsldk8pn7n6rcf417anuvvun43qrk1ioofs6pdq4537eosao17c7ibvktktr3lfqglmj26gmbulmj0 + Foo.baz : Foo -> Int + + 6. -- #0il9pl29jpe3fh6vp3qeqai73915k3qffhf4bgttrgsj000b9fgs3bqoj8ugjop6kdr04acc34m1bj7lf417tslfeva7dmmoqdu5hug + Foo.baz.modify : (Int ->{g} Int) -> Foo ->{g} Foo + + 7. -- #87rjeqltvvd4adffsheqae62eefoge8p78pvnjdkc9q1stq20lhubvtpos0io4v3vhnol8nn2uollup97l4orq1fh2h12b0imeuuc58 + Foo.baz.set : Int -> Foo -> Foo + + 8. -- #05gh1dur4778dauh9slaofprc5356n47qpove0c1jl0birt2fcu301js8auu5vfr5bjfga9j8ikuk07ll9fu1gj3ehrp3basguhsd58#0 + Foo.Foo : Nat -> Int -> Foo + +``` diff --git a/unison-src/transcripts/idempotent/update-type-constructor-alias.md b/unison-src/transcripts/idempotent/update-type-constructor-alias.md new file mode 100644 index 0000000000..044772b2db --- /dev/null +++ b/unison-src/transcripts/idempotent/update-type-constructor-alias.md @@ -0,0 +1,63 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +unique type Foo = Bar Nat +``` + +``` ucm :added-by-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`: + + type Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + +scratch/main> alias.term Foo.Bar Foo.BarAlias + + Done. +``` + +``` unison +unique type Foo = Bar Nat Nat +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + type Foo +``` + +``` ucm :error +scratch/main> update + + Sorry, I wasn't able to perform the update: + + The type Foo has a constructor with multiple names, and I + can't perform an update in this situation: + + * Foo.Bar + * Foo.BarAlias + + Please delete all but one name for each constructor, and then + try updating again. +``` diff --git a/unison-src/transcripts/idempotent/update-type-delete-constructor-with-dependent.md b/unison-src/transcripts/idempotent/update-type-delete-constructor-with-dependent.md new file mode 100644 index 0000000000..8c11024b9c --- /dev/null +++ b/unison-src/transcripts/idempotent/update-type-delete-constructor-with-dependent.md @@ -0,0 +1,80 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +unique type Foo + = Bar Nat + | Baz Nat Nat + +foo : Foo -> Nat +foo = cases + Bar n -> n + Baz n m -> n + m +``` + +``` ucm :added-by-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`: + + type Foo + foo : Foo -> Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + foo : Foo -> Nat +``` + +``` unison +unique type Foo + = Bar Nat +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + type Foo +``` + +``` ucm :error +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Typechecking failed. I've updated your scratch file with the + definitions that need fixing. Once the file is compiling, try + `update` again. +``` + +``` unison :added-by-ucm scratch.u +type Foo = Bar Nat + +-- The definitions below no longer typecheck with the changes above. +-- Please fix the errors and try `update` again. + +foo : Foo -> Nat +foo = cases + Bar n -> n + Baz n m -> n Nat.+ m + +``` diff --git a/unison-src/transcripts/idempotent/update-type-delete-constructor.md b/unison-src/transcripts/idempotent/update-type-delete-constructor.md new file mode 100644 index 0000000000..1f6b205ce5 --- /dev/null +++ b/unison-src/transcripts/idempotent/update-type-delete-constructor.md @@ -0,0 +1,69 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +unique type Foo + = Bar Nat + | Baz Nat Nat +``` + +``` ucm :added-by-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`: + + type Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo +``` + +``` unison +unique type Foo + = Bar Nat +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + type Foo +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/main> view Foo + + type Foo = Bar Nat + +scratch/main> find.verbose + + 1. -- #b509v3eg4kehsg29g6pvrogeb71ue32nm2fj9284n4i7lprsr7u9a7g6s695d09du0fsfti6rrsk1s62q5thpr1jjkqb3us3s0lrd60 + type Foo + + 2. -- #b509v3eg4kehsg29g6pvrogeb71ue32nm2fj9284n4i7lprsr7u9a7g6s695d09du0fsfti6rrsk1s62q5thpr1jjkqb3us3s0lrd60#0 + Foo.Bar : Nat -> Foo + +``` diff --git a/unison-src/transcripts/idempotent/update-type-delete-record-field.md b/unison-src/transcripts/idempotent/update-type-delete-record-field.md new file mode 100644 index 0000000000..ec2417d02b --- /dev/null +++ b/unison-src/transcripts/idempotent/update-type-delete-record-field.md @@ -0,0 +1,122 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +unique type Foo = { bar : Nat, baz : Int } +``` + +``` ucm :added-by-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`: + + type Foo + Foo.bar : Foo -> Nat + Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + Foo.bar.set : Nat -> Foo -> Foo + Foo.baz : Foo -> Int + Foo.baz.modify : (Int ->{g} Int) -> Foo ->{g} Foo + Foo.baz.set : Int -> Foo -> Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + Foo.bar : Foo -> Nat + Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + Foo.bar.set : Nat -> Foo -> Foo + Foo.baz : Foo -> Int + Foo.baz.modify : (Int ->{g} Int) -> Foo ->{g} Foo + Foo.baz.set : Int -> Foo -> Foo +``` + +``` unison +unique type Foo = { bar : Nat } +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + type Foo + Foo.bar : Foo -> Nat + Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + Foo.bar.set : Nat -> Foo -> Foo +``` + +We want the field accessors to go away; but for now they are here, causing the update to fail. + +``` ucm :error +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Typechecking failed. I've updated your scratch file with the + definitions that need fixing. Once the file is compiling, try + `update` again. + +scratch/main> view Foo + + type Foo = { bar : Nat, baz : Int } + +scratch/main> find.verbose + + 1. -- #05gh1dur4778dauh9slaofprc5356n47qpove0c1jl0birt2fcu301js8auu5vfr5bjfga9j8ikuk07ll9fu1gj3ehrp3basguhsd58 + type Foo + + 2. -- #77mi33dv8ac2s90852khi35km5gsamhnpada8mai0k36obbttgg17qld719ospcs1ht9ctolg3pjsqs6qjnl3hfmu493rgsher73sc0 + Foo.bar : Foo -> Nat + + 3. -- #7m1n2178r5u12jdnb6crcmanu2gm961kdvbjul5m6hta1s57avibsvk6p5g9efut8sennpgstbb8kf97eujbbuiplsoloa4cael7t90 + Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + + 4. -- #ghuqoel4pao6v8e7un238i3e86vv7a7pnvgaq8m9s32edm1upgv35gri2iu32ipn9r4poli56r5kr3vtjfrltem696grfl75al4jkgg + Foo.bar.set : Nat -> Foo -> Foo + + 5. -- #p8emkm2s09n3nsd8ne5f6fro0vsldk8pn7n6rcf417anuvvun43qrk1ioofs6pdq4537eosao17c7ibvktktr3lfqglmj26gmbulmj0 + Foo.baz : Foo -> Int + + 6. -- #0il9pl29jpe3fh6vp3qeqai73915k3qffhf4bgttrgsj000b9fgs3bqoj8ugjop6kdr04acc34m1bj7lf417tslfeva7dmmoqdu5hug + Foo.baz.modify : (Int ->{g} Int) -> Foo ->{g} Foo + + 7. -- #87rjeqltvvd4adffsheqae62eefoge8p78pvnjdkc9q1stq20lhubvtpos0io4v3vhnol8nn2uollup97l4orq1fh2h12b0imeuuc58 + Foo.baz.set : Int -> Foo -> Foo + + 8. -- #05gh1dur4778dauh9slaofprc5356n47qpove0c1jl0birt2fcu301js8auu5vfr5bjfga9j8ikuk07ll9fu1gj3ehrp3basguhsd58#0 + Foo.Foo : Nat -> Int -> Foo + +``` + +``` unison :added-by-ucm scratch.u +type Foo = { bar : Nat } + +-- The definitions below no longer typecheck with the changes above. +-- Please fix the errors and try `update` again. + +Foo.baz : Foo -> Int +Foo.baz = cases Foo _ baz -> baz + +Foo.baz.modify : (Int ->{g} Int) -> Foo ->{g} Foo +Foo.baz.modify f = cases Foo bar baz -> Foo bar (f baz) + +Foo.baz.set : Int -> Foo -> Foo +Foo.baz.set baz1 = cases Foo bar _ -> Foo bar baz1 + +``` diff --git a/unison-src/transcripts/idempotent/update-type-missing-constructor.md b/unison-src/transcripts/idempotent/update-type-missing-constructor.md new file mode 100644 index 0000000000..f88af7b953 --- /dev/null +++ b/unison-src/transcripts/idempotent/update-type-missing-constructor.md @@ -0,0 +1,67 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +unique type Foo = Bar Nat +``` + +``` ucm :added-by-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`: + + type Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + +scratch/main> delete.term Foo.Bar + + Done. +``` + +Now we've set up a situation where the original constructor missing. + +``` unison +unique type Foo = Bar Nat Nat +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + type Foo +``` + +``` ucm :error +scratch/main> view Foo + + type Foo = #b509v3eg4k#0 Nat + +scratch/main> update + + Sorry, I wasn't able to perform the update: + + The type Foo has some constructors with missing names, and I + can't perform an update in this situation. + + You can use `view Foo` and + `alias.term Foo.` to give names to + each unnamed constructor, and then try the update again. +``` diff --git a/unison-src/transcripts/idempotent/update-type-nested-decl-aliases.md b/unison-src/transcripts/idempotent/update-type-nested-decl-aliases.md new file mode 100644 index 0000000000..5ce5ee0fea --- /dev/null +++ b/unison-src/transcripts/idempotent/update-type-nested-decl-aliases.md @@ -0,0 +1,60 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +unique type Foo = Bar Nat + +structural type A.B = OneAlias Foo +structural type A = B.TheOtherAlias Foo +``` + +``` ucm :added-by-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`: + + structural type A + structural type A.B + type Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + structural type A + structural type A.B + type Foo +``` + +``` unison +unique type Foo = Bar Nat Nat +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + type Foo +``` + +``` ucm :error +scratch/main> update + + The type A.B is an alias of A. I'm not able to perform an + update when a type exists nested under an alias of itself. + Please separate them or delete one copy, and then try updating + again. +``` diff --git a/unison-src/transcripts/idempotent/update-type-no-op-record.md b/unison-src/transcripts/idempotent/update-type-no-op-record.md new file mode 100644 index 0000000000..0b8888835c --- /dev/null +++ b/unison-src/transcripts/idempotent/update-type-no-op-record.md @@ -0,0 +1,44 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +unique type Foo = { bar : Nat } +``` + +``` ucm :added-by-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`: + + type Foo + Foo.bar : Foo -> Nat + Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + Foo.bar.set : Nat -> Foo -> Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + Foo.bar : Foo -> Nat + Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + Foo.bar.set : Nat -> Foo -> Foo +``` + +Bug: this no-op update should (of course) succeed. + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. +``` diff --git a/unison-src/transcripts/idempotent/update-type-stray-constructor-alias.md b/unison-src/transcripts/idempotent/update-type-stray-constructor-alias.md new file mode 100644 index 0000000000..8e29e089ba --- /dev/null +++ b/unison-src/transcripts/idempotent/update-type-stray-constructor-alias.md @@ -0,0 +1,61 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +unique type Foo = Bar Nat +``` + +``` ucm :added-by-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`: + + type Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + +scratch/main> alias.term Foo.Bar Stray.BarAlias + + Done. +``` + +``` unison +unique type Foo = Bar Nat Nat +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + type Foo +``` + +``` ucm :error +scratch/main> update + + Sorry, I wasn't able to perform the update, because I need all + constructor names to be nested somewhere beneath the + corresponding type name. + + The constructor Stray.BarAlias is not nested beneath the + corresponding type name. Please either use `move` to move it, + or if it's an extra copy, you can simply `delete` it. Then try + the update again. +``` diff --git a/unison-src/transcripts/idempotent/update-type-stray-constructor.md b/unison-src/transcripts/idempotent/update-type-stray-constructor.md new file mode 100644 index 0000000000..8e5aaa91cb --- /dev/null +++ b/unison-src/transcripts/idempotent/update-type-stray-constructor.md @@ -0,0 +1,69 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +unique type Foo = Bar Nat +``` + +``` ucm :added-by-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`: + + type Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + +scratch/main> move.term Foo.Bar Stray.Bar + + Done. +``` + +Now we've set up a situation where the constructor is not where it's supposed to be; it's somewhere else. + +``` unison +unique type Foo = Bar Nat Nat +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + type Foo +``` + +Note that the constructor name shown here (implied to be called `Foo.Stray.Bar`) doesn't really exist, it's just showing up due to a pretty-printer bug. + +``` ucm :error +scratch/main> view Foo + + type Foo = Stray.Bar Nat + +scratch/main> update + + Sorry, I wasn't able to perform the update: + + The type Foo has some constructors with missing names, and I + can't perform an update in this situation. + + You can use `view Foo` and + `alias.term Foo.` to give names to + each unnamed constructor, and then try the update again. +``` diff --git a/unison-src/transcripts/idempotent/update-type-turn-constructor-into-smart-constructor.md b/unison-src/transcripts/idempotent/update-type-turn-constructor-into-smart-constructor.md new file mode 100644 index 0000000000..baf5d34cd9 --- /dev/null +++ b/unison-src/transcripts/idempotent/update-type-turn-constructor-into-smart-constructor.md @@ -0,0 +1,85 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +unique type Foo = Bar Nat + +makeFoo : Nat -> Foo +makeFoo n = Bar (n+10) +``` + +``` ucm :added-by-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`: + + type Foo + makeFoo : Nat -> Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + makeFoo : Nat -> Foo +``` + +``` unison +unique type Foo = internal.Bar Nat + +Foo.Bar : Nat -> Foo +Foo.Bar n = internal.Bar n +``` + +``` ucm :added-by-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: + + ⊡ Previously added definitions will be ignored: Foo + + ⍟ These new definitions are ok to `add`: + + Foo.Bar : Nat -> Foo +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. + +scratch/main> view Foo + + type Foo = internal.Bar Nat + +scratch/main> find.verbose + + 1. -- #b509v3eg4kehsg29g6pvrogeb71ue32nm2fj9284n4i7lprsr7u9a7g6s695d09du0fsfti6rrsk1s62q5thpr1jjkqb3us3s0lrd60 + type Foo + + 2. -- #36rn6jqt1k5jccb3c7vagp3jam74dngr92kgcntqhs6dbkua54verfert2i6hsku6uitt9s2jvt1msric0tgemal52d5apav6akn25o + Foo.Bar : Nat -> Foo + + 3. -- #b509v3eg4kehsg29g6pvrogeb71ue32nm2fj9284n4i7lprsr7u9a7g6s695d09du0fsfti6rrsk1s62q5thpr1jjkqb3us3s0lrd60#0 + Foo.internal.Bar : Nat -> Foo + + 4. -- #204frdcl0iid1ujkkfbkc6b3v7cgqp56h1q3duc46i5md6qb4m6am1fqbceb335u87l05gkdnaa7fjn4alj1diukgme63e41lh072l8 + makeFoo : Nat -> Foo + +``` diff --git a/unison-src/transcripts/idempotent/update-type-turn-non-record-into-record.md b/unison-src/transcripts/idempotent/update-type-turn-non-record-into-record.md new file mode 100644 index 0000000000..ed6fd0aa95 --- /dev/null +++ b/unison-src/transcripts/idempotent/update-type-turn-non-record-into-record.md @@ -0,0 +1,81 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +unique type Foo = Nat +``` + +``` ucm :added-by-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`: + + type Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo +``` + +``` unison +unique type Foo = { bar : Nat } +``` + +``` ucm :added-by-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.bar : Foo -> Nat + Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + Foo.bar.set : Nat -> Foo -> Foo + + ⍟ These names already exist. You can `update` them to your + new definition: + + type Foo +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/main> view Foo + + type Foo = { bar : Nat } + +scratch/main> find.verbose + + 1. -- #b509v3eg4kehsg29g6pvrogeb71ue32nm2fj9284n4i7lprsr7u9a7g6s695d09du0fsfti6rrsk1s62q5thpr1jjkqb3us3s0lrd60 + type Foo + + 2. -- #ovhevqfin94qhq5fu0mujfi20mbpvg5mh4vsfklrohp84cch4lhvrn5p29cnbsqfm92l7bt8c1vpjooh72a0psbddvvten4gq2sipag + Foo.bar : Foo -> Nat + + 3. -- #as72md2u70e0u9s2ig2ug7jvlbrk1mubo8qlfokpuvgusg35svh05r7nsj27sqo5edeghjnk8g8259fi4ismse736v4n5ojrb3o2le8 + Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo + + 4. -- #5cbctoor75nbtn4ppp10qm1i25gqt2lgth3itqa0lloib32je4ijfj2n3qcdfhmdcnbgum2jg46opntlohv7ladun3dmefl1ucgobeg + Foo.bar.set : Nat -> Foo -> Foo + + 5. -- #b509v3eg4kehsg29g6pvrogeb71ue32nm2fj9284n4i7lprsr7u9a7g6s695d09du0fsfti6rrsk1s62q5thpr1jjkqb3us3s0lrd60#0 + Foo.Foo : Nat -> Foo + +``` diff --git a/unison-src/transcripts/idempotent/update-type-with-dependent-term.md b/unison-src/transcripts/idempotent/update-type-with-dependent-term.md new file mode 100644 index 0000000000..c59e3bef59 --- /dev/null +++ b/unison-src/transcripts/idempotent/update-type-with-dependent-term.md @@ -0,0 +1,73 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +unique type Foo = Bar Nat + +incrFoo : Foo -> Foo +incrFoo = cases Bar n -> Bar (n+1) +``` + +``` ucm :added-by-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`: + + type Foo + incrFoo : Foo -> Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Foo + incrFoo : Foo -> Foo +``` + +``` unison +unique type Foo = Bar Nat Nat +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + type Foo +``` + +``` ucm :error +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Typechecking failed. I've updated your scratch file with the + definitions that need fixing. Once the file is compiling, try + `update` again. +``` + +``` unison :added-by-ucm scratch.u +type Foo = Bar Nat Nat + +-- The definitions below no longer typecheck with the changes above. +-- Please fix the errors and try `update` again. + +incrFoo : Foo -> Foo +incrFoo = cases Bar n -> Bar (n Nat.+ 1) + +``` diff --git a/unison-src/transcripts/idempotent/update-type-with-dependent-type-to-different-kind.md b/unison-src/transcripts/idempotent/update-type-with-dependent-type-to-different-kind.md new file mode 100644 index 0000000000..e1b257cf7c --- /dev/null +++ b/unison-src/transcripts/idempotent/update-type-with-dependent-type-to-different-kind.md @@ -0,0 +1,70 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +unique type Foo = Bar Nat +unique type Baz = Qux Foo +``` + +``` ucm :added-by-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`: + + type Baz + type Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Baz + type Foo +``` + +``` unison +unique type Foo a = Bar Nat a +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + type Foo a +``` + +``` ucm :error +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Typechecking failed. I've updated your scratch file with the + definitions that need fixing. Once the file is compiling, try + `update` again. +``` + +``` unison :added-by-ucm scratch.u +type Foo a = Bar Nat a + +-- The definitions below no longer typecheck with the changes above. +-- Please fix the errors and try `update` again. + +type Baz = Qux Foo + +``` diff --git a/unison-src/transcripts/idempotent/update-type-with-dependent-type.md b/unison-src/transcripts/idempotent/update-type-with-dependent-type.md new file mode 100644 index 0000000000..dea13297d2 --- /dev/null +++ b/unison-src/transcripts/idempotent/update-type-with-dependent-type.md @@ -0,0 +1,83 @@ +``` ucm :hide +scratch/main> builtins.merge lib.builtin +``` + +``` unison +unique type Foo = Bar Nat +unique type Baz = Qux Foo +``` + +``` ucm :added-by-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`: + + type Baz + type Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Baz + type Foo +``` + +``` unison +unique type Foo = Bar Nat Nat +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + type Foo +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + That's done. Now I'm making sure everything typechecks... + + Everything typechecks, so I'm saving the results... + + Done. + +scratch/main> view Foo + + type Foo = Bar Nat Nat + +scratch/main> view Baz + + type Baz = Qux Foo + +scratch/main> find.verbose + + 1. -- #34msh9satlfog576493eo9pkjn6aj7d8fj6jfheglvgr5s39iptb81649bpkad1lqraheqb8em9ms551k01oternhknc4m7jicgtk08 + type Baz + + 2. -- #34msh9satlfog576493eo9pkjn6aj7d8fj6jfheglvgr5s39iptb81649bpkad1lqraheqb8em9ms551k01oternhknc4m7jicgtk08#0 + Baz.Qux : Foo -> Baz + + 3. -- #8fk6k0j208th1ia4vnjtoc5fomd6le540prec255svg71bcfga9dofrvoq1d7v6010d6b6em4q51p8st5c5juhrev72cnnel8ko3o1g + type Foo + + 4. -- #8fk6k0j208th1ia4vnjtoc5fomd6le540prec255svg71bcfga9dofrvoq1d7v6010d6b6em4q51p8st5c5juhrev72cnnel8ko3o1g#0 + Foo.Bar : Nat -> Nat -> Foo + +``` diff --git a/unison-src/transcripts/idempotent/update-watch.md b/unison-src/transcripts/idempotent/update-watch.md new file mode 100644 index 0000000000..6772cf521b --- /dev/null +++ b/unison-src/transcripts/idempotent/update-watch.md @@ -0,0 +1,27 @@ +``` unison +> 1 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + ✅ + + scratch.u changed. + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | > 1 + ⧩ + 1 +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. +``` diff --git a/unison-src/transcripts/idempotent/upgrade-happy-path.md b/unison-src/transcripts/idempotent/upgrade-happy-path.md new file mode 100644 index 0000000000..dcc674be5a --- /dev/null +++ b/unison-src/transcripts/idempotent/upgrade-happy-path.md @@ -0,0 +1,73 @@ +``` ucm :hide +proj/main> builtins.merge lib.builtin +``` + +``` unison +lib.old.foo = 17 +lib.new.foo = 18 +thingy = lib.old.foo + 10 +``` + +``` ucm :added-by-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`: + + lib.new.foo : Nat + lib.old.foo : Nat + thingy : Nat +``` + +``` ucm +proj/main> add + + ⍟ I've added these definitions: + + lib.new.foo : Nat + lib.old.foo : Nat + thingy : Nat +``` + +Test tab completion and fzf options of upgrade command. + +``` ucm +proj/main> debug.tab-complete upgrade ol + + old + +proj/main> debug.fuzzy-options upgrade _ + + Select a dependency to upgrade: + * builtin + * new + * old + +proj/main> debug.fuzzy-options upgrade old _ + + Select a dependency to upgrade to: + * builtin + * new + * old +``` + +``` ucm +proj/main> upgrade old new + + I upgraded old to new, and removed old. + +proj/main> ls lib + + 1. builtin/ (469 terms, 74 types) + 2. new/ (1 term) + +proj/main> view thingy + + thingy : Nat + thingy = + use Nat + + foo + 10 +``` diff --git a/unison-src/transcripts/idempotent/upgrade-sad-path.md b/unison-src/transcripts/idempotent/upgrade-sad-path.md new file mode 100644 index 0000000000..2c56bf72d8 --- /dev/null +++ b/unison-src/transcripts/idempotent/upgrade-sad-path.md @@ -0,0 +1,109 @@ +``` ucm :hide +proj/main> builtins.merge lib.builtin +``` + +``` unison +lib.old.foo = 17 +lib.new.foo = +18 +thingy = lib.old.foo + 10 +``` + +``` ucm :added-by-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`: + + lib.new.foo : Int + lib.old.foo : Nat + thingy : Nat +``` + +``` ucm +proj/main> add + + ⍟ I've added these definitions: + + lib.new.foo : Int + lib.old.foo : Nat + thingy : Nat +``` + +``` ucm :error +proj/main> upgrade old new + + I couldn't automatically upgrade old to new. However, I've + added the definitions that need attention to the top of + scratch.u. + + When you're done, you can run + + upgrade.commit + + to merge your changes back into main and delete the temporary + branch. Or, if you decide to cancel the upgrade instead, you + can run + + delete.branch /upgrade-old-to-new + + to delete the temporary branch and switch back to main. +``` + +``` unison :added-by-ucm scratch.u +thingy : Nat +thingy = + use Nat + + foo + 10 +``` + +Resolve the error and commit the upgrade. + +``` unison +thingy = foo + +10 +``` + +``` ucm :added-by-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 names already exist. You can `update` them to your + new definition: + + thingy : Int +``` + +``` ucm +proj/upgrade-old-to-new> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +proj/upgrade-old-to-new> upgrade.commit + + I fast-forward merged proj/upgrade-old-to-new into proj/main. + +proj/main> view thingy + + thingy : Int + thingy = + use Int + + foo + +10 + +proj/main> ls lib + + 1. builtin/ (469 terms, 74 types) + 2. new/ (1 term) + +proj/main> branches + + Branch Remote branch + 1. main +``` diff --git a/unison-src/transcripts/idempotent/upgrade-suffixifies-properly.md b/unison-src/transcripts/idempotent/upgrade-suffixifies-properly.md new file mode 100644 index 0000000000..96bee848b0 --- /dev/null +++ b/unison-src/transcripts/idempotent/upgrade-suffixifies-properly.md @@ -0,0 +1,82 @@ +``` ucm :hide +myproject/main> builtins.merge lib.builtin +``` + +``` unison +lib.old.foo = 25 +lib.new.foo = +30 +a.x.x.x.x = 100 +b.x.x.x.x = 100 +c.y.y.y.y = lib.old.foo + 10 +d.y.y.y.y = lib.old.foo + 10 +bar = a.x.x.x.x + c.y.y.y.y +``` + +``` ucm :added-by-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`: + + a.x.x.x.x : Nat + b.x.x.x.x : Nat + bar : Nat + c.y.y.y.y : Nat + d.y.y.y.y : Nat + lib.new.foo : Int + lib.old.foo : Nat +``` + +``` ucm +myproject/main> add + + ⍟ I've added these definitions: + + a.x.x.x.x : Nat + b.x.x.x.x : Nat + bar : Nat + c.y.y.y.y : Nat + d.y.y.y.y : Nat + lib.new.foo : Int + lib.old.foo : Nat +``` + +``` ucm :error +myproject/main> upgrade old new + + I couldn't automatically upgrade old to new. However, I've + added the definitions that need attention to the top of + scratch.u. + + When you're done, you can run + + upgrade.commit + + to merge your changes back into main and delete the temporary + branch. Or, if you decide to cancel the upgrade instead, you + can run + + delete.branch /upgrade-old-to-new + + to delete the temporary branch and switch back to main. +``` + +``` unison :added-by-ucm scratch.u +bar : Nat +bar = + use Nat + + x + c.y.y.y.y + +c.y.y.y.y : Nat +c.y.y.y.y = + use Nat + + foo + 10 + +d.y.y.y.y : Nat +d.y.y.y.y = + use Nat + + foo + 10 +``` diff --git a/unison-src/transcripts/idempotent/upgrade-with-old-alias.md b/unison-src/transcripts/idempotent/upgrade-with-old-alias.md new file mode 100644 index 0000000000..4038b3df88 --- /dev/null +++ b/unison-src/transcripts/idempotent/upgrade-with-old-alias.md @@ -0,0 +1,50 @@ +``` ucm :hide +myproject/main> builtins.merge lib.builtin +``` + +``` unison +lib.old.foo = 141 +lib.new.foo = 142 +bar = 141 +mything = lib.old.foo + 100 +``` + +``` ucm :added-by-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`: + + bar : Nat + lib.new.foo : Nat + lib.old.foo : Nat + mything : Nat +``` + +``` ucm +myproject/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +myproject/main> upgrade old new + + I upgraded old to new, and removed old. + +myproject/main> view mything + + mything : Nat + mything = + use Nat + + foo + 100 + +myproject/main> view bar + + bar : Nat + bar = 141 +``` diff --git a/unison-src/transcripts/view.md b/unison-src/transcripts/idempotent/view.md similarity index 75% rename from unison-src/transcripts/view.md rename to unison-src/transcripts/idempotent/view.md index 5c2b0e8c58..05ed7f006e 100644 --- a/unison-src/transcripts/view.md +++ b/unison-src/transcripts/idempotent/view.md @@ -1,29 +1,40 @@ # View commands -```ucm:hide +``` ucm :hide scratch/main> builtins.merge ``` -```unison:hide +``` unison :hide a.thing = "a" b.thing = "b" ``` -```ucm:hide +``` ucm :hide scratch/main> add ``` -```ucm +``` ucm -- Should suffix-search and find values in sub-namespaces + scratch/main> view thing + + a.thing : Text + a.thing = "a" + + b.thing : Text + b.thing = "b" + -- Should support absolute paths + scratch/main> view .b.thing -``` + .b.thing : Text + .b.thing = "b" +``` TODO: swap this back to a 'ucm' block when view.global is re-implemented -``` +``` -- view.global should search globally and be absolutely qualified scratch/other> view.global thing -- Should support branch relative paths diff --git a/unison-src/transcripts/idempotent/watch-expressions.md b/unison-src/transcripts/idempotent/watch-expressions.md new file mode 100644 index 0000000000..dffa25f89f --- /dev/null +++ b/unison-src/transcripts/idempotent/watch-expressions.md @@ -0,0 +1,94 @@ +``` ucm +scratch/main> builtins.mergeio + + Done. +``` + +``` unison +test> pass = [Ok "Passed"] +``` + +``` ucm :added-by-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`: + + pass : [Result] + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | test> pass = [Ok "Passed"] + + ✅ Passed Passed +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + pass : [Result] +``` + +``` unison +test> pass = [Ok "Passed"] +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I found and typechecked the definitions in scratch.u. This + file has been previously added to the codebase. + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | test> pass = [Ok "Passed"] + + ✅ Passed Passed (cached) +``` + +``` ucm +scratch/main> add + + ⊡ Ignored previously added definitions: pass + +scratch/main> test + + Cached test results (`help testcache` to learn more) + + 1. pass ◉ Passed + + ✅ 1 test(s) passing + + Tip: Use view 1 to view the source of a test. +``` + +``` unison +> ImmutableArray.fromList [?a, ?b, ?c] +> ImmutableByteArray.fromBytes 0xs123456 +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + ✅ + + scratch.u changed. + + Now evaluating any watch expressions (lines starting with + `>`)... Ctrl+C cancels. + + 1 | > ImmutableArray.fromList [?a, ?b, ?c] + ⧩ + ImmutableArray.fromList [?a, ?b, ?c] + + 2 | > ImmutableByteArray.fromBytes 0xs123456 + ⧩ + fromBytes 0xs123456 +``` diff --git a/unison-src/transcripts/input-parse-errors.output.md b/unison-src/transcripts/input-parse-errors.output.md deleted file mode 100644 index 4dc0dc8133..0000000000 --- a/unison-src/transcripts/input-parse-errors.output.md +++ /dev/null @@ -1,207 +0,0 @@ -# demonstrating our new input parsing errors - -``` unison -x = 55 -``` - -`handleNameArg` parse error in `add` - -``` ucm -scratch/main> add . - -⚠️ - -Sorry, I wasn’t sure how to process your request: - - 1:2: - | - 1 | . - | ^ - unexpected end of input - expecting '`' or operator (valid characters: !$%&*+-/:<=>\^|~) - - -You can run `help add` for more information on using `add`. - -scratch/main> ls - - 1. lib/ (469 terms, 74 types) - 2. x (Nat) - -scratch/main> add 1 - - - -scratch/main> ls - - 1. lib/ (469 terms, 74 types) - 2. x (Nat) - -scratch/main> add 2 - - ⊡ Ignored previously added definitions: x - -``` -todo: - -``` haskell - SA.Name name -> pure name - SA.NameWithBranchPrefix (Left _) name -> pure name - SA.NameWithBranchPrefix (Right prefix) name -> pure $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name - SA.HashQualified hqname -> maybe (Left "can’t find a name from the numbered arg") pure $ HQ.toName hqname - SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ HQ'.toName hqname - SA.HashQualifiedWithBranchPrefix (Right prefix) hqname -> - pure . Path.prefixNameIfRel (Path.AbsolutePath' prefix) $ HQ'.toName hqname - SA.ShallowListEntry prefix entry -> - pure . HQ'.toName . fmap (Path.prefixNameIfRel prefix) $ shallowListEntryToHQ' entry - SA.SearchResult mpath result -> - maybe (Left "can’t find a name from the numbered arg") pure . HQ.toName $ searchResultToHQ mpath result - otherNumArg -> Left . I.Formatted $ wrongStructuredArgument "a name" otherNumArg -``` - -aliasMany: skipped -- similar to `add` - -``` ucm -scratch/main> update arg - -⚠️ - -Sorry, I wasn’t sure how to process your request: - - I expected no arguments, but received one. - -You can run `help update` for more information on using -`update`. - -``` -aliasTerm - -``` -scratch/main> alias.term ##Nat.+ Nat.+ -``` - -aliasTermForce, -aliasType, - -todo: - -``` - -aliasMany, -api, -authLogin, -back, -branchEmptyInputPattern, -branchInputPattern, -branchRenameInputPattern, -branchesInputPattern, -cd, -clear, -clone, -compileScheme, -createAuthor, -debugClearWatchCache, -debugDoctor, -debugDumpNamespace, -debugDumpNamespaceSimple, -debugTerm, -debugTermVerbose, -debugType, -debugLSPFoldRanges, -debugFileHashes, -debugNameDiff, -debugNumberedArgs, -debugTabCompletion, -debugFuzzyOptions, -debugFormat, -delete, -deleteBranch, -deleteProject, -deleteNamespace, -deleteNamespaceForce, -deleteTerm, -deleteTermVerbose, -deleteType, -deleteTypeVerbose, -deleteVerbose, -dependencies, -dependents, -diffNamespace, -display, -displayTo, -docToMarkdown, -docs, -docsToHtml, -edit, -editNamespace, -execute, -find, -findIn, -findAll, -findInAll, -findGlobal, -findShallow, -findVerbose, -findVerboseAll, -sfind, -sfindReplace, -forkLocal, -help, -helpTopics, -history, -ioTest, -ioTestAll, -libInstallInputPattern, -load, -makeStandalone, -mergeBuiltins, -mergeIOBuiltins, -mergeOldInputPattern, -mergeOldPreviewInputPattern, -mergeOldSquashInputPattern, -mergeInputPattern, -mergeCommitInputPattern, -names False, -- names -names True, -- names.global -namespaceDependencies, -previewAdd, -previewUpdate, -printVersion, -projectCreate, -projectCreateEmptyInputPattern, -projectRenameInputPattern, -projectSwitch, -projectsInputPattern, -pull, -pullWithoutHistory, -push, -pushCreate, -pushExhaustive, -pushForce, -quit, -releaseDraft, -renameBranch, -renameTerm, -renameType, -moveAll, -reset, -resetRoot, -runScheme, -saveExecuteResult, -test, -testAll, -todo, -ui, -undo, -up, -update, -updateBuiltins, -updateOld, -updateOldNoPatch, -upgrade, -upgradeCommitInputPattern, -view, -viewGlobal, -viewReflog -``` - diff --git a/unison-src/transcripts/io-test-command.md b/unison-src/transcripts/io-test-command.md deleted file mode 100644 index f10259137e..0000000000 --- a/unison-src/transcripts/io-test-command.md +++ /dev/null @@ -1,43 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -The `io.test` command should run all of the tests within the current namespace, excluding libs. - -```unison:hide --- We manually specify types so we don't need to pull in base to run IO and such -ioAndExceptionTest : '{IO, Exception} [Result] -ioAndExceptionTest = do - [Ok "Success"] - -ioTest : '{IO} [Result] -ioTest = do - [Ok "Success"] - -lib.ioAndExceptionTestInLib : '{IO, Exception} [Result] -lib.ioAndExceptionTestInLib = do - [Ok "Success"] -``` - -```ucm:hide -scratch/main> add -``` - -Run a IO tests one by one - -```ucm -scratch/main> io.test ioAndExceptionTest -scratch/main> io.test ioTest -``` - -`io.test` doesn't cache results - -```ucm -scratch/main> io.test ioAndExceptionTest -``` - -`io.test.all` will run all matching tests except those in the `lib` namespace. - -```ucm -scratch/main> io.test.all -``` diff --git a/unison-src/transcripts/io-test-command.output.md b/unison-src/transcripts/io-test-command.output.md deleted file mode 100644 index 0e1d8cbbdc..0000000000 --- a/unison-src/transcripts/io-test-command.output.md +++ /dev/null @@ -1,78 +0,0 @@ -The `io.test` command should run all of the tests within the current namespace, excluding libs. - -``` unison --- We manually specify types so we don't need to pull in base to run IO and such -ioAndExceptionTest : '{IO, Exception} [Result] -ioAndExceptionTest = do - [Ok "Success"] - -ioTest : '{IO} [Result] -ioTest = do - [Ok "Success"] - -lib.ioAndExceptionTestInLib : '{IO, Exception} [Result] -lib.ioAndExceptionTestInLib = do - [Ok "Success"] -``` - -Run a IO tests one by one - -``` ucm -scratch/main> io.test ioAndExceptionTest - - New test results: - - 1. ioAndExceptionTest ◉ Success - - ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. - -scratch/main> io.test ioTest - - New test results: - - 1. ioTest ◉ Success - - ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` -`io.test` doesn't cache results - -``` ucm -scratch/main> io.test ioAndExceptionTest - - New test results: - - 1. ioAndExceptionTest ◉ Success - - ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` -`io.test.all` will run all matching tests except those in the `lib` namespace. - -``` ucm -scratch/main> io.test.all - - - - - - - - - - New test results: - - 1. ioAndExceptionTest ◉ Success - 2. ioTest ◉ Success - - ✅ 2 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` diff --git a/unison-src/transcripts/io.md b/unison-src/transcripts/io.md deleted file mode 100644 index 7db903ebb4..0000000000 --- a/unison-src/transcripts/io.md +++ /dev/null @@ -1,426 +0,0 @@ -# tests for built-in IO functions - -```ucm:hide -scratch/main> builtins.merge -scratch/main> builtins.mergeio -scratch/main> load unison-src/transcripts-using-base/base.u -scratch/main> add -``` - -Tests for IO builtins which wired to foreign haskell calls. - -## Setup - -You can skip the section which is just needed to make the transcript self-contained. - -TempDirs/autoCleaned is an ability/hanlder which allows you to easily -create a scratch directory which will automatically get cleaned up. - -```ucm:hide -scratch/main> add -``` - -## Basic File Functions - -### Creating/Deleting/Renaming Directories - -Tests: -- createDirectory, -- isDirectory, -- fileExists, -- renameDirectory, -- deleteDirectory - -```unison -testCreateRename : '{io2.IO} [Result] -testCreateRename _ = - test = 'let - tempDir = newTempDir "fileio" - fooDir = tempDir ++ "/foo" - barDir = tempDir ++ "/bar" - void x = () - void (createDirectory.impl fooDir) - check "create a foo directory" (isDirectory fooDir) - check "directory should exist" (fileExists fooDir) - renameDirectory fooDir barDir - check "foo should no longer exist" (not (fileExists fooDir)) - check "directory should no longer exist" (not (fileExists fooDir)) - check "bar should now exist" (fileExists barDir) - - bazDir = barDir ++ "/baz" - void (createDirectory.impl bazDir) - void (removeDirectory.impl barDir) - - check "removeDirectory works recursively" (not (isDirectory barDir)) - check "removeDirectory works recursively" (not (isDirectory bazDir)) - - runTest test -``` - -```ucm -scratch/main> add -scratch/main> io.test testCreateRename -``` - -### Opening / Closing files - -Tests: -- openFile -- closeFile -- isFileOpen - -```unison -testOpenClose : '{io2.IO} [Result] -testOpenClose _ = - test = 'let - tempDir = (newTempDir "seek") - fooFile = tempDir ++ "/foo" - handle1 = openFile fooFile FileMode.Write - check "file should be open" (isFileOpen handle1) - setBuffering handle1 (SizedBlockBuffering 1024) - check "file handle buffering should match what we just set." (getBuffering handle1 == SizedBlockBuffering 1024) - setBuffering handle1 (getBuffering handle1) - putBytes handle1 0xs01 - setBuffering handle1 NoBuffering - setBuffering handle1 (getBuffering handle1) - putBytes handle1 0xs23 - setBuffering handle1 BlockBuffering - setBuffering handle1 (getBuffering handle1) - putBytes handle1 0xs45 - setBuffering handle1 LineBuffering - setBuffering handle1 (getBuffering handle1) - putBytes handle1 0xs67 - closeFile handle1 - check "file should be closed" (not (isFileOpen handle1)) - - -- make sure the bytes have been written - handle2 = openFile fooFile FileMode.Read - check "bytes have been written" (getBytes handle2 4 == 0xs01234567) - closeFile handle2 - - -- checking that ReadWrite mode works fine - handle3 = openFile fooFile FileMode.ReadWrite - check "bytes have been written" (getBytes handle3 4 == 0xs01234567) - closeFile handle3 - - check "file should be closed" (not (isFileOpen handle1)) - - runTest test -``` - -```ucm -scratch/main> add -scratch/main> io.test testOpenClose -``` - -### Reading files with getSomeBytes - -Tests: -- getSomeBytes -- putBytes -- isFileOpen -- seekHandle - -```unison -testGetSomeBytes : '{io2.IO} [Result] -testGetSomeBytes _ = - test = 'let - tempDir = (newTempDir "getSomeBytes") - fooFile = tempDir ++ "/foo" - - testData = "0123456789" - testSize = size testData - - chunkSize = 7 - check "chunk size splits data into 2 uneven sides" ((chunkSize > (testSize / 2)) && (chunkSize < testSize)) - - - -- write testData to a temporary file - fooWrite = openFile fooFile Write - putBytes fooWrite (toUtf8 testData) - closeFile fooWrite - check "file should be closed" (not (isFileOpen fooWrite)) - - -- reopen for reading back the data in chunks - fooRead = openFile fooFile Read - - -- read first part of file - chunk1 = getSomeBytes fooRead chunkSize |> fromUtf8 - check "first chunk matches first part of testData" (chunk1 == take chunkSize testData) - - -- read rest of file - chunk2 = getSomeBytes fooRead chunkSize |> fromUtf8 - check "second chunk matches rest of testData" (chunk2 == drop chunkSize testData) - - check "should be at end of file" (isFileEOF fooRead) - - readAtEOF = getSomeBytes fooRead chunkSize - check "reading at end of file results in Bytes.empty" (readAtEOF == Bytes.empty) - - -- request many bytes from the start of the file - seekHandle fooRead AbsoluteSeek +0 - bigRead = getSomeBytes fooRead (testSize * 999) |> fromUtf8 - check "requesting many bytes results in what's available" (bigRead == testData) - - closeFile fooRead - check "file should be closed" (not (isFileOpen fooRead)) - - runTest test -``` - -```ucm -scratch/main> add -scratch/main> io.test testGetSomeBytes -``` - -### Seeking in open files - -Tests: -- openFile -- putBytes -- closeFile -- isSeekable -- isFileEOF -- seekHandle -- getBytes -- getLine - -```unison -testSeek : '{io2.IO} [Result] -testSeek _ = - test = 'let - tempDir = newTempDir "seek" - emit (Ok "seeked") - fooFile = tempDir ++ "/foo" - handle1 = openFile fooFile FileMode.Append - putBytes handle1 (toUtf8 "12345678") - closeFile handle1 - - handle3 = openFile fooFile FileMode.Read - check "readable file should be seekable" (isSeekable handle3) - check "shouldn't be the EOF" (not (isFileEOF handle3)) - expectU "we should be at position 0" 0 (handlePosition handle3) - - seekHandle handle3 AbsoluteSeek +1 - expectU "we should be at position 1" 1 (handlePosition handle3) - bytes3a = getBytes handle3 1000 - text3a = Text.fromUtf8 bytes3a - expectU "should be able to read our temporary file after seeking" "2345678" text3a - closeFile handle3 - - barFile = tempDir ++ "/bar" - handle4 = openFile barFile FileMode.Append - putBytes handle4 (toUtf8 "foobar\n") - closeFile handle4 - - handle5 = openFile barFile FileMode.Read - expectU "getLine should get a line" "foobar" (getLine handle5) - closeFile handle5 - - runTest test - -testAppend : '{io2.IO} [Result] -testAppend _ = - test = 'let - tempDir = newTempDir "openFile" - fooFile = tempDir ++ "/foo" - handle1 = openFile fooFile FileMode.Write - putBytes handle1 (toUtf8 "test1") - closeFile handle1 - - handle2 = openFile fooFile FileMode.Append - putBytes handle2 (toUtf8 "test2") - closeFile handle2 - - handle3 = openFile fooFile FileMode.Read - bytes3 = getBytes handle3 1000 - text3 = Text.fromUtf8 bytes3 - - expectU "should be able to read our temporary file" "test1test2" text3 - - closeFile handle3 - - runTest test -``` - -```ucm -scratch/main> add -scratch/main> io.test testSeek -scratch/main> io.test testAppend -``` - -### SystemTime -```unison -testSystemTime : '{io2.IO} [Result] -testSystemTime _ = - test = 'let - t = !systemTime - check "systemTime should be sane" ((t > 1600000000) && (t < 2000000000)) - - runTest test -``` - -```ucm -scratch/main> add -scratch/main> io.test testSystemTime -``` - -### Get temp directory - -```unison:hide -testGetTempDirectory : '{io2.IO} [Result] -testGetTempDirectory _ = - test = 'let - tempDir = reraise !getTempDirectory.impl - check "Temp directory is directory" (isDirectory tempDir) - check "Temp directory should exist" (fileExists tempDir) - runTest test -``` - -```ucm -scratch/main> add -scratch/main> io.test testGetTempDirectory -``` - -### Get current directory - -```unison:hide -testGetCurrentDirectory : '{io2.IO} [Result] -testGetCurrentDirectory _ = - test = 'let - currentDir = reraise !getCurrentDirectory.impl - check "Current directory is directory" (isDirectory currentDir) - check "Current directory should exist" (fileExists currentDir) - runTest test -``` - -```ucm -scratch/main> add -scratch/main> io.test testGetCurrentDirectory -``` - -### Get directory contents - -```unison:hide -testDirContents : '{io2.IO} [Result] -testDirContents _ = - test = 'let - tempDir = newTempDir "dircontents" - c = reraise (directoryContents.impl tempDir) - check "directory size should be" (size c == 2) - check "directory contents should have current directory and parent" let - (c == [".", ".."]) || (c == ["..", "."]) - runTest test -``` - -```ucm -scratch/main> add -scratch/main> io.test testDirContents -``` - -### Read environment variables - -```unison:hide -testGetEnv : '{io2.IO} [Result] -testGetEnv _ = - test = 'let - path = reraise (getEnv.impl "PATH") -- PATH exists on windows, mac and linux. - check "PATH environent variable should be set" (size path > 0) - match getEnv.impl "DOESNTEXIST" with - Right _ -> emit (Fail "env var shouldn't exist") - Left _ -> emit (Ok "DOESNTEXIST didn't exist") - runTest test -``` -```ucm -scratch/main> add -scratch/main> io.test testGetEnv -``` - -### Read command line args - -`runMeWithNoArgs`, `runMeWithOneArg`, and `runMeWithTwoArgs` raise exceptions -unless they called with the right number of arguments. - -```unison:hide -testGetArgs.fail : Text -> Failure -testGetArgs.fail descr = Failure (typeLink IOFailure) descr !Any - -testGetArgs.runMeWithNoArgs : '{io2.IO, Exception} () -testGetArgs.runMeWithNoArgs = 'let - args = reraise !getArgs.impl - match args with - [] -> printLine "called with no args" - _ -> raise (fail "called with args") - -testGetArgs.runMeWithOneArg : '{io2.IO, Exception} () -testGetArgs.runMeWithOneArg = 'let - args = reraise !getArgs.impl - match args with - [] -> raise (fail "called with no args") - [_] -> printLine "called with one arg" - _ -> raise (fail "called with too many args") - -testGetArgs.runMeWithTwoArgs : '{io2.IO, Exception} () -testGetArgs.runMeWithTwoArgs = 'let - args = reraise !getArgs.impl - match args with - [] -> raise (fail "called with no args") - [_] -> raise (fail "called with one arg") - [_, _] -> printLine "called with two args" - _ -> raise (fail "called with too many args") -``` - -Test that they can be run with the right number of args. -```ucm -scratch/main> add -scratch/main> run runMeWithNoArgs -scratch/main> run runMeWithOneArg foo -scratch/main> run runMeWithTwoArgs foo bar -``` - -Calling our examples with the wrong number of args will error. - -```ucm:error -scratch/main> run runMeWithNoArgs foo -``` - -```ucm:error -scratch/main> run runMeWithOneArg -``` -```ucm:error -scratch/main> run runMeWithOneArg foo bar -``` - -```ucm:error -scratch/main> run runMeWithTwoArgs -``` - -### Get the time zone - -```unison:hide -testTimeZone = do - (offset, summer, name) = Clock.internals.systemTimeZone +0 - _ = (offset : Int, summer : Nat, name : Text) - () -``` - -```ucm -scratch/main> add -scratch/main> run testTimeZone -``` - -### Get some random bytes - -```unison:hide -testRandom : '{io2.IO} [Result] -testRandom = do - test = do - bytes = IO.randomBytes 10 - check "randomBytes returns the right number of bytes" (size bytes == 10) - runTest test -``` - -```ucm -scratch/main> add -scratch/main> io.test testGetEnv -``` diff --git a/unison-src/transcripts/io.output.md b/unison-src/transcripts/io.output.md deleted file mode 100644 index 4ac673c76e..0000000000 --- a/unison-src/transcripts/io.output.md +++ /dev/null @@ -1,719 +0,0 @@ -# tests for built-in IO functions - -Tests for IO builtins which wired to foreign haskell calls. - -## Setup - -You can skip the section which is just needed to make the transcript self-contained. - -TempDirs/autoCleaned is an ability/hanlder which allows you to easily -create a scratch directory which will automatically get cleaned up. - -## Basic File Functions - -### Creating/Deleting/Renaming Directories - -Tests: - - - createDirectory, - - isDirectory, - - fileExists, - - renameDirectory, - - deleteDirectory - -``` unison -testCreateRename : '{io2.IO} [Result] -testCreateRename _ = - test = 'let - tempDir = newTempDir "fileio" - fooDir = tempDir ++ "/foo" - barDir = tempDir ++ "/bar" - void x = () - void (createDirectory.impl fooDir) - check "create a foo directory" (isDirectory fooDir) - check "directory should exist" (fileExists fooDir) - renameDirectory fooDir barDir - check "foo should no longer exist" (not (fileExists fooDir)) - check "directory should no longer exist" (not (fileExists fooDir)) - check "bar should now exist" (fileExists barDir) - - bazDir = barDir ++ "/baz" - void (createDirectory.impl bazDir) - void (removeDirectory.impl barDir) - - check "removeDirectory works recursively" (not (isDirectory barDir)) - check "removeDirectory works recursively" (not (isDirectory bazDir)) - - runTest test -``` - -``` 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`: - - testCreateRename : '{IO} [Result] - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - testCreateRename : '{IO} [Result] - -scratch/main> io.test testCreateRename - - New test results: - - 1. testCreateRename ◉ create a foo directory - ◉ directory should exist - ◉ foo should no longer exist - ◉ directory should no longer exist - ◉ bar should now exist - ◉ removeDirectory works recursively - ◉ removeDirectory works recursively - - ✅ 7 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` -### Opening / Closing files - -Tests: - - - openFile - - closeFile - - isFileOpen - -``` unison -testOpenClose : '{io2.IO} [Result] -testOpenClose _ = - test = 'let - tempDir = (newTempDir "seek") - fooFile = tempDir ++ "/foo" - handle1 = openFile fooFile FileMode.Write - check "file should be open" (isFileOpen handle1) - setBuffering handle1 (SizedBlockBuffering 1024) - check "file handle buffering should match what we just set." (getBuffering handle1 == SizedBlockBuffering 1024) - setBuffering handle1 (getBuffering handle1) - putBytes handle1 0xs01 - setBuffering handle1 NoBuffering - setBuffering handle1 (getBuffering handle1) - putBytes handle1 0xs23 - setBuffering handle1 BlockBuffering - setBuffering handle1 (getBuffering handle1) - putBytes handle1 0xs45 - setBuffering handle1 LineBuffering - setBuffering handle1 (getBuffering handle1) - putBytes handle1 0xs67 - closeFile handle1 - check "file should be closed" (not (isFileOpen handle1)) - - -- make sure the bytes have been written - handle2 = openFile fooFile FileMode.Read - check "bytes have been written" (getBytes handle2 4 == 0xs01234567) - closeFile handle2 - - -- checking that ReadWrite mode works fine - handle3 = openFile fooFile FileMode.ReadWrite - check "bytes have been written" (getBytes handle3 4 == 0xs01234567) - closeFile handle3 - - check "file should be closed" (not (isFileOpen handle1)) - - runTest test -``` - -``` 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`: - - testOpenClose : '{IO} [Result] - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - testOpenClose : '{IO} [Result] - -scratch/main> io.test testOpenClose - - New test results: - - 1. testOpenClose ◉ file should be open - ◉ file handle buffering should match what we just set. - ◉ file should be closed - ◉ bytes have been written - ◉ bytes have been written - ◉ file should be closed - - ✅ 6 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` -### Reading files with getSomeBytes - -Tests: - - - getSomeBytes - - putBytes - - isFileOpen - - seekHandle - -``` unison -testGetSomeBytes : '{io2.IO} [Result] -testGetSomeBytes _ = - test = 'let - tempDir = (newTempDir "getSomeBytes") - fooFile = tempDir ++ "/foo" - - testData = "0123456789" - testSize = size testData - - chunkSize = 7 - check "chunk size splits data into 2 uneven sides" ((chunkSize > (testSize / 2)) && (chunkSize < testSize)) - - - -- write testData to a temporary file - fooWrite = openFile fooFile Write - putBytes fooWrite (toUtf8 testData) - closeFile fooWrite - check "file should be closed" (not (isFileOpen fooWrite)) - - -- reopen for reading back the data in chunks - fooRead = openFile fooFile Read - - -- read first part of file - chunk1 = getSomeBytes fooRead chunkSize |> fromUtf8 - check "first chunk matches first part of testData" (chunk1 == take chunkSize testData) - - -- read rest of file - chunk2 = getSomeBytes fooRead chunkSize |> fromUtf8 - check "second chunk matches rest of testData" (chunk2 == drop chunkSize testData) - - check "should be at end of file" (isFileEOF fooRead) - - readAtEOF = getSomeBytes fooRead chunkSize - check "reading at end of file results in Bytes.empty" (readAtEOF == Bytes.empty) - - -- request many bytes from the start of the file - seekHandle fooRead AbsoluteSeek +0 - bigRead = getSomeBytes fooRead (testSize * 999) |> fromUtf8 - check "requesting many bytes results in what's available" (bigRead == testData) - - closeFile fooRead - check "file should be closed" (not (isFileOpen fooRead)) - - runTest test -``` - -``` 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`: - - testGetSomeBytes : '{IO} [Result] - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - testGetSomeBytes : '{IO} [Result] - -scratch/main> io.test testGetSomeBytes - - New test results: - - 1. testGetSomeBytes ◉ chunk size splits data into 2 uneven sides - ◉ file should be closed - ◉ first chunk matches first part of testData - ◉ second chunk matches rest of testData - ◉ should be at end of file - ◉ reading at end of file results in Bytes.empty - ◉ requesting many bytes results in what's available - ◉ file should be closed - - ✅ 8 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` -### Seeking in open files - -Tests: - - - openFile - - putBytes - - closeFile - - isSeekable - - isFileEOF - - seekHandle - - getBytes - - getLine - -``` unison -testSeek : '{io2.IO} [Result] -testSeek _ = - test = 'let - tempDir = newTempDir "seek" - emit (Ok "seeked") - fooFile = tempDir ++ "/foo" - handle1 = openFile fooFile FileMode.Append - putBytes handle1 (toUtf8 "12345678") - closeFile handle1 - - handle3 = openFile fooFile FileMode.Read - check "readable file should be seekable" (isSeekable handle3) - check "shouldn't be the EOF" (not (isFileEOF handle3)) - expectU "we should be at position 0" 0 (handlePosition handle3) - - seekHandle handle3 AbsoluteSeek +1 - expectU "we should be at position 1" 1 (handlePosition handle3) - bytes3a = getBytes handle3 1000 - text3a = Text.fromUtf8 bytes3a - expectU "should be able to read our temporary file after seeking" "2345678" text3a - closeFile handle3 - - barFile = tempDir ++ "/bar" - handle4 = openFile barFile FileMode.Append - putBytes handle4 (toUtf8 "foobar\n") - closeFile handle4 - - handle5 = openFile barFile FileMode.Read - expectU "getLine should get a line" "foobar" (getLine handle5) - closeFile handle5 - - runTest test - -testAppend : '{io2.IO} [Result] -testAppend _ = - test = 'let - tempDir = newTempDir "openFile" - fooFile = tempDir ++ "/foo" - handle1 = openFile fooFile FileMode.Write - putBytes handle1 (toUtf8 "test1") - closeFile handle1 - - handle2 = openFile fooFile FileMode.Append - putBytes handle2 (toUtf8 "test2") - closeFile handle2 - - handle3 = openFile fooFile FileMode.Read - bytes3 = getBytes handle3 1000 - text3 = Text.fromUtf8 bytes3 - - expectU "should be able to read our temporary file" "test1test2" text3 - - closeFile handle3 - - runTest test -``` - -``` 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`: - - testAppend : '{IO} [Result] - testSeek : '{IO} [Result] - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - testAppend : '{IO} [Result] - testSeek : '{IO} [Result] - -scratch/main> io.test testSeek - - New test results: - - 1. testSeek ◉ seeked - ◉ readable file should be seekable - ◉ shouldn't be the EOF - ◉ we should be at position 0 - ◉ we should be at position 1 - ◉ should be able to read our temporary file after seeking - ◉ getLine should get a line - - ✅ 7 test(s) passing - - Tip: Use view 1 to view the source of a test. - -scratch/main> io.test testAppend - - New test results: - - 1. testAppend ◉ should be able to read our temporary file - - ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` -### SystemTime - -``` unison -testSystemTime : '{io2.IO} [Result] -testSystemTime _ = - test = 'let - t = !systemTime - check "systemTime should be sane" ((t > 1600000000) && (t < 2000000000)) - - runTest test -``` - -``` 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`: - - testSystemTime : '{IO} [Result] - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - testSystemTime : '{IO} [Result] - -scratch/main> io.test testSystemTime - - New test results: - - 1. testSystemTime ◉ systemTime should be sane - - ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` -### Get temp directory - -``` unison -testGetTempDirectory : '{io2.IO} [Result] -testGetTempDirectory _ = - test = 'let - tempDir = reraise !getTempDirectory.impl - check "Temp directory is directory" (isDirectory tempDir) - check "Temp directory should exist" (fileExists tempDir) - runTest test -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - testGetTempDirectory : '{IO} [Result] - -scratch/main> io.test testGetTempDirectory - - New test results: - - 1. testGetTempDirectory ◉ Temp directory is directory - ◉ Temp directory should exist - - ✅ 2 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` -### Get current directory - -``` unison -testGetCurrentDirectory : '{io2.IO} [Result] -testGetCurrentDirectory _ = - test = 'let - currentDir = reraise !getCurrentDirectory.impl - check "Current directory is directory" (isDirectory currentDir) - check "Current directory should exist" (fileExists currentDir) - runTest test -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - testGetCurrentDirectory : '{IO} [Result] - -scratch/main> io.test testGetCurrentDirectory - - New test results: - - 1. testGetCurrentDirectory ◉ Current directory is directory - ◉ Current directory should exist - - ✅ 2 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` -### Get directory contents - -``` unison -testDirContents : '{io2.IO} [Result] -testDirContents _ = - test = 'let - tempDir = newTempDir "dircontents" - c = reraise (directoryContents.impl tempDir) - check "directory size should be" (size c == 2) - check "directory contents should have current directory and parent" let - (c == [".", ".."]) || (c == ["..", "."]) - runTest test -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - testDirContents : '{IO} [Result] - -scratch/main> io.test testDirContents - - New test results: - - 1. testDirContents ◉ directory size should be - ◉ directory contents should have current directory and parent - - ✅ 2 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` -### Read environment variables - -``` unison -testGetEnv : '{io2.IO} [Result] -testGetEnv _ = - test = 'let - path = reraise (getEnv.impl "PATH") -- PATH exists on windows, mac and linux. - check "PATH environent variable should be set" (size path > 0) - match getEnv.impl "DOESNTEXIST" with - Right _ -> emit (Fail "env var shouldn't exist") - Left _ -> emit (Ok "DOESNTEXIST didn't exist") - runTest test -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - testGetEnv : '{IO} [Result] - -scratch/main> io.test testGetEnv - - New test results: - - 1. testGetEnv ◉ PATH environent variable should be set - ◉ DOESNTEXIST didn't exist - - ✅ 2 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` -### Read command line args - -`runMeWithNoArgs`, `runMeWithOneArg`, and `runMeWithTwoArgs` raise exceptions -unless they called with the right number of arguments. - -``` unison -testGetArgs.fail : Text -> Failure -testGetArgs.fail descr = Failure (typeLink IOFailure) descr !Any - -testGetArgs.runMeWithNoArgs : '{io2.IO, Exception} () -testGetArgs.runMeWithNoArgs = 'let - args = reraise !getArgs.impl - match args with - [] -> printLine "called with no args" - _ -> raise (fail "called with args") - -testGetArgs.runMeWithOneArg : '{io2.IO, Exception} () -testGetArgs.runMeWithOneArg = 'let - args = reraise !getArgs.impl - match args with - [] -> raise (fail "called with no args") - [_] -> printLine "called with one arg" - _ -> raise (fail "called with too many args") - -testGetArgs.runMeWithTwoArgs : '{io2.IO, Exception} () -testGetArgs.runMeWithTwoArgs = 'let - args = reraise !getArgs.impl - match args with - [] -> raise (fail "called with no args") - [_] -> raise (fail "called with one arg") - [_, _] -> printLine "called with two args" - _ -> raise (fail "called with too many args") -``` - -Test that they can be run with the right number of args. - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - testGetArgs.fail : Text -> Failure - testGetArgs.runMeWithNoArgs : '{IO, Exception} () - testGetArgs.runMeWithOneArg : '{IO, Exception} () - testGetArgs.runMeWithTwoArgs : '{IO, Exception} () - -scratch/main> run runMeWithNoArgs - - () - -scratch/main> run runMeWithOneArg foo - - () - -scratch/main> run runMeWithTwoArgs foo bar - - () - -``` -Calling our examples with the wrong number of args will error. - -``` ucm -scratch/main> run runMeWithNoArgs foo - - 💔💥 - - The program halted with an unhandled exception: - - Failure (typeLink IOFailure) "called with args" (Any ()) - - Stack trace: - ##raise - -``` -``` ucm -scratch/main> run runMeWithOneArg - - 💔💥 - - The program halted with an unhandled exception: - - Failure (typeLink IOFailure) "called with no args" (Any ()) - - Stack trace: - ##raise - -``` -``` ucm -scratch/main> run runMeWithOneArg foo bar - - 💔💥 - - The program halted with an unhandled exception: - - Failure - (typeLink IOFailure) "called with too many args" (Any ()) - - Stack trace: - ##raise - -``` -``` ucm -scratch/main> run runMeWithTwoArgs - - 💔💥 - - The program halted with an unhandled exception: - - Failure (typeLink IOFailure) "called with no args" (Any ()) - - Stack trace: - ##raise - -``` -### Get the time zone - -``` unison -testTimeZone = do - (offset, summer, name) = Clock.internals.systemTimeZone +0 - _ = (offset : Int, summer : Nat, name : Text) - () -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - testTimeZone : '{IO} () - -scratch/main> run testTimeZone - - () - -``` -### Get some random bytes - -``` unison -testRandom : '{io2.IO} [Result] -testRandom = do - test = do - bytes = IO.randomBytes 10 - check "randomBytes returns the right number of bytes" (size bytes == 10) - runTest test -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - testRandom : '{IO} [Result] - -scratch/main> io.test testGetEnv - - New test results: - - 1. testGetEnv ◉ PATH environent variable should be set - ◉ DOESNTEXIST didn't exist - - ✅ 2 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` diff --git a/unison-src/transcripts/keyword-identifiers.output.md b/unison-src/transcripts/keyword-identifiers.output.md deleted file mode 100644 index 27a31d6f35..0000000000 --- a/unison-src/transcripts/keyword-identifiers.output.md +++ /dev/null @@ -1,272 +0,0 @@ -Regression tests to make sure keywords are allowed to start identifiers in terms and types. - -In particular, following a keyword with a `wordyIdChar` should be a valid identifier. - -Related issues: - - - https://github.com/unisonweb/unison/issues/2091 - - https://github.com/unisonweb/unison/issues/2727 - -## Keyword list - -Checks the following keywords: - - - `type` - - `ability` - - `structural` - - `unique` - - `if` - - `then` - - `else` - - `forall` - - `handle` - - `with` - - `where` - - `use` - - `true` - - `false` - - `alias` - - `typeLink` - - `termLink` - - `let` - - `namespace` - - `match` - - `cases` - -Note that although `∀` is a keyword, it cannot actually appear at the start of -identifier. - -## Tests - -`type`: - -``` unison -typeFoo = 99 -type1 = "I am a variable" -type_ = 292 -type! = 3943 -type' = 238448 --- this type is the same as `structural type Optional a = Some a | None`, but with very confusing names -structural type type! type_ = type' type_ | type'' -``` - -`ability`: - -``` unison -abilityFoo = 99 -ability1 = "I am a variable" -ability_ = 292 -ability! = 3943 -ability' = 238448 -structural type ability! ability_ = ability' ability_ | ability'' -``` - -`structural` - -``` unison -structuralFoo = 99 -structural1 = "I am a variable" -structural_ = 292 -structural! = 3943 -structural' = 238448 -structural type structural! structural_ = structural' structural_ | structural'' -``` - -`unique` - -``` unison -uniqueFoo = 99 -unique1 = "I am a variable" -unique_ = 292 -unique! = 3943 -unique' = 238448 -structural type unique! unique_ = unique' unique_ | unique'' -``` - -`if` - -``` unison -ifFoo = 99 -if1 = "I am a variable" -if_ = 292 -if! = 3943 -if' = 238448 -structural type if! if_ = if' if_ | if'' -``` - -`then` - -``` unison -thenFoo = 99 -then1 = "I am a variable" -then_ = 292 -then! = 3943 -then' = 238448 -structural type then! then_ = then' then_ | then'' -``` - -`else` - -``` unison -elseFoo = 99 -else1 = "I am a variable" -else_ = 292 -else! = 3943 -else' = 238448 -structural type else! else_ = else' else_ | else'' -``` - -`forall` - -``` unison -forallFoo = 99 -forall1 = "I am a variable" -forall_ = 292 -forall! = 3943 -forall' = 238448 -structural type forall! forall_ = forall' forall_ | forall'' -``` - -`handle` - -``` unison -handleFoo = 99 -handle1 = "I am a variable" -handle_ = 292 -handle! = 3943 -handle' = 238448 -structural type handle! handle_ = handle' handle_ | handle'' -``` - -`with` - -``` unison -withFoo = 99 -with1 = "I am a variable" -with_ = 292 -with! = 3943 -with' = 238448 -structural type with! with_ = with' with_ | with'' -``` - -`where` - -``` unison -whereFoo = 99 -where1 = "I am a variable" -where_ = 292 -where! = 3943 -where' = 238448 -structural type where! where_ = where' where_ | where'' -``` - -`use` - -``` unison -useFoo = 99 -use1 = "I am a variable" -use_ = 292 -use! = 3943 -use' = 238448 -structural type use! use_ = use' use_ | use'' -``` - -`true` - -``` unison -trueFoo = 99 -true1 = "I am a variable" -true_ = 292 -true! = 3943 -true' = 238448 -structural type true! true_ = true' true_ | true'' -``` - -`false` - -``` unison -falseFoo = 99 -false1 = "I am a variable" -false_ = 292 -false! = 3943 -false' = 238448 -structural type false! false_ = false' false_ | false'' -``` - -`alias` - -``` unison -aliasFoo = 99 -alias1 = "I am a variable" -alias_ = 292 -alias! = 3943 -alias' = 238448 -structural type alias! alias_ = alias' alias_ | alias'' -``` - -`typeLink` - -``` unison -typeLinkFoo = 99 -typeLink1 = "I am a variable" -typeLink_ = 292 -typeLink! = 3943 -typeLink' = 238448 -structural type typeLink! typeLink_ = typeLink' typeLink_ | typeLink'' -``` - -`termLink` - -``` unison -termLinkFoo = 99 -termLink1 = "I am a variable" -termLink_ = 292 -termLink! = 3943 -termLink' = 238448 -structural type termLink! termLink_ = termLink' termLink_ | termLink'' -``` - -`let` - -``` unison -letFoo = 99 -let1 = "I am a variable" -let_ = 292 -let! = 3943 -let' = 238448 -structural type let! let_ = let' let_ | let'' -``` - -`namespace` - -``` unison -namespaceFoo = 99 -namespace1 = "I am a variable" -namespace_ = 292 -namespace! = 3943 -namespace' = 238448 -structural type namespace! namespace_ = namespace' namespace_ | namespace'' -``` - -`match` - -``` unison -matchFoo = 99 -match1 = "I am a variable" -match_ = 292 -match! = 3943 -match' = 238448 -structural type match! match_ = match' match_ | match'' -``` - -`cases` - -``` unison -casesFoo = 99 -cases1 = "I am a variable" -cases_ = 292 -cases! = 3943 -cases' = 238448 -structural type cases! cases_ = cases' cases_ | cases'' -``` - diff --git a/unison-src/transcripts/kind-inference.md b/unison-src/transcripts/kind-inference.md deleted file mode 100644 index 3af86ae854..0000000000 --- a/unison-src/transcripts/kind-inference.md +++ /dev/null @@ -1,137 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -## A type param cannot have conflicting kind constraints within a single decl - -conflicting constraints on the kind of `a` in a product -```unison:error -unique type T a = T a (a Nat) -``` - -conflicting constraints on the kind of `a` in a sum -```unison:error -unique type T a - = Star a - | StarStar (a Nat) -``` - -## Kinds are inferred by decl component - -Successfully infer `a` in `Ping a` to be of kind `* -> *` by -inspecting its component-mate `Pong`. -```unison -unique type Ping a = Ping Pong -unique type Pong = Pong (Ping Optional) -``` - -Catch the conflict on the kind of `a` in `Ping a`. `Ping` restricts -`a` to `*`, whereas `Pong` restricts `a` to `* -> *`. -```unison:error -unique type Ping a = Ping a Pong -unique type Pong = Pong (Ping Optional) -``` - -Successful example between mutually recursive type and ability -```unison -unique type Ping a = Ping (a Nat -> {Pong Nat} ()) -unique ability Pong a where - pong : Ping Optional -> () -``` - -Catch conflict between mutually recursive type and ability -```unison:error -unique type Ping a = Ping (a -> {Pong Nat} ()) -unique ability Pong a where - pong : Ping Optional -> () -``` - -Consistent instantiation of `T`'s `a` parameter in `S` -```unison -unique type T a = T a - -unique type S = S (T Nat) -``` - -Delay kind defaulting until all components are processed. Here `S` -constrains the kind of `T`'s `a` parameter, although `S` is not in -the same component as `T`. -```unison -unique type T a = T - -unique type S = S (T Optional) -``` - -Catch invalid instantiation of `T`'s `a` parameter in `S` -```unison:error -unique type T a = T a - -unique type S = S (T Optional) -``` - -## Checking annotations - -Catch kind error in type annotation -```unison:error -test : Nat Nat -test = 0 -``` - -Catch kind error in annotation example 2 -```unison:error -test : Optional -> () -test _ = () -``` - -Catch kind error in annotation example 3 -```unison:error -unique type T a = T (a Nat) - -test : T Nat -> () -test _ = () -``` - -Catch kind error in scoped type variable annotation -```unison:error -unique type StarStar a = StarStar (a Nat) -unique type Star a = Star a - -test : StarStar a -> () -test _ = - buggo : Star a - buggo = bug "" - () -``` - -## Effect/type mismatch - -Effects appearing where types are expected -```unison:error -unique ability Foo where - foo : () - -test : Foo -> () -test _ = () -``` - -Types appearing where effects are expected -```unison:error -test : {Nat} () -test _ = () -``` - -## Cyclic kinds - -```unison:error -unique type T a = T (a a) -``` - -```unison:error -unique type T a b = T (a b) (b a) -``` - -```unison:error -unique type Ping a = Ping (a Pong) -unique type Pong a = Pong (a Ping) -``` diff --git a/unison-src/transcripts/kind-inference.output.md b/unison-src/transcripts/kind-inference.output.md deleted file mode 100644 index c40961bc71..0000000000 --- a/unison-src/transcripts/kind-inference.output.md +++ /dev/null @@ -1,361 +0,0 @@ -## A type param cannot have conflicting kind constraints within a single decl - -conflicting constraints on the kind of `a` in a product - -``` unison -unique type T a = T a (a Nat) -``` - -``` ucm - - Loading changes detected in scratch.u. - - Kind mismatch arising from - 1 | unique type T a = T a (a Nat) - - a doesn't expect an argument; however, it is applied to Nat. - -``` -conflicting constraints on the kind of `a` in a sum - -``` unison -unique type T a - = Star a - | StarStar (a Nat) -``` - -``` ucm - - Loading changes detected in scratch.u. - - Kind mismatch arising from - 3 | | StarStar (a Nat) - - a doesn't expect an argument; however, it is applied to Nat. - -``` -## Kinds are inferred by decl component - -Successfully infer `a` in `Ping a` to be of kind `* -> *` by -inspecting its component-mate `Pong`. - -``` unison -unique type Ping a = Ping Pong -unique type Pong = Pong (Ping Optional) -``` - -``` 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`: - - type Ping a - type Pong - -``` -Catch the conflict on the kind of `a` in `Ping a`. `Ping` restricts -`a` to `*`, whereas `Pong` restricts `a` to `* -> *`. - -``` unison -unique type Ping a = Ping a Pong -unique type Pong = Pong (Ping Optional) -``` - -``` ucm - - Loading changes detected in scratch.u. - - Kind mismatch arising from - 1 | unique type Ping a = Ping a Pong - - The arrow type (->) expects arguments of kind Type; however, - it is applied to a which has kind: Type -> Type. - -``` -Successful example between mutually recursive type and ability - -``` unison -unique type Ping a = Ping (a Nat -> {Pong Nat} ()) -unique ability Pong a where - pong : Ping Optional -> () -``` - -``` 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`: - - type Ping a - ability Pong a - -``` -Catch conflict between mutually recursive type and ability - -``` unison -unique type Ping a = Ping (a -> {Pong Nat} ()) -unique ability Pong a where - pong : Ping Optional -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - Kind mismatch arising from - 3 | pong : Ping Optional -> () - - Ping expects an argument of kind: Type; however, it is - applied to Optional which has kind: Type -> Type. - -``` -Consistent instantiation of `T`'s `a` parameter in `S` - -``` unison -unique type T a = T a - -unique type S = S (T Nat) -``` - -``` 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`: - - type S - type T a - -``` -Delay kind defaulting until all components are processed. Here `S` -constrains the kind of `T`'s `a` parameter, although `S` is not in -the same component as `T`. - -``` unison -unique type T a = T - -unique type S = S (T Optional) -``` - -``` 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`: - - type S - type T a - -``` -Catch invalid instantiation of `T`'s `a` parameter in `S` - -``` unison -unique type T a = T a - -unique type S = S (T Optional) -``` - -``` ucm - - Loading changes detected in scratch.u. - - Kind mismatch arising from - 3 | unique type S = S (T Optional) - - T expects an argument of kind: Type; however, it is applied - to Optional which has kind: Type -> Type. - -``` -## Checking annotations - -Catch kind error in type annotation - -``` unison -test : Nat Nat -test = 0 -``` - -``` ucm - - Loading changes detected in scratch.u. - - Kind mismatch arising from - 1 | test : Nat Nat - - Nat doesn't expect an argument; however, it is applied to - Nat. - -``` -Catch kind error in annotation example 2 - -``` unison -test : Optional -> () -test _ = () -``` - -``` ucm - - Loading changes detected in scratch.u. - - Kind mismatch arising from - 1 | test : Optional -> () - - The arrow type (->) expects arguments of kind Type; however, - it is applied to Optional which has kind: Type -> Type. - -``` -Catch kind error in annotation example 3 - -``` unison -unique type T a = T (a Nat) - -test : T Nat -> () -test _ = () -``` - -``` ucm - - Loading changes detected in scratch.u. - - Kind mismatch arising from - 3 | test : T Nat -> () - - T expects an argument of kind: Type -> Type; however, it is - applied to Nat which has kind: Type. - -``` -Catch kind error in scoped type variable annotation - -``` unison -unique type StarStar a = StarStar (a Nat) -unique type Star a = Star a - -test : StarStar a -> () -test _ = - buggo : Star a - buggo = bug "" - () -``` - -``` ucm - - Loading changes detected in scratch.u. - - Kind mismatch arising from - 6 | buggo : Star a - - Star expects an argument of kind: Type; however, it is - applied to a which has kind: Type -> Type. - -``` -## Effect/type mismatch - -Effects appearing where types are expected - -``` unison -unique ability Foo where - foo : () - -test : Foo -> () -test _ = () -``` - -``` ucm - - Loading changes detected in scratch.u. - - Kind mismatch arising from - 4 | test : Foo -> () - - The arrow type (->) expects arguments of kind Type; however, - it is applied to Foo which has kind: Ability. - -``` -Types appearing where effects are expected - -``` unison -test : {Nat} () -test _ = () -``` - -``` ucm - - Loading changes detected in scratch.u. - - Kind mismatch arising from - 1 | test : {Nat} () - - An ability list must consist solely of abilities; however, - this list contains Nat which has kind Type. Abilities are of - kind Ability. - -``` -## Cyclic kinds - -``` unison -unique type T a = T (a a) -``` - -``` ucm - - Loading changes detected in scratch.u. - - Cannot construct infinite kind - 1 | unique type T a = T (a a) - - The above application constrains the kind of a to be - infinite, generated by the constraint k = k -> Type where k - is the kind of a. - -``` -``` unison -unique type T a b = T (a b) (b a) -``` - -``` ucm - - Loading changes detected in scratch.u. - - Cannot construct infinite kind - 1 | unique type T a b = T (a b) (b a) - - The above application constrains the kind of b to be - infinite, generated by the constraint - k = (k -> Type) -> Type where k is the kind of b. - -``` -``` unison -unique type Ping a = Ping (a Pong) -unique type Pong a = Pong (a Ping) -``` - -``` ucm - - Loading changes detected in scratch.u. - - Cannot construct infinite kind - 1 | unique type Ping a = Ping (a Pong) - - The above application constrains the kind of a to be - infinite, generated by the constraint - k = (((k -> Type) -> Type) -> Type) -> Type where k is the - kind of a. - -``` diff --git a/unison-src/transcripts/lambdacase.md b/unison-src/transcripts/lambdacase.md deleted file mode 100644 index a4d1ba96f1..0000000000 --- a/unison-src/transcripts/lambdacase.md +++ /dev/null @@ -1,119 +0,0 @@ -# Lambda case syntax - -```ucm:hide -scratch/main> builtins.merge -``` - -This function takes a single argument and immediately pattern matches on it. As we'll see below, it can be written using `cases` syntax: - -```unison -isEmpty x = match x with - [] -> true - _ -> false -``` - -```ucm:hide -scratch/main> add -``` - -Here's the same function written using `cases` syntax: - -```unison -isEmpty2 = cases - [] -> true - _ -> false -``` - -Notice that Unison detects this as an alias of `isEmpty`, and if we view `isEmpty` - -```ucm -scratch/main> view isEmpty -``` - -it shows the definition using `cases` syntax opportunistically, even though the code was originally written without that syntax. - -## Multi-argument cases - -Functions that take multiple arguments and immediately match on a tuple of arguments can also be rewritten to use `cases`. Here's a version using regular `match` syntax on a tuple: - -```unison:hide -merge : [a] -> [a] -> [a] -merge xs ys = match (xs, ys) with - ([], ys) -> ys - (xs, []) -> xs - (h +: t, h2 +: t2) -> - if h <= h2 then h +: merge t (h2 +: t2) - else h2 +: merge (h +: t) t2 -``` - -```ucm -scratch/main> add -``` - -And here's a version using `cases`. The patterns are separated by commas: - -```unison -merge2 : [a] -> [a] -> [a] -merge2 = cases - [], ys -> ys - xs, [] -> xs - h +: t, h2 +: t2 -> - if h <= h2 then h +: merge2 t (h2 +: t2) - else h2 +: merge2 (h +: t) t2 -``` - -Notice that Unison detects this as an alias of `merge`, and if we view `merge` - -```ucm -scratch/main> view merge -``` - -it again shows the definition using the multi-argument `cases` syntax opportunistically, even though the code was originally written without that syntax. - -Here's another example: - -```unison -structural type B = T | F - -blah : B -> B -> Text -blah = cases - T, x -> "hi" - x, y -> "bye" - -blorf = cases - x, T -> x - x, y -> y - -> blah T F -> blah F F -> blorf T F -``` - -## Patterns with multiple guards - -```unison -merge3 : [a] -> [a] -> [a] -merge3 = cases - [], ys -> ys - xs, [] -> xs - h +: t, h2 +: t2 | h <= h2 -> h +: merge3 t (h2 +: t2) - | otherwise -> h2 +: merge3 (h +: t) t2 -``` - -```ucm -scratch/main> add -scratch/main> view merge3 -``` - -This is the same definition written with multiple patterns and not using the `cases` syntax; notice it is considered an alias of `merge3` above. - -```unison -merge4 : [a] -> [a] -> [a] -merge4 a b = match (a,b) with - [], ys -> ys - xs, [] -> xs - h +: t, h2 +: t2 | h <= h2 -> h +: merge4 t (h2 +: t2) - h +: t, h2 +: t2 | otherwise -> h2 +: merge4 (h +: t) t2 -``` - - diff --git a/unison-src/transcripts/lambdacase.output.md b/unison-src/transcripts/lambdacase.output.md deleted file mode 100644 index c7c6e01c24..0000000000 --- a/unison-src/transcripts/lambdacase.output.md +++ /dev/null @@ -1,238 +0,0 @@ -# Lambda case syntax - -This function takes a single argument and immediately pattern matches on it. As we'll see below, it can be written using `cases` syntax: - -``` unison -isEmpty x = match x with - [] -> true - _ -> false -``` - -``` 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`: - - isEmpty : [t] -> Boolean - -``` -Here's the same function written using `cases` syntax: - -``` unison -isEmpty2 = cases - [] -> true - _ -> false -``` - -``` 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`: - - isEmpty2 : [t] -> Boolean - (also named isEmpty) - -``` -Notice that Unison detects this as an alias of `isEmpty`, and if we view `isEmpty` - -``` ucm -scratch/main> view isEmpty - - isEmpty : [t] -> Boolean - isEmpty = cases - [] -> true - _ -> false - -``` -it shows the definition using `cases` syntax opportunistically, even though the code was originally written without that syntax. - -## Multi-argument cases - -Functions that take multiple arguments and immediately match on a tuple of arguments can also be rewritten to use `cases`. Here's a version using regular `match` syntax on a tuple: - -``` unison -merge : [a] -> [a] -> [a] -merge xs ys = match (xs, ys) with - ([], ys) -> ys - (xs, []) -> xs - (h +: t, h2 +: t2) -> - if h <= h2 then h +: merge t (h2 +: t2) - else h2 +: merge (h +: t) t2 -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - merge : [a] -> [a] -> [a] - -``` -And here's a version using `cases`. The patterns are separated by commas: - -``` unison -merge2 : [a] -> [a] -> [a] -merge2 = cases - [], ys -> ys - xs, [] -> xs - h +: t, h2 +: t2 -> - if h <= h2 then h +: merge2 t (h2 +: t2) - else h2 +: merge2 (h +: t) t2 -``` - -``` 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`: - - merge2 : [a] -> [a] -> [a] - (also named merge) - -``` -Notice that Unison detects this as an alias of `merge`, and if we view `merge` - -``` ucm -scratch/main> view merge - - merge : [a] -> [a] -> [a] - merge = cases - [], ys -> ys - xs, [] -> xs - h +: t, h2 +: t2 -> - if h <= h2 then h +: merge t (h2 +: t2) - else h2 +: merge (h +: t) t2 - -``` -it again shows the definition using the multi-argument `cases` syntax opportunistically, even though the code was originally written without that syntax. - -Here's another example: - -``` unison -structural type B = T | F - -blah : B -> B -> Text -blah = cases - T, x -> "hi" - x, y -> "bye" - -blorf = cases - x, T -> x - x, y -> y - -> blah T F -> blah F F -> blorf T F -``` - -``` 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`: - - structural type B - blah : B -> B -> Text - blorf : B -> B -> B - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 12 | > blah T F - ⧩ - "hi" - - 13 | > blah F F - ⧩ - "bye" - - 14 | > blorf T F - ⧩ - F - -``` -## Patterns with multiple guards - -``` unison -merge3 : [a] -> [a] -> [a] -merge3 = cases - [], ys -> ys - xs, [] -> xs - h +: t, h2 +: t2 | h <= h2 -> h +: merge3 t (h2 +: t2) - | otherwise -> h2 +: merge3 (h +: t) t2 -``` - -``` 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`: - - merge3 : [a] -> [a] -> [a] - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - merge3 : [a] -> [a] -> [a] - -scratch/main> view merge3 - - merge3 : [a] -> [a] -> [a] - merge3 = cases - [], ys -> ys - xs, [] -> xs - h +: t, h2 +: t2 - | h <= h2 -> h +: merge3 t (h2 +: t2) - | otherwise -> h2 +: merge3 (h +: t) t2 - -``` -This is the same definition written with multiple patterns and not using the `cases` syntax; notice it is considered an alias of `merge3` above. - -``` unison -merge4 : [a] -> [a] -> [a] -merge4 a b = match (a,b) with - [], ys -> ys - xs, [] -> xs - h +: t, h2 +: t2 | h <= h2 -> h +: merge4 t (h2 +: t2) - h +: t, h2 +: t2 | otherwise -> h2 +: merge4 (h +: t) t2 -``` - -``` 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`: - - merge4 : [a] -> [a] -> [a] - (also named merge3) - -``` diff --git a/unison-src/transcripts/lsp-fold-ranges.md b/unison-src/transcripts/lsp-fold-ranges.md deleted file mode 100644 index 20dddc3861..0000000000 --- a/unison-src/transcripts/lsp-fold-ranges.md +++ /dev/null @@ -1,33 +0,0 @@ -```ucm:hide -scratch/main> builtins.mergeio -``` - -```unison:hide - -{{ Type doc }} -structural type Optional a = - None - | Some a - -{{ - Multi line - - Term doc -}} -List.map : - (a -> b) - -> [a] - -> [b] -List.map f = cases - (x +: xs) -> f x +: List.map f xs - [] -> [] - -test> z = let - x = "hello" - y = "world" - [Ok (x ++ y)] -``` - -```ucm -scratch/main> debug.lsp.fold-ranges -``` diff --git a/unison-src/transcripts/lsp-fold-ranges.output.md b/unison-src/transcripts/lsp-fold-ranges.output.md deleted file mode 100644 index 46e0a9c76c..0000000000 --- a/unison-src/transcripts/lsp-fold-ranges.output.md +++ /dev/null @@ -1,52 +0,0 @@ -``` unison -{{ Type doc }} -structural type Optional a = - None - | Some a - -{{ - Multi line - - Term doc -}} -List.map : - (a -> b) - -> [a] - -> [b] -List.map f = cases - (x +: xs) -> f x +: List.map f xs - [] -> [] - -test> z = let - x = "hello" - y = "world" - [Ok (x ++ y)] -``` - -``` ucm -scratch/main> debug.lsp.fold-ranges - - 《{{ Type doc }}》 - 《structural type Optional a = - None - | Some a》 - - 《{{ - Multi line - - Term doc - }}》 - 《List.map : - (a -> b) - -> [a] - -> [b] - List.map f = cases - (x +: xs) -> f x +: List.map f xs - [] -> []》 - - 《test> z = let - x = "hello" - y = "world" - [Ok (x ++ y)]》 - -``` diff --git a/unison-src/transcripts/lsp-name-completion.md b/unison-src/transcripts/lsp-name-completion.md deleted file mode 100644 index ba879a72e9..0000000000 --- a/unison-src/transcripts/lsp-name-completion.md +++ /dev/null @@ -1,35 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtins -``` - -```unison:hide -foldMap = "top-level" -nested.deeply.foldMap = "nested" -lib.base.foldMap = "lib" -lib.dep.lib.transitive.foldMap = "transitive-lib" --- A deeply nested definition with the same hash as the top level one. --- This should not be included in the completion results if a better name with the same hash IS included. -lib.dep.lib.transitive_same_hash.foldMap = "top-level" -foldMapWith = "partial match" - -other = "other" -``` - -```ucm:hide -scratch/main> add -``` - -Completion should find all the `foldMap` definitions in the codebase, -sorted by number of name segments, shortest first. - -Individual LSP clients may still handle sorting differently, e.g. doing a fuzzy match over returned results, or -prioritizing exact matches over partial matches. We don't have any control over that. - -```ucm -scratch/main> debug.lsp-name-completion foldMap -``` - -Should still find the term which has a matching hash to a better name if the better name doesn't match. -```ucm -scratch/main> debug.lsp-name-completion transitive_same_hash.foldMap -``` diff --git a/unison-src/transcripts/lsp-name-completion.output.md b/unison-src/transcripts/lsp-name-completion.output.md deleted file mode 100644 index 9c310ea871..0000000000 --- a/unison-src/transcripts/lsp-name-completion.output.md +++ /dev/null @@ -1,39 +0,0 @@ -``` unison -foldMap = "top-level" -nested.deeply.foldMap = "nested" -lib.base.foldMap = "lib" -lib.dep.lib.transitive.foldMap = "transitive-lib" --- A deeply nested definition with the same hash as the top level one. --- This should not be included in the completion results if a better name with the same hash IS included. -lib.dep.lib.transitive_same_hash.foldMap = "top-level" -foldMapWith = "partial match" - -other = "other" -``` - -Completion should find all the `foldMap` definitions in the codebase, -sorted by number of name segments, shortest first. - -Individual LSP clients may still handle sorting differently, e.g. doing a fuzzy match over returned results, or -prioritizing exact matches over partial matches. We don't have any control over that. - -``` ucm -scratch/main> debug.lsp-name-completion foldMap - - Matching Path Name Hash - foldMap foldMap #o38ps8p4q6 - foldMapWith foldMapWith #r9rs4mcb0m - foldMap nested.deeply.foldMap #snrjegr5dk - foldMap lib.base.foldMap #jf4buul17k - foldMap lib.dep.lib.transitive.foldMap #0o01gvr3fi - -``` -Should still find the term which has a matching hash to a better name if the better name doesn't match. - -``` ucm -scratch/main> debug.lsp-name-completion transitive_same_hash.foldMap - - Matching Path Name Hash - transitive_same_hash.foldMap lib.dep.lib.transitive_same_hash.foldMap #o38ps8p4q6 - -``` diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index 1d28320c84..6b759f44ce 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -3,7 +3,7 @@ The `merge` command merges together two branches in the same project: the current branch (unspecificed), and the target branch. For example, to merge `topic` into `main`, switch to `main` and run `merge topic`: -```ucm +``` ucm scratch/main> help merge scratch/main> help merge.commit ``` @@ -13,136 +13,136 @@ contains both additions. ## Basic merge: two unconflicted adds -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` -```ucm:hide -project/main> branch alice +``` ucm :hide +scratch/main> branch alice ``` Alice's adds: -```unison:hide +``` unison :hide foo : Text foo = "alices foo" ``` -```ucm:hide -project/alice> add -project/main> branch bob +``` ucm :hide +scratch/alice> add +scratch/main> branch bob ``` Bob's adds: -```unison:hide +``` unison :hide bar : Text bar = "bobs bar" ``` -```ucm:hide -project/bob> add +``` ucm :hide +scratch/bob> add ``` Merge result: -```ucm -project/alice> merge /bob -project/alice> view foo bar +``` ucm +scratch/alice> merge /bob +scratch/alice> view foo bar ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## Basic merge: two identical adds If Alice and Bob also happen to add the same definition, that's not a conflict. -```ucm:hide -project/main> builtins.mergeio lib.builtins -project/main> branch alice +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +scratch/main> branch alice ``` Alice's adds: -```unison:hide +``` unison :hide foo : Text foo = "alice and bobs foo" ``` -```ucm:hide -project/alice> add -project/main> branch bob +``` ucm :hide +scratch/alice> add +scratch/main> branch bob ``` Bob's adds: -```unison:hide +``` unison :hide foo : Text foo = "alice and bobs foo" bar : Text bar = "bobs bar" ``` -```ucm:hide -project/bob> add +``` ucm :hide +scratch/bob> add ``` Merge result: -```ucm -project/alice> merge /bob -project/alice> view foo bar +``` ucm +scratch/alice> merge /bob +scratch/alice> view foo bar ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## Simple update propagation Updates that occur in one branch are propagated to the other. In this example, Alice updates `foo`, while Bob adds a new dependent `bar` of the original `foo`. When Bob's branch is merged into Alice's, her update to `foo` is propagated to his `bar`. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` Original branch: -```unison:hide +``` unison :hide foo : Text foo = "old foo" ``` -```ucm:hide -project/main> add -project/main> branch alice +``` ucm :hide +scratch/main> add +scratch/main> branch alice ``` Alice's updates: -```unison:hide +``` unison :hide foo : Text foo = "new foo" ``` -```ucm:hide -project/alice> update -project/main> branch bob +``` ucm :hide +scratch/alice> update +scratch/main> branch bob ``` Bob's adds: -```unison:hide +``` unison :hide bar : Text bar = foo ++ " - " ++ foo ``` -```ucm -project/bob> display bar +``` ucm +scratch/bob> display bar ``` -```ucm:hide -project/bob> add +``` ucm :hide +scratch/bob> add ``` Merge result: -```ucm -project/alice> merge /bob -project/alice> view foo bar -project/alice> display bar +``` ucm +scratch/alice> merge /bob +scratch/alice> view foo bar +scratch/alice> display bar ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## Update propagation with common dependent @@ -151,12 +151,12 @@ We classify something as an update if its "syntactic hash"—not its normal Unis Let's see an example. We have `foo`, which depends on `bar` and `baz`. Alice updates `bar` (propagating to `foo`), and Bob updates `baz` (propagating to `foo`). When we merge their updates, both updates will be reflected in the final `foo`. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` Original branch: -```unison:hide +``` unison :hide foo : Text foo = "foo" ++ " - " ++ bar ++ " - " ++ baz @@ -167,60 +167,60 @@ baz : Text baz = "old baz" ``` -```ucm:hide -project/main> add -project/main> branch alice +``` ucm :hide +scratch/main> add +scratch/main> branch alice ``` Alice's updates: -```unison:hide +``` unison :hide bar : Text bar = "alices bar" ``` -```ucm:hide -project/alice> update +``` ucm :hide +scratch/alice> update ``` -```ucm -project/alice> display foo +``` ucm +scratch/alice> display foo ``` -```ucm:hide -project/main> branch bob +``` ucm :hide +scratch/main> branch bob ``` Bob's updates: -```unison:hide +``` unison :hide baz : Text baz = "bobs baz" ``` -```ucm:hide -project/bob> update +``` ucm :hide +scratch/bob> update ``` -```ucm -project/bob> display foo +``` ucm +scratch/bob> display foo ``` Merge result: -```ucm -project/alice> merge /bob -project/alice> view foo bar baz -project/alice> display foo +``` ucm +scratch/alice> merge /bob +scratch/alice> view foo bar baz +scratch/alice> display foo ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## Propagating an update to an update Of course, it's also possible for Alice's update to propagate to one of Bob's updates. In this example, `foo` depends on `bar` which depends on `baz`. Alice updates `baz`, propagating to `bar` and `foo`, while Bob updates `bar` (to something that still depends on `foo`), propagating to `baz`. The merged result will have Alice's update to `foo` incorporated into Bob's updated `bar`, and both updates will propagate to `baz`. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` Original branch: -```unison:hide +``` unison :hide foo : Text foo = "old foo" ++ " - " ++ bar @@ -231,99 +231,99 @@ baz : Text baz = "old baz" ``` -```ucm:hide -project/main> add +``` ucm :hide +scratch/main> add ``` -```ucm -project/main> display foo +``` ucm +scratch/main> display foo ``` -```ucm:hide -project/main> branch alice +``` ucm :hide +scratch/main> branch alice ``` Alice's updates: -```unison:hide +``` unison :hide baz : Text baz = "alices baz" ``` -```ucm:hide -project/alice> update +``` ucm :hide +scratch/alice> update ``` -```ucm -project/alice> display foo +``` ucm +scratch/alice> display foo ``` -```ucm:hide -project/main> branch bob +``` ucm :hide +scratch/main> branch bob ``` Bob's updates: -```unison:hide +``` unison :hide bar : Text bar = "bobs bar" ++ " - " ++ baz ``` -```ucm:hide -project/bob> update +``` ucm :hide +scratch/bob> update ``` -```ucm -project/bob> display foo +``` ucm +scratch/bob> display foo ``` Merge result: -```ucm -project/alice> merge /bob -project/alice> view foo bar baz -project/alice> display foo +``` ucm +scratch/alice> merge /bob +scratch/alice> view foo bar baz +scratch/alice> display foo ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## Update + delete isn't (currently) a conflict We don't currently consider "update + delete" a conflict like Git does. In this situation, the delete is just ignored, allowing the update to proceed. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` Original branch: -```unison:hide +``` unison :hide foo : Text foo = "old foo" ``` -```ucm:hide -project/main> add -project/main> branch alice +``` ucm :hide +scratch/main> add +scratch/main> branch alice ``` Alice's updates: -```unison:hide +``` unison :hide foo : Text foo = "alices foo" ``` -```ucm:hide -project/alice> update -project/main> branch bob +``` ucm :hide +scratch/alice> update +scratch/main> branch bob ``` Bob's changes: -```ucm -project/bob> delete.term foo +``` ucm +scratch/bob> delete.term foo ``` Merge result: -```ucm -project/alice> merge /bob -project/alice> view foo +``` ucm +scratch/alice> merge /bob +scratch/alice> view foo ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` In a future version, we'd like to give the user a warning at least. @@ -332,16 +332,16 @@ In a future version, we'd like to give the user a warning at least. Library dependencies don't cause merge conflicts, the library dependencies are just unioned together. If two library dependencies have the same name but different namespace hashes, then the merge algorithm makes up two fresh names. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` Alice's adds: -```ucm:hide -project/main> branch alice +``` ucm :hide +scratch/main> branch alice ``` -```unison:hide +``` unison :hide lib.alice.foo : Nat lib.alice.foo = 17 @@ -352,13 +352,13 @@ lib.bothDifferent.baz : Nat lib.bothDifferent.baz = 19 ``` -```ucm:hide -project/alice> add -project/main> branch bob +``` ucm :hide +scratch/alice> add +scratch/main> branch bob ``` Bob's adds: -```unison:hide +``` unison :hide lib.bob.foo : Nat lib.bob.foo = 20 @@ -369,102 +369,102 @@ lib.bothDifferent.baz : Nat lib.bothDifferent.baz = 21 ``` -```ucm:hide -project/bob> add +``` ucm :hide +scratch/bob> add ``` Merge result: -```ucm -project/alice> merge bob -project/alice> view foo bar baz +``` ucm +scratch/alice> merge bob +scratch/alice> view foo bar baz ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## No-op merge (Bob = Alice) If Bob is equals Alice, then merging Bob into Alice looks like this. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` -```ucm -project/main> branch alice -project/main> branch bob -project/alice> merge /bob +``` ucm +scratch/main> branch alice +scratch/main> branch bob +scratch/alice> merge /bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## No-op merge (Bob < Alice) If Bob is behind Alice, then merging Bob into Alice looks like this. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` -```ucm -project/main> branch alice -project/main> branch bob +``` ucm +scratch/main> branch alice +scratch/main> branch bob ``` Alice's addition: -```unison:hide +``` unison :hide foo : Text foo = "foo" ``` -```ucm -project/alice> add -project/alice> merge /bob +``` ucm +scratch/alice> add +scratch/alice> merge /bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## Fast-forward merge (Bob > Alice) If Bob is ahead of Alice, then merging Bob into Alice looks like this. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` -```ucm -project/main> branch alice -project/main> branch bob +``` ucm +scratch/main> branch alice +scratch/main> branch bob ``` Bob's addition: -```unison:hide +``` unison :hide foo : Text foo = "foo" ``` -```ucm -project/bob> add -project/alice> merge /bob +``` ucm +scratch/bob> add +scratch/alice> merge /bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## No-op merge: merge empty namespace into empty namespace -```ucm -project/main> branch topic -project/main> merge /topic +``` ucm +scratch/main> branch topic +scratch/main> merge /topic ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## Merge failure: someone deleted something @@ -475,41 +475,41 @@ This can cause merge failures due to out-of-scope identifiers, and the user may In this example, Alice deletes `foo`, while Bob adds a new dependent of `foo`. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` Original branch: -```unison:hide +``` unison :hide foo : Text foo = "foo" ``` -```ucm:hide -project/main> add -project/main> branch alice +``` ucm :hide +scratch/main> add +scratch/main> branch alice ``` Alice's delete: -```ucm -project/alice> delete.term foo +``` ucm +scratch/alice> delete.term foo ``` -```ucm:hide -project/main> branch bob +``` ucm :hide +scratch/main> branch bob ``` Bob's new code that depends on `foo`: -```unison:hide +``` unison :hide bar : Text bar = foo ++ " - " ++ foo ``` -```ucm:error -project/bob> add -project/alice> merge /bob +``` ucm :error +scratch/bob> add +scratch/alice> merge /bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## Merge failure: type error @@ -518,48 +518,48 @@ It may be Alice's and Bob's changes merge together cleanly in the sense that the In this example, Alice updates a `Text` to a `Nat`, while Bob adds a new dependent of the `Text`. Upon merging, propagating Alice's update to Bob's dependent causes a typechecking failure. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` Original branch: -```unison:hide +``` unison :hide foo : Text foo = "foo" ``` -```ucm:hide -project/main> add -project/main> branch alice +``` ucm :hide +scratch/main> add +scratch/main> branch alice ``` Alice's update: -```unison:hide +``` unison :hide foo : Nat foo = 100 ``` -```ucm:hide -project/alice> update -project/main> branch bob +``` ucm :hide +scratch/alice> update +scratch/main> branch bob ``` Bob's new definition: -```unison:hide +``` unison :hide bar : Text bar = foo ++ " - " ++ foo ``` -```ucm:hide -project/bob> update +``` ucm :hide +scratch/bob> update ``` -```ucm:error -project/alice> merge /bob +``` ucm :error +scratch/alice> merge /bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## Merge failure: simple term conflict @@ -567,12 +567,12 @@ scratch/main> project.delete project Alice and Bob may disagree about the definition of a term. In this case, the conflicted term and all of its dependents are presented to the user to resolve. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` Original branch: -```unison:hide +``` unison :hide foo : Text foo = "old foo" @@ -580,13 +580,13 @@ bar : Text bar = "old bar" ``` -```ucm:hide -project/main> add -project/main> branch alice +``` ucm :hide +scratch/main> add +scratch/main> branch alice ``` Alice's changes: -```unison:hide +``` unison :hide foo : Text foo = "alices foo" @@ -597,14 +597,14 @@ qux : Text qux = "alices qux depends on alices foo" ++ foo ``` -```ucm:hide -project/alice> update -project/main> branch bob +``` ucm :hide +scratch/alice> update +scratch/main> branch bob ``` Bob's changes: -```unison:hide +``` unison :hide foo : Text foo = "bobs foo" @@ -612,246 +612,243 @@ baz : Text baz = "bobs baz" ``` -```ucm:hide -project/bob> update +``` ucm :hide +scratch/bob> update ``` -```ucm:error -project/alice> merge /bob +``` ucm :error +scratch/alice> merge /bob ``` -```ucm -project/merge-bob-into-alice> view bar baz +``` ucm +scratch/merge-bob-into-alice> view bar baz ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## Merge failure: simple type conflict Ditto for types; if the hashes don't match, it's a conflict. In this example, Alice and Bob do different things to the same constructor. However, any explicit changes to the same type will result in a conflict, including changes that could concievably be merged (e.g. Alice and Bob both add a new constructor, or edit different constructors). -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` Original branch: -```unison:hide +``` unison :hide unique type Foo = MkFoo Nat ``` -```ucm:hide -project/main> add -project/main> branch alice +``` ucm :hide +scratch/main> add +scratch/main> branch alice ``` Alice's changes: -```unison:hide +``` unison :hide unique type Foo = MkFoo Nat Nat ``` -```ucm:hide -project/alice> update -project/main> branch bob +``` ucm :hide +scratch/alice> update +scratch/main> branch bob ``` Bob's changes: -```unison:hide +``` unison :hide unique type Foo = MkFoo Nat Text ``` -```ucm:hide -project/bob> update +``` ucm :hide +scratch/bob> update ``` -```ucm:error -project/alice> merge /bob +``` ucm :error +scratch/alice> merge /bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## Merge failure: type-update + constructor-rename conflict We model the renaming of a type's constructor as an update, so if Alice updates a type and Bob renames one of its constructors (even without changing its structure), we consider it a conflict. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` Original branch: -```unison:hide +``` unison :hide unique type Foo = Baz Nat | Qux Text ``` -```ucm:hide -project/main> add -project/main> branch alice +``` ucm :hide +scratch/main> add +scratch/main> branch alice ``` Alice's changes `Baz Nat` to `Baz Nat Nat` -```unison:hide +``` unison :hide unique type Foo = Baz Nat Nat | Qux Text ``` -```ucm:hide -project/alice> update -project/main> branch bob +``` ucm :hide +scratch/alice> update +scratch/main> branch bob ``` Bob's renames `Qux` to `BobQux`: -```unison:hide -unique type Foo = Baz Nat | BobQux Text +``` ucm +scratch/bob> move.term Foo.Qux Foo.BobQux ``` -```ucm:hide -project/bob> update -``` -```ucm:error -project/alice> merge /bob +``` ucm :error +scratch/alice> merge /bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## Merge failure: constructor-rename conflict Here is another example demonstrating that constructor renames are modeled as updates. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` Original branch: -```unison:hide +``` unison :hide unique type Foo = Baz Nat | Qux Text ``` -```ucm:hide -project/main> add -project/main> branch alice +``` ucm :hide +scratch/main> add +scratch/main> branch alice ``` Alice's rename: -```ucm -project/alice> move.term Foo.Baz Foo.Alice +``` ucm +scratch/alice> move.term Foo.Baz Foo.Alice ``` -```ucm:hide -project/main> branch bob +``` ucm :hide +scratch/main> branch bob ``` Bob's rename: -```ucm -project/bob> move.term Foo.Qux Foo.Bob +``` ucm +scratch/bob> move.term Foo.Qux Foo.Bob ``` -```ucm:error -project/alice> merge bob +``` ucm :error +scratch/alice> merge bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## Merge failure: non-constructor/constructor conflict A constructor on one side can conflict with a regular term definition on the other. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` -```ucm:hide -project/main> branch alice +``` ucm :hide +scratch/main> branch alice ``` Alice's additions: -```unison:hide +``` unison :hide my.cool.thing : Nat my.cool.thing = 17 ``` -```ucm:hide -project/alice> add -project/main> branch bob +``` ucm :hide +scratch/alice> add +scratch/main> branch bob ``` Bob's additions: -```unison:hide +``` unison :hide unique ability my.cool where thing : Nat -> Nat ``` -```ucm:hide -project/bob> add +``` ucm :hide +scratch/bob> add ``` -```ucm:error -project/alice> merge bob +``` ucm :error +scratch/alice> merge bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## Merge failure: type/type conflict with term/constructor conflict Here's a subtle situation where a new type is added on each side of the merge, and an existing term is replaced with a constructor of one of the types. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` Original branch: -```unison:hide +``` unison :hide Foo.Bar : Nat Foo.Bar = 17 ``` -```ucm:hide -project/main> add -project/main> branch alice +``` ucm :hide +scratch/main> add +scratch/main> branch alice ``` Alice adds this type `Foo` with constructor `Foo.Alice`: -```unison:hide +``` unison :hide unique type Foo = Alice Nat ``` -```ucm:hide -project/alice> add -project/main> branch bob +``` ucm :hide +scratch/alice> add +scratch/main> branch bob ``` Bob adds the type `Foo` with constructor `Foo.Bar`, replacing the original `Foo.Bar` term: -```ucm -project/bob> delete.term Foo.Bar +``` ucm +scratch/bob> delete.term Foo.Bar ``` -```unison:hide +``` unison :hide unique type Foo = Bar Nat Nat ``` -```ucm:hide -project/bob> add +``` ucm :hide +scratch/bob> add ``` These won't cleanly merge. -```ucm:error -project/alice> merge bob +``` ucm :error +scratch/alice> merge bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` Here's a more involved example that demonstrates the same idea. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` In the LCA, we have a type with two constructors, and some term. -```unison:hide +``` unison :hide unique type Foo = Bar.Baz Nat | Bar.Qux Nat Nat @@ -860,20 +857,20 @@ Foo.Bar.Hello : Nat Foo.Bar.Hello = 17 ``` -```ucm:hide -project/main> add -project/main> branch alice +``` ucm :hide +scratch/main> add +scratch/main> branch alice ``` Alice deletes this type entirely, and repurposes its constructor names for other terms. She also updates the term. -```ucm:hide -project/alice> delete.type Foo -project/alice> delete.term Foo.Bar.Baz -project/alice> delete.term Foo.Bar.Qux +``` ucm :hide +scratch/alice> delete.type Foo +scratch/alice> delete.term Foo.Bar.Baz +scratch/alice> delete.term Foo.Bar.Qux ``` -```unison:hide:all +``` unison :hide:all Foo.Bar.Baz : Nat Foo.Bar.Baz = 100 @@ -884,36 +881,36 @@ Foo.Bar.Hello : Nat Foo.Bar.Hello = 18 ``` -```ucm:hide -project/alice> update +``` ucm :hide +scratch/alice> update ``` -```ucm -project/alice> view Foo.Bar.Baz Foo.Bar.Qux Foo.Bar.Hello +``` ucm +scratch/alice> view Foo.Bar.Baz Foo.Bar.Qux Foo.Bar.Hello ``` Bob, meanwhile, first deletes the term, then sort of deletes the type and re-adds it under another name, but one constructor's fully qualified names doesn't actually change. The other constructor reuses the name of the deleted term. -```ucm:hide -project/main> branch bob -project/bob> delete.term Foo.Bar.Hello -project/bob> move.type Foo Foo.Bar -project/bob> move.term Foo.Bar.Qux Foo.Bar.Hello +``` ucm :hide +scratch/main> branch bob +scratch/bob> delete.term Foo.Bar.Hello +scratch/bob> move.type Foo Foo.Bar +scratch/bob> move.term Foo.Bar.Qux Foo.Bar.Hello ``` -```ucm -project/bob> view Foo.Bar +``` ucm +scratch/bob> view Foo.Bar ``` At this point, Bob and alice have both updated the name `Foo.Bar.Hello` in different ways, so that's a conflict. Therefore, Bob's entire type (`Foo.Bar` with constructors `Foo.Bar.Baz` and `Foo.Bar.Hello`) gets rendered into the scratch file. Notably, Alice's "unconflicted" update on the name "Foo.Bar.Baz" (because she changed its hash and Bob didn't touch it) is nonetheless considered conflicted with Bob's "Foo.Bar.Baz". -```ucm:error -project/alice> merge bob +``` ucm :error +scratch/alice> merge bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## Merge algorithm quirk: add/add unique types @@ -924,45 +921,45 @@ which is a parse error. We will resolve this situation automatically in a future version. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` -```ucm:hide -project/main> branch alice +``` ucm :hide +scratch/main> branch alice ``` Alice's additions: -```unison:hide +``` unison :hide unique type Foo = Bar alice : Foo -> Nat alice _ = 18 ``` -```ucm:hide -project/alice> add -project/main> branch bob +``` ucm :hide +scratch/alice> add +scratch/main> branch bob ``` Bob's additions: -```unison:hide +``` unison :hide unique type Foo = Bar bob : Foo -> Nat bob _ = 19 ``` -```ucm:hide -project/bob> add +``` ucm :hide +scratch/bob> add ``` -```ucm:error -project/alice> merge bob +``` ucm :error +scratch/alice> merge bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## `merge.commit` example (success) @@ -970,84 +967,84 @@ scratch/main> project.delete project After merge conflicts are resolved, you can use `merge.commit` rather than `switch` + `merge` + `branch.delete` to "commit" your changes. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` Original branch: -```unison:hide +``` unison :hide foo : Text foo = "old foo" ``` -```ucm:hide -project/main> add -project/main> branch alice +``` ucm :hide +scratch/main> add +scratch/main> branch alice ``` Alice's changes: -```unison:hide +``` unison :hide foo : Text foo = "alices foo" ``` -```ucm:hide -project/alice> update -project/main> branch bob +``` ucm :hide +scratch/alice> update +scratch/main> branch bob ``` Bob's changes: -```unison:hide +``` unison :hide foo : Text foo = "bobs foo" ``` Attempt to merge: -```ucm:hide -project/bob> update +``` ucm :hide +scratch/bob> update ``` -```ucm:error -project/alice> merge /bob +``` ucm :error +scratch/alice> merge /bob ``` Resolve conflicts and commit: -```unison +``` unison foo : Text foo = "alice and bobs foo" ``` -```ucm -project/merge-bob-into-alice> update -project/merge-bob-into-alice> merge.commit -project/alice> view foo -project/alice> branches +``` ucm +scratch/merge-bob-into-alice> update +scratch/merge-bob-into-alice> merge.commit +scratch/alice> view foo +scratch/alice> branches ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## `merge.commit` example (failure) `merge.commit` can only be run on a "merge branch". -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` -```ucm -project/main> branch topic +``` ucm +scratch/main> branch topic ``` -```ucm:error -project/topic> merge.commit +``` ucm :error +scratch/topic> merge.commit ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` @@ -1059,12 +1056,12 @@ There are a number of conditions under which we can't perform a merge, and the u If `foo` and `bar` are aliases in the nearest common ancestor, but not in Alice's branch, then we don't know whether to update Bob's dependents to Alice's `foo` or Alice's `bar` (and vice-versa). -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` Original branch: -```unison:hide +``` unison :hide foo : Nat foo = 100 @@ -1072,13 +1069,13 @@ bar : Nat bar = 100 ``` -```ucm:hide -project/main> add -project/main> branch alice +``` ucm :hide +scratch/main> add +scratch/main> branch alice ``` Alice's updates: -```unison:hide +``` unison :hide foo : Nat foo = 200 @@ -1086,27 +1083,27 @@ bar : Nat bar = 300 ``` -```ucm:hide -project/alice> update -project/main> branch bob +``` ucm :hide +scratch/alice> update +scratch/main> branch bob ``` Bob's addition: -```unison:hide +``` unison :hide baz : Text baz = "baz" ``` -```ucm:hide -project/bob> add +``` ucm :hide +scratch/bob> add ``` -```ucm:error -project/alice> merge /bob +``` ucm :error +scratch/alice> merge /bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ### Conflict involving builtin @@ -1116,264 +1113,264 @@ conflict involving a builtin, we can't perform a merge. One way to fix this in the future would be to introduce a syntax for defining aliases in the scratch file. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` -```ucm:hide -project/main> branch alice +``` ucm :hide +scratch/main> branch alice ``` Alice's branch: -```ucm -project/alice> alias.type lib.builtins.Nat MyNat +``` ucm +scratch/alice> alias.type lib.builtins.Nat MyNat ``` Bob's branch: -```ucm:hide -project/main> branch bob +``` ucm :hide +scratch/main> branch bob ``` -```unison:hide +``` unison :hide unique type MyNat = MyNat Nat ``` -```ucm:hide -project/bob> add +``` ucm :hide +scratch/bob> add ``` -```ucm:error -project/alice> merge /bob +``` ucm :error +scratch/alice> merge /bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ### Constructor alias Each naming of a decl may not have more than one name for each constructor, within the decl's namespace. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` -```ucm:hide -project/main> branch alice +``` ucm :hide +scratch/main> branch alice ``` Alice's branch: -```unison:hide +``` unison :hide unique type Foo = Bar ``` -```ucm:hide -project/alice> add +``` ucm :hide +scratch/alice> add ``` -```ucm -project/alice> alias.term Foo.Bar Foo.some.other.Alias +``` ucm +scratch/alice> alias.term Foo.Bar Foo.some.other.Alias ``` Bob's branch: -```ucm:hide -project/main> branch bob +``` ucm :hide +scratch/main> branch bob ``` -```unison:hide +``` unison :hide bob : Nat bob = 100 ``` -```ucm:hide -project/bob> add +``` ucm :hide +scratch/bob> add ``` -```ucm:error -project/alice> merge /bob +``` ucm :error +scratch/alice> merge /bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ### Missing constructor name Each naming of a decl must have a name for each constructor, within the decl's namespace. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` Alice's branch: -```ucm:hide -project/main> branch alice +``` ucm :hide +scratch/main> branch alice ``` -```unison:hide +``` unison :hide unique type Foo = Bar ``` -```ucm:hide -project/alice> add +``` ucm :hide +scratch/alice> add ``` -```ucm -project/alice> delete.term Foo.Bar +``` ucm +scratch/alice> delete.term Foo.Bar ``` Bob's branch: -```ucm:hide -project/main> branch /bob +``` ucm :hide +scratch/main> branch /bob ``` -```unison:hide +``` unison :hide bob : Nat bob = 100 ``` -```ucm:hide -project/bob> add +``` ucm :hide +scratch/bob> add ``` -```ucm:error -project/alice> merge /bob +``` ucm :error +scratch/alice> merge /bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ### Nested decl alias A decl cannot be aliased within the namespace of another of its aliased. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` Alice's branch: -```ucm:hide -project/main> branch alice +``` ucm :hide +scratch/main> branch alice ``` -```unison:hide +``` unison :hide structural type A = B Nat | C Nat Nat structural type A.inner.X = Y Nat | Z Nat Nat ``` -```ucm:hide -project/alice> add +``` ucm :hide +scratch/alice> add ``` -```ucm -project/alice> names A +``` ucm +scratch/alice> names A ``` Bob's branch: -```ucm:hide -project/main> branch bob +``` ucm :hide +scratch/main> branch bob ``` -```unison:hide +``` unison :hide bob : Nat bob = 100 ``` -```ucm:hide -project/bob> add +``` ucm :hide +scratch/bob> add ``` -```ucm:error -project/alice> merge /bob +``` ucm :error +scratch/alice> merge /bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ### Stray constructor alias Constructors may only exist within the corresponding decl's namespace. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` Alice's branch: -```ucm:hide -project/main> branch alice +``` ucm :hide +scratch/main> branch alice ``` -```unison:hide:all +``` unison :hide:all unique type Foo = Bar ``` -```ucm -project/alice> add -project/alice> alias.term Foo.Bar AliasOutsideFooNamespace +``` ucm +scratch/alice> add +scratch/alice> alias.term Foo.Bar AliasOutsideFooNamespace ``` Bob's branch: -```ucm:hide -project/main> branch bob +``` ucm :hide +scratch/main> branch bob ``` -```unison:hide:all +``` unison :hide:all bob : Nat bob = 101 ``` -```ucm -project/bob> add +``` ucm +scratch/bob> add ``` -```ucm:error -project/alice> merge bob +``` ucm :error +scratch/alice> merge bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ### Term or type in `lib` By convention, `lib` can only namespaces; each of these represents a library dependencies. Individual terms and types are not allowed at the top level of `lib`. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` Alice's branch: -```ucm:hide -project/main> branch alice +``` ucm :hide +scratch/main> branch alice ``` -```unison:hide +``` unison :hide lib.foo : Nat lib.foo = 1 ``` -```ucm:hide -project/alice> add -project/main> branch bob +``` ucm :hide +scratch/alice> add +scratch/main> branch bob ``` Bob's branch: -```unison:hide +``` unison :hide bob : Nat bob = 100 ``` -```ucm:hide -project/bob> add +``` ucm :hide +scratch/bob> add ``` -```ucm:error -project/alice> merge /bob +``` ucm :error +scratch/alice> merge /bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## LCA precondition violations @@ -1383,63 +1380,63 @@ The LCA is not subject to most precondition violations, which is good, because t Here's an example. We'll delete a constructor name from the LCA and still be able to merge Alice and Bob's stuff together. -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` LCA: -```unison +``` unison structural type Foo = Bar Nat | Baz Nat Nat ``` -```ucm -project/main> add -project/main> delete.term Foo.Baz +``` ucm +scratch/main> add +scratch/main> delete.term Foo.Baz ``` Alice's branch: -```ucm -project/main> branch alice -project/alice> delete.type Foo -project/alice> delete.term Foo.Bar +``` ucm +scratch/main> branch alice +scratch/alice> delete.type Foo +scratch/alice> delete.term Foo.Bar ``` -```unison +``` unison alice : Nat alice = 100 ``` -```ucm -project/alice> add +``` ucm +scratch/alice> add ``` Bob's branch: -```ucm -project/main> branch bob -project/bob> delete.type Foo -project/bob> delete.term Foo.Bar +``` ucm +scratch/main> branch bob +scratch/bob> delete.type Foo +scratch/bob> delete.term Foo.Bar ``` -```unison +``` unison bob : Nat bob = 101 ``` -```ucm -project/bob> add +``` ucm +scratch/bob> add ``` Now we merge: -```ucm -project/alice> merge /bob +``` ucm +scratch/alice> merge /bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ## Regression tests @@ -1447,85 +1444,85 @@ scratch/main> project.delete project ### Delete one alias and update the other -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` -```unison +``` unison foo = 17 bar = 17 ``` -```ucm -project/main> add -project/main> branch alice -project/alice> delete.term bar +``` ucm +scratch/main> add +scratch/main> branch alice +scratch/alice> delete.term bar ``` -```unison +``` unison foo = 18 ``` -```ucm -project/alice> update -project/main> branch bob +``` ucm +scratch/alice> update +scratch/main> branch bob ``` -```unison +``` unison bob = 101 ``` -```ucm -project/bob> add +``` ucm +scratch/bob> add ``` -```ucm -project/alice> merge /bob +``` ucm +scratch/alice> merge /bob ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ### Delete a constructor -```ucm:hide -project/main> builtins.mergeio lib.builtins +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins ``` -```unison +``` unison type Foo = Bar | Baz ``` -```ucm -project/main> add -project/main> branch topic +``` ucm +scratch/main> add +scratch/main> branch topic ``` -```unison +``` unison boop = "boop" ``` -```ucm -project/topic> add +``` ucm +scratch/topic> add ``` -```unison +``` unison type Foo = Bar ``` -```ucm -project/main> update +``` ucm +scratch/main> update ``` -```ucm -project/main> merge topic -project/main> view Foo +``` ucm +scratch/main> merge topic +scratch/main> view Foo ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ### Dependent that doesn't need to be in the file @@ -1533,13 +1530,13 @@ scratch/main> project.delete project This test demonstrates a bug. -```ucm:hide -project/alice> builtins.mergeio lib.builtins +``` ucm :hide +scratch/alice> builtins.mergeio lib.builtins ``` In the LCA, we have `foo` with dependent `bar`, and `baz`. -```unison +``` unison foo : Nat foo = 17 @@ -1550,25 +1547,25 @@ baz : Text baz = "lca" ``` -```ucm -project/alice> add -project/alice> branch bob +``` ucm +scratch/alice> add +scratch/alice> branch bob ``` On Bob, we update `baz` to "bob". -```unison +``` unison baz : Text baz = "bob" ``` -```ucm -project/bob> update +``` ucm +scratch/bob> update ``` On Alice, we update `baz` to "alice" (conflict), but also update `foo` (unconflicted), which propagates to `bar`. -```unison +``` unison foo : Nat foo = 18 @@ -1576,21 +1573,21 @@ baz : Text baz = "alice" ``` -```ucm -project/alice> update +``` ucm +scratch/alice> update ``` When we try to merge Bob into Alice, we should see both versions of `baz`, with Alice's unconflicted `foo` and `bar` in the underlying namespace. -```ucm:error -project/alice> merge /bob +``` ucm :error +scratch/alice> merge /bob ``` But `bar` was put into the scratch file instead. -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ### Merge loop test @@ -1600,52 +1597,52 @@ history. Let's make three identical namespaces with different histories: -```unison +``` unison a = 1 ``` -```ucm -project/alice> add +``` ucm +scratch/alice> add ``` -```unison +``` unison b = 2 ``` -```ucm -project/alice> add +``` ucm +scratch/alice> add ``` -```unison +``` unison b = 2 ``` -```ucm -project/bob> add +``` ucm +scratch/bob> add ``` -```unison +``` unison a = 1 ``` -```ucm -project/bob> add +``` ucm +scratch/bob> add ``` -```unison +``` unison a = 1 b = 2 ``` -```ucm -project/carol> add -project/bob> merge /alice -project/carol> merge /bob -project/carol> history +``` ucm +scratch/carol> add +scratch/bob> merge /alice +scratch/carol> merge /bob +scratch/carol> history ``` -```ucm:hide -scratch/main> project.delete project +``` ucm :hide +scratch/main> project.delete scratch ``` ### Variables named `_` @@ -1653,11 +1650,11 @@ scratch/main> project.delete project This test demonstrates a change in syntactic hashing that fixed a bug due to auto-generated variable names for ignored results. -```ucm:hide +``` ucm :hide scratch/alice> builtins.mergeio lib.builtins ``` -```unison +``` unison ignore : a -> () ignore _ = () @@ -1670,34 +1667,131 @@ bar = foo + foo ``` -```ucm +``` ucm scratch/alice> add scratch/alice> branch bob ``` -```unison +``` unison bar : Nat bar = ignore "hi" foo + foo + foo ``` -```ucm +``` ucm scratch/bob> update ``` Previously, this update to `foo` would also cause a "real update" on `bar`, its dependent. Now it doesn't, so the merge will succeed. -```unison +``` unison foo : Nat foo = 19 ``` -```ucm +``` ucm scratch/alice> update ``` -```ucm +``` ucm +scratch/alice> merge /bob +``` + +``` ucm :hide +scratch/main> project.delete scratch +``` + +### Unique type GUID reuse + +Previously, a merge branch would not include any dependents in the namespace, but that resulted in dependent unique +types' GUIDs being regenerated. + +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + +``` unison +type Foo = Lca +type Bar = MkBar Foo +``` + +``` ucm +scratch/main> add +scratch/main> branch alice +scratch/alice> move.term Foo.Lca Foo.Alice +scratch/main> branch bob +scratch/bob> move.term Foo.Lca Foo.Bob +``` + +``` ucm :error scratch/alice> merge /bob ``` + +``` ucm +scratch/merge-bob-into-alice> +``` + +``` unison +type Foo = Merged +type Bar = MkBar Foo +``` + +``` ucm +scratch/merge-bob-into-alice> update +scratch/merge-bob-into-alice> names Bar +scratch/alice> names Bar +``` + +``` ucm :hide +scratch/main> project.delete scratch +``` + +### Using Alice's names for Bob's things + +Previously, we'd render Alice's stuff with her names and Bob's stuff with his. But because Alice is doing the merge, +we now use her names whenever possible. In this example, Alice calls something `foo` and Bob calls it `bar`. When +rendering conflicts, in Bob's term that references (what he calls) `bar`, we render `foo` instead. + +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + +``` unison +hello = 17 +``` + +``` ucm +scratch/main> add +scratch/main> branch alice +``` + +``` unison +hello = 18 + foo +foo = 100 +``` + +``` ucm +scratch/alice> update +scratch/main> branch bob +``` + +``` unison +hello = 19 + bar +bar = 100 +``` + +``` ucm +scratch/bob> update +``` + +Note Bob's `hello` references `foo` (Alice's name), not `bar` (Bob's name). + +``` ucm :error +scratch/alice> merge /bob +``` + +``` ucm :hide +scratch/main> project.delete scratch +``` diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 7675b0f748..288ec046e2 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -15,64 +15,110 @@ scratch/main> help merge.commit `merge.commit` merges a temporary branch created by the `merge` command back into its parent branch, and removes the temporary branch. - + For example, if you've done `merge topic` from main, then `merge.commit` is equivalent to doing - + * switch /main * merge /merge-topic-into-main * delete.branch /merge-topic-into-main - ``` + Let's see a simple unconflicted merge in action: Alice (us) and Bob (them) add different terms. The merged result contains both additions. ## Basic merge: two unconflicted adds +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + +``` ucm :hide +scratch/main> branch alice +``` + Alice's adds: -``` unison +``` unison :hide foo : Text foo = "alices foo" ``` +``` ucm :hide +scratch/alice> add + +scratch/main> branch bob +``` + Bob's adds: -``` unison +``` unison :hide bar : Text bar = "bobs bar" ``` +``` ucm :hide +scratch/bob> add +``` + Merge result: ``` ucm -project/alice> merge /bob +scratch/alice> merge /bob + + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... - I merged project/bob into project/alice. + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + + I merged scratch/bob into scratch/alice. -project/alice> view foo bar +scratch/alice> view foo bar bar : Text bar = "bobs bar" - + foo : Text foo = "alices foo" +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + ## Basic merge: two identical adds If Alice and Bob also happen to add the same definition, that's not a conflict. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins + +scratch/main> branch alice +``` + Alice's adds: -``` unison +``` unison :hide foo : Text foo = "alice and bobs foo" ``` +``` ucm :hide +scratch/alice> add + +scratch/main> branch bob +``` + Bob's adds: -``` unison +``` unison :hide foo : Text foo = "alice and bobs foo" @@ -80,84 +126,144 @@ bar : Text bar = "bobs bar" ``` +``` ucm :hide +scratch/bob> add +``` + Merge result: ``` ucm -project/alice> merge /bob +scratch/alice> merge /bob + + Loading branches... - I merged project/bob into project/alice. + Computing diff between branches... -project/alice> view foo bar + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + + I merged scratch/bob into scratch/alice. + +scratch/alice> view foo bar bar : Text bar = "bobs bar" - + foo : Text foo = "alice and bobs foo" +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + ## Simple update propagation Updates that occur in one branch are propagated to the other. In this example, Alice updates `foo`, while Bob adds a new dependent `bar` of the original `foo`. When Bob's branch is merged into Alice's, her update to `foo` is propagated to his `bar`. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + Original branch: -``` unison +``` unison :hide foo : Text foo = "old foo" ``` +``` ucm :hide +scratch/main> add + +scratch/main> branch alice +``` + Alice's updates: -``` unison +``` unison :hide foo : Text foo = "new foo" ``` +``` ucm :hide +scratch/alice> update + +scratch/main> branch bob +``` + Bob's adds: -``` unison +``` unison :hide bar : Text bar = foo ++ " - " ++ foo ``` ``` ucm -project/bob> display bar +scratch/bob> display bar "old foo - old foo" +``` +``` ucm :hide +scratch/bob> add ``` + Merge result: ``` ucm -project/alice> merge /bob +scratch/alice> merge /bob - I merged project/bob into project/alice. + Loading branches... -project/alice> view foo bar + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + + I merged scratch/bob into scratch/alice. + +scratch/alice> view foo bar bar : Text bar = use Text ++ foo ++ " - " ++ foo - + foo : Text foo = "new foo" -project/alice> display bar +scratch/alice> display bar "old foo - old foo" +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + ## Update propagation with common dependent We classify something as an update if its "syntactic hash"—not its normal Unison hash—differs from the original definition. This allows us to cleanly merge unconflicted updates that were individually propagated to a common dependent. Let's see an example. We have `foo`, which depends on `bar` and `baz`. Alice updates `bar` (propagating to `foo`), and Bob updates `baz` (propagating to `foo`). When we merge their updates, both updates will be reflected in the final `foo`. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + Original branch: -``` unison +``` unison :hide foo : Text foo = "foo" ++ " - " ++ bar ++ " - " ++ baz @@ -168,64 +274,102 @@ baz : Text baz = "old baz" ``` +``` ucm :hide +scratch/main> add + +scratch/main> branch alice +``` + Alice's updates: -``` unison +``` unison :hide bar : Text bar = "alices bar" ``` +``` ucm :hide +scratch/alice> update +``` + ``` ucm -project/alice> display foo +scratch/alice> display foo "foo - alices bar - old baz" +``` +``` ucm :hide +scratch/main> branch bob ``` + Bob's updates: -``` unison +``` unison :hide baz : Text baz = "bobs baz" ``` +``` ucm :hide +scratch/bob> update +``` + ``` ucm -project/bob> display foo +scratch/bob> display foo "foo - old bar - bobs baz" - ``` + Merge result: ``` ucm -project/alice> merge /bob +scratch/alice> merge /bob + + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... - I merged project/bob into project/alice. + Loading and merging library dependencies... -project/alice> view foo bar baz + Rendering Unison file... + + Typechecking Unison file... + + I merged scratch/bob into scratch/alice. + +scratch/alice> view foo bar baz bar : Text bar = "alices bar" - + baz : Text baz = "bobs baz" - + foo : Text foo = use Text ++ "foo" ++ " - " ++ bar ++ " - " ++ baz -project/alice> display foo +scratch/alice> display foo "foo - alices bar - bobs baz" +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + ## Propagating an update to an update Of course, it's also possible for Alice's update to propagate to one of Bob's updates. In this example, `foo` depends on `bar` which depends on `baz`. Alice updates `baz`, propagating to `bar` and `foo`, while Bob updates `bar` (to something that still depends on `foo`), propagating to `baz`. The merged result will have Alice's update to `foo` incorporated into Bob's updated `bar`, and both updates will propagate to `baz`. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + Original branch: -``` unison +``` unison :hide foo : Text foo = "old foo" ++ " - " ++ bar @@ -236,113 +380,189 @@ baz : Text baz = "old baz" ``` +``` ucm :hide +scratch/main> add +``` + ``` ucm -project/main> display foo +scratch/main> display foo "old foo - old bar - old baz" +``` +``` ucm :hide +scratch/main> branch alice ``` + Alice's updates: -``` unison +``` unison :hide baz : Text baz = "alices baz" ``` +``` ucm :hide +scratch/alice> update +``` + ``` ucm -project/alice> display foo +scratch/alice> display foo "old foo - old bar - alices baz" +``` +``` ucm :hide +scratch/main> branch bob ``` + Bob's updates: -``` unison +``` unison :hide bar : Text bar = "bobs bar" ++ " - " ++ baz ``` +``` ucm :hide +scratch/bob> update +``` + ``` ucm -project/bob> display foo +scratch/bob> display foo "old foo - bobs bar - old baz" - ``` + Merge result: ``` ucm -project/alice> merge /bob +scratch/alice> merge /bob + + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... - I merged project/bob into project/alice. + Rendering Unison file... -project/alice> view foo bar baz + Typechecking Unison file... + + I merged scratch/bob into scratch/alice. + +scratch/alice> view foo bar baz bar : Text bar = use Text ++ "bobs bar" ++ " - " ++ baz - + baz : Text baz = "alices baz" - + foo : Text foo = use Text ++ "old foo" ++ " - " ++ bar -project/alice> display foo +scratch/alice> display foo "old foo - bobs bar - alices baz" +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + ## Update + delete isn't (currently) a conflict We don't currently consider "update + delete" a conflict like Git does. In this situation, the delete is just ignored, allowing the update to proceed. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + Original branch: -``` unison +``` unison :hide foo : Text foo = "old foo" ``` +``` ucm :hide +scratch/main> add + +scratch/main> branch alice +``` + Alice's updates: -``` unison +``` unison :hide foo : Text foo = "alices foo" ``` +``` ucm :hide +scratch/alice> update + +scratch/main> branch bob +``` + Bob's changes: ``` ucm -project/bob> delete.term foo +scratch/bob> delete.term foo Done. - ``` + Merge result: ``` ucm -project/alice> merge /bob +scratch/alice> merge /bob + + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... - I merged project/bob into project/alice. + Loading and merging library dependencies... -project/alice> view foo + Rendering Unison file... + + Typechecking Unison file... + + I merged scratch/bob into scratch/alice. + +scratch/alice> view foo foo : Text foo = "alices foo" +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + In a future version, we'd like to give the user a warning at least. ## Library dependencies don't create merge conflicts Library dependencies don't cause merge conflicts, the library dependencies are just unioned together. If two library dependencies have the same name but different namespace hashes, then the merge algorithm makes up two fresh names. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + Alice's adds: -``` unison +``` ucm :hide +scratch/main> branch alice +``` + +``` unison :hide lib.alice.foo : Nat lib.alice.foo = 17 @@ -353,9 +573,15 @@ lib.bothDifferent.baz : Nat lib.bothDifferent.baz = 19 ``` +``` ucm :hide +scratch/alice> add + +scratch/main> branch bob +``` + Bob's adds: -``` unison +``` unison :hide lib.bob.foo : Nat lib.bob.foo = 20 @@ -366,154 +592,202 @@ lib.bothDifferent.baz : Nat lib.bothDifferent.baz = 21 ``` +``` ucm :hide +scratch/bob> add +``` + Merge result: ``` ucm -project/alice> merge bob +scratch/alice> merge bob + + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... - I merged project/bob into project/alice. + I merged scratch/bob into scratch/alice. -project/alice> view foo bar baz +scratch/alice> view foo bar baz lib.alice.foo : Nat lib.alice.foo = 17 - + lib.bob.foo : Nat lib.bob.foo = 20 - + lib.bothDifferent__0.baz : Nat lib.bothDifferent__0.baz = 19 - + lib.bothDifferent__1.baz : Nat lib.bothDifferent__1.baz = 21 - + lib.bothSame.bar : Nat lib.bothSame.bar = 18 +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + ## No-op merge (Bob = Alice) If Bob is equals Alice, then merging Bob into Alice looks like this. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + ``` ucm -project/main> branch alice +scratch/main> branch alice Done. I've created the alice branch based off of main. - + Tip: To merge your work back into the main branch, first `switch /main` then `merge /alice`. -project/main> branch bob +scratch/main> branch bob Done. I've created the bob branch based off of main. - + Tip: To merge your work back into the main branch, first `switch /main` then `merge /bob`. -project/alice> merge /bob +scratch/alice> merge /bob 😶 - - project/alice was already up-to-date with project/bob. + scratch/alice was already up-to-date with scratch/bob. ``` + +``` ucm :hide +scratch/main> project.delete scratch +``` + ## No-op merge (Bob \< Alice) If Bob is behind Alice, then merging Bob into Alice looks like this. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + ``` ucm -project/main> branch alice +scratch/main> branch alice Done. I've created the alice branch based off of main. - + Tip: To merge your work back into the main branch, first `switch /main` then `merge /alice`. -project/main> branch bob +scratch/main> branch bob Done. I've created the bob branch based off of main. - + Tip: To merge your work back into the main branch, first `switch /main` then `merge /bob`. - ``` + Alice's addition: -``` unison +``` unison :hide foo : Text foo = "foo" ``` ``` ucm -project/alice> add +scratch/alice> add ⍟ I've added these definitions: - + foo : Text -project/alice> merge /bob +scratch/alice> merge /bob 😶 - - project/alice was already up-to-date with project/bob. + scratch/alice was already up-to-date with scratch/bob. +``` + +``` ucm :hide +scratch/main> project.delete scratch ``` + ## Fast-forward merge (Bob \> Alice) If Bob is ahead of Alice, then merging Bob into Alice looks like this. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + ``` ucm -project/main> branch alice +scratch/main> branch alice Done. I've created the alice branch based off of main. - + Tip: To merge your work back into the main branch, first `switch /main` then `merge /alice`. -project/main> branch bob +scratch/main> branch bob Done. I've created the bob branch based off of main. - + Tip: To merge your work back into the main branch, first `switch /main` then `merge /bob`. - ``` + Bob's addition: -``` unison +``` unison :hide foo : Text foo = "foo" ``` ``` ucm -project/bob> add +scratch/bob> add ⍟ I've added these definitions: - + foo : Text -project/alice> merge /bob +scratch/alice> merge /bob - I fast-forward merged project/bob into project/alice. + I fast-forward merged scratch/bob into scratch/alice. +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + ## No-op merge: merge empty namespace into empty namespace ``` ucm -project/main> branch topic +scratch/main> branch topic Done. I've created the topic branch based off of main. - + Tip: To merge your work back into the main branch, first `switch /main` then `merge /topic`. -project/main> merge /topic +scratch/main> merge /topic 😶 - - project/main was already up-to-date with project/topic. + scratch/main was already up-to-date with scratch/topic. ``` + +``` ucm :hide +scratch/main> project.delete scratch +``` + ## Merge failure: someone deleted something If either Alice or Bob delete something, so long as the other person didn't update it (in which case we ignore the delete, as explained above), then the delete goes through. @@ -522,55 +796,81 @@ This can cause merge failures due to out-of-scope identifiers, and the user may In this example, Alice deletes `foo`, while Bob adds a new dependent of `foo`. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + Original branch: -``` unison +``` unison :hide foo : Text foo = "foo" ``` +``` ucm :hide +scratch/main> add + +scratch/main> branch alice +``` + Alice's delete: ``` ucm -project/alice> delete.term foo +scratch/alice> delete.term foo Done. +``` +``` ucm :hide +scratch/main> branch bob ``` + Bob's new code that depends on `foo`: -``` unison +``` unison :hide bar : Text bar = foo ++ " - " ++ foo ``` -``` ucm -project/bob> add +``` ucm :error +scratch/bob> add ⍟ I've added these definitions: - + bar : Text -project/alice> merge /bob +scratch/alice> merge /bob + + Loading branches... - I couldn't automatically merge project/bob into project/alice. + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. - + When you're done, you can run - + merge.commit - + to merge your changes back into alice and delete the temporary branch. Or, if you decide to cancel the merge instead, you can run - + delete.branch /merge-bob-into-alice - - to delete the temporary branch and switch back to alice. + to delete the temporary branch and switch back to alice. ``` -``` unison:added-by-ucm scratch.u + +``` unison :added-by-ucm scratch.u bar : Text bar = use Text ++ @@ -578,54 +878,90 @@ bar = ``` +``` ucm :hide +scratch/main> project.delete scratch +``` + ## Merge failure: type error It may be Alice's and Bob's changes merge together cleanly in the sense that there's no textual conflicts, yet the resulting namespace doesn't typecheck. In this example, Alice updates a `Text` to a `Nat`, while Bob adds a new dependent of the `Text`. Upon merging, propagating Alice's update to Bob's dependent causes a typechecking failure. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + Original branch: -``` unison +``` unison :hide foo : Text foo = "foo" ``` +``` ucm :hide +scratch/main> add + +scratch/main> branch alice +``` + Alice's update: -``` unison +``` unison :hide foo : Nat foo = 100 ``` -Bob's new definition: +``` ucm :hide +scratch/alice> update -``` unison +scratch/main> branch bob +``` + +Bob's new definition: + +``` unison :hide bar : Text bar = foo ++ " - " ++ foo ``` -``` ucm -project/alice> merge /bob +``` ucm :hide +scratch/bob> update +``` + +``` ucm :error +scratch/alice> merge /bob + + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... - I couldn't automatically merge project/bob into project/alice. + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. - + When you're done, you can run - + merge.commit - + to merge your changes back into alice and delete the temporary branch. Or, if you decide to cancel the merge instead, you can run - + delete.branch /merge-bob-into-alice - - to delete the temporary branch and switch back to alice. + to delete the temporary branch and switch back to alice. ``` -``` unison:added-by-ucm scratch.u + +``` unison :added-by-ucm scratch.u bar : Text bar = use Text ++ @@ -633,14 +969,22 @@ bar = ``` +``` ucm :hide +scratch/main> project.delete scratch +``` + ## Merge failure: simple term conflict Alice and Bob may disagree about the definition of a term. In this case, the conflicted term and all of its dependents are presented to the user to resolve. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + Original branch: -``` unison +``` unison :hide foo : Text foo = "old foo" @@ -648,9 +992,15 @@ bar : Text bar = "old bar" ``` +``` ucm :hide +scratch/main> add + +scratch/main> branch alice +``` + Alice's changes: -``` unison +``` unison :hide foo : Text foo = "alices foo" @@ -661,9 +1011,15 @@ qux : Text qux = "alices qux depends on alices foo" ++ foo ``` +``` ucm :hide +scratch/alice> update + +scratch/main> branch bob +``` + Bob's changes: -``` unison +``` unison :hide foo : Text foo = "bobs foo" @@ -671,32 +1027,46 @@ baz : Text baz = "bobs baz" ``` -``` ucm -project/alice> merge /bob +``` ucm :hide +scratch/bob> update +``` + +``` ucm :error +scratch/alice> merge /bob + + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... - I couldn't automatically merge project/bob into project/alice. + Loading and merging library dependencies... + + Rendering Unison file... + + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. - + When you're done, you can run - + merge.commit - + to merge your changes back into alice and delete the temporary branch. Or, if you decide to cancel the merge instead, you can run - + delete.branch /merge-bob-into-alice - - to delete the temporary branch and switch back to alice. + to delete the temporary branch and switch back to alice. ``` -``` unison:added-by-ucm scratch.u --- project/alice + +``` unison :added-by-ucm scratch.u +-- scratch/alice foo : Text foo = "alices foo" --- project/bob +-- scratch/bob foo : Text foo = "bobs foo" @@ -711,289 +1081,457 @@ qux = ``` ``` ucm -project/merge-bob-into-alice> view bar baz +scratch/merge-bob-into-alice> view bar baz bar : Text bar = "alices bar" - + baz : Text baz = "bobs baz" +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + ## Merge failure: simple type conflict Ditto for types; if the hashes don't match, it's a conflict. In this example, Alice and Bob do different things to the same constructor. However, any explicit changes to the same type will result in a conflict, including changes that could concievably be merged (e.g. Alice and Bob both add a new constructor, or edit different constructors). +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + Original branch: -``` unison +``` unison :hide unique type Foo = MkFoo Nat ``` +``` ucm :hide +scratch/main> add + +scratch/main> branch alice +``` + Alice's changes: -``` unison +``` unison :hide unique type Foo = MkFoo Nat Nat ``` +``` ucm :hide +scratch/alice> update + +scratch/main> branch bob +``` + Bob's changes: -``` unison +``` unison :hide unique type Foo = MkFoo Nat Text ``` -``` ucm -project/alice> merge /bob +``` ucm :hide +scratch/bob> update +``` + +``` ucm :error +scratch/alice> merge /bob + + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... - I couldn't automatically merge project/bob into project/alice. + Loading and merging library dependencies... + + Rendering Unison file... + + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. - + When you're done, you can run - + merge.commit - + to merge your changes back into alice and delete the temporary branch. Or, if you decide to cancel the merge instead, you can run - + delete.branch /merge-bob-into-alice - - to delete the temporary branch and switch back to alice. + to delete the temporary branch and switch back to alice. ``` -``` unison:added-by-ucm scratch.u --- project/alice + +``` unison :added-by-ucm scratch.u +-- scratch/alice type Foo = MkFoo Nat Nat --- project/bob +-- scratch/bob type Foo = MkFoo Nat Text ``` +``` ucm :hide +scratch/main> project.delete scratch +``` + ## Merge failure: type-update + constructor-rename conflict We model the renaming of a type's constructor as an update, so if Alice updates a type and Bob renames one of its constructors (even without changing its structure), we consider it a conflict. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + Original branch: -``` unison +``` unison :hide unique type Foo = Baz Nat | Qux Text ``` +``` ucm :hide +scratch/main> add + +scratch/main> branch alice +``` + Alice's changes `Baz Nat` to `Baz Nat Nat` -``` unison +``` unison :hide unique type Foo = Baz Nat Nat | Qux Text ``` -Bob's renames `Qux` to `BobQux`: +``` ucm :hide +scratch/alice> update -``` unison -unique type Foo = Baz Nat | BobQux Text +scratch/main> branch bob ``` +Bob's renames `Qux` to `BobQux`: + ``` ucm -project/alice> merge /bob +scratch/bob> move.term Foo.Qux Foo.BobQux + + Done. +``` + +``` ucm :error +scratch/alice> merge /bob - I couldn't automatically merge project/bob into project/alice. + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. - + When you're done, you can run - + merge.commit - + to merge your changes back into alice and delete the temporary branch. Or, if you decide to cancel the merge instead, you can run - + delete.branch /merge-bob-into-alice - - to delete the temporary branch and switch back to alice. + to delete the temporary branch and switch back to alice. ``` -``` unison:added-by-ucm scratch.u --- project/alice + +``` unison :added-by-ucm scratch.u +-- scratch/alice type Foo = Baz Nat Nat | Qux Text --- project/bob -type Foo = Baz Nat | BobQux Text +-- scratch/bob +type Foo = BobQux Text | Baz Nat ``` +``` ucm :hide +scratch/main> project.delete scratch +``` + ## Merge failure: constructor-rename conflict Here is another example demonstrating that constructor renames are modeled as updates. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + Original branch: -``` unison +``` unison :hide unique type Foo = Baz Nat | Qux Text ``` +``` ucm :hide +scratch/main> add + +scratch/main> branch alice +``` + Alice's rename: ``` ucm -project/alice> move.term Foo.Baz Foo.Alice +scratch/alice> move.term Foo.Baz Foo.Alice Done. +``` +``` ucm :hide +scratch/main> branch bob ``` + Bob's rename: ``` ucm -project/bob> move.term Foo.Qux Foo.Bob +scratch/bob> move.term Foo.Qux Foo.Bob Done. - ``` -``` ucm -project/alice> merge bob - I couldn't automatically merge project/bob into project/alice. +``` ucm :error +scratch/alice> merge bob + + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. - + When you're done, you can run - + merge.commit - + to merge your changes back into alice and delete the temporary branch. Or, if you decide to cancel the merge instead, you can run - + delete.branch /merge-bob-into-alice - - to delete the temporary branch and switch back to alice. + to delete the temporary branch and switch back to alice. ``` -``` unison:added-by-ucm scratch.u --- project/alice + +``` unison :added-by-ucm scratch.u +-- scratch/alice type Foo = Qux Text | Alice Nat --- project/bob +-- scratch/bob type Foo = Bob Text | Baz Nat ``` +``` ucm :hide +scratch/main> project.delete scratch +``` + ## Merge failure: non-constructor/constructor conflict A constructor on one side can conflict with a regular term definition on the other. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + +``` ucm :hide +scratch/main> branch alice +``` + Alice's additions: -``` unison +``` unison :hide my.cool.thing : Nat my.cool.thing = 17 ``` +``` ucm :hide +scratch/alice> add + +scratch/main> branch bob +``` + Bob's additions: -``` unison +``` unison :hide unique ability my.cool where thing : Nat -> Nat ``` -``` ucm -project/alice> merge bob +``` ucm :hide +scratch/bob> add +``` + +``` ucm :error +scratch/alice> merge bob + + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... - I couldn't automatically merge project/bob into project/alice. + Rendering Unison file... + + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. - + When you're done, you can run - + merge.commit - + to merge your changes back into alice and delete the temporary branch. Or, if you decide to cancel the merge instead, you can run - + delete.branch /merge-bob-into-alice - - to delete the temporary branch and switch back to alice. + to delete the temporary branch and switch back to alice. ``` -``` unison:added-by-ucm scratch.u --- project/alice + +``` unison :added-by-ucm scratch.u +-- scratch/alice my.cool.thing : Nat my.cool.thing = 17 --- project/bob +-- scratch/bob ability my.cool where thing : Nat ->{cool} Nat ``` +``` ucm :hide +scratch/main> project.delete scratch +``` + ## Merge failure: type/type conflict with term/constructor conflict Here's a subtle situation where a new type is added on each side of the merge, and an existing term is replaced with a constructor of one of the types. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + Original branch: -``` unison +``` unison :hide Foo.Bar : Nat Foo.Bar = 17 ``` +``` ucm :hide +scratch/main> add + +scratch/main> branch alice +``` + Alice adds this type `Foo` with constructor `Foo.Alice`: -``` unison +``` unison :hide unique type Foo = Alice Nat ``` +``` ucm :hide +scratch/alice> add + +scratch/main> branch bob +``` + Bob adds the type `Foo` with constructor `Foo.Bar`, replacing the original `Foo.Bar` term: ``` ucm -project/bob> delete.term Foo.Bar +scratch/bob> delete.term Foo.Bar Done. - ``` -``` unison + +``` unison :hide unique type Foo = Bar Nat Nat ``` +``` ucm :hide +scratch/bob> add +``` + These won't cleanly merge. -``` ucm -project/alice> merge bob +``` ucm :error +scratch/alice> merge bob + + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... - I couldn't automatically merge project/bob into project/alice. + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. - + When you're done, you can run - + merge.commit - + to merge your changes back into alice and delete the temporary branch. Or, if you decide to cancel the merge instead, you can run - + delete.branch /merge-bob-into-alice - - to delete the temporary branch and switch back to alice. + to delete the temporary branch and switch back to alice. ``` -``` unison:added-by-ucm scratch.u --- project/alice + +``` unison :added-by-ucm scratch.u +-- scratch/alice Foo.Bar : Nat Foo.Bar = 17 --- project/alice +-- scratch/alice type Foo = Alice Nat --- project/bob +-- scratch/bob type Foo = Bar Nat Nat ``` +``` ucm :hide +scratch/main> project.delete scratch +``` + Here's a more involved example that demonstrates the same idea. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + In the LCA, we have a type with two constructors, and some term. -``` unison +``` unison :hide unique type Foo = Bar.Baz Nat | Bar.Qux Nat Nat @@ -1002,67 +1540,109 @@ Foo.Bar.Hello : Nat Foo.Bar.Hello = 17 ``` +``` ucm :hide +scratch/main> add + +scratch/main> branch alice +``` + Alice deletes this type entirely, and repurposes its constructor names for other terms. She also updates the term. +``` ucm :hide +scratch/alice> delete.type Foo + +scratch/alice> delete.term Foo.Bar.Baz + +scratch/alice> delete.term Foo.Bar.Qux +``` + +``` ucm :hide +scratch/alice> update +``` + ``` ucm -project/alice> view Foo.Bar.Baz Foo.Bar.Qux Foo.Bar.Hello +scratch/alice> view Foo.Bar.Baz Foo.Bar.Qux Foo.Bar.Hello Foo.Bar.Baz : Nat Foo.Bar.Baz = 100 - + Foo.Bar.Hello : Nat Foo.Bar.Hello = 18 - + Foo.Bar.Qux : Nat Foo.Bar.Qux = 200 - ``` + Bob, meanwhile, first deletes the term, then sort of deletes the type and re-adds it under another name, but one constructor's fully qualified names doesn't actually change. The other constructor reuses the name of the deleted term. +``` ucm :hide +scratch/main> branch bob + +scratch/bob> delete.term Foo.Bar.Hello + +scratch/bob> move.type Foo Foo.Bar + +scratch/bob> move.term Foo.Bar.Qux Foo.Bar.Hello +``` + ``` ucm -project/bob> view Foo.Bar +scratch/bob> view Foo.Bar type Foo.Bar = Baz Nat | Hello Nat Nat - ``` + At this point, Bob and alice have both updated the name `Foo.Bar.Hello` in different ways, so that's a conflict. Therefore, Bob's entire type (`Foo.Bar` with constructors `Foo.Bar.Baz` and `Foo.Bar.Hello`) gets rendered into the scratch file. Notably, Alice's "unconflicted" update on the name "Foo.Bar.Baz" (because she changed its hash and Bob didn't touch it) is nonetheless considered conflicted with Bob's "Foo.Bar.Baz". -``` ucm -project/alice> merge bob +``` ucm :error +scratch/alice> merge bob + + Loading branches... + + Computing diff between branches... - I couldn't automatically merge project/bob into project/alice. + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. - + When you're done, you can run - + merge.commit - + to merge your changes back into alice and delete the temporary branch. Or, if you decide to cancel the merge instead, you can run - + delete.branch /merge-bob-into-alice - - to delete the temporary branch and switch back to alice. + to delete the temporary branch and switch back to alice. ``` -``` unison:added-by-ucm scratch.u --- project/alice + +``` unison :added-by-ucm scratch.u +-- scratch/alice Foo.Bar.Baz : Nat Foo.Bar.Baz = 100 --- project/alice +-- scratch/alice Foo.Bar.Hello : Nat Foo.Bar.Hello = 18 --- project/bob +-- scratch/bob type Foo.Bar = Baz Nat | Hello Nat Nat ``` +``` ucm :hide +scratch/main> project.delete scratch +``` + ## Merge algorithm quirk: add/add unique types Currently, two unique types created by Alice and Bob will be considered in conflict, even if they "look the same". @@ -1071,50 +1651,78 @@ which is a parse error. We will resolve this situation automatically in a future version. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + +``` ucm :hide +scratch/main> branch alice +``` + Alice's additions: -``` unison +``` unison :hide unique type Foo = Bar alice : Foo -> Nat alice _ = 18 ``` +``` ucm :hide +scratch/alice> add + +scratch/main> branch bob +``` + Bob's additions: -``` unison +``` unison :hide unique type Foo = Bar bob : Foo -> Nat bob _ = 19 ``` -``` ucm -project/alice> merge bob +``` ucm :hide +scratch/bob> add +``` + +``` ucm :error +scratch/alice> merge bob + + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + I couldn't automatically merge scratch/bob into scratch/alice. + However, I've added the definitions that need attention to the + top of scratch.u. + + When you're done, you can run + + merge.commit - I couldn't automatically merge project/bob into project/alice. - However, I've added the definitions that need attention to the - top of scratch.u. - - When you're done, you can run - - merge.commit - to merge your changes back into alice and delete the temporary branch. Or, if you decide to cancel the merge instead, you can run - + delete.branch /merge-bob-into-alice - - to delete the temporary branch and switch back to alice. + to delete the temporary branch and switch back to alice. ``` -``` unison:added-by-ucm scratch.u --- project/alice + +``` unison :added-by-ucm scratch.u +-- scratch/alice type Foo = Bar --- project/bob +-- scratch/bob type Foo = Bar @@ -1129,60 +1737,94 @@ bob _ = 19 ``` +``` ucm :hide +scratch/main> project.delete scratch +``` + ## `merge.commit` example (success) After merge conflicts are resolved, you can use `merge.commit` rather than `switch` + `merge` + `branch.delete` to "commit" your changes. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + Original branch: -``` unison +``` unison :hide foo : Text foo = "old foo" ``` +``` ucm :hide +scratch/main> add + +scratch/main> branch alice +``` + Alice's changes: -``` unison +``` unison :hide foo : Text foo = "alices foo" ``` +``` ucm :hide +scratch/alice> update + +scratch/main> branch bob +``` + Bob's changes: -``` unison +``` unison :hide foo : Text foo = "bobs foo" ``` Attempt to merge: -``` ucm -project/alice> merge /bob +``` ucm :hide +scratch/bob> update +``` + +``` ucm :error +scratch/alice> merge /bob + + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... - I couldn't automatically merge project/bob into project/alice. + Rendering Unison file... + + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. - + When you're done, you can run - + merge.commit - + to merge your changes back into alice and delete the temporary branch. Or, if you decide to cancel the merge instead, you can run - + delete.branch /merge-bob-into-alice - - to delete the temporary branch and switch back to alice. + to delete the temporary branch and switch back to alice. ``` -``` unison:added-by-ucm scratch.u --- project/alice + +``` unison :added-by-ucm scratch.u +-- scratch/alice foo : Text foo = "alices foo" --- project/bob +-- scratch/bob foo : Text foo = "bobs foo" @@ -1195,64 +1837,76 @@ foo : Text foo = "alice and bobs foo" ``` -``` ucm - +``` ucm :added-by-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`: + + ⍟ These names already exist. You can `update` them to your + new definition: foo : Text - ``` + ``` ucm -project/merge-bob-into-alice> update +scratch/merge-bob-into-alice> update Okay, I'm searching the branch for code that needs to be updated... Done. -project/merge-bob-into-alice> merge.commit +scratch/merge-bob-into-alice> merge.commit - I fast-forward merged project/merge-bob-into-alice into - project/alice. + I fast-forward merged scratch/merge-bob-into-alice into + scratch/alice. -project/alice> view foo +scratch/alice> view foo foo : Text foo = "alice and bobs foo" -project/alice> branches +scratch/alice> branches Branch Remote branch 1. alice 2. bob 3. main +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + ## `merge.commit` example (failure) `merge.commit` can only be run on a "merge branch". +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + ``` ucm -project/main> branch topic +scratch/main> branch topic Done. I've created the topic branch based off of main. - + Tip: To merge your work back into the main branch, first `switch /main` then `merge /topic`. - ``` -``` ucm -project/topic> merge.commit + +``` ucm :error +scratch/topic> merge.commit It doesn't look like there's a merge in progress. +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + ## Precondition violations There are a number of conditions under which we can't perform a merge, and the user will have to fix up the namespace(s) manually before attempting to merge again. @@ -1261,9 +1915,13 @@ There are a number of conditions under which we can't perform a merge, and the u If `foo` and `bar` are aliases in the nearest common ancestor, but not in Alice's branch, then we don't know whether to update Bob's dependents to Alice's `foo` or Alice's `bar` (and vice-versa). +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + Original branch: -``` unison +``` unison :hide foo : Nat foo = 100 @@ -1271,9 +1929,15 @@ bar : Nat bar = 100 ``` +``` ucm :hide +scratch/main> add + +scratch/main> branch alice +``` + Alice's updates: -``` unison +``` unison :hide foo : Nat foo = 200 @@ -1281,34 +1945,52 @@ bar : Nat bar = 300 ``` +``` ucm :hide +scratch/alice> update + +scratch/main> branch bob +``` + Bob's addition: -``` unison +``` unison :hide baz : Text baz = "baz" ``` -``` ucm -project/alice> merge /bob +``` ucm :hide +scratch/bob> add +``` + +``` ucm :error +scratch/alice> merge /bob + + Loading branches... + + Computing diff between branches... Sorry, I wasn't able to perform the merge: - + On the merge ancestor, bar and foo were aliases for the same - definition, but on project/alice the names have different + term, but on scratch/alice the names have different definitions currently. I'd need just a single new definition to use in their dependents when I merge. - - Please fix up project/alice to resolve this. For example, - + + Please fix up scratch/alice to resolve this. For example, + * `update` the definitions to be the same again, so that there's nothing for me to decide. * `move` or `delete` all but one of the definitions; I'll use the remaining name when propagating updates. (You can `move` it back after the merge.) - + and then try merging again. +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + ### Conflict involving builtin We don't have a way of rendering a builtin in a scratch file, where users resolve merge conflicts. Thus, if there is a @@ -1316,214 +1998,366 @@ conflict involving a builtin, we can't perform a merge. One way to fix this in the future would be to introduce a syntax for defining aliases in the scratch file. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + +``` ucm :hide +scratch/main> branch alice +``` + Alice's branch: ``` ucm -project/alice> alias.type lib.builtins.Nat MyNat +scratch/alice> alias.type lib.builtins.Nat MyNat Done. - ``` + Bob's branch: -``` unison +``` ucm :hide +scratch/main> branch bob +``` + +``` unison :hide unique type MyNat = MyNat Nat ``` -``` ucm -project/alice> merge /bob +``` ucm :hide +scratch/bob> add +``` + +``` ucm :error +scratch/alice> merge /bob + + Loading branches... + + Computing diff between branches... Sorry, I wasn't able to perform the merge: - - There's a merge conflict on MyNat, but it's a builtin on one - or both branches. I can't yet handle merge conflicts involving - builtins. - + + There's a merge conflict on type MyNat, but it's a builtin on + one or both branches. I can't yet handle merge conflicts + involving builtins. + Please eliminate this conflict by updating one branch or the other, making MyNat the same on both branches, or making neither of them a builtin, and then try the merge again. +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + ### Constructor alias Each naming of a decl may not have more than one name for each constructor, within the decl's namespace. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + +``` ucm :hide +scratch/main> branch alice +``` + Alice's branch: -``` unison +``` unison :hide unique type Foo = Bar ``` +``` ucm :hide +scratch/alice> add +``` + ``` ucm -project/alice> alias.term Foo.Bar Foo.some.other.Alias +scratch/alice> alias.term Foo.Bar Foo.some.other.Alias Done. - ``` + Bob's branch: -``` unison +``` ucm :hide +scratch/main> branch bob +``` + +``` unison :hide bob : Nat bob = 100 ``` -``` ucm -project/alice> merge /bob +``` ucm :hide +scratch/bob> add +``` + +``` ucm :error +scratch/alice> merge /bob + + Loading branches... + + Computing diff between branches... Sorry, I wasn't able to perform the merge: - - On project/alice, the type Foo has a constructor with multiple + + On scratch/alice, the type Foo has a constructor with multiple names, and I can't perform a merge in this situation: - + * Foo.Bar * Foo.some.other.Alias - + Please delete all but one name for each constructor, and then try merging again. +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + ### Missing constructor name Each naming of a decl must have a name for each constructor, within the decl's namespace. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + Alice's branch: -``` unison +``` ucm :hide +scratch/main> branch alice +``` + +``` unison :hide unique type Foo = Bar ``` +``` ucm :hide +scratch/alice> add +``` + ``` ucm -project/alice> delete.term Foo.Bar +scratch/alice> delete.term Foo.Bar Done. - ``` + Bob's branch: -``` unison +``` ucm :hide +scratch/main> branch /bob +``` + +``` unison :hide bob : Nat bob = 100 ``` -``` ucm -project/alice> merge /bob +``` ucm :hide +scratch/bob> add +``` + +``` ucm :error +scratch/alice> merge /bob + + Loading branches... + + Computing diff between branches... Sorry, I wasn't able to perform the merge: - - On project/alice, the type Foo has some constructors with + + On scratch/alice, the type Foo has some constructors with missing names, and I can't perform a merge in this situation. - + You can use `view Foo` and `alias.term Foo.` to give names to each unnamed constructor, and then try the merge again. +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + ### Nested decl alias A decl cannot be aliased within the namespace of another of its aliased. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + Alice's branch: -``` unison +``` ucm :hide +scratch/main> branch alice +``` + +``` unison :hide structural type A = B Nat | C Nat Nat structural type A.inner.X = Y Nat | Z Nat Nat ``` +``` ucm :hide +scratch/alice> add +``` + ``` ucm -project/alice> names A +scratch/alice> names A Type Hash: #65mdg7015r Names: A A.inner.X - ``` + Bob's branch: -``` unison +``` ucm :hide +scratch/main> branch bob +``` + +``` unison :hide bob : Nat bob = 100 ``` -``` ucm -project/alice> merge /bob +``` ucm :hide +scratch/bob> add +``` + +``` ucm :error +scratch/alice> merge /bob + + Loading branches... - On project/alice, the type A.inner.X is an alias of A. I'm not + Computing diff between branches... + + On scratch/alice, the type A.inner.X is an alias of A. I'm not able to perform a merge when a type exists nested under an alias of itself. Please separate them or delete one copy, and then try merging again. +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + ### Stray constructor alias Constructors may only exist within the corresponding decl's namespace. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + Alice's branch: +``` ucm :hide +scratch/main> branch alice +``` + ``` ucm -project/alice> add +scratch/alice> add ⍟ I've added these definitions: - + type Foo -project/alice> alias.term Foo.Bar AliasOutsideFooNamespace +scratch/alice> alias.term Foo.Bar AliasOutsideFooNamespace Done. - ``` + Bob's branch: +``` ucm :hide +scratch/main> branch bob +``` + ``` ucm -project/bob> add +scratch/bob> add ⍟ I've added these definitions: - - bob : Nat + bob : Nat ``` -``` ucm -project/alice> merge bob + +``` ucm :error +scratch/alice> merge bob + + Loading branches... + + Computing diff between branches... Sorry, I wasn't able to perform the merge, because I need all constructor names to be nested somewhere beneath the corresponding type name. - - On project/alice, the constructor AliasOutsideFooNamespace is + + On scratch/alice, the constructor AliasOutsideFooNamespace is not nested beneath the corresponding type name. Please either use `move` to move it, or if it's an extra copy, you can simply `delete` it. Then try the merge again. +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + ### Term or type in `lib` By convention, `lib` can only namespaces; each of these represents a library dependencies. Individual terms and types are not allowed at the top level of `lib`. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + Alice's branch: -``` unison +``` ucm :hide +scratch/main> branch alice +``` + +``` unison :hide lib.foo : Nat lib.foo = 1 ``` +``` ucm :hide +scratch/alice> add + +scratch/main> branch bob +``` + Bob's branch: -``` unison +``` unison :hide bob : Nat bob = 100 ``` -``` ucm -project/alice> merge /bob +``` ucm :hide +scratch/bob> add +``` + +``` ucm :error +scratch/alice> merge /bob + + Loading branches... Sorry, I wasn't able to perform the merge: - - On project/alice, there's a type or term at the top level of + + On scratch/alice, there's a type or term at the top level of the `lib` namespace, where I only expect to find subnamespaces representing library dependencies. - + Please move or remove it and then try merging again. +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + ## LCA precondition violations The LCA is not subject to most precondition violations, which is good, because the user can't easily manipulate it\! @@ -1531,343 +2365,398 @@ The LCA is not subject to most precondition violations, which is good, because t Here's an example. We'll delete a constructor name from the LCA and still be able to merge Alice and Bob's stuff together. +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + LCA: ``` unison structural type Foo = Bar Nat | Baz Nat Nat ``` -``` ucm - +``` ucm :added-by-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`: structural type Foo - ``` + ``` ucm -project/main> add +scratch/main> add ⍟ I've added these definitions: - + structural type Foo -project/main> delete.term Foo.Baz +scratch/main> delete.term Foo.Baz Done. - ``` + Alice's branch: ``` ucm -project/main> branch alice +scratch/main> branch alice Done. I've created the alice branch based off of main. - + Tip: To merge your work back into the main branch, first `switch /main` then `merge /alice`. -project/alice> delete.type Foo +scratch/alice> delete.type Foo Done. -project/alice> delete.term Foo.Bar +scratch/alice> delete.term Foo.Bar Done. - ``` + ``` unison alice : Nat alice = 100 ``` -``` ucm - +``` ucm :added-by-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`: alice : Nat - ``` + ``` ucm -project/alice> add +scratch/alice> add ⍟ I've added these definitions: - - alice : Nat + alice : Nat ``` + Bob's branch: ``` ucm -project/main> branch bob +scratch/main> branch bob Done. I've created the bob branch based off of main. - + Tip: To merge your work back into the main branch, first `switch /main` then `merge /bob`. -project/bob> delete.type Foo +scratch/bob> delete.type Foo Done. -project/bob> delete.term Foo.Bar +scratch/bob> delete.term Foo.Bar Done. - ``` + ``` unison bob : Nat bob = 101 ``` -``` ucm - +``` ucm :added-by-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`: bob : Nat - ``` + ``` ucm -project/bob> add +scratch/bob> add ⍟ I've added these definitions: - - bob : Nat + bob : Nat ``` + Now we merge: ``` ucm -project/alice> merge /bob +scratch/alice> merge /bob - I merged project/bob into project/alice. + Loading branches... -``` -## Regression tests + Computing diff between branches... -### Delete one alias and update the other + Loading dependents of changes... -``` unison -foo = 17 -bar = 17 -``` + Loading and merging library dependencies... -``` ucm + Rendering Unison file... + + Typechecking Unison file... + + I merged scratch/bob into scratch/alice. +``` + +``` ucm :hide +scratch/main> project.delete scratch +``` + +## Regression tests + +### Delete one alias and update the other + +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + +``` unison +foo = 17 +bar = 17 +``` +``` ucm :added-by-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`: bar : Nat foo : Nat - ``` + ``` ucm -project/main> add +scratch/main> add ⍟ I've added these definitions: - + bar : Nat foo : Nat -project/main> branch alice +scratch/main> branch alice Done. I've created the alice branch based off of main. - + Tip: To merge your work back into the main branch, first `switch /main` then `merge /alice`. -project/alice> delete.term bar +scratch/alice> delete.term bar Done. - ``` + ``` unison foo = 18 ``` -``` ucm - +``` ucm :added-by-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 names already exist. You can `update` them to your new definition: foo : Nat - ``` + ``` ucm -project/alice> update +scratch/alice> update Okay, I'm searching the branch for code that needs to be updated... Done. -project/main> branch bob +scratch/main> branch bob Done. I've created the bob branch based off of main. - + Tip: To merge your work back into the main branch, first `switch /main` then `merge /bob`. - ``` + ``` unison bob = 101 ``` -``` ucm - +``` ucm :added-by-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`: bob : Nat - ``` + ``` ucm -project/bob> add +scratch/bob> add ⍟ I've added these definitions: - - bob : Nat + bob : Nat ``` + ``` ucm -project/alice> merge /bob +scratch/alice> merge /bob + + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... - I merged project/bob into project/alice. + I merged scratch/bob into scratch/alice. +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + ### Delete a constructor +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + ``` unison type Foo = Bar | Baz ``` -``` ucm - +``` ucm :added-by-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`: type Foo - ``` + ``` ucm -project/main> add +scratch/main> add ⍟ I've added these definitions: - + type Foo -project/main> branch topic +scratch/main> branch topic Done. I've created the topic branch based off of main. - + Tip: To merge your work back into the main branch, first `switch /main` then `merge /topic`. - ``` + ``` unison boop = "boop" ``` -``` ucm - +``` ucm :added-by-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`: boop : Text - ``` + ``` ucm -project/topic> add +scratch/topic> add ⍟ I've added these definitions: - - boop : Text + boop : Text ``` + ``` unison type Foo = Bar ``` -``` ucm - +``` ucm :added-by-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 names already exist. You can `update` them to your new definition: type Foo - ``` + ``` ucm -project/main> update +scratch/main> update Okay, I'm searching the branch for code that needs to be updated... Done. - ``` + ``` ucm -project/main> merge topic +scratch/main> merge topic + + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... - I merged project/topic into project/main. + I merged scratch/topic into scratch/main. -project/main> view Foo +scratch/main> view Foo type Foo = Bar +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + ### Dependent that doesn't need to be in the file This test demonstrates a bug. +``` ucm :hide +scratch/alice> builtins.mergeio lib.builtins +``` + In the LCA, we have `foo` with dependent `bar`, and `baz`. ``` unison @@ -1881,38 +2770,37 @@ baz : Text baz = "lca" ``` -``` ucm - +``` ucm :added-by-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`: bar : Nat baz : Text foo : Nat - ``` + ``` ucm -project/alice> add +scratch/alice> add ⍟ I've added these definitions: - + bar : Nat baz : Text foo : Nat -project/alice> branch bob +scratch/alice> branch bob Done. I've created the bob branch based off of alice. - + Tip: To merge your work back into the alice branch, first `switch /alice` then `merge /bob`. - ``` + On Bob, we update `baz` to "bob". ``` unison @@ -1920,29 +2808,28 @@ baz : Text baz = "bob" ``` -``` ucm - +``` ucm :added-by-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 names already exist. You can `update` them to your new definition: baz : Text - ``` + ``` ucm -project/bob> update +scratch/bob> update Okay, I'm searching the branch for code that needs to be updated... Done. - ``` + On Alice, we update `baz` to "alice" (conflict), but also update `foo` (unconflicted), which propagates to `bar`. ``` unison @@ -1953,23 +2840,22 @@ baz : Text baz = "alice" ``` -``` ucm - +``` ucm :added-by-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 names already exist. You can `update` them to your new definition: baz : Text foo : Nat - ``` + ``` ucm -project/alice> update +scratch/alice> update Okay, I'm searching the branch for code that needs to be updated... @@ -1979,37 +2865,47 @@ project/alice> update Everything typechecks, so I'm saving the results... Done. - ``` + When we try to merge Bob into Alice, we should see both versions of `baz`, with Alice's unconflicted `foo` and `bar` in the underlying namespace. -``` ucm -project/alice> merge /bob +``` ucm :error +scratch/alice> merge /bob + + Loading branches... + + Computing diff between branches... - I couldn't automatically merge project/bob into project/alice. + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. - + When you're done, you can run - + merge.commit - + to merge your changes back into alice and delete the temporary branch. Or, if you decide to cancel the merge instead, you can run - + delete.branch /merge-bob-into-alice - - to delete the temporary branch and switch back to alice. + to delete the temporary branch and switch back to alice. ``` -``` unison:added-by-ucm scratch.u --- project/alice + +``` unison :added-by-ucm scratch.u +-- scratch/alice baz : Text baz = "alice" --- project/bob +-- scratch/bob baz : Text baz = "bob" @@ -2025,6 +2921,10 @@ bar = But `bar` was put into the scratch file instead. +``` ucm :hide +scratch/main> project.delete scratch +``` + ### Merge loop test This tests for regressions of https://github.com/unisonweb/unison/issues/1276 where trivial merges cause loops in the @@ -2036,148 +2936,175 @@ Let's make three identical namespaces with different histories: a = 1 ``` -``` ucm - +``` ucm :added-by-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`: a : ##Nat - ``` + ``` ucm -project/alice> add +scratch/alice> add ⍟ I've added these definitions: - - a : ##Nat + a : ##Nat ``` + ``` unison b = 2 ``` -``` ucm - +``` ucm :added-by-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`: b : ##Nat - ``` + ``` ucm -project/alice> add +scratch/alice> add ⍟ I've added these definitions: - - b : ##Nat + b : ##Nat ``` + ``` unison b = 2 ``` -``` ucm - +``` ucm :added-by-ucm Loading changes detected in scratch.u. I found and typechecked the definitions in scratch.u. This file has been previously added to the codebase. - ``` + ``` ucm -project/bob> add +scratch/bob> add ⍟ I've added these definitions: - - b : ##Nat + b : ##Nat ``` + ``` unison a = 1 ``` -``` ucm - +``` ucm :added-by-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`: a : ##Nat - ``` + ``` ucm -project/bob> add +scratch/bob> add ⍟ I've added these definitions: - - a : ##Nat + a : ##Nat ``` + ``` unison a = 1 b = 2 ``` -``` ucm - +``` ucm :added-by-ucm Loading changes detected in scratch.u. I found and typechecked the definitions in scratch.u. This file has been previously added to the codebase. - ``` + ``` ucm -project/carol> add +scratch/carol> add ⍟ I've added these definitions: - + a : ##Nat b : ##Nat -project/bob> merge /alice +scratch/bob> merge /alice + + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... - I merged project/alice into project/bob. + I merged scratch/alice into scratch/bob. -project/carol> merge /bob +scratch/carol> merge /bob - I merged project/bob into project/carol. + Loading branches... -project/carol> history + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + + I merged scratch/bob into scratch/carol. + +scratch/carol> history Note: The most recent namespace hash is immediately below this message. - - - + + + This segment of history starts with a merge. Use `history #som3n4m3space` to view history starting from a given namespace hash. - + ⊙ 1. #b7fr6ifj87 ⑃ 2. #9npggauqo9 3. #dm4u1eokg1 +``` +``` ucm :hide +scratch/main> project.delete scratch ``` + ### Variables named `_` This test demonstrates a change in syntactic hashing that fixed a bug due to auto-generated variable names for ignored results. +``` ucm :hide +scratch/alice> builtins.mergeio lib.builtins +``` + ``` unison ignore : a -> () ignore _ = () @@ -2191,26 +3118,25 @@ bar = foo + foo ``` -``` ucm - +``` ucm :added-by-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`: bar : Nat foo : Nat ignore : a -> () - ``` + ``` ucm scratch/alice> add ⍟ I've added these definitions: - + bar : Nat foo : Nat ignore : a -> () @@ -2218,11 +3144,11 @@ scratch/alice> add scratch/alice> branch bob Done. I've created the bob branch based off of alice. - + Tip: To merge your work back into the alice branch, first `switch /alice` then `merge /bob`. - ``` + ``` unison bar : Nat bar = @@ -2230,20 +3156,19 @@ bar = foo + foo + foo ``` -``` ucm - +``` ucm :added-by-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 names already exist. You can `update` them to your new definition: bar : Nat - ``` + ``` ucm scratch/bob> update @@ -2251,8 +3176,8 @@ scratch/bob> update updated... Done. - ``` + Previously, this update to `foo` would also cause a "real update" on `bar`, its dependent. Now it doesn't, so the merge will succeed. @@ -2261,20 +3186,19 @@ foo : Nat foo = 19 ``` -``` ucm - +``` ucm :added-by-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 names already exist. You can `update` them to your new definition: foo : Nat - ``` + ``` ucm scratch/alice> update @@ -2286,11 +3210,332 @@ scratch/alice> update Everything typechecks, so I'm saving the results... Done. - ``` + ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + I merged scratch/bob into scratch/alice. +``` + +``` ucm :hide +scratch/main> project.delete scratch +``` + +### Unique type GUID reuse + +Previously, a merge branch would not include any dependents in the namespace, but that resulted in dependent unique +types' GUIDs being regenerated. + +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + +``` unison +type Foo = Lca +type Bar = MkBar Foo +``` + +``` ucm :added-by-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`: + + type Bar + type Foo +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Bar + type Foo + +scratch/main> branch alice + + Done. I've created the alice branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /alice`. + +scratch/alice> move.term Foo.Lca Foo.Alice + + Done. + +scratch/main> branch bob + + Done. I've created the bob branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /bob`. + +scratch/bob> move.term Foo.Lca Foo.Bob + + Done. +``` + +``` ucm :error +scratch/alice> merge /bob + + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + I couldn't automatically merge scratch/bob into scratch/alice. + However, I've added the definitions that need attention to the + top of scratch.u. + + When you're done, you can run + + merge.commit + + to merge your changes back into alice and delete the temporary + branch. Or, if you decide to cancel the merge instead, you can + run + + delete.branch /merge-bob-into-alice + + to delete the temporary branch and switch back to alice. +``` + +``` unison :added-by-ucm scratch.u +-- scratch/alice +type Foo + = Alice + +-- scratch/bob +type Foo + = Bob + +-- The definitions below are not conflicted, but they each depend on one or more +-- conflicted definitions above. + +type Bar + = MkBar Foo + +``` + +``` ucm +``` + +``` unison +type Foo = Merged +type Bar = MkBar Foo +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I found and typechecked the definitions in scratch.u. This + file has been previously added to the codebase. +``` + +``` ucm +scratch/merge-bob-into-alice> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/merge-bob-into-alice> names Bar + + Type + Hash: #h3af39sae7 + Names: Bar + +scratch/alice> names Bar + + Type + Hash: #h3af39sae7 + Names: Bar +``` + +``` ucm :hide +scratch/main> project.delete scratch +``` + +### Using Alice's names for Bob's things + +Previously, we'd render Alice's stuff with her names and Bob's stuff with his. But because Alice is doing the merge, +we now use her names whenever possible. In this example, Alice calls something `foo` and Bob calls it `bar`. When +rendering conflicts, in Bob's term that references (what he calls) `bar`, we render `foo` instead. + +``` ucm :hide +scratch/main> builtins.mergeio lib.builtins +``` + +``` unison +hello = 17 +``` + +``` ucm :added-by-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`: + + hello : Nat +``` + +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + hello : Nat + +scratch/main> branch alice + + Done. I've created the alice branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /alice`. +``` + +``` unison +hello = 18 + foo +foo = 100 +``` + +``` ucm :added-by-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 + + ⍟ These names already exist. You can `update` them to your + new definition: + + hello : Nat +``` + +``` ucm +scratch/alice> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +scratch/main> branch bob + + Done. I've created the bob branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /bob`. +``` + +``` unison +hello = 19 + bar +bar = 100 +``` + +``` ucm :added-by-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`: + + bar : Nat + + ⍟ These names already exist. You can `update` them to your + new definition: + + hello : Nat +``` + +``` ucm +scratch/bob> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. +``` + +Note Bob's `hello` references `foo` (Alice's name), not `bar` (Bob's name). + +``` ucm :error +scratch/alice> merge /bob + + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + I couldn't automatically merge scratch/bob into scratch/alice. + However, I've added the definitions that need attention to the + top of scratch.u. + + When you're done, you can run + + merge.commit + + to merge your changes back into alice and delete the temporary + branch. Or, if you decide to cancel the merge instead, you can + run + + delete.branch /merge-bob-into-alice + + to delete the temporary branch and switch back to alice. +``` + +``` unison :added-by-ucm scratch.u +-- scratch/alice +hello : Nat +hello = + use Nat + + 18 + foo + +-- scratch/bob +hello : Nat +hello = + use Nat + + 19 + foo + +``` +``` ucm :hide +scratch/main> project.delete scratch ``` diff --git a/unison-src/transcripts/move-all.md b/unison-src/transcripts/move-all.md deleted file mode 100644 index ee83aa33a7..0000000000 --- a/unison-src/transcripts/move-all.md +++ /dev/null @@ -1,71 +0,0 @@ -# Tests for `move` - -```ucm:hide -scratch/main> builtins.merge -``` - -## Happy Path - namespace, term, and type - -Create a term, type, and namespace with history - -```unison -Foo = 2 -unique type Foo = Foo -Foo.termInA = 1 -unique type Foo.T = T -``` - -```ucm -scratch/main> add -``` - -```unison -Foo.termInA = 2 -unique type Foo.T = T1 | T2 -``` - -```ucm -scratch/main> update -``` - -Should be able to move the term, type, and namespace, including its types, terms, and sub-namespaces. - -```ucm -scratch/main> move Foo Bar -scratch/main> ls -scratch/main> ls Bar -scratch/main> history Bar -``` - -## Happy Path - Just term - -```unison -bonk = 5 -``` - -```ucm -z/main> builtins.merge -z/main> add -z/main> move bonk zonk -z/main> ls -``` - -## Happy Path - Just namespace - -```unison -bonk.zonk = 5 -``` - -```ucm -a/main> builtins.merge -a/main> add -a/main> move bonk zonk -a/main> ls -a/main> view zonk.zonk -``` - -## Sad Path - No term, type, or namespace named src - -```ucm:error -scratch/main> move doesntexist foo -``` diff --git a/unison-src/transcripts/move-all.output.md b/unison-src/transcripts/move-all.output.md deleted file mode 100644 index 36116ad2bf..0000000000 --- a/unison-src/transcripts/move-all.output.md +++ /dev/null @@ -1,205 +0,0 @@ -# Tests for `move` - -## Happy Path - namespace, term, and type - -Create a term, type, and namespace with history - -``` unison -Foo = 2 -unique type Foo = Foo -Foo.termInA = 1 -unique type Foo.T = T -``` - -``` 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`: - - type Foo - type Foo.T - Foo : Nat - Foo.termInA : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Foo - type Foo.T - Foo : Nat - Foo.termInA : Nat - -``` -``` unison -Foo.termInA = 2 -unique type Foo.T = T1 | T2 -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - type Foo.T - Foo.termInA : Nat - (also named Foo) - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -``` -Should be able to move the term, type, and namespace, including its types, terms, and sub-namespaces. - -``` ucm -scratch/main> move Foo Bar - - Done. - -scratch/main> ls - - 1. Bar (Nat) - 2. Bar (type) - 3. Bar/ (4 terms, 1 type) - 4. builtin/ (469 terms, 74 types) - -scratch/main> ls Bar - - 1. Foo (Bar) - 2. T (type) - 3. T/ (2 terms) - 4. termInA (Nat) - -scratch/main> history Bar - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #o7vuviel4c - - + Adds / updates: - - T T.T1 T.T2 termInA - - - Deletes: - - T.T - - □ 2. #c5cggiaumo (start of history) - -``` -## Happy Path - Just term - -``` unison -bonk = 5 -``` - -``` 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`: - - bonk : Nat - -``` -``` ucm -z/main> builtins.merge - - Done. - -z/main> add - - ⍟ I've added these definitions: - - bonk : Nat - -z/main> move bonk zonk - - Done. - -z/main> ls - - 1. builtin/ (469 terms, 74 types) - 2. zonk (Nat) - -``` -## Happy Path - Just namespace - -``` unison -bonk.zonk = 5 -``` - -``` 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`: - - bonk.zonk : Nat - (also named zonk) - -``` -``` ucm -a/main> builtins.merge - - Done. - -a/main> add - - ⍟ I've added these definitions: - - bonk.zonk : Nat - -a/main> move bonk zonk - - Done. - -a/main> ls - - 1. builtin/ (469 terms, 74 types) - 2. zonk/ (1 term) - -a/main> view zonk.zonk - - zonk.zonk : Nat - zonk.zonk = 5 - -``` -## Sad Path - No term, type, or namespace named src - -``` ucm -scratch/main> move doesntexist foo - - ⚠️ - - There is no term, type, or namespace at doesntexist. - -``` diff --git a/unison-src/transcripts/move-namespace.md b/unison-src/transcripts/move-namespace.md deleted file mode 100644 index e547fdfa21..0000000000 --- a/unison-src/transcripts/move-namespace.md +++ /dev/null @@ -1,144 +0,0 @@ -# Tests for `move.namespace` - - -## Moving the Root - -I should be able to move the root into a sub-namespace - -```unison:hide -foo = 1 -``` - -```ucm -scratch/main> add --- Should request confirmation -scratch/main> move.namespace . .root.at.path -scratch/main> move.namespace . .root.at.path -scratch/main> ls -scratch/main> history -``` - -```ucm -scratch/main> ls .root.at.path -scratch/main> history .root.at.path -``` - -I should be able to move a sub namespace _over_ the root. - -```ucm --- Should request confirmation -scratch/main> move.namespace .root.at.path . -scratch/main> move.namespace .root.at.path . -scratch/main> ls -scratch/main> history -``` - - -```ucm:error --- should be empty -scratch/main> ls .root.at.path -scratch/main> history .root.at.path -``` - -```ucm:hide -scratch/happy> builtins.merge lib.builtins -``` - -## Happy path - -Create a namespace and add some history to it - -```unison -a.termInA = 1 -unique type a.T = T -``` - -```ucm -scratch/happy> add -``` - -```unison -a.termInA = 2 -unique type a.T = T1 | T2 -``` - -```ucm -scratch/happy> update -``` - -Should be able to move the namespace, including its types, terms, and sub-namespaces. - -```ucm -scratch/happy> move.namespace a b -scratch/happy> ls b -scratch/happy> history b -``` - - -## Namespace history - -```ucm:hide -scratch/history> builtins.merge lib.builtins -``` - -Create some namespaces and add some history to them - -```unison -a.termInA = 1 -b.termInB = 10 -``` - -```ucm -scratch/history> add -``` - -```unison -a.termInA = 2 -b.termInB = 11 -``` - -```ucm -scratch/history> update -``` - -Deleting a namespace should not leave behind any history, -if we move another to that location we expect the history to simply be the history -of the moved namespace. - -```ucm -scratch/history> delete.namespace b -scratch/history> move.namespace a b --- Should be the history from 'a' -scratch/history> history b --- Should be empty -scratch/history> history a -``` - - -## Moving over an existing branch - -```ucm:hide -scratch/existing> builtins.merge lib.builtins -``` - -Create some namespace and add some history to them - -```unison -a.termInA = 1 -b.termInB = 10 -``` - -```ucm -scratch/existing> add -``` - -```unison -a.termInA = 2 -b.termInB = 11 -``` - -```ucm -scratch/existing> update -scratch/existing> move.namespace a b -``` - diff --git a/unison-src/transcripts/move-namespace.output.md b/unison-src/transcripts/move-namespace.output.md deleted file mode 100644 index c90e352696..0000000000 --- a/unison-src/transcripts/move-namespace.output.md +++ /dev/null @@ -1,366 +0,0 @@ -# Tests for `move.namespace` - -## Moving the Root - -I should be able to move the root into a sub-namespace - -``` unison -foo = 1 -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - foo : ##Nat - --- Should request confirmation -scratch/main> move.namespace . .root.at.path - - ⚠️ - - Moves which affect the root branch cannot be undone, are you sure? - Re-run the same command to proceed. - -scratch/main> move.namespace . .root.at.path - - Done. - -scratch/main> ls - - 1. root/ (1 term) - -scratch/main> history - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #g97lh1m2v7 (start of history) - -``` -``` ucm -scratch/main> ls .root.at.path - - 1. foo (##Nat) - -scratch/main> history .root.at.path - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #08a6hgi6s4 (start of history) - -``` -I should be able to move a sub namespace *over* the root. - -``` ucm --- Should request confirmation -scratch/main> move.namespace .root.at.path . - - ⚠️ - - Moves which affect the root branch cannot be undone, are you sure? - Re-run the same command to proceed. - -scratch/main> move.namespace .root.at.path . - - Done. - -scratch/main> ls - - 1. foo (##Nat) - -scratch/main> history - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #08a6hgi6s4 (start of history) - -``` -``` ucm --- should be empty -scratch/main> ls .root.at.path - - nothing to show - -scratch/main> history .root.at.path - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #sg60bvjo91 (start of history) - -``` -## Happy path - -Create a namespace and add some history to it - -``` unison -a.termInA = 1 -unique type a.T = T -``` - -``` 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`: - - type a.T - a.termInA : Nat - -``` -``` ucm -scratch/happy> add - - ⍟ I've added these definitions: - - type a.T - a.termInA : Nat - -``` -``` unison -a.termInA = 2 -unique type a.T = T1 | T2 -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - type a.T - a.termInA : Nat - -``` -``` ucm -scratch/happy> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -``` -Should be able to move the namespace, including its types, terms, and sub-namespaces. - -``` ucm -scratch/happy> move.namespace a b - - Done. - -scratch/happy> ls b - - 1. T (type) - 2. T/ (2 terms) - 3. termInA (Nat) - -scratch/happy> history b - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #rkvfe5p8fu - - + Adds / updates: - - T T.T1 T.T2 termInA - - - Deletes: - - T.T - - □ 2. #avlnmh0erc (start of history) - -``` -## Namespace history - -Create some namespaces and add some history to them - -``` unison -a.termInA = 1 -b.termInB = 10 -``` - -``` 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`: - - a.termInA : Nat - b.termInB : Nat - -``` -``` ucm -scratch/history> add - - ⍟ I've added these definitions: - - a.termInA : Nat - b.termInB : Nat - -``` -``` unison -a.termInA = 2 -b.termInB = 11 -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - a.termInA : Nat - b.termInB : Nat - -``` -``` ucm -scratch/history> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -``` -Deleting a namespace should not leave behind any history, -if we move another to that location we expect the history to simply be the history -of the moved namespace. - -``` ucm -scratch/history> delete.namespace b - - Done. - -scratch/history> move.namespace a b - - Done. - --- Should be the history from 'a' -scratch/history> history b - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #j0cjjqepb3 - - + Adds / updates: - - termInA - - □ 2. #m8smmmgjso (start of history) - --- Should be empty -scratch/history> history a - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #sg60bvjo91 (start of history) - -``` -## Moving over an existing branch - -Create some namespace and add some history to them - -``` unison -a.termInA = 1 -b.termInB = 10 -``` - -``` 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`: - - a.termInA : Nat - b.termInB : Nat - -``` -``` ucm -scratch/existing> add - - ⍟ I've added these definitions: - - a.termInA : Nat - b.termInB : Nat - -``` -``` unison -a.termInA = 2 -b.termInB = 11 -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - a.termInA : Nat - b.termInB : Nat - -``` -``` ucm -scratch/existing> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -scratch/existing> move.namespace a b - - ⚠️ - - A branch existed at the destination: b so I over-wrote it. - - Tip: You can use `undo` or use a hash from `reflog` to undo - this change. - - Done. - -``` diff --git a/unison-src/transcripts/name-segment-escape.md b/unison-src/transcripts/name-segment-escape.md deleted file mode 100644 index bf6bca128d..0000000000 --- a/unison-src/transcripts/name-segment-escape.md +++ /dev/null @@ -1,15 +0,0 @@ -You can use a keyword or reserved operator as a name segment if you surround it with backticks. - -```ucm:error -scratch/main> view `match` -scratch/main> view `=` -``` - -You can also use backticks to expand the set of valid symbols in a symboly name segment to include these three: `.()` - -This allows you to spell `.` or `()` as name segments (which historically have appeared in the namespace). - -```ucm:error -scratch/main> view `.` -scratch/main> view `()` -``` diff --git a/unison-src/transcripts/name-segment-escape.output.md b/unison-src/transcripts/name-segment-escape.output.md deleted file mode 100644 index 4a58422746..0000000000 --- a/unison-src/transcripts/name-segment-escape.output.md +++ /dev/null @@ -1,38 +0,0 @@ -You can use a keyword or reserved operator as a name segment if you surround it with backticks. - -``` ucm -scratch/main> view `match` - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - `match` - -scratch/main> view `=` - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - `=` - -``` -You can also use backticks to expand the set of valid symbols in a symboly name segment to include these three: `.()` - -This allows you to spell `.` or `()` as name segments (which historically have appeared in the namespace). - -``` ucm -scratch/main> view `.` - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - `.` - -scratch/main> view `()` - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - `()` - -``` diff --git a/unison-src/transcripts/name-selection.md b/unison-src/transcripts/name-selection.md deleted file mode 100644 index 5443349c0d..0000000000 --- a/unison-src/transcripts/name-selection.md +++ /dev/null @@ -1,87 +0,0 @@ -This transcript shows how the pretty-printer picks names for a hash when multiple are available. The algorithm is: - -1. Names that are "name-only" come before names that are hash qualified. So `List.map` comes before `List.map#2384a` and also `aaaa#xyz`. -2. Shorter names (in terms of segment count) come before longer ones, for instance `base.List.map` comes before `somelibrary.external.base.List.map`. -3. Otherwise if there are multiple names with a minimal number of segments, compare the names alphabetically. - -```ucm:hide -scratch/main> builtins.merge lib.builtins -scratch/biasing> builtins.merge lib.builtins -``` - -```unison:hide -a.a = a.b + 1 -a.b = 0 + 1 -a.aaa.but.more.segments = 0 + 1 -``` - -Will add `a` and `b` to the codebase and give `b` a longer (in terms of segment length alias), and show that it isn't used when viewing `a`: - -```ucm -scratch/main> add -scratch/main> view a.a -``` - -Next let's introduce a conflicting symbol and show that its hash qualified name isn't used when it has an unconflicted name: - -```unison:hide -a2.a = a2.b + 1 -a2.b = 0 + 1 -a2.aaa.but.more.segments = 0 + 1 -a2.c = 1 -a2.d = a2.c + 10 -a2.long.name.but.shortest.suffixification = 1 - -a3.a = a3.b + 1 -a3.b = 0 + 1 -a3.aaa.but.more.segments = 0 + 1 -a3.c = 2 -a3.d = a3.c + 10 -a3.long.name.but.shortest.suffixification = 1 -``` - -```ucm -scratch/main> add -scratch/main> debug.alias.term.force a2.c a3.c -scratch/main> debug.alias.term.force a2.d a3.d -``` - -At this point, `a3` is conflicted for symbols `c` and `d`, so those are deprioritized. -The original `a2` namespace has an unconflicted definition for `c` and `d`, but since there are multiple 'c's in scope, -`a2.c` is chosen because although the suffixified version has fewer segments, its fully-qualified name has the fewest segments. - -```ucm -scratch/main> view a b c d -``` - -## Name biasing - -```unison -deeply.nested.term = - a + 1 - -deeply.nested.num = 10 - -a = 10 -``` - -```ucm -scratch/biasing> add --- Despite being saved with name `a`, --- the pretty printer should prefer the suffixified 'deeply.nested.num name' over the shallow 'a'. --- It's closer to the term being printed. -scratch/biasing> view deeply.nested.term -``` - -Add another term with `num` suffix to force longer suffixification of `deeply.nested.num` - -```unison -other.num = 20 -``` - -```ucm -scratch/biasing> add --- nested.num should be preferred over the shorter name `a` due to biasing --- because `deeply.nested.num` is nearby to the term being viewed. -scratch/biasing> view deeply.nested.term -``` diff --git a/unison-src/transcripts/name-selection.output.md b/unison-src/transcripts/name-selection.output.md deleted file mode 100644 index 10bb357c98..0000000000 --- a/unison-src/transcripts/name-selection.output.md +++ /dev/null @@ -1,198 +0,0 @@ -This transcript shows how the pretty-printer picks names for a hash when multiple are available. The algorithm is: - -1. Names that are "name-only" come before names that are hash qualified. So `List.map` comes before `List.map#2384a` and also `aaaa#xyz`. -2. Shorter names (in terms of segment count) come before longer ones, for instance `base.List.map` comes before `somelibrary.external.base.List.map`. -3. Otherwise if there are multiple names with a minimal number of segments, compare the names alphabetically. - -``` unison -a.a = a.b + 1 -a.b = 0 + 1 -a.aaa.but.more.segments = 0 + 1 -``` - -Will add `a` and `b` to the codebase and give `b` a longer (in terms of segment length alias), and show that it isn't used when viewing `a`: - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - a.a : Nat - a.aaa.but.more.segments : Nat - a.b : Nat - -scratch/main> view a.a - - a.a : Nat - a.a = - use Nat + - b + 1 - -``` -Next let's introduce a conflicting symbol and show that its hash qualified name isn't used when it has an unconflicted name: - -``` unison -a2.a = a2.b + 1 -a2.b = 0 + 1 -a2.aaa.but.more.segments = 0 + 1 -a2.c = 1 -a2.d = a2.c + 10 -a2.long.name.but.shortest.suffixification = 1 - -a3.a = a3.b + 1 -a3.b = 0 + 1 -a3.aaa.but.more.segments = 0 + 1 -a3.c = 2 -a3.d = a3.c + 10 -a3.long.name.but.shortest.suffixification = 1 -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - a2.a : Nat - (also named a.a) - a2.aaa.but.more.segments : Nat - (also named a.b and a.aaa.but.more.segments) - a2.b : Nat - (also named a.b and a.aaa.but.more.segments) - a2.c : Nat - a2.d : Nat - a2.long.name.but.shortest.suffixification : Nat - a3.a : Nat - (also named a.a) - a3.aaa.but.more.segments : Nat - (also named a.b and a.aaa.but.more.segments) - a3.b : Nat - (also named a.b and a.aaa.but.more.segments) - a3.c : Nat - a3.d : Nat - a3.long.name.but.shortest.suffixification : Nat - -scratch/main> debug.alias.term.force a2.c a3.c - - Done. - -scratch/main> debug.alias.term.force a2.d a3.d - - Done. - -``` -At this point, `a3` is conflicted for symbols `c` and `d`, so those are deprioritized. -The original `a2` namespace has an unconflicted definition for `c` and `d`, but since there are multiple 'c's in scope, -`a2.c` is chosen because although the suffixified version has fewer segments, its fully-qualified name has the fewest segments. - -``` ucm -scratch/main> view a b c d - - a.a : Nat - a.a = - use Nat + - b + 1 - - a.b : Nat - a.b = - use Nat + - 0 + 1 - - a2.c : Nat - a2.c = 1 - - a2.d : Nat - a2.d = - use Nat + - a2.c + 10 - - a3.c#dcgdua2lj6 : Nat - a3.c#dcgdua2lj6 = 2 - - a3.d#9ivhgvhthc : Nat - a3.d#9ivhgvhthc = - use Nat + - c#dcgdua2lj6 + 10 - -``` -## Name biasing - -``` unison -deeply.nested.term = - a + 1 - -deeply.nested.num = 10 - -a = 10 -``` - -``` 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`: - - a : Nat - deeply.nested.num : Nat - deeply.nested.term : Nat - -``` -``` ucm -scratch/biasing> add - - ⍟ I've added these definitions: - - a : Nat - deeply.nested.num : Nat - deeply.nested.term : Nat - --- Despite being saved with name `a`, --- the pretty printer should prefer the suffixified 'deeply.nested.num name' over the shallow 'a'. --- It's closer to the term being printed. -scratch/biasing> view deeply.nested.term - - deeply.nested.term : Nat - deeply.nested.term = - use Nat + - num + 1 - -``` -Add another term with `num` suffix to force longer suffixification of `deeply.nested.num` - -``` unison -other.num = 20 -``` - -``` 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`: - - other.num : Nat - -``` -``` ucm -scratch/biasing> add - - ⍟ I've added these definitions: - - other.num : Nat - --- nested.num should be preferred over the shorter name `a` due to biasing --- because `deeply.nested.num` is nearby to the term being viewed. -scratch/biasing> view deeply.nested.term - - deeply.nested.term : Nat - deeply.nested.term = - use Nat + - nested.num + 1 - -``` diff --git a/unison-src/transcripts/names.md b/unison-src/transcripts/names.md deleted file mode 100644 index 486ff35ec1..0000000000 --- a/unison-src/transcripts/names.md +++ /dev/null @@ -1,44 +0,0 @@ -# `names` command - -```ucm -scratch/main> builtins.merge lib.builtins -``` - -Example uses of the `names` command and output - -```unison --- Some names with the same value -some.place.x = 1 -some.otherplace.y = 1 -some.otherplace.x = 10 -somewhere.z = 1 --- Some similar name with a different value -somewhere.y = 2 -``` - -```ucm -scratch/main> add -``` - - -`names` searches relative to the current path. - -```ucm --- We can search by suffix and find all definitions named 'x', and each of their aliases respectively. -scratch/main> names x --- We can search by hash, and see all aliases of that hash -scratch/main> names #gjmq673r1v --- Works with absolute names too -scratch/main> names .some.place.x -``` - -`debug.names.global` searches from the root, and absolutely qualifies results - -```ucm --- We can search from a different branch and find all names in the codebase named 'x', and each of their aliases respectively. -scratch/other> debug.names.global x --- We can search by hash, and see all aliases of that hash in the codebase -scratch/other> debug.names.global #gjmq673r1v --- We can search using an absolute name -scratch/other> debug.names.global .some.place.x -``` diff --git a/unison-src/transcripts/names.output.md b/unison-src/transcripts/names.output.md deleted file mode 100644 index 06db804432..0000000000 --- a/unison-src/transcripts/names.output.md +++ /dev/null @@ -1,111 +0,0 @@ -# `names` command - -``` ucm -scratch/main> builtins.merge lib.builtins - - Done. - -``` -Example uses of the `names` command and output - -``` unison --- Some names with the same value -some.place.x = 1 -some.otherplace.y = 1 -some.otherplace.x = 10 -somewhere.z = 1 --- Some similar name with a different value -somewhere.y = 2 -``` - -``` 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`: - - some.otherplace.x : Nat - some.otherplace.y : Nat - some.place.x : Nat - somewhere.y : Nat - somewhere.z : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - some.otherplace.x : Nat - some.otherplace.y : Nat - some.place.x : Nat - somewhere.y : Nat - somewhere.z : Nat - -``` -`names` searches relative to the current path. - -``` ucm --- We can search by suffix and find all definitions named 'x', and each of their aliases respectively. -scratch/main> names x - - Terms - Hash: #gjmq673r1v - Names: some.otherplace.y some.place.x somewhere.z - - Hash: #pi25gcdv0o - Names: some.otherplace.x - --- We can search by hash, and see all aliases of that hash -scratch/main> names #gjmq673r1v - - Term - Hash: #gjmq673r1v - Names: some.otherplace.y some.place.x somewhere.z - --- Works with absolute names too -scratch/main> names .some.place.x - - Term - Hash: #gjmq673r1v - Names: some.otherplace.y some.place.x somewhere.z - -``` -`debug.names.global` searches from the root, and absolutely qualifies results - -``` ucm --- We can search from a different branch and find all names in the codebase named 'x', and each of their aliases respectively. -scratch/other> debug.names.global x - - Found results in scratch/main - - Terms - Hash: #gjmq673r1v - Names: some.otherplace.y some.place.x somewhere.z - - Hash: #pi25gcdv0o - Names: some.otherplace.x - --- We can search by hash, and see all aliases of that hash in the codebase -scratch/other> debug.names.global #gjmq673r1v - - Found results in scratch/main - - Term - Hash: #gjmq673r1v - Names: some.otherplace.y some.place.x somewhere.z - --- We can search using an absolute name -scratch/other> debug.names.global .some.place.x - - Found results in scratch/main - - Term - Hash: #gjmq673r1v - Names: some.otherplace.y some.place.x somewhere.z - -``` diff --git a/unison-src/transcripts/namespace-deletion-regression.output.md b/unison-src/transcripts/namespace-deletion-regression.output.md deleted file mode 100644 index 1730897d3e..0000000000 --- a/unison-src/transcripts/namespace-deletion-regression.output.md +++ /dev/null @@ -1,31 +0,0 @@ -# Namespace deletion regression test - -See https://github.com/unisonweb/unison/issues/1552 - -If branch operations aren't performed in the correct order it's possible to end up with unexpected results. - -Previously the following sequence delete the current namespace -unexpectedly 😬. - -``` ucm -scratch/main> alias.term ##Nat.+ Nat.+ - - Done. - -scratch/main> ls Nat - - 1. + (##Nat -> ##Nat -> ##Nat) - -scratch/main> move.namespace Nat Nat.operators - - Done. - -scratch/main> ls Nat - - 1. operators/ (1 term) - -scratch/main> ls Nat.operators - - 1. + (##Nat -> ##Nat -> ##Nat) - -``` diff --git a/unison-src/transcripts/namespace-dependencies.md b/unison-src/transcripts/namespace-dependencies.md deleted file mode 100644 index d60f789367..0000000000 --- a/unison-src/transcripts/namespace-dependencies.md +++ /dev/null @@ -1,16 +0,0 @@ -# namespace.dependencies command - -```ucm -scratch/main> builtins.merge lib.builtins -``` - -```unison:hide -const a b = a -external.mynat = 1 -mynamespace.dependsOnText = const external.mynat 10 -``` - -```ucm -scratch/main> add -scratch/main> namespace.dependencies mynamespace -``` diff --git a/unison-src/transcripts/namespace-dependencies.output.md b/unison-src/transcripts/namespace-dependencies.output.md deleted file mode 100644 index f263473bf6..0000000000 --- a/unison-src/transcripts/namespace-dependencies.output.md +++ /dev/null @@ -1,33 +0,0 @@ -# namespace.dependencies command - -``` ucm -scratch/main> builtins.merge lib.builtins - - Done. - -``` -``` unison -const a b = a -external.mynat = 1 -mynamespace.dependsOnText = const external.mynat 10 -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - const : a -> b -> a - external.mynat : Nat - mynamespace.dependsOnText : Nat - -scratch/main> namespace.dependencies mynamespace - - External dependency Dependents in scratch/main:.mynamespace - lib.builtins.Nat 1. dependsOnText - - const 1. dependsOnText - - external.mynat 1. dependsOnText - -``` diff --git a/unison-src/transcripts/no-hash-in-term-declaration.md b/unison-src/transcripts/no-hash-in-term-declaration.md index ac43b449ac..493c2f32ce 100644 --- a/unison-src/transcripts/no-hash-in-term-declaration.md +++ b/unison-src/transcripts/no-hash-in-term-declaration.md @@ -2,7 +2,7 @@ There should not be hashes in the names used in term declarations, either in the type signature or the type definition. -```unison:hide:all:error +``` unison :hide:all:error x##Nat : Int -> Int -> Boolean x##Nat = 5 -``` \ No newline at end of file +``` diff --git a/unison-src/transcripts/no-hash-in-term-declaration.output.md b/unison-src/transcripts/no-hash-in-term-declaration.output.md index aa3dc9d9fc..a72d53344c 100644 --- a/unison-src/transcripts/no-hash-in-term-declaration.output.md +++ b/unison-src/transcripts/no-hash-in-term-declaration.output.md @@ -1,4 +1,3 @@ # No Hashes in Term Declarations There should not be hashes in the names used in term declarations, either in the type signature or the type definition. - diff --git a/unison-src/transcripts/numbered-args.md b/unison-src/transcripts/numbered-args.md deleted file mode 100644 index 02172710bc..0000000000 --- a/unison-src/transcripts/numbered-args.md +++ /dev/null @@ -1,56 +0,0 @@ -# Using numbered arguments in UCM - -```ucm:hide -scratch/main> alias.type ##Text Text -``` - -First lets add some contents to our codebase. - -```unison -foo = "foo" -bar = "bar" -baz = "baz" -qux = "qux" -quux = "quux" -corge = "corge" -``` - -```ucm -scratch/main> add -``` - -We can get the list of things in the namespace, and UCM will give us a numbered -list: - -```ucm -scratch/main> find -``` - -We can ask to `view` the second element of this list: - -```ucm -scratch/main> find -scratch/main> view 2 -``` - -And we can `view` multiple elements by separating with spaces: - -```ucm -scratch/main> find -scratch/main> view 2 3 5 -``` - -We can also ask for a range: - -```ucm -scratch/main> find -scratch/main> view 2-4 -``` - -And we can ask for multiple ranges and use mix of ranges and numbers: - -```ucm -scratch/main> find -scratch/main> view 1-3 4 5-6 -``` - diff --git a/unison-src/transcripts/numbered-args.output.md b/unison-src/transcripts/numbered-args.output.md deleted file mode 100644 index 0567bcac3f..0000000000 --- a/unison-src/transcripts/numbered-args.output.md +++ /dev/null @@ -1,167 +0,0 @@ -# Using numbered arguments in UCM - -First lets add some contents to our codebase. - -``` unison -foo = "foo" -bar = "bar" -baz = "baz" -qux = "qux" -quux = "quux" -corge = "corge" -``` - -``` 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`: - - bar : Text - baz : Text - corge : Text - foo : Text - quux : Text - qux : Text - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - bar : Text - baz : Text - corge : Text - foo : Text - quux : Text - qux : Text - -``` -We can get the list of things in the namespace, and UCM will give us a numbered -list: - -``` ucm -scratch/main> find - - 1. bar : Text - 2. baz : Text - 3. corge : Text - 4. foo : Text - 5. quux : Text - 6. qux : Text - 7. builtin type Text - - -``` -We can ask to `view` the second element of this list: - -``` ucm -scratch/main> find - - 1. bar : Text - 2. baz : Text - 3. corge : Text - 4. foo : Text - 5. quux : Text - 6. qux : Text - 7. builtin type Text - - -scratch/main> view 2 - - baz : Text - baz = "baz" - -``` -And we can `view` multiple elements by separating with spaces: - -``` ucm -scratch/main> find - - 1. bar : Text - 2. baz : Text - 3. corge : Text - 4. foo : Text - 5. quux : Text - 6. qux : Text - 7. builtin type Text - - -scratch/main> view 2 3 5 - - baz : Text - baz = "baz" - - corge : Text - corge = "corge" - - quux : Text - quux = "quux" - -``` -We can also ask for a range: - -``` ucm -scratch/main> find - - 1. bar : Text - 2. baz : Text - 3. corge : Text - 4. foo : Text - 5. quux : Text - 6. qux : Text - 7. builtin type Text - - -scratch/main> view 2-4 - - baz : Text - baz = "baz" - - corge : Text - corge = "corge" - - foo : Text - foo = "foo" - -``` -And we can ask for multiple ranges and use mix of ranges and numbers: - -``` ucm -scratch/main> find - - 1. bar : Text - 2. baz : Text - 3. corge : Text - 4. foo : Text - 5. quux : Text - 6. qux : Text - 7. builtin type Text - - -scratch/main> view 1-3 4 5-6 - - bar : Text - bar = "bar" - - baz : Text - baz = "baz" - - corge : Text - corge = "corge" - - foo : Text - foo = "foo" - - quux : Text - quux = "quux" - - qux : Text - qux = "qux" - -``` diff --git a/unison-src/transcripts/old-fold-right.md b/unison-src/transcripts/old-fold-right.md deleted file mode 100644 index 179ad5b936..0000000000 --- a/unison-src/transcripts/old-fold-right.md +++ /dev/null @@ -1,17 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -oldRight: (b ->{e} a ->{e} b) -> [a] ->{e} [b] -oldRight f la = bug "out" - -pecan: '{} [Text] -pecan = 'let - la = [1, 2, 3] - f: Text -> Nat -> Text - f = bug "out" - - oldRight f la -``` - diff --git a/unison-src/transcripts/old-fold-right.output.md b/unison-src/transcripts/old-fold-right.output.md deleted file mode 100644 index a74a317a49..0000000000 --- a/unison-src/transcripts/old-fold-right.output.md +++ /dev/null @@ -1,27 +0,0 @@ -``` unison -oldRight: (b ->{e} a ->{e} b) -> [a] ->{e} [b] -oldRight f la = bug "out" - -pecan: '{} [Text] -pecan = 'let - la = [1, 2, 3] - f: Text -> Nat -> Text - f = bug "out" - - oldRight f la -``` - -``` 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`: - - oldRight : (b ->{e} a ->{e} b) -> [a] ->{e} [b] - pecan : '[Text] - -``` diff --git a/unison-src/transcripts/pattern-match-coverage.md b/unison-src/transcripts/pattern-match-coverage.md deleted file mode 100644 index e08ea269ab..0000000000 --- a/unison-src/transcripts/pattern-match-coverage.md +++ /dev/null @@ -1,621 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -# Basics -## non-exhaustive patterns -```unison:error -unique type T = A | B | C - -test : T -> () -test = cases - A -> () -``` - -```unison:error -unique type T = A | B - -test : (T, Optional T) -> () -test = cases - (A, Some _) -> () - (A, None) -> () - (B, Some A) -> () - (B, None) -> () -``` - -## redundant patterns -```unison:error -unique type T = A | B | C - -test : T -> () -test = cases - A -> () - B -> () - C -> () - _ -> () -``` - -```unison:error -unique type T = A | B - -test : (T, Optional T) -> () -test = cases - (A, Some _) -> () - (A, None) -> () - (B, Some _) -> () - (B, None) -> () - (A, Some A) -> () -``` - -# Uninhabited patterns - -match is complete without covering uninhabited patterns -```unison -unique type V = - -test : Optional (Optional V) -> () -test = cases - None -> () - Some None -> () -``` - -uninhabited patterns are reported as redundant -```unison:error -unique type V = - -test0 : V -> () -test0 = cases - _ -> () -``` - -```unison:error -unique type V = - -test : Optional (Optional V) -> () -test = cases - None -> () - Some None -> () - Some _ -> () -``` - -# Guards - -## Incomplete patterns due to guards should be reported -```unison:error -test : () -> () -test = cases - () | false -> () -``` - -```unison:error -test : Optional Nat -> Nat -test = cases - None -> 0 - Some x - | isEven x -> x -``` - -## Complete patterns with guards should be accepted -```unison:error -test : Optional Nat -> Nat -test = cases - None -> 0 - Some x - | isEven x -> x - | otherwise -> 0 -``` - -# Pattern instantiation depth - -Uncovered patterns are only instantiated as deeply as necessary to -distinguish them from existing patterns. -```unison:error -unique type T = A | B | C - -test : Optional (Optional T) -> () -test = cases - None -> () - Some None -> () -``` - -```unison:error -unique type T = A | B | C - -test : Optional (Optional T) -> () -test = cases - None -> () - Some None -> () - Some (Some A) -> () -``` - -# Literals - -## Non-exhaustive - -Nat -```unison:error -test : Nat -> () -test = cases - 0 -> () -``` - -Boolean -```unison:error -test : Boolean -> () -test = cases - true -> () -``` - -## Exhaustive - -Nat -```unison -test : Nat -> () -test = cases - 0 -> () - _ -> () -``` - -Boolean -```unison -test : Boolean -> () -test = cases - true -> () - false -> () -``` - -# Redundant - -Nat -```unison:error -test : Nat -> () -test = cases - 0 -> () - 0 -> () - _ -> () -``` - -Boolean -```unison:error -test : Boolean -> () -test = cases - true -> () - false -> () - _ -> () -``` - -# Sequences - -## Exhaustive -```unison -test : [()] -> () -test = cases - [] -> () - x +: xs -> () -``` - -## Non-exhaustive -```unison:error -test : [()] -> () -test = cases - [] -> () -``` - -```unison:error -test : [()] -> () -test = cases - x +: xs -> () -``` - -```unison:error -test : [()] -> () -test = cases - xs :+ x -> () -``` - -```unison:error -test : [()] -> () -test = cases - x0 +: (x1 +: xs) -> () - [] -> () -``` - -```unison:error -test : [()] -> () -test = cases - [] -> () - x0 +: [] -> () -``` - -## Uninhabited - -`Cons` is not expected since `V` is uninhabited -```unison -unique type V = - -test : [V] -> () -test = cases - [] -> () -``` - -## Length restrictions can equate cons and nil patterns - -Here the first pattern matches lists of length two or greater, the -second pattern matches lists of length 0. The third case matches when the -final element is `false`, while the fourth pattern matches when the -first element is `true`. However, the only possible list length at -the third or fourth clause is 1, so the first and final element must -be equal. Thus, the pattern match is exhaustive. -```unison -test : [Boolean] -> () -test = cases - [a, b] ++ xs -> () - [] -> () - xs :+ false -> () - true +: xs -> () -``` - -This is the same idea as above but shows that fourth match is redundant. -```unison:error -test : [Boolean] -> () -test = cases - [a, b] ++ xs -> () - [] -> () - xs :+ true -> () - true +: xs -> () - _ -> () -``` - -This is another similar example. The first pattern matches lists of -length 5 or greater. The second matches lists of length 4 or greater where the -first and third element are true. The third matches lists of length 4 -or greater where the final 4 elements are `true, false, true, false`. -The list must be exactly of length 4 to arrive at the second or third -clause, so the third pattern is redundant. -```unison:error -test : [Boolean] -> () -test = cases - [a, b, c, d, f] ++ xs -> () - [true, _, true, _] ++ _ -> () - _ ++ [true, false, true, false] -> () - _ -> () -``` - -# bugfix: Sufficient data decl map - -```unison -unique type T = A - -unit2t : Unit -> T -unit2t = cases - () -> A -``` - -```ucm -scratch/main> add -``` - -Pattern coverage checking needs the data decl map to contain all -transitive type dependencies of the scrutinee type. We do this -before typechecking begins in a roundabout way: fetching all -transitive type dependencies of references that appear in the expression. - -This test ensures that we have fetched the `T` type although there is -no data decl reference to `T` in `witht`. -```unison -witht : Unit -witht = match unit2t () with - x -> () -``` - -```unison -unique type V = - -evil : Unit -> V -evil = bug "" -``` - -```ucm -scratch/main> add -``` - -```unison:error -withV : Unit -withV = match evil () with - x -> () -``` - -```unison -unique type SomeType = A -``` - -```ucm -scratch/main> add -``` - -```unison -unique type R = R SomeType - -get x = match x with - R y -> y -``` - -```unison -unique type R = { someType : SomeType } -``` - -# Ability handlers - -## Exhaustive ability handlers are accepted - -```unison -structural ability Abort where - abort : {Abort} a - - -result : '{e, Abort} a -> {e} a -result f = handle !f with cases - { x } -> x - { abort -> _ } -> bug "aborted" -``` - -```unison -structural ability Abort where - abort : {Abort} a - -unique type T = A | B - -result : '{e, Abort} T -> {e} () -result f = handle !f with cases - { A } -> () - { B } -> () - { abort -> _ } -> bug "aborted" -``` - -```unison -structural ability Abort where - abort : {Abort} a - -result : '{e, Abort} V -> {e} V -result f = - impl : Request {Abort} V -> V - impl = cases - { abort -> _ } -> bug "aborted" - handle !f with impl -``` - -```unison -structural ability Abort where - abort : {Abort} a - -structural ability Stream a where - emit : a -> {Stream a} Unit - -handleMulti : '{Stream a, Abort} r -> (Optional r, [a]) -handleMulti c = - impl xs = cases - { r } -> (Some r, xs) - { emit x -> resume } -> handle !resume with impl (xs :+ x) - { abort -> _ } -> (None, xs) - handle !c with impl [] -``` - -## Non-exhaustive ability handlers are rejected - -```unison:error -structural ability Abort where - abort : {Abort} a - abortWithMessage : Text -> {Abort} a - - -result : '{e, Abort} a -> {e} a -result f = handle !f with cases - { abort -> _ } -> bug "aborted" -``` - -```unison:error -structural ability Abort where - abort : {Abort} a - -unique type T = A | B - -result : '{e, Abort} T -> {e} () -result f = handle !f with cases - { A } -> () - { abort -> _ } -> bug "aborted" -``` - -```unison:error -unique ability Give a where - give : a -> {Give a} Unit - -unique type T = A | B - -result : '{e, Give T} r -> {e} r -result f = handle !f with cases - { x } -> x - { give A -> resume } -> result resume -``` - -```unison:error -structural ability Abort where - abort : {Abort} a - -structural ability Stream a where - emit : a -> {Stream a} Unit - -handleMulti : '{Stream a, Abort} r -> (Optional r, [a]) -handleMulti c = - impl : [a] -> Request {Stream a, Abort} r -> (Optional r, [a]) - impl xs = cases - { r } -> (Some r, xs) - { emit x -> resume } -> handle !resume with impl (xs :+ x) - handle !c with impl [] -``` - -## Redundant handler cases are rejected - -```unison:error -unique ability Give a where - give : a -> {Give a} Unit - -unique type T = A | B - -result : '{e, Give T} r -> {e} r -result f = handle !f with cases - { x } -> x - { give _ -> resume } -> result resume - { give A -> resume } -> result resume -``` - -## Exhaustive ability reinterpretations are accepted - -```unison -structural ability Abort where - abort : {Abort} a - abortWithMessage : Text -> {Abort} a - - -result : '{e, Abort} a -> {e, Abort} a -result f = handle !f with cases - { x } -> x - { abort -> _ } -> abort - { abortWithMessage msg -> _ } -> abortWithMessage ("aborting: " ++ msg) -``` - -```unison -structural ability Abort a where - abort : {Abort a} r - abortWithMessage : a -> {Abort a} r - -result : '{e, Abort V} a -> {e, Abort V} a -result f = - impl : Request {Abort V} r -> {Abort V} r - impl = cases - { x } -> x - { abort -> _ } -> abort - handle !f with impl -``` - -## Non-exhaustive ability reinterpretations are rejected - -```unison:error -structural ability Abort where - abort : {Abort} a - abortWithMessage : Text -> {Abort} a - - -result : '{e, Abort} a -> {e, Abort} a -result f = handle !f with cases - { x } -> x - { abortWithMessage msg -> _ } -> abortWithMessage ("aborting: " ++ msg) -``` - -## Hacky workaround for uninhabited abilities - -Although all of the constructors of an ability might be uninhabited, -the typechecker requires at least one be specified so that it can -determine that the ability should be discharged. So, the default -pattern match coverage checking behavior of prohibiting covering any -of the cases is problematic. Instead, the pattern match coverage -checker will require that at least one constructor be given, even if -they are all uninhabited. - -The messages here aren't the best, but I don't think uninhabited -abilities will come up and get handlers written for them often. - -```unison:error -unique ability Give a where - give : a -> {Give a} Unit - give2 : a -> {Give a} Unit - -result : '{e, Give V} r -> {e} r -result f = - impl : Request {Give V} r -> {} r - impl = cases - { x } -> x - handle !f with impl -``` - -```unison -unique ability Give a where - give : a -> {Give a} Unit - give2 : a -> {Give a} Unit - -result : '{e, Give V} r -> {e} r -result f = - impl : Request {Give V} r -> {} r - impl = cases - { x } -> x - { give _ -> resume } -> bug "impossible" - handle !f with impl -``` - -```unison -unique ability Give a where - give : a -> {Give a} Unit - give2 : a -> {Give a} Unit - -result : '{e, Give V} r -> {e} r -result f = - impl : Request {Give V} r -> {} r - impl = cases - { x } -> x - { give2 _ -> resume } -> bug "impossible" - handle !f with impl -``` - -```unison:error -unique ability Give a where - give : a -> {Give a} Unit - give2 : a -> {Give a} Unit - -result : '{e, Give V} r -> {e} r -result f = - impl : Request {Give V} r -> {} r - impl = cases - { x } -> x - { give _ -> resume } -> bug "impossible" - { give2 _ -> resume } -> bug "impossible" - handle !f with impl -``` - -```unison:error -unique ability GiveA a where - giveA : a -> {GiveA a} Unit - giveA2 : a -> {GiveA a} Unit - -unique ability GiveB a where - giveB : a -> {GiveB a} Unit - giveB2 : a -> {GiveB a} Unit - -result : '{e, GiveA V, GiveB V} r -> {e} r -result f = - impl : Request {GiveA V, GiveB V} r -> {} r - impl = cases - { x } -> x - { giveA _ -> _ } -> bug "impossible" - { giveA2 _ -> _ } -> bug "impossible" - { giveB _ -> _ } -> bug "impossible" - { giveB2 _ -> _ } -> bug "impossible" - handle !f with impl -``` - -```unison -unique ability GiveA a where - giveA : a -> {GiveA a} Unit - giveA2 : a -> {GiveA a} Unit - -unique ability GiveB a where - giveB : a -> {GiveB a} Unit - giveB2 : a -> {GiveB a} Unit - -result : '{e, GiveA V, GiveB V} r -> {e} r -result f = - impl : Request {GiveA V, GiveB V} r -> {} r - impl = cases - { x } -> x - { giveA2 _ -> _ } -> bug "impossible" - { giveB _ -> _ } -> bug "impossible" - handle !f with impl -``` diff --git a/unison-src/transcripts/pattern-match-coverage.output.md b/unison-src/transcripts/pattern-match-coverage.output.md deleted file mode 100644 index 575c35cab0..0000000000 --- a/unison-src/transcripts/pattern-match-coverage.output.md +++ /dev/null @@ -1,1340 +0,0 @@ -# Basics - -## non-exhaustive patterns - -``` unison -unique type T = A | B | C - -test : T -> () -test = cases - A -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - Pattern match doesn't cover all possible cases: - 4 | test = cases - 5 | A -> () - - - Patterns not matched: - - * B - * C - -``` -``` unison -unique type T = A | B - -test : (T, Optional T) -> () -test = cases - (A, Some _) -> () - (A, None) -> () - (B, Some A) -> () - (B, None) -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - Pattern match doesn't cover all possible cases: - 4 | test = cases - 5 | (A, Some _) -> () - 6 | (A, None) -> () - 7 | (B, Some A) -> () - 8 | (B, None) -> () - - - Patterns not matched: - * (B, Some B) - -``` -## redundant patterns - -``` unison -unique type T = A | B | C - -test : T -> () -test = cases - A -> () - B -> () - C -> () - _ -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - This case would be ignored because it's already covered by the preceding case(s): - 8 | _ -> () - - -``` -``` unison -unique type T = A | B - -test : (T, Optional T) -> () -test = cases - (A, Some _) -> () - (A, None) -> () - (B, Some _) -> () - (B, None) -> () - (A, Some A) -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - This case would be ignored because it's already covered by the preceding case(s): - 9 | (A, Some A) -> () - - -``` -# Uninhabited patterns - -match is complete without covering uninhabited patterns - -``` unison -unique type V = - -test : Optional (Optional V) -> () -test = cases - None -> () - Some None -> () -``` - -``` 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`: - - type V - test : Optional (Optional V) -> () - -``` -uninhabited patterns are reported as redundant - -``` unison -unique type V = - -test0 : V -> () -test0 = cases - _ -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - This case would be ignored because it's already covered by the preceding case(s): - 5 | _ -> () - - -``` -``` unison -unique type V = - -test : Optional (Optional V) -> () -test = cases - None -> () - Some None -> () - Some _ -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - This case would be ignored because it's already covered by the preceding case(s): - 7 | Some _ -> () - - -``` -# Guards - -## Incomplete patterns due to guards should be reported - -``` unison -test : () -> () -test = cases - () | false -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - Pattern match doesn't cover all possible cases: - 2 | test = cases - 3 | () | false -> () - - - Patterns not matched: - * () - -``` -``` unison -test : Optional Nat -> Nat -test = cases - None -> 0 - Some x - | isEven x -> x -``` - -``` ucm - - Loading changes detected in scratch.u. - - Pattern match doesn't cover all possible cases: - 2 | test = cases - 3 | None -> 0 - 4 | Some x - 5 | | isEven x -> x - - - Patterns not matched: - * Some _ - -``` -## Complete patterns with guards should be accepted - -``` unison -test : Optional Nat -> Nat -test = cases - None -> 0 - Some x - | isEven x -> x - | otherwise -> 0 -``` - -``` 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`: - - test : Optional Nat -> Nat - -``` -# Pattern instantiation depth - -Uncovered patterns are only instantiated as deeply as necessary to -distinguish them from existing patterns. - -``` unison -unique type T = A | B | C - -test : Optional (Optional T) -> () -test = cases - None -> () - Some None -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - Pattern match doesn't cover all possible cases: - 4 | test = cases - 5 | None -> () - 6 | Some None -> () - - - Patterns not matched: - * Some (Some _) - -``` -``` unison -unique type T = A | B | C - -test : Optional (Optional T) -> () -test = cases - None -> () - Some None -> () - Some (Some A) -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - Pattern match doesn't cover all possible cases: - 4 | test = cases - 5 | None -> () - 6 | Some None -> () - 7 | Some (Some A) -> () - - - Patterns not matched: - - * Some (Some B) - * Some (Some C) - -``` -# Literals - -## Non-exhaustive - -Nat - -``` unison -test : Nat -> () -test = cases - 0 -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - Pattern match doesn't cover all possible cases: - 2 | test = cases - 3 | 0 -> () - - - Patterns not matched: - * _ - -``` -Boolean - -``` unison -test : Boolean -> () -test = cases - true -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - Pattern match doesn't cover all possible cases: - 2 | test = cases - 3 | true -> () - - - Patterns not matched: - * false - -``` -## Exhaustive - -Nat - -``` unison -test : Nat -> () -test = cases - 0 -> () - _ -> () -``` - -``` 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`: - - test : Nat -> () - -``` -Boolean - -``` unison -test : Boolean -> () -test = cases - true -> () - false -> () -``` - -``` 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`: - - test : Boolean -> () - -``` -# Redundant - -Nat - -``` unison -test : Nat -> () -test = cases - 0 -> () - 0 -> () - _ -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - This case would be ignored because it's already covered by the preceding case(s): - 4 | 0 -> () - - -``` -Boolean - -``` unison -test : Boolean -> () -test = cases - true -> () - false -> () - _ -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - This case would be ignored because it's already covered by the preceding case(s): - 5 | _ -> () - - -``` -# Sequences - -## Exhaustive - -``` unison -test : [()] -> () -test = cases - [] -> () - x +: xs -> () -``` - -``` 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`: - - test : [()] -> () - -``` -## Non-exhaustive - -``` unison -test : [()] -> () -test = cases - [] -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - Pattern match doesn't cover all possible cases: - 2 | test = cases - 3 | [] -> () - - - Patterns not matched: - * (() +: _) - -``` -``` unison -test : [()] -> () -test = cases - x +: xs -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - Pattern match doesn't cover all possible cases: - 2 | test = cases - 3 | x +: xs -> () - - - Patterns not matched: - * [] - -``` -``` unison -test : [()] -> () -test = cases - xs :+ x -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - Pattern match doesn't cover all possible cases: - 2 | test = cases - 3 | xs :+ x -> () - - - Patterns not matched: - * [] - -``` -``` unison -test : [()] -> () -test = cases - x0 +: (x1 +: xs) -> () - [] -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - Pattern match doesn't cover all possible cases: - 2 | test = cases - 3 | x0 +: (x1 +: xs) -> () - 4 | [] -> () - - - Patterns not matched: - * (() +: []) - -``` -``` unison -test : [()] -> () -test = cases - [] -> () - x0 +: [] -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - Pattern match doesn't cover all possible cases: - 2 | test = cases - 3 | [] -> () - 4 | x0 +: [] -> () - - - Patterns not matched: - * (() +: (() +: _)) - -``` -## Uninhabited - -`Cons` is not expected since `V` is uninhabited - -``` unison -unique type V = - -test : [V] -> () -test = cases - [] -> () -``` - -``` 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`: - - type V - test : [V] -> () - -``` -## Length restrictions can equate cons and nil patterns - -Here the first pattern matches lists of length two or greater, the -second pattern matches lists of length 0. The third case matches when the -final element is `false`, while the fourth pattern matches when the -first element is `true`. However, the only possible list length at -the third or fourth clause is 1, so the first and final element must -be equal. Thus, the pattern match is exhaustive. - -``` unison -test : [Boolean] -> () -test = cases - [a, b] ++ xs -> () - [] -> () - xs :+ false -> () - true +: xs -> () -``` - -``` 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`: - - test : [Boolean] -> () - -``` -This is the same idea as above but shows that fourth match is redundant. - -``` unison -test : [Boolean] -> () -test = cases - [a, b] ++ xs -> () - [] -> () - xs :+ true -> () - true +: xs -> () - _ -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - This case would be ignored because it's already covered by the preceding case(s): - 6 | true +: xs -> () - - -``` -This is another similar example. The first pattern matches lists of -length 5 or greater. The second matches lists of length 4 or greater where the -first and third element are true. The third matches lists of length 4 -or greater where the final 4 elements are `true, false, true, false`. -The list must be exactly of length 4 to arrive at the second or third -clause, so the third pattern is redundant. - -``` unison -test : [Boolean] -> () -test = cases - [a, b, c, d, f] ++ xs -> () - [true, _, true, _] ++ _ -> () - _ ++ [true, false, true, false] -> () - _ -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - This case would be ignored because it's already covered by the preceding case(s): - 5 | _ ++ [true, false, true, false] -> () - - -``` -# bugfix: Sufficient data decl map - -``` unison -unique type T = A - -unit2t : Unit -> T -unit2t = cases - () -> A -``` - -``` 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`: - - type T - unit2t : 'T - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type T - unit2t : 'T - -``` -Pattern coverage checking needs the data decl map to contain all -transitive type dependencies of the scrutinee type. We do this -before typechecking begins in a roundabout way: fetching all -transitive type dependencies of references that appear in the expression. - -This test ensures that we have fetched the `T` type although there is -no data decl reference to `T` in `witht`. - -``` unison -witht : Unit -witht = match unit2t () with - x -> () -``` - -``` 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`: - - witht : () - -``` -``` unison -unique type V = - -evil : Unit -> V -evil = bug "" -``` - -``` 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`: - - type V - evil : 'V - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type V - evil : 'V - -``` -``` unison -withV : Unit -withV = match evil () with - x -> () -``` - -``` ucm - - Loading changes detected in scratch.u. - - This case would be ignored because it's already covered by the preceding case(s): - 3 | x -> () - - -``` -``` unison -unique type SomeType = A -``` - -``` 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`: - - type SomeType - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type SomeType - -``` -``` unison -unique type R = R SomeType - -get x = match x with - R y -> y -``` - -``` 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`: - - type R - get : R -> SomeType - -``` -``` unison -unique type R = { someType : SomeType } -``` - -``` 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`: - - type R - R.someType : R -> SomeType - R.someType.modify : (SomeType ->{g} SomeType) -> R ->{g} R - R.someType.set : SomeType -> R -> R - -``` -# Ability handlers - -## Exhaustive ability handlers are accepted - -``` unison -structural ability Abort where - abort : {Abort} a - - -result : '{e, Abort} a -> {e} a -result f = handle !f with cases - { x } -> x - { abort -> _ } -> bug "aborted" -``` - -``` 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`: - - structural ability Abort - result : '{e, Abort} a ->{e} a - -``` -``` unison -structural ability Abort where - abort : {Abort} a - -unique type T = A | B - -result : '{e, Abort} T -> {e} () -result f = handle !f with cases - { A } -> () - { B } -> () - { abort -> _ } -> bug "aborted" -``` - -``` 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`: - - structural ability Abort - result : '{e, Abort} T ->{e} () - - ⍟ These names already exist. You can `update` them to your - new definition: - - type T - -``` -``` unison -structural ability Abort where - abort : {Abort} a - -result : '{e, Abort} V -> {e} V -result f = - impl : Request {Abort} V -> V - impl = cases - { abort -> _ } -> bug "aborted" - handle !f with impl -``` - -``` 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`: - - structural ability Abort - result : '{e, Abort} V ->{e} V - -``` -``` unison -structural ability Abort where - abort : {Abort} a - -structural ability Stream a where - emit : a -> {Stream a} Unit - -handleMulti : '{Stream a, Abort} r -> (Optional r, [a]) -handleMulti c = - impl xs = cases - { r } -> (Some r, xs) - { emit x -> resume } -> handle !resume with impl (xs :+ x) - { abort -> _ } -> (None, xs) - handle !c with impl [] -``` - -``` 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`: - - structural ability Abort - structural ability Stream a - handleMulti : '{Abort, Stream a} r -> (Optional r, [a]) - -``` -## Non-exhaustive ability handlers are rejected - -``` unison -structural ability Abort where - abort : {Abort} a - abortWithMessage : Text -> {Abort} a - - -result : '{e, Abort} a -> {e} a -result f = handle !f with cases - { abort -> _ } -> bug "aborted" -``` - -``` ucm - - Loading changes detected in scratch.u. - - Pattern match doesn't cover all possible cases: - 7 | result f = handle !f with cases - 8 | { abort -> _ } -> bug "aborted" - - - Patterns not matched: - - * { _ } - * { abortWithMessage _ -> _ } - -``` -``` unison -structural ability Abort where - abort : {Abort} a - -unique type T = A | B - -result : '{e, Abort} T -> {e} () -result f = handle !f with cases - { A } -> () - { abort -> _ } -> bug "aborted" -``` - -``` ucm - - Loading changes detected in scratch.u. - - Pattern match doesn't cover all possible cases: - 7 | result f = handle !f with cases - 8 | { A } -> () - 9 | { abort -> _ } -> bug "aborted" - - - Patterns not matched: - * { B } - -``` -``` unison -unique ability Give a where - give : a -> {Give a} Unit - -unique type T = A | B - -result : '{e, Give T} r -> {e} r -result f = handle !f with cases - { x } -> x - { give A -> resume } -> result resume -``` - -``` ucm - - Loading changes detected in scratch.u. - - Pattern match doesn't cover all possible cases: - 7 | result f = handle !f with cases - 8 | { x } -> x - 9 | { give A -> resume } -> result resume - - - Patterns not matched: - * { give B -> _ } - -``` -``` unison -structural ability Abort where - abort : {Abort} a - -structural ability Stream a where - emit : a -> {Stream a} Unit - -handleMulti : '{Stream a, Abort} r -> (Optional r, [a]) -handleMulti c = - impl : [a] -> Request {Stream a, Abort} r -> (Optional r, [a]) - impl xs = cases - { r } -> (Some r, xs) - { emit x -> resume } -> handle !resume with impl (xs :+ x) - handle !c with impl [] -``` - -``` ucm - - Loading changes detected in scratch.u. - - Pattern match doesn't cover all possible cases: - 10 | impl xs = cases - 11 | { r } -> (Some r, xs) - 12 | { emit x -> resume } -> handle !resume with impl (xs :+ x) - - - Patterns not matched: - * { abort -> _ } - -``` -## Redundant handler cases are rejected - -``` unison -unique ability Give a where - give : a -> {Give a} Unit - -unique type T = A | B - -result : '{e, Give T} r -> {e} r -result f = handle !f with cases - { x } -> x - { give _ -> resume } -> result resume - { give A -> resume } -> result resume -``` - -``` ucm - - Loading changes detected in scratch.u. - - This case would be ignored because it's already covered by the preceding case(s): - 10 | { give A -> resume } -> result resume - - -``` -## Exhaustive ability reinterpretations are accepted - -``` unison -structural ability Abort where - abort : {Abort} a - abortWithMessage : Text -> {Abort} a - - -result : '{e, Abort} a -> {e, Abort} a -result f = handle !f with cases - { x } -> x - { abort -> _ } -> abort - { abortWithMessage msg -> _ } -> abortWithMessage ("aborting: " ++ msg) -``` - -``` 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`: - - structural ability Abort - result : '{e, Abort} a ->{e, Abort} a - -``` -``` unison -structural ability Abort a where - abort : {Abort a} r - abortWithMessage : a -> {Abort a} r - -result : '{e, Abort V} a -> {e, Abort V} a -result f = - impl : Request {Abort V} r -> {Abort V} r - impl = cases - { x } -> x - { abort -> _ } -> abort - handle !f with impl -``` - -``` 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`: - - structural ability Abort a - result : '{e, Abort V} a ->{e, Abort V} a - -``` -## Non-exhaustive ability reinterpretations are rejected - -``` unison -structural ability Abort where - abort : {Abort} a - abortWithMessage : Text -> {Abort} a - - -result : '{e, Abort} a -> {e, Abort} a -result f = handle !f with cases - { x } -> x - { abortWithMessage msg -> _ } -> abortWithMessage ("aborting: " ++ msg) -``` - -``` ucm - - Loading changes detected in scratch.u. - - Pattern match doesn't cover all possible cases: - 7 | result f = handle !f with cases - 8 | { x } -> x - 9 | { abortWithMessage msg -> _ } -> abortWithMessage ("aborting: " ++ msg) - - - Patterns not matched: - * { abort -> _ } - -``` -## Hacky workaround for uninhabited abilities - -Although all of the constructors of an ability might be uninhabited, -the typechecker requires at least one be specified so that it can -determine that the ability should be discharged. So, the default -pattern match coverage checking behavior of prohibiting covering any -of the cases is problematic. Instead, the pattern match coverage -checker will require that at least one constructor be given, even if -they are all uninhabited. - -The messages here aren't the best, but I don't think uninhabited -abilities will come up and get handlers written for them often. - -``` unison -unique ability Give a where - give : a -> {Give a} Unit - give2 : a -> {Give a} Unit - -result : '{e, Give V} r -> {e} r -result f = - impl : Request {Give V} r -> {} r - impl = cases - { x } -> x - handle !f with impl -``` - -``` ucm - - Loading changes detected in scratch.u. - - Pattern match doesn't cover all possible cases: - 8 | impl = cases - 9 | { x } -> x - - - Patterns not matched: - - * { give _ -> _ } - * { give2 _ -> _ } - -``` -``` unison -unique ability Give a where - give : a -> {Give a} Unit - give2 : a -> {Give a} Unit - -result : '{e, Give V} r -> {e} r -result f = - impl : Request {Give V} r -> {} r - impl = cases - { x } -> x - { give _ -> resume } -> bug "impossible" - handle !f with impl -``` - -``` 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`: - - ability Give a - result : '{e, Give V} r ->{e} r - -``` -``` unison -unique ability Give a where - give : a -> {Give a} Unit - give2 : a -> {Give a} Unit - -result : '{e, Give V} r -> {e} r -result f = - impl : Request {Give V} r -> {} r - impl = cases - { x } -> x - { give2 _ -> resume } -> bug "impossible" - handle !f with impl -``` - -``` 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`: - - ability Give a - result : '{e, Give V} r ->{e} r - -``` -``` unison -unique ability Give a where - give : a -> {Give a} Unit - give2 : a -> {Give a} Unit - -result : '{e, Give V} r -> {e} r -result f = - impl : Request {Give V} r -> {} r - impl = cases - { x } -> x - { give _ -> resume } -> bug "impossible" - { give2 _ -> resume } -> bug "impossible" - handle !f with impl -``` - -``` ucm - - Loading changes detected in scratch.u. - - This case would be ignored because it's already covered by the preceding case(s): - 11 | { give2 _ -> resume } -> bug "impossible" - - -``` -``` unison -unique ability GiveA a where - giveA : a -> {GiveA a} Unit - giveA2 : a -> {GiveA a} Unit - -unique ability GiveB a where - giveB : a -> {GiveB a} Unit - giveB2 : a -> {GiveB a} Unit - -result : '{e, GiveA V, GiveB V} r -> {e} r -result f = - impl : Request {GiveA V, GiveB V} r -> {} r - impl = cases - { x } -> x - { giveA _ -> _ } -> bug "impossible" - { giveA2 _ -> _ } -> bug "impossible" - { giveB _ -> _ } -> bug "impossible" - { giveB2 _ -> _ } -> bug "impossible" - handle !f with impl -``` - -``` ucm - - Loading changes detected in scratch.u. - - This case would be ignored because it's already covered by the preceding case(s): - 15 | { giveA2 _ -> _ } -> bug "impossible" - - -``` -``` unison -unique ability GiveA a where - giveA : a -> {GiveA a} Unit - giveA2 : a -> {GiveA a} Unit - -unique ability GiveB a where - giveB : a -> {GiveB a} Unit - giveB2 : a -> {GiveB a} Unit - -result : '{e, GiveA V, GiveB V} r -> {e} r -result f = - impl : Request {GiveA V, GiveB V} r -> {} r - impl = cases - { x } -> x - { giveA2 _ -> _ } -> bug "impossible" - { giveB _ -> _ } -> bug "impossible" - handle !f with impl -``` - -``` 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`: - - ability GiveA a - ability GiveB a - result : '{e, GiveA V, GiveB V} r ->{e} r - -``` diff --git a/unison-src/transcripts/pattern-pretty-print-2345.md b/unison-src/transcripts/pattern-pretty-print-2345.md deleted file mode 100644 index 8728aa4d83..0000000000 --- a/unison-src/transcripts/pattern-pretty-print-2345.md +++ /dev/null @@ -1,85 +0,0 @@ -Regression test for https://github.com/unisonweb/unison/pull/2377 - - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -structural ability Ab where - a: Nat -> () - -dopey = cases - ?0 -> () - _ -> () - -grumpy = cases - d -> () - -happy = cases - true -> () - false -> () - -sneezy = cases - +1 -> () - _ -> () - -bashful = cases - Some a -> () - _ -> () - -mouthy = cases - [] -> () - _ -> () - -pokey = cases - h +: t -> () - _ -> () - -sleepy = cases - i :+ l -> () - _ -> () - -demure = cases - [0] -> () - _ -> () - -angry = cases - a ++ [] -> () - -tremulous = cases - (0,1) -> () - _ -> () - -throaty = cases - { Ab.a a -> k } -> () - { _ } -> () - -agitated = cases - a | a == 2 -> () - _ -> () - -doc = cases - y@4 -> () - _ -> () -``` - -```ucm -scratch/main> add -scratch/main> view dopey -scratch/main> view grumpy -scratch/main> view happy -scratch/main> view sneezy -scratch/main> view bashful -scratch/main> view mouthy -scratch/main> view pokey -scratch/main> view sleepy -scratch/main> view demure -scratch/main> view angry -scratch/main> view tremulous -scratch/main> view throaty -scratch/main> view agitated -scratch/main> view doc - -``` - diff --git a/unison-src/transcripts/pattern-pretty-print-2345.output.md b/unison-src/transcripts/pattern-pretty-print-2345.output.md deleted file mode 100644 index 7112974125..0000000000 --- a/unison-src/transcripts/pattern-pretty-print-2345.output.md +++ /dev/null @@ -1,204 +0,0 @@ -Regression test for https://github.com/unisonweb/unison/pull/2377 - -``` unison -structural ability Ab where - a: Nat -> () - -dopey = cases - ?0 -> () - _ -> () - -grumpy = cases - d -> () - -happy = cases - true -> () - false -> () - -sneezy = cases - +1 -> () - _ -> () - -bashful = cases - Some a -> () - _ -> () - -mouthy = cases - [] -> () - _ -> () - -pokey = cases - h +: t -> () - _ -> () - -sleepy = cases - i :+ l -> () - _ -> () - -demure = cases - [0] -> () - _ -> () - -angry = cases - a ++ [] -> () - -tremulous = cases - (0,1) -> () - _ -> () - -throaty = cases - { Ab.a a -> k } -> () - { _ } -> () - -agitated = cases - a | a == 2 -> () - _ -> () - -doc = cases - y@4 -> () - _ -> () -``` - -``` 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`: - - structural ability Ab - agitated : Nat -> () - angry : [t] -> () - bashful : Optional a -> () - demure : [Nat] -> () - doc : Nat -> () - dopey : Char -> () - grumpy : ff284oqf651 -> () - happy : Boolean -> () - mouthy : [t] -> () - pokey : [t] -> () - sleepy : [t] -> () - sneezy : Int -> () - throaty : Request {g, Ab} x -> () - tremulous : (Nat, Nat) -> () - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - structural ability Ab - agitated : Nat -> () - angry : [t] -> () - bashful : Optional a -> () - demure : [Nat] -> () - doc : Nat -> () - dopey : Char -> () - grumpy : ff284oqf651 -> () - happy : Boolean -> () - mouthy : [t] -> () - pokey : [t] -> () - sleepy : [t] -> () - sneezy : Int -> () - throaty : Request {g, Ab} x -> () - tremulous : (Nat, Nat) -> () - -scratch/main> view dopey - - dopey : Char -> () - dopey = cases - ?0 -> () - _ -> () - -scratch/main> view grumpy - - grumpy : ff284oqf651 -> () - grumpy = cases d -> () - -scratch/main> view happy - - happy : Boolean -> () - happy = cases - true -> () - false -> () - -scratch/main> view sneezy - - sneezy : Int -> () - sneezy = cases - +1 -> () - _ -> () - -scratch/main> view bashful - - bashful : Optional a -> () - bashful = cases - Some a -> () - _ -> () - -scratch/main> view mouthy - - mouthy : [t] -> () - mouthy = cases - [] -> () - _ -> () - -scratch/main> view pokey - - pokey : [t] -> () - pokey = cases - h +: t -> () - _ -> () - -scratch/main> view sleepy - - sleepy : [t] -> () - sleepy = cases - i :+ l -> () - _ -> () - -scratch/main> view demure - - demure : [Nat] -> () - demure = cases - [0] -> () - _ -> () - -scratch/main> view angry - - angry : [t] -> () - angry = cases a ++ [] -> () - -scratch/main> view tremulous - - tremulous : (Nat, Nat) -> () - tremulous = cases - (0, 1) -> () - _ -> () - -scratch/main> view throaty - - throaty : Request {g, Ab} x -> () - throaty = cases - { Ab.a a -> k } -> () - { _ } -> () - -scratch/main> view agitated - - agitated : Nat -> () - agitated = cases - a | a == 2 -> () - _ -> () - -scratch/main> view doc - - doc : Nat -> () - doc = cases - y@4 -> () - _ -> () - -``` diff --git a/unison-src/transcripts/patternMatchTls.md b/unison-src/transcripts/patternMatchTls.md deleted file mode 100644 index dbd8510716..0000000000 --- a/unison-src/transcripts/patternMatchTls.md +++ /dev/null @@ -1,34 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -We had bugs in the calling conventions for both send and terminate which would -cause pattern matching on the resulting (Right ()) would cause a runtime error. - - - -```unison -use builtin.io2.Tls newClient send handshake terminate - -frank: '{IO} () -frank = do - socket = assertRight (clientSocket.impl "example.com" "443") - config = ClientConfig.default "example.com" 0xs - tls = assertRight (newClient.impl config socket) - () = assertRight (handshake.impl tls) - () = assertRight (send.impl tls 0xs) - () = assertRight (terminate.impl tls) - () - -assertRight : Either a b -> b -assertRight = cases - Right x -> x - Left _ -> bug "expected a right but got a left" -``` - - - -```ucm -scratch/main> add -scratch/main> run frank -``` diff --git a/unison-src/transcripts/patternMatchTls.output.md b/unison-src/transcripts/patternMatchTls.output.md deleted file mode 100644 index 1e6e9ced27..0000000000 --- a/unison-src/transcripts/patternMatchTls.output.md +++ /dev/null @@ -1,49 +0,0 @@ -We had bugs in the calling conventions for both send and terminate which would -cause pattern matching on the resulting (Right ()) would cause a runtime error. - -``` unison -use builtin.io2.Tls newClient send handshake terminate - -frank: '{IO} () -frank = do - socket = assertRight (clientSocket.impl "example.com" "443") - config = ClientConfig.default "example.com" 0xs - tls = assertRight (newClient.impl config socket) - () = assertRight (handshake.impl tls) - () = assertRight (send.impl tls 0xs) - () = assertRight (terminate.impl tls) - () - -assertRight : Either a b -> b -assertRight = cases - Right x -> x - Left _ -> bug "expected a right but got a left" -``` - -``` 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`: - - assertRight : Either a b -> b - frank : '{IO} () - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - assertRight : Either a b -> b - frank : '{IO} () - -scratch/main> run frank - - () - -``` diff --git a/unison-src/transcripts/patterns.md b/unison-src/transcripts/patterns.md deleted file mode 100644 index 8eb309ad75..0000000000 --- a/unison-src/transcripts/patterns.md +++ /dev/null @@ -1,12 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -Some tests of pattern behavior. - -```unison -p1 = join [literal "blue", literal "frog"] - -> Pattern.run (many p1) "bluefrogbluegoat" -> Pattern.run (many.corrected p1) "bluefrogbluegoat" -``` diff --git a/unison-src/transcripts/patterns.output.md b/unison-src/transcripts/patterns.output.md deleted file mode 100644 index f68423848f..0000000000 --- a/unison-src/transcripts/patterns.output.md +++ /dev/null @@ -1,33 +0,0 @@ -Some tests of pattern behavior. - -``` unison -p1 = join [literal "blue", literal "frog"] - -> Pattern.run (many p1) "bluefrogbluegoat" -> Pattern.run (many.corrected p1) "bluefrogbluegoat" -``` - -``` 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`: - - p1 : Pattern Text - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 3 | > Pattern.run (many p1) "bluefrogbluegoat" - ⧩ - Some ([], "goat") - - 4 | > Pattern.run (many.corrected p1) "bluefrogbluegoat" - ⧩ - Some ([], "bluegoat") - -``` diff --git a/unison-src/transcripts/project-outputs/.github/ISSUE_TEMPLATE/bug_report.output.md b/unison-src/transcripts/project-outputs/.github/ISSUE_TEMPLATE/bug_report.output.md new file mode 100644 index 0000000000..287ba0bb94 --- /dev/null +++ b/unison-src/transcripts/project-outputs/.github/ISSUE_TEMPLATE/bug_report.output.md @@ -0,0 +1,35 @@ +----- + +name: Bug report +about: Create a report to help us improve +title: '' +labels: bug +assignees: '' + +----- + +**Describe and demonstrate the bug** +This should be written as a [ucm transcript](https://www.unison-lang.org/docs/tooling/transcripts/) if possible, calling out the unexpected behavior in the text. e.g. + +``` unison :hide +a = 1 +``` + +Here I typo the next command and `ucm` silently does nothing, I would have expected an error message: + +``` ucm +scratch/main> add b + +``` + +**Screenshots** +If applicable, add screenshots to help explain your problem. + +**Environment (please complete the following information):** + + - `ucm --version` \[e.g. "0.5.21", or "1cb2437 (built on 2024-06-03)"\] + - OS/Architecture: \[e.g. "macOS 14.5, Intel"\] + - Browser, if applicable: \[e.g. "chrome 125.0.6422.142"\] (Version numbers are typically found the about menu option) + +**Additional context** +Add any other context about the problem here. diff --git a/unison-src/transcripts/project-outputs/.github/pull_request_template.output.md b/unison-src/transcripts/project-outputs/.github/pull_request_template.output.md new file mode 100644 index 0000000000..4a02905b24 --- /dev/null +++ b/unison-src/transcripts/project-outputs/.github/pull_request_template.output.md @@ -0,0 +1,32 @@ +**Choose your PR title well:** Your pull request title is what's used to create release notes, so please make it descriptive of the change itself, which may be different from the initial motivation to make the change. + +## Overview + +What does this change accomplish and why? +i.e. How does it change the user experience? +i.e. What was the old behavior/API and what is the new behavior/API? + +Feel free to include "before and after" examples if appropriate. (You can copy/paste screenshots directly into this editor.) + +If relevant, which Github issues does it close? (See [closing-issues-using-keywords](https://help.github.com/en/enterprise/2.16/user/github/managing-your-work-on-github/closing-issues-using-keywords).) + +## Implementation notes + +How does it accomplish it, in broad strokes? i.e. How does it change the Haskell codebase? + +## Interesting/controversial decisions + +Include anything that you thought twice about, debated, chose arbitrarily, etc. +What could have been done differently, but wasn't? And why? + +## Test coverage + +Have you included tests (which could be a transcript) for this change, or is it somehow covered by existing tests? + +Would you recommend improving the test coverage (either as part of this PR or as a separate issue) or do you think it’s adequate? + +If you only tested by hand, because that's all that's practical to do for this change, mention that. + +## Loose ends + +Link to related issues that address things you didn't get to. Stuff you encountered on the way and decided not to include in this PR. diff --git a/unison-src/transcripts/project-outputs/docs/ability-typechecking.output.md b/unison-src/transcripts/project-outputs/docs/ability-typechecking.output.md new file mode 100644 index 0000000000..9d8b398604 --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/ability-typechecking.output.md @@ -0,0 +1,81 @@ +Brief document discussing Unison's algebraic effects. + + - The type `a ->{IO} b` type is a function from `a` to `b`, which requires the `IO` ability. The `{}` should be thought of as being attached to the `->`. + - The `{}` syntax can contain any number of comma separated types, like `a ->{IO, Abort, State Nat} b`. We call the `{}` list the "required abilities" of the function. + - Within an abilities list, type variables like `{e1, e2}` can be instantiated to sets of abilities, so we should think of the `{}` as just taking the union of all the sets contained therein. `IO` within `{IO}` is really the singleton set. + - Unison's typechecker prevents calling a function whose required abilities aren't available in the currrent expression. We say that at each subexpression of the program, there's an *ambient* set of abilities available, and when calling a function `f : a ->{e1,e2} b`, the ambient abilities must be at least as big as as `{e1, e2}` (according to the subtyping judgement). Verifying that these requested abilities are available is called an "ability check". + - The ambient abilities at a subterm is defined to be equal to the required abilities on the type of the *nearest enclosing lambda*. For instance, within the body of a lambda of type `a ->{Remote} b`, `{Remote}` is the ambient set. + - Okay the above isn't quite right because `handle` blocks prepend new abilities to the ambient based on the abilities that the handler eliminates. So a handler `h : Request {IO} a -> b` will grant access to `IO` within the `body` of `handle h in body`. So the ambient set is really the required abilities on the type of the nearest enclosing lambda, plus the abilities eliminated by enclosing handlers. + +Here are a few examples: + +``` haskell +foo : Text ->{} () +foo name = IO.printLine ("Hello, " ++ name) +``` + +Triggers an ability check failure, since the nearest enclosing lambda requires `{}`, the empty set of abilities. Therefore the body of that lambda doesn't have access to `IO`. + +``` haskell +foo2 : Text ->{IO} Text ->{} () +foo2 name1 name = IO.printLine ("Hello, " ++ name) +``` + +This also triggers an ability check failure. The inner lambda still requires only `{}` and we don't get access to abilities required by outer lambdas. This would be unsound (you could partially apply the function, then obtain a function with a smaller abilities requirement than what it actually used). + +This would work: + +``` haskell +foo2 : Text ->{IO} Text ->{} () +foo2 name1 = + IO.printLine ("Hello, " ++ name1) + name -> () +``` + +Notice that we get access to `IO` after just the first argument is supplied. The lambda we return though can't use `IO`. + +TODO: handle blocks + +## Type annotations and ability inference + +The type of the nearest enclosing lambda and therefore the ambient set can't always be known in advance, if the user hasn't provided type annotations. In this case, we invent an existential type parameter for the ambient set and allow the existential to be refined by the normal ability checks. + +I realized it's not sound to do Frank-style effect generalization after typechecking and have a different proposal instead. For instance, suppose we have the function: + +``` haskell +map : (a -> b) -> [a] -> [b] +``` + +Which we typecheck and then afterwards generalize to: + +``` haskell +map : (a ->{e} b) -> [a] ->{e} [b] +``` + +Except, what if that function `a ->{e} b` were actually being passed (within the body of `map`) to some other function that was expecting an `a ->{} b`? We can't just generalize this willy nilly, we actually need to typecheck with the enriched type. + +So I propose the following: + + - The type `a -> b` means `a ->{e} b` for some existential `e` to be inferrered by Unison. It doesn't mean `forall e . a ->{e} b` or `a ->{} b`. + - And as before: + - The type `a ->{} b` means a function with no required abilities, AKA a pure function + - The type `a ->{e} b` means a function with exactly `e` as its required abilities + +So, the `map` function, assuming it were implemented in an ability-polymorphic way, would get the signature: + +``` haskell +map : (a ->{e} b) -> [a] ->{e} [b] +``` + +This would be the type it would get if inferred, or if the user provided the signature `(a -> b) -> [a] -> [b]` to the function, it would note this elaborated type for the user (and possibly link to some docs about what this means). + +This is sound and should work fine. It has the benefit of being highly nonmagical. I think it could also good for teaching about abilities: one can write "simple" type signatures and have them be elaborated automatically, which builds some familiarity. A downside is that the user will see more ability type variables. But maybe that's a feature, not a bug. + +A couple usability improvements can elide ability type variables in various cases: + + - When displaying a type signature, we can elide any ability type variables that are mentioned just once by the type (as in `forall e . Nat ->{e} Nat`). If the variable is mentioned more than once in the signature, we include it, since it's adding useful information about what the function does and how it works. A principle here is that it's okay to eliminate informtaion from an arrow `a ->{e} b` and show that as `a -> b` if the user can use that as an `a ->{e} b` for any choice of `e`, including `{}`. + - Another possible usability thing that's maybe more questionable, eliminate any empty `{}` that aren't to the left of an `->`. So for instance `Nat ->{} Nat ->{} Text` would display as just `Nat -> Nat -> Text`, but like `(a ->{} b) -> blah` would still display as `(a ->{} b) -> blah` since the `{}` appear to the left of an `->`. + +### Question + +Given the above, wow do we decide when a type signature is redundant, for purposes of determining whether to store that signature along with the type? diff --git a/unison-src/transcripts/project-outputs/docs/adding-builtins.output.md b/unison-src/transcripts/project-outputs/docs/adding-builtins.output.md new file mode 100644 index 0000000000..4a5029f870 --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/adding-builtins.output.md @@ -0,0 +1,236 @@ +This document explains how to add builtins to the language by working +through the example of adding `MVar` and some associated functions. + +## Builtin Data + +The logical first step for this example is to add a built-in `MVar` +type, whose values will simply be wrapped values of the Haskell type +with the same name. The 'old' runtime deviates from this approach for +several types, but this is how e.g. `Text` works even there. + +Data types, including opaque pseudo data types of this sort are +referred to by `Reference`. Builtin, opaque data types use the +`Builtin` constructor with an appropriate name. The ones in actual +use are listed in the `Unison.Type` module, so we'll add a definition +there: + +``` haskell +mvarRef :: Reference +mvarRef = Reference.Builtin "MVar" +``` + +This definition alone won't do anything, however. It is merely +something for other definitions to refer to. If the reference is used +in e.g. the type of a function definitions without giving it an actual +name in the codebase, the type will be displayed with the raw hash, +which looks like `#MVar`. + +The builtin reference can be given a name during the `builtins.merge` +ucm command. To make this happen, we must modify the `builtinTypesSrc` +definition in the `Unison.Builtin` module. This is just a list of +values that describe various builtin type related actions to be +performed during that command. In this case, we will add two values to +the list: + +``` haskell +B' "MVar" CT.Data +``` + +This specifies that there should be a builtin data type referring to +the `Builtin "MVar"` reference. The codebase name assigned to this is +the same as the reference (MVar here), but nested in the `builtin` +namespace. However, we will also add the value: + +``` haskell +Rename' "MVar" "io2.MVar" +``` + +because this is a type to be used with the new IO functions, which are +currently nested under the `io2` namespace. With both of these added +to the list, running `builtins.merge` should have a `builtin.io2.MVar` +type referring to the `Builtin "MVar"` reference. + +The reason for both a `B'` and a `Rename'` is that eventually one +would expect the IO functionality to be moved from the `io2` +namespace. However, the builtin reference name may not be changed +easily, so it is preferable to have it named in the eventual expected +way, rather than permanently named `io2.MVar` internally. + +## Builtin function declarations + +The next step is to declare builtin functions that make use of the new +type. These are declared in a similar way to the type names above. +There is another list in `Unison.Builtin`, `builtinsSrc`, that defines +values specifying what builtin functions should exist. + +Like the builtin type list, there are declarations for adding a +builtin function with a given name, and declarations for renaming from +the given name to a different namespace location. For the `MVar` +functions, we'll again give them their intended names as the original, +and rename them to the `io2` namespace for the time being. + +Builtin functions also have an associated type as part of the initial +declaration. So for the complete specification of a function, we will +add declarations similar to: + +``` haskell +B "MVar.new" $ forall1 "a" (\a -> a --> io (mvar a)) +Rename "MVar.new" "io2.MVar.new" +B "MVar.take" $ forall1 "a" (\a -> mvar a --> iof a) +Rename "MVar.take" "io2.MVar.take" +``` + +The `forall1`, `io`, `iof` and `-->` functions are local definitions +in `Unison.Builtin` for assistance in writing the types. `iof` +indicates that an error result may be returned, while `io` should +always succeed. Note that when the `{IO}` ability appears as a type +parameter rather than the return type of a function, you will need to +use `iot` instead. +`mvar` can be defined locally using some other +helpers in scope: + +``` haskell +mvar :: Type -> Type +mvar a = Type.ref () Type.mvarRef `app` a +``` + +For the actual `MVar` implementation, we'll be doing many definitions +followed by renames, so it'll be factored into a list of the name and +type, and we can then call the `moveUnder` helper to generate the `B` +declaration and the `Rename`. + +## Builtin function implementation -- new runtime + +What we have done so far only declares the functions and their types. +There is nothing yet implementing them. This section will proceed +through the implementation backing the declarations of the `MVar.new` +and `MVar.take` above. + +In this case, we will implement the operations using the 'foreign +function' machinery. This path is somewhat less optimized, but +doesn't require inventing opcodes and modifying the runtime at +quite as low a level. The builtin 'foreign' functions are declared +in `Unison.Runtime.Builtin`, in a definition `declareForeigns`. We +can declare our builtins there by adding: + +``` haskell + declareForeign Tracked "MVar.new" boxDirect + . mkForeign $ \(c :: Closure) -> newMVar c + declareForeign Tracked "MVar.take" boxToEFBox + . mkForeignIOF $ \(mv :: MVar Closure) -> takeMVar mv +``` + +These lines do multiple things at once. The first argument to +`declareForeign` determines whether the function should be explicitly +tracked by the Unison Cloud sandboxing functionality or not. As a +general guideline, functions in `{IO}` are `Tracked`, and pure +functions are `Untracked`. The second argument must match the name +from `Unison.Builtin`, as this is how they are associated. The third +argument is wrapper code that defines the conversion from the Haskell +runtim calling convention into Unison, and the definitions for these +two cases will be shown later. The last argument is the actual Haskell +implementation of the operation. However, the format for foreign +functions is somewhat more limited than 'any Haskell function,' so the +`mkForeign` and `mkForeignIOF` helpers assist in wrapping Haskell +functions correctly. The latter will catch some exceptions and yield +them as explicit results. + +The wrapper code for these two operations looks like: + +``` haskell +-- a -> b +boxDirect :: ForeignOp +boxDirect instr = + ([BX],) + . TAbs arg + $ TFOp instr [arg] + where + arg = fresh1 + +-- a -> Either Failure b +boxToEFBox :: ForeignOp +boxToEFBox = + inBx arg result $ + outIoFailBox stack1 stack2 stack3 any fail result + where + (arg, result, stack1, stack2, stack3, any, fail) = fresh +``` + +The breakdown of what is happening here is as follows: + + - `instr` is an identifier that is used to decouple the wrapper + code from the actual Haskell implementation functions. It is + made up in `declareForeign` and passed to the wrapper to use as a + sort of instruction code. + - A `ForeignOp` may take many arguments, and the list in the tuple + section specifies the calling convention for them. `[BX]` means + one boxed argument, which in this case is the value of type `a`. + `[BX,BX]` would be two boxed arguments, and `[BX,UN]` would be + one boxed and one unboxed argument. Builtin wrappers will + currently be taking all boxed arguments, because there is no way + to talk about unboxed values in the surface syntax where they are + called. + - `TAbs arg` abstracts the argument variable, which we got from + `fresh1'` at the bottom. Multiple arguments may be abstracted with + e.g. `TAbss [x,y,z]`. You can call `fresh` to instantiate a tuple of + fresh variables of a certain arity. + - `inBx` and `outIoFailBox` are helper functions for calling the + instruction and wrapping up a possible error result. + - `TFOp` simply calls the instruction with the assumption that the + result value is acceptable for directly returning. `MVar` values + will be represented directly by their Haskell values wrapped into + a closure, so the `boxDirect` code doesn't need to do any + processing of the results of its foreign function. + +The names of the helpers generally follow a form of form of Hungarian +notation, e.g. `boxToEFBox` means "boxed value to either a failure or +a boxed value", i.e. `a -> Either a b`. +However, not all helpers are named consistently at the moment, and +different builtins use slightly different implementations, so looking +at other parts of the file may be instructive, depending on what is +being added. + +At first, our declarations will cause an error, because some of the +automatic machinery for creating builtin 'foreign' functions does not +exist for `MVar`. To rectify this, we can add a `ForeignConvention` +instance in `Unison.Runtime.Foreign.Function` that specifies how to +automatically marshal `MVar Closure`, which is the representation +we'll be using. + +``` haskell +instance ForeignConvention (MVar Closure) where + readForeign = readForeignAs (unwrapForeign . marshalToForeign) + writeForeign = writeForeignAs (Foreign . Wrap mvarRef) +``` + +This takes advantage of the `Closure` instance, and uses helper +functions that apply (un)wrappers from another convention. + +With these in place, the functions should now be usable in the new +runtime. + +## Decompilation + +If it makes sense for an added type, it is possible to add to Unison's +ability to decompile runtime values or test for universal +equality/ordering. Directly embedded Haskell types are wrapped in the +`Foreign` type, and are decompiled in `Unison.Runtime.Decompile` using +the `decompileForeign` function. For instance, `Text` is decompiled in +the case: + +``` haskell + | Just t <- maybeUnwrapBuiltin f = Right $ text () t +``` + +Further cases may be added using the `maybeUnwrapBuiltin`, which just +requires adding an instance to the `BuiltinForeign` class in +`Unison.Runtime.Foreign`, specifying which builtin reference +corresponds to the type. + +## Transcripts + +One last thing remains. The additional builtin operations will have +changed some of the transcript output. The transcript runner should be +executed, and modified files should be checked and committed, so that +CI tests will pass (which check transcripts against an expected +result). diff --git a/unison-src/transcripts/project-outputs/docs/branchless-scratch.output.md b/unison-src/transcripts/project-outputs/docs/branchless-scratch.output.md new file mode 100644 index 0000000000..cbcef53ae6 --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/branchless-scratch.output.md @@ -0,0 +1,54 @@ +### Remembering local/remote codetree associations? + +``` haskell +-- Designates remote paths to sync local paths against +newtype RemoteMap = RemoteMap { toMap :: Map (Path, RemoteName) RemotePath } +``` + +If I have some branch (tree node) that I want to sync with github on an ongoing basis. e.g. `/projects/foo` to `github:aryairani/foo` — that becomes a place I can publish to or pull from, how should I associate the two? If I + +If I associate it by path, then what should happen when I move or copy the node in the tree? What do I have to update to make that happen? + +What happens if I associate it by `Causal` hash? + +``` +# parenthesized hashes represent the branch hash + +/projects (mZm)> remote.set github:user/foo foo + Set remote github:user/foo for /projects/foo (0e9). +``` + +/projects/foo (0e9) linked to github:user/foo + +``` +/projects (mZm)> cp foo foo-fork +/projects (wkP)> cd foo-fork +/projects/foo-fork (0e9)> add myFunc + Added myFunc. +/projects/foo-fork (p3z)> + +Should now have: +/projects/foo (0e9) linked to github:user/foo +/projects/foo-fork (p3z) linked to github:user/foo +``` + +``` +# types +.unison/types//compiled.ub +.unison/types//dependents/ +.unison/types/_builtin//dependents/ +# terms +.unison/terms/_builtin//dependents/ +.unison/terms//compiled.ub +.unison/terms//type.ub +.unison/terms//dependents/ +# branches +.unison/branches/.ubf +.unison/branches/head/ -- if several, merge entries to produce new head. +# edits +.unison/edits// +.unison/edits//name/ -- (base58encode (utf8encode "name of the edit")) +.unison/edits//head/ -- if several, merge entries +# remotes +.unison/remotes/ +``` diff --git a/unison-src/transcripts/project-outputs/docs/branchless.output.md b/unison-src/transcripts/project-outputs/docs/branchless.output.md new file mode 100644 index 0000000000..ed371b16b1 --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/branchless.output.md @@ -0,0 +1,656 @@ +----- + +### Dependents + +The reason we keep track of dependents is for the `todo` calculation. When we make an edit, what are the things that need to be updated as a result? + +When adding term `a` that depends on "derived" term `b` or type `B`, then a change to `b` or `B` affects `a`, so we record that `a` is a dependent of `b` and `B`. + +When adding type `A` that depends on type `B`, a change to `B` affects `A`, so we record that `A` is a dependent of `B`. + +We don't do anything for constructors, because constructors don't change. Depending on the constructor really means you depend on the type that constructor comes from. (i.e. a constructor doesn't have dependents.) Similarly, constructor doesn't have dependencies, but its declaring type may depend on other types. + +----- + +Commands + +``` +/> cd libs/Foo +/libs/Foo> cd .. +/libs> fork Foo Foo2 +/libs> fork thing +/libs> fork Foo /outside/Foo +/libs> fork /outside/Foo /outside/Foo2 +/libs> help merge + `> merge src dest` +/libs> merge /outside/Foo Foo +/libs> merge Foo2 Foo + +/libs/Foo> +/libs> move /libs/Foo /libs/Foo' +/libs> + +A.B.c +A.B.d + +arya renames, and has: -> +A.Z.c +A.Z.d + +paul adds, and has -> +A.B.e +A.B.c +A.B.d + +then merge -> +"Merge introduces the following aliases:" +A.Z.c -> A.B.c +A.Z.d -> A.B.d + +/libs> delete /libs/Foo +"warning: /libs/Foo includes the following definitions that aren't anywhere else: + + A.B.e#123 + +run it again to proceed with deletion" + +/libs> alias /libs/Foo/sqrt /libs/Foo2/butt +-- we talked about combining alias & fork into a single "copy" command +/libs> +``` + +Weird thing: There's no history for `sqrt`\! + +Suppose: + +``` +data Raw = Raw + { _termsR :: Set Referent + , _typesR :: Set Reference + , _childrenR :: Map NameSegment Hash + } +``` + +``` +/libfoo/Foo <- type +/libfoo/Foo <- constructor +/libfoo/Foo.f <- term in child namespace + +/libfoo> move Foo Foo2 +/libfoo> alias Foo Foo2 +``` + +``` + +``` + +## Data types: + +Old **PrettyPrintEnv** is for pretty-pretting code, and \_\_\_ + +``` haskell +{ terms :: Referent -> Maybe HashQualified +, types :: Reference -> Maybe HashQualified } +``` + +Q: How do we want to handle lookup of names that are outside of our branch? + +Old **Namespace** + +``` haskell +{ _terms :: Relation Name Referent +, _types :: Relation Name Reference } +``` + +Old **Names** is an unconflicted **Namespace**. is for parsing code? Not sufficient to parse hash-qualified names. + +``` haskell +{ termNames :: Map Name Referent +, typeNames :: Map Name Reference } +``` + +New **Names** combines old **PrettyPrintEnv** and old **Names**: + +``` haskell +-- these HashQualified are fully qualified +{ terms :: Relation HashQualified Referent +, types :: Relation HashQualified Reference } +``` + +We should be able to construct one from a `Codebase2`, given: + +``` haskell +root :: Branch +current :: Branch +terms :: Set HashQualified +types :: Set HashQualified +``` + +or + +``` haskell +root :: Branch +current :: Branch +terms :: Set Referent +types :: Set Reference +``` + +### Needed functionality + +Parsing a .u file: + + - Look up a Reference by name + + - Look up a Reference by hash-qualified name? We could avoid this by requiring that the user deconflict the names before parsing. + +Parsing command-line arguments: + + - Look up a Reference by name. + + - Look up a Reference by hash-qualified name (possibly from among deleted names); for resolving conflicted names and edits. + + ``` + /foo> todo + + These names are conflicted: + foo#abc + foo#xyz + Use `rename` to change a names, or `unname` to remove one. + + These edits are conflicted: + bar#fff -> bar#ggg : Nat (12 usages) + bar#fff -> bar#hhh : Nat -> Nat (7 usages) + bar#fff (Deprecated) + + Use `view bar#ggg bar#hhh` to view these choices. + Use `edit.resolve` to choose a canonical replacement. + Use `edit.unreplace` to cancel a replacement. + Use `edit.undeprecate` to cancel a deprecation. + Use `edit.replace bar#hhh bar#ggg` to start replacing the 7 usages of `bar#hhh` with `bar#ggg`. + + /foo> alias bar baz + + Not sure which bar you meant? + bar#ggg + bar#hhh + Try specifying the hash-qualified name, or sort out the conflicts before + making the alias. + ``` + + ``` + /foo> edit.resolve bar#fff bar#ggg + + Cleared bar#fff -> bar#hhh + Added bar#ggg -> bar#hhh + ``` + + or + + ``` + /foo> edit.unreplace bar#fff bar#ggg + + Cleared bar#fff -> bar#ggg + ``` + +Pretty-printing: + + - Select a name by Reference + +Q: What to do about names outside the current branch? + +Option 1: Don't support names outside the current branch; user must go up a level (possibly to the root), set up the names as desired, and then descend again. + +Option 2: Introduce some syntax for names outside the current branch, e.g. `_root_.Foo.bar`. We could first lookup references in the current branch, then in the root branch, then in the history of the root branch? + +## TODO tracking refactoring of existing functionality + + - \[ \] Add edits/patches to Namespace / Branch + + - \[ \] Add patch to `NameTarget` + + - \[ \] rename `propagate` to `patch` + + - moves names from old hash to new hash, transitively, to the type-preserving frontier + + - \[ \] `list [path]` + + - ~~by default, don't descend into links with names that start with `_`~~ + + - \[ \] `todo [path]` + + - list conflicted names (hash-qualified) and edit frontier + + - \[ \] `update [path]` + + - ~~when updating a term, old names goes into `./_archived`, which will be largely conflicted.~~ + + - \[ \] `propagate [path]` + + - \[ \] `edit.resolve ` + + - +Old names use case 1: + +``` +patch: +#a -> #b +#a -> #c + +namelookup: +#b -> "foo" +#c -> "foo2" + +"You have a conflicted edit: + #a -> foo#b + #a -> foo2#c + Please choose one. +" + +/pc/libs/x> edit.resolve #a foo#b +``` + +You're in the middle of an edit, it's not type preserving + + - \[ \] `rename / move` + + - \[ \] `rename.edits` + - \[ \] `rename.type` + - \[ \] `rename.term` + + - \[ \] name / copy `copy <[src][#hash]> ` + + - \[ \] `todo [path]`, `update [path]`, `propagate [path]` + + - \[x\] Implement `Branch.sync` operation that synchronizes a monadic `Branch` to disk + + - \[x\] Implement something like `Branch.fromDirectory : FilePath -> IO (Branch IO)` for getting a lazy proxy for a `Branch` + + - Also `Branch.fromExternal : (Path -> m ByteString) -> Hash -> m (Branch m)` + - Could we create a `Branch` from a GitHub reference? Seems like yeah, it's just going to do some HTTP fetching. + + - \[x\] Tweak `Codebase` to `Codebase2` + + - \[x\] Implement a `Codebase2` for `FileCodebase2` + + - \[ \] Implement `Actions2` + + - \[ \] Implement `Editor2` + + - \[ \] Implement `OutputMessages2` + + - \[ \] Implement `InputPatterns2` + + - \[ \] Go back and leave a spot for Link in serialized Branch0 format. + + - \[ \] Split Edits out of `Branch0` + + - \[ \] Delete `oldNamespace`, and instead add deprecated names + + - \[ \] Parsing takes a `Names`, a map from `Name`(fully-qualified name) to `Referent`/`Reference`. We should switch these from `Map` to `Name -> Optional xxx`, or even `Name -> m (Optional xxx)` + + - \[ \] `Context.synthesizeClosed` takes a `TypeLookup`, which includes a map from `Reference` to `Type`, `DataDecl`, `EffectDecl`. Shall we plan to include the full codebase here, or load them on demand? Maybe it doesn't matter yet. + + - `parseAndSynthesizeFile` takes a `Set Reference -> m (TypeLookup v Ann)`, maybe that's a good model. + + - \[ \] `add` and `update` will need a way to update the `Branch'` at the current level, and all the way back to the root. Some kind of zipper? + + - \[ \] `find` takes an optional path + + - \[ \] `fork` takes a `RepoPath` (or we could have a dedicated command like `clone`) + + - \[ \] `merge` takes at least a path, if not a `RepoPath` + + - \[ \] `publish` or `push`that takes a local path and a remote path? + +## Branchless codebase format + +## Commands / Usage + +``` +/> clone gh:aryairani/libfoo + Copied gh:aryairani/libfoo blah blah to /libfoo +/> undo +/> clone gh:aryairani/libfoo /libs/DeepLearning/Foo + Copied gh:aryairani/libfoo blah blah to /libs/DeepLearning/Foo +/> +``` + +`clone [path]` + +`push [path] ` + +``` +/> cd projects +/projects> rename FaceDetector FaceDetector/V1 +/projects> cd FaceDetector +/projects/FaceDetector> cp V1 V2 +``` + +`cd ` — support relative paths? + +`cp ` + +``` +/projects/FaceDetector> replace.scoped V2 /libs/DeepLearning/Foo/thing1 mything1 + + Noted replacement of thing1#af2 with mything#i9d within /projects/FaceDetector/V2. +``` + +``` +replace.write +todo + +``` + +``` +/projects/FaceDetector> todo + ...7 things... +/projects/FaceDetector> todo / + ...33 things... +/projects/FaceDetector> +``` + +`mv` / `rename` command: can refer to Terms, Types, Directories, or all three. Use hash-qualified names to discriminate. + +## Namespaces + +``` haskell +data Branch' m = Branch' (Causal m Namespace) + +data Causal m e + = One { currentHash :: Hash, head :: e } + | Cons { currentHash :: Hash, head :: e, tail :: m (Causal e) } + -- The merge operation `<>` flattens and normalizes for order + | Merge { currentHash :: Hash, head :: e, tails :: Map Hash (m (Causal e)) } + +-- just one level of name, like Foo or Bar, but not Foo.Bar +newtype NameSegment = NameSegment { toText :: Text } -- no dots, no slashes +newtype Path = Path { toList :: [NameSegment] } + +data Namespace m = Namespace + { terms :: Relation NameSegment Referent + , types :: Relation NameSegment Reference + , children :: Relation NameSegment (Branch' m) + } +``` + +**Repo format:** + +``` +# types +.unison/types//compiled.ub +.unison/types//dependents/ +.unison/types/_builtin//dependents/ + +# terms +.unison/terms//compiled.ub +.unison/terms//type.ub +.unison/terms//dependents/ +.unison/terms/_builtin//dependents/ + +# branches (hashes of Causal m Namespace) +.unison/branches/.ubf +.unison/branches/head/ -- if several, merge to produce new head. +``` + +### Backup Names? + +For pretty-printing, we want a name for every hash. Even for hashes we deleted the names for. 😐 + + - When we delete a name `x` from path `/p` (i.e. `/p/x`), we add the name `/_deleted/p/x`. + + - Or, do we just disallow removing the last name of things with dependencies? + + - When deleting a name, notify the user of the remaining names. + +## Edits + +``` haskell +newtype EditMap = EditMap { toMap :: Map GUID (Causal Edits) } + +data Edits = Edits + { terms :: Relation Reference TermEdit + , types :: Relation Reference TypeEdit + } + +type FriendlyEditNames = Relation Text GUID +``` + +**Repo format:** + +``` +.unison/edits// +.unison/edits//name/ -- (base58encode (utf8encode "name of the edit")) +.unison/edits//head/ -- if several, merge to produce new head. +``` + +### TODO: How to share these edits? + + - It could be the same as sharing Unison names (e.g. if the edits were Unison terms) + - It could be the same as sharing Unison definitions: + Make up a URI that references a repo and an edit GUID. + e.g. `https://github.com///<...>/[/hash]` + - `clone.edits [local-name]` + - `guid` comes from remote-url, and is locally given the name `local-name` + - if `local-name` is omitted, then copy name from `remote-url`. + - if `local-name` already exists locally with a different `guid`, then abort. + +### Editsets as first-class unison terms: + +Benefits: + + - Don't have two separate dimensions of forking and causality (namespace vs edits). + - Makes codebase model way simpler to explain. \<— BFD + +Costs / todo: + +Q: Do we allow users to edit `EditSets` using standard `view` and `edit` in M1? + +If Yes: + + - EditSets are arbitrary Unison programs that need to be evaluated. Once evaluated, they would have a known structure that can be decomposed for EditSet operations. We would need: + + - - \[ \] some new or existing syntax for constructing EditSet values + - \[x\] a way to evaluate these unison programs + - \[ \] a way to save evaluated results back to the codebase / namespace + - Q: Do we evaluate and save these eagerly or lazily? + - \[ \] a way in Haskell to deconstruct the EditSet value + - \[ \] a way to modify (append to) values of that type using CLI commands. e.g. `update` ? + - either `update` calls a unison function that + +If no (we don't provide user syntax for constructing `EditSets` in .u file): + + - EditSets are part of the term language? + - Or a constructor with a particular hash? (Applied to Unison terms) + +## Collecting external dependencies + +If a subtree references external dependencies, they should be given local names when exporting. + +Given: + +``` +/A/B/c#xxx +/D/E/f#yyy (depends on #xxx, #zzz) +/D/G/h#zzz +/libs/G/bar#zzz +``` + +If `/D/E` is published, what names should be assigned to `#xxx`, `#zzz`? + +### Idea 1: Names relative to nearest parent + +Collect external dependencies under `Dependencies`, using names relative to the nearest parent in common with the publication point? + +i.e.: + +``` +f#yyy +Dependencies/A/B/C#xxx +Dependencies/G/h#zzz +``` + + + + + +### Idea 2: Somehow derive from qualified imports used? + +If + +### Idea 3: Surface the condition\* to the user + +\*the condition = the publication node contains definitions that reference definitions not under the publication node. + +Ask them to create aliases below the publication point? + +### Idea 4: Add external names to `./_auxNames/` + +The nearest aux-name would only be used to render code only if there were no primary names known. + +### Idea 5: Something with symlinks + +``` haskell +data Branch' m = Branch' (Causal m Namespace) + +data Causal m e + = One { currentHash :: Hash, head :: e } + | Cons { currentHash :: Hash, head :: e, tail :: m (Causal m e) } + -- The merge operation `<>` flattens and normalizes for order + | Merge { currentHash :: Hash, head :: e, tails :: Map Hash (m (Causal m e)) } + +-- just one level of name, like Foo or Bar, but not Foo.Bar +newtype NameSegment = NameSegment { toText :: Text } -- no dots, no slashes +newtype Path = Path { toList :: [NameSegment] } + +data Namespace m = Namespace + { terms :: Relation NameSegment Referent + , types :: Relation NameSegment Reference + , children :: Relation NameSegment (Link m) + } + +data Link m = LocalLink (Branch' m) | RemoteLink RemotePath +data RemotePath = Github { username :: Text, repo :: Text, commit :: Text } -- | ... future +``` + +This lets us avoid redistributing libs unnecessarily — let the requesting user get it from wherever we got it from. But it doesn't specifically address this external naming question. + +We might be publishing `/app/foo` which references definitions we got from `repo1`. Somewhere in our tree (possibly under `/app/foo` and possibly not?) we have a link to `repo1`. + +Somewhere under `/app/foo` we reference some defn from `repo1`. + +Transitive publication algorithm: + + - find all the things that you're referencing + - the things you're publishing that aren't under the pbulication point need to be resolved + - they're local, and need to be given names under the publication point + - user is notified, or we do something automatic + - they're remote, and we need to include, in the publication, a link to the remote repo. + - user is notified, or we do something automatic + - "Something automatic" will be: + - mirror the dependency names from our namespace into `./_Libs`; if it would produce naming conflicts to use `./_Libs`, then `_Libs1`, etc. + - Or, just dump them into `./_Libs` and if doing so produces naming conflicts, force the user to resolve them before publishing. + +## Syncing with remote codetrees + +``` haskell +-- names tbd +data BranchPath = BranchPath RepoRef Path +data RepoRef = Local | GithubRef { username :: Text, repo :: Text, treeish :: Text } + +``` + +``` +/libs/community/DL +``` + +becomes +​\`\`\`haskell +BranchPath Local (Path \["libs","community","DL"\]) + +``` + + + +``` + +gh:/\[/\]\[?ref=\] -- defaults to repo's `default_branch` + +e.g. gh:aryairani/unison/libs?ref=topic/370 + +```` +becomes +​```haskell +BranchPath (GithubRef "aryairani" "unison" "topic/370") (Path ["libs"]) +```` + +or + +``` +gh:user/repo[:treeish][/path] + +e.g. github:aryairani/unison:topic/370/libs +``` + +becomes + +``` haskell +BranchPath (GithubRef "'aryairani" "unison" "topic/370") (Path ["libs"]) +``` + +## Github Notes + +Github uses a few different URL schemes. They call the ones you can pluck off their website "html\_url"s. They let you refer to files and directories, and can be parameterized by git *treeish* (branch, tag, commit). + +We can interpret these to refer to the root of a namespace. https://github.com/unisonweb/unison can be interpreted as: + +``` haskell +GithubRef "unisonweb" "unison" <$> getDefaultBranch "unisonweb" "unison" +``` + +The Github website will let you navigate to a git branch, e.g https://github.com/unisonweb/unison/tree/topic/370/ can be interpreted as: + +``` haskell +GithubRef "unisonweb" "unison" <$> matchBranch "unisonweb" "unison" "topic/370/" +``` + +Branch names can contain slashes, such as `topic/370`, complicating parsing if there's meant to be path info following the branch name. + +1. Fortunately, if you have a git branch `a/b` then it's not possible to create branches `a` or `a/b/c`. So you can load the [list of branches](https://api.github.com/repos/unisonweb/unison/branches) from JSON, and then test them against that treeish-prefixed path without ambiguity. +2. Github's website doesn't know how to navigate into `Causal` structures, so it's never going to give us URLs with paths into a Unison namespace. So maybe this is a moot point. + +So, I would still go ahead with the made-up `gh:username/repo[:treeish][/path]` URI scheme; we can try to support the other URLs mentioned above, and let them refer to the root of the published namespace. + +Our Javascript viewer can be made to create URLs with query params or fragments in them that can indicate the Unison path, and those can be the ones we share in tweets, etc: + +http(s)://.github.io/?branch=\&path= with the default branch being the head, and the default path being `/`. + +``` + + +``` diff --git a/unison-src/transcripts/project-outputs/docs/codebase-editor-design.output.md b/unison-src/transcripts/project-outputs/docs/codebase-editor-design.output.md new file mode 100644 index 0000000000..8d3f24f0f0 --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/codebase-editor-design.output.md @@ -0,0 +1,511 @@ +Note: initial draft, probably a lot of rough edges. Comments/questions/ideas are welcome\! + +# Editing a Unison codebase + +The Unison codebase is not just a mutable bag of text files, it's a structured object that undergoes a series of well-typed transformations over the course of development, yet we can still make arbitrary edits to a codebase. The benefits of the Unison approach which we'll see are: + + - Incremental compilation is perfectly precise and comes for free, regardless of what editor you use. You'll almost never spend time [waiting for Unison code to compile](https://xkcd.com/303/), *no matter how large your codebase*. + - Refactoring is a controlled experience where the refactoring always typechecks and you can precisely measure your progress, so arbitrary changes to a codebase can be completed without ever dealing with a depressingly long list of (often misleading) compile errors or broken tests\! + - Codebase changes can be worked on concurrently by multiple developers, and many situations that traditionally result in incidental merge conflicts or build issues can no longer occur. (e.g., Alice swapped the order of two definitions in a file, conflicting with Bob's adding an unrelated definition.) + - Renames, even bulk renames of whole packages of definitions, are 100% accurate and fast. When it's this easy to rename things, there's less anxiety about picking names and less need to pick the perfect name at the moment you start writing something. + - We can assign multiple names to the same definitions, and you can choose which naming you prefer and publish your naming schemes for others to use if they wish. [Bikeshedding](http://bikeshed.com/) over names can be a thing of the past (or at least vastly reduced 😀). + - Dependency hell is also vastly reduced: many situations that contribute to dependency hell simply cannot arise with the Unison codebase model. + - As an added bonus, it's no problem to use different versions of some library in different parts of your application when convenient, just as you might use two unrelated libraries in your application. + - It's easy to mix and match parts of different libraries into a custom bundle, which others can use, all while retaining full compatibility with the existing libraries that the bundle draws from. + - Publishing code is trivial; it won't require any additional steps beyond pushing to a git repository or shared filesystem. (Other filesystem-like services can be supported in the future.) + - Import statements are first-class values which can be shared and aggregated and published for consumption by others. No more project-wide import boilerplate at the top of every file\! + - And this is all done in a backwards compatible way using existing tools: you can still use your favorite text editor, can still version your code with Git, use GitHub, etc. + +Warning: once you experience this mode of editing a codebase and the control, safety, and ease of it, the "mutable bag of text files" model of a codebase may start to seem barbaric in comparison. 😱 + +## The big idea 🧠 + +Here it is: *Unison definitions are identified by content.* Therefore, there's no such thing as changing a definition, there's only introducing new definitions. What can change is how we map definitions to human-friendly names. e.g. `x -> x + 1` (a definition) vs `Integer.increment` (a name we associate with it for the purposes of writing and reading other code that references it). An analogy: Unison definitions are like stars in the sky. We can discover new stars and create new star maps that pick different names for the stars, but the stars exist independently of what we choose to call them. + +With this model, we don't ever change a definition, nor do we ever change the mapping from names to definitions (we call such mappings "namespaces"). A namespace is simply another kind of definition. Like all definitions, it is immutable. When we want to "change" a namespace, we create a new one, and *change which namespace mapping we are interested in*. This might seem limited, but it isn't at all, as we'll see. + +From this simple idea of making definitions (including definitions of namespaces) immutable, we can build a better development experience around codebase editing with all of the above benefits. + +## The model + +This section gives the model of what a Unison codebase is and gives its API. Later we'll cover what the actual user experience is for interacting with the model, along with various concrete usage scenarios. The model deals with a few types, `Code`, `Codebase`, `Release`, and `Branch`: + + - `Code` could be a function or value definition (a `Term`) or a `TypeDeclaration`. Each `Term` in the `Codebase` also includes its `Type`. A Unison codebase contains no ill-typed terms. Each `Code` also knows its `Author` and `License`, which are just terms. + - `Namespace` denotes a `Map Name Code`. It defines a subset of the universe of possible Unison definitions, along with names for these definitions. (The set of definitions it talks about is just the set of values of this `Map`.) + - `Release` denotes a `Namespace -> Namespace`. It provides a function for "upgrading" from old definitions, and the "current" `Namespace` can be obtained by giving the `Release` the empty `Namespace`. + - `Branch` denotes a `Causal (Map Code (Conflicted CodeEdit, Conflicted NameEdits))`, which comes equipped with a commutative `merge` operation and can be converted to a `Release` assuming no conflicts. A `Branch` represents a `Release` "in progress". We discuss the `Causal` and `Conflicted` types later. + - `Codebase` denotes a `Set Code`, a `Map Name Branch` of named branches, and a `Map Name Release` of named releases. + +A `Release` can be sequenced with another `Release`: + +``` haskell +sequence : Release -> Release -> Release +sequence up1 up2 nsi = Map.unionWith const (up2 . up1 $ nsi) (up1 nsi) +``` + +A `Branch` has two important operations: + + - A commutative `merge` operation for combining concurrent edits. + - An associative `sequence` operation for sequencing edits. + +`Causal a` has 5 operations, specified algebraically here (we give an implementation later): + + - `before : Causal a -> Causal a -> Bool` defines a partial order on `Causal`. + - `head : Causal a -> a`, which represents the "latest" `a` value in a causal chain. + - `one : a -> Causal a`, satisfying `head (one hd) == hd` + - `cons : a -> Causal a -> Causal a`, satisfying `head (cons hd tl) == hd` and also `before tl (cons hd tl)`. + - `merge : CommutativeSemigroup a => Causal a -> Causal a -> Causal a`, which is associative and commutative and satisfies: + - `before c1 (merge c1 c2)` + - `before c2 (merge c1 c2)` + - `sequence : Causal a -> Causal a -> Causal a`, which is defined as `sequence c1 c2 = cons (head c2) (merge c1 c2)`. + - `before c1 (sequence c1 c2)` + - `head (sequence c1 c2) == head c2` + +Question: can we give a simple denotation for `Causal a`? (That doesn't mention hashes or anything) + +Thought: `Causal` could also be a `Comonad` (in the category of commutative semigroups), where each value has access to the past history at each point. + +``` haskell +merge : Branch -> Branch -> Branch +merge = Causal.merge + +mergePickRight : Branch -> Branch -> Branch +mergePickRight b1 b2 = Causal.mergePickRight + +data Conflicted a = Conflicted (Set a) deriving Monoid via Set + +-- note: +instance (Semigroup v, Ord k) => Monoid (Map k v) where + mempty = Map.empty + m1 `mappend` m2 = Map.unionWith (<>) m1 m2 + +-- Add a new definition; if one already exists for that name, produce a conflict +add : Name -> Code -> Branch +add n c = step (Map.insertWith (<>) n (Conflicted.one c)) + +-- Add or replace a definition, clobber any existing definitions for given name +set : Name -> Code -> Branch +set n c = step (Map.insert n (Conflicted.one c)) + +step : (a -> a) -> Causal a -> Causal a +step f c = f (head c) `cons` c + +deleteName : Name -> Branch +deleteName n = step (Map.delete n) + +deleteCode : Code -> Branch +deleteCode c = step (Map.filterValues (/= c)) +``` + +Here's `Codebase` and `Code` types: + +``` haskell +data Codebase = + Codebase { code : Set Code + , branches : Map Name Branch + , releases : Map Name Release } + +-- All code knows its dependencies, author, and license +Code.dependencies : Code -> Set Code +Code.author : Code -> Author +Code.license : Code -> License +``` + +### Implementation + +Now that we've given the denotation, here's some ideas for implementation: + +``` haskell +-- A branch can have unresolved conflicts, and we maintain some +-- history to help merge branches, respecting causality +data Branch' = Branch' + { namespace :: Map Code (Conflicted NameEdits) + , edited :: Map Term (Conflicted Edit) + , editedTypes :: Map TypeDeclaration (Conflicted TypeEdit) } + +data Branch = Branch (Causal Branch') + +-- A release doesn't have history or conflicts. +data Release' = Release' + { namespace :: Map Name Code + , edited :: Map Term Edit + , editedTypes :: Map TypeDeclaration TypeEdit } + +data Release = Release (Causal Release') + +data Conflicted a = One a | Many (Set a) + +instance Eq a => Semigroup (Conflicted a) where + One a <> One a2 = if a == a2 then One a else Many (Set.fromList [a,a2]) + One a <> Many as = Many (Set.add a as) + Many as <> One a = Many (Set.add a as) + Many as <> Many as2 = Many (as `Set.union` as2) + +data Edit = Replace Term Typing | Deprecated | .. -- SwapArguments Permutation, etc +data TypeEdit = Replace TypeDeclaration | Deprecated +data NameEdits = NameEdits { adds :: Set Code, removes :: Set Code } +data Typing = Same | Subtype | Different + +merge :: Branch -> Branch -> Branch +merge (Branch b1) (Branch b2) = Branch (Causal.merge b1 b2) + +-- produces a release if the branch is not conflicted +Branch.toRelease :: Branch -> Either Conflicts Release +Release.toBranch :: Release -> Branch +Release.toBranch = ... -- trivial, just promoting a to `Causal (Conflicted a)` +``` + +A couple notes: + + - The `Typing` indicates whether the replacement `Code` is the same type as the old `Code`, a subtype of it, or a different type. This is useful for knowing how far we can automatically apply changes in a `Branch`. + - The `Edit` type produces a `Conflict` when merged, though with more structured edits (*e.g.*, in the case of the `SwapArguments` data constructor), even more could be done here. + - A common workflow will be grabbing a release and then applying it to a branch you have in progress. There are some choices about how you do this: + - You can `sequence` the release into your branch, either before or after your existing changes. If you `sequence` the release *before* your changes, then any edits to the same `Code` will keep your version. Etc. + - You can `merge` the release into your branch, which can result in conflicts that you can then resolve however you like. + - You can break apart a release `Branch` and cherry-pick elements of the release, making different `sequence` / `merge` decisions on even a per-definition basis. It would be interesting to try to come up with some UX for doing this that isn't totally overwhelming for the user. + +Here's the `Causal` type, which is used above in `Branch`: + +``` haskell +newtype Causal e + = One { currentHash :: Hash, head :: e } + | Cons { currentHash :: Hash, head :: e, tail :: Causal e } + | Merge { currentHash :: Hash, head :: e, tail1 :: Causal e, tail2 :: Causal e } + +instance Semigroup e => Semigroup (Causal e) where + Causal a1 h1 <> Causal a2 h2 + | before h1 h2 = Causal a2 h2 + | before h2 h1 = Causal a1 h1 + | otherwise = Causal (a1 <> a2) (h1 `merge` h2) + +one :: Hashable e => e -> Causal e +one e h = One (hash e) e + +cons :: Hashable e => e -> Causal e -> Causal e +cons e tl = Cons (hash e <> currentHash tl) e tl + +merge :: (Hashable e, Semigroup e) => Causal e -> Causal e -> Causal e +merge h1 h2 | h1 `before` h2 = h2 + | h2 `before` h1 = h1 + | otherwise = Merge (currentHash h1 <> currentHash h2) (head h1 <> head h2) h1 h2 + +sequence :: Hashable e => Causal e -> Causal e -> Causal e +sequence a (One h e) = cons e a +sequence a (Cons h e tl) = cons e (sequence a tl) +sequence a (Merge h e l r) = merge e (sequence a l) r +-- note: if causal had a `split` operation, we'd need to sequence on both sides + +-- Does `h2` incorporate all of `h1`? +before :: Causal e -> Causal e -> Bool +before h1 h2 = go (currentHash h1) h2 where + go h1 (One h _) = h == h1 + go h1 (Cons h _ tl) = h == h1 || go h1 tl + go h1 (Merge h _ left right) = h == h1 || go h1 left || go h1 right +``` + +Operations on a `Branch`: + + - `add` a `Name` and associated `Code` to a `Branch`. + - `rename name1 name2`, checks that `name2` is available, and if so does the rename. + - `update oldcode oldnameafter newcode newname`, check that `newname` is available, if so add it to `edited` map. `oldcode` will be referred to using some fully-qualified name. `oldnameafter` will be the name for `oldcode` after the update, just like for `deprecate`. + - `deprecate oldcode newname` marks `oldcode` for deprecation, with optional `newname`, also adds this to `edited` map. + - `empty` creates a `Branch 0 newGuid Map.empty Map.empty Map.empty`, satisfies `merge b empty ~= b` and `merge empty b ~= b`, where `~=` compares branches ignoring their `branchId`. + - `fork b == merge new-branch b` + +A branch is said to *cover* a `cb : Set Code` when it has been developed to the point that the remaining updates are type-preserving and can thus be applied automatically. More precisely, a Branch `c` covers a `cb : Set Code` when all dependents in `cb` of type-changing edits in `c` (including deprecations) also have an edit in `c`, and none of the edits are in a conflicted state. If we want to measure how much work remains for a Branch `c` to cover a `cb : Codebase`, we can count the transitive dependents of all *escaped dependents* of type-changing edits in `c`. An *escaped dependent* is in `cb` but not `c`. This number will decrease monotonically as the `Branch` is developed. + +*Related:* There are some useful computations we can do to suggest which dependents of the frontier to upgrade next, based on what will make maximal progress in decreasing the remaining work. The idea is that it's useful to focus first on the "trunk" of a refactoring, which lots of code depend on, rather than the branches and leaves. Programmers sometimes try to do something like this when refactoring, but it can be difficult to know what's what when the main feedback you get from the compiler is just a big list of compile errors. + +We also typically want to encourage the user to work on updates by expanding outward from initial changes, such that the set of edits form a connected dependency graph. If the user "skips over" nodes in the graph, there's a chance they'll need to redo their work, and we should notify the user about this. It's not something we need to prevent but we want the user to be aware that it's happening. + +Thought: we may want to prevent a merge of `source` into `target` unless `source` covers all the definitions in `target` (either in the `namespace` or in the values of the `edited` `Map`). The user could develop `source` until it covers `target`, then the two branches can be merged. Alternately, we could just allow the branches to exist in an inconsistent state and prompt the user to fix these inconsistencies. + +The `namespace` portion of a `Branch` can be built up using whatever logic the programmer wishes, including picking arbitrary new names for definitions, though very often, the names output by a `Branch` will be the same as or based on the names assigned to old versions of definitions. + +This is it for the model. The rest of this document focuses on how to expose this nice model for use by the Unison programmer. + +## The developer experience + +This section very much a work in progress. + +When writing code, a developer has full access to all code that's been written, just by using different imports. Here's a sketch of developer experience: + +``` +> branch scratch +There's no branch named 'scratch' yet. +Would you like me to create it and switch to it? y/n +> y +✅ I've created and switched to branch 'scratch'. + Note: `> branch` can be used to show the active branch. +> branch +'scratch' at version 0 +> watch foo.u +Watching foo.u for definitions to add to 'scratch' branch... +Noticed a change, parsing and typechecking... +🛑 I've found errors in 'foo.u', here's what I know: +... +✅ I've parsed and typechecked definitions in foo.u: `wrangle` + Would you like to add this to the codebase? y/n +> y +✅ It's done, using 'Alice' as author, Acme, Inc. as copyright holder, + license is BSD3 (your chosen defaults). Use `> help license` if you'd + like guidance on how to change any of this. +> branch +'scratch' at version 1 +> branch series/24 +✅ Switched to 'series/24' branch +> alias scratch.wrangle Acme.Alice.utils.wrangle +✅ I've marked a new definition 'Acme.Alice.utils.wrangle' for publication + in 'series/24' branch. +``` + +*Question:* what if `Acme.Alice.utils.wrangle` already exists in the 'series/24' branch? Unison reports a conflict and forces the user to pick a unique name: + +``` +> alias scratch.wrangle Acme.Alice.utils.wrangle +🛑 I'm afraid there's already a definition in this branch called 'Acme.Alice.utils.wrangle'. + You can either `> move Acme.Alice.utils.wrangle ` or choose + a different local name for `scratch.wrangle`. +``` + +Another possibility: the name already exists locally and is coincidentally bound to the exact same `Code`, in which case we get a warning: + +``` +> alias scratch.wrangle Acme.Alice.utils.wrangle +🔸 There was already a definition `Acme.Alice.utils.wrangle` which was + exactly equivalent to `scratch.wrangle`. +``` + +*Question:* what if `scratch.wrangle` also exists in this branch? If you're using `alias`, you are always referring to another branch as the first argument. You can't alias a definition in the current branch as that would mean that a `Code` in this branch no longer had a unique name. (Alternate answer: some special syntax to disambiguate referring to another branch, like `scratch:wrangle` or `scratch/wrangle`, though if we do that, we would need to disallow that separator in branch identifiers) + +*Question:* How does Alice test that her changes actually work? She probably needs to propagate them out as far as her tests, assuming that's possible. But we obviously don't want to be recompiling and regenerating binaries on every edit. *Answer:* The namespace of a branch refers to the latest version of everything, propagated as far as possible. Anything else has the prefix `old`. We achieve this just by keep a `Map Reference Reference` of type-compatible replacements which we then use in various places (such as the runtime) to do on-the-fly rewriting. + +*Question:* What about "third-party" dependencies? How do those fit in here? *Answer:* These are tracked with first-class imports. + +Assuming that is successful: + +``` +> delete branch scratch +✅ I've deleted the 'scratch' branch. +> git commit push +✅ I've committed and pushed 'series/24' updates (listed below) + to https://github.com/acme/acme + ... +``` + +It's not generally necessary to create a new branch every time, you can also just add definitions directly to the current base branch. + +The `> branch blah` command creates a new branch with no ancestors. You can also create branches whose ancestor is the current branch, which is useful for a refactoring that you eventually want to merge back into the current branch. + +``` +> fork major-refactoring +✅ I've created and switched to new branch 'major-refactoring'. + It's a child of branch 'series/24' version 29381. +> watch foo.u +... +✅ Added definition 'Acme.transmogrify' +> branch series/24 +✅ Switched to 'series/24' branch +> merge major-refactoring +✅ Updated 182 definitions, no conflicts +> save release/24 +✅ Saved 'series/24' as branch 'release/24' +``` + +Note that a `use release/24` in your Unison code can be used to access the namespace of a branch. + +### Publishing + +To publish something for use by others, users just share a URL that links to their GitHub repository. There's no separate step of creating some artifact like a jar and uploading that to some third-party package repository. That URL is something like `https://acme.github.io/unison/QjdBS8sdbWdj`, where the `QjdBS8sdbWdj` is a Base 58 encoding of a particular Unison hash. The GitHub repository format for Unison doubles as a GitHub pages site so anyone can explore the repository from that point, obtaining pretty-printed and hyperlinked source code, pretty HTML documentation, and so on. + +To start using someone else's published code, you can do a `get`: + +``` +> get https://acme.github.io/unison/QjdBS8sdbWdj +About to fetch 'https://acme.github.io/unison/release/24'. +choose a name for the namespace (suggest 'acme'): acme + +Fetching... + +✅ Loaded 1089 definitions into acme/release/24 + Use `> docs acme/release/24` +``` + +The URL here can point to a single definition, in which case it along with its transitive dependencies are added to the local codebase. In this case, it doesn't get a name, but you can refer to it by hash. Nameless code in the codebase probably records the URL where it was loaded from since that URL might have useful information about the hash. We might also by default look for `/docs-**.link` or something to fetch documentation. + +Alternately, we can juse `use` a release URL directly, as a namespace, without a `> get` happening first. Perhaps `use from `. `` includes the hash of the release, which is a Unison Term including the namespace itself and references to a bunch of code. This is downloaded, along with all of its transitive dependencies. The namespace is spliced into the current parsing environment according to the import expression of the `use` statement. + +Question: How do you discover new versions of hashes? (including hashes that refer to docs) + +**Note:** In the event of naming conflicts when doing a `get` (if you already have a branch with that name locally), Unison will force you to pick a different name. + +## Repository format + +A design goal of the repository format is that it can be versioned using Git (or Hg, or whatever), and there should never be merge conflicts when merging two Unison repositories. That is, Git merge conflicts are a bad UX for surfacing concurrent edits that the user may wish to reconcile. We use a few tricks to achieve this property: + + - Sets are represented by directories of immutable empty files whose file names represent the elements of the set - the sets are union'd as a result of a Git merge. Deletions are handled without conflicts as well. + - Likewise, maps are represented by directories with a subdirectory named by each key in the map. The content of each subdirectory represents the value for that key in the map. + - When naming files according to a hash of their content, git will never produce a conflict as a result of a `merge`. + +Here's a proposed repository representation: + +``` text +terms/ + jAjGDJnsdfL/ + compiled.ub -- compiled form of the term + type.ub -- binary representation of the type of the term + index.html -- pretty, hyperlinked source code of the term + reference-english-JasVXOEBBV8.link -- link to docs, in English + reference-spanish-9JasdfjHNBdjj.link -- link to docs, in Spanish + doc-english-OD03VvvsjK.link -- other docs + license-8JSJdkVvvow92.link -- reference to the license for this term + author-38281234jf.link -- link to the hash of the authors list +types/ -- directory of all type declarations + 8sdfA1baBw/ + compiled.ub -- compiled form of the type declaration + index.html -- pretty, hyperlinked source code of the type decl + reference-english-KgLfAIBw312.link -- reference docs + doc-english-8AfjKBCXdkw.link -- other docs + license-8JSJdkVvvow92.link -- reference to the license for this term + author-38281234jf.link -- link to + constructors/ + 0/type.ub -- the type of the first ctor + 1/type.ub -- the type of the second ctor +branches/ + branchGuid7/ + myAwesomeBranch.name + asdf8j23jd.ubf -- unison branch file, named according to its hash (so no conflicts), deserializes to a `Branch` +releases/ + releaseName1/ + asdf8j23jd.ur -- unison release file, named according to its hash, deserializes to a `Release` +``` + +Thought: might want to make `Release` representation more granular, so can pull out the namespace separate from the upgrade function. + +When doing a `git pull` or `git merge`, this can sometimes result in multiple `.ubf` files under a branch. We simply deserialize both `Branch` values, `merge` them, and serialize the result back to a file. The previous `.ubf` files can be deleted. + +Observation: we'll probably want some additional indexing structure (which won't be versioned) which can be cached on disk and derived from the primary repo format. This is useful for answering different queries on the codebase more efficiently. + +## Questions + +Some good questions from @atacratic: + +> What's a typical workflow, say for a few developers working on different topics? + +I think very similar to now in "masterless" development. You create `series/1` branch, branch topics off that and merge into it, cut `release/1`, then create `series/2`, etc. + +To cut a release: + + - Convert `series/1` to `release/1`. + - Create a new branch, `series/2`, which is *empty*. + - Start hacking on `series/2`, likely referencing things by name in `release/1` (`edit release/1/math.random` might be a thing you do to edit a definition from a prior release) + +Questions: + + - Maybe it's fine to just have an indefinitely-long running master branch and just cut releases off of that? This might be equivalent to sequencing all the releases that come before each release (maybe less flexible). + - Let's keep in mind that we might want to expose some simplified workflow for beginners so they aren't forced to learn about all this branch management stuff before even writing "hello world\!" + - Should be easy for advanced users too, no unnecessary juggling. + +> Where in the old ways people would have made a commit, do they now make a `Branch`? How do things proceed as we build up several of those for a topic? + +Same as now. You don't create a branch for every little change necessarily, though you could. You often just make changes to a branch directly. In terms of recording history, we can "git commit" whenever is convenient. + +> How does it work if you're editing "your" code as well as "other" people's code? + +Thought: You can reference any code in any release just with imports. You can also edit any code from any release, even from a release you didn't create. I suspect you'll want to give some qualified name to a definition that you edit which comes from another user's library. (For instance, I might republish a new version of `Runar.sort` under `Paul.patches.Runar.sort` in the branch I'm working on... and then I might contact `Runar` to get that change merged "upstream", something something...) + +> Where can they see their version history? Presumably not in the underlying git repo, if there's a branch for every incremental change? + +To start, git history is probably okay (though we could probably present it nicer). + +> Is the typical github PR now the addition of a branch? Or an in-place update to the master release? + +Might be addition of a new Unison branch, a merge or commits to some Unison branch, or a new Unison release. + +> When is a branch B converted to a release? + +Whenever is convenient or you want to record a snapshot. + +> What are the implications of the loss of all the Causal history at that point? Will other people find it harder to merge onto that release, if they've been working concurrently with what was in B, maybe sharing changes with it? + +Good questions. Maybe convention is to just use a single long-running branch, with all releases cut from that branch (similar to how people use `master` today?) For efficiency, want to have branch representation such that don't have to load it all in memory. + +I think this is overall TBD. + +> I can't actually put my finger on why we need a commutative merge operation. + +It needs to be commutative so that Alice and Bob can apply their changes in either order and still reach the same repository state. + +> Ditto I can't explain why we need Causal. I guess it helps spot when one edit is a merge ancestor of another. But why do we need that? + +So that in merging, we have enough information to know that one edit supercedes another. Similar to Git tracking enough info to be able to do "fast-forward" merges. If we didn't have this, we'd get spurious conflicts when forking off branches and then merging them back in. + +> Why is Causal being applied on a per-name basis? i.e. why is it Map Name Causal (Conflicted Edit) rather than Causal (Map Name (Conflicted Edit))? + +No good reason\! We changed this, to put the `Causal` on the outside. + +> You've got Edit as a forgetful thing - it knows the new term but not the old one. I've got a feeling we're going to want to be able to reverse edits (and hence branch upgrades), so we should store the old value too. + +Now we are keying on `Code` instead of `Name` so I think we have enough information in the current representation to be able to invert a `Branch`? + +> If Alice renames a term from X to Y, and Bob renames it from X to Z, what's their experience when merging? + +They get a conflict which is easy to merge automatically, and you can imagine different choices: a) Allow both names b) Use Alice's name c) Use Bob's name. It's fine to have multiple names for the same code, though you will have to pick one when pretty-printing the code. + +> How does conflict resolution interact with propagation? So, if term f has some conflicting edits, does that mean that all its transitive dependents have conflicts too? How does someone resolve that? + +Yes, but we'll give tooling to help resolve all these conflicts in an efficient order (probably want to resolve conflicts in dependencies of a term before resolving conflicts in the term itself). + +> How are you going to render a Conflicted Edit to the user doing conflict resolution? Surely they want to know which source branches/releases each version of the edit is coming from, but I can't see how you'll know that. + +Good point. We could include some more metadata on each `Edit` to help with this. + +> Is this bit still current? "The namespace of a branch refers to the latest version of everything, propagated as far as possible. Anything else has the prefix old." Is doing propagations going to add a bunch of new names to the namespace automatically? + +No longer current. The branch's namespace is actually minimal and doesn't include any transitive updates by default (though you could "bake" the branch to propagate updates). + +> Is it possible to rename a branch or a release? + +Sure. Might have a GUID for each branch and/or release, with a name that can be changed associated with that GUID. + +> I have an urge to make it turtles all the way down: to make the names of branches and releases part of the namespaces we're trying to manage. Have you explored that line of thinking? + +I like it. It would be cool if the codebase is something you can talk about from within Unison, so `Branch` and `Release` are types in Unison that come with some nice Unison API. + +Not sure if we need to do this right away though. + +> Trying to work out the boundary between the unison codebase editor and the underlying VCS: is there a 'git blame' of any kind, in the new world? is there a history (of a term, a name, or the codebase as a whole)? + +Might track this in the `Edit`, also any new `Code` will have associated metadata such as author, license, timestamp, possibly descendants / ancestors... + +Note: we won't very granular information about who wrote which part of each expression, though we could recover information by doing tree diffs on the history. + +> is there a way to rewind the clock and get access to a previous revision in Unison-land, i.e. without using the VCS? + +Yeah, all branches and releases are accessible to you. But if you want to access a point in time of some branch, you need to use the VCS. Could imagine doing something about that. + +Sketch: + + - Can refer a branch at particular state just by hash, which picks out some subgraph of a `Causal`. But refering to hashes is annoying (though we can view a log of changes). + - Put timestamp and user id in `Causal`, in addition to the hash. + - Now can do queries like "go back in time to 1 week ago". + +> How much of the codebase model will be internalised into Unison? Will I be able to talk about a Namespace or a Branch in Unison code, say if I'm using a Codebase ability? I have a smalltalk-ish desire for the answer to be yes: if Unison can describe its own UI domain model, and is its own domain language, then we might end up with a more consistent and composable world, in which Unison tooling can be written in Unison, and in which people can talk about Unison in the same universe as they talk in Unison. + +I like it. This API should be exposed to Unison so you can write tooling for Unison in Unison. + +> In your code for Semigroup Causal here, I can't work out if it's meant to be right-biased or left-biased - the first two lines make it seem like the former, and the next two the latter. Might have misunderstood though. + +Code might be wrong, but I think the `Causal` semigroup was meant to be a commutative merge operation, but we should make that more explicit (the semigroup calls `Causal.merge` for instance) + +## Notes and ideas + +You can have first-class imports with a type like: + +``` haskell +type Namespace = Map Name (Set Code) -> Map Code [NameEdit] +``` + +There's a nice little combinator library you can write to build up `Namespace` values in various ways, and we can imagine the Unison `use` syntax to be sugar for this library. + +**Arya**: I'm still thinking we'll want something like scopes to be able to apply a branch to a prefix in a "clone package foo.x to foo.y and apply these changes" sort of way. diff --git a/unison-src/transcripts/project-outputs/docs/commandline-editor-dev.output.md b/unison-src/transcripts/project-outputs/docs/commandline-editor-dev.output.md new file mode 100644 index 0000000000..6db18f6768 --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/commandline-editor-dev.output.md @@ -0,0 +1,11 @@ +The Unison CLI code is made up of a few components: + +`CommandLine.Main` sets up threads to watch the filesystem and parse `stdin` to produce `Editor.Event`s and `Editor.Input`s respectively. + +`Editor.Input` parsers are defined in InputPattern.hs and InputPatterns.hs. + +`Action.loop` receives `Editor.Event`s and `Editor.Input`s and executes `Editor.Command`s. This loop can't use `IO` or access the `Codebase` -- any access to these things must come from what `Editor.Command` provides. + +`Editor.Command`s are defined in Editor.hs and interpreted by `Editor.commandLine`. `Editor.commandLine` *does* use `IO` and access the `Codebase`.\` + +One of the `Editor.Commands` that can be executed is `Notify`, which presents an `Editor.Output` to the user. Our current implementation is in `OutputMessages.notifyUser`. diff --git a/unison-src/transcripts/project-outputs/docs/comments-and-docs.output.md b/unison-src/transcripts/project-outputs/docs/comments-and-docs.output.md new file mode 100644 index 0000000000..49a7f34635 --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/comments-and-docs.output.md @@ -0,0 +1,226 @@ +# Design for Unison documentation and comments + +This is a rough design of a way to supply commentary and formal documentation for Unison code. [Discuss here](https://github.com/unisonweb/unison/issues/462) and also be sure to view the raw markdown file for some embedded comments. + +## Comments + +Comments in Unison can be either line comments or block comments. It’s probably only necessary to implement one of these for a first release of Unison, but ultimately we may want to offer both. + + + +### Line comments + +Line comments can be introduced in code with a special token. For example, if we want Haskell-like syntax, the `--` token introduces a comment: + +``` +foo x y = + -- This is a comment + x + y +``` + +Line comments follow these syntactic rules: + +1. A line comment must occupy the whole line. For simplicity, it’s a syntax error to put a comment at the end of a line that contains anything other than whitespace. +2. The comment is attached to the abstract syntax tree node that is BEGUN by the token following the comment. +3. When rendering comments, the indentation should be the same as the token that follows the comment. + + + +### Block comments + +Block comments can be introduced with special brackets. For example, if we want Haskell-like syntax, the `{-``-}` brackets delimit a block comment: + +``` +foo x y = + {- This is a comment. -} x + y + +foo x y = {- comment -} (x + y) + +foo x y = + {- comment -} + (x + y) + +foo x y = + {- comment -} + x + y +``` + +Block comments follow these syntactic rules: + +1. A block comment can appear anywhere. +2. The comment is attached to the abstract syntax tree node that is BEGUN by the token following the comment. If that's not defined, could be an error, or could just use some ad hoc heuristic to find "nearest" AST node. +3. When rendering comments, the indentation should be the same as the token that follows the comment. + + + +### Comments and code structure + +Comments should not have any effect on the hash of a Unison term or type. I propose that comments be kept as an annotation on the AST rather than as part of the AST itself. This way, comments can be edited, added, or removed, without touching the AST. + + + +### Comments and the codebase + +Comments should be stored in the codebase as annotations on the syntax tree. For example, under the hash for the term (or type), we could add a new file `comments.ub` that contains the comments in pairs of `(AST node index, comment text)`. + +A future version might allow for multiple comment sets (commentary with different purposes or audiences) by adding e.g. a tag field to the comments, or having a whole `comments` directory instead of just one file. + + + +## API documentation + +Any hash in the codebase can have formal API documentation associated with it. This might include basic usage, free-text explanations, examples, links to further reading, and links to related hashes. + +Probably some flavor of Markdown is ideal for API docs. + + + +### The Unison CLI and API docs + +Ultimately we’ll want to have a more visual codebase editor (see e.g. Pharo Smalltalk), but for now we have the Unison CLI. So there ought to be a special syntax for indicating that you want to associate API docs to a definition when you `add` it to the codebase (or `update`). This syntax should be light-weight and easy to type. + +For example: + +``` +{| `foo x y` adds `x` to `y` |} + +foo x y = x + y +``` + +The rule here would be that the documentation block gets associated with the definition that immediately follows. + +Alternatively, something like: + +``` +{foo| `foo x y` adds `x` to `y`|}. +``` + + + +This would associate the documentation block to the hash named `foo` even if that hash isn’t being otherwise edited in the file. + +### Semantic content of API docs + +Wherever docs have code (in Markdown between fences or backticks), Unison should parse that code, resolve names, and substitute hashes for names. + +E.g., the doc might have a usage example: + +``` +{| +Usage: `foo x y` adds `x` to `y`. +|} +``` + +When this doc block gets processed by Unison, it should parse `foo x y` and recognize that `foo`, `x`, and `y` are free. It should replace `foo` with a hyperlink to the hash of `foo`. It should do this for every name that exists in the codebase. + +There should be some syntax to exclude a code block from this processing. + +Alternatively, we could have special syntax to indicate that something should be parsed as a Unison name. E.g. + +``` +{| +Usage: `@foo x y` adds `x` to `y`. +|} +``` + +Where `@foo` indicates that `foo` is a Unison name, we’d like an error if it isn’t, and it should be replaced in the rendered docs with a hyperlink to `foo`. + +### Opinionated doc format + +It’s possible that we’ll want to be very opinionated about how what goes into API documentation, for uniformity across libraries and ease of use. + +For example, we might have API docs support the following fields for a function definition: + + - Usage: How to call the function. E.g. “`foo x y` adds `x` to `y`”. We should maintain the invariant that the usage is correct (that it matches the name of the function and its arity). + - Examples: discussed above. + +Note that author name, time stamp, etc, can be inferred from the codebase. These are data that can be displayed in the API docs when rendered, but don’t need to be written by the author. + + + +## Docbase/Wiki + +Separately from API documentation, it would be good to be able to write tutorials or long-form explanations of Unison libraries, with links into the codebase API docs. + +We’d need to write a tool that can process e.g. Github-flavoured Markdown together with a Unison codebase. The markdown format would have Unison-specific extensions to allow hyperlinking Unison hashes as well as Tut-style evaluation of examples. + +Ideally, the documentation would be kept automatically up to date in the face of renames, etc. + +Processing has to have two distinct phases, authoring and rendering. + + - *Authoring*: you write the markdown document and use Unison human-readable names in your code. When you add your document to the docbase, all the names get replaced with Unison hashes before being stored. + - *Rendering*: A document stored in the docbase could then be rendered as e.g. HTML (or Markdown) where Unison hashes are turned back to human-readable names from the codebase, and hyperlinked to the API documentation for the hashes. + + + +### Transclusion + +A particularly useful feature for this kind of documentation tool would be *transclusion* of code. E.g. with a syntax like… + +``` +{:transclude MyLibrary.myFun} +``` + +The tool could render that as a code block containing the definition of `MyLibrary.myFun`. Ideally that would register this document as a dependency of `MyLibrary.myFun` and propagation of updates could work the same way as for code. + +It would be good to also have a way (as in Elm) of transcluding the API docs of individual types and functions in a document. + +This is a way of keeping documentation automatically up to date, at least partially. diff --git a/unison-src/transcripts/project-outputs/docs/configuration.output.md b/unison-src/transcripts/project-outputs/docs/configuration.output.md new file mode 100644 index 0000000000..0bf4d06de5 --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/configuration.output.md @@ -0,0 +1,176 @@ +# Configuration + + - [UCM Configuration](#ucm-configuration) + - [`UNISON_DEBUG`](#unison_debug) + - [`UNISON_PAGER`](#unison_pager) + - [`UNISON_LSP_PORT`](#unison_lsp_port) + - [`UNISON_LSP_ENABLED`](#unison_lsp_enabled) + - [`UNISON_SHARE_HOST`](#unison_share_host) + - [`UNISON_SHARE_ACCESS_TOKEN`](#unison_share_access_token) + - [`UNISON_READONLY`](#unison_readonly) + - [`UNISON_ENTITY_VALIDATION`](#unison_entity_validation) + - [Local Codebase Server](#local-codebase-server) + - [Codebase Configuration](#codebase-configuration) + +## UCM Configuration + +### `UNISON_DEBUG` + +Enable debugging output for various portions of the application. +See `lib/unison-prelude/src/Unison/Debug.hs` for the full list of supported flags. + +E.g. + +``` sh +# Enable ALL debugging flags (likely quite noisy) +$ UNISON_DEBUG= ucm +# Enable timing debugging, printing how long different actions take. +$ UNISON_DEBUG=timing ucm +# Enable LSP and TIMING debugging +$ UNISON_DEBUG=lsp,timing ucm +``` + +### `UNISON_PAGER` + +Allows selecting which pager to use for long command outputs. +Defaults to `less` on Linux & Mac, `more` on Windows + +E.g. + +``` sh +# User more instead of less +$ UNISON_PAGER=more ucm +``` + +### `UNISON_LSP_PORT` + +Allows selecting the port to run the LSP server on. Defaults to `5757`. + +E.g. + +``` sh +$ UNISON_LSP_PORT=8080 ucm +``` + +### `UNISON_LSP_ENABLED` + +Allows explicitly enabling or disabling the LSP server. +Acceptable values are 'true' or 'false' + +Note for Windows users: Due to an outstanding issue with GHC's IO manager on Windows, the LSP is **disabled by default** on Windows machines. +Enabling the LSP on windows can cause UCM to hang on exit and may require the process to be killed by the operating system or via Ctrl-C. +Note that this doesn't pose any risk of codebase corruption or cause any known issues, it's simply an annoyance. + +If you accept this annoyance, you can enable the LSP server on Windows by exporting the `UNISON_LSP_ENABLED=true` environment variable. + +You can set this persistently in powershell using: + +``` powershell +[System.Environment]::SetEnvironmentVariable('UNISON_LSP_ENABLED','true') +``` + +See [this issue](https://github.com/unisonweb/unison/issues/3487) for more details. + +E.g. + +``` sh +$ UNISON_LSP_ENABLED=true ucm +``` + +### `UNISON_SHARE_HOST` + +Allows selecting the location for the default Share server. + +E.g. + +``` sh +$ UNISON_SHARE_HOST="http://localhost:5424" ucm +``` + +### `UNISON_SHARE_ACCESS_TOKEN` + +Allows overriding the credentials used when authenticating with the Share server. + +E.g. + +``` sh +$ UNISON_SHARE_ACCESS_TOKEN="my.token.string" ucm +``` + +### `UNISON_READONLY` + +Force unison to use readonly connections to codebases. + +``` sh +$ UNISON_READONLY="true" ucm +``` + +### `UNISON_ENTITY_VALIDATION` + +Allows disabling validation of entities pulled from a codebase server. +It's generally a good idea to leave this enabled unless you know exactly what you're doing. + +Defaults to enabled. + +``` sh +$ UNISON_ENTITY_VALIDATION="false" ucm +``` + +### `UNISON_PULL_WORKERS` + +Allows setting the number of workers to use when pulling from a codebase server. +Defaults to 5. + +``` sh +$ UNISON_PULL_WORKERS=6 ucm +``` + +### `UNISON_PUSH_WORKERS` + +Allows setting the number of workers to use when pushing to a codebase server. +Defaults to 1. + +``` sh +$ UNISON_PULL_WORKERS=2 ucm +``` + +### `UNISON_SYNC_CHUNK_SIZE` + +Allows setting the chunk size used in requests when syncing a codebase. +Defaults to 50. + +``` sh +$ UNISON_SYNC_CHUNK_SIZE=100 ucm +``` + +### Local Codebase Server + +The port, host and token to be used for the local codebase server can all be configured by providing environment +variables when starting `ucm`, using `UCM_PORT`, `UCM_HOST`, and `UCM_TOKEN`. + +E.g. + +``` sh +UCM_PORT=8080 UCM_HOST=localhost UCM_TOKEN=1234 ucm +``` + +## Codebase Configuration + +Also, see the guide [here](https://www.unison-lang.org/learn/tooling/configuration/) + +The following configuration options can be provided within the `.unisonConfig` file, +which exists within the codebase directory, or at `~/.unisonConfig` for your default codebase. + +``` +# Attach myself as author and use BSD license for all of my contributions +DefaultMetadata = [ ".metadata.authors.chrispenner" + , ".metadata.licenses.chrispenner" ] + +# RemoteMapping allows mapping a path in the codebase to a specific location on share. +# Here I state that I want my .share namespace to push to .chrispenner.public +# Everything inside .share will be mapped accordingly, e.g. .share.foo will map to +# chrispenner.public.foo on share. +RemoteMapping { + share = "chrispenner.public" +} +``` diff --git a/unison-src/transcripts/project-outputs/docs/data-types.output.md b/unison-src/transcripts/project-outputs/docs/data-types.output.md new file mode 100644 index 0000000000..7adf0b87c2 --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/data-types.output.md @@ -0,0 +1,34 @@ +# Type declaration hashing and identity + +This doc describes how data types are uniquely identified in Unison. There's been a bunch of discussion on this topic (todo - I can't seem to find the link to past discussions, help\!) but for v1 we'll keep it simple. We may add other ways of generating data type identities if/when we decide we really need it. + +> 🚧 There's duplication between this doc and type-declarations.markdown ([github link](https://github.com/unisonweb/unison/blob/master/docs/type-declarations.markdown)). + +**Background:** In most languages, a data type is uniquely identified by some named type within some package. If either the package name is changed (due to a new numbered release of the package) or the module name or name of the type is changed, this results in a type that the language type system considers to be different. + +In Unison, a type declaration (introduced by either the `type` or `ability` keyword) creates a type which is uniquely identified in one of two ways: + + - A *structural* type declaration is identified by a hash of its structure, exactly as is done for hashing of a term. This is the current default if you just write: `type Blah = ...`. + - A *nominal* type declaration is identified by a GUID generated at the time the declaration. Syntax for this is TBD, but perhaps: `nominal type Blah = ...` + +Notes: + + - Structural types have unordered constructors, and their identity isn't affected by the names chosen, so `type O a = N | S a` is the same type as `type Maybe a = Just a | Nothing`. + - If the user writes a structural type where two constructors have the same structure, that's a type error and the user should be prompted to either make the structure different or choose a different. + - Nominal types have ordered constructors. The order of the constructors is frozen at the time of the creation of the type. The constructors and the type may be renamed, but the GUID associated with the type never changes. + +Nominal types are to be used for things like "days of the week". Structural types are to be used for things like `List` or `Maybe`. + +That's it for now. + +## Other ideas and notes + +Possibly for later: + + - *opaque/whatever* - a newtype with some privileged functions that can treat it as a type alias instead of newtype + - *algebraic* - defined by a set of laws (Monoid, Semilattice, etc) Question around how those laws are encoded + +Other notes: + + - Want a nice story for refactoring: e.g. if I have a conversion from T1 to T2, that can be applied automatically everywhere T1 is in positive position. T2 -\> T1 will cover where T1 is in negative position; isomorphism will cover both. + - Want a nice story for discovery of existing types to limit fragmentation. diff --git a/unison-src/transcripts/project-outputs/docs/distributed-api-discussion-v1.output.md b/unison-src/transcripts/project-outputs/docs/distributed-api-discussion-v1.output.md new file mode 100644 index 0000000000..c859ec1752 --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/distributed-api-discussion-v1.output.md @@ -0,0 +1,285 @@ +# Distributed programming API v1 discussion + +``` haskell +type Either a b = Left a | Right b +type Status = Running | Finished | Canceled | Error Error +type Error = + Unknown | Unreachable | Unresponsive | AbilityCheckFailure + +ability Remote location where + fork : location {e} -> '{e} a ->{Remote location} Future a + join : Future a ->{Remote location} Either Error a + status : Future a ->{Remote location} Status + cancel : Future a ->{Remote location} Either Error () + +type Future a = Future + ('{Remote loc} (Either Err a) -- join + ,'{Remote loc} () -- cancel + ,'{Remote loc} Status, -- status + , Duration ->{Remote loc} ()) -- keepalive (seconds 10) +``` + +Feb 11 Q\&A: + + - Do we need `Remote.here`? Thinking is: we don’t, we can just get one when starting the Unison Remote server; can then use that value, or restricted derivatives, in applications. + +``` +Unison.server + -> (Location {e} ->{Remote Location} r) -- local computation + -> {e} r -- rrrrresult +``` + +`handle expression with handler` OR +`with handler handle expression` +\* How do you launch anything? +\* Watch expression lol +\* launch + + - What does it mean to `cancel`? + Proposal: Runtime needs to support this. `fork`-ing in Unison likely works by forking a new instance `t` of Haskell runtime; that Haskell thread `t` can be asynchronously interrupted. So, the implementation of `Future.cancel` just throws a Haskell async exception into `t`, terminating that instance of the runtime. + + - How do decide if a received computation is allowed to be run? (and we are capable of running it?) + + 1. Some Unison term comes over the wire. + 2. \-Decide the type (typecheck? maybe slow? some other proof?)- No, we can use runtime exception. + 3. Scan the term for unknown hashes. (Could we do this lazily? Arya says: that’s crazay \[sic\]\! Rúnar adds: Sounds super fragile.) + - Could speculatively send some dependencies with the initial request, especially if protocol has minimum message size, but maybe not easy to anticipate which dependencies will be needed at remote end. + - If doing this lazily, could spare sending definitions for code paths not used during this particular execution. + - Could get started running the computation if there’s any work that can be done before receiving missing dependencies. Background thread works to populate the term cache from remote sources. + 4. If missing some of the dependencies, send list of references back to originator for definitions. Repeat steps 3–4 until the whole application is loaded / cached / whatever. + 5. Just run it and then complain if encountering an unexpected ability request. + + - How do actually run one? + +----- + +Do we need to choose a representation of `Location` now? + + - No, we can use incrementally more sophisticated representations. e.g., loc can initially be `()` or `Nat`, and the handler can maintain pure maps or whatever. (note: need pure maps). + - Yes, because the entire `Remote` ability needs to be defined up front, but some APIs e.g. relating to “keepalives” only make sense in the context of true multi-node Locations. + +Do we need to choose a representation of `Future` now? + + - Yes, because the entire `Remote` ability needs to be defined up front, but we may need additional remote abilities to operate on `Future`s. + - It can just be `'{Remote loc} a` + - No, this representation doesn’t contain enough info to asynchronously identify the computation, e.g. to support `Remote.status` in a multi-node implementation. + - It can be some kind of handle or GUID. + - Can we index typed results by untyped handle? + +Do we need the ability to automatically clean up zombie tasks? This informs the discussion around keepalives. + + - Yes: + +## Locations + +A Location is simply a computing context with access to certain computational resources. The `Remote` ability is parameterized with a Location type `loc`, giving us significant flexibility in defining various `Remote` interpreters. The interpreter can then require a `loc` that describes resources in whatever way it likes, and the interpreter can be paired with an appropriate implementation for obtaining or generating `loc`s. + +For example: + +``` haskell +runLocal : '{Remote () ()} a -> a +runLocal r = + step nid r = case r of + {a} -> a + {Remote.fork t -> k} -> handle (step nid) in k t + {Remote.spawn -> k} -> handle (step (Node.increment nid)) in k nid + {Remote.at _ t -> k} -> handle (step nid) in k !t + handle (step (Node.Node 0)) in !r +``` + +Its runtime representation is essentially a collection of cryptographic tokens authorizing the use of these resources. + +In Unison code, a Location is represented by a `Loc {e}`. A Unison value of type `Loc {}` supports only pure computations, whereas a `Loc {Remote, GPU}` provides the `Remote` and `GPU` abilities. + +### Locations have a composite runtime representation + +A `Loc` is represented by one or more host / port / auth tokens, along with ability use tokens. The `Remote` handler may use any algorithm in selecting a host to submit a task to, and the receiving host will run the computation provided the accompanying tokens are valid. + +``` haskell +-- Haskell runtime representation +-- individual Tokens should be cryptographically unguessable. +-- Tokens may correspond to or contain quota/other data. +data Loc = Loc Hosts Abilities +type Token = TBD +type Hosts = Map (Hostname,Port) Token +type Abilities = Map Reference Token -- Map Reference (PublicKey, RandomDigits, signature(publicKey, randomDigits <> reference)) +``` + +### What's in a Token? + +In this formulation, Token is a possibly-parameterized catch-all that includes whatever information is necessary to securely authorize some use. + +Stateless tokens will include: + + - A description of the authorized resource/activity, sufficient to be understood by the resource servers. + - A signature by entity trusted by the resource server. + - If the token is composite, each separable piece must be individually signed. Signatures are typically the size of the key (4096 bits = 512 bytes), so they can start to add up. + +They will optionally include: + + - An expiration / validity period - or be valid in perpetuity + - An "audience", identity of the target resource server, in cases where the signature key is too broad to identify the resource server. + +Example: + +``` +Token = + abilities e_1, ..., e_n <> expiration + <> signature ku ([e_1 ... e_n] <> expiration) + <> fingerprint ku + +or: + (e_1 <> expiration <> signature ku (e_1 <> expiration) <> fingerprint ku) +<> ... +<>(e_n <> expiration <> signature ku (e_n <> expiration) <> fingerprint ku) +``` + +This is leading up to an exponential number of signatures, just to support `Loc.restrict`. So, let's look at some schemes for delegation. + +### Elastically producing new Locations + +An elastic compute service “front-end” would expose: +1\. a function to `provision` new locations +2\. a Location at which the function could be run + + - Can I have this `provision` function in my namespace, without having its implementation in my codebase? + + + + - \[ \] The implementation of `provision` would need some way to authenticate and validate the request. + - \[ \] It would need some way to construct a Unison `Loc` value (not yet discussed). + - \[ \] It should provide a way for the front-end to monitor utilization and spin up or shut down physical resources as needed. + +*Idea*: Maybe the `Token` value provided by the front-end is structured in a provider-specific way, with whatever data is needed to make these decisions. Having a distinct `Token` type for distinct providers means another type parameter on the `Loc`, which could answer the question about consolidating `Loc`s on the user side. If two Locations share the same provider type, they can be consolidated (hosts, quotas, abilities); otherwise they obviously couldn’t be. + +``` haskell +Remote.forkAt : Loc {e} p -> '({e} a) ->{Remote} Future a +Location.join : Loc {e} p -> Loc {e2} p -> Loc {e,e2} p +``` + +## Futures + +A `Future` represents an asynchronous computation. `Remote.forkAt` takes a computation and returns immediately with a `Future`. To wait for the computation’s output, use `Future.force`. + +``` haskell +Remote.forkAt : Loc {e} ->'({e} a) ->{Remote} Future a +Future.force : Future a ->{Remote} (Either Err a) +type Err = TBD + +-- example: +f1 = forkAt a 'let + x = longRunningComputation 101 + makeHistogram x +y = otherLongComputation +x = Future.force f1 +Database.save (x, y) +``` + + - How many times can a future be successfully forced? Suppose a future is shared with 5,000 machines. The task backing the future eventually completes, and now what? + - The thought: the machines sending keepalives (subscribers?) are retained at the Location performing the computation; when the computation is complete, the Location should send the result back to those subscribers. The subscribers save the result in their caches until they no longer reference the `Future`. + - Random thing - if 5,000 nodes have a reference to a future, the status update / keepalive protocol should come with a response like "send me another keeplive within X time", where X is influenced by the number of other subscribers / density of keepalives. This prevents flooding the network with keepalives. + +### Supervision and garbage-collection of Futures + +Unison Futures can be monitored or terminated using: + +``` haskell +Future.status : Future a ->{Remote} Future.Status +type Future.Status + = Running LastUpdate | Canceled | Finished + | Unreachable | Unresponsive + +Future.cancel : Future a ->{Remote} (Either Err2 ()) +type Err2 = TBD +``` + +To the extent that an async computation should be canceled if there is no other computation interested in its result, we need some way of determining whether or not this is the case. We discussed having a system of keep-alives, absent which a Future might be canceled by its host: + +``` haskell +-- these likely will just be handled by the interpreter +-- of Remote, not by "user" code. +Future.keepalive : Duration -> Future a ->{Remote} Status +Future.remaining : Future a ->{Remote} Duration +``` + +Moreover, there will be cases where we want to transfer or delegate the keep-alive responsibility for a long-running tasks to a more available location. + +``` haskell +Remote.supervise : Loc {e} -> Future a -> {Remote} () +Remote.unsupervise : Loc {e} -> Future a -> {Remote} () +``` + +> We discussed producing a `Heartbeat` identifier along with any `Future`, but decided there was no benefit to separating the two. + +We haven’t discussed how to prevent a delegate supervisor from accumulating and perpetuating many long-running Futures that will never actually be forced. With this in mind, have we gained anything from a GC perspective? + +## Stationary data + +We will need some notion of data that doesn't just move automatically with the computation, even if the computation references it. We identified two reasons you might want to do this: + + - The data is big, and you don't want to copy it around willy-nilly. + - The data is secret, and you don't want to accidentally ship it to another location, you want to be very explicit about when this happens (for instance, secret keys, etc). + +More generally, we want a way of being explicit about when certain data is moved between locations, rather than implicitly relocating anything in lexical scope (this could be an API thing, a type-system thing, a code-analysis tool). + +----- + +## Notes/Desiderata + + - \[ \] Elastic computation - need to be able to talk about spawning new computing resources, and ideally this compute can be garbage collected as soon as you're done using it. + - \[x\] `fork` a task to run on a separate thread or at another "location" + - \[x\] Different locations may have access to different abilities (just pure computation, `IO`, `GPU`, etc) + - \[x\] Need to be able to respond to location failures, with maximal flexibility. Allow different ways of doing failure detection/recovery. + + + + - Locations are first-class, permissions, tasks, are first-class + - \[x\] locations + - \[ \] permissions? + - \[x\] tasks (futures) + + + + - \[ \] Some notion of data that doesn't just move automatically with the computation, even if the computation references it. + + - e.g., The data is big, and you don't want to copy it around willy nilly. + - e.g., The data is secret, and you don't want to accidentally ship it to another location, you want to be very explicit about when this happens (for instance, secret keys, etc). + - Might more generally want a way of being explicit about when data is moved to a location rather than just implicitly relocating anything in lexical scope (could be an API thing, a type system thing, a tool). + + - \[x\] Need to be able to launch a long-running computation and have it outlive the task / location / node that launches it. But then how do you interact with this computation later? (Say, to cancel it? Or to check if it's finished? Or more generally, how do you monitor it?) + + - \[ \] Need to be able to hash and serialize any Unison value, so that storage API(s) can be implemented in pure Unison. + + - Should the hash of a value know the type of the value? (`hash : a -> Hash a`) + + - \[x\] How do you represent `Loc{e}` to be securely verified by the receiving node? The `Loc{e}` must be unguessable and tamper-proof. + + - This is achieved by making the component `Token`s unguessable and tamper-proof. + + - \[ \] Must be safe to say `at loc1 loc2` without allowing nefarious loc1 to abuse loc2. (Needs clarification.) + + - \[x\] The runtime needs an unguessable way (crypto?) to represent Locations and their abilities. + + - \[ \] Not all computations should have access to all data. + + - file system + - individual durables + + - \[x\] Not all Locations should provide unlimited resources to all users (arbitrary computation, time, storage, bandwidth, priority). + + - \[ \] Not all data should be portable to arbitrary locations (think secret keys, top secret clearance, hipaa). + +*Misc?*: + + - Mutable typed (durable if needed) state at each location + - For v1, could not have this, just focus on batch computation + - Dealing with weird networks? (nat-busting) + - Maybe in implementation, but not explicit in v1 API + - Well-defined semantics not just a bunch of implementation-defined gobbledygook + - Do we need globally-addressed mutable state? e.g. node `a` can refer to mutable data on node `b`; or node `c` can mutate data on node `d`. Yes, probably. + +## Choices + + - We decided that automatically cancelling a child computation when its parent terminates or delaying termination of of the parent until its children complete would break associativity in terms of parallelism when chaining computations, therefore `forkAt` doesn’t enforce any such conditions. See more about cancellation & termination below, in “Supervision and garbage-collection of Futures” + +\#unison diff --git a/unison-src/transcripts/project-outputs/docs/distributed-garbage-collection.output.md b/unison-src/transcripts/project-outputs/docs/distributed-garbage-collection.output.md new file mode 100644 index 0000000000..facbfb93cd --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/distributed-garbage-collection.output.md @@ -0,0 +1,94 @@ +## Distributed Garbage Collection + +We use a weak `B` map, to track local boxes (entries are removed by virtue of being a weak map once they are no longer referenced in local heap / boxes): + +``` haskell +B_map :: WeakMap BoxId (MVar Value) +``` + +and a weak `C` set, tracking all remote boxes referenced by local heap / boxes: + +``` haskell +type RemoteBox = (BoxId, Node) +C_set :: WeakMap RemoteBox +``` + +Each local box `b` has an associated value, and associated set of boxes referenced by its contents, `b_subs`. + +``` haskell +let keepaliveDuration = 20.seconds -- or whatever +type Keepalive = Keepalive { b :: BoxId, visited :: Set RemoteBox } +``` + +**Receiving Keepalives** +When node `n` receives a keepalive message for BoxId `b` + +1. If `n` doesn't own `b`, disregard (shouldn't occur) +2. Else if `(b,n)` ∈ `visited`, disregard (normal occurrence) +3. Else + 1. Create a strong reference to `b` for a fixed period of time (`keepaliveDuration`) + 2. Let `b_subs` be the set of all boxes (local and remote) referenced by `b`. + 1. If `b_subs` is not cached, and no existing process is indexing `b`, starting indexing `b` and cache the result when complete. + 2. If indexing does not complete in time, do not interrupt indexing, but use `C_set` as an approximation of `b_subs` for the purposes of processing this particular keepalive message. + 3. For each `b_i` ∈ `b_subs`, + 1. If `b_i` is a remote box, send `(Keepalive b_i (Set.insert (b,n) visited))` to the owner of `b_i`. + 2. If `b_i` is a local box, process `(Keepalive b_i (Set.insert (b,n) visited))` locally. Whether or not you hit the network is up to you, but in this scheme, we do need to recursively propagate keepalives through local boxes. + +To compute `b_subs` (set of boxes referenced by the value inside the `b` box): + +1. Keep mutable cache `Optional [BoxId]` for each runtime value, `v`, tracking boxes referenced transitively by `v`. +2. Do a deep scan of the `v` inside the box to fully populate caches, recursively. +3. Avoid revisiting subtrees that already have a computed cache. + +**Receiving Continuations or Box Updates** +When a continuation `c` is transferred from node `x` to node `y`, or when value `c` is `Box.put` from node `x` to node `y`, node `y` adds non-local boxes referenced by `c` to `C_set`. (This indexing may be done as part of the network deserialization.) + +We must ensure that boxes referenced by `c` are not GCed before `y` can issue keepalives; this means that node `x` must send keep-alives to any boxes referenced by `c` during the transfer (this should already happen without special care) and at least once more after the transfer has completed, to avoid a race condition while `y` takes over the keepalives. This may mean that both nodes `x` and `y` must also index `c` while it is being transferred. + +**FAQ** +Q: Will `C_set` contain all of the remote boxes referenced by local boxes? +A: Yes: to store a value into `b`, the value must be constructed within some continuation. Remote box references can only exist in a continuation transferred from a remote node, or a value `Box.put` from a remote node. In both of these cases, any remote boxes referenced in the transfer are indexed into `C`, per "Receiving Continuations or Box Updates" above. + +Q: Can we say that durable values don't keep boxes alive? That a durable shouldn't expect any particular value to be preserved in a referenced box? +A: ... + +Q: If a remote node has computed the `Optional [BoxId]` for a runtime value, should the remote node transfer that cache to me? +A: ... + +**Optimizations** + + - Avoid allocating boxes to B-map and C-set until first transfer. Until first transfer, boxes are just a regular `MVar` on the stack. + +\*\* Example reference graph\*\* + +``` haskell +type Foo = Ref (Box Foo) | No_Ref + +do Remote + Remote.transfer x + q := Box.make + r := Box.make + Remote.transfer y + s := Box.make + t := Box.make + Remote.fork <| do Remote + sleep-random-duration + Box.take t + Box.put q (Ref s) + Box.put s (Ref r) + Box.put r (Ref t) + Box.put t (Ref q) + Box.put t No_Ref -- maintains cycle until Box.take t, then breaks cycle +``` + +``` text + x y + ┌─┐ ┌─┐ + ┌>│q│──>│s│ + │ ├─┤ /├─┤ + │ │ │ / │ │ + │ ├─┤└ ├─┤ + │ │r│──>│t│ + │ └─┘ └─┘ + └────────┘ +``` diff --git a/unison-src/transcripts/project-outputs/docs/distributed-programming-rfc.output.md b/unison-src/transcripts/project-outputs/docs/distributed-programming-rfc.output.md new file mode 100644 index 0000000000..4ffa4b2108 --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/distributed-programming-rfc.output.md @@ -0,0 +1,223 @@ +This document describes a set of core Unison functions for expressing fault-tolerant multi-node systems, including systems that must be dynamically updated and redeployed without downtime. + +Remarks: + + - There's a mixture of old and new stuff here, see the [history section](#history) for background. + - Some version of these APIs will be implemented on the new Unison runtime. We are looking to gather design feedback and possibly iterate the design before starting on the implementation. + - Some of these primitives are rather low-level and imperative; it's expected that people will use them to build nicer APIs in pure Unison. + - Questions are good if you have them; ask away in the comments and we'll curate that into a Q\&A section of the document. + +Lastly, thank you to all who have contributed to this design or worked on earlier iterations\! + +### The API + +Unison computations can hop between nodes, can fail, can be forked to execute asynchronously, and can be supervised: + +``` Haskell +-- Promote a pure value to `Remote` +Remote.pure : ∀ a . a -> Remote a + +-- Sequencing of remote computations +Remote.bind : ∀ a b . (a -> Remote b) -> Remote a -> Remote b + +-- The current node where the computation is executing +Remote.here : Remote Node + +-- Transfer control of remainder of computation to target node +Remote.transfer : Node -> Remote Unit + +-- Explicitly fail a computation for the provided reason +Remote.fail : ∀ a . Text -> Remote a + +-- Sleep the current computation for the given duration +Remote.sleep : Duration -> Remote Unit + +-- Start running a remote computation asynchronously, returning +-- a `Task` value that can be used for supervision +Remote.fork : ∀ a . Remote a -> Remote Task + +-- Halt a running task (and any running subtasks) using the provided `Cause` +Task.stop : Cause -> Task -> Remote Unit + +-- Obtain the `Cause` that caused a running task to complete +Task.supervise : Task -> Remote (Remote Cause) + +-- Create a duration from a number of seconds +Duration.seconds : Number -> Duration + +-- this is TBD +type Cause = Error Text Node | Completed | Cancelled | Unresponsive Node +``` + +Unison computations can provision new nodes: + +``` Haskell +-- Like `Remote.spawn`, but create the node inside a fresh sandbox +Remote.spawn-sandboxed : Sandbox -> Remote Node + +-- Like `Remote.spawn-sandboxed`, but use the provided symmetric key +-- to communicate with the returned `Node` +Remote.spawn-sandboxed' : Key -> Sandbox -> Remote Node + +-- Create a new node 'in the same location' as the current node, sharing +-- current sandbox resources +Remote.spawn : Remote Node + +-- Like `Remote.spawn`, but use the provided symmetric key +-- to communicate with the returned `Node`. +Remote.spawn' : Key -> Remote Node + +-- Statically provision a `personal-info : Node` +node personal-info -- layout block starts here + Sandbox 5% 10MB 3GB accept-from + +-- TBD +type Sandbox = + Sandbox CPU% Memory Storage (∀ a . Node -> Remote a -> Remote a) +``` + +We can encrypt / decrypt any value at all: + +``` Haskell +-- Encrypt a value, requires `Remote` since we use random IV / nonce +encrypt : ∀ a . Key -> a -> Remote (Encrypted a) + +-- Decrypt a value, or return `None` if key is incorrect +decrypt : ∀ a . Key -> Encrypted a -> Either DecryptionFailure a + +-- `Key` is just a symmetric encryption key. We might generate keys via: + +AES256.key : Remote Key +Blowfish.key : Remote Key +-- etc + +-- TBD +type DecryptionFailure = WrongKey | AlgorithmMismatch | IntegrityFailure +``` + +Unison programs have access to mutable variables, which also serve as a concurrency primitive: + +``` Haskell +-- Create an ephemeral `Box` on the current node; just a (GUID, Node) at runtime +Box.empty : ∀ a . Remote (Box a) + +-- Put a value into the box, or if the box is full, +-- wait until a `Box.take` empties the box. +Box.put : ∀ a . a -> Box a -> Remote Unit + +-- Remove and return the value in the box, or if the box is empty, +-- wait until a `Box.put` fills the box. +Box.take : ∀ a . Box a -> Remote a + +-- Like `Box.take`, but leaves the value inside the box +Box.read : ∀ a . Box a -> Remote a + +-- Read the current value inside the box or return `None` immediately. +-- Also returns a setter which returns `True` if the set was successful. +-- The `set` is successful only if the value inside the box has not +-- otherwise changed since the read, so this can be used to implement +-- "optimistic" atomic modifies. +Box.access : ∀ a . Box a -> Remote (Optional a, a -> Remote Bool) +``` + +Unison can resolve references dynamically on a node: + +``` Haskell +-- Create a `Name`, which is a typed reference to a node-local value. +Name.make : ∀ a . Remote (Name a) + +-- Lookup the node-local value associated with the `Name`. +Name.resolve : ∀ a . Name a -> Remote (Box a) + +-- Declare `bob : Name Number` statically. The value bound to +-- the `Name` does not survive node restarting. +ephemeral name bob : Number + +-- Declare `cluster-peers : Name (Vector Node)` statically. The current +-- value of `cluster-peers` survives node restarting. +durable name cluster-peers : Vector Node +``` + +Unison can make any value durable. `Durable` values are immutable: + +``` Haskell +-- Move any value from RAM to local durable storage +Durable.store : ∀ a . a -> Remote (Durable a) + +-- Synchronize any value AND ALL TRANSITIVE DEPENDENCIES +-- to local durable storage, returning `True` if the given `Node` +-- has that `Durable a` locally and the sync was successful. +Durable.sync-from : ∀ a . Node -> Durable a -> Remote Boolean + +-- Load a durable value into RAM, assuming it exists on the given node +Durable.load-from : ∀ a . Node -> Durable a -> Remote (Optional a) + +-- Returns a list of nodes that the Unison runtime believes could +-- successfully `Durable.load-from` or `Durable.sync-from` for the +-- given `Durable`. +Durable.peers : ∀ a . Durable a -> Remote (Vector Node) +``` + +Lastly, we can declare foreign functions: + +``` Haskell +-- Declare `my-fn : Foreign (Number -> Remote Number)` statically +-- Bindings for some of these foreign declarations would be done +-- in some implementation-dependent way on Unison node container startup. +foreign my-fn : Number -> Remote Number + +-- Ask the current node if it has a binding for a `Foreign a` +Foreign.ask : forall a . Foreign a -> Remote (Optional a) +``` + +## Notes on semantics and implementation details + +A basic design principle: the Unison runtime should never contact another Unison node unless the user's program explicitly indicates that node should be contacted. Thus, the runtime cannot run any sort of background task that contacts other nodes (like upkeep for a DHT), nor can it implicitly choose which nodes to contact (like doing some sort of autodiscovery to find "good" peers). The idea here is to make the runtime "as dumb as possible", and move all intelligence to regular Unison libraries. + +The `Task` returned by `Remote.fork` controls the entirety of the computation forked, including any subtasks forked. Stopping that `Task` stops anything that may be running underneath this fork. + +Implementation notes on `Task.supervise`: + + - At runtime, a `Task` value contains a `Node` reference where the `Task` was originally forked. + - To implement `Task.supervise`, the runtime maintains at each node a `Map Task (Timestamp, Status, Optional Node)`, tracking for each task a timestamped last update for that task (when it was running on the current node), and an `Optional Node` if the computation was transferred elsewhere. This `Map` can be pruned using some ad hoc policy (like retain 30s of data or 5000 entries). `Task.supervise` then just chases the computation, following these transfer links until it obtains a "recent enough" status update for the computation. If a node is unresponsive or unreachable, this eventually leads to an `Unresponsive` error being passed to the supervisor. + +On node local storage: + + - The association between a `Name` and a `Box` is *local to the node*. Conceptually, each node has its own durable and ephemeral storage. There is no storage concept exposed by Unison at any granularity beyond nodes (though of course you can write multi-node storage as regular Unison libraries). Nodes are isolated from each other and must communicate explicitly (even if the nodes are all spawned in a single sandbox). + - The `durable name blah : Name Number` is somewhat analogous to a typed file name. It can be resolved on any node to a `Box Number`, and the state of that `Box Number` (whether it is empty or full) will survive node restarts. + - The `node node-name` block declares a node statically, by proving a `Sandbox`. + - The various `Durable` functions give some flexibility to Unison programs in how they resolve `Durable` values and where they load them from. + +On storage and discovery of `Durable` values: + + - It's expected that `Durable.load : Durable a -> Remote a` could be implemented in terms of `Remote.load-from` and `Durable.peers` (with a small chance of failure if all nodes delete durable data stored elsewhere). + - A sketch of how `Durable.peers` map gets updated: + - Any call to `Durable.load-from n1 d` for a `d` not already present on the current node gets an entry in the peers map. + - When receiving a continuation via `Remote.transfer`, entries are added to the peers map for any durables not present on the receiving node. So if the continuation references `d : Durable Number`, and the sender's peer map for `d` was `[alice, bob, carol]`, then `[alice, bob, carol]` would be added to the recipient's peer map for `d`. If the sender's peer map is empty (because the sender has the `Durable` locally), we'd just add the sender to the peer map. + - Successful calls to `Durable.sync-from` clear out peers map entries for that `Durable` and its transitive dependencies, since once it's stored locally, we stop caring where else we could get it from. + - May want to prune the number of peers stored for a given `Durable`, if lots of peers have it. + +### Appendix: History and context + +**Most recently (after discussion in [\#142](https://github.com/unisonweb/unison/issues/142)):** + + - Split `Capability` into `Foreign` (for the foreign function interface) and `Name`, for locally bound names. + - Loading of `Durable` values is more explicit about *where* the values are being loaded from, but runtime provides enough info to implement good heuristics for discovering `Durable` values from peers more implicitly. + - There's now a way to statically declare a `Node`, which is important for bootstrapping a system. + +**V2 (after discussion in [\#141](https://github.com/unisonweb/unison/issues/141)):** + + - Got rid of `Clock` and `Index` in favor of immutable durable storage concept + mutable pointers. + - Got rid of `Channel` in favor of `Box`, also simplified `Capability` API to just build on `Box` directly. + - Got rid of `Heartbeat` arguments to a whole bunch of functions (like `Box.take`, etc), opting for just using the ambient lexically-scoped heartbeat established via `Remote.link`. 99% of the time this is what you want, and you can always push another `Heartbeat` onto the stack via a nested `Remote.link`. + - Clarified behavior around lifetimes of `Remote.fork`-ed computations and `Remote.spawn*` nodes--they always inherit the current ambient heartbeat. I believe this is key for composability, since it makes the interface for shutting down a subcomputation completely uniform. + +**Previously:** + +[This post](http://unisonweb.org/2015-06-02/distributed-evaluation.html) has an early writeup of how Unison's hashing scheme could be used to build a robust multi-node computation story. That eventually got an implementation, and as a demo I put together [a simple multi-node search engine](http://unisonweb.org/2016-10-12/search.html#post-start) in Unison. That raised a couple issues and questions, some discussed in that post, some discussed [in this post about microservices](http://unisonweb.org/2016-10-12/microservices.html#post-start), and some that I have just been ruminating on. 🤔 + +The big questions were around: + + - Lifecycle management of nodes and durable data---when is durable data destroyed, and when are nodes destroyed? This led to the `Heartbeat` design (which was later scrapped). + - Encryption: how are things encrypted, both at rest (in durable storage) and in transit (when moving between nodes). The solution given here is to have 'in transit' encryption handled transparently by the runtime, but to have encryption keys for durable state to be managed explicitly by the programmer. This allows for multiple nodes to use a common storage layer, without all reads needing to go through a common node. + - Dynamic updates and redeployment---how is this done? Solution given is the `Capability` stuff. diff --git a/unison-src/transcripts/project-outputs/docs/github-actions-help.output.md b/unison-src/transcripts/project-outputs/docs/github-actions-help.output.md new file mode 100644 index 0000000000..63eb0c717d --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/github-actions-help.output.md @@ -0,0 +1,92 @@ +## Some things I wish I'd known about Github Actions + +You can't have an `env:` key defined in terms of another `env` key, but you can use `$GITHUB_ENV` to get around this. + +You can't define a `matrix` at the top level, it has to be defined within a `job`'s `strategy`. + +`runs-on:` doesn't allow `env` for some reason. + +Strings don't need quotes, unless you need to force something to be a string. + +A `@ref` is always needed on a remote action. + +Windows doesn't seem to honor the `default: run: shell:` setting, so you need to set the `shell:` on `run:` manually? + +Don't hesitate to do a lot with `run:` blocks aka bash scripts — at least bash is mature and well documented. + +e.g. +echo "bar=whatever" \>\> $GITHUB\_OUTPUT +\# access with `steps..outputs.bar` in yaml strings + +``` +echo "foo=whatever" >> $GITHUB_ENV +# access with `env.foo` in yaml strings, or `$foo` in bash +``` + +`$GITHUB_ENV` updates the `env` context between steps, but not in the middle of a step. Obvious in retrospect. + +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. + +Therefore, I think the String interpolation in `if: ${{runner.os}} != 'Windows'` causes the whole expression to become a String, which is coerced to `true`, when you definitely didn't mean `if: true`. So don't use `${{}}` here. + +### Job names + +Job names will automatically get `(${{matrix.os}})` if you don't use `${{matrix.os}}` somewhere in the name. + +### Windows + +The whole thing with `.exe` is a mess. Unix commands typically drop and add `.exe` correctly as needed, but Github Actions (e.g. `actions/upload-artifact`?) don't. + +### Cache + +When using the `cache` action, getting a cache hit on the primary key means you won't update the cache with any changes. + +When picking a key, you have to ask, "Which key, if exactly matched, would mean that I'm already so done that I don't even want to save anything new from this run." + +Similarly, `save-always: true` only if a key hit means there will be nothing new to save, even if a previous run failed AND a failed result is worth starting with. + +Backup restore keys: "Is there a prior run that would be worth starting out from? With the caveat that any irrelevant garbage it includes will be saved into this run too." + +### Upload Artifact + +I suspect on Windows it can't support paths that select a drive in a Unix-y way, +like `/c/asdf` or `/d/asdf`. It's got to be `C:/asdf` or `C:\asdf` etc. + +Upload will complain if any + +Upload and Download plugin versions have to match. + +### Reusability + +Github supports splitting off "reusable workflows" (`jobs` that can be imported into another workflow), and "composite actions" (multi-step `steps` that can be imported into another `job`). + +#### Composite actions + +Needs to have `shell:` specified on every `run:` + +#### Reusable workflows + +These have to be in `.github/workflows`, you can't organize them deeper, or elsewhere. + +### Reference + +Default Environment Variables: +https://docs.github.com/en/actions/learn-github-actions/variables\#default-environment-variables + +Workflow syntax: +https://docs.github.com/en/actions/using-workflows/workflow-syntax-for-github-actions + +Reusable workflows: +https://docs.github.com/en/actions/using-workflows/reusing-workflows + +Composite actions: +https://docs.github.com/en/actions/creating-actions/creating-a-composite-action diff --git a/unison-src/transcripts/project-outputs/docs/language-server.output.md b/unison-src/transcripts/project-outputs/docs/language-server.output.md new file mode 100644 index 0000000000..2e766d2256 --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/language-server.output.md @@ -0,0 +1,223 @@ +# Unison Language Server + +[![asciicast](https://asciinema.org/a/Kwa7NscffA3R8KCHxq1OavRm0.svg)](https://asciinema.org/a/Kwa7NscffA3R8KCHxq1OavRm0) + + - [Overview](#overview) + - [Installation and setup](#installation-and-setup) + - [NeoVim](#neovim) + - [VSCode](#vscode) + - [Helix Editor](#helix-editor) + - [Emacs](#emacs) + - [other editors](#other-editors) + - [Configuration](#configuration) + +## Overview + +Supported features: + + - Autocompletion + - Inline type and parser error messages + - Format on save (you can disable this in your editor if you like) + - Show type on hover + +Notes: + + - The LSP listens for changes from the UCM it's linked to, so name resolution is dependent on your current UCM path. + +## Installation and setup + +Currently the only supported configuration is to connect to the LSP via a specified port, not all LSP implementations support this configuration. + +By default the LSP is hosted at `127.0.0.1:5757`, but you can change the port using `UNISON_LSP_PORT=1234`. + +Note for Windows users: Due to an outstanding issue with GHC's IO manager on Windows, the LSP is **disabled by default** on Windows machines. +Enabling the LSP on windows can cause UCM to hang on exit and may require the process to be killed by the operating system or via Ctrl-C. +Note that this doesn't pose any risk of codebase corruption or cause any known issues, it's simply an annoyance. + +If you accept this annoyance, you can enable the LSP server on Windows by exporting the `UNISON_LSP_ENABLED=true` environment variable. + +You can set this persistently in powershell using: + +``` powershell +[System.Environment]::SetEnvironmentVariable('UNISON_LSP_ENABLED','true') +``` + +See [this issue](https://github.com/unisonweb/unison/issues/3487) for more details. + +### NeoVim + +Before configuring the LSP, install the Vim plugin for filetype detection and syntax highlighting. +For [Packer](https://github.com/wbthomason/packer.nvim) you can install the package as follow: + +``` lua +-- You may need to increase the git clone timeout setting in Packer! +use { + "unisonweb/unison", + branch = "trunk", + rtp = "/editor-support/vim" +} +``` + +or [Plug](https://github.com/junegunn/vim-plug): + +``` vim +Plug 'unisonweb/unison', { 'branch': 'trunk', 'rtp': 'editor-support/vim' } +``` + +or [Lazy](https://github.com/folke/lazy.nvim/): + +``` lua +{ + "unisonweb/unison", + branch = "trunk", + config = function(plugin) + vim.opt.rtp:append(plugin.dir .. "/editor-support/vim") + require("lazy.core.loader").packadd(plugin.dir .. "/editor-support/vim") + end, + init = function(plugin) + require("lazy.core.loader").ftdetect(plugin.dir .. "/editor-support/vim") + end, +} +``` + +Configuration for [coc-nvim](https://github.com/neoclide/coc.nvim), enter the following in the relevant place of your CocConfig + +``` + "languageserver": { + "unison": { + "filetypes": ["unison"], + "host": "127.0.0.1", + "port": 5757, + "settings": {} + } + } +``` + +For [lspconfig](https://github.com/neovim/nvim-lspconfig) with optional autocomplete [nvim-cmp](https://github.com/hrsh7th/nvim-cmp) for LSP +[cmp-nvim-lsp](https://github.com/hrsh7th/cmp-nvim-lsp), you can use the following setup function(s): + +``` lua +-- This function is for configuring a buffer when an LSP is attached +local on_attach = function(client, bufnr) + -- Always show the signcolumn, otherwise it would shift the text each time + -- diagnostics appear/become resolved + vim.o.signcolumn = 'yes' + + -- Update the cursor hover location every 1/4 of a second + vim.o.updatetime = 250 + + -- Disable appending of the error text at the offending line + vim.diagnostic.config({virtual_text=false}) + + -- Enable a floating window containing the error text when hovering over an error + vim.api.nvim_create_autocmd("CursorHold", { + buffer = bufnr, + callback = function() + local opts = { + focusable = false, + close_events = { "BufLeave", "CursorMoved", "InsertEnter", "FocusLost" }, + border = 'rounded', + source = 'always', + prefix = ' ', + scope = 'cursor', + } + vim.diagnostic.open_float(nil, opts) + end + }) + + -- This setting is to display hover information about the symbol under the cursor + vim.keymap.set('n', 'K', vim.lsp.buf.hover) + +end + +-- Setup the Unison LSP +require('lspconfig')['unison'].setup{ + on_attach = on_attach, +} +``` + +``` lua +-- This is NVim Autocompletion support +local cmp = require 'cmp' + +-- This function sets up autocompletion +cmp.setup { + + -- This mapping affects the autocompletion choices menu + mapping = cmp.mapping.preset.insert(), + + -- This table names the sources for autocompletion + sources = { + { name = 'nvim_lsp' }, + }, +} + +``` + +Note that you'll need to start UCM *before* you try connecting to it in your editor or your editor might give up. + +### VSCode + +Simply install the [Unison Language VSCode extension](https://marketplace.visualstudio.com/items?itemName=unison-lang.unison). + +### Helix Editor + +To `~/.config/helix/languages.toml` append this code: + +``` toml +[language-server.ucm] +command = "nc" # or 'ncat' or 'netcat' +args = ["localhost", "5757"] + +[[language]] +name = "unison" +scope = "source.unison" +injection-regex = "unison" +file-types = ["u"] +shebangs = [] +roots = [] +auto-format = false +comment-token = "--" +indent = { tab-width = 4, unit = " " } +language-servers = [ "ucm" ] + +``` + +or follow the instructions for Unison in "[How to install the default language servers](https://github.com/helix-editor/helix/wiki/How-to-install-the-default-language-servers#unison)" wiki page. + +### Emacs + +In Emacs 29 (or earlier, if you install the [Eglot](https://elpa.gnu.org/packages/eglot.html) package), add the following to your init file: + +``` elisp +(push '((unison-ts-mode unisonlang-mode) "127.0.0.1" 5757) + eglot-server-programs) +``` + +This requires having either [unison-ts-mode](https://github.com/fmguerreiro/unison-ts-mode) or [unisonlang-mode](https://melpa.org/#/unisonlang-mode) installed. unison-ts-mode is newer, supported, and more complete, but isn’t in [MELPA](https://melpa.org/) yet and requires a couple commands to set up [tree-sitter-unison](https://github.com/kylegoetz/tree-sitter-unison). + +You can then use `M-x eglot` in a Unison scratch file buffer. You can also [configure Eglot to start automatically](https://www.gnu.org/software/emacs/manual/html_node/eglot/Starting-Eglot.html). + +### Other Editors + +If your editor provides a mechanism for connecting to a host and port, provide a host of `127.0.0.1` and port `5757`. + +If your editor requires a command to run, you can provide the command `nc localhost 5757` on Mac, or `netcat localhost 5757` on linux. +Note that some editors require passing the command and arguments as separate parameters. + +## Configuration + +Supported settings and their defaults. See information for your language server client about where to provide these. + + - `formattingWidth`: A suggestion for the formatter about how wide (in columns) to print definitions. + + - `maxCompletions`: The number of completions the server should collect and send based on a single query. Increasing this limit will provide more completion results, but at the cost of being slower to respond. + + If explicitly set to `null` the server will return ALL completions available. + +``` json +{ + "formattingWidth": 80, + "maxCompletions": 100 +} +``` diff --git a/unison-src/transcripts/project-outputs/docs/metadata.output.md b/unison-src/transcripts/project-outputs/docs/metadata.output.md new file mode 100644 index 0000000000..5a69896347 --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/metadata.output.md @@ -0,0 +1,34 @@ +The Unison codebase format needs to be able to store metadata about definitions it contains, such as: + + - Author, copyright holder + - Creation date + - License + - API docs + - Boolean indicating whether a definition is a test, needed to support incremental test evaluation + - Comments that annotate subpaths of the definition + - ... + +Some desired features: + + - We probably won't know all the kinds of metadata in advance, so having it be extensible would be good. + - Metadata should probably be versioned. (Example: what if you want to change the license of a definition?) + +A simple proposal is to just add metadata information at each level of the versioned namespace tree: + +``` Haskell +-- Metadata is always just a link to some other term +newtype Metadata = Metadata Reference +newtype MetadataType = MetadataType Text -- "License", "Creation date", etc + +data Branch0 = + Branch0 { _terms :: Relation NameSegment Referent + , _types :: Relation NameSegment Reference + , _edits :: ... + , _metadata :: Relation (MetadataType, Referent) Metadata } +``` + +That's it. Metadata is just a "link", a lightweight reference to some other definition. + +We don't try to make `MetadataType` more strongly typed. It's just a string, its meaning determined by convention. For instance, the default CLI viewer can look for an "API docs" key, and use that in its display. + +Nothing special for the on disk format, it can just be encoded the same way as the other relations in the Branch0. diff --git a/unison-src/transcripts/project-outputs/docs/nix.output.md b/unison-src/transcripts/project-outputs/docs/nix.output.md new file mode 100644 index 0000000000..f325a83384 --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/nix.output.md @@ -0,0 +1,65 @@ +(Todo: it might be nice to have a gentle and concise introduction into why Unison does anything with Nix and what cachix is.) + +We can push any nix store path into our cachix cache. This is typically done with `cachix push unison `. + +Some ways to come up with a store path: + +1. If you build something you get a symlink to the store path of the built thing, named `result` by default. +2. With `nix path-info` + +So, you could push the unison executable with the cache with + +``` nix +nix build -o my-little-unison-store-path +cachix push unison my-little-unison-store-path +``` + +or + +``` nix +nix build | cachix push unison +``` + +We want to cache the \[immediate\] build dependencies of our build products, because those are the only ones actually needed to build our build products. + +``` nix +nix-store --query --references $(nix path-info --derivation) | xargs nix-store --realize | cachix push unison +``` + +Breaking down the above: + +``` nix +nix path-info --derivation +``` + +gets the store path of the derivation of the unison executable + +``` nix +nix-store --query --references $(nix path-info --derivation) +``` + +gets the store paths of the derivations of immediate dependencies of the unison executable derivation. + +``` nix +nix-store --query --references $(nix path-info --derivation) | xargs nix-store --realize +``` + +builds the above derivations if necessary and writes the resulting store paths to stdout + +These paths are then fed to cachix with `| cachix push unison`. + +Development environments are defined in the flake under the `devShells` key. There are a number of different development environments, and they can be entered by giving a different argument to `nix develop`. If you want to push a development environment you could do so with something like: + +``` nix +nix build --no-link '.#devShells.x86_64-linux.default' | cachix push unison +``` + +and you could push the build dependencies of the default shell with something like + +``` nix +nix-store --query --references $(nix path-info --derivation '.#devShells.x86_64-linux.default') | xargs nix-store --realize | cachix push unison +``` + +``` nix +nix-store --query --references $(nix path-info --derivation '.#devShells.aarch64-darwin.default') | xargs nix-store --realize | cachix push unison +``` diff --git a/unison-src/transcripts/project-outputs/docs/publishing-library1.output.md b/unison-src/transcripts/project-outputs/docs/publishing-library1.output.md new file mode 100644 index 0000000000..c01a49adbe --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/publishing-library1.output.md @@ -0,0 +1,389 @@ +# Using library code in my application + +## Current status + +We've thought of library code as coming from a different branch, which we incorporate by merging branches. (There's no other way to utilize a branch, except to merge it.) + +Branches come from the `.unison` directory on disk, and `.unison` directories from external sources can be merged externally by recursively merging the directories. When two `.unison` directories each contain a branch with a given name, the two branches are merged by the `unison` tool. + +Each branch consists roughly of a `(Name, Reference)` "namespace" relation, and an `(Reference, Replacement)` "edits" relation. + +### Some problems with this + + - There are a lot of steps: + - Download someone's repo + - Make a new dir and git clone to it? + - Figure out how to recursively merge directories + - Maybe that's not that many steps. + - We incorporate all of the incoming branch's names (including dependency names?), whether you want them or not. + - This by itself isn't necessarily a dealbreaker, but it implies a lot of energy (or tooling) will be needed to provide immaculate namespaces in published libraries. + - We incorporate and activate all of the incoming branch's edits, whether you want them or not. + - Ditto + +### Question about collaborative edit semantics + +If you rename `foo` to `bar`, and I upgrade `foo#a` to `foo#b` and share my work with you, should you end up with `bar#a` and `foo#b`, or just `bar#b`? + +## What might be nicer? + +### A built-in way to get a published branch + +#### Idea: Provide a command to create a local branch from a Github repo + +``` +app> branch.clone gh:/[:ghbranch][/] lib + + Got 17 definitions from gh:user/ghrepo:ghbranch/ubranch + +lib> +``` + +#### Idea: Let existing branch commands support `gh:` scheme + +``` xml +branchspec + := 'gh:' '/' [ ':' ] [ '/' ] + | +``` + +``` +master> branch.checkout gh:aryairani/either + + Synced 23 definitions. -- example output, idk + +gh:aryairani/either> branch.checkout meetup3 + + Ok. + +meetup3> +``` + +Question: Can the "current" branch be remote, or do we need to introduce remote-tracking branches like git does; the former seems simpler IMO. We would need an offline mode for a branch, and it should be as transparent to the user as possible. + +### Use a branch without first merging? + +#### Idea: Reference other branches via qualified imports + +``` +prefix := wordyId [ '.' prefix ] +id := [ prefix '.' ] ( wordyId | '(' symbolyId ')' +ids := id [ ' ' ids ] + +importspec + := 'import ' branchspec [ '/' prefix ] [ '(' ids ')' ] [ ' hiding (' ids ')' ] + | 'import ' branchspec [ '/' prefix ] [ ' as ' prefix ] +``` + +Sample program: + +``` +import experiment2 as e2 -- embed a local branch into the current namespace +import gh:aryairani/either as Either -- embed a git branch into the cur. namespace + +foo = Either1.Either.rightToOptional (e2.runExperiment data) +``` + +##### Redundant qualifiers? + + - Adding another (qualified) prefix to identifiers in a branch without also removing some leads to unnecessary line noise: `Either.Either.rightToOptional`. + + - We could reference deeper into a branch for our qualified imports: + + ``` + import gh:aryairani/either/Either as Either + foo = Either1.rightToOptional + ``` + + Now we've imported only names prefixed with '`Either.`' from `aryairani/either`, and can refer to them by prefixing them with '`Either.`', i.e. `Either.rightToOptional` instead of `Either.Either.rightToOptional` in the previous example. + +#### Idea: Branch-qualified identifiers + +We can add a syntax for branch-qualified identifiers, then proceed with normal branch-management commands, then proceed with normal branch-management commands. + +``` +meetup3> alias gh:aryairani/either/Either.rightToOptional Either.rightMay + ┌ + │ ✅ + │ + │ I aliased the term gh:aryairani/either/Either.rightToOptional to + │ Either.rightMay. + └ + +meetup3> +``` + +This is pretty first-order and terrible. + +#### Idea: Merge libraries not at their roots + +``` +meetup3> merge gh:aryairani/either as Arya + + Copied 17 names. Use `details` to list them. + +meetup3> view Arya. + + Arya.Either.rightToOption : Either a b -> Option b + Arya.Either.leftToOption : Either a b -> Option a + ... + +meetup3> +``` + +#### Idea: `import` statements are 1st class entities + +`import` statements could be first-class things that are added to the namespace on an `add`. + +> Side note: This reminds me, I think there are reasons to reconsider adding support for `add`ing individual definitions from .u to branch. I have a WIP for this, but it doesn't work. 😅 Could probably knock it out quickly by pairing. + +Anyway, if we `>add` on this file, + +``` haskell +import gh:ghuser/ghrepo:treeish/unisonbranch as Foo +import gh:arya/either:either//Either as E -- 🤔 so many "either" +bar x = E.fromJust (Foo.foo x) + 1 +``` + +we also add an entry to the namespace: + +``` haskell +("Foo", QualifiedImport (Github "ghuser" "ghrepo" (Just treeish) "unisonbranch") Nothing) +("E", QualifiedImport + (Github "aryairani" "either" Nothing "default?master?") + (Just "Either") ) +``` + +where + +``` haskell +data BranchSpec + = Local UBranchName + | Github Username Repo (Maybe Treeish) UBranchName + +data QualifiedImport = QualifiedImport + { branchSpec :: BranchSpec + , from :: Maybe Prefix + , as :: Prefix + } +``` + +This could be a Haskell value or a Unison term. `import` could also be a CLI command (syntax tbd). + +We can copy any remote data to a github cache under `.unison/cache/gh/gh-commit-id` or `.unison/cache/gh/ghuser/ghrepo/gh-commit-id` or whatever, and reuse it from there, or refresh it according to some protocol. + +When I reference `E.fromJust` or `Foo.foo` it looks in the branches it downloaded from github. The names of transitive dependents are added to "oldnames", so if the remote name goes away, or the link is deleted, we still have some text to display. If `treeish` is a git hash, it would refer to an immutable thing, so it could be cached permanently. + +#### Idea: First class namespace — move this to publishing section? + +This is basically the previous idea but allowing for more complex structure. Instead of just being a link to a remote namespace in its entirety, we could have a single value that describes many imports; these structures can be imported in the same way within .u files, Github gists, etc. + +``` +prefix := wordyId [ '.' prefix ] +id := [ prefix '.' ] ( wordyId | '(' symbolyId ')' +ids := id [ ' ' ids ] + +importspec + := 'import ' branchspec [ '/' prefix ] [ '(' ids ')' ] [ ' hiding (' ids ')' ] + | 'import ' branchspec [ '/' prefix ] [ ' as ' prefix ] + +namespace := 'namespace ' id ' where' [ imports, defs ] +``` + +Sample program: + +``` haskell +namespace AryaPack where + -- can reference local branch experiment1's `dataset` as `e1.dataset` + import experiment1 as e1 -- embed a local branch into the AryaPack namespace + -- Can reference runar's Multiset.Multiset.empty as Multiset.empty + import gh:runarorama/Multiset (Multiset.fromList) + -- Can reference paul's Simple.Example.Example1 as AryaPack.Example1 + import gh:pchiusano/EasyTest/Simple.Example as Example + + myFunc = Multiset.fromList (Example.summarize e1.dataset) +``` + +The above becomes a term named `AryaPack : Namespace`, which I somehow get into my github aryairani/AryaPack project. + + - Basically this is syntax sugar for defining a special Unison object. We could also define it with normal Unison constructors, although it would probably be uglier. + - The above program includes a definition along with the imports, but that doesn't have to be allowed. + +Then the program below works: + +``` haskell +import experiment2 as e2 -- embed a local branch into the current namespace +import gh:eed3si9n/hello as Hello -- embed a git branch into the cur. namespace +from gh:aryairani/AryaPack/AryaPack import myFunc +-- ^^ repo ^^ branch ^^ term; in this case, a namespace +``` + +## + +#### Question: When do we actually download stuff? + +When do we actually bring those names/definitions into the local codebase, so we can view dependents without being online, or if the import statements are removed from .u file? + +##### Idea: Copy referenced names/defs into the branch + +If we `>add` on this file: + +``` +import gh:aryairani/either/Either as Either +foo = Either1.rightToOptional +``` + +we get a temporary copy of the `gh:aryairani/either` branch (maybe greedily get the whole remote codebase, or maybe stream data as needed), use it to retrieve names and dependencies of any symbols we may try to resolve against it. If `foo` is added to the local branch, then we save the names of those remote dependencies into the local branch as well. + +###### Question: What names do we assign to unreferenced dependencies? + +### What if the codebase were a tree, rather than a list of branches? + +\#\#\#\#Hand-wavy example + +``` +/> clone gh:aryairani/libfoo + Copied gh:aryairani/libfoo blah blah to /libfoo +/> undo +/> clone gh:aryairani/libfoo /libs/DeepLearning/Foo + Copied gh:aryairani/libfoo blah blah to /libs/DeepLearning/Foo +/> +``` + +Sorry that I am using `/` and `.` interchangeably. + +I'm using `.`, because it's the typical code identifier separator we're used to, and I'm using `/` because it looks like directories and also commonly represents a tree root. `.` doesn't feel good as a tree root, because it common represents the "current" node in a tree. There's also the Scala route of `.` separator and `_root_` means the tree root. 😅 + +Anyway, we have some kind of structure like: + +``` +/Builtin +/libs/UJson +/libs/Stream +/libs/DeepLearning/Bar +/libs/DeepLearning/Foo +/projects/BoringCrudApp +/projects/ChordProgressions +/projects/FaceDetector +``` + +``` +/> cd projects +/projects> rename FaceDetector FaceDetector/V1 +/projects> cd FaceDetector +/projects/FaceDetector> cp V1 V2 +-- +/projects/FaceDetector> replace.scoped V2 /libs/DeepLearning/Foo/thing1 mything1 + + Noted replacement of thing1#af2 with mything#i9d within /projects/FaceDetector/V2. + +/projects/FaceDetector> todo + ...7 things... +/projects/FaceDetector> todo / + ...33 things... +/projects/FaceDetector> +``` + +#### How do you reference code in a system like this? + +##### Idea: Absolute imports + +.u: + +``` haskell +import /projects/FaceDetector/V1 as V1 +-- or: import _root_.FaceDetector.V1 as V1 +compareResult = foo V1.result result +``` + +CLI: + +``` +projects/FaceDetector/v2> + Typechecked the following definition: + compareResult : Result +``` + +vs + +``` +projects/FaceDetector> + Typechecked the following definition: + compareResult : V2.Result +``` + +##### Idea: Relative imports + +``` haskell +import ../V1 as V1 +-- or: import _parent_.V1 as V1 +``` + +##### Also: TDNR + +Given: + +``` +/foo/bar/Bar.baz -- #abc +/blah/wah/Bar.baz -- #xyz +``` + +TDNR candidates are `foo.bar.Bar.baz` and `blah.wah.Bar.baz` + +##### Benefit: Organize your shared repo to arbitrary depth + +``` haskell +import gh:aryairani/awesome-unison/alltheparsers/specificparser/submodule as M +``` + +#### What are the units of code sharing and collaboration? + +You can easily imagine exporting a subtree, but what if that subtree references definitions that are outside of it? e.g. you want to share `/Foo/`, but `Foo.bar` references `/Quuz.quuzCount`? + + - Unison could warn you, and help you stage a subtree to publish. "I can collect all these referenced names into a subtree for you to bulk edit" + + - Unison could make up / choose some appropriate names based on the current tree: + + ``` haskell + namespace Dependencies where + static import /libs/Foo as Abc -- this is replaced by a full/static copy of the names + static import /temp/Bar as Xyz -- some other library code in this subtree uses + ``` + + In this next syntax block, I'm tagging subtrees with a publication location, to avoid needing to have separate unison repos on your local machine for each project. e.g. One repo would have all your preferred customizations. + + ``` + /projects/FaceDetector/V2> publish.set-destination.scoped .. gh:aryairani/face-detector + I will publish /projects/FaceDetector to gh:aryairani/face-detector + /projects/FaceDetector/V2> publish + + Syncing /projects/FaceDetector to gh:aryairani/face-detector + Syncing / to gh:aryairani/private-repo + + /projects/FaceDetector/V2> + ``` + + Elsewhere: + + ``` + libs> clone gh:aryairani/face-detector FaceDetector + libs> ls FaceDetector + + Dependencies.Abc.asdf : Blah -> Blah + Dependencies.Abc.ghjk : Blah -> Blah + Dependencies.Xyz.awww : Blah -> Blah + V1.result + ... + V2.result + ... + libs> + ``` + +# Sharing my code as library + +TBD, but it will include: + + - specifying which code + - specifying the publication destination + - juggling some credentials for the destination + +Next: [Updating my library & sharing an updated library](publishing-library2.md) diff --git a/unison-src/transcripts/project-outputs/docs/publishing-library2.output.md b/unison-src/transcripts/project-outputs/docs/publishing-library2.output.md new file mode 100644 index 0000000000..8f7fa1d466 --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/publishing-library2.output.md @@ -0,0 +1,179 @@ +previous: [Using library code in my application & sharing my application as a library](publishing-library1.md) + +# Updating my library & sharing the updates + +We can imagine a number of potential classes of structured edits to the codebase, each requiring their own supporting data and DX design. Like the ability to assign of names to references, these aren't fundamental to Unison; but they are critical to usability. + +In designing our codebase representation, we should remember that **the set of edit helpers will likely change over time**. Although the codebase editor will have to change to support new edit classes, **the codebase format may not need to**. i.e. each edit class could have some ID as part of its supporting data, and data for edit classes not supported by a particular codebase editor could be gracefully ignored. + +## Replacement & deprecation of definitions + +The first structured edit we've begun to tackle is: replacement and deprecation of definitions, propagated to dependents within the scope defined by a branch's namespace. + +Currently, we accumulate "edit" directives as part of a branch: + +``` haskell +editedTerms :: Branch0 -> Relation Reference TermEdit +editedTypes :: Branch0 -> Relation Reference TypeEdit +data TypeEdit = Replace Reference | Deprecate +data TermEdit = Replace Reference Typing | Deprecate +data Typing = Same | Subtype | Different +``` + +A relation `(r, edit)` indicates that we are working to remove `r` from the edit scope (currently: the branch `Namespace`). + + - These edits are simply metadata used by the `todo` and (unused/obsolete?) `propagate` commands. + - These edits currently accumulate forever and are applied in perpetuity. + - Edits are meant to be used to help users of a library to upgrade between versions, by describing how to rewrite their usage sites. + +We are going to want to do some or all of the following: + + - Define/use short-term edits + - Define edits within a limited set of code + - Share with others how to upgrade their own dependents of our code, *in a way that allows them to understand what's going to happen and then choose to opt-in*. + +### Short-term edits + +We can quick-fix the "in perpetuity" part by giving the user an `edit.clear` command to "forget" an edit directive in a branch. There are potentially a huge number of edits for the user to select among, but we can help a little with that by utilizing the same numbered-args scheme as `ls` currently uses, and/or by offering different ways of sorting: by name, by recency, other? + +### Making managing edits manageable + +If a human is meant to maintain this list by manually culling edit directives, he will need more context than a list of `Reference` pairs. e.g.: Where did this edit come from? Was it created by the `update` command on a .u file, or the \[likely not yet implemented\] `replace` command in the code editor? Or by auto-propagation? By whom? When? Other? We should add at least a flag to indicate whether the update was manual or auto-propagated. Maybe even a human-readable message: + +``` haskell +data EditSource = ManualUpdate | ManualReplace | AutoPropagate +data EditReason = EditReason EditSource (Optional Text) +``` + +### Managing multiple sets of edits + +Here is a hand-wavy, imagined script for managing multiple sets of edits: + +``` +master> + ┌ + │ ✅ + │ + │ I found and typechecked these definitions in Base.u: + │ + │ Sequence.map : c -> (a -> b) -> [a] -> [b] + │ + │ Now evaluating any watch expressions (lines starting with `>`)... + └ +master> edit.set-reason adding a silly parameter to Sequence.map +master> update + ┌ + │ ✅ + │ + │ I updated these definitions as part of "adding a silly parameter to + │ Sequence". + │ + │ Sequence.map : c -> (a -> b) -> [a] -> [b] + └ +master> edit.list + + "adding a silly parameter to sequence": + Terms: + Sequence.map#31q -> Sequence.map + Sequence.map#aa4 -> Sequence.map#31q + +master> edit.elide Sequence.map#31q + + You still have 6 dependents of Sequence.map#31q in this branch. + + Repeat the same command to proceed anyway. + + Tip: Use `todo` to see what's left to do in the refactor. + + Tip: Use `edit.clear Sequence.map#31q` to cancel refactoring its dependents. + +master> edits.save Sequence.wip20190315 + + 2 edits saved as Sequence.wip20190315 + +master> edit.elide Sequence.map#31q + + You still have 6 dependents repeat the same command to proceed anyway. + +master> edit.elide Sequence.map#31q + + Cleared: + Sequence.map#31q -> Sequence.map + Sequence.map#aa4 -> Sequence.map#31q + + Added: + Sequence.map#aa4 -> Sequence.map + + +master> edits.save Sequence.upgrade20190315 + + 1 edit saved as Sequence.ugprade20190315 + +master> publish gh:aryairani/Sequence:sequence + + Pushed 2 new definitions to gh:aryairani/Sequence/sequence + +master>^C +``` + +Then, elsewhere: + +``` haskell +import gh:aryairani/Sequence:master/Sequence as Sequence +``` + +``` +master> add +``` + +``` +master> edits.activate git:runarorama/Multiset/Multiset.upgrade2_3 + + Activated 6 edit directives. + + Your branch has 37 affected dependents, 35 of which can be upgraded automatically. + + Tip: Use `view git:runarorama/Multiset/Multiset.upgrade2_3` to summarize the changes. + + Tip: Use `todo` to see what's left to complete these edits. + +master> todo +``` + +### First-class edits + +An edit set could be represented by a Unison term. The previous example is meant to be ambiguous as to whether or not that is the case, but it could be, and I suspect + +### How do we manage secondary edits? + +Working through one set of edits/upgrades produces a secondary set of edits. Where, if anywhere should this secondary set be saved long-term? What effect will it have on bookkeeping if a user wants to process more than one first-class edit sets at the same time? i.e. in the course of processing updates from library Foo to library Foo', and library Bar to library Bar', if I update App.func1 to App.func1', to which library update can I attribute that change? Well, we haven't discussed anything about attributing application changes to library changes, but + +## Curating edits + +The user should be able to curate the list of edits that are in the branch, like what we do when auditing an unsubmitted Github PR. The example script in the earlier section explores this a bit, but if the edit lists could be edited in the `.u`, or by Unison code at some point in the future, that will probably be much more convenient than implementing a ton of CLI commands to manipulate the list(s). + +### Curating name changes + +Could the branch/namespace also be a first-class Unison term? How would that ground out? + +## Publishing a set of edits + +If a set of edits is just a Unison term that the CLI knows about, then you can publish it in the same way you publish unison terms; TBD once we confirm the branch/repo format. + +## Using an updated library + +The example above touched on this in the example above, with + +``` +> edits.activate gh:runarorama/Multiset/Multiset.upgrade2_3 +``` + +or, having linked `/libs/Multiset` to `gh:runarorama/Multiset/...`: + +``` +> edits.activate /libs/Multiset/upgrade2_3 +``` + +We can collect additional questions here. + + diff --git a/unison-src/transcripts/project-outputs/docs/publishing.output.md b/unison-src/transcripts/project-outputs/docs/publishing.output.md new file mode 100644 index 0000000000..b961d886d3 --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/publishing.output.md @@ -0,0 +1,10 @@ +# Publishing Unison code + +Thinking about a design for publishing Unison code revealed a nest of interrelated concerns: + + - [Using library code in my application & sharing my application as a library](publishing-library1.md) + - [Updating my library & sharing an updated library](publishing-library2.md) + + + +Each of these linked subtopics presents concerns, questions, and ideas, which we can weigh and collect into [our M1 proposal](publishing-M1.md). diff --git a/unison-src/transcripts/project-outputs/docs/release-steps.output.md b/unison-src/transcripts/project-outputs/docs/release-steps.output.md new file mode 100644 index 0000000000..52eb16ab5d --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/release-steps.output.md @@ -0,0 +1,92 @@ +# Release Steps + +## 1\. (Major milestones only) New Base Release + +Cut a release of base. @runarorama does this usually. + +``` +.> pull git(git@github.com:unisonweb/base) basedev.release +.> cd .basedev.release +.basedev.release> delete.namespace releases._latest +.basedev.release> squash trunk releases._ +``` + +Edit `releases._.README` to include `Release: `. + +``` +.basedev.release> fork releases._ releases._latest +.basedev.release> push git(git@github.com:unisonweb/base) +``` + +## 2\. Run Release script + + - **Milestone Release**: Look up the most recent release; bump the number and remove any trailing letters, e.g. `./scripts/make-release release/M5 trunk` + - **Minor Release**: Increment the trailing letter of the previous release, or add an `a` to the previous milestone release, e.g. `./scripts/make-release release/M5a trunk` + +Then, using the new release version, from the root of the `unisonweb/unison` project run: + +``` sh +./scripts/make_release.sh [TARGET (defaults to trunk)] +``` + +This will tag the appropriate versions in all the required projects, and kick off all of the necessary CI jobs to ship a release. + +Including: + + - A release workflow in `unisonweb/unison` to build UCM on multiple platforms, create a release with appropriate release notes from the previous release, and upload the artifacts to that release. + - A release workflow in `unison-local-ui` to build UCM on multiple platforms, create a release with appropriate release notes from the previous release, and upload the artifacts to that release. + - A release workflow in `homebrew-unison` to wait for artifacts to be uploaded, then download those artifacts, get the checksums, and create an up-to-date homebrew formula. + +After successfully executing the script you just have to sit tight and wait for all the jobs to complete. + +## 3 + +Smoke test of the new release. Try `brew upgrade unison-language`, launch it, launch `ui`. + +## 4 + +Write up release notes, template below. + +Preview the markdown in Slack \#general and tag @paul. + +## 5 + +If there are new builtins, redeploy Share. + +## 6 + +Announce on \#general Discord channel. + +----- + +@everyone We've just released a new version of Unison, $RELEASE\_NAME. + +----- + +**macOS or Linux w/ Homebrew:** +Install or upgrade is just `brew upgrade unisonweb/unison/unison-language`. + +**macOS or Linux manual install:** +macOS + +``` +mkdir -p unisonlanguage && cd unisonlanguage +curl -L https://github.com/unisonweb/unison/releases/latest/download/ucm-macos.tar.gz \ + | tar -xz +./ucm +``` + +Linux + +``` +mkdir -p unisonlanguage && cd unisonlanguage +curl -L https://github.com/unisonweb/unison/releases/latest/download/ucm-linux.tar.gz \ + | tar -xz +./ucm +``` + +**Windows manual install:** + + - Recommended: [Set your default Terminal application](https://devblogs.microsoft.com/commandline/windows-terminal-as-your-default-command-line-experience/) to “Windows Terminal”. + - Download [the release](https://github.com/unisonweb/unison/releases/latest/download/ucm-windows.zip) and extract it to a location of your choosing. + - Run `ucm.exe` diff --git a/unison-src/transcripts/project-outputs/docs/runtime-calling-conventions.output.md b/unison-src/transcripts/project-outputs/docs/runtime-calling-conventions.output.md new file mode 100644 index 0000000000..9b1fb09e2a --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/runtime-calling-conventions.output.md @@ -0,0 +1,51 @@ +### Lambda + + - called with arguments in declared order. + - whenever a lambda is called, it takes itself as `rec` + - it evaluates the body passing the bound lambda parameters on the stack + +### Computation + + - bound variables passed on stack with innermost scope closest to index 0 + - "rec" is passed as well (?) + - evaluations in nontail positions need to catch handle TC because their "frame" + has more work and shouldn't be thrown away; evaluations in tail positions can + throw their tailcalls upward and discard their frame + - let1/letrec evaluate the bindings with the existing stack (bound variables in their scope); + body is called with bindings prepended to stack + - compilevar returns rec if its name matches currentRec, + otherwise looks up a value on the bindings stack + - compilelambda returns a computation that will produce a lambda when evaluated + - apply + - if fn name matches currentRec, then staticRecCall + - staticRecTailCall + - throw selfTailCall with evaluated args (seems like this would not do anything) (?) + - staticRecNonTailCall + - call (rec: Lambda) with evaluated args + - a SelfCall exception should never escape the wrapper lambda + - else compile fn + - if compiled fn is Return(Lambda) + - staticTailCall + - throw tailcall with fn + - staticNonTailCall + - call fn with rec = fn + - else compiled fn is not yet a lambda, and needs to be evaluated again (at least once) + - dynamicTailCall + - eval mkFn and assume it produces a lambda (it should) + - throw tailcall with lambda and eval'd args + - dynamicNontailCall + - eval mkFn and assume it produces a lambda (it should\!) + - call lambda with evaluated args + +### Tail calls + +tailcall throws an exception with the target function & args +selfTailCall throws a tailcall with null(implied?) function + +when a tailcall exception is caught, we enter a while loop which calls the +target function and continues to catch tail calls until the target function +is null. + +note that the selftailcall begins with null. (?) don't understand + +### annotated bounds diff --git a/unison-src/transcripts/project-outputs/docs/sharing-code.output.md b/unison-src/transcripts/project-outputs/docs/sharing-code.output.md new file mode 100644 index 0000000000..7ff0619231 --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/sharing-code.output.md @@ -0,0 +1,135 @@ +# Sharing code + +``` haskell +data Causal m e + = One { currentHash :: Hash, head :: e } + | Cons { currentHash :: Hash, head :: e, tail :: m (Causal e) } + -- The merge operation `<>` flattens and normalizes for order + | Merge { currentHash :: Hash, head :: e, tails :: Map Hash (m (Causal e)) } + +-- just one level of name, like Foo or Bar, but not Foo.Bar +newtype NameSegment = NameSegment { toText :: Text } +newtype Path = Path { toList :: [NameSegment] } + +data Namespace m = Namespace + { terms :: Relation NameSegment Referent + , types :: Relation NameSegment Reference + , children :: Relation NameSegment (Codetree m) + } + +data Codetree m = Codetree (Causal m Namespace) + +data RemotePath = RemotePath RemoteRef Path +data RemoteRef = GithubRef { username :: Text, repo :: Text, treeish :: Text } + -- | ... +-- "gh:/[/][?ref=] -- treeish defaults to repo's `default_branch` +-- "gh:aryairani/unison/libs?ref=topic/370" becomes +-- RemotePath (GithubRef "aryairani" "unison" "topic/370") (Path ["libs"]) + +newtype EditMap = EditMap { toMap :: Map GUID (Causal Edits) } +data Edits = Edits + { terms :: Relation Reference TermEdit + , types :: Relation Reference TypeEdit + } + +-- maps local paths to remote paths +data RemoteStatus = Map Path RemoteSpec +``` + +A couple of important points: + + - A namespace is "just" part of your preferences for parsing (and to some extent, rendering) code. + - Edits as we know them are just state for edit helper commands, like "todo" and "propagate" + - We should consider making the codebase representation of this data modular, since they really can be separated; they are likely still meaningful even in the presence of unexpected state/preferences that might exist in the future to support other features of future versions of the editor. + - We use `Causal` to represent a shareable data structure — shareable in the sense that which can tell whether a certain change came after another. + +Questions: + + - Do we want to distinguish between `/` paths and `.` separators in names? + + - Should a type `A` be at the same level as + + - On one hand, you probably don't need to separate a type `A` from its constructor `A.A`. You wouldn't be able to export the constructor without the type which resides a level up in the namespace. + + - Maybe the type `A` should organically be organized as `A/A`, and its constructor also as `A/A`. This is reminiscent of having a separate module per type in Haskell, except that a reorganization could be done more easily: + + ``` + /mycode> mv ClassA* ClassA/ + /mycode> mv ClassB* ClassB/ + /mycode> cd ClassA + /mycode/ClassA> ls + ``` + + - ``` + + ``` + +## NameTree representation + +examples: + +``` + + +/A (type) +/A (term) +/A/A (ctor) + + + +``` + +``` haskell +data NameTree a = Causal (Relation Name (NameTree a)) +``` + +or + +``` haskell +data NameTree a + = Leaf a + | Branch (Relation Name (NameTree a)) + | SharePoint (Causal (NameTree a)) +``` + +## Github Notes + +Base: https://api.github.com/repos/unisonweb/unison/ + +Branches: https://api.github.com/repos/unisonweb/unison/branches + +A directory: + +``` +url: +https://api.github.com/repos/unisonweb/unison/contents/unison-src/demo?ref=master + +html_url: +https://github.com/unisonweb/unison/tree/master/unison-src/demo + +git_url +https://api.github.com/repos/unisonweb/unison/git/trees/f8d91c6cc2ee1bc8f2bfc759e328a851d0df3b95 +``` + +A file: + +``` +url: +https://api.github.com/repos/unisonweb/unison/contents/unison-src/Base.u?ref=master + +html_url: +https://github.com/unisonweb/unison/blob/master/unison-src/Base.u + +git_url: https://api.github.com/repos/unisonweb/unison/git/blobs/e617fbad4e32d25380f536179f558f9213cd4bad + +download_url: +https://raw.githubusercontent.com/unisonweb/unison/master/unison-src/Base.u +``` + +Note that `treeish` (in this example, `master`) can contain slashes, such as `topic/370`. This makes parsing a little tricky. Fortunately, if you have a git branch `a/b` then it's not possible to create branches `a` or `a/b/c`. So you can load the list of branches, and then test them against that treeish-prefixed path: + +`https://github.com///<"tree" or "blob">/` + +If any of the branch names + `/` form a prefix of `treeish-prefixed-path`, then the suffix is the path into the causal. Crap, wait. The github HTML UI isn't going to be showing Unison paths at all. + +So, we could use out made up `gh:username/repo[:treeish][/path]` URI scheme; can support others as desired. Maybe our Javascript viewer will create URLs with query params that can indicate the Unison path. diff --git a/unison-src/transcripts/project-outputs/docs/testing.output.md b/unison-src/transcripts/project-outputs/docs/testing.output.md new file mode 100644 index 0000000000..0ac2a53377 --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/testing.output.md @@ -0,0 +1,57 @@ +### Testing and watch expression caching + +First, let's get this out of the way. One uncontroversial, status quo way to do testing in Unison: just use a regular main function. So, by convention, your branch might have a term, `tests : '{IO} Boolean` or perhaps `[Text] ->{IO} Boolean`, if it has an EasyTest-like interface where you can select scopes dynamically. You then do: + +``` +> execute tests +``` + +In your branch and it runs your tests and prints out some nice emojis. If you're running `tests` standalone and care about exit codes, you probably take the `Boolean` you get, where `true` indicates success and `false` indicates a failure, and convert that to an exit code. Assuming `IO` has some way of exiting with an exit code. + +(Note, we don't have a way of launching `unison` to run some commands on a branch then quit yet, but we probably will have something like `unison mybranch execute tests ["math"]`.) + +Easy peasy. Nothing special we need to do to enable this mode of working, and it's going to be how you do any sort of integration tests that need to talk to the outside world. + +### Easy incremental testing for pure tests (the "tests cache") + +But, when tests *aren't* in `IO`, there's no need to rerun them unless one of their dependencies changes (though you can if you want to). A simple proposal which lets us take advantage of this is we allow watch expressions to be marked as tests. They have to be of type `Test.Status`: + +``` +type Test.Status = Failed Text | Passed Text +``` + +> We debated whether to make tests have more structure and came down on "no" - different testing combinator libraries or abilities can handle all that, and this `Test.Status` is more like a final compilation target for different testing APIs: the test passed or failed, and has some human-readable information in it. That's it. + +And to mark a watch expression as a test, you say: + +``` Haskell +test> Test.equal (sort [3,1,2]) [1,2,3] +``` + +> Hmm, what if your test needs a whole bunch of auxiliary definitions and doesn't fit in a single watch expression? Easy, just introduce regular definitions for these, perhaps with some simple naming convention (like I'd prefix these testing helper definition names with `tests.`). + +> Did you consider just keying off the type of the watch, like if it's of type `Test.Status`, assume it's a test? Yes we did, but we decided being explicit was better. Also by communicating your intent up front, you can get better feedback from the tool ("er, looks like this isn't a test, here's how you can make it one") vs silently ignoring the thing the user thought was a test and just not adding it to the branch. + +On `add`, these `test>` watches are added to the codebase. Watch expressions marked as `test>` are also added to the namespace of the branch and given some autogenerated unique name (perhaps just computed from the hash of the test itself), unless the watch expression picks a name as in `test> test.sortEx1 = ...`. The user is told these names on `add`/`update` and can always rename them later if they like. Don't forget that in the event of a test failure, Unison can also show you the full source of the failed watch expression. Also note that the `Passed` and `Failed` cases might include the name of the "scope" of the test or other relevant info. So I'm not sure how important these names will be in practice + +There's a directory, `tests/`, containing files of the form `.ub`. The `hashXYZ` is a reference to the source of the original watch expression (in this case, the `Test.equal (sort [3,1,2]) [1,2,3]`), and the `.ub` file itself is a serialized `Test.Status`. We can ask if a branch is passing just by taking the intersection of the hashes in the branch with the hashes in this directory and seeing if all the `Test.Status` values for the branch are `Passed`. Notice this doesn't involve running any of the tests\! + +Since these test watches are part of the branch, they get refactored just like everything else when their dependencies change. Nothing special there, which is nice. We suggest that `update` rerun any changed tests by default. Here's how that works: + + - On `update`, we check the `tests/` directory and compare the hashes there to the edits list in the branch. If there's a file `.ub`, and the branch has an edit `hashXYZ -> hashPQR`, we lookup the source of `hashPQR` and evaluate it, and store the result in `.ub`. We do this for any affected tests. + +The `tests/` directory will be versioned, so everyone collaborating on the code shares a cache of test results. As the tests are 100% deterministic, this is fine, unless of course someone manually mucks with that directory to doctor some test results, or if like a freak gamma ray corrupts your test as it's running and gives the wrong result. But note that you can always choose to rerun some or all of your tests, ignoring the cache - just lookup the source of the `` and recompute it. (And perhaps there's a command to do that in bulk for a whole branch.) If it doesn't match, you can then hunt down the person who added that bogus test result. :) + +### Caching watch expressions (the "watches cache") + +Same idea, except that the source of a watch expression isn't added to the codebase. We just have a `watches/` directory in the same spot, with files `.ub` in it, which contain the evaluated result of the watch whose source was `hashXYZ`. Optionally, `watches/` directory could be in some other user-configurable location. + +When evaluating a Unison file, we have to hash all its definitions. If one of those hashes matches a hash in the `watches/` directory, we skip its evaluation and return the cached value. + +This caching can be done by default, but I suggest that the `watches` directory *not* be versioned as the values might be quite large. However, I could see people wanting to share their watches cache and sticking it on some shared file system. + +### Implementation notes and remarks + +We will neeed the list of watches in `UnisonFile` to include extra information: what kind of watch expression is it? A test or a regular watch? We'll then need to make use of this information on `add` and `update`. And we might want to expose other commands for rerunning tests anyway. + +Aside: I kinda like the "trust but occasionally reverify" model for this kind of caching. So every once in a while, pick a random test to rerun and make sure it checks out. With statistics, over time, it becomes exceedingly likely that the cache is good and any somehow incorrect results will be caught. Pessimistically rerunning all the tests, all the time, is Right Out. :) diff --git a/unison-src/transcripts/project-outputs/docs/type-declarations.output.md b/unison-src/transcripts/project-outputs/docs/type-declarations.output.md new file mode 100644 index 0000000000..09ff26703a --- /dev/null +++ b/unison-src/transcripts/project-outputs/docs/type-declarations.output.md @@ -0,0 +1,150 @@ +draft draft draft + +# Type Declarations in Unison + +``` haskell +data DataDeclaration' v a = DataDeclaration { + annotation :: a, + bound :: [v], + constructors' :: [(a, v, AnnotatedType v a)] + -- isStructural :: IsStructural + -- isOpaque :: Set (AnnotatedTerm v a) +} deriving (Eq, Show, Functor) + +-- type IsStructural = Structural | Unique GUID +``` + +> There is some discussion history on this doc in the comment threads [here](https://github.com/unisonweb/unison/commit/bc65f460a7b6a6c0dec7f3028680d55f0372123e#comments) and [here](https://github.com/unisonweb/unison/commit/6be8cba7e7fde29cf87af7fb28f2b30185c40c89#commitcomment-33025457). + +## Structural Types + +> 👉 These got implemented - it's the default, so there's no `structural` keyword. + +Structural types are defined uniquely by their structure. Every constructor has a unique signature, which intrinsically defines the meaning of the constructor. For example, the following types are identical and interoperable: + +``` haskell +structural type Maybe a = Nothing | Just a +structural type Optional t = Some t | None +``` + +These definitions would also be identical and interoperable (although they maybe shouldn't be): + +``` haskell +structural type Validation e a = Success a | Failure e +structural type Either a b = Left a | Right b +``` + +It should be an error if two constructors of a structural type have the same signature, indicating that the semantics are defined outside of the structure. + +The identity of a structural type is determined by normalizing the constructor order by \ and then hashing their types. + +## Unique types + +> 👉 This got implemented - see [here](https://www.unison-lang.org/learn/language-reference/unique-types/). + +Unique types have extrinsic semantics, not completely defined by the constructor types. Their representation includes a GUID, along with the constructors. The constructors types need not be unique. The GUID is typically auto-generated, but can be specified as part of the type declaration, in order to use a textual representation to declare an identical type. + +``` haskell +unique type Day = Mon | Tue | Wed | ... + +unique[] +type Day = Mon | Tue | Wed | ... +``` + +Order of constructors having the same type is stable, but the relative constructor order of differently typed constructors is (currently) unspecified. + +## Opaque Types + +How do we support modularity? That is, how do we let people expose a 'public API' to their library, and avoid exposing the internals behind it, so that (a) you can keep your library's internal data invariants intact without having to explain them, (b) you're free to change the internals without breaking client code that uses the API, and (c) you can tame complexity in the overall system by decoupling client code from library code? + +The key thing is to control access to the introduction and elimination of data types: who is allowed to create, and to pattern-match on, a value of your type? Both of those necessarily expose the guts of the representation of the type. + +An opaque type has a structure and a block of terms that can inspect structure. The hash of those terms is part of the type ID. They have a flag in the decl so typechecker can prevent access. + +``` haskell +opaque type Socket = Socket Nat +opaque type Handle = Handle Text +``` + +Q: How do you declare a definition that can inspect two opaque types? +Q: How do *we* create and inspect Sockets? We don't want to create public accessors, but we do want some way for privileged code to construct those values. I guess it's straightforward for types with a single constructor, but we may end up needing some deterministic way of distinguishing the other constructors. + +For reference and comparison: https://docs.scala-lang.org/sips/opaque-types.html +Notes re Scala opaque types: + + - They are a type alias (no boxing) that is only equal for definitions inside a corresponding companion object/module. + - We (Unison) do need to "box" values within a constructor to give them a hash corresponding to their type identity. + +### Alternative take on opaque types + +The thread starting [here](https://unisonlanguage.slack.com/archives/CLKV43YE4/p1565135564409000) makes the case that it's not very 'open world' to force people to change your type's identity in order to add a function which is privileged - i.e. can create and pattern match on values of that type. + +An alternative would be to say that, in terms of type identity, opaque types work exactly like unique types. But that you can annotate terms as being a 'friend' of that type, and so allowed to create / pattern match. So maybe here's what a term looks like that's a friend of types Foo and Bar: + +``` haskell +friend[Foo, Bar] eg : Foo Bar +eg = Foo.Foo 1 "hi" (Bar.Bar 3.1) +-- syntax reminiscent of unique[#af361] +``` + +This annotation would be metadata attached to the term. You can get unison to list all the friends of a given type, in order to work out what the footprint of 'privileged' code is. + +### Private functions + +It's not quite true to say that controlling creation and pattern matching is enough for the three aspects of modularity mentioned above. What about internal library helper functions which could be called in a way that creates data that doesn't respect the invariants? Or that you might want to change or remove later? Or that are not at the same semantic level as your API? So maybe we'd want a `private[Foo]` annotation on terms, which both implies `friend[Foo]`, and can only be referenced from other `friend[Foo]` terms. + +## Combinations? + +*Structural + Unique:* No. + +*Structural + Opaque:* No. + +*Unique + Opaque:* Sure why not. + +(So note that Opaque implies Unique.) + +Example where you want Opaque without Unique: `SortedSet` -- the exposed methods define the semantics. Example where you want Unique + Opaque: `Socket`, `Handle` -- the exposed methods may necessarily dictate that the two types are not the same. + +## Misc scenarios / questions: + +I was just editing some Haskell code. + +``` haskell +-- InputPatterns accept some fixed number of Required arguments of various +-- types, followed by a variable number of a single type of argument. +data IsOptional + = Optional -- 0 or 1, at the end + | Required -- 1, at the start + | ZeroPlus -- 0 or more, at the end + | OnePlus -- 1 or more, at the end + deriving Show +``` + +I decided to move `Required` to the top for clarity since, as the comments state, InputPattern arg lists start with some number of `Required` arguments. + +``` haskell +data IsOptional + = Optional -- 0 or 1, at the end + | Required -- 1, at the start + | ZeroPlus -- 0 or more, at the end + | OnePlus -- 1 or more, at the end + deriving Show +``` + +I still want this to be the same type. None of the semantics have changed, I just reordered the constructors for readability. I don't think this would be possible with any of our current proposed type implementations. Yes, I could create a new unique type, and refactor everything to use that, but that strikes me as unappealing, especially from a code-sharing perspective. + +Thoughts? + + - @pchiusano - I'd say that "constructor display order" should be a bit of metadata that can be attached to a data declaration, and you should be able to edit this metadata somehow (perhaps by default, the `add` / `update` command can suggest "metadata edits" in reponse to this sort of thing). + +## Old stuff: Algebraic Types? + +Algebraic types are defined by their structure and a set of laws relating their fields. Note that the laws may involve more than one type. + +``` +algebraic Monoid a = Monoid { mempty : a, mappend : a -> a -> a } +where m a -> (mappend m) (mempty m) a == a + m a -> (mappend m) a (mempty m) == a + m a b c -> (mappend m) a ((mappend m) b c) == + (mappend m) ((mappend m) a b) c +``` diff --git a/unison-src/transcripts/propagate.md b/unison-src/transcripts/propagate.md deleted file mode 100644 index 19576d8bb8..0000000000 --- a/unison-src/transcripts/propagate.md +++ /dev/null @@ -1,80 +0,0 @@ -# Propagating type edits - -```ucm:hide -scratch/main> builtins.merge lib.builtins -``` - -We introduce a type `Foo` with a function dependent `fooToInt`. - -```unison -unique type Foo = Foo - -fooToInt : Foo -> Int -fooToInt _ = +42 -``` - -And then we add it. - -```ucm -scratch/main> add -scratch/main> find.verbose -scratch/main> view fooToInt -``` - -Then if we change the type `Foo`... - -```unison -unique type Foo = Foo | Bar -``` - -and update the codebase to use the new type `Foo`... - -```ucm -scratch/main> update.old -``` - -... it should automatically propagate the type to `fooToInt`. - -```ucm -scratch/main> view fooToInt -``` - -### Preserving user type variables - -We make a term that has a dependency on another term and also a non-redundant -user-provided type signature. - -```unison -preserve.someTerm : Optional foo -> Optional foo -preserve.someTerm x = x - -preserve.otherTerm : Optional baz -> Optional baz -preserve.otherTerm y = someTerm y -``` - -Add that to the codebase: - -```ucm -scratch/main> add -``` - -Let's now edit the dependency: - -```unison -preserve.someTerm : Optional x -> Optional x -preserve.someTerm _ = None -``` - -Update... - -```ucm -scratch/main> update.old -``` - -Now the type of `someTerm` should be `Optional x -> Optional x` and the -type of `otherTerm` should remain the same. - -```ucm -scratch/main> view preserve.someTerm -scratch/main> view preserve.otherTerm -``` diff --git a/unison-src/transcripts/propagate.output.md b/unison-src/transcripts/propagate.output.md deleted file mode 100644 index d438a96b37..0000000000 --- a/unison-src/transcripts/propagate.output.md +++ /dev/null @@ -1,177 +0,0 @@ -# Propagating type edits - -We introduce a type `Foo` with a function dependent `fooToInt`. - -``` unison -unique type Foo = Foo - -fooToInt : Foo -> Int -fooToInt _ = +42 -``` - -``` 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`: - - type Foo - fooToInt : Foo -> Int - -``` -And then we add it. - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Foo - fooToInt : Foo -> Int - -scratch/main> find.verbose - - 1. -- #uj8oalgadr2f52qloufah6t8vsvbc76oqijkotek87vooih7aqu44k20hrs34kartusapghp4jmfv6g1409peklv3r6a527qpk52soo - type Foo - - 2. -- #uj8oalgadr2f52qloufah6t8vsvbc76oqijkotek87vooih7aqu44k20hrs34kartusapghp4jmfv6g1409peklv3r6a527qpk52soo#0 - Foo.Foo : Foo - - 3. -- #j6hbm1gc2ak4f46b6705q90ld4bmhoi8etq2q45j081i9jgn95fvk3p6tjg67e7sm0021035i8qikmk4p6k845l5d00u26cos5731to - fooToInt : Foo -> Int - - - -scratch/main> view fooToInt - - fooToInt : Foo -> Int - fooToInt _ = +42 - -``` -Then if we change the type `Foo`... - -``` unison -unique type Foo = Foo | Bar -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - type Foo - -``` -and update the codebase to use the new type `Foo`... - -``` ucm -scratch/main> update.old - - ⍟ I've updated these names to your new definition: - - type Foo - -``` -... it should automatically propagate the type to `fooToInt`. - -``` ucm -scratch/main> view fooToInt - - fooToInt : Foo -> Int - fooToInt _ = +42 - -``` -### Preserving user type variables - -We make a term that has a dependency on another term and also a non-redundant -user-provided type signature. - -``` unison -preserve.someTerm : Optional foo -> Optional foo -preserve.someTerm x = x - -preserve.otherTerm : Optional baz -> Optional baz -preserve.otherTerm y = someTerm y -``` - -``` 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`: - - preserve.otherTerm : Optional baz -> Optional baz - preserve.someTerm : Optional foo -> Optional foo - -``` -Add that to the codebase: - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - preserve.otherTerm : Optional baz -> Optional baz - preserve.someTerm : Optional foo -> Optional foo - -``` -Let's now edit the dependency: - -``` unison -preserve.someTerm : Optional x -> Optional x -preserve.someTerm _ = None -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - preserve.someTerm : Optional x -> Optional x - -``` -Update... - -``` ucm -scratch/main> update.old - - ⍟ I've updated these names to your new definition: - - preserve.someTerm : Optional x -> Optional x - -``` -Now the type of `someTerm` should be `Optional x -> Optional x` and the -type of `otherTerm` should remain the same. - -``` ucm -scratch/main> view preserve.someTerm - - preserve.someTerm : Optional x -> Optional x - preserve.someTerm _ = None - -scratch/main> view preserve.otherTerm - - preserve.otherTerm : Optional baz -> Optional baz - preserve.otherTerm y = someTerm y - -``` diff --git a/unison-src/transcripts/pull-errors.md b/unison-src/transcripts/pull-errors.md deleted file mode 100644 index 784221bb8e..0000000000 --- a/unison-src/transcripts/pull-errors.md +++ /dev/null @@ -1,6 +0,0 @@ -```ucm:error -test/main> pull @aryairani/test-almost-empty/main lib.base_latest -test/main> pull @aryairani/test-almost-empty/main a.b -test/main> pull @aryairani/test-almost-empty/main a -test/main> pull @aryairani/test-almost-empty/main .a -``` diff --git a/unison-src/transcripts/pull-errors.output.md b/unison-src/transcripts/pull-errors.output.md deleted file mode 100644 index 38afde71c9..0000000000 --- a/unison-src/transcripts/pull-errors.output.md +++ /dev/null @@ -1,43 +0,0 @@ -``` ucm -test/main> pull @aryairani/test-almost-empty/main lib.base_latest - - The use of `pull` to install libraries is now deprecated. - Going forward, you can use - `lib.install @aryairani/test-almost-empty/main`. - - Downloaded 2 entities. - - I installed @aryairani/test-almost-empty/main as - aryairani_test_almost_empty_main. - -test/main> pull @aryairani/test-almost-empty/main a.b - -⚠️ - -Sorry, I wasn’t sure how to process your request: - - I think you want to merge @aryairani/test-almost-empty/main - into the a.b namespace, but the `pull` command only supports - merging into the top level of a local project branch. - -You can run `help pull` for more information on using `pull`. - -test/main> pull @aryairani/test-almost-empty/main a - - I think you want to merge @aryairani/test-almost-empty/main - into the a branch, but it doesn't exist. If you want, you can - create it with `branch.empty a`, and then `pull` again. - -test/main> pull @aryairani/test-almost-empty/main .a - -⚠️ - -Sorry, I wasn’t sure how to process your request: - - I think you want to merge @aryairani/test-almost-empty/main - into the .a namespace, but the `pull` command only supports - merging into the top level of a local project branch. - -You can run `help pull` for more information on using `pull`. - -``` diff --git a/unison-src/transcripts/records.md b/unison-src/transcripts/records.md deleted file mode 100644 index 199218f3ea..0000000000 --- a/unison-src/transcripts/records.md +++ /dev/null @@ -1,138 +0,0 @@ -Ensure that Records keep their syntax after being added to the codebase - -```ucm:hide -scratch/main> builtins.merge -scratch/main> load unison-src/transcripts-using-base/base.u -``` - -## Record with 1 field - -```unison:hide -unique type Record1 = { a : Text } -``` - -```ucm:hide -scratch/main> add -``` - -```ucm -scratch/main> view Record1 -``` - -## Record with 2 fields - -```unison:hide -unique type Record2 = { a : Text, b : Int } -``` - -```ucm:hide -scratch/main> add -``` - -```ucm -scratch/main> view Record2 -``` - -## Record with 3 fields - -```unison:hide -unique type Record3 = { a : Text, b : Int, c : Nat } -``` - -```ucm:hide -scratch/main> add -``` - -```ucm -scratch/main> view Record3 -``` - -## Record with many fields - -```unison:hide -unique type Record4 = - { a : Text - , b : Int - , c : Nat - , d : Bytes - , e : Text - , f : Nat - , g : [Nat] - } -``` - -```ucm:hide -scratch/main> add -``` - -```ucm -scratch/main> view Record4 -``` - -## Record with many many fields - -```unison:hide -unique type Record5 = { - zero : Nat, - one : [Nat], - two : [[Nat]], - three: [[[Nat]]], - four: [[[[Nat]]]], - five: [[[[[Nat]]]]], - six: [[[[[[Nat]]]]]], - seven: [[[[[[[Nat]]]]]]], - eight: [[[[[[[[Nat]]]]]]]], - nine: [[[[[[[[[Nat]]]]]]]]], - ten: [[[[[[[[[[Nat]]]]]]]]]], - eleven: [[[[[[[[[[[Nat]]]]]]]]]]], - twelve: [[[[[[[[[[[[Nat]]]]]]]]]]]], - thirteen: [[[[[[[[[[[[[Nat]]]]]]]]]]]]], - fourteen: [[[[[[[[[[[[[[Nat]]]]]]]]]]]]]], - fifteen: [[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]], - sixteen: [[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]], - seventeen: [[[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]]], - eighteen: [[[[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]]]], - nineteen: [[[[[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]]]]], - twenty: [[[[[[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]]]]]] -} -``` - -```ucm:hide -scratch/main> add -``` - -```ucm -scratch/main> view Record5 -``` - -## Record with user-defined type fields - -This record type has two fields whose types are user-defined (`Record4` and `UserType`). - -```unison:hide -unique type UserType = UserType Nat - -unique type RecordWithUserType = { a : Text, b : Record4, c : UserType } -``` - -```ucm:hide -scratch/main> add -``` - -If you `view` or `edit` it, it _should_ be treated as a record type, but it does not (which is a bug) - -```ucm -scratch/main> view RecordWithUserType -``` - - -## Syntax - -Trailing commas are allowed. - -```unison -unique type Record5 = - { a : Text, - b : Int, - } -``` diff --git a/unison-src/transcripts/records.output.md b/unison-src/transcripts/records.output.md deleted file mode 100644 index 3e3d66245c..0000000000 --- a/unison-src/transcripts/records.output.md +++ /dev/null @@ -1,177 +0,0 @@ -Ensure that Records keep their syntax after being added to the codebase - -## Record with 1 field - -``` unison -unique type Record1 = { a : Text } -``` - -``` ucm -scratch/main> view Record1 - - type Record1 = { a : Text } - -``` -## Record with 2 fields - -``` unison -unique type Record2 = { a : Text, b : Int } -``` - -``` ucm -scratch/main> view Record2 - - type Record2 = { a : Text, b : Int } - -``` -## Record with 3 fields - -``` unison -unique type Record3 = { a : Text, b : Int, c : Nat } -``` - -``` ucm -scratch/main> view Record3 - - type Record3 = { a : Text, b : Int, c : Nat } - -``` -## Record with many fields - -``` unison -unique type Record4 = - { a : Text - , b : Int - , c : Nat - , d : Bytes - , e : Text - , f : Nat - , g : [Nat] - } -``` - -``` ucm -scratch/main> view Record4 - - type Record4 - = { a : Text, - b : Int, - c : Nat, - d : Bytes, - e : Text, - f : Nat, - g : [Nat] } - -``` -## Record with many many fields - -``` unison -unique type Record5 = { - zero : Nat, - one : [Nat], - two : [[Nat]], - three: [[[Nat]]], - four: [[[[Nat]]]], - five: [[[[[Nat]]]]], - six: [[[[[[Nat]]]]]], - seven: [[[[[[[Nat]]]]]]], - eight: [[[[[[[[Nat]]]]]]]], - nine: [[[[[[[[[Nat]]]]]]]]], - ten: [[[[[[[[[[Nat]]]]]]]]]], - eleven: [[[[[[[[[[[Nat]]]]]]]]]]], - twelve: [[[[[[[[[[[[Nat]]]]]]]]]]]], - thirteen: [[[[[[[[[[[[[Nat]]]]]]]]]]]]], - fourteen: [[[[[[[[[[[[[[Nat]]]]]]]]]]]]]], - fifteen: [[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]], - sixteen: [[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]], - seventeen: [[[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]]], - eighteen: [[[[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]]]], - nineteen: [[[[[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]]]]], - twenty: [[[[[[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]]]]]] -} -``` - -``` ucm -scratch/main> view Record5 - - type Record5 - = { zero : Nat, - one : [Nat], - two : [[Nat]], - three : [[[Nat]]], - four : [[[[Nat]]]], - five : [[[[[Nat]]]]], - six : [[[[[[Nat]]]]]], - seven : [[[[[[[Nat]]]]]]], - eight : [[[[[[[[Nat]]]]]]]], - nine : [[[[[[[[[Nat]]]]]]]]], - ten : [[[[[[[[[[Nat]]]]]]]]]], - eleven : [[[[[[[[[[[Nat]]]]]]]]]]], - twelve : [[[[[[[[[[[[Nat]]]]]]]]]]]], - thirteen : [[[[[[[[[[[[[Nat]]]]]]]]]]]]], - fourteen : [[[[[[[[[[[[[[Nat]]]]]]]]]]]]]], - fifteen : [[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]], - sixteen : [[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]], - seventeen : [[[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]]], - eighteen : [[[[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]]]], - nineteen : [[[[[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]]]]], - twenty : [[[[[[[[[[[[[[[[[[[[Nat]]]]]]]]]]]]]]]]]]]] } - -``` -## Record with user-defined type fields - -This record type has two fields whose types are user-defined (`Record4` and `UserType`). - -``` unison -unique type UserType = UserType Nat - -unique type RecordWithUserType = { a : Text, b : Record4, c : UserType } -``` - -If you `view` or `edit` it, it *should* be treated as a record type, but it does not (which is a bug) - -``` ucm -scratch/main> view RecordWithUserType - - type RecordWithUserType - = { a : Text, b : Record4, c : UserType } - -``` -## Syntax - -Trailing commas are allowed. - -``` unison -unique type Record5 = - { a : Text, - b : Int, - } -``` - -``` 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`: - - Record5.a : Record5 -> Text - Record5.a.modify : (Text ->{g} Text) - -> Record5 - ->{g} Record5 - Record5.a.set : Text -> Record5 -> Record5 - Record5.b : Record5 -> Int - Record5.b.modify : (Int ->{g} Int) - -> Record5 - ->{g} Record5 - Record5.b.set : Int -> Record5 -> Record5 - - ⍟ These names already exist. You can `update` them to your - new definition: - - type Record5 - -``` diff --git a/unison-src/transcripts/redundant.output.md b/unison-src/transcripts/redundant.output.md deleted file mode 100644 index b778734cd7..0000000000 --- a/unison-src/transcripts/redundant.output.md +++ /dev/null @@ -1,45 +0,0 @@ -The same kind of thing happens with `map`. Are we saying this is incorrect behaviour? - -```unison -map : (a -> b) -> [a] -> [b] -map f = cases - x +: xs -> f x +: map f xs - [] -> [] -``` - -```ucm - - 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`: - - map : (a ->{𝕖} b) ->{𝕖} [a] ->{𝕖} [b] - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - -``` -```ucm -.> add - - ⍟ I've added these definitions: - - map : (a ->{𝕖} b) ->{𝕖} [a] ->{𝕖} [b] - -.> view map - - map : (a -> b) -> [a] -> [b] - map f = cases - x +: xs -> - use builtin.List +: - f x +: map f xs - [] -> [] - -.> find map - - 1. map : (a ->{𝕖} b) ->{𝕖} [a] ->{𝕖} [b] - - -``` diff --git a/unison-src/transcripts/reflog.md b/unison-src/transcripts/reflog.md deleted file mode 100644 index 0bbb4f57df..0000000000 --- a/unison-src/transcripts/reflog.md +++ /dev/null @@ -1,41 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtins -``` - -First we make some changes to the codebase so there's data in the reflog. - -```unison -x = 1 -``` -```ucm -scratch/main> add -``` -```unison -y = 2 -``` -```ucm -scratch/main> add -scratch/main> branch /other -scratch/other> alias.term y z -newproject/main> builtins.merge lib.builtins -newproject/main> alias.type lib.builtins.Nat MyNat -``` - -Should see reflog entries from the current branch - -```ucm -scratch/main> reflog -``` - -Should see reflog entries from the current project - -```ucm -scratch/main> project.reflog -``` - - -Should see reflog entries from all projects - -```ucm -scratch/main> reflog.global -``` diff --git a/unison-src/transcripts/reflog.output.md b/unison-src/transcripts/reflog.output.md deleted file mode 100644 index 9fbff90318..0000000000 --- a/unison-src/transcripts/reflog.output.md +++ /dev/null @@ -1,135 +0,0 @@ -First we make some changes to the codebase so there's data in the reflog. - -``` unison -x = 1 -``` - -``` 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`: - - x : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - x : Nat - -``` -``` unison -y = 2 -``` - -``` 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`: - - y : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - y : Nat - -scratch/main> branch /other - - Done. I've created the other branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /other`. - -scratch/other> alias.term y z - - Done. - -newproject/main> builtins.merge lib.builtins - - Done. - -newproject/main> alias.type lib.builtins.Nat MyNat - - Done. - -``` -Should see reflog entries from the current branch - -``` ucm -scratch/main> reflog - - Below is a record of recent changes, you can use - `reset #abcdef` to reset the current branch to a previous - state. - - Tip: Use `diff.namespace 1 7` to compare between points in - history. - - Branch Hash Description - 1. scratch/main #6mdl5gruh5 add - 2. scratch/main #3rqf1hbev7 add - 3. scratch/main #ms9lggs2rg builtins.merge scratch/main:lib.builtins - 4. scratch/main #sg60bvjo91 Project Created - -``` -Should see reflog entries from the current project - -``` ucm -scratch/main> project.reflog - - Below is a record of recent changes, you can use - `reset #abcdef` to reset the current branch to a previous - state. - - Tip: Use `diff.namespace 1 7` to compare between points in - history. - - Branch Hash Description - 1. scratch/other #148flqs4b1 alias.term scratch/other:.y scratch/other:z - 2. scratch/other #6mdl5gruh5 Branch created from scratch/main - 3. scratch/main #6mdl5gruh5 add - 4. scratch/main #3rqf1hbev7 add - 5. scratch/main #ms9lggs2rg builtins.merge scratch/main:lib.builtins - 6. scratch/main #sg60bvjo91 Project Created - -``` -Should see reflog entries from all projects - -``` ucm -scratch/main> reflog.global - - Below is a record of recent changes, you can use - `reset #abcdef` to reset the current branch to a previous - state. - - Tip: Use `diff.namespace 1 7` to compare between points in - history. - - Branch Hash Description - 1. newproject/main #2rjhs2vq43 alias.term newproject/main:lib.builtins.Nat newproject/main:... - 2. newproject/main #ms9lggs2rg builtins.merge newproject/main:lib.builtins - 3. newproject/main #sg60bvjo91 Branch Created - 4. scratch/other #148flqs4b1 alias.term scratch/other:.y scratch/other:z - 5. scratch/other #6mdl5gruh5 Branch created from scratch/main - 6. scratch/main #6mdl5gruh5 add - 7. scratch/main #3rqf1hbev7 add - 8. scratch/main #ms9lggs2rg builtins.merge scratch/main:lib.builtins - 9. scratch/main #sg60bvjo91 Project Created - -``` diff --git a/unison-src/transcripts/release-draft-command.md b/unison-src/transcripts/release-draft-command.md deleted file mode 100644 index bac0e991b0..0000000000 --- a/unison-src/transcripts/release-draft-command.md +++ /dev/null @@ -1,29 +0,0 @@ -The `release.draft` command drafts a release from the current branch. - -```ucm:hide -foo/main> builtins.merge -``` - -Some setup: - -```unison -someterm = 18 -``` - -```ucm -foo/main> add -``` - -Now, the `release.draft` demo: - -`release.draft` accepts a single semver argument. - -```ucm -foo/main> release.draft 1.2.3 -``` - -It's an error to try to create a `releases/drafts/x.y.z` branch that already exists. - -```ucm:error -foo/main> release.draft 1.2.3 -``` diff --git a/unison-src/transcripts/release-draft-command.output.md b/unison-src/transcripts/release-draft-command.output.md deleted file mode 100644 index 3354e764f9..0000000000 --- a/unison-src/transcripts/release-draft-command.output.md +++ /dev/null @@ -1,60 +0,0 @@ -The `release.draft` command drafts a release from the current branch. - -Some setup: - -``` unison -someterm = 18 -``` - -``` 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`: - - someterm : Nat - -``` -``` ucm -foo/main> add - - ⍟ I've added these definitions: - - someterm : Nat - -``` -Now, the `release.draft` demo: - -`release.draft` accepts a single semver argument. - -``` ucm -foo/main> release.draft 1.2.3 - - 😎 Great! I've created a draft release for you at - /releases/drafts/1.2.3. - - You can create a `ReleaseNotes : Doc` in this branch to give - an overview of the release. It'll automatically show up on - Unison Share when you publish. - - When ready to release 1.2.3 to the world, `push` the release - to Unison Share, navigate to the release, and click "Publish". - - Tip: if you get pulled away from drafting your release, you - can always get back to it with - `switch /releases/drafts/1.2.3`. - -``` -It's an error to try to create a `releases/drafts/x.y.z` branch that already exists. - -``` ucm -foo/main> release.draft 1.2.3 - - foo/releases/drafts/1.2.3 already exists. You can switch to it - with `switch foo/releases/drafts/1.2.3`. - -``` diff --git a/unison-src/transcripts/reset.md b/unison-src/transcripts/reset.md deleted file mode 100644 index e430ef2906..0000000000 --- a/unison-src/transcripts/reset.md +++ /dev/null @@ -1,63 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -def = "first value" -``` - -```ucm:hide -scratch/main> update -``` - -```unison:hide -def = "second value" -``` - -Can reset to a value from history by number. - -```ucm -scratch/main> update -scratch/main> history -scratch/main> reset 2 -scratch/main> view def -scratch/main> history -``` - -Can reset to a value from reflog by number. - -```ucm -scratch/main> reflog --- Reset the current branch to the first history element -scratch/main> reset 2 -scratch/main> view def -scratch/main> history -``` - -# reset branch - -```ucm -foo/main> history -``` - -```unison:hide -a = 5 -``` - -```ucm -foo/main> update -foo/empty> reset /main: -foo/empty> view a -foo/empty> history -``` - -## second argument is always interpreted as a branch -```unison:hide -main.a = 3 -``` - -```ucm -foo/main> update -foo/main> history -foo/main> reset 2 main -``` diff --git a/unison-src/transcripts/reset.output.md b/unison-src/transcripts/reset.output.md deleted file mode 100644 index 7bcdacc4a1..0000000000 --- a/unison-src/transcripts/reset.output.md +++ /dev/null @@ -1,198 +0,0 @@ -``` unison -def = "first value" -``` - -``` 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`: - - def : Text - -``` -``` unison -def = "second value" -``` - -Can reset to a value from history by number. - -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -scratch/main> history - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #5vq851j3hg - - + Adds / updates: - - def - - ⊙ 2. #ujvq6e87kp - - + Adds / updates: - - def - - □ 3. #4bigcpnl7t (start of history) - -scratch/main> reset 2 - - Done. - -scratch/main> view def - - def : Text - def = "first value" - -scratch/main> history - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #ujvq6e87kp - - + Adds / updates: - - def - - □ 2. #4bigcpnl7t (start of history) - -``` -Can reset to a value from reflog by number. - -``` ucm -scratch/main> reflog - - Below is a record of recent changes, you can use - `reset #abcdef` to reset the current branch to a previous - state. - - Tip: Use `diff.namespace 1 7` to compare between points in - history. - - Branch Hash Description - 1. scratch/main #ujvq6e87kp reset ujvq6e87kp4288eq3al9v5luctic0ocd7ug1fu0go5bicrr2vfnrb0... - 2. scratch/main #5vq851j3hg update - 3. scratch/main #ujvq6e87kp update - 4. scratch/main #4bigcpnl7t builtins.merge - 5. scratch/main #sg60bvjo91 Project Created - --- Reset the current branch to the first history element -scratch/main> reset 2 - - Done. - -scratch/main> view def - - def : Text - def = "second value" - -scratch/main> history - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #5vq851j3hg - - + Adds / updates: - - def - - ⊙ 2. #ujvq6e87kp - - + Adds / updates: - - def - - □ 3. #4bigcpnl7t (start of history) - -``` -# reset branch - -``` ucm -foo/main> history - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #sg60bvjo91 (start of history) - -``` -``` unison -a = 5 -``` - -``` ucm -foo/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -foo/empty> reset /main: - - Done. - -foo/empty> view a - - a : ##Nat - a = 5 - -foo/empty> history - - Note: The most recent namespace hash is immediately below this - message. - - - - □ 1. #5l94rduvel (start of history) - -``` -## second argument is always interpreted as a branch - -``` unison -main.a = 3 -``` - -``` ucm -foo/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -foo/main> history - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #0i64kpfccl - - + Adds / updates: - - main.a - - □ 2. #5l94rduvel (start of history) - -foo/main> reset 2 main - - Done. - -``` diff --git a/unison-src/transcripts/resolution-failures.md b/unison-src/transcripts/resolution-failures.md deleted file mode 100644 index b9b97c999e..0000000000 --- a/unison-src/transcripts/resolution-failures.md +++ /dev/null @@ -1,54 +0,0 @@ -# Resolution Errors - -This transcript tests the errors printed to the user when a name cannot be resolved. - -## Codebase Setup - -```ucm -scratch/main> builtins.merge lib.builtins -``` - -First we define differing types with the same name in different namespaces: - -```unison -unique type one.AmbiguousType = one.AmbiguousType -unique type two.AmbiguousType = two.AmbiguousType - -one.ambiguousTerm = "term one" -two.ambiguousTerm = "term two" -``` - -```ucm -scratch/main> add -``` - -## Tests - -Now we introduce code which isn't sufficiently qualified. -It is ambiguous which type from which namespace we mean. - -We expect the output to: - -1. Print all ambiguous usage sites separately -2. Print possible disambiguation suggestions for each unique ambiguity - -```unison:error --- We intentionally avoid using a constructor to ensure the constructor doesn't --- affect type resolution. -useAmbiguousType : AmbiguousType -> () -useAmbiguousType _ = () - -useUnknownType : UnknownType -> () -useUnknownType _ = () - --- Despite being a duplicate disambiguation, this should still be included in the annotations printout -separateAmbiguousTypeUsage : AmbiguousType -> () -separateAmbiguousTypeUsage _ = () -``` - -Currently, ambiguous terms are caught and handled by type directed name resolution, -but expect it to eventually be handled by the above machinery. - -```unison:error -useAmbiguousTerm = ambiguousTerm -``` diff --git a/unison-src/transcripts/resolution-failures.output.md b/unison-src/transcripts/resolution-failures.output.md deleted file mode 100644 index c4aaf98906..0000000000 --- a/unison-src/transcripts/resolution-failures.output.md +++ /dev/null @@ -1,126 +0,0 @@ -# Resolution Errors - -This transcript tests the errors printed to the user when a name cannot be resolved. - -## Codebase Setup - -``` ucm -scratch/main> builtins.merge lib.builtins - - Done. - -``` -First we define differing types with the same name in different namespaces: - -``` unison -unique type one.AmbiguousType = one.AmbiguousType -unique type two.AmbiguousType = two.AmbiguousType - -one.ambiguousTerm = "term one" -two.ambiguousTerm = "term two" -``` - -``` 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`: - - type one.AmbiguousType - type two.AmbiguousType - one.ambiguousTerm : Text - two.ambiguousTerm : Text - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type one.AmbiguousType - type two.AmbiguousType - one.ambiguousTerm : Text - two.ambiguousTerm : Text - -``` -## Tests - -Now we introduce code which isn't sufficiently qualified. -It is ambiguous which type from which namespace we mean. - -We expect the output to: - -1. Print all ambiguous usage sites separately -2. Print possible disambiguation suggestions for each unique ambiguity - -``` unison --- We intentionally avoid using a constructor to ensure the constructor doesn't --- affect type resolution. -useAmbiguousType : AmbiguousType -> () -useAmbiguousType _ = () - -useUnknownType : UnknownType -> () -useUnknownType _ = () - --- Despite being a duplicate disambiguation, this should still be included in the annotations printout -separateAmbiguousTypeUsage : AmbiguousType -> () -separateAmbiguousTypeUsage _ = () -``` - -``` ucm - - Loading changes detected in scratch.u. - - - ❓ - - I couldn't resolve any of these symbols: - - 3 | useAmbiguousType : AmbiguousType -> () - 4 | useAmbiguousType _ = () - 5 | - 6 | useUnknownType : UnknownType -> () - 7 | useUnknownType _ = () - 8 | - 9 | -- Despite being a duplicate disambiguation, this should still be included in the annotations printout - 10 | separateAmbiguousTypeUsage : AmbiguousType -> () - - - Symbol Suggestions - - AmbiguousType one.AmbiguousType - two.AmbiguousType - - UnknownType No matches - - -``` -Currently, ambiguous terms are caught and handled by type directed name resolution, -but expect it to eventually be handled by the above machinery. - -``` unison -useAmbiguousTerm = ambiguousTerm -``` - -``` ucm - - Loading changes detected in scratch.u. - - I couldn't figure out what ambiguousTerm refers to here: - - 1 | useAmbiguousTerm = ambiguousTerm - - The name ambiguousTerm is ambiguous. I couldn't narrow it down - by type, as any type would work here. - - I found some terms in scope that have matching names and - types. Maybe you meant one of these: - - one.ambiguousTerm : Text - two.ambiguousTerm : Text - -``` diff --git a/unison-src/transcripts/rsa.md b/unison-src/transcripts/rsa.md deleted file mode 100644 index 6fe2118370..0000000000 --- a/unison-src/transcripts/rsa.md +++ /dev/null @@ -1,37 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison - -up = 0xs0123456789abcdef -down = 0xsfedcba9876543210 - --- | Generated with: --- openssl genrsa -out private_key.pem 1024 --- openssl rsa -in private_key.pem -outform DER | xxd -p -secret = 0xs30820276020100300d06092a864886f70d0101010500048202603082025c02010002818100a7104b2f20725896076e629ccedbcd6907b16694c6e3d8768b5e0e685670b49616e796c588e5aafb92ef986c1a42c021fed0bdc99212c969cdab98087a0ee4c2f4acd4b6049a87a96afc45668329a3cf21a86fb13b488bbe9fefa1cd5a459014f0d0101378e9661e11b73acf54c8a91141ac90309e7fb6ed69b4e63230ab291502030100010281807cdc23a4fc3619d93f8293b728af848d0c0fdd603269d5bd7b99f760a9c22065d08693dbdcddf1f5863306133d694819e04d789aef4e95343b601507b8d9eac4492e6d7031b035c5d84eceaa9686b292712632d33b3303af84314d7920bc3d45f90d7818fc2587b129196d378ee4ed3e6b8d9010d504bb6470ff53e7c5fb17a1024100d67cbcf113d24325fcef12a778dc47c7060055290b68287649ef092558daccb61c4e7bc290740b75a29d4356dcbd66d18b0860dbff394cc8ff3d94d57617adbd024100c765d8261dd3d8e0d3caf11ab7b212eed181354215687ca6387283e4f0be16e79c8f298be0a70c7734dea78ea65128517d693cabfa4c0ff5328f2abb85d2023902403ca41dc347285e65c22251b2d9bfe5e7463217e1b7e0e5f7b3a58a7f6da4c6d60220ca6ad2ee8c42e10bf77afa83ee2af6551315800e52404db1ba7fb398b43d02410084877d85c0177933ddb12a554eb8edfa8b872c85d2c2d2ee8be019280696e19469ab81bab5c371f69d4e4be1f54b45d7fbda017870f1333e0eafb78051ee8689024061f694c12e934c44b7734f62d1b2a3d3624a4980e1b8e066d78dbabd2436654fbb9d9701425900daaafa1e031310e8a580520bb9e1c1288c669fce252bad1e65 - --- | Generated with: --- openssl rsa -in private_key.pem -outform DER -pubout | xxd -p -publicKey = 0xs30819f300d06092a864886f70d010101050003818d0030818902818100a7104b2f20725896076e629ccedbcd6907b16694c6e3d8768b5e0e685670b49616e796c588e5aafb92ef986c1a42c021fed0bdc99212c969cdab98087a0ee4c2f4acd4b6049a87a96afc45668329a3cf21a86fb13b488bbe9fefa1cd5a459014f0d0101378e9661e11b73acf54c8a91141ac90309e7fb6ed69b4e63230ab29150203010001 - -incorrectPublicKey = 0xs30819f300d06092a864886f70d010101050003818d0030818902818100a7104b2f20725896076e629ccedbcd6907b16694c6e3d8768b5e0e685670b49616e796c588e5aafb92ef986c1a42c021fed0bdc99212c969cdab98087a0ee4c2f4acd4b6049a87a96afc45668329a3cf21a86fb13b488bbe9fefa1cd5a459014f0d0101378e9661e11b73acf54c8a91141ac90309e7fb6ed69b4e63230ab29150203010002 - -message = up ++ down ++ up ++ down ++ down ++ up ++ down ++ up - -signature = crypto.Rsa.sign.impl secret message - -sigOkay = match signature with - Left err -> Left err - Right sg -> crypto.Rsa.verify.impl publicKey message sg - -sigKo = match signature with - Left err -> Left err - Right sg -> crypto.Rsa.verify.impl incorrectPublicKey message sg - -> signature -> sigOkay -> sigKo -``` diff --git a/unison-src/transcripts/rsa.output.md b/unison-src/transcripts/rsa.output.md deleted file mode 100644 index 98e735c2ed..0000000000 --- a/unison-src/transcripts/rsa.output.md +++ /dev/null @@ -1,69 +0,0 @@ -``` unison -up = 0xs0123456789abcdef -down = 0xsfedcba9876543210 - --- | Generated with: --- openssl genrsa -out private_key.pem 1024 --- openssl rsa -in private_key.pem -outform DER | xxd -p -secret = 0xs30820276020100300d06092a864886f70d0101010500048202603082025c02010002818100a7104b2f20725896076e629ccedbcd6907b16694c6e3d8768b5e0e685670b49616e796c588e5aafb92ef986c1a42c021fed0bdc99212c969cdab98087a0ee4c2f4acd4b6049a87a96afc45668329a3cf21a86fb13b488bbe9fefa1cd5a459014f0d0101378e9661e11b73acf54c8a91141ac90309e7fb6ed69b4e63230ab291502030100010281807cdc23a4fc3619d93f8293b728af848d0c0fdd603269d5bd7b99f760a9c22065d08693dbdcddf1f5863306133d694819e04d789aef4e95343b601507b8d9eac4492e6d7031b035c5d84eceaa9686b292712632d33b3303af84314d7920bc3d45f90d7818fc2587b129196d378ee4ed3e6b8d9010d504bb6470ff53e7c5fb17a1024100d67cbcf113d24325fcef12a778dc47c7060055290b68287649ef092558daccb61c4e7bc290740b75a29d4356dcbd66d18b0860dbff394cc8ff3d94d57617adbd024100c765d8261dd3d8e0d3caf11ab7b212eed181354215687ca6387283e4f0be16e79c8f298be0a70c7734dea78ea65128517d693cabfa4c0ff5328f2abb85d2023902403ca41dc347285e65c22251b2d9bfe5e7463217e1b7e0e5f7b3a58a7f6da4c6d60220ca6ad2ee8c42e10bf77afa83ee2af6551315800e52404db1ba7fb398b43d02410084877d85c0177933ddb12a554eb8edfa8b872c85d2c2d2ee8be019280696e19469ab81bab5c371f69d4e4be1f54b45d7fbda017870f1333e0eafb78051ee8689024061f694c12e934c44b7734f62d1b2a3d3624a4980e1b8e066d78dbabd2436654fbb9d9701425900daaafa1e031310e8a580520bb9e1c1288c669fce252bad1e65 - --- | Generated with: --- openssl rsa -in private_key.pem -outform DER -pubout | xxd -p -publicKey = 0xs30819f300d06092a864886f70d010101050003818d0030818902818100a7104b2f20725896076e629ccedbcd6907b16694c6e3d8768b5e0e685670b49616e796c588e5aafb92ef986c1a42c021fed0bdc99212c969cdab98087a0ee4c2f4acd4b6049a87a96afc45668329a3cf21a86fb13b488bbe9fefa1cd5a459014f0d0101378e9661e11b73acf54c8a91141ac90309e7fb6ed69b4e63230ab29150203010001 - -incorrectPublicKey = 0xs30819f300d06092a864886f70d010101050003818d0030818902818100a7104b2f20725896076e629ccedbcd6907b16694c6e3d8768b5e0e685670b49616e796c588e5aafb92ef986c1a42c021fed0bdc99212c969cdab98087a0ee4c2f4acd4b6049a87a96afc45668329a3cf21a86fb13b488bbe9fefa1cd5a459014f0d0101378e9661e11b73acf54c8a91141ac90309e7fb6ed69b4e63230ab29150203010002 - -message = up ++ down ++ up ++ down ++ down ++ up ++ down ++ up - -signature = crypto.Rsa.sign.impl secret message - -sigOkay = match signature with - Left err -> Left err - Right sg -> crypto.Rsa.verify.impl publicKey message sg - -sigKo = match signature with - Left err -> Left err - Right sg -> crypto.Rsa.verify.impl incorrectPublicKey message sg - -> signature -> sigOkay -> sigKo -``` - -``` 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`: - - down : Bytes - incorrectPublicKey : Bytes - message : Bytes - publicKey : Bytes - secret : Bytes - sigKo : Either Failure Boolean - sigOkay : Either Failure Boolean - signature : Either Failure Bytes - up : Bytes - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 27 | > signature - ⧩ - Right - 0xs84b02b6bb0e1196b65378cb12b727f7b4b38e5979f0632e8a51cfab088827f6d3da4221788029f75a0a5f4d740372cfa590462888a1189bbd9de9b084f26116640e611af5a1a17229beec7fb2570887181bbdced8f0ebfec6cad6bdd318a616ba4f01c90e1436efe44b18417d18ce712a0763be834f8c76e0c39b2119b061373 - - 28 | > sigOkay - ⧩ - Right true - - 29 | > sigKo - ⧩ - Right false - -``` diff --git a/unison-src/transcripts/scope-ref.md b/unison-src/transcripts/scope-ref.md deleted file mode 100644 index 1abf26be2f..0000000000 --- a/unison-src/transcripts/scope-ref.md +++ /dev/null @@ -1,19 +0,0 @@ - -A short script to test mutable references with local scope. - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -test = Scope.run 'let - r = Scope.ref 0 - Ref.write r 1 - i = Ref.read r - Ref.write r 2 - j = Ref.read r - Ref.write r 5 - (i, j, Ref.read r) - -> test -``` diff --git a/unison-src/transcripts/scope-ref.output.md b/unison-src/transcripts/scope-ref.output.md deleted file mode 100644 index c356bc531d..0000000000 --- a/unison-src/transcripts/scope-ref.output.md +++ /dev/null @@ -1,35 +0,0 @@ -A short script to test mutable references with local scope. - -``` unison -test = Scope.run 'let - r = Scope.ref 0 - Ref.write r 1 - i = Ref.read r - Ref.write r 2 - j = Ref.read r - Ref.write r 5 - (i, j, Ref.read r) - -> test -``` - -``` 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`: - - test : (Nat, Nat, Nat) - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 10 | > test - ⧩ - (1, 2, 5) - -``` diff --git a/unison-src/transcripts/suffixes.md b/unison-src/transcripts/suffixes.md deleted file mode 100644 index 7245b4cb31..0000000000 --- a/unison-src/transcripts/suffixes.md +++ /dev/null @@ -1,107 +0,0 @@ -# Suffix-based resolution of names - -```ucm:hide -scratch/main> builtins.merge -``` - -Any unique name suffix can be used to refer to a definition. For instance: - -```unison:hide --- No imports needed even though FQN is `builtin.{Int,Nat}` -foo.bar.a : Int -foo.bar.a = +99 - --- No imports needed even though FQN is `builtin.Optional.{None,Some}` -optional.isNone = cases - None -> true - Some _ -> false -``` - -This also affects commands like find. Notice lack of qualified names in output: - -```ucm -scratch/main> add -scratch/main> find take -``` - -The `view` and `display` commands also benefit from this: - -```ucm -scratch/main> view List.drop -scratch/main> display bar.a -``` - -In the signature, we don't see `base.Nat`, just `Nat`. The full declaration name is still shown for each search result though. - -Type-based search also benefits from this, we can just say `Nat` rather than `.base.Nat`: - -```ucm -scratch/main> find : Nat -> [a] -> [a] -``` - -## Preferring names not in `lib.*.lib.*` - -Suffix-based resolution prefers names that are not in an indirect dependency. - -```unison -cool.abra.cadabra = "my project" -lib.distributed.abra.cadabra = "direct dependency 1" -lib.distributed.baz.qux = "direct dependency 2" -lib.distributed.lib.baz.qux = "indirect dependency" -``` - -```ucm -scratch/main> add -``` - -```unison:error -> abra.cadabra -``` - -```unison -> baz.qux -``` - -```ucm -scratch/main> view abra.cadabra -scratch/main> view baz.qux -``` - -Note that we can always still view indirect dependencies by using more name segments: - -```ucm -scratch/main> view distributed.abra.cadabra -scratch/main> names distributed.lib.baz.qux -``` - -## Corner cases - -If a definition is given in a scratch file, its suffixes shadow existing definitions that exist in the codebase with the same suffixes. For example: - -```unison:hide -unique type A = Thing1 Nat | thing2 Nat - -foo.a = 23 -bar = 100 -``` - -```ucm -scratch/main> add -``` - -```unison -unique type B = Thing1 Text | thing2 Text | Thing3 Text - -zoink.a = "hi" - --- verifying that the `a` here references `zoink.a` -foo.baz.qux.bar : Text -foo.baz.qux.bar = a - --- verifying that the `bar` is resolving to `foo.baz.qux.bar` --- and that `Thing1` references `B.Thing1` from the current file -fn = cases - Thing1 msg -> msg Text.++ bar - thing2 msg -> msg Text.++ bar - _ -> todo "hmm" -``` diff --git a/unison-src/transcripts/suffixes.output.md b/unison-src/transcripts/suffixes.output.md deleted file mode 100644 index a4cd5e3b02..0000000000 --- a/unison-src/transcripts/suffixes.output.md +++ /dev/null @@ -1,223 +0,0 @@ -# Suffix-based resolution of names - -Any unique name suffix can be used to refer to a definition. For instance: - -``` unison --- No imports needed even though FQN is `builtin.{Int,Nat}` -foo.bar.a : Int -foo.bar.a = +99 - --- No imports needed even though FQN is `builtin.Optional.{None,Some}` -optional.isNone = cases - None -> true - Some _ -> false -``` - -This also affects commands like find. Notice lack of qualified names in output: - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - foo.bar.a : Int - optional.isNone : Optional a -> Boolean - -scratch/main> find take - - 1. builtin.Bytes.take : Nat -> Bytes -> Bytes - 2. builtin.List.take : Nat -> [a] -> [a] - 3. builtin.Text.take : Nat -> Text -> Text - 4. builtin.io2.MVar.take.impl : MVar a ->{IO} Either Failure a - 5. builtin.io2.MVar.tryTake : MVar a ->{IO} Optional a - - -``` -The `view` and `display` commands also benefit from this: - -``` ucm -scratch/main> view List.drop - - builtin builtin.List.drop : builtin.Nat -> [a] -> [a] - -scratch/main> display bar.a - - +99 - -``` -In the signature, we don't see `base.Nat`, just `Nat`. The full declaration name is still shown for each search result though. - -Type-based search also benefits from this, we can just say `Nat` rather than `.base.Nat`: - -``` ucm -scratch/main> find : Nat -> [a] -> [a] - - 1. builtin.List.drop : Nat -> [a] -> [a] - 2. builtin.List.take : Nat -> [a] -> [a] - - -``` -## Preferring names not in `lib.*.lib.*` - -Suffix-based resolution prefers names that are not in an indirect dependency. - -``` unison -cool.abra.cadabra = "my project" -lib.distributed.abra.cadabra = "direct dependency 1" -lib.distributed.baz.qux = "direct dependency 2" -lib.distributed.lib.baz.qux = "indirect dependency" -``` - -``` 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`: - - cool.abra.cadabra : Text - lib.distributed.abra.cadabra : Text - lib.distributed.baz.qux : Text - lib.distributed.lib.baz.qux : Text - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - cool.abra.cadabra : Text - lib.distributed.abra.cadabra : Text - lib.distributed.baz.qux : Text - lib.distributed.lib.baz.qux : Text - -``` -``` unison -> abra.cadabra -``` - -``` ucm - - Loading changes detected in scratch.u. - - I couldn't figure out what abra.cadabra refers to here: - - 1 | > abra.cadabra - - The name abra.cadabra is ambiguous. I couldn't narrow it down - by type, as any type would work here. - - I found some terms in scope that have matching names and - types. Maybe you meant one of these: - - cool.abra.cadabra : Text - distributed.abra.cadabra : Text - -``` -``` unison -> baz.qux -``` - -``` ucm - - Loading changes detected in scratch.u. - - ✅ - - scratch.u changed. - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 1 | > baz.qux - ⧩ - "direct dependency 2" - -``` -``` ucm -scratch/main> view abra.cadabra - - cool.abra.cadabra : Text - cool.abra.cadabra = "my project" - - lib.distributed.abra.cadabra : Text - lib.distributed.abra.cadabra = "direct dependency 1" - -scratch/main> view baz.qux - - lib.distributed.baz.qux : Text - lib.distributed.baz.qux = "direct dependency 2" - -``` -Note that we can always still view indirect dependencies by using more name segments: - -``` ucm -scratch/main> view distributed.abra.cadabra - - lib.distributed.abra.cadabra : Text - lib.distributed.abra.cadabra = "direct dependency 1" - -scratch/main> names distributed.lib.baz.qux - - Term - Hash: #nhup096n2s - Names: lib.distributed.lib.baz.qux - -``` -## Corner cases - -If a definition is given in a scratch file, its suffixes shadow existing definitions that exist in the codebase with the same suffixes. For example: - -``` unison -unique type A = Thing1 Nat | thing2 Nat - -foo.a = 23 -bar = 100 -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type A - bar : Nat - foo.a : Nat - -``` -``` unison -unique type B = Thing1 Text | thing2 Text | Thing3 Text - -zoink.a = "hi" - --- verifying that the `a` here references `zoink.a` -foo.baz.qux.bar : Text -foo.baz.qux.bar = a - --- verifying that the `bar` is resolving to `foo.baz.qux.bar` --- and that `Thing1` references `B.Thing1` from the current file -fn = cases - Thing1 msg -> msg Text.++ bar - thing2 msg -> msg Text.++ bar - _ -> todo "hmm" -``` - -``` 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`: - - type B - fn : B -> Text - foo.baz.qux.bar : Text - zoink.a : Text - -``` diff --git a/unison-src/transcripts/sum-type-update-conflicts.md b/unison-src/transcripts/sum-type-update-conflicts.md deleted file mode 100644 index 1abf98f3ba..0000000000 --- a/unison-src/transcripts/sum-type-update-conflicts.md +++ /dev/null @@ -1,36 +0,0 @@ -# Regression test for updates which conflict with an existing data constructor - -https://github.com/unisonweb/unison/issues/2786 - -```ucm:hide -scratch/main> builtins.merge lib.builtins -``` - -First we add a sum-type to the codebase. - -```unison -structural type X = x -``` - -```ucm -scratch/main> add -``` - -Now we update the type, changing the name of the constructors, _but_, we simultaneously -add a new top-level term with the same name as the old constructor. - -```unison -structural type X = y | z - -X.x : Text -X.x = "some text that's not in the codebase" - -dependsOnX = Text.size X.x -``` - -This update should succeed since the conflicted constructor -is removed in the same update that the new term is being added. - -```ucm -scratch/main> update.old -``` diff --git a/unison-src/transcripts/sum-type-update-conflicts.output.md b/unison-src/transcripts/sum-type-update-conflicts.output.md deleted file mode 100644 index ba70632b86..0000000000 --- a/unison-src/transcripts/sum-type-update-conflicts.output.md +++ /dev/null @@ -1,82 +0,0 @@ -# Regression test for updates which conflict with an existing data constructor - -https://github.com/unisonweb/unison/issues/2786 - -First we add a sum-type to the codebase. - -``` unison -structural type X = x -``` - -``` 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`: - - structural type X - (also named lib.builtins.Unit) - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - structural type X - (also named lib.builtins.Unit) - -``` -Now we update the type, changing the name of the constructors, *but*, we simultaneously -add a new top-level term with the same name as the old constructor. - -``` unison -structural type X = y | z - -X.x : Text -X.x = "some text that's not in the codebase" - -dependsOnX = Text.size X.x -``` - -``` 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`: - - X.x : Text - dependsOnX : Nat - - ⍟ These names already exist. You can `update` them to your - new definition: - - structural type X - (The old definition is also named lib.builtins.Unit.) - -``` -This update should succeed since the conflicted constructor -is removed in the same update that the new term is being added. - -``` ucm -scratch/main> update.old - - ⍟ I've added these definitions: - - X.x : Text - dependsOnX : Nat - - ⍟ I've updated these names to your new definition: - - structural type X - (The old definition was also named lib.builtins.Unit.) - -``` diff --git a/unison-src/transcripts/switch-command.md b/unison-src/transcripts/switch-command.md deleted file mode 100644 index 13e33c8583..0000000000 --- a/unison-src/transcripts/switch-command.md +++ /dev/null @@ -1,50 +0,0 @@ -The `switch` command switches to an existing project or branch. - -```ucm:hide -foo/main> builtins.merge -bar/main> builtins.merge -``` - -Setup stuff. - -```unison -someterm = 18 -``` - -```ucm -foo/main> add -foo/main> branch bar -foo/main> branch topic -``` - -Now, the demo. When unambiguous, `switch` switches to either a project or a branch in the current project. A branch in -the current project can be preceded by a forward slash (which makes it unambiguous). A project can be followed by a -forward slash (which makes it unambiguous). - -```ucm -scratch/main> switch foo -scratch/main> switch foo/topic -foo/main> switch topic -foo/main> switch /topic -foo/main> switch bar/ -``` - -It's an error to try to switch to something ambiguous. - -```ucm:error -foo/main> switch bar -``` - -It's an error to try to switch to something that doesn't exist, of course. - -```ucm:error -scratch/main> switch foo/no-such-branch -``` - -```ucm:error -scratch/main> switch no-such-project -``` - -```ucm:error -foo/main> switch no-such-project-or-branch -``` diff --git a/unison-src/transcripts/switch-command.output.md b/unison-src/transcripts/switch-command.output.md deleted file mode 100644 index 96778f99d7..0000000000 --- a/unison-src/transcripts/switch-command.output.md +++ /dev/null @@ -1,95 +0,0 @@ -The `switch` command switches to an existing project or branch. - -Setup stuff. - -``` unison -someterm = 18 -``` - -``` 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`: - - someterm : Nat - -``` -``` ucm -foo/main> add - - ⍟ I've added these definitions: - - someterm : Nat - -foo/main> branch bar - - Done. I've created the bar branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /bar`. - -foo/main> branch topic - - Done. I've created the topic branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /topic`. - -``` -Now, the demo. When unambiguous, `switch` switches to either a project or a branch in the current project. A branch in -the current project can be preceded by a forward slash (which makes it unambiguous). A project can be followed by a -forward slash (which makes it unambiguous). - -``` ucm -scratch/main> switch foo - -scratch/main> switch foo/topic - -foo/main> switch topic - -foo/main> switch /topic - -foo/main> switch bar/ - -``` -It's an error to try to switch to something ambiguous. - -``` ucm -foo/main> switch bar - - I'm not sure if you wanted to switch to the branch foo/bar or - the project bar. Could you be more specific? - - 1. /bar (the branch bar in the current project) - 2. bar/ (the project bar, with the branch left unspecified) - - Tip: use `switch 1` or `switch 2` to pick one of these. - -``` -It's an error to try to switch to something that doesn't exist, of course. - -``` ucm -scratch/main> switch foo/no-such-branch - - foo/no-such-branch does not exist. - -``` -``` ucm -scratch/main> switch no-such-project - - Neither project no-such-project nor branch /no-such-project - exists. - -``` -``` ucm -foo/main> switch no-such-project-or-branch - - Neither project no-such-project-or-branch nor branch - /no-such-project-or-branch exists. - -``` diff --git a/unison-src/transcripts/tab-completion.md b/unison-src/transcripts/tab-completion.md deleted file mode 100644 index e7b7e8b76c..0000000000 --- a/unison-src/transcripts/tab-completion.md +++ /dev/null @@ -1,95 +0,0 @@ -# Tab Completion - -Test that tab completion works as expected. - -## Tab Complete Command Names - -```ucm -scratch/main> debug.tab-complete vi -scratch/main> debug.tab-complete delete. -``` - -## Tab complete terms & types - -```unison -subnamespace.someName = 1 -subnamespace.someOtherName = 2 -subnamespace2.thing = 3 -othernamespace.someName = 4 - -unique type subnamespace.AType = A | B -``` - -```ucm:hide -scratch/main> add -``` - -```ucm --- Should tab complete namespaces since they may contain terms/types -scratch/main> debug.tab-complete view sub --- Should not complete things from child namespaces of the current query if there are other completions at this level -scratch/main> debug.tab-complete view subnamespace --- Should complete things from child namespaces of the current query if it's dot-suffixed -scratch/main> debug.tab-complete view subnamespace. --- Should complete things from child namespaces of the current query if there are no more completions at this level. -scratch/main> debug.tab-complete view subnamespace2 --- Should prefix-filter by query suffix -scratch/main> debug.tab-complete view subnamespace.some -scratch/main> debug.tab-complete view subnamespace.someOther -``` - -```unison:hide -absolute.term = "absolute" -``` - -```ucm -scratch/main> add --- Should tab complete absolute names -scratch/main> debug.tab-complete view .absolute.te -``` - -## Tab complete namespaces - -```ucm --- Should tab complete namespaces -scratch/main> debug.tab-complete find-in sub -scratch/main> debug.tab-complete find-in subnamespace -scratch/main> debug.tab-complete find-in subnamespace. -scratch/main> debug.tab-complete io.test sub -scratch/main> debug.tab-complete io.test subnamespace -scratch/main> debug.tab-complete io.test subnamespace. -``` - -Tab Complete Delete Subcommands - -```unison -unique type Foo = A | B -add : a -> a -add b = b -``` - -```ucm -scratch/main> update.old -scratch/main> debug.tab-complete delete.type Foo -scratch/main> debug.tab-complete delete.term add -``` - -## Tab complete projects and branches - -```ucm -myproject/main> branch mybranch -myproject/main> debug.tab-complete branch.delete /mybr -myproject/main> debug.tab-complete project.rename my -``` - -Commands which complete namespaces OR branches should list both - -```unison -mybranchsubnamespace.term = 1 -``` - - -```ucm -myproject/main> add -myproject/main> debug.tab-complete merge mybr -``` diff --git a/unison-src/transcripts/tab-completion.output.md b/unison-src/transcripts/tab-completion.output.md deleted file mode 100644 index 2c0103bb95..0000000000 --- a/unison-src/transcripts/tab-completion.output.md +++ /dev/null @@ -1,233 +0,0 @@ -# Tab Completion - -Test that tab completion works as expected. - -## Tab Complete Command Names - -``` ucm -scratch/main> debug.tab-complete vi - - view - view.global - -scratch/main> debug.tab-complete delete. - - delete.branch - delete.namespace - delete.namespace.force - delete.project - delete.term - delete.term.verbose - delete.type - delete.type.verbose - delete.verbose - -``` -## Tab complete terms & types - -``` unison -subnamespace.someName = 1 -subnamespace.someOtherName = 2 -subnamespace2.thing = 3 -othernamespace.someName = 4 - -unique type subnamespace.AType = A | B -``` - -``` 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`: - - type subnamespace.AType - othernamespace.someName : ##Nat - subnamespace.someName : ##Nat - subnamespace.someOtherName : ##Nat - subnamespace2.thing : ##Nat - -``` -``` ucm --- Should tab complete namespaces since they may contain terms/types -scratch/main> debug.tab-complete view sub - - subnamespace. - subnamespace2. - --- Should not complete things from child namespaces of the current query if there are other completions at this level -scratch/main> debug.tab-complete view subnamespace - - subnamespace. - subnamespace2. - --- Should complete things from child namespaces of the current query if it's dot-suffixed -scratch/main> debug.tab-complete view subnamespace. - - * subnamespace.AType - subnamespace.AType. - * subnamespace.someName - * subnamespace.someOtherName - --- Should complete things from child namespaces of the current query if there are no more completions at this level. -scratch/main> debug.tab-complete view subnamespace2 - - subnamespace2. - * subnamespace2.thing - --- Should prefix-filter by query suffix -scratch/main> debug.tab-complete view subnamespace.some - - * subnamespace.someName - * subnamespace.someOtherName - -scratch/main> debug.tab-complete view subnamespace.someOther - - * subnamespace.someOtherName - -``` -``` unison -absolute.term = "absolute" -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - absolute.term : ##Text - --- Should tab complete absolute names -scratch/main> debug.tab-complete view .absolute.te - - * .absolute.term - -``` -## Tab complete namespaces - -``` ucm --- Should tab complete namespaces -scratch/main> debug.tab-complete find-in sub - - subnamespace - subnamespace2 - -scratch/main> debug.tab-complete find-in subnamespace - - subnamespace - subnamespace2 - -scratch/main> debug.tab-complete find-in subnamespace. - - subnamespace.AType - -scratch/main> debug.tab-complete io.test sub - - subnamespace. - subnamespace2. - -scratch/main> debug.tab-complete io.test subnamespace - - subnamespace. - subnamespace2. - -scratch/main> debug.tab-complete io.test subnamespace. - - subnamespace.AType. - * subnamespace.someName - * subnamespace.someOtherName - -``` -Tab Complete Delete Subcommands - -``` unison -unique type Foo = A | B -add : a -> a -add b = b -``` - -``` 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`: - - type Foo - add : a -> a - -``` -``` ucm -scratch/main> update.old - - ⍟ I've added these definitions: - - type Foo - add : a -> a - -scratch/main> debug.tab-complete delete.type Foo - - * Foo - Foo. - -scratch/main> debug.tab-complete delete.term add - - * add - -``` -## Tab complete projects and branches - -``` ucm -myproject/main> branch mybranch - - Done. I've created the mybranch branch based off of main. - - Tip: To merge your work back into the main branch, first - `switch /main` then `merge /mybranch`. - -myproject/main> debug.tab-complete branch.delete /mybr - - /mybranch - -myproject/main> debug.tab-complete project.rename my - - myproject - -``` -Commands which complete namespaces OR branches should list both - -``` unison -mybranchsubnamespace.term = 1 -``` - -``` 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`: - - mybranchsubnamespace.term : ##Nat - -``` -``` ucm -myproject/main> add - - ⍟ I've added these definitions: - - mybranchsubnamespace.term : ##Nat - -myproject/main> debug.tab-complete merge mybr - - /mybranch - -``` diff --git a/unison-src/transcripts/test-command.md b/unison-src/transcripts/test-command.md deleted file mode 100644 index aedcb1b59d..0000000000 --- a/unison-src/transcripts/test-command.md +++ /dev/null @@ -1,57 +0,0 @@ -Merge builtins so we get enough names for the testing stuff. - -```ucm:hide -scratch/main> builtins.merge -``` - -The `test` command should run all of the tests in the current directory. - -```unison -test1 : [Result] -test1 = [Ok "test1"] - -foo.test2 : [Result] -foo.test2 = [Ok "test2"] -``` - -```ucm:hide -scratch/main> add -``` - -```ucm -scratch/main> test -``` - -Tests should be cached if unchanged. - -```ucm -scratch/main> test -``` - -`test` won't descend into the `lib` namespace, but `test.all` will. - -```unison -lib.dep.testInLib : [Result] -lib.dep.testInLib = [Ok "testInLib"] -``` - -```ucm:hide -scratch/main> add -``` - -```ucm -scratch/main> test -scratch/main> test.all -``` - -`test` WILL run tests within `lib` if specified explicitly. - -```ucm -scratch/main> test lib.dep -``` - -`test` can be given a relative path, in which case it will only run tests found somewhere in that namespace. - -```ucm -scratch/main> test foo -``` diff --git a/unison-src/transcripts/test-command.output.md b/unison-src/transcripts/test-command.output.md deleted file mode 100644 index f603bc3f1b..0000000000 --- a/unison-src/transcripts/test-command.output.md +++ /dev/null @@ -1,149 +0,0 @@ -Merge builtins so we get enough names for the testing stuff. - -The `test` command should run all of the tests in the current directory. - -``` unison -test1 : [Result] -test1 = [Ok "test1"] - -foo.test2 : [Result] -foo.test2 = [Ok "test2"] -``` - -``` 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.test2 : [Result] - test1 : [Result] - -``` -``` ucm -scratch/main> test - - ✅ - - - - - - - - - - New test results: - - 1. foo.test2 ◉ test2 - 2. test1 ◉ test1 - - ✅ 2 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` -Tests should be cached if unchanged. - -``` ucm -scratch/main> test - - Cached test results (`help testcache` to learn more) - - 1. foo.test2 ◉ test2 - 2. test1 ◉ test1 - - ✅ 2 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` -`test` won't descend into the `lib` namespace, but `test.all` will. - -``` unison -lib.dep.testInLib : [Result] -lib.dep.testInLib = [Ok "testInLib"] -``` - -``` 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`: - - lib.dep.testInLib : [Result] - -``` -``` ucm -scratch/main> test - - Cached test results (`help testcache` to learn more) - - 1. foo.test2 ◉ test2 - 2. test1 ◉ test1 - - ✅ 2 test(s) passing - - Tip: Use view 1 to view the source of a test. - -scratch/main> test.all - - - Cached test results (`help testcache` to learn more) - - 1. foo.test2 ◉ test2 - 2. test1 ◉ test1 - - ✅ 2 test(s) passing - - ✅ - - - - - - New test results: - - 1. lib.dep.testInLib ◉ testInLib - - ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` -`test` WILL run tests within `lib` if specified explicitly. - -``` ucm -scratch/main> test lib.dep - - Cached test results (`help testcache` to learn more) - - 1. lib.dep.testInLib ◉ testInLib - - ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` -`test` can be given a relative path, in which case it will only run tests found somewhere in that namespace. - -``` ucm -scratch/main> test foo - - Cached test results (`help testcache` to learn more) - - 1. foo.test2 ◉ test2 - - ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` diff --git a/unison-src/transcripts/text-literals.md b/unison-src/transcripts/text-literals.md deleted file mode 100644 index 3d3b1359aa..0000000000 --- a/unison-src/transcripts/text-literals.md +++ /dev/null @@ -1,42 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -This transcript shows some syntax for raw text literals. - -```unison -lit1 = """ -This is a raw text literal. -It can start with 3 or more ", -and is terminated by the same number of quotes. -Nothing is escaped. \n - -The initial newline, if it exists, is ignored. -The last line, if it's just whitespace up to the closing quotes, -is ignored. - -Use an extra blank line if you'd like a trailing newline. Like so: - -""" - -> lit1 -> Some lit1 - -lit2 = """" - This is a raw text literal, indented. - It can start with 3 or more ", - and is terminated by the same number of quotes. - Nothing is escaped. \n - - This doesn't terminate the literal - """ - """" - -> lit2 -> Some lit2 -``` - -```ucm -scratch/main> add -scratch/main> view lit1 lit2 -``` \ No newline at end of file diff --git a/unison-src/transcripts/text-literals.output.md b/unison-src/transcripts/text-literals.output.md deleted file mode 100644 index b023a3d062..0000000000 --- a/unison-src/transcripts/text-literals.output.md +++ /dev/null @@ -1,125 +0,0 @@ -This transcript shows some syntax for raw text literals. - -``` unison -lit1 = """ -This is a raw text literal. -It can start with 3 or more ", -and is terminated by the same number of quotes. -Nothing is escaped. \n - -The initial newline, if it exists, is ignored. -The last line, if it's just whitespace up to the closing quotes, -is ignored. - -Use an extra blank line if you'd like a trailing newline. Like so: - -""" - -> lit1 -> Some lit1 - -lit2 = """" - This is a raw text literal, indented. - It can start with 3 or more ", - and is terminated by the same number of quotes. - Nothing is escaped. \n - - This doesn't terminate the literal - """ - """" - -> lit2 -> Some lit2 -``` - -``` 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`: - - lit1 : Text - lit2 : Text - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 15 | > lit1 - ⧩ - """ - This is a raw text literal. - It can start with 3 or more ", - and is terminated by the same number of quotes. - Nothing is escaped. \n - - The initial newline, if it exists, is ignored. - The last line, if it's just whitespace up to the closing quotes, - is ignored. - - Use an extra blank line if you'd like a trailing newline. Like so: - - """ - - 16 | > Some lit1 - ⧩ - Some - "This is a raw text literal.\nIt can start with 3 or more \",\nand is terminated by the same number of quotes.\nNothing is escaped. \\n\n\nThe initial newline, if it exists, is ignored.\nThe last line, if it's just whitespace up to the closing quotes,\nis ignored.\n\nUse an extra blank line if you'd like a trailing newline. Like so:\n" - - 27 | > lit2 - ⧩ - """" - This is a raw text literal, indented. - It can start with 3 or more ", - and is terminated by the same number of quotes. - Nothing is escaped. \n - - This doesn't terminate the literal - """ - """" - - 28 | > Some lit2 - ⧩ - Some - "This is a raw text literal, indented.\nIt can start with 3 or more \",\nand is terminated by the same number of quotes.\nNothing is escaped. \\n\n\nThis doesn't terminate the literal - \"\"\"" - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - lit1 : Text - lit2 : Text - -scratch/main> view lit1 lit2 - - lit1 : Text - lit1 = - """ - This is a raw text literal. - It can start with 3 or more ", - and is terminated by the same number of quotes. - Nothing is escaped. \n - - The initial newline, if it exists, is ignored. - The last line, if it's just whitespace up to the closing quotes, - is ignored. - - Use an extra blank line if you'd like a trailing newline. Like so: - - """ - - lit2 : Text - lit2 = - """" - This is a raw text literal, indented. - It can start with 3 or more ", - and is terminated by the same number of quotes. - Nothing is escaped. \n - - This doesn't terminate the literal - """ - """" - -``` diff --git a/unison-src/transcripts/todo-bug-builtins.md b/unison-src/transcripts/todo-bug-builtins.md deleted file mode 100644 index e472204d4c..0000000000 --- a/unison-src/transcripts/todo-bug-builtins.md +++ /dev/null @@ -1,27 +0,0 @@ -# The `todo` and `bug` builtin - -```ucm:hide -scratch/main> builtins.merge -``` - -`todo` and `bug` have type `a -> b`. They take a message or a value of type `a` and crash during runtime displaying `a` in ucm. -```unison:error -> todo "implement me later" -``` -```unison:error -> bug "there's a bug in my code" -``` - -## Todo -`todo` is useful if you want to come back to a piece of code later but you want your project to compile. -```unison -complicatedMathStuff x = todo "Come back and to something with x here" -``` - -## Bug -`bug` is used to indicate that a particular branch is not expected to execute. -```unison -test = match true with - true -> "Yay" - false -> bug "Wow, that's unexpected" -``` diff --git a/unison-src/transcripts/todo-bug-builtins.output.md b/unison-src/transcripts/todo-bug-builtins.output.md deleted file mode 100644 index 932353888f..0000000000 --- a/unison-src/transcripts/todo-bug-builtins.output.md +++ /dev/null @@ -1,102 +0,0 @@ -# The `todo` and `bug` builtin - -`todo` and `bug` have type `a -> b`. They take a message or a value of type `a` and crash during runtime displaying `a` in ucm. - -``` unison -> todo "implement me later" -``` - -``` ucm - - Loading changes detected in scratch.u. - - ✅ - - scratch.u changed. - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 💔💥 - - I've encountered a call to builtin.todo with the following - value: - - "implement me later" - - Stack trace: - todo - #qe5e1lcfn8 - -``` -``` unison -> bug "there's a bug in my code" -``` - -``` ucm - - Loading changes detected in scratch.u. - - ✅ - - scratch.u changed. - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 💔💥 - - I've encountered a call to builtin.bug with the following - value: - - "there's a bug in my code" - - Stack trace: - bug - #m67hcdcoda - -``` -## Todo - -`todo` is useful if you want to come back to a piece of code later but you want your project to compile. - -``` unison -complicatedMathStuff x = todo "Come back and to something with x here" -``` - -``` 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`: - - complicatedMathStuff : x -> r - -``` -## Bug - -`bug` is used to indicate that a particular branch is not expected to execute. - -``` unison -test = match true with - true -> "Yay" - false -> bug "Wow, that's unexpected" -``` - -``` 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`: - - test : Text - -``` diff --git a/unison-src/transcripts/todo.md b/unison-src/transcripts/todo.md deleted file mode 100644 index 46e1eb6165..0000000000 --- a/unison-src/transcripts/todo.md +++ /dev/null @@ -1,188 +0,0 @@ -# Nothing to do - -When there's nothing to do, `todo` says this: - -```ucm -scratch/main> todo -``` - -# Dependents of `todo` - -The `todo` command shows local (outside `lib`) terms that directly call `todo`. - -```ucm:hide -scratch/main> builtins.mergeio lib.builtins -``` - -```unison -foo : Nat -foo = todo "implement foo" - -bar : Nat -bar = foo + foo -``` - -```ucm -scratch/main> add -scratch/main> todo -``` - -```ucm:hide -scratch/main> delete.project scratch -``` - -# Direct dependencies without names - -The `todo` command shows hashes of direct dependencies of local (outside `lib`) definitions that don't have names in -the current namespace. - -```ucm:hide -scratch/main> builtins.mergeio lib.builtins -``` - -```unison -foo.bar = 15 -baz = foo.bar + foo.bar -``` - -```ucm -scratch/main> add -scratch/main> delete.namespace.force foo -scratch/main> todo -``` - -```ucm:hide -scratch/main> delete.project scratch -``` - -# Conflicted names - -The `todo` command shows conflicted names. - -```ucm:hide -scratch/main> builtins.mergeio lib.builtins -``` - -```unison -foo = 16 -bar = 17 -``` - -```ucm -scratch/main> add -scratch/main> debug.alias.term.force foo bar -scratch/main> todo -``` - -```ucm:hide -scratch/main> delete.project scratch -``` - -# Definitions in lib - -The `todo` command complains about terms and types directly in `lib`. - -```ucm:hide -scratch/main> builtins.mergeio lib.builtins -``` - -```unison -lib.foo = 16 -``` - -```ucm -scratch/main> add -scratch/main> todo -``` - -```ucm:hide -scratch/main> delete.project scratch -``` - -# Constructor aliases - -The `todo` command complains about constructor aliases. - -```ucm:hide -scratch/main> builtins.mergeio lib.builtins -``` - -```unison -type Foo = One -``` - -```ucm -scratch/main> add -scratch/main> alias.term Foo.One Foo.Two -scratch/main> todo -``` - -```ucm:hide -scratch/main> delete.project scratch -``` - -# Missing constructor names - -The `todo` command complains about missing constructor names. - -```ucm:hide -scratch/main> builtins.mergeio lib.builtins -``` - -```unison -type Foo = Bar -``` - -```ucm -scratch/main> add -scratch/main> delete.term Foo.Bar -scratch/main> todo -``` - -```ucm:hide -scratch/main> delete.project scratch -``` - -# Nested decl aliases - -The `todo` command complains about nested decl aliases. - -```ucm:hide -scratch/main> builtins.mergeio lib.builtins -``` - -```unison -structural type Foo a = One a | Two a a -structural type Foo.inner.Bar a = Uno a | Dos a a -``` - -```ucm -scratch/main> add -scratch/main> todo -``` - -```ucm:hide -scratch/main> delete.project scratch -``` - -# Stray constructors - -The `todo` command complains about stray constructors. - -```ucm:hide -scratch/main> builtins.mergeio lib.builtins -``` - -```unison -type Foo = Bar -``` - -```ucm -scratch/main> add -scratch/main> alias.term Foo.Bar Baz -scratch/main> todo -``` - -```ucm:hide -scratch/main> delete.project scratch -``` diff --git a/unison-src/transcripts/todo.output.md b/unison-src/transcripts/todo.output.md deleted file mode 100644 index 9b4ba914ba..0000000000 --- a/unison-src/transcripts/todo.output.md +++ /dev/null @@ -1,353 +0,0 @@ -# Nothing to do - -When there's nothing to do, `todo` says this: - -``` ucm -scratch/main> todo - - You have no pending todo items. Good work! ✅ - -``` -# Dependents of `todo` - -The `todo` command shows local (outside `lib`) terms that directly call `todo`. - -``` unison -foo : Nat -foo = todo "implement foo" - -bar : Nat -bar = foo + foo -``` - -``` 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`: - - bar : Nat - foo : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - bar : Nat - foo : Nat - -scratch/main> todo - - These terms call `todo`: - - 1. foo - -``` -# Direct dependencies without names - -The `todo` command shows hashes of direct dependencies of local (outside `lib`) definitions that don't have names in -the current namespace. - -``` unison -foo.bar = 15 -baz = foo.bar + foo.bar -``` - -``` 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`: - - baz : Nat - foo.bar : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - baz : Nat - foo.bar : Nat - -scratch/main> delete.namespace.force foo - - Done. - - ⚠️ - - Of the things I deleted, the following are still used in the - following definitions. They now contain un-named references. - - Dependency Referenced In - bar 1. baz - -scratch/main> todo - - These terms do not have any names in the current namespace: - - 1. #1jujb8oelv - -``` -# Conflicted names - -The `todo` command shows conflicted names. - -``` unison -foo = 16 -bar = 17 -``` - -``` 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`: - - bar : Nat - foo : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - bar : Nat - foo : Nat - -scratch/main> debug.alias.term.force foo bar - - Done. - -scratch/main> todo - - ❓ - - The term bar has conflicting definitions: - - 1. bar#14ibahkll6 - 2. bar#cq22mm4sca - - Tip: Use `move.term` or `delete.term` to resolve the - conflicts. - -``` -# Definitions in lib - -The `todo` command complains about terms and types directly in `lib`. - -``` unison -lib.foo = 16 -``` - -``` 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`: - - lib.foo : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - lib.foo : Nat - -scratch/main> todo - - There's a type or term at the top level of the `lib` - namespace, where I only expect to find subnamespaces - representing library dependencies. Please move or remove it. - -``` -# Constructor aliases - -The `todo` command complains about constructor aliases. - -``` unison -type Foo = One -``` - -``` 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`: - - type Foo - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Foo - -scratch/main> alias.term Foo.One Foo.Two - - Done. - -scratch/main> todo - - The type Foo has a constructor with multiple names. - - 1. Foo.One - 2. Foo.Two - - Please delete all but one name for each constructor. - -``` -# Missing constructor names - -The `todo` command complains about missing constructor names. - -``` unison -type Foo = Bar -``` - -``` 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`: - - type Foo - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Foo - -scratch/main> delete.term Foo.Bar - - Done. - -scratch/main> todo - - These types have some constructors with missing names. - - 1. Foo - - You can use `view 1` and - `alias.term .` to give names - to each unnamed constructor. - -``` -# Nested decl aliases - -The `todo` command complains about nested decl aliases. - -``` unison -structural type Foo a = One a | Two a a -structural type Foo.inner.Bar a = Uno a | Dos a a -``` - -``` 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`: - - structural type Foo a - structural type Foo.inner.Bar a - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - structural type Foo a - structural type Foo.inner.Bar a - -scratch/main> todo - - These types are aliases, but one is nested under the other. - Please separate them or delete one copy. - - 1. Foo - 2. Foo.inner.Bar - -``` -# Stray constructors - -The `todo` command complains about stray constructors. - -``` unison -type Foo = Bar -``` - -``` 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`: - - type Foo - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Foo - -scratch/main> alias.term Foo.Bar Baz - - Done. - -scratch/main> todo - - These constructors are not nested beneath their corresponding - type names: - - 1. Baz - - For each one, please either use `move` to move if, or if it's - an extra copy, you can simply `delete` it. - -``` diff --git a/unison-src/transcripts/top-level-exceptions.md b/unison-src/transcripts/top-level-exceptions.md deleted file mode 100644 index 4caf9d717c..0000000000 --- a/unison-src/transcripts/top-level-exceptions.md +++ /dev/null @@ -1,46 +0,0 @@ - -A simple transcript to test the use of exceptions that bubble to the top level. - -```ucm:hide -scratch/main> builtins.merge -``` - -FYI, here are the `Exception` and `Failure` types: - -```ucm -scratch/main> view Exception Failure -``` - -Here's a sample program just to verify that the typechecker allows `run` to throw exceptions: - -```unison -use builtin IO Exception Test.Result - -main : '{IO, Exception} () -main _ = () - -mytest : '{IO, Exception} [Test.Result] -mytest _ = [Ok "Great"] -``` - -```ucm -scratch/main> run main -scratch/main> add -scratch/main> io.test mytest -``` - -Now a test to show the handling of uncaught exceptions: - -```unison -main2 = '(error "oh noes!" ()) - -error : Text -> a ->{Exception} x -error msg a = - builtin.Exception.raise (Failure (typeLink RuntimeError) msg (Any a)) - -unique type RuntimeError = -``` - -```ucm:error -scratch/main> run main2 -``` diff --git a/unison-src/transcripts/top-level-exceptions.output.md b/unison-src/transcripts/top-level-exceptions.output.md deleted file mode 100644 index ded6bdda0e..0000000000 --- a/unison-src/transcripts/top-level-exceptions.output.md +++ /dev/null @@ -1,103 +0,0 @@ -A simple transcript to test the use of exceptions that bubble to the top level. - -FYI, here are the `Exception` and `Failure` types: - -``` ucm -scratch/main> view Exception Failure - - structural ability builtin.Exception where - raise : Failure ->{builtin.Exception} x - - type builtin.io2.Failure - = Failure Type Text Any - -``` -Here's a sample program just to verify that the typechecker allows `run` to throw exceptions: - -``` unison -use builtin IO Exception Test.Result - -main : '{IO, Exception} () -main _ = () - -mytest : '{IO, Exception} [Test.Result] -mytest _ = [Ok "Great"] -``` - -``` 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`: - - main : '{IO, Exception} () - mytest : '{IO, Exception} [Result] - -``` -``` ucm -scratch/main> run main - - () - -scratch/main> add - - ⍟ I've added these definitions: - - main : '{IO, Exception} () - mytest : '{IO, Exception} [Result] - -scratch/main> io.test mytest - - New test results: - - 1. mytest ◉ Great - - ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` -Now a test to show the handling of uncaught exceptions: - -``` unison -main2 = '(error "oh noes!" ()) - -error : Text -> a ->{Exception} x -error msg a = - builtin.Exception.raise (Failure (typeLink RuntimeError) msg (Any a)) - -unique type RuntimeError = -``` - -``` 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`: - - type RuntimeError - error : Text -> a ->{Exception} x - main2 : '{Exception} r - -``` -``` ucm -scratch/main> run main2 - - 💔💥 - - The program halted with an unhandled exception: - - Failure (typeLink RuntimeError) "oh noes!" (Any ()) - - Stack trace: - ##raise - -``` diff --git a/unison-src/transcripts/transcript-parser-commands.md b/unison-src/transcripts/transcript-parser-commands.md deleted file mode 100644 index afd90011ea..0000000000 --- a/unison-src/transcripts/transcript-parser-commands.md +++ /dev/null @@ -1,41 +0,0 @@ -### Transcript parser operations - -```ucm:hide -scratch/main> builtins.merge -``` - -The transcript parser is meant to parse `ucm` and `unison` blocks. - -```unison -x = 1 -``` - -```ucm -scratch/main> add -``` - -```unison:hide:error:scratch.u -z -``` - -```ucm:error -scratch/main> delete foo -``` - -```ucm :error -scratch/main> delete lineToken.call -``` - -However handling of blocks of other languages should be supported. - -```python -some python code -``` - -```c_cpp -some C++ code -``` - -```c9search -some cloud9 code -``` diff --git a/unison-src/transcripts/transcript-parser-commands.output.md b/unison-src/transcripts/transcript-parser-commands.output.md deleted file mode 100644 index af7d730d15..0000000000 --- a/unison-src/transcripts/transcript-parser-commands.output.md +++ /dev/null @@ -1,69 +0,0 @@ -### Transcript parser operations - -The transcript parser is meant to parse `ucm` and `unison` blocks. - -``` unison -x = 1 -``` - -``` 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`: - - x : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - x : Nat - -``` -``` unison ---- -title: :scratch.u ---- -z - -``` - -``` ucm -scratch/main> delete foo - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - foo - -``` -``` ucm -scratch/main> delete lineToken.call - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - lineToken.call - -``` -However handling of blocks of other languages should be supported. - -``` python -some python code -``` - -``` c_cpp -some C++ code -``` - -``` c9search -some cloud9 code -``` - diff --git a/unison-src/transcripts/type-deps.md b/unison-src/transcripts/type-deps.md deleted file mode 100644 index e63b539d50..0000000000 --- a/unison-src/transcripts/type-deps.md +++ /dev/null @@ -1,32 +0,0 @@ -# Ensure type dependencies are properly considered in slurping - -https://github.com/unisonweb/unison/pull/2821 - -```ucm:hide -scratch/main> builtins.merge -``` - - -Define a type. - -```unison:hide -structural type Y = Y -``` - -```ucm:hide -scratch/main> add -``` - -Now, we update `Y`, and add a new type `Z` which depends on it. - -```unison -structural type Z = Z Y -structural type Y = Y Nat -``` - -Adding should fail for BOTH definitions, `Y` needs an update and `Z` is blocked by `Y`. -```ucm:error -scratch/main> add --- This shouldn't exist, because it should've been blocked. -scratch/main> view Z -``` diff --git a/unison-src/transcripts/type-deps.output.md b/unison-src/transcripts/type-deps.output.md deleted file mode 100644 index fb04cc34c4..0000000000 --- a/unison-src/transcripts/type-deps.output.md +++ /dev/null @@ -1,58 +0,0 @@ -# Ensure type dependencies are properly considered in slurping - -https://github.com/unisonweb/unison/pull/2821 - -Define a type. - -``` unison -structural type Y = Y -``` - -Now, we update `Y`, and add a new type `Z` which depends on it. - -``` unison -structural type Z = Z Y -structural type Y = Y Nat -``` - -``` 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`: - - structural type Z - - ⍟ These names already exist. You can `update` them to your - new definition: - - structural type Y - (The old definition is also named builtin.Unit.) - -``` -Adding should fail for BOTH definitions, `Y` needs an update and `Z` is blocked by `Y`. - -``` ucm -scratch/main> add - - x These definitions failed: - - Reason - needs update structural type Y - blocked structural type Z - - Tip: Use `help filestatus` to learn more. - --- This shouldn't exist, because it should've been blocked. -scratch/main> view Z - - ⚠️ - - The following names were not found in the codebase. Check your spelling. - Z - -``` diff --git a/unison-src/transcripts/type-modifier-are-optional.md b/unison-src/transcripts/type-modifier-are-optional.md deleted file mode 100644 index f0a13f59ea..0000000000 --- a/unison-src/transcripts/type-modifier-are-optional.md +++ /dev/null @@ -1,17 +0,0 @@ -# Type modifiers are optional, `unique` is the default. - -```ucm:hide -scratch/main> builtins.merge -``` - -Types and abilities may be prefixed with either `unique` or `structural`. When left unspecified, `unique` is assumed. - -```unison -type Abc = Abc -unique type Def = Def -structural type Ghi = Ghi - -ability MyAbility where const : a -unique ability MyAbilityU where const : a -structural ability MyAbilityS where const : a -``` diff --git a/unison-src/transcripts/type-modifier-are-optional.output.md b/unison-src/transcripts/type-modifier-are-optional.output.md deleted file mode 100644 index 6cd6812daa..0000000000 --- a/unison-src/transcripts/type-modifier-are-optional.output.md +++ /dev/null @@ -1,33 +0,0 @@ -# Type modifiers are optional, `unique` is the default. - -Types and abilities may be prefixed with either `unique` or `structural`. When left unspecified, `unique` is assumed. - -``` unison -type Abc = Abc -unique type Def = Def -structural type Ghi = Ghi - -ability MyAbility where const : a -unique ability MyAbilityU where const : a -structural ability MyAbilityS where const : a -``` - -``` 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`: - - type Abc - type Def - structural type Ghi - (also named builtin.Unit) - ability MyAbility - structural ability MyAbilityS - ability MyAbilityU - -``` diff --git a/unison-src/transcripts/undo.md b/unison-src/transcripts/undo.md deleted file mode 100644 index 112fc30eb3..0000000000 --- a/unison-src/transcripts/undo.md +++ /dev/null @@ -1,51 +0,0 @@ -# Undo - -Undo should pop a node off of the history of the current branch. - -```unison:hide -x = 1 -``` - -```ucm -scratch/main> builtins.merge lib.builtins -scratch/main> add -scratch/main> ls -scratch/main> alias.term x y -scratch/main> ls -scratch/main> history -scratch/main> undo -scratch/main> ls -scratch/main> history -``` - ---- - -It should not be affected by changes on other branches. - -```unison:hide -x = 1 -``` - -```ucm -scratch/branch1> builtins.merge lib.builtins -scratch/branch1> add -scratch/branch1> ls -scratch/branch1> alias.term x y -scratch/branch1> ls -scratch/branch1> history --- Make some changes on an unrelated branch -scratch/branch2> builtins.merge lib.builtins -scratch/branch2> delete.namespace lib -scratch/branch1> undo -scratch/branch1> ls -scratch/branch1> history -``` - ---- - -Undo should be a no-op on a newly created branch - -```ucm:error -scratch/main> branch.create-empty new -scratch/new> undo -``` diff --git a/unison-src/transcripts/undo.output.md b/unison-src/transcripts/undo.output.md deleted file mode 100644 index 32933a2fb9..0000000000 --- a/unison-src/transcripts/undo.output.md +++ /dev/null @@ -1,199 +0,0 @@ -# Undo - -Undo should pop a node off of the history of the current branch. - -``` unison -x = 1 -``` - -``` ucm -scratch/main> builtins.merge lib.builtins - - Done. - -scratch/main> add - - ⍟ I've added these definitions: - - x : Nat - -scratch/main> ls - - 1. lib/ (469 terms, 74 types) - 2. x (Nat) - -scratch/main> alias.term x y - - Done. - -scratch/main> ls - - 1. lib/ (469 terms, 74 types) - 2. x (Nat) - 3. y (Nat) - -scratch/main> history - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #nmem6r6no1 - - + Adds / updates: - - y - - = Copies: - - Original name New name(s) - x y - - ⊙ 2. #3rqf1hbev7 - - + Adds / updates: - - x - - □ 3. #ms9lggs2rg (start of history) - -scratch/main> undo - - Here are the changes I undid - - Name changes: - - Original Changes - 1. x 2. y (added) - -scratch/main> ls - - 1. lib/ (469 terms, 74 types) - 2. x (Nat) - -scratch/main> history - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #3rqf1hbev7 - - + Adds / updates: - - x - - □ 2. #ms9lggs2rg (start of history) - -``` ------ - -It should not be affected by changes on other branches. - -``` unison -x = 1 -``` - -``` ucm -scratch/branch1> builtins.merge lib.builtins - - Done. - -scratch/branch1> add - - ⍟ I've added these definitions: - - x : Nat - -scratch/branch1> ls - - 1. lib/ (469 terms, 74 types) - 2. x (Nat) - -scratch/branch1> alias.term x y - - Done. - -scratch/branch1> ls - - 1. lib/ (469 terms, 74 types) - 2. x (Nat) - 3. y (Nat) - -scratch/branch1> history - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #nmem6r6no1 - - + Adds / updates: - - y - - = Copies: - - Original name New name(s) - x y - - ⊙ 2. #3rqf1hbev7 - - + Adds / updates: - - x - - □ 3. #ms9lggs2rg (start of history) - --- Make some changes on an unrelated branch -scratch/branch2> builtins.merge lib.builtins - - Done. - -scratch/branch2> delete.namespace lib - - Done. - -scratch/branch1> undo - - Here are the changes I undid - - Name changes: - - Original Changes - 1. x 2. y (added) - -scratch/branch1> ls - - 1. lib/ (469 terms, 74 types) - 2. x (Nat) - -scratch/branch1> history - - Note: The most recent namespace hash is immediately below this - message. - - ⊙ 1. #3rqf1hbev7 - - + Adds / updates: - - x - - □ 2. #ms9lggs2rg (start of history) - -``` ------ - -Undo should be a no-op on a newly created branch - -``` ucm -scratch/main> branch.create-empty new - - Done. I've created an empty branch scratch/new. - - Tip: Use `merge /somebranch` to initialize this branch. - -scratch/new> undo - - ⚠️ - - Nothing more to undo. - -``` diff --git a/unison-src/transcripts/unique-type-churn.md b/unison-src/transcripts/unique-type-churn.md deleted file mode 100644 index d35b2fa09a..0000000000 --- a/unison-src/transcripts/unique-type-churn.md +++ /dev/null @@ -1,46 +0,0 @@ -This transcript demonstrates that unique types no longer always get a fresh GUID: they share GUIDs with already-saved -unique types of the same name. - -```unison -unique type A = A - -unique type B = B C -unique type C = C B -``` - -```ucm -scratch/main> add -``` - -```unison -unique type A = A - -unique type B = B C -unique type C = C B -``` - -If the name stays the same, the churn is even prevented if the type is updated and then reverted to the original form. - -```ucm -scratch/main> names A -``` - -```unison -unique type A = A () -``` - -```ucm -scratch/main> update -scratch/main> names A -``` - -```unison -unique type A = A -``` - -Note that `A` is back to its original hash. - -```ucm -scratch/main> update -scratch/main> names A -``` diff --git a/unison-src/transcripts/unique-type-churn.output.md b/unison-src/transcripts/unique-type-churn.output.md deleted file mode 100644 index 661b0b65dd..0000000000 --- a/unison-src/transcripts/unique-type-churn.output.md +++ /dev/null @@ -1,140 +0,0 @@ -This transcript demonstrates that unique types no longer always get a fresh GUID: they share GUIDs with already-saved -unique types of the same name. - -``` unison -unique type A = A - -unique type B = B C -unique type C = C B -``` - -``` 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`: - - type A - type B - type C - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type A - type B - type C - -``` -``` unison -unique type A = A - -unique type B = B C -unique type C = C B -``` - -``` ucm - - Loading changes detected in scratch.u. - - I found and typechecked the definitions in scratch.u. This - file has been previously added to the codebase. - -``` -If the name stays the same, the churn is even prevented if the type is updated and then reverted to the original form. - -``` ucm -scratch/main> names A - - Type - Hash: #uj8oalgadr - Names: A - - Term - Hash: #uj8oalgadr#0 - Names: A.A - -``` -``` unison -unique type A = A () -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - type A - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -scratch/main> names A - - Type - Hash: #ufo5tuc7ho - Names: A - - Term - Hash: #ufo5tuc7ho#0 - Names: A.A - -``` -``` unison -unique type A = A -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - type A - -``` -Note that `A` is back to its original hash. - -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -scratch/main> names A - - Type - Hash: #uj8oalgadr - Names: A - - Term - Hash: #uj8oalgadr#0 - Names: A.A - -``` diff --git a/unison-src/transcripts/unitnamespace.md b/unison-src/transcripts/unitnamespace.md deleted file mode 100644 index c1f9f5fc5b..0000000000 --- a/unison-src/transcripts/unitnamespace.md +++ /dev/null @@ -1,10 +0,0 @@ -```unison -`()`.foo = "bar" -``` - -```ucm -scratch/main> add -scratch/main> find -scratch/main> find-in `()` -scratch/main> delete.namespace `()` -``` diff --git a/unison-src/transcripts/unitnamespace.output.md b/unison-src/transcripts/unitnamespace.output.md deleted file mode 100644 index 0a4833afee..0000000000 --- a/unison-src/transcripts/unitnamespace.output.md +++ /dev/null @@ -1,39 +0,0 @@ -``` unison -`()`.foo = "bar" -``` - -``` 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 : ##Text - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - `()`.foo : ##Text - -scratch/main> find - - 1. `()`.foo : ##Text - - -scratch/main> find-in `()` - - 1. foo : ##Text - - -scratch/main> delete.namespace `()` - - Done. - -``` diff --git a/unison-src/transcripts/universal-cmp.md b/unison-src/transcripts/universal-cmp.md deleted file mode 100644 index 7e41982e99..0000000000 --- a/unison-src/transcripts/universal-cmp.md +++ /dev/null @@ -1,28 +0,0 @@ - -File for test cases making sure that universal equality/comparison -cases exist for built-in types. Just making sure they don't crash. - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -unique type A = A - -threadEyeDeez _ = - t1 = forkComp '() - t2 = forkComp '() - (t1 == t2, t1 < t2) -``` - -```ucm -scratch/main> add -scratch/main> run threadEyeDeez -``` - -```unison -> typeLink A == typeLink A -> typeLink Text == typeLink Text -> typeLink Text == typeLink A -> termLink threadEyeDeez == termLink threadEyeDeez -``` diff --git a/unison-src/transcripts/universal-cmp.output.md b/unison-src/transcripts/universal-cmp.output.md deleted file mode 100644 index 5b8913fffa..0000000000 --- a/unison-src/transcripts/universal-cmp.output.md +++ /dev/null @@ -1,74 +0,0 @@ -File for test cases making sure that universal equality/comparison -cases exist for built-in types. Just making sure they don't crash. - -``` unison -unique type A = A - -threadEyeDeez _ = - t1 = forkComp '() - t2 = forkComp '() - (t1 == t2, t1 < t2) -``` - -``` 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`: - - type A - threadEyeDeez : ∀ _. _ ->{IO} (Boolean, Boolean) - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type A - threadEyeDeez : ∀ _. _ ->{IO} (Boolean, Boolean) - -scratch/main> run threadEyeDeez - - (false, true) - -``` -``` unison -> typeLink A == typeLink A -> typeLink Text == typeLink Text -> typeLink Text == typeLink A -> termLink threadEyeDeez == termLink threadEyeDeez -``` - -``` ucm - - Loading changes detected in scratch.u. - - ✅ - - scratch.u changed. - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 1 | > typeLink A == typeLink A - ⧩ - true - - 2 | > typeLink Text == typeLink Text - ⧩ - true - - 3 | > typeLink Text == typeLink A - ⧩ - false - - 4 | > termLink threadEyeDeez == termLink threadEyeDeez - ⧩ - true - -``` diff --git a/unison-src/transcripts/unsafe-coerce.md b/unison-src/transcripts/unsafe-coerce.md deleted file mode 100644 index 9b483f9bbf..0000000000 --- a/unison-src/transcripts/unsafe-coerce.md +++ /dev/null @@ -1,23 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -f : '{} Nat -f _ = 5 - -fc : '{IO, Exception} Nat -fc = unsafe.coerceAbilities f - -main : '{IO, Exception} [Result] -main _ = - n = !fc - if n == 5 then [Ok ""] else [Fail ""] -``` - -```ucm -scratch/main> find unsafe.coerceAbilities -scratch/main> add -scratch/main> io.test main -``` diff --git a/unison-src/transcripts/unsafe-coerce.output.md b/unison-src/transcripts/unsafe-coerce.output.md deleted file mode 100644 index 20380cb69f..0000000000 --- a/unison-src/transcripts/unsafe-coerce.output.md +++ /dev/null @@ -1,53 +0,0 @@ -``` unison -f : '{} Nat -f _ = 5 - -fc : '{IO, Exception} Nat -fc = unsafe.coerceAbilities f - -main : '{IO, Exception} [Result] -main _ = - n = !fc - if n == 5 then [Ok ""] else [Fail ""] -``` - -``` 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`: - - f : 'Nat - fc : '{IO, Exception} Nat - main : '{IO, Exception} [Result] - -``` -``` ucm -scratch/main> find unsafe.coerceAbilities - - 1. builtin.unsafe.coerceAbilities : (a ->{e1} b) -> a -> b - - -scratch/main> add - - ⍟ I've added these definitions: - - f : 'Nat - fc : '{IO, Exception} Nat - main : '{IO, Exception} [Result] - -scratch/main> io.test main - - New test results: - - 1. main ◉ - - ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` diff --git a/unison-src/transcripts/update-ignores-lib-namespace.md b/unison-src/transcripts/update-ignores-lib-namespace.md deleted file mode 100644 index 2db633f143..0000000000 --- a/unison-src/transcripts/update-ignores-lib-namespace.md +++ /dev/null @@ -1,25 +0,0 @@ -`update` / `patch` (anything that a patch) ignores the namespace named "lib" at the location it's applied. This follows -the project organization convention that dependencies are put in "lib"; it's much easier to apply a patch to all of -one's own code if the "lib" namespace is simply ignored. - -```ucm:hide -scratch/main> builtins.merge -``` - -```unison -foo = 100 -lib.foo = 100 -``` - -```ucm -scratch/main> add -``` - -```unison -foo = 200 -``` - -```ucm -scratch/main> update -scratch/main> names foo -``` diff --git a/unison-src/transcripts/update-ignores-lib-namespace.output.md b/unison-src/transcripts/update-ignores-lib-namespace.output.md deleted file mode 100644 index a91ca27840..0000000000 --- a/unison-src/transcripts/update-ignores-lib-namespace.output.md +++ /dev/null @@ -1,66 +0,0 @@ -`update` / `patch` (anything that a patch) ignores the namespace named "lib" at the location it's applied. This follows -the project organization convention that dependencies are put in "lib"; it's much easier to apply a patch to all of -one's own code if the "lib" namespace is simply ignored. - -``` unison -foo = 100 -lib.foo = 100 -``` - -``` 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.foo : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - foo : Nat - lib.foo : Nat - -``` -``` unison -foo = 200 -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - foo : Nat - (The old definition is also named lib.foo.) - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -scratch/main> names foo - - Term - Hash: #9ntnotdp87 - Names: foo - -``` diff --git a/unison-src/transcripts/update-on-conflict.md b/unison-src/transcripts/update-on-conflict.md deleted file mode 100644 index 8239a4689b..0000000000 --- a/unison-src/transcripts/update-on-conflict.md +++ /dev/null @@ -1,26 +0,0 @@ -# Update on conflict - -Conflicted definitions prevent `update` from succeeding. - -```ucm:hide -scratch/main> builtins.merge lib.builtins -``` - -```unison -x = 1 -temp = 2 -``` - -```ucm -scratch/main> add -scratch/main> debug.alias.term.force temp x -scratch/main> delete.term temp -``` - -```unison -x = 3 -``` - -```ucm:error -scratch/main> update -``` diff --git a/unison-src/transcripts/update-on-conflict.output.md b/unison-src/transcripts/update-on-conflict.output.md deleted file mode 100644 index 9beda9810c..0000000000 --- a/unison-src/transcripts/update-on-conflict.output.md +++ /dev/null @@ -1,66 +0,0 @@ -# Update on conflict - -Conflicted definitions prevent `update` from succeeding. - -``` unison -x = 1 -temp = 2 -``` - -``` 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`: - - temp : Nat - x : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - temp : Nat - x : Nat - -scratch/main> debug.alias.term.force temp x - - Done. - -scratch/main> delete.term temp - - Done. - -``` -``` unison -x = 3 -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - x : Nat - -``` -``` ucm -scratch/main> update - - This branch has more than one term with the name `x`. Please - delete or rename all but one of them, then try the update - again. - -``` diff --git a/unison-src/transcripts/update-suffixifies-properly.md b/unison-src/transcripts/update-suffixifies-properly.md deleted file mode 100644 index d983959770..0000000000 --- a/unison-src/transcripts/update-suffixifies-properly.md +++ /dev/null @@ -1,24 +0,0 @@ -```ucm:hide -myproject/main> builtins.merge lib.builtin -``` - -```unison -a.x.x.x.x = 100 -b.x.x.x.x = 100 -foo = 25 -c.y.y.y.y = foo + 10 -d.y.y.y.y = foo + 10 -bar = a.x.x.x.x + c.y.y.y.y -``` - -```ucm -myproject/main> add -``` - -```unison -foo = +30 -``` - -```ucm:error -myproject/main> update -``` diff --git a/unison-src/transcripts/update-suffixifies-properly.output.md b/unison-src/transcripts/update-suffixifies-properly.output.md deleted file mode 100644 index e8a30e7f38..0000000000 --- a/unison-src/transcripts/update-suffixifies-properly.output.md +++ /dev/null @@ -1,94 +0,0 @@ -``` unison -a.x.x.x.x = 100 -b.x.x.x.x = 100 -foo = 25 -c.y.y.y.y = foo + 10 -d.y.y.y.y = foo + 10 -bar = a.x.x.x.x + c.y.y.y.y -``` - -``` 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`: - - a.x.x.x.x : Nat - b.x.x.x.x : Nat - bar : Nat - c.y.y.y.y : Nat - d.y.y.y.y : Nat - foo : Nat - -``` -``` ucm -myproject/main> add - - ⍟ I've added these definitions: - - a.x.x.x.x : Nat - b.x.x.x.x : Nat - bar : Nat - c.y.y.y.y : Nat - d.y.y.y.y : Nat - foo : Nat - -``` -``` unison -foo = +30 -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - foo : Int - -``` -``` ucm -myproject/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Typechecking failed. I've updated your scratch file with the - definitions that need fixing. Once the file is compiling, try - `update` again. - -``` -``` unison:added-by-ucm scratch.u -foo = +30 - --- The definitions below no longer typecheck with the changes above. --- Please fix the errors and try `update` again. - -bar : Nat -bar = - use Nat + - x + c.y.y.y.y - -c.y.y.y.y : Nat -c.y.y.y.y = - use Nat + - foo + 10 - -d.y.y.y.y : Nat -d.y.y.y.y = - use Nat + - foo + 10 - -``` - diff --git a/unison-src/transcripts/update-term-aliases-in-different-ways.md b/unison-src/transcripts/update-term-aliases-in-different-ways.md deleted file mode 100644 index e99deb63be..0000000000 --- a/unison-src/transcripts/update-term-aliases-in-different-ways.md +++ /dev/null @@ -1,28 +0,0 @@ -```ucm -scratch/main> builtins.merge -``` - -```unison -foo : Nat -foo = 5 - -bar : Nat -bar = 5 -``` - -```ucm -scratch/main> add -``` - -```unison -foo : Nat -foo = 6 - -bar : Nat -bar = 7 -``` - -```ucm -scratch/main> update -scratch/main> view foo bar -``` diff --git a/unison-src/transcripts/update-term-aliases-in-different-ways.output.md b/unison-src/transcripts/update-term-aliases-in-different-ways.output.md deleted file mode 100644 index 5b0e7bf65d..0000000000 --- a/unison-src/transcripts/update-term-aliases-in-different-ways.output.md +++ /dev/null @@ -1,79 +0,0 @@ -``` ucm -scratch/main> builtins.merge - - Done. - -``` -``` unison -foo : Nat -foo = 5 - -bar : Nat -bar = 5 -``` - -``` 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`: - - bar : Nat - foo : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - bar : Nat - foo : Nat - -``` -``` unison -foo : Nat -foo = 6 - -bar : Nat -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 names already exist. You can `update` them to your - new definition: - - bar : Nat - (The old definition is also named foo.) - foo : Nat - (The old definition is also named bar.) - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -scratch/main> view foo bar - - bar : Nat - bar = 7 - - foo : Nat - foo = 6 - -``` diff --git a/unison-src/transcripts/update-term-to-different-type.md b/unison-src/transcripts/update-term-to-different-type.md deleted file mode 100644 index 31859e3a13..0000000000 --- a/unison-src/transcripts/update-term-to-different-type.md +++ /dev/null @@ -1,22 +0,0 @@ -```ucm -scratch/main> builtins.merge -``` - -```unison -foo : Nat -foo = 5 -``` - -```ucm -scratch/main> add -``` - -```unison -foo : Int -foo = +5 -``` - -```ucm -scratch/main> update -scratch/main> view foo -``` diff --git a/unison-src/transcripts/update-term-to-different-type.output.md b/unison-src/transcripts/update-term-to-different-type.output.md deleted file mode 100644 index c1f65aacac..0000000000 --- a/unison-src/transcripts/update-term-to-different-type.output.md +++ /dev/null @@ -1,65 +0,0 @@ -``` ucm -scratch/main> builtins.merge - - Done. - -``` -``` unison -foo : Nat -foo = 5 -``` - -``` 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 - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - foo : Nat - -``` -``` unison -foo : Int -foo = +5 -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - foo : Int - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -scratch/main> view foo - - foo : Int - foo = +5 - -``` diff --git a/unison-src/transcripts/update-term-with-alias.md b/unison-src/transcripts/update-term-with-alias.md deleted file mode 100644 index e45eb8b768..0000000000 --- a/unison-src/transcripts/update-term-with-alias.md +++ /dev/null @@ -1,25 +0,0 @@ -```ucm -scratch/main> builtins.merge -``` - -```unison -foo : Nat -foo = 5 - -bar : Nat -bar = 5 -``` - -```ucm -scratch/main> add -``` - -```unison -foo : Nat -foo = 6 -``` - -```ucm -scratch/main> update -scratch/main> view foo bar -``` diff --git a/unison-src/transcripts/update-term-with-alias.output.md b/unison-src/transcripts/update-term-with-alias.output.md deleted file mode 100644 index b0fbeab2ae..0000000000 --- a/unison-src/transcripts/update-term-with-alias.output.md +++ /dev/null @@ -1,74 +0,0 @@ -``` ucm -scratch/main> builtins.merge - - Done. - -``` -``` unison -foo : Nat -foo = 5 - -bar : Nat -bar = 5 -``` - -``` 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`: - - bar : Nat - foo : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - bar : Nat - foo : Nat - -``` -``` unison -foo : Nat -foo = 6 -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - foo : Nat - (The old definition is also named bar.) - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -scratch/main> view foo bar - - bar : Nat - bar = 5 - - foo : Nat - foo = 6 - -``` diff --git a/unison-src/transcripts/update-term-with-dependent-to-different-type.md b/unison-src/transcripts/update-term-with-dependent-to-different-type.md deleted file mode 100644 index b7bd1196ae..0000000000 --- a/unison-src/transcripts/update-term-with-dependent-to-different-type.md +++ /dev/null @@ -1,24 +0,0 @@ -```ucm -scratch/main> builtins.merge -``` - -```unison -foo : Nat -foo = 5 - -bar : Nat -bar = foo + 10 -``` - -```ucm -scratch/main> add -``` - -```unison -foo : Int -foo = +5 -``` - -```ucm:error -scratch/main> update -``` diff --git a/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md b/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md deleted file mode 100644 index c1737627d4..0000000000 --- a/unison-src/transcripts/update-term-with-dependent-to-different-type.output.md +++ /dev/null @@ -1,83 +0,0 @@ -``` ucm -scratch/main> builtins.merge - - Done. - -``` -``` unison -foo : Nat -foo = 5 - -bar : Nat -bar = foo + 10 -``` - -``` 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`: - - bar : Nat - foo : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - bar : Nat - foo : Nat - -``` -``` unison -foo : Int -foo = +5 -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - foo : Int - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Typechecking failed. I've updated your scratch file with the - definitions that need fixing. Once the file is compiling, try - `update` again. - -``` -``` unison:added-by-ucm scratch.u -foo : Int -foo = +5 - --- The definitions below no longer typecheck with the changes above. --- Please fix the errors and try `update` again. - -bar : Nat -bar = - use Nat + - foo + 10 - -``` - diff --git a/unison-src/transcripts/update-term-with-dependent.md b/unison-src/transcripts/update-term-with-dependent.md deleted file mode 100644 index 402138857b..0000000000 --- a/unison-src/transcripts/update-term-with-dependent.md +++ /dev/null @@ -1,25 +0,0 @@ -```ucm -scratch/main> builtins.merge -``` - -```unison -foo : Nat -foo = 5 - -bar : Nat -bar = foo + 10 -``` - -```ucm -scratch/main> add -``` - -```unison -foo : Nat -foo = 6 -``` - -```ucm -scratch/main> update -scratch/main> view bar -``` diff --git a/unison-src/transcripts/update-term-with-dependent.output.md b/unison-src/transcripts/update-term-with-dependent.output.md deleted file mode 100644 index 42ae8158f5..0000000000 --- a/unison-src/transcripts/update-term-with-dependent.output.md +++ /dev/null @@ -1,76 +0,0 @@ -``` ucm -scratch/main> builtins.merge - - Done. - -``` -``` unison -foo : Nat -foo = 5 - -bar : Nat -bar = foo + 10 -``` - -``` 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`: - - bar : Nat - foo : Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - bar : Nat - foo : Nat - -``` -``` unison -foo : Nat -foo = 6 -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - foo : Nat - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Everything typechecks, so I'm saving the results... - - Done. - -scratch/main> view bar - - bar : Nat - bar = - use Nat + - foo + 10 - -``` diff --git a/unison-src/transcripts/update-term.md b/unison-src/transcripts/update-term.md deleted file mode 100644 index 0cdc0e86f9..0000000000 --- a/unison-src/transcripts/update-term.md +++ /dev/null @@ -1,22 +0,0 @@ -```ucm -scratch/main> builtins.merge -``` - -```unison -foo : Nat -foo = 5 -``` - -```ucm -scratch/main> add -``` - -```unison -foo : Nat -foo = 6 -``` - -```ucm -scratch/main> update -scratch/main> view foo -``` diff --git a/unison-src/transcripts/update-term.output.md b/unison-src/transcripts/update-term.output.md deleted file mode 100644 index 54abb8e06a..0000000000 --- a/unison-src/transcripts/update-term.output.md +++ /dev/null @@ -1,65 +0,0 @@ -``` ucm -scratch/main> builtins.merge - - Done. - -``` -``` unison -foo : Nat -foo = 5 -``` - -``` 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 - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - foo : Nat - -``` -``` unison -foo : Nat -foo = 6 -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - foo : Nat - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -scratch/main> view foo - - foo : Nat - foo = 6 - -``` diff --git a/unison-src/transcripts/update-test-to-non-test.md b/unison-src/transcripts/update-test-to-non-test.md deleted file mode 100644 index 0c2ba33f80..0000000000 --- a/unison-src/transcripts/update-test-to-non-test.md +++ /dev/null @@ -1,25 +0,0 @@ -```ucm -scratch/main> builtins.merge -``` - -```unison -test> foo = [] -``` - -After adding the test `foo`, we expect `view` to render it like a test. (Bug: It doesn't.) - -```ucm -scratch/main> add -scratch/main> view foo -``` - -```unison -foo = 1 -``` - -After updating `foo` to not be a test, we expect `view` to not render it like a test. - -```ucm -scratch/main> update -scratch/main> view foo -``` diff --git a/unison-src/transcripts/update-test-to-non-test.output.md b/unison-src/transcripts/update-test-to-non-test.output.md deleted file mode 100644 index 5275b97eb3..0000000000 --- a/unison-src/transcripts/update-test-to-non-test.output.md +++ /dev/null @@ -1,78 +0,0 @@ -``` ucm -scratch/main> builtins.merge - - Done. - -``` -``` unison -test> foo = [] -``` - -``` 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 : [Result] - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 1 | test> foo = [] - - -``` -After adding the test `foo`, we expect `view` to render it like a test. (Bug: It doesn't.) - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - foo : [Result] - -scratch/main> view foo - - foo : [Result] - foo = [] - -``` -``` unison -foo = 1 -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - foo : Nat - -``` -After updating `foo` to not be a test, we expect `view` to not render it like a test. - -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -scratch/main> view foo - - foo : Nat - foo = 1 - -``` diff --git a/unison-src/transcripts/update-test-watch-roundtrip.md b/unison-src/transcripts/update-test-watch-roundtrip.md deleted file mode 100644 index 135412df66..0000000000 --- a/unison-src/transcripts/update-test-watch-roundtrip.md +++ /dev/null @@ -1,28 +0,0 @@ - -```ucm:hide -scratch/main> builtins.merge -``` - -Given a test that depends on another definition, - -```unison:hide -foo n = n + 1 - -test> mynamespace.foo.test = - n = 2 - if (foo n) == 2 then [ Ok "passed" ] else [ Fail "wat" ] -``` - -```ucm -scratch/main> add -``` - -if we change the type of the dependency, the test should show in the scratch file as a test watch. - -```unison -foo n = "hello, world!" -``` - -```ucm:error -scratch/main> update -``` diff --git a/unison-src/transcripts/update-test-watch-roundtrip.output.md b/unison-src/transcripts/update-test-watch-roundtrip.output.md deleted file mode 100644 index 45ddaaa3f8..0000000000 --- a/unison-src/transcripts/update-test-watch-roundtrip.output.md +++ /dev/null @@ -1,64 +0,0 @@ -Given a test that depends on another definition, - -``` unison -foo n = n + 1 - -test> mynamespace.foo.test = - n = 2 - if (foo n) == 2 then [ Ok "passed" ] else [ Fail "wat" ] -``` - -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - foo : Nat -> Nat - mynamespace.foo.test : [Result] - -``` -if we change the type of the dependency, the test should show in the scratch file as a test watch. - -``` unison -foo n = "hello, world!" -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - foo : n -> Text - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Typechecking failed. I've updated your scratch file with the - definitions that need fixing. Once the file is compiling, try - `update` again. - -``` -``` unison:added-by-ucm scratch.u -foo n = "hello, world!" - --- The definitions below no longer typecheck with the changes above. --- Please fix the errors and try `update` again. - -test> mynamespace.foo.test = - n = 2 - if foo n == 2 then [Ok "passed"] else [Fail "wat"] - -``` - diff --git a/unison-src/transcripts/update-type-add-constructor.md b/unison-src/transcripts/update-type-add-constructor.md deleted file mode 100644 index 1decf30154..0000000000 --- a/unison-src/transcripts/update-type-add-constructor.md +++ /dev/null @@ -1,24 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtin -``` - -```unison -unique type Foo - = Bar Nat -``` - -```ucm -scratch/main> add -``` - -```unison -unique type Foo - = Bar Nat - | Baz Nat Nat -``` - -```ucm -scratch/main> update -scratch/main> view Foo -scratch/main> find.verbose -``` diff --git a/unison-src/transcripts/update-type-add-constructor.output.md b/unison-src/transcripts/update-type-add-constructor.output.md deleted file mode 100644 index c87b1b7cd8..0000000000 --- a/unison-src/transcripts/update-type-add-constructor.output.md +++ /dev/null @@ -1,72 +0,0 @@ -``` unison -unique type Foo - = Bar Nat -``` - -``` 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`: - - type Foo - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Foo - -``` -``` unison -unique type Foo - = Bar Nat - | Baz Nat Nat -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - type Foo - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -scratch/main> view Foo - - type Foo = Bar Nat | Baz Nat Nat - -scratch/main> find.verbose - - 1. -- #2sffq4apsq1cts53njcunj63fa8ohov4eqn77q14s77ajicajh4g28sq5s5ai33f2k6oh6o67aarnlpu7u7s4la07ag2er33epalsog - type Foo - - 2. -- #2sffq4apsq1cts53njcunj63fa8ohov4eqn77q14s77ajicajh4g28sq5s5ai33f2k6oh6o67aarnlpu7u7s4la07ag2er33epalsog#0 - Foo.Bar : Nat -> Foo - - 3. -- #2sffq4apsq1cts53njcunj63fa8ohov4eqn77q14s77ajicajh4g28sq5s5ai33f2k6oh6o67aarnlpu7u7s4la07ag2er33epalsog#1 - Foo.Baz : Nat -> Nat -> Foo - - - -``` diff --git a/unison-src/transcripts/update-type-add-field.md b/unison-src/transcripts/update-type-add-field.md deleted file mode 100644 index cdd41c3388..0000000000 --- a/unison-src/transcripts/update-type-add-field.md +++ /dev/null @@ -1,21 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtin -``` - -```unison -unique type Foo = Bar Nat -``` - -```ucm -scratch/main> add -``` - -```unison -unique type Foo = Bar Nat Nat -``` - -```ucm -scratch/main> update -scratch/main> view Foo -scratch/main> find.verbose -``` diff --git a/unison-src/transcripts/update-type-add-field.output.md b/unison-src/transcripts/update-type-add-field.output.md deleted file mode 100644 index 6741c27a09..0000000000 --- a/unison-src/transcripts/update-type-add-field.output.md +++ /dev/null @@ -1,66 +0,0 @@ -``` unison -unique type Foo = Bar Nat -``` - -``` 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`: - - type Foo - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Foo - -``` -``` unison -unique type Foo = Bar Nat Nat -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - type Foo - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -scratch/main> view Foo - - type Foo = Bar Nat Nat - -scratch/main> find.verbose - - 1. -- #8fk6k0j208th1ia4vnjtoc5fomd6le540prec255svg71bcfga9dofrvoq1d7v6010d6b6em4q51p8st5c5juhrev72cnnel8ko3o1g - type Foo - - 2. -- #8fk6k0j208th1ia4vnjtoc5fomd6le540prec255svg71bcfga9dofrvoq1d7v6010d6b6em4q51p8st5c5juhrev72cnnel8ko3o1g#0 - Foo.Bar : Nat -> Nat -> Foo - - - -``` diff --git a/unison-src/transcripts/update-type-add-new-record.md b/unison-src/transcripts/update-type-add-new-record.md deleted file mode 100644 index a7f82df0c8..0000000000 --- a/unison-src/transcripts/update-type-add-new-record.md +++ /dev/null @@ -1,12 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtins -``` - -```unison -unique type Foo = { bar : Nat } -``` - -```ucm -scratch/main> update -scratch/main> view Foo -``` diff --git a/unison-src/transcripts/update-type-add-new-record.output.md b/unison-src/transcripts/update-type-add-new-record.output.md deleted file mode 100644 index a96ce90c24..0000000000 --- a/unison-src/transcripts/update-type-add-new-record.output.md +++ /dev/null @@ -1,33 +0,0 @@ -``` unison -unique type Foo = { bar : Nat } -``` - -``` 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`: - - type Foo - Foo.bar : Foo -> Nat - Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo - Foo.bar.set : Nat -> Foo -> Foo - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -scratch/main> view Foo - - type Foo = { bar : Nat } - -``` diff --git a/unison-src/transcripts/update-type-add-record-field.md b/unison-src/transcripts/update-type-add-record-field.md deleted file mode 100644 index d4edf079e1..0000000000 --- a/unison-src/transcripts/update-type-add-record-field.md +++ /dev/null @@ -1,21 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtin -``` - -```unison -unique type Foo = { bar : Nat } -``` - -```ucm -scratch/main> add -``` - -```unison -unique type Foo = { bar : Nat, baz : Int } -``` - -```ucm -scratch/main> update -scratch/main> view Foo -scratch/main> find.verbose -``` diff --git a/unison-src/transcripts/update-type-add-record-field.output.md b/unison-src/transcripts/update-type-add-record-field.output.md deleted file mode 100644 index 23365f09b7..0000000000 --- a/unison-src/transcripts/update-type-add-record-field.output.md +++ /dev/null @@ -1,99 +0,0 @@ -``` unison -unique type Foo = { bar : Nat } -``` - -``` 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`: - - type Foo - Foo.bar : Foo -> Nat - Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo - Foo.bar.set : Nat -> Foo -> Foo - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Foo - Foo.bar : Foo -> Nat - Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo - Foo.bar.set : Nat -> Foo -> Foo - -``` -``` unison -unique type Foo = { bar : Nat, baz : Int } -``` - -``` 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.baz : Foo -> Int - Foo.baz.modify : (Int ->{g} Int) -> Foo ->{g} Foo - Foo.baz.set : Int -> Foo -> Foo - - ⍟ These names already exist. You can `update` them to your - new definition: - - type Foo - Foo.bar : Foo -> Nat - Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo - Foo.bar.set : Nat -> Foo -> Foo - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -scratch/main> view Foo - - type Foo = { bar : Nat, baz : Int } - -scratch/main> find.verbose - - 1. -- #05gh1dur4778dauh9slaofprc5356n47qpove0c1jl0birt2fcu301js8auu5vfr5bjfga9j8ikuk07ll9fu1gj3ehrp3basguhsd58 - type Foo - - 2. -- #77mi33dv8ac2s90852khi35km5gsamhnpada8mai0k36obbttgg17qld719ospcs1ht9ctolg3pjsqs6qjnl3hfmu493rgsher73sc0 - Foo.bar : Foo -> Nat - - 3. -- #7m1n2178r5u12jdnb6crcmanu2gm961kdvbjul5m6hta1s57avibsvk6p5g9efut8sennpgstbb8kf97eujbbuiplsoloa4cael7t90 - Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo - - 4. -- #ghuqoel4pao6v8e7un238i3e86vv7a7pnvgaq8m9s32edm1upgv35gri2iu32ipn9r4poli56r5kr3vtjfrltem696grfl75al4jkgg - Foo.bar.set : Nat -> Foo -> Foo - - 5. -- #p8emkm2s09n3nsd8ne5f6fro0vsldk8pn7n6rcf417anuvvun43qrk1ioofs6pdq4537eosao17c7ibvktktr3lfqglmj26gmbulmj0 - Foo.baz : Foo -> Int - - 6. -- #0il9pl29jpe3fh6vp3qeqai73915k3qffhf4bgttrgsj000b9fgs3bqoj8ugjop6kdr04acc34m1bj7lf417tslfeva7dmmoqdu5hug - Foo.baz.modify : (Int ->{g} Int) -> Foo ->{g} Foo - - 7. -- #87rjeqltvvd4adffsheqae62eefoge8p78pvnjdkc9q1stq20lhubvtpos0io4v3vhnol8nn2uollup97l4orq1fh2h12b0imeuuc58 - Foo.baz.set : Int -> Foo -> Foo - - 8. -- #05gh1dur4778dauh9slaofprc5356n47qpove0c1jl0birt2fcu301js8auu5vfr5bjfga9j8ikuk07ll9fu1gj3ehrp3basguhsd58#0 - Foo.Foo : Nat -> Int -> Foo - - - -``` diff --git a/unison-src/transcripts/update-type-constructor-alias.md b/unison-src/transcripts/update-type-constructor-alias.md deleted file mode 100644 index 4e946d635b..0000000000 --- a/unison-src/transcripts/update-type-constructor-alias.md +++ /dev/null @@ -1,20 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtin -``` - -```unison -unique type Foo = Bar Nat -``` - -```ucm -scratch/main> add -scratch/main> alias.term Foo.Bar Foo.BarAlias -``` - -```unison -unique type Foo = Bar Nat Nat -``` - -```ucm:error -scratch/main> update -``` diff --git a/unison-src/transcripts/update-type-constructor-alias.output.md b/unison-src/transcripts/update-type-constructor-alias.output.md deleted file mode 100644 index 5dfa27c938..0000000000 --- a/unison-src/transcripts/update-type-constructor-alias.output.md +++ /dev/null @@ -1,62 +0,0 @@ -``` unison -unique type Foo = Bar Nat -``` - -``` 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`: - - type Foo - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Foo - -scratch/main> alias.term Foo.Bar Foo.BarAlias - - Done. - -``` -``` unison -unique type Foo = Bar Nat Nat -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - type Foo - -``` -``` ucm -scratch/main> update - - Sorry, I wasn't able to perform the update: - - The type Foo has a constructor with multiple names, and I - can't perform an update in this situation: - - * Foo.Bar - * Foo.BarAlias - - Please delete all but one name for each constructor, and then - try updating again. - -``` diff --git a/unison-src/transcripts/update-type-delete-constructor-with-dependent.md b/unison-src/transcripts/update-type-delete-constructor-with-dependent.md deleted file mode 100644 index 3c7be50a53..0000000000 --- a/unison-src/transcripts/update-type-delete-constructor-with-dependent.md +++ /dev/null @@ -1,27 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtin -``` - -```unison -unique type Foo - = Bar Nat - | Baz Nat Nat - -foo : Foo -> Nat -foo = cases - Bar n -> n - Baz n m -> n + m -``` - -```ucm -scratch/main> add -``` - -```unison -unique type Foo - = Bar Nat -``` - -```ucm:error -scratch/main> update -``` diff --git a/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md b/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md deleted file mode 100644 index 085d0826a7..0000000000 --- a/unison-src/transcripts/update-type-delete-constructor-with-dependent.output.md +++ /dev/null @@ -1,79 +0,0 @@ -``` unison -unique type Foo - = Bar Nat - | Baz Nat Nat - -foo : Foo -> Nat -foo = cases - Bar n -> n - Baz n m -> n + m -``` - -``` 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`: - - type Foo - foo : Foo -> Nat - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Foo - foo : Foo -> Nat - -``` -``` unison -unique type Foo - = Bar Nat -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - type Foo - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Typechecking failed. I've updated your scratch file with the - definitions that need fixing. Once the file is compiling, try - `update` again. - -``` -``` unison:added-by-ucm scratch.u -type Foo = Bar Nat - --- The definitions below no longer typecheck with the changes above. --- Please fix the errors and try `update` again. - -foo : Foo -> Nat -foo = cases - Bar n -> n - Baz n m -> n Nat.+ m - -``` - diff --git a/unison-src/transcripts/update-type-delete-constructor.md b/unison-src/transcripts/update-type-delete-constructor.md deleted file mode 100644 index 18a8295d5a..0000000000 --- a/unison-src/transcripts/update-type-delete-constructor.md +++ /dev/null @@ -1,24 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtin -``` - -```unison -unique type Foo - = Bar Nat - | Baz Nat Nat -``` - -```ucm -scratch/main> add -``` - -```unison -unique type Foo - = Bar Nat -``` - -```ucm -scratch/main> update -scratch/main> view Foo -scratch/main> find.verbose -``` diff --git a/unison-src/transcripts/update-type-delete-constructor.output.md b/unison-src/transcripts/update-type-delete-constructor.output.md deleted file mode 100644 index 31afdb7d41..0000000000 --- a/unison-src/transcripts/update-type-delete-constructor.output.md +++ /dev/null @@ -1,69 +0,0 @@ -``` unison -unique type Foo - = Bar Nat - | Baz Nat Nat -``` - -``` 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`: - - type Foo - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Foo - -``` -``` unison -unique type Foo - = Bar Nat -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - type Foo - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -scratch/main> view Foo - - type Foo = Bar Nat - -scratch/main> find.verbose - - 1. -- #b509v3eg4kehsg29g6pvrogeb71ue32nm2fj9284n4i7lprsr7u9a7g6s695d09du0fsfti6rrsk1s62q5thpr1jjkqb3us3s0lrd60 - type Foo - - 2. -- #b509v3eg4kehsg29g6pvrogeb71ue32nm2fj9284n4i7lprsr7u9a7g6s695d09du0fsfti6rrsk1s62q5thpr1jjkqb3us3s0lrd60#0 - Foo.Bar : Nat -> Foo - - - -``` diff --git a/unison-src/transcripts/update-type-delete-record-field.md b/unison-src/transcripts/update-type-delete-record-field.md deleted file mode 100644 index cd3520e8b2..0000000000 --- a/unison-src/transcripts/update-type-delete-record-field.md +++ /dev/null @@ -1,23 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtin -``` - -```unison -unique type Foo = { bar : Nat, baz : Int } -``` - -```ucm -scratch/main> add -``` - -```unison -unique type Foo = { bar : Nat } -``` - -We want the field accessors to go away; but for now they are here, causing the update to fail. - -```ucm:error -scratch/main> update -scratch/main> view Foo -scratch/main> find.verbose -``` diff --git a/unison-src/transcripts/update-type-delete-record-field.output.md b/unison-src/transcripts/update-type-delete-record-field.output.md deleted file mode 100644 index fb3f7a3c99..0000000000 --- a/unison-src/transcripts/update-type-delete-record-field.output.md +++ /dev/null @@ -1,122 +0,0 @@ -``` unison -unique type Foo = { bar : Nat, baz : Int } -``` - -``` 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`: - - type Foo - Foo.bar : Foo -> Nat - Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo - Foo.bar.set : Nat -> Foo -> Foo - Foo.baz : Foo -> Int - Foo.baz.modify : (Int ->{g} Int) -> Foo ->{g} Foo - Foo.baz.set : Int -> Foo -> Foo - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Foo - Foo.bar : Foo -> Nat - Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo - Foo.bar.set : Nat -> Foo -> Foo - Foo.baz : Foo -> Int - Foo.baz.modify : (Int ->{g} Int) -> Foo ->{g} Foo - Foo.baz.set : Int -> Foo -> Foo - -``` -``` unison -unique type Foo = { bar : Nat } -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - type Foo - Foo.bar : Foo -> Nat - Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo - Foo.bar.set : Nat -> Foo -> Foo - -``` -We want the field accessors to go away; but for now they are here, causing the update to fail. - -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Typechecking failed. I've updated your scratch file with the - definitions that need fixing. Once the file is compiling, try - `update` again. - -scratch/main> view Foo - - type Foo = { bar : Nat, baz : Int } - -scratch/main> find.verbose - - 1. -- #05gh1dur4778dauh9slaofprc5356n47qpove0c1jl0birt2fcu301js8auu5vfr5bjfga9j8ikuk07ll9fu1gj3ehrp3basguhsd58 - type Foo - - 2. -- #77mi33dv8ac2s90852khi35km5gsamhnpada8mai0k36obbttgg17qld719ospcs1ht9ctolg3pjsqs6qjnl3hfmu493rgsher73sc0 - Foo.bar : Foo -> Nat - - 3. -- #7m1n2178r5u12jdnb6crcmanu2gm961kdvbjul5m6hta1s57avibsvk6p5g9efut8sennpgstbb8kf97eujbbuiplsoloa4cael7t90 - Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo - - 4. -- #ghuqoel4pao6v8e7un238i3e86vv7a7pnvgaq8m9s32edm1upgv35gri2iu32ipn9r4poli56r5kr3vtjfrltem696grfl75al4jkgg - Foo.bar.set : Nat -> Foo -> Foo - - 5. -- #p8emkm2s09n3nsd8ne5f6fro0vsldk8pn7n6rcf417anuvvun43qrk1ioofs6pdq4537eosao17c7ibvktktr3lfqglmj26gmbulmj0 - Foo.baz : Foo -> Int - - 6. -- #0il9pl29jpe3fh6vp3qeqai73915k3qffhf4bgttrgsj000b9fgs3bqoj8ugjop6kdr04acc34m1bj7lf417tslfeva7dmmoqdu5hug - Foo.baz.modify : (Int ->{g} Int) -> Foo ->{g} Foo - - 7. -- #87rjeqltvvd4adffsheqae62eefoge8p78pvnjdkc9q1stq20lhubvtpos0io4v3vhnol8nn2uollup97l4orq1fh2h12b0imeuuc58 - Foo.baz.set : Int -> Foo -> Foo - - 8. -- #05gh1dur4778dauh9slaofprc5356n47qpove0c1jl0birt2fcu301js8auu5vfr5bjfga9j8ikuk07ll9fu1gj3ehrp3basguhsd58#0 - Foo.Foo : Nat -> Int -> Foo - - - -``` -``` unison:added-by-ucm scratch.u -type Foo = { bar : Nat } - --- The definitions below no longer typecheck with the changes above. --- Please fix the errors and try `update` again. - -Foo.baz : Foo -> Int -Foo.baz = cases Foo _ baz -> baz - -Foo.baz.modify : (Int ->{g} Int) -> Foo ->{g} Foo -Foo.baz.modify f = cases Foo bar baz -> Foo bar (f baz) - -Foo.baz.set : Int -> Foo -> Foo -Foo.baz.set baz1 = cases Foo bar _ -> Foo bar baz1 - -``` - diff --git a/unison-src/transcripts/update-type-missing-constructor.md b/unison-src/transcripts/update-type-missing-constructor.md deleted file mode 100644 index 5fa29c2a86..0000000000 --- a/unison-src/transcripts/update-type-missing-constructor.md +++ /dev/null @@ -1,23 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtin -``` - -```unison -unique type Foo = Bar Nat -``` - -```ucm -scratch/main> add -scratch/main> delete.term Foo.Bar -``` - -Now we've set up a situation where the original constructor missing. - -```unison -unique type Foo = Bar Nat Nat -``` - -```ucm:error -scratch/main> view Foo -scratch/main> update -``` diff --git a/unison-src/transcripts/update-type-missing-constructor.output.md b/unison-src/transcripts/update-type-missing-constructor.output.md deleted file mode 100644 index bd92140cdd..0000000000 --- a/unison-src/transcripts/update-type-missing-constructor.output.md +++ /dev/null @@ -1,66 +0,0 @@ -``` unison -unique type Foo = Bar Nat -``` - -``` 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`: - - type Foo - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Foo - -scratch/main> delete.term Foo.Bar - - Done. - -``` -Now we've set up a situation where the original constructor missing. - -``` unison -unique type Foo = Bar Nat Nat -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - type Foo - -``` -``` ucm -scratch/main> view Foo - - type Foo = #b509v3eg4k#0 Nat - -scratch/main> update - - Sorry, I wasn't able to perform the update: - - The type Foo has some constructors with missing names, and I - can't perform an update in this situation. - - You can use `view Foo` and - `alias.term Foo.` to give names to - each unnamed constructor, and then try the update again. - -``` diff --git a/unison-src/transcripts/update-type-nested-decl-aliases.md b/unison-src/transcripts/update-type-nested-decl-aliases.md deleted file mode 100644 index c04f01b5fe..0000000000 --- a/unison-src/transcripts/update-type-nested-decl-aliases.md +++ /dev/null @@ -1,22 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtin -``` - -```unison -unique type Foo = Bar Nat - -structural type A.B = OneAlias Foo -structural type A = B.TheOtherAlias Foo -``` - -```ucm -scratch/main> add -``` - -```unison -unique type Foo = Bar Nat Nat -``` - -```ucm:error -scratch/main> update -``` diff --git a/unison-src/transcripts/update-type-nested-decl-aliases.output.md b/unison-src/transcripts/update-type-nested-decl-aliases.output.md deleted file mode 100644 index 96325c6404..0000000000 --- a/unison-src/transcripts/update-type-nested-decl-aliases.output.md +++ /dev/null @@ -1,59 +0,0 @@ -``` unison -unique type Foo = Bar Nat - -structural type A.B = OneAlias Foo -structural type A = B.TheOtherAlias Foo -``` - -``` 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`: - - structural type A - structural type A.B - type Foo - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - structural type A - structural type A.B - type Foo - -``` -``` unison -unique type Foo = Bar Nat Nat -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - type Foo - -``` -``` ucm -scratch/main> update - - The type A.B is an alias of A. I'm not able to perform an - update when a type exists nested under an alias of itself. - Please separate them or delete one copy, and then try updating - again. - -``` diff --git a/unison-src/transcripts/update-type-no-op-record.md b/unison-src/transcripts/update-type-no-op-record.md deleted file mode 100644 index e9ec904c95..0000000000 --- a/unison-src/transcripts/update-type-no-op-record.md +++ /dev/null @@ -1,17 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtin -``` - -```unison -unique type Foo = { bar : Nat } -``` - -```ucm -scratch/main> add -``` - -Bug: this no-op update should (of course) succeed. - -```ucm -scratch/main> update -``` diff --git a/unison-src/transcripts/update-type-no-op-record.output.md b/unison-src/transcripts/update-type-no-op-record.output.md deleted file mode 100644 index 763a1aba59..0000000000 --- a/unison-src/transcripts/update-type-no-op-record.output.md +++ /dev/null @@ -1,42 +0,0 @@ -``` unison -unique type Foo = { bar : Nat } -``` - -``` 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`: - - type Foo - Foo.bar : Foo -> Nat - Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo - Foo.bar.set : Nat -> Foo -> Foo - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Foo - Foo.bar : Foo -> Nat - Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo - Foo.bar.set : Nat -> Foo -> Foo - -``` -Bug: this no-op update should (of course) succeed. - -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -``` diff --git a/unison-src/transcripts/update-type-stray-constructor-alias.md b/unison-src/transcripts/update-type-stray-constructor-alias.md deleted file mode 100644 index 86e8a663ca..0000000000 --- a/unison-src/transcripts/update-type-stray-constructor-alias.md +++ /dev/null @@ -1,20 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtin -``` - -```unison -unique type Foo = Bar Nat -``` - -```ucm -scratch/main> add -scratch/main> alias.term Foo.Bar Stray.BarAlias -``` - -```unison -unique type Foo = Bar Nat Nat -``` - -```ucm:error -scratch/main> update -``` diff --git a/unison-src/transcripts/update-type-stray-constructor-alias.output.md b/unison-src/transcripts/update-type-stray-constructor-alias.output.md deleted file mode 100644 index 78574abe55..0000000000 --- a/unison-src/transcripts/update-type-stray-constructor-alias.output.md +++ /dev/null @@ -1,60 +0,0 @@ -``` unison -unique type Foo = Bar Nat -``` - -``` 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`: - - type Foo - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Foo - -scratch/main> alias.term Foo.Bar Stray.BarAlias - - Done. - -``` -``` unison -unique type Foo = Bar Nat Nat -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - type Foo - -``` -``` ucm -scratch/main> update - - Sorry, I wasn't able to perform the update, because I need all - constructor names to be nested somewhere beneath the - corresponding type name. - - The constructor Stray.BarAlias is not nested beneath the - corresponding type name. Please either use `move` to move it, - or if it's an extra copy, you can simply `delete` it. Then try - the update again. - -``` diff --git a/unison-src/transcripts/update-type-stray-constructor.md b/unison-src/transcripts/update-type-stray-constructor.md deleted file mode 100644 index 7808f759be..0000000000 --- a/unison-src/transcripts/update-type-stray-constructor.md +++ /dev/null @@ -1,25 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtin -``` - -```unison -unique type Foo = Bar Nat -``` - -```ucm -scratch/main> add -scratch/main> move.term Foo.Bar Stray.Bar -``` - -Now we've set up a situation where the constructor is not where it's supposed to be; it's somewhere else. - -```unison -unique type Foo = Bar Nat Nat -``` - -Note that the constructor name shown here (implied to be called `Foo.Stray.Bar`) doesn't really exist, it's just showing up due to a pretty-printer bug. - -```ucm:error -scratch/main> view Foo -scratch/main> update -``` diff --git a/unison-src/transcripts/update-type-stray-constructor.output.md b/unison-src/transcripts/update-type-stray-constructor.output.md deleted file mode 100644 index f188fb9252..0000000000 --- a/unison-src/transcripts/update-type-stray-constructor.output.md +++ /dev/null @@ -1,68 +0,0 @@ -``` unison -unique type Foo = Bar Nat -``` - -``` 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`: - - type Foo - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Foo - -scratch/main> move.term Foo.Bar Stray.Bar - - Done. - -``` -Now we've set up a situation where the constructor is not where it's supposed to be; it's somewhere else. - -``` unison -unique type Foo = Bar Nat Nat -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - type Foo - -``` -Note that the constructor name shown here (implied to be called `Foo.Stray.Bar`) doesn't really exist, it's just showing up due to a pretty-printer bug. - -``` ucm -scratch/main> view Foo - - type Foo = Stray.Bar Nat - -scratch/main> update - - Sorry, I wasn't able to perform the update: - - The type Foo has some constructors with missing names, and I - can't perform an update in this situation. - - You can use `view Foo` and - `alias.term Foo.` to give names to - each unnamed constructor, and then try the update again. - -``` diff --git a/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.md b/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.md deleted file mode 100644 index 1f2933242a..0000000000 --- a/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.md +++ /dev/null @@ -1,27 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtin -``` - -```unison -unique type Foo = Bar Nat - -makeFoo : Nat -> Foo -makeFoo n = Bar (n+10) -``` - -```ucm -scratch/main> add -``` - -```unison -unique type Foo = internal.Bar Nat - -Foo.Bar : Nat -> Foo -Foo.Bar n = internal.Bar n -``` - -```ucm -scratch/main> update -scratch/main> view Foo -scratch/main> find.verbose -``` diff --git a/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.output.md b/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.output.md deleted file mode 100644 index b6daa83021..0000000000 --- a/unison-src/transcripts/update-type-turn-constructor-into-smart-constructor.output.md +++ /dev/null @@ -1,85 +0,0 @@ -``` unison -unique type Foo = Bar Nat - -makeFoo : Nat -> Foo -makeFoo n = Bar (n+10) -``` - -``` 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`: - - type Foo - makeFoo : Nat -> Foo - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Foo - makeFoo : Nat -> Foo - -``` -``` unison -unique type Foo = internal.Bar Nat - -Foo.Bar : Nat -> Foo -Foo.Bar n = internal.Bar n -``` - -``` 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: - - ⊡ Previously added definitions will be ignored: Foo - - ⍟ These new definitions are ok to `add`: - - Foo.Bar : Nat -> Foo - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Everything typechecks, so I'm saving the results... - - Done. - -scratch/main> view Foo - - type Foo = internal.Bar Nat - -scratch/main> find.verbose - - 1. -- #b509v3eg4kehsg29g6pvrogeb71ue32nm2fj9284n4i7lprsr7u9a7g6s695d09du0fsfti6rrsk1s62q5thpr1jjkqb3us3s0lrd60 - type Foo - - 2. -- #36rn6jqt1k5jccb3c7vagp3jam74dngr92kgcntqhs6dbkua54verfert2i6hsku6uitt9s2jvt1msric0tgemal52d5apav6akn25o - Foo.Bar : Nat -> Foo - - 3. -- #b509v3eg4kehsg29g6pvrogeb71ue32nm2fj9284n4i7lprsr7u9a7g6s695d09du0fsfti6rrsk1s62q5thpr1jjkqb3us3s0lrd60#0 - Foo.internal.Bar : Nat -> Foo - - 4. -- #204frdcl0iid1ujkkfbkc6b3v7cgqp56h1q3duc46i5md6qb4m6am1fqbceb335u87l05gkdnaa7fjn4alj1diukgme63e41lh072l8 - makeFoo : Nat -> Foo - - - -``` diff --git a/unison-src/transcripts/update-type-turn-non-record-into-record.md b/unison-src/transcripts/update-type-turn-non-record-into-record.md deleted file mode 100644 index 829240ff62..0000000000 --- a/unison-src/transcripts/update-type-turn-non-record-into-record.md +++ /dev/null @@ -1,21 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtin -``` - -```unison -unique type Foo = Nat -``` - -```ucm -scratch/main> add -``` - -```unison -unique type Foo = { bar : Nat } -``` - -```ucm -scratch/main> update -scratch/main> view Foo -scratch/main> find.verbose -``` diff --git a/unison-src/transcripts/update-type-turn-non-record-into-record.output.md b/unison-src/transcripts/update-type-turn-non-record-into-record.output.md deleted file mode 100644 index edeb85642e..0000000000 --- a/unison-src/transcripts/update-type-turn-non-record-into-record.output.md +++ /dev/null @@ -1,81 +0,0 @@ -``` unison -unique type Foo = Nat -``` - -``` 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`: - - type Foo - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Foo - -``` -``` unison -unique type Foo = { bar : Nat } -``` - -``` 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.bar : Foo -> Nat - Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo - Foo.bar.set : Nat -> Foo -> Foo - - ⍟ These names already exist. You can `update` them to your - new definition: - - type Foo - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -scratch/main> view Foo - - type Foo = { bar : Nat } - -scratch/main> find.verbose - - 1. -- #b509v3eg4kehsg29g6pvrogeb71ue32nm2fj9284n4i7lprsr7u9a7g6s695d09du0fsfti6rrsk1s62q5thpr1jjkqb3us3s0lrd60 - type Foo - - 2. -- #ovhevqfin94qhq5fu0mujfi20mbpvg5mh4vsfklrohp84cch4lhvrn5p29cnbsqfm92l7bt8c1vpjooh72a0psbddvvten4gq2sipag - Foo.bar : Foo -> Nat - - 3. -- #as72md2u70e0u9s2ig2ug7jvlbrk1mubo8qlfokpuvgusg35svh05r7nsj27sqo5edeghjnk8g8259fi4ismse736v4n5ojrb3o2le8 - Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo - - 4. -- #5cbctoor75nbtn4ppp10qm1i25gqt2lgth3itqa0lloib32je4ijfj2n3qcdfhmdcnbgum2jg46opntlohv7ladun3dmefl1ucgobeg - Foo.bar.set : Nat -> Foo -> Foo - - 5. -- #b509v3eg4kehsg29g6pvrogeb71ue32nm2fj9284n4i7lprsr7u9a7g6s695d09du0fsfti6rrsk1s62q5thpr1jjkqb3us3s0lrd60#0 - Foo.Foo : Nat -> Foo - - - -``` diff --git a/unison-src/transcripts/update-type-with-dependent-term.md b/unison-src/transcripts/update-type-with-dependent-term.md deleted file mode 100644 index 300eddc69f..0000000000 --- a/unison-src/transcripts/update-type-with-dependent-term.md +++ /dev/null @@ -1,22 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtin -``` - -```unison -unique type Foo = Bar Nat - -incrFoo : Foo -> Foo -incrFoo = cases Bar n -> Bar (n+1) -``` - -```ucm -scratch/main> add -``` - -```unison -unique type Foo = Bar Nat Nat -``` - -```ucm:error -scratch/main> update -``` diff --git a/unison-src/transcripts/update-type-with-dependent-term.output.md b/unison-src/transcripts/update-type-with-dependent-term.output.md deleted file mode 100644 index c334a5e853..0000000000 --- a/unison-src/transcripts/update-type-with-dependent-term.output.md +++ /dev/null @@ -1,72 +0,0 @@ -``` unison -unique type Foo = Bar Nat - -incrFoo : Foo -> Foo -incrFoo = cases Bar n -> Bar (n+1) -``` - -``` 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`: - - type Foo - incrFoo : Foo -> Foo - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Foo - incrFoo : Foo -> Foo - -``` -``` unison -unique type Foo = Bar Nat Nat -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - type Foo - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Typechecking failed. I've updated your scratch file with the - definitions that need fixing. Once the file is compiling, try - `update` again. - -``` -``` unison:added-by-ucm scratch.u -type Foo = Bar Nat Nat - --- The definitions below no longer typecheck with the changes above. --- Please fix the errors and try `update` again. - -incrFoo : Foo -> Foo -incrFoo = cases Bar n -> Bar (n Nat.+ 1) - -``` - diff --git a/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.md b/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.md deleted file mode 100644 index 1caef319d8..0000000000 --- a/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.md +++ /dev/null @@ -1,20 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtin -``` - -```unison -unique type Foo = Bar Nat -unique type Baz = Qux Foo -``` - -```ucm -scratch/main> add -``` - -```unison -unique type Foo a = Bar Nat a -``` - -```ucm:error -scratch/main> update -``` diff --git a/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md b/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md deleted file mode 100644 index bff59176e3..0000000000 --- a/unison-src/transcripts/update-type-with-dependent-type-to-different-kind.output.md +++ /dev/null @@ -1,69 +0,0 @@ -``` unison -unique type Foo = Bar Nat -unique type Baz = Qux Foo -``` - -``` 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`: - - type Baz - type Foo - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Baz - type Foo - -``` -``` unison -unique type Foo a = Bar Nat a -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - type Foo a - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Typechecking failed. I've updated your scratch file with the - definitions that need fixing. Once the file is compiling, try - `update` again. - -``` -``` unison:added-by-ucm scratch.u -type Foo a = Bar Nat a - --- The definitions below no longer typecheck with the changes above. --- Please fix the errors and try `update` again. - -type Baz = Qux Foo - -``` - diff --git a/unison-src/transcripts/update-type-with-dependent-type.md b/unison-src/transcripts/update-type-with-dependent-type.md deleted file mode 100644 index 4b6e8aa2dc..0000000000 --- a/unison-src/transcripts/update-type-with-dependent-type.md +++ /dev/null @@ -1,23 +0,0 @@ -```ucm:hide -scratch/main> builtins.merge lib.builtin -``` - -```unison -unique type Foo = Bar Nat -unique type Baz = Qux Foo -``` - -```ucm -scratch/main> add -``` - -```unison -unique type Foo = Bar Nat Nat -``` - -```ucm -scratch/main> update -scratch/main> view Foo -scratch/main> view Baz -scratch/main> find.verbose -``` diff --git a/unison-src/transcripts/update-type-with-dependent-type.output.md b/unison-src/transcripts/update-type-with-dependent-type.output.md deleted file mode 100644 index 6effd150c3..0000000000 --- a/unison-src/transcripts/update-type-with-dependent-type.output.md +++ /dev/null @@ -1,83 +0,0 @@ -``` unison -unique type Foo = Bar Nat -unique type Baz = Qux Foo -``` - -``` 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`: - - type Baz - type Foo - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - type Baz - type Foo - -``` -``` unison -unique type Foo = Bar Nat Nat -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - type Foo - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - That's done. Now I'm making sure everything typechecks... - - Everything typechecks, so I'm saving the results... - - Done. - -scratch/main> view Foo - - type Foo = Bar Nat Nat - -scratch/main> view Baz - - type Baz = Qux Foo - -scratch/main> find.verbose - - 1. -- #34msh9satlfog576493eo9pkjn6aj7d8fj6jfheglvgr5s39iptb81649bpkad1lqraheqb8em9ms551k01oternhknc4m7jicgtk08 - type Baz - - 2. -- #34msh9satlfog576493eo9pkjn6aj7d8fj6jfheglvgr5s39iptb81649bpkad1lqraheqb8em9ms551k01oternhknc4m7jicgtk08#0 - Baz.Qux : Foo -> Baz - - 3. -- #8fk6k0j208th1ia4vnjtoc5fomd6le540prec255svg71bcfga9dofrvoq1d7v6010d6b6em4q51p8st5c5juhrev72cnnel8ko3o1g - type Foo - - 4. -- #8fk6k0j208th1ia4vnjtoc5fomd6le540prec255svg71bcfga9dofrvoq1d7v6010d6b6em4q51p8st5c5juhrev72cnnel8ko3o1g#0 - Foo.Bar : Nat -> Nat -> Foo - - - -``` diff --git a/unison-src/transcripts/update-watch.md b/unison-src/transcripts/update-watch.md deleted file mode 100644 index 013801ebb7..0000000000 --- a/unison-src/transcripts/update-watch.md +++ /dev/null @@ -1,7 +0,0 @@ -```unison -> 1 -``` - -```ucm -scratch/main> update -``` diff --git a/unison-src/transcripts/update-watch.output.md b/unison-src/transcripts/update-watch.output.md deleted file mode 100644 index feb53dc173..0000000000 --- a/unison-src/transcripts/update-watch.output.md +++ /dev/null @@ -1,29 +0,0 @@ -``` unison -> 1 -``` - -``` ucm - - Loading changes detected in scratch.u. - - ✅ - - scratch.u changed. - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 1 | > 1 - ⧩ - 1 - -``` -``` ucm -scratch/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -``` diff --git a/unison-src/transcripts/upgrade-happy-path.md b/unison-src/transcripts/upgrade-happy-path.md deleted file mode 100644 index 068c8ccf1c..0000000000 --- a/unison-src/transcripts/upgrade-happy-path.md +++ /dev/null @@ -1,28 +0,0 @@ -```ucm:hide -proj/main> builtins.merge lib.builtin -``` - -```unison -lib.old.foo = 17 -lib.new.foo = 18 -thingy = lib.old.foo + 10 -``` - - -```ucm -proj/main> add -``` - -Test tab completion and fzf options of upgrade command. - -```ucm -proj/main> debug.tab-complete upgrade ol -proj/main> debug.fuzzy-options upgrade _ -proj/main> debug.fuzzy-options upgrade old _ -``` - -```ucm -proj/main> upgrade old new -proj/main> ls lib -proj/main> view thingy -``` diff --git a/unison-src/transcripts/upgrade-happy-path.output.md b/unison-src/transcripts/upgrade-happy-path.output.md deleted file mode 100644 index 127b0c4897..0000000000 --- a/unison-src/transcripts/upgrade-happy-path.output.md +++ /dev/null @@ -1,71 +0,0 @@ -``` unison -lib.old.foo = 17 -lib.new.foo = 18 -thingy = lib.old.foo + 10 -``` - -``` 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`: - - lib.new.foo : Nat - lib.old.foo : Nat - thingy : Nat - -``` -``` ucm -proj/main> add - - ⍟ I've added these definitions: - - lib.new.foo : Nat - lib.old.foo : Nat - thingy : Nat - -``` -Test tab completion and fzf options of upgrade command. - -``` ucm -proj/main> debug.tab-complete upgrade ol - - old - -proj/main> debug.fuzzy-options upgrade _ - - Select a dependency to upgrade: - * builtin - * new - * old - -proj/main> debug.fuzzy-options upgrade old _ - - Select a dependency to upgrade to: - * builtin - * new - * old - -``` -``` ucm -proj/main> upgrade old new - - I upgraded old to new, and removed old. - -proj/main> ls lib - - 1. builtin/ (469 terms, 74 types) - 2. new/ (1 term) - -proj/main> view thingy - - thingy : Nat - thingy = - use Nat + - foo + 10 - -``` diff --git a/unison-src/transcripts/upgrade-sad-path.md b/unison-src/transcripts/upgrade-sad-path.md deleted file mode 100644 index c2c1fe459a..0000000000 --- a/unison-src/transcripts/upgrade-sad-path.md +++ /dev/null @@ -1,31 +0,0 @@ -```ucm:hide -proj/main> builtins.merge lib.builtin -``` - -```unison -lib.old.foo = 17 -lib.new.foo = +18 -thingy = lib.old.foo + 10 -``` - -```ucm -proj/main> add -``` - -```ucm:error -proj/main> upgrade old new -``` - -Resolve the error and commit the upgrade. - -```unison -thingy = foo + +10 -``` - -```ucm -proj/upgrade-old-to-new> update -proj/upgrade-old-to-new> upgrade.commit -proj/main> view thingy -proj/main> ls lib -proj/main> branches -``` diff --git a/unison-src/transcripts/upgrade-sad-path.output.md b/unison-src/transcripts/upgrade-sad-path.output.md deleted file mode 100644 index 54c7b546c1..0000000000 --- a/unison-src/transcripts/upgrade-sad-path.output.md +++ /dev/null @@ -1,108 +0,0 @@ -``` unison -lib.old.foo = 17 -lib.new.foo = +18 -thingy = lib.old.foo + 10 -``` - -``` 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`: - - lib.new.foo : Int - lib.old.foo : Nat - thingy : Nat - -``` -``` ucm -proj/main> add - - ⍟ I've added these definitions: - - lib.new.foo : Int - lib.old.foo : Nat - thingy : Nat - -``` -``` ucm -proj/main> upgrade old new - - I couldn't automatically upgrade old to new. However, I've - added the definitions that need attention to the top of - scratch.u. - - When you're done, you can run - - upgrade.commit - - to merge your changes back into main and delete the temporary - branch. Or, if you decide to cancel the upgrade instead, you - can run - - delete.branch /upgrade-old-to-new - - to delete the temporary branch and switch back to main. - -``` -``` unison:added-by-ucm scratch.u -thingy : Nat -thingy = - use Nat + - foo + 10 -``` - -Resolve the error and commit the upgrade. - -``` unison -thingy = foo + +10 -``` - -``` 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 names already exist. You can `update` them to your - new definition: - - thingy : Int - -``` -``` ucm -proj/upgrade-old-to-new> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -proj/upgrade-old-to-new> upgrade.commit - - I fast-forward merged proj/upgrade-old-to-new into proj/main. - -proj/main> view thingy - - thingy : Int - thingy = - use Int + - foo + +10 - -proj/main> ls lib - - 1. builtin/ (469 terms, 74 types) - 2. new/ (1 term) - -proj/main> branches - - Branch Remote branch - 1. main - -``` diff --git a/unison-src/transcripts/upgrade-suffixifies-properly.md b/unison-src/transcripts/upgrade-suffixifies-properly.md deleted file mode 100644 index 08c4b002d9..0000000000 --- a/unison-src/transcripts/upgrade-suffixifies-properly.md +++ /dev/null @@ -1,21 +0,0 @@ -```ucm:hide -myproject/main> builtins.merge lib.builtin -``` - -```unison -lib.old.foo = 25 -lib.new.foo = +30 -a.x.x.x.x = 100 -b.x.x.x.x = 100 -c.y.y.y.y = lib.old.foo + 10 -d.y.y.y.y = lib.old.foo + 10 -bar = a.x.x.x.x + c.y.y.y.y -``` - -```ucm -myproject/main> add -``` - -```ucm:error -myproject/main> upgrade old new -``` diff --git a/unison-src/transcripts/upgrade-suffixifies-properly.output.md b/unison-src/transcripts/upgrade-suffixifies-properly.output.md deleted file mode 100644 index 0440acc2ac..0000000000 --- a/unison-src/transcripts/upgrade-suffixifies-properly.output.md +++ /dev/null @@ -1,80 +0,0 @@ -``` unison -lib.old.foo = 25 -lib.new.foo = +30 -a.x.x.x.x = 100 -b.x.x.x.x = 100 -c.y.y.y.y = lib.old.foo + 10 -d.y.y.y.y = lib.old.foo + 10 -bar = a.x.x.x.x + c.y.y.y.y -``` - -``` 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`: - - a.x.x.x.x : Nat - b.x.x.x.x : Nat - bar : Nat - c.y.y.y.y : Nat - d.y.y.y.y : Nat - lib.new.foo : Int - lib.old.foo : Nat - -``` -``` ucm -myproject/main> add - - ⍟ I've added these definitions: - - a.x.x.x.x : Nat - b.x.x.x.x : Nat - bar : Nat - c.y.y.y.y : Nat - d.y.y.y.y : Nat - lib.new.foo : Int - lib.old.foo : Nat - -``` -``` ucm -myproject/main> upgrade old new - - I couldn't automatically upgrade old to new. However, I've - added the definitions that need attention to the top of - scratch.u. - - When you're done, you can run - - upgrade.commit - - to merge your changes back into main and delete the temporary - branch. Or, if you decide to cancel the upgrade instead, you - can run - - delete.branch /upgrade-old-to-new - - to delete the temporary branch and switch back to main. - -``` -``` unison:added-by-ucm scratch.u -bar : Nat -bar = - use Nat + - x + c.y.y.y.y - -c.y.y.y.y : Nat -c.y.y.y.y = - use Nat + - foo + 10 - -d.y.y.y.y : Nat -d.y.y.y.y = - use Nat + - foo + 10 -``` - diff --git a/unison-src/transcripts/upgrade-with-old-alias.md b/unison-src/transcripts/upgrade-with-old-alias.md deleted file mode 100644 index aeb818947e..0000000000 --- a/unison-src/transcripts/upgrade-with-old-alias.md +++ /dev/null @@ -1,17 +0,0 @@ -```ucm:hide -myproject/main> builtins.merge lib.builtin -``` - -```unison -lib.old.foo = 141 -lib.new.foo = 142 -bar = 141 -mything = lib.old.foo + 100 -``` - -```ucm -myproject/main> update -myproject/main> upgrade old new -myproject/main> view mything -myproject/main> view bar -``` diff --git a/unison-src/transcripts/upgrade-with-old-alias.output.md b/unison-src/transcripts/upgrade-with-old-alias.output.md deleted file mode 100644 index 9afef6c22b..0000000000 --- a/unison-src/transcripts/upgrade-with-old-alias.output.md +++ /dev/null @@ -1,48 +0,0 @@ -``` unison -lib.old.foo = 141 -lib.new.foo = 142 -bar = 141 -mything = lib.old.foo + 100 -``` - -``` 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`: - - bar : Nat - lib.new.foo : Nat - lib.old.foo : Nat - mything : Nat - -``` -``` ucm -myproject/main> update - - Okay, I'm searching the branch for code that needs to be - updated... - - Done. - -myproject/main> upgrade old new - - I upgraded old to new, and removed old. - -myproject/main> view mything - - mything : Nat - mything = - use Nat + - foo + 100 - -myproject/main> view bar - - bar : Nat - bar = 141 - -``` diff --git a/unison-src/transcripts/view.output.md b/unison-src/transcripts/view.output.md deleted file mode 100644 index 336a8c932e..0000000000 --- a/unison-src/transcripts/view.output.md +++ /dev/null @@ -1,33 +0,0 @@ -# View commands - -``` unison -a.thing = "a" -b.thing = "b" -``` - -``` ucm --- Should suffix-search and find values in sub-namespaces -scratch/main> view thing - - a.thing : Text - a.thing = "a" - - b.thing : Text - b.thing = "b" - --- Should support absolute paths -scratch/main> view .b.thing - - .b.thing : Text - .b.thing = "b" - -``` -TODO: swap this back to a 'ucm' block when view.global is re-implemented - -``` --- view.global should search globally and be absolutely qualified -scratch/other> view.global thing --- Should support branch relative paths -scratch/other> view /main:a.thing -``` - diff --git a/unison-src/transcripts/watch-expressions.md b/unison-src/transcripts/watch-expressions.md deleted file mode 100644 index b4f54004b0..0000000000 --- a/unison-src/transcripts/watch-expressions.md +++ /dev/null @@ -1,25 +0,0 @@ -```ucm -scratch/main> builtins.mergeio -``` - -```unison -test> pass = [Ok "Passed"] -``` - -```ucm -scratch/main> add -``` - -```unison -test> pass = [Ok "Passed"] -``` - -```ucm -scratch/main> add -scratch/main> test -``` - -```unison -> ImmutableArray.fromList [?a, ?b, ?c] -> ImmutableByteArray.fromBytes 0xs123456 -``` diff --git a/unison-src/transcripts/watch-expressions.output.md b/unison-src/transcripts/watch-expressions.output.md deleted file mode 100644 index 096f08e7a3..0000000000 --- a/unison-src/transcripts/watch-expressions.output.md +++ /dev/null @@ -1,98 +0,0 @@ -``` ucm -scratch/main> builtins.mergeio - - Done. - -``` -``` unison -test> pass = [Ok "Passed"] -``` - -``` 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`: - - pass : [Result] - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 1 | test> pass = [Ok "Passed"] - - ✅ Passed Passed - -``` -``` ucm -scratch/main> add - - ⍟ I've added these definitions: - - pass : [Result] - -``` -``` unison -test> pass = [Ok "Passed"] -``` - -``` ucm - - Loading changes detected in scratch.u. - - I found and typechecked the definitions in scratch.u. This - file has been previously added to the codebase. - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 1 | test> pass = [Ok "Passed"] - - ✅ Passed Passed (cached) - -``` -``` ucm -scratch/main> add - - ⊡ Ignored previously added definitions: pass - -scratch/main> test - - Cached test results (`help testcache` to learn more) - - 1. pass ◉ Passed - - ✅ 1 test(s) passing - - Tip: Use view 1 to view the source of a test. - -``` -``` unison -> ImmutableArray.fromList [?a, ?b, ?c] -> ImmutableByteArray.fromBytes 0xs123456 -``` - -``` ucm - - Loading changes detected in scratch.u. - - ✅ - - scratch.u changed. - - Now evaluating any watch expressions (lines starting with - `>`)... Ctrl+C cancels. - - 1 | > ImmutableArray.fromList [?a, ?b, ?c] - ⧩ - ImmutableArray.fromList [?a, ?b, ?c] - - 2 | > ImmutableByteArray.fromBytes 0xs123456 - ⧩ - fromBytes 0xs123456 - -``` diff --git a/unison-syntax/package.yaml b/unison-syntax/package.yaml index b093dc182f..77a4c724b3 100644 --- a/unison-syntax/package.yaml +++ b/unison-syntax/package.yaml @@ -4,42 +4,47 @@ copyright: Copyright (C) 2013-2022 Unison Computing, PBC and contributors ghc-options: -Wall -dependencies: - - base - - bytes - - containers - - cryptonite - - deriving-compat - - extra - - free - - lens - - megaparsec - - mtl - - parser-combinators - - text - - text-builder - - unison-core - - unison-core1 - - unison-hash - - unison-prelude - - unison-util-base32hex - - unison-util-bytes - library: source-dirs: src when: - condition: false other-modules: Paths_unison_syntax + dependencies: + - base + - bytes + - containers + - cryptonite + - deriving-compat + - extra + - free + - lens + - megaparsec + - mtl + - parser-combinators + - text + - unison-core + - unison-core1 + - unison-hash + - unison-prelude + - unison-util-base32hex + - unison-util-bytes + tests: syntax-tests: when: - condition: false other-modules: Paths_unison_syntax dependencies: + - base - code-page - easytest + - megaparsec + - unison-core1 + - unison-prelude - unison-syntax + - unison-util-recursion + - text main: Main.hs source-dirs: test diff --git a/unison-syntax/src/Unison/Parser/Ann.hs b/unison-syntax/src/Unison/Parser/Ann.hs index e4b361d148..1b73adeaf6 100644 --- a/unison-syntax/src/Unison/Parser/Ann.hs +++ b/unison-syntax/src/Unison/Parser/Ann.hs @@ -29,6 +29,7 @@ startingLine _ = Nothing instance Monoid Ann where mempty = External +-- | This instance is commutative. instance Semigroup Ann where Ann s1 e1 <> Ann s2 e2 = Ann (min s1 s2) (max e1 e2) -- If we have a concrete location from a file, use it diff --git a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs index c641786505..6eb51da9cb 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer/Unison.hs @@ -14,6 +14,9 @@ module Unison.Syntax.Lexer.Unison showEscapeChar, touches, + -- * Lexers + typeOrTerm, + -- * Character classifiers wordyIdChar, wordyIdStartChar, @@ -29,6 +32,7 @@ import Control.Lens qualified as Lens import Control.Monad.State qualified as S import Data.Char (isAlphaNum, isDigit, isSpace, ord, toLower) import Data.Foldable qualified as Foldable +import Data.Functor.Classes (Show1 (..), showsPrec1) import Data.List qualified as List import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List.NonEmpty qualified as Nel @@ -46,9 +50,7 @@ import U.Codebase.Reference (ReferenceType (..)) import Unison.HashQualifiedPrime qualified as HQ' import Unison.Name (Name) import Unison.Name qualified as Name -import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment (docSegment) -import Unison.NameSegment.Internal qualified as NameSegment import Unison.Prelude import Unison.ShortHash (ShortHash) import Unison.ShortHash qualified as SH @@ -56,7 +58,7 @@ import Unison.Syntax.HashQualifiedPrime qualified as HQ' (toText) import Unison.Syntax.Lexer import Unison.Syntax.Lexer.Token (posP, tokenP) import Unison.Syntax.Name qualified as Name (isSymboly, nameP, toText, unsafeParseText) -import Unison.Syntax.NameSegment qualified as NameSegment (ParseErr (..), wordyP) +import Unison.Syntax.NameSegment qualified as NameSegment (ParseErr (..)) import Unison.Syntax.Parser.Doc qualified as Doc import Unison.Syntax.Parser.Doc.Data qualified as Doc import Unison.Syntax.ReservedWords (delimiters, typeModifiers, typeOrAbility) @@ -78,6 +80,9 @@ data ParsingEnv = ParsingEnv } deriving (Show) +initialEnv :: BlockName -> ParsingEnv +initialEnv scope = ParsingEnv [] (Just scope) True + type P = P.ParsecT (Token Err) String (S.State ParsingEnv) data Err @@ -88,6 +93,7 @@ data Err | InvalidBytesLiteral String | InvalidHexLiteral | InvalidOctalLiteral + | InvalidBinaryLiteral | Both Err Err | MissingFractional String -- ex `1.` rather than `1.04` | MissingExponent String -- ex `1e` rather than `1e3` @@ -105,20 +111,30 @@ data Err -- further knowledge of spacing or indentation levels -- any knowledge of comments data Lexeme - = Open String -- start of a block - | Semi IsVirtual -- separator between elements of a block - | Close -- end of a block - | Reserved String -- reserved tokens such as `{`, `(`, `type`, `of`, etc - | Textual String -- text literals, `"foo bar"` - | Character Char -- character literals, `?X` - | WordyId (HQ'.HashQualified Name) -- a (non-infix) identifier. invariant: last segment is wordy - | SymbolyId (HQ'.HashQualified Name) -- an infix identifier. invariant: last segment is symboly - | Blank String -- a typed hole or placeholder - | Numeric String -- numeric literals, left unparsed - | Bytes Bytes.Bytes -- bytes literals - | Hash ShortHash -- hash literals + = -- | start of a block + Open String + | -- | separator between elements of a block + Semi IsVirtual + | -- | end of a block + Close + | -- | reserved tokens such as `{`, `(`, `type`, `of`, etc + Reserved String + | -- | text literals, `"foo bar"` + Textual String + | -- | character literals, `?X` + Character Char + | -- | a (non-infix) identifier. invariant: last segment is wordy + WordyId (HQ'.HashQualified Name) + | -- | an infix identifier. invariant: last segment is symboly + SymbolyId (HQ'.HashQualified Name) + | -- | numeric literals, left unparsed + Numeric String + | -- | bytes literals + Bytes Bytes.Bytes + | -- | hash literals + Hash ShortHash | Err Err - | Doc (Doc.UntitledSection (Doc.Tree (ReferenceType, HQ'.HashQualified Name) [Token Lexeme])) + | Doc (Doc.UntitledSection (Doc.Tree (Token (ReferenceType, HQ'.HashQualified Name)) [Token Lexeme])) deriving stock (Eq, Show, Ord) type IsVirtual = Bool -- is it a virtual semi or an actual semi? @@ -186,7 +202,7 @@ token'' tok p = do pops p = do env <- S.get let l = layout env - if top l == column p && topContainsVirtualSemis l + if column p == top l && topContainsVirtualSemis l then pure [Token (Semi True) p p] else if column p > top l || topHasClosePair l @@ -194,7 +210,9 @@ token'' tok p = do else if column p < top l then S.put (env {layout = pop l}) >> ((Token Close p p :) <$> pops p) - else error "impossible" + else -- we hit this branch exactly when `token''` is given the state + -- `{layout = [], opening = Nothing, inLayout = True}` + fail "internal error: token''" -- don't emit virtual semis in (, {, or [ blocks topContainsVirtualSemis :: Layout -> Bool @@ -277,7 +295,7 @@ lexer scope rem = (P.EndOfInput) -> "end of input" customErrs es = [Err <$> e | P.ErrorCustom e <- toList es] toPos (P.SourcePos _ line col) = Pos (P.unPos line) (P.unPos col) - env0 = ParsingEnv [] (Just scope) True + env0 = initialEnv scope -- | hacky postprocessing pass to do some cleanup of stuff that's annoying to -- fix without adding more state to the lexer: @@ -330,7 +348,6 @@ displayLexeme = \case Character c -> "?" <> [c] WordyId hq -> Text.unpack (HQ'.toTextWith Name.toText hq) SymbolyId hq -> Text.unpack (HQ'.toTextWith Name.toText hq) - Blank b -> b Numeric n -> n Bytes _b -> "bytes literal" Hash h -> Text.unpack (SH.toText h) @@ -355,7 +372,7 @@ doc2 = do (docTok, closeTok) <- local (\env -> env {inLayout = False}) do - body <- Doc.doc typeOrTerm lexemes' . P.lookAhead $ lit "}}" + body <- Doc.doc (tokenP typeOrTerm) lexemes' . P.lookAhead $ lit "}}" closeStart <- posP lit "}}" closeEnd <- posP @@ -383,12 +400,6 @@ doc2 = do isTopLevel = length (layout env0) + maybe 0 (const 1) (opening env0) == 1 _ -> docTok : endToks where - wordyKw kw = separated wordySep (lit kw) - typeOrAbility' = typeOrAbilityAlt (wordyKw . Text.unpack) - typeOrTerm = do - mtype <- P.optional $ typeOrAbility' <* CP.space - ident <- identifierP <* CP.space - pure (maybe RtTerm (const RtType) mtype, ident) subsequentTypeName = P.lookAhead . P.optional $ do let lit' s = lit s <* sp let modifier = typeModifiersAlt (lit' . Text.unpack) @@ -409,17 +420,28 @@ doc2 = do where ok s = length [() | '\n' <- s] < 2 +typeOrTerm :: (Monad m) => P.ParsecT (Token Err) String m (ReferenceType, HQ'.HashQualified Name) +typeOrTerm = do + mtype <- P.optional $ typeOrAbility' <* CP.space + ident <- identifierP <* CP.space + pure (maybe RtTerm (const RtType) mtype, ident) + +typeOrAbility' :: (Monad m) => P.ParsecT (Token Err) String m String +typeOrAbility' = typeOrAbilityAlt (wordyKw . Text.unpack) + where + wordyKw kw = separated wordySep (lit kw) + lexemes' :: P () -> P [Token Lexeme] lexemes' eof = - -- NB: `postLex` requires the token stream to start with an `Open`, otherwise it can’t create a `T`, so this adds one, - -- runs `postLex`, then removes it. + -- NB: `postLex` requires the token stream to start with an `Open`, otherwise it can’t create a `BlockTree`, so this + -- adds one, runs `postLex`, then removes it. fmap (tail . postLex . (Token (Open "fake") mempty mempty :)) $ - local (\env -> env {inLayout = True, opening = Just "DUMMY"}) do + local (const $ initialEnv "DUMMY") do p <- lexemes $ [] <$ eof -- deals with a final "unclosed" block at the end of `p`) unclosed <- takeWhile (("DUMMY" /=) . fst) . layout <$> S.get - let pos = end $ last p - pure $ p <> replicate (length unclosed) (Token Close pos pos) + finalPos <- posP + pure $ p <> replicate (length unclosed) (Token Close finalPos finalPos) -- | Consumes an entire Unison “module”. lexemes :: P [Token Lexeme] -> P [Token Lexeme] @@ -436,7 +458,6 @@ lexemes eof = <|> token numeric <|> token character <|> reserved - <|> token blank <|> token identifierLexemeP <|> (asum . map token) [semi, textual, hash] @@ -469,12 +490,6 @@ lexemes eof = t <- tok identifierLexemeP pure $ (fmap Reserved <$> typ) <> t - blank = - separated wordySep do - _ <- char '_' - seg <- P.optional wordyIdSegP - pure (Blank (maybe "" (Text.unpack . NameSegment.toUnescapedText) seg)) - semi = char ';' $> Semi False textual = Textual <$> quoted quoted = quotedRaw <|> quotedSingleLine @@ -532,7 +547,7 @@ lexemes eof = case Bytes.fromBase16 $ Bytes.fromWord8s (fromIntegral . ord <$> s) of Left _ -> err start (InvalidBytesLiteral $ "0xs" <> s) Right bs -> pure (Bytes bs) - otherbase = octal <|> hex + otherbase = octal <|> hex <|> binary octal = do start <- posP commitAfter2 sign (lit "0o") $ \sign _ -> @@ -541,6 +556,10 @@ lexemes eof = start <- posP commitAfter2 sign (lit "0x") $ \sign _ -> fmap (num sign) LP.hexadecimal <|> err start InvalidHexLiteral + binary = do + start <- posP + commitAfter2 sign (lit "0b") $ \sign _ -> + fmap (num sign) LP.binary <|> err start InvalidBinaryLiteral num :: Maybe String -> Integer -> Lexeme num sign n = Numeric (fromMaybe "" sign <> show n) @@ -573,6 +592,7 @@ lexemes eof = <|> symbolyKw "&&" <|> wordyKw "true" <|> wordyKw "false" + <|> wordyKw "namespace" <|> wordyKw "use" <|> wordyKw "forall" <|> wordyKw "∀" @@ -757,10 +777,6 @@ identifierLexeme name = then SymbolyId name else WordyId name -wordyIdSegP :: P.ParsecT (Token Err) String m NameSegment -wordyIdSegP = - PI.withParsecT (fmap (ReservedWordyId . Text.unpack)) NameSegment.wordyP - shortHashP :: P.ParsecT (Token Err) String m ShortHash shortHashP = PI.withParsecT (fmap (InvalidShortHash . Text.unpack)) ShortHash.shortHashP @@ -837,17 +853,36 @@ headToken (Block a _ _) = a headToken (Leaf a) = a instance (Show a) => Show (BlockTree a) where - show (Leaf a) = show a - show (Block open mid close) = - show open - ++ "\n" - ++ indent " " (intercalateMap "\n" (intercalateMap " " show) mid) - ++ "\n" - ++ maybe "" show close + showsPrec = showsPrec1 + +-- | This instance should be compatible with `Read`, but inserts newlines and indentation to make it more +-- /human/-readable. +instance Show1 BlockTree where + liftShowsPrec spa sla = shows "" where - indent by s = by ++ (s >>= go by) - go by '\n' = '\n' : by - go _ c = [c] + shows by prec = + showParen (prec > appPrec) . \case + Leaf a -> showString "Leaf " . showsNext spa "" a + Block open mid close -> + showString "Block " + . showsNext spa "" open + . showString "\n" + . showIndentedList (showIndentedList (\b -> showsIndented (shows b 0) b)) (" " <> by) mid + . showString "\n" + . showsNext (liftShowsPrec spa sla) (" " <> by) close + appPrec = 10 + showsNext :: (Int -> x -> ShowS) -> String -> x -> ShowS + showsNext fn = showsIndented (fn $ appPrec + 1) + showsIndented :: (x -> ShowS) -> String -> x -> ShowS + showsIndented fn by x = showString by . fn x + showIndentedList :: (String -> x -> ShowS) -> String -> [x] -> ShowS + showIndentedList fn by xs = + showString by + . showString "[" + . foldr (\x acc -> showString "\n" . fn (" " <> by) x . showString "," . acc) id xs + . showString "\n" + . showString by + . showString "]" reorderTree :: ([[BlockTree a]] -> [[BlockTree a]]) -> BlockTree a -> BlockTree a reorderTree f (Block open mid close) = Block open (f (fmap (reorderTree f) <$> mid)) close @@ -878,17 +913,19 @@ stanzas = ) ([] :| []) --- Moves type and ability declarations to the front of the token stream --- and move `use` statements to the front of each block +-- Moves type and ability declarations to the front of the token stream (but not before the leading optional namespace +-- directive) and move `use` statements to the front of each block reorder :: [[BlockTree (Token Lexeme)]] -> [[BlockTree (Token Lexeme)]] reorder = foldr fixup [] . sortWith f where - f [] = 3 :: Int + f [] = 4 :: Int f (t0 : _) = case payload $ headToken t0 of - Open mod | Set.member (Text.pack mod) typeModifiers -> 1 - Open typOrA | Set.member (Text.pack typOrA) typeOrAbility -> 1 - Reserved "use" -> 0 - _ -> 3 :: Int + Open mod | Set.member (Text.pack mod) typeModifiers -> 3 + Open typOrA | Set.member (Text.pack typOrA) typeOrAbility -> 3 + -- put `namespace` before `use` because the file parser only accepts a namespace directive at the top of the file + Reserved "namespace" -> 1 + Reserved "use" -> 2 + _ -> 4 :: Int -- after reordering can end up with trailing semicolon at the end of -- a block, which we remove with this pass fixup stanza [] = case Lens.unsnoc stanza of @@ -990,7 +1027,6 @@ instance P.VisualStream [Token Lexeme] where Nothing -> '?' : [c] pretty (WordyId n) = Text.unpack (HQ'.toText n) pretty (SymbolyId n) = Text.unpack (HQ'.toText n) - pretty (Blank s) = "_" ++ s pretty (Numeric n) = n pretty (Hash sh) = show sh pretty (Err e) = show e diff --git a/unison-syntax/src/Unison/Syntax/Parser.hs b/unison-syntax/src/Unison/Syntax/Parser.hs index 6c4aa74b95..30126c7d8b 100644 --- a/unison-syntax/src/Unison/Syntax/Parser.hs +++ b/unison-syntax/src/Unison/Syntax/Parser.hs @@ -9,12 +9,13 @@ module Unison.Syntax.Parser Input (..), P, ParsingEnv (..), - UniqueName, + UniqueName (..), anyToken, blank, bytesToken, chainl1, chainr1, + chainl1Accum, character, closeBlock, optionalCloseBlock, @@ -75,12 +76,13 @@ import Text.Megaparsec qualified as P import U.Codebase.Reference (ReferenceType (..)) import U.Util.Base32Hex qualified as Base32Hex import Unison.ABT qualified as ABT -import Unison.ConstructorReference (ConstructorReference) import Unison.Hash qualified as Hash import Unison.HashQualified qualified as HQ import Unison.HashQualifiedPrime qualified as HQ' import Unison.Hashable qualified as Hashable import Unison.Name as Name +import Unison.NameSegment (NameSegment) +import Unison.NameSegment qualified as NameSegment import Unison.Names (Names) import Unison.Names.ResolutionResult qualified as Names import Unison.Parser.Ann (Ann (..), Annotated (..)) @@ -90,7 +92,7 @@ import Unison.Prelude import Unison.Reference (Reference) import Unison.Referent (Referent) import Unison.Syntax.Lexer.Unison qualified as L -import Unison.Syntax.Name qualified as Name (toVar, unsafeParseText) +import Unison.Syntax.Name qualified as Name (toVar) import Unison.Syntax.Parser.Doc qualified as Doc import Unison.Syntax.Parser.Doc.Data qualified as Doc import Unison.Term (MatchCase (..)) @@ -115,7 +117,33 @@ data ParsingEnv (m :: Type -> Type) = ParsingEnv -- The name (e.g. `Foo` in `unique type Foo`) is passed in, and if the function returns a Just, that GUID is used; -- otherwise, a random one is generated from `uniqueNames`. uniqueTypeGuid :: Name -> m (Maybe Text), - names :: Names + names :: Names, + -- The namespace block we are currently parsing under, and the file-bound namespace-prefixed type and constructor + -- names in scope (we've already parsed all type declarations by the time we need this, in the term parser). + -- + -- Ideally these ought to have no affect on parsing: "applying" a namespace should be a pre-processing pass. All + -- bindings are prefixed with the namespace (easy), and all free variables that match a binding are prefixed (also + -- easy). + -- + -- ... but our "parser" is also doing parse-time name resolution for hash-qualified names, type references, + -- constructors in patterns, and term/type links. + -- + -- For constructors in patterns, when parsing a pattern `Foo.Bar` in a namespace `baz`, if `baz.Foo.Bar` is among + -- the file-bound namespace-prefixed constructor names in scope, then resolve to that constructor. Otherwise, + -- proceed as normal to look for `Foo.Bar` in the names environment. + -- + -- For type links, similar deal: we (only because we parse and hash all types before terms) could conceivably + -- properly handle code like + -- + -- namespace foo + -- type Bar = ... + -- baz = ... typeLink Bar ... + -- + -- And for term links we are certainly out of luck: we can't look up a resolved file-bound term by hash *during + -- parsing*. That's an issue with term links in general, unrelated to namespaces, but perhaps complicated by + -- namespaces nonetheless. + maybeNamespace :: Maybe Name, + localNamespacePrefixedTypesAndConstructors :: Names } newtype UniqueName = UniqueName (L.Pos -> Int -> Maybe Text) @@ -156,14 +184,10 @@ data Error v = SignatureNeedsAccompanyingBody (L.Token v) | DisallowedAbsoluteName (L.Token Name) | EmptyBlock (L.Token String) - | UnknownAbilityConstructor (L.Token (HQ.HashQualified Name)) (Set ConstructorReference) - | UnknownDataConstructor (L.Token (HQ.HashQualified Name)) (Set ConstructorReference) | UnknownTerm (L.Token (HQ.HashQualified Name)) (Set Referent) | UnknownType (L.Token (HQ.HashQualified Name)) (Set Reference) | UnknownId (L.Token (HQ.HashQualified Name)) (Set Referent) (Set Reference) | ExpectedBlockOpen String (L.Token L.Lexeme) - | -- | Indicates a cases or match/with which doesn't have any patterns - EmptyMatch (L.Token ()) | EmptyWatch Ann | UseInvalidPrefixSuffix (Either (L.Token Name) (L.Token Name)) (Maybe [L.Token Name]) | UseEmpty (L.Token String) -- an empty `use` statement @@ -173,7 +197,7 @@ data Error v MissingTypeModifier (L.Token String) (L.Token v) | -- | A type was found in a position that requires a term TypeNotAllowed (L.Token (HQ.HashQualified Name)) - | ResolutionFailures [Names.ResolutionFailure v Ann] + | ResolutionFailures [Names.ResolutionFailure Ann] | DuplicateTypeNames [(v, [Ann])] | DuplicateTermNames [(v, [Ann])] | -- | PatternArityMismatch expectedArity actualArity location @@ -279,9 +303,19 @@ closeBlock = void <$> matchToken L.Close optionalCloseBlock :: (Ord v) => P v m (L.Token ()) optionalCloseBlock = closeBlock <|> (\() -> L.Token () mempty mempty) <$> P.eof +-- | A `Name` is blank when it is unqualified and begins with a `_` (also implying that it is wordy) +isBlank :: Name -> Bool +isBlank n = isUnqualified n && Text.isPrefixOf "_" (NameSegment.toUnescapedText $ lastSegment n) + +-- | A HQ Name is blank when its Name is blank and it has no hash. +isBlank' :: HQ'.HashQualified Name -> Bool +isBlank' = \case + HQ'.NameOnly n -> isBlank n + HQ'.HashQualified _ _ -> False + wordyPatternName :: (Var v) => P v m (L.Token v) wordyPatternName = queryToken \case - L.WordyId (HQ'.NameOnly n) -> Just $ Name.toVar n + L.WordyId (HQ'.NameOnly n) -> if isBlank n then Nothing else Just $ Name.toVar n _ -> Nothing -- | Parse a prefix identifier e.g. Foo or (+), discarding any hash @@ -296,7 +330,6 @@ prefixTermName = wordyTermName <|> parenthesize symbolyTermName where wordyTermName = queryToken \case L.WordyId (HQ'.NameOnly n) -> Just $ Name.toVar n - L.Blank s -> Just $ Var.nameds ("_" <> s) _ -> Nothing symbolyTermName = queryToken \case L.SymbolyId (HQ'.NameOnly n) -> Just $ Name.toVar n @@ -304,16 +337,14 @@ prefixTermName = wordyTermName <|> parenthesize symbolyTermName -- | Parse a wordy identifier e.g. Foo, discarding any hash wordyDefinitionName :: (Var v) => P v m (L.Token v) -wordyDefinitionName = queryToken $ \case +wordyDefinitionName = queryToken \case L.WordyId n -> Just $ Name.toVar (HQ'.toName n) - L.Blank s -> Just $ Var.nameds ("_" <> s) _ -> Nothing -- | Parse a wordyId as a Name, rejecting any hash importWordyId :: (Ord v) => P v m (L.Token Name) importWordyId = queryToken \case L.WordyId (HQ'.NameOnly n) -> Just n - L.Blank s | not (null s) -> Just $ Name.unsafeParseText (Text.pack ("_" <> s)) _ -> Nothing -- | The `+` in: use Foo.bar + as a Name @@ -348,7 +379,6 @@ hqWordyId_ :: (Ord v) => P v m (L.Token (HQ.HashQualified Name)) hqWordyId_ = queryToken \case L.WordyId n -> Just $ HQ'.toHQ n L.Hash h -> Just $ HQ.HashOnly h - L.Blank s | not (null s) -> Just $ HQ.NameOnly (Name.unsafeParseText (Text.pack ("_" <> s))) _ -> Nothing -- | Parse a hash-qualified symboly ID like >>=#foo or && @@ -365,10 +395,10 @@ reserved w = label w $ queryToken getReserved getReserved _ = Nothing -- | Parse a placeholder or typed hole -blank :: (Ord v) => P v m (L.Token String) +blank :: (Ord v) => P v m (L.Token NameSegment) blank = label "blank" $ queryToken getBlank where - getBlank (L.Blank s) = Just ('_' : s) + getBlank (L.WordyId n) = if isBlank' n then Just (Name.lastSegment $ HQ'.toName n) else Nothing getBlank _ = Nothing numeric :: (Ord v) => P v m (L.Token String) @@ -405,7 +435,8 @@ string = queryToken getString getString _ = Nothing doc :: - (Ord v) => P v m (L.Token (Doc.UntitledSection (Doc.Tree (ReferenceType, HQ'.HashQualified Name) [L.Token L.Lexeme]))) + (Ord v) => + P v m (L.Token (Doc.UntitledSection (Doc.Tree (L.Token (ReferenceType, HQ'.HashQualified Name)) [L.Token L.Lexeme]))) doc = queryToken \case L.Doc d -> pure d _ -> Nothing @@ -444,6 +475,27 @@ chainr1 p op = go1 chainl1 :: (Ord v) => P v m a -> P v m (a -> a -> a) -> P v m a chainl1 p op = foldl (flip ($)) <$> p <*> P.many (flip <$> op <*> p) +-- chainl1Accum is like chainl1, but it accumulates intermediate results +-- instead of applying them immediately. It's used to implement infix +-- operators that may or may not have precedence rules. +chainl1Accum :: + (P.Stream u, Ord s) => + P.ParsecT s u m a -> + P.ParsecT s u m (a -> a -> a) -> + P.ParsecT s u m (a, [a -> a]) +chainl1Accum p op = do + x <- p + fs <- rest [] + pure (x, fs) + where + rest fs = + ( do + f <- op + y <- p + rest (fs ++ [flip f y]) + ) + <|> return fs + -- | If `p` would succeed, this fails uncommitted. -- Otherwise, `failIfOk` used to produce the output failureIf :: (Ord v) => P v m (P v m b) -> P v m a -> P v m b diff --git a/unison-syntax/src/Unison/Syntax/Parser/Doc.hs b/unison-syntax/src/Unison/Syntax/Parser/Doc.hs index 1a03665493..715666866f 100644 --- a/unison-syntax/src/Unison/Syntax/Parser/Doc.hs +++ b/unison-syntax/src/Unison/Syntax/Parser/Doc.hs @@ -10,6 +10,7 @@ -- Each of those parsers is expected to satisfy @(`Ord` e, `P.MonadParsec` e `String` m)@. module Unison.Syntax.Parser.Doc ( Tree, + Leaves, initialEnv, doc, untitledSection, @@ -35,18 +36,13 @@ module Unison.Syntax.Parser.Doc italic, strikethrough, verbatim, - source, - foldedSource, - evalInline, - signatures, - signatureInline, + keyedInline, group, word, -- * other components column', embedLink, - embedSignatureLink, join, ) where @@ -56,19 +52,22 @@ import Control.Monad.Reader qualified as R import Data.Char (isControl, isSpace) import Data.List qualified as List import Data.List.Extra qualified as List -import Data.List.NonEmpty (NonEmpty ((:|))) +import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty) import Data.List.NonEmpty qualified as NonEmpty import Text.Megaparsec qualified as P -import Text.Megaparsec.Char (char) +import Text.Megaparsec.Char (char, letterChar) import Text.Megaparsec.Char qualified as CP import Text.Megaparsec.Char.Lexer qualified as LP -import Unison.Parser.Ann (Ann, Annotated (..)) -import Unison.Prelude hiding (join) +import Unison.Parser.Ann (Ann (Ann)) +import Unison.Prelude hiding (Word, join) import Unison.Syntax.Lexer (column, line, lit, sepBy1', some', someTill', (<+>)) import Unison.Syntax.Lexer.Token (Token (Token), posP, tokenP) import Unison.Syntax.Parser.Doc.Data +import Prelude hiding (Word) -type Tree ident code = Cofree (Top ident code) Ann +type Leaves ident code = Cofree (Leaf ident code) Ann + +type Tree ident code = Cofree (Top code (Leaves ident code)) Ann data ParsingEnv = ParsingEnv { -- | Use a stack to remember the parent section and allow docSections within docSections. @@ -83,12 +82,12 @@ initialEnv :: ParsingEnv initialEnv = ParsingEnv [0] 0 doc :: - (Ord e, P.MonadParsec e String m, Annotated code) => + (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m end -> m (UntitledSection (Tree ident code)) -doc ident code = flip R.runReaderT initialEnv . untitledSection . sectionElem ident code . void +doc ident code = flip R.runReaderT initialEnv . untitledSection . wrap . sectionElem ident code . void -- | This is the actual `Doc` lexer. Unlike `doc2`, it doesn’t do any Unison-side lexing (i.e., it doesn’t know that -- Unison wraps `Doc` literals in `}}`). @@ -96,28 +95,27 @@ untitledSection :: (P.MonadParsec e String m) => m a -> m (UntitledSection a) untitledSection a = UntitledSection <$> P.many (a <* CP.space) sectionElem :: - (Ord e, P.MonadParsec e String m, Annotated code) => + (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m () -> - R.ReaderT ParsingEnv m (Tree ident code) + R.ReaderT ParsingEnv m (Top code (Leaves ident code) (Tree ident code)) sectionElem ident code docClose = - fmap wrap' $ - section ident code docClose - <|> lift (P.label "block eval (syntax: a fenced code block)" (eval code <|> exampleBlock code <|> codeBlock)) - <|> list ident code docClose - <|> lift (paragraph ident code docClose) + section ident code docClose + <|> lift (P.label "block eval (syntax: a fenced code block)" (eval code <|> exampleBlock code <|> codeBlock)) + <|> fmap List' (list ident code docClose) + <|> lift (Paragraph' <$> paragraph ident code docClose) paragraph :: - (Ord e, P.MonadParsec e String m, Annotated code) => + (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m () -> - m (Top ident code (Tree ident code)) + m (Paragraph (Leaves ident code)) paragraph ident code docClose = fmap Paragraph . spaced docClose $ leafy ident code docClose -word :: (Ord e, P.MonadParsec e String m) => m end -> m (Leaf ident code void) -word closing = fmap Word . tokenP . P.try $ do +word :: (Ord e, P.MonadParsec e String m) => m end -> m Word +word closing = fmap Word . P.try $ do let end = P.lookAhead $ void (P.satisfy isSpace) <|> void closing word <- P.manyTill (P.satisfy (\ch -> not (isSpace ch))) end guard (not $ reserved word || null word) @@ -126,59 +124,51 @@ word closing = fmap Word . tokenP . P.try $ do reserved word = List.isPrefixOf "}}" word || all (== '#') word leaf :: - (Ord e, P.MonadParsec e String m, Annotated code) => + (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m () -> - m (Leaf ident code (Tree ident code)) + m (Leaf ident code (Leaves ident code)) leaf ident code closing = link ident <|> namedLink ident code closing <|> example code - <|> transclude code + <|> (Transclude' <$> transclude code) <|> bold ident code closing <|> italic ident code closing <|> strikethrough ident code closing <|> verbatim - <|> source ident code - <|> foldedSource ident code - <|> evalInline code - <|> signatures ident - <|> signatureInline ident - <|> word closing + <|> keyedInline ident code + <|> (Word' <$> word closing) leafy :: - (Ord e, P.MonadParsec e String m, Annotated code) => + (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m () -> - m (Leaf ident code (Tree ident code)) + m (Leaves ident code) leafy ident code closing = do - p <- leaf ident code closing + p <- wrap $ leaf ident code closing after <- P.optional . P.try $ leafy ident code closing case after of Nothing -> pure p - Just after -> group . pure $ p :| pure after + Just after -> wrap . fmap Group' . group . pure $ p :| pure after comma :: (P.MonadParsec e String m) => m String comma = lit "," <* CP.space -source :: (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m (Leaf ident code a) -source ident = fmap Source . (lit "@source" *>) . sourceElements ident - -foldedSource :: (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m (Leaf ident code a) -foldedSource ident = fmap FoldedSource . (lit "@foldedSource" *>) . sourceElements ident - -sourceElements :: - (Ord e, P.MonadParsec e String m) => - m ident -> - (m () -> m code) -> - m (NonEmpty (SourceElement ident (Leaf ident code Void))) -sourceElements ident code = do - _ <- (lit " {" <|> lit "{") *> CP.space - s <- sepBy1' srcElem comma - _ <- lit "}" - pure s +-- | A syntactic pattern of “@keyword{…}”, where we process the contents differently depending on the keyword provided. +keyedInline :: (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m (Leaf ident code a) +keyedInline ident code = P.try do + keyword <- lit "@" *> P.many letterChar <* (lit " {" <|> lit "{") + case keyword of + "source" -> Source <$> sepBy1' srcElem comma <* lit "}" + "foldedSource" -> FoldedSource <$> sepBy1' srcElem comma <* lit "}" + "eval" -> fmap EvalInline . code . void $ lit "}" + "signature" -> Signature <$> sepBy1' (embedSignatureLink ident) comma <* lit "}" + "signatures" -> Signature <$> sepBy1' (embedSignatureLink ident) comma <* lit "}" + "inlineSignature" -> SignatureInline <$> embedSignatureLink ident <* lit "}" + keyword -> P.unexpected . maybe (P.Label $ '@' :| "keyword{...}") P.Tokens $ nonEmpty keyword where srcElem = SourceElement @@ -187,36 +177,13 @@ sourceElements ident code = do (lit "@") *> (CP.space *> annotations) ) where - annotation = fmap Left (tokenP ident) <|> fmap Right (transclude code) <* CP.space + annotation = fmap Left ident <|> fmap Right (transclude code) <* CP.space annotations = P.some (EmbedAnnotation <$> annotation) - -signatures :: (Ord e, P.MonadParsec e String m) => m ident -> m (Leaf ident code a) -signatures ident = fmap Signature $ do - _ <- (lit "@signatures" <|> lit "@signature") *> (lit " {" <|> lit "{") *> CP.space - s <- sepBy1' (embedSignatureLink ident) comma - _ <- lit "}" - pure s - -signatureInline :: (Ord e, P.MonadParsec e String m) => m ident -> m (Leaf ident code a) -signatureInline ident = fmap SignatureInline $ do - _ <- lit "@inlineSignature" *> (lit " {" <|> lit "{") *> CP.space - s <- embedSignatureLink ident - _ <- lit "}" - pure s - -evalInline :: (P.MonadParsec e String m) => (m () -> m code) -> m (Leaf ident code a) -evalInline code = fmap EvalInline $ do - _ <- lit "@eval" *> (lit " {" <|> lit "{") *> CP.space - let inlineEvalClose = void $ lit "}" - s <- code inlineEvalClose - pure s + embedSignatureLink ident = EmbedSignatureLink <$> ident <* CP.space -- | Not an actual node, but this pattern is referenced in multiple places embedLink :: (Ord e, P.MonadParsec e s m, P.TraversableStream s) => m ident -> m (EmbedLink ident) -embedLink = fmap EmbedLink . tokenP - -embedSignatureLink :: (Ord e, P.MonadParsec e String m) => m ident -> m (EmbedSignatureLink ident) -embedSignatureLink ident = EmbedSignatureLink <$> tokenP ident <* CP.space +embedLink = fmap EmbedLink verbatim :: (Ord e, P.MonadParsec e String m) => m (Leaf ident code a) verbatim = @@ -235,8 +202,8 @@ verbatim = txt = trimIndentFromVerbatimBlock (column start - 1) trimmed in -- If it's a multi-line verbatim block we trim any whitespace representing -- indentation from the pretty-printer. See 'trimIndentFromVerbatimBlock' - Verbatim . Word $ Token txt start stop - else Code . Word $ Token originalText start stop + Verbatim . Word $ txt + else Code . Word $ originalText example :: (P.MonadParsec e String m) => (m () -> m code) -> m (Leaf ident code void) example code = @@ -251,7 +218,7 @@ example code = link :: (Ord e, P.MonadParsec e String m) => m ident -> m (Leaf ident code a) link ident = P.label "link (examples: {type List}, {Nat.+})" $ Link <$> P.try (lit "{" *> embedLink ident <* lit "}") -transclude :: (P.MonadParsec e String m) => (m () -> m code) -> m (Leaf ident code a) +transclude :: (P.MonadParsec e String m) => (m () -> m code) -> m (Transclude code) transclude code = fmap Transclude . P.label "transclusion (examples: {{ doc2 }}, {{ sepBy s [doc1, doc2] }})" $ lit "{{" *> code (void $ lit "}}") @@ -261,7 +228,8 @@ nonNewlineSpaces = P.takeWhileP Nothing nonNewlineSpace where nonNewlineSpace ch = isSpace ch && ch /= '\n' && ch /= '\r' -eval :: (P.MonadParsec e String m, Annotated code) => (m () -> m code) -> m (Top ident code (Tree ident code)) +eval :: + (P.MonadParsec e String m) => (m () -> m code) -> m (Top code (Leaves ident code) (Tree ident code)) eval code = Eval <$> do -- commit after seeing that ``` is on its own line @@ -271,7 +239,7 @@ eval code = fence <$ guard b CP.space *> code (void $ lit fence) -exampleBlock :: (P.MonadParsec e String m, Annotated code) => (m () -> m code) -> m (Top ident code (Tree ident code)) +exampleBlock :: (P.MonadParsec e String m) => (m () -> m code) -> m (Top code (Leaves ident code) (Tree ident code)) exampleBlock code = ExampleBlock <$> do @@ -279,20 +247,14 @@ exampleBlock code = fence <- lit "```" <+> P.takeWhileP Nothing (== '`') code . void $ lit fence -codeBlock :: (Ord e, P.MonadParsec e String m) => m (Top ident code (Tree ident code)) +codeBlock :: (Ord e, P.MonadParsec e String m) => m (Top code (Leaves ident code) (Tree ident code)) codeBlock = do column <- (\x -> x - 1) . toInteger . P.unPos <$> LP.indentLevel let tabWidth = toInteger . P.unPos $ P.defaultTabWidth fence <- lit "```" <+> P.takeWhileP Nothing (== '`') - name <- - nonNewlineSpaces - *> tokenP (P.takeWhile1P Nothing (not . isSpace)) - <* nonNewlineSpaces + name <- nonNewlineSpaces *> P.takeWhile1P Nothing (not . isSpace) <* nonNewlineSpaces _ <- void CP.eol - verbatim <- - tokenP $ - uncolumn column tabWidth . trimAroundDelimiters - <$> P.someTill P.anySingle ([] <$ lit fence) + verbatim <- uncolumn column tabWidth . trimAroundDelimiters <$> P.someTill P.anySingle ([] <$ lit fence) pure $ CodeBlock name verbatim where uncolumn column tabWidth s = @@ -306,19 +268,19 @@ codeBlock = do in List.intercalate "\n" $ skip column <$> lines s emphasis :: - (Ord e, P.MonadParsec e String m, Annotated code) => + (Ord e, P.MonadParsec e String m) => Char -> m ident -> (m () -> m code) -> m () -> - m (Tree ident code) + m (Paragraph (Leaves ident code)) emphasis delimiter ident code closing = do let start = some (P.satisfy (== delimiter)) end <- P.try $ do end <- start P.lookAhead (P.satisfy (not . isSpace)) pure end - wrap' . Paragraph + Paragraph <$> someTill' (leafy ident code (closing <|> (void $ lit end)) <* void whitespaceWithoutParagraphBreak) (lit end) @@ -331,44 +293,44 @@ emphasis delimiter ident code closing = do Nothing -> pure () bold :: - (Ord e, P.MonadParsec e String m, Annotated code) => + (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m () -> - m (Leaf ident code (Tree ident code)) + m (Leaf ident code (Leaves ident code)) bold ident code = fmap Bold . emphasis '*' ident code italic :: - (Ord e, P.MonadParsec e String m, Annotated code) => + (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m () -> - m (Leaf ident code (Tree ident code)) + m (Leaf ident code (Leaves ident code)) italic ident code = fmap Italic . emphasis '_' ident code strikethrough :: - (Ord e, P.MonadParsec e String m, Annotated code) => + (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m () -> - m (Leaf ident code (Tree ident code)) + m (Leaf ident code (Leaves ident code)) strikethrough ident code = fmap Strikethrough . emphasis '~' ident code namedLink :: - (Ord e, P.MonadParsec e String m, Annotated code) => + (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m () -> - m (Leaf ident code (Tree ident code)) + m (Leaf ident code (Leaves ident code)) namedLink ident code docClose = P.label "hyperlink (example: [link name](https://destination.com))" do _ <- lit "[" p <- spaced docClose . leafy ident code . void $ char ']' _ <- lit "]" _ <- lit "(" - target <- group $ fmap pure (link ident) <|> some' (transclude code <|> word (docClose <|> void (char ')'))) + target <- group $ fmap pure (wrap $ link ident) <|> some' (wrap (Transclude' <$> transclude code) <|> wrap (Word' <$> word (docClose <|> void (char ')')))) _ <- lit ")" - pure $ NamedLink (wrap' $ Paragraph p) target + pure $ NamedLink (Paragraph p) target sp :: (P.MonadParsec e String m) => m () -> m String sp docClose = P.try $ do @@ -386,11 +348,11 @@ spaced docClose p = some' $ p <* P.optional (sp docClose) -- | Not an actual node, but this pattern is referenced in multiple places list :: - (Ord e, P.MonadParsec e String m, Annotated code) => + (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m () -> - R.ReaderT ParsingEnv m (Top ident code (Tree ident code)) + R.ReaderT ParsingEnv m (List (Leaves ident code)) list ident code docClose = bulletedList ident code docClose <|> numberedList ident code docClose listSep :: (Ord e, R.MonadReader ParsingEnv m, P.MonadParsec e String m) => m () @@ -412,16 +374,16 @@ listItemStart gutter = P.try do guard (col > parentCol) (col,) <$> gutter -numberedStart :: (Ord e, R.MonadReader ParsingEnv m, P.MonadParsec e String m) => m (Int, Token Word64) -numberedStart = listItemStart $ P.try (tokenP $ LP.decimal <* lit ".") +numberedStart :: (Ord e, R.MonadReader ParsingEnv m, P.MonadParsec e String m) => m (Int, Word64) +numberedStart = listItemStart . P.try $ LP.decimal <* lit "." -- | FIXME: This should take a @`P` a@ numberedList :: - (Ord e, P.MonadParsec e String m, Annotated code) => + (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m () -> - R.ReaderT ParsingEnv m (Top ident code (Tree ident code)) + R.ReaderT ParsingEnv m (List (Leaves ident code)) numberedList ident code docClose = NumberedList <$> sepBy1' numberedItem listSep where numberedItem = P.label "numbered list (examples: 1. item1, 8. start numbering at '8')" do @@ -430,11 +392,11 @@ numberedList ident code docClose = NumberedList <$> sepBy1' numberedItem listSep -- | FIXME: This should take a @`P` a@ bulletedList :: - (Ord e, P.MonadParsec e String m, Annotated code) => + (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m () -> - R.ReaderT ParsingEnv m (Top ident code (Tree ident code)) + R.ReaderT ParsingEnv m (List (Leaves ident code)) bulletedList ident code docClose = BulletedList <$> sepBy1' bullet listSep where bullet = P.label "bullet (examples: * item1, - item2)" do @@ -442,16 +404,16 @@ bulletedList ident code docClose = BulletedList <$> sepBy1' bullet listSep column' ident code docClose col column' :: - (Ord e, P.MonadParsec e String m, Annotated code) => + (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m () -> Int -> - R.ReaderT ParsingEnv m (Column (Tree ident code)) + R.ReaderT ParsingEnv m (Column (Leaves ident code)) column' ident code docClose col = - Column . wrap' + Column <$> (nonNewlineSpaces *> listItemParagraph) - <*> R.local (\e -> e {parentListColumn = col}) (P.optional $ listSep *> fmap wrap' (list ident code docClose)) + <*> R.local (\e -> e {parentListColumn = col}) (P.optional $ listSep *> list ident code docClose) where listItemParagraph = Paragraph <$> do @@ -493,11 +455,11 @@ newline = P.label "newline" $ lit "\n" <|> lit "\r\n" -- > -- > # A section title (not a subsection) section :: - (Ord e, P.MonadParsec e String m, Annotated code) => + (Ord e, P.MonadParsec e String m) => m ident -> (m () -> m code) -> m () -> - R.ReaderT ParsingEnv m (Top ident code (Tree ident code)) + R.ReaderT ParsingEnv m (Top code (Leaves ident code) (Tree ident code)) section ident code docClose = do ns <- R.asks parentSections hashes <- lift $ P.try $ lit (replicate (head ns) '#') *> P.takeWhile1P Nothing (== '#') <* sp docClose @@ -505,11 +467,11 @@ section ident code docClose = do let m = length hashes + head ns body <- R.local (\env -> env {parentSections = m : tail ns}) $ - P.many (sectionElem ident code docClose <* CP.space) - pure $ Section (wrap' title) body + P.many (wrap (sectionElem ident code docClose) <* CP.space) + pure $ Section title body -- | FIXME: This should just take a @`P` code@ and @`P` a@. -group :: (P.MonadParsec e s m) => m (NonEmpty (Leaf ident code a)) -> m (Leaf ident code a) +group :: (P.MonadParsec e s m) => m (NonEmpty (Leaves ident code)) -> m (Group (Leaves ident code)) group = fmap Group . join -- | FIXME: This should just take a @`P` a@ @@ -518,8 +480,12 @@ join = fmap Join -- * utility functions -wrap' :: (Annotated code) => Top ident code (Tree ident code) -> Tree ident code -wrap' doc = ann doc :< doc +wrap :: (Ord e, P.MonadParsec e s m, P.TraversableStream s) => m (f (Cofree f Ann)) -> m (Cofree f Ann) +wrap p = do + start <- posP + val <- p + end <- posP + pure (Ann start end :< val) -- | If it's a multi-line verbatim block we trim any whitespace representing -- indentation from the pretty-printer. diff --git a/unison-syntax/src/Unison/Syntax/Parser/Doc/Data.hs b/unison-syntax/src/Unison/Syntax/Parser/Doc/Data.hs index 75bc3a621e..fbc1e042b0 100644 --- a/unison-syntax/src/Unison/Syntax/Parser/Doc/Data.hs +++ b/unison-syntax/src/Unison/Syntax/Parser/Doc/Data.hs @@ -13,150 +13,140 @@ -- line. module Unison.Syntax.Parser.Doc.Data where +import Data.Bifoldable (Bifoldable, bifoldr) +import Data.Bitraversable (Bitraversable, bitraverse) import Data.Eq.Deriving (deriveEq1, deriveEq2) +import Data.Functor.Classes (Eq1 (..), Ord1 (..), Show1 (..)) import Data.List.NonEmpty (NonEmpty) import Data.Ord.Deriving (deriveOrd1, deriveOrd2) import Text.Show.Deriving (deriveShow1, deriveShow2) -import Unison.Parser.Ann (Annotated (..)) -import Unison.Prelude -import Unison.Syntax.Lexer.Token (Token (..)) +import Unison.Prelude hiding (Word) +import Prelude hiding (Word) newtype UntitledSection a = UntitledSection [a] deriving (Eq, Ord, Show, Foldable, Functor, Traversable) -data Top ident code a - = -- | The first argument is always a `Paragraph` - Section a [a] - | Eval code - | ExampleBlock code - | CodeBlock (Token String) (Token String) - | BulletedList (NonEmpty (Column a)) - | NumberedList (NonEmpty (Token Word64, Column a)) - | Paragraph (NonEmpty (Leaf ident code a)) +newtype Paragraph a = Paragraph (NonEmpty a) + deriving (Eq, Ord, Show, Foldable, Functor, Traversable) + +$(deriveEq1 ''Paragraph) +$(deriveOrd1 ''Paragraph) +$(deriveShow1 ''Paragraph) + +data List a + = BulletedList (NonEmpty (Column a)) + | NumberedList (NonEmpty (Word64, Column a)) deriving (Eq, Ord, Show, Foldable, Functor, Traversable) +instance Eq1 List where + liftEq eqA = curry \case + (BulletedList as, BulletedList as') -> liftEq (liftEq eqA) as as' + (NumberedList as, NumberedList as') -> liftEq (liftEq (liftEq eqA)) as as' + (_, _) -> False + +instance Ord1 List where + liftCompare compareA = curry \case + (BulletedList as, BulletedList as') -> liftCompare (liftCompare compareA) as as' + (NumberedList as, NumberedList as') -> liftCompare (liftCompare (liftCompare compareA)) as as' + (BulletedList _, NumberedList _) -> LT + (NumberedList _, BulletedList _) -> GT + +instance Show1 List where + liftShowsPrec showsPrecA showListA prec = + showParen (prec <= 11) . \case + BulletedList as -> + showString "BulletedList " + . liftShowsPrec (liftShowsPrec showsPrecA showListA) (liftShowList showsPrecA showListA) 11 as + NumberedList as -> + showString "NumberedList " + . liftShowsPrec + (liftShowsPrec (liftShowsPrec showsPrecA showListA) (liftShowList showsPrecA showListA)) + (liftShowList (liftShowsPrec showsPrecA showListA) (liftShowList showsPrecA showListA)) + 11 + as + data Column a - = -- | The first is always a `Paragraph`, and the second a `BulletedList` or `NumberedList` - Column a (Maybe a) + = Column (Paragraph a) (Maybe (List a)) deriving (Eq, Ord, Show, Foldable, Functor, Traversable) -data Leaf ident code a - = Link (EmbedLink ident) - | -- | first is a Paragraph, second is always a Group (which contains either a single Term/Type link or list of - -- `Transclude`s & `Word`s) - NamedLink a (Leaf ident code Void) - | Example code - | Transclude code - | -- | Always a Paragraph - Bold a - | -- | Always a Paragraph - Italic a - | -- | Always a Paragraph - Strikethrough a - | -- | Always a Word - Verbatim (Leaf ident Void Void) - | -- | Always a Word - Code (Leaf ident Void Void) - | -- | Always a Transclude - Source (NonEmpty (SourceElement ident (Leaf ident code Void))) - | -- | Always a Transclude - FoldedSource (NonEmpty (SourceElement ident (Leaf ident code Void))) - | EvalInline code - | Signature (NonEmpty (EmbedSignatureLink ident)) - | SignatureInline (EmbedSignatureLink ident) - | Word (Token String) - | Group (Join (Leaf ident code a)) +instance Eq1 Column where + liftEq eqA (Column para mlist) (Column para' mlist') = + liftEq eqA para para' && liftEq (liftEq eqA) mlist mlist' + +instance Ord1 Column where + liftCompare compareA (Column para mlist) (Column para' mlist') = + liftCompare compareA para para' <> liftCompare (liftCompare compareA) mlist mlist' + +instance Show1 Column where + liftShowsPrec showsPrecA showListA prec (Column para mlist) = + showParen (prec <= 11) $ + showString "Column " + . liftShowsPrec showsPrecA showListA 11 para + . liftShowsPrec (liftShowsPrec showsPrecA showListA) (liftShowList showsPrecA showListA) 11 mlist + +data Top code leaf a + = Section (Paragraph leaf) [a] + | Eval code + | ExampleBlock code + | CodeBlock String String + | List' (List leaf) + | Paragraph' (Paragraph leaf) deriving (Eq, Ord, Show, Foldable, Functor, Traversable) -instance Bifunctor (Leaf ident) where +instance Bifoldable (Top code) where + bifoldr f g z = \case + Section para as -> foldr f (foldr g z as) para + Eval _ -> z + ExampleBlock _ -> z + CodeBlock _ _ -> z + List' list -> foldr f z list + Paragraph' para -> foldr f z para + +instance Bifunctor (Top code) where bimap f g = \case - Link x -> Link x - NamedLink a leaf -> NamedLink (g a) $ first f leaf - Example code -> Example $ f code - Transclude code -> Transclude $ f code - Bold a -> Bold $ g a - Italic a -> Italic $ g a - Strikethrough a -> Strikethrough $ g a - Verbatim leaf -> Verbatim leaf - Code leaf -> Code leaf - Source elems -> Source $ fmap (first f) <$> elems - FoldedSource elems -> FoldedSource $ fmap (first f) <$> elems - EvalInline code -> EvalInline $ f code - Signature x -> Signature x - SignatureInline x -> SignatureInline x - Word x -> Word x - Group join -> Group $ bimap f g <$> join + Section para as -> Section (fmap f para) $ fmap g as + Eval code -> Eval code + ExampleBlock code -> ExampleBlock code + CodeBlock title body -> CodeBlock title body + List' list -> List' $ fmap f list + Paragraph' para -> Paragraph' $ fmap f para + +instance Bitraversable (Top code) where + bitraverse f g = \case + Section para as -> Section <$> traverse f para <*> traverse g as + Eval code -> pure $ Eval code + ExampleBlock code -> pure $ ExampleBlock code + CodeBlock title body -> pure $ CodeBlock title body + List' list -> List' <$> traverse f list + Paragraph' para -> Paragraph' <$> traverse f para + +$(deriveEq1 ''Top) +$(deriveOrd1 ''Top) +$(deriveShow1 ''Top) +$(deriveEq2 ''Top) +$(deriveOrd2 ''Top) +$(deriveShow2 ''Top) -- | This is a deviation from the Unison Doc data model – in Unison, Doc distinguishes between type and term links, but -- here Doc knows nothing about what namespaces may exist. -data EmbedLink ident = EmbedLink (Token ident) - deriving (Eq, Ord, Show) - -data SourceElement ident a = SourceElement (EmbedLink ident) [EmbedAnnotation ident a] +data EmbedLink a = EmbedLink a deriving (Eq, Ord, Show, Foldable, Functor, Traversable) -newtype EmbedSignatureLink ident = EmbedSignatureLink (Token ident) - deriving (Eq, Ord, Show) +$(deriveEq1 ''EmbedLink) +$(deriveOrd1 ''EmbedLink) +$(deriveShow1 ''EmbedLink) -newtype Join a = Join (NonEmpty a) +newtype Transclude a = Transclude a deriving (Eq, Ord, Show, Foldable, Functor, Traversable) +$(deriveEq1 ''Transclude) +$(deriveOrd1 ''Transclude) +$(deriveShow1 ''Transclude) + newtype EmbedAnnotation ident a - = EmbedAnnotation (Either (Token ident) a) + = EmbedAnnotation (Either ident a) deriving (Eq, Ord, Show, Foldable, Functor, Traversable) -instance (Annotated code, Annotated a) => Annotated (Top ident code a) where - ann = \case - Section title body -> ann title <> ann body - Eval code -> ann code - ExampleBlock code -> ann code - CodeBlock label body -> ann label <> ann body - BulletedList items -> ann items - NumberedList items -> ann $ snd <$> items - Paragraph leaves -> ann leaves - -instance (Annotated a) => Annotated (Column a) where - ann (Column para list) = ann para <> ann list - -instance (Annotated code, Annotated a) => Annotated (Leaf ident code a) where - ann = \case - Link link -> ann link - NamedLink label target -> ann label <> ann target - Example code -> ann code - Transclude code -> ann code - Bold para -> ann para - Italic para -> ann para - Strikethrough para -> ann para - Verbatim word -> ann word - Code word -> ann word - Source elems -> ann elems - FoldedSource elems -> ann elems - EvalInline code -> ann code - Signature links -> ann links - SignatureInline link -> ann link - Word text -> ann text - Group (Join leaves) -> ann leaves - -instance Annotated (EmbedLink ident) where - ann (EmbedLink name) = ann name - -instance (Annotated code) => Annotated (SourceElement ident code) where - ann (SourceElement link target) = ann link <> ann target - -instance Annotated (EmbedSignatureLink ident) where - ann (EmbedSignatureLink name) = ann name - -instance (Annotated code) => Annotated (EmbedAnnotation ident code) where - ann (EmbedAnnotation a) = either ann ann a - -$(deriveEq1 ''Column) -$(deriveOrd1 ''Column) -$(deriveShow1 ''Column) - -$(deriveEq1 ''Token) -$(deriveOrd1 ''Token) -$(deriveShow1 ''Token) - $(deriveEq1 ''EmbedAnnotation) $(deriveOrd1 ''EmbedAnnotation) $(deriveShow1 ''EmbedAnnotation) @@ -164,9 +154,8 @@ $(deriveEq2 ''EmbedAnnotation) $(deriveOrd2 ''EmbedAnnotation) $(deriveShow2 ''EmbedAnnotation) -$(deriveEq1 ''EmbedLink) -$(deriveOrd1 ''EmbedLink) -$(deriveShow1 ''EmbedLink) +data SourceElement ident a = SourceElement (EmbedLink ident) [EmbedAnnotation ident a] + deriving (Eq, Ord, Show, Foldable, Functor, Traversable) $(deriveEq1 ''SourceElement) $(deriveOrd1 ''SourceElement) @@ -175,20 +164,68 @@ $(deriveEq2 ''SourceElement) $(deriveOrd2 ''SourceElement) $(deriveShow2 ''SourceElement) +newtype EmbedSignatureLink a = EmbedSignatureLink a + deriving (Eq, Ord, Show, Foldable, Functor, Traversable) + +newtype Word = Word String + deriving (Eq, Ord, Show) + +newtype Join a = Join (NonEmpty a) + deriving (Eq, Ord, Show, Foldable, Functor, Traversable) + $(deriveEq1 ''Join) $(deriveOrd1 ''Join) $(deriveShow1 ''Join) +newtype Group a = Group (Join a) + deriving (Eq, Ord, Show, Foldable, Functor, Traversable) + +$(deriveEq1 ''Group) +$(deriveOrd1 ''Group) +$(deriveShow1 ''Group) + +data Leaf ident code a + = Link (EmbedLink ident) + | -- | the Group always contains either a single Term/Type link or list of `Transclude`s & `Word`s + NamedLink (Paragraph a) (Group a) + | Example code + | Transclude' (Transclude code) + | Bold (Paragraph a) + | Italic (Paragraph a) + | Strikethrough (Paragraph a) + | Verbatim Word + | Code Word + | Source (NonEmpty (SourceElement ident (Transclude code))) + | FoldedSource (NonEmpty (SourceElement ident (Transclude code))) + | EvalInline code + | Signature (NonEmpty (EmbedSignatureLink ident)) + | SignatureInline (EmbedSignatureLink ident) + | Word' Word + | Group' (Group a) + deriving (Eq, Ord, Show, Foldable, Functor, Traversable) + +instance Bifunctor (Leaf ident) where + bimap f g = \case + Link x -> Link x + NamedLink para group -> NamedLink (g <$> para) $ g <$> group + Example code -> Example $ f code + Transclude' trans -> Transclude' $ f <$> trans + Bold para -> Bold $ g <$> para + Italic para -> Italic $ g <$> para + Strikethrough para -> Strikethrough $ g <$> para + Verbatim word -> Verbatim word + Code word -> Code word + Source elems -> Source $ fmap (fmap f) <$> elems + FoldedSource elems -> FoldedSource $ fmap (fmap f) <$> elems + EvalInline code -> EvalInline $ f code + Signature x -> Signature x + SignatureInline x -> SignatureInline x + Word' word -> Word' word + Group' group -> Group' $ g <$> group + $(deriveEq1 ''Leaf) $(deriveOrd1 ''Leaf) $(deriveShow1 ''Leaf) $(deriveEq2 ''Leaf) $(deriveOrd2 ''Leaf) $(deriveShow2 ''Leaf) - -$(deriveEq1 ''Top) -$(deriveOrd1 ''Top) -$(deriveShow1 ''Top) -$(deriveEq2 ''Top) -$(deriveOrd2 ''Top) -$(deriveShow2 ''Top) diff --git a/unison-syntax/src/Unison/Syntax/Var.hs b/unison-syntax/src/Unison/Syntax/Var.hs index 9fbc934d29..9f92e2c758 100644 --- a/unison-syntax/src/Unison/Syntax/Var.hs +++ b/unison-syntax/src/Unison/Syntax/Var.hs @@ -1,5 +1,6 @@ module Unison.Syntax.Var ( namespaced, + namespaced2, ) where @@ -13,3 +14,8 @@ import Unison.Var (Var) namespaced :: (Var v) => List.NonEmpty v -> v namespaced (v :| vs) = Name.toVar (foldl' Name.joinDot (Name.unsafeParseVar v) (map Name.unsafeParseVar vs)) + +-- | Like 'namespaced', but for the common case that you have two vars to join. +namespaced2 :: (Var v) => v -> v -> v +namespaced2 v1 v2 = + namespaced (v1 :| [v2]) diff --git a/unison-syntax/test/Main.hs b/unison-syntax/test/Main.hs index b7235f299b..3c84130548 100644 --- a/unison-syntax/test/Main.hs +++ b/unison-syntax/test/Main.hs @@ -1,243 +1,9 @@ -{-# OPTIONS_GHC -Wno-orphans #-} - module Main (main) where -import Data.Maybe (fromJust) -import Data.Text qualified as Text import EasyTest import System.IO.CodePage (withCP65001) -import Unison.Prelude -import Unison.ShortHash (ShortHash) -import Unison.ShortHash qualified as ShortHash -import Unison.Syntax.HashQualifiedPrime qualified as HQ' (unsafeParseText) -import Unison.Syntax.Lexer.Unison +import Unison.Test.Doc qualified as Doc +import Unison.Test.Unison qualified as Unison main :: IO () -main = - withCP65001 (run test) - -test :: Test () -test = - scope "lexer" . tests $ - [ t "1" [Numeric "1"], - t "+1" [Numeric "+1"], - t "-1" [Numeric "-1"], - t "-1.0" [Numeric "-1.0"], - t "+1.0" [Numeric "+1.0"], - t "1e3" [Numeric "1e3"], - t "1e+3" [Numeric "1e+3"], - t "1e-3" [Numeric "1e-3"], - t "+1e3" [Numeric "+1e3"], - t "+1e+3" [Numeric "+1e+3"], - t "+1e-3" [Numeric "+1e-3"], - t "-1e3" [Numeric "-1e3"], - t "-1e+3" [Numeric "-1e+3"], - t "-1e-3" [Numeric "-1e-3"], - t "1.2e3" [Numeric "1.2e3"], - t "1.2e+3" [Numeric "1.2e+3"], - t "1.2e-3" [Numeric "1.2e-3"], - t "+1.2e3" [Numeric "+1.2e3"], - t "+1.2e+3" [Numeric "+1.2e+3"], - t "+1.2e-3" [Numeric "+1.2e-3"], - t "-1.2e3" [Numeric "-1.2e3"], - t "-1.2e+3" [Numeric "-1.2e+3"], - t "-1.2e-3" [Numeric "-1.2e-3"], - t "1E3" [Numeric "1e3"], - t "1E+3" [Numeric "1e+3"], - t "1E-3" [Numeric "1e-3"], - t "+1E3" [Numeric "+1e3"], - t "+1E+3" [Numeric "+1e+3"], - t "+1E-3" [Numeric "+1e-3"], - t "-1E3" [Numeric "-1e3"], - t "-1E+3" [Numeric "-1e+3"], - t "-1E-3" [Numeric "-1e-3"], - t "1.2E3" [Numeric "1.2e3"], - t "1.2E+3" [Numeric "1.2e+3"], - t "1.2E-3" [Numeric "1.2e-3"], - t "+1.2E3" [Numeric "+1.2e3"], - t "+1.2E+3" [Numeric "+1.2e+3"], - t "+1.2E-3" [Numeric "+1.2e-3"], - t "-1.2E3" [Numeric "-1.2e3"], - t "-1.2E+3" [Numeric "-1.2e+3"], - t "-1.2E-3" [Numeric "-1.2e-3"], - t "1-1" [Numeric "1", simpleSymbolyId "-", Numeric "1"], - t "1+1" [Numeric "1", simpleSymbolyId "+", Numeric "1"], - t "1 +1" [Numeric "1", Numeric "+1"], - t "1+ 1" [Numeric "1", simpleSymbolyId "+", Numeric "1"], - t "x+y" [simpleWordyId "x", simpleSymbolyId "+", simpleWordyId "y"], - t "++;++" [simpleSymbolyId "++", Semi False, simpleSymbolyId "++"], - t "++; woot" [simpleSymbolyId "++", Semi False, simpleWordyId "woot"], - t "woot;woot" [simpleWordyId "woot", Semi False, simpleWordyId "woot"], - t "woot;(woot)" [simpleWordyId "woot", Semi False, Open "(", simpleWordyId "woot", Close], - t - "[+1,+1]" - [Open "[", Numeric "+1", Reserved ",", Numeric "+1", Close], - t - "[ +1 , +1 ]" - [Open "[", Numeric "+1", Reserved ",", Numeric "+1", Close], - t "-- a comment 1.0" [], - t "\"woot\" -- a comment 1.0" [Textual "woot"], - t "0:Int" [Numeric "0", Reserved ":", simpleWordyId "Int"], - t "0 : Int" [Numeric "0", Reserved ":", simpleWordyId "Int"], - t - ".Foo Foo `.` .foo.bar.baz" - [ simpleWordyId ".Foo", - simpleWordyId "Foo", - simpleSymbolyId "`.`", - simpleWordyId ".foo.bar.baz" - ], - t ".Foo.Bar.+" [simpleSymbolyId ".Foo.Bar.+"], - t ".Foo.++.+" [simpleSymbolyId ".Foo.++.+"], - t ".Foo.`++`.+" [simpleSymbolyId ".Foo.`++`.+"], - t ".Foo.`+.+`.+" [simpleSymbolyId ".Foo.`+.+`.+"], - -- idents with hashes - t "foo#bar" [simpleWordyId "foo#bar"], - t "+#bar" [simpleSymbolyId "+#bar"], - -- note - these are all the same, just with different spacing - let ex1 = "if x then y else z" - ex2 = unlines ["if", " x", "then", " y", "else z"] - ex3 = unlines ["if", " x", " then", " y", "else z"] - ex4 = unlines ["if", " x", " then", " y", "else z"] - expected = - [ Open "if", - simpleWordyId "x", - Close, - Open "then", - simpleWordyId "y", - Close, - Open "else", - simpleWordyId "z", - Close - ] - in -- directly close empty = block - tests $ map (`t` expected) [ex1, ex2, ex3, ex4], - let ex = unlines ["test =", "", "x = 1"] - in -- directly close nested empty blocks - t - ex - [ simpleWordyId "test", - Open "=", - Close, - (Semi True), - simpleWordyId "x", - Open "=", - Numeric "1", - Close - ], - let ex = unlines ["test =", " test2 =", "", "x = 1"] - in t - ex - [ simpleWordyId "test", - Open "=", - simpleWordyId "test2", - Open "=", - Close, - Close, - (Semi True), - simpleWordyId "x", - Open "=", - Numeric "1", - Close - ], - let ex = - unlines - ["if a then b", "else if c then d", "else if e then f", "else g"] -- close of the three `else` blocks - in -- In an empty `then` clause, the `else` is interpreted as a `Reserved` token - t - ex - [ Open "if", - simpleWordyId "a", - Close, - Open "then", - simpleWordyId "b", - Close, - Open "else", - Open "if", - simpleWordyId "c", - Close, - Open "then", - simpleWordyId "d", - Close, - Open "else", - Open "if", - simpleWordyId "e", - Close, - Open "then", - simpleWordyId "f", - Close, - Open "else", - simpleWordyId "g", - Close, - Close, - Close - ], - t - "if x then else" - [ Open "if", - simpleWordyId "x", - Close, - Open "then", - Close, - Open "else", - Close - ], - -- Empty `else` clause - t - "if x then 1 else" - [ Open "if", - simpleWordyId "x", - Close, - Open "then", - Numeric "1", - Close, - Open "else", - Close - ], - -- shouldn't be too eager to find keywords at the front of identifiers, - -- particularly for block-closing keywords (see #2727) - tests $ do - kw <- ["if", "then", "else"] - suffix <- ["0", "x", "!", "'"] -- examples of wordyIdChar - let i = kw ++ suffix - -- a keyword at the front of an identifier should still be an identifier - pure $ t i [simpleWordyId (Text.pack i)], - -- Test string literals - t - "\"simple string without escape characters\"" - [Textual "simple string without escape characters"], - t - "\"test escaped quotes \\\"in quotes\\\"\"" - [Textual "test escaped quotes \"in quotes\""], - t "\"\\n \\t \\b \\a\"" [Textual "\n \t \b \a"], - -- Delayed string - t "'\"\"" [Reserved "'", Textual ""], - -- https://github.com/unisonweb/unison/issues/4683 - -- don't emit virtual semis in ability lists or normal lists - t "{foo\n,bar}" [Open "{", simpleWordyId "foo", Reserved ",", simpleWordyId "bar", Close], - t "{foo\n ,bar}" [Open "{", simpleWordyId "foo", Reserved ",", simpleWordyId "bar", Close], - t "[foo\n,bar]" [Open "[", simpleWordyId "foo", Reserved ",", simpleWordyId "bar", Close], - t "[foo\n ,bar]" [Open "[", simpleWordyId "foo", Reserved ",", simpleWordyId "bar", Close] - ] - -t :: String -> [Lexeme] -> Test () -t s expected = - let actual0 = payload <$> preParse (lexer "ignored filename" s) - actual = take (length actual0 - 2) . drop 1 $ toList actual0 - in scope s $ - if actual == expected - then ok - else do - note $ "expected: " ++ show expected - note $ "actual : " ++ show actual - crash "actual != expected" - -simpleSymbolyId :: Text -> Lexeme -simpleSymbolyId = - SymbolyId . HQ'.unsafeParseText - -simpleWordyId :: Text -> Lexeme -simpleWordyId = - WordyId . HQ'.unsafeParseText - -instance IsString ShortHash where - fromString = fromJust . ShortHash.fromText . Text.pack +main = withCP65001 . run $ tests [Unison.test, Doc.test] diff --git a/unison-syntax/test/Unison/Test/Doc.hs b/unison-syntax/test/Unison/Test/Doc.hs new file mode 100644 index 0000000000..50e7eb10de --- /dev/null +++ b/unison-syntax/test/Unison/Test/Doc.hs @@ -0,0 +1,168 @@ +module Unison.Test.Doc (test) where + +import Data.Bifunctor (first) +import Data.List.NonEmpty (NonEmpty ((:|))) +import Data.Text (Text) +import EasyTest +import Text.Megaparsec qualified as P +import Unison.HashQualifiedPrime qualified as HQ' +import Unison.Syntax.Lexer.Unison +import Unison.Syntax.Name qualified as Name +import Unison.Syntax.Parser.Doc qualified as DP +import Unison.Syntax.Parser.Doc.Data qualified as Doc +import Unison.Util.Recursion + +test :: Test () +test = + scope "Doc parser" . tests $ + [ t "# Hello" [Doc.Section (Doc.Paragraph $ docWord "Hello" :| []) []], + t + ( unlines + [ "# Hello", + "## Again" + ] + ) + [ Doc.Section + (Doc.Paragraph $ docWord "Hello" :| []) + [Fix $ Doc.Section (Doc.Paragraph $ docWord "Again" :| []) []] + ], + t + ( unlines + [ "## Hello", + "# Again" + ] + ) + [ Doc.Section (Doc.Paragraph $ docWord "Hello" :| []) [], + Doc.Section (Doc.Paragraph $ docWord "Again" :| []) [] + ], + t + "*some bold words*" + [Doc.Paragraph' . Doc.Paragraph $ docBold (docWord "some" :| [docWord "bold", docWord "words"]) :| []], + t + "_some italic words_" + [Doc.Paragraph' . Doc.Paragraph $ docItalic (docWord "some" :| [docWord "italic", docWord "words"]) :| []], + t + "~some struck-through words~" + [ Doc.Paragraph' . Doc.Paragraph $ + docStrikethrough (docWord "some" :| [docWord "struck-through", docWord "words"]) :| [] + ], + -- any number of emphasis delimiters is allowed + t + "__some italic words__" + [Doc.Paragraph' . Doc.Paragraph $ docItalic (docWord "some" :| [docWord "italic", docWord "words"]) :| []], + t + "________some italic words________" + [Doc.Paragraph' . Doc.Paragraph $ docItalic (docWord "some" :| [docWord "italic", docWord "words"]) :| []], + t + "***some bold words***" + [ Doc.Paragraph' . Doc.Paragraph $ docBold (docWord "some" :| [docWord "bold", docWord "words"]) :| [] + ], + t + "***some _nested_ emphasis***" + [ Doc.Paragraph' . Doc.Paragraph $ + docBold (docWord "some" :| [docItalic $ docWord "nested" :| [], docWord "emphasis"]) :| [] + ], + -- mismatched delimiters should be preserved as text + t "*" [Doc.Paragraph' . Doc.Paragraph $ docWord "*" :| []], + t "`" [Doc.Paragraph' . Doc.Paragraph $ docWord "`" :| []], + -- various code blocks (although we’re not testing the Unison code block lexer/parser with these) + t + ( unlines + [ "```", + "You might think this is code, but it’s not", + "```" + ] + ) + [Doc.Eval "You might think this is code, but it’s not\n"], + t + ( unlines + [ "`````````", + "This one has extra delimiters", + "`````````" + ] + ) + [Doc.Eval "This one has extra delimiters\n"], + t + ( unlines + [ "``` unison", + "You might think this is code, but it’s not", + "```" + ] + ) + [Doc.CodeBlock "unison" "You might think this is code, but it’s not"], + t + ( unlines + [ "````````` unison", + "This one has extra delimiters", + "`````````" + ] + ) + [Doc.CodeBlock "unison" "This one has extra delimiters"], + t + ( unlines + [ "@typecheck ```", + "You might think this is code, but it’s not", + "```" + ] + ) + [Doc.ExampleBlock "\nYou might think this is code, but it’s not\n"], + t + ( unlines + [ "@typecheck`````````", + "This one has extra delimiters", + "`````````" + ] + ) + [Doc.ExampleBlock "\nThis one has extra delimiters\n"], + t "`some verbatim text`" [Doc.Paragraph' . Doc.Paragraph $ docCode "some verbatim text" :| []], + t "''some verbatim text''" [Doc.Paragraph' . Doc.Paragraph $ docCode "some verbatim text" :| []], + t "'''''some verbatim text'''''" [Doc.Paragraph' . Doc.Paragraph $ docCode "some verbatim text" :| []] + ] + +-- round-trip tests need to be in unison-parser-typechecker +-- +-- -- want to get this to `Text` (or `String`), for round-trip testing +-- showPrettyDoc :: (Var v) => PrettyPrintEnv -> Term v a -> Pretty ColorText +-- showPrettyDoc ppe tm = PP.syntaxToColor . runPretty (avoidShadowing tm ppe) <$> prettyDoc2 emptyAc (printAnnotate ppe tm) + +t :: + String -> + -- | Despite the long type, this is a simplified `Doc` – no annotations, and ident and code are Text & String, + -- respectively. + [Doc.Top String (Fix (Doc.Leaf Text String)) (Fix (Doc.Top String (Fix (Doc.Leaf Text String))))] -> + Test () +t s expected = + scope s + . either + (crash . P.errorBundlePretty) + ( \actual -> + let expected' = Doc.UntitledSection $ embed <$> expected + actual' = cata (\(_ :<< top) -> embed $ first (cata \(_ :<< leaf) -> embed leaf) top) <$> actual + in if actual' == expected' + then ok + else do + note $ "expected: " ++ show expected' + note $ "actual : " ++ show actual' + crash "actual != expected" + ) + $ P.runParser (DP.doc (Name.toText . HQ'.toName . snd <$> typeOrTerm) (P.manyTill P.anySingle) P.eof) "test case" s + +-- * Helper functions to make it easier to read the examples. + +-- Once the parser gets generalized, these should be able to be removed, as they won’t require multiple layers of +-- constructor. + +docBold :: NonEmpty (Fix (Doc.Leaf ident code)) -> Fix (Doc.Leaf ident code) +docBold = embed . Doc.Bold . Doc.Paragraph + +docCode :: String -> Fix (Doc.Leaf ident code) +docCode = embed . Doc.Code . Doc.Word + +docItalic :: NonEmpty (Fix (Doc.Leaf ident code)) -> Fix (Doc.Leaf ident code) +docItalic = embed . Doc.Italic . Doc.Paragraph + +docStrikethrough :: NonEmpty (Fix (Doc.Leaf ident code)) -> Fix (Doc.Leaf ident code) +docStrikethrough = embed . Doc.Strikethrough . Doc.Paragraph + +docWord :: String -> Fix (Doc.Leaf ident code) +docWord = embed . Doc.Word' . Doc.Word diff --git a/unison-syntax/test/Unison/Test/Unison.hs b/unison-syntax/test/Unison/Test/Unison.hs new file mode 100644 index 0000000000..5468046400 --- /dev/null +++ b/unison-syntax/test/Unison/Test/Unison.hs @@ -0,0 +1,235 @@ +module Unison.Test.Unison (test) where + +import Data.Text qualified as Text +import EasyTest +import Unison.Prelude +import Unison.Syntax.HashQualifiedPrime qualified as HQ' (unsafeParseText) +import Unison.Syntax.Lexer.Unison + +test :: Test () +test = + scope "lexer" . tests $ + [ t "" [], + t "1" [Numeric "1"], + t "+1" [Numeric "+1"], + t "-1" [Numeric "-1"], + t "-1.0" [Numeric "-1.0"], + t "+1.0" [Numeric "+1.0"], + t "1e3" [Numeric "1e3"], + t "1e+3" [Numeric "1e+3"], + t "1e-3" [Numeric "1e-3"], + t "+1e3" [Numeric "+1e3"], + t "+1e+3" [Numeric "+1e+3"], + t "+1e-3" [Numeric "+1e-3"], + t "-1e3" [Numeric "-1e3"], + t "-1e+3" [Numeric "-1e+3"], + t "-1e-3" [Numeric "-1e-3"], + t "1.2e3" [Numeric "1.2e3"], + t "1.2e+3" [Numeric "1.2e+3"], + t "1.2e-3" [Numeric "1.2e-3"], + t "+1.2e3" [Numeric "+1.2e3"], + t "+1.2e+3" [Numeric "+1.2e+3"], + t "+1.2e-3" [Numeric "+1.2e-3"], + t "-1.2e3" [Numeric "-1.2e3"], + t "-1.2e+3" [Numeric "-1.2e+3"], + t "-1.2e-3" [Numeric "-1.2e-3"], + t "1E3" [Numeric "1e3"], + t "1E+3" [Numeric "1e+3"], + t "1E-3" [Numeric "1e-3"], + t "+1E3" [Numeric "+1e3"], + t "+1E+3" [Numeric "+1e+3"], + t "+1E-3" [Numeric "+1e-3"], + t "-1E3" [Numeric "-1e3"], + t "-1E+3" [Numeric "-1e+3"], + t "-1E-3" [Numeric "-1e-3"], + t "1.2E3" [Numeric "1.2e3"], + t "1.2E+3" [Numeric "1.2e+3"], + t "1.2E-3" [Numeric "1.2e-3"], + t "+1.2E3" [Numeric "+1.2e3"], + t "+1.2E+3" [Numeric "+1.2e+3"], + t "+1.2E-3" [Numeric "+1.2e-3"], + t "-1.2E3" [Numeric "-1.2e3"], + t "-1.2E+3" [Numeric "-1.2e+3"], + t "-1.2E-3" [Numeric "-1.2e-3"], + t "1-1" [Numeric "1", simpleSymbolyId "-", Numeric "1"], + t "1+1" [Numeric "1", simpleSymbolyId "+", Numeric "1"], + t "1 +1" [Numeric "1", Numeric "+1"], + t "1+ 1" [Numeric "1", simpleSymbolyId "+", Numeric "1"], + t "x+y" [simpleWordyId "x", simpleSymbolyId "+", simpleWordyId "y"], + t "++;++" [simpleSymbolyId "++", Semi False, simpleSymbolyId "++"], + t "++; woot" [simpleSymbolyId "++", Semi False, simpleWordyId "woot"], + t "woot;woot" [simpleWordyId "woot", Semi False, simpleWordyId "woot"], + t "woot;(woot)" [simpleWordyId "woot", Semi False, Open "(", simpleWordyId "woot", Close], + t + "[+1,+1]" + [Open "[", Numeric "+1", Reserved ",", Numeric "+1", Close], + t + "[ +1 , +1 ]" + [Open "[", Numeric "+1", Reserved ",", Numeric "+1", Close], + t "-- a comment 1.0" [], + t "\"woot\" -- a comment 1.0" [Textual "woot"], + t "0:Int" [Numeric "0", Reserved ":", simpleWordyId "Int"], + t "0 : Int" [Numeric "0", Reserved ":", simpleWordyId "Int"], + t + ".Foo Foo `.` .foo.bar.baz" + [ simpleWordyId ".Foo", + simpleWordyId "Foo", + simpleSymbolyId "`.`", + simpleWordyId ".foo.bar.baz" + ], + t ".Foo.Bar.+" [simpleSymbolyId ".Foo.Bar.+"], + t ".Foo.++.+" [simpleSymbolyId ".Foo.++.+"], + t ".Foo.`++`.+" [simpleSymbolyId ".Foo.`++`.+"], + t ".Foo.`+.+`.+" [simpleSymbolyId ".Foo.`+.+`.+"], + -- idents with hashes + t "foo#bar" [simpleWordyId "foo#bar"], + t "+#bar" [simpleSymbolyId "+#bar"], + -- note - these are all the same, just with different spacing + let ex1 = "if x then y else z" + ex2 = unlines ["if", " x", "then", " y", "else z"] + ex3 = unlines ["if", " x", " then", " y", "else z"] + ex4 = unlines ["if", " x", " then", " y", "else z"] + expected = + [ Open "if", + simpleWordyId "x", + Close, + Open "then", + simpleWordyId "y", + Close, + Open "else", + simpleWordyId "z", + Close + ] + in -- directly close empty = block + tests $ map (`t` expected) [ex1, ex2, ex3, ex4], + let ex = unlines ["test =", "", "x = 1"] + in -- directly close nested empty blocks + t + ex + [ simpleWordyId "test", + Open "=", + Close, + (Semi True), + simpleWordyId "x", + Open "=", + Numeric "1", + Close + ], + let ex = unlines ["test =", " test2 =", "", "x = 1"] + in t + ex + [ simpleWordyId "test", + Open "=", + simpleWordyId "test2", + Open "=", + Close, + Close, + (Semi True), + simpleWordyId "x", + Open "=", + Numeric "1", + Close + ], + let ex = + unlines + ["if a then b", "else if c then d", "else if e then f", "else g"] -- close of the three `else` blocks + in -- In an empty `then` clause, the `else` is interpreted as a `Reserved` token + t + ex + [ Open "if", + simpleWordyId "a", + Close, + Open "then", + simpleWordyId "b", + Close, + Open "else", + Open "if", + simpleWordyId "c", + Close, + Open "then", + simpleWordyId "d", + Close, + Open "else", + Open "if", + simpleWordyId "e", + Close, + Open "then", + simpleWordyId "f", + Close, + Open "else", + simpleWordyId "g", + Close, + Close, + Close + ], + t + "if x then else" + [ Open "if", + simpleWordyId "x", + Close, + Open "then", + Close, + Open "else", + Close + ], + -- Empty `else` clause + t + "if x then 1 else" + [ Open "if", + simpleWordyId "x", + Close, + Open "then", + Numeric "1", + Close, + Open "else", + Close + ], + -- shouldn't be too eager to find keywords at the front of identifiers, + -- particularly for block-closing keywords (see #2727) + tests $ do + kw <- ["if", "then", "else"] + suffix <- ["0", "x", "!", "'"] -- examples of wordyIdChar + let i = kw ++ suffix + -- a keyword at the front of an identifier should still be an identifier + pure $ t i [simpleWordyId (Text.pack i)], + -- Test string literals + t + "\"simple string without escape characters\"" + [Textual "simple string without escape characters"], + t + "\"test escaped quotes \\\"in quotes\\\"\"" + [Textual "test escaped quotes \"in quotes\""], + t "\"\\n \\t \\b \\a\"" [Textual "\n \t \b \a"], + -- Delayed string + t "'\"\"" [Reserved "'", Textual ""], + -- https://github.com/unisonweb/unison/issues/4683 + -- don't emit virtual semis in ability lists or normal lists + t "{foo\n,bar}" [Open "{", simpleWordyId "foo", Reserved ",", simpleWordyId "bar", Close], + t "{foo\n ,bar}" [Open "{", simpleWordyId "foo", Reserved ",", simpleWordyId "bar", Close], + t "[foo\n,bar]" [Open "[", simpleWordyId "foo", Reserved ",", simpleWordyId "bar", Close], + t "[foo\n ,bar]" [Open "[", simpleWordyId "foo", Reserved ",", simpleWordyId "bar", Close] + ] + +t :: String -> [Lexeme] -> Test () +t s expected = case toList . preParse $ lexer filename s of + [token@(Token (Err _) _ _)] -> crash $ show token + tokened -> + let actual = payload <$> tokened + expected' = Open filename : expected <> pure Close + in scope s $ + if actual == expected' + then ok + else do + note $ "expected: " ++ show expected' + note $ "actual : " ++ show actual + crash "actual != expected" + where + filename = "test case" + +simpleSymbolyId :: Text -> Lexeme +simpleSymbolyId = + SymbolyId . HQ'.unsafeParseText + +simpleWordyId :: Text -> Lexeme +simpleWordyId = + WordyId . HQ'.unsafeParseText diff --git a/unison-syntax/unison-syntax.cabal b/unison-syntax/unison-syntax.cabal index 0da37d0036..389ca06413 100644 --- a/unison-syntax/unison-syntax.cabal +++ b/unison-syntax/unison-syntax.cabal @@ -79,7 +79,6 @@ library , mtl , parser-combinators , text - , text-builder , unison-core , unison-core1 , unison-hash @@ -91,6 +90,9 @@ library test-suite syntax-tests type: exitcode-stdio-1.0 main-is: Main.hs + other-modules: + Unison.Test.Doc + Unison.Test.Unison hs-source-dirs: test default-extensions: @@ -126,25 +128,12 @@ test-suite syntax-tests ghc-options: -Wall build-depends: base - , bytes , code-page - , containers - , cryptonite - , deriving-compat , easytest - , extra - , free - , lens , megaparsec - , mtl - , parser-combinators , text - , text-builder - , unison-core , unison-core1 - , unison-hash , unison-prelude , unison-syntax - , unison-util-base32hex - , unison-util-bytes + , unison-util-recursion default-language: Haskell2010