From 697cc11916cddc37c129adef82ded37a7d7ebde3 Mon Sep 17 00:00:00 2001 From: Travis Staton Date: Thu, 21 Mar 2024 15:36:50 -0400 Subject: [PATCH 001/124] kind inference docs --- .../src/Unison/KindInference.hs | 2 +- .../src/Unison/KindInference/Solve.hs | 36 +++++++++++++++---- 2 files changed, 31 insertions(+), 7 deletions(-) diff --git a/parser-typechecker/src/Unison/KindInference.hs b/parser-typechecker/src/Unison/KindInference.hs index 7041146bf..8265f042b 100644 --- a/parser-typechecker/src/Unison/KindInference.hs +++ b/parser-typechecker/src/Unison/KindInference.hs @@ -8,7 +8,7 @@ -- decl to discover constraints on the decl vars. These constraints -- are then given to a constraint solver that determines a unique kind -- for each type variable. Unconstrained variables are defaulted to --- kind * (just like Haskell 98). This is done by 'inferDecls'. +-- kind Type (just like Haskell 98). This is done by 'inferDecls'. -- -- Afterwards, the 'SolveState' holds the kinds of all decls and we -- can check that type annotations in terms that may mention the diff --git a/parser-typechecker/src/Unison/KindInference/Solve.hs b/parser-typechecker/src/Unison/KindInference/Solve.hs index cdda14228..57b1c033c 100644 --- a/parser-typechecker/src/Unison/KindInference/Solve.hs +++ b/parser-typechecker/src/Unison/KindInference/Solve.hs @@ -43,8 +43,14 @@ import Unison.Syntax.TypePrinter qualified as TP import Unison.Util.Pretty qualified as P import Unison.Var (Var) +-- | Like "GeneratedConstraint" but the provenance of @IsType@ +-- constraints may be due to kind defaulting. (See "defaultUnconstrainedVars") type UnsolvedConstraint v loc = Unsolved.Constraint (UVar v loc) v loc StarProvenance +-- | We feed both @UnsolvedConstraint@ and @GeneratedConstraint@ to +-- our constraint solver, so it is useful to convert +-- @GeneratedConstraint@ into @UnsolvedConstraint@ to avoid code +-- duplication. _Generated :: forall v loc. Prism' (UnsolvedConstraint v loc) (GeneratedConstraint v loc) _Generated = prism' (Unsolved.starProv %~ NotDefault) \case Unsolved.IsType s l -> case l of @@ -79,7 +85,7 @@ step e st cs = Left e -> Left e Right () -> Right finalState --- | Default any unconstrained vars to * +-- | Default any unconstrained vars to Type defaultUnconstrainedVars :: Var v => SolveState v loc -> SolveState v loc defaultUnconstrainedVars st = let newConstraints = foldl' phi (constraints st) (newUnifVars st) @@ -284,6 +290,9 @@ addConstraint constraint = do processPostAction . fmap concat =<< runExceptT ((traverse (ExceptT . addConstraint') (x : xs))) processPostAction =<< addConstraint' (review _Generated constraint) +-- | Decompose the unsolved constraint into implied constraints, +-- returning a constraint conflict if the constraint cannot be +-- satisfied. addConstraint' :: forall v loc. Ord loc => @@ -291,11 +300,21 @@ addConstraint' :: UnsolvedConstraint v loc -> Solve v loc (Either (ConstraintConflict v loc) [UnsolvedConstraint v loc]) addConstraint' = \case + -- @IsAbility@ and @IsType@ constraints are very straightforward, + -- they are satisfied of the constraint already exists or no + -- constraint exists. Unsolved.IsAbility s p0 -> do handleConstraint s (Solved.IsAbility p0) \case Solved.IsAbility _ -> Just (Solved.IsAbility p0, []) _ -> Nothing + Unsolved.IsType s p0 -> do + handleConstraint s (Solved.IsType p0) \case + Solved.IsType _ -> Just (Solved.IsType p0, []) + _ -> Nothing Unsolved.IsArr s p0 a b -> do + -- If an @IsArr@ constraint is already present then we need to unify + -- the left and right hand sides of the input constraints and the + -- existing constraints, so we return those as implied constraints. handleConstraint s (Solved.IsArr p0 a b) \case Solved.IsArr _p1 c d -> let implied = @@ -305,18 +324,23 @@ addConstraint' = \case prov = p0 in Just (Solved.IsArr prov a b, implied) _ -> Nothing - Unsolved.IsType s p0 -> do - handleConstraint s (Solved.IsType p0) \case - Solved.IsType _ -> Just (Solved.IsType p0, []) - _ -> Nothing Unsolved.Unify l a b -> Right <$> union l a b where + -- | A helper for solving various @Is*@ constraints. In each case + -- we want to lookup any existing constraints on the constrained + -- variable. If none exist then we simply add the new constraint, + -- as it can't conflict with anything. If there is an existing + -- constraint we defer to the passed in function. handleConstraint :: + -- | The variable mentioned in the input constraint UVar v loc -> + -- | The new constraint Solved.Constraint (UVar v loc) v loc -> + -- | How to handle the an existing constraint ( Solved.Constraint (UVar v loc) v loc -> Maybe (Solved.Constraint (UVar v loc) v loc, [UnsolvedConstraint v loc]) ) -> + -- | An error or a list of implied constraints Solve v loc (Either (ConstraintConflict v loc) [UnsolvedConstraint v loc]) handleConstraint s solvedConstraint phi = do st@SolveState {constraints} <- M.get @@ -399,7 +423,7 @@ assertGen gen = do st <- step env st cs verify st case comp of - Left _ -> error "[assertGen]: constraint failure in among builtin constraints" + Left _ -> error "[assertGen]: constraint failure in builtin constraints" Right st -> M.put st initialState :: forall v loc. (BuiltinAnnotation loc, Show loc, Ord loc, Var v) => Env -> SolveState v loc From 6162ba0ce50f7b0d0074caf971eddfce0a57783c Mon Sep 17 00:00:00 2001 From: Travis Staton Date: Thu, 21 Mar 2024 15:58:42 -0400 Subject: [PATCH 002/124] docs, module rearrangement --- .../src/Unison/KindInference/Solve.hs | 231 ++++++++++-------- 1 file changed, 125 insertions(+), 106 deletions(-) diff --git a/parser-typechecker/src/Unison/KindInference/Solve.hs b/parser-typechecker/src/Unison/KindInference/Solve.hs index 57b1c033c..1bd1b7030 100644 --- a/parser-typechecker/src/Unison/KindInference/Solve.hs +++ b/parser-typechecker/src/Unison/KindInference/Solve.hs @@ -116,102 +116,6 @@ prettyUVar ppe (UVar s t) = TP.pretty ppe t <> " :: " <> P.prettyVar s tracePretty :: P.Pretty P.ColorText -> a -> a tracePretty p = trace (P.toAnsiUnbroken p) -data OccCheckState v loc = OccCheckState - { visitingSet :: Set (UVar v loc), - visitingStack :: [UVar v loc], - solvedSet :: Set (UVar v loc), - solvedConstraints :: ConstraintMap v loc, - kindErrors :: [KindError v loc] - } - -markVisiting :: Var v => UVar v loc -> M.State (OccCheckState v loc) CycleCheck -markVisiting x = do - OccCheckState {visitingSet, visitingStack} <- M.get - case Set.member x visitingSet of - True -> do - OccCheckState {solvedConstraints} <- M.get - let loc = case U.lookupCanon x solvedConstraints of - Just (_, _, Descriptor {descriptorConstraint = Just (Solved.IsArr (Provenance _ loc) _ _)}, _) -> loc - _ -> error "cycle without IsArr constraint" - addError (CycleDetected loc x solvedConstraints) - pure Cycle - False -> do - M.modify \st -> - st - { visitingSet = Set.insert x visitingSet, - visitingStack = x : visitingStack - } - pure NoCycle - -unmarkVisiting :: Var v => UVar v loc -> M.State (OccCheckState v loc) () -unmarkVisiting x = M.modify \st -> - st - { visitingSet = Set.delete x (visitingSet st), - visitingStack = tail (visitingStack st), - solvedSet = Set.insert x (solvedSet st) - } - -addError :: KindError v loc -> M.State (OccCheckState v loc) () -addError ke = M.modify \st -> st {kindErrors = ke : kindErrors st} - -isSolved :: Var v => UVar v loc -> M.State (OccCheckState v loc) Bool -isSolved x = do - OccCheckState {solvedSet} <- M.get - pure $ Set.member x solvedSet - -data CycleCheck - = Cycle - | NoCycle - --- | occurence check and report any errors -occCheck :: - forall v loc. - Var v => - ConstraintMap v loc -> - Either (NonEmpty (KindError v loc)) (ConstraintMap v loc) -occCheck constraints0 = - let go :: - [(UVar v loc)] -> - M.State (OccCheckState v loc) () - go = \case - [] -> pure () - u : us -> do - isSolved u >>= \case - True -> go us - False -> do - markVisiting u >>= \case - Cycle -> pure () - NoCycle -> do - st@OccCheckState {solvedConstraints} <- M.get - let handleNothing = error "impossible" - handleJust _canonK ecSize d = case descriptorConstraint d of - Nothing -> ([], U.Canonical ecSize d {descriptorConstraint = Just $ Solved.IsType Default}) - Just v -> - let descendants = case v of - Solved.IsType _ -> [] - Solved.IsAbility _ -> [] - Solved.IsArr _ a b -> [a, b] - in (descendants, U.Canonical ecSize d) - let (descendants, solvedConstraints') = U.alterF u handleNothing handleJust solvedConstraints - M.put st {solvedConstraints = solvedConstraints'} - go descendants - unmarkVisiting u - go us - - OccCheckState {solvedConstraints, kindErrors} = - M.execState - (go (U.keys constraints0)) - OccCheckState - { visitingSet = Set.empty, - visitingStack = [], - solvedSet = Set.empty, - solvedConstraints = constraints0, - kindErrors = [] - } - in case kindErrors of - [] -> Right solvedConstraints - e : es -> Left (e :| es) - -- | loop through the constraints, eliminating constraints until we -- have some set that cannot be reduced reduce :: @@ -230,36 +134,50 @@ reduce cs0 = dbg "reduce" cs0 (go False []) Right () -> error "impossible" c : cs -> addConstraint c >>= \case + -- If an error occurs then push it back onto the unsolved + -- stack Left _ -> go b (c : acc) cs + -- Signal that we solved something on this pass (by passing + -- @True@) and continue Right () -> go True acc cs + + -- | tracing helper dbg :: forall a. + -- | A hanging prefix or header P.Pretty P.ColorText -> + -- | The constraints to print [GeneratedConstraint v loc] -> ([GeneratedConstraint v loc] -> Solve v loc a) -> Solve v loc a - dbg hdr cs f = - case shouldDebug KindInference of - True -> do - ppe <- asks prettyPrintEnv - tracePretty (P.hang (P.bold hdr) (prettyConstraints ppe (map (review _Generated) cs))) (f cs) - False -> f cs + dbg = traceApp \ppe cs -> prettyConstraints ppe (map (review _Generated) cs) + -- | Like @dbg@, but for a single constraint dbgSingle :: forall a. P.Pretty P.ColorText -> GeneratedConstraint v loc -> (GeneratedConstraint v loc -> Solve v loc a) -> Solve v loc a - dbgSingle hdr c f = + dbgSingle = traceApp \ppe c -> prettyConstraintD' ppe (review _Generated c) + + -- | A helper for @dbg*@ + traceApp :: + forall a b. + (PrettyPrintEnv -> a -> P.Pretty P.ColorText) -> + P.Pretty P.ColorText -> + a -> + (a -> Solve v loc b) -> + Solve v loc b + traceApp prettyA hdr a ab = case shouldDebug KindInference of + False -> ab a True -> do ppe <- asks prettyPrintEnv - tracePretty (P.hang (P.bold hdr) (prettyConstraintD' ppe (review _Generated c))) (f c) - False -> f c + tracePretty (P.hang (P.bold hdr) (prettyA ppe a)) (ab a) -- | Add a single constraint, returning an error if there is a --- contradictory constraint +-- contradictory constraint. addConstraint :: forall v loc. Ord loc => @@ -430,3 +348,104 @@ initialState :: forall v loc. (BuiltinAnnotation loc, Show loc, Ord loc, Var v) initialState env = let ((), finalState) = run env emptyState initializeState in finalState + +-------------------------------------------------------------------------------- +-- Occurence check and helpers +-------------------------------------------------------------------------------- + +-- | occurence check and report any errors +occCheck :: + forall v loc. + Var v => + ConstraintMap v loc -> + Either (NonEmpty (KindError v loc)) (ConstraintMap v loc) +occCheck constraints0 = + let go :: + [(UVar v loc)] -> + M.State (OccCheckState v loc) () + go = \case + [] -> pure () + u : us -> do + isSolved u >>= \case + True -> go us + False -> do + markVisiting u >>= \case + Cycle -> pure () + NoCycle -> do + st@OccCheckState {solvedConstraints} <- M.get + let handleNothing = error "impossible" + handleJust _canonK ecSize d = case descriptorConstraint d of + Nothing -> ([], U.Canonical ecSize d {descriptorConstraint = Just $ Solved.IsType Default}) + Just v -> + let descendants = case v of + Solved.IsType _ -> [] + Solved.IsAbility _ -> [] + Solved.IsArr _ a b -> [a, b] + in (descendants, U.Canonical ecSize d) + let (descendants, solvedConstraints') = U.alterF u handleNothing handleJust solvedConstraints + M.put st {solvedConstraints = solvedConstraints'} + go descendants + unmarkVisiting u + go us + + OccCheckState {solvedConstraints, kindErrors} = + M.execState + (go (U.keys constraints0)) + OccCheckState + { visitingSet = Set.empty, + visitingStack = [], + solvedSet = Set.empty, + solvedConstraints = constraints0, + kindErrors = [] + } + in case kindErrors of + [] -> Right solvedConstraints + e : es -> Left (e :| es) + +data OccCheckState v loc = OccCheckState + { visitingSet :: Set (UVar v loc), + visitingStack :: [UVar v loc], + solvedSet :: Set (UVar v loc), + solvedConstraints :: ConstraintMap v loc, + kindErrors :: [KindError v loc] + } + +markVisiting :: Var v => UVar v loc -> M.State (OccCheckState v loc) CycleCheck +markVisiting x = do + OccCheckState {visitingSet, visitingStack} <- M.get + case Set.member x visitingSet of + True -> do + OccCheckState {solvedConstraints} <- M.get + let loc = case U.lookupCanon x solvedConstraints of + Just (_, _, Descriptor {descriptorConstraint = Just (Solved.IsArr (Provenance _ loc) _ _)}, _) -> loc + _ -> error "cycle without IsArr constraint" + addError (CycleDetected loc x solvedConstraints) + pure Cycle + False -> do + M.modify \st -> + st + { visitingSet = Set.insert x visitingSet, + visitingStack = x : visitingStack + } + pure NoCycle + +unmarkVisiting :: Var v => UVar v loc -> M.State (OccCheckState v loc) () +unmarkVisiting x = M.modify \st -> + st + { visitingSet = Set.delete x (visitingSet st), + visitingStack = tail (visitingStack st), + solvedSet = Set.insert x (solvedSet st) + } + +addError :: KindError v loc -> M.State (OccCheckState v loc) () +addError ke = M.modify \st -> st {kindErrors = ke : kindErrors st} + +isSolved :: Var v => UVar v loc -> M.State (OccCheckState v loc) Bool +isSolved x = do + OccCheckState {solvedSet} <- M.get + pure $ Set.member x solvedSet + +data CycleCheck + = Cycle + | NoCycle + From 9856de82f0c091cf60b382490ddc235d3745f728 Mon Sep 17 00:00:00 2001 From: Travis Staton Date: Thu, 21 Mar 2024 16:13:01 -0400 Subject: [PATCH 003/124] StarProvenance -> TypeProvenance --- .../Unison/KindInference/Constraint/Solved.hs | 8 +-- .../{StarProvenance.hs => TypeProvenance.hs} | 10 +-- .../KindInference/Constraint/Unsolved.hs | 12 ++-- .../src/Unison/KindInference/Solve.hs | 61 +++++++++++-------- .../unison-parser-typechecker.cabal | 4 +- 5 files changed, 53 insertions(+), 42 deletions(-) rename parser-typechecker/src/Unison/KindInference/Constraint/{StarProvenance.hs => TypeProvenance.hs} (78%) diff --git a/parser-typechecker/src/Unison/KindInference/Constraint/Solved.hs b/parser-typechecker/src/Unison/KindInference/Constraint/Solved.hs index b5fe4ba0e..d806663a3 100644 --- a/parser-typechecker/src/Unison/KindInference/Constraint/Solved.hs +++ b/parser-typechecker/src/Unison/KindInference/Constraint/Solved.hs @@ -8,15 +8,15 @@ where import Control.Lens (Traversal, Traversal') import Unison.KindInference.Constraint.Provenance (Provenance) import Unison.KindInference.Constraint.Provenance qualified as Provenance -import Unison.KindInference.Constraint.StarProvenance (StarProvenance) -import Unison.KindInference.Constraint.StarProvenance qualified as SP +import Unison.KindInference.Constraint.TypeProvenance (TypeProvenance) +import Unison.KindInference.Constraint.TypeProvenance qualified as TP -- | Solved constraints -- -- These constraints are associated with unification variables during -- kind inference. data Constraint uv v loc - = IsType (StarProvenance v loc) + = IsType (TypeProvenance v loc) | IsAbility (Provenance v loc) | IsArr (Provenance v loc) uv uv deriving stock (Show, Eq, Ord) @@ -28,7 +28,7 @@ prov :: (Provenance v loc) (Provenance v loc') prov f = \case - IsType x -> IsType <$> SP.prov f x + IsType x -> IsType <$> TP.prov f x IsAbility x -> IsAbility <$> f x IsArr l a b -> (\x -> IsArr x a b) <$> f l {-# INLINE prov #-} diff --git a/parser-typechecker/src/Unison/KindInference/Constraint/StarProvenance.hs b/parser-typechecker/src/Unison/KindInference/Constraint/TypeProvenance.hs similarity index 78% rename from parser-typechecker/src/Unison/KindInference/Constraint/StarProvenance.hs rename to parser-typechecker/src/Unison/KindInference/Constraint/TypeProvenance.hs index e273d4971..d8ed9bb2f 100644 --- a/parser-typechecker/src/Unison/KindInference/Constraint/StarProvenance.hs +++ b/parser-typechecker/src/Unison/KindInference/Constraint/TypeProvenance.hs @@ -1,5 +1,5 @@ -module Unison.KindInference.Constraint.StarProvenance - ( StarProvenance (..), +module Unison.KindInference.Constraint.TypeProvenance + ( TypeProvenance (..), prov, ) where @@ -11,15 +11,15 @@ import Unison.KindInference.Constraint.Provenance (Provenance) -- in constraint generation (in which case it will have a -- @Provenance@) and also in the solver through kind-defaulting on -- unconstrained unification variables. -data StarProvenance v loc +data TypeProvenance v loc = NotDefault (Provenance v loc) | Default deriving stock (Show, Eq, Ord) prov :: Traversal - (StarProvenance v loc) - (StarProvenance v loc') + (TypeProvenance v loc) + (TypeProvenance v loc') (Provenance v loc) (Provenance v loc') prov f = \case diff --git a/parser-typechecker/src/Unison/KindInference/Constraint/Unsolved.hs b/parser-typechecker/src/Unison/KindInference/Constraint/Unsolved.hs index 92ad1fc4c..3fd637ca2 100644 --- a/parser-typechecker/src/Unison/KindInference/Constraint/Unsolved.hs +++ b/parser-typechecker/src/Unison/KindInference/Constraint/Unsolved.hs @@ -1,6 +1,6 @@ module Unison.KindInference.Constraint.Unsolved ( Constraint (..), - starProv, + typeProv, prov, loc, ) @@ -14,29 +14,29 @@ import Unison.KindInference.Constraint.Provenance qualified as Provenance -- -- These are produced during constraint generation and given as input -- to the constraint solver. -data Constraint uv v loc starProv +data Constraint uv v loc typeProv = -- | An IsType constraint may arise from generation or from the -- solver. During generation the provenance is always a real -- source code location, but the solver defaults unconstrained -- kind vars to Star. - IsType uv (starProv v loc) + IsType uv (typeProv v loc) | IsArr uv (Provenance v loc) uv uv | IsAbility uv (Provenance v loc) | Unify (Provenance v loc) uv uv deriving stock (Show, Eq, Ord) -starProv :: +typeProv :: Traversal (Constraint uv v loc prov) (Constraint uv v loc prov') (prov v loc) (prov' v loc) -starProv f = \case +typeProv f = \case IsType x l -> IsType x <$> f l IsAbility x l -> pure (IsAbility x l) IsArr s l a b -> pure (IsArr s l a b) Unify l a b -> pure (Unify l a b) -{-# INLINE starProv #-} +{-# INLINE typeProv #-} prov :: Lens diff --git a/parser-typechecker/src/Unison/KindInference/Solve.hs b/parser-typechecker/src/Unison/KindInference/Solve.hs index 1bd1b7030..a90966058 100644 --- a/parser-typechecker/src/Unison/KindInference/Solve.hs +++ b/parser-typechecker/src/Unison/KindInference/Solve.hs @@ -19,7 +19,7 @@ import Unison.Codebase.BuiltinAnnotation (BuiltinAnnotation) import Unison.Debug (DebugFlag (KindInference), shouldDebug) import Unison.KindInference.Constraint.Provenance (Provenance (..)) import Unison.KindInference.Constraint.Solved qualified as Solved -import Unison.KindInference.Constraint.StarProvenance (StarProvenance (..)) +import Unison.KindInference.Constraint.TypeProvenance (TypeProvenance (..)) import Unison.KindInference.Constraint.Unsolved qualified as Unsolved import Unison.KindInference.Error (ConstraintConflict (..), KindError (..), improveError) import Unison.KindInference.Generate (builtinConstraints) @@ -45,14 +45,14 @@ import Unison.Var (Var) -- | Like "GeneratedConstraint" but the provenance of @IsType@ -- constraints may be due to kind defaulting. (See "defaultUnconstrainedVars") -type UnsolvedConstraint v loc = Unsolved.Constraint (UVar v loc) v loc StarProvenance +type UnsolvedConstraint v loc = Unsolved.Constraint (UVar v loc) v loc TypeProvenance -- | We feed both @UnsolvedConstraint@ and @GeneratedConstraint@ to -- our constraint solver, so it is useful to convert -- @GeneratedConstraint@ into @UnsolvedConstraint@ to avoid code -- duplication. _Generated :: forall v loc. Prism' (UnsolvedConstraint v loc) (GeneratedConstraint v loc) -_Generated = prism' (Unsolved.starProv %~ NotDefault) \case +_Generated = prism' (Unsolved.typeProv %~ NotDefault) \case Unsolved.IsType s l -> case l of Default -> Nothing NotDefault l -> Just (Unsolved.IsType s l) @@ -96,28 +96,12 @@ defaultUnconstrainedVars st = Just _ -> U.Canonical ecSize d in st {constraints = newConstraints, newUnifVars = []} -prettyConstraintD' :: Show loc => Var v => PrettyPrintEnv -> UnsolvedConstraint v loc -> P.Pretty P.ColorText -prettyConstraintD' ppe = - P.wrap . \case - Unsolved.IsType v p -> prettyUVar ppe v <> " ~ Type" <> prettyProv p - Unsolved.IsAbility v p -> prettyUVar ppe v <> " ~ Ability" <> prettyProv p - Unsolved.IsArr v p a b -> prettyUVar ppe v <> " ~ " <> prettyUVar ppe a <> " -> " <> prettyUVar ppe b <> prettyProv p - Unsolved.Unify p a b -> prettyUVar ppe a <> " ~ " <> prettyUVar ppe b <> prettyProv p - where - prettyProv x = - "[" <> P.string (show x) <> "]" - -prettyConstraints :: Show loc => Var v => PrettyPrintEnv -> [UnsolvedConstraint v loc] -> P.Pretty P.ColorText -prettyConstraints ppe = P.sep "\n" . map (prettyConstraintD' ppe) - -prettyUVar :: Var v => PrettyPrintEnv -> UVar v loc -> P.Pretty P.ColorText -prettyUVar ppe (UVar s t) = TP.pretty ppe t <> " :: " <> P.prettyVar s - -tracePretty :: P.Pretty P.ColorText -> a -> a -tracePretty p = trace (P.toAnsiUnbroken p) - --- | loop through the constraints, eliminating constraints until we --- have some set that cannot be reduced +-- | Loop through the constraints, eliminating constraints until we +-- have some set that cannot be reduced. There isn't any strong reason +-- to avoid halting at the first error -- we don't have constraints +-- that error but may succeed with more information or anything. The +-- idea of looping was to resolve as much as possible so that the +-- error message can be as filled out as possible. reduce :: forall v loc. (Show loc, Var v, Ord loc) => @@ -326,6 +310,10 @@ verify st = Left e -> Left e Right m -> Right st {constraints = m} +-------------------------------------------------------------------------------- +-- Occurence check and helpers +-------------------------------------------------------------------------------- + initializeState :: forall v loc. (BuiltinAnnotation loc, Ord loc, Show loc, Var v) => Solve v loc () initializeState = assertGen do builtinConstraints @@ -449,3 +437,26 @@ data CycleCheck = Cycle | NoCycle +-------------------------------------------------------------------------------- +-- Debug output helpers +-------------------------------------------------------------------------------- + +prettyConstraintD' :: Show loc => Var v => PrettyPrintEnv -> UnsolvedConstraint v loc -> P.Pretty P.ColorText +prettyConstraintD' ppe = + P.wrap . \case + Unsolved.IsType v p -> prettyUVar ppe v <> " ~ Type" <> prettyProv p + Unsolved.IsAbility v p -> prettyUVar ppe v <> " ~ Ability" <> prettyProv p + Unsolved.IsArr v p a b -> prettyUVar ppe v <> " ~ " <> prettyUVar ppe a <> " -> " <> prettyUVar ppe b <> prettyProv p + Unsolved.Unify p a b -> prettyUVar ppe a <> " ~ " <> prettyUVar ppe b <> prettyProv p + where + prettyProv x = + "[" <> P.string (show x) <> "]" + +prettyConstraints :: Show loc => Var v => PrettyPrintEnv -> [UnsolvedConstraint v loc] -> P.Pretty P.ColorText +prettyConstraints ppe = P.sep "\n" . map (prettyConstraintD' ppe) + +prettyUVar :: Var v => PrettyPrintEnv -> UVar v loc -> P.Pretty P.ColorText +prettyUVar ppe (UVar s t) = TP.pretty ppe t <> " :: " <> P.prettyVar s + +tracePretty :: P.Pretty P.ColorText -> a -> a +tracePretty p = trace (P.toAnsiUnbroken p) diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index 622403d5f..c952d6487 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -101,7 +101,7 @@ library Unison.KindInference.Constraint.Pretty Unison.KindInference.Constraint.Provenance Unison.KindInference.Constraint.Solved - Unison.KindInference.Constraint.StarProvenance + Unison.KindInference.Constraint.TypeProvenance Unison.KindInference.Constraint.Unsolved Unison.KindInference.Error Unison.KindInference.Error.Pretty From f074d3b0ba12508a2b0d68c49a1658ad50e74d26 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 22 Mar 2024 01:14:29 -0600 Subject: [PATCH 004/124] actions/upload-artifact@v2 was on node 16 --- .github/workflows/build-optimized-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/build-optimized-ucm.yaml b/.github/workflows/build-optimized-ucm.yaml index a0e90d1d3..88514d91d 100644 --- a/.github/workflows/build-optimized-ucm.yaml +++ b/.github/workflows/build-optimized-ucm.yaml @@ -88,7 +88,7 @@ jobs: echo "artifact_archive=${artifact_archive}" >> $GITHUB_ENV - name: upload artifact - uses: actions/upload-artifact@v2 + uses: actions/upload-artifact@v4 with: if-no-files-found: error name: build-${{env.artifact_os}} From 2a6708d2b55ffa830b1d7e48d892a8b72ea5704c Mon Sep 17 00:00:00 2001 From: Travis Staton Date: Thu, 21 Mar 2024 16:40:15 -0400 Subject: [PATCH 005/124] document kind inference solver --- .../src/Unison/KindInference/Solve.hs | 11 +++++----- .../src/Unison/KindInference/Solve/Monad.hs | 21 +++++++++++++++++++ 2 files changed, 27 insertions(+), 5 deletions(-) diff --git a/parser-typechecker/src/Unison/KindInference/Solve.hs b/parser-typechecker/src/Unison/KindInference/Solve.hs index a90966058..7e206a9f7 100644 --- a/parser-typechecker/src/Unison/KindInference/Solve.hs +++ b/parser-typechecker/src/Unison/KindInference/Solve.hs @@ -43,8 +43,8 @@ import Unison.Syntax.TypePrinter qualified as TP import Unison.Util.Pretty qualified as P import Unison.Var (Var) --- | Like "GeneratedConstraint" but the provenance of @IsType@ --- constraints may be due to kind defaulting. (See "defaultUnconstrainedVars") +-- | Like 'GeneratedConstraint' but the provenance of @IsType@ +-- constraints may be due to kind defaulting. (See 'defaultUnconstrainedVars') type UnsolvedConstraint v loc = Unsolved.Constraint (UVar v loc) v loc TypeProvenance -- | We feed both @UnsolvedConstraint@ and @GeneratedConstraint@ to @@ -60,8 +60,9 @@ _Generated = prism' (Unsolved.typeProv %~ NotDefault) \case Unsolved.IsArr s l a b -> Just (Unsolved.IsArr s l a b) Unsolved.Unify l a b -> Just (Unsolved.Unify l a b) --- | Apply some generated constraints to a solve state, returning a --- kind error if detected or a new solve state. +-- | This is the primary function in the exposed API. @step@ applies +-- some generated constraints to a solve state, returning a kind error +-- if detected or a new solve state. step :: (Var v, Ord loc, Show loc) => Env -> @@ -85,7 +86,7 @@ step e st cs = Left e -> Left e Right () -> Right finalState --- | Default any unconstrained vars to Type +-- | Default any unconstrained vars to @Type@ defaultUnconstrainedVars :: Var v => SolveState v loc -> SolveState v loc defaultUnconstrainedVars st = let newConstraints = foldl' phi (constraints st) (newUnifVars st) diff --git a/parser-typechecker/src/Unison/KindInference/Solve/Monad.hs b/parser-typechecker/src/Unison/KindInference/Solve/Monad.hs index bcd83b4ec..d0d8fc58f 100644 --- a/parser-typechecker/src/Unison/KindInference/Solve/Monad.hs +++ b/parser-typechecker/src/Unison/KindInference/Solve/Monad.hs @@ -35,6 +35,18 @@ data Env = Env {prettyPrintEnv :: PrettyPrintEnv} type ConstraintMap v loc = U.UFMap (UVar v loc) (Descriptor v loc) +-- | The @SolveState@ holds all kind constraints gathered for each +-- type. For example, after processing data and effect decls the +-- @typeMap@ will hold entries for every decl, and looking up the +-- corresponding @UVar@ in @constraints@ will return its kind. +-- +-- The other fields, @unifVars@ and @newUnifVars@, are relevant when +-- interleaving constraint generation with solving. Constraint +-- generation needs to create fresh unification variables, so it needs +-- the set of bound unification variables from +-- @unifVars@. @newUnifVars@ holds the uvars that are candidates for +-- kind defaulting (see +-- 'Unison.KindInference.Solve.defaultUnconstrainedVars'). data SolveState v loc = SolveState { unifVars :: !(Set Symbol), newUnifVars :: [UVar v loc], @@ -42,6 +54,7 @@ data SolveState v loc = SolveState typeMap :: !(Map (T.Type v loc) (NonEmpty (UVar v loc))) } +-- | Constraints associated with a unification variable data Descriptor v loc = Descriptor { descriptorConstraint :: Maybe (Constraint (UVar v loc) v loc) } @@ -57,6 +70,7 @@ newtype Solve v loc a = Solve {unSolve :: Env -> SolveState v loc -> (a, SolveSt ) via M.ReaderT Env (M.State (SolveState v loc)) +-- | Helper for inteleaving constraint generation and solving genStateL :: Lens' (SolveState v loc) (Gen.GenState v loc) genStateL f st = ( \genState -> @@ -72,6 +86,7 @@ genStateL f st = newVars = [] } +-- | Interleave constraint generation into constraint solving runGen :: Var v => Gen v loc a -> Solve v loc a runGen gena = do st <- M.get @@ -85,15 +100,20 @@ runGen gena = do M.modify \st -> st {newUnifVars = vs ++ newUnifVars st} pure cs +-- | Add a unification variable to the constarint mapping with no +-- constraints. This is done on uvars created during constraint +-- generation to initialize the new uvars (see 'runGen'). addUnconstrainedVar :: Var v => UVar v loc -> Solve v loc () addUnconstrainedVar uvar = do st@SolveState {constraints} <- M.get let constraints' = U.insert uvar Descriptor {descriptorConstraint = Nothing} constraints M.put st {constraints = constraints'} +-- | Runner for the @Solve@ monad run :: Env -> SolveState v loc -> Solve v loc a -> (a, SolveState v loc) run e st action = unSolve action e st +-- | Initial solve state emptyState :: SolveState v loc emptyState = SolveState @@ -103,6 +123,7 @@ emptyState = typeMap = M.empty } +-- | Lookup the constraints associated with a unification variable find :: Var v => UVar v loc -> Solve v loc (Maybe (Constraint (UVar v loc) v loc)) find k = do st@SolveState {constraints} <- M.get From 587267a1519895f40e2df5b472b54916ba5b044e Mon Sep 17 00:00:00 2001 From: Travis Staton Date: Fri, 22 Mar 2024 11:43:00 -0400 Subject: [PATCH 006/124] document kind inference constraint generation --- .../src/Unison/KindInference/Generate.hs | 148 +++++++++++------- .../Unison/KindInference/Generate/Monad.hs | 6 + .../src/Unison/KindInference/Solve.hs | 15 +- 3 files changed, 108 insertions(+), 61 deletions(-) diff --git a/parser-typechecker/src/Unison/KindInference/Generate.hs b/parser-typechecker/src/Unison/KindInference/Generate.hs index c9841800d..b2d41f5a5 100644 --- a/parser-typechecker/src/Unison/KindInference/Generate.hs +++ b/parser-typechecker/src/Unison/KindInference/Generate.hs @@ -1,3 +1,5 @@ +-- | Handles generating kind constraints to be fed to the kind +-- constraint solver (found in "Unison.KindInference.Solve"). module Unison.KindInference.Generate ( typeConstraints, termConstraints, @@ -28,40 +30,16 @@ import Unison.Term qualified as Term import Unison.Type qualified as Type import Unison.Var (Type (User), Var (typed), freshIn) -data ConstraintTree v loc - = Node [ConstraintTree v loc] - | Constraint (GeneratedConstraint v loc) (ConstraintTree v loc) - | ParentConstraint (GeneratedConstraint v loc) (ConstraintTree v loc) - | StrictOrder (ConstraintTree v loc) (ConstraintTree v loc) -newtype TreeWalk = TreeWalk (forall a. ([a] -> [a]) -> [([a] -> [a], [a] -> [a])] -> [a] -> [a]) +-------------------------------------------------------------------------------- +-- Constraints arising from Types +-------------------------------------------------------------------------------- -bottomUp :: TreeWalk -bottomUp = TreeWalk \down pairs0 -> foldr (\(d, u) b -> d . u . b) id pairs0 . down - -flatten :: TreeWalk -> ConstraintTree v loc -> [GeneratedConstraint v loc] -flatten (TreeWalk f) = ($ []) . flattenTop - where - flattenTop :: ConstraintTree v loc -> [GeneratedConstraint v loc] -> [GeneratedConstraint v loc] - flattenTop t0 = - f id [flattenRec id t0] - - flattenRec :: - ([GeneratedConstraint v loc] -> [GeneratedConstraint v loc]) -> - ConstraintTree v loc -> - ([GeneratedConstraint v loc] -> [GeneratedConstraint v loc], [GeneratedConstraint v loc] -> [GeneratedConstraint v loc]) - flattenRec down = \case - Node cts -> - let pairs = map (flattenRec id) cts - in (f down pairs, id) - Constraint c ct -> flattenRec (down . (c :)) ct - ParentConstraint c ct -> - let (down', up) = flattenRec down ct - in (down', up . (c :)) - StrictOrder a b -> - let as = flattenTop a - bs = flattenTop b - in (f down [(as . bs, id)], id) +-- | Generate kind constraints arising from a given type. The given +-- @UVar@ is constrained to have the kind of the given type. +typeConstraints :: (Var v, Ord loc) => UVar v loc -> Type.Type v loc -> Gen v loc [GeneratedConstraint v loc] +typeConstraints resultVar typ = + flatten bottomUp <$> typeConstraintTree resultVar typ typeConstraintTree :: (Var v, Ord loc) => UVar v loc -> Type.Type v loc -> Gen v loc (ConstraintTree v loc) typeConstraintTree resultVar term@ABT.Term {annotation, out} = do @@ -130,11 +108,6 @@ typeConstraintTree resultVar term@ABT.Term {annotation, out} = do effConstraints <- typeConstraintTree effKind eff pure $ ParentConstraint (IsAbility effKind (Provenance EffectsList $ ABT.annotation eff)) effConstraints --- | Generate kind constraints arising from a given type. The given --- @UVar@ is constrained to have the kind of the given type. -typeConstraints :: (Var v, Ord loc) => UVar v loc -> Type.Type v loc -> Gen v loc [GeneratedConstraint v loc] -typeConstraints resultVar typ = - flatten bottomUp <$> typeConstraintTree resultVar typ handleIntroOuter :: Var v => v -> loc -> (GeneratedConstraint v loc -> Gen v loc r) -> Gen v loc r handleIntroOuter v loc k = do @@ -146,6 +119,29 @@ handleIntroOuter v loc k = do Just a -> pure a k (Unify (Provenance ScopeReference loc) new orig) +-------------------------------------------------------------------------------- +-- Constraints arising from Type annotations +-------------------------------------------------------------------------------- + +-- | Check that all annotations in a term are well-kinded +termConstraints :: forall v loc. (Var v, Ord loc) => Term.Term v loc -> Gen v loc [GeneratedConstraint v loc] +termConstraints x = flatten bottomUp <$> termConstraintTree x + +termConstraintTree :: forall v loc. (Var v, Ord loc) => Term.Term v loc -> Gen v loc (ConstraintTree v loc) +termConstraintTree = fmap Node . dfAnns processAnn cons nil . hackyStripAnns + where + processAnn :: loc -> Type.Type v loc -> Gen v loc [ConstraintTree v loc] -> Gen v loc [ConstraintTree v loc] + processAnn ann typ mrest = do + instantiateType typ \typ gcs -> do + typKind <- freshVar typ + annConstraints <- ParentConstraint (IsType typKind (Provenance TypeAnnotation ann)) <$> typeConstraintTree typKind typ + let annConstraints' = foldr Constraint annConstraints gcs + rest <- mrest + pure (annConstraints' : rest) + cons mlhs mrhs = (++) <$> mlhs <*> mrhs + nil = pure [] + + -- | Helper for @termConstraints@ that instantiates the outermost -- foralls and keeps the type in scope (in the type map) while -- checking lexically nested type annotations. @@ -165,24 +161,6 @@ instantiateType type0 k = t -> k t (reverse acc) in go [] type0 --- | Check that all annotations in a term are well-kinded -termConstraints :: forall v loc. (Var v, Ord loc) => Term.Term v loc -> Gen v loc [GeneratedConstraint v loc] -termConstraints x = flatten bottomUp <$> termConstraintTree x - -termConstraintTree :: forall v loc. (Var v, Ord loc) => Term.Term v loc -> Gen v loc (ConstraintTree v loc) -termConstraintTree = fmap Node . dfAnns processAnn cons nil . hackyStripAnns - where - processAnn :: loc -> Type.Type v loc -> Gen v loc [ConstraintTree v loc] -> Gen v loc [ConstraintTree v loc] - processAnn ann typ mrest = do - instantiateType typ \typ gcs -> do - typKind <- freshVar typ - annConstraints <- ParentConstraint (IsType typKind (Provenance TypeAnnotation ann)) <$> typeConstraintTree typKind typ - let annConstraints' = foldr Constraint annConstraints gcs - rest <- mrest - pure (annConstraints' : rest) - cons mlhs mrhs = (++) <$> mlhs <*> mrhs - nil = pure [] - -- | Process type annotations depth-first. Allows processing -- annotations with lexical scoping. dfAnns :: (loc -> Type.Type v loc -> b -> b) -> (b -> b -> b) -> b -> Term.Term v loc -> b @@ -222,6 +200,10 @@ hackyStripAnns = Term.Ann trm _typ -> trm t -> ABT.tm ann t +-------------------------------------------------------------------------------- +-- Constraints arising from Decls +-------------------------------------------------------------------------------- + -- | Generate kind constraints for a mutally recursive component of -- decls declComponentConstraints :: @@ -345,6 +327,12 @@ withInstantiatedConstructorType declType tyParams0 constructorType0 k = pure (Unify (Provenance DeclDefinition (ABT.annotation typ)) x tp) in goForall constructorType0 +-------------------------------------------------------------------------------- +-- Constraints on builtins +-------------------------------------------------------------------------------- + +-- | Constraints on language builtins, used to initialize the kind +-- inference state ('Unison.KindInference.Solve.initialState') builtinConstraints :: forall v loc. (Ord loc, BuiltinAnnotation loc, Var v) => Gen v loc [GeneratedConstraint v loc] builtinConstraints = flatten bottomUp <$> builtinConstraintTree @@ -417,6 +405,11 @@ builtinConstraintTree = kindVar <- pushType (t builtinAnnotation) foldr Constraint (Node []) <$> constrainToKind (Provenance Builtin builtinAnnotation) kindVar k +-------------------------------------------------------------------------------- +-- Helpers for constructing constraints +-------------------------------------------------------------------------------- + +-- | Constrain a @UVar@ to the provided @Kind@ constrainToKind :: (Var v) => Provenance v loc -> UVar v loc -> Kind -> Gen v loc [GeneratedConstraint v loc] constrainToKind prov resultVar0 = fmap ($ []) . go resultVar0 where @@ -438,7 +431,52 @@ data Kind = Type | Ability | Kind :-> Kind infixr 9 :-> +-- | Convert the 'Unison.Kind' annotation type to our internal 'Kind' fromUnisonKind :: Unison.Kind -> Kind fromUnisonKind = \case Unison.Star -> Type Unison.Arrow a b -> fromUnisonKind a :-> fromUnisonKind b + +-------------------------------------------------------------------------------- +-- Constraint ordering +-------------------------------------------------------------------------------- + +-- | The order in which constraints are generated has a great impact +-- on the error observed. To separate the concern of constraint +-- generation and constraint ordering the constraints are generated as +-- a constraint tree, and the flattening of this tree determines the +-- generated constraint order. +data ConstraintTree v loc + = Node [ConstraintTree v loc] + | Constraint (GeneratedConstraint v loc) (ConstraintTree v loc) + | ParentConstraint (GeneratedConstraint v loc) (ConstraintTree v loc) + | StrictOrder (ConstraintTree v loc) (ConstraintTree v loc) + +newtype TreeWalk = TreeWalk (forall a. ([a] -> [a]) -> [([a] -> [a], [a] -> [a])] -> [a] -> [a]) + +bottomUp :: TreeWalk +bottomUp = TreeWalk \down pairs0 -> foldr (\(d, u) b -> d . u . b) id pairs0 . down + +flatten :: TreeWalk -> ConstraintTree v loc -> [GeneratedConstraint v loc] +flatten (TreeWalk f) = ($ []) . flattenTop + where + flattenTop :: ConstraintTree v loc -> [GeneratedConstraint v loc] -> [GeneratedConstraint v loc] + flattenTop t0 = + f id [flattenRec id t0] + + flattenRec :: + ([GeneratedConstraint v loc] -> [GeneratedConstraint v loc]) -> + ConstraintTree v loc -> + ([GeneratedConstraint v loc] -> [GeneratedConstraint v loc], [GeneratedConstraint v loc] -> [GeneratedConstraint v loc]) + flattenRec down = \case + Node cts -> + let pairs = map (flattenRec id) cts + in (f down pairs, id) + Constraint c ct -> flattenRec (down . (c :)) ct + ParentConstraint c ct -> + let (down', up) = flattenRec down ct + in (down', up . (c :)) + StrictOrder a b -> + let as = flattenTop a + bs = flattenTop b + in (f down [(as . bs, id)], id) diff --git a/parser-typechecker/src/Unison/KindInference/Generate/Monad.hs b/parser-typechecker/src/Unison/KindInference/Generate/Monad.hs index 73952c2b6..7b374d6ef 100644 --- a/parser-typechecker/src/Unison/KindInference/Generate/Monad.hs +++ b/parser-typechecker/src/Unison/KindInference/Generate/Monad.hs @@ -25,8 +25,10 @@ import Unison.Symbol import Unison.Type qualified as T import Unison.Var +-- | A generated constraint type GeneratedConstraint v loc = Constraint (UVar v loc) v loc Provenance +-- | The @Gen@ monad state data GenState v loc = GenState { unifVars :: !(Set Symbol), typeMap :: !(Map (T.Type v loc) (NonEmpty (UVar v loc))), @@ -45,6 +47,7 @@ newtype Gen v loc a = Gen ) via State (GenState v loc) +-- | @Gen@ monad runner run :: Gen v loc a -> GenState v loc -> (a, GenState v loc) run (Gen ma) st0 = ma st0 @@ -71,11 +74,13 @@ pushType t = do modify \st -> st {typeMap = newTypeMap} pure var +-- | Lookup the @UVar@ associated with a @Type@ lookupType :: Var v => T.Type v loc -> Gen v loc (Maybe (UVar v loc)) lookupType t = do GenState {typeMap} <- get pure (NonEmpty.head <$> Map.lookup t typeMap) +-- | Remove a @Type@ from the context popType :: Var v => T.Type v loc -> Gen v loc () popType t = do modify \st -> st {typeMap = del (typeMap st)} @@ -88,6 +93,7 @@ popType t = do x : xs -> Just (x :| xs) in Map.alter f t m +-- | Helper to run an action with the given @Type@ in the context scopedType :: Var v => T.Type v loc -> (UVar v loc -> Gen v loc r) -> Gen v loc r scopedType t m = do s <- pushType t diff --git a/parser-typechecker/src/Unison/KindInference/Solve.hs b/parser-typechecker/src/Unison/KindInference/Solve.hs index 7e206a9f7..09acd3979 100644 --- a/parser-typechecker/src/Unison/KindInference/Solve.hs +++ b/parser-typechecker/src/Unison/KindInference/Solve.hs @@ -1,3 +1,5 @@ +-- | Handles solving kind constraints generated by +-- "Unison.KindInference.Generate". module Unison.KindInference.Solve ( step, verify, @@ -312,9 +314,15 @@ verify st = Right m -> Right st {constraints = m} -------------------------------------------------------------------------------- --- Occurence check and helpers +-- @SolveState@ initialization -------------------------------------------------------------------------------- +initialState :: forall v loc. (BuiltinAnnotation loc, Show loc, Ord loc, Var v) => Env -> SolveState v loc +initialState env = + let ((), finalState) = run env emptyState initializeState + in finalState + + initializeState :: forall v loc. (BuiltinAnnotation loc, Ord loc, Show loc, Var v) => Solve v loc () initializeState = assertGen do builtinConstraints @@ -333,11 +341,6 @@ assertGen gen = do Left _ -> error "[assertGen]: constraint failure in builtin constraints" Right st -> M.put st -initialState :: forall v loc. (BuiltinAnnotation loc, Show loc, Ord loc, Var v) => Env -> SolveState v loc -initialState env = - let ((), finalState) = run env emptyState initializeState - in finalState - -------------------------------------------------------------------------------- -- Occurence check and helpers -------------------------------------------------------------------------------- From 702318a6e4c2949ad03f02634f40833066294c0b Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Fri, 22 Mar 2024 13:09:23 -0400 Subject: [PATCH 007/124] A few fixes/tweaks - Changes the naming convention for builtin types/data to avoid clashes between builtins and pregenerated data types. For instance, both had a Value type in scheme, because of the in-unison representation. Instead of just `unison-`, now either `builtin-` or `ref-` prefixes are used. - Fixes several places where invalid values were being used in exceptions. Raw scheme values were being returned that do not correspond to unison values, and this was causing problems with reflection. - Fixes some code loading operations returning in-unison `Reference` values instead of term link values. Parts of these are implemented in unison, so both types are in play, and need to be correctly mediated. --- scheme-libs/racket/unison-runtime.rkt | 4 +- scheme-libs/racket/unison/boot.ss | 106 ++++++------ scheme-libs/racket/unison/concurrent.ss | 20 +-- scheme-libs/racket/unison/core.ss | 2 +- scheme-libs/racket/unison/data.ss | 134 +++++++-------- scheme-libs/racket/unison/io-handles.rkt | 99 ++++++----- scheme-libs/racket/unison/io.rkt | 30 ++-- .../racket/unison/primops-generated.rkt | 154 +++++++++--------- scheme-libs/racket/unison/primops.ss | 32 +--- scheme-libs/racket/unison/tcp.rkt | 40 ++--- scheme-libs/racket/unison/tls.rkt | 26 +-- scheme-libs/racket/unison/zlib.rkt | 2 +- .../transcripts-manual/gen-racket-libs.md | 2 +- .../gen-racket-libs.output.md | 4 +- 14 files changed, 339 insertions(+), 316 deletions(-) diff --git a/scheme-libs/racket/unison-runtime.rkt b/scheme-libs/racket/unison-runtime.rkt index 608023c79..89ec69f06 100644 --- a/scheme-libs/racket/unison-runtime.rkt +++ b/scheme-libs/racket/unison-runtime.rkt @@ -54,7 +54,7 @@ (let ([bs (grab-bytes)]) (match (builtin-Value.deserialize (bytes->chunked-bytes bs)) [(unison-data _ t (list q)) - (= t unison-either-right:tag) + (= t ref-either-right:tag) (apply values (unison-tuple->list (reify-value (unison-quote-val q))))] @@ -67,7 +67,7 @@ (define (do-evaluate) (let-values ([(code main-ref) (decode-input)]) (add-runtime-code 'unison-main code) - (handle [unison-exception:typelink] top-exn-handler + (handle [ref-exception:typelink] top-exn-handler ((termlink->proc main-ref)) (data 'unit 0)))) diff --git a/scheme-libs/racket/unison/boot.ss b/scheme-libs/racket/unison/boot.ss index 4a778e310..8da74927a 100644 --- a/scheme-libs/racket/unison/boot.ss +++ b/scheme-libs/racket/unison/boot.ss @@ -13,38 +13,39 @@ #!racket/base (provide (all-from-out unison/data-info) - unison-any:typelink - unison-boolean:typelink - unison-bytes:typelink - unison-char:typelink - unison-float:typelink - unison-int:typelink - unison-nat:typelink - unison-text:typelink - unison-code:typelink - unison-mvar:typelink - unison-pattern:typelink - unison-promise:typelink - unison-sequence:typelink - unison-socket:typelink - unison-tls:typelink - unison-timespec:typelink - unison-threadid:typelink + builtin-any:typelink + builtin-boolean:typelink + builtin-bytes:typelink + builtin-char:typelink + builtin-float:typelink + builtin-int:typelink + builtin-nat:typelink + builtin-text:typelink + builtin-code:typelink + builtin-mvar:typelink + builtin-pattern:typelink + builtin-promise:typelink + builtin-sequence:typelink + builtin-socket:typelink + builtin-tls:typelink + builtin-timespec:typelink + builtin-threadid:typelink + builtin-value:typelink - unison-crypto.hashalgorithm:typelink - unison-char.class:typelink - unison-immutablearray:typelink - unison-immutablebytearray:typelink - unison-mutablearray:typelink - unison-mutablebytearray:typelink - unison-processhandle:typelink - unison-ref.ticket:typelink - unison-tls.cipher:typelink - unison-tls.clientconfig:typelink - unison-tls.privatekey:typelink - unison-tls.serverconfig:typelink - unison-tls.signedcert:typelink - unison-tls.version:typelink + builtin-crypto.hashalgorithm:typelink + builtin-char.class:typelink + builtin-immutablearray:typelink + builtin-immutablebytearray:typelink + builtin-mutablearray:typelink + builtin-mutablebytearray:typelink + builtin-processhandle:typelink + builtin-ref.ticket:typelink + builtin-tls.cipher:typelink + builtin-tls.clientconfig:typelink + builtin-tls.privatekey:typelink + builtin-tls.serverconfig:typelink + builtin-tls.signedcert:typelink + builtin-tls.version:typelink bytevector bytes @@ -495,60 +496,57 @@ (define (reference->termlink rf) (match rf [(unison-data _ t (list nm)) - #:when (= t unison-reference-builtin:tag) + #:when (= t ref-reference-builtin:tag) (unison-termlink-builtin (chunked-string->string nm))] [(unison-data _ t (list id)) - #:when (= t unison-reference-derived:tag) + #:when (= t ref-reference-derived:tag) (match id [(unison-data _ t (list rf i)) - #:when (= t unison-id-id:tag) + #:when (= t ref-id-id:tag) (unison-termlink-derived rf i)])])) (define (referent->termlink rn) (match rn [(unison-data _ t (list rf i)) - #:when (= t unison-referent-con:tag) + #:when (= t ref-referent-con:tag) (unison-termlink-con (reference->typelink rf) i)] [(unison-data _ t (list rf)) - #:when (= t unison-referent-def:tag) + #:when (= t ref-referent-def:tag) (reference->termlink rf)])) (define (reference->typelink rf) (match rf [(unison-data _ t (list nm)) - #:when (= t unison-reference-builtin:tag) + #:when (= t ref-reference-builtin:tag) (unison-typelink-builtin (chunked-string->string nm))] [(unison-data _ t (list id)) - #:when (= t unison-reference-derived:tag) + #:when (= t ref-reference-derived:tag) (match id [(unison-data _ t (list rf i)) - #:when (= t unison-id-id:tag) + #:when (= t ref-id-id:tag) (unison-typelink-derived rf i)])])) (define (typelink->reference tl) (match tl [(unison-typelink-builtin nm) - (unison-reference-builtin (string->chunked-string nm))] + (ref-reference-builtin (string->chunked-string nm))] [(unison-typelink-derived hs i) - (unison-reference-derived - (unison-id-id hs i))])) + (ref-reference-derived (ref-id-id hs i))])) (define (termlink->referent tl) (match tl [(unison-termlink-builtin nm) - (unison-referent-def - (unison-reference-builtin nm))] + (ref-referent-def + (ref-reference-builtin nm))] [(unison-termlink-derived rf i) - (unison-referent-def - (unison-reference-derived - (unison-id-id rf i)))] + (ref-referent-def + (ref-reference-derived + (ref-id-id rf i)))] [(unison-termlink-con tyl i) - (unison-referent-con - (typelink->reference tyl) - i)])) + (ref-referent-con (typelink->reference tyl) i)])) (define (list->unison-tuple l) - (foldr unison-tuple-pair unison-unit-unit l)) + (foldr ref-tuple-pair ref-unit-unit l)) (define (unison-tuple . l) (list->unison-tuple l)) @@ -564,13 +562,13 @@ [pure (x) (match x [(unison-data r 0 (list)) - (eq? r unison-unit:typelink) + (eq? r ref-unit:typelink) (display "")] [else (display (describe-value x))])] - [unison-exception:typelink + [ref-exception:typelink [0 (f) - (control unison-exception:typelink k + (control ref-exception:typelink k (let ([disp (describe-value f)]) (raise (make-exn:bug "builtin.bug" disp))))]])) diff --git a/scheme-libs/racket/unison/concurrent.ss b/scheme-libs/racket/unison/concurrent.ss index 5ebabde48..0f85aa035 100644 --- a/scheme-libs/racket/unison/concurrent.ss +++ b/scheme-libs/racket/unison/concurrent.ss @@ -112,31 +112,31 @@ ([exn:break? (lambda (e) (exception - unison-threadkilledfailure:typelink + ref-threadkilledfailure:typelink (string->chunked-string "thread killed") - ()))] + ref-unit-unit))] [exn:io? (lambda (e) (exception - unison-iofailure:typelink - (exception->string e) ()))] + ref-iofailure:typelink + (exception->string e) ref-unit-unit))] [exn:arith? (lambda (e) (exception - unison-arithfailure:typelink + ref-arithfailure:typelink (exception->string e) - ()))] + ref-unit-unit))] [exn:bug? (lambda (e) (exn:bug->exception e))] [exn:fail? (lambda (e) (exception - unison-runtimefailure:typelink + ref-runtimefailure:typelink (exception->string e) - ()))] + ref-unit-unit))] [(lambda (x) #t) (lambda (e) (exception - unison-miscfailure:typelink + ref-miscfailure:typelink (string->chunked-string "unknown exception") - e))]) + ref-unit-unit))]) (right (thunk))))) diff --git a/scheme-libs/racket/unison/core.ss b/scheme-libs/racket/unison/core.ss index bb3d270f1..e0bf83088 100644 --- a/scheme-libs/racket/unison/core.ss +++ b/scheme-libs/racket/unison/core.ss @@ -385,6 +385,6 @@ #:constructor-name make-exn:bug) (define (exn:bug->exception b) (exception - unison-runtimefailure:typelink + ref-runtimefailure:typelink (exn:bug-msg b) (exn:bug-a b))) diff --git a/scheme-libs/racket/unison/data.ss b/scheme-libs/racket/unison/data.ss index beb72696a..116cf1c90 100644 --- a/scheme-libs/racket/unison/data.ss +++ b/scheme-libs/racket/unison/data.ss @@ -53,47 +53,47 @@ failure exception - unison-any:typelink + builtin-any:typelink unison-any-any:tag unison-any-any - unison-boolean:typelink + builtin-boolean:typelink unison-boolean-true:tag unison-boolean-false:tag unison-boolean-true unison-boolean-false - unison-bytes:typelink - unison-char:typelink - unison-float:typelink - unison-int:typelink - unison-nat:typelink - unison-text:typelink - unison-code:typelink - unison-mvar:typelink - unison-pattern:typelink - unison-promise:typelink - unison-sequence:typelink - unison-socket:typelink - unison-tls:typelink - unison-timespec:typelink - unison-threadid:typelink - ; unison-value:typelink + builtin-bytes:typelink + builtin-char:typelink + builtin-float:typelink + builtin-int:typelink + builtin-nat:typelink + builtin-text:typelink + builtin-code:typelink + builtin-mvar:typelink + builtin-pattern:typelink + builtin-promise:typelink + builtin-sequence:typelink + builtin-socket:typelink + builtin-tls:typelink + builtin-timespec:typelink + builtin-threadid:typelink + builtin-value:typelink - unison-crypto.hashalgorithm:typelink - unison-char.class:typelink - unison-immutablearray:typelink - unison-immutablebytearray:typelink - unison-mutablearray:typelink - unison-mutablebytearray:typelink - unison-processhandle:typelink - unison-ref.ticket:typelink - unison-tls.cipher:typelink - unison-tls.clientconfig:typelink - unison-tls.privatekey:typelink - unison-tls.serverconfig:typelink - unison-tls.signedcert:typelink - unison-tls.version:typelink + builtin-crypto.hashalgorithm:typelink + builtin-char.class:typelink + builtin-immutablearray:typelink + builtin-immutablebytearray:typelink + builtin-mutablearray:typelink + builtin-mutablebytearray:typelink + builtin-processhandle:typelink + builtin-ref.ticket:typelink + builtin-tls.cipher:typelink + builtin-tls.clientconfig:typelink + builtin-tls.privatekey:typelink + builtin-tls.serverconfig:typelink + builtin-tls.signedcert:typelink + builtin-tls.version:typelink unison-tuple->list) @@ -332,63 +332,63 @@ (define (either-get either) (car (unison-sum-fields either))) ; a -> Any -(define unison-any:typelink (unison-typelink-builtin "Any")) +(define builtin-any:typelink (unison-typelink-builtin "Any")) (define unison-any-any:tag 0) (define (unison-any-any x) - (data unison-any:typelink unison-any-any:tag x)) + (data builtin-any:typelink unison-any-any:tag x)) -(define unison-boolean:typelink (unison-typelink-builtin "Boolean")) +(define builtin-boolean:typelink (unison-typelink-builtin "Boolean")) (define unison-boolean-true:tag 1) (define unison-boolean-false:tag 0) (define unison-boolean-true - (data unison-boolean:typelink unison-boolean-true:tag)) + (data builtin-boolean:typelink unison-boolean-true:tag)) (define unison-boolean-false - (data unison-boolean:typelink unison-boolean-false:tag)) + (data builtin-boolean:typelink unison-boolean-false:tag)) -(define unison-bytes:typelink (unison-typelink-builtin "Bytes")) -(define unison-char:typelink (unison-typelink-builtin "Char")) -(define unison-code:typelink (unison-typelink-builtin "Code")) -(define unison-float:typelink (unison-typelink-builtin "Float")) -(define unison-int:typelink (unison-typelink-builtin "Int")) -(define unison-mvar:typelink (unison-typelink-builtin "MVar")) -(define unison-nat:typelink (unison-typelink-builtin "Nat")) -(define unison-pattern:typelink (unison-typelink-builtin "Pattern")) -(define unison-promise:typelink (unison-typelink-builtin "Promise")) -(define unison-sequence:typelink (unison-typelink-builtin "Sequence")) -(define unison-socket:typelink (unison-typelink-builtin "Socket")) -(define unison-text:typelink (unison-typelink-builtin "Text")) -(define unison-tls:typelink (unison-typelink-builtin "Tls")) -(define unison-timespec:typelink (unison-typelink-builtin "TimeSpec")) -(define unison-threadid:typelink (unison-typelink-builtin "ThreadId")) -; (define unison-value:typelink (unison-typelink-builtin "Value")) +(define builtin-bytes:typelink (unison-typelink-builtin "Bytes")) +(define builtin-char:typelink (unison-typelink-builtin "Char")) +(define builtin-code:typelink (unison-typelink-builtin "Code")) +(define builtin-float:typelink (unison-typelink-builtin "Float")) +(define builtin-int:typelink (unison-typelink-builtin "Int")) +(define builtin-mvar:typelink (unison-typelink-builtin "MVar")) +(define builtin-nat:typelink (unison-typelink-builtin "Nat")) +(define builtin-pattern:typelink (unison-typelink-builtin "Pattern")) +(define builtin-promise:typelink (unison-typelink-builtin "Promise")) +(define builtin-sequence:typelink (unison-typelink-builtin "Sequence")) +(define builtin-socket:typelink (unison-typelink-builtin "Socket")) +(define builtin-text:typelink (unison-typelink-builtin "Text")) +(define builtin-tls:typelink (unison-typelink-builtin "Tls")) +(define builtin-timespec:typelink (unison-typelink-builtin "TimeSpec")) +(define builtin-threadid:typelink (unison-typelink-builtin "ThreadId")) +(define builtin-value:typelink (unison-typelink-builtin "Value")) -(define unison-crypto.hashalgorithm:typelink +(define builtin-crypto.hashalgorithm:typelink (unison-typelink-builtin "crypto.HashAlgorithm")) -(define unison-char.class:typelink +(define builtin-char.class:typelink (unison-typelink-builtin "Char.Class")) -(define unison-immutablearray:typelink +(define builtin-immutablearray:typelink (unison-typelink-builtin "ImmutableArray")) -(define unison-immutablebytearray:typelink +(define builtin-immutablebytearray:typelink (unison-typelink-builtin "ImmutableByteArray")) -(define unison-mutablearray:typelink +(define builtin-mutablearray:typelink (unison-typelink-builtin "MutableArray")) -(define unison-mutablebytearray:typelink +(define builtin-mutablebytearray:typelink (unison-typelink-builtin "MutableArray")) -(define unison-processhandle:typelink +(define builtin-processhandle:typelink (unison-typelink-builtin "ProcessHandle")) -(define unison-ref.ticket:typelink +(define builtin-ref.ticket:typelink (unison-typelink-builtin "Ref.Ticket")) -(define unison-tls.cipher:typelink +(define builtin-tls.cipher:typelink (unison-typelink-builtin "Tls.Cipher")) -(define unison-tls.clientconfig:typelink +(define builtin-tls.clientconfig:typelink (unison-typelink-builtin "Tls.ClientConfig")) -(define unison-tls.privatekey:typelink +(define builtin-tls.privatekey:typelink (unison-typelink-builtin "Tls.PrivateKey")) -(define unison-tls.serverconfig:typelink +(define builtin-tls.serverconfig:typelink (unison-typelink-builtin "Tls.ServerConfig")) -(define unison-tls.signedcert:typelink +(define builtin-tls.signedcert:typelink (unison-typelink-builtin "Tls.SignedCert")) -(define unison-tls.version:typelink +(define builtin-tls.version:typelink (unison-typelink-builtin "Tls.Version")) ; Type -> Text -> Any -> Failure diff --git a/scheme-libs/racket/unison/io-handles.rkt b/scheme-libs/racket/unison/io-handles.rkt index 80a0518e6..0967ee094 100644 --- a/scheme-libs/racket/unison/io-handles.rkt +++ b/scheme-libs/racket/unison/io-handles.rkt @@ -43,87 +43,103 @@ ; typeLink msg any (define (Exception typeLink message payload) - (let* ([x7 (unison-any-any payload)] - [x8 (unison-failure-failure typeLink message x7)]) - (unison-either-left x8))) + (let* ([a (unison-any-any payload)] + [msg (string->chunked-string message)] + [f (ref-failure-failure typeLink msg a)]) + (ref-either-left f))) (define-unison (isFileOpen.impl.v3 port) - (unison-either-right (not (port-closed? port)))) + (ref-either-right (not (port-closed? port)))) (define-unison (ready.impl.v1 port) (if (byte-ready? port) - (unison-either-right #t) + (ref-either-right #t) (if (port-eof? port) - (Exception unison-iofailure:typelink "EOF" port) - (unison-either-right #f)))) + (Exception ref-iofailure:typelink "EOF" port) + (ref-either-right #f)))) (define-unison (getCurrentDirectory.impl.v3 unit) - (unison-either-right + (ref-either-right (string->chunked-string (path->string (current-directory))))) (define-unison (isSeekable.impl.v3 handle) - (unison-either-right + (ref-either-right (port-has-set-port-position!? handle))) (define-unison (handlePosition.impl.v3 handle) - (unison-either-right (port-position handle))) + (ref-either-right (port-position handle))) (define-unison (seekHandle.impl.v3 handle mode amount) (data-case mode (0 () (set-port-position! handle amount) - (unison-either-right none)) + (ref-either-right none)) (1 () (let ([current (port-position handle)]) (set-port-position! handle (+ current amount)) - (unison-either-right none))) + (ref-either-right none))) (2 () - (Exception unison-iofailure:typelink "SeekFromEnd not supported" 0)))) + (Exception + ref-iofailure:typelink + "SeekFromEnd not supported" + 0)))) (define-unison (getLine.impl.v1 handle) (let* ([line (read-line handle)]) (if (eof-object? line) - (unison-either-right (string->chunked-string "")) - (unison-either-right (string->chunked-string line)) + (ref-either-right (string->chunked-string "")) + (ref-either-right (string->chunked-string line)) ))) (define-unison (getChar.impl.v1 handle) (let* ([char (read-char handle)]) (if (eof-object? char) - (Exception unison-iofailure:typelink "End of file reached") - (unison-either-right char)))) + (Exception + ref-iofailure:typelink + "End of file reached" + ref-unit-unit) + (ref-either-right char)))) (define-unison (getSomeBytes.impl.v1 handle bytes) (let* ([buffer (make-bytes bytes)] [line (read-bytes-avail! buffer handle)]) (if (eof-object? line) - (unison-either-right (bytes->chunked-bytes #"")) - (unison-either-right (bytes->chunked-bytes buffer)) + (ref-either-right (bytes->chunked-bytes #"")) + (ref-either-right (bytes->chunked-bytes buffer)) ))) (define-unison (getBuffering.impl.v3 handle) (case (file-stream-buffer-mode handle) - [(none) (unison-either-right unison-buffermode-no-buffering)] - [(line) (unison-either-right - unison-buffermode-line-buffering)] - [(block) (unison-either-right - unison-buffermode-block-buffering)] - [(#f) (Exception unison-iofailure:typelink "Unable to determine buffering mode of handle" '())] - [else (Exception unison-iofailure:typelink "Unexpected response from file-stream-buffer-mode" '())])) + [(none) (ref-either-right ref-buffermode-no-buffering)] + [(line) (ref-either-right + ref-buffermode-line-buffering)] + [(block) (ref-either-right + ref-buffermode-block-buffering)] + [(#f) (Exception + ref-iofailure:typelink + "Unable to determine buffering mode of handle" + ref-unit-unit)] + [else (Exception + ref-iofailure:typelink + "Unexpected response from file-stream-buffer-mode" + ref-unit-unit)])) (define-unison (setBuffering.impl.v3 handle mode) (data-case mode (0 () (file-stream-buffer-mode handle 'none) - (unison-either-right none)) + (ref-either-right none)) (1 () (file-stream-buffer-mode handle 'line) - (unison-either-right none)) + (ref-either-right none)) (2 () (file-stream-buffer-mode handle 'block) - (unison-either-right none)) + (ref-either-right none)) (3 (size) - (Exception unison-iofailure:typelink "Sized block buffering not supported" '())))) + (Exception + ref-iofailure:typelink + "Sized block buffering not supported" + ref-unit-unit)))) (define (with-buffer-mode port mode) (file-stream-buffer-mode port mode) @@ -141,8 +157,11 @@ (define-unison (getEcho.impl.v1 handle) (if (eq? handle stdin) - (unison-either-right (get-stdin-echo)) - (Exception unison-iofailure:typelink "getEcho only supported on stdin" '()))) + (ref-either-right (get-stdin-echo)) + (Exception + ref-iofailure:typelink + "getEcho only supported on stdin" + ref-unit-unit))) (define-unison (setEcho.impl.v1 handle echo) (if (eq? handle stdin) @@ -150,23 +169,29 @@ (if echo (system "stty echo") (system "stty -echo")) - (unison-either-right none)) - (Exception unison-iofailure:typelink "setEcho only supported on stdin" '()))) + (ref-either-right none)) + (Exception + ref-iofailure:typelink + "setEcho only supported on stdin" + ref-unit-unit))) (define (get-stdin-echo) (let ([current (with-output-to-string (lambda () (system "stty -a")))]) (string-contains? current " echo "))) (define-unison (getArgs.impl.v1 unit) - (unison-either-right + (ref-either-right (vector->chunked-list (vector-map string->chunked-string (current-command-line-arguments))))) (define-unison (getEnv.impl.v1 key) (let ([value (environment-variables-ref (current-environment-variables) (string->bytes/utf-8 (chunked-string->string key)))]) (if (false? value) - (Exception unison-iofailure:typelink "environmental variable not found" key) - (unison-either-right + (Exception + ref-iofailure:typelink + "environmental variable not found" + key) + (ref-either-right (string->chunked-string (bytes->string/utf-8 value)))))) ;; From https://github.com/sorawee/shlex/blob/5de06500e8c831cfc8dffb99d57a76decc02c569/main.rkt (MIT License) diff --git a/scheme-libs/racket/unison/io.rkt b/scheme-libs/racket/unison/io.rkt index 84e9bc505..6bdfa7f3e 100644 --- a/scheme-libs/racket/unison/io.rkt +++ b/scheme-libs/racket/unison/io.rkt @@ -46,20 +46,26 @@ (with-handlers [[exn:fail:filesystem? (lambda (e) - (exception unison-iofailure:typelink (exception->string e) '()))]] + (exception + ref-iofailure:typelink + (exception->string e) + ref-unit-unit))]] (right (file-size (chunked-string->string path))))) (define (getFileTimestamp.impl.v3 path) (with-handlers [[exn:fail:filesystem? (lambda (e) - (exception unison-iofailure:typelink (exception->string e) '()))]] + (exception + ref-iofailure:typelink + (exception->string e) + ref-unit-unit))]] (right (file-or-directory-modify-seconds (chunked-string->string path))))) ; in haskell, it's not just file but also directory (define-unison (fileExists.impl.v3 path) (let ([path-string (chunked-string->string path)]) - (unison-either-right + (ref-either-right (or (file-exists? path-string) (directory-exists? path-string))))) @@ -73,10 +79,10 @@ (define-unison (setCurrentDirectory.impl.v3 path) (current-directory (chunked-string->string path)) - (unison-either-right none)) + (ref-either-right none)) (define-unison (createTempDirectory.impl.v3 prefix) - (unison-either-right + (ref-either-right (string->chunked-string (path->string (make-temporary-directory* @@ -85,31 +91,31 @@ (define-unison (createDirectory.impl.v3 file) (make-directory (chunked-string->string file)) - (unison-either-right none)) + (ref-either-right none)) (define-unison (removeDirectory.impl.v3 file) (delete-directory/files (chunked-string->string file)) - (unison-either-right none)) + (ref-either-right none)) (define-unison (isDirectory.impl.v3 path) - (unison-either-right + (ref-either-right (directory-exists? (chunked-string->string path)))) (define-unison (renameDirectory.impl.v3 old new) (rename-file-or-directory (chunked-string->string old) (chunked-string->string new)) - (unison-either-right none)) + (ref-either-right none)) (define-unison (renameFile.impl.v3 old new) (rename-file-or-directory (chunked-string->string old) (chunked-string->string new)) - (unison-either-right none)) + (ref-either-right none)) (define-unison (systemTime.impl.v3 unit) - (unison-either-right (current-seconds))) + (ref-either-right (current-seconds))) (define-unison (systemTimeMicroseconds.impl.v3 unit) - (unison-either-right (inexact->exact (* 1000 (current-inexact-milliseconds))))) + (ref-either-right (inexact->exact (* 1000 (current-inexact-milliseconds))))) (define (threadCPUTime.v1) (right (current-process-milliseconds (current-thread)))) diff --git a/scheme-libs/racket/unison/primops-generated.rkt b/scheme-libs/racket/unison/primops-generated.rkt index 86159e7ab..0c7df03e4 100644 --- a/scheme-libs/racket/unison/primops-generated.rkt +++ b/scheme-libs/racket/unison/primops-generated.rkt @@ -83,10 +83,10 @@ (define (decode-term tm) (match tm [(unison-data _ t (list tms)) - #:when (= t unison-schemeterm-sexpr:tag) + #:when (= t ref-schemeterm-sexpr:tag) (map decode-term (chunked-list->list tms))] [(unison-data _ t (list as h tms)) - #:when (= t unison-schemeterm-handle:tag) + #:when (= t ref-schemeterm-handle:tag) `(handle ,(map (lambda (tx) (text->linkname tx)) @@ -94,27 +94,27 @@ ,(text->ident h) ,@(map decode-term (chunked-list->list tms)))] [(unison-data _ t (list hd sc cs)) - #:when (= t unison-schemeterm-cases:tag) + #:when (= t ref-schemeterm-cases:tag) (assemble-cases (text->ident hd) (decode-term sc) (map decode-term (chunked-list->list cs)))] [(unison-data _ t (list hd bs bd)) - #:when (= t unison-schemeterm-binds:tag) + #:when (= t ref-schemeterm-binds:tag) `(,(text->ident hd) ,(map decode-binding (chunked-list->list bs)) ,(decode-term bd))] [(unison-data _ t (list tx)) - #:when (= t unison-schemeterm-ident:tag) + #:when (= t ref-schemeterm-ident:tag) (text->ident tx)] [(unison-data _ t (list tx)) - #:when (= t unison-schemeterm-string:tag) + #:when (= t ref-schemeterm-string:tag) (chunked-string->string tx)] [(unison-data _ t (list tx)) - #:when (= t unison-schemeterm-symbol:tag) + #:when (= t ref-schemeterm-symbol:tag) `(quote ,(text->ident tx))] [(unison-data _ t (list ns)) - #:when (= t unison-schemeterm-bytevec:tag) + #:when (= t ref-schemeterm-bytevec:tag) (list->bytes (chunked-list->list ns))] [else (raise (format "decode-term: unimplemented case: ~a" tm))])) @@ -131,13 +131,13 @@ (define (decode-syntax dfn) (match dfn [(unison-data _ t (list nm vs bd)) - #:when (= t unison-schemedefn-define:tag) + #: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))] [(unison-data _ t (list nm bd)) - #:when (= t unison-schemedefn-alias:tag) + #:when (= t ref-schemedefn-alias:tag) (list 'define (text->ident nm) (decode-term bd))] [else (raise (format "decode-syntax: unimplemented case: ~a" dfn))])) @@ -167,10 +167,10 @@ (define (decode-ref rf) (match rf [(unison-data r t (list name)) - #:when (= t unison-reference-builtin:tag) + #:when (= t ref-reference-builtin:tag) (sum 0 (chunked-string->string name))] [(unison-data r t (list id)) - #:when (= t unison-reference-derived:tag) + #:when (= t ref-reference-derived:tag) (data-case id [0 (bs i) (sum 1 bs i)])])) @@ -200,7 +200,7 @@ [(_) #`(lambda (gr) (data-case (group-ref-ident gr) - [#,unison-schemeterm-ident:tag (name) name] + [#,ref-schemeterm-ident:tag (name) name] [else (raise (format @@ -242,10 +242,10 @@ (define (termlink->reference rn) (match rn [(unison-termlink-builtin name) - (unison-reference-builtin + (ref-reference-builtin (string->chunked-string name))] [(unison-termlink-derived bs i) - (unison-reference-derived (unison-id-id bs i))] + (ref-reference-derived (ref-id-id bs i))] [else (raise "termlink->reference: con case")])) (define (group-reference gr) @@ -260,19 +260,19 @@ (define runtime-module-map (make-hash)) (define (reflect-derived bs i) - (data unison-reference:typelink unison-reference-derived:tag - (data unison-id:typelink unison-id-id:tag bs i))) + (data ref-reference:typelink ref-reference-derived:tag + (data ref-id:typelink ref-id-id:tag bs i))) (define (function->groupref f) (match (lookup-function-link f) [(unison-termlink-derived h i) - (unison-groupref-group - (unison-reference-derived - (unison-id-id h i)) + (ref-groupref-group + (ref-reference-derived + (ref-id-id h i)) 0)] [(unison-termlink-builtin name) - (unison-groupref-group - (unison-reference-builtin (string->chunked-string name)) + (ref-groupref-group + (ref-reference-builtin (string->chunked-string name)) 0)] [else (raise "function->groupref: con case")])) @@ -280,19 +280,19 @@ (match vl [(unison-data _ t (list l)) (cond - [(= t unison-vlit-bytes:tag) l] - [(= t unison-vlit-char:tag) l] - [(= t unison-vlit-bytearray:tag) l] - [(= t unison-vlit-text:tag) l] - [(= t unison-vlit-termlink:tag) (referent->termlink l)] - [(= t unison-vlit-typelink:tag) (reference->typelink l)] - [(= t unison-vlit-float:tag) l] - [(= t unison-vlit-pos:tag) l] - [(= t unison-vlit-neg:tag) (- l)] - [(= t unison-vlit-quote:tag) (unison-quote l)] - [(= t unison-vlit-code:tag) (unison-code l)] - [(= t unison-vlit-array:tag) (vector-map reify-value l)] - [(= t unison-vlit-seq:tag) + [(= t ref-vlit-bytes:tag) l] + [(= t ref-vlit-char:tag) l] + [(= t ref-vlit-bytearray:tag) l] + [(= t ref-vlit-text:tag) l] + [(= t ref-vlit-termlink:tag) (referent->termlink l)] + [(= t ref-vlit-typelink:tag) (reference->typelink l)] + [(= t ref-vlit-float:tag) l] + [(= t ref-vlit-pos:tag) l] + [(= t ref-vlit-neg:tag) (- l)] + [(= t ref-vlit-quote:tag) (unison-quote l)] + [(= t ref-vlit-code:tag) (unison-code l)] + [(= t ref-vlit-array:tag) (vector-map reify-value l)] + [(= t ref-vlit-seq:tag) ; TODO: better map over chunked list (vector->chunked-list (vector-map reify-value (chunked-list->vector l)))] @@ -302,19 +302,19 @@ (define (reify-value v) (match v [(unison-data _ t (list rf rt bs0)) - #:when (= t unison-value-data:tag) + #:when (= t ref-value-data:tag) (let ([bs (map reify-value (chunked-list->list bs0))]) (make-data (reference->typelink rf) rt bs))] [(unison-data _ t (list gr bs0)) - #:when (= t unison-value-partial:tag) + #:when (= t ref-value-partial:tag) (let ([bs (map reify-value (chunked-list->list bs0))] [proc (resolve-proc gr)]) (apply proc bs))] [(unison-data _ t (list vl)) - #:when (= t unison-value-vlit:tag) + #:when (= t ref-value-vlit:tag) (reify-vlit vl)] [(unison-data _ t (list bs0 k)) - #:when (= t unison-value-cont:tag) + #:when (= t ref-value-cont:tag) (raise "reify-value: unimplemented cont case")] [(unison-data r t fs) (raise "reify-value: unimplemented data case")] @@ -324,75 +324,75 @@ (define (reflect-typelink tl) (match tl [(unison-typelink-builtin name) - (unison-reference-builtin + (ref-reference-builtin (string->chunked-string name))] [(unison-typelink-derived h i) - (unison-reference-derived (unison-id-id h i))])) + (ref-reference-derived (ref-id-id h i))])) (define (reflect-termlink tl) (match tl [(unison-termlink-con r i) - (unison-referent-con (reflect-typelink r) i)] + (ref-referent-con (reflect-typelink r) i)] [(unison-termlink-builtin name) - (unison-referent-def - (unison-reference-builtin + (ref-referent-def + (ref-reference-builtin (string->chunked-string name)))] [(unison-termlink-derived h i) - (unison-referent-def - (unison-reference-derived - (unison-id-id h i)))])) + (ref-referent-def + (ref-reference-derived + (ref-id-id h i)))])) (define (number-reference n) (cond [(exact-nonnegative-integer? n) - (unison-reference-builtin (string->chunked-string "Nat"))] + (ref-reference-builtin (string->chunked-string "Nat"))] [(exact-integer? n) - (unison-reference-builtin (string->chunked-string "Int"))] + (ref-reference-builtin (string->chunked-string "Int"))] [else - (unison-reference-builtin (string->chunked-string "Float"))])) + (ref-reference-builtin (string->chunked-string "Float"))])) (define (reflect-value v) (match v [(? exact-nonnegative-integer?) - (unison-value-vlit (unison-vlit-pos v))] + (ref-value-vlit (ref-vlit-pos v))] [(? exact-integer?) - (unison-value-vlit (unison-vlit-neg (- v)))] + (ref-value-vlit (ref-vlit-neg (- v)))] [(? inexact-real?) - (unison-value-vlit (unison-vlit-float v))] + (ref-value-vlit (ref-vlit-float v))] [(? char?) - (unison-value-vlit (unison-vlit-char v))] + (ref-value-vlit (ref-vlit-char v))] [(? chunked-bytes?) - (unison-value-vlit (unison-vlit-bytes v))] + (ref-value-vlit (ref-vlit-bytes v))] [(? bytes?) - (unison-value-vlit (unison-vlit-bytearray v))] + (ref-value-vlit (ref-vlit-bytearray v))] [(? vector?) - (unison-value-vlit - (unison-vlit-array + (ref-value-vlit + (ref-vlit-array (vector-map reflect-value v)))] [(? chunked-string?) - (unison-value-vlit (unison-vlit-text v))] + (ref-value-vlit (ref-vlit-text v))] ; TODO: better map over chunked lists [(? chunked-list?) - (unison-value-vlit - (unison-vlit-seq + (ref-value-vlit + (ref-vlit-seq (list->chunked-list (map reflect-value (chunked-list->list v)))))] [(? unison-termlink?) - (unison-value-vlit (unison-vlit-termlink (reflect-termlink v)))] + (ref-value-vlit (ref-vlit-termlink (reflect-termlink v)))] [(? unison-typelink?) - (unison-value-vlit (unison-vlit-typelink (reflect-typelink v)))] - [(unison-code sg) (unison-value-vlit (unison-vlit-code sg))] - [(unison-quote q) (unison-value-vlit (unison-vlit-quote q))] + (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-value-partial + (ref-value-partial (function->groupref f) (list->chunked-list (map reflect-value as)))] [(? procedure?) - (unison-value-partial + (ref-value-partial (function->groupref v) empty-chunked-list)] [(unison-data rf t fs) - (unison-value-data + (ref-value-data (reflect-typelink rf) t (list->chunked-list (map reflect-value fs)))])) @@ -428,8 +428,8 @@ #:result (if (null? unkn) - (unison-either-right (list->chunked-list sdbx)) - (unison-either-left (list->chunked-list unkn)))) + (ref-either-right (list->chunked-list sdbx)) + (ref-either-left (list->chunked-list unkn)))) ([r (in-chunked-list (value-term-dependencies v))]) @@ -593,7 +593,7 @@ ,@sdefs - (handle [unison-exception:typelink] top-exn-handler + (handle [ref-exception:typelink] top-exn-handler (,pname #f))))) (define (build-runtime-module mname tylinks tmlinks defs) @@ -655,7 +655,9 @@ (add-module-associations tmlinks mname) (add-runtime-module mname tylinks tmlinks sdefs) #f)] - [else (list->chunked-list rdeps)]))] + [else + (list->chunked-list + (map reference->termlink rdeps))]))] [else #f]))) (define (unison-POp-CACH dfns0) @@ -671,14 +673,16 @@ [fdeps (filter need-dependency? (chunked-list->list deps))]) (if (null? fdeps) (sum 1 (reify-value val)) - (sum 0 (list->chunked-list fdeps))))) + (sum 0 + (list->chunked-list + (map reference->termlink fdeps)))))) (define (unison-POp-LKUP tl) (lookup-code tl)) (define-unison (builtin-Code.lookup tl) (match (lookup-code tl) - [(unison-sum 0 (list)) unison-optional-none] - [(unison-sum 1 (list co)) (unison-optional-some co)])) + [(unison-sum 0 (list)) ref-optional-none] + [(unison-sum 1 (list co)) (ref-optional-some co)])) (define-unison (builtin-validateSandboxed ok v) (let ([l (sandbox-scheme-value (chunked-list->list ok) v)]) diff --git a/scheme-libs/racket/unison/primops.ss b/scheme-libs/racket/unison/primops.ss index 7698cbed1..080fe6ae3 100644 --- a/scheme-libs/racket/unison/primops.ss +++ b/scheme-libs/racket/unison/primops.ss @@ -24,13 +24,6 @@ #!r6rs (library (unison primops) (export - builtin-Any:typelink - builtin-Char:typelink - builtin-Float:typelink - builtin-Int:typelink - builtin-Nat:typelink - builtin-Text:typelink - builtin-Float.* builtin-Float.*:termlink builtin-Float.>= @@ -645,13 +638,6 @@ (unison concurrent) (racket random)) - (define builtin-Any:typelink unison-any:typelink) - (define builtin-Char:typelink unison-char:typelink) - (define builtin-Float:typelink unison-float:typelink) - (define builtin-Int:typelink unison-int:typelink) - (define builtin-Nat:typelink unison-nat:typelink) - (define builtin-Text:typelink unison-text:typelink) - (define-builtin-link Float.*) (define-builtin-link Float.fromRepresentation) (define-builtin-link Float.toRepresentation) @@ -780,13 +766,13 @@ (define-unison (builtin-List.splitLeft n s) (match (unison-POp-SPLL n s) - [(unison-sum 0 fs) unison-seqview-empty] - [(unison-sum 1 (list l r)) (unison-seqview-elem l r)])) + [(unison-sum 0 fs) ref-seqview-empty] + [(unison-sum 1 (list l r)) (ref-seqview-elem l r)])) (define-unison (builtin-List.splitRight n s) (match (unison-POp-SPLR n s) - [(unison-sum 0 fs) unison-seqview-empty] - [(unison-sum 1 (list l r)) (unison-seqview-elem l r)])) + [(unison-sum 0 fs) ref-seqview-empty] + [(unison-sum 1 (list l r)) (ref-seqview-elem l r)])) (define-unison (builtin-Float.> x y) (fl> x y)) (define-unison (builtin-Float.< x y) (fl< x y)) @@ -896,7 +882,7 @@ (define (reify-exn thunk) (guard (e [else - (sum 0 '() (exception->string e) e)]) + (sum 0 '() (exception->string e) ref-unit-unit)]) (thunk))) ; Core implemented primops, upon which primops-in-unison can be built. @@ -977,8 +963,8 @@ (define (->optional v) (if v - (unison-optional-some v) - unison-optional-none)) + (ref-optional-some v) + ref-optional-none)) (define-unison (builtin-Text.indexOf n h) (->optional (chunked-string-index-of h n))) @@ -1130,7 +1116,7 @@ ([exn:fail:contract? (lambda (e) (exception - unison-iofailure:typelink + ref-iofailure:typelink (string->chunked-string (string-append "Invalid UTF-8 stream: " @@ -1143,7 +1129,7 @@ (bytes->chunked-bytes (string->bytes/utf-8 (chunked-string->string s)))) (define-unison (builtin-IO.isFileEOF.impl.v3 p) - (unison-either-right (port-eof? p))) + (ref-either-right (port-eof? p))) (define (unison-FOp-IO.closeFile.impl.v3 h) (if (input-port? h) diff --git a/scheme-libs/racket/unison/tcp.rkt b/scheme-libs/racket/unison/tcp.rkt index 870854a34..19a20ff38 100644 --- a/scheme-libs/racket/unison/tcp.rkt +++ b/scheme-libs/racket/unison/tcp.rkt @@ -30,21 +30,22 @@ [[exn:fail:network? (lambda (e) (exception - unison-iofailure:typelink - (exception->string e) '()))] + ref-iofailure:typelink + (exception->string e) + ref-unit-unit))] [exn:fail:contract? (lambda (e) (exception - unison-miscfailure:typelink + ref-miscfailure:typelink (exception->string e) - '()))] + ref-unit-unit))] [(lambda _ #t) (lambda (e) (exception - unison-miscfailure:typelink + ref-miscfailure:typelink (chunked-string->string (format "Unknown exception ~a" (exn->string e))) - e))]] + ref-unit-unit))]] (fn))) (define (closeSocket.impl.v3 socket) @@ -66,9 +67,9 @@ (define (socketSend.impl.v3 socket data) ; socket bytes -> () (if (not (socket-pair? socket)) (exception - unison-iofailure:typelink - "Cannot send on a server socket" - '()) + ref-iofailure:typelink + (string->chunked-string "Cannot send on a server socket") + ref-unit-unit) (begin (write-bytes (chunked-bytes->bytes data) (socket-pair-output socket)) (flush-output (socket-pair-output socket)) @@ -77,8 +78,8 @@ (define (socketReceive.impl.v3 socket amt) ; socket int -> bytes (if (not (socket-pair? socket)) (exception - unison-iofailure:typelink - "Cannot receive on a server socket") + ref-iofailure:typelink + (string->chunked-string "Cannot receive on a server socket")) (handle-errors (lambda () (begin @@ -106,20 +107,21 @@ [[exn:fail:network? (lambda (e) (exception - unison-iofailure:typelink - (exception->string e) '()))] + ref-iofailure:typelink + (exception->string e) + ref-unit-unit))] [exn:fail:contract? (lambda (e) (exception - unison-iofailure:typelink + ref-iofailure:typelink (exception->string e) - '()))] + ref-unit-unit))] [(lambda _ #t) (lambda (e) (exception - unison-miscfailure:typelink + ref-miscfailure:typelink (string->chunked-string "Unknown exception") - e))] ] + ref-unit-unit))] ] (let ([listener (tcp-listen (string->number port ) 4 #f (if (equal? 0 hostname) #f hostname))]) (right listener)))))) @@ -135,9 +137,9 @@ (define (socketAccept.impl.v3 listener) (if (socket-pair? listener) (exception - unison-iofailure:typelink + ref-iofailure:typelink (string->chunked-string "Cannot accept on a non-server socket") - '()) + ref-unit-unit) (begin (let-values ([(input output) (tcp-accept listener)]) (right (socket-pair input output)))))) diff --git a/scheme-libs/racket/unison/tls.rkt b/scheme-libs/racket/unison/tls.rkt index 390940d21..136bb52d4 100644 --- a/scheme-libs/racket/unison/tls.rkt +++ b/scheme-libs/racket/unison/tls.rkt @@ -63,8 +63,9 @@ (if (= 1 (length certs)) (right bytes) (exception - unison-tlsfailure:typelink - (string->chunked-string "nope") certs)))) ; TODO passing certs is wrong, should either be converted to chunked-list or removed + ref-tlsfailure:typelink + (string->chunked-string "nope") + bytes)))) ; We don't actually "decode" certificates, we just validate them (define (encodeCert bytes) bytes) @@ -119,35 +120,36 @@ [[exn:fail:network? (lambda (e) (exception - unison-iofailure:typelink - (exception->string e) '()))] + ref-iofailure:typelink + (exception->string e) + ref-unit-unit))] [exn:fail:contract? (lambda (e) (exception - unison-miscfailure:typelink + ref-miscfailure:typelink (exception->string e) - '()))] + ref-unit-unit))] [(lambda err (string-contains? (exn->string err) "not valid for hostname")) (lambda (e) (exception - unison-tlsfailure:typelink + ref-tlsfailure:typelink (string->chunked-string "NameMismatch") - '()))] + ref-unit-unit))] [(lambda err (string-contains? (exn->string err) "certificate verify failed")) (lambda (e) (exception - unison-tlsfailure:typelink + ref-tlsfailure:typelink (string->chunked-string "certificate verify failed") - '()))] + ref-unit-unit))] [(lambda _ #t) (lambda (e) (exception - unison-miscfailure:typelink + ref-miscfailure:typelink (string->chunked-string (format "Unknown exception ~a" (exn->string e))) - e))]] + ref-unit-unit))]] (fn))) (define (newClient.impl.v3 config socket) diff --git a/scheme-libs/racket/unison/zlib.rkt b/scheme-libs/racket/unison/zlib.rkt index 4d7e032dd..a3f716ae3 100644 --- a/scheme-libs/racket/unison/zlib.rkt +++ b/scheme-libs/racket/unison/zlib.rkt @@ -110,7 +110,7 @@ [[exn:fail? (lambda (e) (exception - unison-miscfailure:typelink + ref-miscfailure:typelink (exception->string e) '()))]] (right diff --git a/unison-src/transcripts-manual/gen-racket-libs.md b/unison-src/transcripts-manual/gen-racket-libs.md index 63c368068..e918f1882 100644 --- a/unison-src/transcripts-manual/gen-racket-libs.md +++ b/unison-src/transcripts-manual/gen-racket-libs.md @@ -5,7 +5,7 @@ Next, we'll download the jit project and generate a few Racket files from it. ```ucm .> project.create-empty jit-setup -jit-setup/main> pull @unison/internal/releases/0.0.12 lib.jit +jit-setup/main> pull @unison/internal/releases/0.0.13 lib.jit ``` ```unison diff --git a/unison-src/transcripts-manual/gen-racket-libs.output.md b/unison-src/transcripts-manual/gen-racket-libs.output.md index 1df36af30..59a3a1c52 100644 --- a/unison-src/transcripts-manual/gen-racket-libs.output.md +++ b/unison-src/transcripts-manual/gen-racket-libs.output.md @@ -20,9 +20,9 @@ Next, we'll download the jit project and generate a few Racket files from it. 🎉 🥳 Happy coding! -jit-setup/main> pull @unison/internal/releases/0.0.12 lib.jit +jit-setup/main> pull @unison/internal/releases/0.0.13 lib.jit - Downloaded 15048 entities. + Downloaded 15053 entities. ✅ From e617995b64e73bd9b53855510f781b7af1429939 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 22 Mar 2024 11:20:32 -0600 Subject: [PATCH 008/124] move stack actions to dedicated repo --- .../actions/install-stack/action.yaml | 42 -------- .../actions/restore-stack-cache/action.yaml | 100 ------------------ .../actions/save-stack-cache/action.yaml | 73 ------------- .github/workflows/build-optimized-ucm.yaml | 6 +- .github/workflows/ci.yaml | 6 +- .github/workflows/haddocks.yaml | 6 +- .github/workflows/update-transcripts.yaml | 2 +- 7 files changed, 10 insertions(+), 225 deletions(-) delete mode 100644 .github/workflows/actions/install-stack/action.yaml delete mode 100644 .github/workflows/actions/restore-stack-cache/action.yaml delete mode 100644 .github/workflows/actions/save-stack-cache/action.yaml diff --git a/.github/workflows/actions/install-stack/action.yaml b/.github/workflows/actions/install-stack/action.yaml deleted file mode 100644 index f3796fa0b..000000000 --- a/.github/workflows/actions/install-stack/action.yaml +++ /dev/null @@ -1,42 +0,0 @@ -# Reference: -# https://docs.github.com/en/actions/creating-actions/creating-a-composite-action - -name: "Install Stack" -description: "Install stack for Linux, macOS, and Windows" - -inputs: - stack-version: - description: "The version of stack to install, e.g. 2.9.1" - required: true - default: "2.9.1" - -runs: - using: "composite" - steps: - - name: install stack - shell: bash - working-directory: ${{ runner.temp }} - run: | - if [[ ${{runner.os}} = 'Windows' ]]; then - stack_os="windows" - elif [[ ${{runner.os}} = 'macOS' ]]; then - stack_os="osx" - elif [[ ${{runner.os}} = 'Linux' ]]; then - stack_os="linux" - else - echo "Unsupported OS: ${{runner.os}}" - exit 1 - fi - if [[ ${{runner.arch}} = 'X64' ]]; then - stack_arch="x86_64" - elif [[ ${{runner.arch}} = 'ARM64' ]]; then - stack_arch="aarch64" - else - echo "Unsupported architecture: ${{runner.arch}}" - exit 1 - fi - - mkdir stack && cd stack - curl -L https://github.com/commercialhaskell/stack/releases/download/v${{inputs.stack-version}}/stack-${{inputs.stack-version}}-${stack_os}-${stack_arch}.tar.gz | tar -xz - echo "$PWD/stack-"* >> $GITHUB_PATH - echo "stack_path=$PWD/stack-"* >> $GITHUB_ENV diff --git a/.github/workflows/actions/restore-stack-cache/action.yaml b/.github/workflows/actions/restore-stack-cache/action.yaml deleted file mode 100644 index 563b0c3fd..000000000 --- a/.github/workflows/actions/restore-stack-cache/action.yaml +++ /dev/null @@ -1,100 +0,0 @@ -name: restore stack cache -description: restore ~/.stack and .stack-work caches on Linux, macOS, and Windows - -inputs: - cache-prefix: - description: The cache prefix to use for `~/.stack`, e.g. "release" or "ci" - required: true - work-cache-prefix: - description: The cache prefix to use for `**/.stack-work`, defaults to the same as `cache-prefix` - required: false - stack-yaml-dir: - description: The directory to search for `stack.yaml` - required: false - default: '.' - lookup-only: - description: If true, only checks if cache entry exists and skips download. - required: false - default: 'false' - -outputs: - cache-hit: - description: Whether the .stack cache was restored with an exact match - value: ${{ steps.cache-stack-unix.outputs.cache-hit || steps.cache-stack-windows.outputs.cache-hit }} - work-cache-hit: - description: Whether the .stack-work cache was restored with an exact match - value: ${{ steps.cache-stack-work.outputs.cache-hit }} - -runs: - using: composite - steps: - - name: set default work cache prefix - shell: bash - run: | - if [ -z "${{inputs.work-cache-prefix}}" ]; then - echo "work-cache-prefix=${{inputs.cache-prefix}}" >> "$GITHUB_ENV" - else - echo "work-cache-prefix=${{inputs.work-cache-prefix}}" >> "$GITHUB_ENV" - fi - - # The number towards the beginning of the cache keys allow you to manually avoid using a previous cache. - # GitHub will automatically delete caches that haven't been accessed in 7 days, but there is no way to - # purge one manually. - - id: stackage-resolver - name: record stackage resolver - shell: bash - # https://docs.github.com/en/actions/using-workflows/workflow-commands-for-github-actions#environment-files - # looks for `resolver: nightly-yyyy-mm-dd` or `resolver: lts-xx.yy` in `stack.yaml` and splits it into - # `nightly` or `lts-xx`. the whole resolver string is put into $resolver as a backup cache key - # ${{ env.resolver_short }} - # ${{ env.resolver }} - run: | - grep resolver ${{inputs.stack-yaml-dir}}/stack.yaml | awk '{ x="resolver_short="; if (split($2,a,"-") > 2) print x a[1]; else {split($2,b,"."); print x b[1]}}' >> "$GITHUB_ENV" - grep resolver ${{inputs.stack-yaml-dir}}/stack.yaml | awk '{print "resolver="$2}' >> "$GITHUB_ENV" - - - name: restore ~/.stack (non-Windows) - uses: actions/cache/restore@v4 - id: cache-stack-unix - if: runner.os != 'Windows' - with: - lookup-only: ${{inputs.lookup-only}} - path: ~/.stack - key: - ${{inputs.cache-prefix}}-stack-${{runner.os}}_${{env.resolver}}-${{hashFiles('**/stack.yaml', '**/package.yaml')}} - restore-keys: - ${{inputs.cache-prefix}}-stack-${{runner.os}}_${{env.resolver}}- - - - name: restore ~/.stack (Windows) - uses: actions/cache/restore@v4 - id: cache-stack-windows - if: runner.os == 'Windows' - with: - lookup-only: ${{inputs.lookup-only}} - path: | - C:\Users\runneradmin\AppData\Roaming\stack - C:\Users\runneradmin\AppData\Local\Programs\stack - key: - ${{inputs.cache-prefix}}-stack-${{runner.os}}_${{env.resolver}}-${{hashFiles('**/stack.yaml', '**/package.yaml')}} - restore-keys: - ${{inputs.cache-prefix}}-stack-${{runner.os}}_${{env.resolver}}- - - - name: restore .stack-work - uses: actions/cache/restore@v4 - id: cache-stack-work - with: - lookup-only: ${{inputs.lookup-only}} - path: | - **/.stack-work - key: - ${{env.work-cache-prefix}}-stack-work-${{runner.os}}_${{env.resolver}}-${{hashFiles('**/stack.yaml', '**/package.yaml')}}-${{hashFiles('**/*.hs')}} - restore-keys: | - ${{env.work-cache-prefix}}-stack-work-${{runner.os}}_${{env.resolver}}-${{hashFiles('**/stack.yaml', '**/package.yaml')}}- - ${{env.work-cache-prefix}}-stack-work-${{runner.os}}_${{env.resolver}}- - ${{env.work-cache-prefix}}-stack-work-${{runner.os}}_ - - # we added this step out of necessity, don't exactly remember why. - # hope to remove it someday. - - name: remove ~/.stack/setup-exe-cache on macOS - if: runner.os == 'macOS' - shell: bash - run: rm -rf ~/.stack/setup-exe-cache diff --git a/.github/workflows/actions/save-stack-cache/action.yaml b/.github/workflows/actions/save-stack-cache/action.yaml deleted file mode 100644 index 7411caf34..000000000 --- a/.github/workflows/actions/save-stack-cache/action.yaml +++ /dev/null @@ -1,73 +0,0 @@ -name: save stack cache -description: save ~/.stack and .stack-work caches on Linux, macOS, and Windows - -inputs: - cache-prefix: - description: The cache prefix to use for `~/.stack`, e.g. "release" or "ci" - required: true - work-cache-prefix: - description: The cache prefix to use for `**/.stack-work`, defaults to the same as `cache-prefix` - required: false - stack-yaml-dir: - description: The directory to search for `stack.yaml` - required: false - default: '.' - -runs: - using: composite - steps: - - name: set default work cache prefix - shell: bash - run: | - if [ -z "${{inputs.work-cache-prefix}}" ]; then - echo "work-cache-prefix=${{inputs.cache-prefix}}" >> "$GITHUB_ENV" - else - echo "work-cache-prefix=${{inputs.work-cache-prefix}}" >> "$GITHUB_ENV" - fi - - - name: check stack caches - id: check-stack - uses: ./.github/workflows/actions/restore-stack-cache - with: - cache-prefix: ${{inputs.cache-prefix}} - work-cache-prefix: ${{env.work-cache-prefix}} - stack-yaml-dir: ${{inputs.stack-yaml-dir}} - lookup-only: true - - # The number towards the beginning of the cache keys allow you to manually avoid using a previous cache. - # GitHub will automatically delete caches that haven't been accessed in 7 days, but there is no way to - # purge one manually. - - name: record stackage resolver - shell: bash - # https://docs.github.com/en/actions/using-workflows/workflow-commands-for-github-actions#environment-files - # looks for `resolver: nightly-yyyy-mm-dd` or `resolver: lts-xx.yy` in `stack.yaml` and splits it into - # `nightly` or `lts-xx`. the whole resolver string is put into $resolver as a backup cache key - # ${{ env.resolver_short }} - # ${{ env.resolver }} - run: | - grep resolver ${{inputs.stack-yaml-dir}}/stack.yaml | awk '{ x="resolver_short="; if (split($2,a,"-") > 2) print x a[1]; else {split($2,b,"."); print x b[1]}}' >> "$GITHUB_ENV" - grep resolver ${{inputs.stack-yaml-dir}}/stack.yaml | awk '{print "resolver="$2}' >> "$GITHUB_ENV" - - - name: save ~/.stack (non-Windows) - if: runner.os != 'Windows' && steps.check-stack.outputs.cache-hit != 'true' - uses: actions/cache/save@v4 - with: - path: ~/.stack - key: ${{inputs.cache-prefix}}-stack-${{runner.os}}_${{env.resolver}}-${{hashFiles('**/stack.yaml', '**/package.yaml')}} - - - name: save ~/.stack (Windows) - if: runner.os == 'Windows' && steps.check-stack.outputs.cache-hit != 'true' - uses: actions/cache/save@v4 - with: - path: | - C:\Users\runneradmin\AppData\Roaming\stack - C:\Users\runneradmin\AppData\Local\Programs\stack - key: ${{inputs.cache-prefix}}-stack-${{runner.os}}_${{env.resolver}}-${{hashFiles('**/stack.yaml', '**/package.yaml')}} - - - name: save .stack-work - if: steps.check-stack.outputs.work-cache-hit != 'true' - uses: actions/cache/save@v4 - with: - path: | - **/.stack-work - key: ${{env.work-cache-prefix}}-stack-work-${{runner.os}}_${{env.resolver}}-${{hashFiles('**/stack.yaml', '**/package.yaml')}}-${{hashFiles('**/*.hs')}} diff --git a/.github/workflows/build-optimized-ucm.yaml b/.github/workflows/build-optimized-ucm.yaml index 88514d91d..c0776efb0 100644 --- a/.github/workflows/build-optimized-ucm.yaml +++ b/.github/workflows/build-optimized-ucm.yaml @@ -28,12 +28,12 @@ jobs: ref: ${{inputs.ref}} - name: restore stack caches - uses: ./.github/workflows/actions/restore-stack-cache + uses: unisonweb/actions/stack/cache/restore with: cache-prefix: release - name: install stack - uses: ./.github/workflows/actions/install-stack + uses: unisonweb/actions/stack/install - name: build run: | @@ -50,7 +50,7 @@ jobs: done - name: save stack caches - uses: ./.github/workflows/actions/save-stack-cache + uses: unisonweb/actions/stack/cache/save with: cache-prefix: release diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index 6de72f2da..d4fd14871 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -117,13 +117,13 @@ jobs: - name: restore stack caches if: steps.cache-ucm-binaries.outputs.cache-hit != 'true' id: restore-stack-caches - uses: ./.github/workflows/actions/restore-stack-cache + uses: unisonweb/actions/stack/cache/restore with: cache-prefix: ci${{env.stack-cache-key-version}} - name: install stack if: steps.cache-ucm-binaries.outputs.cache-hit != 'true' - uses: ./.github/workflows/actions/install-stack + uses: unisonweb/actions/stack/install # One of the transcripts fails if the user's git name hasn't been set. ## (Which transcript? -AI) @@ -261,7 +261,7 @@ jobs: !cancelled() && steps.restore-stack-caches.outputs.cache-hit != 'true' && steps.cache-ucm-binaries.outputs.cache-hit != 'true' - uses: ./.github/workflows/actions/save-stack-cache + uses: unisonweb/actions/stack/cache/save with: cache-prefix: ci${{env.stack-cache-key-version}} diff --git a/.github/workflows/haddocks.yaml b/.github/workflows/haddocks.yaml index 6b5826791..92dab27f0 100644 --- a/.github/workflows/haddocks.yaml +++ b/.github/workflows/haddocks.yaml @@ -20,20 +20,20 @@ jobs: path: unison - name: restore stack caches - uses: ./.github/workflows/actions/restore-stack-cache + uses: unisonweb/actions/stack/cache/restore with: cache-prefix: haddocks stack-yaml-dir: unison - name: install stack - uses: ./unison/.github/workflows/actions/install-stack + uses: unisonweb/actions/stack/install - name: build with haddocks working-directory: unison run: stack build --fast --haddock - name: save stack caches - uses: ./.github/workflows/actions/save-stack-cache + uses: unisonweb/actions/stack/cache/save with: cache-prefix: haddocks stack-yaml-dir: unison diff --git a/.github/workflows/update-transcripts.yaml b/.github/workflows/update-transcripts.yaml index 02f9e3690..0fdc414b7 100644 --- a/.github/workflows/update-transcripts.yaml +++ b/.github/workflows/update-transcripts.yaml @@ -61,7 +61,7 @@ jobs: stack-work-4_${{matrix.os}}- - name: install stack - uses: ./.github/workflows/actions/install-stack + uses: unisonweb/actions/stack/install # One of the transcripts fails if the user's git name hasn't been set. - name: set git user info From d4cff550a5197eaf1278e2709bb6f31b6f30c414 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 22 Mar 2024 11:24:41 -0600 Subject: [PATCH 009/124] a ref is needed on a remote action --- .github/workflows/build-optimized-ucm.yaml | 6 +++--- .github/workflows/ci.yaml | 6 +++--- .github/workflows/haddocks.yaml | 6 +++--- .github/workflows/update-transcripts.yaml | 2 +- 4 files changed, 10 insertions(+), 10 deletions(-) diff --git a/.github/workflows/build-optimized-ucm.yaml b/.github/workflows/build-optimized-ucm.yaml index c0776efb0..745319139 100644 --- a/.github/workflows/build-optimized-ucm.yaml +++ b/.github/workflows/build-optimized-ucm.yaml @@ -28,12 +28,12 @@ jobs: ref: ${{inputs.ref}} - name: restore stack caches - uses: unisonweb/actions/stack/cache/restore + uses: unisonweb/actions/stack/cache/restore@main with: cache-prefix: release - name: install stack - uses: unisonweb/actions/stack/install + uses: unisonweb/actions/stack/install@main - name: build run: | @@ -50,7 +50,7 @@ jobs: done - name: save stack caches - uses: unisonweb/actions/stack/cache/save + uses: unisonweb/actions/stack/cache/save@main with: cache-prefix: release diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index d4fd14871..b401c6b39 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -117,13 +117,13 @@ jobs: - name: restore stack caches if: steps.cache-ucm-binaries.outputs.cache-hit != 'true' id: restore-stack-caches - uses: unisonweb/actions/stack/cache/restore + uses: unisonweb/actions/stack/cache/restore@main with: cache-prefix: ci${{env.stack-cache-key-version}} - name: install stack if: steps.cache-ucm-binaries.outputs.cache-hit != 'true' - uses: unisonweb/actions/stack/install + uses: unisonweb/actions/stack/install@main # One of the transcripts fails if the user's git name hasn't been set. ## (Which transcript? -AI) @@ -261,7 +261,7 @@ jobs: !cancelled() && steps.restore-stack-caches.outputs.cache-hit != 'true' && steps.cache-ucm-binaries.outputs.cache-hit != 'true' - uses: unisonweb/actions/stack/cache/save + uses: unisonweb/actions/stack/cache/save@main with: cache-prefix: ci${{env.stack-cache-key-version}} diff --git a/.github/workflows/haddocks.yaml b/.github/workflows/haddocks.yaml index 92dab27f0..35a1c15fe 100644 --- a/.github/workflows/haddocks.yaml +++ b/.github/workflows/haddocks.yaml @@ -20,20 +20,20 @@ jobs: path: unison - name: restore stack caches - uses: unisonweb/actions/stack/cache/restore + uses: unisonweb/actions/stack/cache/restore@main with: cache-prefix: haddocks stack-yaml-dir: unison - name: install stack - uses: unisonweb/actions/stack/install + uses: unisonweb/actions/stack/install@main - name: build with haddocks working-directory: unison run: stack build --fast --haddock - name: save stack caches - uses: unisonweb/actions/stack/cache/save + uses: unisonweb/actions/stack/cache/save@main with: cache-prefix: haddocks stack-yaml-dir: unison diff --git a/.github/workflows/update-transcripts.yaml b/.github/workflows/update-transcripts.yaml index 0fdc414b7..b659a4657 100644 --- a/.github/workflows/update-transcripts.yaml +++ b/.github/workflows/update-transcripts.yaml @@ -61,7 +61,7 @@ jobs: stack-work-4_${{matrix.os}}- - name: install stack - uses: unisonweb/actions/stack/install + uses: unisonweb/actions/stack/install@main # One of the transcripts fails if the user's git name hasn't been set. - name: set git user info From 1dc66840c25a0a58e09140ab763445aed7e5223f Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Fri, 22 Mar 2024 15:31:13 -0400 Subject: [PATCH 010/124] Neglected to update ci.yaml for jit --- .github/workflows/ci.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index 5353bddaa..0778001df 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -21,7 +21,7 @@ env: ormolu_version: "0.5.2.0" racket_version: "8.7" ucm_local_bin: "ucm-local-bin" - jit_version: "@unison/internal/releases/0.0.12" + jit_version: "@unison/internal/releases/0.0.13" jit_src_scheme: "unison-jit-src/scheme-libs/racket" jit_dist: "unison-jit-dist" jit_generator_os: ubuntu-20.04 From d981ed20101b17c4c16569f8f6fd444ad8f407c2 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 22 Mar 2024 14:06:49 -0600 Subject: [PATCH 011/124] tweak some workflows --- .github/workflows/build-optimized-ucm.yaml | 2 + .github/workflows/pre-release.yaml | 4 +- .github/workflows/update-transcripts.yaml | 45 +--------------------- 3 files changed, 7 insertions(+), 44 deletions(-) diff --git a/.github/workflows/build-optimized-ucm.yaml b/.github/workflows/build-optimized-ucm.yaml index 745319139..00f4016f3 100644 --- a/.github/workflows/build-optimized-ucm.yaml +++ b/.github/workflows/build-optimized-ucm.yaml @@ -1,3 +1,5 @@ +name: build optimized ucm + on: workflow_call: inputs: diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index c5ca77957..e3d713c7c 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -1,4 +1,4 @@ -name: "pre-release" +name: pre-release defaults: run: @@ -10,6 +10,8 @@ on: branches: [ trunk ] types: - completed + workflow_dispatch: + jobs: build-ucm: uses: ./.github/workflows/build-optimized-ucm.yaml diff --git a/.github/workflows/update-transcripts.yaml b/.github/workflows/update-transcripts.yaml index b659a4657..441833f51 100644 --- a/.github/workflows/update-transcripts.yaml +++ b/.github/workflows/update-transcripts.yaml @@ -15,50 +15,9 @@ jobs: - macOS-12 steps: - uses: actions/checkout@v4 - - id: stackage-resolver - name: record stackage resolver - # https://docs.github.com/en/actions/using-workflows/workflow-commands-for-github-actions#environment-files - # looks for `resolver: nightly-yyyy-mm-dd` or `resolver: lts-xx.yy` in `stack.yaml` and splits it into - # `nightly` or `lts-xx`. the whole resolver string is put into resolver_long as a backup cache key - # ${{ steps.stackage-resolver.outputs.resolver_short }} - # ${{ steps.stackage-resolver.outputs.resolver_long }} - run: | - grep resolver stack.yaml | awk '{ x="resolver_short="; if (split($2,a,"-") > 2) print x a[1]; else {split($2,b,"."); print x b[1]}}' >> "$GITHUB_OUTPUT" - grep resolver stack.yaml | awk '{print "resolver_long="$2}' >> "$GITHUB_OUTPUT" - # Cache ~/.stack, keyed by the contents of 'stack.yaml'. - - uses: actions/cache@v3 - name: cache ~/.stack (unix) - if: runner.os != 'Windows' + - uses: unisonweb/actions/stack/cache/restore@main with: - path: ~/.stack - key: stack-1_${{matrix.os}}-${{ steps.stackage-resolver.outputs.resolver_long }}-${{hashFiles('**/stack.yaml')}}-${{github.sha}} - # Fall-back to use the most recent cache for the stack.yaml, or failing that the OS - restore-keys: | - stack-1_${{matrix.os}}-${{ steps.stackage-resolver.outputs.resolver_long }}-${{hashFiles('**/stack.yaml')}}- - stack-1_${{matrix.os}}-${{ steps.stackage-resolver.outputs.resolver_long }}- - stack-1_${{matrix.os}}-${{ steps.stackage-resolver.outputs.resolver_short }}- - stack-1_${{matrix.os}}-${{ steps.stackage-resolver.outputs.resolver_short }}. - stack-1_${{matrix.os}}- - - # Cache each local package's ~/.stack-work for fast incremental builds in CI. - - uses: actions/cache@v3 - name: cache .stack-work - with: - path: | - **/.stack-work - # Main cache key: commit hash. This should always result in a cache miss... - # So when loading a cache we'll always fall back to the restore-keys, - # which should load the most recent cache via a prefix search on the most - # recent branch cache. - # Then it will save a new cache at this commit sha, which should be used by - # the next build on this branch. - key: stack-work-4_${{matrix.os}}-${{ steps.stackage-resolver.outputs.resolver_short }}-${{hashFiles('**/stack.yaml')}}-${{github.sha}} - restore-keys: | - stack-work-4_${{matrix.os}}-${{ steps.stackage-resolver.outputs.resolver_long }}-${{hashFiles('**/stack.yaml')}}- - stack-work-4_${{matrix.os}}-${{ steps.stackage-resolver.outputs.resolver_long }}- - stack-work-4_${{matrix.os}}-${{ steps.stackage-resolver.outputs.resolver_short }}- - stack-work-4_${{matrix.os}}-${{ steps.stackage-resolver.outputs.resolver_short }}. - stack-work-4_${{matrix.os}}- + cache-prefix: ci1 - name: install stack uses: unisonweb/actions/stack/install@main From fe2a355702408462bc05bfa90fa2c95347404d7a Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 22 Mar 2024 14:11:03 -0600 Subject: [PATCH 012/124] delete the cache key versions, not worth the space --- .github/workflows/ci.md | 9 -------- .github/workflows/ci.yaml | 25 ++++++++--------------- .github/workflows/update-transcripts.yaml | 2 +- 3 files changed, 9 insertions(+), 27 deletions(-) diff --git a/.github/workflows/ci.md b/.github/workflows/ci.md index 009c6f690..5a0e659f0 100644 --- a/.github/workflows/ci.md +++ b/.github/workflows/ci.md @@ -24,15 +24,6 @@ Some cached directories: `jit_generator_os: ubuntu-20.04` - afaik, the jit sources are generated in a platform-independent way, so we just choose one platform to generate them on. -`*-cache-key-version` — increment one of these to invalidate its corresponding cache, though you shouldn't have to: - - `ucm-binaries` - - `unison-src-test-results` - - `stack` - - `stack-work` - - `base-codebase` - - `jit-src` - - `jit-dist` - ### Cached directories: One reason for this change is to reduce the CI time for commits that only change docs, or yaml or other uninteresting things. diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index b401c6b39..4e067f580 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -30,15 +30,6 @@ env: # refers to all tests that depend on **/unison-src/** unison_src_test_results: "unison-src-test-results" - # cache key versions, increment to invalidate one, though you aren't expected to have to. - ucm-binaries-cache-key-version: 1 - unison-src-test-results-cache-key-version: 1 - stack-cache-key-version: 1 - stack-work-cache-key-version: 1 - base-codebase-cache-key-version: 1 - jit-src-cache-key-version: 1 - jit-dist-cache-key-version: 1 - jobs: ormolu: runs-on: ubuntu-20.04 @@ -105,21 +96,21 @@ jobs: uses: actions/cache@v4 with: path: ${{env.ucm_local_bin}} - key: ucm-${{env.ucm-binaries-cache-key-version}}_${{ matrix.os }}-${{ hashFiles('**/stack.yaml', '**/package.yaml', '**/*.hs')}} + key: ucm-${{ matrix.os }}-${{ hashFiles('**/stack.yaml', '**/package.yaml', '**/*.hs')}} - name: cache unison-src test results id: cache-unison-src-test-results uses: actions/cache@v4 with: path: ${{env.unison_src_test_results}} - key: unison-src-test-results-${{env.unison-src-test-results-cache-key-version}}_${{ matrix.os }}-${{ hashFiles('**/ci.yaml', '**/stack.yaml', '**/package.yaml', '**/*.hs')}}-${{ hashFiles('**/unison-src/**') }} + key: unison-src-test-results-${{ matrix.os }}-${{ hashFiles('**/ci.yaml', '**/stack.yaml', '**/package.yaml', '**/*.hs')}}-${{ hashFiles('**/unison-src/**') }} - name: restore stack caches if: steps.cache-ucm-binaries.outputs.cache-hit != 'true' id: restore-stack-caches uses: unisonweb/actions/stack/cache/restore@main with: - cache-prefix: ci${{env.stack-cache-key-version}} + cache-prefix: ci - name: install stack if: steps.cache-ucm-binaries.outputs.cache-hit != 'true' @@ -227,7 +218,7 @@ jobs: with: path: ${{ env.base-codebase }} # key = base transcript contents + sqlite schema version - key: base.unison-${{env.base-codebase-cache-key-version}}_${{hashFiles('**/unison-src/builtin-tests/base.md', '**/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs')}}. + key: base.unison-${{hashFiles('**/unison-src/builtin-tests/base.md', '**/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs')}}. - name: create base.md codebase if: steps.cache-base-codebase.outputs.cache-hit != 'true' @@ -263,7 +254,7 @@ jobs: && steps.cache-ucm-binaries.outputs.cache-hit != 'true' uses: unisonweb/actions/stack/cache/save@main with: - cache-prefix: ci${{env.stack-cache-key-version}} + cache-prefix: ci generate-jit-source: if: always() && needs.build-ucm.result == 'success' @@ -280,7 +271,7 @@ jobs: if: runner.os == 'Linux' with: path: ${{ env.jit_src_scheme }} - key: jit_src_scheme-${{env.jit-src-cache-key-version}}.racket_${{env.racket_version}}.jit_${{env.jit_version}} + key: jit_src_scheme-racket_${{env.racket_version}}.jit_${{env.jit_version}} - name: check source exists id: jit_src_exists @@ -396,7 +387,7 @@ jobs: uses: actions/cache@v4 with: path: ${{ env.jit_dist }} - key: jit_dist-${{env.jit-dist-cache-key-version}}.racket_${{ env.racket_version }}.jit_${{ env.jit_version }} + key: jit_dist-racket_${{ env.racket_version }}.jit_${{ env.jit_version }} - name: Cache Racket dependencies if: steps.restore-jit-binaries.outputs.cache-hit != 'true' @@ -460,7 +451,7 @@ jobs: uses: actions/cache/restore@v4 with: path: ${{ env.base-codebase}} - key: base.unison-${{env.base-codebase-cache-key-version}}_${{hashFiles('**/unison-src/builtin-tests/base.md', '**/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs')}}. + key: base.unison-${{hashFiles('**/unison-src/builtin-tests/base.md', '**/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs')}}. - name: jit integration test ${{ matrix.os }} if: runner.os != 'Windows' && steps.restore-jit-binaries.outputs.cache-hit != 'true' diff --git a/.github/workflows/update-transcripts.yaml b/.github/workflows/update-transcripts.yaml index 441833f51..129fbdcac 100644 --- a/.github/workflows/update-transcripts.yaml +++ b/.github/workflows/update-transcripts.yaml @@ -17,7 +17,7 @@ jobs: - uses: actions/checkout@v4 - uses: unisonweb/actions/stack/cache/restore@main with: - cache-prefix: ci1 + cache-prefix: ci - name: install stack uses: unisonweb/actions/stack/install@main From 423ecb16c1a8813ee2af61ffe4c279e41c1f6d2d Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 22 Mar 2024 14:15:30 -0600 Subject: [PATCH 013/124] temporarily always save stack caches, to test --- .github/workflows/ci.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index 4e067f580..0e7c82959 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -250,8 +250,8 @@ jobs: - name: save stack caches if: | !cancelled() - && steps.restore-stack-caches.outputs.cache-hit != 'true' - && steps.cache-ucm-binaries.outputs.cache-hit != 'true' + # && steps.restore-stack-caches.outputs.cache-hit != 'true' + # && steps.cache-ucm-binaries.outputs.cache-hit != 'true' uses: unisonweb/actions/stack/cache/save@main with: cache-prefix: ci From 5d113af5df8b95ce889aa9b41eba05909cb004b9 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 22 Mar 2024 14:17:19 -0600 Subject: [PATCH 014/124] didn't need to do that after changing the cache keys --- .github/workflows/ci.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index 0e7c82959..4e067f580 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -250,8 +250,8 @@ jobs: - name: save stack caches if: | !cancelled() - # && steps.restore-stack-caches.outputs.cache-hit != 'true' - # && steps.cache-ucm-binaries.outputs.cache-hit != 'true' + && steps.restore-stack-caches.outputs.cache-hit != 'true' + && steps.cache-ucm-binaries.outputs.cache-hit != 'true' uses: unisonweb/actions/stack/cache/save@main with: cache-prefix: ci From 046d8f28adb1ba7e170c7b606159f4569849e7bc Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 22 Mar 2024 15:27:38 -0600 Subject: [PATCH 015/124] comment --- .github/workflows/update-transcripts.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/update-transcripts.yaml b/.github/workflows/update-transcripts.yaml index 129fbdcac..47de04dc8 100644 --- a/.github/workflows/update-transcripts.yaml +++ b/.github/workflows/update-transcripts.yaml @@ -17,6 +17,7 @@ jobs: - uses: actions/checkout@v4 - uses: unisonweb/actions/stack/cache/restore@main with: + # take cache from the ci job, read-only cache-prefix: ci - name: install stack From 57a838095d60acc3a64de84bffd6297c7ad69c9d Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 22 Mar 2024 15:29:05 -0600 Subject: [PATCH 016/124] re-generate scheme source if `scheme-libs/` has changed --- .github/workflows/ci.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index 738231072..9b9439f7d 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -268,13 +268,13 @@ jobs: echo "ucm=${{ runner.temp }}/unison" >> $GITHUB_ENV - uses: actions/cache@v4 name: cache jit source - if: runner.os == 'Linux' with: path: ${{ env.jit_src_scheme }} - key: jit_src_scheme-racket_${{env.racket_version}}.jit_${{env.jit_version}} + key: jit_src_scheme-racket_${{env.racket_version}}.jit_${{env.jit_version}}-${{hashFiles('**/scheme-libs/**')}} - name: check source exists id: jit_src_exists + if: steps.cache-jit-source.outputs.cache-hit != 'true' run: | files=(data-info boot-generated simple-wrappers builtin-generated compound-wrappers) all_exist=true From 86cf0dd22a0d60ab679eb530882f77df5a483154 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Fri, 22 Mar 2024 17:33:22 -0400 Subject: [PATCH 017/124] Fix a bug in the jit's runtime code caching operation It was written with the wrong calling convention --- scheme-libs/racket/unison/primops-generated.rkt | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/scheme-libs/racket/unison/primops-generated.rkt b/scheme-libs/racket/unison/primops-generated.rkt index 0c7df03e4..ae7c184fb 100644 --- a/scheme-libs/racket/unison/primops-generated.rkt +++ b/scheme-libs/racket/unison/primops-generated.rkt @@ -646,25 +646,22 @@ [fdeps (filter need-dependency? deps)] [rdeps (remove* refs fdeps)]) (cond - [(null? fdeps) #f] + [(null? fdeps) empty-chunked-list] [(null? rdeps) - (let ([ndefs (map gen-code udefs)] [sdefs (flatten (map gen-code udefs))] + (let ([ndefs (map gen-code udefs)] + [sdefs (flatten (map gen-code udefs))] [mname (or mname0 (generate-module-name tmlinks))]) (expand-sandbox tmlinks (map-links depss)) (register-code udefs) (add-module-associations tmlinks mname) (add-runtime-module mname tylinks tmlinks sdefs) - #f)] + empty-chunked-list)] [else (list->chunked-list (map reference->termlink rdeps))]))] - [else #f]))) + [else empty-chunked-list]))) -(define (unison-POp-CACH dfns0) - (let ([result (add-runtime-code #f dfns0)]) - (if result - (sum 1 result) - (sum 0 '())))) +(define (unison-POp-CACH dfns0) (add-runtime-code #f dfns0)) (define (unison-POp-LOAD v0) (let* ([val (unison-quote-val v0)] From 596fb892ac74c29f0b366de375bdf3c25af342d5 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Fri, 22 Mar 2024 17:47:37 -0400 Subject: [PATCH 018/124] Modify serial-tests to test for cache_ bug --- unison-src/builtin-tests/serial-tests.u | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/unison-src/builtin-tests/serial-tests.u b/unison-src/builtin-tests/serial-tests.u index 5e6afe896..5c7aaecca 100644 --- a/unison-src/builtin-tests/serial-tests.u +++ b/unison-src/builtin-tests/serial-tests.u @@ -95,7 +95,10 @@ serial.loadSelfContained name path = Right [] -> pass (name ++ " links validated") Right _ -> fail name "failed link validation" - _ = cache_ deps + match cache_ deps with + [] -> () + miss -> raiseFailure "code missing deps" miss + checkCached name deps match Value.load v with Left l -> raiseFailure "value missing deps" l From 16636dd201a0cbd64c5e24ab4cb4fb576b4f9850 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 22 Mar 2024 16:07:21 -0600 Subject: [PATCH 019/124] stefanzweifel/git-auto-commit-action v4 used deprecated node --- .github/workflows/ci.yaml | 2 +- .github/workflows/update-transcripts.yaml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index 9b9439f7d..8144de206 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -50,7 +50,7 @@ jobs: mode: inplace pattern: ${{ steps.changed-files.outputs.all_changed_files }} - name: apply formatting changes - uses: stefanzweifel/git-auto-commit-action@v4 + uses: stefanzweifel/git-auto-commit-action@v5 # Only try to commit formatting changes if we're running within the repo containing the PR, # and not on a protected branch. # The job doesn't have permission to push back to contributor forks on contributor PRs. diff --git a/.github/workflows/update-transcripts.yaml b/.github/workflows/update-transcripts.yaml index 47de04dc8..3f52f2e02 100644 --- a/.github/workflows/update-transcripts.yaml +++ b/.github/workflows/update-transcripts.yaml @@ -37,6 +37,6 @@ jobs: - name: transcripts run: stack --no-terminal exec transcripts - name: save transcript changes - uses: stefanzweifel/git-auto-commit-action@v4 + uses: stefanzweifel/git-auto-commit-action@v5 with: commit_message: rerun transcripts (reminder to rerun CI!) From 743da93537c7f1ebf647d6cacc1589bda7dc93eb Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 22 Mar 2024 19:09:53 -0600 Subject: [PATCH 020/124] git config needed before commit --- .github/workflows/haddocks.yaml | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/.github/workflows/haddocks.yaml b/.github/workflows/haddocks.yaml index 35a1c15fe..4b9179e56 100644 --- a/.github/workflows/haddocks.yaml +++ b/.github/workflows/haddocks.yaml @@ -42,11 +42,18 @@ jobs: - name: Checkout haddocks branch uses: actions/checkout@v4 with: - ref: 'haddocks' - path: 'haddocks' + ref: haddocks + path: haddocks + + # Needed for `git commit` below + - name: set git user info + working-directory: unison + run: | + git config --global user.name "GitHub Actions" + git config --global user.email "actions@github.com" - name: Copy haddocks - working-directory: 'unison' + working-directory: unison run: | docs_root="$(stack path --local-doc-root)" # Erase any stale files From 342f27bdeea7888159dc4812c465c200f4029620 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 22 Mar 2024 23:59:00 -0600 Subject: [PATCH 021/124] move release workflows --- .github/workflows/pre-release.yaml | 2 +- .github/workflows/release.yaml | 2 +- .github/workflows/{ => release}/build-optimized-ucm.yaml | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) rename .github/workflows/{ => release}/build-optimized-ucm.yaml (96%) diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index e3d713c7c..b0aa54a1a 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -14,7 +14,7 @@ on: jobs: build-ucm: - uses: ./.github/workflows/build-optimized-ucm.yaml + uses: ./.github/workflows/release/build-optimized-ucm.yaml with: ref: ${{ github.ref }} diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml index 3b88f3b61..a1e284685 100644 --- a/.github/workflows/release.yaml +++ b/.github/workflows/release.yaml @@ -21,7 +21,7 @@ on: jobs: build-ucm: - uses: ./.github/workflows/build-optimized-ucm.yaml + uses: ./.github/workflows/release/build-optimized-ucm.yaml with: ref: release/${{inputs.version}} diff --git a/.github/workflows/build-optimized-ucm.yaml b/.github/workflows/release/build-optimized-ucm.yaml similarity index 96% rename from .github/workflows/build-optimized-ucm.yaml rename to .github/workflows/release/build-optimized-ucm.yaml index 00f4016f3..bc0c6199b 100644 --- a/.github/workflows/build-optimized-ucm.yaml +++ b/.github/workflows/release/build-optimized-ucm.yaml @@ -48,7 +48,7 @@ jobs: # Just keep retrying on these failures. tries=5 for (( i = 0; i < $tries; i++ )); do - stack --no-terminal build --flag unison-parser-typechecker:optimized && break; + stack build --flag unison-parser-typechecker:optimized && break; done - name: save stack caches From 682b6afd634ec22906b7cc53dd15f9cb09b12a39 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 22 Mar 2024 23:59:15 -0600 Subject: [PATCH 022/124] add replacement release workflows --- .github/workflows/pre-release2.yaml | 45 +++++ .github/workflows/release/bundle-ucm.yaml | 235 ++++++++++++++++++++++ .github/workflows/release2.yaml | 66 ++++++ 3 files changed, 346 insertions(+) create mode 100644 .github/workflows/pre-release2.yaml create mode 100644 .github/workflows/release/bundle-ucm.yaml create mode 100644 .github/workflows/release2.yaml diff --git a/.github/workflows/pre-release2.yaml b/.github/workflows/pre-release2.yaml new file mode 100644 index 000000000..78a355f1e --- /dev/null +++ b/.github/workflows/pre-release2.yaml @@ -0,0 +1,45 @@ +name: pre-release + +defaults: + run: + shell: bash + +on: + workflow_run: + workflows: ["CI"] + branches: [ trunk ] + types: + - completed + workflow_dispatch: + +jobs: + build-ucm: + uses: ./.github/workflows/release/bundle-ucm.yaml + with: + ref: ${{ github.ref }} + + release: + name: create release + runs-on: ubuntu-20.04 + needs: + - build-ucm + + steps: + - name: make download dir + run: mkdir /tmp/ucm + + - name: "download artifacts" + uses: actions/download-artifact@v2 + with: + path: /tmp/ucm + + - uses: "marvinpinto/action-automatic-releases@latest" + with: + repo_token: "${{ secrets.GITHUB_TOKEN }}" + automatic_release_tag: "trunk-build" + prerelease: true + title: "Development Build" + files: | + /tmp/ucm/**/*.tar.gz + /tmp/ucm/**/*.zip + /tmp/ucm/**/*.zip.CHECKSUM diff --git a/.github/workflows/release/bundle-ucm.yaml b/.github/workflows/release/bundle-ucm.yaml new file mode 100644 index 000000000..2ab9bf38f --- /dev/null +++ b/.github/workflows/release/bundle-ucm.yaml @@ -0,0 +1,235 @@ +name: bundle ucm + +# build optimized ucm +# package racket lib +# build/dist unison-runtime + +on: + workflow_call: + inputs: + ref: + description: Git ref to check out for this build, e.g. `trunk` or `release/0.5.19` + type: string + required: true + +env: + racket_version: "8.7" + +defaults: + run: + shell: bash + +jobs: + build-ucm: + name: build ucm ${{matrix.os}} + strategy: + fail-fast: false + matrix: + os: [ubuntu-20.04, macos-12, windows-2019] + runs-on: ${{matrix.os}} + steps: + - uses: actions/checkout@v4 + with: + ref: ${{inputs.ref}} + + - name: restore stack caches + uses: unisonweb/actions/stack/cache/restore@main + with: + cache-prefix: release + + - name: install stack + uses: unisonweb/actions/stack/install@main + + - name: build + run: | + # unison-cli embeds version numbers using TH + # so it needs to be forced to rebuild to ensure those are updated. + stack clean unison-cli + + # Windows will crash on build intermittently because the filesystem + # sucks at managing concurrent file access; + # Just keep retrying on these failures. + tries=5 + for (( i = 0; i < $tries; i++ )); do + stack build --flag unison-parser-typechecker:optimized && break; + done + + echo ucm="$(stack exec -- which unison)" > $GITHUB_ENV + + - name: save stack caches + uses: unisonweb/actions/stack/cache/save@main + with: + cache-prefix: release + + - name: upload ucm + uses: actions/upload-artifact@v4 + with: + name: unison-${{matrix.os}} + path: ${{ env.ucm }} + + package-racket-lib: + env: + os: ubuntu-20.04 + needs: build-ucm + name: package racket lib + runs-on: ${{env.runner_os}} + steps: + - name: set up environment + # echo "jit_src_scheme=${{ runner.temp }}/${{ env.jit_src_scheme }}" >> $GITHUB_ENV + run: | + echo "ucm=${{ runner.temp }}/unison" >> $GITHUB_ENV + - name: download scheme-libs + uses: actions/checkout@v4 + with: + ref: ${{inputs.ref}} + - name: download ucm artifact + uses: actions/download-artifact@v4 + with: + name: unison-${{env.runner_os}} + path: ${{ runner.temp }} + - name: generate source + run: | + chmod +x ${{ env.ucm }} + ${{ env.ucm }} transcript unison-src/transcripts-manual/gen-racket-libs.md + - name: Cache Racket dependencies + uses: actions/cache@v4 + with: + path: | + ~/.cache/racket + ~/.local/share/racket + key: ${{ runner.os }}-racket-${{env.racket_version}} + - uses: Bogdanp/setup-racket@v1.11 + if: steps.restore-jit-binaries.outputs.cache-hit != 'true' + with: + architecture: 'x64' + distribution: 'full' + variant: 'CS' + version: ${{env.racket_version}} + - uses: awalsh128/cache-apt-pkgs-action@latest + with: + packages: libb2-dev + version: 1.0 # cache key version afaik + - name: create racket lib + run: raco pkg create scheme-libs/racket/unison + - name: upload racket lib + uses: actions/upload-artifact@v4 + with: + name: racket-lib + path: scheme-libs/racket/unison.zip{,.CHECKSUM} + + build-dist-unison-runtime: + needs: package-racket-lib + name: build unison-runtime ${{matrix.os}} + strategy: + fail-fast: false + matrix: + os: + - ubuntu-20.04 + - macos-12 + # - windows-2019 + runs-on: ${{matrix.os}} + steps: + - uses: actions/checkout@v4 + with: + ref: ${{inputs.ref}} + - name: Cache Racket dependencies + uses: actions/cache@v4 + with: + path: | + ~/.cache/racket + ~/.local/share/racket + key: ${{ runner.os }}-racket-${{env.racket_version}} + - uses: Bogdanp/setup-racket@v1.11 + if: steps.restore-jit-binaries.outputs.cache-hit != 'true' + with: + architecture: 'x64' + distribution: 'full' + variant: 'CS' + version: ${{env.racket_version}} + - uses: awalsh128/cache-apt-pkgs-action@latest + with: + packages: libb2-dev + version: 1.0 # cache key version afaik + - name: download racket lib + uses: actions/download-artifact@v4 + with: + name: racket-lib + path: . + - name: build unison-runtime + run: | + raco pkg install --auto scheme-libs/racket/unison.zip + raco exe --embed-dlls--orig-exe scheme-libs/racket/unison-runtime.rkt + mkdir runtime + raco distribute runtime scheme-libs/racket/unison-runtime + - name: upload unison-runtime + uses: actions/upload-artifact@v4 + with: + name: unison-runtime-${{matrix.os}} + path: runtime/ + + bundle: + name: bundle ucm+jit+ui ${{matrix.os}} + needs: [build-ucm, package-racket-lib, build-dist-unison-runtime] + runs-on: ${{matrix.os}} + strategy: + fail-fast: false + matrix: + os: [ubuntu-20.04, macos-12, windows-2019] + steps: + - name: set up environment + run: | + staging_dir="${{runner.temp}}/ucm-staging" + + if [[ ${{runner.os}} = 'Windows' ]]; then + artifact_os="windows" + staging_dir=$"{staging_dir//\\//}" + elif [[ ${{runner.os}} = 'macOS' ]]; then + artifact_os="osx" + elif [[ ${{runner.os}} = 'Linux' ]]; then + artifact_os="linux" + else + echo "Unexpected OS: ${{runner.os}}" + exit 1 + fi + + echo "staging_dir=$staging_dir" >> $GITHUB_ENV + echo "artifact_os=$artifact_os" >> $GITHUB_ENV + - name: make staging dir + run: mkdir -p ${{env.staging_dir}}/{racket,ui} + - name: download ucm + uses: actions/download-artifact@v4 + with: + name: unison-${{matrix.os}} + path: ${{env.staging_dir}}/ucm + - name: download racket lib + uses: actions/download-artifact@v4 + with: + name: racket-lib + path: ${{env.staging_dir}}/racket/ + - name: download unison-runtime + uses: actions/download-artifact@v4 + with: + name: unison-runtime-${{matrix.os}} + path: ${{env.staging_dir}}/ + - name: fetch latest Unison Local UI and package with ucm + run: | + ls -l `find ${{env.staging_dir}}` + curl -L -o /tmp/unisonLocal.zip \ + https://github.com/unisonweb/unison-local-ui/releases/download/latest/unisonLocal.zip + unzip -d ${{env.staging_dir}}/ui /tmp/unisonLocal.zip + + if [[ ${{runner.os}} = 'Windows' ]]; then + artifact_archive=ucm-${{env.artifact_os}}.zip + 7z a -r -tzip ${artifact_archive} /tmp/ucm/* + else + artifact_archive=ucm-${{env.artifact_os}}.tar.gz + tar -c -z -f ${artifact_archive} -C /tmp/ucm . + fi + echo "artifact_archive=${artifact_archive}" >> $GITHUB_ENV + + - name: upload artifact + uses: actions/upload-artifact@v4 + with: + if-no-files-found: error + name: bundle-${{env.artifact_os}} + path: ${{env.artifact_archive}} diff --git a/.github/workflows/release2.yaml b/.github/workflows/release2.yaml new file mode 100644 index 000000000..92604817e --- /dev/null +++ b/.github/workflows/release2.yaml @@ -0,0 +1,66 @@ +name: "release v2" + +run-name: "release v2 ${{inputs.version}}" + +defaults: + run: + shell: bash + +on: + workflow_dispatch: + inputs: + version: + description: Release version; e.g. `0.5.19`. We'll create tag `release/${version}`. + required: true + type: string + target: + description: Git ref to use for this release; defaults to `trunk`. + required: true + default: trunk + type: string + +jobs: + build-ucm: + uses: ./.github/workflows/release/bundle-ucm.yaml + with: + ref: release/${{inputs.version}} + + release: + name: create release + runs-on: ubuntu-20.04 + needs: + - build-ucm + + steps: + - name: make download dir + run: mkdir /tmp/ucm + + - name: "download artifacts" + uses: actions/download-artifact@v2 + with: + path: /tmp/ucm + + - name: Create Release + env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + run: | + version="${{inputs.version}}" + target="${{inputs.target}}" + prev_tag="$( \ + gh release view \ + --repo unisonweb/unison \ + --json tagName -t '{{printf .tagName}}' \ + )" + if [ -z "$prev_tag" ]; then echo "No previous release found"; exit 1; fi + + echo "Creating a release from these artifacts:" + ls -R /tmp/ucm/**/*.{zip,tar.gz,zip.CHECKSUM} + + + gh release create "release/${version}" \ + --repo unisonweb/unison \ + --target "${target}" \ + --generate-notes \ + --notes-start-tag "${prev_tag}" \ + \ + /tmp/ucm/**/*.{zip,tar.gz,zip.CHECKSUM} From cadfe55d845e7a8057dbf542e79dddd3e85446b8 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Fri, 22 Mar 2024 23:59:22 -0600 Subject: [PATCH 023/124] take off --no-terminal --- .github/workflows/update-transcripts.yaml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/update-transcripts.yaml b/.github/workflows/update-transcripts.yaml index 3f52f2e02..3c35e9f04 100644 --- a/.github/workflows/update-transcripts.yaml +++ b/.github/workflows/update-transcripts.yaml @@ -29,13 +29,13 @@ jobs: git config --global user.name "GitHub Actions" git config --global user.email "actions@github.com" - name: build - run: stack --no-terminal build --fast --no-run-tests --test + run: stack build --fast --no-run-tests --test - name: round-trip-tests run: | - stack --no-terminal exec unison transcript unison-src/transcripts-round-trip/main.md - stack --no-terminal exec unison transcript unison-src/transcripts-manual/rewrites.md + stack exec unison transcript unison-src/transcripts-round-trip/main.md + stack exec unison transcript unison-src/transcripts-manual/rewrites.md - name: transcripts - run: stack --no-terminal exec transcripts + run: stack exec transcripts - name: save transcript changes uses: stefanzweifel/git-auto-commit-action@v5 with: From de7c1beb0f2a8bbfbe59ef169682f84c92d02717 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 00:02:56 -0600 Subject: [PATCH 024/124] workflows can't be in subdirectories apparently "workflows must be defined at the top level of the .github/workflows/ directory" --- .github/workflows/{release => }/build-optimized-ucm.yaml | 0 .github/workflows/{release => }/bundle-ucm.yaml | 0 .github/workflows/pre-release.yaml | 2 +- .github/workflows/pre-release2.yaml | 2 +- .github/workflows/release.yaml | 2 +- .github/workflows/release2.yaml | 2 +- 6 files changed, 4 insertions(+), 4 deletions(-) rename .github/workflows/{release => }/build-optimized-ucm.yaml (100%) rename .github/workflows/{release => }/bundle-ucm.yaml (100%) diff --git a/.github/workflows/release/build-optimized-ucm.yaml b/.github/workflows/build-optimized-ucm.yaml similarity index 100% rename from .github/workflows/release/build-optimized-ucm.yaml rename to .github/workflows/build-optimized-ucm.yaml diff --git a/.github/workflows/release/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml similarity index 100% rename from .github/workflows/release/bundle-ucm.yaml rename to .github/workflows/bundle-ucm.yaml diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index b0aa54a1a..e3d713c7c 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -14,7 +14,7 @@ on: jobs: build-ucm: - uses: ./.github/workflows/release/build-optimized-ucm.yaml + uses: ./.github/workflows/build-optimized-ucm.yaml with: ref: ${{ github.ref }} diff --git a/.github/workflows/pre-release2.yaml b/.github/workflows/pre-release2.yaml index 78a355f1e..da8da02c3 100644 --- a/.github/workflows/pre-release2.yaml +++ b/.github/workflows/pre-release2.yaml @@ -14,7 +14,7 @@ on: jobs: build-ucm: - uses: ./.github/workflows/release/bundle-ucm.yaml + uses: ./.github/workflows/bundle-ucm.yaml with: ref: ${{ github.ref }} diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml index a1e284685..3b88f3b61 100644 --- a/.github/workflows/release.yaml +++ b/.github/workflows/release.yaml @@ -21,7 +21,7 @@ on: jobs: build-ucm: - uses: ./.github/workflows/release/build-optimized-ucm.yaml + uses: ./.github/workflows/build-optimized-ucm.yaml with: ref: release/${{inputs.version}} diff --git a/.github/workflows/release2.yaml b/.github/workflows/release2.yaml index 92604817e..a7ff99924 100644 --- a/.github/workflows/release2.yaml +++ b/.github/workflows/release2.yaml @@ -21,7 +21,7 @@ on: jobs: build-ucm: - uses: ./.github/workflows/release/bundle-ucm.yaml + uses: ./.github/workflows/bundle-ucm.yaml with: ref: release/${{inputs.version}} From 11107c07b71c46ff58cc572cb37a728646cf669a Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 00:06:13 -0600 Subject: [PATCH 025/124] do workflows need distinct names to show in the list? --- .github/workflows/pre-release2.yaml | 4 +++- .github/workflows/release2.yaml | 4 ++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/.github/workflows/pre-release2.yaml b/.github/workflows/pre-release2.yaml index da8da02c3..905d1a18f 100644 --- a/.github/workflows/pre-release2.yaml +++ b/.github/workflows/pre-release2.yaml @@ -1,4 +1,6 @@ -name: pre-release +name: pre-release v2 +run-name: pre-release v2 ${{inputs.version}} + defaults: run: diff --git a/.github/workflows/release2.yaml b/.github/workflows/release2.yaml index a7ff99924..a7ee5db24 100644 --- a/.github/workflows/release2.yaml +++ b/.github/workflows/release2.yaml @@ -1,6 +1,6 @@ -name: "release v2" +name: release v2 -run-name: "release v2 ${{inputs.version}}" +run-name: release v2 ${{inputs.version}} defaults: run: From 0633c839488ce846b29538d8e57ca761960bb430 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 00:09:47 -0600 Subject: [PATCH 026/124] deleted and replaced the old release workflows to reclaim their names before merging --- .github/workflows/build-optimized-ucm.yaml | 97 ---------------------- .github/workflows/pre-release.yaml | 6 +- .github/workflows/pre-release2.yaml | 47 ----------- .github/workflows/release.yaml | 10 +-- .github/workflows/release2.yaml | 66 --------------- 5 files changed, 9 insertions(+), 217 deletions(-) delete mode 100644 .github/workflows/build-optimized-ucm.yaml delete mode 100644 .github/workflows/pre-release2.yaml delete mode 100644 .github/workflows/release2.yaml diff --git a/.github/workflows/build-optimized-ucm.yaml b/.github/workflows/build-optimized-ucm.yaml deleted file mode 100644 index bc0c6199b..000000000 --- a/.github/workflows/build-optimized-ucm.yaml +++ /dev/null @@ -1,97 +0,0 @@ -name: build optimized ucm - -on: - workflow_call: - inputs: - ref: - description: Git ref to check out for this build, e.g. `trunk` or `release/0.5.19` - type: string - required: true - stack-cache-prefix: - description: The Stack cache prefix to use for builds - type: string - default: release - -defaults: - run: - shell: bash - -jobs: - build-ucm: - name: bundle ucm+ui ${{matrix.os}} - runs-on: ${{matrix.os}} - strategy: - fail-fast: false - matrix: - os: [ubuntu-20.04, macos-12, windows-2019] - steps: - - uses: actions/checkout@v4 - with: - ref: ${{inputs.ref}} - - - name: restore stack caches - uses: unisonweb/actions/stack/cache/restore@main - with: - cache-prefix: release - - - name: install stack - uses: unisonweb/actions/stack/install@main - - - name: build - run: | - # unison-cli embeds version numbers using TH - # so it needs to be forced to rebuild to ensure those are updated. - stack clean unison-cli - - # Windows will crash on build intermittently because the filesystem - # sucks at managing concurrent file access; - # Just keep retrying on these failures. - tries=5 - for (( i = 0; i < $tries; i++ )); do - stack build --flag unison-parser-typechecker:optimized && break; - done - - - name: save stack caches - uses: unisonweb/actions/stack/cache/save@main - with: - cache-prefix: release - - - name: set up environment - run: | - if [[ ${{runner.os}} = 'Windows' ]]; then - artifact_os="windows" - elif [[ ${{runner.os}} = 'macOS' ]]; then - artifact_os="osx" - elif [[ ${{runner.os}} = 'Linux' ]]; then - artifact_os="linux" - else - echo "Unexpected OS: ${{runner.os}}" - exit 1 - fi - echo "artifact_os=$artifact_os" >> $GITHUB_ENV - - - name: fetch latest Unison Local UI and package with ucm - run: | - mkdir /tmp/ucm - cp -v $(stack exec -- which unison) /tmp/ucm/ucm - - curl -L -o /tmp/unisonLocal.zip \ - https://github.com/unisonweb/unison-local-ui/releases/download/latest/unisonLocal.zip - mkdir /tmp/ucm/ui - unzip -d /tmp/ucm/ui /tmp/unisonLocal.zip - - if [[ ${{runner.os}} = 'Windows' ]]; then - artifact_archive=ucm-${{env.artifact_os}}.zip - 7z a -r -tzip ${artifact_archive} /tmp/ucm/* - else - artifact_archive=ucm-${{env.artifact_os}}.tar.gz - tar -c -z -f ${artifact_archive} -C /tmp/ucm . - fi - echo "artifact_archive=${artifact_archive}" >> $GITHUB_ENV - - - name: upload artifact - uses: actions/upload-artifact@v4 - with: - if-no-files-found: error - name: build-${{env.artifact_os}} - path: ${{env.artifact_archive}} diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index e3d713c7c..46eb22aef 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -1,4 +1,5 @@ -name: pre-release +name: pre-release v2 +run-name: pre-release v2 ${{inputs.version}} defaults: run: @@ -14,7 +15,7 @@ on: jobs: build-ucm: - uses: ./.github/workflows/build-optimized-ucm.yaml + uses: ./.github/workflows/bundle-ucm.yaml with: ref: ${{ github.ref }} @@ -42,3 +43,4 @@ jobs: files: | /tmp/ucm/**/*.tar.gz /tmp/ucm/**/*.zip + /tmp/ucm/**/*.zip.CHECKSUM diff --git a/.github/workflows/pre-release2.yaml b/.github/workflows/pre-release2.yaml deleted file mode 100644 index 905d1a18f..000000000 --- a/.github/workflows/pre-release2.yaml +++ /dev/null @@ -1,47 +0,0 @@ -name: pre-release v2 -run-name: pre-release v2 ${{inputs.version}} - - -defaults: - run: - shell: bash - -on: - workflow_run: - workflows: ["CI"] - branches: [ trunk ] - types: - - completed - workflow_dispatch: - -jobs: - build-ucm: - uses: ./.github/workflows/bundle-ucm.yaml - with: - ref: ${{ github.ref }} - - release: - name: create release - runs-on: ubuntu-20.04 - needs: - - build-ucm - - steps: - - name: make download dir - run: mkdir /tmp/ucm - - - name: "download artifacts" - uses: actions/download-artifact@v2 - with: - path: /tmp/ucm - - - uses: "marvinpinto/action-automatic-releases@latest" - with: - repo_token: "${{ secrets.GITHUB_TOKEN }}" - automatic_release_tag: "trunk-build" - prerelease: true - title: "Development Build" - files: | - /tmp/ucm/**/*.tar.gz - /tmp/ucm/**/*.zip - /tmp/ucm/**/*.zip.CHECKSUM diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml index 3b88f3b61..a7ee5db24 100644 --- a/.github/workflows/release.yaml +++ b/.github/workflows/release.yaml @@ -1,6 +1,6 @@ -name: "release" +name: release v2 -run-name: "release ${{inputs.version}}" +run-name: release v2 ${{inputs.version}} defaults: run: @@ -21,7 +21,7 @@ on: jobs: build-ucm: - uses: ./.github/workflows/build-optimized-ucm.yaml + uses: ./.github/workflows/bundle-ucm.yaml with: ref: release/${{inputs.version}} @@ -54,7 +54,7 @@ jobs: if [ -z "$prev_tag" ]; then echo "No previous release found"; exit 1; fi echo "Creating a release from these artifacts:" - ls -R /tmp/ucm + ls -R /tmp/ucm/**/*.{zip,tar.gz,zip.CHECKSUM} gh release create "release/${version}" \ @@ -63,4 +63,4 @@ jobs: --generate-notes \ --notes-start-tag "${prev_tag}" \ \ - /tmp/ucm/**/*.{zip,tar.gz} + /tmp/ucm/**/*.{zip,tar.gz,zip.CHECKSUM} diff --git a/.github/workflows/release2.yaml b/.github/workflows/release2.yaml deleted file mode 100644 index a7ee5db24..000000000 --- a/.github/workflows/release2.yaml +++ /dev/null @@ -1,66 +0,0 @@ -name: release v2 - -run-name: release v2 ${{inputs.version}} - -defaults: - run: - shell: bash - -on: - workflow_dispatch: - inputs: - version: - description: Release version; e.g. `0.5.19`. We'll create tag `release/${version}`. - required: true - type: string - target: - description: Git ref to use for this release; defaults to `trunk`. - required: true - default: trunk - type: string - -jobs: - build-ucm: - uses: ./.github/workflows/bundle-ucm.yaml - with: - ref: release/${{inputs.version}} - - release: - name: create release - runs-on: ubuntu-20.04 - needs: - - build-ucm - - steps: - - name: make download dir - run: mkdir /tmp/ucm - - - name: "download artifacts" - uses: actions/download-artifact@v2 - with: - path: /tmp/ucm - - - name: Create Release - env: - GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} - run: | - version="${{inputs.version}}" - target="${{inputs.target}}" - prev_tag="$( \ - gh release view \ - --repo unisonweb/unison \ - --json tagName -t '{{printf .tagName}}' \ - )" - if [ -z "$prev_tag" ]; then echo "No previous release found"; exit 1; fi - - echo "Creating a release from these artifacts:" - ls -R /tmp/ucm/**/*.{zip,tar.gz,zip.CHECKSUM} - - - gh release create "release/${version}" \ - --repo unisonweb/unison \ - --target "${target}" \ - --generate-notes \ - --notes-start-tag "${prev_tag}" \ - \ - /tmp/ucm/**/*.{zip,tar.gz,zip.CHECKSUM} From de52b2241897a30cb1dd125786ff8b8ec87cc3fc Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 00:11:30 -0600 Subject: [PATCH 027/124] typo --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 2ab9bf38f..bed5f2996 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -69,7 +69,7 @@ jobs: package-racket-lib: env: - os: ubuntu-20.04 + runner_os: ubuntu-20.04 needs: build-ucm name: package racket lib runs-on: ${{env.runner_os}} From 1e5df2b4a08459b0a73f50af98f386ab02a6cfdd Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 00:15:22 -0600 Subject: [PATCH 028/124] remove quotes --- .github/workflows/pre-release.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index 46eb22aef..5a671a8cc 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -37,9 +37,9 @@ jobs: - uses: "marvinpinto/action-automatic-releases@latest" with: repo_token: "${{ secrets.GITHUB_TOKEN }}" - automatic_release_tag: "trunk-build" + automatic_release_tag: trunk-build prerelease: true - title: "Development Build" + title: Development Build files: | /tmp/ucm/**/*.tar.gz /tmp/ucm/**/*.zip From f1d7bdd0cc2e961d3379242061ec6eebd08889cc Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 00:18:36 -0600 Subject: [PATCH 029/124] environment variables not available everywhere, for some reason --- .github/workflows/bundle-ucm.yaml | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index bed5f2996..41ddb276a 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -68,16 +68,15 @@ jobs: path: ${{ env.ucm }} package-racket-lib: - env: - runner_os: ubuntu-20.04 + strategy: + matrix: + os: [ubuntu-20.04] needs: build-ucm name: package racket lib - runs-on: ${{env.runner_os}} + runs-on: ${{matrix.os}} steps: - name: set up environment - # echo "jit_src_scheme=${{ runner.temp }}/${{ env.jit_src_scheme }}" >> $GITHUB_ENV - run: | - echo "ucm=${{ runner.temp }}/unison" >> $GITHUB_ENV + run: echo "ucm=${{ runner.temp }}/unison" >> $GITHUB_ENV - name: download scheme-libs uses: actions/checkout@v4 with: From 67371c2f6201f99dbc0d3a309499d2e575fb8730 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 00:33:53 -0600 Subject: [PATCH 030/124] drop target parameter from release.yaml --- .github/workflows/release.yaml | 14 +++----------- 1 file changed, 3 insertions(+), 11 deletions(-) diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml index a7ee5db24..7e089f786 100644 --- a/.github/workflows/release.yaml +++ b/.github/workflows/release.yaml @@ -13,17 +13,12 @@ on: description: Release version; e.g. `0.5.19`. We'll create tag `release/${version}`. required: true type: string - target: - description: Git ref to use for this release; defaults to `trunk`. - required: true - default: trunk - type: string jobs: build-ucm: uses: ./.github/workflows/bundle-ucm.yaml with: - ref: release/${{inputs.version}} + ref: ${{github.ref}} release: name: create release @@ -44,8 +39,6 @@ jobs: env: GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} run: | - version="${{inputs.version}}" - target="${{inputs.target}}" prev_tag="$( \ gh release view \ --repo unisonweb/unison \ @@ -56,10 +49,9 @@ jobs: echo "Creating a release from these artifacts:" ls -R /tmp/ucm/**/*.{zip,tar.gz,zip.CHECKSUM} - - gh release create "release/${version}" \ + gh release create "release/${{inputs.version}}" \ --repo unisonweb/unison \ - --target "${target}" \ + --target "${{github.ref}}" \ --generate-notes \ --notes-start-tag "${prev_tag}" \ \ From faae5c003aef5c83004e7c8cba62c6d748d0aa4a Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 00:46:46 -0600 Subject: [PATCH 031/124] try to save unison.exe --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 41ddb276a..53b9ef9af 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -65,7 +65,7 @@ jobs: uses: actions/upload-artifact@v4 with: name: unison-${{matrix.os}} - path: ${{ env.ucm }} + path: ${{ env.ucm }}{,.exe} package-racket-lib: strategy: From 2ca599ea3ee1be1f16a6a34c07fba1bf70fb4d8f Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 00:47:27 -0600 Subject: [PATCH 032/124] environment variables are for losers --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 53b9ef9af..2b3b7ba38 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -84,7 +84,7 @@ jobs: - name: download ucm artifact uses: actions/download-artifact@v4 with: - name: unison-${{env.runner_os}} + name: unison-${{matrix.os}} path: ${{ runner.temp }} - name: generate source run: | From 7fab9daad1a89c8d460de98a7fbeff5e8316a870 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 00:59:08 -0600 Subject: [PATCH 033/124] globs don't support bracket alternatives syntax --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 2b3b7ba38..5745cf79d 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -65,7 +65,7 @@ jobs: uses: actions/upload-artifact@v4 with: name: unison-${{matrix.os}} - path: ${{ env.ucm }}{,.exe} + path: ${{ env.ucm }}* package-racket-lib: strategy: From 9f789a43c1ae653680d529e0f981ec9b30b90bc5 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 01:30:42 -0600 Subject: [PATCH 034/124] I guess `*` doesn't work as expected in upload-artifact path? --- .github/workflows/bundle-ucm.yaml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 5745cf79d..6be346c7f 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -54,7 +54,9 @@ jobs: stack build --flag unison-parser-typechecker:optimized && break; done - echo ucm="$(stack exec -- which unison)" > $GITHUB_ENV + ucm=$(stack exec -- which unison) + exe=$([ ${{runner.os}} = Windows ] && echo .exe || echo '') + echo ucm="$ucm$exe" > $GITHUB_ENV - name: save stack caches uses: unisonweb/actions/stack/cache/save@main @@ -65,7 +67,7 @@ jobs: uses: actions/upload-artifact@v4 with: name: unison-${{matrix.os}} - path: ${{ env.ucm }}* + path: ${{ env.ucm }} package-racket-lib: strategy: From 55cb9d1d360f9e3457771855a49d7bb655e7a864 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 01:42:27 -0600 Subject: [PATCH 035/124] where is my exe? --- .github/workflows/bundle-ucm.yaml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 6be346c7f..b0b7a23e4 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -54,7 +54,11 @@ jobs: stack build --flag unison-parser-typechecker:optimized && break; done - ucm=$(stack exec -- which unison) + ucm=$(stack exec which unison) + ls -l $ucm + if [[ ${{runner.os}} = 'Windows' ]]; then + dir $ucm + fi exe=$([ ${{runner.os}} = Windows ] && echo .exe || echo '') echo ucm="$ucm$exe" > $GITHUB_ENV From 65560850774c1c0c1558cc3339ed0588b8574a30 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 01:49:46 -0600 Subject: [PATCH 036/124] i'll hope to use automatic os labeling which apparently exists? --- .github/workflows/bundle-ucm.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index b0b7a23e4..5b51471bb 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -21,7 +21,7 @@ defaults: jobs: build-ucm: - name: build ucm ${{matrix.os}} + name: build ucm strategy: fail-fast: false matrix: @@ -173,7 +173,7 @@ jobs: path: runtime/ bundle: - name: bundle ucm+jit+ui ${{matrix.os}} + name: bundle ucm+jit+ui needs: [build-ucm, package-racket-lib, build-dist-unison-runtime] runs-on: ${{matrix.os}} strategy: From e92fda7a0601588c14d1d6e9b520d08b7eea607a Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 01:50:16 -0600 Subject: [PATCH 037/124] putting `ls -l` all over because no idea what's going on --- .github/workflows/bundle-ucm.yaml | 23 +++++++++++++++++++---- 1 file changed, 19 insertions(+), 4 deletions(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 5b51471bb..da422bbed 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -46,12 +46,17 @@ jobs: # so it needs to be forced to rebuild to ensure those are updated. stack clean unison-cli + mkdir ucm-bin + # Windows will crash on build intermittently because the filesystem # sucks at managing concurrent file access; # Just keep retrying on these failures. tries=5 for (( i = 0; i < $tries; i++ )); do - stack build --flag unison-parser-typechecker:optimized && break; + stack build --flag unison-parser-typechecker:optimized \ + --local-bin-path ucm-bin \ + --copy-bins \ + && break; done ucm=$(stack exec which unison) @@ -61,6 +66,7 @@ jobs: fi exe=$([ ${{runner.os}} = Windows ] && echo .exe || echo '') echo ucm="$ucm$exe" > $GITHUB_ENV + ls -l ${{ env.ucm }} - name: save stack caches uses: unisonweb/actions/stack/cache/save@main @@ -72,6 +78,7 @@ jobs: with: name: unison-${{matrix.os}} path: ${{ env.ucm }} + if-no-files-found: error package-racket-lib: strategy: @@ -115,12 +122,17 @@ jobs: packages: libb2-dev version: 1.0 # cache key version afaik - name: create racket lib - run: raco pkg create scheme-libs/racket/unison + run: | + raco pkg create scheme-libs/racket/unison + ls -l scheme-libs/racket/unison.zip{,.CHECKSUM} - name: upload racket lib uses: actions/upload-artifact@v4 with: name: racket-lib - path: scheme-libs/racket/unison.zip{,.CHECKSUM} + path: | + scheme-libs/racket/unison.zip + scheme-libs/racket/unison.zip.CHECKSUM + if-no-files-found: error build-dist-unison-runtime: needs: package-racket-lib @@ -166,11 +178,13 @@ jobs: raco exe --embed-dlls--orig-exe scheme-libs/racket/unison-runtime.rkt mkdir runtime raco distribute runtime scheme-libs/racket/unison-runtime + ls -l runtime/ - name: upload unison-runtime uses: actions/upload-artifact@v4 with: name: unison-runtime-${{matrix.os}} path: runtime/ + if-no-files-found: error bundle: name: bundle ucm+jit+ui @@ -231,10 +245,11 @@ jobs: tar -c -z -f ${artifact_archive} -C /tmp/ucm . fi echo "artifact_archive=${artifact_archive}" >> $GITHUB_ENV + ls -l ${{env.artifact_archive}} - name: upload artifact uses: actions/upload-artifact@v4 with: - if-no-files-found: error name: bundle-${{env.artifact_os}} path: ${{env.artifact_archive}} + if-no-files-found: error From c32dc89ac0f0ead5bfe08ddfaeef4ca013a6f1f7 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 02:16:29 -0600 Subject: [PATCH 038/124] this is so annoying the windows box doesn't agree with itself on where the ucm executable is --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index da422bbed..d1b408270 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -66,7 +66,7 @@ jobs: fi exe=$([ ${{runner.os}} = Windows ] && echo .exe || echo '') echo ucm="$ucm$exe" > $GITHUB_ENV - ls -l ${{ env.ucm }} + ls -l $ucm$exe - name: save stack caches uses: unisonweb/actions/stack/cache/save@main From 8ac2ec05b5ee53da550bffadd4a786359854550c Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 02:32:10 -0600 Subject: [PATCH 039/124] does this work please? --- .github/workflows/bundle-ucm.yaml | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index d1b408270..45438a4b5 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -59,14 +59,13 @@ jobs: && break; done - ucm=$(stack exec which unison) - ls -l $ucm if [[ ${{runner.os}} = 'Windows' ]]; then - dir $ucm + ucm=$(stack exec where unison) + else + ucm=$(stack exec which unison) fi - exe=$([ ${{runner.os}} = Windows ] && echo .exe || echo '') - echo ucm="$ucm$exe" > $GITHUB_ENV - ls -l $ucm$exe + echo ucm="$ucm" > $GITHUB_ENV + ls -l $ucm - name: save stack caches uses: unisonweb/actions/stack/cache/save@main From a765f16f855752e7d74bc36a3564fcd1d9af252c Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 02:41:02 -0600 Subject: [PATCH 040/124] hints --- docs/github-actions-help.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/docs/github-actions-help.md b/docs/github-actions-help.md index b923e7da2..e760ce68b 100644 --- a/docs/github-actions-help.md +++ b/docs/github-actions-help.md @@ -29,6 +29,11 @@ Similarly, `save-always: true` only if a key hit means there will be nothing new Backup restore keys: "Is there a prior run that would be worth starting out from? With the caveat that any irrelevant garbage it includes will be saved into this run too." +### Upload Artifact + +I suspect on Windows it can't support paths that select a drive in a Unix-y way, +like `/c/asdf` or `/d/asdf`. It's got to be `C:/asdf` or `C:\asdf` etc. + ### Reusability Github supports splitting off "reusable workflows" (`jobs` that can be imported into another workflow), and "composite actions" (multi-step `steps` that can be imported into another `job`). From bca1a76a6c02e49ff379c0d7c4952414c13f1490 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 02:54:35 -0600 Subject: [PATCH 041/124] not installing or running anything yet --- .github/workflows/bundle-ucm.yaml | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 45438a4b5..130a17636 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -102,24 +102,12 @@ jobs: run: | chmod +x ${{ env.ucm }} ${{ env.ucm }} transcript unison-src/transcripts-manual/gen-racket-libs.md - - name: Cache Racket dependencies - uses: actions/cache@v4 - with: - path: | - ~/.cache/racket - ~/.local/share/racket - key: ${{ runner.os }}-racket-${{env.racket_version}} - uses: Bogdanp/setup-racket@v1.11 - if: steps.restore-jit-binaries.outputs.cache-hit != 'true' with: architecture: 'x64' distribution: 'full' variant: 'CS' version: ${{env.racket_version}} - - uses: awalsh128/cache-apt-pkgs-action@latest - with: - packages: libb2-dev - version: 1.0 # cache key version afaik - name: create racket lib run: | raco pkg create scheme-libs/racket/unison From cc2194483d9cf055a8489fc4e4268a27a39685d1 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 02:54:55 -0600 Subject: [PATCH 042/124] cargo junk --- .github/workflows/bundle-ucm.yaml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 130a17636..4540c2820 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -144,7 +144,6 @@ jobs: ~/.local/share/racket key: ${{ runner.os }}-racket-${{env.racket_version}} - uses: Bogdanp/setup-racket@v1.11 - if: steps.restore-jit-binaries.outputs.cache-hit != 'true' with: architecture: 'x64' distribution: 'full' From 5985a65f13642a212b66bd60b53fe6e380d775be Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 02:55:54 -0600 Subject: [PATCH 043/124] don't reinstall unison library --- .github/workflows/bundle-ucm.yaml | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 4540c2820..3e6c2d26f 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -136,13 +136,19 @@ jobs: - uses: actions/checkout@v4 with: ref: ${{inputs.ref}} + - name: download racket lib + uses: actions/download-artifact@v4 + with: + name: racket-lib + path: . - name: Cache Racket dependencies + id: cache-racket-deps uses: actions/cache@v4 with: path: | ~/.cache/racket ~/.local/share/racket - key: ${{ runner.os }}-racket-${{env.racket_version}} + key: ${{ runner.os }}-racket-${{env.racket_version}}-${{hashFiles('scheme-libs/racket/unison.zip'))}} - uses: Bogdanp/setup-racket@v1.11 with: architecture: 'x64' @@ -153,15 +159,12 @@ jobs: with: packages: libb2-dev version: 1.0 # cache key version afaik - - name: download racket lib - uses: actions/download-artifact@v4 - with: - name: racket-lib - path: . + - name: install unison racket lib + if: steps.cache-racket-deps.outputs.cache-hit != 'true' + run: raco pkg install --auto scheme-libs/racket/unison.zip - name: build unison-runtime run: | - raco pkg install --auto scheme-libs/racket/unison.zip - raco exe --embed-dlls--orig-exe scheme-libs/racket/unison-runtime.rkt + raco exe --embed-dlls --orig-exe scheme-libs/racket/unison-runtime.rkt mkdir runtime raco distribute runtime scheme-libs/racket/unison-runtime ls -l runtime/ From 250577d6cc09df5dd50c7d4e0b93770a1119ce08 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 02:58:40 -0600 Subject: [PATCH 044/124] have to ask remote computer if i have too many parens --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 3e6c2d26f..2d066025a 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -148,7 +148,7 @@ jobs: path: | ~/.cache/racket ~/.local/share/racket - key: ${{ runner.os }}-racket-${{env.racket_version}}-${{hashFiles('scheme-libs/racket/unison.zip'))}} + key: ${{ runner.os }}-racket-${{env.racket_version}}-${{hashFiles('scheme-libs/racket/unison.zip')}} - uses: Bogdanp/setup-racket@v1.11 with: architecture: 'x64' From a51e4561cb045a341e3fafb9bf290e26b2eea898 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 03:12:46 -0600 Subject: [PATCH 045/124] get your story straight --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 2d066025a..ed8989019 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -140,7 +140,7 @@ jobs: uses: actions/download-artifact@v4 with: name: racket-lib - path: . + path: scheme-libs/racket/ - name: Cache Racket dependencies id: cache-racket-deps uses: actions/cache@v4 From d94eaadd69fe9a3aa9804af55a7842cf4766c550 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 03:24:30 -0600 Subject: [PATCH 046/124] don't try to package windows jit --- .github/workflows/bundle-ucm.yaml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index ed8989019..dba17863f 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -215,6 +215,7 @@ jobs: name: racket-lib path: ${{env.staging_dir}}/racket/ - name: download unison-runtime + if: ${{runner.os}} != 'Windows' uses: actions/download-artifact@v4 with: name: unison-runtime-${{matrix.os}} @@ -228,10 +229,10 @@ jobs: if [[ ${{runner.os}} = 'Windows' ]]; then artifact_archive=ucm-${{env.artifact_os}}.zip - 7z a -r -tzip ${artifact_archive} /tmp/ucm/* + 7z a -r -tzip ${artifact_archive} ${{env.staging_dir}}/* else artifact_archive=ucm-${{env.artifact_os}}.tar.gz - tar -c -z -f ${artifact_archive} -C /tmp/ucm . + tar -c -z -f ${artifact_archive} -C ${{env.staging_dir}} . fi echo "artifact_archive=${artifact_archive}" >> $GITHUB_ENV ls -l ${{env.artifact_archive}} From 091927ea4e3aa91581351edcafa1f1b08a52ebfb Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 03:30:39 -0600 Subject: [PATCH 047/124] only use apt on linux --- .github/workflows/bundle-ucm.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index dba17863f..3c9d4df56 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -156,6 +156,7 @@ jobs: variant: 'CS' version: ${{env.racket_version}} - uses: awalsh128/cache-apt-pkgs-action@latest + if: ${{ runner.os }} == 'Linux' with: packages: libb2-dev version: 1.0 # cache key version afaik From e2f5a966b8d0b6bf2e88598c2ae2cd18465a62b9 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 03:42:23 -0600 Subject: [PATCH 048/124] missed one --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 3c9d4df56..3d074b63c 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -123,7 +123,7 @@ jobs: build-dist-unison-runtime: needs: package-racket-lib - name: build unison-runtime ${{matrix.os}} + name: build unison-runtime strategy: fail-fast: false matrix: From 967e9b1a3633407b3a2e37363dda0dca87dc56bd Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 03:49:52 -0600 Subject: [PATCH 049/124] ugh that isn't a string --- .github/workflows/bundle-ucm.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 3d074b63c..a3b79f508 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -156,7 +156,7 @@ jobs: variant: 'CS' version: ${{env.racket_version}} - uses: awalsh128/cache-apt-pkgs-action@latest - if: ${{ runner.os }} == 'Linux' + if: runner.os == 'Linux' with: packages: libb2-dev version: 1.0 # cache key version afaik @@ -216,7 +216,7 @@ jobs: name: racket-lib path: ${{env.staging_dir}}/racket/ - name: download unison-runtime - if: ${{runner.os}} != 'Windows' + if: runner.os != 'Windows' uses: actions/download-artifact@v4 with: name: unison-runtime-${{matrix.os}} From d96cf8dd99648babafb4f74e61ac3cfbda83ef95 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 04:05:49 -0600 Subject: [PATCH 050/124] whoops --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index a3b79f508..5a2a44206 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -191,7 +191,7 @@ jobs: if [[ ${{runner.os}} = 'Windows' ]]; then artifact_os="windows" - staging_dir=$"{staging_dir//\\//}" + staging_dir="${staging_dir//\\//}" elif [[ ${{runner.os}} = 'macOS' ]]; then artifact_os="osx" elif [[ ${{runner.os}} = 'Linux' ]]; then From 700a3367cd7151f0b8a2b45b020f37b2ea93bb64 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 04:36:18 -0600 Subject: [PATCH 051/124] upload/download versions have to match --- .github/workflows/pre-release.yaml | 2 +- .github/workflows/release.yaml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index 5a671a8cc..e31dbcadd 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -30,7 +30,7 @@ jobs: run: mkdir /tmp/ucm - name: "download artifacts" - uses: actions/download-artifact@v2 + uses: actions/download-artifact@v4 with: path: /tmp/ucm diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml index 7e089f786..e67570bcc 100644 --- a/.github/workflows/release.yaml +++ b/.github/workflows/release.yaml @@ -31,7 +31,7 @@ jobs: run: mkdir /tmp/ucm - name: "download artifacts" - uses: actions/download-artifact@v2 + uses: actions/download-artifact@v4 with: path: /tmp/ucm From e7647a601ce0a545fe7903b12e4d73eb5670c82f Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 04:55:42 -0600 Subject: [PATCH 052/124] try to cache racket mac stuff --- .github/workflows/bundle-ucm.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 5a2a44206..db57fde02 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -148,6 +148,7 @@ jobs: path: | ~/.cache/racket ~/.local/share/racket + ~/Library/Racket/${{env.racket_version}} key: ${{ runner.os }}-racket-${{env.racket_version}}-${{hashFiles('scheme-libs/racket/unison.zip')}} - uses: Bogdanp/setup-racket@v1.11 with: From dec29e94687ed5835b5e62284d1394d9b7d650b4 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 05:06:11 -0600 Subject: [PATCH 053/124] move ucm and runtime in dist --- .github/workflows/bundle-ucm.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index db57fde02..11ade48ec 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -210,7 +210,7 @@ jobs: uses: actions/download-artifact@v4 with: name: unison-${{matrix.os}} - path: ${{env.staging_dir}}/ucm + path: ${{env.staging_dir}}/ - name: download racket lib uses: actions/download-artifact@v4 with: @@ -221,7 +221,7 @@ jobs: uses: actions/download-artifact@v4 with: name: unison-runtime-${{matrix.os}} - path: ${{env.staging_dir}}/ + path: ${{env.staging_dir}}/runtime - name: fetch latest Unison Local UI and package with ucm run: | ls -l `find ${{env.staging_dir}}` From 0444f5478763a3931cee56d5bb52338b5d72f01a Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 12:24:28 -0600 Subject: [PATCH 054/124] exclude the racket library from the downloads --- .github/workflows/release.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml index e67570bcc..e5d8a1118 100644 --- a/.github/workflows/release.yaml +++ b/.github/workflows/release.yaml @@ -47,7 +47,7 @@ jobs: if [ -z "$prev_tag" ]; then echo "No previous release found"; exit 1; fi echo "Creating a release from these artifacts:" - ls -R /tmp/ucm/**/*.{zip,tar.gz,zip.CHECKSUM} + ls -R /tmp/ucm/**/ucm-*.{zip,tar.gz,zip.CHECKSUM} gh release create "release/${{inputs.version}}" \ --repo unisonweb/unison \ @@ -55,4 +55,4 @@ jobs: --generate-notes \ --notes-start-tag "${prev_tag}" \ \ - /tmp/ucm/**/*.{zip,tar.gz,zip.CHECKSUM} + /tmp/ucm/**/ucm-*.{zip,tar.gz,zip.CHECKSUM} From 09fdb865c99bea9c653f2ad405e61c9df9c9219a Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 12:36:22 -0600 Subject: [PATCH 055/124] try to just build the single executable we need although it doesn't seem to work --- .github/workflows/bundle-ucm.yaml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 11ade48ec..69d49da6d 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -53,7 +53,8 @@ jobs: # Just keep retrying on these failures. tries=5 for (( i = 0; i < $tries; i++ )); do - stack build --flag unison-parser-typechecker:optimized \ + stack build :unison \ + --flag unison-parser-typechecker:optimized \ --local-bin-path ucm-bin \ --copy-bins \ && break; From 6bf7b817b392f31c87a6d52954fb446ffe540846 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 12:36:44 -0600 Subject: [PATCH 056/124] I guess we were already calling this `macos`, so we can simplify --- .github/workflows/bundle-ucm.yaml | 16 ++-------------- 1 file changed, 2 insertions(+), 14 deletions(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 69d49da6d..b1841a463 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -189,20 +189,8 @@ jobs: steps: - name: set up environment run: | - staging_dir="${{runner.temp}}/ucm-staging" - - if [[ ${{runner.os}} = 'Windows' ]]; then - artifact_os="windows" - staging_dir="${staging_dir//\\//}" - elif [[ ${{runner.os}} = 'macOS' ]]; then - artifact_os="osx" - elif [[ ${{runner.os}} = 'Linux' ]]; then - artifact_os="linux" - else - echo "Unexpected OS: ${{runner.os}}" - exit 1 - fi - + staging_dir="${RUNNER_TEMP//\\//}/ucm-staging" + artifact_os="${RUNNER_OS,,}" echo "staging_dir=$staging_dir" >> $GITHUB_ENV echo "artifact_os=$artifact_os" >> $GITHUB_ENV - name: make staging dir From 985ac0eed3c2e9be6a019cf47b7b2e7af8bd93af Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 12:37:24 -0600 Subject: [PATCH 057/124] call ucm `ucm` and not `unison` --- .github/workflows/bundle-ucm.yaml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index b1841a463..3957ce784 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -200,6 +200,8 @@ jobs: with: name: unison-${{matrix.os}} path: ${{env.staging_dir}}/ + - name: rename unison -> ucm + run: mv ${{env.staging_dir}}/unison ${{env.staging_dir}}/ucm - name: download racket lib uses: actions/download-artifact@v4 with: From b1fcb0f56500b7b002742e11fffb4a76a75732bd Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 12:58:04 -0600 Subject: [PATCH 058/124] tweak label --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 3957ce784..05ba4b767 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -90,7 +90,7 @@ jobs: steps: - name: set up environment run: echo "ucm=${{ runner.temp }}/unison" >> $GITHUB_ENV - - name: download scheme-libs + - name: download racket `unison` source uses: actions/checkout@v4 with: ref: ${{inputs.ref}} From 2368446b6c9884fdce0e557f2252d9834e508e35 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 12:58:25 -0600 Subject: [PATCH 059/124] doublecheck what happens when we build for windows --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 05ba4b767..120c60d73 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -131,7 +131,7 @@ jobs: os: - ubuntu-20.04 - macos-12 - # - windows-2019 + - windows-2019 runs-on: ${{matrix.os}} steps: - uses: actions/checkout@v4 From f5488b62d37752aeeebd4d8e16ce43be10dddc93 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 13:10:18 -0600 Subject: [PATCH 060/124] `${RUNNER_OS,,}` doesn't work on bash 3.2 --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 120c60d73..8dac1c454 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -190,7 +190,7 @@ jobs: - name: set up environment run: | staging_dir="${RUNNER_TEMP//\\//}/ucm-staging" - artifact_os="${RUNNER_OS,,}" + artifact_os="$(echo $RUNNER_OS | tr '[:upper:]' '[:lower:]')" echo "staging_dir=$staging_dir" >> $GITHUB_ENV echo "artifact_os=$artifact_os" >> $GITHUB_ENV - name: make staging dir From 48daa5d98d18df4c73b50dc8062372a7317f13fe Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 13:24:13 -0600 Subject: [PATCH 061/124] note re racket deps cache --- .github/workflows/bundle-ucm.yaml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 8dac1c454..149c982ad 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -150,6 +150,8 @@ jobs: ~/.cache/racket ~/.local/share/racket ~/Library/Racket/${{env.racket_version}} + # This isn't right because unison.zip is going to include different dates each time. + # Maybe we can unpack it and hash the contents. key: ${{ runner.os }}-racket-${{env.racket_version}}-${{hashFiles('scheme-libs/racket/unison.zip')}} - uses: Bogdanp/setup-racket@v1.11 with: From 6366e9f1fdee4cac239084ab0b4e58deaf4d94a5 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 13:24:28 -0600 Subject: [PATCH 062/124] maybe this wildcard will help find `unison-runtime{,.exe}` --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 149c982ad..baae7b3ae 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -171,7 +171,7 @@ jobs: run: | raco exe --embed-dlls --orig-exe scheme-libs/racket/unison-runtime.rkt mkdir runtime - raco distribute runtime scheme-libs/racket/unison-runtime + raco distribute runtime scheme-libs/racket/unison-runtime* ls -l runtime/ - name: upload unison-runtime uses: actions/upload-artifact@v4 From 7acf95da8591744ba932772883b1e16b89de939f Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 13:40:01 -0600 Subject: [PATCH 063/124] that was the wrong wildcard. maybe this? --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index baae7b3ae..f4dd769a2 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -171,7 +171,7 @@ jobs: run: | raco exe --embed-dlls --orig-exe scheme-libs/racket/unison-runtime.rkt mkdir runtime - raco distribute runtime scheme-libs/racket/unison-runtime* + raco distribute runtime scheme-libs/racket/unison-runtime{,.exe} ls -l runtime/ - name: upload unison-runtime uses: actions/upload-artifact@v4 From 137eebdfbfa067edb36743f3eeaa4f99f3eeaeaa Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 14:07:48 -0600 Subject: [PATCH 064/124] that was not how. maybe this? --- .github/workflows/bundle-ucm.yaml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index f4dd769a2..b3e3c1fae 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -171,7 +171,8 @@ jobs: run: | raco exe --embed-dlls --orig-exe scheme-libs/racket/unison-runtime.rkt mkdir runtime - raco distribute runtime scheme-libs/racket/unison-runtime{,.exe} + if [[ ${{runner.os}} = 'Windows' ]]; then exe=".exe"; else exe=""; fi + raco distribute runtime scheme-libs/racket/unison-runtime$exe ls -l runtime/ - name: upload unison-runtime uses: actions/upload-artifact@v4 From 1c9090ed9e496071b1a8bccc194d902d7e7ce064 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 14:49:06 -0600 Subject: [PATCH 065/124] don't try to include a `.zip.CHECKSUM` that was part of the unison racket lib dist --- .github/workflows/pre-release.yaml | 5 ++--- .github/workflows/release.yaml | 4 ++-- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index e31dbcadd..99ee2ed30 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -41,6 +41,5 @@ jobs: prerelease: true title: Development Build files: | - /tmp/ucm/**/*.tar.gz - /tmp/ucm/**/*.zip - /tmp/ucm/**/*.zip.CHECKSUM + /tmp/ucm/**/ucm-*.tar.gz + /tmp/ucm/**/ucm-*.zip diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml index e5d8a1118..ebe738271 100644 --- a/.github/workflows/release.yaml +++ b/.github/workflows/release.yaml @@ -47,7 +47,7 @@ jobs: if [ -z "$prev_tag" ]; then echo "No previous release found"; exit 1; fi echo "Creating a release from these artifacts:" - ls -R /tmp/ucm/**/ucm-*.{zip,tar.gz,zip.CHECKSUM} + ls -R /tmp/ucm/**/ucm-*.{zip,tar.gz} gh release create "release/${{inputs.version}}" \ --repo unisonweb/unison \ @@ -55,4 +55,4 @@ jobs: --generate-notes \ --notes-start-tag "${prev_tag}" \ \ - /tmp/ucm/**/ucm-*.{zip,tar.gz,zip.CHECKSUM} + /tmp/ucm/**/ucm-*.{zip,tar.gz} From d8e1bed518f4d2ccebb5897f90bbf51d8e9c1dd7 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sat, 23 Mar 2024 15:24:20 -0600 Subject: [PATCH 066/124] missed another `if` re bundling jit for windows --- .github/workflows/bundle-ucm.yaml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index b3e3c1fae..e1922e7fd 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -211,7 +211,6 @@ jobs: name: racket-lib path: ${{env.staging_dir}}/racket/ - name: download unison-runtime - if: runner.os != 'Windows' uses: actions/download-artifact@v4 with: name: unison-runtime-${{matrix.os}} From 7ae31b85232609ed5fc57cc73fbcf7f29c630ac6 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sun, 24 Mar 2024 11:01:10 -0600 Subject: [PATCH 067/124] split TH parts of unison-cli into unison-cli-main to minimize the amount that needs to be rebuilt when we just want to make sure the `Version` is current --- unison-cli-main/LICENSE | 19 + .../IntegrationTests/ArgumentParsing.hs | 0 .../IntegrationTests/print.u | 0 .../IntegrationTests/transcript.md | 0 .../IntegrationTests/transcript.output.md | 0 .../integration-tests/Suite.hs | 0 unison-cli-main/package.yaml | 82 ++++ unison-cli-main/unison-cli-main.cabal | 127 +++++ unison-cli-main/unison/Main.hs | 15 + .../unison/Version.hs | 12 +- unison-cli/package.yaml | 63 +-- unison-cli/unison-cli.cabal | 434 +++++++----------- unison-cli/unison/{ => Unison}/Main.hs | 53 ++- unison-cli/unison/Unison/Version.hs | 12 + 14 files changed, 471 insertions(+), 346 deletions(-) create mode 100644 unison-cli-main/LICENSE rename {unison-cli => unison-cli-main}/integration-tests/IntegrationTests/ArgumentParsing.hs (100%) rename {unison-cli => unison-cli-main}/integration-tests/IntegrationTests/print.u (100%) rename {unison-cli => unison-cli-main}/integration-tests/IntegrationTests/transcript.md (100%) rename {unison-cli => unison-cli-main}/integration-tests/IntegrationTests/transcript.output.md (100%) rename {unison-cli => unison-cli-main}/integration-tests/Suite.hs (100%) create mode 100644 unison-cli-main/package.yaml create mode 100644 unison-cli-main/unison-cli-main.cabal create mode 100644 unison-cli-main/unison/Main.hs rename {unison-cli => unison-cli-main}/unison/Version.hs (87%) rename unison-cli/unison/{ => Unison}/Main.hs (93%) create mode 100644 unison-cli/unison/Unison/Version.hs diff --git a/unison-cli-main/LICENSE b/unison-cli-main/LICENSE new file mode 100644 index 000000000..a89d63138 --- /dev/null +++ b/unison-cli-main/LICENSE @@ -0,0 +1,19 @@ +Copyright (c) 2021, Unison Computing, public benefit corp and contributors + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/unison-cli/integration-tests/IntegrationTests/ArgumentParsing.hs b/unison-cli-main/integration-tests/IntegrationTests/ArgumentParsing.hs similarity index 100% rename from unison-cli/integration-tests/IntegrationTests/ArgumentParsing.hs rename to unison-cli-main/integration-tests/IntegrationTests/ArgumentParsing.hs diff --git a/unison-cli/integration-tests/IntegrationTests/print.u b/unison-cli-main/integration-tests/IntegrationTests/print.u similarity index 100% rename from unison-cli/integration-tests/IntegrationTests/print.u rename to unison-cli-main/integration-tests/IntegrationTests/print.u diff --git a/unison-cli/integration-tests/IntegrationTests/transcript.md b/unison-cli-main/integration-tests/IntegrationTests/transcript.md similarity index 100% rename from unison-cli/integration-tests/IntegrationTests/transcript.md rename to unison-cli-main/integration-tests/IntegrationTests/transcript.md diff --git a/unison-cli/integration-tests/IntegrationTests/transcript.output.md b/unison-cli-main/integration-tests/IntegrationTests/transcript.output.md similarity index 100% rename from unison-cli/integration-tests/IntegrationTests/transcript.output.md rename to unison-cli-main/integration-tests/IntegrationTests/transcript.output.md diff --git a/unison-cli/integration-tests/Suite.hs b/unison-cli-main/integration-tests/Suite.hs similarity index 100% rename from unison-cli/integration-tests/Suite.hs rename to unison-cli-main/integration-tests/Suite.hs diff --git a/unison-cli-main/package.yaml b/unison-cli-main/package.yaml new file mode 100644 index 000000000..cf10ac1e3 --- /dev/null +++ b/unison-cli-main/package.yaml @@ -0,0 +1,82 @@ +name: unison-cli-main +github: unisonweb/unison +copyright: Copyright (C) 2013-2018 Unison Computing, PBC and contributors + +flags: + optimized: + manual: true + default: false + +ghc-options: -Wall + +executables: + unison: + when: + - condition: false + other-modules: Paths_unison_cli_main + source-dirs: unison + main: Main.hs + ghc-options: -threaded -rtsopts "-with-rtsopts=-I0 -N -qn4 -qg1 -T" -optP-Wno-nonportable-include-path + dependencies: + - base + - shellmet + - template-haskell + - text + - unison-cli + + cli-integration-tests: + when: + - condition: false + other-modules: Paths_unison_cli_main + source-dirs: integration-tests + main: Suite.hs + ghc-options: -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0 + dependencies: + - base + - code-page + - filepath + - directory + - easytest + - process + - shellmet + - time + build-tools: + - unison-cli-main:unison + +when: + - condition: flag(optimized) + ghc-options: -O2 -funbox-strict-fields + +default-extensions: + - ApplicativeDo + - BangPatterns + - BlockArguments + - DeriveAnyClass + - DeriveFunctor + - DeriveFoldable + - DeriveTraversable + - DeriveGeneric + - DerivingStrategies + - DerivingVia + - DoAndIfThenElse + - DuplicateRecordFields + - FlexibleContexts + - FlexibleInstances + - GADTs + - GeneralizedNewtypeDeriving + - ImportQualifiedPost + - InstanceSigs + - KindSignatures + - LambdaCase + - MultiParamTypeClasses + - MultiWayIf + - NamedFieldPuns + - NumericUnderscores + - OverloadedLabels + - OverloadedStrings + - PatternSynonyms + - RankNTypes + - ScopedTypeVariables + - TupleSections + - TypeApplications + - ViewPatterns diff --git a/unison-cli-main/unison-cli-main.cabal b/unison-cli-main/unison-cli-main.cabal new file mode 100644 index 000000000..a16bf1f78 --- /dev/null +++ b/unison-cli-main/unison-cli-main.cabal @@ -0,0 +1,127 @@ +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-cli-main +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 +license: MIT +license-file: LICENSE +build-type: Simple + +source-repository head + type: git + location: https://github.com/unisonweb/unison + +flag optimized + manual: True + default: False + +executable cli-integration-tests + main-is: Suite.hs + other-modules: + IntegrationTests.ArgumentParsing + hs-source-dirs: + integration-tests + default-extensions: + ApplicativeDo + BangPatterns + BlockArguments + DeriveAnyClass + DeriveFunctor + DeriveFoldable + DeriveTraversable + DeriveGeneric + DerivingStrategies + DerivingVia + DoAndIfThenElse + DuplicateRecordFields + FlexibleContexts + FlexibleInstances + GADTs + GeneralizedNewtypeDeriving + ImportQualifiedPost + InstanceSigs + KindSignatures + LambdaCase + MultiParamTypeClasses + MultiWayIf + NamedFieldPuns + NumericUnderscores + OverloadedLabels + OverloadedStrings + PatternSynonyms + RankNTypes + ScopedTypeVariables + TupleSections + TypeApplications + ViewPatterns + ghc-options: -Wall -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0 + build-tools: + unison + build-depends: + base + , code-page + , directory + , easytest + , filepath + , process + , shellmet + , time + default-language: Haskell2010 + if flag(optimized) + ghc-options: -O2 -funbox-strict-fields + +executable unison + main-is: Main.hs + other-modules: + Version + hs-source-dirs: + unison + default-extensions: + ApplicativeDo + BangPatterns + BlockArguments + DeriveAnyClass + DeriveFunctor + DeriveFoldable + DeriveTraversable + DeriveGeneric + DerivingStrategies + DerivingVia + DoAndIfThenElse + DuplicateRecordFields + FlexibleContexts + FlexibleInstances + GADTs + GeneralizedNewtypeDeriving + ImportQualifiedPost + InstanceSigs + KindSignatures + LambdaCase + MultiParamTypeClasses + MultiWayIf + NamedFieldPuns + NumericUnderscores + OverloadedLabels + OverloadedStrings + PatternSynonyms + RankNTypes + ScopedTypeVariables + TupleSections + TypeApplications + ViewPatterns + ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-I0 -N -qn4 -qg1 -T" -optP-Wno-nonportable-include-path + build-depends: + base + , shellmet + , template-haskell + , text + , unison-cli + default-language: Haskell2010 + if flag(optimized) + ghc-options: -O2 -funbox-strict-fields diff --git a/unison-cli-main/unison/Main.hs b/unison-cli-main/unison/Main.hs new file mode 100644 index 000000000..ba32d0b1c --- /dev/null +++ b/unison-cli-main/unison/Main.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -Wno-partial-type-signatures #-} + +module Main (main) where + +import Unison.Main qualified +import Version (version) + +main :: IO () +main = Unison.Main.main version diff --git a/unison-cli/unison/Version.hs b/unison-cli-main/unison/Version.hs similarity index 87% rename from unison-cli/unison/Version.hs rename to unison-cli-main/unison/Version.hs index a879b5d7d..f9c0d420f 100644 --- a/unison-cli/unison/Version.hs +++ b/unison-cli-main/unison/Version.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -module Version where +module Version (version) where import Data.Bifunctor import Data.Text @@ -9,6 +9,10 @@ import Data.Text qualified as Text import Language.Haskell.TH (Exp (TupE), runIO) import Language.Haskell.TH.Syntax (Exp (LitE), Lit (StringL)) import Shellmet +import Unison.Version (CommitDate, GitRef, Version (Version)) + +version :: Version +version = Version gitDescribeWithDate gitDescribe -- | A formatted descriptor of when and against which commit this unison executable was built -- E.g. latest-149-g5cef8f851 (built on 2021-10-04) @@ -16,13 +20,9 @@ import Shellmet gitDescribeWithDate :: Text gitDescribeWithDate = let formatDate d = " (built on " <> d <> ")" - (gitRef, date) = gitDescribe + (gitRef, date) = Version.gitDescribe in gitRef <> formatDate date -type CommitDate = Text - -type GitRef = Text - -- | Uses Template Haskell to embed a git descriptor of the commit -- which was used to build the executable. -- E.g. latest-149-g5cef8f851 (built on 2021-10-04) diff --git a/unison-cli/package.yaml b/unison-cli/package.yaml index b78dc81e5..9a0179d17 100644 --- a/unison-cli/package.yaml +++ b/unison-cli/package.yaml @@ -19,6 +19,7 @@ dependencies: - base - bytes - bytestring + - code-page - concurrent-output - configurator - containers >= 0.6.3 @@ -54,6 +55,7 @@ dependencies: - uri-encode - nonempty-containers - open-browser + - optparse-applicative >= 0.16.1.0 - pretty-simple - process - random >= 1.2.0 @@ -64,7 +66,10 @@ dependencies: - semigroups - servant - servant-client + - shellmet - stm + - template-haskell + - temporary - text - text-builder - text-rope @@ -98,13 +103,24 @@ dependencies: - witch - witherable +internal-libraries: + unison-cli-lib: + source-dirs: src + when: + - condition: "!os(windows)" + dependencies: unix + - condition: false + other-modules: Paths_unison_cli + library: - source-dirs: src - when: - - condition: '!os(windows)' - dependencies: unix - - condition: false - other-modules: Paths_unison_cli + source-dirs: unison + dependencies: + - code-page + - optparse-applicative >= 0.16.1.0 + - shellmet + - template-haskell + - temporary + - unison-cli-lib tests: cli-tests: @@ -117,26 +133,11 @@ tests: - here - shellmet - temporary - - unison-cli + - unison-cli-lib main: Main.hs source-dirs: tests executables: - unison: - when: - - condition: false - other-modules: Paths_unison_cli - source-dirs: unison - main: Main.hs - ghc-options: -threaded -rtsopts "-with-rtsopts=-I0 -N -qn4 -qg1 -T" -optP-Wno-nonportable-include-path - dependencies: - - code-page - - optparse-applicative >= 0.16.1.0 - - shellmet - - template-haskell - - temporary - - unison-cli - transcripts: when: - condition: false @@ -149,25 +150,9 @@ executables: - easytest - process - shellmet - - unison-cli + - unison-cli-lib - silently - cli-integration-tests: - when: - - condition: false - other-modules: Paths_unison_cli - source-dirs: integration-tests - main: Suite.hs - ghc-options: -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0 - dependencies: - - code-page - - easytest - - process - - shellmet - - time - build-tools: - - unison-cli:unison - when: - condition: flag(optimized) ghc-options: -O2 -funbox-strict-fields diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index fa6585699..90e8246cd 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -1,6 +1,6 @@ -cabal-version: 1.12 +cabal-version: 2.0 --- 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 @@ -22,6 +22,150 @@ flag optimized default: False library + exposed-modules: + ArgParse + Stats + System.Path + Unison.Main + Unison.Version + other-modules: + Paths_unison_cli + autogen-modules: + Paths_unison_cli + hs-source-dirs: + unison + default-extensions: + ApplicativeDo + BangPatterns + BlockArguments + DeriveAnyClass + DeriveFunctor + DeriveFoldable + DeriveTraversable + DeriveGeneric + DerivingStrategies + DerivingVia + DoAndIfThenElse + DuplicateRecordFields + FlexibleContexts + FlexibleInstances + GADTs + GeneralizedNewtypeDeriving + ImportQualifiedPost + InstanceSigs + KindSignatures + LambdaCase + MultiParamTypeClasses + MultiWayIf + NamedFieldPuns + NumericUnderscores + OverloadedLabels + OverloadedStrings + PatternSynonyms + RankNTypes + ScopedTypeVariables + TupleSections + TypeApplications + ViewPatterns + ghc-options: -Wall + build-depends: + IntervalMap + , ListLike + , aeson >=2.0.0.0 + , aeson-pretty + , ansi-terminal + , async + , base + , bytes + , bytestring + , co-log-core + , code-page + , concurrent-output + , configurator + , containers >=0.6.3 + , cryptonite + , directory + , either + , errors + , exceptions + , extra + , filepath + , free + , friendly-time + , fsnotify + , fuzzyfind + , generic-lens + , haskeline + , http-client >=0.7.6 + , http-client-tls + , http-types + , jwt + , ki + , lens + , lock-file + , lsp >=2.2.0.0 + , lsp-types >=2.0.2.0 + , megaparsec + , memory + , mtl + , network + , network-simple + , network-uri + , nonempty-containers + , open-browser + , optparse-applicative >=0.16.1.0 + , pretty-simple + , process + , random >=1.2.0 + , random-shuffle + , recover-rtti + , regex-tdfa + , semialign + , semigroups + , servant + , servant-client + , shellmet + , stm + , template-haskell + , temporary + , text + , text-builder + , text-rope + , these + , these-lens + , time + , transformers + , unison-cli-lib + , unison-codebase + , unison-codebase-sqlite + , unison-codebase-sqlite-hashing-v2 + , unison-core + , unison-core1 + , unison-hash + , unison-parser-typechecker + , unison-prelude + , unison-pretty-printer + , unison-share-api + , unison-share-projects-api + , unison-sqlite + , unison-syntax + , unison-util-base32hex + , unison-util-nametree + , unison-util-relation + , unliftio + , unordered-containers + , uri-encode + , uuid + , vector + , wai + , warp + , witch + , witherable + default-language: Haskell2010 + if flag(optimized) + ghc-options: -O2 -funbox-strict-fields + +library unison-cli-lib exposed-modules: Compat Unison.Auth.CredentialFile @@ -179,6 +323,7 @@ library , bytes , bytestring , co-log-core + , code-page , concurrent-output , configurator , containers >=0.6.3 @@ -212,6 +357,7 @@ library , network-uri , nonempty-containers , open-browser + , optparse-applicative >=0.16.1.0 , pretty-simple , process , random >=1.2.0 @@ -222,7 +368,10 @@ library , semigroups , servant , servant-client + , shellmet , stm + , template-haskell + , temporary , text , text-builder , text-rope @@ -262,142 +411,6 @@ library build-depends: unix -executable cli-integration-tests - main-is: Suite.hs - other-modules: - IntegrationTests.ArgumentParsing - hs-source-dirs: - integration-tests - default-extensions: - ApplicativeDo - BangPatterns - BlockArguments - DeriveAnyClass - DeriveFunctor - DeriveFoldable - DeriveTraversable - DeriveGeneric - DerivingStrategies - DerivingVia - DoAndIfThenElse - DuplicateRecordFields - FlexibleContexts - FlexibleInstances - GADTs - GeneralizedNewtypeDeriving - ImportQualifiedPost - InstanceSigs - KindSignatures - LambdaCase - MultiParamTypeClasses - MultiWayIf - NamedFieldPuns - NumericUnderscores - OverloadedLabels - OverloadedStrings - PatternSynonyms - RankNTypes - ScopedTypeVariables - TupleSections - TypeApplications - ViewPatterns - ghc-options: -Wall -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0 - build-tools: - unison - build-depends: - IntervalMap - , ListLike - , aeson >=2.0.0.0 - , aeson-pretty - , ansi-terminal - , async - , base - , bytes - , bytestring - , co-log-core - , code-page - , concurrent-output - , configurator - , containers >=0.6.3 - , cryptonite - , directory - , easytest - , either - , errors - , exceptions - , extra - , filepath - , free - , friendly-time - , fsnotify - , fuzzyfind - , generic-lens - , haskeline - , http-client >=0.7.6 - , http-client-tls - , http-types - , jwt - , ki - , lens - , lock-file - , lsp >=2.2.0.0 - , lsp-types >=2.0.2.0 - , megaparsec - , memory - , mtl - , network - , network-simple - , network-uri - , nonempty-containers - , open-browser - , pretty-simple - , process - , random >=1.2.0 - , random-shuffle - , recover-rtti - , regex-tdfa - , semialign - , semigroups - , servant - , servant-client - , shellmet - , stm - , text - , text-builder - , text-rope - , these - , these-lens - , time - , transformers - , unison-codebase - , unison-codebase-sqlite - , unison-codebase-sqlite-hashing-v2 - , unison-core - , unison-core1 - , unison-hash - , unison-parser-typechecker - , unison-prelude - , unison-pretty-printer - , unison-share-api - , unison-share-projects-api - , unison-sqlite - , unison-syntax - , unison-util-base32hex - , unison-util-nametree - , unison-util-relation - , unliftio - , unordered-containers - , uri-encode - , uuid - , vector - , wai - , warp - , witch - , witherable - default-language: Haskell2010 - if flag(optimized) - ghc-options: -O2 -funbox-strict-fields - executable transcripts main-is: Transcripts.hs hs-source-dirs: @@ -482,6 +495,7 @@ executable transcripts , network-uri , nonempty-containers , open-browser + , optparse-applicative >=0.16.1.0 , pretty-simple , process , random >=1.2.0 @@ -495,144 +509,6 @@ executable transcripts , shellmet , silently , stm - , text - , text-builder - , text-rope - , these - , these-lens - , time - , transformers - , unison-cli - , unison-codebase - , unison-codebase-sqlite - , unison-codebase-sqlite-hashing-v2 - , unison-core - , unison-core1 - , unison-hash - , unison-parser-typechecker - , unison-prelude - , unison-pretty-printer - , unison-share-api - , unison-share-projects-api - , unison-sqlite - , unison-syntax - , unison-util-base32hex - , unison-util-nametree - , unison-util-relation - , unliftio - , unordered-containers - , uri-encode - , uuid - , vector - , wai - , warp - , witch - , witherable - default-language: Haskell2010 - if flag(optimized) - ghc-options: -O2 -funbox-strict-fields - -executable unison - main-is: Main.hs - other-modules: - ArgParse - Stats - System.Path - Version - hs-source-dirs: - unison - default-extensions: - ApplicativeDo - BangPatterns - BlockArguments - DeriveAnyClass - DeriveFunctor - DeriveFoldable - DeriveTraversable - DeriveGeneric - DerivingStrategies - DerivingVia - DoAndIfThenElse - DuplicateRecordFields - FlexibleContexts - FlexibleInstances - GADTs - GeneralizedNewtypeDeriving - ImportQualifiedPost - InstanceSigs - KindSignatures - LambdaCase - MultiParamTypeClasses - MultiWayIf - NamedFieldPuns - NumericUnderscores - OverloadedLabels - OverloadedStrings - PatternSynonyms - RankNTypes - ScopedTypeVariables - TupleSections - TypeApplications - ViewPatterns - ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-I0 -N -qn4 -qg1 -T" -optP-Wno-nonportable-include-path - build-depends: - IntervalMap - , ListLike - , aeson >=2.0.0.0 - , aeson-pretty - , ansi-terminal - , async - , base - , bytes - , bytestring - , co-log-core - , code-page - , concurrent-output - , configurator - , containers >=0.6.3 - , cryptonite - , directory - , either - , errors - , exceptions - , extra - , filepath - , free - , friendly-time - , fsnotify - , fuzzyfind - , generic-lens - , haskeline - , http-client >=0.7.6 - , http-client-tls - , http-types - , jwt - , ki - , lens - , lock-file - , lsp >=2.2.0.0 - , lsp-types >=2.0.2.0 - , megaparsec - , memory - , mtl - , network - , network-simple - , network-uri - , nonempty-containers - , open-browser - , optparse-applicative >=0.16.1.0 - , pretty-simple - , process - , random >=1.2.0 - , random-shuffle - , recover-rtti - , regex-tdfa - , semialign - , semigroups - , servant - , servant-client - , shellmet - , stm , template-haskell , temporary , text @@ -642,7 +518,7 @@ executable unison , these-lens , time , transformers - , unison-cli + , unison-cli-lib , unison-codebase , unison-codebase-sqlite , unison-codebase-sqlite-hashing-v2 @@ -765,6 +641,7 @@ test-suite cli-tests , network-uri , nonempty-containers , open-browser + , optparse-applicative >=0.16.1.0 , pretty-simple , process , random >=1.2.0 @@ -777,6 +654,7 @@ test-suite cli-tests , servant-client , shellmet , stm + , template-haskell , temporary , text , text-builder @@ -785,7 +663,7 @@ test-suite cli-tests , these-lens , time , transformers - , unison-cli + , unison-cli-lib , unison-codebase , unison-codebase-sqlite , unison-codebase-sqlite-hashing-v2 diff --git a/unison-cli/unison/Main.hs b/unison-cli/unison/Unison/Main.hs similarity index 93% rename from unison-cli/unison/Main.hs rename to unison-cli/unison/Unison/Main.hs index 09b702e7e..32e829c0b 100644 --- a/unison-cli/unison/Main.hs +++ b/unison-cli/unison/Unison/Main.hs @@ -6,7 +6,7 @@ {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-partial-type-signatures #-} -module Main +module Unison.Main ( main, ) where @@ -89,9 +89,10 @@ import Unison.Server.Backend qualified as Backend import Unison.Server.CodebaseServer qualified as Server import Unison.Symbol (Symbol) import Unison.Util.Pretty qualified as P +import Unison.Version (Version) +import Unison.Version qualified as Version import UnliftIO qualified import UnliftIO.Directory (getHomeDirectory) -import Version qualified type Runtimes = (RTI.Runtime Symbol, RTI.Runtime Symbol, RTI.Runtime Symbol) @@ -102,8 +103,8 @@ fixNativeRuntimePath override = do let ucr = takeDirectory ucm "runtime" "unison-runtime" <.> exeExtension pure $ maybe ucr id override -main :: IO () -main = do +main :: Version -> IO () +main version = do -- Replace the default exception handler with one complains loudly, because we shouldn't have any uncaught exceptions. -- Sometimes `show` and `displayException` are different strings; in this case, we want to show them both, so this -- issue is easier to debug. @@ -131,17 +132,17 @@ main = do withCP65001 . runInUnboundThread . Ki.scoped $ \scope -> do interruptHandler <- defaultInterruptHandler withInterruptHandler interruptHandler $ do - void $ Ki.fork scope initHTTPClient + void $ Ki.fork scope (initHTTPClient version) progName <- getProgName -- hSetBuffering stdout NoBuffering -- cool - (renderUsageInfo, globalOptions, command) <- parseCLIArgs progName (Text.unpack Version.gitDescribeWithDate) + (renderUsageInfo, globalOptions, command) <- parseCLIArgs progName (Text.unpack (Version.gitDescribeWithDate version)) nrtp <- fixNativeRuntimePath (nativeRuntimePath globalOptions) let GlobalOptions {codebasePathOption = mCodePathOption, exitOption, lspFormattingConfig} = globalOptions withConfig mCodePathOption \config -> do currentDir <- getCurrentDirectory case command of PrintVersion -> - Text.putStrLn $ Text.pack progName <> " version: " <> Version.gitDescribeWithDate + Text.putStrLn $ Text.pack progName <> " version: " <> Version.gitDescribeWithDate version Init -> do exitError ( P.lines @@ -156,7 +157,7 @@ main = do ) Run (RunFromSymbol mainName) args -> do getCodebaseOrExit mCodePathOption (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(_, _, theCodebase) -> do - RTI.withRuntime False RTI.OneOff Version.gitDescribeWithDate \runtime -> do + RTI.withRuntime False RTI.OneOff (Version.gitDescribeWithDate version) \runtime -> do withArgs args (execute theCodebase runtime mainName) >>= \case Left err -> exitError err Right () -> pure () @@ -175,6 +176,7 @@ main = do let serverUrl = Nothing let startPath = Nothing launch + version currentDir config rt @@ -201,6 +203,7 @@ main = do let serverUrl = Nothing let startPath = Nothing launch + version currentDir config rt @@ -244,7 +247,7 @@ main = do Left err -> exitError err Right () -> pure () where - vmatch = v == Version.gitDescribeWithDate + vmatch = v == Version.gitDescribeWithDate version ws s = P.wrap (P.text s) ifile | 'c' : 'u' : '.' : rest <- reverse file = reverse rest @@ -260,7 +263,7 @@ main = do P.indentN 4 $ P.text v, "", "Your version", - P.indentN 4 $ P.text Version.gitDescribeWithDate, + P.indentN 4 $ P.text $ Version.gitDescribeWithDate version, "", P.wrap $ "The program was compiled from hash " @@ -279,7 +282,7 @@ main = do \that matches your version of Unison." ] Transcript shouldFork shouldSaveCodebase mrtsStatsFp transcriptFiles -> do - let action = runTranscripts Verbosity.Verbose renderUsageInfo shouldFork shouldSaveCodebase mCodePathOption nrtp transcriptFiles + let action = runTranscripts version Verbosity.Verbose renderUsageInfo shouldFork shouldSaveCodebase mCodePathOption nrtp transcriptFiles case mrtsStatsFp of Nothing -> action Just fp -> recordRtsStats fp action @@ -334,6 +337,7 @@ main = do PT.putPrettyLn $ P.string "Now starting the Unison Codebase Manager (UCM)..." launch + version currentDir config runtime @@ -352,11 +356,11 @@ main = do -- (runtime, sandboxed runtime) withRuntimes :: FilePath -> RTI.RuntimeHost -> (Runtimes -> IO a) -> IO a withRuntimes nrtp mode action = - RTI.withRuntime False mode Version.gitDescribeWithDate \runtime -> do - RTI.withRuntime True mode Version.gitDescribeWithDate \sbRuntime -> + RTI.withRuntime False mode (Version.gitDescribeWithDate version) \runtime -> do + RTI.withRuntime True mode (Version.gitDescribeWithDate version) \sbRuntime -> action . (runtime,sbRuntime,) -- startNativeRuntime saves the path to `unison-runtime` - =<< RTI.startNativeRuntime Version.gitDescribeWithDate nrtp + =<< RTI.startNativeRuntime (Version.gitDescribeWithDate version) nrtp withConfig :: Maybe CodebasePathOption -> (Config -> IO a) -> IO a withConfig mCodePathOption action = do UnliftIO.bracket @@ -371,9 +375,9 @@ main = do -- | Set user agent and configure TLS on global http client. -- Note that the authorized http client is distinct from the global http client. -initHTTPClient :: IO () -initHTTPClient = do - let (ucmVersion, _date) = Version.gitDescribe +initHTTPClient :: Version -> IO () +initHTTPClient version = do + let (ucmVersion, _date) = Version.gitDescribe version let userAgent = Text.encodeUtf8 $ "UCM/" <> ucmVersion let addUserAgent req = do pure $ req {HTTP.requestHeaders = ("User-Agent", userAgent) : HTTP.requestHeaders req} @@ -405,18 +409,19 @@ prepareTranscriptDir verbosity shouldFork mCodePathOption shouldSaveCodebase = d pure tmp runTranscripts' :: + Version -> String -> Maybe FilePath -> FilePath -> FilePath -> NonEmpty MarkdownFile -> IO Bool -runTranscripts' progName mcodepath nativeRtp transcriptDir markdownFiles = do +runTranscripts' version progName mcodepath nativeRtp transcriptDir markdownFiles = do currentDir <- getCurrentDirectory configFilePath <- getConfigFilePath mcodepath -- We don't need to create a codebase through `getCodebaseOrExit` as we've already done so previously. and <$> getCodebaseOrExit (Just (DontCreateCodebaseWhenMissing transcriptDir)) (SC.MigrateAutomatically SC.Backup SC.Vacuum) \(_, codebasePath, theCodebase) -> do - TR.withTranscriptRunner Verbosity.Verbose Version.gitDescribeWithDate nativeRtp (Just configFilePath) $ \runTranscript -> do + TR.withTranscriptRunner Verbosity.Verbose (Version.gitDescribeWithDate version) nativeRtp (Just configFilePath) $ \runTranscript -> do for markdownFiles $ \(MarkdownFile fileName) -> do transcriptSrc <- readUtf8 fileName result <- runTranscript fileName transcriptSrc (codebasePath, theCodebase) @@ -459,6 +464,7 @@ runTranscripts' progName mcodepath nativeRtp transcriptDir markdownFiles = do pure succeeded runTranscripts :: + Version -> Verbosity.Verbosity -> UsageRenderer -> ShouldForkCodebase -> @@ -467,7 +473,7 @@ runTranscripts :: FilePath -> NonEmpty String -> IO () -runTranscripts verbosity renderUsageInfo shouldFork shouldSaveTempCodebase mCodePathOption nativeRtp args = do +runTranscripts version verbosity renderUsageInfo shouldFork shouldSaveTempCodebase mCodePathOption nativeRtp args = do markdownFiles <- case traverse (first (pure @[]) . markdownFile) args of Failure invalidArgs -> do PT.putPrettyLn $ @@ -485,7 +491,7 @@ runTranscripts verbosity renderUsageInfo shouldFork shouldSaveTempCodebase mCode progName <- getProgName transcriptDir <- prepareTranscriptDir verbosity shouldFork mCodePathOption shouldSaveTempCodebase completed <- - runTranscripts' progName (Just transcriptDir) nativeRtp transcriptDir markdownFiles + runTranscripts' version progName (Just transcriptDir) nativeRtp transcriptDir markdownFiles case shouldSaveTempCodebase of DontSaveCodebase -> removeDirectoryRecursive transcriptDir SaveCodebase _ -> @@ -510,6 +516,7 @@ defaultInitialPath :: Path.Absolute defaultInitialPath = Path.absoluteEmpty launch :: + Version -> FilePath -> Config -> Rt.Runtime Symbol -> @@ -524,12 +531,12 @@ launch :: (Path.Absolute -> STM ()) -> CommandLine.ShouldWatchFiles -> IO () -launch dir config runtime sbRuntime nRuntime codebase inputs serverBaseUrl mayStartingPath initResult notifyRootChange notifyPathChange shouldWatchFiles = do +launch version dir config runtime sbRuntime nRuntime codebase inputs serverBaseUrl mayStartingPath initResult notifyRootChange notifyPathChange shouldWatchFiles = do showWelcomeHint <- Codebase.runTransaction codebase Queries.doProjectsExist let isNewCodebase = case initResult of CreatedCodebase -> NewlyCreatedCodebase OpenedCodebase -> PreviouslyCreatedCodebase - (ucmVersion, _date) = Version.gitDescribe + (ucmVersion, _date) = Version.gitDescribe version welcome = Welcome.welcome isNewCodebase ucmVersion showWelcomeHint in CommandLine.main dir diff --git a/unison-cli/unison/Unison/Version.hs b/unison-cli/unison/Unison/Version.hs new file mode 100644 index 000000000..ce24e6a48 --- /dev/null +++ b/unison-cli/unison/Unison/Version.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Unison.Version where + +import Data.Text (Text) + +data Version = Version {gitDescribeWithDate :: Text, gitDescribe :: (GitRef, CommitDate)} + +type CommitDate = Text + +type GitRef = Text From 0e7ea3f2bbe6c928b1edc07facb24e9c414e9a24 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sun, 24 Mar 2024 11:36:22 -0600 Subject: [PATCH 068/124] some auto-format? not sure when this happened --- .github/workflows/bundle-ucm.yaml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index e1922e7fd..9d3f68a11 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -105,9 +105,9 @@ jobs: ${{ env.ucm }} transcript unison-src/transcripts-manual/gen-racket-libs.md - uses: Bogdanp/setup-racket@v1.11 with: - architecture: 'x64' - distribution: 'full' - variant: 'CS' + architecture: "x64" + distribution: "full" + variant: "CS" version: ${{env.racket_version}} - name: create racket lib run: | @@ -155,9 +155,9 @@ jobs: key: ${{ runner.os }}-racket-${{env.racket_version}}-${{hashFiles('scheme-libs/racket/unison.zip')}} - uses: Bogdanp/setup-racket@v1.11 with: - architecture: 'x64' - distribution: 'full' - variant: 'CS' + architecture: "x64" + distribution: "full" + variant: "CS" version: ${{env.racket_version}} - uses: awalsh128/cache-apt-pkgs-action@latest if: runner.os == 'Linux' From d76a00d8501f2a49ed2abe28d0c6b7ec928c49cc Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sun, 24 Mar 2024 11:36:56 -0600 Subject: [PATCH 069/124] set +x on non-windows executables --- .github/workflows/bundle-ucm.yaml | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 9d3f68a11..1deec55ce 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -203,6 +203,8 @@ jobs: with: name: unison-${{matrix.os}} path: ${{env.staging_dir}}/ + - name: restore permissions on ucm + run: chmod +x ${{env.staging_dir}}/unison - name: rename unison -> ucm run: mv ${{env.staging_dir}}/unison ${{env.staging_dir}}/ucm - name: download racket lib @@ -215,12 +217,17 @@ jobs: with: name: unison-runtime-${{matrix.os}} path: ${{env.staging_dir}}/runtime - - name: fetch latest Unison Local UI and package with ucm + - name: restore permissions on unison-runtime + if: ${{runner.os}} != 'Windows' + run: chmod +x ${{env.staging_dir}}/runtime/bin/unison-runtime + - name: download latest unison-local-ui run: | - ls -l `find ${{env.staging_dir}}` curl -L -o /tmp/unisonLocal.zip \ https://github.com/unisonweb/unison-local-ui/releases/download/latest/unisonLocal.zip unzip -d ${{env.staging_dir}}/ui /tmp/unisonLocal.zip + - name: package everything together + run: | + ls -l `find ${{env.staging_dir}}` if [[ ${{runner.os}} = 'Windows' ]]; then artifact_archive=ucm-${{env.artifact_os}}.zip From faeb372c9084f2927a455b4d5df30c037c666771 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sun, 24 Mar 2024 11:38:37 -0600 Subject: [PATCH 070/124] reset release action names --- .github/workflows/pre-release.yaml | 6 +++--- .github/workflows/release.yaml | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index 99ee2ed30..64b3a68d6 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -1,5 +1,5 @@ -name: pre-release v2 -run-name: pre-release v2 ${{inputs.version}} +name: pre-release +run-name: pre-release ${{inputs.version}} defaults: run: @@ -8,7 +8,7 @@ defaults: on: workflow_run: workflows: ["CI"] - branches: [ trunk ] + branches: [trunk] types: - completed workflow_dispatch: diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml index ebe738271..fbde4136d 100644 --- a/.github/workflows/release.yaml +++ b/.github/workflows/release.yaml @@ -1,6 +1,6 @@ -name: release v2 +name: release -run-name: release v2 ${{inputs.version}} +run-name: release ${{inputs.version}} defaults: run: From 5504f5e893b27170d8858e517d0e0fb5f773e5b1 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sun, 24 Mar 2024 11:39:17 -0600 Subject: [PATCH 071/124] add some more yaml notes unfortunately these tips are hard to remember, and also hard to document if you don't have the specific error message. all in all it would be best if the errors appeared in your editor, not at the end of a run --- docs/github-actions-help.md | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/docs/github-actions-help.md b/docs/github-actions-help.md index e760ce68b..888ed9435 100644 --- a/docs/github-actions-help.md +++ b/docs/github-actions-help.md @@ -1,9 +1,15 @@ ## Some things I wish I'd known about Github Actions -You can't have an `env:` key defined in terms of another `env` key, but +You can't have an `env:` key defined in terms of another `env` key, but you can use `$GITHUB_ENV` to get around this. You can't define a `matrix` at the top level, it has to be defined within a `job`'s `strategy`. +`runs-on:` doesn't allow `env` for some reason. + +Strings don't need quotes, unless you need to force something to be a string. + +A `@ref` is always needed on a remote action. + Windows doesn't seem to honor the `default: run: shell:` setting, so you need to set the `shell:` on `run:` manually? Don't hesitate to do a lot with `run:` blocks aka bash scripts — at least bash is mature and well documented. @@ -20,6 +26,14 @@ e.g. It's not clear to me when to use `$GITHUB_OUTPUT` vs `$GITHUB_ENV`, but I have been favoring `$GITHUB_ENV` because it requires fewer characters to access. However, it seems a little wrong. +### Job names + +Job names will automatically get `(${{matrix.os}})` if you don't use `${{matrix.os}}` somewhere in the name. + +### Windows + +The whole thing with `.exe` is a mess. Unix commands typically drop and add `.exe` correctly as needed, but Github Actions (e.g. `actions/upload-artifact`?) don't. + ### Cache When using the `cache` action, getting a cache hit on the primary key means you won't update the cache with any changes. @@ -34,6 +48,10 @@ Backup restore keys: "Is there a prior run that would be worth starting out from I suspect on Windows it can't support paths that select a drive in a Unix-y way, like `/c/asdf` or `/d/asdf`. It's got to be `C:/asdf` or `C:\asdf` etc. +Upload will complain if any + +Upload and Download plugin versions have to match. + ### Reusability Github supports splitting off "reusable workflows" (`jobs` that can be imported into another workflow), and "composite actions" (multi-step `steps` that can be imported into another `job`). @@ -42,6 +60,10 @@ Github supports splitting off "reusable workflows" (`jobs` that can be imported Needs to have `shell:` specified on every `run:` +#### Reusable workflows + +These have to be in `.github/workflows`, you can't organize them deeper, or elsewhere. + ### Reference Default Environment Variables: From a38e841791e47fe4172e8b7f80cb3631a0122608 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sun, 24 Mar 2024 11:47:30 -0600 Subject: [PATCH 072/124] one very important piece --- stack.yaml | 111 +++++++++++++++++++++++++++-------------------------- 1 file changed, 56 insertions(+), 55 deletions(-) diff --git a/stack.yaml b/stack.yaml index fbb7c62ee..5e7171467 100644 --- a/stack.yaml +++ b/stack.yaml @@ -8,67 +8,68 @@ build: interleaved-output: false packages: -- codebase2/codebase -- codebase2/codebase-sqlite -- codebase2/codebase-sqlite-hashing-v2 -- codebase2/codebase-sync -- codebase2/core -- codebase2/util-serialization -- codebase2/util-term -- lib/orphans/network-uri-orphans-sqlite -- lib/orphans/unison-core-orphans-sqlite -- lib/orphans/unison-hash-orphans-aeson -- lib/orphans/unison-hash-orphans-sqlite -- lib/orphans/uuid-orphans-sqlite -- lib/unison-hash -- lib/unison-hashing -- lib/unison-prelude -- lib/unison-pretty-printer -- lib/unison-sqlite -- lib/unison-util-base32hex -- 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 -- unison-cli -- unison-core -- unison-hashing-v2 -- unison-share-api -- unison-share-projects-api -- unison-syntax -- yaks/easytest + - codebase2/codebase + - codebase2/codebase-sqlite + - codebase2/codebase-sqlite-hashing-v2 + - codebase2/codebase-sync + - codebase2/core + - codebase2/util-serialization + - codebase2/util-term + - lib/orphans/network-uri-orphans-sqlite + - lib/orphans/unison-core-orphans-sqlite + - lib/orphans/unison-hash-orphans-aeson + - lib/orphans/unison-hash-orphans-sqlite + - lib/orphans/uuid-orphans-sqlite + - lib/unison-hash + - lib/unison-hashing + - lib/unison-prelude + - lib/unison-pretty-printer + - lib/unison-sqlite + - lib/unison-util-base32hex + - 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 + - unison-cli + - unison-cli-main + - unison-core + - unison-hashing-v2 + - unison-share-api + - unison-share-projects-api + - unison-syntax + - yaks/easytest resolver: lts-20.26 extra-deps: -# broken version in snapshot -- github: unisonweb/configurator - commit: e47e9e9fe1f576f8c835183b9def52d73c01327a -# This custom Haskeline alters ANSI rendering on Windows. -# If changing the haskeline dependency, please ensure color renders properly in a -# Windows terminal. -# https://github.com/judah/haskeline/pull/126 -- github: unisonweb/haskeline - commit: 9275eea7982dabbf47be2ba078ced669ae7ef3d5 + # broken version in snapshot + - github: unisonweb/configurator + commit: e47e9e9fe1f576f8c835183b9def52d73c01327a + # This custom Haskeline alters ANSI rendering on Windows. + # If changing the haskeline dependency, please ensure color renders properly in a + # Windows terminal. + # https://github.com/judah/haskeline/pull/126 + - github: unisonweb/haskeline + commit: 9275eea7982dabbf47be2ba078ced669ae7ef3d5 -# not in stackage -- fuzzyfind-3.0.1 -- guid-0.1.0@sha256:a7c975be473f6f142d5cc1b39bc807a99043d20b1bb0873fdfe7a3ce84d2faf1,1078 -- lock-file-0.7.0.0@sha256:3ad84b5e454145e1d928063b56abb96db24a99a21b493989520e58fa0ab37b00,4484 -- monad-validate-1.2.0.0@sha256:9850f408431098b28806dd464b6825a88a0b56c84f380d7fe0454c1df9d6f881,3505 -- recover-rtti-0.4.2@sha256:c179a303921126d8d782264e14f386c96e54a270df74be002e4c4ec3c8c7aebd,4529 -- lsp-2.2.0.0@sha256:82fbf4b69d94d8d22543be71f89986b3e90050032d671fb3de3f8253ea1e5b6f,3550 -- lsp-types-2.0.2.0@sha256:a9a51c3cea0726d91fe63fa0670935ee720f7b31bc3f3b33b2483fc538152677,29421 -- row-types-1.0.1.2@sha256:4d4c7cb95d06a32b28ba977852d52a26b4c1f695ef083a6fd874ab6d79933b64,3071 + # not in stackage + - fuzzyfind-3.0.1 + - guid-0.1.0@sha256:a7c975be473f6f142d5cc1b39bc807a99043d20b1bb0873fdfe7a3ce84d2faf1,1078 + - lock-file-0.7.0.0@sha256:3ad84b5e454145e1d928063b56abb96db24a99a21b493989520e58fa0ab37b00,4484 + - monad-validate-1.2.0.0@sha256:9850f408431098b28806dd464b6825a88a0b56c84f380d7fe0454c1df9d6f881,3505 + - recover-rtti-0.4.2@sha256:c179a303921126d8d782264e14f386c96e54a270df74be002e4c4ec3c8c7aebd,4529 + - lsp-2.2.0.0@sha256:82fbf4b69d94d8d22543be71f89986b3e90050032d671fb3de3f8253ea1e5b6f,3550 + - lsp-types-2.0.2.0@sha256:a9a51c3cea0726d91fe63fa0670935ee720f7b31bc3f3b33b2483fc538152677,29421 + - row-types-1.0.1.2@sha256:4d4c7cb95d06a32b28ba977852d52a26b4c1f695ef083a6fd874ab6d79933b64,3071 ghc-options: - # All packages - "$locals": -Wall -Werror -Wno-name-shadowing -Wno-missing-pattern-synonym-signatures -fprint-expanded-synonyms -fwrite-ide-info #-freverse-errors + # All packages + "$locals": -Wall -Werror -Wno-name-shadowing -Wno-missing-pattern-synonym-signatures -fprint-expanded-synonyms -fwrite-ide-info #-freverse-errors - # See https://github.com/haskell/haskell-language-server/issues/208 - "$everything": -haddock + # See https://github.com/haskell/haskell-language-server/issues/208 + "$everything": -haddock - statistics: -fsimpl-tick-factor=10000 # statistics fails on GHC 9 without this, https://github.com/haskell/statistics/issues/173 + statistics: -fsimpl-tick-factor=10000 # statistics fails on GHC 9 without this, https://github.com/haskell/statistics/issues/173 From 5ad9d11d59c0e830a9490f4880fcf4f7eb5fcad6 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sun, 24 Mar 2024 11:52:49 -0600 Subject: [PATCH 073/124] so annoying --- .github/workflows/bundle-ucm.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 1deec55ce..0f44171ae 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -204,6 +204,7 @@ jobs: name: unison-${{matrix.os}} path: ${{env.staging_dir}}/ - name: restore permissions on ucm + if: ${{runner.os}} != 'Windows' run: chmod +x ${{env.staging_dir}}/unison - name: rename unison -> ucm run: mv ${{env.staging_dir}}/unison ${{env.staging_dir}}/ucm From 7b5d0d8eab86dd4e14c2b402368a6f80b9681d1b Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sun, 24 Mar 2024 11:52:58 -0600 Subject: [PATCH 074/124] change label --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 0f44171ae..f11938f57 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -182,7 +182,7 @@ jobs: if-no-files-found: error bundle: - name: bundle ucm+jit+ui + name: bundle ucm, jit, and ui needs: [build-ucm, package-racket-lib, build-dist-unison-runtime] runs-on: ${{matrix.os}} strategy: From 1c6f5920c1066b49fa55ef81e49154a927339f96 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sun, 24 Mar 2024 12:09:15 -0600 Subject: [PATCH 075/124] update hie.yaml --- hie.yaml | 51 +++++++++++++++++++++++++++------------------------ 1 file changed, 27 insertions(+), 24 deletions(-) diff --git a/hie.yaml b/hie.yaml index 378e2fea8..03f93ad40 100644 --- a/hie.yaml +++ b/hie.yaml @@ -21,18 +21,24 @@ cradle: - path: "codebase2/util-term/./" component: "unison-util-term:lib" + - path: "lib/orphans/network-uri-orphans-sqlite/src" + component: "network-uri-orphans-sqlite:lib" + - path: "lib/orphans/unison-core-orphans-sqlite/src" component: "unison-core-orphans-sqlite:lib" - - path: "lib/unison-hash/src" - component: "unison-hash:lib" - - path: "lib/orphans/unison-hash-orphans-aeson/src" component: "unison-hash-orphans-aeson:lib" - path: "lib/orphans/unison-hash-orphans-sqlite/src" component: "unison-hash-orphans-sqlite:lib" + - path: "lib/orphans/uuid-orphans-sqlite/src" + component: "uuid-orphans-sqlite:lib" + + - path: "lib/unison-hash/src" + component: "unison-hash:lib" + - path: "lib/unison-hashing/src" component: "unison-hashing:lib" @@ -72,6 +78,9 @@ cradle: - path: "lib/unison-util-file-embed/src" component: "unison-util-file-embed:lib" + - path: "lib/unison-util-nametree/src" + component: "unison-util-nametree:lib" + - path: "lib/unison-util-relation/src" component: "unison-util-relation:lib" @@ -84,42 +93,36 @@ cradle: - path: "lib/unison-util-rope/src" component: "unison-util-rope:lib" - - path: "lib/orphans/uuid-orphans-sqlite/src" - component: "uuid-orphans-sqlite:lib" - - path: "parser-typechecker/src" component: "unison-parser-typechecker:lib" - path: "parser-typechecker/tests" component: "unison-parser-typechecker:test:parser-typechecker-tests" - - path: "unison-cli/src" + - path: "unison-cli/unison" component: "unison-cli:lib" - - path: "unison-cli/integration-tests/Suite.hs" - component: "unison-cli:exe:cli-integration-tests" - - - path: "unison-cli/integration-tests/IntegrationTests/ArgumentParsing.hs" - component: "unison-cli:exe:cli-integration-tests" + - path: "unison-cli/src" + component: "unison-cli:lib:unison-cli-lib" - path: "unison-cli/transcripts/Transcripts.hs" component: "unison-cli:exe:transcripts" - - path: "unison-cli/unison/Main.hs" - component: "unison-cli:exe:unison" - - - path: "unison-cli/unison/ArgParse.hs" - component: "unison-cli:exe:unison" - - - path: "unison-cli/unison/System/Path.hs" - component: "unison-cli:exe:unison" - - - path: "unison-cli/unison/Version.hs" - component: "unison-cli:exe:unison" - - path: "unison-cli/tests" component: "unison-cli:test:cli-tests" + - path: "unison-cli-main/integration-tests/Suite.hs" + component: "unison-cli-main:exe:cli-integration-tests" + + - path: "unison-cli-main/integration-tests/IntegrationTests/ArgumentParsing.hs" + component: "unison-cli-main:exe:cli-integration-tests" + + - path: "unison-cli-main/unison/Main.hs" + component: "unison-cli-main:exe:unison" + + - path: "unison-cli-main/unison/Version.hs" + component: "unison-cli-main:exe:unison" + - path: "unison-core/src" component: "unison-core1:lib" From 04c02b854befe945489eaef139c51350c924e86a Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sun, 24 Mar 2024 12:09:24 -0600 Subject: [PATCH 076/124] integration tests need to know where to find themselves --- .../integration-tests/IntegrationTests/ArgumentParsing.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unison-cli-main/integration-tests/IntegrationTests/ArgumentParsing.hs b/unison-cli-main/integration-tests/IntegrationTests/ArgumentParsing.hs index 238c67491..f71f83eb3 100644 --- a/unison-cli-main/integration-tests/IntegrationTests/ArgumentParsing.hs +++ b/unison-cli-main/integration-tests/IntegrationTests/ArgumentParsing.hs @@ -12,7 +12,7 @@ import System.Process (readProcessWithExitCode) import Text.Printf integrationTestsDir :: FilePath -integrationTestsDir = "unison-cli" "integration-tests" "IntegrationTests" +integrationTestsDir = "unison-cli-main" "integration-tests" "IntegrationTests" uFile :: FilePath uFile = integrationTestsDir "print.u" From 16525d82d4e38dbcd26db9de926eada8c1b24ed1 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sun, 24 Mar 2024 12:31:14 -0600 Subject: [PATCH 077/124] the transcripts also had stack paths embedded --- .../integration-tests/IntegrationTests/transcript.md | 2 +- .../IntegrationTests/transcript.output.md | 8 +++++--- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/unison-cli-main/integration-tests/IntegrationTests/transcript.md b/unison-cli-main/integration-tests/IntegrationTests/transcript.md index 4b95fcc0b..584929f86 100644 --- a/unison-cli-main/integration-tests/IntegrationTests/transcript.md +++ b/unison-cli-main/integration-tests/IntegrationTests/transcript.md @@ -40,5 +40,5 @@ main = do ```ucm .> add -.> compile main ./unison-cli/integration-tests/IntegrationTests/main +.> compile main ./unison-cli-main/integration-tests/IntegrationTests/main ``` diff --git a/unison-cli-main/integration-tests/IntegrationTests/transcript.output.md b/unison-cli-main/integration-tests/IntegrationTests/transcript.output.md index d10d75868..b9e6abc8f 100644 --- a/unison-cli-main/integration-tests/IntegrationTests/transcript.output.md +++ b/unison-cli-main/integration-tests/IntegrationTests/transcript.output.md @@ -29,6 +29,8 @@ main = do ```ucm + Loading changes detected in scratch.u. + I found and typechecked these definitions in scratch.u. If you do an `add` or `update`, here's how your codebase would change: @@ -36,7 +38,7 @@ main = do ⍟ These new definitions are ok to `add`: structural ability Break - unique type MyBool + type MyBool main : '{IO, Exception} () resume : Request {g, Break} x -> x @@ -47,10 +49,10 @@ main = do ⍟ I've added these definitions: structural ability Break - unique type MyBool + type MyBool main : '{IO, Exception} () resume : Request {g, Break} x -> x -.> compile main ./unison-cli/integration-tests/IntegrationTests/main +.> compile main ./unison-cli-main/integration-tests/IntegrationTests/main ``` From cbbaecc0df4d40cdfd466e8cc9e9c9a91959de7b Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sun, 24 Mar 2024 13:29:10 -0600 Subject: [PATCH 078/124] we can clean less now --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index f11938f57..b709ac07e 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -44,7 +44,7 @@ jobs: run: | # unison-cli embeds version numbers using TH # so it needs to be forced to rebuild to ensure those are updated. - stack clean unison-cli + stack clean unison-cli-main mkdir ucm-bin From 886a55bc723b7ab0ca77d39702d5ac5e39cda733 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sun, 24 Mar 2024 13:46:20 -0600 Subject: [PATCH 079/124] yaml is dynamically typed --- .github/workflows/bundle-ucm.yaml | 6 ++++-- docs/github-actions-help.md | 6 ++++++ 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index f11938f57..df0ccac4c 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -204,7 +204,6 @@ jobs: name: unison-${{matrix.os}} path: ${{env.staging_dir}}/ - name: restore permissions on ucm - if: ${{runner.os}} != 'Windows' run: chmod +x ${{env.staging_dir}}/unison - name: rename unison -> ucm run: mv ${{env.staging_dir}}/unison ${{env.staging_dir}}/ucm @@ -219,7 +218,10 @@ jobs: name: unison-runtime-${{matrix.os}} path: ${{env.staging_dir}}/runtime - name: restore permissions on unison-runtime - if: ${{runner.os}} != 'Windows' + # here we have the `if:` not because of the missing .exe on Windows, + # nor the lack of need to chmod, but because /runtime/bin/ probably doesn't exist + # due to differences in `raco distribute` on Windows vs macOS and Linux. + if: runner.os != 'Windows' run: chmod +x ${{env.staging_dir}}/runtime/bin/unison-runtime - name: download latest unison-local-ui run: | diff --git a/docs/github-actions-help.md b/docs/github-actions-help.md index 888ed9435..c454232cc 100644 --- a/docs/github-actions-help.md +++ b/docs/github-actions-help.md @@ -26,6 +26,12 @@ e.g. It's not clear to me when to use `$GITHUB_OUTPUT` vs `$GITHUB_ENV`, but I have been favoring `$GITHUB_ENV` because it requires fewer characters to access. However, it seems a little wrong. +### `if:` + +Although the type rules don't totally make sense in Github Actions, `if:` takes a Boolean. + +Therefore, I think the String interpolation in `if: ${{runner.os}} != 'Windows'` causes the whole expression to become a String, which is coerced to `true`, when you definitely didn't mean `if: true`. So don't use `${{}}` here. + ### Job names Job names will automatically get `(${{matrix.os}})` if you don't use `${{matrix.os}}` somewhere in the name. From 81fe27bd05bbc4c6131aca655f93f2e75edfc2e1 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sun, 24 Mar 2024 13:58:38 -0600 Subject: [PATCH 080/124] update comment --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index d462badc7..4fcac2d51 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -42,7 +42,7 @@ jobs: - name: build run: | - # unison-cli embeds version numbers using TH + # unison-cli-main embeds version numbers using TH # so it needs to be forced to rebuild to ensure those are updated. stack clean unison-cli-main From 79898e5f0c5d36fb9ec026bbc6d2d8d6fab387a1 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sun, 24 Mar 2024 14:47:15 -0600 Subject: [PATCH 081/124] rename workflow stage --- .github/workflows/pre-release.yaml | 2 +- .github/workflows/release.yaml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index 64b3a68d6..761756803 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -14,7 +14,7 @@ on: workflow_dispatch: jobs: - build-ucm: + bundle-ucm: uses: ./.github/workflows/bundle-ucm.yaml with: ref: ${{ github.ref }} diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml index fbde4136d..2ca9c7078 100644 --- a/.github/workflows/release.yaml +++ b/.github/workflows/release.yaml @@ -15,7 +15,7 @@ on: type: string jobs: - build-ucm: + bundle-ucm: uses: ./.github/workflows/bundle-ucm.yaml with: ref: ${{github.ref}} From 2326c257e08386972b474c54b205145687138429 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sun, 24 Mar 2024 14:50:41 -0600 Subject: [PATCH 082/124] rename more --- .github/workflows/pre-release.yaml | 1 + .github/workflows/release.yaml | 1 + 2 files changed, 2 insertions(+) diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index 761756803..80fdeb989 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -15,6 +15,7 @@ on: jobs: bundle-ucm: + name: build and bundle ucm uses: ./.github/workflows/bundle-ucm.yaml with: ref: ${{ github.ref }} diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml index 2ca9c7078..0f6680a4a 100644 --- a/.github/workflows/release.yaml +++ b/.github/workflows/release.yaml @@ -16,6 +16,7 @@ on: jobs: bundle-ucm: + name: build and bundle ucm uses: ./.github/workflows/bundle-ucm.yaml with: ref: ${{github.ref}} From fbc19edb3ed788e96377f3ac2e5e5da32ad7c09a Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sun, 24 Mar 2024 15:05:50 -0600 Subject: [PATCH 083/124] accidentally removed the magic blurb that makes stack not break hopefully this is correct now --- unison-cli/package.yaml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/unison-cli/package.yaml b/unison-cli/package.yaml index 9a0179d17..abe89d21c 100644 --- a/unison-cli/package.yaml +++ b/unison-cli/package.yaml @@ -114,6 +114,9 @@ internal-libraries: library: source-dirs: unison + when: + - condition: false + other-modules: Paths_unison_cli dependencies: - code-page - optparse-applicative >= 0.16.1.0 From b58d962c4bcfb960c661517cf2cdc6a027214139 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sun, 24 Mar 2024 15:17:24 -0600 Subject: [PATCH 084/124] i should've known this was mismatched before pushing --- .github/workflows/pre-release.yaml | 2 +- .github/workflows/release.yaml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index 80fdeb989..78f513076 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -24,7 +24,7 @@ jobs: name: create release runs-on: ubuntu-20.04 needs: - - build-ucm + - bundle-ucm steps: - name: make download dir diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml index 0f6680a4a..4cac97eac 100644 --- a/.github/workflows/release.yaml +++ b/.github/workflows/release.yaml @@ -25,7 +25,7 @@ jobs: name: create release runs-on: ubuntu-20.04 needs: - - build-ucm + - bundle-ucm steps: - name: make download dir From b8b02e9a399120d2aa555b78498f84c1429c2f37 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Sun, 24 Mar 2024 15:35:26 -0600 Subject: [PATCH 085/124] out of date cabal file due to hpack mismatch (my bad) --- unison-cli/unison-cli.cabal | 4 ---- 1 file changed, 4 deletions(-) diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 90e8246cd..481788d04 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -28,10 +28,6 @@ library System.Path Unison.Main Unison.Version - other-modules: - Paths_unison_cli - autogen-modules: - Paths_unison_cli hs-source-dirs: unison default-extensions: From 35f3101fd321438db50517b809135321a2b4fde8 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Mon, 25 Mar 2024 04:54:33 -0600 Subject: [PATCH 086/124] include the ref in the pre-release build name to start using it instead of real releases for testing --- .github/workflows/pre-release.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index 78f513076..fd9463957 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -38,7 +38,7 @@ jobs: - uses: "marvinpinto/action-automatic-releases@latest" with: repo_token: "${{ secrets.GITHUB_TOKEN }}" - automatic_release_tag: trunk-build + automatic_release_tag: ${{ github.ref }}-build prerelease: true title: Development Build files: | From b7fc4aa22ae7065941227c70156e6dfd3d37eb75 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Mon, 25 Mar 2024 05:19:38 -0600 Subject: [PATCH 087/124] move cli-integration tests to their own package --- stack.yaml | 1 + .../IntegrationTests/ArgumentParsing.hs | 2 +- .../IntegrationTests/print.u | 0 .../IntegrationTests/transcript.md | 2 +- .../IntegrationTests/transcript.output.md | 8 +- .../integration-tests/Suite.hs | 0 unison-cli-integration/package.yaml | 68 +++++++++++++++++ .../unison-cli-integration.cabal | 75 +++++++++++++++++++ unison-cli-main/package.yaml | 19 ----- unison-cli-main/unison-cli-main.cabal | 55 -------------- 10 files changed, 150 insertions(+), 80 deletions(-) rename {unison-cli-main => unison-cli-integration}/integration-tests/IntegrationTests/ArgumentParsing.hs (97%) rename {unison-cli-main => unison-cli-integration}/integration-tests/IntegrationTests/print.u (100%) rename {unison-cli-main => unison-cli-integration}/integration-tests/IntegrationTests/transcript.md (88%) rename {unison-cli-main => unison-cli-integration}/integration-tests/IntegrationTests/transcript.output.md (92%) rename {unison-cli-main => unison-cli-integration}/integration-tests/Suite.hs (100%) create mode 100644 unison-cli-integration/package.yaml create mode 100644 unison-cli-integration/unison-cli-integration.cabal diff --git a/stack.yaml b/stack.yaml index 5e7171467..54bf26aa6 100644 --- a/stack.yaml +++ b/stack.yaml @@ -34,6 +34,7 @@ packages: - lib/unison-util-rope - parser-typechecker - unison-cli + - unison-cli-integration - unison-cli-main - unison-core - unison-hashing-v2 diff --git a/unison-cli-main/integration-tests/IntegrationTests/ArgumentParsing.hs b/unison-cli-integration/integration-tests/IntegrationTests/ArgumentParsing.hs similarity index 97% rename from unison-cli-main/integration-tests/IntegrationTests/ArgumentParsing.hs rename to unison-cli-integration/integration-tests/IntegrationTests/ArgumentParsing.hs index f71f83eb3..02ef8fce9 100644 --- a/unison-cli-main/integration-tests/IntegrationTests/ArgumentParsing.hs +++ b/unison-cli-integration/integration-tests/IntegrationTests/ArgumentParsing.hs @@ -12,7 +12,7 @@ import System.Process (readProcessWithExitCode) import Text.Printf integrationTestsDir :: FilePath -integrationTestsDir = "unison-cli-main" "integration-tests" "IntegrationTests" +integrationTestsDir = "unison-cli-integration" "integration-tests" "IntegrationTests" uFile :: FilePath uFile = integrationTestsDir "print.u" diff --git a/unison-cli-main/integration-tests/IntegrationTests/print.u b/unison-cli-integration/integration-tests/IntegrationTests/print.u similarity index 100% rename from unison-cli-main/integration-tests/IntegrationTests/print.u rename to unison-cli-integration/integration-tests/IntegrationTests/print.u diff --git a/unison-cli-main/integration-tests/IntegrationTests/transcript.md b/unison-cli-integration/integration-tests/IntegrationTests/transcript.md similarity index 88% rename from unison-cli-main/integration-tests/IntegrationTests/transcript.md rename to unison-cli-integration/integration-tests/IntegrationTests/transcript.md index 584929f86..c8b10ea26 100644 --- a/unison-cli-main/integration-tests/IntegrationTests/transcript.md +++ b/unison-cli-integration/integration-tests/IntegrationTests/transcript.md @@ -40,5 +40,5 @@ main = do ```ucm .> add -.> compile main ./unison-cli-main/integration-tests/IntegrationTests/main +.> compile main ./unison-cli-integration/integration-tests/IntegrationTests/main ``` diff --git a/unison-cli-main/integration-tests/IntegrationTests/transcript.output.md b/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md similarity index 92% rename from unison-cli-main/integration-tests/IntegrationTests/transcript.output.md rename to unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md index b9e6abc8f..b5753f5df 100644 --- a/unison-cli-main/integration-tests/IntegrationTests/transcript.output.md +++ b/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md @@ -34,9 +34,9 @@ main = do I found and typechecked these definitions in scratch.u. If you do an `add` or `update`, here's how your codebase would change: - + ⍟ These new definitions are ok to `add`: - + structural ability Break type MyBool main : '{IO, Exception} () @@ -47,12 +47,12 @@ main = do .> add ⍟ I've added these definitions: - + structural ability Break type MyBool main : '{IO, Exception} () resume : Request {g, Break} x -> x -.> compile main ./unison-cli-main/integration-tests/IntegrationTests/main +.> compile main ./unison-cli-integration/integration-tests/IntegrationTests/main ``` diff --git a/unison-cli-main/integration-tests/Suite.hs b/unison-cli-integration/integration-tests/Suite.hs similarity index 100% rename from unison-cli-main/integration-tests/Suite.hs rename to unison-cli-integration/integration-tests/Suite.hs diff --git a/unison-cli-integration/package.yaml b/unison-cli-integration/package.yaml new file mode 100644 index 000000000..9ea425cb5 --- /dev/null +++ b/unison-cli-integration/package.yaml @@ -0,0 +1,68 @@ +name: unison-cli-integration +github: unisonweb/unison +copyright: Copyright (C) 2013-2018 Unison Computing, PBC and contributors + +flags: + optimized: + manual: true + default: false + +ghc-options: -Wall + +executables: + cli-integration-tests: + when: + - condition: false + other-modules: Paths_unison_cli_integration + source-dirs: integration-tests + main: Suite.hs + ghc-options: -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0 + dependencies: + - base + - code-page + - filepath + - directory + - easytest + - process + - shellmet + - time + build-tools: + - unison-cli-main:unison + +when: + - condition: flag(optimized) + ghc-options: -O2 -funbox-strict-fields + +default-extensions: + - ApplicativeDo + - BangPatterns + - BlockArguments + - DeriveAnyClass + - DeriveFunctor + - DeriveFoldable + - DeriveTraversable + - DeriveGeneric + - DerivingStrategies + - DerivingVia + - DoAndIfThenElse + - DuplicateRecordFields + - FlexibleContexts + - FlexibleInstances + - GADTs + - GeneralizedNewtypeDeriving + - ImportQualifiedPost + - InstanceSigs + - KindSignatures + - LambdaCase + - MultiParamTypeClasses + - MultiWayIf + - NamedFieldPuns + - NumericUnderscores + - OverloadedLabels + - OverloadedStrings + - PatternSynonyms + - RankNTypes + - ScopedTypeVariables + - TupleSections + - TypeApplications + - ViewPatterns diff --git a/unison-cli-integration/unison-cli-integration.cabal b/unison-cli-integration/unison-cli-integration.cabal new file mode 100644 index 000000000..3b5a0fb54 --- /dev/null +++ b/unison-cli-integration/unison-cli-integration.cabal @@ -0,0 +1,75 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.35.2. +-- +-- see: https://github.com/sol/hpack + +name: unison-cli-integration +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 + +flag optimized + manual: True + default: False + +executable cli-integration-tests + main-is: Suite.hs + other-modules: + IntegrationTests.ArgumentParsing + hs-source-dirs: + integration-tests + default-extensions: + ApplicativeDo + BangPatterns + BlockArguments + DeriveAnyClass + DeriveFunctor + DeriveFoldable + DeriveTraversable + DeriveGeneric + DerivingStrategies + DerivingVia + DoAndIfThenElse + DuplicateRecordFields + FlexibleContexts + FlexibleInstances + GADTs + GeneralizedNewtypeDeriving + ImportQualifiedPost + InstanceSigs + KindSignatures + LambdaCase + MultiParamTypeClasses + MultiWayIf + NamedFieldPuns + NumericUnderscores + OverloadedLabels + OverloadedStrings + PatternSynonyms + RankNTypes + ScopedTypeVariables + TupleSections + TypeApplications + ViewPatterns + ghc-options: -Wall -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0 + build-tool-depends: + unison-cli-main:unison + build-depends: + base + , code-page + , directory + , easytest + , filepath + , process + , shellmet + , time + default-language: Haskell2010 + if flag(optimized) + ghc-options: -O2 -funbox-strict-fields diff --git a/unison-cli-main/package.yaml b/unison-cli-main/package.yaml index cf10ac1e3..b64fe5276 100644 --- a/unison-cli-main/package.yaml +++ b/unison-cli-main/package.yaml @@ -24,25 +24,6 @@ executables: - text - unison-cli - cli-integration-tests: - when: - - condition: false - other-modules: Paths_unison_cli_main - source-dirs: integration-tests - main: Suite.hs - ghc-options: -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0 - dependencies: - - base - - code-page - - filepath - - directory - - easytest - - process - - shellmet - - time - build-tools: - - unison-cli-main:unison - when: - condition: flag(optimized) ghc-options: -O2 -funbox-strict-fields diff --git a/unison-cli-main/unison-cli-main.cabal b/unison-cli-main/unison-cli-main.cabal index a16bf1f78..4c5425497 100644 --- a/unison-cli-main/unison-cli-main.cabal +++ b/unison-cli-main/unison-cli-main.cabal @@ -21,61 +21,6 @@ flag optimized manual: True default: False -executable cli-integration-tests - main-is: Suite.hs - other-modules: - IntegrationTests.ArgumentParsing - hs-source-dirs: - integration-tests - default-extensions: - ApplicativeDo - BangPatterns - BlockArguments - DeriveAnyClass - DeriveFunctor - DeriveFoldable - DeriveTraversable - DeriveGeneric - DerivingStrategies - DerivingVia - DoAndIfThenElse - DuplicateRecordFields - FlexibleContexts - FlexibleInstances - GADTs - GeneralizedNewtypeDeriving - ImportQualifiedPost - InstanceSigs - KindSignatures - LambdaCase - MultiParamTypeClasses - MultiWayIf - NamedFieldPuns - NumericUnderscores - OverloadedLabels - OverloadedStrings - PatternSynonyms - RankNTypes - ScopedTypeVariables - TupleSections - TypeApplications - ViewPatterns - ghc-options: -Wall -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0 - build-tools: - unison - build-depends: - base - , code-page - , directory - , easytest - , filepath - , process - , shellmet - , time - default-language: Haskell2010 - if flag(optimized) - ghc-options: -O2 -funbox-strict-fields - executable unison main-is: Main.hs other-modules: From eca3d94726f56ffd4b9cd1f4321918d3f7701dee Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Mon, 25 Mar 2024 05:19:38 -0600 Subject: [PATCH 088/124] move cli-integration tests to their own package --- stack.yaml | 1 + .../IntegrationTests/ArgumentParsing.hs | 2 +- .../IntegrationTests/print.u | 0 .../IntegrationTests/transcript.md | 2 +- .../IntegrationTests/transcript.output.md | 8 +- .../integration-tests/Suite.hs | 0 unison-cli-integration/package.yaml | 68 +++++++++++++++++ .../unison-cli-integration.cabal | 75 +++++++++++++++++++ unison-cli-main/package.yaml | 19 ----- unison-cli-main/unison-cli-main.cabal | 55 -------------- 10 files changed, 150 insertions(+), 80 deletions(-) rename {unison-cli-main => unison-cli-integration}/integration-tests/IntegrationTests/ArgumentParsing.hs (97%) rename {unison-cli-main => unison-cli-integration}/integration-tests/IntegrationTests/print.u (100%) rename {unison-cli-main => unison-cli-integration}/integration-tests/IntegrationTests/transcript.md (88%) rename {unison-cli-main => unison-cli-integration}/integration-tests/IntegrationTests/transcript.output.md (92%) rename {unison-cli-main => unison-cli-integration}/integration-tests/Suite.hs (100%) create mode 100644 unison-cli-integration/package.yaml create mode 100644 unison-cli-integration/unison-cli-integration.cabal diff --git a/stack.yaml b/stack.yaml index 5e7171467..54bf26aa6 100644 --- a/stack.yaml +++ b/stack.yaml @@ -34,6 +34,7 @@ packages: - lib/unison-util-rope - parser-typechecker - unison-cli + - unison-cli-integration - unison-cli-main - unison-core - unison-hashing-v2 diff --git a/unison-cli-main/integration-tests/IntegrationTests/ArgumentParsing.hs b/unison-cli-integration/integration-tests/IntegrationTests/ArgumentParsing.hs similarity index 97% rename from unison-cli-main/integration-tests/IntegrationTests/ArgumentParsing.hs rename to unison-cli-integration/integration-tests/IntegrationTests/ArgumentParsing.hs index f71f83eb3..02ef8fce9 100644 --- a/unison-cli-main/integration-tests/IntegrationTests/ArgumentParsing.hs +++ b/unison-cli-integration/integration-tests/IntegrationTests/ArgumentParsing.hs @@ -12,7 +12,7 @@ import System.Process (readProcessWithExitCode) import Text.Printf integrationTestsDir :: FilePath -integrationTestsDir = "unison-cli-main" "integration-tests" "IntegrationTests" +integrationTestsDir = "unison-cli-integration" "integration-tests" "IntegrationTests" uFile :: FilePath uFile = integrationTestsDir "print.u" diff --git a/unison-cli-main/integration-tests/IntegrationTests/print.u b/unison-cli-integration/integration-tests/IntegrationTests/print.u similarity index 100% rename from unison-cli-main/integration-tests/IntegrationTests/print.u rename to unison-cli-integration/integration-tests/IntegrationTests/print.u diff --git a/unison-cli-main/integration-tests/IntegrationTests/transcript.md b/unison-cli-integration/integration-tests/IntegrationTests/transcript.md similarity index 88% rename from unison-cli-main/integration-tests/IntegrationTests/transcript.md rename to unison-cli-integration/integration-tests/IntegrationTests/transcript.md index 584929f86..c8b10ea26 100644 --- a/unison-cli-main/integration-tests/IntegrationTests/transcript.md +++ b/unison-cli-integration/integration-tests/IntegrationTests/transcript.md @@ -40,5 +40,5 @@ main = do ```ucm .> add -.> compile main ./unison-cli-main/integration-tests/IntegrationTests/main +.> compile main ./unison-cli-integration/integration-tests/IntegrationTests/main ``` diff --git a/unison-cli-main/integration-tests/IntegrationTests/transcript.output.md b/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md similarity index 92% rename from unison-cli-main/integration-tests/IntegrationTests/transcript.output.md rename to unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md index b9e6abc8f..b5753f5df 100644 --- a/unison-cli-main/integration-tests/IntegrationTests/transcript.output.md +++ b/unison-cli-integration/integration-tests/IntegrationTests/transcript.output.md @@ -34,9 +34,9 @@ main = do I found and typechecked these definitions in scratch.u. If you do an `add` or `update`, here's how your codebase would change: - + ⍟ These new definitions are ok to `add`: - + structural ability Break type MyBool main : '{IO, Exception} () @@ -47,12 +47,12 @@ main = do .> add ⍟ I've added these definitions: - + structural ability Break type MyBool main : '{IO, Exception} () resume : Request {g, Break} x -> x -.> compile main ./unison-cli-main/integration-tests/IntegrationTests/main +.> compile main ./unison-cli-integration/integration-tests/IntegrationTests/main ``` diff --git a/unison-cli-main/integration-tests/Suite.hs b/unison-cli-integration/integration-tests/Suite.hs similarity index 100% rename from unison-cli-main/integration-tests/Suite.hs rename to unison-cli-integration/integration-tests/Suite.hs diff --git a/unison-cli-integration/package.yaml b/unison-cli-integration/package.yaml new file mode 100644 index 000000000..9ea425cb5 --- /dev/null +++ b/unison-cli-integration/package.yaml @@ -0,0 +1,68 @@ +name: unison-cli-integration +github: unisonweb/unison +copyright: Copyright (C) 2013-2018 Unison Computing, PBC and contributors + +flags: + optimized: + manual: true + default: false + +ghc-options: -Wall + +executables: + cli-integration-tests: + when: + - condition: false + other-modules: Paths_unison_cli_integration + source-dirs: integration-tests + main: Suite.hs + ghc-options: -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0 + dependencies: + - base + - code-page + - filepath + - directory + - easytest + - process + - shellmet + - time + build-tools: + - unison-cli-main:unison + +when: + - condition: flag(optimized) + ghc-options: -O2 -funbox-strict-fields + +default-extensions: + - ApplicativeDo + - BangPatterns + - BlockArguments + - DeriveAnyClass + - DeriveFunctor + - DeriveFoldable + - DeriveTraversable + - DeriveGeneric + - DerivingStrategies + - DerivingVia + - DoAndIfThenElse + - DuplicateRecordFields + - FlexibleContexts + - FlexibleInstances + - GADTs + - GeneralizedNewtypeDeriving + - ImportQualifiedPost + - InstanceSigs + - KindSignatures + - LambdaCase + - MultiParamTypeClasses + - MultiWayIf + - NamedFieldPuns + - NumericUnderscores + - OverloadedLabels + - OverloadedStrings + - PatternSynonyms + - RankNTypes + - ScopedTypeVariables + - TupleSections + - TypeApplications + - ViewPatterns diff --git a/unison-cli-integration/unison-cli-integration.cabal b/unison-cli-integration/unison-cli-integration.cabal new file mode 100644 index 000000000..3b5a0fb54 --- /dev/null +++ b/unison-cli-integration/unison-cli-integration.cabal @@ -0,0 +1,75 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.35.2. +-- +-- see: https://github.com/sol/hpack + +name: unison-cli-integration +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 + +flag optimized + manual: True + default: False + +executable cli-integration-tests + main-is: Suite.hs + other-modules: + IntegrationTests.ArgumentParsing + hs-source-dirs: + integration-tests + default-extensions: + ApplicativeDo + BangPatterns + BlockArguments + DeriveAnyClass + DeriveFunctor + DeriveFoldable + DeriveTraversable + DeriveGeneric + DerivingStrategies + DerivingVia + DoAndIfThenElse + DuplicateRecordFields + FlexibleContexts + FlexibleInstances + GADTs + GeneralizedNewtypeDeriving + ImportQualifiedPost + InstanceSigs + KindSignatures + LambdaCase + MultiParamTypeClasses + MultiWayIf + NamedFieldPuns + NumericUnderscores + OverloadedLabels + OverloadedStrings + PatternSynonyms + RankNTypes + ScopedTypeVariables + TupleSections + TypeApplications + ViewPatterns + ghc-options: -Wall -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0 + build-tool-depends: + unison-cli-main:unison + build-depends: + base + , code-page + , directory + , easytest + , filepath + , process + , shellmet + , time + default-language: Haskell2010 + if flag(optimized) + ghc-options: -O2 -funbox-strict-fields diff --git a/unison-cli-main/package.yaml b/unison-cli-main/package.yaml index cf10ac1e3..b64fe5276 100644 --- a/unison-cli-main/package.yaml +++ b/unison-cli-main/package.yaml @@ -24,25 +24,6 @@ executables: - text - unison-cli - cli-integration-tests: - when: - - condition: false - other-modules: Paths_unison_cli_main - source-dirs: integration-tests - main: Suite.hs - ghc-options: -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0 - dependencies: - - base - - code-page - - filepath - - directory - - easytest - - process - - shellmet - - time - build-tools: - - unison-cli-main:unison - when: - condition: flag(optimized) ghc-options: -O2 -funbox-strict-fields diff --git a/unison-cli-main/unison-cli-main.cabal b/unison-cli-main/unison-cli-main.cabal index a16bf1f78..4c5425497 100644 --- a/unison-cli-main/unison-cli-main.cabal +++ b/unison-cli-main/unison-cli-main.cabal @@ -21,61 +21,6 @@ flag optimized manual: True default: False -executable cli-integration-tests - main-is: Suite.hs - other-modules: - IntegrationTests.ArgumentParsing - hs-source-dirs: - integration-tests - default-extensions: - ApplicativeDo - BangPatterns - BlockArguments - DeriveAnyClass - DeriveFunctor - DeriveFoldable - DeriveTraversable - DeriveGeneric - DerivingStrategies - DerivingVia - DoAndIfThenElse - DuplicateRecordFields - FlexibleContexts - FlexibleInstances - GADTs - GeneralizedNewtypeDeriving - ImportQualifiedPost - InstanceSigs - KindSignatures - LambdaCase - MultiParamTypeClasses - MultiWayIf - NamedFieldPuns - NumericUnderscores - OverloadedLabels - OverloadedStrings - PatternSynonyms - RankNTypes - ScopedTypeVariables - TupleSections - TypeApplications - ViewPatterns - ghc-options: -Wall -W -threaded -rtsopts "-with-rtsopts=-N -T" -v0 - build-tools: - unison - build-depends: - base - , code-page - , directory - , easytest - , filepath - , process - , shellmet - , time - default-language: Haskell2010 - if flag(optimized) - ghc-options: -O2 -funbox-strict-fields - executable unison main-is: Main.hs other-modules: From e171df7cd78158cec7da706fcbeb6f42ddff0cfe Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Mon, 25 Mar 2024 05:23:30 -0600 Subject: [PATCH 089/124] supposed to only clean unison-cli-main was the point --- .github/workflows/build-optimized-ucm.yaml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/.github/workflows/build-optimized-ucm.yaml b/.github/workflows/build-optimized-ucm.yaml index 00f4016f3..caf23166d 100644 --- a/.github/workflows/build-optimized-ucm.yaml +++ b/.github/workflows/build-optimized-ucm.yaml @@ -41,14 +41,16 @@ jobs: run: | # unison-cli embeds version numbers using TH # so it needs to be forced to rebuild to ensure those are updated. - stack clean unison-cli + stack clean unison-cli-main # Windows will crash on build intermittently because the filesystem # sucks at managing concurrent file access; # Just keep retrying on these failures. tries=5 for (( i = 0; i < $tries; i++ )); do - stack --no-terminal build --flag unison-parser-typechecker:optimized && break; + stack build unison-cli-main \ + --flag unison-parser-typechecker:optimized \ + && break; done - name: save stack caches From dba1c33ffb31d50fbbf9cf11bd3680a4b982b248 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Mon, 25 Mar 2024 06:18:52 -0600 Subject: [PATCH 090/124] setup prerelease name --- .github/workflows/pre-release.yaml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index fd9463957..0ec018424 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -35,10 +35,15 @@ jobs: with: path: /tmp/ucm + - name: set up release name + run: | + tag_name=$(echo "${{ github.ref }}" | awk -F'/' '{print $NF}') + echo "tag_name=$tag_name" >> $GITHUB_ENV + - uses: "marvinpinto/action-automatic-releases@latest" with: repo_token: "${{ secrets.GITHUB_TOKEN }}" - automatic_release_tag: ${{ github.ref }}-build + automatic_release_tag: ${{ env.tag_name }}-build prerelease: true title: Development Build files: | From 6fa22809c5b4bb2735a9a6418e7cce5340f07c35 Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Mon, 25 Mar 2024 10:14:29 -0600 Subject: [PATCH 091/124] Update pre-release.yaml download to match upload --- .github/workflows/pre-release.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index e3d713c7c..8e3b446e5 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -29,7 +29,7 @@ jobs: run: mkdir /tmp/ucm - name: "download artifacts" - uses: actions/download-artifact@v2 + uses: actions/download-artifact@v4 with: path: /tmp/ucm From 5f99eb3451193786d653af6256087f7b242f629e Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Mon, 25 Mar 2024 15:17:29 -0400 Subject: [PATCH 092/124] Give a more informative error for miscellaneous try-eval --- scheme-libs/racket/unison/concurrent.ss | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scheme-libs/racket/unison/concurrent.ss b/scheme-libs/racket/unison/concurrent.ss index 0f85aa035..67520ae30 100644 --- a/scheme-libs/racket/unison/concurrent.ss +++ b/scheme-libs/racket/unison/concurrent.ss @@ -137,6 +137,6 @@ (lambda (e) (exception ref-miscfailure:typelink - (string->chunked-string "unknown exception") + (exception->string e) ref-unit-unit))]) (right (thunk))))) From d8e2ef3decc5051e479f4cc006c8c1cda1348ebb Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Mon, 25 Mar 2024 14:38:00 -0600 Subject: [PATCH 093/124] add github.ref to prerelease workflow name --- .github/workflows/pre-release.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index 8e3b446e5..a9c554ec1 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -1,4 +1,4 @@ -name: pre-release +name: pre-release (${{ github.ref }}) defaults: run: From e872c80f83142ba7acfeb6900a0aecdb90f595a1 Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Mon, 25 Mar 2024 15:15:22 -0600 Subject: [PATCH 094/124] that did not work --- .github/workflows/pre-release.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index a9c554ec1..8e3b446e5 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -1,4 +1,4 @@ -name: pre-release (${{ github.ref }}) +name: pre-release defaults: run: From 3ec6c65300d525d98d073736d7f48c3934bd7c12 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Mon, 25 Mar 2024 15:56:45 -0600 Subject: [PATCH 095/124] use github.ref_name for pre-release bundle name --- .github/workflows/pre-release.yaml | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index 0ec018424..490b252f4 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -35,17 +35,12 @@ jobs: with: path: /tmp/ucm - - name: set up release name - run: | - tag_name=$(echo "${{ github.ref }}" | awk -F'/' '{print $NF}') - echo "tag_name=$tag_name" >> $GITHUB_ENV - - uses: "marvinpinto/action-automatic-releases@latest" with: repo_token: "${{ secrets.GITHUB_TOKEN }}" - automatic_release_tag: ${{ env.tag_name }}-build + automatic_release_tag: ${{ github.ref_name }}-build prerelease: true - title: Development Build + title: Development Build (${{ github.ref_name }}) files: | /tmp/ucm/**/ucm-*.tar.gz /tmp/ucm/**/ucm-*.zip From c225961ab7c5c040e13ed011a7ab71f5e2af0cff Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Mon, 25 Mar 2024 18:33:55 -0600 Subject: [PATCH 096/124] release.yaml only takes the one arg now... `${target}` should have always been passed as `--ref` iirc --- scripts/make-release.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/scripts/make-release.sh b/scripts/make-release.sh index 1d6e2a105..0f8f0c7ff 100755 --- a/scripts/make-release.sh +++ b/scripts/make-release.sh @@ -53,8 +53,8 @@ git fetch origin trunk git tag "${tag}" "${target}" git push origin "${tag}" gh workflow run release --repo unisonweb/unison \ - --field "version=${version}" \ - --field "target=${target}" + --ref "${target}" \ + --field "version=${version} echo "Kicking off Homebrew update task" gh workflow run release --repo unisonweb/homebrew-unison --field "version=${version}" From 51153d8caca4a42f8f4837d12e2f1430958476b4 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Mon, 25 Mar 2024 18:38:57 -0600 Subject: [PATCH 097/124] update hie.yaml --- hie.yaml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/hie.yaml b/hie.yaml index 03f93ad40..383e58bd0 100644 --- a/hie.yaml +++ b/hie.yaml @@ -111,11 +111,11 @@ cradle: - path: "unison-cli/tests" component: "unison-cli:test:cli-tests" - - path: "unison-cli-main/integration-tests/Suite.hs" - component: "unison-cli-main:exe:cli-integration-tests" + - path: "unison-cli-integration/integration-tests/Suite.hs" + component: "unison-cli-integration:exe:cli-integration-tests" - - path: "unison-cli-main/integration-tests/IntegrationTests/ArgumentParsing.hs" - component: "unison-cli-main:exe:cli-integration-tests" + - path: "unison-cli-integration/integration-tests/IntegrationTests/ArgumentParsing.hs" + component: "unison-cli-integration:exe:cli-integration-tests" - path: "unison-cli-main/unison/Main.hs" component: "unison-cli-main:exe:unison" From fe22f956c43db8e19b82674a6c64efc6c2c8a3e7 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Mon, 25 Mar 2024 20:31:45 -0600 Subject: [PATCH 098/124] drop earlier segments from release name, but allow override --- .github/workflows/pre-release.yaml | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index 490b252f4..6144ad865 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -12,6 +12,10 @@ on: types: - completed workflow_dispatch: + inputs: + tag: + description: specify the tag name for the release + required: false jobs: bundle-ucm: @@ -35,12 +39,20 @@ jobs: with: path: /tmp/ucm + - name: derive release tag + run: | + if [ -n "${{ github.event.inputs.tag }}" ]; then + echo "ref_name=${{ github.event.inputs.tag }}" + else + echo "ref_name=$(echo ${{ github.ref_name }} | awk -F'/' '{print $NF}')" + fi + - uses: "marvinpinto/action-automatic-releases@latest" with: repo_token: "${{ secrets.GITHUB_TOKEN }}" - automatic_release_tag: ${{ github.ref_name }}-build + automatic_release_tag: ${{ env.ref_name }}-build prerelease: true - title: Development Build (${{ github.ref_name }}) + title: Development Build (${{ env.ref_name }}) files: | /tmp/ucm/**/ucm-*.tar.gz /tmp/ucm/**/ucm-*.zip From 108d6d5121bac6b4a0ebd6e688f9c257f1ca878b Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Tue, 26 Mar 2024 20:02:57 -0600 Subject: [PATCH 099/124] Update .github/workflows/bundle-ucm.yaml --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 4fcac2d51..fc5e8767d 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -65,7 +65,7 @@ jobs: else ucm=$(stack exec which unison) fi - echo ucm="$ucm" > $GITHUB_ENV + echo ucm="$ucm" >> $GITHUB_ENV ls -l $ucm - name: save stack caches From 6b5abd01d38d8d876a5fe19a42081d3627bad4d2 Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Tue, 26 Mar 2024 20:05:07 -0600 Subject: [PATCH 100/124] write env vars to $GITHUB_ENV and not just to nowhere --- .github/workflows/pre-release.yaml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index 6144ad865..6d93d7fa9 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -42,10 +42,11 @@ jobs: - name: derive release tag run: | if [ -n "${{ github.event.inputs.tag }}" ]; then - echo "ref_name=${{ github.event.inputs.tag }}" + ref_name=${{ github.event.inputs.tag }} else - echo "ref_name=$(echo ${{ github.ref_name }} | awk -F'/' '{print $NF}')" + ref_name=$(echo ${{ github.ref_name }} | awk -F'/' '{print $NF}') fi + echo "ref_name=$ref_name" >> $GITHUB_ENV - uses: "marvinpinto/action-automatic-releases@latest" with: From 369c3a8c4bd0433ca7e35ed932bee54413240baf Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Tue, 26 Mar 2024 20:14:40 -0600 Subject: [PATCH 101/124] remove the tag name input in favor of being more opinionated --- .github/workflows/pre-release.yaml | 14 ++------------ 1 file changed, 2 insertions(+), 12 deletions(-) diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index 6d93d7fa9..64ed1cd96 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -1,5 +1,5 @@ name: pre-release -run-name: pre-release ${{inputs.version}} +run-name: pre-release ${{github.ref_name}} defaults: run: @@ -12,10 +12,6 @@ on: types: - completed workflow_dispatch: - inputs: - tag: - description: specify the tag name for the release - required: false jobs: bundle-ucm: @@ -40,13 +36,7 @@ jobs: path: /tmp/ucm - name: derive release tag - run: | - if [ -n "${{ github.event.inputs.tag }}" ]; then - ref_name=${{ github.event.inputs.tag }} - else - ref_name=$(echo ${{ github.ref_name }} | awk -F'/' '{print $NF}') - fi - echo "ref_name=$ref_name" >> $GITHUB_ENV + run: echo "ref_name=$(echo ${{ github.ref_name }} | awk -F'/' '{print $NF}')" >> $GITHUB_ENV - uses: "marvinpinto/action-automatic-releases@latest" with: From 3771db2ae41012b309a47a6a9a4eb8189b791124 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Tue, 26 Mar 2024 20:36:16 -0600 Subject: [PATCH 102/124] add startup script to bundle-ucm --- .github/workflows/bundle-ucm.yaml | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index fc5e8767d..f21aae699 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -196,17 +196,13 @@ jobs: artifact_os="$(echo $RUNNER_OS | tr '[:upper:]' '[:lower:]')" echo "staging_dir=$staging_dir" >> $GITHUB_ENV echo "artifact_os=$artifact_os" >> $GITHUB_ENV - - name: make staging dir - run: mkdir -p ${{env.staging_dir}}/{racket,ui} - name: download ucm uses: actions/download-artifact@v4 with: name: unison-${{matrix.os}} - path: ${{env.staging_dir}}/ + path: ${{env.staging_dir}}/unison/ - name: restore permissions on ucm - run: chmod +x ${{env.staging_dir}}/unison - - name: rename unison -> ucm - run: mv ${{env.staging_dir}}/unison ${{env.staging_dir}}/ucm + run: chmod +x ${{env.staging_dir}}/unison/unison - name: download racket lib uses: actions/download-artifact@v4 with: @@ -228,10 +224,22 @@ jobs: curl -L -o /tmp/unisonLocal.zip \ https://github.com/unisonweb/unison-local-ui/releases/download/latest/unisonLocal.zip unzip -d ${{env.staging_dir}}/ui /tmp/unisonLocal.zip + - name: create startup script + run: | + if [[ ${{runner.os}} = 'Windows' ]]; then + echo > ${{env.staging_dir}}/ucm.cmd << EOF + @echo off + "%~dp0unison\ucm.exe" --runtime-path "%~dp0runtime\unison-runtime.exe" + EOF + else + echo > ${{env.staging_dir}}/ucm << EOF + #!/bin/bash + $(dirname "$0")/unison/unison --runtime-path $(dirname "$0")/runtime/bin/unison-runtime + EOF + chmod +x ${{env.staging_dir}}/ucm + fi - name: package everything together run: | - ls -l `find ${{env.staging_dir}}` - if [[ ${{runner.os}} = 'Windows' ]]; then artifact_archive=ucm-${{env.artifact_os}}.zip 7z a -r -tzip ${artifact_archive} ${{env.staging_dir}}/* @@ -240,8 +248,6 @@ jobs: tar -c -z -f ${artifact_archive} -C ${{env.staging_dir}} . fi echo "artifact_archive=${artifact_archive}" >> $GITHUB_ENV - ls -l ${{env.artifact_archive}} - - name: upload artifact uses: actions/upload-artifact@v4 with: From e83f4f6a31f531bde477d0dd2aa52bbd3678e641 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Tue, 26 Mar 2024 21:19:05 -0600 Subject: [PATCH 103/124] another try at creating startup script --- .github/workflows/bundle-ucm.yaml | 29 +++++++++++++++++------------ 1 file changed, 17 insertions(+), 12 deletions(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index f21aae699..5e069f60d 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -224,26 +224,31 @@ jobs: curl -L -o /tmp/unisonLocal.zip \ https://github.com/unisonweb/unison-local-ui/releases/download/latest/unisonLocal.zip unzip -d ${{env.staging_dir}}/ui /tmp/unisonLocal.zip - - name: create startup script - run: | - if [[ ${{runner.os}} = 'Windows' ]]; then - echo > ${{env.staging_dir}}/ucm.cmd << EOF - @echo off - "%~dp0unison\ucm.exe" --runtime-path "%~dp0runtime\unison-runtime.exe" - EOF - else - echo > ${{env.staging_dir}}/ucm << EOF + - name: create startup script (non-Windows) + if: runner.os != 'Windows' + uses: 1arp/create-a-file@0 + with: + path: ${{env.staging_dir}} + file: ucm + content: | #!/bin/bash $(dirname "$0")/unison/unison --runtime-path $(dirname "$0")/runtime/bin/unison-runtime - EOF - chmod +x ${{env.staging_dir}}/ucm - fi + - name: create startup script (Windows) + if: runner.os == 'Windows' + uses: 1arp/create-a-file@0 + with: + path: ${{env.staging_dir}} + file: ucm.cmd + content: | + @echo off + "%~dp0unison\ucm.exe" --runtime-path "%~dp0runtime\unison-runtime.exe" - name: package everything together run: | if [[ ${{runner.os}} = 'Windows' ]]; then artifact_archive=ucm-${{env.artifact_os}}.zip 7z a -r -tzip ${artifact_archive} ${{env.staging_dir}}/* else + chmod +x ${{env.staging_dir}}/ucm artifact_archive=ucm-${{env.artifact_os}}.tar.gz tar -c -z -f ${artifact_archive} -C ${{env.staging_dir}} . fi From 5b0bcabdc1ea3b73c07e7fc79cddc4ff1b1f7664 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Tue, 26 Mar 2024 21:41:11 -0600 Subject: [PATCH 104/124] annoying --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 5e069f60d..defd48b9d 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -235,7 +235,7 @@ jobs: $(dirname "$0")/unison/unison --runtime-path $(dirname "$0")/runtime/bin/unison-runtime - name: create startup script (Windows) if: runner.os == 'Windows' - uses: 1arp/create-a-file@0 + uses: 1arp/create-a-file-action@0 with: path: ${{env.staging_dir}} file: ucm.cmd From af32a30ab6bb5784f2c9faa8dc3990fa18d02ca4 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Tue, 26 Mar 2024 21:55:16 -0600 Subject: [PATCH 105/124] instructions unclear --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index defd48b9d..876e3d68d 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -235,7 +235,7 @@ jobs: $(dirname "$0")/unison/unison --runtime-path $(dirname "$0")/runtime/bin/unison-runtime - name: create startup script (Windows) if: runner.os == 'Windows' - uses: 1arp/create-a-file-action@0 + uses: 1arp/create-a-file-action@v0 with: path: ${{env.staging_dir}} file: ucm.cmd From e15d87212292fd56c4e7e58e1cd9e2157e82421a Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Tue, 26 Mar 2024 23:20:35 -0600 Subject: [PATCH 106/124] trying again --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 876e3d68d..86c7eb287 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -235,7 +235,7 @@ jobs: $(dirname "$0")/unison/unison --runtime-path $(dirname "$0")/runtime/bin/unison-runtime - name: create startup script (Windows) if: runner.os == 'Windows' - uses: 1arp/create-a-file-action@v0 + uses: 1arp/create-a-file-action@0.4.4 with: path: ${{env.staging_dir}} file: ucm.cmd From 2952bee715df77c5d620e030d54f6c27075af513 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Tue, 26 Mar 2024 23:41:08 -0600 Subject: [PATCH 107/124] my screen wasn't big enough to remember there were two of them --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 86c7eb287..184e406ef 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -226,7 +226,7 @@ jobs: unzip -d ${{env.staging_dir}}/ui /tmp/unisonLocal.zip - name: create startup script (non-Windows) if: runner.os != 'Windows' - uses: 1arp/create-a-file@0 + uses: 1arp/create-a-file-action@0 with: path: ${{env.staging_dir}} file: ucm From 6ec135e083cbc9680f0d30858a3d6a8ed5b47207 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Tue, 26 Mar 2024 23:52:28 -0600 Subject: [PATCH 108/124] it was worth a shot --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 184e406ef..91d34b456 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -226,7 +226,7 @@ jobs: unzip -d ${{env.staging_dir}}/ui /tmp/unisonLocal.zip - name: create startup script (non-Windows) if: runner.os != 'Windows' - uses: 1arp/create-a-file-action@0 + uses: 1arp/create-a-file-action@0.4.4 with: path: ${{env.staging_dir}} file: ucm From 3560a6e8c5d98e1e91eb18acef1ef34e287c51dd Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 28 Mar 2024 09:19:33 -0700 Subject: [PATCH 109/124] Fix conversion from referent2to1 for Doc fuzzyfind results --- unison-share-api/src/Unison/Server/Backend.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/unison-share-api/src/Unison/Server/Backend.hs b/unison-share-api/src/Unison/Server/Backend.hs index 07a7eeefb..db883d269 100644 --- a/unison-share-api/src/Unison/Server/Backend.hs +++ b/unison-share-api/src/Unison/Server/Backend.hs @@ -277,7 +277,7 @@ data TermEntry v a = TermEntry deriving (Eq, Ord, Show, Generic) termEntryLabeledDependencies :: Ord v => TermEntry v a -> Set LD.LabeledDependency -termEntryLabeledDependencies TermEntry {termEntryType, termEntryReferent, termEntryTag} = +termEntryLabeledDependencies TermEntry {termEntryType, termEntryReferent, termEntryTag, termEntryName} = foldMap Type.labeledDependencies termEntryType <> Set.singleton (LD.TermReferent (Cv.referent2to1UsingCT ct termEntryReferent)) where @@ -285,7 +285,8 @@ termEntryLabeledDependencies TermEntry {termEntryType, termEntryReferent, termEn ct = case termEntryTag of ServerTypes.Constructor ServerTypes.Ability -> V2Referent.EffectConstructor ServerTypes.Constructor ServerTypes.Data -> V2Referent.DataConstructor - _ -> error "termEntryLabeledDependencies: not a constructor, but one was required" + ServerTypes.Doc -> V2Referent.DataConstructor + _ -> error $ "termEntryLabeledDependencies: Term is not a constructor, but the referent was a constructor. Tag: " <> show termEntryTag <> " Name: " <> show termEntryName <> " Referent: " <> show termEntryReferent termEntryDisplayName :: TermEntry v a -> Text termEntryDisplayName = HQ'.toTextWith Name.toText . termEntryHQName From fe5f8994d91ee4a28ed93b258082a282fa1f343d Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Thu, 28 Mar 2024 17:40:43 -0400 Subject: [PATCH 110/124] Flesh out universal comparison in jit Miscellaneous tweaks related to the process of filling this in --- scheme-libs/racket/unison/boot.ss | 5 - scheme-libs/racket/unison/concurrent.ss | 1 - scheme-libs/racket/unison/core.ss | 231 +++++++++++++++++++----- scheme-libs/racket/unison/primops.ss | 2 +- scheme-libs/racket/unison/tls.rkt | 2 - 5 files changed, 191 insertions(+), 50 deletions(-) diff --git a/scheme-libs/racket/unison/boot.ss b/scheme-libs/racket/unison/boot.ss index 8da74927a..2de387d58 100644 --- a/scheme-libs/racket/unison/boot.ss +++ b/scheme-libs/racket/unison/boot.ss @@ -545,11 +545,6 @@ [(unison-termlink-con tyl i) (ref-referent-con (typelink->reference tyl) i)])) -(define (list->unison-tuple l) - (foldr ref-tuple-pair ref-unit-unit l)) - -(define (unison-tuple . l) (list->unison-tuple l)) - (define (unison-seq . l) (vector->chunked-list (list->vector l))) diff --git a/scheme-libs/racket/unison/concurrent.ss b/scheme-libs/racket/unison/concurrent.ss index 67520ae30..6ac7b81bc 100644 --- a/scheme-libs/racket/unison/concurrent.ss +++ b/scheme-libs/racket/unison/concurrent.ss @@ -106,7 +106,6 @@ (or (exn:fail:contract:divide-by-zero? e) (exn:fail:contract:non-fixnum-result? e))) - ;; TODO Replace strings with proper type links once we have them (define (try-eval thunk) (with-handlers ([exn:break? diff --git a/scheme-libs/racket/unison/core.ss b/scheme-libs/racket/unison/core.ss index e0bf83088..2c703eec6 100644 --- a/scheme-libs/racket/unison/core.ss +++ b/scheme-libs/racket/unison/core.ss @@ -30,6 +30,9 @@ chunked-string-foldMap-chunks + unison-tuple + list->unison-tuple + freeze-bytevector! freeze-vector! freeze-subvector @@ -69,6 +72,7 @@ build-path path->string match + match* for/fold) (string-copy! racket-string-copy!) (bytes-append bytevector-append) @@ -184,12 +188,43 @@ [sfx (if (<= l 10) "" "...")]) (string-append "32x" (substring s 0 10) sfx))) +(define (describe-tuple x) + (define (format-tuple l) + (for/fold + ([sep ")"] + [bits '()] + #:result (apply string-append (cons "(" bits))) + ([e l]) + (values ", " (list* (describe-value e) sep bits)))) + + (define (format-non-tuple l) + (for/fold + ([result #f]) + ([e l]) + (let ([de (describe-value e)]) + (if (not result) de + (string-append "Cons (" de ") (" result ")"))))) + + (let rec ([acc '()] [tup x]) + (match tup + [(unison-data r t (list x y)) + #:when (eq? r ref-tuple:typelink) + (rec (cons x acc) y)] + [(unison-data r t (list)) + #:when (eq? r ref-unit:typelink) + (format-tuple acc)] + [else + (format-non-tuple (cons tup acc))]))) + (define (describe-value x) (match x [(unison-sum t fs) (let ([tt (number->string t)] [vs (describe-list-br fs)]) (string-append "Sum " tt " " vs))] + [(unison-data r t fs) + #:when (eq? r ref-tuple:typelink) + (describe-tuple x)] [(unison-data r t fs) (let ([tt (number->string t)] [rt (describe-ref r)] @@ -258,62 +293,158 @@ [else sc]))])) ; universal-compares two lists of values lexicographically -(define (lexico-compare ls rs) +(define (lexico-compare ls rs cmp-ty) (let rec ([cls ls] [crs rs]) (cond [(and (null? cls) (null? crs)) '=] [else (comparisons - (universal-compare (car cls) (car crs)) + (universal-compare (car cls) (car crs) cmp-ty) (rec (cdr cls) (cdr crs)))]))) -(define (cmp-num l r) +(define ((comparison e? l?) l r) (cond - [(= l r) '=] - [(< l r) '<] + [(e? l r) '=] + [(l? l r) '<] [else '>])) -(define (compare-char a b) - (cond - [(char=? a b) '=] - [(char])) +(define compare-num (comparison = <)) +(define compare-char (comparison char=? char])) +(define (compare-typelink ll rl) + (match ll + [(unison-typelink-builtin lnm) + (match rl + [(unison-typelink-builtin rnm) (compare-string lnm rnm)] + [(? unison-typelink-derived?) '<])] + [(unison-typelink-derived lh i) + (match rl + [(unison-typelink-derived rh j) + (comparisons + (compare-bytes lh rh) + (compare-num i j))] + [(? unison-typelink-builtin?) '>])])) -(define (universal-compare l r) +(define (compare-termlink ll rl) + (match ll + [(unison-termlink-builtin lnm) + (match rl + [(unison-termlink-builtin rnm) + (compare-string lnm rnm)] + [else '<])] + [(unison-termlink-derived lh i) + (match rl + [(unison-termlink-derived rh j) + (comparisons + (compare-bytes lh rh) + (compare-num i j))] + [(? unison-termlink-builtin?) '>] + [else '<])] + [(unison-termlink-con lr t) + (match rl + [(unison-termlink-con rr u) + (comparisons + (compare-typelink lr rr) + (compare-num t u))] + [else '>])])) + +(define (value->category v) (cond - [(equal? l r) '=] - [(and (number? l) (number? r)) (if (< l r) '< '>)] - [(and (char? l) (char? r)) (if (char)] + [(procedure? v) 0] + [(unison-closure? v) 0] + [(number? v) 1] + [(char? v) 1] + [(boolean? v) 1] + [(unison-data? v) 1] + [(chunked-list? v) 3] + [(chunked-string? v) 3] + [(chunked-bytes? v) 3] + [(unison-termlink? v) 3] + [(unison-typelink? v) 3] + [(bytes? v) 5])) + +(define (compare-data l r cmp-ty) + (match* (l r) + [((unison-data lr lt lfs) (unison-data rr rt rfs)) + (compare-data-stuff lr lt lfs rr rt rfs cmp-ty)])) + +(define (compare-data-stuff lr lt lfs rr rt rfs cmp-ty) + (define new-cmp-ty (or cmp-ty (eq? lr builtin-any:typelink))) + (comparisons + (if cmp-ty (compare-typelink lr rr) '=) + (compare-num lt rt) + (compare-num (length lfs) (length rfs)) + (lexico-compare lfs rfs new-cmp-ty))) + +; gives links to compare values as pseudo- or actual data types. +; This is how the interpreter works, so this is an attempt to obtain +; the same ordering. +(define (pseudo-data-link v) + (cond + [(boolean? v) builtin-boolean:typelink] + [(char? v) builtin-char:typelink] + [(flonum? v) builtin-float:typelink] + [(and (number? v) (negative? v)) builtin-int:typelink] + [(number? v) builtin-nat:typelink] + [(unison-data? v) (unison-data-ref v)])) + +(define (compare-proc l r cmp-ty) + (define (unpack v) + (if (procedure? v) + (values (lookup-function-link v) '()) + (values + (lookup-function-link (unison-closure-code v)) + (unison-closure-env v)))) + + (define-values (lnl envl) (unpack l)) + + (define-values (lnr envr) (unpack r)) + + (comparisons + (compare-termlink lnl lnr) + (lexico-compare envl envr cmp-ty))) + +(define (universal-compare l r [cmp-ty #f]) + (define (u-proc? v) + (or (procedure? v) (unison-closure? v))) + + (cond + [(eq? l r) '=] ; optimistic equality case [(and (boolean? l) (boolean? r)) (if r '< '>)] - [(and (chunked-list? l) (chunked-list? r)) (chunked-list-compare/recur l r universal-compare)] + [(and (char? l) (char? r)) (if (char)] + [(and (number? l) (number? r)) (compare-num l r)] + [(and (chunked-list? l) (chunked-list? r)) + (chunked-list-compare/recur l r universal-compare)] [(and (chunked-string? l) (chunked-string? r)) (chunked-string-compare/recur l r compare-char)] [(and (chunked-bytes? l) (chunked-bytes? r)) (chunked-bytes-compare/recur l r compare-byte)] - [(and (bytes? l) (bytes? r)) - (cond - [(bytes=? l r) '=] - [(bytes])] - [(and (unison-data? l) (unison-data? r)) - (let ([fls (unison-data-fields l)] [frs (unison-data-fields r)]) - (comparisons - (cmp-num (unison-data-tag l) (unison-data-tag r)) - (cmp-num (length fls) (length frs)) - (lexico-compare fls frs)))] + [(and (unison-data? l) (unison-data? r)) (compare-data l r cmp-ty)] + [(and (bytes? r) (bytes? r)) (compare-bytes l r)] + [(and (u-proc? l) (u-proc? r)) (compare-proc l r)] + [(and (unison-termlink? l) (unison-termlink? r)) + (compare-termlink l r)] + [(and (unison-typelink? l) (unison-typelink? r)) + (compare-typelink l r)] + [(= 3 (value->category l) (value->category r)) + (compare-typelink (pseudo-data-link l) (pseudo-data-link r))] + [(= (value->category l) (value->category r)) + (raise + (make-exn:bug + "unsupported universal comparison of values" + (unison-tuple l r)))] [else - (let ([dl (describe-value l)] - [dr (describe-value r)]) - (raise - (format - "universal-compare: unimplemented\n~a\n\n~a" - dl dr)))])) + (compare-num (value->category l) (value->category r))])) + + +(define (list->unison-tuple l) + (foldr ref-tuple-pair ref-unit-unit l)) + +(define (unison-tuple . l) (list->unison-tuple l)) + (define (chunked-stringstring (exn:bug-msg ex)) port) + (if mode (write-string " " port) (newline port)) + (write-string (describe-value (exn:bug-val ex)) port)) + + (when mode + (write-string ">"))) + +(struct exn:bug (msg val) + #:constructor-name make-exn:bug + #:methods gen:custom-write + [(define write-proc write-exn:bug)]) + + (define (exn:bug->exception b) (exception ref-runtimefailure:typelink (exn:bug-msg b) - (exn:bug-a b))) + (exn:bug-val b))) diff --git a/scheme-libs/racket/unison/primops.ss b/scheme-libs/racket/unison/primops.ss index 080fe6ae3..dffdae99f 100644 --- a/scheme-libs/racket/unison/primops.ss +++ b/scheme-libs/racket/unison/primops.ss @@ -909,7 +909,7 @@ (define (unison-POp-EQLT s t) (bool (equal? s t))) (define (unison-POp-LEQT s t) (bool (chunked-stringstring fnm)) (put-string p ": ") diff --git a/scheme-libs/racket/unison/tls.rkt b/scheme-libs/racket/unison/tls.rkt index 136bb52d4..8f7f3b341 100644 --- a/scheme-libs/racket/unison/tls.rkt +++ b/scheme-libs/racket/unison/tls.rkt @@ -113,8 +113,6 @@ (define (ClientConfig.certificates.set certs config) ; list tlsSignedCert tlsClientConfig -> tlsClientConfig (client-config (client-config-host config) certs)) -; TODO: have someone familiar with TLS verify these exception -; classifications (define (handle-errors fn) (with-handlers [[exn:fail:network? From bb0ee7d044c787f5c0f506b2d0299dc3942141bd Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Thu, 28 Mar 2024 17:41:24 -0400 Subject: [PATCH 111/124] Add link equality/comparison tests to jit test suite --- unison-src/builtin-tests/interpreter-tests.md | 5 +++++ unison-src/builtin-tests/jit-tests.md | 5 +++++ unison-src/builtin-tests/tests.u | 1 + 3 files changed, 11 insertions(+) diff --git a/unison-src/builtin-tests/interpreter-tests.md b/unison-src/builtin-tests/interpreter-tests.md index 3530224d9..d81f0ccd7 100644 --- a/unison-src/builtin-tests/interpreter-tests.md +++ b/unison-src/builtin-tests/interpreter-tests.md @@ -21,6 +21,11 @@ to `Tests.check` and `Tests.checkEqual`). .> add ``` +```ucm:hide +.> load unison-src/builtin-tests/link-tests.u +.> add +``` + ```ucm:hide .> load unison-src/builtin-tests/math-tests.u .> add diff --git a/unison-src/builtin-tests/jit-tests.md b/unison-src/builtin-tests/jit-tests.md index a5212c99f..32e6aee7e 100644 --- a/unison-src/builtin-tests/jit-tests.md +++ b/unison-src/builtin-tests/jit-tests.md @@ -21,6 +21,11 @@ to `Tests.check` and `Tests.checkEqual`). .> add ``` +```ucm:hide +.> load unison-src/builtin-tests/link-tests.u +.> add +``` + ```ucm:hide .> load unison-src/builtin-tests/math-tests.u .> add diff --git a/unison-src/builtin-tests/tests.u b/unison-src/builtin-tests/tests.u index dd865223d..3151255b0 100644 --- a/unison-src/builtin-tests/tests.u +++ b/unison-src/builtin-tests/tests.u @@ -17,6 +17,7 @@ tests = Tests.main do !array.tests !codelookup.tests !sandbox.tests + !linkstuff.tests murmur.hash.tests = do targets = From e695cf75dbae0cda1340cc0afb1fa33551fb9291 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Thu, 28 Mar 2024 16:14:49 -0600 Subject: [PATCH 112/124] switch windows executable name --- .github/workflows/bundle-ucm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index 91d34b456..a3a40e17e 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -241,7 +241,7 @@ jobs: file: ucm.cmd content: | @echo off - "%~dp0unison\ucm.exe" --runtime-path "%~dp0runtime\unison-runtime.exe" + "%~dp0unison\unison.exe" --runtime-path "%~dp0runtime\unison-runtime.exe" - name: package everything together run: | if [[ ${{runner.os}} = 'Windows' ]]; then From f0c56cb7b289f19dbabda0e8736c9d1bf4addf31 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Thu, 28 Mar 2024 17:11:19 -0600 Subject: [PATCH 113/124] automatically run a pre-release whenever the pre-release code changes --- .github/workflows/pre-release.yaml | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index 64ed1cd96..3acc43076 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -6,13 +6,22 @@ defaults: shell: bash on: + # run on each merge to `trunk` workflow_run: workflows: ["CI"] branches: [trunk] types: - completed + + # run manually workflow_dispatch: + # run for any PR that touches this file + pull_request: + paths: + - .github/workflows/pre-release.yaml + - .github/workflows/bundle-ucm.yaml + jobs: bundle-ucm: name: build and bundle ucm From 8c58de7d62f64c1d1cf19633c253b903254c905a Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Thu, 28 Mar 2024 19:30:07 -0400 Subject: [PATCH 114/124] Add jit link tests file --- unison-src/builtin-tests/link-tests.u | 58 +++++++++++++++++++++++++++ 1 file changed, 58 insertions(+) create mode 100644 unison-src/builtin-tests/link-tests.u diff --git a/unison-src/builtin-tests/link-tests.u b/unison-src/builtin-tests/link-tests.u new file mode 100644 index 000000000..6ec2d913a --- /dev/null +++ b/unison-src/builtin-tests/link-tests.u @@ -0,0 +1,58 @@ + +linkstuff.termlinks = + [ termLink data.Map.adjust + , termLink data.Map.alter + , termLink data.Map.contains + , termLink data.Map.delete + , termLink data.Map.difference + , termLink data.List.any + , termLink data.List.apply + , termLink data.List.compare + , termLink data.List.contains + , termLink data.List.count + , termLink data.List.diagonal + , termLink data.List.distinct + , termLink data.NatSet.alter + , termLink data.NatSet.any + , termLink data.NatSet.empty + , termLink data.NatSet.filter + , termLink data.Tuple.at1 + , termLink data.Tuple.at2 + , termLink data.Tuple.at3 + , termLink data.Tuple.bimap + , termLink data.Tuple.mapLeft + , termLink data.graph.SCC.map + ] + +linkstuff.typelinks = + [ typeLink data.Map + , typeLink Nat + , typeLink Char + , typeLink data.List + , typeLink data.NatSet + , typeLink data.Tuple + ] + +linkstuff.tmlpairs = + flatMap (l -> map (r -> (l,r)) termlinks) termlinks + +linkstuff.tylpairs = + flatMap (l -> map (r -> (l,r)) typelinks) typelinks + +linkstuff.tests : '{Tests,IO} () +linkstuff.tests = do + use Universal gteq + if all (cases (l,r) -> (l === r) || (l !== r)) tmlpairs + then pass "term link equality" + else fail "term link equality" "" + if all (cases (l,r) -> (l === r) || (l !== r)) tylpairs + then pass "type link equality" + else fail "type link equality" "" + + if all (cases (l,r) -> gteq l r || gteq r l) tmlpairs + then pass "term link comparison" + else fail "term link comparison" "" + if all (cases (l,r) -> gteq l r || gteq r l) tylpairs + then pass "type link comparison" + else fail "type link comparison" "" + From 08a971f56eb8990fc01d8da6adc491ef23e53eac Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Thu, 28 Mar 2024 19:12:00 -0600 Subject: [PATCH 115/124] delete pre-release on PR for now it could use some more work, PRs have a different ref format and the "derive release tag" step needs to be updated to detect and do something intelligent with it, but I didn't want to right now. --- .github/workflows/pre-release.yaml | 6 ------ 1 file changed, 6 deletions(-) diff --git a/.github/workflows/pre-release.yaml b/.github/workflows/pre-release.yaml index 3acc43076..3c3629ef9 100644 --- a/.github/workflows/pre-release.yaml +++ b/.github/workflows/pre-release.yaml @@ -16,12 +16,6 @@ on: # run manually workflow_dispatch: - # run for any PR that touches this file - pull_request: - paths: - - .github/workflows/pre-release.yaml - - .github/workflows/bundle-ucm.yaml - jobs: bundle-ucm: name: build and bundle ucm From 1415b3964d1ed8d872a4be7d1ed53b25558aa26b Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Thu, 28 Mar 2024 19:14:50 -0600 Subject: [PATCH 116/124] hide `run.native` and `compile.native` until release --- unison-cli/src/Unison/CommandLine/InputPatterns.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index ca94f78b4..a6369039f 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -2507,7 +2507,7 @@ runScheme = InputPattern "run.native" [] - I.Visible + I.Hidden [("definition to run", Required, exactDefinitionTermQueryArg), ("arguments", ZeroPlus, noCompletionsArg)] ( P.wrapColumn2 [ ( makeExample runScheme ["main", "args"], @@ -2524,7 +2524,7 @@ compileScheme = InputPattern "compile.native" [] - I.Visible + I.Hidden [("definition to compile", Required, exactDefinitionTermQueryArg), ("output file", Required, filePathArg)] ( P.wrapColumn2 [ ( makeExample compileScheme ["main", "file"], From e9aadfaa545aacb90a505a78e386344d771c2942 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Thu, 28 Mar 2024 22:54:01 -0600 Subject: [PATCH 117/124] update make-release.sh to build from release tag --- scripts/make-release.sh | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/scripts/make-release.sh b/scripts/make-release.sh index 0f8f0c7ff..0246584ae 100755 --- a/scripts/make-release.sh +++ b/scripts/make-release.sh @@ -13,10 +13,10 @@ usage() { prev_version="${prev_tag#release/}" prefix="${prev_version%.*}" next_version="${prefix}.$(( ${prev_version##*.} + 1 ))" - echo "usage: $0 [target]" + echo "usage: $0 [ref]" echo "" echo "version: The new version number" - echo "target: The Git revision to make the release from, defaults to 'origin/trunk'" + echo "ref: The Git revision to make the release from, defaults to 'origin/trunk'" echo "" echo "Try: $0 $next_version" } @@ -53,8 +53,8 @@ git fetch origin trunk git tag "${tag}" "${target}" git push origin "${tag}" gh workflow run release --repo unisonweb/unison \ - --ref "${target}" \ - --field "version=${version} + --ref "${tag}" \ + --field "version=${version}" echo "Kicking off Homebrew update task" gh workflow run release --repo unisonweb/homebrew-unison --field "version=${version}" From dabfc09c57197fe1997cc58b99f1e8efa15a2ff1 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Thu, 28 Mar 2024 23:44:57 -0600 Subject: [PATCH 118/124] pass the rest of the args from ucm wrapper --- .github/workflows/bundle-ucm.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/bundle-ucm.yaml b/.github/workflows/bundle-ucm.yaml index a3a40e17e..5a891823d 100644 --- a/.github/workflows/bundle-ucm.yaml +++ b/.github/workflows/bundle-ucm.yaml @@ -232,7 +232,7 @@ jobs: file: ucm content: | #!/bin/bash - $(dirname "$0")/unison/unison --runtime-path $(dirname "$0")/runtime/bin/unison-runtime + $(dirname "$0")/unison/unison --runtime-path $(dirname "$0")/runtime/bin/unison-runtime "$@" - name: create startup script (Windows) if: runner.os == 'Windows' uses: 1arp/create-a-file-action@0.4.4 @@ -241,7 +241,7 @@ jobs: file: ucm.cmd content: | @echo off - "%~dp0unison\unison.exe" --runtime-path "%~dp0runtime\unison-runtime.exe" + "%~dp0unison\unison.exe" --runtime-path "%~dp0runtime\unison-runtime.exe" %* - name: package everything together run: | if [[ ${{runner.os}} = 'Windows' ]]; then From eaee313440ee28d73deef464d70f3f986a40aa27 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Fri, 29 Mar 2024 12:39:30 -0400 Subject: [PATCH 119/124] Split corrected many pattern into two patterns --- parser-typechecker/src/Unison/Builtin.hs | 1 + .../src/Unison/Runtime/Builtin.hs | 4 +- .../src/Unison/Util/Text/Pattern.hs | 9 +- .../tests/Unison/Test/Util/Text.hs | 10 +- scheme-libs/racket/unison/primops.ss | 6 + .../all-base-hashes.output.md | 525 +++++++++--------- .../transcripts/builtins-merge.output.md | 2 +- .../transcripts/emptyCodebase.output.md | 4 +- unison-src/transcripts/merges.output.md | 12 +- unison-src/transcripts/move-all.output.md | 6 +- .../transcripts/move-namespace.output.md | 44 +- unison-src/transcripts/patterns.md | 1 + unison-src/transcripts/patterns.output.md | 5 + unison-src/transcripts/reflog.output.md | 10 +- unison-src/transcripts/reset.output.md | 10 +- unison-src/transcripts/squash.output.md | 20 +- .../transcripts/upgrade-happy-path.output.md | 2 +- 17 files changed, 345 insertions(+), 326 deletions(-) diff --git a/parser-typechecker/src/Unison/Builtin.hs b/parser-typechecker/src/Unison/Builtin.hs index 4ce2cf0e3..d0f0b814b 100644 --- a/parser-typechecker/src/Unison/Builtin.hs +++ b/parser-typechecker/src/Unison/Builtin.hs @@ -506,6 +506,7 @@ builtinsSrc = B "Text.patterns.notCharIn" $ list char --> pat text, -- Pattern.many : Pattern a -> Pattern a B "Pattern.many" $ forall1 "a" (\a -> pat a --> pat a), + B "Pattern.many.corrected" $ forall1 "a" (\a -> pat a --> pat a), B "Pattern.replicate" $ forall1 "a" (\a -> nat --> nat --> pat a --> pat a), B "Pattern.capture" $ forall1 "a" (\a -> pat a --> pat a), B "Pattern.captureAs" $ forall1 "a" (\a -> a --> pat a --> pat a), diff --git a/parser-typechecker/src/Unison/Runtime/Builtin.hs b/parser-typechecker/src/Unison/Runtime/Builtin.hs index e60b00ec7..8531698ca 100644 --- a/parser-typechecker/src/Unison/Runtime/Builtin.hs +++ b/parser-typechecker/src/Unison/Runtime/Builtin.hs @@ -3103,7 +3103,9 @@ declareForeigns = do _ -> die "Text.patterns.notCharIn: non-character closure" evaluate . TPat.cpattern . TPat.Char . TPat.Not $ TPat.CharSet cs declareForeign Untracked "Pattern.many" boxDirect . mkForeign $ - \(TPat.CP p _) -> evaluate . TPat.cpattern $ TPat.Many p + \(TPat.CP p _) -> evaluate . TPat.cpattern $ TPat.Many False p + declareForeign Untracked "Pattern.many.corrected" boxDirect . mkForeign $ + \(TPat.CP p _) -> evaluate . TPat.cpattern $ TPat.Many True p declareForeign Untracked "Pattern.capture" boxDirect . mkForeign $ \(TPat.CP p _) -> evaluate . TPat.cpattern $ TPat.Capture p declareForeign Untracked "Pattern.captureAs" boxBoxDirect . mkForeign $ diff --git a/parser-typechecker/src/Unison/Util/Text/Pattern.hs b/parser-typechecker/src/Unison/Util/Text/Pattern.hs index eeeef97dd..29ce6806a 100644 --- a/parser-typechecker/src/Unison/Util/Text/Pattern.hs +++ b/parser-typechecker/src/Unison/Util/Text/Pattern.hs @@ -12,7 +12,7 @@ data Pattern | Or Pattern Pattern -- left-biased choice: tries second pattern only if first fails | Capture Pattern -- capture all the text consumed by the inner pattern, discarding its subcaptures | CaptureAs Text Pattern -- capture the given text, discarding its subcaptures, and name the capture - | Many Pattern -- zero or more repetitions (at least 1 can be written: Join [p, Many p]) + | Many Bool Pattern -- zero or more repetitions (at least 1 can be written: Join [p, Many p]); boolean determines whether it works correctly | Replicate Int Int Pattern -- m to n occurrences of a pattern, optional = 0-1 | Eof -- succeed if given the empty text, fail otherwise | Literal Text -- succeed if input starts with the given text, advance by that text @@ -128,7 +128,7 @@ compile (CaptureAs t p) !err !success = go success' _ rem acc0 _ = success (pushCapture t acc0) rem compiled = compile p err' success' go acc t = compiled acc t acc t -compile (Capture (Many (Char Any))) !_ !success = \acc t -> success (pushCapture t acc) Text.empty +compile (Capture (Many _ (Char Any))) !_ !success = \acc t -> success (pushCapture t acc) Text.empty compile (Capture c) !err !success = go where err' _ _ acc0 t0 = err acc0 t0 @@ -152,12 +152,13 @@ compile (Char cp) !err !success = go go acc t = case Text.uncons t of Just (ch, rem) | ok ch -> success acc rem _ -> err acc t -compile (Many p) !_ !success = case p of +compile (Many correct p) !_ !success = case p of Char Any -> (\acc _ -> success acc Text.empty) Char cp -> walker (charPatternPred cp) p -> go where - go = try "Many" (compile p) success success' + go | correct = try "Many" (compile p) success success' + | otherwise = compile p success success' success' acc rem | Text.size rem == 0 = success acc rem | otherwise = go acc rem diff --git a/parser-typechecker/tests/Unison/Test/Util/Text.hs b/parser-typechecker/tests/Unison/Test/Util/Text.hs index ab791c1fd..e5e13e9d5 100644 --- a/parser-typechecker/tests/Unison/Test/Util/Text.hs +++ b/parser-typechecker/tests/Unison/Test/Util/Text.hs @@ -114,12 +114,12 @@ test = expect' (P.run (P.Char (P.CharSet "0123")) "3ab" == Just ([], "ab")) expect' (P.run (P.Char (P.Not (P.CharSet "0123"))) "a3b" == Just ([], "3b")) expect' (P.run (P.Capture (P.Char (P.Not (P.CharSet "0123")))) "a3b" == Just (["a"], "3b")) - expect' (P.run (P.Many (P.Char (P.CharSet "abcd"))) "babbababac123" == Just ([], "123")) - expect' (P.run (P.Capture (P.Many (P.Char (P.CharSet "abcd")))) "babbababac123" == Just (["babbababac"], "123")) - expect' (P.run (P.Capture (P.Many (P.Char (P.CharClass P.Number)))) "012345abc" == Just (["012345"], "abc")) - expect' (P.run (P.Join [P.Capture (P.Many (P.Char (P.CharClass P.Number))), P.Literal ",", P.Capture (P.Many (P.Char P.Any))]) "012345,abc" == Just (["012345", "abc"], "")) + expect' (P.run (P.Many True (P.Char (P.CharSet "abcd"))) "babbababac123" == Just ([], "123")) + expect' (P.run (P.Capture (P.Many True (P.Char (P.CharSet "abcd")))) "babbababac123" == Just (["babbababac"], "123")) + expect' (P.run (P.Capture (P.Many True (P.Char (P.CharClass P.Number)))) "012345abc" == Just (["012345"], "abc")) + expect' (P.run (P.Join [P.Capture (P.Many True (P.Char (P.CharClass P.Number))), P.Literal ",", P.Capture (P.Many True (P.Char P.Any))]) "012345,abc" == Just (["012345", "abc"], "")) expect' - ( P.run (P.Many (P.Join [P.Capture (P.Many (P.Char (P.CharClass P.Number))), P.Many (P.Char (P.CharClass P.Whitespace))])) "01 10 20 1123 292 110 10" + ( P.run (P.Many True (P.Join [P.Capture (P.Many True (P.Char (P.CharClass P.Number))), P.Many True (P.Char (P.CharClass P.Whitespace))])) "01 10 20 1123 292 110 10" == Just (["01", "10", "20", "1123", "292", "110", "10"], "") ) expect' $ diff --git a/scheme-libs/racket/unison/primops.ss b/scheme-libs/racket/unison/primops.ss index dffdae99f..e262d87bb 100644 --- a/scheme-libs/racket/unison/primops.ss +++ b/scheme-libs/racket/unison/primops.ss @@ -248,6 +248,8 @@ builtin-Char.Class.is:termlink builtin-Pattern.captureAs builtin-Pattern.captureAs:termlink + builtin-Pattern.many.corrected + builtin-Pattern.many.corrected:termlink builtin-Pattern.isMatch builtin-Pattern.isMatch:termlink builtin-IO.fileExists.impl.v3 @@ -740,6 +742,7 @@ (define-builtin-link Universal.compare) (define-builtin-link Universal.murmurHash) (define-builtin-link Pattern.captureAs) + (define-builtin-link Pattern.many.corrected) (define-builtin-link Pattern.isMatch) (define-builtin-link Char.Class.is) (define-builtin-link Scope.bytearrayOf) @@ -862,6 +865,8 @@ (define-unison (builtin-Pattern.captureAs c p) (capture-as c p)) + (define-unison (builtin-Pattern.many.corrected p) (many p)) + (define-unison (builtin-Pattern.isMatch p s) (pattern-match? p s)) @@ -1457,5 +1462,6 @@ (declare-builtin-link builtin-Pattern.isMatch) (declare-builtin-link builtin-Scope.bytearrayOf) (declare-builtin-link builtin-Char.Class.is) + (declare-builtin-link builtin-Pattern.many.corrected) (declare-builtin-link builtin-unsafe.coerceAbilities) ) diff --git a/unison-src/transcripts-using-base/all-base-hashes.output.md b/unison-src/transcripts-using-base/all-base-hashes.output.md index d99d877ca..ddd3773a2 100644 --- a/unison-src/transcripts-using-base/all-base-hashes.output.md +++ b/unison-src/transcripts-using-base/all-base-hashes.output.md @@ -2025,548 +2025,551 @@ This transcript is intended to make visible accidental changes to the hashing al 575. -- ##Pattern.many builtin.Pattern.many : Pattern a -> Pattern a - 576. -- ##Pattern.or + 576. -- ##Pattern.many.corrected + builtin.Pattern.many.corrected : Pattern a -> Pattern a + + 577. -- ##Pattern.or builtin.Pattern.or : Pattern a -> Pattern a -> Pattern a - 577. -- ##Pattern.replicate + 578. -- ##Pattern.replicate builtin.Pattern.replicate : Nat -> Nat -> Pattern a -> Pattern a - 578. -- ##Pattern.run + 579. -- ##Pattern.run builtin.Pattern.run : Pattern a -> a -> Optional ([a], a) - 579. -- #cbo8de57n17pgc5iic1741jeiunhvhfcfd7gt79vd6516u64aplasdodqoouejbgovhge2le5jb6rje923fcrllhtu01t29cdrssgbg + 580. -- #cbo8de57n17pgc5iic1741jeiunhvhfcfd7gt79vd6516u64aplasdodqoouejbgovhge2le5jb6rje923fcrllhtu01t29cdrssgbg structural type builtin.Pretty txt - 580. -- #fqfaur9v9v4fks5d0c74ouitpjp121c3fbu2l9t05km8otjcj43gk453vu668pg54rte6qmh4v3uao6vbfpntrtaq057jgni1jk8fj8 + 581. -- #fqfaur9v9v4fks5d0c74ouitpjp121c3fbu2l9t05km8otjcj43gk453vu668pg54rte6qmh4v3uao6vbfpntrtaq057jgni1jk8fj8 type builtin.Pretty.Annotated w txt - 581. -- #fqfaur9v9v4fks5d0c74ouitpjp121c3fbu2l9t05km8otjcj43gk453vu668pg54rte6qmh4v3uao6vbfpntrtaq057jgni1jk8fj8#1 + 582. -- #fqfaur9v9v4fks5d0c74ouitpjp121c3fbu2l9t05km8otjcj43gk453vu668pg54rte6qmh4v3uao6vbfpntrtaq057jgni1jk8fj8#1 builtin.Pretty.Annotated.Append : w -> [Annotated w txt] -> Annotated w txt - 582. -- #fqfaur9v9v4fks5d0c74ouitpjp121c3fbu2l9t05km8otjcj43gk453vu668pg54rte6qmh4v3uao6vbfpntrtaq057jgni1jk8fj8#6 + 583. -- #fqfaur9v9v4fks5d0c74ouitpjp121c3fbu2l9t05km8otjcj43gk453vu668pg54rte6qmh4v3uao6vbfpntrtaq057jgni1jk8fj8#6 builtin.Pretty.Annotated.Empty : Annotated w txt - 583. -- #fqfaur9v9v4fks5d0c74ouitpjp121c3fbu2l9t05km8otjcj43gk453vu668pg54rte6qmh4v3uao6vbfpntrtaq057jgni1jk8fj8#4 + 584. -- #fqfaur9v9v4fks5d0c74ouitpjp121c3fbu2l9t05km8otjcj43gk453vu668pg54rte6qmh4v3uao6vbfpntrtaq057jgni1jk8fj8#4 builtin.Pretty.Annotated.Group : w -> Annotated w txt -> Annotated w txt - 584. -- #fqfaur9v9v4fks5d0c74ouitpjp121c3fbu2l9t05km8otjcj43gk453vu668pg54rte6qmh4v3uao6vbfpntrtaq057jgni1jk8fj8#3 + 585. -- #fqfaur9v9v4fks5d0c74ouitpjp121c3fbu2l9t05km8otjcj43gk453vu668pg54rte6qmh4v3uao6vbfpntrtaq057jgni1jk8fj8#3 builtin.Pretty.Annotated.Indent : w -> Annotated w txt -> Annotated w txt -> Annotated w txt -> Annotated w txt - 585. -- #fqfaur9v9v4fks5d0c74ouitpjp121c3fbu2l9t05km8otjcj43gk453vu668pg54rte6qmh4v3uao6vbfpntrtaq057jgni1jk8fj8#7 + 586. -- #fqfaur9v9v4fks5d0c74ouitpjp121c3fbu2l9t05km8otjcj43gk453vu668pg54rte6qmh4v3uao6vbfpntrtaq057jgni1jk8fj8#7 builtin.Pretty.Annotated.Lit : w -> txt -> Annotated w txt - 586. -- #fqfaur9v9v4fks5d0c74ouitpjp121c3fbu2l9t05km8otjcj43gk453vu668pg54rte6qmh4v3uao6vbfpntrtaq057jgni1jk8fj8#2 + 587. -- #fqfaur9v9v4fks5d0c74ouitpjp121c3fbu2l9t05km8otjcj43gk453vu668pg54rte6qmh4v3uao6vbfpntrtaq057jgni1jk8fj8#2 builtin.Pretty.Annotated.OrElse : w -> Annotated w txt -> Annotated w txt -> Annotated w txt - 587. -- #fqfaur9v9v4fks5d0c74ouitpjp121c3fbu2l9t05km8otjcj43gk453vu668pg54rte6qmh4v3uao6vbfpntrtaq057jgni1jk8fj8#0 + 588. -- #fqfaur9v9v4fks5d0c74ouitpjp121c3fbu2l9t05km8otjcj43gk453vu668pg54rte6qmh4v3uao6vbfpntrtaq057jgni1jk8fj8#0 builtin.Pretty.Annotated.Table : w -> [[Annotated w txt]] -> Annotated w txt - 588. -- #fqfaur9v9v4fks5d0c74ouitpjp121c3fbu2l9t05km8otjcj43gk453vu668pg54rte6qmh4v3uao6vbfpntrtaq057jgni1jk8fj8#5 + 589. -- #fqfaur9v9v4fks5d0c74ouitpjp121c3fbu2l9t05km8otjcj43gk453vu668pg54rte6qmh4v3uao6vbfpntrtaq057jgni1jk8fj8#5 builtin.Pretty.Annotated.Wrap : w -> Annotated w txt -> Annotated w txt - 589. -- #loh4epguhqj73ut43b287p1272ko7ackkr544k9scurlsf6m6smpifp5ghdcscvqdofpf79req1pl4e7qni0hvo4m0gsi3f1jhn9nvo + 590. -- #loh4epguhqj73ut43b287p1272ko7ackkr544k9scurlsf6m6smpifp5ghdcscvqdofpf79req1pl4e7qni0hvo4m0gsi3f1jhn9nvo builtin.Pretty.append : Pretty txt -> Pretty txt -> Pretty txt - 590. -- #sonptakf85a3uklev4rq0pub00k56jdpaop4tcd9bmk0gmjjij5t16sf1knspku2hbp0uikiflbo0dtjv1i6r3t2rpjh86vo1rlaer8 + 591. -- #sonptakf85a3uklev4rq0pub00k56jdpaop4tcd9bmk0gmjjij5t16sf1knspku2hbp0uikiflbo0dtjv1i6r3t2rpjh86vo1rlaer8 builtin.Pretty.empty : Pretty txt - 591. -- #mlpplm1bhqkcif5j09204uuvfll7qte95msb0skjfd30nmei005kiich1ao39gm2j8687s14qvf5llu6i1a6fvt4vdmbp99jlfundfo + 592. -- #mlpplm1bhqkcif5j09204uuvfll7qte95msb0skjfd30nmei005kiich1ao39gm2j8687s14qvf5llu6i1a6fvt4vdmbp99jlfundfo builtin.Pretty.get : Pretty txt -> Annotated () txt - 592. -- #303bqopo0ditms2abmf35ikbgbb7gkcmqcd5g5eie85lvvmkpd89mi8v0etgm2508bejlgj9e7ffvpufj3v94mlks3ugvr3sjkbttq0 + 593. -- #303bqopo0ditms2abmf35ikbgbb7gkcmqcd5g5eie85lvvmkpd89mi8v0etgm2508bejlgj9e7ffvpufj3v94mlks3ugvr3sjkbttq0 builtin.Pretty.group : Pretty txt -> Pretty txt - 593. -- #o5dik2fg10998uep20m3du4iqqjbtap0apq4452g9emve8g3m655392u97iunphh90opvg92riaabbjsofc02bhr0qkcousvqgg2a78 + 594. -- #o5dik2fg10998uep20m3du4iqqjbtap0apq4452g9emve8g3m655392u97iunphh90opvg92riaabbjsofc02bhr0qkcousvqgg2a78 builtin.Pretty.indent : Pretty txt -> Pretty txt -> Pretty txt - 594. -- #evbq94p3dn4l8ugge1o2f8dk072gcfho082lm7j02ejjsnctb5inkfsasuplmu8a529jh4v0h6v8ti7koff23e58cceda0nlh98m530 + 595. -- #evbq94p3dn4l8ugge1o2f8dk072gcfho082lm7j02ejjsnctb5inkfsasuplmu8a529jh4v0h6v8ti7koff23e58cceda0nlh98m530 builtin.Pretty.indent' : Pretty txt -> Pretty txt -> Pretty txt -> Pretty txt - 595. -- #u5s76jh01asd7hbqaq466dp48v217o7tclphuk7gepc99vbv0fbfv5j2uq8o3n7lsvpiri5925o02j22a6tq7koc9t8tbcps4naetbg + 596. -- #u5s76jh01asd7hbqaq466dp48v217o7tclphuk7gepc99vbv0fbfv5j2uq8o3n7lsvpiri5925o02j22a6tq7koc9t8tbcps4naetbg builtin.Pretty.join : [Pretty txt] -> Pretty txt - 596. -- #uoti2ppnfp1l11obl8tto1m2h4r6n1i14cc3i45bjpjrhogh52cuoch1n6b1q0n3jf6blr9585stb1i155jjq17b4c2hvd4d3abmrpo + 597. -- #uoti2ppnfp1l11obl8tto1m2h4r6n1i14cc3i45bjpjrhogh52cuoch1n6b1q0n3jf6blr9585stb1i155jjq17b4c2hvd4d3abmrpo builtin.Pretty.lit : txt -> Pretty txt - 597. -- #mabh3q4gsoiao223a03t7voj937b3sefb7e1j5r33su5o5tqrkmenl2aeboq909vs3bh2snltuqrfcsd3liic1vma0f976h1eo63upg + 598. -- #mabh3q4gsoiao223a03t7voj937b3sefb7e1j5r33su5o5tqrkmenl2aeboq909vs3bh2snltuqrfcsd3liic1vma0f976h1eo63upg builtin.Pretty.map : (txt ->{g} txt2) -> Pretty txt ->{g} Pretty txt2 - 598. -- #i260pi6le5cdptpo78mbbi4r6qfc76kvb1g9r9d210b1altjtmoqi8b6psu3ag5hb8gq7crhgei406arn999c1dfrqt67j8vnls4gg8 + 599. -- #i260pi6le5cdptpo78mbbi4r6qfc76kvb1g9r9d210b1altjtmoqi8b6psu3ag5hb8gq7crhgei406arn999c1dfrqt67j8vnls4gg8 builtin.Pretty.orElse : Pretty txt -> Pretty txt -> Pretty txt - 599. -- #cbo8de57n17pgc5iic1741jeiunhvhfcfd7gt79vd6516u64aplasdodqoouejbgovhge2le5jb6rje923fcrllhtu01t29cdrssgbg#0 + 600. -- #cbo8de57n17pgc5iic1741jeiunhvhfcfd7gt79vd6516u64aplasdodqoouejbgovhge2le5jb6rje923fcrllhtu01t29cdrssgbg#0 builtin.Pretty.Pretty : Annotated () txt -> Pretty txt - 600. -- #bvuv0d49kosa6op5j54ln2h3vbs3209e4fjtb3kehvn76p92l8682qnp2r5e9t7sflnv3dfb0uf9p0f76qbobn562oqdusi9mo3ubjo + 601. -- #bvuv0d49kosa6op5j54ln2h3vbs3209e4fjtb3kehvn76p92l8682qnp2r5e9t7sflnv3dfb0uf9p0f76qbobn562oqdusi9mo3ubjo builtin.Pretty.sepBy : Pretty txt -> [Pretty txt] -> Pretty txt - 601. -- #rm3moq6nqvk1rs49lsshdtheqo72qv2fg1fqkk5m8tbqppik498otkrq6ppu7fu9p1kddldmpv0dig7bn82n0tj0ngnbu83fpb11upg + 602. -- #rm3moq6nqvk1rs49lsshdtheqo72qv2fg1fqkk5m8tbqppik498otkrq6ppu7fu9p1kddldmpv0dig7bn82n0tj0ngnbu83fpb11upg builtin.Pretty.table : [[Pretty txt]] -> Pretty txt - 602. -- #n01tnlfatb0lo6s762cfofhtdavui9j8ovljacdbn9bvrfoeimd0pkner0694d3lb1f4qa5gur4975lvopftk7jkrflmhjv6gbsifbo + 603. -- #n01tnlfatb0lo6s762cfofhtdavui9j8ovljacdbn9bvrfoeimd0pkner0694d3lb1f4qa5gur4975lvopftk7jkrflmhjv6gbsifbo builtin.Pretty.wrap : Pretty txt -> Pretty txt - 603. -- ##Ref + 604. -- ##Ref builtin type builtin.Ref - 604. -- ##Ref.read + 605. -- ##Ref.read builtin.Ref.read : Ref g a ->{g} a - 605. -- ##Ref.write + 606. -- ##Ref.write builtin.Ref.write : Ref g a -> a ->{g} () - 606. -- ##Effect + 607. -- ##Effect builtin type builtin.Request - 607. -- #bga77hj5p43epjosu36iero5ulpm7hqrct1slj5ivdcajsr52ksjam8d5smq2965netv9t43o3g0amgva26qoatt4qth29khkuds2t0 + 608. -- #bga77hj5p43epjosu36iero5ulpm7hqrct1slj5ivdcajsr52ksjam8d5smq2965netv9t43o3g0amgva26qoatt4qth29khkuds2t0 type builtin.RewriteCase a b - 608. -- #bga77hj5p43epjosu36iero5ulpm7hqrct1slj5ivdcajsr52ksjam8d5smq2965netv9t43o3g0amgva26qoatt4qth29khkuds2t0#0 + 609. -- #bga77hj5p43epjosu36iero5ulpm7hqrct1slj5ivdcajsr52ksjam8d5smq2965netv9t43o3g0amgva26qoatt4qth29khkuds2t0#0 builtin.RewriteCase.RewriteCase : a -> b -> RewriteCase a b - 609. -- #qcot4bpj2skgnui8hoignn6fl2gnn2nfrur451ft2egd5n1ndu6ti4uu7r1mvtc8r4p7iielfijk2mb7md9tt2m2rdvaikah4oluf7o + 610. -- #qcot4bpj2skgnui8hoignn6fl2gnn2nfrur451ft2egd5n1ndu6ti4uu7r1mvtc8r4p7iielfijk2mb7md9tt2m2rdvaikah4oluf7o type builtin.Rewrites a - 610. -- #qcot4bpj2skgnui8hoignn6fl2gnn2nfrur451ft2egd5n1ndu6ti4uu7r1mvtc8r4p7iielfijk2mb7md9tt2m2rdvaikah4oluf7o#0 + 611. -- #qcot4bpj2skgnui8hoignn6fl2gnn2nfrur451ft2egd5n1ndu6ti4uu7r1mvtc8r4p7iielfijk2mb7md9tt2m2rdvaikah4oluf7o#0 builtin.Rewrites.Rewrites : a -> Rewrites a - 611. -- #nu6eab37fl81lb5hfcainu83hph0ksqjsjgjbqvc3t8o13djtt5511qfa6tuggc5c3re06c5p6eto5o2cqme0jdlo31nnd13npqigjo + 612. -- #nu6eab37fl81lb5hfcainu83hph0ksqjsjgjbqvc3t8o13djtt5511qfa6tuggc5c3re06c5p6eto5o2cqme0jdlo31nnd13npqigjo type builtin.RewriteSignature a b - 612. -- #nu6eab37fl81lb5hfcainu83hph0ksqjsjgjbqvc3t8o13djtt5511qfa6tuggc5c3re06c5p6eto5o2cqme0jdlo31nnd13npqigjo#0 + 613. -- #nu6eab37fl81lb5hfcainu83hph0ksqjsjgjbqvc3t8o13djtt5511qfa6tuggc5c3re06c5p6eto5o2cqme0jdlo31nnd13npqigjo#0 builtin.RewriteSignature.RewriteSignature : (a -> b -> ()) -> RewriteSignature a b - 613. -- #bvffhraos4oatd3qmedt676dqul9c1oj8r4cqns36lsrue84kl0ote15iqbbmgu8joek3gce1h2raqas5b9nnvs2d79l9mrpmmi2sf0 + 614. -- #bvffhraos4oatd3qmedt676dqul9c1oj8r4cqns36lsrue84kl0ote15iqbbmgu8joek3gce1h2raqas5b9nnvs2d79l9mrpmmi2sf0 type builtin.RewriteTerm a b - 614. -- #bvffhraos4oatd3qmedt676dqul9c1oj8r4cqns36lsrue84kl0ote15iqbbmgu8joek3gce1h2raqas5b9nnvs2d79l9mrpmmi2sf0#0 + 615. -- #bvffhraos4oatd3qmedt676dqul9c1oj8r4cqns36lsrue84kl0ote15iqbbmgu8joek3gce1h2raqas5b9nnvs2d79l9mrpmmi2sf0#0 builtin.RewriteTerm.RewriteTerm : a -> b -> RewriteTerm a b - 615. -- ##Scope + 616. -- ##Scope builtin type builtin.Scope - 616. -- ##Scope.array + 617. -- ##Scope.array builtin.Scope.array : Nat ->{Scope s} MutableArray (Scope s) a - 617. -- ##Scope.arrayOf + 618. -- ##Scope.arrayOf builtin.Scope.arrayOf : a -> Nat ->{Scope s} MutableArray (Scope s) a - 618. -- ##Scope.bytearray + 619. -- ##Scope.bytearray builtin.Scope.bytearray : Nat ->{Scope s} MutableByteArray (Scope s) - 619. -- ##Scope.bytearrayOf + 620. -- ##Scope.bytearrayOf builtin.Scope.bytearrayOf : Nat -> Nat ->{Scope s} MutableByteArray (Scope s) - 620. -- ##Scope.ref + 621. -- ##Scope.ref builtin.Scope.ref : a ->{Scope s} Ref {Scope s} a - 621. -- ##Scope.run + 622. -- ##Scope.run builtin.Scope.run : (∀ s. '{g, Scope s} r) ->{g} r - 622. -- #6uigas14aqgd889s036hq9ssrlo22pju41009m0rktetcrbm97qniljjc1rv1u661r4f63oq6pupoevghs8a2hupvlbi6qi4ntn9320 + 623. -- #6uigas14aqgd889s036hq9ssrlo22pju41009m0rktetcrbm97qniljjc1rv1u661r4f63oq6pupoevghs8a2hupvlbi6qi4ntn9320 structural type builtin.SeqView a b - 623. -- #6uigas14aqgd889s036hq9ssrlo22pju41009m0rktetcrbm97qniljjc1rv1u661r4f63oq6pupoevghs8a2hupvlbi6qi4ntn9320#0 + 624. -- #6uigas14aqgd889s036hq9ssrlo22pju41009m0rktetcrbm97qniljjc1rv1u661r4f63oq6pupoevghs8a2hupvlbi6qi4ntn9320#0 builtin.SeqView.VElem : a -> b -> SeqView a b - 624. -- #6uigas14aqgd889s036hq9ssrlo22pju41009m0rktetcrbm97qniljjc1rv1u661r4f63oq6pupoevghs8a2hupvlbi6qi4ntn9320#1 + 625. -- #6uigas14aqgd889s036hq9ssrlo22pju41009m0rktetcrbm97qniljjc1rv1u661r4f63oq6pupoevghs8a2hupvlbi6qi4ntn9320#1 builtin.SeqView.VEmpty : SeqView a b - 625. -- ##Socket.toText + 626. -- ##Socket.toText builtin.Socket.toText : Socket -> Text - 626. -- #pfp0ajb4v2mb9tspp29v53dkacb76aa1t5kbk1dl0q354cjcg4egdpmvtr5d6t818ucon9eubf6r1vdvh926fgk8otvbkvbpn90levo + 627. -- #pfp0ajb4v2mb9tspp29v53dkacb76aa1t5kbk1dl0q354cjcg4egdpmvtr5d6t818ucon9eubf6r1vdvh926fgk8otvbkvbpn90levo builtin.syntax.docAside : Doc2 -> Doc2 - 627. -- #mvov9qf78ctohefjbmrgs8ussspo5juhf75pee4ikkg8asuos72unn4pjn3fdel8471soj2vaskd5ls103pb6nb8qf75sjn4igs7v48 + 628. -- #mvov9qf78ctohefjbmrgs8ussspo5juhf75pee4ikkg8asuos72unn4pjn3fdel8471soj2vaskd5ls103pb6nb8qf75sjn4igs7v48 builtin.syntax.docBlockquote : Doc2 -> Doc2 - 628. -- #cg64hg7dag89u80104kit2p40rhmo1k6h1j8obfhjolpogs705bt6hc92ct6rfj8h74m3ioug14u9pm1s7qqpmjda2srjojhi01nvf0 + 629. -- #cg64hg7dag89u80104kit2p40rhmo1k6h1j8obfhjolpogs705bt6hc92ct6rfj8h74m3ioug14u9pm1s7qqpmjda2srjojhi01nvf0 builtin.syntax.docBold : Doc2 -> Doc2 - 629. -- #3qd5kt9gjiggrb871al82n11jccedl3kb5p8ffemr703frn38tqajkett30fg7hef5orh7vl0obp3lap9qq2po3ufcnu4k3bik81rlg + 630. -- #3qd5kt9gjiggrb871al82n11jccedl3kb5p8ffemr703frn38tqajkett30fg7hef5orh7vl0obp3lap9qq2po3ufcnu4k3bik81rlg builtin.syntax.docBulletedList : [Doc2] -> Doc2 - 630. -- #el0rph43k5qg25qg20o5jdjukuful041r87v92tcb2339om0hp9u6vqtrcrfkvgj78hrpo2o1l39bbg1oier87pvgkli0lkgalgpo90 + 631. -- #el0rph43k5qg25qg20o5jdjukuful041r87v92tcb2339om0hp9u6vqtrcrfkvgj78hrpo2o1l39bbg1oier87pvgkli0lkgalgpo90 builtin.syntax.docCallout : Optional Doc2 -> Doc2 -> Doc2 - 631. -- #7jij106qpusbsbpqhmtgrk59qo8ss9e77rtrc1h9hbpnbab8sq717fe6hppmhhds9smqbv3k2q0irjgoe4mogatlp9e4k25kopt6rgo + 632. -- #7jij106qpusbsbpqhmtgrk59qo8ss9e77rtrc1h9hbpnbab8sq717fe6hppmhhds9smqbv3k2q0irjgoe4mogatlp9e4k25kopt6rgo builtin.syntax.docCode : Doc2 -> Doc2 - 632. -- #3paq4qqrk028tati33723c4aqi7ebgnjln12avbnf7eu8h8sflg0frlehb4lni4ru0pcfg9ftsurq3pb2q11cfebeki51vom697l7h0 + 633. -- #3paq4qqrk028tati33723c4aqi7ebgnjln12avbnf7eu8h8sflg0frlehb4lni4ru0pcfg9ftsurq3pb2q11cfebeki51vom697l7h0 builtin.syntax.docCodeBlock : Text -> Text -> Doc2 - 633. -- #1of955s8tqa74vu0ve863p8dn2mncc2anmms54aj084pkbdcpml6ckvs0qb4defi0df3b1e8inp29p60ac93hf2u7to0je4op9fum40 + 634. -- #1of955s8tqa74vu0ve863p8dn2mncc2anmms54aj084pkbdcpml6ckvs0qb4defi0df3b1e8inp29p60ac93hf2u7to0je4op9fum40 builtin.syntax.docColumn : [Doc2] -> Doc2 - 634. -- #ukv56cjchfao07qb08l7iimd2mmv09s5glmtljo5b71leaijtja04obd0u1hsr38itjnv85f7jvd37nr654bl4lfn4msr1one0hi4s0 + 635. -- #ukv56cjchfao07qb08l7iimd2mmv09s5glmtljo5b71leaijtja04obd0u1hsr38itjnv85f7jvd37nr654bl4lfn4msr1one0hi4s0 builtin.syntax.docEmbedAnnotation : tm -> Doc2.Term - 635. -- #uccvv8mn62ne8iqppsnpgbquqmhk4hk3n4tg7p6kttr20gov4698tu18jmmvdcs7ab455q7kklhb4uv1mtei4vbvq4qmbtbu1dbagmg + 636. -- #uccvv8mn62ne8iqppsnpgbquqmhk4hk3n4tg7p6kttr20gov4698tu18jmmvdcs7ab455q7kklhb4uv1mtei4vbvq4qmbtbu1dbagmg builtin.syntax.docEmbedAnnotations : tms -> tms - 636. -- #3r6c432d46j544g26chbfgfqrr79k7disfn41igdpe0thjar30lrjhqsuhipsr9rvg8jk6rpmnalc5iu8j842sq3svu1bo4c02og7to + 637. -- #3r6c432d46j544g26chbfgfqrr79k7disfn41igdpe0thjar30lrjhqsuhipsr9rvg8jk6rpmnalc5iu8j842sq3svu1bo4c02og7to builtin.syntax.docEmbedSignatureLink : '{g} t -> Doc2.Term - 637. -- #pjtf55viib2vgc4hp60e2bui7r8iij7kan0u6uq6d60d6d6ccpq81f9ngcrou2lob9maqsvcqsa85ev4171iml9elg5hbfaopijo6lo + 638. -- #pjtf55viib2vgc4hp60e2bui7r8iij7kan0u6uq6d60d6d6ccpq81f9ngcrou2lob9maqsvcqsa85ev4171iml9elg5hbfaopijo6lo builtin.syntax.docEmbedTermLink : '{g} t -> Either a Doc2.Term - 638. -- #7t98ois54isfkh31uefvdg4bg302s5q3sun4hfh0mqnosk4ded353jp0p2ij6b22vnvlcbipcv2jb91suh6qc33i7uqlfuto9f0r4n8 + 639. -- #7t98ois54isfkh31uefvdg4bg302s5q3sun4hfh0mqnosk4ded353jp0p2ij6b22vnvlcbipcv2jb91suh6qc33i7uqlfuto9f0r4n8 builtin.syntax.docEmbedTypeLink : typ -> Either typ b - 639. -- #ngon71rp4i6a3qd36pu015kk7d7il2i1491upfgernpm635hkjhcrm84oumfe6tvn193nb1lsrkulvvnmq5os0evm6sndlarquhe3i0 + 640. -- #ngon71rp4i6a3qd36pu015kk7d7il2i1491upfgernpm635hkjhcrm84oumfe6tvn193nb1lsrkulvvnmq5os0evm6sndlarquhe3i0 builtin.syntax.docEval : 'a -> Doc2 - 640. -- #hsmpfd41n9m02atorpvnj2gf7lcf04o51nrc8kohfddgq4vo18unk2c1ci8pfsam9f4i02babsu7urhvcek8fbfrilcusrgnaifp278 + 641. -- #hsmpfd41n9m02atorpvnj2gf7lcf04o51nrc8kohfddgq4vo18unk2c1ci8pfsam9f4i02babsu7urhvcek8fbfrilcusrgnaifp278 builtin.syntax.docEvalInline : 'a -> Doc2 - 641. -- #73m68mnahgud6dl9red3rcmd49qn80d0ptr2m1h163e1jr1fitibr2hf84o62cqs7dsqiuea578ge7en7kk290k6778lgo39btl5468 + 642. -- #73m68mnahgud6dl9red3rcmd49qn80d0ptr2m1h163e1jr1fitibr2hf84o62cqs7dsqiuea578ge7en7kk290k6778lgo39btl5468 builtin.syntax.docExample : Nat -> '{g} t -> Doc2 - 642. -- #62nif2cvq90cnds9eo95hdn6uvgqo6np4eku52ar4pnb18sfdetl9oo6cu99hbksfa0b4krlcvse5gr5uv5k5b0ukuovt75krhlp418 + 643. -- #62nif2cvq90cnds9eo95hdn6uvgqo6np4eku52ar4pnb18sfdetl9oo6cu99hbksfa0b4krlcvse5gr5uv5k5b0ukuovt75krhlp418 builtin.syntax.docExampleBlock : Nat -> '{g} t -> Doc2 - 643. -- #pomj7lft70jnnuk5job0pstih2mosva1oee4tediqbkhnm54tjqnfe6qs1mqt8os1ehg9ksgenb6veub2ngdpb1qat400vn0bj3fju0 + 644. -- #pomj7lft70jnnuk5job0pstih2mosva1oee4tediqbkhnm54tjqnfe6qs1mqt8os1ehg9ksgenb6veub2ngdpb1qat400vn0bj3fju0 builtin.syntax.docFoldedSource : [( Either Type Doc2.Term, [Doc2.Term])] -> Doc2 - 644. -- #dg44n9t54o1jkl3dtecsqh9vvs57jsvtvbfohkrtolqqgf2g7mf5el9i5jhg6qop1arms99c7s34d9h5rnrvf1fi4100lerjg3b38q8 + 645. -- #dg44n9t54o1jkl3dtecsqh9vvs57jsvtvbfohkrtolqqgf2g7mf5el9i5jhg6qop1arms99c7s34d9h5rnrvf1fi4100lerjg3b38q8 builtin.syntax.docFormatConsole : Doc2 -> Pretty (Either SpecialForm ConsoleText) - 645. -- #99qvifgs3u7nof50jbp5lhrf8cab0qiujr1tque2b7hfj56r39o8ot2fafhafuphoraddl1j142k994e22g5v2rhq98flc0954t5918 + 646. -- #99qvifgs3u7nof50jbp5lhrf8cab0qiujr1tque2b7hfj56r39o8ot2fafhafuphoraddl1j142k994e22g5v2rhq98flc0954t5918 builtin.syntax.docGroup : Doc2 -> Doc2 - 646. -- #gsratvk7mo273bqhivdv06f9rog2cj48u7ci0jp6ubt5oidf8cq0rjilimkas5801inbbsjcedh61jl40i3en1qu6r9vfe684ad6r08 + 647. -- #gsratvk7mo273bqhivdv06f9rog2cj48u7ci0jp6ubt5oidf8cq0rjilimkas5801inbbsjcedh61jl40i3en1qu6r9vfe684ad6r08 builtin.syntax.docItalic : Doc2 -> Doc2 - 647. -- #piohhscvm6lgpk6vfg91u2ndmlfv81nnkspihom77ucr4dev6s22rk2n9hp38nifh5p8vt7jfvep85vudpvlg2tt99e9s2qfjv5oau8 + 648. -- #piohhscvm6lgpk6vfg91u2ndmlfv81nnkspihom77ucr4dev6s22rk2n9hp38nifh5p8vt7jfvep85vudpvlg2tt99e9s2qfjv5oau8 builtin.syntax.docJoin : [Doc2] -> Doc2 - 648. -- #hjdqcolihf4obmnfoakl2t5hs1e39hpmpo9ijvc37fqgejog1ii7fpd4q2fe2rkm62tf81unmqlbud8uh63vaa9feaekg5a7uo3nq00 + 649. -- #hjdqcolihf4obmnfoakl2t5hs1e39hpmpo9ijvc37fqgejog1ii7fpd4q2fe2rkm62tf81unmqlbud8uh63vaa9feaekg5a7uo3nq00 builtin.syntax.docLink : Either Type Doc2.Term -> Doc2 - 649. -- #iv6urr76b0ohvr22qa6d05e7e01cd0re77g8c98cm0bqo0im345fotsevqnhk1igtutkrrqm562gtltofvku5mh0i87ru8tdf0i53bo + 650. -- #iv6urr76b0ohvr22qa6d05e7e01cd0re77g8c98cm0bqo0im345fotsevqnhk1igtutkrrqm562gtltofvku5mh0i87ru8tdf0i53bo builtin.syntax.docNamedLink : Doc2 -> Doc2 -> Doc2 - 650. -- #b5dvn0bqj3rc1rkmlep5f6cd6n3vp247hqku8lqndena5ocgcoae18iuq3985finagr919re4fvji011ved0g21i6o0je2jn8f7k1p0 + 651. -- #b5dvn0bqj3rc1rkmlep5f6cd6n3vp247hqku8lqndena5ocgcoae18iuq3985finagr919re4fvji011ved0g21i6o0je2jn8f7k1p0 builtin.syntax.docNumberedList : Nat -> [Doc2] -> Doc2 - 651. -- #fs8mho20fqj31ch5kpn8flm4geomotov7fb5ct8mtnh52ladorgp22vder3jgt1mr0u710e6s9gn4u36c9sp19vitvq1r0adtm3t1c0 + 652. -- #fs8mho20fqj31ch5kpn8flm4geomotov7fb5ct8mtnh52ladorgp22vder3jgt1mr0u710e6s9gn4u36c9sp19vitvq1r0adtm3t1c0 builtin.syntax.docParagraph : [Doc2] -> Doc2 - 652. -- #6dvkai3hc122e2h2h8c3jnijink5m20e27i640qvnt6smefpp2vna1rq4gbmulhb46tdabmkb5hsjeiuo4adtsutg4iu1vfmqhlueso + 653. -- #6dvkai3hc122e2h2h8c3jnijink5m20e27i640qvnt6smefpp2vna1rq4gbmulhb46tdabmkb5hsjeiuo4adtsutg4iu1vfmqhlueso builtin.syntax.docSection : Doc2 -> [Doc2] -> Doc2 - 653. -- #n0idf1bdrq5vgpk4pj9db5demk1es4jsnpodfoajftehvqjelsi0h5j2domdllq2peltdek4ptaqfpl4o8l6jpmqhcom9vq107ivdu0 + 654. -- #n0idf1bdrq5vgpk4pj9db5demk1es4jsnpodfoajftehvqjelsi0h5j2domdllq2peltdek4ptaqfpl4o8l6jpmqhcom9vq107ivdu0 builtin.syntax.docSignature : [Doc2.Term] -> Doc2 - 654. -- #git1povkck9jrptdmmpqrv1g17ptbq9hr17l52l8477ijk4cia24tr7cj36v1o22mvtk00qoo5jt4bs4e79sl3eh6is8ubh8aoc1pu0 + 655. -- #git1povkck9jrptdmmpqrv1g17ptbq9hr17l52l8477ijk4cia24tr7cj36v1o22mvtk00qoo5jt4bs4e79sl3eh6is8ubh8aoc1pu0 builtin.syntax.docSignatureInline : Doc2.Term -> Doc2 - 655. -- #47agivvofl1jegbqpdg0eeed72mdj29d623e4kdei0l10mhgckif7q2pd968ggribregcknra9u43mhehr1q86n0t4vbe4eestnu9l8 + 656. -- #47agivvofl1jegbqpdg0eeed72mdj29d623e4kdei0l10mhgckif7q2pd968ggribregcknra9u43mhehr1q86n0t4vbe4eestnu9l8 builtin.syntax.docSource : [( Either Type Doc2.Term, [Doc2.Term])] -> Doc2 - 656. -- #n6uk5tc4d8ipbga8boelh51ro24paveca9fijm1nkn3tlfddqludmlppb2ps8807v2kuou1a262sa59764mdhug2va69q4sls5jli10 + 657. -- #n6uk5tc4d8ipbga8boelh51ro24paveca9fijm1nkn3tlfddqludmlppb2ps8807v2kuou1a262sa59764mdhug2va69q4sls5jli10 builtin.syntax.docSourceElement : link -> annotations -> (link, annotations) - 657. -- #nurq288b5rfp1f5keccleh51ojgcpd2rp7cane6ftquf7gidtamffb8tr1r5h6luk1nsrqomn1k4as4kcpaskjjv35rnvoous457sag + 658. -- #nurq288b5rfp1f5keccleh51ojgcpd2rp7cane6ftquf7gidtamffb8tr1r5h6luk1nsrqomn1k4as4kcpaskjjv35rnvoous457sag builtin.syntax.docStrikethrough : Doc2 -> Doc2 - 658. -- #4ns2amu2njhvb5mtdvh3v7oljjb5ammnb41us4ekpbhb337b6mo2a4q0790cmrusko7omphtfdsaust2fn49hr5acl40ef8fkb9556g + 659. -- #4ns2amu2njhvb5mtdvh3v7oljjb5ammnb41us4ekpbhb337b6mo2a4q0790cmrusko7omphtfdsaust2fn49hr5acl40ef8fkb9556g builtin.syntax.docTable : [[Doc2]] -> Doc2 - 659. -- #i77kddfr68gbjt3767a091dtnqff9beltojh93md8peo28t59c6modeccsfd2tnrtmd75fa7dn0ie21kcv4me098q91h4ftg9eau5fo + 660. -- #i77kddfr68gbjt3767a091dtnqff9beltojh93md8peo28t59c6modeccsfd2tnrtmd75fa7dn0ie21kcv4me098q91h4ftg9eau5fo builtin.syntax.docTooltip : Doc2 -> Doc2 -> Doc2 - 660. -- #r0hdacbk2orcb2ate3uhd7ht05hmfa8643slm3u63nb3jaaim533up04lgt0pq97is43v2spkqble7mtu8f63hgcc0k2tb2jhpr2b68 + 661. -- #r0hdacbk2orcb2ate3uhd7ht05hmfa8643slm3u63nb3jaaim533up04lgt0pq97is43v2spkqble7mtu8f63hgcc0k2tb2jhpr2b68 builtin.syntax.docTransclude : d -> d - 661. -- #0nptdh40ngakd2rh92bl573a7vbdjcj2kc8rai39v8bb9dfpbj90i7nob381usjsott41c3cpo2m2q095fm0k0r68e8mrda135qa1k0 + 662. -- #0nptdh40ngakd2rh92bl573a7vbdjcj2kc8rai39v8bb9dfpbj90i7nob381usjsott41c3cpo2m2q095fm0k0r68e8mrda135qa1k0 builtin.syntax.docUntitledSection : [Doc2] -> Doc2 - 662. -- #krjm78blt08v52c52l4ubsnfidcrs0h6010j2v2h9ud38mgm6jj4vuqn4okp4g75039o7u78sbg6ghforucbfdf94f8am9kvt6875jo + 663. -- #krjm78blt08v52c52l4ubsnfidcrs0h6010j2v2h9ud38mgm6jj4vuqn4okp4g75039o7u78sbg6ghforucbfdf94f8am9kvt6875jo builtin.syntax.docVerbatim : Doc2 -> Doc2 - 663. -- #c14vgd4g1tkumf4jjd9vcoos1olb3f4gbc3hketf5l8h3i0efk8igbinh6gn018tr5075uo5nv1elva6tki6ofo3pdafidrkv9m0ot0 + 664. -- #c14vgd4g1tkumf4jjd9vcoos1olb3f4gbc3hketf5l8h3i0efk8igbinh6gn018tr5075uo5nv1elva6tki6ofo3pdafidrkv9m0ot0 builtin.syntax.docWord : Text -> Doc2 - 664. -- #aql7qk3iud6vs4cvu43aimopoosgk0fnipibdkc3so13adencmibgfn0u5c01r0adei55nkl3ttsjhl8gbj7tr4gnpj63g64ftbq6s0 + 665. -- #aql7qk3iud6vs4cvu43aimopoosgk0fnipibdkc3so13adencmibgfn0u5c01r0adei55nkl3ttsjhl8gbj7tr4gnpj63g64ftbq6s0 type builtin.Test.Result - 665. -- #aql7qk3iud6vs4cvu43aimopoosgk0fnipibdkc3so13adencmibgfn0u5c01r0adei55nkl3ttsjhl8gbj7tr4gnpj63g64ftbq6s0#0 + 666. -- #aql7qk3iud6vs4cvu43aimopoosgk0fnipibdkc3so13adencmibgfn0u5c01r0adei55nkl3ttsjhl8gbj7tr4gnpj63g64ftbq6s0#0 builtin.Test.Result.Fail : Text -> Result - 666. -- #aql7qk3iud6vs4cvu43aimopoosgk0fnipibdkc3so13adencmibgfn0u5c01r0adei55nkl3ttsjhl8gbj7tr4gnpj63g64ftbq6s0#1 + 667. -- #aql7qk3iud6vs4cvu43aimopoosgk0fnipibdkc3so13adencmibgfn0u5c01r0adei55nkl3ttsjhl8gbj7tr4gnpj63g64ftbq6s0#1 builtin.Test.Result.Ok : Text -> Result - 667. -- ##Text + 668. -- ##Text builtin type builtin.Text - 668. -- ##Text.!= + 669. -- ##Text.!= builtin.Text.!= : Text -> Text -> Boolean - 669. -- ##Text.++ + 670. -- ##Text.++ builtin.Text.++ : Text -> Text -> Text - 670. -- #nv11qo7s2lqirk3qb44jkm3q3fb6i3mn72ji2c52eubh3kufrdumanblh2bnql1o24efdhmue0v21gd7d1p5ec9j6iqrmekas0183do + 671. -- #nv11qo7s2lqirk3qb44jkm3q3fb6i3mn72ji2c52eubh3kufrdumanblh2bnql1o24efdhmue0v21gd7d1p5ec9j6iqrmekas0183do builtin.Text.alignLeftWith : Nat -> Char -> Text -> Text - 671. -- #ebeq250fdoigvu89fneb4c24f8f18eotc8kocdmosn4ri9shoeeg7ofkejts6clm5c6bifce66qtr0vpfkrhuup2en3khous41hp8rg + 672. -- #ebeq250fdoigvu89fneb4c24f8f18eotc8kocdmosn4ri9shoeeg7ofkejts6clm5c6bifce66qtr0vpfkrhuup2en3khous41hp8rg builtin.Text.alignRightWith : Nat -> Char -> Text -> Text - 672. -- ##Text.drop + 673. -- ##Text.drop builtin.Text.drop : Nat -> Text -> Text - 673. -- ##Text.empty + 674. -- ##Text.empty builtin.Text.empty : Text - 674. -- ##Text.== + 675. -- ##Text.== builtin.Text.eq : Text -> Text -> Boolean - 675. -- ##Text.fromCharList + 676. -- ##Text.fromCharList builtin.Text.fromCharList : [Char] -> Text - 676. -- ##Text.fromUtf8.impl.v3 + 677. -- ##Text.fromUtf8.impl.v3 builtin.Text.fromUtf8.impl : Bytes -> Either Failure Text - 677. -- ##Text.> + 678. -- ##Text.> builtin.Text.gt : Text -> Text -> Boolean - 678. -- ##Text.>= + 679. -- ##Text.>= builtin.Text.gteq : Text -> Text -> Boolean - 679. -- ##Text.indexOf + 680. -- ##Text.indexOf builtin.Text.indexOf : Text -> Text -> Optional Nat - 680. -- ##Text.< + 681. -- ##Text.< builtin.Text.lt : Text -> Text -> Boolean - 681. -- ##Text.<= + 682. -- ##Text.<= builtin.Text.lteq : Text -> Text -> Boolean - 682. -- ##Text.patterns.anyChar + 683. -- ##Text.patterns.anyChar builtin.Text.patterns.anyChar : Pattern Text - 683. -- ##Text.patterns.char + 684. -- ##Text.patterns.char builtin.Text.patterns.char : Class -> Pattern Text - 684. -- ##Text.patterns.charIn + 685. -- ##Text.patterns.charIn builtin.Text.patterns.charIn : [Char] -> Pattern Text - 685. -- ##Text.patterns.charRange + 686. -- ##Text.patterns.charRange builtin.Text.patterns.charRange : Char -> Char -> Pattern Text - 686. -- ##Text.patterns.digit + 687. -- ##Text.patterns.digit builtin.Text.patterns.digit : Pattern Text - 687. -- ##Text.patterns.eof + 688. -- ##Text.patterns.eof builtin.Text.patterns.eof : Pattern Text - 688. -- ##Text.patterns.letter + 689. -- ##Text.patterns.letter builtin.Text.patterns.letter : Pattern Text - 689. -- ##Text.patterns.literal + 690. -- ##Text.patterns.literal builtin.Text.patterns.literal : Text -> Pattern Text - 690. -- ##Text.patterns.notCharIn + 691. -- ##Text.patterns.notCharIn builtin.Text.patterns.notCharIn : [Char] -> Pattern Text - 691. -- ##Text.patterns.notCharRange + 692. -- ##Text.patterns.notCharRange builtin.Text.patterns.notCharRange : Char -> Char -> Pattern Text - 692. -- ##Text.patterns.punctuation + 693. -- ##Text.patterns.punctuation builtin.Text.patterns.punctuation : Pattern Text - 693. -- ##Text.patterns.space + 694. -- ##Text.patterns.space builtin.Text.patterns.space : Pattern Text - 694. -- ##Text.repeat + 695. -- ##Text.repeat builtin.Text.repeat : Nat -> Text -> Text - 695. -- ##Text.reverse + 696. -- ##Text.reverse builtin.Text.reverse : Text -> Text - 696. -- ##Text.size + 697. -- ##Text.size builtin.Text.size : Text -> Nat - 697. -- ##Text.take + 698. -- ##Text.take builtin.Text.take : Nat -> Text -> Text - 698. -- ##Text.toCharList + 699. -- ##Text.toCharList builtin.Text.toCharList : Text -> [Char] - 699. -- ##Text.toLowercase + 700. -- ##Text.toLowercase builtin.Text.toLowercase : Text -> Text - 700. -- ##Text.toUppercase + 701. -- ##Text.toUppercase builtin.Text.toUppercase : Text -> Text - 701. -- ##Text.toUtf8 + 702. -- ##Text.toUtf8 builtin.Text.toUtf8 : Text -> Bytes - 702. -- ##Text.uncons + 703. -- ##Text.uncons builtin.Text.uncons : Text -> Optional (Char, Text) - 703. -- ##Text.unsnoc + 704. -- ##Text.unsnoc builtin.Text.unsnoc : Text -> Optional (Text, Char) - 704. -- ##ThreadId.toText + 705. -- ##ThreadId.toText builtin.ThreadId.toText : ThreadId -> Text - 705. -- ##todo + 706. -- ##todo builtin.todo : a -> b - 706. -- #2lg4ah6ir6t129m33d7gssnigacral39qdamo20mn6r2vefliubpeqnjhejai9ekjckv0qnu9mlu3k9nbpfhl2schec4dohn7rjhjt8 + 707. -- #2lg4ah6ir6t129m33d7gssnigacral39qdamo20mn6r2vefliubpeqnjhejai9ekjckv0qnu9mlu3k9nbpfhl2schec4dohn7rjhjt8 structural type builtin.Tuple a b - 707. -- #2lg4ah6ir6t129m33d7gssnigacral39qdamo20mn6r2vefliubpeqnjhejai9ekjckv0qnu9mlu3k9nbpfhl2schec4dohn7rjhjt8#0 + 708. -- #2lg4ah6ir6t129m33d7gssnigacral39qdamo20mn6r2vefliubpeqnjhejai9ekjckv0qnu9mlu3k9nbpfhl2schec4dohn7rjhjt8#0 builtin.Tuple.Cons : a -> b -> Tuple a b - 708. -- #00nv2kob8fp11qdkr750rlppf81cda95m3q0niohj1pvljnjl4r3hqrhvp1un2p40ptgkhhsne7hocod90r3qdlus9guivh7j3qcq0g + 709. -- #00nv2kob8fp11qdkr750rlppf81cda95m3q0niohj1pvljnjl4r3hqrhvp1un2p40ptgkhhsne7hocod90r3qdlus9guivh7j3qcq0g structural type builtin.Unit - 709. -- #00nv2kob8fp11qdkr750rlppf81cda95m3q0niohj1pvljnjl4r3hqrhvp1un2p40ptgkhhsne7hocod90r3qdlus9guivh7j3qcq0g#0 + 710. -- #00nv2kob8fp11qdkr750rlppf81cda95m3q0niohj1pvljnjl4r3hqrhvp1un2p40ptgkhhsne7hocod90r3qdlus9guivh7j3qcq0g#0 builtin.Unit.Unit : () - 710. -- ##Universal.< + 711. -- ##Universal.< builtin.Universal.< : a -> a -> Boolean - 711. -- ##Universal.<= + 712. -- ##Universal.<= builtin.Universal.<= : a -> a -> Boolean - 712. -- ##Universal.== + 713. -- ##Universal.== builtin.Universal.== : a -> a -> Boolean - 713. -- ##Universal.> + 714. -- ##Universal.> builtin.Universal.> : a -> a -> Boolean - 714. -- ##Universal.>= + 715. -- ##Universal.>= builtin.Universal.>= : a -> a -> Boolean - 715. -- ##Universal.compare + 716. -- ##Universal.compare builtin.Universal.compare : a -> a -> Int - 716. -- ##Universal.murmurHash + 717. -- ##Universal.murmurHash builtin.Universal.murmurHash : a -> Nat - 717. -- ##unsafe.coerceAbilities + 718. -- ##unsafe.coerceAbilities builtin.unsafe.coerceAbilities : (a ->{e1} b) -> a -> b - 718. -- ##Value + 719. -- ##Value builtin type builtin.Value - 719. -- ##Value.dependencies + 720. -- ##Value.dependencies builtin.Value.dependencies : Value -> [Link.Term] - 720. -- ##Value.deserialize + 721. -- ##Value.deserialize builtin.Value.deserialize : Bytes -> Either Text Value - 721. -- ##Value.load + 722. -- ##Value.load builtin.Value.load : Value ->{IO} Either [Link.Term] a - 722. -- ##Value.serialize + 723. -- ##Value.serialize builtin.Value.serialize : Value -> Bytes - 723. -- ##Value.value + 724. -- ##Value.value builtin.Value.value : a -> Value - 724. -- #dem6aglnj8cppfrnq9qipl7geo5pim3auo9cmv1rhh5la9edalj19sspbpm1pd4vh0plokdh6qfo48gs034dqlg0s7j9fhr9p9ndtpo + 725. -- #dem6aglnj8cppfrnq9qipl7geo5pim3auo9cmv1rhh5la9edalj19sspbpm1pd4vh0plokdh6qfo48gs034dqlg0s7j9fhr9p9ndtpo type builtin.Year - 725. -- #dem6aglnj8cppfrnq9qipl7geo5pim3auo9cmv1rhh5la9edalj19sspbpm1pd4vh0plokdh6qfo48gs034dqlg0s7j9fhr9p9ndtpo#0 + 726. -- #dem6aglnj8cppfrnq9qipl7geo5pim3auo9cmv1rhh5la9edalj19sspbpm1pd4vh0plokdh6qfo48gs034dqlg0s7j9fhr9p9ndtpo#0 builtin.Year.Year : Nat -> Year - 726. -- #iur47o4jj4v554bfjsu95t8eru2vtko62d4jo4kvvt0mqnshtbleit15dlj1gkrpmokmf2pbegon8cof7600mv9s0m9229uk19bdvgg + 727. -- #iur47o4jj4v554bfjsu95t8eru2vtko62d4jo4kvvt0mqnshtbleit15dlj1gkrpmokmf2pbegon8cof7600mv9s0m9229uk19bdvgg cache : [(Link.Term, Code)] ->{IO, Exception} () - 727. -- #okolgrio28p1mbl1bfjfs9qtsr1m9upblcm3ul872gcir6epkcbq619vk5bdq1fnr371nelsof6jsp8469g4j6f0gg3007p79o4kf18 + 728. -- #okolgrio28p1mbl1bfjfs9qtsr1m9upblcm3ul872gcir6epkcbq619vk5bdq1fnr371nelsof6jsp8469g4j6f0gg3007p79o4kf18 check : Text -> Boolean ->{Stream Result} () - 728. -- #je42vk6rsefjlup01e1fmmdssf5i3ba9l6aka3bipggetfm8o4i8d1q5d7hddggu5jure1bu5ot8aq5in31to4788ctrtpb44ri83r8 + 729. -- #je42vk6rsefjlup01e1fmmdssf5i3ba9l6aka3bipggetfm8o4i8d1q5d7hddggu5jure1bu5ot8aq5in31to4788ctrtpb44ri83r8 checks : [Boolean] -> [Result] - 729. -- #jf82mm2gvoc3h5ibpejfeohkrl8022m38mi14r08v8s4np9187smglvtbk8u109ri427af2j5fuv1an6lq2k718vgtvr0c4rt9t32vg + 730. -- #jf82mm2gvoc3h5ibpejfeohkrl8022m38mi14r08v8s4np9187smglvtbk8u109ri427af2j5fuv1an6lq2k718vgtvr0c4rt9t32vg clientSocket : Text -> Text ->{IO, Exception} Socket - 730. -- #72auim6cvu5tl8ubmfj5m2p1a822m0jq6fmi8osd99ujbs9h20o3t9e47hcitdcku1e7d40r052sdmfgi1oktio9is8tf503f5unh7g + 731. -- #72auim6cvu5tl8ubmfj5m2p1a822m0jq6fmi8osd99ujbs9h20o3t9e47hcitdcku1e7d40r052sdmfgi1oktio9is8tf503f5unh7g closeFile : Handle ->{IO, Exception} () - 731. -- #nsvn5rj51knr3j62dp1ki0glb01bqj3ccq4537e1hgl2m89o9v7ghc54bu12r515mum791tcf4vgsrb6b1csa0tol1ldkiqrb8akkpo + 732. -- #nsvn5rj51knr3j62dp1ki0glb01bqj3ccq4537e1hgl2m89o9v7ghc54bu12r515mum791tcf4vgsrb6b1csa0tol1ldkiqrb8akkpo closeSocket : Socket ->{IO, Exception} () - 732. -- #ei73jot64ogu4q76rm3jecdn76vmrj0h7riqqecf1d439mjav7ehh0h7rol5s18nupv586ln3l0m4kmh99p5mhgv6qfcrfgilkgq1oo + 733. -- #ei73jot64ogu4q76rm3jecdn76vmrj0h7riqqecf1d439mjav7ehh0h7rol5s18nupv586ln3l0m4kmh99p5mhgv6qfcrfgilkgq1oo Code.transitiveDeps : Link.Term ->{IO} [(Link.Term, Code)] - 733. -- #srpc2uag5p1grvshbcm3urjntakgi3g3dthfse2cp38sd6uestd5neseces5ue7kum2ca0gsg9i0cilkl0gn8dn3q5dn86v4r8lbha0 + 734. -- #srpc2uag5p1grvshbcm3urjntakgi3g3dthfse2cp38sd6uestd5neseces5ue7kum2ca0gsg9i0cilkl0gn8dn3q5dn86v4r8lbha0 compose : (i1 ->{g1} o) -> (i ->{g} i1) -> i ->{g1, g} o - 734. -- #stnrk323b8mm7dknlonfl70epd9f9ede60iom7sgok31mmggnic7etgi0are2uccs9g429qo3ruaeb9tk90bh35obnce1038p5qe6co + 735. -- #stnrk323b8mm7dknlonfl70epd9f9ede60iom7sgok31mmggnic7etgi0are2uccs9g429qo3ruaeb9tk90bh35obnce1038p5qe6co compose2 : (i2 ->{g2} o) -> (i1 ->{g1} i ->{g} i2) -> i1 -> i ->{g2, g1, g} o - 735. -- #mrc183aovjcae3i03r1a0ia26crmmkcf2e723pda860ps6q11rancsenjoqhc3fn0eraih1mobcvt245jr77l27uoujqa452utq8p68 + 736. -- #mrc183aovjcae3i03r1a0ia26crmmkcf2e723pda860ps6q11rancsenjoqhc3fn0eraih1mobcvt245jr77l27uoujqa452utq8p68 compose3 : (i3 ->{g3} o) -> (i2 ->{g2} i1 ->{g1} i ->{g} i3) -> i2 @@ -2574,333 +2577,333 @@ This transcript is intended to make visible accidental changes to the hashing al -> i ->{g3, g2, g1, g} o - 736. -- #ilkeid6l866bmq90d2v1ilqp9dsjo6ucmf8udgrokq3nr3mo9skl2vao2mo7ish136as52rsf19u9v3jkmd85bl08gnmamo4e5v2fqo + 737. -- #ilkeid6l866bmq90d2v1ilqp9dsjo6ucmf8udgrokq3nr3mo9skl2vao2mo7ish136as52rsf19u9v3jkmd85bl08gnmamo4e5v2fqo contains : Text -> Text -> Boolean - 737. -- #tc40jeeetbig6vcl7j6v1n0o59r8ugmjkhi6tee6o5fmkkbhmttevg093b29637gb6p70trmh9lrje86hhuuiqq565qs20qmjg4kbk0 + 738. -- #tc40jeeetbig6vcl7j6v1n0o59r8ugmjkhi6tee6o5fmkkbhmttevg093b29637gb6p70trmh9lrje86hhuuiqq565qs20qmjg4kbk0 crawl : [(Link.Term, Code)] -> [Link.Term] ->{IO} [(Link.Term, Code)] - 738. -- #urivjjshp3j122vb412mr5rq7jbf21ij1grh4amk1jfd33nfbcgv4emnnas5ekmblc4j4gsncoofatcdtktv0tp1f8sk8p06occb0hg + 739. -- #urivjjshp3j122vb412mr5rq7jbf21ij1grh4amk1jfd33nfbcgv4emnnas5ekmblc4j4gsncoofatcdtktv0tp1f8sk8p06occb0hg createTempDirectory : Text ->{IO, Exception} Text - 739. -- #h4ob7r10rul2v0dekeqjdfctbqr943ut9fgln5jgdgk0reg5d7ha0nlr16vcgcusfncgmquf5pv048lt3l9k7m653i7m0odmrvl69t0 + 740. -- #h4ob7r10rul2v0dekeqjdfctbqr943ut9fgln5jgdgk0reg5d7ha0nlr16vcgcusfncgmquf5pv048lt3l9k7m653i7m0odmrvl69t0 decodeCert : Bytes ->{Exception} SignedCert - 740. -- #ihbmfc4r7o3391jocjm6v4mojpp3hvt84ivqigrmp34vb5l3d7mmdlvh3hkrtebi812npso7rqo203a59pbs7r2g78ig6jvsv0nva38 + 741. -- #ihbmfc4r7o3391jocjm6v4mojpp3hvt84ivqigrmp34vb5l3d7mmdlvh3hkrtebi812npso7rqo203a59pbs7r2g78ig6jvsv0nva38 delay : Nat ->{IO, Exception} () - 741. -- #donnstdrflrkve7cqi26cqd90kvpdht2gp1q7v5u816a2v0h8uhevh4o618d6cdafqcnia2uqdanpn62sb7nafp77rqavj258vvjdr0 + 742. -- #donnstdrflrkve7cqi26cqd90kvpdht2gp1q7v5u816a2v0h8uhevh4o618d6cdafqcnia2uqdanpn62sb7nafp77rqavj258vvjdr0 directoryContents : Text ->{IO, Exception} [Text] - 742. -- #ac6oh72pmu5gojdaff977lj48f83rr5cuquv2nhll3iiit0hu04dr2nflrvi5chbond10mnplq1d0uqu9i52uc7ebvn3dlqp1n504qg + 743. -- #ac6oh72pmu5gojdaff977lj48f83rr5cuquv2nhll3iiit0hu04dr2nflrvi5chbond10mnplq1d0uqu9i52uc7ebvn3dlqp1n504qg Either.isLeft : Either a b -> Boolean - 743. -- #5n8bp6bvja969upaa6l2l346hab5vhemoa9ehb0n7qjer0kfapvuc7bd5hcugrf2o2auu11e9hstlf2g8uv6h3fn3v8ggmeig4blfe8 + 744. -- #5n8bp6bvja969upaa6l2l346hab5vhemoa9ehb0n7qjer0kfapvuc7bd5hcugrf2o2auu11e9hstlf2g8uv6h3fn3v8ggmeig4blfe8 Either.mapLeft : (i ->{g} o) -> Either i b ->{g} Either o b - 744. -- #jp6itgd1nh1tjn2c7e0ebkskk7sgdooh48e023l1hhkvrkuhrklrdf4omr73jpvnodfbtt4tki495480n0bp54fd0o3hngj8k2knqs8 + 745. -- #jp6itgd1nh1tjn2c7e0ebkskk7sgdooh48e023l1hhkvrkuhrklrdf4omr73jpvnodfbtt4tki495480n0bp54fd0o3hngj8k2knqs8 Either.raiseMessage : v -> Either Text b ->{Exception} b - 745. -- #4pa382t5o39uapf9tncjra8parmg9rppsn9ob3qnnrvbvtqc1oq8g3u69uapbjee9d118v8or3suhc3vu82de7l0c0og5h01beqjnko + 746. -- #4pa382t5o39uapf9tncjra8parmg9rppsn9ob3qnnrvbvtqc1oq8g3u69uapbjee9d118v8or3suhc3vu82de7l0c0og5h01beqjnko evalTest : '{IO, TempDirs, Exception, Stream Result} a ->{IO, Exception} ([Result], a) - 746. -- #4n0fgs00hpsj3paqnm9bfm4nbt9cbrin3hl88i992m9tjiq1ik7eq72asu4hcg885uti36tbnj5rudt56eahhnut1nobofg86pk1bng + 747. -- #4n0fgs00hpsj3paqnm9bfm4nbt9cbrin3hl88i992m9tjiq1ik7eq72asu4hcg885uti36tbnj5rudt56eahhnut1nobofg86pk1bng structural ability Exception structural ability builtin.Exception - 747. -- #ilea09hgph2cdqsiaeup3o58met3e62m61nckvc89v20cq3g5e71pe19idi270o7i0jdfttra51lvi1vhs0g6oluvhavhdetpor74e0 + 748. -- #ilea09hgph2cdqsiaeup3o58met3e62m61nckvc89v20cq3g5e71pe19idi270o7i0jdfttra51lvi1vhs0g6oluvhavhdetpor74e0 Exception.catch : '{g, Exception} a ->{g} Either Failure a - 748. -- #hbhvk2e00l6o7qhn8e7p6dc36bjl7ljm0gn2df5clidlrdoufsig1gt5pjhg72kl67folgg2b892kh9jc1oh0l79h4p8dqhcf1tkde0 + 749. -- #hbhvk2e00l6o7qhn8e7p6dc36bjl7ljm0gn2df5clidlrdoufsig1gt5pjhg72kl67folgg2b892kh9jc1oh0l79h4p8dqhcf1tkde0 Exception.failure : Text -> a -> Failure - 749. -- #4n0fgs00hpsj3paqnm9bfm4nbt9cbrin3hl88i992m9tjiq1ik7eq72asu4hcg885uti36tbnj5rudt56eahhnut1nobofg86pk1bng#0 + 750. -- #4n0fgs00hpsj3paqnm9bfm4nbt9cbrin3hl88i992m9tjiq1ik7eq72asu4hcg885uti36tbnj5rudt56eahhnut1nobofg86pk1bng#0 Exception.raise, builtin.Exception.raise : Failure ->{Exception} x - 750. -- #5mqjoauctm02dlqdc10cc66relu40997d6o1u8fj7vv7g0i2mtacjc83afqhuekll1gkqr9vv4lq7aenanq4kf53kcce4l1srr6ip08 + 751. -- #5mqjoauctm02dlqdc10cc66relu40997d6o1u8fj7vv7g0i2mtacjc83afqhuekll1gkqr9vv4lq7aenanq4kf53kcce4l1srr6ip08 Exception.reraise : Either Failure a ->{Exception} a - 751. -- #eak26rh0k633mbfsj8stppgj1e4l6gest2dfb2ol538l2hcmn1gpspq4vf3g72f1g8jnokfk8uv614cbdvcof0hk21nk2e55jseo18g + 752. -- #eak26rh0k633mbfsj8stppgj1e4l6gest2dfb2ol538l2hcmn1gpspq4vf3g72f1g8jnokfk8uv614cbdvcof0hk21nk2e55jseo18g Exception.toEither : '{ε, Exception} a ->{ε} Either Failure a - 752. -- #g2qp63rds1msu1c3ejqfqnsbhsiigsneuij8eq3kfnv2gdmpqui5g7t0alo1cv6mqqgp36ihvst2jc9t1jp6tnumk18mn5v8m9r3n58 + 753. -- #g2qp63rds1msu1c3ejqfqnsbhsiigsneuij8eq3kfnv2gdmpqui5g7t0alo1cv6mqqgp36ihvst2jc9t1jp6tnumk18mn5v8m9r3n58 Exception.toEither.handler : Request {Exception} a -> Either Failure a - 753. -- #q1e3avumkdpbjalk4v7c5rog11ertc0ra5nlkpgd23n6jmbki58rkebl25cbfbn7i3t274srrpbgont7j12i80hkh3gnt713poo13c8 + 754. -- #q1e3avumkdpbjalk4v7c5rog11ertc0ra5nlkpgd23n6jmbki58rkebl25cbfbn7i3t274srrpbgont7j12i80hkh3gnt713poo13c8 Exception.unsafeRun! : '{g, Exception} a ->{g} a - 754. -- #b6eskvgfv4vr30obfnaegflsf0h8u2t8816d3qhl2hl3r0l794rqgqks67q5hd46qlm06pbgt01439hmmk8jvuu3adc45cra0ggeqhg + 755. -- #b6eskvgfv4vr30obfnaegflsf0h8u2t8816d3qhl2hl3r0l794rqgqks67q5hd46qlm06pbgt01439hmmk8jvuu3adc45cra0ggeqhg expect : Text -> (a -> a -> Boolean) -> a -> a ->{Stream Result} () - 755. -- #6oqh4j31ujgecbu9kionucdbv8mbiiuasqrt294trdbqaoqlm5milniomc2c8jej0e2hco809kdb856djrr12luck2onn5que7kp2eo + 756. -- #6oqh4j31ujgecbu9kionucdbv8mbiiuasqrt294trdbqaoqlm5milniomc2c8jej0e2hco809kdb856djrr12luck2onn5que7kp2eo expectU : Text -> a -> a ->{Stream Result} () - 756. -- #ug02c2qol2gp0af97nuceu59r3jm9f52lro04ahkandkin8sabseuckr6ep0lvuknjlfhhogj9k5m2epp15d0j8bipc8iljgg8at7ho + 757. -- #ug02c2qol2gp0af97nuceu59r3jm9f52lro04ahkandkin8sabseuckr6ep0lvuknjlfhhogj9k5m2epp15d0j8bipc8iljgg8at7ho fail : Text -> b ->{Exception} c - 757. -- #ri1irkdfcdg3a0c3orv23fk2vjda5n0mlp7ooi0hskvaloa8d8qs9i7essti135k0sfomqajspr9idhu2hgjpmmb6etfabj8jdo02a8 + 758. -- #ri1irkdfcdg3a0c3orv23fk2vjda5n0mlp7ooi0hskvaloa8d8qs9i7essti135k0sfomqajspr9idhu2hgjpmmb6etfabj8jdo02a8 fileExists : Text ->{IO, Exception} Boolean - 758. -- #urlf22mo1assv31k95beddq2ava91p953ueg8kdcddofc2ftogrt10jemg760mkcd8m3lnjc3keog8anop0r0kmo2k1lggbt2chse30 + 759. -- #urlf22mo1assv31k95beddq2ava91p953ueg8kdcddofc2ftogrt10jemg760mkcd8m3lnjc3keog8anop0r0kmo2k1lggbt2chse30 first : (a ->{g} b) -> (a, c) ->{g} (b, c) - 759. -- #4rfr9je7fbsithij70iaqofqu4hgl6ji7t06ok0k98a5ni1397di8d0mllef935mdvj0e57hbg6rm9nn6ok5gcnvqr0vmodelli9qqg + 760. -- #4rfr9je7fbsithij70iaqofqu4hgl6ji7t06ok0k98a5ni1397di8d0mllef935mdvj0e57hbg6rm9nn6ok5gcnvqr0vmodelli9qqg fromB32 : Bytes ->{Exception} Bytes - 760. -- #13fpchr37ua0pr38ssr7j22pudmseuedf490aok18upagh0f00kg40guj9pgl916v9qurqrvu53f3lpsvi0s82hg3dtjacanrpjvs38 + 761. -- #13fpchr37ua0pr38ssr7j22pudmseuedf490aok18upagh0f00kg40guj9pgl916v9qurqrvu53f3lpsvi0s82hg3dtjacanrpjvs38 fromHex : Text -> Bytes - 761. -- #od69b4q2upcvsdjhb7ra8unq1r8t7924mra5j5s8f7n173bmslp8dprhgt1mjdj49qj10h2gj91eflke1avj0qlecus1mdevufm3hho + 762. -- #od69b4q2upcvsdjhb7ra8unq1r8t7924mra5j5s8f7n173bmslp8dprhgt1mjdj49qj10h2gj91eflke1avj0qlecus1mdevufm3hho getBuffering : Handle ->{IO, Exception} BufferMode - 762. -- #fupr0p6pmt834qep0jp18h9jhf4uadmtrsndpfac3kpkf4q4foqnqi6dmc6u4mgs9aubl8issknu89taqhi1mvaeg1ctbt3uf2lidh8 + 763. -- #fupr0p6pmt834qep0jp18h9jhf4uadmtrsndpfac3kpkf4q4foqnqi6dmc6u4mgs9aubl8issknu89taqhi1mvaeg1ctbt3uf2lidh8 getBytes : Handle -> Nat ->{IO, Exception} Bytes - 763. -- #qgocu5n2e7urg44ch4m8upn24efh6jk4cmp8bjsvhnenhahq8nniauav0ihpqa31p57v8fhqdep4fh5dj7nj1uul7596us04dr6dqng + 764. -- #qgocu5n2e7urg44ch4m8upn24efh6jk4cmp8bjsvhnenhahq8nniauav0ihpqa31p57v8fhqdep4fh5dj7nj1uul7596us04dr6dqng getChar : Handle ->{IO, Exception} Char - 764. -- #t92if409jh848oifd8v6bbu6o0hd0916rc3rbdlj4vf46oll2tradqrilk6r28mmm19dao5sh8l349qrhc59qopv4u1hba3ndfiitq8 + 765. -- #t92if409jh848oifd8v6bbu6o0hd0916rc3rbdlj4vf46oll2tradqrilk6r28mmm19dao5sh8l349qrhc59qopv4u1hba3ndfiitq8 getEcho : Handle ->{IO, Exception} Boolean - 765. -- #5nc47o8abjut8sab84ltouhiv3mtid9poipn2b53q3bpceebdimb4sb1e7lkrmu3bn3ivgcqe568upqqh5clrqgkhfdsji58kcdrt4g + 766. -- #5nc47o8abjut8sab84ltouhiv3mtid9poipn2b53q3bpceebdimb4sb1e7lkrmu3bn3ivgcqe568upqqh5clrqgkhfdsji58kcdrt4g getLine : Handle ->{IO, Exception} Text - 766. -- #l9pfqiqb3u9o8qo7jnaajph1qh0jbodih4vtuqti53vjmtp4diddidt8r2qa826918bt7b1cf873oo511tkivfkg35fo5o4kh5j35r0 + 767. -- #l9pfqiqb3u9o8qo7jnaajph1qh0jbodih4vtuqti53vjmtp4diddidt8r2qa826918bt7b1cf873oo511tkivfkg35fo5o4kh5j35r0 getSomeBytes : Handle -> Nat ->{IO, Exception} Bytes - 767. -- #mdhva408l4fji5h23okmhk5t4dakt1lokuie28nsdspal45lbhe06vkmcu8hf8jplse56o576ogn72j7k5nbph06nl36o957qn25tvo + 768. -- #mdhva408l4fji5h23okmhk5t4dakt1lokuie28nsdspal45lbhe06vkmcu8hf8jplse56o576ogn72j7k5nbph06nl36o957qn25tvo getTempDirectory : '{IO, Exception} Text - 768. -- #vniqolukf0296u5dc6d68ngfvi9quuuklcsjodnfm0tm8atslq19sidso2uqnbf4g6h23qck69dpd0oceb9539ufoo12rhdcdd934lo + 769. -- #vniqolukf0296u5dc6d68ngfvi9quuuklcsjodnfm0tm8atslq19sidso2uqnbf4g6h23qck69dpd0oceb9539ufoo12rhdcdd934lo handlePosition : Handle ->{IO, Exception} Nat - 769. -- #85s6gvfbpv8lhgq8m36h7ebvan4lljiu2ffehbgese5c11h3vpqlcssts8svi2qo2c5d68oeke092puta1ng84982hiid972hss9m40 + 770. -- #85s6gvfbpv8lhgq8m36h7ebvan4lljiu2ffehbgese5c11h3vpqlcssts8svi2qo2c5d68oeke092puta1ng84982hiid972hss9m40 handshake : Tls ->{IO, Exception} () - 770. -- #128490j1tmitiu3vesv97sqspmefobg1am38vos9p0vt4s1bhki87l7kj4cctquffkp40eanmr9ummfglj9i7s25jrpb32ob5sf2tio + 771. -- #128490j1tmitiu3vesv97sqspmefobg1am38vos9p0vt4s1bhki87l7kj4cctquffkp40eanmr9ummfglj9i7s25jrpb32ob5sf2tio hex : Bytes -> Text - 771. -- #ttjui80dbufvf3vgaddmcr065dpgl0rtp68i5cdht6tq4t2vk3i2vg60hi77rug368qijgijf8oui27te7o5oq0t0osm6dg65c080i0 + 772. -- #ttjui80dbufvf3vgaddmcr065dpgl0rtp68i5cdht6tq4t2vk3i2vg60hi77rug368qijgijf8oui27te7o5oq0t0osm6dg65c080i0 id : a -> a - 772. -- #0lj5fufff9ocn6lfgc3sv23aup971joh61ei6llu7djblug7tmv2avijc91ing6jmm42hu3akdefl1ttdvepk69sc8jslih1g80npg8 + 773. -- #0lj5fufff9ocn6lfgc3sv23aup971joh61ei6llu7djblug7tmv2avijc91ing6jmm42hu3akdefl1ttdvepk69sc8jslih1g80npg8 isDirectory : Text ->{IO, Exception} Boolean - 773. -- #flakrb6iks7vgijtm8dhipj14v57tk96nq5uj3uluplpoamb1etufn7rsjrelaj3letaa0e2aivq95794nv2b8a8vqbqdumd6i0fvpo + 774. -- #flakrb6iks7vgijtm8dhipj14v57tk96nq5uj3uluplpoamb1etufn7rsjrelaj3letaa0e2aivq95794nv2b8a8vqbqdumd6i0fvpo isFileEOF : Handle ->{IO, Exception} Boolean - 774. -- #5qan8ssedn9pouru70v1a06tkivapiv0es8k6v3hjpmkmboekktnh30ia7asmevglf4pu8ujb0t9vsctjsjtam160o9bn9g02uciui8 + 775. -- #5qan8ssedn9pouru70v1a06tkivapiv0es8k6v3hjpmkmboekktnh30ia7asmevglf4pu8ujb0t9vsctjsjtam160o9bn9g02uciui8 isFileOpen : Handle ->{IO, Exception} Boolean - 775. -- #2a11371klrv2i8726knma0l3g14on4m2ucihpg65cjj9k930aefg65ovvg0ak4uv3i9evtnu0a5249q3i8ugheqd65cnmgquc1a88n0 + 776. -- #2a11371klrv2i8726knma0l3g14on4m2ucihpg65cjj9k930aefg65ovvg0ak4uv3i9evtnu0a5249q3i8ugheqd65cnmgquc1a88n0 isNone : Optional a -> Boolean - 776. -- #jsqdsol9g3qnkub2f2ogertbiieldlkqh859vn5qovub6halelfmpv1tc50u1n23kotgd9nnejnn0n6foef8aqfcp615ashd0cfi3j8 + 777. -- #jsqdsol9g3qnkub2f2ogertbiieldlkqh859vn5qovub6halelfmpv1tc50u1n23kotgd9nnejnn0n6foef8aqfcp615ashd0cfi3j8 isSeekable : Handle ->{IO, Exception} Boolean - 777. -- #gop2v9s6l24ii1v6bf1nks2h0h18pato0vbsf4u3el18s7mp1jfnp4c7fesdf9sunnlv5f5a9fjr1s952pte87mf63l1iqki9bp0mio + 778. -- #gop2v9s6l24ii1v6bf1nks2h0h18pato0vbsf4u3el18s7mp1jfnp4c7fesdf9sunnlv5f5a9fjr1s952pte87mf63l1iqki9bp0mio List.all : (a ->{ε} Boolean) -> [a] ->{ε} Boolean - 778. -- #thvdk6pgdi019on95nttjhg3rbqo7aq5lv9fqgehg00657utkitc1k5r9bfl7soqdrqd82tjmesn5ocb6d30ire6vkl0ad6rcppg5vo + 779. -- #thvdk6pgdi019on95nttjhg3rbqo7aq5lv9fqgehg00657utkitc1k5r9bfl7soqdrqd82tjmesn5ocb6d30ire6vkl0ad6rcppg5vo List.filter : (a ->{g} Boolean) -> [a] ->{g} [a] - 779. -- #ca71f74kmn16u76lch7ropsgou2t3lbtc5hr06858l97qkhk0b4ado1pnii4hqfannelbgv4qruv4f1iqn43kgkbsq8lpjmo3mnrp38 + 780. -- #ca71f74kmn16u76lch7ropsgou2t3lbtc5hr06858l97qkhk0b4ado1pnii4hqfannelbgv4qruv4f1iqn43kgkbsq8lpjmo3mnrp38 List.foldLeft : (b ->{g} a ->{g} b) -> b -> [a] ->{g} b - 780. -- #o1gssqn32qvl4pa79a0lko5ksvbn0rtv8u5g9jpd73ig94om2r4nlbcqa4nd968q74ios37eg0ol36776praolimpch8jsbohg47j2o + 781. -- #o1gssqn32qvl4pa79a0lko5ksvbn0rtv8u5g9jpd73ig94om2r4nlbcqa4nd968q74ios37eg0ol36776praolimpch8jsbohg47j2o List.forEach : [a] -> (a ->{e} ()) ->{e} () - 781. -- #atruig2897q7u699k1u4ruou8epfb9qsok7ojkm5om67fhhaqgdi597jr7dvr09h9qndupc49obo4cccir98ei1grfehrcd5qhnkcq0 + 782. -- #atruig2897q7u699k1u4ruou8epfb9qsok7ojkm5om67fhhaqgdi597jr7dvr09h9qndupc49obo4cccir98ei1grfehrcd5qhnkcq0 List.range : Nat -> Nat -> [Nat] - 782. -- #marlqbcbculvqjfro3iidf899g2ncob2f8ld3gosg7kas5t9hlh341d49uh57ff5litvrt0hlb2ms7tj0mkfqs9do67cm4msodt8dng + 783. -- #marlqbcbculvqjfro3iidf899g2ncob2f8ld3gosg7kas5t9hlh341d49uh57ff5litvrt0hlb2ms7tj0mkfqs9do67cm4msodt8dng List.reverse : [a] -> [a] - 783. -- #30hfqasco93u0oipi7irfoabh5uofuu2aeplo2c87p4dg0386si6gvv715dbr21s4ftfquev4baj5ost3h17mt8fajn64mbffp6c8c0 + 784. -- #30hfqasco93u0oipi7irfoabh5uofuu2aeplo2c87p4dg0386si6gvv715dbr21s4ftfquev4baj5ost3h17mt8fajn64mbffp6c8c0 List.unzip : [(a, b)] -> ([a], [b]) - 784. -- #s8l7maltpsr01naqadvs5ssttg7eim4ca2096lbo3f3he1i1b11kk95ahtgb5ukb8cjr6kg4r4c1qrvshk9e8dp5fkq87254gc1pk48 + 785. -- #s8l7maltpsr01naqadvs5ssttg7eim4ca2096lbo3f3he1i1b11kk95ahtgb5ukb8cjr6kg4r4c1qrvshk9e8dp5fkq87254gc1pk48 List.zip : [a] -> [b] -> [(a, b)] - 785. -- #g6g6lhj9upe46032doaeo0ndu8lh1krfkc56gvupeg4a16me5vghhi6bthphnsvgtve9ogl73qab6d69ju6uorpj029g97pjg3p2k2o + 786. -- #g6g6lhj9upe46032doaeo0ndu8lh1krfkc56gvupeg4a16me5vghhi6bthphnsvgtve9ogl73qab6d69ju6uorpj029g97pjg3p2k2o listen : Socket ->{IO, Exception} () - 786. -- #ilva5f9uoaia9l8suc3hl9kh2bg1lah1k7uvm8mlq3mt0b9krdh15kurbhb9pu7a8irmvk6m2lpulg75a5alf0a95u0rp0v0n9folmg + 787. -- #ilva5f9uoaia9l8suc3hl9kh2bg1lah1k7uvm8mlq3mt0b9krdh15kurbhb9pu7a8irmvk6m2lpulg75a5alf0a95u0rp0v0n9folmg loadCodeBytes : Bytes ->{Exception} Code - 787. -- #tjj9c7fbprd57jlnndl8huslhvfbhi1bt1mr45v1fvvr2b3bguhnjtll3lbsbnqqjb290tm9cnuafpbtlfev1csbtjjog0r2kfv0e50 + 788. -- #tjj9c7fbprd57jlnndl8huslhvfbhi1bt1mr45v1fvvr2b3bguhnjtll3lbsbnqqjb290tm9cnuafpbtlfev1csbtjjog0r2kfv0e50 loadSelfContained : Text ->{IO, Exception} a - 788. -- #1pkgu9vbcdl57d9pn9ses1htmfokjq6212ed5oo9jscjkf8t2s407j71287hd9nr1shgsjmn0eunm5e7h262id4hh3t4op6barrvc70 + 789. -- #1pkgu9vbcdl57d9pn9ses1htmfokjq6212ed5oo9jscjkf8t2s407j71287hd9nr1shgsjmn0eunm5e7h262id4hh3t4op6barrvc70 loadValueBytes : Bytes ->{IO, Exception} ([(Link.Term, Code)], Value) - 789. -- #nqodnhhovq1ilb5fstpc61l8omfto62r8s0qq8s4ij39ulorqpgtinef64mullq0ns4914gck6obeuu6so1hds09hh5o1ptpt4k909g + 790. -- #nqodnhhovq1ilb5fstpc61l8omfto62r8s0qq8s4ij39ulorqpgtinef64mullq0ns4914gck6obeuu6so1hds09hh5o1ptpt4k909g MVar.put : MVar i -> i ->{IO, Exception} () - 790. -- #4ck8hqiu4m7478q5p7osqd1g9piie53g2v6j89en9s90f3cnhb9jr2515f35605e18ohiod7nb93t03765cil0lecob3hcsht9870g0 + 791. -- #4ck8hqiu4m7478q5p7osqd1g9piie53g2v6j89en9s90f3cnhb9jr2515f35605e18ohiod7nb93t03765cil0lecob3hcsht9870g0 MVar.read : MVar o ->{IO, Exception} o - 791. -- #tchse01rs4t1e6bk9br5ofad23ahlb9eanlv9nqqlk5eh7rv7qtpd5jmdjrcksm1q3uji64kqblrqq0vgap9tmak3urkr3ok4kg2ci0 + 792. -- #tchse01rs4t1e6bk9br5ofad23ahlb9eanlv9nqqlk5eh7rv7qtpd5jmdjrcksm1q3uji64kqblrqq0vgap9tmak3urkr3ok4kg2ci0 MVar.swap : MVar o -> o ->{IO, Exception} o - 792. -- #23nq5mshk51uktsg3su3mnkr9s4fe3sktf4q388bpsluiik64l8h060qptgfv48r25fcskecmc9t4gdsm8im9fhjf70i1klp34epksg + 793. -- #23nq5mshk51uktsg3su3mnkr9s4fe3sktf4q388bpsluiik64l8h060qptgfv48r25fcskecmc9t4gdsm8im9fhjf70i1klp34epksg MVar.take : MVar o ->{IO, Exception} o - 793. -- #18pqussken2f5u9vuall7ds58cf4fajoc4trf7p93vk4640ia88vsh2lgq9kgu8fvpr86518443ecvn7eo5tessq2hmgs55aiftui8g + 794. -- #18pqussken2f5u9vuall7ds58cf4fajoc4trf7p93vk4640ia88vsh2lgq9kgu8fvpr86518443ecvn7eo5tessq2hmgs55aiftui8g newClient : ClientConfig -> Socket ->{IO, Exception} Tls - 794. -- #mmoj281h8bimgcfqfpfg6mfriu8cta5vva4ppo41ioc6phegdfii26ic2s5sh0lf5tc6o15o7v79ui8eeh2mbicup07tl6hkrq9q34o + 795. -- #mmoj281h8bimgcfqfpfg6mfriu8cta5vva4ppo41ioc6phegdfii26ic2s5sh0lf5tc6o15o7v79ui8eeh2mbicup07tl6hkrq9q34o newServer : ServerConfig -> Socket ->{IO, Exception} Tls - 795. -- #r6l6s6ni7ut1b9le2d84el9dkhqjcjhodhd0l1qsksahm4cbgdk0odjck9jnku08v0pn909kabe2v88p43jisavkariomtgmtrrtbu8 + 796. -- #r6l6s6ni7ut1b9le2d84el9dkhqjcjhodhd0l1qsksahm4cbgdk0odjck9jnku08v0pn909kabe2v88p43jisavkariomtgmtrrtbu8 openFile : Text -> FileMode ->{IO, Exception} Handle - 796. -- #c58qbcgd90d965dokk7bu82uehegkbe8jttm7lv4j0ohgi2qm3e3p4v1qfr8vc2dlsmsl9tv0v71kco8c18mneule0ntrhte4ks1090 + 797. -- #c58qbcgd90d965dokk7bu82uehegkbe8jttm7lv4j0ohgi2qm3e3p4v1qfr8vc2dlsmsl9tv0v71kco8c18mneule0ntrhte4ks1090 printLine : Text ->{IO, Exception} () - 797. -- #dck7pb7qv05ol3b0o76l88a22bc7enl781ton5qbs2umvgsua3p16n22il02m29592oohsnbt3cr7hnlumpdhv2ibjp6iji9te4iot0 + 798. -- #dck7pb7qv05ol3b0o76l88a22bc7enl781ton5qbs2umvgsua3p16n22il02m29592oohsnbt3cr7hnlumpdhv2ibjp6iji9te4iot0 printText : Text ->{IO} Either Failure () - 798. -- #5si7baedo99eap6jgd9krvt7q4ak8s98t4ushnno8mgjp7u9li137ferm3dn11g4k3mds1m8n33sbuodrohstbm9hcqm1937tfj7iq8 + 799. -- #5si7baedo99eap6jgd9krvt7q4ak8s98t4ushnno8mgjp7u9li137ferm3dn11g4k3mds1m8n33sbuodrohstbm9hcqm1937tfj7iq8 putBytes : Handle -> Bytes ->{IO, Exception} () - 799. -- #gkd4pi7uossfe12b19s0mrr0a04v5vvhnfmq3qer3cu7jr24m5v4e1qu59mktrornbrrqgihsvkj1f29je971oqimpngiqgebkr9i58 + 800. -- #gkd4pi7uossfe12b19s0mrr0a04v5vvhnfmq3qer3cu7jr24m5v4e1qu59mktrornbrrqgihsvkj1f29je971oqimpngiqgebkr9i58 readFile : Text ->{IO, Exception} Bytes - 800. -- #ak95mrmd6jhaiikkr42qsvd5lu7au0mpveqm1e347mkr7s4f846apqhh203ei1p3pqi18dcuhuotf53l8p2ivsjs8octc1eenjdqb48 + 801. -- #ak95mrmd6jhaiikkr42qsvd5lu7au0mpveqm1e347mkr7s4f846apqhh203ei1p3pqi18dcuhuotf53l8p2ivsjs8octc1eenjdqb48 ready : Handle ->{IO, Exception} Boolean - 801. -- #gpogpcuoc1dsktoh5t50ofl6dc4vulm0fsqoeevuuoivbrin87ah166b8k8vq3s3977ha0p7np5mn198gglqkjj1gh7nbv31eb7dbqo + 802. -- #gpogpcuoc1dsktoh5t50ofl6dc4vulm0fsqoeevuuoivbrin87ah166b8k8vq3s3977ha0p7np5mn198gglqkjj1gh7nbv31eb7dbqo receive : Tls ->{IO, Exception} Bytes - 802. -- #7rctbhido3s7lm9tjb6dit94cg2jofasr6div31976q840e5va5j6tu6p0pugkt106mcjrtiqndimaknakrnssdo6ul0jef6a9nf1qo + 803. -- #7rctbhido3s7lm9tjb6dit94cg2jofasr6div31976q840e5va5j6tu6p0pugkt106mcjrtiqndimaknakrnssdo6ul0jef6a9nf1qo removeDirectory : Text ->{IO, Exception} () - 803. -- #710k006oln987ch4k1c986sb0jfqtpusp0a235te6cejhns51um6umr311ltgfiv80kt0s8sb8r0ic63gj2nvgbi66vq10s4ilkk5ng + 804. -- #710k006oln987ch4k1c986sb0jfqtpusp0a235te6cejhns51um6umr311ltgfiv80kt0s8sb8r0ic63gj2nvgbi66vq10s4ilkk5ng renameDirectory : Text -> Text ->{IO, Exception} () - 804. -- #vb50tjb967ic3mr4brs0pro9819ftcj4q48eoeal8gmk02f05isuqhn0accbi7rv07g3i4hjgntu2b2r8b9bn15mjc59v10u9c3gjdo + 805. -- #vb50tjb967ic3mr4brs0pro9819ftcj4q48eoeal8gmk02f05isuqhn0accbi7rv07g3i4hjgntu2b2r8b9bn15mjc59v10u9c3gjdo runTest : '{IO, TempDirs, Exception, Stream Result} a ->{IO} [Result] - 805. -- #ub9vp3rs8gh7kj9ksq0dbpoj22r61iq179co8tpgsj9m52n36qha52rm5hlht4hesgqfb8917cp1tk8jhgcft6sufgis6bgemmd57ag + 806. -- #ub9vp3rs8gh7kj9ksq0dbpoj22r61iq179co8tpgsj9m52n36qha52rm5hlht4hesgqfb8917cp1tk8jhgcft6sufgis6bgemmd57ag saveSelfContained : a -> Text ->{IO, Exception} () - 806. -- #6jriif58nb7gbb576kcabft4k4qaa74prd4dpsomokbqceust7p0gu0jlpar4o70qt987lkki2sj1pknkr0ggoif8fcvu2jg2uenqe8 + 807. -- #6jriif58nb7gbb576kcabft4k4qaa74prd4dpsomokbqceust7p0gu0jlpar4o70qt987lkki2sj1pknkr0ggoif8fcvu2jg2uenqe8 saveTestCase : Text -> Text -> (a -> Text) -> a ->{IO, Exception} () - 807. -- #uq87p0r1djq5clhkbimp3fc325e5kp3bv33dc8fpphotdqp95a0ps2c2ch8d2ftdpdualpq2oo9dmnka6kvnc9kvugs2538q62up4t0 + 808. -- #uq87p0r1djq5clhkbimp3fc325e5kp3bv33dc8fpphotdqp95a0ps2c2ch8d2ftdpdualpq2oo9dmnka6kvnc9kvugs2538q62up4t0 seekHandle : Handle -> SeekMode -> Int ->{IO, Exception} () - 808. -- #ftkuro0u0et9ahigdr1k38tl2sl7i0plm7cv5nciccdd71t6a64icla66ss0ufu7llfuj7cuvg3ms4ieel6penfi8gkahb9tm3sfhjo + 809. -- #ftkuro0u0et9ahigdr1k38tl2sl7i0plm7cv5nciccdd71t6a64icla66ss0ufu7llfuj7cuvg3ms4ieel6penfi8gkahb9tm3sfhjo send : Tls -> Bytes ->{IO, Exception} () - 809. -- #k6gmcn3qg50h49gealh8o7j7tp74rvhgn040kftsavd2cldqopcv9945olnooe04cqitgpvekpcbr5ccqjosg7r9gb1lagju5v9ln0o + 810. -- #k6gmcn3qg50h49gealh8o7j7tp74rvhgn040kftsavd2cldqopcv9945olnooe04cqitgpvekpcbr5ccqjosg7r9gb1lagju5v9ln0o serverSocket : Optional Text -> Text ->{IO, Exception} Socket - 810. -- #umje4ibrfv3c6vsjrdkbne1u7c8hg4ll9185m3frqr2rsr8738hp5fq12kepa28h63u9qi23stsegjp1hv0incr5djbl7ulp2s12d8g + 811. -- #umje4ibrfv3c6vsjrdkbne1u7c8hg4ll9185m3frqr2rsr8738hp5fq12kepa28h63u9qi23stsegjp1hv0incr5djbl7ulp2s12d8g setBuffering : Handle -> BufferMode ->{IO, Exception} () - 811. -- #je6s0pdkrg3mvphpg535pubchjd40mepki6ipum7498sma7pll9l89h6de65063bufihf2jb5ihepth2jahir8rs757ggfrnpp7fs7o + 812. -- #je6s0pdkrg3mvphpg535pubchjd40mepki6ipum7498sma7pll9l89h6de65063bufihf2jb5ihepth2jahir8rs757ggfrnpp7fs7o setEcho : Handle -> Boolean ->{IO, Exception} () - 812. -- #in06o7cfgnlmm6pvdtv0jv9hniahcli0fvh27o01ork1p77ro2v51rc05ts1h6p9mtffqld4ufs8klcc4bse1tsj93cu0na0bbiuqb0 + 813. -- #in06o7cfgnlmm6pvdtv0jv9hniahcli0fvh27o01ork1p77ro2v51rc05ts1h6p9mtffqld4ufs8klcc4bse1tsj93cu0na0bbiuqb0 snd : (a1, a) -> a - 813. -- #km3cpkvcnvcos0isfbnb7pb3s45ri5q42n74jmm9c4v1bcu8nlk63353u4ohfr7av4k00s4s180ddnqbam6a01thhlt2tie1hm5a9bo + 814. -- #km3cpkvcnvcos0isfbnb7pb3s45ri5q42n74jmm9c4v1bcu8nlk63353u4ohfr7av4k00s4s180ddnqbam6a01thhlt2tie1hm5a9bo socketAccept : Socket ->{IO, Exception} Socket - 814. -- #ubteu6e7h7om7o40e8mm1rcmp8uur7qn7p5d92gtp3q92rtr459nn3rff4i9q46o2o60tmh77i9vgu0pub768s9kvn9egtcds30nk88 + 815. -- #ubteu6e7h7om7o40e8mm1rcmp8uur7qn7p5d92gtp3q92rtr459nn3rff4i9q46o2o60tmh77i9vgu0pub768s9kvn9egtcds30nk88 socketPort : Socket ->{IO, Exception} Nat - 815. -- #3rp8h0dt7g60nrjdehuhqga9dmomti5rdqho7r1rm5rg5moet7kt3ieempo7c9urur752njachq6k48ggbic4ugbbv75jl2mfbk57a0 + 816. -- #3rp8h0dt7g60nrjdehuhqga9dmomti5rdqho7r1rm5rg5moet7kt3ieempo7c9urur752njachq6k48ggbic4ugbbv75jl2mfbk57a0 startsWith : Text -> Text -> Boolean - 816. -- #elsab3sc7p4c6bj73pgvklv0j7qu268rn5isv6micfp7ib8grjoustpqdq0pkd4a379mr5ijb8duu2q0n040osfurppp8pt8vaue2fo + 817. -- #elsab3sc7p4c6bj73pgvklv0j7qu268rn5isv6micfp7ib8grjoustpqdq0pkd4a379mr5ijb8duu2q0n040osfurppp8pt8vaue2fo stdout : Handle - 817. -- #rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8 + 818. -- #rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8 structural ability Stream a - 818. -- #s76vfp9t00khf3bvrg01h9u7gnqj5m62sere8ac97un79ojd82b71q2e0cllj002jn4r2g3qhjft40gkqotgor74v0iogkt3lfftlug + 819. -- #s76vfp9t00khf3bvrg01h9u7gnqj5m62sere8ac97un79ojd82b71q2e0cllj002jn4r2g3qhjft40gkqotgor74v0iogkt3lfftlug Stream.collect : '{e, Stream a} r ->{e} ([a], r) - 819. -- #abc5m7k74em3fk9et4lrj0ee2lsbvp8vp826josen26l1g3lh9ansb47b68efe1vhhi8f6l6kaircd5t4ihlbt0pq4nlipgde9rq8v8 + 820. -- #abc5m7k74em3fk9et4lrj0ee2lsbvp8vp826josen26l1g3lh9ansb47b68efe1vhhi8f6l6kaircd5t4ihlbt0pq4nlipgde9rq8v8 Stream.collect.handler : Request {Stream a} r -> ([a], r) - 820. -- #rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8#0 + 821. -- #rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8#0 Stream.emit : a ->{Stream a} () - 821. -- #mrhqdu5he7p8adejmvt4ss09apkbnu8jn66g4lpf0uas9dvm8goa6g65bo2u7s0175hrrofd6uqg7ogmduf928knfpkd12042k6o860 + 822. -- #mrhqdu5he7p8adejmvt4ss09apkbnu8jn66g4lpf0uas9dvm8goa6g65bo2u7s0175hrrofd6uqg7ogmduf928knfpkd12042k6o860 Stream.toList : '{Stream a} r -> [a] - 822. -- #t3klufmrq2bk8gg0o4lukenlmu0dkkcssq9l80m4p3dm6rqesrt51nrebfujfgco9h47f4e5nplmj7rvc3salvs65labd7nvj2fkne8 + 823. -- #t3klufmrq2bk8gg0o4lukenlmu0dkkcssq9l80m4p3dm6rqesrt51nrebfujfgco9h47f4e5nplmj7rvc3salvs65labd7nvj2fkne8 Stream.toList.handler : Request {Stream a} r -> [a] - 823. -- #pus3urtj4e1bhv5p5l16d7vnv4g2hso78pcfussnufkt3d53j7oaqde1ajvijr1g6f0cv2c4ice34g8g8n17hd7hql6hvl8sgcgu6s8 + 824. -- #pus3urtj4e1bhv5p5l16d7vnv4g2hso78pcfussnufkt3d53j7oaqde1ajvijr1g6f0cv2c4ice34g8g8n17hd7hql6hvl8sgcgu6s8 systemTime : '{IO, Exception} Nat - 824. -- #11mhfqj6rts8lm3im7saf44tn3km5bboqtu1td0udnaiit4qqg6ar1ecmccosl6gufsnp6sug3vcmgapsc58sgj7dh7rg8msq2qkj18 + 825. -- #11mhfqj6rts8lm3im7saf44tn3km5bboqtu1td0udnaiit4qqg6ar1ecmccosl6gufsnp6sug3vcmgapsc58sgj7dh7rg8msq2qkj18 structural ability TempDirs - 825. -- #11mhfqj6rts8lm3im7saf44tn3km5bboqtu1td0udnaiit4qqg6ar1ecmccosl6gufsnp6sug3vcmgapsc58sgj7dh7rg8msq2qkj18#0 + 826. -- #11mhfqj6rts8lm3im7saf44tn3km5bboqtu1td0udnaiit4qqg6ar1ecmccosl6gufsnp6sug3vcmgapsc58sgj7dh7rg8msq2qkj18#0 TempDirs.newTempDir : Text ->{TempDirs} Text - 826. -- #11mhfqj6rts8lm3im7saf44tn3km5bboqtu1td0udnaiit4qqg6ar1ecmccosl6gufsnp6sug3vcmgapsc58sgj7dh7rg8msq2qkj18#1 + 827. -- #11mhfqj6rts8lm3im7saf44tn3km5bboqtu1td0udnaiit4qqg6ar1ecmccosl6gufsnp6sug3vcmgapsc58sgj7dh7rg8msq2qkj18#1 TempDirs.removeDir : Text ->{TempDirs} () - 827. -- #ibj0sc16l6bd7r6ptft93jeocitrjod98g210beogdk30t3tb127fbe33vau29j0j4gt8mbs2asfs5rslgk0fl3o4did2t9oa8o5kf8 + 828. -- #ibj0sc16l6bd7r6ptft93jeocitrjod98g210beogdk30t3tb127fbe33vau29j0j4gt8mbs2asfs5rslgk0fl3o4did2t9oa8o5kf8 terminate : Tls ->{IO, Exception} () - 828. -- #iis8ph5ljlq8ijd9jsdlsga91fh1354fii7955l4v52mnvn71cd76maculs0eathrmtfjqh0knbc600kmvq6abj4k2ntnbh5ee10m2o + 829. -- #iis8ph5ljlq8ijd9jsdlsga91fh1354fii7955l4v52mnvn71cd76maculs0eathrmtfjqh0knbc600kmvq6abj4k2ntnbh5ee10m2o testAutoClean : '{IO} [Result] - 829. -- #k1prgid1t9d4fu6f60rct978khcuinkpq49ps95aqaimt2tfoa77fc0c8i3pmc8toeth1s98al3nosaa1mhbh2j2k2nvqivm0ks963o + 830. -- #k1prgid1t9d4fu6f60rct978khcuinkpq49ps95aqaimt2tfoa77fc0c8i3pmc8toeth1s98al3nosaa1mhbh2j2k2nvqivm0ks963o Text.fromUtf8 : Bytes ->{Exception} Text - 830. -- #32q9jqhmi8f08pec3hj0je4u7k52f9f1hdfsmn9ncg2kpki5da9dabigplvdcot3a00k7s5npc4n78psd6ojaumqjla259e9pqd4ov8 + 831. -- #32q9jqhmi8f08pec3hj0je4u7k52f9f1hdfsmn9ncg2kpki5da9dabigplvdcot3a00k7s5npc4n78psd6ojaumqjla259e9pqd4ov8 structural ability Throw e - 831. -- #32q9jqhmi8f08pec3hj0je4u7k52f9f1hdfsmn9ncg2kpki5da9dabigplvdcot3a00k7s5npc4n78psd6ojaumqjla259e9pqd4ov8#0 + 832. -- #32q9jqhmi8f08pec3hj0je4u7k52f9f1hdfsmn9ncg2kpki5da9dabigplvdcot3a00k7s5npc4n78psd6ojaumqjla259e9pqd4ov8#0 Throw.throw : e ->{Throw e} a - 832. -- #f6pkvs6ukf8ngh2j8lm935p1bqadso76o7e3t0j1ukupjh1rg0m1rhtp7u492sq17p3bkbintbnjehc1cqs33qlhnfkoihf5uee4ug0 + 833. -- #f6pkvs6ukf8ngh2j8lm935p1bqadso76o7e3t0j1ukupjh1rg0m1rhtp7u492sq17p3bkbintbnjehc1cqs33qlhnfkoihf5uee4ug0 uncurry : (i1 ->{g1} i ->{g} o) -> (i1, i) ->{g1, g} o - 833. -- #u1o44hd0cdlfa8racf458sahdmgea409k8baajgc5k7bqukf2ak5ggs2ped0u3h85v99pgefgb9r7ct2dv4nn9eihjghnqf30p4l57g + 834. -- #u1o44hd0cdlfa8racf458sahdmgea409k8baajgc5k7bqukf2ak5ggs2ped0u3h85v99pgefgb9r7ct2dv4nn9eihjghnqf30p4l57g Value.transitiveDeps : Value ->{IO} [(Link.Term, Code)] - 834. -- #o5bg5el7ckak28ib98j5b6rt26bqbprpddd1brrg3s18qahhbbe3uohufjjnt5eenvtjg0hrvnvpra95jmdppqrovvmcfm1ih2k7guo + 835. -- #o5bg5el7ckak28ib98j5b6rt26bqbprpddd1brrg3s18qahhbbe3uohufjjnt5eenvtjg0hrvnvpra95jmdppqrovvmcfm1ih2k7guo void : x -> () - 835. -- #b4pssu6mf30r4irqj43vvgbc6geq8pp7eg4o2erl948qp3nskp6io5damjj54o2eq9q76mrhsijr1q1d0bna4soed3oggddfvdajaj8 + 836. -- #b4pssu6mf30r4irqj43vvgbc6geq8pp7eg4o2erl948qp3nskp6io5damjj54o2eq9q76mrhsijr1q1d0bna4soed3oggddfvdajaj8 writeFile : Text -> Bytes ->{IO, Exception} () - 836. -- #lcmj2envm11lrflvvcl290lplhvbccv82utoej0lg0eomhmsf2vrv8af17k6if7ff98fp1b13rkseng3fng4stlr495c8dn3gn4k400 + 837. -- #lcmj2envm11lrflvvcl290lplhvbccv82utoej0lg0eomhmsf2vrv8af17k6if7ff98fp1b13rkseng3fng4stlr495c8dn3gn4k400 |> : a -> (a ->{g} t) ->{g} t diff --git a/unison-src/transcripts/builtins-merge.output.md b/unison-src/transcripts/builtins-merge.output.md index 499ff55ec..9aeb9abc0 100644 --- a/unison-src/transcripts/builtins-merge.output.md +++ b/unison-src/transcripts/builtins-merge.output.md @@ -52,7 +52,7 @@ The `builtins.merge` command adds the known builtins to a `builtin` subnamespace 41. Optional (type) 42. Optional/ (2 terms) 43. Pattern (builtin type) - 44. Pattern/ (8 terms) + 44. Pattern/ (9 terms) 45. Ref (builtin type) 46. Ref/ (2 terms) 47. Request (builtin type) diff --git a/unison-src/transcripts/emptyCodebase.output.md b/unison-src/transcripts/emptyCodebase.output.md index e07e6c996..46fd51942 100644 --- a/unison-src/transcripts/emptyCodebase.output.md +++ b/unison-src/transcripts/emptyCodebase.output.md @@ -23,7 +23,7 @@ Technically, the definitions all exist, but they have no names. `builtins.merge` .foo> ls - 1. builtin/ (455 terms, 71 types) + 1. builtin/ (456 terms, 71 types) ``` And for a limited time, you can get even more builtin goodies: @@ -35,7 +35,7 @@ And for a limited time, you can get even more builtin goodies: .foo> ls - 1. builtin/ (627 terms, 89 types) + 1. builtin/ (628 terms, 89 types) ``` More typically, you'd start out by pulling `base. diff --git a/unison-src/transcripts/merges.output.md b/unison-src/transcripts/merges.output.md index 19bf194ba..211c54a21 100644 --- a/unison-src/transcripts/merges.output.md +++ b/unison-src/transcripts/merges.output.md @@ -119,13 +119,13 @@ it's still in the `history` of the parent namespace and can be resurrected at an Note: The most recent namespace hash is immediately below this message. - ⊙ 1. #1qpabd7ooq + ⊙ 1. #mqis95ft23 - Deletes: feature1.y - ⊙ 2. #jhqb98218p + ⊙ 2. #5ro9c9692q + Adds / updates: @@ -136,26 +136,26 @@ it's still in the `history` of the parent namespace and can be resurrected at an Original name New name(s) feature1.y master.y - ⊙ 3. #n25372gm2b + ⊙ 3. #da33td9rni + Adds / updates: feature1.y - ⊙ 4. #b9s4c5ut48 + ⊙ 4. #ks6rftepdv > Moves: Original name New name x master.x - ⊙ 5. #9uq9mhup43 + ⊙ 5. #dgcqc7jftr + Adds / updates: x - □ 6. #8f47abto6r (start of history) + □ 6. #ms344fdodl (start of history) ``` To resurrect an old version of a namespace, you can learn its hash via the `history` command, then use `fork #namespacehash .newname`. diff --git a/unison-src/transcripts/move-all.output.md b/unison-src/transcripts/move-all.output.md index 059277fcb..e7a1ab211 100644 --- a/unison-src/transcripts/move-all.output.md +++ b/unison-src/transcripts/move-all.output.md @@ -80,7 +80,7 @@ Should be able to move the term, type, and namespace, including its types, terms 1. Bar (Nat) 2. Bar (type) 3. Bar/ (4 terms, 1 type) - 4. builtin/ (627 terms, 89 types) + 4. builtin/ (628 terms, 89 types) .> ls Bar @@ -145,7 +145,7 @@ bonk = 5 .z> ls - 1. builtin/ (455 terms, 71 types) + 1. builtin/ (456 terms, 71 types) 2. zonk (Nat) ``` @@ -188,7 +188,7 @@ bonk.zonk = 5 .a> ls - 1. builtin/ (455 terms, 71 types) + 1. builtin/ (456 terms, 71 types) 2. zonk/ (1 term) .a> view zonk.zonk diff --git a/unison-src/transcripts/move-namespace.output.md b/unison-src/transcripts/move-namespace.output.md index 17c1aafa2..a86fd4c98 100644 --- a/unison-src/transcripts/move-namespace.output.md +++ b/unison-src/transcripts/move-namespace.output.md @@ -277,7 +277,7 @@ I should be able to move the root into a sub-namespace .> ls - 1. root/ (1370 terms, 214 types) + 1. root/ (1373 terms, 214 types) .> history @@ -286,22 +286,22 @@ I should be able to move the root into a sub-namespace - □ 1. #p1ltr60tg9 (start of history) + □ 1. #vrn80pdffk (start of history) ``` ```ucm .> ls .root.at.path - 1. existing/ (456 terms, 71 types) - 2. happy/ (458 terms, 72 types) - 3. history/ (456 terms, 71 types) + 1. existing/ (457 terms, 71 types) + 2. happy/ (459 terms, 72 types) + 3. history/ (457 terms, 71 types) .> history .root.at.path Note: The most recent namespace hash is immediately below this message. - ⊙ 1. #nndiivp3ng + ⊙ 1. #g3ri07hi09 - Deletes: @@ -312,7 +312,7 @@ I should be able to move the root into a sub-namespace Original name New name existing.a.termInA existing.b.termInA - ⊙ 2. #1he7dqonrt + ⊙ 2. #ifjg1bj57v + Adds / updates: @@ -324,26 +324,26 @@ I should be able to move the root into a sub-namespace happy.b.termInA existing.a.termInA history.b.termInA existing.a.termInA - ⊙ 3. #fbm4gr3975 + ⊙ 3. #bdn8f7vhg1 + Adds / updates: existing.a.termInA existing.b.termInB - ⊙ 4. #v7j1f8vgni + ⊙ 4. #5dqmgnr0lt > Moves: Original name New name history.a.termInA history.b.termInA - ⊙ 5. #ofsvuc0cgu + ⊙ 5. #vd3d37rn3c - Deletes: history.b.termInB - ⊙ 6. #s3afu924g2 + ⊙ 6. #gi32sh566a + Adds / updates: @@ -354,13 +354,13 @@ I should be able to move the root into a sub-namespace Original name New name(s) happy.b.termInA history.a.termInA - ⊙ 7. #0bb30gq2b1 + ⊙ 7. #u2bs53f2hl + Adds / updates: history.a.termInA history.b.termInB - ⊙ 8. #aoclegh6j7 + ⊙ 8. #48hsm89mgl > Moves: @@ -370,7 +370,7 @@ I should be able to move the root into a sub-namespace happy.a.T.T2 happy.b.T.T2 happy.a.termInA happy.b.termInA - ⊙ 9. #509sbqajct + ⊙ 9. #pqd79g3q7l + Adds / updates: @@ -380,7 +380,7 @@ I should be able to move the root into a sub-namespace happy.a.T.T - ⊙ 10. #8erj1uau9u + ⊙ 10. #allrjqq7ga + Adds / updates: @@ -392,7 +392,7 @@ I should be able to move the root into a sub-namespace ⠇ - ⊙ 11. #v4nrp8uols + ⊙ 11. #ohd0a9rim1 ``` @@ -414,26 +414,26 @@ I should be able to move a sub namespace _over_ the root. .> ls 1. b/ (3 terms, 1 type) - 2. builtin/ (455 terms, 71 types) + 2. builtin/ (456 terms, 71 types) .> history Note: The most recent namespace hash is immediately below this message. - ⊙ 1. #buu0h3vir1 + ⊙ 1. #lf3m1s2e7i + Adds / updates: b.T b.T.T1 b.T.T2 b.termInA - ⊙ 2. #rck0cngerk + ⊙ 2. #b1cg22v7s1 - Deletes: a.T a.T.T1 a.T.T2 a.termInA - ⊙ 3. #k6m6gfsvd6 + ⊙ 3. #r83v608ifd + Adds / updates: @@ -443,13 +443,13 @@ I should be able to move a sub namespace _over_ the root. a.T.T - ⊙ 4. #2rvval9cn9 + ⊙ 4. #pmm6a0f6fj + Adds / updates: a.T a.T.T a.termInA - □ 5. #schnold03v (start of history) + □ 5. #nmcjvlnbk1 (start of history) ``` ```ucm diff --git a/unison-src/transcripts/patterns.md b/unison-src/transcripts/patterns.md index ea4a64f6e..104d1bc8a 100644 --- a/unison-src/transcripts/patterns.md +++ b/unison-src/transcripts/patterns.md @@ -8,4 +8,5 @@ Some tests of pattern behavior. p1 = join [literal "blue", literal "frog"] > Pattern.run (many p1) "bluefrogbluegoat" +> Pattern.run (many.corrected p1) "bluefrogbluegoat" ``` diff --git a/unison-src/transcripts/patterns.output.md b/unison-src/transcripts/patterns.output.md index db7325f86..7db153f99 100644 --- a/unison-src/transcripts/patterns.output.md +++ b/unison-src/transcripts/patterns.output.md @@ -4,6 +4,7 @@ Some tests of pattern behavior. p1 = join [literal "blue", literal "frog"] > Pattern.run (many p1) "bluefrogbluegoat" +> Pattern.run (many.corrected p1) "bluefrogbluegoat" ``` ```ucm @@ -22,6 +23,10 @@ p1 = join [literal "blue", literal "frog"] `>`)... Ctrl+C cancels. 3 | > Pattern.run (many p1) "bluefrogbluegoat" + ⧩ + Some ([], "goat") + + 4 | > Pattern.run (many.corrected p1) "bluefrogbluegoat" ⧩ Some ([], "bluegoat") diff --git a/unison-src/transcripts/reflog.output.md b/unison-src/transcripts/reflog.output.md index 9f28365bc..de15d58cd 100644 --- a/unison-src/transcripts/reflog.output.md +++ b/unison-src/transcripts/reflog.output.md @@ -63,17 +63,17 @@ y = 2 most recent, along with the command that got us there. Try: `fork 2 .old` - `fork #lbg8tf1sdh .old` to make an old namespace + `fork #mq4oqhiuuq .old` to make an old namespace accessible again, - `reset-root #lbg8tf1sdh` to reset the root namespace and + `reset-root #mq4oqhiuuq` to reset the root namespace and its history to that of the specified namespace. When Root Hash Action - 1. now #5gonu2p9gp add - 2. now #lbg8tf1sdh add - 3. now #schnold03v builtins.merge + 1. now #1n5tjujeu7 add + 2. now #mq4oqhiuuq add + 3. now #nmcjvlnbk1 builtins.merge 4. #sg60bvjo91 history starts here Tip: Use `diff.namespace 1 7` to compare namespaces between diff --git a/unison-src/transcripts/reset.output.md b/unison-src/transcripts/reset.output.md index 04baed1f1..38672d85b 100644 --- a/unison-src/transcripts/reset.output.md +++ b/unison-src/transcripts/reset.output.md @@ -28,13 +28,13 @@ a = 5 Note: The most recent namespace hash is immediately below this message. - ⊙ 1. #havp29or07 + ⊙ 1. #0nv4t3770d + Adds / updates: a - □ 2. #schnold03v (start of history) + □ 2. #nmcjvlnbk1 (start of history) .> reset 2 @@ -47,7 +47,7 @@ a = 5 - □ 1. #schnold03v (start of history) + □ 1. #nmcjvlnbk1 (start of history) ``` ```unison @@ -83,13 +83,13 @@ foo.a = 5 Note: The most recent namespace hash is immediately below this message. - ⊙ 1. #i2199da947 + ⊙ 1. #3s91aop8k9 + Adds / updates: foo.a - □ 2. #schnold03v (start of history) + □ 2. #nmcjvlnbk1 (start of history) .> reset 1 foo diff --git a/unison-src/transcripts/squash.output.md b/unison-src/transcripts/squash.output.md index 8652d65ea..57fba2546 100644 --- a/unison-src/transcripts/squash.output.md +++ b/unison-src/transcripts/squash.output.md @@ -13,7 +13,7 @@ Let's look at some examples. We'll start with a namespace with just the builtins - □ 1. #iq58l8umv4 (start of history) + □ 1. #3pq2vvggng (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. - ⊙ 1. #cb1ngbi7os + ⊙ 1. #4g884gq7lc > Moves: Original name New name Nat.frobnicate Nat.+ - ⊙ 2. #evasbqug8s + ⊙ 2. #hnah4l7s0j > Moves: Original name New name Nat.+ Nat.frobnicate - □ 3. #iq58l8umv4 (start of history) + □ 3. #3pq2vvggng (start of history) ``` If we merge that back into `builtin`, we get that same chain of history: @@ -73,21 +73,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. - ⊙ 1. #cb1ngbi7os + ⊙ 1. #4g884gq7lc > Moves: Original name New name Nat.frobnicate Nat.+ - ⊙ 2. #evasbqug8s + ⊙ 2. #hnah4l7s0j > Moves: Original name New name Nat.+ Nat.frobnicate - □ 3. #iq58l8umv4 (start of history) + □ 3. #3pq2vvggng (start of history) ``` Let's try again, but using a `merge.squash` (or just `squash`) instead. The history will be unchanged: @@ -108,7 +108,7 @@ Let's try again, but using a `merge.squash` (or just `squash`) instead. The hist - □ 1. #iq58l8umv4 (start of history) + □ 1. #3pq2vvggng (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. @@ -493,13 +493,13 @@ This checks to see that squashing correctly preserves deletions: Note: The most recent namespace hash is immediately below this message. - ⊙ 1. #272p6p79u5 + ⊙ 1. #jdptkosbfp - Deletes: Nat.* Nat.+ - □ 2. #iq58l8umv4 (start of history) + □ 2. #3pq2vvggng (start of history) ``` Notice that `Nat.+` and `Nat.*` are deleted by the squash, and we see them deleted in one atomic step in the history. diff --git a/unison-src/transcripts/upgrade-happy-path.output.md b/unison-src/transcripts/upgrade-happy-path.output.md index 22b4a1f0b..b627974ef 100644 --- a/unison-src/transcripts/upgrade-happy-path.output.md +++ b/unison-src/transcripts/upgrade-happy-path.output.md @@ -57,7 +57,7 @@ proj/main> upgrade old new proj/main> ls lib - 1. builtin/ (455 terms, 71 types) + 1. builtin/ (456 terms, 71 types) 2. new/ (1 term) proj/main> view thingy From a0eb9a17f4ea10e899a78361ea3c564dab0e6797 Mon Sep 17 00:00:00 2001 From: Arya Irani <538571+aryairani@users.noreply.github.com> Date: Fri, 29 Mar 2024 16:48:40 -0400 Subject: [PATCH 120/124] Update parser-typechecker/src/Unison/Util/Text/Pattern.hs --- parser-typechecker/src/Unison/Util/Text/Pattern.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parser-typechecker/src/Unison/Util/Text/Pattern.hs b/parser-typechecker/src/Unison/Util/Text/Pattern.hs index 29ce6806a..e2c80452a 100644 --- a/parser-typechecker/src/Unison/Util/Text/Pattern.hs +++ b/parser-typechecker/src/Unison/Util/Text/Pattern.hs @@ -12,7 +12,7 @@ data Pattern | Or Pattern Pattern -- left-biased choice: tries second pattern only if first fails | Capture Pattern -- capture all the text consumed by the inner pattern, discarding its subcaptures | CaptureAs Text Pattern -- capture the given text, discarding its subcaptures, and name the capture - | Many Bool Pattern -- zero or more repetitions (at least 1 can be written: Join [p, Many p]); boolean determines whether it works correctly + | Many Bool Pattern -- zero or more repetitions (at least 1 can be written: Join [p, Many p]); boolean determines whether it's the correct version (True) or the original (False). | Replicate Int Int Pattern -- m to n occurrences of a pattern, optional = 0-1 | Eof -- succeed if given the empty text, fail otherwise | Literal Text -- succeed if input starts with the given text, advance by that text From 5a4de510bdef770e101de3d5b16230b435a436c3 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Mon, 1 Apr 2024 16:07:16 -0400 Subject: [PATCH 121/124] Fix a problem with rehashing from scratch files Was causing run.native of terms in a scratch file to fail after the first time. --- parser-typechecker/src/Unison/Runtime/Interface.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/parser-typechecker/src/Unison/Runtime/Interface.hs b/parser-typechecker/src/Unison/Runtime/Interface.hs index 7e43c034a..677dca6bb 100644 --- a/parser-typechecker/src/Unison/Runtime/Interface.hs +++ b/parser-typechecker/src/Unison/Runtime/Interface.hs @@ -363,6 +363,7 @@ performRehash rgrp0 ctx = irs = remap $ intermedRemap ctx f b r | not b, + r `Map.notMember` rgrp0, r <- Map.findWithDefault r r frs, Just r <- Map.lookup r irs = r @@ -757,7 +758,8 @@ prepareEvaluation ppe tm ctx = do pure (backrefAdd rbkr ctx', rgrp, rmn) where (rmn0, frem, rgrp0, rbkr) = intermediateTerm ppe ctx tm - int b r = if b then r else toIntermed ctx r + int b r | b || Map.member r rgrp0 = r + | otherwise = toIntermed ctx r (ctx', rrefs, rgrp) = performRehash ((fmap . overGroupLinks) int rgrp0) From 4f4395fd65c355b8edd043a52de437da544d8d29 Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Mon, 1 Apr 2024 16:12:22 -0400 Subject: [PATCH 122/124] Add a jit test for multiple evaluation from scratch file --- unison-src/builtin-tests/jit-tests.md | 14 +++++++++ unison-src/builtin-tests/jit-tests.output.md | 32 ++++++++++++++++++++ 2 files changed, 46 insertions(+) diff --git a/unison-src/builtin-tests/jit-tests.md b/unison-src/builtin-tests/jit-tests.md index 32e6aee7e..c0470038b 100644 --- a/unison-src/builtin-tests/jit-tests.md +++ b/unison-src/builtin-tests/jit-tests.md @@ -103,3 +103,17 @@ to `Tests.check` and `Tests.checkEqual`). ```ucm .> run.native tests.jit.only ``` + +```unison +foo = do + go : Nat ->{Exception} () + go = cases + 0 -> () + n -> go (decrement n) + go 1000 +``` + +```ucm +.> run.native foo +.> run.native foo +``` diff --git a/unison-src/builtin-tests/jit-tests.output.md b/unison-src/builtin-tests/jit-tests.output.md index 70e7e86ca..b5f353352 100644 --- a/unison-src/builtin-tests/jit-tests.output.md +++ b/unison-src/builtin-tests/jit-tests.output.md @@ -17,3 +17,35 @@ to `Tests.check` and `Tests.checkEqual`). () ``` +```unison +foo = do + go : Nat ->{Exception} () + go = cases + 0 -> () + n -> go (decrement n) + go 1000 +``` + +```ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + foo : '{Exception} () + +``` +```ucm +.> run.native foo + + () + +.> run.native foo + + () + +``` From 7a6757a433044137427c8e5a4f62c2458f382f57 Mon Sep 17 00:00:00 2001 From: dolio Date: Mon, 1 Apr 2024 20:21:30 +0000 Subject: [PATCH 123/124] automatically run ormolu --- parser-typechecker/src/Unison/Runtime/Interface.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/parser-typechecker/src/Unison/Runtime/Interface.hs b/parser-typechecker/src/Unison/Runtime/Interface.hs index 677dca6bb..075698852 100644 --- a/parser-typechecker/src/Unison/Runtime/Interface.hs +++ b/parser-typechecker/src/Unison/Runtime/Interface.hs @@ -758,8 +758,9 @@ prepareEvaluation ppe tm ctx = do pure (backrefAdd rbkr ctx', rgrp, rmn) where (rmn0, frem, rgrp0, rbkr) = intermediateTerm ppe ctx tm - int b r | b || Map.member r rgrp0 = r - | otherwise = toIntermed ctx r + int b r + | b || Map.member r rgrp0 = r + | otherwise = toIntermed ctx r (ctx', rrefs, rgrp) = performRehash ((fmap . overGroupLinks) int rgrp0) From 13ded7d15edd81f8bf66f64055b47791b194ab8a Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Tue, 2 Apr 2024 11:43:39 -0400 Subject: [PATCH 124/124] Fix some inconsistencies in the time functions in the jit Some racket functions return integers and others floating point, so some care is needed to make sure they work. This adds a designated internal unison time rep as well instead of just using the raw value returned by the racket function. --- scheme-libs/racket/unison/core.ss | 7 ++++++ scheme-libs/racket/unison/data.ss | 21 +++++++++++++++++ scheme-libs/racket/unison/io.rkt | 35 +++++++++++++++++++++++------ unison-src/builtin-tests/io-tests.u | 26 +++++++++++++++++++++ 4 files changed, 82 insertions(+), 7 deletions(-) diff --git a/scheme-libs/racket/unison/core.ss b/scheme-libs/racket/unison/core.ss index 2c703eec6..44a4e7e7d 100644 --- a/scheme-libs/racket/unison/core.ss +++ b/scheme-libs/racket/unison/core.ss @@ -407,6 +407,11 @@ (compare-termlink lnl lnr) (lexico-compare envl envr cmp-ty))) +(define (compare-timespec l r) + (comparisons + (compare-num (unison-timespec-sec l) (unison-timespec-sec r)) + (compare-num (unison-timespec-nsec l) (unison-timespec-nsec r)))) + (define (universal-compare l r [cmp-ty #f]) (define (u-proc? v) (or (procedure? v) (unison-closure? v))) @@ -429,6 +434,8 @@ (compare-termlink l r)] [(and (unison-typelink? l) (unison-typelink? r)) (compare-typelink l r)] + [(and (unison-timespec? l) (unison-timespec? r)) + (compare-timespec l r)] [(= 3 (value->category l) (value->category r)) (compare-typelink (pseudo-data-link l) (pseudo-data-link r))] [(= (value->category l) (value->category r)) diff --git a/scheme-libs/racket/unison/data.ss b/scheme-libs/racket/unison/data.ss index 116cf1c90..43621e0b1 100644 --- a/scheme-libs/racket/unison/data.ss +++ b/scheme-libs/racket/unison/data.ss @@ -25,6 +25,7 @@ (struct-out unison-typelink-derived) (struct-out unison-code) (struct-out unison-quote) + (struct-out unison-timespec) define-builtin-link declare-builtin-link @@ -253,6 +254,26 @@ (apply (unison-closure-code clo) (append (unison-closure-env clo) rest))])) +(struct unison-timespec (sec nsec) + #:transparent + #:property prop:equal+hash + (let () + (define (equal-proc tml tmr rec) + (match tml + [(unison-timespec sl nsl) + (match tmr + [(unison-timespec sr nsr) + (and (= sl sr) (= nsl nsr))])])) + + (define ((hash-proc init) tm rec) + (match tm + [(unison-timespec s ns) + (fxxor (fx*/wraparound (rec s) 67) + (fx*/wraparound (rec ns) 71) + (fx*/wraparound init 73))])) + + (list equal-proc (hash-proc 3) (hash-proc 5)))) + (define-syntax (define-builtin-link stx) (syntax-case stx () [(_ name) diff --git a/scheme-libs/racket/unison/io.rkt b/scheme-libs/racket/unison/io.rkt index 6bdfa7f3e..319bc9e7e 100644 --- a/scheme-libs/racket/unison/io.rkt +++ b/scheme-libs/racket/unison/io.rkt @@ -118,17 +118,38 @@ (ref-either-right (inexact->exact (* 1000 (current-inexact-milliseconds))))) (define (threadCPUTime.v1) - (right (current-process-milliseconds (current-thread)))) + (right + (integer->time + (current-process-milliseconds (current-thread))))) + (define (processCPUTime.v1) - (right (current-process-milliseconds 'process))) + (right + (integer->time + (current-process-milliseconds #f)))) + (define (realtime.v1) - (right (current-inexact-milliseconds))) + (right + (float->time + (current-inexact-milliseconds)))) + (define (monotonic.v1) - (right (current-inexact-monotonic-milliseconds))) + (right + (float->time + (current-inexact-monotonic-milliseconds)))) + +(define (integer->time msecs) + (unison-timespec + (truncate (/ msecs 1000)) + (* (modulo msecs 1000) 1000000))) + +(define (float->time msecs) + (unison-timespec + (trunc (/ msecs 1000)) + (trunc (* (flmod msecs 1000.0) 1000000)))) ; -(define (flt f) (fl->exact-integer (fltruncate f))) +(define (trunc f) (inexact->exact (truncate f))) -(define (sec.v1 ts) (flt (/ ts 1000))) +(define sec.v1 unison-timespec-sec) -(define (nsec.v1 ts) (flt (* (flmod ts 1000.0) 1000000))) +(define nsec.v1 unison-timespec-nsec) diff --git a/unison-src/builtin-tests/io-tests.u b/unison-src/builtin-tests/io-tests.u index 7c06fb764..ed4b56b0f 100644 --- a/unison-src/builtin-tests/io-tests.u +++ b/unison-src/builtin-tests/io-tests.u @@ -20,6 +20,9 @@ io.tests = Tests.main do !io.test_isFileOpen !io.test_ready !io.test_now + !io.test_monotonic + !io.test_processCPUTime + !io.test_threadCPUTime !io.test_isSeekable !io.test_handlePosition !io.test_renameDirectory @@ -79,6 +82,29 @@ io.test_now = do else Tests.fail "!now" "now is too small" +io.test_threadCPUTime = do + match !threadCPUTime with + Duration s ns + | (s == +0) && (ns == 0) -> + Tests.pass "!threadCPUTime" + | otherwise -> + Tests.pass "!threadCPUTime" + +io.test_processCPUTime = do + match !processCPUTime with + Duration s ns + | (s == +0) && (ns == 0) -> + Tests.pass "!processCPUTime" + | otherwise -> + Tests.pass "!processCPUTime" + +io.test_monotonic = do + match !Clock.monotonic with + Duration s ns + | (s == +0) && (ns == 0) -> + Tests.pass "!Clock.monotonic" + | otherwise -> + Tests.pass "!Clock.monotonic" io.test_createTempDirectory = do tmp = (createTempDirectory (FilePath "prefix-"))