unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-08-15 13:30:27 +03:00
Code Issues Projects Releases Wiki Activity

Merge remote-tracking branch 'upstream/trunk' into better-CLI-error-messages

Browse Source
This commit is contained in:
Greg Pfeil 2024-07-05 11:32:56 -06:00
commit 0e76597e51
No known key found for this signature in database
GPG Key ID: 1193ACD196ED61F2
468 changed files with 5550 additions and 5485 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.github/workflows/ci.md vendored
View File

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

2
.github/workflows/ci.yaml vendored
View File

@ -14,7 +14,7 @@ on:
env:
ormolu_version: 0.5.2.0
ucm_local_bin: ucm-local-bin
jit_version: "@unison/internal/releases/0.0.17"
jit_version: "@unison/internal/releases/0.0.18"
jit_src_scheme: unison-jit-src/scheme-libs/racket
jit_dist: unison-jit-dist
jit_generator_os: ubuntu-20.04

2
codebase2/codebase-sqlite/package.yaml
View File

@ -31,6 +31,7 @@ dependencies:
- unison-codebase
- unison-codebase-sync
- unison-core
- unison-core1
- unison-core-orphans-sqlite
- unison-hash
- unison-hash-orphans-sqlite
@ -39,7 +40,6 @@ dependencies:
- unison-util-base32hex
- unison-util-cache
- unison-util-file-embed
- unison-util-nametree
- unison-util-serialization
- unison-util-term
- unliftio

2
codebase2/codebase-sqlite/unison-codebase-sqlite.cabal
View File

@ -126,6 +126,7 @@ library
, unison-codebase-sync
, unison-core
, unison-core-orphans-sqlite
, unison-core1
, unison-hash
, unison-hash-orphans-sqlite
, unison-prelude
@ -133,7 +134,6 @@ library
, unison-util-base32hex
, unison-util-cache
, unison-util-file-embed
, unison-util-nametree
, unison-util-serialization
, unison-util-term
, unliftio

1
contrib/cabal.project
View File

@ -24,7 +24,6 @@ packages:
lib/unison-util-relation
lib/unison-util-rope
lib/unison-util-file-embed
lib/unison-util-nametree
parser-typechecker
unison-core

12
lib/unison-prelude/src/Unison/Debug.hs
View File

