Merge remote-tracking branch 'origin/trunk' into pchiusano/ormolu_prs

# Conflicts: # parser-typechecker/src/Unison/Runtime/Foreign.hs
2024-09-17 13:27:30 +03:00 · 2023-02-14 09:57:48 -06:00 · 2023-02-14 09:57:48 -06:00 · 7e37991a96
commit 7e37991a96
parent 4bd4eff184 47e5ce7c7d
27 changed files with 2447 additions and 1843 deletions
--- a/parser-typechecker/src/Unison/Builtin.hs
+++ b/parser-typechecker/src/Unison/Builtin.hs
@ -253,7 +253,8 @@ builtinTypesSrc =
    B' "ImmutableArray" CT.Data,
    B' "MutableArray" CT.Data,
    B' "ImmutableByteArray" CT.Data,
-    B' "MutableByteArray" CT.Data
+    B' "MutableByteArray" CT.Data,
+    B' "Char.Class" CT.Data
  ]

 -- rename these to "builtin" later, when builtin means intrinsic as opposed to
@ -665,7 +666,32 @@ builtinsSrc =
    B "Scope.bytearray" . forall1 "s" $ \s ->
      nat --> Type.effect1 () (scopet s) (mbytearrayt (scopet s)),
    B "Scope.bytearrayOf" . forall1 "s" $ \s ->
-      nat --> nat --> Type.effect1 () (scopet s) (mbytearrayt (scopet s))
+      nat --> nat --> Type.effect1 () (scopet s) (mbytearrayt (scopet s)),
+    B "Char.Class.any" charClass,
+    B "Char.Class.not" $ charClass --> charClass,
+    B "Char.Class.and" $ charClass --> charClass --> charClass,
+    B "Char.Class.or" $ charClass --> charClass --> charClass,
+    B "Char.Class.range" $ char --> char --> charClass,
+    B "Char.Class.anyOf" $ list char --> charClass,
+    B "Char.Class.alphanumeric" charClass,
+    B "Char.Class.upper" charClass,
+    B "Char.Class.lower" charClass,
+    B "Char.Class.whitespace" charClass,
+    B "Char.Class.control" charClass,
+    B "Char.Class.printable" charClass,
+    B "Char.Class.mark" charClass,
+    B "Char.Class.number" charClass,
+    B "Char.Class.punctuation" charClass,
+    B "Char.Class.symbol" charClass,
+    B "Char.Class.separator" charClass,
+    B "Char.Class.letter" charClass,
+    B "Char.Class.is" $
+      charClass
+        --> char
+        --> boolean,
+    B
+      "Text.patterns.char"
+      $ charClass --> pat text
  ]
    ++
    -- avoid name conflicts with Universal == < > <= >=
@ -1041,5 +1067,8 @@ stm = Type.effect1 () (Type.ref () Type.stmRef)
 tvar a = Type.ref () Type.tvarRef `app` a
 pat a = Type.ref () Type.patternRef `app` a

+charClass :: Type
+charClass = Type.ref () Type.charClassRef
+
 timeSpec :: Type
 timeSpec = Type.ref () Type.timeSpecRef
--- a/parser-typechecker/src/Unison/Runtime/Builtin.hs
+++ b/parser-typechecker/src/Unison/Runtime/Builtin.hs
@ -153,6 +153,7 @@ import Unison.Runtime.Foreign.Function
 import Unison.Runtime.Stack (Closure)
 import qualified Unison.Runtime.Stack as Closure
 import Unison.Symbol
+import Unison.Type (charRef)
 import qualified Unison.Type as Ty
 import qualified Unison.Util.Bytes as Bytes
 import Unison.Util.EnumContainers as EC
@ -1587,6 +1588,16 @@ wordDirect wordType instr =
  where
    (b1, ub1) = fresh

+-- Nat -> Bool
+boxWordToBool :: Reference -> ForeignOp
+boxWordToBool wordType instr =
+  ([BX, BX],)
+    . TAbss [b1, w1]
+    . unbox w1 wordType uw1
+    $ TLetD result UN (TFOp instr [b1, uw1]) (boolift result)
+  where
+    (b1, w1, uw1, result) = fresh
+
 -- Nat -> Nat -> c
 wordWordDirect :: Reference -> Reference -> ForeignOp
 wordWordDirect word1 word2 instr =
@ -2332,7 +2343,7 @@ declareForeigns = do
    $ \(hs, n) ->
      maybe mempty Bytes.fromArray <$> SYS.recv hs n

-  declareForeign Tracked "IO.kill.impl.v3" boxTo0 $ mkForeignIOF killThread
+  declareForeign Tracked "IO.kill.impl.v3" boxToEF0 $ mkForeignIOF killThread

  declareForeign Tracked "IO.delay.impl.v3" natToEFUnit $
    mkForeignIOF threadDelay
@ -2900,32 +2911,32 @@ declareForeigns = do
  declareForeign Untracked "Text.patterns.literal" boxDirect . mkForeign $
    \txt -> evaluate . TPat.cpattern $ TPat.Literal txt
  declareForeign Untracked "Text.patterns.digit" direct . mkForeign $
-    let v = TPat.cpattern TPat.Digit in \() -> pure v
+    let v = TPat.cpattern (TPat.Char (TPat.CharRange '0' '9')) in \() -> pure v
  declareForeign Untracked "Text.patterns.letter" direct . mkForeign $
-    let v = TPat.cpattern TPat.Letter in \() -> pure v
+    let v = TPat.cpattern (TPat.Char (TPat.CharClass TPat.Letter)) in \() -> pure v
  declareForeign Untracked "Text.patterns.space" direct . mkForeign $
-    let v = TPat.cpattern TPat.Space in \() -> pure v
+    let v = TPat.cpattern (TPat.Char (TPat.CharClass TPat.Whitespace)) in \() -> pure v
  declareForeign Untracked "Text.patterns.punctuation" direct . mkForeign $
-    let v = TPat.cpattern TPat.Punctuation in \() -> pure v
+    let v = TPat.cpattern (TPat.Char (TPat.CharClass TPat.Punctuation)) in \() -> pure v
  declareForeign Untracked "Text.patterns.anyChar" direct . mkForeign $
-    let v = TPat.cpattern TPat.AnyChar in \() -> pure v
+    let v = TPat.cpattern (TPat.Char TPat.Any) in \() -> pure v
  declareForeign Untracked "Text.patterns.eof" direct . mkForeign $
    let v = TPat.cpattern TPat.Eof in \() -> pure v
  let ccd = wordWordDirect Ty.charRef Ty.charRef
  declareForeign Untracked "Text.patterns.charRange" ccd . mkForeign $
-    \(beg, end) -> evaluate . TPat.cpattern $ TPat.CharRange beg end
+    \(beg, end) -> evaluate . TPat.cpattern . TPat.Char $ TPat.CharRange beg end
  declareForeign Untracked "Text.patterns.notCharRange" ccd . mkForeign $
-    \(beg, end) -> evaluate . TPat.cpattern $ TPat.NotCharRange beg end
+    \(beg, end) -> evaluate . TPat.cpattern . TPat.Char . TPat.Not $ TPat.CharRange beg end
  declareForeign Untracked "Text.patterns.charIn" boxDirect . mkForeign $ \ccs -> do
    cs <- for ccs $ \case
      Closure.DataU1 _ _ i -> pure (toEnum i)
      _ -> die "Text.patterns.charIn: non-character closure"
