mirror of
https://github.com/unisonweb/unison.git
synced 2024-11-15 04:11:34 +03:00
Merge remote-tracking branch 'origin/trunk' into feature/nice-IO-names
This commit is contained in:
commit
d3bc3df9b4
@ -31,6 +31,7 @@ import qualified Text.Regex.TDFA as RE
|
||||
import qualified Unison.ConstructorType as CT
|
||||
import Unison.Codebase.CodeLookup ( CodeLookup(..) )
|
||||
import qualified Unison.Builtin.Decls as DD
|
||||
import qualified Unison.Builtin.Terms as TD
|
||||
import qualified Unison.DataDeclaration as DD
|
||||
import Unison.Parser ( Ann(..) )
|
||||
import qualified Unison.Reference as R
|
||||
@ -59,7 +60,9 @@ names0 = Names3.names0 terms types where
|
||||
Rel.fromList [ (Name.fromVar vc, Referent.Con (R.DerivedId r) cid ct)
|
||||
| (ct, (_,(r,decl))) <- ((CT.Data,) <$> builtinDataDecls @Symbol) <>
|
||||
((CT.Effect,) . (second . second) DD.toDataDecl <$> builtinEffectDecls)
|
||||
, ((_,vc,_), cid) <- DD.constructors' decl `zip` [0..]]
|
||||
, ((_,vc,_), cid) <- DD.constructors' decl `zip` [0..]] <>
|
||||
Rel.fromList [ (Name.fromVar v, Referent.Ref (R.DerivedId i))
|
||||
| (v,i) <- Map.toList $ TD.builtinTermsRef @Symbol Intrinsic]
|
||||
types = Rel.fromList builtinTypes <>
|
||||
Rel.fromList [ (Name.fromVar v, R.DerivedId r)
|
||||
| (v,(r,_)) <- builtinDataDecls @Symbol ] <>
|
||||
|
@ -41,6 +41,9 @@ optionalRef = lookupDeclRef "Optional"
|
||||
eitherRef = lookupDeclRef "Either"
|
||||
|
||||
testResultRef, linkRef, docRef, ioErrorRef, stdHandleRef, failureRef, tlsSignedCertRef, tlsPrivateKeyRef :: Reference
|
||||
isPropagatedRef, isTestRef :: Reference
|
||||
isPropagatedRef = lookupDeclRef "IsPropagated"
|
||||
isTestRef = lookupDeclRef "IsTest"
|
||||
testResultRef = lookupDeclRef "Test.Result"
|
||||
linkRef = lookupDeclRef "Link"
|
||||
docRef = lookupDeclRef "Doc"
|
||||
@ -67,6 +70,9 @@ constructorId ref name = do
|
||||
elemIndex name $ DD.constructorNames dd
|
||||
|
||||
okConstructorId, failConstructorId, docBlobId, docLinkId, docSignatureId, docSourceId, docEvaluateId, docJoinId, linkTermId, linkTypeId :: ConstructorId
|
||||
isPropagatedConstructorId, isTestConstructorId :: ConstructorId
|
||||
Just isPropagatedConstructorId = constructorId isPropagatedRef "IsPropagated.IsPropagated"
|
||||
Just isTestConstructorId = constructorId isTestRef "IsTest.IsTest"
|
||||
Just okConstructorId = constructorId testResultRef "Test.Result.Ok"
|
||||
Just failConstructorId = constructorId testResultRef "Test.Result.Fail"
|
||||
Just docBlobId = constructorId docRef "Doc.Blob"
|
||||
@ -96,6 +102,8 @@ builtinDataDecls = rs1 ++ rs
|
||||
, (v "Optional" , opt)
|
||||
, (v "Either" , eith)
|
||||
, (v "Test.Result" , tr)
|
||||
, (v "IsPropagated" , isPropagated)
|
||||
, (v "IsTest" , isTest)
|
||||
, (v "Doc" , doc)
|
||||
, (v "io2.FileMode" , fmode)
|
||||
, (v "io2.BufferMode" , bmode)
|
||||
@ -157,6 +165,18 @@ builtinDataDecls = rs1 ++ rs
|
||||
(var "b" `arr` Type.apps' (var "Either") [var "a", var "b"])
|
||||
)
|
||||
]
|
||||
isTest =
|
||||
DataDeclaration
|
||||
(Unique "e6dca08b40458b03ca1660cfbdaecaa7279b42d18257898b5fd1c34596aac36f")
|
||||
()
|
||||
[]
|
||||
[((), v "IsTest.IsTest", var "IsTest")]
|
||||
isPropagated =
|
||||
DataDeclaration
|
||||
(Unique "b28d929d0a73d2c18eac86341a3bb9399f8550c11b5f35eabb2751e6803ccc20")
|
||||
()
|
||||
[]
|
||||
[((), v "IsPropagated.IsPropagated", var "IsPropagated")]
|
||||
fmode = DataDeclaration
|
||||
(Unique "3c11ba4f0a5d8fedd427b476cdd2d7673197d11e")
|
||||
()
|
||||
|
36
parser-typechecker/src/Unison/Builtin/Terms.hs
Normal file
36
parser-typechecker/src/Unison/Builtin/Terms.hs
Normal file
@ -0,0 +1,36 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module Unison.Builtin.Terms where
|
||||
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Text (Text)
|
||||
import qualified Unison.Builtin.Decls as Decls
|
||||
import qualified Unison.Reference as Reference
|
||||
import Unison.Term (Term)
|
||||
import qualified Unison.Term as Term
|
||||
import Unison.Type (Type)
|
||||
import qualified Unison.Type as Type
|
||||
import Unison.Var (Var)
|
||||
import qualified Unison.Var as Var
|
||||
|
||||
builtinTermsSrc :: Var v => a -> [(v, Term v a, Type v a)]
|
||||
builtinTermsSrc a =
|
||||
[ ( v "metadata.isPropagated",
|
||||
Term.constructor a Decls.isPropagatedRef Decls.isPropagatedConstructorId,
|
||||
Type.ref a Decls.isPropagatedRef
|
||||
),
|
||||
( v "metadata.isTest",
|
||||
Term.constructor a Decls.isTestRef Decls.isTestConstructorId,
|
||||
Type.ref a Decls.isTestRef
|
||||
)
|
||||
]
|
||||
|
||||
v :: Var v => Text -> v
|
||||
v = Var.named
|
||||
|
||||
builtinTermsRef :: Var v => a -> Map v Reference.Id
|
||||
builtinTermsRef a = fmap fst . Term.hashComponents . Map.fromList
|
||||
. fmap (\(v, tm, _tp) -> (v, tm))
|
||||
$ builtinTermsSrc a
|
@ -11,13 +11,13 @@ import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
import qualified Unison.ABT as ABT
|
||||
import qualified Unison.Builtin as Builtin
|
||||
import qualified Unison.Builtin.Terms as Builtin
|
||||
import Unison.Codebase.Branch ( Branch )
|
||||
import qualified Unison.Codebase.Branch as Branch
|
||||
import qualified Unison.Codebase.CodeLookup as CL
|
||||
import qualified Unison.Codebase.Reflog as Reflog
|
||||
import Unison.Codebase.SyncMode ( SyncMode )
|
||||
import qualified Unison.DataDeclaration as DD
|
||||
import qualified Unison.Names2 as Names
|
||||
import Unison.Reference ( Reference )
|
||||
import qualified Unison.Reference as Reference
|
||||
import qualified Unison.Referent as Referent
|
||||
@ -31,7 +31,6 @@ import qualified Unison.Util.Relation as Rel
|
||||
import qualified Unison.Util.Set as Set
|
||||
import qualified Unison.Var as Var
|
||||
import Unison.Var ( Var )
|
||||
import qualified Unison.Runtime.IOSource as IOSource
|
||||
import Unison.Symbol ( Symbol )
|
||||
import Unison.DataDeclaration (Decl)
|
||||
import Unison.Term (Term)
|
||||
@ -98,16 +97,13 @@ data GetRootBranchError
|
||||
|
||||
data SyncFileCodebaseResult = SyncOk | UnknownDestinationRootBranch Branch.Hash | NotFastForward
|
||||
|
||||
bootstrapNames :: Names.Names0
|
||||
bootstrapNames =
|
||||
Builtin.names0 <> UF.typecheckedToNames0 IOSource.typecheckedFile
|
||||
|
||||
-- | Write all of the builtins types into the codebase and create empty namespace
|
||||
initializeCodebase :: forall m. Monad m => Codebase m Symbol Parser.Ann -> m ()
|
||||
initializeCodebase c = do
|
||||
let uf = (UF.typecheckedUnisonFile (Map.fromList Builtin.builtinDataDecls)
|
||||
(Map.fromList Builtin.builtinEffectDecls)
|
||||
mempty mempty)
|
||||
[Builtin.builtinTermsSrc Parser.Intrinsic]
|
||||
mempty)
|
||||
addDefsToCodebase c uf
|
||||
putRootBranch c (Branch.one Branch.empty0)
|
||||
|
||||
|
@ -18,6 +18,7 @@ import qualified Unison.Builtin as B
|
||||
|
||||
import qualified Crypto.Random as Random
|
||||
import Control.Monad.Except ( runExceptT )
|
||||
import qualified Control.Monad.State as State
|
||||
import qualified Data.Configurator as Config
|
||||
import Data.Configurator.Types ( Config )
|
||||
import qualified Data.Map as Map
|
||||
@ -92,78 +93,80 @@ commandLine
|
||||
-> Free (Command IO i v) a
|
||||
-> IO a
|
||||
commandLine config awaitInput setBranchRef rt notifyUser notifyNumbered loadSource codebase rngGen branchCache =
|
||||
Free.foldWithIndex go
|
||||
flip State.evalStateT 0 . Free.fold go
|
||||
where
|
||||
go :: forall x . Int -> Command IO i v x -> IO x
|
||||
go i x = case x of
|
||||
go :: forall x . Command IO i v x -> State.StateT Int IO x
|
||||
go x = case x of
|
||||
-- Wait until we get either user input or a unison file update
|
||||
Eval m -> m
|
||||
Input -> awaitInput
|
||||
Notify output -> notifyUser output
|
||||
NotifyNumbered output -> notifyNumbered output
|
||||
Eval m -> lift $ m
|
||||
Input -> lift $ awaitInput
|
||||
Notify output -> lift $ notifyUser output
|
||||
NotifyNumbered output -> lift $ notifyNumbered output
|
||||
ConfigLookup name ->
|
||||
Config.lookup config name
|
||||
LoadSource sourcePath -> loadSource sourcePath
|
||||
lift $ Config.lookup config name
|
||||
LoadSource sourcePath -> lift $ loadSource sourcePath
|
||||
|
||||
Typecheck ambient names sourceName source -> do
|
||||
-- todo: if guids are being shown to users,
|
||||
-- not ideal to generate new guid every time
|
||||
rng <- rngGen i
|
||||
i <- State.get
|
||||
State.modify' (+1)
|
||||
rng <- lift $ rngGen i
|
||||
let namegen = Parser.uniqueBase32Namegen rng
|
||||
env = Parser.ParsingEnv namegen names
|
||||
typecheck ambient codebase env sourceName source
|
||||
TypecheckFile file ambient -> typecheck' ambient codebase file
|
||||
Evaluate ppe unisonFile -> evalUnisonFile ppe unisonFile
|
||||
Evaluate1 ppe term -> eval1 ppe term
|
||||
LoadLocalRootBranch -> either (const Branch.empty) id <$> Codebase.getRootBranch codebase
|
||||
LoadLocalBranch h -> fromMaybe Branch.empty <$> Codebase.getBranchForHash codebase h
|
||||
SyncLocalRootBranch branch -> do
|
||||
lift $ typecheck ambient codebase env sourceName source
|
||||
TypecheckFile file ambient -> lift $ typecheck' ambient codebase file
|
||||
Evaluate ppe unisonFile -> lift $ evalUnisonFile ppe unisonFile
|
||||
Evaluate1 ppe term -> lift $ eval1 ppe term
|
||||
LoadLocalRootBranch -> lift $ either (const Branch.empty) id <$> Codebase.getRootBranch codebase
|
||||
LoadLocalBranch h -> lift $ fromMaybe Branch.empty <$> Codebase.getBranchForHash codebase h
|
||||
SyncLocalRootBranch branch -> lift $ do
|
||||
setBranchRef branch
|
||||
Codebase.putRootBranch codebase branch
|
||||
ViewRemoteBranch ns ->
|
||||
runExceptT $ Git.viewRemoteBranch branchCache ns
|
||||
lift $ runExceptT $ Git.viewRemoteBranch branchCache ns
|
||||
ImportRemoteBranch ns syncMode ->
|
||||
runExceptT $ Git.importRemoteBranch codebase branchCache ns syncMode
|
||||
lift $ runExceptT $ Git.importRemoteBranch codebase branchCache ns syncMode
|
||||
SyncRemoteRootBranch repo branch syncMode ->
|
||||
runExceptT $ Git.pushGitRootBranch codebase branchCache branch repo syncMode
|
||||
LoadTerm r -> Codebase.getTerm codebase r
|
||||
LoadType r -> Codebase.getTypeDeclaration codebase r
|
||||
LoadTypeOfTerm r -> Codebase.getTypeOfTerm codebase r
|
||||
PutTerm r tm tp -> Codebase.putTerm codebase r tm tp
|
||||
PutDecl r decl -> Codebase.putTypeDeclaration codebase r decl
|
||||
PutWatch kind r e -> Codebase.putWatch codebase kind r e
|
||||
LoadWatches kind rs -> catMaybes <$> traverse go (toList rs) where
|
||||
lift $ runExceptT $ Git.pushGitRootBranch codebase branchCache branch repo syncMode
|
||||
LoadTerm r -> lift $ Codebase.getTerm codebase r
|
||||
LoadType r -> lift $ Codebase.getTypeDeclaration codebase r
|
||||
LoadTypeOfTerm r -> lift $ Codebase.getTypeOfTerm codebase r
|
||||
PutTerm r tm tp -> lift $ Codebase.putTerm codebase r tm tp
|
||||
PutDecl r decl -> lift $ Codebase.putTypeDeclaration codebase r decl
|
||||
PutWatch kind r e -> lift $ Codebase.putWatch codebase kind r e
|
||||
LoadWatches kind rs -> lift $ catMaybes <$> traverse go (toList rs) where
|
||||
go (Reference.Builtin _) = pure Nothing
|
||||
go r@(Reference.DerivedId rid) =
|
||||
fmap (r,) <$> Codebase.getWatch codebase kind rid
|
||||
IsTerm r -> Codebase.isTerm codebase r
|
||||
IsType r -> Codebase.isType codebase r
|
||||
GetDependents r -> Codebase.dependents codebase r
|
||||
AddDefsToCodebase unisonFile -> Codebase.addDefsToCodebase codebase unisonFile
|
||||
GetTermsOfType ty -> Codebase.termsOfType codebase ty
|
||||
GetTermsMentioningType ty -> Codebase.termsMentioningType codebase ty
|
||||
CodebaseHashLength -> Codebase.hashLength codebase
|
||||
IsTerm r -> lift $ Codebase.isTerm codebase r
|
||||
IsType r -> lift $ Codebase.isType codebase r
|
||||
GetDependents r -> lift $ Codebase.dependents codebase r
|
||||
AddDefsToCodebase unisonFile -> lift $ Codebase.addDefsToCodebase codebase unisonFile
|
||||
GetTermsOfType ty -> lift $ Codebase.termsOfType codebase ty
|
||||
GetTermsMentioningType ty -> lift $ Codebase.termsMentioningType codebase ty
|
||||
CodebaseHashLength -> lift $ Codebase.hashLength codebase
|
||||
-- all builtin and derived type references
|
||||
TypeReferencesByShortHash sh -> do
|
||||
fromCodebase <- Codebase.typeReferencesByPrefix codebase sh
|
||||
fromCodebase <- lift $ Codebase.typeReferencesByPrefix codebase sh
|
||||
let fromBuiltins = Set.filter (\r -> sh == Reference.toShortHash r)
|
||||
$ B.intrinsicTypeReferences
|
||||
pure (fromBuiltins <> Set.map Reference.DerivedId fromCodebase)
|
||||
-- all builtin and derived term references
|
||||
TermReferencesByShortHash sh -> do
|
||||
fromCodebase <- Codebase.termReferencesByPrefix codebase sh
|
||||
fromCodebase <- lift $ Codebase.termReferencesByPrefix codebase sh
|
||||
let fromBuiltins = Set.filter (\r -> sh == Reference.toShortHash r)
|
||||
$ B.intrinsicTermReferences
|
||||
pure (fromBuiltins <> Set.map Reference.DerivedId fromCodebase)
|
||||
-- all builtin and derived term references & type constructors
|
||||
TermReferentsByShortHash sh -> do
|
||||
fromCodebase <- Codebase.termReferentsByPrefix codebase sh
|
||||
fromCodebase <- lift $ Codebase.termReferentsByPrefix codebase sh
|
||||
let fromBuiltins = Set.map Referent.Ref
|
||||
. Set.filter (\r -> sh == Reference.toShortHash r)
|
||||
$ B.intrinsicTermReferences
|
||||
pure (fromBuiltins <> Set.map (fmap Reference.DerivedId) fromCodebase)
|
||||
BranchHashLength -> Codebase.branchHashLength codebase
|
||||
BranchHashesByPrefix h -> Codebase.branchHashesByPrefix codebase h
|
||||
BranchHashLength -> lift $ Codebase.branchHashLength codebase
|
||||
BranchHashesByPrefix h -> lift $ Codebase.branchHashesByPrefix codebase h
|
||||
ParseType names (src, _) -> pure $
|
||||
Parsers.parseType (Text.unpack src) (Parser.ParsingEnv mempty names)
|
||||
RuntimeMain -> pure $ Runtime.mainType rt
|
||||
@ -175,9 +178,9 @@ commandLine config awaitInput setBranchRef rt notifyUser notifyNumbered loadSour
|
||||
-- pure $ Branch.append b0 b
|
||||
|
||||
Execute ppe uf ->
|
||||
evalUnisonFile ppe uf
|
||||
AppendToReflog reason old new -> Codebase.appendReflog codebase reason old new
|
||||
LoadReflog -> Codebase.getReflog codebase
|
||||
lift $ evalUnisonFile ppe uf
|
||||
AppendToReflog reason old new -> lift $ Codebase.appendReflog codebase reason old new
|
||||
LoadReflog -> lift $ Codebase.getReflog codebase
|
||||
CreateAuthorInfo t -> AuthorInfo.createAuthorInfo Parser.External t
|
||||
|
||||
eval1 :: PPE.PrettyPrintEnv -> Term v Ann -> _
|
||||
|
@ -118,6 +118,7 @@ import Unison.LabeledDependency (LabeledDependency)
|
||||
import Unison.Term (Term)
|
||||
import Unison.Type (Type)
|
||||
import qualified Unison.Builtin as Builtin
|
||||
import qualified Unison.Builtin.Terms as Builtin
|
||||
import Unison.NameSegment (NameSegment(..))
|
||||
import qualified Unison.NameSegment as NameSegment
|
||||
import Unison.Codebase.ShortBranchHash (ShortBranchHash)
|
||||
@ -370,11 +371,9 @@ loop = do
|
||||
(misses', hits) <- hqNameQuery [from]
|
||||
let tpRefs = Set.fromList $ typeReferences hits
|
||||
tmRefs = Set.fromList $ termReferences hits
|
||||
tmMisses = misses'
|
||||
<> (HQ'.toHQ . SR.termName <$> termResults hits)
|
||||
tpMisses = misses'
|
||||
<> (HQ'.toHQ . SR.typeName <$> typeResults hits)
|
||||
misses = if isTerm then tpMisses else tmMisses
|
||||
misses = Set.difference (Set.fromList misses') if isTerm
|
||||
then Set.fromList $ HQ'.toHQ . SR.termName <$> termResults hits
|
||||
else Set.fromList $ HQ'.toHQ . SR.typeName <$> typeResults hits
|
||||
go :: Reference -> Action m (Either Event Input) v ()
|
||||
go fr = do
|
||||
let termPatch =
|
||||
@ -390,8 +389,8 @@ loop = do
|
||||
(const (if isTerm then termPatch else typePatch)))
|
||||
-- Say something
|
||||
success
|
||||
unless (null misses) $
|
||||
respond $ SearchTermsNotFound misses
|
||||
unless (Set.null misses) $
|
||||
respond $ SearchTermsNotFound (Set.toList misses)
|
||||
traverse_ go (if isTerm then tmRefs else tpRefs)
|
||||
branchExists dest _x = respond $ BranchAlreadyExists dest
|
||||
branchExistsSplit = branchExists . Path.unsplit'
|
||||
@ -1628,8 +1627,8 @@ loop = do
|
||||
e <- eval $ Execute ppe unisonFile
|
||||
|
||||
case e of
|
||||
Left e -> respond $ EvaluationFailure e
|
||||
Right _ -> pure () -- TODO
|
||||
Left e -> respond $ EvaluationFailure e
|
||||
Right _ -> pure () -- TODO
|
||||
|
||||
IOTestI main -> do
|
||||
testType <- eval RuntimeTest
|
||||
@ -1661,7 +1660,7 @@ loop = do
|
||||
tm' <- eval $ Evaluate1 ppe tm
|
||||
case tm' of
|
||||
Left e -> respond (EvaluationFailure e)
|
||||
Right tm' ->
|
||||
Right tm' ->
|
||||
respond $ TestResults Output.NewlyComputed ppe True True (oks [(ref, tm')]) (fails [(ref, tm')])
|
||||
_ -> respond $ NoMainFunction "main" ppe [testType]
|
||||
_ -> respond $ NoMainFunction "main" ppe [testType]
|
||||
@ -1675,7 +1674,8 @@ loop = do
|
||||
-- added again.
|
||||
let uf = UF.typecheckedUnisonFile (Map.fromList Builtin.builtinDataDecls)
|
||||
(Map.fromList Builtin.builtinEffectDecls)
|
||||
mempty mempty
|
||||
[Builtin.builtinTermsSrc Intrinsic]
|
||||
mempty
|
||||
eval $ AddDefsToCodebase uf
|
||||
-- add the names; note, there are more names than definitions
|
||||
-- due to builtin terms; so we don't just reuse `uf` above.
|
||||
@ -1689,7 +1689,8 @@ loop = do
|
||||
-- added again.
|
||||
let uf = UF.typecheckedUnisonFile (Map.fromList Builtin.builtinDataDecls)
|
||||
(Map.fromList Builtin.builtinEffectDecls)
|
||||
mempty mempty
|
||||
[Builtin.builtinTermsSrc Intrinsic]
|
||||
mempty
|
||||
eval $ AddDefsToCodebase uf
|
||||
-- these have not neceesarily been added yet
|
||||
eval $ AddDefsToCodebase IOSource.typecheckedFile'
|
||||
|
@ -145,6 +145,10 @@ decomposePattern
|
||||
:: Var v
|
||||
=> Reference -> Int -> Int -> P.Pattern v
|
||||
-> [[P.Pattern v]]
|
||||
decomposePattern rf0 t _ (P.Boolean _ b)
|
||||
| rf0 == Rf.booleanRef
|
||||
, t == if b then 1 else 0
|
||||
= [[]]
|
||||
decomposePattern rf0 t nfields p@(P.Constructor _ rf u ps)
|
||||
| t == u
|
||||
, rf0 == rf
|
||||
|
@ -1738,6 +1738,10 @@ abilityCheck' ambient0 requested0 = go ambient0 requested0 where
|
||||
Just amb -> do
|
||||
subtype amb r `orElse` die r
|
||||
go ambient rs
|
||||
-- Corner case where a unification caused `r` to expand to a
|
||||
-- list of effects. This whole function should be restructured
|
||||
-- such that this can go in a better spot.
|
||||
Nothing | Type.Effects' es <- r -> go ambient (es ++ rs)
|
||||
-- 2b. If no:
|
||||
Nothing -> case r of
|
||||
-- It's an unsolved existential, instantiate it to all of ambient
|
||||
|
@ -15,7 +15,7 @@ import qualified Unison.Test.Codebase.Path as Path
|
||||
import qualified Unison.Test.ColorText as ColorText
|
||||
import qualified Unison.Test.DataDeclaration as DataDeclaration
|
||||
import qualified Unison.Test.FileParser as FileParser
|
||||
import qualified Unison.Test.Git as Git
|
||||
-- import qualified Unison.Test.Git as Git
|
||||
import qualified Unison.Test.Lexer as Lexer
|
||||
import qualified Unison.Test.IO as TestIO
|
||||
import qualified Unison.Test.Range as Range
|
||||
@ -66,7 +66,7 @@ test rt = tests
|
||||
, Typechecker.test
|
||||
, UriParser.test
|
||||
, Context.test
|
||||
, Git.test
|
||||
-- , Git.test
|
||||
, TestIO.test
|
||||
, Name.test
|
||||
, VersionParser.test
|
||||
|
@ -153,7 +153,7 @@ resultTest rt uf filepath = do
|
||||
tm' = Term.letRec' False bindings watchResult
|
||||
-- note . show $ tm'
|
||||
-- note . show $ Term.amap (const ()) tm
|
||||
expect $ tm' == Term.amap (const ()) tm
|
||||
expectEqual tm' (Term.amap (const ()) tm)
|
||||
Left e -> crash $ show e
|
||||
else pure ()
|
||||
|
||||
|
@ -55,6 +55,7 @@ library
|
||||
exposed-modules:
|
||||
Unison.Builtin
|
||||
Unison.Builtin.Decls
|
||||
Unison.Builtin.Terms
|
||||
Unison.Codecs
|
||||
Unison.Codebase
|
||||
Unison.Codebase.Branch
|
||||
|
@ -26,6 +26,12 @@ extra-deps:
|
||||
- sandi-0.5@sha256:b278d072ca717706ea38f9bd646e023f7f2576a778fb43565b434f93638849aa,3010
|
||||
- strings-1.1@sha256:0285dec4c8ab262359342b3e5ef1eb567074669461b9b38404f1cb870c881c5c,1617
|
||||
- ListLike-4.7.3
|
||||
# remove these when stackage upgrades containers
|
||||
- containers-0.6.4.1
|
||||
- text-1.2.4.1
|
||||
- binary-0.8.8.0
|
||||
- parsec-3.1.14.0
|
||||
- Cabal-3.2.1.0
|
||||
|
||||
ghc-options:
|
||||
# All packages
|
||||
|
@ -29,7 +29,7 @@ test> match (decodeCert.impl (toUtf8 self_signed_cert_pem) with
|
||||
|
||||
⍟ These new definitions are ok to `add`:
|
||||
|
||||
test.ckc3ihvvem (Unison bug, unknown term)
|
||||
test.ko630itb5m (Unison bug, unknown term)
|
||||
|
||||
Now evaluating any watch expressions (lines starting with
|
||||
`>`)... Ctrl+C cancels.
|
||||
|
@ -92,7 +92,7 @@ test> checkRoundTrip greek
|
||||
|
||||
checkRoundTrip : Text -> [Result]
|
||||
greek : Text
|
||||
test.kqfpde2g5a (Unison bug, unknown term)
|
||||
test.nm3cmq1utb (Unison bug, unknown term)
|
||||
|
||||
Now evaluating any watch expressions (lines starting with
|
||||
`>`)... Ctrl+C cancels.
|
||||
|
10
unison-src/tests/fix1779.u
Normal file
10
unison-src/tests/fix1779.u
Normal file
@ -0,0 +1,10 @@
|
||||
unique ability S a where
|
||||
s : a
|
||||
|
||||
unique type R g = R ('{g} ())
|
||||
|
||||
run : '{S (R g), g} ()
|
||||
run _ = todo ()
|
||||
|
||||
run' : '{S (R {})} ()
|
||||
run' = run
|
@ -19,10 +19,30 @@ pat7 x y = cases
|
||||
(p1, _) | p1 == 9 -> (x + y : Nat, p1)
|
||||
(p1, _) | true -> (0, p1)
|
||||
|
||||
bpat = cases
|
||||
false -> 0
|
||||
true -> 1
|
||||
|
||||
npat = cases
|
||||
0 -> 1
|
||||
_ -> 0
|
||||
|
||||
ipat = cases
|
||||
+1 -> -1
|
||||
-1 -> +1
|
||||
_ -> +0
|
||||
|
||||
> (pat1 0 1 (2, 3),
|
||||
pat2 0 1 "hi",
|
||||
pat3 0 1 (2, 3),
|
||||
pat4 0 1 (2, 3),
|
||||
pat5 0 1 (3, 2),
|
||||
pat6 1 2 (3, 4),
|
||||
pat7 1 2 (20, 10))
|
||||
pat7 1 2 (20, 10),
|
||||
bpat false,
|
||||
bpat true,
|
||||
npat 0,
|
||||
npat 33,
|
||||
ipat +1,
|
||||
ipat -1,
|
||||
ipat -33)
|
||||
|
@ -4,4 +4,11 @@
|
||||
(0, 1, 2),
|
||||
(0, 1, 2),
|
||||
(3, 3),
|
||||
(0, 20))
|
||||
(0, 20),
|
||||
0,
|
||||
1,
|
||||
1,
|
||||
0,
|
||||
-1,
|
||||
+1,
|
||||
+0)
|
||||
|
@ -128,293 +128,299 @@ Let's try it!
|
||||
108. Int.trailingZeros : Int -> Nat
|
||||
109. Int.truncate0 : Int -> Nat
|
||||
110. Int.xor : Int -> Int -> Int
|
||||
111. unique type Link
|
||||
112. builtin type Link.Term
|
||||
113. Link.Term : Term -> Link
|
||||
114. builtin type Link.Type
|
||||
115. Link.Type : Type -> Link
|
||||
116. builtin type List
|
||||
117. List.++ : [a] -> [a] -> [a]
|
||||
118. List.+: : a -> [a] -> [a]
|
||||
119. List.:+ : [a] -> a -> [a]
|
||||
120. List.at : Nat -> [a] -> Optional a
|
||||
121. List.cons : a -> [a] -> [a]
|
||||
122. List.drop : Nat -> [a] -> [a]
|
||||
123. List.empty : [a]
|
||||
124. List.size : [a] -> Nat
|
||||
125. List.snoc : [a] -> a -> [a]
|
||||
126. List.take : Nat -> [a] -> [a]
|
||||
127. builtin type Nat
|
||||
128. Nat.* : Nat -> Nat -> Nat
|
||||
129. Nat.+ : Nat -> Nat -> Nat
|
||||
130. Nat./ : Nat -> Nat -> Nat
|
||||
131. Nat.and : Nat -> Nat -> Nat
|
||||
132. Nat.complement : Nat -> Nat
|
||||
133. Nat.drop : Nat -> Nat -> Nat
|
||||
134. Nat.eq : Nat -> Nat -> Boolean
|
||||
135. Nat.fromText : Text -> Optional Nat
|
||||
136. Nat.gt : Nat -> Nat -> Boolean
|
||||
137. Nat.gteq : Nat -> Nat -> Boolean
|
||||
138. Nat.increment : Nat -> Nat
|
||||
139. Nat.isEven : Nat -> Boolean
|
||||
140. Nat.isOdd : Nat -> Boolean
|
||||
141. Nat.leadingZeros : Nat -> Nat
|
||||
142. Nat.lt : Nat -> Nat -> Boolean
|
||||
143. Nat.lteq : Nat -> Nat -> Boolean
|
||||
144. Nat.mod : Nat -> Nat -> Nat
|
||||
145. Nat.or : Nat -> Nat -> Nat
|
||||
146. Nat.popCount : Nat -> Nat
|
||||
147. Nat.pow : Nat -> Nat -> Nat
|
||||
148. Nat.shiftLeft : Nat -> Nat -> Nat
|
||||
149. Nat.shiftRight : Nat -> Nat -> Nat
|
||||
150. Nat.sub : Nat -> Nat -> Int
|
||||
151. Nat.toFloat : Nat -> Float
|
||||
152. Nat.toInt : Nat -> Int
|
||||
153. Nat.toText : Nat -> Text
|
||||
154. Nat.trailingZeros : Nat -> Nat
|
||||
155. Nat.xor : Nat -> Nat -> Nat
|
||||
156. type Optional a
|
||||
157. Optional.None : Optional a
|
||||
158. Optional.Some : a -> Optional a
|
||||
159. builtin type Request
|
||||
160. type SeqView a b
|
||||
161. SeqView.VElem : a -> b -> SeqView a b
|
||||
162. SeqView.VEmpty : SeqView a b
|
||||
163. unique type Test.Result
|
||||
164. Test.Result.Fail : Text -> Result
|
||||
165. Test.Result.Ok : Text -> Result
|
||||
166. builtin type Text
|
||||
167. Text.!= : Text -> Text -> Boolean
|
||||
168. Text.++ : Text -> Text -> Text
|
||||
169. Text.drop : Nat -> Text -> Text
|
||||
170. Text.empty : Text
|
||||
171. Text.eq : Text -> Text -> Boolean
|
||||
172. Text.fromCharList : [Char] -> Text
|
||||
173. Text.fromUtf8.impl : Bytes -> Either Failure Text
|
||||
174. Text.gt : Text -> Text -> Boolean
|
||||
175. Text.gteq : Text -> Text -> Boolean
|
||||
176. Text.lt : Text -> Text -> Boolean
|
||||
177. Text.lteq : Text -> Text -> Boolean
|
||||
178. Text.size : Text -> Nat
|
||||
179. Text.take : Nat -> Text -> Text
|
||||
180. Text.toCharList : Text -> [Char]
|
||||
181. Text.toUtf8 : Text -> Bytes
|
||||
182. Text.uncons : Text -> Optional (Char, Text)
|
||||
183. Text.unsnoc : Text -> Optional (Text, Char)
|
||||
184. type Tuple a b
|
||||
185. Tuple.Cons : a -> b -> Tuple a b
|
||||
186. type Unit
|
||||
187. Unit.Unit : ()
|
||||
188. Universal.< : a -> a -> Boolean
|
||||
189. Universal.<= : a -> a -> Boolean
|
||||
190. Universal.== : a -> a -> Boolean
|
||||
191. Universal.> : a -> a -> Boolean
|
||||
192. Universal.>= : a -> a -> Boolean
|
||||
193. Universal.compare : a -> a -> Int
|
||||
194. builtin type Value
|
||||
195. Value.dependencies : Value -> [Term]
|
||||
196. Value.deserialize : Bytes -> Either Text Value
|
||||
197. Value.load : Value ->{IO} Either [Term] a
|
||||
198. Value.serialize : Value -> Bytes
|
||||
199. Value.value : a -> Value
|
||||
200. bug : a -> b
|
||||
201. builtin type crypto.HashAlgorithm
|
||||
202. crypto.HashAlgorithm.Blake2b_256 : HashAlgorithm
|
||||
203. crypto.HashAlgorithm.Blake2b_512 : HashAlgorithm
|
||||
204. crypto.HashAlgorithm.Blake2s_256 : HashAlgorithm
|
||||
205. crypto.HashAlgorithm.Sha2_256 : HashAlgorithm
|
||||
206. crypto.HashAlgorithm.Sha2_512 : HashAlgorithm
|
||||
207. crypto.HashAlgorithm.Sha3_256 : HashAlgorithm
|
||||
208. crypto.HashAlgorithm.Sha3_512 : HashAlgorithm
|
||||
209. crypto.hash : HashAlgorithm -> a -> Bytes
|
||||
210. crypto.hashBytes : HashAlgorithm -> Bytes -> Bytes
|
||||
211. crypto.hmac : HashAlgorithm -> Bytes -> a -> Bytes
|
||||
212. crypto.hmacBytes : HashAlgorithm
|
||||
111. unique type IsPropagated
|
||||
112. IsPropagated.IsPropagated : IsPropagated
|
||||
113. unique type IsTest
|
||||
114. IsTest.IsTest : IsTest
|
||||
115. unique type Link
|
||||
116. builtin type Link.Term
|
||||
117. Link.Term : Term -> Link
|
||||
118. builtin type Link.Type
|
||||
119. Link.Type : Type -> Link
|
||||
120. builtin type List
|
||||
121. List.++ : [a] -> [a] -> [a]
|
||||
122. List.+: : a -> [a] -> [a]
|
||||
123. List.:+ : [a] -> a -> [a]
|
||||
124. List.at : Nat -> [a] -> Optional a
|
||||
125. List.cons : a -> [a] -> [a]
|
||||
126. List.drop : Nat -> [a] -> [a]
|
||||
127. List.empty : [a]
|
||||
128. List.size : [a] -> Nat
|
||||
129. List.snoc : [a] -> a -> [a]
|
||||
130. List.take : Nat -> [a] -> [a]
|
||||
131. builtin type Nat
|
||||
132. Nat.* : Nat -> Nat -> Nat
|
||||
133. Nat.+ : Nat -> Nat -> Nat
|
||||
134. Nat./ : Nat -> Nat -> Nat
|
||||
135. Nat.and : Nat -> Nat -> Nat
|
||||
136. Nat.complement : Nat -> Nat
|
||||
137. Nat.drop : Nat -> Nat -> Nat
|
||||
138. Nat.eq : Nat -> Nat -> Boolean
|
||||
139. Nat.fromText : Text -> Optional Nat
|
||||
140. Nat.gt : Nat -> Nat -> Boolean
|
||||
141. Nat.gteq : Nat -> Nat -> Boolean
|
||||
142. Nat.increment : Nat -> Nat
|
||||
143. Nat.isEven : Nat -> Boolean
|
||||
144. Nat.isOdd : Nat -> Boolean
|
||||
145. Nat.leadingZeros : Nat -> Nat
|
||||
146. Nat.lt : Nat -> Nat -> Boolean
|
||||
147. Nat.lteq : Nat -> Nat -> Boolean
|
||||
148. Nat.mod : Nat -> Nat -> Nat
|
||||
149. Nat.or : Nat -> Nat -> Nat
|
||||
150. Nat.popCount : Nat -> Nat
|
||||
151. Nat.pow : Nat -> Nat -> Nat
|
||||
152. Nat.shiftLeft : Nat -> Nat -> Nat
|
||||
153. Nat.shiftRight : Nat -> Nat -> Nat
|
||||
154. Nat.sub : Nat -> Nat -> Int
|
||||
155. Nat.toFloat : Nat -> Float
|
||||
156. Nat.toInt : Nat -> Int
|
||||
157. Nat.toText : Nat -> Text
|
||||
158. Nat.trailingZeros : Nat -> Nat
|
||||
159. Nat.xor : Nat -> Nat -> Nat
|
||||
160. type Optional a
|
||||
161. Optional.None : Optional a
|
||||
162. Optional.Some : a -> Optional a
|
||||
163. builtin type Request
|
||||
164. type SeqView a b
|
||||
165. SeqView.VElem : a -> b -> SeqView a b
|
||||
166. SeqView.VEmpty : SeqView a b
|
||||
167. unique type Test.Result
|
||||
168. Test.Result.Fail : Text -> Result
|
||||
169. Test.Result.Ok : Text -> Result
|
||||
170. builtin type Text
|
||||
171. Text.!= : Text -> Text -> Boolean
|
||||
172. Text.++ : Text -> Text -> Text
|
||||
173. Text.drop : Nat -> Text -> Text
|
||||
174. Text.empty : Text
|
||||
175. Text.eq : Text -> Text -> Boolean
|
||||
176. Text.fromCharList : [Char] -> Text
|
||||
177. Text.fromUtf8.impl : Bytes -> Either Failure Text
|
||||
178. Text.gt : Text -> Text -> Boolean
|
||||
179. Text.gteq : Text -> Text -> Boolean
|
||||
180. Text.lt : Text -> Text -> Boolean
|
||||
181. Text.lteq : Text -> Text -> Boolean
|
||||
182. Text.size : Text -> Nat
|
||||
183. Text.take : Nat -> Text -> Text
|
||||
184. Text.toCharList : Text -> [Char]
|
||||
185. Text.toUtf8 : Text -> Bytes
|
||||
186. Text.uncons : Text -> Optional (Char, Text)
|
||||
187. Text.unsnoc : Text -> Optional (Text, Char)
|
||||
188. type Tuple a b
|
||||
189. Tuple.Cons : a -> b -> Tuple a b
|
||||
190. type Unit
|
||||
191. Unit.Unit : ()
|
||||
192. Universal.< : a -> a -> Boolean
|
||||
193. Universal.<= : a -> a -> Boolean
|
||||
194. Universal.== : a -> a -> Boolean
|
||||
195. Universal.> : a -> a -> Boolean
|
||||
196. Universal.>= : a -> a -> Boolean
|
||||
197. Universal.compare : a -> a -> Int
|
||||
198. builtin type Value
|
||||
199. Value.dependencies : Value -> [Term]
|
||||
200. Value.deserialize : Bytes -> Either Text Value
|
||||
201. Value.load : Value ->{IO} Either [Term] a
|
||||
202. Value.serialize : Value -> Bytes
|
||||
203. Value.value : a -> Value
|
||||
204. bug : a -> b
|
||||
205. builtin type crypto.HashAlgorithm
|
||||
206. crypto.HashAlgorithm.Blake2b_256 : HashAlgorithm
|
||||
207. crypto.HashAlgorithm.Blake2b_512 : HashAlgorithm
|
||||
208. crypto.HashAlgorithm.Blake2s_256 : HashAlgorithm
|
||||
209. crypto.HashAlgorithm.Sha2_256 : HashAlgorithm
|
||||
210. crypto.HashAlgorithm.Sha2_512 : HashAlgorithm
|
||||
211. crypto.HashAlgorithm.Sha3_256 : HashAlgorithm
|
||||
212. crypto.HashAlgorithm.Sha3_512 : HashAlgorithm
|
||||
213. crypto.hash : HashAlgorithm -> a -> Bytes
|
||||
214. crypto.hashBytes : HashAlgorithm -> Bytes -> Bytes
|
||||
215. crypto.hmac : HashAlgorithm -> Bytes -> a -> Bytes
|
||||
216. crypto.hmacBytes : HashAlgorithm
|
||||
-> Bytes
|
||||
-> Bytes
|
||||
-> Bytes
|
||||
213. unique type io2.BufferMode
|
||||
214. io2.BufferMode.BlockBuffering : BufferMode
|
||||
215. io2.BufferMode.LineBuffering : BufferMode
|
||||
216. io2.BufferMode.NoBuffering : BufferMode
|
||||
217. io2.BufferMode.SizedBlockBuffering : Nat -> BufferMode
|
||||
218. unique type io2.Failure
|
||||
219. io2.Failure.Failure : Type -> Text -> Any -> Failure
|
||||
220. unique type io2.FileMode
|
||||
221. io2.FileMode.Append : FileMode
|
||||
222. io2.FileMode.Read : FileMode
|
||||
223. io2.FileMode.ReadWrite : FileMode
|
||||
224. io2.FileMode.Write : FileMode
|
||||
225. builtin type io2.Handle
|
||||
226. builtin type io2.IO
|
||||
227. io2.IO.clientSocket.impl : Text
|
||||
217. unique type io2.BufferMode
|
||||
218. io2.BufferMode.BlockBuffering : BufferMode
|
||||
219. io2.BufferMode.LineBuffering : BufferMode
|
||||
220. io2.BufferMode.NoBuffering : BufferMode
|
||||
221. io2.BufferMode.SizedBlockBuffering : Nat -> BufferMode
|
||||
222. unique type io2.Failure
|
||||
223. io2.Failure.Failure : Type -> Text -> Any -> Failure
|
||||
224. unique type io2.FileMode
|
||||
225. io2.FileMode.Append : FileMode
|
||||
226. io2.FileMode.Read : FileMode
|
||||
227. io2.FileMode.ReadWrite : FileMode
|
||||
228. io2.FileMode.Write : FileMode
|
||||
229. builtin type io2.Handle
|
||||
230. builtin type io2.IO
|
||||
231. io2.IO.clientSocket.impl : Text
|
||||
-> Text
|
||||
->{IO} Either Failure Socket
|
||||
228. io2.IO.closeFile.impl : Handle ->{IO} Either Failure ()
|
||||
229. io2.IO.closeSocket.impl : Socket ->{IO} Either Failure ()
|
||||
230. io2.IO.createDirectory.impl : Text
|
||||
232. io2.IO.closeFile.impl : Handle ->{IO} Either Failure ()
|
||||
233. io2.IO.closeSocket.impl : Socket ->{IO} Either Failure ()
|
||||
234. io2.IO.createDirectory.impl : Text
|
||||
->{IO} Either Failure ()
|
||||
231. io2.IO.createTempDirectory.impl : Text
|
||||
235. io2.IO.createTempDirectory.impl : Text
|
||||
->{IO} Either
|
||||
Failure Text
|
||||
232. io2.IO.delay.impl : Nat ->{IO} Either Failure ()
|
||||
233. io2.IO.fileExists.impl : Text
|
||||
236. io2.IO.delay.impl : Nat ->{IO} Either Failure ()
|
||||
237. io2.IO.fileExists.impl : Text
|
||||
->{IO} Either Failure Boolean
|
||||
234. io2.IO.forkComp : '{IO} a ->{IO} ThreadId
|
||||
235. io2.IO.getBuffering.impl : Handle
|
||||
238. io2.IO.forkComp : '{IO} a ->{IO} ThreadId
|
||||
239. io2.IO.getBuffering.impl : Handle
|
||||
->{IO} Either
|
||||
Failure BufferMode
|
||||
236. io2.IO.getBytes.impl : Handle
|
||||
240. io2.IO.getBytes.impl : Handle
|
||||
-> Nat
|
||||
->{IO} Either Failure Bytes
|
||||
237. io2.IO.getCurrentDirectory.impl : '{IO} Either
|
||||
241. io2.IO.getCurrentDirectory.impl : '{IO} Either
|
||||
Failure Text
|
||||
238. io2.IO.getFileSize.impl : Text ->{IO} Either Failure Nat
|
||||
239. io2.IO.getFileTimestamp.impl : Text
|
||||
242. io2.IO.getFileSize.impl : Text ->{IO} Either Failure Nat
|
||||
243. io2.IO.getFileTimestamp.impl : Text
|
||||
->{IO} Either Failure Nat
|
||||
240. io2.IO.getTempDirectory.impl : '{IO} Either Failure Text
|
||||
241. io2.IO.handlePosition.impl : Handle
|
||||
244. io2.IO.getTempDirectory.impl : '{IO} Either Failure Text
|
||||
245. io2.IO.handlePosition.impl : Handle
|
||||
->{IO} Either Failure Nat
|
||||
242. io2.IO.isDirectory.impl : Text
|
||||
246. io2.IO.isDirectory.impl : Text
|
||||
->{IO} Either Failure Boolean
|
||||
243. io2.IO.isFileEOF.impl : Handle
|
||||
247. io2.IO.isFileEOF.impl : Handle
|
||||
->{IO} Either Failure Boolean
|
||||
244. io2.IO.isFileOpen.impl : Handle
|
||||
248. io2.IO.isFileOpen.impl : Handle
|
||||
->{IO} Either Failure Boolean
|
||||
245. io2.IO.isSeekable.impl : Handle
|
||||
249. io2.IO.isSeekable.impl : Handle
|
||||
->{IO} Either Failure Boolean
|
||||
246. io2.IO.kill.impl : ThreadId ->{IO} Either Failure ()
|
||||
247. io2.IO.listen.impl : Socket ->{IO} Either Failure ()
|
||||
248. io2.IO.openFile.impl : Text
|
||||
250. io2.IO.kill.impl : ThreadId ->{IO} Either Failure ()
|
||||
251. io2.IO.listen.impl : Socket ->{IO} Either Failure ()
|
||||
252. io2.IO.openFile.impl : Text
|
||||
-> FileMode
|
||||
->{IO} Either Failure Handle
|
||||
249. io2.IO.putBytes.impl : Handle
|
||||
253. io2.IO.putBytes.impl : Handle
|
||||
-> Bytes
|
||||
->{IO} Either Failure ()
|
||||
250. io2.IO.removeDirectory.impl : Text
|
||||
254. io2.IO.removeDirectory.impl : Text
|
||||
->{IO} Either Failure ()
|
||||
251. io2.IO.removeFile.impl : Text ->{IO} Either Failure ()
|
||||
252. io2.IO.renameDirectory.impl : Text
|
||||
255. io2.IO.removeFile.impl : Text ->{IO} Either Failure ()
|
||||
256. io2.IO.renameDirectory.impl : Text
|
||||
-> Text
|
||||
->{IO} Either Failure ()
|
||||
253. io2.IO.renameFile.impl : Text
|
||||
257. io2.IO.renameFile.impl : Text
|
||||
-> Text
|
||||
->{IO} Either Failure ()
|
||||
254. io2.IO.seekHandle.impl : Handle
|
||||
258. io2.IO.seekHandle.impl : Handle
|
||||
-> SeekMode
|
||||
-> Int
|
||||
->{IO} Either Failure ()
|
||||
255. io2.IO.serverSocket.impl : Optional Text
|
||||
259. io2.IO.serverSocket.impl : Optional Text
|
||||
-> Text
|
||||
->{IO} Either Failure Socket
|
||||
256. io2.IO.setBuffering.impl : Handle
|
||||
260. io2.IO.setBuffering.impl : Handle
|
||||
-> BufferMode
|
||||
->{IO} Either Failure ()
|
||||
257. io2.IO.setCurrentDirectory.impl : Text
|
||||
261. io2.IO.setCurrentDirectory.impl : Text
|
||||
->{IO} Either
|
||||
Failure ()
|
||||
258. io2.IO.socketAccept.impl : Socket
|
||||
262. io2.IO.socketAccept.impl : Socket
|
||||
->{IO} Either Failure Socket
|
||||
259. io2.IO.socketPort.impl : Socket ->{IO} Either Failure Nat
|
||||
260. io2.IO.socketReceive.impl : Socket
|
||||
263. io2.IO.socketPort.impl : Socket ->{IO} Either Failure Nat
|
||||
264. io2.IO.socketReceive.impl : Socket
|
||||
-> Nat
|
||||
->{IO} Either Failure Bytes
|
||||
261. io2.IO.socketSend.impl : Socket
|
||||
265. io2.IO.socketSend.impl : Socket
|
||||
-> Bytes
|
||||
->{IO} Either Failure ()
|
||||
262. io2.IO.stdHandle : StdHandle -> Handle
|
||||
263. io2.IO.systemTime.impl : '{IO} Either Failure Nat
|
||||
264. unique type io2.IOError
|
||||
265. io2.IOError.AlreadyExists : IOError
|
||||
266. io2.IOError.EOF : IOError
|
||||
267. io2.IOError.IllegalOperation : IOError
|
||||
268. io2.IOError.NoSuchThing : IOError
|
||||
269. io2.IOError.PermissionDenied : IOError
|
||||
270. io2.IOError.ResourceBusy : IOError
|
||||
271. io2.IOError.ResourceExhausted : IOError
|
||||
272. io2.IOError.UserError : IOError
|
||||
273. unique type io2.IOFailure
|
||||
274. builtin type io2.MVar
|
||||
275. io2.MVar.isEmpty : MVar a ->{IO} Boolean
|
||||
276. io2.MVar.new : a ->{IO} MVar a
|
||||
277. io2.MVar.newEmpty : '{IO} MVar a
|
||||
278. io2.MVar.put.impl : MVar a -> a ->{IO} Either Failure ()
|
||||
279. io2.MVar.read.impl : MVar a ->{IO} Either Failure a
|
||||
280. io2.MVar.swap.impl : MVar a -> a ->{IO} Either Failure a
|
||||
281. io2.MVar.take.impl : MVar a ->{IO} Either Failure a
|
||||
282. io2.MVar.tryPut.impl : MVar a
|
||||
266. io2.IO.stdHandle : StdHandle -> Handle
|
||||
267. io2.IO.systemTime.impl : '{IO} Either Failure Nat
|
||||
268. unique type io2.IOError
|
||||
269. io2.IOError.AlreadyExists : IOError
|
||||
270. io2.IOError.EOF : IOError
|
||||
271. io2.IOError.IllegalOperation : IOError
|
||||
272. io2.IOError.NoSuchThing : IOError
|
||||
273. io2.IOError.PermissionDenied : IOError
|
||||
274. io2.IOError.ResourceBusy : IOError
|
||||
275. io2.IOError.ResourceExhausted : IOError
|
||||
276. io2.IOError.UserError : IOError
|
||||
277. unique type io2.IOFailure
|
||||
278. builtin type io2.MVar
|
||||
279. io2.MVar.isEmpty : MVar a ->{IO} Boolean
|
||||
280. io2.MVar.new : a ->{IO} MVar a
|
||||
281. io2.MVar.newEmpty : '{IO} MVar a
|
||||
282. io2.MVar.put.impl : MVar a -> a ->{IO} Either Failure ()
|
||||
283. io2.MVar.read.impl : MVar a ->{IO} Either Failure a
|
||||
284. io2.MVar.swap.impl : MVar a -> a ->{IO} Either Failure a
|
||||
285. io2.MVar.take.impl : MVar a ->{IO} Either Failure a
|
||||
286. io2.MVar.tryPut.impl : MVar a
|
||||
-> a
|
||||
->{IO} Either Failure Boolean
|
||||
283. io2.MVar.tryRead.impl : MVar a
|
||||
287. io2.MVar.tryRead.impl : MVar a
|
||||
->{IO} Either
|
||||
Failure (Optional a)
|
||||
284. io2.MVar.tryTake : MVar a ->{IO} Optional a
|
||||
285. builtin type io2.STM
|
||||
286. io2.STM.atomically : '{STM} a ->{IO} a
|
||||
287. io2.STM.retry : '{STM} a
|
||||
288. unique type io2.SeekMode
|
||||
289. io2.SeekMode.AbsoluteSeek : SeekMode
|
||||
290. io2.SeekMode.RelativeSeek : SeekMode
|
||||
291. io2.SeekMode.SeekFromEnd : SeekMode
|
||||
292. builtin type io2.Socket
|
||||
293. unique type io2.StdHandle
|
||||
294. io2.StdHandle.StdErr : StdHandle
|
||||
295. io2.StdHandle.StdIn : StdHandle
|
||||
296. io2.StdHandle.StdOut : StdHandle
|
||||
297. io2.TLS.ClientConfig.ciphers.set : [##Tls.Cipher]
|
||||
288. io2.MVar.tryTake : MVar a ->{IO} Optional a
|
||||
289. builtin type io2.STM
|
||||
290. io2.STM.atomically : '{STM} a ->{IO} a
|
||||
291. io2.STM.retry : '{STM} a
|
||||
292. unique type io2.SeekMode
|
||||
293. io2.SeekMode.AbsoluteSeek : SeekMode
|
||||
294. io2.SeekMode.RelativeSeek : SeekMode
|
||||
295. io2.SeekMode.SeekFromEnd : SeekMode
|
||||
296. builtin type io2.Socket
|
||||
297. unique type io2.StdHandle
|
||||
298. io2.StdHandle.StdErr : StdHandle
|
||||
299. io2.StdHandle.StdIn : StdHandle
|
||||
300. io2.StdHandle.StdOut : StdHandle
|
||||
301. io2.TLS.ClientConfig.ciphers.set : [##Tls.Cipher]
|
||||
-> ClientConfig
|
||||
-> ClientConfig
|
||||
298. builtin type io2.TVar
|
||||
299. io2.TVar.new : a ->{STM} TVar a
|
||||
300. io2.TVar.newIO : a ->{IO} TVar a
|
||||
301. io2.TVar.read : TVar a ->{STM} a
|
||||
302. io2.TVar.readIO : TVar a ->{IO} a
|
||||
303. io2.TVar.swap : TVar a -> a ->{STM} a
|
||||
304. io2.TVar.write : TVar a -> a ->{STM} ()
|
||||
305. builtin type io2.ThreadId
|
||||
306. builtin type io2.Tls
|
||||
307. builtin type io2.Tls.ClientConfig
|
||||
308. io2.Tls.ClientConfig.certificates.set : [SignedCert]
|
||||
302. builtin type io2.TVar
|
||||
303. io2.TVar.new : a ->{STM} TVar a
|
||||
304. io2.TVar.newIO : a ->{IO} TVar a
|
||||
305. io2.TVar.read : TVar a ->{STM} a
|
||||
306. io2.TVar.readIO : TVar a ->{IO} a
|
||||
307. io2.TVar.swap : TVar a -> a ->{STM} a
|
||||
308. io2.TVar.write : TVar a -> a ->{STM} ()
|
||||
309. builtin type io2.ThreadId
|
||||
310. builtin type io2.Tls
|
||||
311. builtin type io2.Tls.ClientConfig
|
||||
312. io2.Tls.ClientConfig.certificates.set : [SignedCert]
|
||||
-> ClientConfig
|
||||
-> ClientConfig
|
||||
309. io2.Tls.ClientConfig.default : Text
|
||||
313. io2.Tls.ClientConfig.default : Text
|
||||
-> Bytes
|
||||
-> ClientConfig
|
||||
310. io2.Tls.ClientConfig.versions.set : [##Tls.Version]
|
||||
314. io2.Tls.ClientConfig.versions.set : [##Tls.Version]
|
||||
-> ClientConfig
|
||||
-> ClientConfig
|
||||
311. builtin type io2.Tls.PrivateKey
|
||||
312. builtin type io2.Tls.ServerConfig
|
||||
313. io2.Tls.ServerConfig.certificates.set : [SignedCert]
|
||||
315. builtin type io2.Tls.PrivateKey
|
||||
316. builtin type io2.Tls.ServerConfig
|
||||
317. io2.Tls.ServerConfig.certificates.set : [SignedCert]
|
||||
-> ServerConfig
|
||||
-> ServerConfig
|
||||
314. io2.Tls.ServerConfig.ciphers.set : [##Tls.Cipher]
|
||||
318. io2.Tls.ServerConfig.ciphers.set : [##Tls.Cipher]
|
||||
-> ServerConfig
|
||||
-> ServerConfig
|
||||
315. io2.Tls.ServerConfig.default : [SignedCert]
|
||||
319. io2.Tls.ServerConfig.default : [SignedCert]
|
||||
-> PrivateKey
|
||||
-> ServerConfig
|
||||
316. io2.Tls.ServerConfig.versions.set : [##Tls.Version]
|
||||
320. io2.Tls.ServerConfig.versions.set : [##Tls.Version]
|
||||
-> ServerConfig
|
||||
-> ServerConfig
|
||||
317. builtin type io2.Tls.SignedCert
|
||||
318. io2.Tls.decodeCert.impl : Bytes
|
||||
321. builtin type io2.Tls.SignedCert
|
||||
322. io2.Tls.decodeCert.impl : Bytes
|
||||
-> Either Failure SignedCert
|
||||
319. io2.Tls.decodePrivateKey : Bytes -> [PrivateKey]
|
||||
320. io2.Tls.encodeCert : SignedCert -> Bytes
|
||||
321. io2.Tls.encodePrivateKey : PrivateKey -> Bytes
|
||||
322. io2.Tls.handshake.impl : Tls ->{IO} Either Failure ()
|
||||
323. io2.Tls.newClient.impl : ClientConfig
|
||||
323. io2.Tls.decodePrivateKey : Bytes -> [PrivateKey]
|
||||
324. io2.Tls.encodeCert : SignedCert -> Bytes
|
||||
325. io2.Tls.encodePrivateKey : PrivateKey -> Bytes
|
||||
326. io2.Tls.handshake.impl : Tls ->{IO} Either Failure ()
|
||||
327. io2.Tls.newClient.impl : ClientConfig
|
||||
-> Socket
|
||||
->{IO} Either Failure Tls
|
||||
324. io2.Tls.newServer.impl : ServerConfig
|
||||
328. io2.Tls.newServer.impl : ServerConfig
|
||||
-> Socket
|
||||
->{IO} Either Failure Tls
|
||||
325. io2.Tls.receive.impl : Tls ->{IO} Either Failure Bytes
|
||||
326. io2.Tls.send.impl : Tls -> Bytes ->{IO} Either Failure ()
|
||||
327. io2.Tls.terminate.impl : Tls ->{IO} Either Failure ()
|
||||
328. unique type io2.TlsFailure
|
||||
329. todo : a -> b
|
||||
329. io2.Tls.receive.impl : Tls ->{IO} Either Failure Bytes
|
||||
330. io2.Tls.send.impl : Tls -> Bytes ->{IO} Either Failure ()
|
||||
331. io2.Tls.terminate.impl : Tls ->{IO} Either Failure ()
|
||||
332. unique type io2.TlsFailure
|
||||
333. metadata.isPropagated : IsPropagated
|
||||
334. metadata.isTest : IsTest
|
||||
335. todo : a -> b
|
||||
|
||||
|
||||
.builtin> alias.many 94-104 .mylib
|
||||
|
@ -9,49 +9,54 @@ The `builtins.merge` command adds the known builtins to a `builtin` subnamespace
|
||||
|
||||
.tmp> ls builtin
|
||||
|
||||
1. Any (builtin type)
|
||||
2. Any/ (1 definition)
|
||||
3. Boolean (builtin type)
|
||||
4. Boolean/ (1 definition)
|
||||
5. Bytes (builtin type)
|
||||
6. Bytes/ (17 definitions)
|
||||
7. Char (builtin type)
|
||||
8. Char/ (2 definitions)
|
||||
9. Code (builtin type)
|
||||
10. Code/ (6 definitions)
|
||||
11. Debug/ (1 definition)
|
||||
12. Doc (type)
|
||||
13. Doc/ (6 definitions)
|
||||
14. Either (type)
|
||||
15. Either/ (2 definitions)
|
||||
16. Float (builtin type)
|
||||
17. Float/ (36 definitions)
|
||||
18. Int (builtin type)
|
||||
19. Int/ (29 definitions)
|
||||
20. Link (type)
|
||||
21. Link/ (4 definitions)
|
||||
22. List (builtin type)
|
||||
23. List/ (10 definitions)
|
||||
24. Nat (builtin type)
|
||||
25. Nat/ (28 definitions)
|
||||
26. Optional (type)
|
||||
27. Optional/ (2 definitions)
|
||||
28. Request (builtin type)
|
||||
29. SeqView (type)
|
||||
30. SeqView/ (2 definitions)
|
||||
31. Test/ (3 definitions)
|
||||
32. Text (builtin type)
|
||||
33. Text/ (17 definitions)
|
||||
34. Tuple (type)
|
||||
35. Tuple/ (1 definition)
|
||||
36. Unit (type)
|
||||
37. Unit/ (1 definition)
|
||||
38. Universal/ (6 definitions)
|
||||
39. Value (builtin type)
|
||||
40. Value/ (5 definitions)
|
||||
41. bug (a -> b)
|
||||
42. crypto/ (12 definitions)
|
||||
43. io2/ (116 definitions)
|
||||
44. todo (a -> b)
|
||||
1. Any (builtin type)
|
||||
2. Any/ (1 definition)
|
||||
3. Boolean (builtin type)
|
||||
4. Boolean/ (1 definition)
|
||||
5. Bytes (builtin type)
|
||||
6. Bytes/ (17 definitions)
|
||||
7. Char (builtin type)
|
||||
8. Char/ (2 definitions)
|
||||
9. Code (builtin type)
|
||||
10. Code/ (6 definitions)
|
||||
11. Debug/ (1 definition)
|
||||
12. Doc (type)
|
||||
13. Doc/ (6 definitions)
|
||||
14. Either (type)
|
||||
15. Either/ (2 definitions)
|
||||
16. Float (builtin type)
|
||||
17. Float/ (36 definitions)
|
||||
18. Int (builtin type)
|
||||
19. Int/ (29 definitions)
|
||||
20. IsPropagated (type)
|
||||
21. IsPropagated/ (1 definition)
|
||||
22. IsTest (type)
|
||||
23. IsTest/ (1 definition)
|
||||
24. Link (type)
|
||||
25. Link/ (4 definitions)
|
||||
26. List (builtin type)
|
||||
27. List/ (10 definitions)
|
||||
28. Nat (builtin type)
|
||||
29. Nat/ (28 definitions)
|
||||
30. Optional (type)
|
||||
31. Optional/ (2 definitions)
|
||||
32. Request (builtin type)
|
||||
33. SeqView (type)
|
||||
34. SeqView/ (2 definitions)
|
||||
35. Test/ (3 definitions)
|
||||
36. Text (builtin type)
|
||||
37. Text/ (17 definitions)
|
||||
38. Tuple (type)
|
||||
39. Tuple/ (1 definition)
|
||||
40. Unit (type)
|
||||
41. Unit/ (1 definition)
|
||||
42. Universal/ (6 definitions)
|
||||
43. Value (builtin type)
|
||||
44. Value/ (5 definitions)
|
||||
45. bug (a -> b)
|
||||
46. crypto/ (12 definitions)
|
||||
47. io2/ (116 definitions)
|
||||
48. metadata/ (2 definitions)
|
||||
49. todo (a -> b)
|
||||
|
||||
```
|
||||
|
@ -44,3 +44,22 @@ type Foo = Foo | Bar
|
||||
.> view.patch
|
||||
```
|
||||
|
||||
```unison
|
||||
bar = 3
|
||||
type bar = Foo
|
||||
```
|
||||
|
||||
```ucm
|
||||
.> add
|
||||
```
|
||||
|
||||
```unison
|
||||
type bar = Foo | Bar
|
||||
```
|
||||
|
||||
```ucm
|
||||
.> update
|
||||
.> view.patch
|
||||
.> delete.type-replacement bar
|
||||
.> view.patch
|
||||
```
|
||||
|
@ -130,3 +130,75 @@ type Foo = Foo | Bar
|
||||
This patch is empty.
|
||||
|
||||
```
|
||||
```unison
|
||||
bar = 3
|
||||
type bar = Foo
|
||||
```
|
||||
|
||||
```ucm
|
||||
|
||||
I found and typechecked these definitions in scratch.u. If you
|
||||
do an `add` or `update`, here's how your codebase would
|
||||
change:
|
||||
|
||||
⍟ These new definitions are ok to `add`:
|
||||
|
||||
type bar
|
||||
bar : ##Nat
|
||||
|
||||
```
|
||||
```ucm
|
||||
.> add
|
||||
|
||||
⍟ I've added these definitions:
|
||||
|
||||
type bar
|
||||
bar : ##Nat
|
||||
|
||||
```
|
||||
```unison
|
||||
type bar = Foo | Bar
|
||||
```
|
||||
|
||||
```ucm
|
||||
|
||||
I found and typechecked these definitions in scratch.u. If you
|
||||
do an `add` or `update`, here's how your codebase would
|
||||
change:
|
||||
|
||||
⍟ These names already exist. You can `update` them to your
|
||||
new definition:
|
||||
|
||||
type bar
|
||||
(also named Foo)
|
||||
|
||||
```
|
||||
```ucm
|
||||
.> update
|
||||
|
||||
⍟ I've updated these names to your new definition:
|
||||
|
||||
type bar
|
||||
(also named Foo)
|
||||
|
||||
.> view.patch
|
||||
|
||||
Edited Types: bar#568rsi7o3g -> Foo
|
||||
|
||||
Tip: To remove entries from a patch, use
|
||||
delete.term-replacement or delete.type-replacement, as
|
||||
appropriate.
|
||||
|
||||
.> delete.type-replacement bar
|
||||
|
||||
Done.
|
||||
|
||||
.> view.patch
|
||||
|
||||
Edited Types: bar#568rsi7o3g -> Foo
|
||||
|
||||
Tip: To remove entries from a patch, use
|
||||
delete.term-replacement or delete.type-replacement, as
|
||||
appropriate.
|
||||
|
||||
```
|
||||
|
@ -23,7 +23,7 @@ Technically, the definitions all exist, but they have no names. `builtins.merge`
|
||||
|
||||
.foo> ls
|
||||
|
||||
1. builtin/ (329 definitions)
|
||||
1. builtin/ (335 definitions)
|
||||
|
||||
```
|
||||
And for a limited time, you can get even more builtin goodies:
|
||||
|
39
unison-src/transcripts/isPropagated-exists.md
Normal file
39
unison-src/transcripts/isPropagated-exists.md
Normal file
@ -0,0 +1,39 @@
|
||||
This transcript tests that UCM can always access the definition of
|
||||
`IsPropagated`/`isPropagated`, which is used internally.
|
||||
|
||||
```ucm:hide
|
||||
.> alias.term ##Nat.+ +
|
||||
.> alias.type ##Nat Nat
|
||||
```
|
||||
|
||||
`y` depends on `x`,
|
||||
```unison:hide
|
||||
x = 3
|
||||
y = x + 1
|
||||
```
|
||||
|
||||
```ucm
|
||||
.> add
|
||||
```
|
||||
|
||||
so the `update` of `x` causes a propagated update of `y`, and UCM links the
|
||||
`isPropagated` metadata to such resulting terms:
|
||||
|
||||
```unison:hide
|
||||
x = 4
|
||||
```
|
||||
|
||||
```ucm
|
||||
.> update
|
||||
.> links y
|
||||
.> view 1
|
||||
```
|
||||
|
||||
Well, it's hard to tell from those hashes, but those are right. We can confirm
|
||||
by running `builtins.merge` to have UCM add names for them.
|
||||
|
||||
```ucm
|
||||
.> builtins.merge
|
||||
.> links y
|
||||
.> view 1
|
||||
```
|
66
unison-src/transcripts/isPropagated-exists.output.md
Normal file
66
unison-src/transcripts/isPropagated-exists.output.md
Normal file
@ -0,0 +1,66 @@
|
||||
This transcript tests that UCM can always access the definition of
|
||||
`IsPropagated`/`isPropagated`, which is used internally.
|
||||
|
||||
`y` depends on `x`,
|
||||
```unison
|
||||
x = 3
|
||||
y = x + 1
|
||||
```
|
||||
|
||||
```ucm
|
||||
.> add
|
||||
|
||||
⍟ I've added these definitions:
|
||||
|
||||
x : Nat
|
||||
y : Nat
|
||||
|
||||
```
|
||||
so the `update` of `x` causes a propagated update of `y`, and UCM links the
|
||||
`isPropagated` metadata to such resulting terms:
|
||||
|
||||
```unison
|
||||
x = 4
|
||||
```
|
||||
|
||||
```ucm
|
||||
.> update
|
||||
|
||||
⍟ I've updated these names to your new definition:
|
||||
|
||||
x : Nat
|
||||
|
||||
.> links y
|
||||
|
||||
1. #uqdd5t2fgn : #ffb7g9cull
|
||||
|
||||
Tip: Try using `display 1` to display the first result or
|
||||
`view 1` to view its source.
|
||||
|
||||
.> view 1
|
||||
|
||||
#uqdd5t2fgn : #ffb7g9cull
|
||||
#uqdd5t2fgn = #ffb7g9cull#0
|
||||
|
||||
```
|
||||
Well, it's hard to tell from those hashes, but those are right. We can confirm
|
||||
by running `builtins.merge` to have UCM add names for them.
|
||||
|
||||
```ucm
|
||||
.> builtins.merge
|
||||
|
||||
Done.
|
||||
|
||||
.> links y
|
||||
|
||||
1. builtin.metadata.isPropagated : IsPropagated
|
||||
|
||||
Tip: Try using `display 1` to display the first result or
|
||||
`view 1` to view its source.
|
||||
|
||||
.> view 1
|
||||
|
||||
builtin.metadata.isPropagated : IsPropagated
|
||||
builtin.metadata.isPropagated = IsPropagated
|
||||
|
||||
```
|
18
unison-src/transcripts/isTest-exists.md
Normal file
18
unison-src/transcripts/isTest-exists.md
Normal file
@ -0,0 +1,18 @@
|
||||
This transcript tests that UCM can always access the definition of
|
||||
`IsTest`/`isTest`, which is used internally.
|
||||
|
||||
```ucm
|
||||
.> builtins.merge
|
||||
```
|
||||
|
||||
```unison:hide
|
||||
test> pass = [Ok "Passed"]
|
||||
```
|
||||
|
||||
```ucm
|
||||
.> add
|
||||
.> links pass
|
||||
.> display 1
|
||||
```
|
||||
|
||||
The definition and type of `isTest` should exist.
|
33
unison-src/transcripts/isTest-exists.output.md
Normal file
33
unison-src/transcripts/isTest-exists.output.md
Normal file
@ -0,0 +1,33 @@
|
||||
This transcript tests that UCM can always access the definition of
|
||||
`IsTest`/`isTest`, which is used internally.
|
||||
|
||||
```ucm
|
||||
.> builtins.merge
|
||||
|
||||
Done.
|
||||
|
||||
```
|
||||
```unison
|
||||
test> pass = [Ok "Passed"]
|
||||
```
|
||||
|
||||
```ucm
|
||||
.> add
|
||||
|
||||
⍟ I've added these definitions:
|
||||
|
||||
pass : [Result]
|
||||
|
||||
.> links pass
|
||||
|
||||
1. builtin.metadata.isTest : IsTest
|
||||
|
||||
Tip: Try using `display 1` to display the first result or
|
||||
`view 1` to view its source.
|
||||
|
||||
.> display 1
|
||||
|
||||
IsTest
|
||||
|
||||
```
|
||||
The definition and type of `isTest should exist.
|
@ -112,13 +112,13 @@ We can also delete the fork if we're done with it. (Don't worry, it's still in t
|
||||
Note: The most recent namespace hash is immediately below this
|
||||
message.
|
||||
|
||||
⊙ #aq4ln4eubk
|
||||
⊙ #ocf2qv3eiq
|
||||
|
||||
- Deletes:
|
||||
|
||||
feature1.y
|
||||
|
||||
⊙ #3dd9rilp4d
|
||||
⊙ #m9bsfo72sb
|
||||
|
||||
+ Adds / updates:
|
||||
|
||||
@ -129,26 +129,26 @@ We can also delete the fork if we're done with it. (Don't worry, it's still in t
|
||||
Original name New name(s)
|
||||
feature1.y master.y
|
||||
|
||||
⊙ #bcens9nged
|
||||
⊙ #kr6uveidib
|
||||
|
||||
+ Adds / updates:
|
||||
|
||||
feature1.y
|
||||
|
||||
⊙ #cbkou656ou
|
||||
⊙ #qbp32ttvld
|
||||
|
||||
> Moves:
|
||||
|
||||
Original name New name
|
||||
x master.x
|
||||
|
||||
⊙ #id60mvqgud
|
||||
⊙ #omd5gcmiai
|
||||
|
||||
+ Adds / updates:
|
||||
|
||||
x
|
||||
|
||||
⊙ #pa8ctn231i
|
||||
⊙ #7uh35q38sl
|
||||
|
||||
+ Adds / updates:
|
||||
|
||||
@ -193,19 +193,22 @@ We can also delete the fork if we're done with it. (Don't worry, it's still in t
|
||||
builtin.Int.shiftRight builtin.Int.signum
|
||||
builtin.Int.toFloat builtin.Int.toText
|
||||
builtin.Int.trailingZeros builtin.Int.truncate0
|
||||
builtin.Int.xor builtin.Link builtin.Link.Term##Link.Term
|
||||
builtin.Link.Term#quh#0 builtin.Link.Type##Link.Type
|
||||
builtin.Link.Type#quh#1 builtin.List builtin.List.++
|
||||
builtin.List.+: builtin.List.:+ builtin.List.at
|
||||
builtin.List.cons builtin.List.drop builtin.List.empty
|
||||
builtin.List.size builtin.List.snoc builtin.List.take
|
||||
builtin.Nat builtin.Nat.* builtin.Nat.+ builtin.Nat./
|
||||
builtin.Nat.and builtin.Nat.complement builtin.Nat.drop
|
||||
builtin.Nat.eq builtin.Nat.fromText builtin.Nat.gt
|
||||
builtin.Nat.gteq builtin.Nat.increment builtin.Nat.isEven
|
||||
builtin.Nat.isOdd builtin.Nat.leadingZeros builtin.Nat.lt
|
||||
builtin.Nat.lteq builtin.Nat.mod builtin.Nat.or
|
||||
builtin.Nat.popCount builtin.Nat.pow builtin.Nat.shiftLeft
|
||||
builtin.Int.xor builtin.IsPropagated
|
||||
builtin.IsPropagated.IsPropagated builtin.IsTest
|
||||
builtin.IsTest.IsTest builtin.Link
|
||||
builtin.Link.Term##Link.Term builtin.Link.Term#quh#0
|
||||
builtin.Link.Type##Link.Type builtin.Link.Type#quh#1
|
||||
builtin.List builtin.List.++ builtin.List.+:
|
||||
builtin.List.:+ builtin.List.at builtin.List.cons
|
||||
builtin.List.drop builtin.List.empty builtin.List.size
|
||||
builtin.List.snoc builtin.List.take builtin.Nat
|
||||
builtin.Nat.* builtin.Nat.+ builtin.Nat./ builtin.Nat.and
|
||||
builtin.Nat.complement builtin.Nat.drop builtin.Nat.eq
|
||||
builtin.Nat.fromText builtin.Nat.gt builtin.Nat.gteq
|
||||
builtin.Nat.increment builtin.Nat.isEven builtin.Nat.isOdd
|
||||
builtin.Nat.leadingZeros builtin.Nat.lt builtin.Nat.lteq
|
||||
builtin.Nat.mod builtin.Nat.or builtin.Nat.popCount
|
||||
builtin.Nat.pow builtin.Nat.shiftLeft
|
||||
builtin.Nat.shiftRight builtin.Nat.sub builtin.Nat.toFloat
|
||||
builtin.Nat.toInt builtin.Nat.toText
|
||||
builtin.Nat.trailingZeros builtin.Nat.xor builtin.Optional
|
||||
@ -319,6 +322,7 @@ We can also delete the fork if we're done with it. (Don't worry, it's still in t
|
||||
builtin.io2.Tls.newServer.impl
|
||||
builtin.io2.Tls.receive.impl builtin.io2.Tls.send.impl
|
||||
builtin.io2.Tls.terminate.impl builtin.io2.TlsFailure
|
||||
builtin.metadata.isPropagated builtin.metadata.isTest
|
||||
builtin.todo
|
||||
|
||||
□ #7asfbtqmoj (start of history)
|
||||
|
@ -37,13 +37,13 @@ And then we add it.
|
||||
|
||||
.subpath> find.verbose
|
||||
|
||||
1. -- #qae64o6am81hoadf7eabd909gojboi5iu3g9deip79ro18f11bbhir2vg51grg4m72kr5ikdovi6aupttet0nsqil7f0df9nqr10hqg
|
||||
1. -- #v4a90flt15t54qnjbvbdtj42ouqo8dktu5da8g6q30l4frc6l81ttjtov42r1nbj5jq3hh98snlb64tkbb1mc5dk8les96v71b4qr6g
|
||||
unique type Foo
|
||||
|
||||
2. -- #qae64o6am81hoadf7eabd909gojboi5iu3g9deip79ro18f11bbhir2vg51grg4m72kr5ikdovi6aupttet0nsqil7f0df9nqr10hqg#0
|
||||
2. -- #v4a90flt15t54qnjbvbdtj42ouqo8dktu5da8g6q30l4frc6l81ttjtov42r1nbj5jq3hh98snlb64tkbb1mc5dk8les96v71b4qr6g#0
|
||||
Foo.Foo : Foo
|
||||
|
||||
3. -- #hvtmbg1bd8of81n2os4ginnnen13njh47294uandlohooq0ej971u6tl5cdsfq237lec1tc007oajc4dee1fmnflqi6ogom3ecemu5g
|
||||
3. -- #31g7t8qcmqqdtpe4bdo1591egqh1q0ltnt69u345gdrdur0n8flfu1ohpjasauc9k81msvi2a4q4b03tp1018sac9esd8d3qmbq4b2g
|
||||
fooToInt : Foo -> Int
|
||||
|
||||
|
||||
@ -187,9 +187,9 @@ Cleaning up a bit...
|
||||
Removed definitions:
|
||||
|
||||
1. unique type Foo
|
||||
2. Foo.Bar : #16d2id848g
|
||||
3. Foo.Foo : #16d2id848g
|
||||
4. fooToInt : #16d2id848g -> Int
|
||||
2. Foo.Bar : #i2nv821v0u
|
||||
3. Foo.Foo : #i2nv821v0u
|
||||
4. fooToInt : #i2nv821v0u -> Int
|
||||
5. preserve.otherTerm : Optional baz -> Optional baz
|
||||
6. preserve.someTerm : Optional x -> Optional x
|
||||
7. patch patch
|
||||
|
@ -59,16 +59,16 @@ y = 2
|
||||
most recent, along with the command that got us there. Try:
|
||||
|
||||
`fork 2 .old`
|
||||
`fork #e81k8pc1ab .old` to make an old namespace
|
||||
`fork #eh80qvvka6 .old` to make an old namespace
|
||||
accessible again,
|
||||
|
||||
`reset-root #e81k8pc1ab` to reset the root namespace and
|
||||
`reset-root #eh80qvvka6` to reset the root namespace and
|
||||
its history to that of the
|
||||
specified namespace.
|
||||
|
||||
1. #a0b6r1c387 : add
|
||||
2. #e81k8pc1ab : add
|
||||
3. #pa8ctn231i : builtins.merge
|
||||
1. #qrbjnpeee4 : add
|
||||
2. #eh80qvvka6 : add
|
||||
3. #7uh35q38sl : builtins.merge
|
||||
4. #7asfbtqmoj : (initial reflogged namespace)
|
||||
|
||||
```
|
||||
|
@ -13,7 +13,7 @@ Let's look at some examples. We'll start with a namespace with just the builtins
|
||||
|
||||
|
||||
|
||||
□ #5f3plfnc5s (start of history)
|
||||
□ #hi70rf8au8 (start of history)
|
||||
|
||||
.> fork builtin builtin2
|
||||
|
||||
@ -42,21 +42,21 @@ Now suppose we `fork` a copy of builtin, then rename `Nat.+` to `frobnicate`, th
|
||||
Note: The most recent namespace hash is immediately below this
|
||||
message.
|
||||
|
||||
⊙ #rv10pat861
|
||||
⊙ #m0ppju0ejo
|
||||
|
||||
> Moves:
|
||||
|
||||
Original name New name
|
||||
Nat.frobnicate Nat.+
|
||||
|
||||
⊙ #vtlq9q9lem
|
||||
⊙ #1ohipe5cc9
|
||||
|
||||
> Moves:
|
||||
|
||||
Original name New name
|
||||
Nat.+ Nat.frobnicate
|
||||
|
||||
□ #5f3plfnc5s (start of history)
|
||||
□ #hi70rf8au8 (start of history)
|
||||
|
||||
```
|
||||
If we merge that back into `builtin`, we get that same chain of history:
|
||||
@ -71,21 +71,21 @@ If we merge that back into `builtin`, we get that same chain of history:
|
||||
Note: The most recent namespace hash is immediately below this
|
||||
message.
|
||||
|
||||
⊙ #rv10pat861
|
||||
⊙ #m0ppju0ejo
|
||||
|
||||
> Moves:
|
||||
|
||||
Original name New name
|
||||
Nat.frobnicate Nat.+
|
||||
|
||||
⊙ #vtlq9q9lem
|
||||
⊙ #1ohipe5cc9
|
||||
|
||||
> Moves:
|
||||
|
||||
Original name New name
|
||||
Nat.+ Nat.frobnicate
|
||||
|
||||
□ #5f3plfnc5s (start of history)
|
||||
□ #hi70rf8au8 (start of history)
|
||||
|
||||
```
|
||||
Let's try again, but using a `merge.squash` (or just `squash`) instead. The history will be unchanged:
|
||||
@ -106,7 +106,7 @@ Let's try again, but using a `merge.squash` (or just `squash`) instead. The hist
|
||||
|
||||
|
||||
|
||||
□ #5f3plfnc5s (start of history)
|
||||
□ #hi70rf8au8 (start of history)
|
||||
|
||||
```
|
||||
The churn that happened in `mybuiltin` namespace ended up back in the same spot, so the squash merge of that namespace with our original namespace had no effect.
|
||||
|
Loading…
Reference in New Issue
Block a user