@ -13,13 +13,12 @@ module Unison.Debug
)
where
import Control.Applicative (empty)
import Control.Monad (when)
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text qualified as Text
import Debug.Pretty.Simple (pTrace, pTraceM, pTraceShowId, pTraceShowM)
import Debug.Pretty.Simple (pTrace, pTraceM)
import System.IO.Unsafe (unsafePerformIO)
import Text.Pretty.Simple (pShow)
import Unison.Prelude
import UnliftIO.Environment (lookupEnv)
data DebugFlag
@ -148,7 +147,7 @@ debugPatternCoverageConstraintSolver = PatternCoverageConstraintSolver `Set.memb
debug :: (Show a) => DebugFlag -> String -> a -> a
debug flag msg a =
if shouldDebug flag
then pTraceShowId (pTrace (msg <> ":\n") a)
then (pTrace (msg <> ":\n" <> into @String (pShow a)) a)
else a
-- | Use for selective debug logging in monadic contexts.
@ -159,8 +158,7 @@ debug flag msg a =
debugM :: (Show a, Monad m) => DebugFlag -> String -> a -> m ()
debugM flag msg a =
whenDebug flag do
pTraceM (msg <> ":\n")
pTraceShowM a
traceM (msg <> ":\n" <> into @String (pShow a))
debugLog :: DebugFlag -> String -> a -> a
debugLog flag msg =

14
lib/unison-pretty-printer/src/Unison/Util/Pretty.hs
View File

@ -78,7 +78,7 @@ module Unison.Util.Pretty
lineSkip,
nonEmpty,
numbered,
numberedColumn2,
numberedColumn2ListFrom,
numberedColumn2Header,
numberedColumnNHeader,
numberedList,
@ -544,12 +544,12 @@ numberedHeader num ps = column2 (fmap num (Nothing : fmap Just [1 ..]) `zip` toL
-- 1. one thing : this is a thing
-- 2. another thing : this is another thing
-- 3. and another : yet one more thing
numberedColumn2 ::
(Foldable f, LL.ListLike s Char, IsString s) =>
(Int -> Pretty s) ->
f (Pretty s, Pretty s) ->
Pretty s
numberedColumn2 num ps = numbered num (align $ toList ps)
numberedColumn2ListFrom ::
(Foldable f) =>
Int ->
f (Pretty ColorText, Pretty ColorText) ->
Pretty ColorText
numberedColumn2ListFrom num ps = numberedListFrom num (align $ toList ps)
numberedColumn2Header ::
(Foldable f, LL.ListLike s Char, IsString s) =>

56
lib/unison-util-nametree/package.yaml
View File

@ -1,56 +0,0 @@
name: unison-util-nametree
github: unisonweb/unison
copyright: Copyright (C) 2013-2018 Unison Computing, PBC and contributors
ghc-options: -Wall
dependencies:
- base
- containers
- lens
- semialign
- semigroups
- these
- unison-core
- unison-core1
- unison-prelude
- unison-util-relation
library:
source-dirs: src
when:
- condition: false
other-modules: Paths_unison_util_nametree
default-extensions:
- BangPatterns
- BlockArguments
- DeriveAnyClass
- DeriveFoldable
- DeriveFunctor
- DeriveGeneric
- DeriveTraversable
- DerivingStrategies
- DerivingVia
- DoAndIfThenElse
- DuplicateRecordFields
- FlexibleContexts
- FlexibleInstances
- GADTs
- GeneralizedNewtypeDeriving
- ImportQualifiedPost
- InstanceSigs
- LambdaCase
- MultiParamTypeClasses
- MultiWayIf
- NamedFieldPuns
- NumericUnderscores
- OverloadedLabels
- OverloadedRecordDot
- OverloadedStrings
- PatternSynonyms
- RankNTypes
- ScopedTypeVariables
- TupleSections
- TypeApplications
- ViewPatterns

68
lib/unison-util-nametree/unison-util-nametree.cabal
View File

@ -1,68 +0,0 @@
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-nametree
version: 0.0.0
homepage: https://github.com/unisonweb/unison#readme
bug-reports: https://github.com/unisonweb/unison/issues
copyright: Copyright (C) 2013-2018 Unison Computing, PBC and contributors
build-type: Simple
source-repository head
type: git
location: https://github.com/unisonweb/unison
library
exposed-modules:
Unison.Util.Defns
Unison.Util.Nametree
hs-source-dirs:
src
default-extensions:
BangPatterns
BlockArguments
DeriveAnyClass
DeriveFoldable
DeriveFunctor
DeriveGeneric
DeriveTraversable
DerivingStrategies
DerivingVia
DoAndIfThenElse
DuplicateRecordFields
FlexibleContexts
FlexibleInstances
GADTs
GeneralizedNewtypeDeriving
ImportQualifiedPost
InstanceSigs
LambdaCase
MultiParamTypeClasses
MultiWayIf
NamedFieldPuns
NumericUnderscores
OverloadedLabels
OverloadedRecordDot
OverloadedStrings
PatternSynonyms
RankNTypes
ScopedTypeVariables
TupleSections
TypeApplications
ViewPatterns
ghc-options: -Wall
build-depends:
base
, containers
, lens
, semialign
, semigroups
, these
, unison-core
, unison-core1
, unison-prelude
, unison-util-relation
default-language: Haskell2010

1
parser-typechecker/package.yaml
View File

@ -127,7 +127,6 @@ dependencies:
- unison-util-base32hex
- unison-util-bytes
- unison-util-cache
- unison-util-nametree
- unison-util-relation
- unison-util-rope
- unison-util-serialization

26
parser-typechecker/src/Unison/Codebase/Path.hs
View File

@ -56,15 +56,13 @@ module Unison.Codebase.Path
toList,
toName,
toName',
unsafeToName,
unsafeToName',
toText,
toText',
unsplit,
unsplit',
unsplitAbsolute,
unsplitHQ,
unsplitHQ',
nameFromHQSplit,
nameFromHQSplit',
nameFromSplit',
splitFromName,
splitFromName',
@ -171,11 +169,11 @@ unsplitAbsolute :: (Absolute, NameSegment) -> Absolute
unsplitAbsolute =
coerce unsplit
unsplitHQ :: HQSplit -> HQ'.HashQualified Path
unsplitHQ (p, a) = fmap (snoc p) a
nameFromHQSplit :: HQSplit -> HQ'.HashQualified Name
nameFromHQSplit = nameFromHQSplit' . first (RelativePath' . Relative)
unsplitHQ' :: HQSplit' -> HQ'.HashQualified Path'
unsplitHQ' (p, a) = fmap (snoc' p) a
nameFromHQSplit' :: HQSplit' -> HQ'.HashQualified Name
nameFromHQSplit' (p, a) = fmap (nameFromSplit' . (p,)) a
type Split = (Path, NameSegment)
@ -316,9 +314,6 @@ cons = Lens.cons
snoc :: Path -> NameSegment -> Path
snoc = Lens.snoc
snoc' :: Path' -> NameSegment -> Path'
snoc' = Lens.snoc
unsnoc :: Path -> Maybe (Path, NameSegment)
unsnoc = Lens.unsnoc
@ -344,15 +339,6 @@ fromName' n
where
path = fromName n
unsafeToName :: Path -> Name
unsafeToName =
fromMaybe (error "empty path") . toName
-- | Convert a Path' to a Name
unsafeToName' :: Path' -> Name
unsafeToName' =
fromMaybe (error "empty path") . toName'
toName :: Path -> Maybe Name
toName = \case
Path Seq.Empty -> Nothing

4
parser-typechecker/unison-parser-typechecker.cabal
View File

@ -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
@ -330,7 +330,6 @@ library
, unison-util-base32hex
, unison-util-bytes
, unison-util-cache
, unison-util-nametree
, unison-util-relation
, unison-util-rope
, unison-util-serialization
@ -532,7 +531,6 @@ test-suite parser-typechecker-tests
, unison-util-base32hex
, unison-util-bytes
, unison-util-cache
, unison-util-nametree
, unison-util-relation
, unison-util-rope
, unison-util-serialization

105
scheme-libs/racket/unison/arithmetic.rkt
View File

@ -1,70 +1,103 @@
#!racket/base
(provide
(prefix-out
builtin-
(combine-out
Nat.toFloat
Nat.increment
Nat.+
Nat.drop
Float.*
Float.fromRepresentation
Float.toRepresentation
Float.ceiling
Int.+
Int.-
Int./
Int.increment
Int.negate
Int.fromRepresentation
Int.toRepresentation
Int.signum
)))
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 (Nat.+ m n) (clamp-natural (+ m n)))
(define-unison (Nat.drop m n) (max 0 (- m n)))
(define-unison-builtin
(builtin-Nat.+ m n)
(clamp-natural (+ m n)))
(define-unison (Nat.increment n) (clamp-natural (add1 n)))
(define-unison (Int.increment i) (clamp-integer (add1 i)))
(define-unison (Int.negate i) (if (> i nbit63) (- i) i))
(define-unison (Int.+ i j) (clamp-integer (+ i j)))
(define-unison (Int.- i j) (clamp-integer (- i j)))
(define-unison (Int./ i j) (floor (/ i j)))
(define-unison (Int.signum i) (sgn i))
(define-unison (Float.* x y) (fl* x y))
(define-unison-builtin
(builtin-Nat.drop m n)
(max 0 (- m n)))
(define-unison (Nat.toFloat n) (->fl 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 (Float.ceiling f)
(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 (Float.toRepresentation fl)
(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 (Float.fromRepresentation n)
(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 (Int.toRepresentation i)
(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 (Int.fromRepresentation n)
(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

387
scheme-libs/racket/unison/boot.ss
View File

@ -55,6 +55,7 @@
bytes
control
define-unison
define-unison-builtin
handle
name
data
@ -116,14 +117,16 @@
(require
(for-syntax
racket/set
(only-in racket partition flatten))
(only-in racket partition flatten split-at)
(only-in racket/string string-prefix?)
(only-in racket/syntax format-id))
(rename-in
(except-in racket false true unit any)
[make-continuation-prompt-tag make-prompt])
; (for (only (compatibility mlist) mlist->list list->mlist) expand)
; (for (only (racket base) quasisyntax/loc) expand)
; (for-syntax (only-in unison/core syntax->list))
(only-in racket/control prompt0-at control0-at)
(only-in racket/control control0-at)
racket/performance-hint
unison/core
unison/data
@ -151,115 +154,301 @@
(syntax-rules ()
[(with-name name e) (let ([name e]) name)]))
; function definition with slow/fast path. Slow path allows for
; under/overapplication. Fast path is exact application.
; 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)
(string->symbol
(string-append
(symbol->string name)
":"
post)))
(define-for-syntax (adjust-name name post)
(datum->syntax name (adjust-symbol (syntax->datum name) post) name))
; Helper function. Turns a list of syntax objects into a
; list-syntax object.
(define-for-syntax (list->syntax l) #`(#,@l))
; These are auxiliary functions for manipulating a unison definition
; into a form amenable for the right runtime behavior. This involves
; multiple separate definitions:
;
; The intent is for the scheme compiler to be able to recognize and
; optimize static, fast path calls itself, while still supporting
; unison-like automatic partial application and such.
(define-syntax (define-unison x)
(define (fast-path-symbol name)
(string->symbol
(string-append
(symbol->string name)
":fast-path")))
; 1. an :impl definition is generated containing the actual code body
; 2. a :fast definition, which takes exactly the number of arguments
; as the original, but checks if stack information needs to be
; stored for continuation serialization.
; 3. a :slow path which implements under/over application to unison
; definitions, so they act like curried functions, not scheme
; procedures
; 4. a macro that implements the actual occurrences, and directly
; calls the fast path for static calls with exactly the right
; number of arguments
;
; Additionally, arguments are threaded through the internal
; definitions that indicate whether an ability handler is in place
; that could potentially result in the continuation being serialized.
; If so, then calls write additional information to the continuation
; for that serialization. This isn't cheap for tight loops, so we
; attempt to avoid this as much as possible (conditioning the
; annotation on a flag checkseems to cause no performance loss).
(define (fast-path-name name)
(datum->syntax name (fast-path-symbol (syntax->datum name))))
; Helper function. Turns a list of syntax objects into a
; list-syntax object.
(define (list->syntax l) #`(#,@l))
; Builds partial application cases for unison functions.
; It seems most efficient to have a case for each posible
; under-application.
(define (build-partials name formals)
(let rec ([us formals] [acc '()])
(syntax-case us ()
[() (list->syntax (cons #`[() #,name] acc))]
[(a ... z)
(rec #'(a ...)
(cons
#`[(a ... z)
(with-name
#,(datum->syntax name (syntax->datum name))
(partial-app #,name a ... z))]
acc))])))
; 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)
(with-syntax ([name:impl name:impl:stx]
[args arg:stx]
[body body:stx])
(syntax/loc body:stx
(define (name:impl #:pure pure? . args) . body))))
; Given an overall function name, a fast path name, and a list of
; arguments, builds the case-lambda body of a unison function that
; enables applying to arbitrary numbers of arguments.
(define (func-cases name name:fast args)
(syntax-case args ()
[() (quasisyntax/loc x
(case-lambda
[() (#,name:fast)]
[r (apply (#,name:fast) r)]))]
[(a ... z)
(quasisyntax/loc x
(case-lambda
#,@(build-partials name #'(a ...))
[(a ... z) (#,name:fast a ... z)]
[(a ... z . r) (apply (#,name:fast a ... z) r)]))]))
(define frame-contents (gensym))
(syntax-case x ()
[(define-unison (name a ...) e ...)
(let ([fname (fast-path-name #'name)])
(with-syntax ([name:fast fname]
[fast (syntax/loc x (lambda (a ...) e ...))]
[slow (func-cases #'name fname #'(a ...))])
(syntax/loc x
(define-values (name:fast name) (values fast slow)))))]))
; Builds the wrapper definition, 'fast path,' which just tests the
; purity, writes the stack information if necessary, and calls the
; implementation. If #:force-pure is specified, the fast path just
; directly calls the implementation procedure. This should allow
; tight loops to still perform well if we can detect that they
; (hereditarily) cannot make ability requests, even in contexts
; where a handler is present.
(define-for-syntax
(make-fast-path
#:force-pure force-pure?
loc ; original location
name:fast:stx name:impl:stx
arg:stx)
(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))
(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)
(with-syntax ([name name:stx]
[name:fast name:fast:stx]
[arity arity:val])
(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)))])))]
[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)))])))])))
(define-for-syntax
(link-decl no-link-decl? loc name:stx name:fast:stx name:impl:stx)
(if no-link-decl?
#'()
(let ([name:link:stx (adjust-name name:stx "termlink")])
(with-syntax
([name:fast name:fast:stx]
[name:impl name:impl:stx]
[name:link name:link:stx])
(syntax/loc loc
((declare-function-link name:fast name:link)
(declare-function-link name:impl name:link)))))))
(define-for-syntax (process-hints hs)
(for/fold ([internal? #f]
[force-pure? #t]
[gen-link? #f]
[no-link-decl? #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)))))
(define-for-syntax
(make-link-def gen-link? loc name:stx name:link:stx)
(define (chop s)
(if (string-prefix? s "builtin-")
(substring s 8)
s))
(define name:txt
(chop
(symbol->string
(syntax->datum name:stx))))
(cond
[gen-link?
(with-syntax ([name:link name:link:stx])
(quasisyntax/loc loc
((define name:link
(unison-termlink-builtin #,name:txt)))))]
[else #'()]))
(define-for-syntax
(expand-define-unison
#:hints hints
loc name:stx arg:stx expr:stx)
(define-values
(internal? force-pure? gen-link? no-link-decl?)
(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))])
(with-syntax
([(link ...) (make-link-def gen-link? loc name:stx name:link:stx)]
[fast (make-fast-path
#:force-pure force-pure?
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 ...)))))
; Function definition supporting various unison features, like
; partial application and continuation serialization. See above for
; details.
;
; `#:internal #t` indicates that the definition is for builtin
; functions. These should always be built in a way that does not
; annotate the stack, because they don't make relevant ability
; requests. This is important for performance and some correct
; behavior (i.e. they may occur in non-unison contexts where a
; `pure?` indicator is not being threaded).
(define-syntax (define-unison stx)
(syntax-case stx ()
[(define-unison #:hints hs (name . args) . exprs)
(expand-define-unison
#:hints (syntax->datum #'hs)
stx #'name #'args #'exprs)]
[(define-unison (name . args) . exprs)
(expand-define-unison
#:hints '[internal]
stx #'name #'args #'exprs)]))
(define-syntax (define-unison-builtin stx)
(syntax-case stx ()
[(define-unison-builtin . rest)
(syntax/loc stx
(define-unison #:hints [internal gen-link] . rest))]))
; call-by-name bindings
(define-syntax name
(lambda (stx)
(syntax-case stx ()
((name ([v (f . args)] ...) body ...)
(with-syntax ([(lam ...)
(map (lambda (body)
(quasisyntax/loc stx
(lambda r #,body)))
(syntax->list #'[(apply f (append (list . args) r)) ...]))])
#`(let ([v lam] ...)
body ...))))))
(define-syntax (name stx)
(syntax-case stx ()
[(name ([v (f . args)] ...) body ...)
(syntax/loc stx
(let ([v (f #:by-name #t . args)] ...) body ...))]))
; Wrapper that more closely matches `handle` constructs
;
; Note: this uses the prompt _twice_ to achieve the sort of dynamic
; scoping we want. First we push an outer delimiter, then install
; the continuation marks corresponding to the handled abilities
; (which tells which propt to use for that ability and which
; functions to use for each request). Then we re-delimit by the same
; prompt.
;
; If we just used one delimiter, we'd have a problem. If we pushed
; the marks _after_ the delimiter, then the continuation captured
; when handling would contain those marks, and would effectively
; retain the handler for requests within the continuation. If the
; marks were outside the prompt, we'd be in a similar situation,
; except where the handler would be automatically handling requests
; within its own implementation (although, in both these cases we'd
; get control errors, because we would be using the _function_ part
; of the handler without the necessary delimiters existing on the
; continuation). Both of these situations are wrong for _shallow_
; handlers.
;
; Instead, what we need to be able to do is capture the continuation
; _up to_ the marks, then _discard_ the marks, and this is what the
; multiple delimiters accomplish. There might be more efficient ways
; to accomplish this with some specialized mark functions, but I'm
; uncertain of what pitfalls there are with regard to that (whehter
; they work might depend on exact frame structure of the
; metacontinuation).
(define-syntax handle
(syntax-rules ()
[(handle [r ...] h e ...)
(let ([p (make-prompt)])
(prompt0-at p
(let ([v (let-marks (list r ...) (cons p h)
(prompt0-at p e ...))])
(h (make-pure v)))))]))
(call-with-handler (list r ...) h (lambda () e ...))]))
; wrapper that more closely matches ability requests
(define-syntax request

12
scheme-libs/racket/unison/concurrent.ss
View File

@ -66,17 +66,17 @@
[cas! (lambda () (unsafe-struct*-cas! promise 2 value (some new-value)))]
[awake-readers (lambda () (semaphore-post (promise-semaphore promise)))])
(cond
[(some? value) false]
[(some? value) sum-false]
[else
(let ([ok (parameterize-break #f (if (cas!) (awake-readers) false))])
(if ok true (loop)))]))))
(let ([ok (parameterize-break #f (if (cas!) (awake-readers) sum-false))])
(if ok sum-true (loop)))]))))
(define (ref-cas ref ticket value)
(if (box-cas! ref ticket value) true false))
(if (box-cas! ref ticket value) sum-true sum-false))
(define (sleep n)
(sleep-secs (/ n 1000000))
(right unit))
(right sum-unit))
;; Swallows uncaught breaks/thread kills rather than logging them to
;; match the behaviour of the Haskell runtime
@ -88,5 +88,5 @@
(define (kill threadId)
(break-thread threadId)
(right unit))
(right sum-unit))
)

12
scheme-libs/racket/unison/core.ss
View File

@ -23,6 +23,7 @@
(struct-out exn:bug)
let-marks
call-with-marks
ref-mark
chunked-string-foldMap-chunks
@ -192,7 +193,9 @@
(string-append "{Value " (describe-value v) "}")]
[(unison-code v)
(string-append "{Code " (describe-value v) "}")]
[(unison-closure code env)
[(unison-cont-reflected fs) "{Continuation}"]
[(unison-cont-wrapped _) "{Continuation}"]
[(unison-closure _ code env)
(define dc
(termlink->string (lookup-function-link code) #t))
(define (f v)
@ -437,13 +440,6 @@
; [() '()]
; [(x . xs) (cons #'x (syntax->list #'xs))]))
(define (call-with-marks rs v f)
(cond
[(null? rs) (f)]
[else
(with-continuation-mark (car rs) v
(call-with-marks (cdr rs) v f))]))
(define-syntax let-marks
(syntax-rules ()
[(let-marks ks bn e ...)

187
scheme-libs/racket/unison/data.ss
View File

@ -12,6 +12,12 @@
have-code?
(struct-out unison-data)
(struct-out unison-continuation)
(struct-out unison-cont-wrapped)
(struct-out unison-cont-reflected)
(struct-out unison-frame)
(struct-out unison-frame-push)
(struct-out unison-frame-mark)
(struct-out unison-sum)
(struct-out unison-pure)
(struct-out unison-request)
@ -27,6 +33,9 @@
(struct-out unison-quote)
(struct-out unison-timespec)
call-with-handler
call-with-marks
define-builtin-link
declare-builtin-link
@ -45,9 +54,9 @@
left?
either-get
either-get
unit
false
true
sum-unit
sum-false
sum-true
bool
char
ord
@ -100,12 +109,15 @@
builtin-tls.version:typelink
unison-tuple->list
unison-pair->cons
typelink->string
termlink->string)
(require
racket
(rename-in racket
[make-continuation-prompt-tag make-prompt])
(only-in racket/control prompt0-at control0-at)
racket/fixnum
(only-in "vector-trie.rkt" ->fx/wraparound)
unison/bytevector)
@ -290,13 +302,10 @@
(write-string ")" port))
(struct unison-closure
(code env)
(arity code env)
#:transparent
#:methods gen:custom-write
[(define (write-proc clo port mode)
(define code-tl
(lookup-function-link (unison-closure-code clo)))
(define rec
(case mode
[(#t) write]
@ -308,12 +317,31 @@
(write-string " " port)
(write-sequence (unison-closure-env clo) port mode)
(write-string ")" port))]
; This has essentially becomes the slow path for unison function
; application. The definition macro immediately creates a closure
; for any statically under-saturated call or unapplied occurrence.
; 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
(case-lambda
[(clo) clo]
[(clo . rest)
(apply (unison-closure-code clo)
(append (unison-closure-env clo) rest))]))
(lambda (clo #:pure [pure? #f] #:by-name [by-name? #f] . rest)
(define arity (unison-closure-arity clo))
(define old-env (unison-closure-env clo))
(define code (unison-closure-code 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)]
[(= 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)])))
(struct unison-timespec (sec nsec)
#:transparent
@ -335,6 +363,115 @@
(list equal-proc (hash-proc 3) (hash-proc 5))))
; This is the base struct for continuation representations. It has
; two possibilities seen below.
(struct unison-continuation () #:transparent)
; This is a wrapper that allows for a struct representation of all
; continuations involved in unison. I.E. instead of just passing
; around a raw racket continuation, we wrap it in a box for easier
; identification.
(struct unison-cont-wrapped unison-continuation (cont)
; Use the wrapped continuation for procedure calls. Continuations
; will always be called via the jumpCont wrapper which exactly
; applies them to one argument.
#:property prop:procedure 0)
; Basic mechanism for installing handlers, defined here so that it
; can be used in the implementation of reflected continuations.
;
; Note: this uses the prompt _twice_ to achieve the sort of dynamic
; scoping we want. First we push an outer delimiter, then install
; the continuation marks corresponding to the handled abilities
; (which tells which propt to use for that ability and which
; functions to use for each request). Then we re-delimit by the same
; prompt.
;
; If we just used one delimiter, we'd have a problem. If we pushed
; the marks _after_ the delimiter, then the continuation captured
; when handling would contain those marks, and would effectively
; retain the handler for requests within the continuation. If the
; marks were outside the prompt, we'd be in a similar situation,
; except where the handler would be automatically handling requests
; within its own implementation (although, in both these cases we'd
; get control errors, because we would be using the _function_ part
; of the handler without the necessary delimiters existing on the
; continuation). Both of these situations are wrong for _shallow_
; handlers.
;
; Instead, what we need to be able to do is capture the continuation
; _up to_ the marks, then _discard_ the marks, and this is what the
; multiple delimiters accomplish. There might be more efficient ways
; to accomplish this with some specialized mark functions, but I'm
; uncertain of what pitfalls there are with regard to that (whehter
; they work might depend on exact frame structure of the
; metacontinuation).
(define (call-with-handler rs h f)
(let ([p (make-prompt)])
(prompt0-at p
(let ([v (call-with-marks rs (cons p h)
(lambda () (prompt0-at p (f))))])
(h (make-pure v))))))
(define (call-with-marks rs v f)
(cond
[(null? rs) (f)]
[else
(with-continuation-mark (car rs) v
(call-with-marks (cdr rs) v f))]))
; Version of the above for re-installing a handlers in the serialized
; format. In that case, there is an association list of links and
; handlers, rather than a single handler (although the separate
; handlers are likely duplicates).
(define (call-with-assoc-marks p hs f)
(match hs
['() (f)]
[(cons (cons r h) rest)
(with-continuation-mark r (cons p h)
(call-with-assoc-marks rest f))]))
(define (call-with-handler-assocs hs f)
(let ([p (make-prompt)])
(prompt0-at p
(call-with-assoc-marks p hs
(lambda () (prompt0-at p (f)))))))
(define (repush frames v)
(match frames
['() v]
[(cons (unison-frame-mark as tls hs) frames)
; handler frame; as are pending arguments, tls are typelinks
; for handled abilities; hs are associations from links to
; handler values.
;
; todo: args
(call-with-handler-assocs hs
(lambda () (repush frames v)))]
[(cons (unison-frame-push ls as rt) rest)
(displayln (list ls as rt))
(raise "repush push: not implemented yet")]))
; This is a *reflected* representation of continuations amenable
; to serialization. Most continuations won't be in this format,
; because it's foolish to eagerly parse the racket continuation if
; it's just going to be applied. But, a continuation that we've
; gotten from serialization will be in this format.
;
; `frames` should be a list of the below `unison-frame` structs.
(struct unison-cont-reflected unison-continuation (frames)
#:property prop:procedure
(lambda (cont v) (repush (unison-cont-reflected-frames cont) v)))
; Stack frames for reflected continuations
(struct unison-frame () #:transparent)
(struct unison-frame-push unison-frame
(locals args return-to))
(struct unison-frame-mark unison-frame
(args abilities handlers))
(define-syntax (define-builtin-link stx)
(syntax-case stx ()
[(_ name)
@ -344,9 +481,11 @@
[dname (datum->syntax stx
(string->symbol
(string-append
"builtin-" txt ":termlink")))])
#`(define #,dname
(unison-termlink-builtin #,(datum->syntax stx txt))))]))
"builtin-" txt ":termlink"))
#'name)])
(quasisyntax/loc stx
(define #,dname
(unison-termlink-builtin #,(datum->syntax stx txt)))))]))
(define-syntax (declare-builtin-link stx)
(syntax-case stx ()
@ -357,7 +496,8 @@
[dname (datum->syntax stx
(string->symbol
(string-append txt ":termlink")))])
#`(declare-function-link name #,dname))]))
(quasisyntax/loc stx
(declare-function-link name #,dname)))]))
(define (partial-app f . args) (unison-closure f args))
@ -382,11 +522,11 @@
; #<void> works as well
; Unit
(define unit (sum 0))
(define sum-unit (sum 0))
; Booleans are represented as numbers
(define false 0)
(define true 1)
(define sum-false 0)
(define sum-true 1)
(define (bool b) (if b 1 0))
@ -542,6 +682,13 @@
[else
(raise "unison-tuple->list: unexpected value")])))
(define (unison-pair->cons t)
(match t
[(unison-data _ _ (list x (unison-data _ _ (list y _))))
(cons x y)]
[else
(raise "unison-pair->cons: unexpected value")]))
(define (hash-string hs)
(string-append
"#"

103
scheme-libs/racket/unison/io-handles.rkt
View File

@ -3,7 +3,7 @@
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)
(only-in unison/boot data-case define-unison-builtin)
unison/data
unison/chunked-seq
unison/data
@ -15,26 +15,39 @@
(provide
unison-FOp-IO.stdHandle
unison-FOp-IO.openFile.impl.v3
(prefix-out
builtin-IO.
(combine-out
seekHandle.impl.v3
getLine.impl.v1
getSomeBytes.impl.v1
getBuffering.impl.v3
setBuffering.impl.v3
getEcho.impl.v1
setEcho.impl.v1
getArgs.impl.v1
getEnv.impl.v1
getChar.impl.v1
isFileOpen.impl.v3
isSeekable.impl.v3
handlePosition.impl.v3
process.call
getCurrentDirectory.impl.v3
ready.impl.v1
))
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
@ -49,28 +62,34 @@
[f (ref-failure-failure typeLink msg a)])
(ref-either-left f)))
(define-unison (isFileOpen.impl.v3 port)
(define-unison-builtin
(builtin-IO.isFileOpen.impl.v3 port)
(ref-either-right (not (port-closed? port))))
(define-unison (ready.impl.v1 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 (getCurrentDirectory.impl.v3 unit)
(define-unison-builtin
(builtin-IO.getCurrentDirectory.impl.v3 unit)
(ref-either-right
(string->chunked-string (path->string (current-directory)))))
(define-unison (isSeekable.impl.v3 handle)
(define-unison-builtin
(builtin-IO.isSeekable.impl.v3 handle)
(ref-either-right
(port-has-set-port-position!? handle)))
(define-unison (handlePosition.impl.v3 handle)
(define-unison-builtin
(builtin-IO.handlePosition.impl.v3 handle)
(ref-either-right (port-position handle)))
(define-unison (seekHandle.impl.v3 handle mode amount)
(define-unison-builtin
(builtin-IO.seekHandle.impl.v3 handle mode amount)
(data-case mode
(0 ()
(set-port-position! handle amount)
@ -85,14 +104,16 @@
"SeekFromEnd not supported"
0))))
(define-unison (getLine.impl.v1 handle)
(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 (getChar.impl.v1 handle)
(define-unison-builtin
(builtin-IO.getChar.impl.v1 handle)
(let* ([char (read-char handle)])
(if (eof-object? char)
(Exception
@ -101,7 +122,8 @@
ref-unit-unit)
(ref-either-right char))))
(define-unison (getSomeBytes.impl.v1 handle nbytes)
(define-unison-builtin
(builtin-IO.getSomeBytes.impl.v1 handle nbytes)
(let* ([buffer (make-bytes nbytes)]
[line (read-bytes-avail! buffer handle)])
(cond
@ -119,7 +141,8 @@
(subbytes buffer 0 line)
buffer)))])))
(define-unison (getBuffering.impl.v3 handle)
(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
@ -135,7 +158,8 @@
"Unexpected response from file-stream-buffer-mode"
ref-unit-unit)]))
(define-unison (setBuffering.impl.v3 handle mode)
(define-unison-builtin
(builtin-IO.setBuffering.impl.v3 handle mode)
(data-case mode
(0 ()
(file-stream-buffer-mode handle 'none)
@ -166,7 +190,8 @@
[(1) stdout]
[(2) stderr]))
(define-unison (getEcho.impl.v1 handle)
(define-unison-builtin
(builtin-IO.getEcho.impl.v1 handle)
(if (eq? handle stdin)
(ref-either-right (get-stdin-echo))
(Exception
@ -174,7 +199,8 @@
"getEcho only supported on stdin"
ref-unit-unit)))
(define-unison (setEcho.impl.v1 handle echo)
(define-unison-builtin
(builtin-IO.setEcho.impl.v1 handle echo)
(if (eq? handle stdin)
(begin
(if echo
@ -190,12 +216,14 @@
(let ([current (with-output-to-string (lambda () (system "stty -a")))])
(string-contains? current " echo ")))
(define-unison (getArgs.impl.v1 unit)
(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 (getEnv.impl.v1 key)
(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
@ -224,7 +252,8 @@
s)
"''"))
(define-unison (process.call command arguments)
(define-unison-builtin
(builtin-IO.process.call command arguments)
(system/exit-code
(string-join (cons
(chunked-string->string command)

75
scheme-libs/racket/unison/io.rkt
View File

@ -9,7 +9,7 @@
date-dst?
date-time-zone-offset
date*-time-zone-name)
(only-in unison/boot data-case define-unison)
(only-in unison/boot data-case define-unison-builtin)
(only-in
rnrs/arithmetic/flonums-6
flmod))
@ -33,20 +33,29 @@
getTempDirectory.impl.v3
removeFile.impl.v3
getFileSize.impl.v3))
(prefix-out
builtin-IO.
(combine-out
fileExists.impl.v3
renameFile.impl.v3
createDirectory.impl.v3
removeDirectory.impl.v3
directoryContents.impl.v3
setCurrentDirectory.impl.v3
renameDirectory.impl.v3
isDirectory.impl.v3
systemTime.impl.v3
systemTimeMicroseconds.impl.v3
createTempDirectory.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
@ -76,7 +85,8 @@
(right (file-or-directory-modify-seconds (chunked-string->string path)))))
; in haskell, it's not just file but also directory
(define-unison (fileExists.impl.v3 path)
(define-unison-builtin
(builtin-IO.fileExists.impl.v3 path)
(let ([path-string (chunked-string->string path)])
(ref-either-right
(or
@ -90,11 +100,13 @@
(define (getTempDirectory.impl.v3)
(right (string->chunked-string (path->string (find-system-path 'temp-dir)))))
(define-unison (setCurrentDirectory.impl.v3 path)
(define-unison-builtin
(builtin-IO.setCurrentDirectory.impl.v3 path)
(current-directory (chunked-string->string path))
(ref-either-right none))
(define-unison (directoryContents.impl.v3 path)
(define-unison-builtin
(builtin-IO.directoryContents.impl.v3 path)
(with-handlers
[[exn:fail:filesystem?
(lambda (e)
@ -112,7 +124,8 @@
(list* "." ".." dirss))))))))
(define-unison (createTempDirectory.impl.v3 prefix)
(define-unison-builtin
(builtin-IO.createTempDirectory.impl.v3 prefix)
(ref-either-right
(string->chunked-string
(path->string
@ -120,35 +133,43 @@
(string->bytes/utf-8
(chunked-string->string prefix)) #"")))))
(define-unison (createDirectory.impl.v3 file)
(define-unison-builtin
(builtin-IO.createDirectory.impl.v3 file)
(make-directory (chunked-string->string file))
(ref-either-right none))
(define-unison (removeDirectory.impl.v3 file)
(define-unison-builtin
(builtin-IO.removeDirectory.impl.v3 file)
(delete-directory/files (chunked-string->string file))
(ref-either-right none))
(define-unison (isDirectory.impl.v3 path)
(define-unison-builtin
(builtin-IO.isDirectory.impl.v3 path)
(ref-either-right
(directory-exists? (chunked-string->string path))))
(define-unison (renameDirectory.impl.v3 old new)
(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 (renameFile.impl.v3 old new)
(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 (systemTime.impl.v3 unit)
(define-unison-builtin
(builtin-IO.systemTime.impl.v3 unit)
(ref-either-right (current-seconds)))
(define-unison (systemTimeMicroseconds.impl.v3 unit)
(define-unison-builtin
(builtin-IO.systemTimeMicroseconds.impl.v3 unit)
(ref-either-right (inexact->exact (* 1000 (current-inexact-milliseconds)))))
(define-unison (builtin-Clock.internals.systemTimeZone.v1 secs)
(define-unison-builtin
(builtin-Clock.internals.systemTimeZone.v1 secs)
(let* ([d (seconds->date secs)])
(list->unison-tuple
(list

102
scheme-libs/racket/unison/math.rkt
View File

@ -7,24 +7,39 @@
clamp-integer
clamp-natural
data-case
define-unison
define-unison-builtin
nbit63))
(provide
builtin-Float.exp
builtin-Float.log
builtin-Float.max
builtin-Float.min
builtin-Float.tan
builtin-Float.tanh
builtin-Float.logBase
builtin-Int.*
builtin-Int.pow
builtin-Int.trailingZeros
builtin-Nat.trailingZeros
builtin-Int.popCount
builtin-Nat.popCount
builtin-Float.pow
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
@ -71,21 +86,50 @@
SINF
ITOF)))
(define-unison (builtin-Float.logBase base num) (log num base))
(define-unison-builtin
(builtin-Float.logBase base num)
(log num base))
(define (LOGB base num) (log num base))
(define-unison (builtin-Float.exp n) (exp n))
(define-unison (builtin-Float.log n) (log n))
(define-unison (builtin-Float.max n m) (max n m))
(define-unison (builtin-Float.min n m) (min n m))
(define-unison (builtin-Float.tan n) (tan n))
(define-unison (builtin-Float.tanh n) (tanh n))
(define-unison (builtin-Int.* n m) (clamp-integer (* n m)))
(define-unison (builtin-Int.pow n m) (clamp-integer (expt n m)))
(define-unison (builtin-Int.trailingZeros n) (TZRO n))
(define-unison (builtin-Nat.trailingZeros n) (TZRO n))
(define-unison (builtin-Nat.popCount n) (POPC n))
(define-unison (builtin-Int.popCount n) (POPC n))
(define-unison (builtin-Float.pow n m) (expt n m))
(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)

184
scheme-libs/racket/unison/primops-generated.rkt
View File

@ -31,9 +31,11 @@
builtin-sandboxLinks
builtin-sandboxLinks:termlink
builtin-Code.dependencies:termlink
builtin-Code.deserialize:termlink
builtin-Code.serialize:termlink
builtin-Code.validateLinks:termlink
builtin-Value.dependencies:termlink
builtin-Value.deserialize:termlink
builtin-Value.serialize:termlink
builtin-crypto.hash:termlink
@ -54,21 +56,15 @@
build-runtime-module
termlink->proc)
(define-builtin-link Value.value)
(define-builtin-link Value.reflect)
(define-builtin-link Code.isMissing)
(define-builtin-link Code.lookup)
(define-builtin-link Code.dependencies)
(define-builtin-link Code.deserialize)
(define-builtin-link Code.serialize)
(define-builtin-link Code.validateLinks)
(define-builtin-link Value.dependencies)
(define-builtin-link Value.deserialize)
(define-builtin-link Value.serialize)
(define-builtin-link crypto.hash)
(define-builtin-link crypto.hmac)
(define-builtin-link validateSandboxed)
(define-builtin-link Value.validateSandboxed)
(define-builtin-link sandboxLinks)
(define (chunked-list->list cl)
(vector->list (chunked-list->vector cl)))
@ -129,14 +125,33 @@
(raise
(format "decode-binding: unimplemented case: ~a" bn))]))
(define (decode-hints hs)
(define (hint->sym t)
(cond
[(= t ref-defnhint-internal:tag) 'internal]
[(= t ref-defnhint-genlink:tag) 'gen-link]
[(= t ref-defnhint-nolinkdecl:tag) 'no-link-decl]))
(for/fold ([def 'define-unison] [out '()]) ([h hs])
(match h
[(unison-data _ t (list))
#:when (= t ref-defnhint-builtin:tag)
(values 'define-unison-builtin out)]
[(unison-data _ t (list))
(values def (cons (hint->sym t) out))])))
(define (decode-syntax dfn)
(match dfn
[(unison-data _ t (list nm vs bd))
[(unison-data _ t (list nm hs vs bd))
#:when (= t ref-schemedefn-define:tag)
(let ([head (map text->ident
(cons nm (chunked-list->list vs)))]
[body (decode-term bd)])
(list 'define-unison head body))]
(let-values
([(head) (map text->ident
(cons nm (chunked-list->list vs)))]
[(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)))]
[(unison-data _ t (list nm bd))
#:when (= t ref-schemedefn-alias:tag)
(list 'define (text->ident nm) (decode-term bd))]
@ -195,20 +210,17 @@
(describe-value tl)))]
[1 (rf) rf]))
(define-syntax make-group-ref-decoder
(lambda (stx)
(syntax-case stx ()
[(_)
#`(lambda (gr)
(data-case (group-ref-ident gr)
[#,ref-schemeterm-ident:tag (name) name]
[else
(raise
(format
"decode-group-ref: unimplemented data case: ~a"
(describe-value gr)))]))])))
(define (decode-group-ref gr0)
(match (group-ref-ident gr0)
[(unison-data _ t (list name))
#:when (= t ref-schemeterm-ident:tag)
name]
[else
(raise
(format
"decode-group-ref: unimplemented data case: ~a"
(describe-value gr0)))]))
(define decode-group-ref (make-group-ref-decoder))
(define (group-ref-sym gr)
(string->symbol
(chunked-string->string
@ -301,6 +313,70 @@
[else
(raise (format "decode-vlit: unimplemented case: !a" vl))])]))
(define (reify-handlers hs)
(for/list ([h (chunked-list->list hs)])
(match (unison-pair->cons h)
[(cons r h)
(cons (reference->typelink r)
(reify-value h))])))
(define (reflect-handlers hs)
(list->chunked-list
(for/list ([h hs])
(match h
[(cons r h)
(unison-tuple
(typelink->reference r)
(reflect-value h))]))))
(define (reify-groupref gr0)
(match gr0
[(unison-data _ t (list r i))
#: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
[(unison-data _ t (list))
#:when (= t ref-cont-empty:tag)
(unison-cont-reflected (reverse frames))]
[(unison-data _ t (list l a gr0 k))
#:when (= t ref-cont-push:tag)
(cond
[(>= (length vs) (+ l a))
(let*-values
([(locals int) (split-at vs l)]
[(args rest) (split-at int a)]
[(gr) (reify-groupref gr0)]
[(fm) (unison-frame-push locals args gr)])
(rec k rest (cons fm frames)))]
[else
(raise
(make-exn:bug
"reify-value: malformed continuation"
orig))])]
[(unison-data _ t (list a rs0 de0 k))
#:when (= t ref-cont-mark:tag)
(cond
[(>= (length vs) a)
(let*-values
([(args rest) (split-at vs a)]
[(rs) (map reference->termlink (chunked-list->list rs0))]
[(hs) (reify-handlers de0)]
[(fm) (unison-frame-mark args rs hs)])
(rec k rest (cons fm frames)))]
[else
(raise
(make-exn:bug
"reify-value: malformed continuation"
orig))])])))
(define (reify-value v)
(match v
[(unison-data _ t (list rf rt bs0))
@ -327,16 +403,14 @@
#:when (= t ref-value-partial:tag)
(let ([bs (map reify-value (chunked-list->list bs0))]
[proc (resolve-proc gr)])
(apply proc bs))]
(struct-copy unison-closure proc [env bs]))]
[(unison-data _ t (list vl))
#:when (= t ref-value-vlit:tag)
(reify-vlit vl)]
[(unison-data _ t (list bs0 k))
[(unison-data _ t (list vs0 k))
#:when (= t ref-value-cont:tag)
(raise
(make-exn:bug
"reify-value: unimplemented cont case"
ref-unit-unit))]
(parse-continuation v k
(map reify-value (chunked-list->list vs0)))]
[(unison-data r t fs)
(raise
(make-exn:bug
@ -413,14 +487,34 @@
(ref-value-vlit (ref-vlit-typelink (reflect-typelink v)))]
[(unison-code sg) (ref-value-vlit (ref-vlit-code sg))]
[(unison-quote q) (ref-value-vlit (ref-vlit-quote q))]
[(unison-closure f as)
[(unison-cont-reflected frames0)
(for/foldr ([k ref-cont-empty]
[vs '()]
#:result
(ref-value-cont
(list->chunked-list (map reflect-value vs))
k))
([frame frames0])
(match frame
[(unison-frame-push locals args return-to)
(values
(ref-cont-push
(length locals)
(length args)
(reflect-groupref return-to)
k)
(append locals args vs))]
[(unison-frame-mark args refs hs)
(values
(ref-cont-mark
(length args)
(map typelink->reference refs)
(reflect-handlers hs))
(append args vs))]))]
[(unison-closure arity f as)
(ref-value-partial
(function->groupref f)
(list->chunked-list (map reflect-value as)))]
[(? procedure?)
(ref-value-partial
(function->groupref v)
empty-chunked-list)]
[(unison-data rf t fs)
(ref-value-data
(reflect-typelink rf)
@ -438,7 +532,7 @@
[(? chunked-list?)
(for/fold ([acc '()]) ([e (in-chunked-list v)])
(append (sandbox-value ok e) acc))]
[(unison-closure f as)
[(unison-closure arity f as)
(for/fold ([acc (sandbox-proc ok f)]) ([a (in-list as)])
(append (sandbox-scheme-value ok a) acc))]
[(? procedure?) (sandbox-proc ok v)]
@ -474,11 +568,11 @@
[(unison-quote v) (sandbox-value ok v)]))
; replacment for Value.unsafeValue : a -> Value
(define-unison
(define-unison-builtin
(builtin-Value.reflect v)
(reflect-value v))
(define-unison
(define-unison-builtin
(builtin-Value.value v)
(let ([rv (reflect-value v)])
(unison-quote rv)))
@ -706,23 +800,23 @@
(define (unison-POp-LKUP tl) (lookup-code tl))
(define-unison (builtin-Code.lookup tl)
(define-unison-builtin (builtin-Code.lookup tl)
(match (lookup-code tl)
[(unison-sum 0 (list)) ref-optional-none]
[(unison-sum 1 (list co)) (ref-optional-some co)]))
(define-unison (builtin-validateSandboxed ok v)
(define-unison-builtin (builtin-validateSandboxed ok v)
(let ([l (sandbox-scheme-value (chunked-list->list ok) v)])
(null? l)))
(define-unison (builtin-sandboxLinks tl) (check-sandbox tl))
(define-unison-builtin (builtin-sandboxLinks tl) (check-sandbox tl))
(define-unison (builtin-Code.isMissing tl)
(define-unison-builtin (builtin-Code.isMissing tl)
(cond
[(unison-termlink-builtin? tl) #f]
[(unison-termlink-con? tl) #f]
[(have-code? tl) #t]
[else #f]))
(define-unison (builtin-Value.validateSandboxed ok v)
(define-unison-builtin (builtin-Value.validateSandboxed ok v)
(sandbox-quoted (chunked-list->list ok) v))

2891
scheme-libs/racket/unison/primops.ss
View File

File diff suppressed because it is too large Load Diff

2
scheme-libs/racket/unison/sandbox.rkt
View File

@ -4,7 +4,7 @@
(provide expand-sandbox check-sandbox set-sandbox)
(require racket racket/hash)
(require (except-in unison/data true false unit))
(require unison/data)
; sandboxing information
(define sandbox-links (make-hash))

125
scheme-libs/racket/unison/udp.rkt
View File

@ -2,7 +2,7 @@
#lang racket/base
(require racket/udp
racket/format
(only-in unison/boot define-unison)
(only-in unison/boot define-unison-builtin)
unison/data
unison/data-info
unison/chunked-seq
@ -11,32 +11,29 @@
unison/core)
(provide
(prefix-out
builtin-IO.UDP.
(combine-out
clientSocket.impl.v1
clientSocket.impl.v1:termlink
UDPSocket.recv.impl.v1
UDPSocket.recv.impl.v1:termlink
UDPSocket.send.impl.v1
UDPSocket.send.impl.v1:termlink
UDPSocket.close.impl.v1
UDPSocket.close.impl.v1:termlink
ListenSocket.close.impl.v1
ListenSocket.close.impl.v1:termlink
UDPSocket.toText.impl.v1
UDPSocket.toText.impl.v1:termlink
serverSocket.impl.v1
serverSocket.impl.v1:termlink
ListenSocket.toText.impl.v1
ListenSocket.toText.impl.v1:termlink
ListenSocket.recvFrom.impl.v1
ListenSocket.recvFrom.impl.v1:termlink
ClientSockAddr.toText.v1
ClientSockAddr.toText.v1:termlink
ListenSocket.sendTo.impl.v1
ListenSocket.sendTo.impl.v1: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)
(struct client-sock-addr (host port))
@ -48,10 +45,10 @@
(sum-case a
(0 (type msg meta)
(ref-either-left (ref-failure-failure type msg (unison-any-any meta))))
(1 (data)
(1 (data)
(ref-either-right data))))
(define
(define
(format-socket socket)
(let*-values ([(local-hn local-port remote-hn remote-port) (udp-addresses socket #t)]
[(rv) (~a "<socket local=" local-hn ":" local-port " remote=" remote-hn ":" remote-port ">")])
@ -64,7 +61,7 @@
(wrap-in-either rv)))
;; define termlink builtins
(define clientSocket.impl.v1:termlink
(define clientSocket.impl.v1:termlink
(unison-termlink-builtin "IO.UDP.clientSocket.impl.v1"))
(define UDPSocket.recv.impl.v1:termlink
(unison-termlink-builtin "IO.UDP.UDPSocket.recv.impl.v1"))
@ -72,7 +69,7 @@
(unison-termlink-builtin "IO.UDP.UDPSocket.send.impl.v1"))
(define UDPSocket.close.impl.v1:termlink
(unison-termlink-builtin "IO.UDP.UDPSocket.close.impl.v1"))
(define ListenSocket.close.impl.v1:termlink
(define ListenSocket.close.impl.v1:termlink
(unison-termlink-builtin "IO.UDP.ListenSocket.close.impl.v1"))
(define UDPSocket.toText.impl.v1:termlink
(unison-termlink-builtin "IO.UDP.UDPSocket.toText.impl.v1"))
@ -89,22 +86,25 @@
;; define builtins
(define-unison
(UDPSocket.recv.impl.v1 socket) ; socket -> Either Failure Bytes
(let
([rv (handle-errors (lambda()
(define-unison-builtin
(builtin-IO.UDP.UDPSocket.recv.impl.v1 socket)
; socket -> Either Failure Bytes
(let
([rv (handle-errors (lambda()
(let*-values
([(buffer) (make-bytes buffer-size)]
[(len a b) (udp-receive! socket buffer)])
(right (bytes->chunked-bytes (subbytes buffer 0 len))))))])
(wrap-in-either rv)))
(define-unison
(ListenSocket.close.impl.v1 socket) ; socket -> Either Failure ()
(define-unison-builtin
(builtin-IO.UDP.ListenSocket.close.impl.v1 socket)
; socket -> Either Failure ()
(close-socket socket))
(define-unison
(serverSocket.impl.v1 ip port) ; string string -> Either Failure socket
(define-unison-builtin
(builtin-IO.UDP.serverSocket.impl.v1 ip port)
; string string -> Either Failure socket
(let
([result (handle-errors (lambda()
(let* ([iip (chunked-string->string ip)]
@ -115,12 +115,13 @@
(right sock)))))])
(wrap-in-either result)))
(define-unison
(ListenSocket.recvFrom.impl.v1 socket) ; socket -> Either Failure (Bytes, ClientSockAddr)
(let ([result (handle-errors (lambda()
(define-unison-builtin
(builtin-IO.UDP.ListenSocket.recvFrom.impl.v1 socket)
; socket -> Either Failure (Bytes, ClientSockAddr)
(let ([result (handle-errors (lambda()
(if (not (udp? socket))
(raise-argument-error 'socket "a UDP socket" socket)
(let*-values
(let*-values
([(buffer) (make-bytes buffer-size)]
[(len host port) (udp-receive! socket buffer)]
[(csa) (client-sock-addr host port)]
@ -129,18 +130,20 @@
(right (ref-tuple-pair chunked (ref-tuple-pair csa ref-unit-unit)))))))])
(wrap-in-either result)))
(define-unison
(UDPSocket.send.impl.v1 socket data) ; socket -> Bytes -> Either Failure ()
(define-unison-builtin
(builtin-IO.UDP.UDPSocket.send.impl.v1 socket data)
; socket -> Bytes -> Either Failure ()
(let
([result (handle-errors (lambda () (begin
(udp-send socket (chunked-bytes->bytes data))
(udp-send socket (chunked-bytes->bytes data))
(right ref-unit-unit))))])
(wrap-in-either result)))
(define-unison
(ListenSocket.sendTo.impl.v1 sock bytes addr) ; socket -> Bytes -> ClientSockAddr -> Either Failure ()
(define-unison-builtin
(builtin-IO.UDP.ListenSocket.sendTo.impl.v1 sock bytes addr)
; socket -> Bytes -> ClientSockAddr -> Either Failure ()
(let
([result (handle-errors (lambda()
([result (handle-errors (lambda()
(let* ([host (client-sock-addr-host addr)]
[port (client-sock-addr-port addr)]
[bytes (chunked-bytes->bytes bytes)])
@ -149,28 +152,32 @@
(right ref-unit-unit)))))])
(wrap-in-either result)))
(define-unison
(UDPSocket.toText.impl.v1 socket) ; socket -> string
(define-unison-builtin
(builtin-IO.UDP.UDPSocket.toText.impl.v1 socket) ; socket -> string
(format-socket socket))
(define-unison
(ClientSockAddr.toText.v1 addr) ; ClientSocketAddr -> string
(define-unison-builtin
(builtin-IO.UDP.ClientSockAddr.toText.v1 addr)
; ClientSocketAddr -> string
(string->chunked-string (format "<client-sock-addr ~a ~a>" (client-sock-addr-host addr) (client-sock-addr-port addr))))
(define-unison
(ListenSocket.toText.impl.v1 socket) ; socket -> string
(define-unison-builtin
(builtin-IO.UDP.ListenSocket.toText.impl.v1 socket)
; socket -> string
(format-socket socket))
(define-unison
(UDPSocket.close.impl.v1 socket) ; socket -> Either Failure ()
(define-unison-builtin
(builtin-IO.UDP.UDPSocket.close.impl.v1 socket)
; socket -> Either Failure ()
(let
([rv (handle-errors (lambda() (begin
(udp-close socket)
(right ref-unit-unit))))])
(wrap-in-either rv)))
(define-unison
(clientSocket.impl.v1 host port) ; string string -> Either Failure socket
(define-unison-builtin
(builtin-IO.UDP.clientSocket.impl.v1 host port)
; string string -> Either Failure socket
(let ([rv (handle-errors (lambda() (let* ([pport (string->number (chunked-string->string port))]
[hhost (chunked-string->string host)]
[sock (udp-open-socket hhost pport)]

1
stack.yaml
View File

@ -29,7 +29,6 @@ packages:
- lib/unison-util-bytes
- lib/unison-util-cache
- lib/unison-util-file-embed
- lib/unison-util-nametree
- lib/unison-util-relation
- lib/unison-util-rope
- parser-typechecker

1
unison-cli/package.yaml
View File

@ -93,7 +93,6 @@ dependencies:
- unison-sqlite
- unison-syntax
- unison-util-base32hex
- unison-util-nametree
- unison-util-relation
- unliftio
- unordered-containers

28
unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
View File

@ -77,7 +77,6 @@ import Unison.Codebase.Editor.HandleInput.NamespaceDiffUtils (diffHelper)
import Unison.Codebase.Editor.HandleInput.ProjectClone (handleClone)
import Unison.Codebase.Editor.HandleInput.ProjectCreate (projectCreate)
import Unison.Codebase.Editor.HandleInput.ProjectRename (handleProjectRename)
import Unison.Codebase.Editor.HandleInput.Todo (handleTodo)
import Unison.Codebase.Editor.HandleInput.ProjectSwitch (projectSwitch)
import Unison.Codebase.Editor.HandleInput.Projects (handleProjects)
import Unison.Codebase.Editor.HandleInput.Pull (handlePull, mergeBranchAndPropagateDefaultPatch)
@ -88,6 +87,7 @@ import Unison.Codebase.Editor.HandleInput.RuntimeUtils qualified as RuntimeUtils
import Unison.Codebase.Editor.HandleInput.ShowDefinition (showDefinitions)
import Unison.Codebase.Editor.HandleInput.TermResolution (resolveMainRef)
import Unison.Codebase.Editor.HandleInput.Tests qualified as Tests
import Unison.Codebase.Editor.HandleInput.Todo (handleTodo)
import Unison.Codebase.Editor.HandleInput.UI (openUI)
import Unison.Codebase.Editor.HandleInput.Update (doSlurpAdds, handleUpdate)
import Unison.Codebase.Editor.HandleInput.Update2 (handleUpdate2)
@ -104,7 +104,6 @@ import Unison.Codebase.Editor.StructuredArgument qualified as SA
import Unison.Codebase.IntegrityCheck qualified as IntegrityCheck (integrityCheckFullCodebase)
import Unison.Codebase.Metadata qualified as Metadata
import Unison.Codebase.Path (Path, Path' (..))
import Unison.Codebase.Path qualified as HQSplit'
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.Runtime qualified as Runtime
import Unison.Codebase.ShortCausalHash qualified as SCH
@ -119,7 +118,6 @@ import Unison.DataDeclaration qualified as DD
import Unison.Hash qualified as Hash
import Unison.HashQualified qualified as HQ
import Unison.HashQualified' qualified as HQ'
import Unison.HashQualified' qualified as HashQualified
import Unison.LabeledDependency (LabeledDependency)
import Unison.LabeledDependency qualified as LD
import Unison.LabeledDependency qualified as LabeledDependency
@ -494,7 +492,7 @@ loop e = do
description <- inputDescription input
Cli.stepAt description (BranchUtil.makeAddTermName (first Path.unabsolute dest) srcTerm)
Cli.respond Success
AliasTypeI src' dest' -> do
AliasTypeI force src' dest' -> do
src <- traverseOf _Right Cli.resolveSplit' src'
srcTypes <-
either
@ -512,7 +510,7 @@ loop e = do
pure (DeleteNameAmbiguous hqLength name Set.empty srcTypes)
dest <- Cli.resolveSplit' dest'
destTypes <- Cli.getTypesAt (HQ'.NameOnly <$> dest)
when (not (Set.null destTypes)) do
when (not force && not (Set.null destTypes)) do
Cli.returnEarly (TypeAlreadyExists dest' destTypes)
description <- inputDescription input
Cli.stepAt description (BranchUtil.makeAddTypeName (first Path.unabsolute dest) srcType)
@ -574,7 +572,7 @@ loop e = do
(Just as1, Just as2) -> (missingSrcs, actions ++ as1 ++ as2)
fixupOutput :: Path.HQSplit -> HQ.HashQualified Name
fixupOutput = fmap Path.unsafeToName . HQ'.toHQ . Path.unsplitHQ
fixupOutput = HQ'.toHQ . Path.nameFromHQSplit
NamesI global query -> do
hqLength <- Cli.runTransaction Codebase.hashLength
root <- Cli.getRootBranch
@ -659,7 +657,7 @@ loop e = do
description <- inputDescription input
let toDelete =
Names.prefix0
(Path.unsafeToName (Path.unsplit (p)))
(Path.nameFromSplit' $ first (Path.RelativePath' . Path.Relative) p)
(Branch.toNames (Branch.head branch))
afterDelete <- do
names <- Cli.currentNames
@ -980,11 +978,11 @@ inputDescription input =
AliasTermI force src0 dest0 -> do
src <- hhqs' src0
dest <- ps' dest0
pure ((if force then "alias.term.force " else "alias.term ") <> src <> " " <> dest)
AliasTypeI src0 dest0 -> do
pure ((if force then "debug.alias.term.force " else "alias.term ") <> src <> " " <> dest)
AliasTypeI force src0 dest0 -> do
src <- hhqs' src0
dest <- ps' dest0
pure ("alias.type " <> src <> " " <> dest)
pure ((if force then "debug.alias.type.force " else "alias.term ") <> src <> " " <> dest)
AliasManyI srcs0 dest0 -> do
srcs <- traverse hqs srcs0
dest <- p' dest0
@ -1540,7 +1538,7 @@ delete input doutput getTerms getTypes hqs' = do
then do
let toName :: [(Path.HQSplit', Set Reference, Set referent)] -> [Name]
toName notFounds =
mapMaybe (\(split, _, _) -> Path.toName' $ HashQualified.toName (HQSplit'.unsplitHQ' split)) notFounds
map (\(split, _, _) -> HQ'.toName $ Path.nameFromHQSplit' split) notFounds
Cli.returnEarly $ NamesNotFound (toName notFounds)
else do
checkDeletes typesTermsTuple doutput input
@ -1551,8 +1549,14 @@ checkDeletes typesTermsTuples doutput inputs = do
(Path.HQSplit', Set Reference, Set Referent) ->
Cli (Path.Split, Name, Set Reference, Set Referent)
toSplitName hq = do
-- __FIXME__: `resolvedPath` is ostensiby `Absolute`, but the paths here must be `Relative` below
resolvedPath <- first Path.unabsolute <$> Cli.resolveSplit' (HQ'.toName <$> hq ^. _1)
return (resolvedPath, Path.unsafeToName (Path.unsplit resolvedPath), hq ^. _2, hq ^. _3)
return
( resolvedPath,
Path.nameFromSplit' $ first (Path.RelativePath' . Path.Relative) resolvedPath,
hq ^. _2,
hq ^. _3
)
-- get the splits and names with terms and types
splitsNames <- traverse toSplitName typesTermsTuples
let toRel :: (Ord ref) => Set ref -> Name -> R.Relation Name ref

76
unison-cli/src/Unison/Codebase/Editor/HandleInput/Tests.hs
View File

@ -14,7 +14,6 @@ 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.Tuple qualified as Tuple
import Unison.ABT qualified as ABT
import Unison.Builtin.Decls qualified as DD
import Unison.Cli.Monad (Cli)
@ -69,21 +68,24 @@ handleTest TestInput {includeLibNamespace, path, showFailures, showSuccesses} =
Map.fromList <$> Cli.runTransaction do
Set.toList testRefs & wither \case
rid -> fmap (rid,) <$> Codebase.getWatch codebase WK.TestWatch rid
let (oks, fails) = passFails cachedTests
passFails :: (Ord r) => Map r (Term v a) -> ([(r, Text)], [(r, Text)])
passFails = Tuple.swap . partitionEithers . concat . map p . Map.toList
let (fails, oks) = passFails cachedTests
passFails :: (Ord r) => Map r (Term v a) -> (Map r [Text], Map r [Text])
passFails =
Map.foldrWithKey
(\r v (f, o) -> bimap (\ts -> if null ts then f else Map.insert r ts f) (\ts -> if null ts then o else Map.insert r ts o) . partitionEithers $ p v)
(Map.empty, Map.empty)
where
p :: (r, Term v a) -> [Either (r, Text) (r, Text)]
p (r, tm) = case tm of
Term.List' ts -> mapMaybe (q r) (toList ts)
p :: Term v a -> [Either Text Text]
p = \case
Term.List' ts -> mapMaybe q $ toList ts
_ -> []
q r = \case
q = \case
Term.App' (Term.Constructor' (ConstructorReference ref cid)) (Term.Text' msg) ->
if
| ref == DD.testResultRef ->
if
| cid == DD.okConstructorId -> Just (Right (r, msg))
| cid == DD.failConstructorId -> Just (Left (r, msg))
| cid == DD.okConstructorId -> Just (Right msg)
| cid == DD.failConstructorId -> Just (Left msg)
| otherwise -> Nothing
| otherwise -> Nothing
_ -> Nothing
@ -91,7 +93,7 @@ handleTest TestInput {includeLibNamespace, path, showFailures, showSuccesses} =
names <- Cli.currentNames
pped <- Cli.prettyPrintEnvDeclFromNames names
let fqnPPE = PPED.unsuffixifiedPPE pped
Cli.respond $
Cli.respondNumbered $
TestResults
stats
fqnPPE
@ -123,8 +125,8 @@ handleTest TestInput {includeLibNamespace, path, showFailures, showSuccesses} =
pure [(r, tm')]
let m = Map.fromList computedTests
(mOks, mFails) = passFails m
Cli.respond $ TestResults Output.NewlyComputed fqnPPE showSuccesses showFailures mOks mFails
(mFails, mOks) = passFails m
Cli.respondNumbered $ TestResults Output.NewlyComputed fqnPPE showSuccesses showFailures mOks mFails
handleIOTest :: HQ.HashQualified Name -> Cli ()
handleIOTest main = do
@ -135,11 +137,15 @@ handleIOTest main = do
let isIOTest typ = Foldable.any (Typechecker.isSubtype typ) $ Runtime.ioTestTypes runtime
refs <- resolveHQNames names (Set.singleton main)
(fails, oks) <-
refs & foldMapM \(ref, typ) -> do
when (not $ isIOTest typ) do
Cli.returnEarly (BadMainFunction "io.test" main typ suffixifiedPPE (Foldable.toList $ Runtime.ioTestTypes runtime))
runIOTest suffixifiedPPE ref
Cli.respond $ TestResults Output.NewlyComputed suffixifiedPPE True True oks fails
Foldable.foldrM
( \(ref, typ) (f, o) -> do
when (not $ isIOTest typ) $
Cli.returnEarly (BadMainFunction "io.test" main typ suffixifiedPPE (Foldable.toList $ Runtime.ioTestTypes runtime))
bimap (\ts -> if null ts then f else Map.insert ref ts f) (\ts -> if null ts then o else Map.insert ref ts o) <$> runIOTest suffixifiedPPE ref
)
(Map.empty, Map.empty)
refs
Cli.respondNumbered $ TestResults Output.NewlyComputed suffixifiedPPE True True oks fails
findTermsOfTypes :: Codebase.Codebase m Symbol Ann -> Bool -> Path -> NESet (Type.Type Symbol Ann) -> Cli (Set TermReferenceId)
findTermsOfTypes codebase includeLib path filterTypes = do
@ -163,16 +169,21 @@ handleAllIOTests = do
let suffixifiedPPE = PPED.suffixifiedPPE pped
ioTestRefs <- findTermsOfTypes codebase False Path.empty (Runtime.ioTestTypes runtime)
case NESet.nonEmptySet ioTestRefs of
Nothing -> Cli.respond $ TestResults Output.NewlyComputed suffixifiedPPE True True [] []
Nothing -> Cli.respondNumbered $ TestResults Output.NewlyComputed suffixifiedPPE True True Map.empty Map.empty
Just neTestRefs -> do
let total = NESet.size neTestRefs
(fails, oks) <-
toList neTestRefs & zip [1 :: Int ..] & foldMapM \(n, r) -> do
Cli.respond $ TestIncrementalOutputStart suffixifiedPPE (n, total) r
(fails, oks) <- runIOTest suffixifiedPPE r
Cli.respond $ TestIncrementalOutputEnd suffixifiedPPE (n, total) r (null fails)
pure (fails, oks)
Cli.respond $ TestResults Output.NewlyComputed suffixifiedPPE True True oks fails
toList neTestRefs
& zip [1 :: Int ..]
& Foldable.foldrM
( \(n, r) (f, o) -> do
Cli.respond $ TestIncrementalOutputStart suffixifiedPPE (n, total) r
(fails, oks) <- runIOTest suffixifiedPPE r
Cli.respond $ TestIncrementalOutputEnd suffixifiedPPE (n, total) r (null fails)
pure (if null fails then f else Map.insert r fails f, if null oks then o else Map.insert r oks o)
)
(Map.empty, Map.empty)
Cli.respondNumbered $ TestResults Output.NewlyComputed suffixifiedPPE True True oks fails
resolveHQNames :: Names -> Set (HQ.HashQualified Name) -> Cli (Set (Reference.Id, Type.Type Symbol Ann))
resolveHQNames parseNames hqNames =
@ -197,19 +208,16 @@ resolveHQNames parseNames hqNames =
typ <- MaybeT (Codebase.getTypeOfReferent codebase (Referent.fromTermReferenceId ref))
pure (ref, typ)
runIOTest :: PPE.PrettyPrintEnv -> Reference.Id -> Cli ([(Reference.Id, Text)], [(Reference.Id, Text)])
runIOTest :: PPE.PrettyPrintEnv -> Reference.Id -> Cli ([Text], [Text])
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
pure $ partitionTestResults [(ref, tm')]
pure $ partitionTestResults tm'
partitionTestResults ::
[(Reference.Id, Term Symbol Ann)] ->
([(Reference.Id, Text {- fails -})], [(Reference.Id, Text {- oks -})])
partitionTestResults results = fold $ do
(ref, tm) <- results
partitionTestResults :: Term Symbol Ann -> ([Text {- fails -}], [Text {- oks -}])
partitionTestResults tm = fold $ do
element <- case tm of
Term.List' ts -> toList ts
_ -> empty
@ -217,8 +225,8 @@ partitionTestResults results = fold $ do
Term.App' (Term.Constructor' (ConstructorReference conRef cid)) (Term.Text' msg) -> do
guard (conRef == DD.testResultRef)
if
| cid == DD.okConstructorId -> pure (mempty, [(ref, msg)])
| cid == DD.failConstructorId -> pure ([(ref, msg)], mempty)
| cid == DD.okConstructorId -> pure (mempty, [msg])
| cid == DD.failConstructorId -> pure ([msg], mempty)
| otherwise -> empty
_ -> empty

2
unison-cli/src/Unison/Codebase/Editor/Input.hs
View File

@ -133,7 +133,7 @@ data Input
-- > names #sdflkjsdfhsdf
NamesI IsGlobal (HQ.HashQualified Name)
| AliasTermI !Bool HashOrHQSplit' Path.Split' -- bool = force?
| AliasTypeI HashOrHQSplit' Path.Split'
| AliasTypeI !Bool HashOrHQSplit' Path.Split' -- bool = force?
| AliasManyI [Path.HQSplit] Path'
| MoveAllI Path.Path' Path.Path'
| -- Move = Rename; It's an HQSplit' not an HQSplit', meaning the arg has to have a name.

27
unison-cli/src/Unison/Codebase/Editor/Output.hs
View File

@ -9,6 +9,7 @@ module Unison.Codebase.Editor.Output
HistoryTail (..),
TestReportStats (..),
TodoOutput (..),
todoOutputIsEmpty,
UndoFailureReason (..),
ShareError (..),
UpdateOrUpgrade (..),
@ -18,6 +19,7 @@ module Unison.Codebase.Editor.Output
where
import Data.List.NonEmpty (NonEmpty)
import Data.Set qualified as Set
import Data.Set.NonEmpty (NESet)
import Data.Time (UTCTime)
import Network.URI (URI)
@ -76,10 +78,11 @@ import Unison.Term (Term)
import Unison.Type (Type)
import Unison.Typechecker.Context qualified as Context
import Unison.UnisonFile qualified as UF
import Unison.Util.Defns (DefnsF)
import Unison.Util.Defns (DefnsF, defnsAreEmpty)
import Unison.Util.Pretty qualified as P
import Unison.Util.Relation (Relation)
import Unison.WatchKind qualified as WK
import qualified Unison.Names as Names
type ListDetailed = Bool
@ -119,6 +122,13 @@ data NumberedOutput
| ShowDiffAfterPull Path.Path' Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann)
| -- <authorIdentifier> <authorPath> <relativeBase>
ShowDiffAfterCreateAuthor NameSegment Path.Path' Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput Symbol Ann)
| TestResults
TestReportStats
PPE.PrettyPrintEnv
ShowSuccesses
ShowFailures
(Map TermReferenceId [Text]) -- oks
(Map TermReferenceId [Text]) -- fails
| Output'Todo !TodoOutput
| -- | CantDeleteDefinitions ppe couldntDelete becauseTheseStillReferenceThem
CantDeleteDefinitions PPE.PrettyPrintEnvDecl (Map LabeledDependency (NESet LabeledDependency))
@ -150,6 +160,12 @@ data TodoOutput = TodoOutput
ppe :: !PrettyPrintEnvDecl
}
todoOutputIsEmpty :: TodoOutput -> Bool
todoOutputIsEmpty todo =
Set.null todo.dependentsOfTodo
&& defnsAreEmpty todo.directDependenciesWithoutNames
&& Names.isEmpty todo.nameConflicts
data AmbiguousReset'Argument
= AmbiguousReset'Hash
| AmbiguousReset'Target
@ -263,13 +279,6 @@ data Output
| LoadedDefinitionsToSourceFile FilePath Int
| TestIncrementalOutputStart PPE.PrettyPrintEnv (Int, Int) TermReferenceId
| TestIncrementalOutputEnd PPE.PrettyPrintEnv (Int, Int) TermReferenceId Bool {- True if success, False for Failure -}
| TestResults
TestReportStats
PPE.PrettyPrintEnv
ShowSuccesses
ShowFailures
[(TermReferenceId, Text)] -- oks
[(TermReferenceId, Text)] -- fails
| CantUndo UndoFailureReason
| -- new/unrepresented references followed by old/removed
-- todo: eventually replace these sets with [SearchResult' v Ann]
@ -542,7 +551,6 @@ isFailure o = case o of
DisplayRendered {} -> False
TestIncrementalOutputStart {} -> False
TestIncrementalOutputEnd {} -> False
TestResults _ _ _ _ _ fails -> not (null fails)
CantUndo {} -> True
BustedBuiltins {} -> True
NoConfiguredRemoteMapping {} -> True
@ -677,4 +685,5 @@ isNumberedFailure = \case
ShowDiffAfterUndo {} -> False
ShowDiffNamespace _ _ _ bd -> BD.isEmpty bd
ListNamespaceDependencies {} -> False
TestResults _ _ _ _ _ fails -> not (null fails)
Output'Todo {} -> False

24
unison-cli/src/Unison/CommandLine/InputPatterns.hs
View File

@ -1400,8 +1400,8 @@ aliasTerm =
_ -> Left $ P.wrap "`alias.term` takes two arguments, like `alias.term oldname newname`."
}
aliasTermForce :: InputPattern
aliasTermForce =
debugAliasTermForce :: InputPattern
debugAliasTermForce =
InputPattern
{ patternName = "debug.alias.term.force",
aliases = [],
@ -1424,9 +1424,24 @@ aliasType =
[("type to alias", Required, exactDefinitionTypeQueryArg), ("alias name", Required, newNameArg)]
"`alias.type Foo Bar` introduces `Bar` with the same definition as `Foo`."
\case
[oldName, newName] -> Input.AliasTypeI <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName
[oldName, newName] -> Input.AliasTypeI False <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName
_ -> Left $ P.wrap "`alias.type` takes two arguments, like `alias.type oldname newname`."
debugAliasTypeForce :: InputPattern
debugAliasTypeForce =
InputPattern
{ patternName = "debug.alias.type.force",
aliases = [],
visibility = I.Hidden,
args = [("type to alias", Required, exactDefinitionTypeQueryArg), ("alias name", Required, newNameArg)],
help = "`debug.alias.type.force Foo Bar` introduces `Bar` with the same definition as `Foo`.",
parse = \case
[oldName, newName] -> Input.AliasTypeI True <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName
_ ->
Left . warn $
P.wrap "`debug.alias.type.force` takes two arguments, like `debug.alias.type.force oldname newname`."
}
aliasMany :: InputPattern
aliasMany =
InputPattern
@ -3303,7 +3318,6 @@ validInputs =
[ add,
aliasMany,
aliasTerm,
aliasTermForce,
aliasType,
api,
authLogin,
@ -3317,6 +3331,8 @@ validInputs =
clone,
compileScheme,
createAuthor,
debugAliasTermForce,
debugAliasTypeForce,
debugClearWatchCache,
debugDoctor,
debugDumpNamespace,

201
unison-cli/src/Unison/CommandLine/OutputMessages.hs
View File

@ -55,6 +55,7 @@ import Unison.Codebase.Editor.Output
TestReportStats (CachedTests, NewlyComputed),
TodoOutput,
UndoFailureReason (CantUndoPastMerge, CantUndoPastStart),
todoOutputIsEmpty,
)
import Unison.Codebase.Editor.Output qualified as E
import Unison.Codebase.Editor.Output.BranchDiff qualified as OBD
@ -110,7 +111,7 @@ import Unison.PrintError
renderCompilerBug,
)
import Unison.Project (ProjectAndBranch (..))
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
@ -307,6 +308,29 @@ notifyNumbered = \case
]
)
(showDiffNamespace ShowNumbers ppe (absPathToBranchId bAbs) (absPathToBranchId bAbs) diff)
TestResults stats ppe _showSuccess _showFailures oksUnsorted failsUnsorted ->
let oks = Name.sortByText (HQ.toText . fst) [(name r, msgs) | (r, msgs) <- Map.toList oksUnsorted]
fails = Name.sortByText (HQ.toText . fst) [(name r, msgs) | (r, msgs) <- Map.toList failsUnsorted]
name r = PPE.termName ppe (Referent.fromTermReferenceId r)
in ( case stats of
CachedTests 0 _ -> P.callout "😶" $ "No tests to run."
CachedTests n n' | n == n' -> P.lines [cache, "", displayTestResults True oks fails]
CachedTests _n m ->
if m == 0
then "✅ "
else
P.indentN 2 $
P.lines ["", cache, "", displayTestResults False oks fails, "", "✅ "]
NewlyComputed ->
P.lines
[ " " <> P.bold "New test results:",
"",
displayTestResults True oks fails
],
fmap (SA.HashQualified . fst) $ oks <> fails
)
where
cache = P.bold "Cached test results " <> "(`help testcache` to learn more)"
Output'Todo todoOutput -> runNumbered (handleTodoOutput todoOutput)
CantDeleteDefinitions ppeDecl endangerments ->
( P.warnCallout $
@ -638,29 +662,6 @@ notifyUser dir = \case
OutputRewrittenFile dest vs -> displayOutputRewrittenFile dest vs
DisplayRendered outputLoc pp ->
displayRendered outputLoc pp
TestResults stats ppe _showSuccess _showFailures oks fails -> case stats of
CachedTests 0 _ -> pure . P.callout "😶" $ "No tests to run."
CachedTests n n'
| n == n' ->
pure $
P.lines [cache, "", displayTestResults True ppe oks fails]
CachedTests _n m ->
pure $
if m == 0
then "✅ "
else
P.indentN 2 $
P.lines ["", cache, "", displayTestResults False ppe oks fails, "", "✅ "]
NewlyComputed -> do
clearCurrentLine
pure $
P.lines
[ " " <> P.bold "New test results:",
"",
displayTestResults True ppe oks fails
]
where
cache = P.bold "Cached test results " <> "(`help testcache` to learn more)"
TestIncrementalOutputStart ppe (n, total) r -> do
putPretty' $
P.shown (total - n)
@ -1199,7 +1200,7 @@ notifyUser dir = \case
]
where
name :: Name
name = Path.unsafeToName' (HQ'.toName (Path.unsplitHQ' p))
name = HQ'.toName $ Path.nameFromHQSplit' p
qualifyTerm :: Referent -> Pretty
qualifyTerm = P.syntaxToColor . prettyNamedReferent hashLen name
qualifyType :: Reference -> Pretty
@ -2535,38 +2536,37 @@ displayRendered outputLoc pp =
displayTestResults ::
Bool -> -- whether to show the tip
PPE.PrettyPrintEnv ->
[(TermReferenceId, Text)] ->
[(TermReferenceId, Text)] ->
[(HQ.HashQualified Name, [Text])] ->
[(HQ.HashQualified Name, [Text])] ->
Pretty
displayTestResults showTip ppe oksUnsorted failsUnsorted =
let oks = Name.sortByText fst [(name r, msg) | (r, msg) <- oksUnsorted]
fails = Name.sortByText fst [(name r, msg) | (r, msg) <- failsUnsorted]
name r = HQ.toText $ PPE.termName ppe (Referent.fromTermReferenceId r)
displayTestResults showTip oks fails =
let name = P.text . HQ.toText
okMsg =
if null oks
then mempty
else P.column2 [(P.green "◉ " <> P.text r, " " <> P.green (P.text msg)) | (r, msg) <- oks]
else
P.indentN 2 $
P.numberedColumn2ListFrom 0 [(name r, P.lines $ P.green . (" ◉ " <>) . P.text <$> msgs) | (r, msgs) <- oks]
okSummary =
if null oks
then mempty
else "✅ " <> P.bold (P.num (length oks)) <> P.green " test(s) passing"
else "✅ " <> P.bold (P.num (sum $ fmap (length . snd) oks)) <> P.green " test(s) passing"
failMsg =
if null fails
then mempty
else P.column2 [(P.red "✗ " <> P.text r, " " <> P.red (P.text msg)) | (r, msg) <- fails]
else
P.indentN 2 $
P.numberedColumn2ListFrom
(length oks)
[(name r, P.lines $ P.red . (" ✗ " <>) . P.text <$> msgs) | (r, msgs) <- fails]
failSummary =
if null fails
then mempty
else "🚫 " <> P.bold (P.num (length fails)) <> P.red " test(s) failing"
else "🚫 " <> P.bold (P.num (sum $ fmap (length . snd) fails)) <> P.red " test(s) failing"
tipMsg =
if not showTip || (null oks && null fails)
then mempty
else
tip $
"Use "
<> P.blue ("view " <> P.text (fst $ head (fails ++ oks)))
<> "to view the source of a test."
else tip $ "Use " <> P.blue "view 1" <> "to view the source of a test."
in if null oks && null fails
then "😶 No tests available."
else
@ -2662,66 +2662,68 @@ runNumbered m =
in (a, Foldable.toList args)
handleTodoOutput :: TodoOutput -> Numbered Pretty
handleTodoOutput todo = do
prettyConflicts <-
if todo.nameConflicts == mempty
then pure mempty
else renderNameConflicts todo.ppe.unsuffixifiedPPE todo.nameConflicts
handleTodoOutput todo
| todoOutputIsEmpty todo = pure "You have no pending todo items. Good work! ✅"
| otherwise = do
prettyConflicts <-
if todo.nameConflicts == mempty
then pure mempty
else renderNameConflicts todo.ppe.unsuffixifiedPPE todo.nameConflicts
prettyDependentsOfTodo <- do
if Set.null todo.dependentsOfTodo
then pure mempty
else do
terms <-
for (Set.toList todo.dependentsOfTodo) \term -> do
n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.idToShortHash term)))
let name =
term
& Referent.fromTermReferenceId
& PPE.termName todo.ppe.suffixifiedPPE
& prettyHashQualified
& P.syntaxToColor
pure (formatNum n <> name)
pure $
P.wrap "These terms call `todo`:"
<> P.newline
<> P.newline
<> P.indentN 2 (P.lines terms)
prettyDependentsOfTodo <- do
if Set.null todo.dependentsOfTodo
then pure mempty
else do
terms <-
for (Set.toList todo.dependentsOfTodo) \term -> do
n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.idToShortHash term)))
let name =
term
& Referent.fromTermReferenceId
& PPE.termName todo.ppe.suffixifiedPPE
& prettyHashQualified
& P.syntaxToColor
pure (formatNum n <> name)
pure $
P.wrap "These terms call `todo`:"
<> P.newline
<> P.newline
<> P.indentN 2 (P.lines terms)
prettyDirectTermDependenciesWithoutNames <- do
if Set.null todo.directDependenciesWithoutNames.terms
then pure mempty
else do
terms <-
for (Set.toList todo.directDependenciesWithoutNames.terms) \term -> do
n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash term)))
pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen term))
pure $
P.wrap "These terms do not have any names in the current namespace:"
<> P.newline
<> P.newline
<> P.indentN 2 (P.lines terms)
prettyDirectTermDependenciesWithoutNames <- do
if Set.null todo.directDependenciesWithoutNames.terms
then pure mempty
else do
terms <-
for (Set.toList todo.directDependenciesWithoutNames.terms) \term -> do
n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash term)))
pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen term))
pure $
P.wrap "These terms do not have any names in the current namespace:"
<> P.newline
<> P.newline
<> P.indentN 2 (P.lines terms)
prettyDirectTypeDependenciesWithoutNames <- do
if Set.null todo.directDependenciesWithoutNames.types
then pure mempty
else do
types <-
for (Set.toList todo.directDependenciesWithoutNames.types) \typ -> do
n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash typ)))
pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen typ))
pure $
P.wrap "These types do not have any names in the current namespace:"
<> P.newline
<> P.newline
<> P.indentN 2 (P.lines types)
prettyDirectTypeDependenciesWithoutNames <- do
if Set.null todo.directDependenciesWithoutNames.types
then pure mempty
else do
types <-
for (Set.toList todo.directDependenciesWithoutNames.types) \typ -> do
n <- addNumberedArg (SA.HashQualified (HQ.HashOnly (Reference.toShortHash typ)))
pure (formatNum n <> P.syntaxToColor (prettyReference todo.hashLen typ))
pure $
P.wrap "These types do not have any names in the current namespace:"
<> P.newline
<> P.newline
<> P.indentN 2 (P.lines types)
(pure . P.sep "\n\n" . P.nonEmpty)
[ prettyDependentsOfTodo,
prettyDirectTermDependenciesWithoutNames,
prettyDirectTypeDependenciesWithoutNames,
prettyConflicts
]
(pure . P.sep "\n\n" . P.nonEmpty)
[ prettyDependentsOfTodo,
prettyDirectTermDependenciesWithoutNames,
prettyDirectTypeDependenciesWithoutNames,
prettyConflicts
]
listOfDefinitions ::
(Var v) => Input.FindScope -> PPE.PrettyPrintEnv -> E.ListDetailed -> [SR'.SearchResult' v a] -> IO Pretty
@ -3449,7 +3451,7 @@ listDependentsOrDependencies ppe labelStart label lds types terms =
P.lines $
[ P.indentN 2 $ P.bold "Types:",
"",
P.indentN 2 $ P.numbered (numFrom 0) $ c . prettyHashQualified <$> types
P.indentN 2 . P.numberedList $ c . prettyHashQualified <$> types
]
termsOut =
if null terms
@ -3458,7 +3460,6 @@ listDependentsOrDependencies ppe labelStart label lds types terms =
P.lines
[ P.indentN 2 $ P.bold "Terms:",
"",
P.indentN 2 $ P.numbered (numFrom $ length types) $ c . prettyHashQualified <$> terms
P.indentN 2 . P.numberedListFrom (length types) $ c . prettyHashQualified <$> terms
]
numFrom k n = P.hiBlack $ P.shown (k + n) <> "."
c = P.syntaxToColor

6
unison-cli/src/Unison/LSP/VFS.hs
View File

@ -81,7 +81,11 @@ identifierSplitAtPosition uri pos = do
vf <- getVirtualFile uri
PosPrefixInfo {fullLine, cursorPos} <- MaybeT (VFS.getCompletionPrefix pos vf)
let (before, after) = Text.splitAt (cursorPos ^. character . to fromIntegral) fullLine
pure (Text.takeWhileEnd isIdentifierChar before, Text.takeWhile isIdentifierChar after)
pure
( Text.takeWhileEnd isIdentifierChar before,
-- names can end with '!', and it's not a force, so we include it in the identifier if it's at the end.
Text.takeWhile (\c -> isIdentifierChar c || c == '!') after
)
where
isIdentifierChar c =
-- Manually exclude '!' and apostrophe, since those are usually just forces and

3
unison-cli/unison-cli.cabal
View File

@ -266,7 +266,6 @@ library
, unison-sqlite
, unison-syntax
, unison-util-base32hex
, unison-util-nametree
, unison-util-relation
, unliftio
, unordered-containers
@ -410,7 +409,6 @@ executable transcripts
, unison-sqlite
, unison-syntax
, unison-util-base32hex
, unison-util-nametree
, unison-util-relation
, unliftio
, unordered-containers
@ -558,7 +556,6 @@ test-suite cli-tests
, unison-sqlite
, unison-syntax
, unison-util-base32hex
, unison-util-nametree
, unison-util-relation
, unliftio
, unordered-containers

7
unison-core/package.yaml
View File

@ -24,6 +24,8 @@ library:
- mtl
- rfc5051
- safe
- semialign
- semigroups
- text
- text-builder
- these
@ -54,7 +56,7 @@ tests:
source-dirs: test
default-extensions:
- ApplicativeDo
- BangPatterns
- BlockArguments
- DeriveAnyClass
- DeriveFoldable
@ -62,17 +64,20 @@ default-extensions:
- DeriveGeneric
- DeriveTraversable
- DerivingStrategies
- DerivingVia
- DoAndIfThenElse
- FlexibleContexts
- FlexibleInstances
- GADTs
- GeneralizedNewtypeDeriving
- ImportQualifiedPost
- InstanceSigs
- KindSignatures
- LambdaCase
- MultiParamTypeClasses
- NamedFieldPuns
- OverloadedStrings
- OverloadedRecordDot
- PatternSynonyms
- RankNTypes
- ScopedTypeVariables

0
lib/unison-util-nametree/src/Unison/Util/Defns.hs → unison-core/src/Unison/Util/Defns.hs
View File

0
lib/unison-util-nametree/src/Unison/Util/Nametree.hs → unison-core/src/Unison/Util/Nametree.hs
View File

14
unison-core/unison-core1.cabal
View File

@ -55,12 +55,14 @@ library
Unison.Type
Unison.Type.Names
Unison.Util.Components
Unison.Util.Defns
Unison.Util.Nametree
Unison.Var
Unison.WatchKind
hs-source-dirs:
src
default-extensions:
ApplicativeDo
BangPatterns
BlockArguments
DeriveAnyClass
DeriveFoldable
@ -68,17 +70,20 @@ library
DeriveGeneric
DeriveTraversable
DerivingStrategies
DerivingVia
DoAndIfThenElse
FlexibleContexts
FlexibleInstances
GADTs
GeneralizedNewtypeDeriving
ImportQualifiedPost
InstanceSigs
KindSignatures
LambdaCase
MultiParamTypeClasses
NamedFieldPuns
OverloadedStrings
OverloadedRecordDot
PatternSynonyms
RankNTypes
ScopedTypeVariables
@ -102,6 +107,8 @@ library
, nonempty-containers
, rfc5051
, safe
, semialign
, semigroups
, text
, text-builder
, these
@ -123,7 +130,7 @@ test-suite tests
hs-source-dirs:
test
default-extensions:
ApplicativeDo
BangPatterns
BlockArguments
DeriveAnyClass
DeriveFoldable
@ -131,17 +138,20 @@ test-suite tests
DeriveGeneric
DeriveTraversable
DerivingStrategies
DerivingVia
DoAndIfThenElse
FlexibleContexts
FlexibleInstances
GADTs
GeneralizedNewtypeDeriving
ImportQualifiedPost
InstanceSigs
KindSignatures
LambdaCase
MultiParamTypeClasses
NamedFieldPuns
OverloadedStrings
OverloadedRecordDot
PatternSynonyms
RankNTypes
ScopedTypeVariables

1
unison-merge/package.yaml
View File

@ -34,7 +34,6 @@ dependencies:
- unison-sqlite
- unison-syntax
- unison-util-cache
- unison-util-nametree
- unison-util-relation
- vector
- witherable

1
unison-merge/unison-merge.cabal
View File

@ -103,7 +103,6 @@ library
, unison-sqlite
, unison-syntax
, unison-util-cache
, unison-util-nametree
, unison-util-relation
, vector
, witherable

4
unison-share-api/src/Unison/Server/Local.hs
View File

@ -41,11 +41,11 @@ relocateToNameRoot perspective query rootBranch = do
-- Since the project root is lower down we need to strip the part of the prefix
-- which is now redundant.
pure . Right $ (projectRoot, query <&> \n -> fromMaybe n $ Path.unprefixName (Path.Absolute remainder) n)
-- The namesRoot is _inside_ of the project containing the query
-- The namesRoot is _inside (or equal to)_ the project containing the query
(_sharedPrefix, remainder, Path.Empty) -> do
-- Since the project is higher up, we need to prefix the query
-- with the remainder of the path
pure $ Right (projectRoot, query <&> Path.prefixNameIfRel (Path.AbsolutePath' $ Path.Absolute remainder))
pure $ Right (projectRoot, query <&> Path.prefixNameIfRel (Path.RelativePath' $ Path.Relative remainder))
-- The namesRoot and project root are disjoint, this shouldn't ever happen.
(_, _, _) -> pure $ Left (DisjointProjectAndPerspective perspective projectRoot)

6
unison-src/builtin-tests/base.md
View File

@ -5,7 +5,7 @@ Thus, make sure the contents of this file define the contents of the cache
(e.g. don't pull `latest`.)
```ucm
.> pull @unison/base/releases/2.5.0 .base
.> builtins.mergeio
.> undo
scratch/main> pull @unison/base/releases/2.5.0 .base
scratch/main> builtins.mergeio
scratch/main> undo
```

8
unison-src/builtin-tests/interpreter-tests.tpl.md
View File

@ -5,12 +5,12 @@ 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
.> this is a hack to trigger an error, in order to swallow any error on the next line.
.> we delete the project to avoid any merge conflicts or complaints from ucm.
.> delete.project runtime-tests
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
.> clone ${runtime_tests_version} runtime-tests/selected
scratch/main> clone ${runtime_tests_version} runtime-tests/selected
```
```ucm

4
unison-src/builtin-tests/jit-tests.output.md
View File

@ -40,11 +40,11 @@ foo = do
```
```ucm
.> run.native foo
scratch/main> run.native foo
()
.> run.native foo
scratch/main> run.native foo
()

12
unison-src/builtin-tests/jit-tests.tpl.md
View File

@ -5,12 +5,12 @@ 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
.> this is a hack to trigger an error, in order to swallow any error on the next line.
.> we delete the project to avoid any merge conflicts or complaints from ucm.
.> delete.project runtime-tests
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
.> clone ${runtime_tests_version} runtime-tests/selected
scratch/main> clone ${runtime_tests_version} runtime-tests/selected
```
```ucm
@ -31,8 +31,8 @@ foo = do
```
```ucm
.> run.native foo
.> run.native foo
scratch/main> run.native foo
scratch/main> run.native foo
```
This can also only be tested by separately running this test, because

52
unison-src/transcripts-manual/benchmarks.md
View File

@ -1,6 +1,6 @@
```ucm:hide
.> pull unison.public.base.releases.M4d base
.> pull runarorama.public.sort.data sort
scratch/main> pull unison.public.base.releases.M4d base
scratch/main> pull runarorama.public.sort.data sort
```
```unison:hide
@ -34,63 +34,63 @@ prepare = do
```
```ucm:hide
.> add
.> run prepare
scratch/main> add
scratch/main> run prepare
```
## Benchmarks
```ucm
.> load unison-src/transcripts-manual/benchmarks/each.u
.> run main
scratch/main> load unison-src/transcripts-manual/benchmarks/each.u
scratch/main> run main
```
```ucm
.> load unison-src/transcripts-manual/benchmarks/listmap.u
.> run main
scratch/main> load unison-src/transcripts-manual/benchmarks/listmap.u
scratch/main> run main
```
```ucm
.> load unison-src/transcripts-manual/benchmarks/listfilter.u
.> run main
scratch/main> load unison-src/transcripts-manual/benchmarks/listfilter.u
scratch/main> run main
```
```ucm
.> load unison-src/transcripts-manual/benchmarks/random.u
.> run main
scratch/main> load unison-src/transcripts-manual/benchmarks/random.u
scratch/main> run main
```
```ucm
.> load unison-src/transcripts-manual/benchmarks/simpleloop.u
.> run main
scratch/main> load unison-src/transcripts-manual/benchmarks/simpleloop.u
scratch/main> run main
```
```ucm
.> load unison-src/transcripts-manual/benchmarks/fibonacci.u
.> run main
scratch/main> load unison-src/transcripts-manual/benchmarks/fibonacci.u
scratch/main> run main
```
```ucm
.> load unison-src/transcripts-manual/benchmarks/map.u
.> run main
scratch/main> load unison-src/transcripts-manual/benchmarks/map.u
scratch/main> run main
```
```ucm
.> load unison-src/transcripts-manual/benchmarks/natmap.u
.> run main
scratch/main> load unison-src/transcripts-manual/benchmarks/natmap.u
scratch/main> run main
```
```ucm
.> load unison-src/transcripts-manual/benchmarks/stm.u
.> run main
scratch/main> load unison-src/transcripts-manual/benchmarks/stm.u
scratch/main> run main
```
```ucm
.> load unison-src/transcripts-manual/benchmarks/tmap.u
.> run main
scratch/main> load unison-src/transcripts-manual/benchmarks/tmap.u
scratch/main> run main
```
```ucm
.> load unison-src/transcripts-manual/benchmarks/array-sort.u
.> run main
scratch/main> load unison-src/transcripts-manual/benchmarks/array-sort.u
scratch/main> run main
```

3
unison-src/transcripts-manual/docs.to-html.md
View File

@ -1,6 +1,5 @@
```ucm
.> project.create test-html-docs
test-html-docs/main> builtins.merge
test-html-docs/main> builtins.mergeio lib.builtins
```
```unison

39
unison-src/transcripts-manual/docs.to-html.output.md
View File

@ -1,26 +1,5 @@
```ucm
.> project.create test-html-docs
🎉 I've created the project test-html-docs.
I'll now fetch the latest version of the base Unison
library...
Downloaded 12886 entities.
🎨 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!
test-html-docs/main> builtins.merge
test-html-docs/main> builtins.mergeio lib.builtins
Done.
@ -47,13 +26,11 @@ some.outside = 3
⍟ These new definitions are ok to `add`:
some.ns.direct : Nat
some.ns.direct.doc : Doc
some.ns.direct.doc : Doc2
some.ns.pretty.deeply.nested : Nat
(also named lib.base.data.Map.internal.ratio)
some.ns.pretty.deeply.nested.doc : Doc
some.ns.pretty.deeply.nested.doc : Doc2
some.outside : Nat
(also named lib.base.data.Map.internal.delta)
some.outside.doc : Doc
some.outside.doc : Doc2
```
```ucm
@ -62,13 +39,11 @@ test-html-docs/main> add
⍟ I've added these definitions:
some.ns.direct : Nat
some.ns.direct.doc : Doc
some.ns.direct.doc : Doc2
some.ns.pretty.deeply.nested : Nat
(also named lib.base.data.Map.internal.ratio)
some.ns.pretty.deeply.nested.doc : Doc
some.ns.pretty.deeply.nested.doc : Doc2
some.outside : Nat
(also named lib.base.data.Map.internal.delta)
some.outside.doc : Doc
some.outside.doc : Doc2
test-html-docs/main> docs.to-html some.ns unison-src/transcripts-manual/docs.to-html

2
unison-src/transcripts-manual/gen-racket-libs.md
View File

@ -4,7 +4,7 @@ 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.17
jit-setup/main> lib.install @unison/internal/releases/0.0.18
```
```unison

25
unison-src/transcripts-manual/gen-racket-libs.output.md
View File

@ -4,29 +4,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
.> project.create-empty jit-setup
jit-setup/main> lib.install @unison/internal/releases/0.0.18
🎉 I've created the project jit-setup.
Downloaded 14917 entities.
🎨 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!
jit-setup/main> pull @unison/internal/releases/0.0.17 lib.jit
Downloaded 15091 entities.
✅
Successfully pulled into lib.jit, which was empty.
I installed @unison/internal/releases/0.0.18 as
unison_internal_0_0_18.
```
```unison

2
unison-src/transcripts-manual/remote-tab-completion.md
View File

@ -3,5 +3,5 @@
Note: this makes a network call to share to get completions
```ucm
.> debug.tab-complete pull unison.pub
scratch/main> debug.tab-complete pull unison.pub
```

48
unison-src/transcripts-manual/rewrites.md
View File

@ -1,8 +1,8 @@
```ucm:hide
.> builtins.mergeio
.> load unison-src/transcripts-using-base/base.u
.> add
scratch/main> builtins.mergeio
scratch/main> load unison-src/transcripts-using-base/base.u
scratch/main> add
```
## Structural find and replace
@ -37,19 +37,19 @@ rule2 x = @rewrite signature Optional ==> Optional2
Let's rewrite these:
```ucm
.> rewrite rule1
.> rewrite eitherToOptional
scratch/main> rewrite rule1
scratch/main> rewrite eitherToOptional
```
```ucm:hide
.> load
.> add
scratch/main> load
scratch/main> add
```
After adding to the codebase, here's the rewritten source:
```ucm
.> view ex1 Either.mapRight rule1
scratch/main> view ex1 Either.mapRight rule1
```
Another example, showing that we can rewrite to definitions that only exist in the file:
@ -75,18 +75,18 @@ blah2 = 456
Let's apply the rewrite `woot1to2`:
```ucm
.> rewrite woot1to2
scratch/main> rewrite woot1to2
```
```ucm:hide
.> load
.> add
scratch/main> load
scratch/main> add
```
After adding the rewritten form to the codebase, here's the rewritten `Woot1` to `Woot2`:
```ucm
.> view wootEx
scratch/main> view wootEx
```
This example shows that rewrite rules can to refer to term definitions that only exist in the file:
@ -111,15 +111,15 @@ sameFileEx =
```
```ucm:hide
.> rewrite rule
.> load
.> add
scratch/main> rewrite rule
scratch/main> load
scratch/main> add
```
After adding the rewritten form to the codebase, here's the rewritten definitions:
```ucm
.> view foo1 foo2 sameFileEx
scratch/main> view foo1 foo2 sameFileEx
```
## Capture avoidance
@ -145,13 +145,13 @@ 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
.> rewrite rule
scratch/main> rewrite rule
```
Instead, it should be an unbound free variable, which doesn't typecheck:
```ucm:error
.> load
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:
@ -167,13 +167,13 @@ rule a = @rewrite
```
```ucm
.> rewrite rule
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
.> load
scratch/main> load
```
## Structural find
@ -183,7 +183,7 @@ eitherEx = Left ("hello", "there")
```
```ucm:hide
.> add
scratch/main> add
```
```unison:hide
@ -192,7 +192,7 @@ findEitherFailure = @rewrite signature a . Either Failure a ==> ()
```
```ucm
.> sfind findEitherEx
.> sfind findEitherFailure
.> find 1-5
scratch/main> sfind findEitherEx
scratch/main> sfind findEitherFailure
scratch/main> find 1-5
```

26
unison-src/transcripts-manual/rewrites.output.md
View File

@ -31,7 +31,7 @@ rule2 x = @rewrite signature Optional ==> Optional2
Let's rewrite these:
```ucm
.> rewrite rule1
scratch/main> rewrite rule1
☝️
@ -39,7 +39,7 @@ Let's rewrite these:
The rewritten file has been added to the top of scratch.u
.> rewrite eitherToOptional
scratch/main> rewrite eitherToOptional
☝️
@ -112,7 +112,7 @@ rule2 x = @rewrite signature Optional ==> Optional2
After adding to the codebase, here's the rewritten source:
```ucm
.> view ex1 Either.mapRight rule1
scratch/main> view ex1 Either.mapRight rule1
Either.mapRight : (a ->{g} b) -> Optional a ->{g} Optional b
Either.mapRight f = cases
@ -158,7 +158,7 @@ blah2 = 456
Let's apply the rewrite `woot1to2`:
```ucm
.> rewrite woot1to2
scratch/main> rewrite woot1to2
☝️
@ -194,7 +194,7 @@ blah2 = 456
After adding the rewritten form to the codebase, here's the rewritten `Woot1` to `Woot2`:
```ucm
.> view wootEx
scratch/main> view wootEx
wootEx : Nat ->{Woot2} Nat
wootEx a =
@ -226,7 +226,7 @@ sameFileEx =
After adding the rewritten form to the codebase, here's the rewritten definitions:
```ucm
.> view foo1 foo2 sameFileEx
scratch/main> view foo1 foo2 sameFileEx
foo1 : Nat
foo1 =
@ -267,7 +267,7 @@ 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
.> rewrite rule
scratch/main> rewrite rule
☝️
@ -301,7 +301,7 @@ sameFileEx =
Instead, it should be an unbound free variable, which doesn't typecheck:
```ucm
.> load
scratch/main> load
Loading changes detected in scratch.u.
@ -332,7 +332,7 @@ rule a = @rewrite
```
```ucm
.> rewrite rule
scratch/main> rewrite rule
☝️
@ -358,7 +358,7 @@ 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
.> load
scratch/main> load
Loading changes detected in scratch.u.
@ -388,7 +388,7 @@ findEitherFailure = @rewrite signature a . Either Failure a ==> ()
```
```ucm
.> sfind findEitherEx
scratch/main> sfind findEitherEx
🔎
@ -398,7 +398,7 @@ findEitherFailure = @rewrite signature a . Either Failure a ==> ()
Tip: Try `edit 1` to bring this into your scratch file.
.> sfind findEitherFailure
scratch/main> sfind findEitherFailure
🔎
@ -413,7 +413,7 @@ findEitherFailure = @rewrite signature a . Either Failure a ==> ()
Tip: Try `edit 1` or `edit 1-5` to bring these into your
scratch file.
.> find 1-5
scratch/main> find 1-5
1. Exception.catch : '{g, Exception} a ->{g} Either Failure a
2. Exception.reraise : Either Failure a ->{Exception} a

10
unison-src/transcripts-manual/scheme.md
View File

@ -2,8 +2,8 @@ This transcript executes very slowly, because the compiler has an
entire copy of base (and other stuff) within it.
```ucm:hide
.> builtins.merge
.> pull.without-history unison.public.base.trunk base
scratch/main> builtins.merge
scratch/main> pull.without-history unison.public.base.trunk base
```
```unison
@ -55,7 +55,7 @@ multiAddUp = repeat 35 '(printAddUp 3000000)
```
```ucm
.> add
.> run singleAddUp
.> run.native multiAddUp
scratch/main> add
scratch/main> run singleAddUp
scratch/main> run.native multiAddUp
```

12
unison-src/transcripts-using-base/_base.md
View File

@ -10,9 +10,9 @@ transcripts which contain less boilerplate.
## Usage
```ucm:hide
.> builtins.mergeio
.> load unison-src/transcripts-using-base/base.u
.> add
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.
@ -24,7 +24,7 @@ test> hex.tests.ex1 = checks let
```
```ucm:hide
.> test
scratch/main> test
```
Lets do some basic testing of our test harness to make sure its
@ -50,6 +50,6 @@ testAutoClean _ =
```
```ucm
.> add
.> io.test testAutoClean
scratch/main> add
scratch/main> io.test testAutoClean
```

10
unison-src/transcripts-using-base/_base.output.md
View File

@ -53,21 +53,21 @@ testAutoClean _ =
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
testAutoClean : '{IO} [Result]
.> io.test testAutoClean
scratch/main> io.test testAutoClean
New test results:
◉ testAutoClean our temporary directory should exist
◉ testAutoClean our temporary directory should no longer exist
1. testAutoClean ◉ our temporary directory should exist
◉ our temporary directory should no longer exist
✅ 2 test(s) passing
Tip: Use view testAutoClean to view the source of a test.
Tip: Use view 1 to view the source of a test.
```

2
unison-src/transcripts-using-base/all-base-hashes.md
View File

@ -1,5 +1,5 @@
This transcript is intended to make visible accidental changes to the hashing algorithm.
```ucm
.> find.verbose
scratch/main> find.verbose
```

2
unison-src/transcripts-using-base/all-base-hashes.output.md
View File

@ -1,7 +1,7 @@
This transcript is intended to make visible accidental changes to the hashing algorithm.
```ucm
.> find.verbose
scratch/main> find.verbose
1. -- #sgesq8035ut22q779pl1g4gqsg8c81894jjonmrq1bjltphkath225up841hk8dku59tnnc4laj9nggbofamgei4klof0ldc20uj2oo
<| : (i ->{g} o) -> i ->{g} o

4
unison-src/transcripts-using-base/binary-encoding-nats.md
View File

@ -54,6 +54,6 @@ testABunchOfNats _ =
```
```ucm
.> add
.> io.test testABunchOfNats
scratch/main> add
scratch/main> io.test testABunchOfNats
```

142
unison-src/transcripts-using-base/binary-encoding-nats.output.md
View File

@ -76,7 +76,7 @@ testABunchOfNats _ =
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
@ -91,81 +91,81 @@ testABunchOfNats _ =
testNat : Nat -> '{IO, Stream Result} ()
testRoundTrip : Nat -> EncDec ->{IO, Stream Result} ()
.> io.test testABunchOfNats
scratch/main> io.test testABunchOfNats
New test results:
◉ testABunchOfNats successfully decoded 4294967295 using 64 bit Big Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 4294967295 using 64 bit Little Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 4294967295 using 32 bit Big Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 4294967295 using 32 bit Little Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 1090519040 using 64 bit Big Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 1090519040 using 64 bit Little Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 1090519040 using 32 bit Big Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 1090519040 using 32 bit Little Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 4259840 using 64 bit Big Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 4259840 using 64 bit Little Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 4259840 using 32 bit Big Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 4259840 using 32 bit Little Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 16640 using 64 bit Big Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 16640 using 64 bit Little Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 16640 using 32 bit Big Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 16640 using 32 bit Little Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 16640 using 16 bit Big Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 16640 using 16 bit Little Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 2255827097 using 64 bit Big Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 2255827097 using 64 bit Little Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 2255827097 using 32 bit Big Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 2255827097 using 32 bit Little Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 65 using 64 bit Big Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 65 using 64 bit Little Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 65 using 32 bit Big Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 65 using 32 bit Little Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 65 using 16 bit Big Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 65 using 16 bit Little Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 0 using 64 bit Big Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 0 using 64 bit Little Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 0 using 32 bit Big Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 0 using 32 bit Little Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 0 using 16 bit Big Endian
◉ testABunchOfNats consumed all input
◉ testABunchOfNats successfully decoded 0 using 16 bit Little Endian
◉ testABunchOfNats consumed all input
1. testABunchOfNats ◉ successfully decoded 4294967295 using 64 bit Big Endian
◉ consumed all input
◉ successfully decoded 4294967295 using 64 bit Little Endian
◉ consumed all input
◉ successfully decoded 4294967295 using 32 bit Big Endian
◉ consumed all input
◉ successfully decoded 4294967295 using 32 bit Little Endian
◉ consumed all input
◉ successfully decoded 1090519040 using 64 bit Big Endian
◉ consumed all input
◉ successfully decoded 1090519040 using 64 bit Little Endian
◉ consumed all input
◉ successfully decoded 1090519040 using 32 bit Big Endian
◉ consumed all input
◉ successfully decoded 1090519040 using 32 bit Little Endian
◉ consumed all input
◉ successfully decoded 4259840 using 64 bit Big Endian
◉ consumed all input
◉ successfully decoded 4259840 using 64 bit Little Endian
◉ consumed all input
◉ successfully decoded 4259840 using 32 bit Big Endian
◉ consumed all input
◉ successfully decoded 4259840 using 32 bit Little Endian
◉ consumed all input
◉ successfully decoded 16640 using 64 bit Big Endian
◉ consumed all input
◉ successfully decoded 16640 using 64 bit Little Endian
◉ consumed all input
◉ successfully decoded 16640 using 32 bit Big Endian
◉ consumed all input
◉ successfully decoded 16640 using 32 bit Little Endian
◉ consumed all input
◉ successfully decoded 16640 using 16 bit Big Endian
◉ consumed all input
◉ successfully decoded 16640 using 16 bit Little Endian
◉ consumed all input
◉ successfully decoded 2255827097 using 64 bit Big Endian
◉ consumed all input
◉ successfully decoded 2255827097 using 64 bit Little Endian
◉ consumed all input
◉ successfully decoded 2255827097 using 32 bit Big Endian
◉ consumed all input
◉ successfully decoded 2255827097 using 32 bit Little Endian
◉ consumed all input
◉ successfully decoded 65 using 64 bit Big Endian
◉ consumed all input
◉ successfully decoded 65 using 64 bit Little Endian
◉ consumed all input
◉ successfully decoded 65 using 32 bit Big Endian
◉ consumed all input
◉ successfully decoded 65 using 32 bit Little Endian
◉ consumed all input
◉ successfully decoded 65 using 16 bit Big Endian
◉ consumed all input
◉ successfully decoded 65 using 16 bit Little Endian
◉ consumed all input
◉ successfully decoded 0 using 64 bit Big Endian
◉ consumed all input
◉ successfully decoded 0 using 64 bit Little Endian
◉ consumed all input
◉ successfully decoded 0 using 32 bit Big Endian
◉ consumed all input
◉ successfully decoded 0 using 32 bit Little Endian
◉ consumed all input
◉ successfully decoded 0 using 16 bit Big Endian
◉ consumed all input
◉ successfully decoded 0 using 16 bit Little Endian
◉ consumed all input
✅ 68 test(s) passing
Tip: Use view testABunchOfNats to view the source of a test.
Tip: Use view 1 to view the source of a test.
```

16
unison-src/transcripts-using-base/codeops.md
View File

@ -153,7 +153,7 @@ swapped name link =
```
```ucm
.> add
scratch/main> add
```
```unison
@ -236,9 +236,9 @@ we gain the ability to capture output in a transcript, it can be modified
to actual show that the serialization works.
```ucm
.> add
.> io.test tests
.> io.test badLoad
scratch/main> add
scratch/main> io.test tests
scratch/main> io.test badLoad
```
```unison
@ -278,8 +278,8 @@ codeTests =
```
```ucm
.> add
.> io.test codeTests
scratch/main> add
scratch/main> io.test codeTests
```
```unison
@ -309,6 +309,6 @@ vtests _ =
```
```ucm
.> add
.> io.test vtests
scratch/main> add
scratch/main> io.test vtests
```

128
unison-src/transcripts-using-base/codeops.output.md
View File

@ -200,7 +200,7 @@ swapped name link =
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
@ -344,7 +344,7 @@ we gain the ability to capture output in a transcript, it can be modified
to actual show that the serialization works.
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
@ -360,37 +360,37 @@ to actual show that the serialization works.
tests : '{IO} [Result]
zapper : Three Nat Nat Nat -> Request {Zap} r -> r
.> io.test tests
scratch/main> io.test tests
New test results:
◉ tests (ext f) passed
◉ tests (ext h) passed
◉ tests (ident compound) passed
◉ tests (ident fib10) passed
◉ tests (ident effect) passed
◉ tests (ident zero) passed
◉ tests (ident h) passed
◉ tests (ident text) passed
◉ tests (ident int) passed
◉ tests (ident float) passed
◉ tests (ident termlink) passed
◉ tests (ident bool) passed
◉ tests (ident bytes) passed
1. tests ◉ (ext f) passed
◉ (ext h) passed
◉ (ident compound) passed
◉ (ident fib10) passed
◉ (ident effect) passed
◉ (ident zero) passed
◉ (ident h) passed
◉ (ident text) passed
◉ (ident int) passed
◉ (ident float) passed
◉ (ident termlink) passed
◉ (ident bool) passed
◉ (ident bytes) passed
✅ 13 test(s) passing
Tip: Use view tests to view the source of a test.
Tip: Use view 1 to view the source of a test.
.> io.test badLoad
scratch/main> io.test badLoad
New test results:
◉ badLoad serialized77
1. badLoad ◉ serialized77
✅ 1 test(s) passing
Tip: Use view badLoad to view the source of a test.
Tip: Use view 1 to view the source of a test.
```
```unison
@ -443,50 +443,50 @@ codeTests =
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
codeTests : '{IO} [Result]
.> io.test codeTests
scratch/main> io.test codeTests
New test results:
◉ codeTests (idem f) passed
◉ codeTests (idem h) passed
◉ codeTests (idem rotate) passed
◉ codeTests (idem zapper) passed
◉ codeTests (idem showThree) passed
◉ codeTests (idem concatMap) passed
◉ codeTests (idem big) passed
◉ codeTests (idem extensionality) passed
◉ codeTests (idem identicality) passed
◉ codeTests (verified f) passed
◉ codeTests (verified h) passed
◉ codeTests (verified rotate) passed
◉ codeTests (verified zapper) passed
◉ codeTests (verified showThree) passed
◉ codeTests (verified concatMap) passed
◉ codeTests (verified big) passed
◉ codeTests (verified extensionality) passed
◉ codeTests (verified identicality) passed
◉ codeTests (verified mutual0) passed
◉ codeTests (verified mutual1) passed
◉ codeTests (verified mutual2) passed
◉ codeTests (rejected missing mutual0) passed
◉ codeTests (rejected missing mutual1) passed
◉ codeTests (rejected missing mutual2) passed
◉ codeTests (rejected swapped zapper) passed
◉ codeTests (rejected swapped extensionality) passed
◉ codeTests (rejected swapped identicality) passed
◉ codeTests (rejected swapped mututal0) passed
◉ codeTests (rejected swapped mututal1) passed
◉ codeTests (rejected swapped mututal2) passed
1. codeTests ◉ (idem f) passed
◉ (idem h) passed
◉ (idem rotate) passed
◉ (idem zapper) passed
◉ (idem showThree) passed
◉ (idem concatMap) passed
◉ (idem big) passed
◉ (idem extensionality) passed
◉ (idem identicality) passed
◉ (verified f) passed
◉ (verified h) passed
◉ (verified rotate) passed
◉ (verified zapper) passed
◉ (verified showThree) passed
◉ (verified concatMap) passed
◉ (verified big) passed
◉ (verified extensionality) passed
◉ (verified identicality) passed
◉ (verified mutual0) passed
◉ (verified mutual1) passed
◉ (verified mutual2) passed
◉ (rejected missing mutual0) passed
◉ (rejected missing mutual1) passed
◉ (rejected missing mutual2) passed
◉ (rejected swapped zapper) passed
◉ (rejected swapped extensionality) passed
◉ (rejected swapped identicality) passed
◉ (rejected swapped mututal0) passed
◉ (rejected swapped mututal1) passed
◉ (rejected swapped mututal2) passed
✅ 30 test(s) passing
Tip: Use view codeTests to view the source of a test.
Tip: Use view 1 to view the source of a test.
```
```unison
@ -530,28 +530,28 @@ vtests _ =
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
validateTest : Link.Term ->{IO} Result
vtests : '{IO} [Result]
.> io.test vtests
scratch/main> io.test vtests
New test results:
◉ vtests validated
◉ vtests validated
◉ vtests validated
◉ vtests validated
◉ vtests validated
◉ vtests validated
◉ vtests validated
◉ vtests validated
1. vtests ◉ validated
◉ validated
◉ validated
◉ validated
◉ validated
◉ validated
◉ validated
◉ validated
✅ 8 test(s) passing
Tip: Use view vtests to view the source of a test.
Tip: Use view 1 to view the source of a test.
```

38
unison-src/transcripts-using-base/doc.md
View File

@ -33,9 +33,9 @@ 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
.> display d1
.> docs ImportantConstant
.> docs DayOfWeek
scratch/main> display d1
scratch/main> docs ImportantConstant
scratch/main> docs DayOfWeek
```
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.
@ -45,11 +45,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
.> load ./unison-src/transcripts-using-base/doc.md.files/syntax.u
scratch/main> load ./unison-src/transcripts-using-base/doc.md.files/syntax.u
```
```ucm:hide
.> add
scratch/main> add
```
Now we can review different portions of the guide.
@ -57,25 +57,25 @@ we'll show both the pretty-printed source using `view`
and the rendered output using `display`:
```ucm
.> view basicFormatting
.> display basicFormatting
.> view lists
.> display lists
.> view evaluation
.> display evaluation
.> view includingSource
.> display includingSource
.> view nonUnisonCodeBlocks
.> display nonUnisonCodeBlocks
.> view otherElements
.> display otherElements
scratch/main> view basicFormatting
scratch/main> display basicFormatting
scratch/main> view lists
scratch/main> display lists
scratch/main> view evaluation
scratch/main> display evaluation
scratch/main> view includingSource
scratch/main> display includingSource
scratch/main> view nonUnisonCodeBlocks
scratch/main> display nonUnisonCodeBlocks
scratch/main> view otherElements
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
.> view doc.guide
.> display doc.guide
scratch/main> view doc.guide
scratch/main> display doc.guide
```
🌻 THE END

36
unison-src/transcripts-using-base/doc.output.md
View File

@ -51,15 +51,15 @@ 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
.> display d1
scratch/main> display d1
Hello there Alice!
.> docs ImportantConstant
scratch/main> docs ImportantConstant
An important constant, equal to `42`
.> docs DayOfWeek
scratch/main> docs DayOfWeek
The 7 days of the week, defined as:
@ -73,7 +73,7 @@ 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
.> load ./unison-src/transcripts-using-base/doc.md.files/syntax.u
scratch/main> load ./unison-src/transcripts-using-base/doc.md.files/syntax.u
Loading changes detected in
./unison-src/transcripts-using-base/doc.md.files/syntax.u.
@ -100,7 +100,7 @@ we'll show both the pretty-printed source using `view`
and the rendered output using `display`:
```ucm
.> view basicFormatting
scratch/main> view basicFormatting
basicFormatting : Doc2
basicFormatting =
@ -130,7 +130,7 @@ and the rendered output using `display`:
__Next up:__ {lists}
}}
.> display basicFormatting
scratch/main> display basicFormatting
# Basic formatting
@ -155,7 +155,7 @@ and the rendered output using `display`:
*Next up:* lists
.> view lists
scratch/main> view lists
lists : Doc2
lists =
@ -198,7 +198,7 @@ and the rendered output using `display`:
3. Get dressed.
}}
.> display lists
scratch/main> display lists
# Lists
@ -237,7 +237,7 @@ and the rendered output using `display`:
2. Take shower.
3. Get dressed.
.> view evaluation
scratch/main> view evaluation
evaluation : Doc2
evaluation =
@ -272,7 +272,7 @@ and the rendered output using `display`:
```
}}
.> display evaluation
scratch/main> display evaluation
# Evaluation
@ -300,7 +300,7 @@ and the rendered output using `display`:
cube : Nat -> Nat
cube x = x * x * x
.> view includingSource
scratch/main> view includingSource
includingSource : Doc2
includingSource =
@ -341,7 +341,7 @@ and the rendered output using `display`:
{{ docExample 1 do x -> sqr x }}.
}}
.> display includingSource
scratch/main> display includingSource
# Including Unison source code
@ -387,7 +387,7 @@ and the rendered output using `display`:
application, you can put it in double backticks, like
so: `sqr x`. This is equivalent to `sqr x`.
.> view nonUnisonCodeBlocks
scratch/main> view nonUnisonCodeBlocks
nonUnisonCodeBlocks : Doc2
nonUnisonCodeBlocks =
@ -420,7 +420,7 @@ and the rendered output using `display`:
```
}}
.> display nonUnisonCodeBlocks
scratch/main> display nonUnisonCodeBlocks
# Non-Unison code blocks
@ -449,7 +449,7 @@ and the rendered output using `display`:
xs.foldLeft(Nil : List[A])((acc,a) => a +: acc)
```
.> view otherElements
scratch/main> view otherElements
otherElements : Doc2
otherElements =
@ -506,7 +506,7 @@ and the rendered output using `display`:
] }}
}}
.> display otherElements
scratch/main> display otherElements
There are also asides, callouts, tables, tooltips, and more.
These don't currently have special syntax; just use the
@ -549,7 +549,7 @@ and the rendered output using `display`:
Lastly, it's common to build longer documents including subdocuments via `{{ subdoc }}`. We can stitch together the full syntax guide in this way:
```ucm
.> view doc.guide
scratch/main> view doc.guide
doc.guide : Doc2
doc.guide =
@ -569,7 +569,7 @@ Lastly, it's common to build longer documents including subdocuments via `{{ sub
{{ otherElements }}
}}
.> display doc.guide
scratch/main> display doc.guide
# Unison computable documentation

6
unison-src/transcripts-using-base/failure-tests.md
View File

@ -19,13 +19,13 @@ test2 = do
```
```ucm
.> add
scratch/main> add
```
```ucm:error
.> io.test test1
scratch/main> io.test test1
```
```ucm:error
.> io.test test2
scratch/main> io.test test2
```

6
unison-src/transcripts-using-base/failure-tests.output.md
View File

@ -33,7 +33,7 @@ test2 = do
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
@ -42,7 +42,7 @@ test2 = do
```
```ucm
.> io.test test1
scratch/main> io.test test1
💔💥
@ -58,7 +58,7 @@ test2 = do
```
```ucm
.> io.test test2
scratch/main> io.test test2
💔💥

2
unison-src/transcripts-using-base/fix2358.md
View File

@ -10,5 +10,5 @@ timingApp2 _ =
```
```ucm
.> run timingApp2
scratch/main> run timingApp2
```

2
unison-src/transcripts-using-base/fix2358.output.md
View File

@ -23,7 +23,7 @@ timingApp2 _ =
```
```ucm
.> run timingApp2
scratch/main> run timingApp2
()

6
unison-src/transcripts-using-base/fix3939.md
View File

@ -6,7 +6,7 @@ meh = 9
```
```ucm
.> add
.> find meh
.> docs 1
scratch/main> add
scratch/main> find meh
scratch/main> docs 1
```

6
unison-src/transcripts-using-base/fix3939.output.md
View File

@ -20,20 +20,20 @@ meh = 9
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
meh : Nat
meh.doc : Doc2
.> find meh
scratch/main> find meh
1. meh : Nat
2. meh.doc : Doc2
.> docs 1
scratch/main> docs 1
A simple doc.

12
unison-src/transcripts-using-base/hashing.md
View File

@ -3,7 +3,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
.> ls builtin.Bytes
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`.
@ -43,7 +43,7 @@ ex5 = crypto.hmac Sha2_256 mysecret f |> hex
And here's the full API:
```ucm
.> find-in builtin.crypto
scratch/main> find-in builtin.crypto
```
Note that the universal versions of `hash` and `hmac` are currently unimplemented and will bomb at runtime:
@ -189,11 +189,11 @@ test> crypto.hash.numTests =
```
```ucm:hide
.> add
scratch/main> add
```
```ucm
.> test
scratch/main> test
```
## HMAC tests
@ -251,9 +251,9 @@ test> md5.tests.ex3 =
```
```ucm:hide
.> add
scratch/main> add
```
```ucm
.> test
scratch/main> test
```

120
unison-src/transcripts-using-base/hashing.output.md
View File

@ -3,7 +3,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
.> ls builtin.Bytes
scratch/main> ls builtin.Bytes
1. ++ (Bytes -> Bytes -> Bytes)
2. at (Nat -> Bytes -> Optional Nat)
@ -120,7 +120,7 @@ ex5 = crypto.hmac Sha2_256 mysecret f |> hex
And here's the full API:
```ucm
.> find-in builtin.crypto
scratch/main> find-in builtin.crypto
1. type CryptoFailure
2. Ed25519.sign.impl : Bytes
@ -312,40 +312,39 @@ test> crypto.hash.numTests =
```
```ucm
.> test
scratch/main> test
Cached test results (`help testcache` to learn more)
◉ blake2b_512.tests.ex1 Passed
◉ blake2b_512.tests.ex2 Passed
◉ blake2b_512.tests.ex3 Passed
◉ blake2s_256.tests.ex1 Passed
◉ crypto.hash.numTests Passed
◉ sha1.tests.ex1 Passed
◉ sha1.tests.ex2 Passed
◉ sha1.tests.ex3 Passed
◉ sha1.tests.ex4 Passed
◉ sha2_256.tests.ex1 Passed
◉ sha2_256.tests.ex2 Passed
◉ sha2_256.tests.ex3 Passed
◉ sha2_256.tests.ex4 Passed
◉ sha2_512.tests.ex1 Passed
◉ sha2_512.tests.ex2 Passed
◉ sha2_512.tests.ex3 Passed
◉ sha2_512.tests.ex4 Passed
◉ sha3_256.tests.ex1 Passed
◉ sha3_256.tests.ex2 Passed
◉ sha3_256.tests.ex3 Passed
◉ sha3_256.tests.ex4 Passed
◉ sha3_512.tests.ex1 Passed
◉ sha3_512.tests.ex2 Passed
◉ sha3_512.tests.ex3 Passed
◉ sha3_512.tests.ex4 Passed
1. blake2b_512.tests.ex1 ◉ Passed
2. blake2b_512.tests.ex2 ◉ Passed
3. blake2b_512.tests.ex3 ◉ Passed
4. blake2s_256.tests.ex1 ◉ Passed
5. crypto.hash.numTests ◉ Passed
6. sha1.tests.ex1 ◉ Passed
7. sha1.tests.ex2 ◉ Passed
8. sha1.tests.ex3 ◉ Passed
9. sha1.tests.ex4 ◉ Passed
10. sha2_256.tests.ex1 ◉ Passed
11. sha2_256.tests.ex2 ◉ Passed
12. sha2_256.tests.ex3 ◉ Passed
13. sha2_256.tests.ex4 ◉ Passed
14. sha2_512.tests.ex1 ◉ Passed
15. sha2_512.tests.ex2 ◉ Passed
16. sha2_512.tests.ex3 ◉ Passed
17. sha2_512.tests.ex4 ◉ Passed
18. sha3_256.tests.ex1 ◉ Passed
19. sha3_256.tests.ex2 ◉ Passed
20. sha3_256.tests.ex3 ◉ Passed
21. sha3_256.tests.ex4 ◉ Passed
22. sha3_512.tests.ex1 ◉ Passed
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 blake2b_512.tests.ex1 to view the source of a
test.
Tip: Use view 1 to view the source of a test.
```
## HMAC tests
@ -475,42 +474,41 @@ test> md5.tests.ex3 =
```
```ucm
.> test
scratch/main> test
Cached test results (`help testcache` to learn more)
◉ blake2b_512.tests.ex1 Passed
◉ blake2b_512.tests.ex2 Passed
◉ blake2b_512.tests.ex3 Passed
◉ blake2s_256.tests.ex1 Passed
◉ crypto.hash.numTests Passed
◉ md5.tests.ex1 Passed
◉ md5.tests.ex2 Passed
◉ md5.tests.ex3 Passed
◉ sha1.tests.ex1 Passed
◉ sha1.tests.ex2 Passed
◉ sha1.tests.ex3 Passed
◉ sha1.tests.ex4 Passed
◉ sha2_256.tests.ex1 Passed
◉ sha2_256.tests.ex2 Passed
◉ sha2_256.tests.ex3 Passed
◉ sha2_256.tests.ex4 Passed
◉ sha2_512.tests.ex1 Passed
◉ sha2_512.tests.ex2 Passed
◉ sha2_512.tests.ex3 Passed
◉ sha2_512.tests.ex4 Passed
◉ sha3_256.tests.ex1 Passed
◉ sha3_256.tests.ex2 Passed
◉ sha3_256.tests.ex3 Passed
◉ sha3_256.tests.ex4 Passed
◉ sha3_512.tests.ex1 Passed
◉ sha3_512.tests.ex2 Passed
◉ sha3_512.tests.ex3 Passed
◉ sha3_512.tests.ex4 Passed
1. blake2b_512.tests.ex1 ◉ Passed
2. blake2b_512.tests.ex2 ◉ Passed
3. blake2b_512.tests.ex3 ◉ Passed
4. blake2s_256.tests.ex1 ◉ Passed
5. crypto.hash.numTests ◉ Passed
6. md5.tests.ex1 ◉ Passed
7. md5.tests.ex2 ◉ Passed
8. md5.tests.ex3 ◉ Passed
9. sha1.tests.ex1 ◉ Passed
10. sha1.tests.ex2 ◉ Passed
11. sha1.tests.ex3 ◉ Passed
12. sha1.tests.ex4 ◉ Passed
13. sha2_256.tests.ex1 ◉ Passed
14. sha2_256.tests.ex2 ◉ Passed
15. sha2_256.tests.ex3 ◉ Passed
16. sha2_256.tests.ex4 ◉ Passed
17. sha2_512.tests.ex1 ◉ Passed
18. sha2_512.tests.ex2 ◉ Passed
19. sha2_512.tests.ex3 ◉ Passed
20. sha2_512.tests.ex4 ◉ Passed
21. sha3_256.tests.ex1 ◉ Passed
22. sha3_256.tests.ex2 ◉ Passed
23. sha3_256.tests.ex3 ◉ Passed
24. sha3_256.tests.ex4 ◉ Passed
25. sha3_512.tests.ex1 ◉ Passed
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 blake2b_512.tests.ex1 to view the source of a
test.
Tip: Use view 1 to view the source of a test.
```

4
unison-src/transcripts-using-base/mvar.md
View File

@ -51,7 +51,7 @@ testMvars _ =
runTest test
```
```ucm
.> add
.> io.test testMvars
scratch/main> add
scratch/main> io.test testMvars
```

32
unison-src/transcripts-using-base/mvar.output.md
View File

@ -66,33 +66,33 @@ testMvars _ =
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
eitherCk : (a ->{g} Boolean) -> Either e a ->{g} Boolean
testMvars : '{IO} [Result]
.> io.test testMvars
scratch/main> io.test testMvars
New test results:
◉ testMvars ma should not be empty
◉ testMvars should read what you sow
◉ testMvars should reap what you sow
◉ testMvars ma should be empty
◉ testMvars swap returns old contents
◉ testMvars swap returns old contents
◉ testMvars tryRead should succeed when not empty
◉ testMvars tryPut should fail when not empty
◉ testMvars tryTake should succeed when not empty
◉ testMvars tryTake should not succeed when empty
◉ testMvars ma2 should be empty
◉ testMvars tryTake should fail when empty
◉ testMvars tryRead should fail when empty
1. testMvars ◉ ma should not be empty
◉ should read what you sow
◉ should reap what you sow
◉ ma should be empty
◉ swap returns old contents
◉ swap returns old contents
◉ tryRead should succeed when not empty
◉ tryPut should fail when not empty
◉ tryTake should succeed when not empty
◉ tryTake should not succeed when empty
◉ ma2 should be empty
◉ tryTake should fail when empty
◉ tryRead should fail when empty
✅ 13 test(s) passing
Tip: Use view testMvars to view the source of a test.
Tip: Use view 1 to view the source of a test.
```

4
unison-src/transcripts-using-base/nat-coersion.md
View File

@ -33,6 +33,6 @@ test = 'let
```
```ucm
.> add
.> io.test test
scratch/main> add
scratch/main> io.test test
```

34
unison-src/transcripts-using-base/nat-coersion.output.md
View File

@ -49,7 +49,7 @@ test = 'let
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
@ -59,27 +59,27 @@ test = 'let
-> Optional Float
->{Stream Result} ()
.> io.test test
scratch/main> io.test test
New test results:
◉ test expected 0.0 got 0.0
◉ test round trip though float, expected 0 got 0
◉ test expected 0 got 0
◉ test round trip though Int, expected 0 got 0
◉ test skipped
◉ test expected 1 got 1
◉ test round trip though Int, expected 1 got 1
◉ test skipped
◉ test expected -1 got -1
◉ test round trip though Int, expected 18446744073709551615 got 18446744073709551615
◉ test expected 1.0000000000000002 got 1.0000000000000002
◉ test round trip though float, expected 4607182418800017409 got 4607182418800017409
◉ test expected 4607182418800017409 got 4607182418800017409
◉ test round trip though Int, expected 4607182418800017409 got 4607182418800017409
1. test ◉ expected 0.0 got 0.0
◉ round trip though float, expected 0 got 0
◉ expected 0 got 0
◉ round trip though Int, expected 0 got 0
◉ skipped
◉ expected 1 got 1
◉ round trip though Int, expected 1 got 1
◉ skipped
◉ expected -1 got -1
◉ round trip though Int, expected 18446744073709551615 got 18446744073709551615
◉ expected 1.0000000000000002 got 1.0000000000000002
◉ 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 test to view the source of a test.
Tip: Use view 1 to view the source of a test.
```

10
unison-src/transcripts-using-base/net.md
View File

@ -10,7 +10,7 @@ socketAccept = compose reraise socketAccept.impl
```
```ucm:hide
.> add
scratch/main> add
```
# Tests for network related builtins
@ -93,8 +93,8 @@ testDefaultPort _ =
runTest test
```
```ucm
.> add
.> io.test testDefaultPort
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.
@ -149,6 +149,6 @@ testTcpConnect = 'let
```
```ucm
.> add
.> io.test testTcpConnect
scratch/main> add
scratch/main> io.test testTcpConnect
```

20
unison-src/transcripts-using-base/net.output.md
View File

@ -107,7 +107,7 @@ testDefaultPort _ =
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
@ -115,17 +115,17 @@ testDefaultPort _ =
testDefaultPort : '{IO} [Result]
testExplicitHost : '{IO} [Result]
.> io.test testDefaultPort
scratch/main> io.test testDefaultPort
New test results:
◉ testDefaultPort successfully created socket
◉ testDefaultPort port should be > 1024
◉ testDefaultPort port should be < 65536
1. testDefaultPort ◉ successfully created socket
◉ port should be > 1024
◉ port should be < 65536
✅ 3 test(s) passing
Tip: Use view testDefaultPort 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.
@ -194,7 +194,7 @@ testTcpConnect = 'let
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
@ -202,14 +202,14 @@ testTcpConnect = 'let
serverThread : MVar Nat -> Text -> '{IO} ()
testTcpConnect : '{IO} [Result]
.> io.test testTcpConnect
scratch/main> io.test testTcpConnect
New test results:
◉ testTcpConnect should have reaped what we've sown
1. testTcpConnect ◉ should have reaped what we've sown
✅ 1 test(s) passing
Tip: Use view testTcpConnect to view the source of a test.
Tip: Use view 1 to view the source of a test.
```

4
unison-src/transcripts-using-base/random-deserial.md
View File

@ -56,6 +56,6 @@ serialTests = do
```
```ucm
.> add
.> io.test serialTests
scratch/main> add
scratch/main> io.test serialTests
```

16
unison-src/transcripts-using-base/random-deserial.output.md
View File

@ -74,7 +74,7 @@ serialTests = do
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
@ -85,18 +85,18 @@ serialTests = do
serialTests : '{IO, Exception} [Result]
shuffle : Nat -> [a] -> [a]
.> io.test serialTests
scratch/main> io.test serialTests
New test results:
◉ serialTests case-00
◉ serialTests case-01
◉ serialTests case-02
◉ serialTests case-03
◉ serialTests case-04
1. serialTests ◉ case-00
◉ case-01
◉ case-02
◉ case-03
◉ case-04
✅ 5 test(s) passing
Tip: Use view serialTests to view the source of a test.
Tip: Use view 1 to view the source of a test.
```

18
unison-src/transcripts-using-base/ref-promise.md
View File

@ -19,8 +19,8 @@ casTest = do
```
```ucm
.> add
.> io.test casTest
scratch/main> add
scratch/main> io.test casTest
```
Promise is a simple one-shot awaitable condition.
@ -54,9 +54,9 @@ promiseConcurrentTest = do
```
```ucm
.> add
.> io.test promiseSequentialTest
.> io.test promiseConcurrentTest
scratch/main> add
scratch/main> io.test promiseSequentialTest
scratch/main> io.test promiseConcurrentTest
```
CAS can be used to write an atomic update function.
@ -70,7 +70,7 @@ atomicUpdate ref f =
```
```ucm
.> add
scratch/main> add
```
Promise can be used to write an operation that spawns N concurrent
@ -91,7 +91,7 @@ spawnN n fa =
map Promise.read (go n [])
```
```ucm
.> add
scratch/main> add
```
We can use these primitives to write a more interesting example, where
@ -123,6 +123,6 @@ fullTest = do
```
```ucm
.> add
.> io.test fullTest
scratch/main> add
scratch/main> io.test fullTest
```

40
unison-src/transcripts-using-base/ref-promise.output.md
View File

@ -32,22 +32,22 @@ casTest = do
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
casTest : '{IO} [Result]
.> io.test casTest
scratch/main> io.test casTest
New test results:
◉ casTest CAS is successful is there were no conflicting writes
◉ casTest CAS fails when there was an intervening write
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 casTest 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.
@ -95,35 +95,33 @@ promiseConcurrentTest = do
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
promiseConcurrentTest : '{IO} [Result]
promiseSequentialTest : '{IO} [Result]
.> io.test promiseSequentialTest
scratch/main> io.test promiseSequentialTest
New test results:
◉ promiseSequentialTest Should read a value that's been written
◉ promiseSequentialTest Promise can only be written to once
1. promiseSequentialTest ◉ Should read a value that's been written
◉ Promise can only be written to once
✅ 2 test(s) passing
Tip: Use view promiseSequentialTest to view the source of a
test.
Tip: Use view 1 to view the source of a test.
.> io.test promiseConcurrentTest
scratch/main> io.test promiseConcurrentTest
New test results:
◉ promiseConcurrentTest Reads awaits for completion of the Promise
1. promiseConcurrentTest ◉ Reads awaits for completion of the Promise
✅ 1 test(s) passing
Tip: Use view promiseConcurrentTest 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.
@ -150,7 +148,7 @@ atomicUpdate ref f =
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
@ -189,7 +187,7 @@ spawnN n fa =
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
@ -238,20 +236,20 @@ fullTest = do
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
fullTest : '{IO} [Result]
.> io.test fullTest
scratch/main> io.test fullTest
New test results:
◉ fullTest The state of the counter is consistent
1. fullTest ◉ The state of the counter is consistent
✅ 1 test(s) passing
Tip: Use view fullTest to view the source of a test.
Tip: Use view 1 to view the source of a test.
```

4
unison-src/transcripts-using-base/serial-test-00.md
View File

@ -68,6 +68,6 @@ mkTestCase = do
```
```ucm
.> add
.> run mkTestCase
scratch/main> add
scratch/main> run mkTestCase
```

4
unison-src/transcripts-using-base/serial-test-00.output.md
View File

@ -95,7 +95,7 @@ mkTestCase = do
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
@ -115,7 +115,7 @@ mkTestCase = do
tree2 : Tree Nat
tree3 : Tree Text
.> run mkTestCase
scratch/main> run mkTestCase
()

4
unison-src/transcripts-using-base/serial-test-01.md
View File

@ -16,6 +16,6 @@ mkTestCase = do
```
```ucm
.> add
.> run mkTestCase
scratch/main> add
scratch/main> run mkTestCase
```

4
unison-src/transcripts-using-base/serial-test-01.output.md
View File

@ -33,7 +33,7 @@ mkTestCase = do
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
@ -43,7 +43,7 @@ mkTestCase = do
l3 : [Char]
mkTestCase : '{IO, Exception} ()
.> run mkTestCase
scratch/main> run mkTestCase
()

4
unison-src/transcripts-using-base/serial-test-02.md
View File

@ -30,6 +30,6 @@ mkTestCase = do
```
```ucm
.> add
.> run mkTestCase
scratch/main> add
scratch/main> run mkTestCase
```

4
unison-src/transcripts-using-base/serial-test-02.output.md
View File

@ -49,7 +49,7 @@ mkTestCase = do
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
@ -61,7 +61,7 @@ mkTestCase = do
prod : [Nat] -> Nat
products : ([Nat], [Nat], [Nat]) -> Text
.> run mkTestCase
scratch/main> run mkTestCase
()

4
unison-src/transcripts-using-base/serial-test-03.md
View File

@ -44,6 +44,6 @@ mkTestCase = do
```
```ucm
.> add
.> run mkTestCase
scratch/main> add
scratch/main> run mkTestCase
```

4
unison-src/transcripts-using-base/serial-test-03.output.md
View File

@ -68,7 +68,7 @@ mkTestCase = do
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
@ -84,7 +84,7 @@ mkTestCase = do
reset : '{DC r} r -> r
suspSum : [Nat] -> Delayed Nat
.> run mkTestCase
scratch/main> run mkTestCase
()

4
unison-src/transcripts-using-base/serial-test-04.md
View File

@ -14,6 +14,6 @@ mkTestCase = do
```
```ucm
.> add
.> run mkTestCase
scratch/main> add
scratch/main> run mkTestCase
```

4
unison-src/transcripts-using-base/serial-test-04.output.md
View File

@ -28,7 +28,7 @@ mkTestCase = do
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
@ -36,7 +36,7 @@ mkTestCase = do
mutual0 : Nat -> Text
mutual1 : Nat -> Text
.> run mkTestCase
scratch/main> run mkTestCase
()

6
unison-src/transcripts-using-base/stm.md
View File

@ -28,7 +28,7 @@ body k out v =
```
```ucm
.> add
scratch/main> add
```
Test case.
@ -67,6 +67,6 @@ tests = '(map spawn nats)
```
```ucm
.> add
.> io.test tests
scratch/main> add
scratch/main> io.test tests
```

28
unison-src/transcripts-using-base/stm.output.md
View File

@ -44,7 +44,7 @@ body k out v =
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
@ -106,7 +106,7 @@ tests = '(map spawn nats)
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
@ -115,23 +115,23 @@ tests = '(map spawn nats)
spawn : Nat ->{IO} Result
tests : '{IO} [Result]
.> io.test tests
scratch/main> io.test tests
New test results:
◉ tests verified
◉ tests verified
◉ tests verified
◉ tests verified
◉ tests verified
◉ tests verified
◉ tests verified
◉ tests verified
◉ tests verified
◉ tests verified
1. tests ◉ verified
◉ verified
◉ verified
◉ verified
◉ verified
◉ verified
◉ verified
◉ verified
◉ verified
◉ verified
✅ 10 test(s) passing
Tip: Use view tests to view the source of a test.
Tip: Use view 1 to view the source of a test.
```

6
unison-src/transcripts-using-base/test-watch-dependencies.md
View File

@ -9,7 +9,7 @@ x = 999
```
```ucm:hide
.> add
scratch/main> add
```
Now, we update that definition and define a test-watch which depends on it.
@ -22,7 +22,7 @@ test> mytest = checks [x + 1 == 1001]
We expect this 'add' to fail because the test is blocked by the update to `x`.
```ucm:error
.> add
scratch/main> add
```
---
@ -35,5 +35,5 @@ test> useY = checks [y + 1 == 43]
This should correctly identify `y` as a dependency and add that too.
```ucm
.> add useY
scratch/main> add useY
```

4
unison-src/transcripts-using-base/test-watch-dependencies.output.md
View File

@ -43,7 +43,7 @@ test> mytest = checks [x + 1 == 1001]
We expect this 'add' to fail because the test is blocked by the update to `x`.
```ucm
.> add
scratch/main> add
x These definitions failed:
@ -85,7 +85,7 @@ test> useY = checks [y + 1 == 43]
This should correctly identify `y` as a dependency and add that too.
```ucm
.> add useY
scratch/main> add useY
⍟ I've added these definitions:

12
unison-src/transcripts-using-base/thread.md
View File

@ -19,8 +19,8 @@ testBasicFork = 'let
See if we can get another thread to stuff a value into a MVar
```ucm:hide
.> add
.> io.test testBasicFork
scratch/main> add
scratch/main> io.test testBasicFork
```
```unison
@ -48,8 +48,8 @@ testBasicMultiThreadMVar = 'let
```
```ucm
.> add
.> io.test testBasicMultiThreadMVar
scratch/main> add
scratch/main> io.test testBasicMultiThreadMVar
```
```unison
@ -91,6 +91,6 @@ testTwoThreads = 'let
```
```ucm
.> add
.> io.test testTwoThreads
scratch/main> add
scratch/main> io.test testTwoThreads
```

17
unison-src/transcripts-using-base/thread.output.md
View File

@ -71,23 +71,22 @@ testBasicMultiThreadMVar = 'let
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
testBasicMultiThreadMVar : '{IO} [Result]
thread1 : Nat -> MVar Nat -> '{IO} ()
.> io.test testBasicMultiThreadMVar
scratch/main> io.test testBasicMultiThreadMVar
New test results:
◉ testBasicMultiThreadMVar other thread should have incremented
1. testBasicMultiThreadMVar ◉ other thread should have incremented
✅ 1 test(s) passing
Tip: Use view testBasicMultiThreadMVar to view the source of a
test.
Tip: Use view 1 to view the source of a test.
```
```unison
@ -145,7 +144,7 @@ testTwoThreads = 'let
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
@ -154,14 +153,14 @@ testTwoThreads = 'let
(also named thread1)
testTwoThreads : '{IO} [Result]
.> io.test testTwoThreads
scratch/main> io.test testTwoThreads
New test results:
◉ testTwoThreads
1. testTwoThreads ◉
✅ 1 test(s) passing
Tip: Use view testTwoThreads to view the source of a test.
Tip: Use view 1 to view the source of a test.
```

14
unison-src/transcripts-using-base/tls.md
View File

@ -12,7 +12,7 @@ not_a_cert = "-----BEGIN SCHERMIFICATE-----\n-----END SCHERMIFICATE-----"
```
```ucm:hide
.> add
scratch/main> add
```
# Using an alternative certificate store
@ -32,8 +32,8 @@ what_should_work _ = this_should_work ++ this_should_not_work
```
```ucm
.> add
.> io.test what_should_work
scratch/main> add
scratch/main> io.test what_should_work
```
Test handshaking a client/server a local TCP connection using our
@ -191,8 +191,8 @@ testCNReject _ =
```
```ucm
.> add
.> io.test testConnectSelfSigned
.> io.test testCAReject
.> io.test testCNReject
scratch/main> add
scratch/main> io.test testConnectSelfSigned
scratch/main> io.test testCAReject
scratch/main> io.test testCNReject
```

31
unison-src/transcripts-using-base/tls.output.md
View File

@ -43,7 +43,7 @@ what_should_work _ = this_should_work ++ this_should_not_work
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
@ -51,16 +51,16 @@ what_should_work _ = this_should_work ++ this_should_not_work
this_should_work : [Result]
what_should_work : ∀ _. _ -> [Result]
.> io.test what_should_work
scratch/main> io.test what_should_work
New test results:
◉ what_should_work succesfully decoded self_signed_pem
◉ what_should_work failed
1. what_should_work ◉ succesfully decoded self_signed_pem
◉ failed
✅ 2 test(s) passing
Tip: Use view what_should_work 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
@ -238,7 +238,7 @@ testCNReject _ =
```
```ucm
.> add
scratch/main> add
⍟ I've added these definitions:
@ -251,35 +251,34 @@ testCNReject _ =
-> '{IO, Exception} Text
testConnectSelfSigned : '{IO} [Result]
.> io.test testConnectSelfSigned
scratch/main> io.test testConnectSelfSigned
New test results:
◉ testConnectSelfSigned should have reaped what we've sown
1. testConnectSelfSigned ◉ should have reaped what we've sown
✅ 1 test(s) passing
Tip: Use view testConnectSelfSigned to view the source of a
test.
Tip: Use view 1 to view the source of a test.
.> io.test testCAReject
scratch/main> io.test testCAReject
New test results:
◉ testCAReject correctly rejected self-signed cert
1. testCAReject ◉ correctly rejected self-signed cert
✅ 1 test(s) passing
Tip: Use view testCAReject to view the source of a test.
Tip: Use view 1 to view the source of a test.
.> io.test testCNReject
scratch/main> io.test testCNReject
New test results:
◉ testCNReject correctly rejected self-signed cert
1. testCNReject ◉ correctly rejected self-signed cert
✅ 1 test(s) passing
Tip: Use view testCNReject to view the source of a test.
Tip: Use view 1 to view the source of a test.
```

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