-    evaluate . TPat.cpattern $ TPat.CharIn cs
+    evaluate . TPat.cpattern . TPat.Char $ TPat.CharSet cs
  declareForeign Untracked "Text.patterns.notCharIn" boxDirect . mkForeign $ \ccs -> do
    cs <- for ccs $ \case
      Closure.DataU1 _ _ i -> pure (toEnum i)
      _ -> die "Text.patterns.notCharIn: non-character closure"
-    evaluate . TPat.cpattern $ TPat.NotCharIn cs
+    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
  declareForeign Untracked "Pattern.capture" boxDirect . mkForeign $
@ -2945,6 +2956,32 @@ declareForeigns = do
  declareForeign Untracked "Pattern.isMatch" boxBoxToBool . mkForeign $
    \(TPat.CP _ matcher, input :: Text) -> pure . isJust $ matcher input

+  declareForeign Untracked "Char.Class.any" direct . mkForeign $ \() -> pure TPat.Any
+  declareForeign Untracked "Char.Class.not" boxDirect . mkForeign $ pure . TPat.Not
+  declareForeign Untracked "Char.Class.and" boxBoxDirect . mkForeign $ \(a, b) -> pure $ TPat.Intersect a b
+  declareForeign Untracked "Char.Class.or" boxBoxDirect . mkForeign $ \(a, b) -> pure $ TPat.Union a b
+  declareForeign Untracked "Char.Class.range" (wordWordDirect charRef charRef) . mkForeign $ \(a, b) -> pure $ TPat.CharRange a b
+  declareForeign Untracked "Char.Class.anyOf" boxDirect . mkForeign $ \ccs -> do
+    cs <- for ccs $ \case
+      Closure.DataU1 _ _ i -> pure (toEnum i)
+      _ -> die "Text.patterns.charIn: non-character closure"
+    evaluate $ TPat.CharSet cs
+  declareForeign Untracked "Char.Class.alphanumeric" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.AlphaNum)
+  declareForeign Untracked "Char.Class.upper" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Upper)
+  declareForeign Untracked "Char.Class.lower" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Lower)
+  declareForeign Untracked "Char.Class.whitespace" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Whitespace)
+  declareForeign Untracked "Char.Class.control" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Control)
+  declareForeign Untracked "Char.Class.printable" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Printable)
+  declareForeign Untracked "Char.Class.mark" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.MarkChar)
+  declareForeign Untracked "Char.Class.number" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Number)
+  declareForeign Untracked "Char.Class.punctuation" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Punctuation)
+  declareForeign Untracked "Char.Class.symbol" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Symbol)
+  declareForeign Untracked "Char.Class.separator" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Separator)
+  declareForeign Untracked "Char.Class.letter" direct . mkForeign $ \() -> pure (TPat.CharClass TPat.Letter)
+  declareForeign Untracked "Char.Class.is" (boxWordToBool charRef) . mkForeign $ \(cl, c) -> evaluate $ TPat.charPatternPred cl c
+  declareForeign Untracked "Text.patterns.char" boxDirect . mkForeign $ \c ->
+    let v = TPat.cpattern (TPat.Char c) in pure v
+
 type RW = PA.PrimState IO

 checkedRead ::
--- a/parser-typechecker/src/Unison/Runtime/Foreign.hs
+++ b/parser-typechecker/src/Unison/Runtime/Foreign.hs
@ -1,5 +1,6 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE PatternGuards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@ -36,7 +37,7 @@ import Unison.Symbol (Symbol)
 import qualified Unison.Type as Ty
 import Unison.Util.Bytes (Bytes)
 import Unison.Util.Text (Text)
-import Unison.Util.Text.Pattern (CPattern)
+import Unison.Util.Text.Pattern (CPattern, CharPattern)
 import Unsafe.Coerce

 data Foreign where
@ -111,6 +112,14 @@ cpatCmp :: CPattern -> CPattern -> Ordering
 cpatCmp l r = compare l r
 {-# NOINLINE cpatCmp #-}

+charClassEq :: CharPattern -> CharPattern -> Bool
+charClassEq l r = l == r
+{-# NOINLINE charClassEq #-}
+
+charClassCmp :: CharPattern -> CharPattern -> Ordering
+charClassCmp = compare
+{-# NOINLINE charClassCmp #-}
+
 tylEq :: Reference -> Reference -> Bool
 tylEq r l = r == l
 {-# NOINLINE tylEq #-}
@ -144,6 +153,7 @@ ref2eq r
  | r == Ty.mbytearrayRef = Just $ promote mbarrEq
  | r == Ty.ibytearrayRef = Just $ promote barrEq
  | r == Ty.patternRef = Just $ promote cpatEq
+  | r == Ty.charClassRef = Just $ promote charClassEq
  | otherwise = Nothing

 ref2cmp :: Reference -> Maybe (a -> b -> Ordering)
@ -155,6 +165,7 @@ ref2cmp r
  | r == Ty.threadIdRef = Just $ promote tidCmp
  | r == Ty.ibytearrayRef = Just $ promote barrCmp
  | r == Ty.patternRef = Just $ promote cpatCmp
+  | r == Ty.charClassRef = Just $ promote charClassCmp
  | otherwise = Nothing

 instance Eq Foreign where
@ -194,7 +205,9 @@ maybeUnwrapForeign rt (Wrap r e)
 class BuiltinForeign f where
  foreignRef :: Tagged f Reference

-instance BuiltinForeign Text where foreignRef = Tagged Ty.textRef
+instance BuiltinForeign Text where
+  foreignRef :: Tagged Text Reference
+  foreignRef = Tagged Ty.textRef

 instance BuiltinForeign Bytes where foreignRef = Tagged Ty.bytesRef

@ -227,7 +240,7 @@ instance BuiltinForeign TimeSpec where foreignRef = Tagged Ty.timeSpecRef

 data HashAlgorithm where
  -- Reference is a reference to the hash algorithm
-  HashAlgorithm :: (Hash.HashAlgorithm a) => Reference -> a -> HashAlgorithm
+  HashAlgorithm :: Hash.HashAlgorithm a => Reference -> a -> HashAlgorithm

 newtype Tls = Tls TLS.Context

@ -238,15 +251,18 @@ instance BuiltinForeign HashAlgorithm where foreignRef = Tagged Ty.hashAlgorithm
 instance BuiltinForeign CPattern where
  foreignRef = Tagged Ty.patternRef

-wrapBuiltin :: forall f. (BuiltinForeign f) => f -> Foreign
+instance BuiltinForeign CharPattern where
+  foreignRef = Tagged Ty.charClassRef
+
+wrapBuiltin :: forall f. BuiltinForeign f => f -> Foreign
 wrapBuiltin x = Wrap r x
  where
    Tagged r = foreignRef :: Tagged f Reference

-unwrapBuiltin :: (BuiltinForeign f) => Foreign -> f
+unwrapBuiltin :: BuiltinForeign f => Foreign -> f
 unwrapBuiltin (Wrap _ x) = unsafeCoerce x

-maybeUnwrapBuiltin :: forall f. (BuiltinForeign f) => Foreign -> Maybe f
+maybeUnwrapBuiltin :: forall f. BuiltinForeign f => Foreign -> Maybe f
 maybeUnwrapBuiltin (Wrap r x)
  | r == r0 = Just (unsafeCoerce x)
  | otherwise = Nothing
--- a/parser-typechecker/src/Unison/Util/Text/Pattern.hs
+++ b/parser-typechecker/src/Unison/Util/Text/Pattern.hs
@ -2,7 +2,7 @@

 module Unison.Util.Text.Pattern where

-import Data.Char (isDigit, isLetter, isPunctuation, isSpace)
+import Data.Char (isAlphaNum, isControl, isLetter, isLower, isMark, isNumber, isPrint, isPunctuation, isSeparator, isSpace, isSymbol, isUpper)
 import qualified Data.Text as DT
 import Unison.Util.Text (Text)
 import qualified Unison.Util.Text as Text
@ -13,18 +13,35 @@ data Pattern
  | Capture Pattern -- capture all the text consumed by the inner pattern, discarding its subcaptures
  | Many Pattern -- zero or more repetitions (at least 1 can be written: Join [p, Many p])
  | Replicate Int Int Pattern -- m to n occurrences of a pattern, optional = 0-1
-  | AnyChar -- consume a single char
  | Eof -- succeed if given the empty text, fail otherwise
  | Literal Text -- succeed if input starts with the given text, advance by that text
-  | CharRange Char Char -- consume 1 char in the given range, or fail
-  | CharIn [Char] -- consume 1 char in the given set, or fail
-  | NotCharIn [Char] -- consume 1 char NOT in the given set, or fail
-  | NotCharRange Char Char -- consume 1 char NOT in the given range, or fail
-  | Digit -- consume 1 digit (according to Char.isDigit)
-  | Letter -- consume 1 letter (according to Char.isLetter)
-  | Space -- consume 1 space character (according to Char.isSpace)
-  | Punctuation -- consume 1 punctuation char (according to Char.isPunctuation)
-  deriving (Eq, Ord)
+  | Char CharPattern -- succeed if input starts with a char matching the given pattern, advance by 1 char
+  deriving (Show, Eq, Ord)
+
+data CharPattern
+  = Any -- any char
+  | Not CharPattern -- negation of the given pattern
+  | Union CharPattern CharPattern -- match if either pattern matches
+  | Intersect CharPattern CharPattern -- match if both patterns match
+  | CharRange Char Char -- match if char is in the given range
+  | CharSet [Char] -- match if char is in the given set
+  | CharClass CharClass -- match if char is in the given class
+  deriving (Show, Eq, Ord)
+
+data CharClass
+  = AlphaNum -- alphabetic or numeric characters
+  | Upper -- uppercase alphabetic characters
+  | Lower -- lowercase alphabetic characters
+  | Whitespace -- whitespace characters (space, tab, newline, etc.)
+  | Control -- non-printing control characters
+  | Printable -- letters, numbers, punctuation, symbols, spaces
+  | MarkChar -- accents, diacritics, etc.
+  | Number -- numeric characters in any script
+  | Punctuation -- connectors, brackets, quotes
+  | Symbol -- symbols (math, currency, etc.)
+  | Separator -- spaces, line separators, paragraph separators
+  | Letter -- letters in any script
+  deriving (Show, Eq, Ord)

 -- Wrapper type. Holds a pattern together with its compilation. This is used as
 -- the semantic value of a unison `Pattern a`. Laziness avoids building the
@ -98,13 +115,13 @@ compile (Literal txt) !err !success = go
    go acc t
      | Text.take (Text.size txt) t == txt = success acc (Text.drop (Text.size txt) t)
      | otherwise = err acc t
-compile AnyChar !err !success = go
+compile (Char Any) !err !success = go
  where
    go acc t = case Text.drop 1 t of
      rem
        | Text.size t > Text.size rem -> success acc rem
        | otherwise -> err acc rem
-compile (Capture (Many AnyChar)) !_ !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
@ -122,38 +139,15 @@ compile (Join ps) !err !success = go ps
      let pc = compile p err psc
          psc = compile (Join ps) err success
       in pc
-compile (NotCharIn cs) !err !success = go
+compile (Char cp) !err !success = go
  where
-    ok = charNotInPred cs
+    ok = charPatternPred cp
    go acc t = case Text.uncons t of
      Just (ch, rem) | ok ch -> success acc rem
      _ -> err acc t
-compile (CharIn cs) !err !success = go
-  where
-    ok = charInPred cs
-    go acc t = case Text.uncons t of
-      Just (ch, rem) | ok ch -> success acc rem
-      _ -> err acc t
-compile (CharRange c1 c2) !err !success = go
-  where
-    go acc t = case Text.uncons t of
-      Just (ch, rem) | ch >= c1 && ch <= c2 -> success acc rem
-      _ -> err acc t
-compile (NotCharRange c1 c2) !err !success = go
-  where
-    go acc t = case Text.uncons t of
-      Just (ch, rem) | not (ch >= c1 && ch <= c2) -> success acc rem
-      _ -> err acc t
 compile (Many p) !_ !success = case p of
-  AnyChar -> (\acc _ -> success acc Text.empty)
-  CharIn cs -> walker (charInPred cs)
-  NotCharIn cs -> walker (charNotInPred cs)
-  CharRange c1 c2 -> walker (\ch -> ch >= c1 && ch <= c2)
-  NotCharRange c1 c2 -> walker (\ch -> ch < c1 || ch > c2)
-  Digit -> walker isDigit
-  Letter -> walker isLetter
-  Punctuation -> walker isPunctuation
-  Space -> walker isSpace
+  Char Any -> (\acc _ -> success acc Text.empty)
+  Char cp -> walker (charPatternPred cp)
  p -> go
    where
      go = compile p success success'
@ -169,25 +163,18 @@ compile (Many p) !_ !success = case p of
            rem
              | DT.null rem -> go acc t
              | otherwise ->
-                  -- moving the remainder to the root of the tree is much more efficient
-                  -- since the next uncons will be O(1) rather than O(log n)
-                  -- this can't unbalance the tree too badly since these promoted chunks
-                  -- are being consumed and will get removed by a subsequent uncons
-                  success acc (Text.appendUnbalanced (Text.fromText rem) t)
+                -- moving the remainder to the root of the tree is much more efficient
+                -- since the next uncons will be O(1) rather than O(log n)
+                -- this can't unbalance the tree too badly since these promoted chunks
+                -- are being consumed and will get removed by a subsequent uncons
+                success acc (Text.appendUnbalanced (Text.fromText rem) t)
    {-# INLINE walker #-}
 compile (Replicate m n p) !err !success = case p of
-  AnyChar -> \acc t ->
+  Char Any -> \acc t ->
    if Text.size t < m
      then err acc t
      else success acc (Text.drop n t)
-  CharIn cs -> dropper (charInPred cs)
-  NotCharIn cs -> dropper (charNotInPred cs)
-  CharRange c1 c2 -> dropper (\ch -> ch >= c1 && c1 <= c2)
-  NotCharRange c1 c2 -> dropper (\ch -> ch < c1 || ch > c2)
-  Digit -> dropper isDigit
-  Letter -> dropper isLetter
-  Punctuation -> dropper isPunctuation
-  Space -> dropper isSpace
+  Char cp -> dropper (charPatternPred cp)
  _ -> try "Replicate" (go1 m) err (go2 (n - m))
  where
    go1 0 = \_err success stk rem -> success stk rem
@ -198,26 +185,6 @@ compile (Replicate m n p) !err !success = case p of
    dropper ok acc t
      | (i, rest) <- Text.dropWhileMax ok n t, i >= m = success acc rest
      | otherwise = err acc t
-compile Digit !err !success = go
-  where
-    go acc t = case Text.uncons t of
-      Just (ch, rem) | isDigit ch -> success acc rem
-      _ -> err acc t
-compile Letter !err !success = go
-  where
-    go acc t = case Text.uncons t of
-      Just (ch, rem) | isLetter ch -> success acc rem
-      _ -> err acc t
-compile Punctuation !err !success = go
-  where
-    go acc t = case Text.uncons t of
-      Just (ch, rem) | isPunctuation ch -> success acc rem
-      _ -> err acc t
-compile Space !err !success = go
-  where
-    go acc t = case Text.uncons t of
-      Just (ch, rem) | isSpace ch -> success acc rem
-      _ -> err acc t

 charInPred, charNotInPred :: [Char] -> Char -> Bool
 charInPred [] = const False
@ -225,6 +192,29 @@ charInPred (c : chs) = let ok = charInPred chs in \ci -> ci == c || ok ci
 charNotInPred [] = const True
 charNotInPred (c : chs) = let ok = charNotInPred chs in (\ci -> ci /= c && ok ci)

+charPatternPred :: CharPattern -> Char -> Bool
+charPatternPred Any = const True
+charPatternPred (Not cp) = let notOk = charPatternPred cp in \ci -> not (notOk ci)
+charPatternPred (Union cp1 cp2) = let ok1 = charPatternPred cp1; ok2 = charPatternPred cp2 in \ci -> ok1 ci || ok2 ci
+charPatternPred (Intersect cp1 cp2) = let ok1 = charPatternPred cp1; ok2 = charPatternPred cp2 in \ci -> ok1 ci && ok2 ci
+charPatternPred (CharRange c1 c2) = \ci -> ci >= c1 && ci <= c2
+charPatternPred (CharSet cs) = charInPred cs
+charPatternPred (CharClass cc) = charClassPred cc
+
+charClassPred :: CharClass -> Char -> Bool
+charClassPred AlphaNum = isAlphaNum
+charClassPred Upper = isUpper
+charClassPred Lower = isLower
+charClassPred Whitespace = isSpace
+charClassPred Control = isControl
+charClassPred Printable = isPrint
+charClassPred MarkChar = isMark
+charClassPred Number = isNumber
+charClassPred Punctuation = isPunctuation
+charClassPred Symbol = isSymbol
+charClassPred Separator = isSeparator
+charClassPred Letter = isLetter
+
 -- runs c and if it fails, restores state to what it was before
 try :: String -> Compiled r -> Compiled r
 try msg c err success stk rem =
--- a/parser-typechecker/tests/Unison/Test/Util/Text.hs
+++ b/parser-typechecker/tests/Unison/Test/Util/Text.hs
@ -4,6 +4,7 @@ module Unison.Test.Util.Text where

 import Control.Monad
 import Data.List (foldl', unfoldr)
+import Data.Maybe (isNothing)
 import qualified Data.Text as T
 import EasyTest
 import qualified Unison.Util.Rope as R
@ -104,36 +105,36 @@ test =
        ok,
      scope "patterns" $ do
        expect' (P.run P.Eof "" == Just ([], ""))
-        expect' (P.run P.AnyChar "a" == Just ([], ""))
-        expect' (P.run (P.CharRange 'a' 'z') "a" == Just ([], ""))
-        expect' (P.run (P.NotCharRange 'a' 'z') "a" == Nothing)
-        expect' (P.run (P.Or (P.NotCharRange 'a' 'z') P.AnyChar) "abc" == Just ([], "bc"))
+        expect' (P.run (P.Char P.Any) "a" == Just ([], ""))
+        expect' (P.run (P.Char (P.CharRange 'a' 'z')) "a" == Just ([], ""))
+        expect' . isNothing $ P.run (P.Char (P.Not (P.CharRange 'a' 'z'))) "a"
+        expect' (P.run (P.Or (P.Char (P.Not (P.CharRange 'a' 'z'))) (P.Char P.Any)) "abc" == Just ([], "bc"))
        -- this shows that we ignore subcaptures
-        expect' (P.run (P.Join [P.Capture (P.Join [P.Capture P.AnyChar, P.Capture P.AnyChar]), P.AnyChar]) "abcdef" == Just (["ab"], "def"))
-        expect' (P.run (P.CharIn "0123") "3ab" == Just ([], "ab"))
-        expect' (P.run (P.NotCharIn "0123") "a3b" == Just ([], "3b"))
-        expect' (P.run (P.Capture (P.NotCharIn "0123")) "a3b" == Just (["a"], "3b"))
-        expect' (P.run (P.Many (P.CharIn "abcd")) "babbababac123" == Just ([], "123"))
-        expect' (P.run (P.Capture (P.Many (P.CharIn "abcd"))) "babbababac123" == Just (["babbababac"], "123"))
-        expect' (P.run (P.Capture (P.Many (P.Digit))) "012345abc" == Just (["012345"], "abc"))
-        expect' (P.run (P.Join [P.Capture (P.Many (P.Digit)), P.Literal ",", P.Capture (P.Many P.AnyChar)]) "012345,abc" == Just (["012345", "abc"], ""))
+        expect' (P.run (P.Join [P.Capture (P.Join [P.Capture (P.Char P.Any), P.Capture (P.Char P.Any)]), P.Char P.Any]) "abcdef" == Just (["ab"], "def"))
+        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 (P.Join [P.Capture (P.Many (P.Digit)), P.Many P.Space])) "01 10 20 1123 292 110 10"
+          ( 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"
              == Just (["01", "10", "20", "1123", "292", "110", "10"], "")
          )
        expect' $
-          let part = P.Capture (P.Replicate 1 3 (P.Digit))
+          let part = P.Capture (P.Replicate 1 3 (P.Char (P.CharClass P.Number)))
              dpart = P.Join [P.Literal ".", part]
              ip = P.Join [part, P.Replicate 3 3 dpart, P.Eof]
           in P.run ip "127.0.0.1" == Just (["127", "0", "0", "1"], "")
        expect' $
-          let p = P.Replicate 5 8 (P.Capture P.Digit)
+          let p = P.Replicate 5 8 (P.Capture (P.Char (P.CharClass P.Number)))
           in P.run p "12345" == Just (["1", "2", "3", "4", "5"], "")
        expect' $
-          let p = P.Replicate 5 8 (P.Capture P.Digit) `P.Or` P.Join []
+          let p = P.Replicate 5 8 (P.Capture (P.Char (P.CharClass P.Number))) `P.Or` P.Join []
           in P.run p "1234" == Just ([], "1234")
        expect' $
-          let p = P.Replicate 5 8 (P.Capture (P.Join [P.Digit, P.Literal "z"])) `P.Or` P.Join []
+          let p = P.Replicate 5 8 (P.Capture (P.Join [P.Char (P.CharClass P.Number), P.Literal "z"])) `P.Or` P.Join []
           in P.run p "1z2z3z4z5z6a" == Just (["1z", "2z", "3z", "4z", "5z"], "6a")
        -- https://github.com/unisonweb/unison/issues/3530
        expectEqual Nothing $
@ -156,10 +157,10 @@ test =
        -- this is just making sure we don't duplicate captures to our left
        -- when entering an `Or` node
        expectEqual (Just (["@"], "")) $
-          let p = P.Join [P.Capture P.AnyChar, P.Or (P.Literal "c") (P.Join []), P.Literal "d"]
+          let p = P.Join [P.Capture (P.Char P.Any), P.Or (P.Literal "c") (P.Join []), P.Literal "d"]
           in P.run p "@cd"
        expectEqual (Just (["%", "c"], "")) $
-          let p = P.Join [P.Capture P.AnyChar, (P.Or (P.Capture (P.Literal "c")) (P.Join [])), P.Literal "d"]
+          let p = P.Join [P.Capture (P.Char P.Any), (P.Or (P.Capture (P.Literal "c")) (P.Join [])), P.Literal "d"]
           in P.run p "%cd"
        expectEqual (Just ([""], "ac")) $
          let p = P.Capture (P.Or (P.Join [P.Literal "a", P.Literal "b"]) (P.Join []))
--- a/scheme-libs/chez/unison/concurrent.ss
+++ b/scheme-libs/chez/unison/concurrent.ss
@ -0,0 +1,29 @@
+(library (unison concurrent)
+  (export
+    ref-new
+    ref-read
+    ref-write
+    ref-cas
+    promise-new
+    promise-read
+    promise-write
+    promise-try-read
+    fork
+    kill
+    sleep)
+
+
+  (define err "This operation is not supported on the pure Chez Scheme
+backend, use the Racket over Chez Scheme backend")
+
+  ;; TODO feels like there is a macro waiting to happen here
+  (define (ref-new a) (error err))
+  (define (ref-read ref) (error err))
+  (define (ref-write ref a) (error err))
+  (define (ref-cas ref old-value new-value) (error err))
+  (define (promise-new) (error err))
+  (define (promise-read promise) (error err))
+  (define (promise-try-read promise) (error err))
+  (define (fork thread-thunk) (error err))
+  (define (kill thread-id) (error err)))
+  
--- a/scheme-libs/common/unison/data.ss
+++ b/scheme-libs/common/unison/data.ss
@ -0,0 +1,63 @@
+;; Helpers for building data that conform to the compiler calling convention
+
+#!r6rs
+(library (unison data)
+  (export
+   some
+   none
+   some?
+   none?
+   option-get
+   right
+   left
+   right?
+   left?
+   either-get
+   either-get
+   unit
+   false
+   true)
+
+  (import (rnrs))
+
+  ; Option a
+  (define none `(0))
+
+  ; a -> Option a
+  (define (some a) `(1 ,a))
+
+  ; Option a -> Bool
+  (define (some? option) (eq? 1 (car option)))
+
+  ; Option a -> Bool
+  (define (none? option) (eq? 0 (car option)))
+
+  ; Option a -> a (or #f)
+  (define (option-get option)
+    (if
+     (some? option)
+     (car (cdr option))
+     (raise "Cannot get the value of an empty option ")))
+
+  ; #<void> works as well
+  ; Unit
+  (define unit `(0))
+
+  ; Booleans are represented as numbers
+  (define false 0)
+  (define true 1)
+
+  ; a -> Either b a
+  (define (right a) `(1 ,a))
+
+  ; b -> Either b a
+  (define (left b) `(0 ,b))
+
+  ; Either a b -> Boolean
+  (define (right? either) (eq? 1 (car either)))
+
+  ; Either a b -> Boolean
+  (define (left? either) (eq? 0 (car either)))
+
+  ; Either a b -> a | b
+  (define (either-get either) (car (cdr either))))
--- a/scheme-libs/common/unison/primops.ss
+++ b/scheme-libs/common/unison/primops.ss
@ -56,6 +56,23 @@

    unison-FOp-Scope.bytearray
    unison-FOp-Scope.array
+    unison-FOp-Scope.ref
+
+    unison-FOp-IO.ref
+    unison-FOp-Ref.read
+    unison-FOp-Ref.write
+    unison-FOp-Ref.readForCas
+    unison-FOp-Ref.Ticket.read
+    unison-FOp-Ref.cas
+
+    unison-FOp-Promise.new
+    unison-FOp-Promise.read
+    unison-FOp-Promise.tryRead
+    unison-FOp-Promise.write
+
+    unison-FOp-IO.delay.impl.v3
+    unison-POp-FORK
+    unison-FOp-IO.kill.impl.v3

    unison-POp-ADDN
    unison-POp-ANDN
@ -129,7 +146,8 @@
          (unison string)
          (unison crypto)
          (unison bytevector)
-          (unison vector))
+          (unison vector)
+          (unison concurrent))

  (define unison-POp-UPKB bytevector->u8-list)
  (define unison-POp-ADDI +)
@ -308,5 +326,18 @@
  (define (unison-FOp-Scope.bytearray n) (make-bytevector n))
  (define (unison-FOp-Scope.array n) (make-vector n))

-  )
+  (define (unison-POp-FORK thunk) (fork thunk))
+  (define (unison-FOp-IO.delay.impl.v3 micros) (sleep micros))
+  (define (unison-FOp-IO.kill.impl.v3 threadId) (kill threadId))
+  (define (unison-FOp-Scope.ref a) (ref-new a))
+  (define (unison-FOp-IO.ref a) (ref-new a))
+  (define (unison-FOp-Ref.read ref) (ref-read ref))
+  (define (unison-FOp-Ref.write ref a) (ref-write ref a))
+  (define (unison-FOp-Ref.readForCas ref) (ref-read ref))
+  (define (unison-FOp-Ref.Ticket.read ticket) ticket)
+  (define (unison-FOp-Ref.cas ref ticket value) (ref-cas ref ticket value))
+  (define (unison-FOp-Promise.new) (promise-new))
+  (define (unison-FOp-Promise.read promise) (promise-read promise))
+  (define (unison-FOp-Promise.tryRead promise) (promise-try-read promise))
+  (define (unison-FOp-Promise.write promise a) (promise-write promise a)))

--- a/scheme-libs/racket/unison/concurrent.ss
+++ b/scheme-libs/racket/unison/concurrent.ss
@ -0,0 +1,89 @@
+#!r6rs
+
+(library (unison concurrent)
+  (export
+    ref-new
+    ref-read
+    ref-write
+    ref-cas
+    promise-new
+    promise-read
+    promise-write
+    promise-try-read
+    fork
+    kill
+    sleep)
+
+  (import (rnrs)
+          (rnrs records syntactic)
+          (unison data)
+          (rename
+           (only (racket base)
+                 box
+                 unbox
+                 set-box!
+                 box-cas!
+                 make-semaphore
+                 semaphore-peek-evt
+                 semaphore-post
+                 sync/enable-break
+                 thread
+                 break-thread
+                 parameterize-break
+                 sleep
+                 printf
+                 exn:break?
+                 with-handlers)
+           (box ref-new)
+           (unbox ref-read)
+           (set-box! ref-write)
+           (sleep sleep-secs))
+          (only (racket unsafe ops) unsafe-struct*-cas!)
+          (unison data))
+
+  (define-record-type promise (fields semaphore event (mutable value)))
+
+  (define (promise-new)
+    (let* ([sem (make-semaphore)]
+           [evt (semaphore-peek-evt sem)]
+           [value none])
+      (make-promise sem evt value)))
+
+  (define (promise-try-read promise) (promise-value promise))
+
+  (define (promise-read promise)
+    (let loop ()
+      (let ([value (promise-value promise)])
+        (cond
+          [(some? value) (option-get value)]
+          [else (sync/enable-break (promise-event promise)) (loop)]))))
+
+  (define (promise-write promise new-value)
+    (let loop ()
+      (let* ([value (promise-value promise)]
+             [cas! (lambda () (unsafe-struct*-cas! promise 2 value (some new-value)))]
+             [awake-readers (lambda () (semaphore-post (promise-semaphore promise)))])
+        (cond
+          [(some? value) false]
+          [else
+           (let ([ok (parameterize-break #f (if (cas!) (awake-readers) false))])
+             (if ok true (loop)))]))))
+
+  (define (ref-cas ref ticket value)
+    (if (box-cas! ref ticket value) true false))
+
+  (define (sleep n)
+    (sleep-secs (/ n 1000000))
+    (right unit))
+
+  ;; Swallows uncaught breaks/thread kills rather than logging them to
+  ;; match the behaviour of the Haskell runtime
+  (define (fork thunk)
+    (thread
+     (lambda ()
+       (with-handlers ([exn:break? (lambda (x) ())])
+         (thunk)))))
+
+  (define (kill threadId)
+    (break-thread threadId)
+    (right unit)))
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
@ -36,8 +36,14 @@ import System.Directory
    getXdgDirectory,
  )
 import System.Environment (withArgs)
+import System.Exit (ExitCode (..))
 import System.FilePath ((</>))
-import System.Process (callProcess, readCreateProcess, shell)
+import System.Process
+  ( callProcess,
+    readCreateProcess,
+    readCreateProcessWithExitCode,
+    shell,
+  )
 import qualified Text.Megaparsec as P
 import qualified U.Codebase.Branch.Diff as V2Branch
 import qualified U.Codebase.Causal as V2Causal
@ -2661,7 +2667,7 @@ doFetchCompiler =
    ns =
      ReadShareRemoteNamespace
        { server = RemoteRepo.DefaultCodeserver,
-          repo = ShareUserHandle "dolio",
+          repo = ShareUserHandle "unison",
          path =
            Path.fromList $ NameSegment <$> ["public", "internal", "trunk"]
        }
@ -2743,37 +2749,51 @@ typecheckAndEval ppe tm = do
    a = External
    rendered = P.toPlainUnbroken $ TP.pretty ppe tm

-ensureSchemeExists :: Cli ()
-ensureSchemeExists =
+ensureSchemeExists :: SchemeBackend -> Cli ()
+ensureSchemeExists bk =
  liftIO callScheme >>= \case
    True -> pure ()
    False -> Cli.returnEarly (PrintMessage msg)
  where
-    msg =
-      P.lines
-        [ "I can't seem to call scheme. See",
-          "",
-          P.indentN
-            2
-            "https://github.com/cisco/ChezScheme/blob/main/BUILDING",
-          "",
-          "for how to install Chez Scheme."
-        ]
+    msg = case bk of
+      Racket ->
+        P.lines
+          [ "I can't seem to call racket. See",
+            "",
+            P.indentN
+              2
+              "https://download.racket-lang.org/",
+            "",
+            "for how to install Racket."
+          ]
+      Chez ->
+        P.lines
+          [ "I can't seem to call scheme. See",
+            "",
+            P.indentN
+              2
+              "https://github.com/cisco/ChezScheme/blob/main/BUILDING",
+            "",
+            "for how to install Chez Scheme."
+          ]

+    cmd = case bk of
+      Racket -> "racket -l- raco help"
+      Chez -> "scheme -q"
    callScheme =
-      catch
-        (True <$ readCreateProcess (shell "scheme -q") "")
-        (\(_ :: IOException) -> pure False)
+      readCreateProcessWithExitCode (shell cmd) "" >>= \case
+        (ExitSuccess, _, _) -> pure True
+        (ExitFailure _, _, _) -> pure False

-racketOpts :: FilePath -> FilePath -> FilePath -> [String] -> [String]
-racketOpts gendir statdir file args = libs ++ [file] ++ args
+racketOpts :: FilePath -> FilePath -> [String] -> [String]
+racketOpts gendir statdir args = libs ++ args
  where
    includes = [gendir, statdir </> "common", statdir </> "racket"]
    libs = concatMap (\dir -> ["-S", dir]) includes

-chezOpts :: FilePath -> FilePath -> FilePath -> [String] -> [String]
-chezOpts gendir statdir file args =
-  "-q" : opt ++ libs ++ ["--script", file] ++ args
+chezOpts :: FilePath -> FilePath -> [String] -> [String]
+chezOpts gendir statdir args =
+  "-q" : opt ++ libs ++ ["--script"] ++ args
  where
    includes = [gendir, statdir </> "common", statdir </> "chez"]
    libs = ["--libdirs", List.intercalate ":" includes]
@ -2782,14 +2802,14 @@ chezOpts gendir statdir file args =
 data SchemeBackend = Racket | Chez

 runScheme :: SchemeBackend -> String -> [String] -> Cli ()
-runScheme bk file args0 = do
-  ensureSchemeExists
+runScheme bk file args = do
+  ensureSchemeExists bk
  gendir <- getSchemeGenLibDir
  statdir <- getSchemeStaticLibDir
  let cmd = case bk of Racket -> "racket"; Chez -> "scheme"
      opts = case bk of
-        Racket -> racketOpts gendir statdir file args0
-        Chez -> chezOpts gendir statdir file args0
+        Racket -> racketOpts gendir statdir (file : args)
+        Chez -> chezOpts gendir statdir (file : args)
  success <-
    liftIO $
      (True <$ callProcess cmd opts)
@ -2797,11 +2817,28 @@ runScheme bk file args0 = do
  unless success $
    Cli.returnEarly (PrintMessage "Scheme evaluation failed.")

-buildChez :: String -> String -> Cli ()
-buildChez main file = do
-  ensureSchemeExists
+buildScheme :: SchemeBackend -> String -> String -> Cli ()
+buildScheme bk main file = do
+  ensureSchemeExists bk
  statDir <- getSchemeStaticLibDir
  genDir <- getSchemeGenLibDir
+  build genDir statDir main file
+  where
+    build
+      | Racket <- bk = buildRacket
+      | Chez <- bk = buildChez
+
+buildRacket :: String -> String -> String -> String -> Cli ()
+buildRacket genDir statDir main file =
+  let args = ["-l", "raco", "--", "exe", "-o", main, file]
+      opts = racketOpts genDir statDir args
+   in void . liftIO $
+        catch
+          (True <$ callProcess "racket" opts)
+          (\(_ :: IOException) -> pure False)
+
+buildChez :: String -> String -> String -> String -> Cli ()
+buildChez genDir statDir main file = do
  let cmd = shell "scheme -q --optimize-level 3"
  void . liftIO $ readCreateProcess cmd (build statDir genDir)
  where
@ -2830,7 +2867,7 @@ doRunAsScheme main args = do

 doCompileScheme :: String -> HQ.HashQualified Name -> Cli ()
 doCompileScheme out main =
-  generateSchemeFile False out main >>= buildChez out
+  generateSchemeFile True out main >>= buildScheme Racket out

 generateSchemeFile :: Bool -> String -> HQ.HashQualified Name -> Cli String
 generateSchemeFile exec out main = do
--- a/unison-core/src/Unison/Type.hs
+++ b/unison-core/src/Unison/Type.hs
@ -293,6 +293,9 @@ stmRef = Reference.Builtin "STM"
 patternRef :: Reference
 patternRef = Reference.Builtin "Pattern"

+charClassRef :: Reference
+charClassRef = Reference.Builtin "Char.Class"
+
 tlsClientConfigRef :: Reference
 tlsClientConfigRef = Reference.Builtin "Tls.ClientConfig"

@ -641,7 +644,7 @@ removePureEffects :: (ABT.Var v) => Type v a -> Type v a
 removePureEffects t
  | not Settings.removePureEffects = t
  | otherwise =
-      generalize vs $ removeEffectVars fvs tu
+    generalize vs $ removeEffectVars fvs tu
  where
    (vs, tu) = unforall' t
    vss = Set.fromList vs
--- a/unison-src/builtin-tests/concurrency-tests.u
+++ b/unison-src/builtin-tests/concurrency-tests.u
@ -0,0 +1,127 @@
+concurrency.tests = Tests.main do
+  !simpleRefTest
+  !simpleRefTestScope
+  !ticketTest
+  !casTest
+  !promiseSequentialTest
+  !promiseConcurrentTest
+  !forkKillTest
+  --  !tryEvalForkTest
+  !fullTest
+
+simpleRefTest = do
+  r = IO.ref 0
+  Ref.write r 1
+  i = Ref.read r
+  Ref.write r 2
+  j = Ref.read r
+  Ref.write r 5
+  checkEqual "Ref read-write"  (i, j, Ref.read r) (1, 2, 5)
+
+simpleRefTestScope = do
+  Scope.run do
+    r = Scope.ref 0
+    Ref.write r 1
+    i = Ref.read r
+    Ref.write r 2
+    j = Ref.read r
+    Ref.write r 5
+    checkEqual "Ref read-write"  (i, j, Ref.read r) (1, 2, 5)
+
+ticketTest = do
+ r = IO.ref 3
+ t = Ref.readForCas r
+ v = Ticket.read t
+ checkEqual "Ticket contains the Ref value" v 3
+
+casTest = do
+   ref = IO.ref 0
+   ticket = Ref.readForCas ref
+   v1 = Ref.cas ref ticket 5
+   check "CAS is successful is there were no conflicting writes" 'v1
+   Ref.write ref 10
+   v2 = Ref.cas ref ticket 15
+   check "CAS fails when there was an intervening write" '(not v2)
+
+promiseSequentialTest = do
+  use Nat eq
+  use Promise read write
+  p = !Promise.new
+  v0 = Promise.tryRead p
+  checkEqual "Promise should be empty when created" v0 None
+  Promise.write_ p 0
+  v1 = read p
+  checkEqual "Promise should read a value that's been written" v1 0
+  Promise.write_ p 1
+  v2 = read p
+  checkEqual "Promise can only be written to once" v2 v1
+  v3 = Promise.tryRead p
+  checkEqual "Once the Promise is full, tryRead is the same as read" v3 (Some v2)
+
+millis = 1000
+sleep_ n = unsafeRun! do sleep n
+
+promiseConcurrentTest = do
+  use Nat eq
+  use concurrent fork
+  p = !Promise.new
+  _ = fork do
+     sleep_ (200 * millis)
+     Promise.write p 5
+  v = Promise.read p
+  checkEqual "Reads awaits for completion of the Promise" v 5
+
+kill_ t = unsafeRun! do concurrent.kill t
+
+forkKillTest = do
+  ref = IO.ref "initial"
+  thread = fork do
+    sleep_ (400 * millis)
+    Ref.write ref "done"
+  sleep_ (200 * millis)
+  kill_ thread
+  sleep_ (300 * millis)
+  v = Ref.read ref
+  checkEqual "Thread was killed" v "initial"
+
+tryEvalForkTest = bug "Depends on the Exception ability being implemented"
+
+atomicUpdate : Ref {IO} a -> (a -> a) ->{IO} ()
+atomicUpdate ref f =
+  ticket = Ref.readForCas ref
+  value = f (Ticket.read ticket)
+  if Ref.cas ref ticket value then () else atomicUpdate ref f
+
+spawnN : Nat -> '{IO} a ->{IO} [a]
+spawnN n fa =
+  use Nat eq -
+  use concurrent fork
+  
+  go i acc =
+    if eq i 0
+    then acc
+    else
+      value = !Promise.new
+      _ = fork do Promise.write value !fa
+      go (i - 1) (acc :+ value)
+
+  map Promise.read (go n [])
+
+fullTest = do
+  use Nat * + eq -
+  
+  numThreads = 100
+  iterations = 100
+  expected = numThreads * iterations
+
+  state = IO.ref 0
+  thread n =
+    if eq n 0
+    then ()
+    else 
+      atomicUpdate state (v -> v + 1)
+      thread (n - 1)
+  ignore (spawnN numThreads '(thread iterations))
+  result = Ref.read state
+  checkEqual "The state of the counter is consistent " result expected
+
--- a/unison-src/builtin-tests/interpreter-tests.md
+++ b/unison-src/builtin-tests/interpreter-tests.md
@ -17,4 +17,14 @@ to `Tests.check` and `Tests.checkEqual`).

 ```ucm
 .> run tests
-```
+```
+
+```ucm:hide
+.> load unison-src/builtin-tests/concurrency-tests.u
+.> add
+```
+
+```ucm
+.> run concurrency.tests
+```
+
--- a/unison-src/builtin-tests/interpreter-tests.output.md
+++ b/unison-src/builtin-tests/interpreter-tests.output.md
@ -11,3 +11,9 @@ to `Tests.check` and `Tests.checkEqual`).
  ()

 ```
+```ucm
+.> run concurrency.tests
+
+  ()
+
+```
--- a/unison-src/builtin-tests/jit-tests.md
+++ b/unison-src/builtin-tests/jit-tests.md
@ -19,4 +19,13 @@ to `Tests.check` and `Tests.checkEqual`).

 ```ucm
 .> run.native tests
-```
+```
+
+```ucm:hide
+.> load unison-src/builtin-tests/concurrency-tests.u
+.> add
+```
+
+```ucm
+.> run.native concurrency.tests
+```
--- a/unison-src/builtin-tests/jit-tests.output.md
+++ b/unison-src/builtin-tests/jit-tests.output.md
@ -9,3 +9,7 @@ to `Tests.check` and `Tests.checkEqual`).
 .> run.native tests

 ```
+```ucm
+.> run.native concurrency.tests
+
+```
--- a/unison-src/transcripts-using-base/all-base-hashes.output.md
+++ b/unison-src/transcripts-using-base/all-base-hashes.output.md
--- a/unison-src/transcripts/alias-many.output.md
+++ b/unison-src/transcripts/alias-many.output.md
--- a/unison-src/transcripts/builtins-merge.output.md
+++ b/unison-src/transcripts/builtins-merge.output.md
@ -16,7 +16,7 @@ The `builtins.merge` command adds the known builtins to a `builtin` subnamespace
  5.  Bytes               (builtin type)
  6.  Bytes/              (33 terms)
  7.  Char                (builtin type)
-  8.  Char/               (3 terms)
+  8.  Char/               (22 terms, 1 type)
  9.  Code                (builtin type)
  10. Code/               (8 terms)
  11. Debug/              (3 terms)
@ -63,7 +63,7 @@ The `builtins.merge` command adds the known builtins to a `builtin` subnamespace
  52. Socket/             (1 term)
  53. Test/               (2 terms, 1 type)
  54. Text                (builtin type)
-  55. Text/               (32 terms)
+  55. Text/               (33 terms)
  56. ThreadId/           (1 term)
  57. Tuple               (type)
  58. Tuple/              (1 term)
--- 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/ (420 terms, 64 types)
+  1. builtin/ (440 terms, 65 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/ (592 terms, 82 types)
+  1. builtin/ (612 terms, 83 types)

 ```
 More typically, you'd start out by pulling `base.
--- a/unison-src/transcripts/fix1063.md
+++ b/unison-src/transcripts/fix1063.md
@ -7,6 +7,8 @@ Tests that functions named `.` are rendered correctly.
 ``` unison
 (.) f g x = f (g x)

+use Boolean not
+
 noop = not . not
 ```

--- a/unison-src/transcripts/fix1063.output.md
+++ b/unison-src/transcripts/fix1063.output.md
@ -3,6 +3,8 @@ Tests that functions named `.` are rendered correctly.
 ```unison
 (.) f g x = f (g x)

+use Boolean not
+
 noop = not . not
 ```

@ -31,6 +33,8 @@ noop = not . not
 .> view noop

  noop : Boolean -> Boolean
-  noop = not . not
+  noop =
+    use Boolean not
+    not . not

 ```
--- a/unison-src/transcripts/merges.output.md
+++ b/unison-src/transcripts/merges.output.md
@ -113,13 +113,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. #492bge1qkb
+  ⊙ 1. #pfspc3m714
  
    - Deletes:
    
      feature1.y
  
-  ⊙ 2. #qdsgea37fc
+  ⊙ 2. #t9gdv3652e
  
    + Adds / updates:
    
@ -130,26 +130,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. #ppkkh269f7
+  ⊙ 3. #fnah4umom7
  
    + Adds / updates:
    
      feature1.y
  
-  ⊙ 4. #u8aiheqfug
+  ⊙ 4. #fsd9t403lp
  
    > Moves:
    
      Original name New name
      x             master.x
  
-  ⊙ 5. #es9cmc7kok
+  ⊙ 5. #64tba28sdf
  
    + Adds / updates:
    
      x
  
-  □ 6. #jo7t8m4dft (start of history)
+  □ 6. #uql7vkh78v (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`.
--- a/unison-src/transcripts/move-namespace.output.md
+++ b/unison-src/transcripts/move-namespace.output.md
@ -269,7 +269,7 @@ I should be able to move the root into a sub-namespace

 .> ls

-  1. root/ (597 terms, 83 types)
+  1. root/ (617 terms, 84 types)

 .> history

@ -278,13 +278,13 @@ I should be able to move the root into a sub-namespace
  
  
  
-  □ 1. #bn675bbtpm (start of history)
+  □ 1. #g5nn5l3b03 (start of history)

 ```
 ```ucm
 .> ls .root.at.path

-  1. builtin/  (592 terms, 82 types)
+  1. builtin/  (612 terms, 83 types)
  2. existing/ (1 term)
  3. happy/    (3 terms, 1 type)
  4. history/  (1 term)
@ -294,7 +294,7 @@ I should be able to move the root into a sub-namespace
  Note: The most recent namespace hash is immediately below this
        message.
  
-  ⊙ 1. #vor04lbt72
+  ⊙ 1. #vt3jsa8k80
  
    - Deletes:
    
@ -305,7 +305,7 @@ I should be able to move the root into a sub-namespace
      Original name      New name
      existing.a.termInA existing.b.termInA
  
-  ⊙ 2. #tk3qtdeoov
+  ⊙ 2. #b2h3s5rv29
  
    + Adds / updates:
    
@ -317,26 +317,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. #r971i7m95i
+  ⊙ 3. #7v6bvecsm0
  
    + Adds / updates:
    
      existing.a.termInA existing.b.termInB
  
-  ⊙ 4. #6qh988adub
+  ⊙ 4. #1uf0leagkk
  
    > Moves:
    
      Original name     New name
      history.a.termInA history.b.termInA
  
-  ⊙ 5. #g19mlrid0i
+  ⊙ 5. #a3uao3fp6q
  
    - Deletes:
    
      history.b.termInB
  
-  ⊙ 6. #n0a5seofan
+  ⊙ 6. #umd1mp6mku
  
    + Adds / updates:
    
@ -347,13 +347,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. #i3nsbtl7kc
+  ⊙ 7. #dqfd14almm
  
    + Adds / updates:
    
      history.a.termInA history.b.termInB
  
-  ⊙ 8. #a2u0kep087
+  ⊙ 8. #ljk3oa07ld
  
    > Moves:
    
@ -363,7 +363,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. #g18uf760mb
+  ⊙ 9. #hhun973gp5
  
    + Adds / updates:
    
@ -373,7 +373,7 @@ I should be able to move the root into a sub-namespace
    
      happy.a.T.T
  
-  ⊙ 10. #2edl4803r1
+  ⊙ 10. #8ri4h5gjvo
  
    + Adds / updates:
    
@ -385,7 +385,7 @@ I should be able to move the root into a sub-namespace
  
  ⠇
  
-  ⊙ 11. #qcd5obbuv8
+  ⊙ 11. #ahcsbbqt21
  

 ```
--- a/unison-src/transcripts/name-selection.output.md
+++ b/unison-src/transcripts/name-selection.output.md
--- a/unison-src/transcripts/reflog.output.md
+++ b/unison-src/transcripts/reflog.output.md
@ -59,17 +59,17 @@ y = 2
  most recent, along with the command that got us there. Try:
  
    `fork 2 .old`             
-    `fork #2b8npf0tu2 .old`   to make an old namespace
+    `fork #s4kjl4lbf3 .old`   to make an old namespace
                              accessible again,
                              
-    `reset-root #2b8npf0tu2`  to reset the root namespace and
+    `reset-root #s4kjl4lbf3`  to reset the root namespace and
                              its history to that of the
                              specified namespace.
  
       When   Root Hash     Action
-  1.   now    #j967usn5hk   add
-  2.   now    #2b8npf0tu2   add
-  3.   now    #lv9og66mct   builtins.merge
+  1.   now    #hr821c0ji5   add
+  2.   now    #s4kjl4lbf3   add
+  3.   now    #92606li9fc   builtins.merge
  4.          #sg60bvjo91   history starts here
  
  Tip: Use `diff.namespace 1 7` to compare namespaces between
--- 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. #a2uij441jg (start of history)
+  □ 1. #3jjj6quqhh (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. #2orc0vqqcv
+  ⊙ 1. #6qm36657l4
  
    > Moves:
    
      Original name  New name
      Nat.frobnicate Nat.+
  
-  ⊙ 2. #fk0nmiqqgk
+  ⊙ 2. #72ip8q9i3l
  
    > Moves:
    
      Original name New name
      Nat.+         Nat.frobnicate
  
-  □ 3. #a2uij441jg (start of history)
+  □ 3. #3jjj6quqhh (start of history)

 ```
 If we merge that back into `builtin`, we get that same chain of history:
@ -71,21 +71,21 @@ If we merge that back into `builtin`, we get that same chain of history:
  Note: The most recent namespace hash is immediately below this
        message.
  
-  ⊙ 1. #2orc0vqqcv
+  ⊙ 1. #6qm36657l4
  
    > Moves:
    
      Original name  New name
      Nat.frobnicate Nat.+
  
-  ⊙ 2. #fk0nmiqqgk
+  ⊙ 2. #72ip8q9i3l
  
    > Moves:
    
      Original name New name
      Nat.+         Nat.frobnicate
  
-  □ 3. #a2uij441jg (start of history)
+  □ 3. #3jjj6quqhh (start of history)

 ```
 Let's try again, but using a `merge.squash` (or just `squash`) instead. The history will be unchanged:
@ -106,7 +106,7 @@ Let's try again, but using a `merge.squash` (or just `squash`) instead. The hist
  
  
  
-  □ 1. #a2uij441jg (start of history)
+  □ 1. #3jjj6quqhh (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.
@ -485,13 +485,13 @@ This checks to see that squashing correctly preserves deletions:
  Note: The most recent namespace hash is immediately below this
        message.
  
-  ⊙ 1. #9ijnd9ip7o
+  ⊙ 1. #p9ur8e0jlu
  
    - Deletes:
    
      Nat.* Nat.+
  
-  □ 2. #a2uij441jg (start of history)
+  □ 2. #3jjj6quqhh (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.