all shared tests now passing

shared/src/Text/Parsec/Layout.hs

@@ -1,6 +1,6 @@
 {-# Language BangPatterns #-}
 
--- Copyright (c) 2013, Edward Kmett, Luke Palmer
+-- Copyright (c) 2013, Edward Kmett, Luke Palmer, Paul Chiusano
 --
 -- All rights reserved.
 --
@@ -52,11 +52,12 @@ module Text.Parsec.Layout
     , HasLayoutEnv(..)
     , maybeFollowedBy
     , virtual_rbrace
+    , withoutLayout
     ) where
 
 import Data.Functor
 import Control.Applicative ((<$>))
-import Control.Monad (guard)
+import Control.Monad
 
 import Data.Char (isSpace)
 
@@ -133,6 +134,10 @@ pushCurrentContext = do
 maybeFollowedBy :: Stream s m c => ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
 t `maybeFollowedBy` x = do t' <- t; optional x; return t'
 
+withoutLayout :: (HasLayoutEnv u, Stream s m c) => String -> ParsecT s u m a -> ParsecT s u m a
+withoutLayout endMsg p =
+  pushContext NoLayout *> (p <* popContext endMsg)
+
 -- | @(\``maybeFollowedBy`\` space)@
 spaced :: (HasLayoutEnv u, Stream s m Char) => ParsecT s u m a -> ParsecT s u m a
 spaced t = t `maybeFollowedBy` space
@@ -200,11 +205,31 @@ layout = try $ do
 layoutSatisfies :: (HasLayoutEnv u, Stream s m Char) => (Layout -> Bool) -> ParsecT s u m ()
 layoutSatisfies p = guard . p =<< layout
 
+inLayout :: (HasLayoutEnv u, Stream s m Char) => ParsecT s u m Bool
+inLayout = do
+  env <- getEnv
+  pure $ case envLayout env of
+    [] -> True
+    (NoLayout:_) -> False
+    (Layout _:_) -> True
+
+pushIncrementedContext :: (HasLayoutEnv u, Stream s m c) => ParsecT s u m ()
+pushIncrementedContext = do
+  env <- getEnv
+  case envLayout env of
+    [] -> pushContext (Layout 1)
+    (Layout n : _) -> pushContext (Layout (n + 1))
+    (NoLayout : _) -> pure ()
+
 virtual_lbrace :: (HasLayoutEnv u, Stream s m Char) => ParsecT s u m ()
-virtual_lbrace = pushCurrentContext
+virtual_lbrace = do
+  allow <- inLayout
+  when allow pushCurrentContext
 
 virtual_rbrace :: (HasLayoutEnv u, Stream s m Char) => ParsecT s u m ()
-virtual_rbrace = eof <|> try (layoutSatisfies (VBrace ==) <?> "outdent")
+virtual_rbrace = do
+  allow <- inLayout
+  when allow $ eof <|> try (layoutSatisfies (VBrace ==) <?> "outdent")
 
 -- | Consumes one or more spaces, comments, and onside newlines in a layout rule.
 space :: (HasLayoutEnv u, Stream s m Char) => ParsecT s u m String
@@ -237,10 +262,14 @@ rbrace = do
     return "}"
 
 block :: (HasLayoutEnv u, Stream s m Char) => ParsecT s u m a -> ParsecT s u m a
-block p = try (braced p) <|> try (vbraced p) <|> p where
+block p = braced p <|> vbraced p where
-  braced s = between (spaced lbrace) (spaced rbrace) s
+  braced s = between (try (spaced lbrace)) (spaced rbrace) s
   vbraced s = between (spaced virtual_lbrace) (spaced virtual_rbrace) s
--- block p = p <* lookAhead (spaced (virtual_lbrace <|> void semi))
+  -- NB: virtual_lbrace here doesn't use current column for offside calc, instead
+  -- uses 1 column greater than whatever column is at top of layout stack
+  virtual_lbrace = do
+    allow <- inLayout
+    when allow pushIncrementedContext
 
 -- | Repeat a parser in layout, separated by (virtual) semicolons.
 laidout :: (HasLayoutEnv u, Stream s m Char) => ParsecT s u m a -> ParsecT s u m [a]

shared/src/Unison/ABT.hs

@@ -53,6 +53,7 @@ unvar (Free v) = v
 unvar (Bound v) = v
 
 instance Var v => Var (V v) where
+  rename n2 = fmap (Var.rename n2)
   named txt = Bound (Var.named txt)
   name v = Var.name (unvar v)
   qualifiedName v = Var.qualifiedName (unvar v)

shared/src/Unison/Parser.hs

@@ -1,6 +1,7 @@
 {-# Language DeriveFunctor #-}
 {-# Language DeriveTraversable #-}
 {-# Language DeriveFoldable #-}
+{-# Language BangPatterns #-}
 
 module Unison.Parser where
 
@@ -107,9 +108,9 @@ wordyId :: [String] -> Parser s String
 wordyId keywords = label "wordyId" . token $ do
   op <- (False <$ symbolyId keywords) <|> pure True
   guard op
-  f <$> sepBy1 dot id
+  f <$> sepBy1 dot id -- todo: this screws up ∀ a. without a space following 'a'
   where
-    dot = char '.'
+    dot = attempt (char '.')
     id = identifier "alphanumeric identifier"
       [any (not . Char.isDigit), any Char.isAlphaNum, (`notElem` keywords)]
     f segs = intercalate "." segs
@@ -129,8 +130,8 @@ token p = attempt (L.spaced p)
 parenthesized :: Parser s a -> Parser s a
 parenthesized p = lp *> body <* rp
   where
-    lp = token (char '(')
+    lp = char '(' <* L.withoutLayout "space" (optional L.space)
-    body = p
+    body = L.withoutLayout "parentheses" p
     rp = token (char ')')
 
 takeWhile :: String -> (Char -> Bool) -> Parser s String

shared/src/Unison/Scratch.hs

@@ -18,7 +18,10 @@ type TermV = Term V
 parse' :: P.Parser (PS.S V) a -> String -> Either String a
 parse' p input = P.run p input PS.s0
 
-parse :: P.Parser (PS.S V) TermV -> String -> Either String TermV
+-- parse :: P.Parser (PS.S V) TermV -> String -> Either String TermV
+-- parse p input = P.run p input PS.s0
+
+parse :: P.Parser (PS.S V) [(V,TermV)] -> String -> Either String [(V, TermV)]
 parse p input = P.run p input PS.s0
 
 input' = unlines
@@ -28,17 +31,14 @@ input' = unlines
   , "  x = 2"
   , "  x + 1" ]
 
-input = "let { x = 1 ; x }"
+-- input = "let { x = 1 ; x }"
+input = "(do Remote { pure 42 } )"
 -- input = "let\n  x = 1\n  x"
 
 main :: IO ()
-main =
+main = do
-  let p = E.term
+  input <- readFile "unison-src/base.u"
-      -- p2 = parser
+  let p = E.moduleBindings
-  --in case parse' p2 "let { a; a; a   }" of
+  case parse p input of
-  --  Left err -> putStrLn err
-  --  Right a -> putStrLn (show a)
-  -- in case parse p "let { x=1; x }" of
-  in case parse p "let { a = 2 ; 1 }" of
     Left err -> putStrLn err
     Right a -> putStrLn (show a)

shared/src/Unison/TermParser.hs

@@ -57,11 +57,11 @@ term :: Var v => Parser (S v) (Term v)
 term = term2
 
 term2 :: Var v => Parser (S v) (Term v)
-term2 = let_ <|> lam term2 <|> term3
+term2 = lam term2 <|> effectBlock <|> term3
 
 term3 :: Var v => Parser (S v) (Term v)
 term3 = do
-  t <- ifthen <|> infixApp
+  t <- let_ <|> ifthen <|> infixApp
   ot <- optional (token (char ':') *> TypeParser.type_)
   pure $ case ot of
     Nothing -> t
@@ -80,7 +80,7 @@ term4 = f <$> some term5
     f [] = error "'some' shouldn't produce an empty list"
 
 term5 :: Var v => Parser (S v) (Term v)
-term5 = label "effect block" effectBlock <|> termLeaf
+term5 = termLeaf
 
 termLeaf :: Var v => Parser (S v) (Term v)
 termLeaf =
@@ -89,9 +89,9 @@ termLeaf =
 ifthen :: Var v => Parser (S v) (Term v)
 ifthen = do
   _ <- token (string "if")
-  cond <- term
+  cond <- L.withoutLayout "then" term
   _ <- token (string "then")
-  iftrue <- term
+  iftrue <- L.withoutLayout "else" term
   _ <- token (string "else")
   iffalse <- L.block term
   pure (Term.apps (Term.lit Term.If) [cond, iftrue, iffalse])

shared/tests/Unison/Test/Interpreter.hs

@@ -15,7 +15,7 @@ tests = withResource Common.codebase (\_ -> pure ()) $ \codebase ->
       [ t "1 + 1" "2"
       , t "1 + 1 + 1" "3"
       , t "(x -> x) 42" "42"
-      , t "let x = 2; y = 3 ; x + y;;" "5"
+      , t "let { x = 2; y = 3 ; x + y }" "5"
       , t "if False then 0 else 1" "1"
       , t "if True then 12 else 13" "12"
       , t "1 >_Number 0" "True"
@@ -41,12 +41,12 @@ tests = withResource Common.codebase (\_ -> pure ()) $ \codebase ->
       , t "False `and` False" "False"
       , t "not False" "True"
       , t "not True" "False"
-      , t "let rec fac n = if n ==_Number 0 then 1 else n * fac (n - 1); fac 5;;" "120"
+      , t "let rec { fac n = if n ==_Number 0 then 1 else n * fac (n - 1); fac 5 }" "120"
-      , t "let rec ping n = if n >=_Number 10 then n else pong (n + 1); pong n = ping (n + 1); ping 0;;"
+      , t "let rec { ping n = if n >=_Number 10 then n else pong (n + 1); pong n = ping (n + 1); ping 0}"
           "10"
-      , t "let id x = x; g = id 42; p = id \"hi\" ; g;;" "42"
+      , t "let\n  id x = x\n  g = id 42\n  p = id \"hi\"\n  g" "42"
-      , t "let id : forall a . a -> a; id x = x; g = id 42; p = id \"hi\" ; g;;" "42"
+      , t "let { id : forall a . a -> a; id x = x; g = id 42; p = id \"hi\" ; g }" "42"
-      , t "(let id x = x; id;; : forall a . a -> a) 42" "42"
+      , t "(let { id x = x; id } : forall a . a -> a) 42" "42"
       , t "Optional.map ((+) 1) (Some 1)" "Some 2"
       , t "Optional.map ((+) 1) ((Some: ∀ a . a -> Optional a) 1)" "Some 2"
       , t "Either.fold ((+) 1) ((+) 2) (Left 1)" "2"

shared/tests/Unison/Test/Term.hs

@@ -115,11 +115,11 @@ pingpong1 :: TTerm
 pingpong1 =
   unsafeParseTerm $
     unlines [ "let rec "
-            , "  ping x = pong (x + 1);"
+            , "  ping x = pong (x + 1)"
-            , "  pong y = ping (y - 1);"
+            , "  pong y = ping (y - 1)"
-            , "  ping 1;;"
+            , "  ping 1"
             ]
 
 pingpong2 :: TTerm
 pingpong2 =
-  unsafeParseTerm $ "let rec pong1 p = ping1 (p - 1); ping1 q = pong1 (q + 1); ping1 1;;"
+  unsafeParseTerm $ "let rec { pong1 p = ping1 (p - 1); ping1 q = pong1 (q + 1); ping1 1 }"

shared/tests/Unison/Test/TermParser.hs

@@ -48,7 +48,7 @@ tests = testGroup "TermParser" $ (parse <$> shouldPass)
       , ("#V-f/XHD3-N0E", "invalid base64url")
       ]
     shouldParse =
-      [ "do Remote n1 := Remote.spawn; n2 := Remote.spawn; let rec { x = 10; Remote.pure 42 }" ]
+      [ "do Remote { n1 := Remote.spawn; n2 := Remote.spawn; let rec { x = 10; Remote.pure 42 }}" ]
     shouldPass =
       [ ("1", one)
       , ("[1,1]", vectorForced [one, one])
@@ -83,18 +83,18 @@ tests = testGroup "TermParser" $ (parse <$> shouldPass)
       , ("a b -> a + b : Int", lam' ["a", "b"] (ann (apps numberplus [a, b]) int))
       , ("a -> a", lam' ["a"] a)
       , ("(a -> a) : forall a . a -> a", ann (lam' ["a"] a) (T.forall' ["a"] (T.arrow a' a')))
-      , ("let f = a b -> a + b; f 1 1", f_eq_lamab_in_f11)
+      , ("let { f = a b -> a + b; f 1 1 }", f_eq_lamab_in_f11)
-      , ("let f a b = a + b; f 1 1", f_eq_lamab_in_f11)
+      , ("let { f a b = a + b; f 1 1 }", f_eq_lamab_in_f11)
-      , ("let f (+) b = 1 + b; f g 1", let1' [("f", lam' ["+", "b"] (apps plus [one, b]))] (apps f [g,one]))
+      , ("let { f (+) b = 1 + b; f g 1 }", let1' [("f", lam' ["+", "b"] (apps plus [one, b]))] (apps f [g,one]))
-      , ("let a + b = f a b; 1 + 1", let1' [("+", lam' ["a", "b"] fab)] one_plus_one)
+      , ("let { a + b = f a b; 1 + 1 }", let1' [("+", lam' ["a", "b"] fab)] one_plus_one)
       , ("let\n  (+) : Int -> Int -> Int\n  a + b = f a b\n  1 + 1", plusintintint_fab_in_1plus1)
-      , ("let (+) : Int -> Int -> Int; (+) a b = f a b; 1 + 1", plusintintint_fab_in_1plus1)
+      , ("let { (+) : Int -> Int -> Int; (+) a b = f a b; 1 + 1 }", plusintintint_fab_in_1plus1)
-      , ("let (+) : Int -> Int -> Int; (+) a b = f a b; (+) 1 1", plusintintint_fab_in_1plus1)
+      , ("let { (+) : Int -> Int -> Int; (+) a b = f a b; (+) 1 1 }", plusintintint_fab_in_1plus1)
-      , ("let f b = b + 1; a = 1; (+) a (f 1)", let1' [("f", lam_b_bplus1), ("a", one)] (apps numberplus [a, apps f [one]]))
+      , ("let { f b = b + 1; a = 1; (+) a (f 1) }", let1' [("f", lam_b_bplus1), ("a", one)] (apps numberplus [a, apps f [one]]))
       -- from Unison.Test.Term
       , ("a -> a", lam' ["a"] $ var' "a") -- id
       , ("x y -> x", lam' ["x", "y"] $ var' "x") -- const
-      , ("let rec fix = f -> f (fix f); fix", fix) -- fix
+      , ("let rec { fix = f -> f (fix f); fix }", fix) -- fix
       , ("let rec\n  fix f = f (fix f)\n  fix", fix) -- fix
       , ("1 + 2 + 3", num 1 `plus'` num 2 `plus'` num 3)
       , ("[1, 2, 1 + 1]", vectorForced [num 1, num 2, num 1 `plus'` num 1])
@@ -105,13 +105,13 @@ tests = testGroup "TermParser" $ (parse <$> shouldPass)
         , ("#" ++ Text.unpack sampleHash64, derived' sampleHash64)
         , ("#" ++ Text.unpack sampleHash512, derived' sampleHash512)
       , ("(do Remote { pure 42 } )", builtin "Remote.pure" `app` num 42)
-      , ("do Remote x = 42; pure (x + 1) ",
+      , ("do Remote { x = 42; pure (x + 1) } ",
           builtin "Remote.bind" `apps` [
             lam' ["q"] (builtin "Remote.pure" `app` (var' "q" `plus'` num 1)),
             builtin "Remote.pure" `app` num 42
           ]
         )
-      , ("do Remote x := pure 42;  pure (x + 1) ",
+      , ("do Remote { x := pure 42;  pure (x + 1) } ",
           builtin "Remote.bind" `apps` [
             lam' ["q"] (builtin "Remote.pure" `app` (var' "q" `plus'` num 1)),
             builtin "Remote.pure" `app` num 42

shared/tests/Unison/Test/Typechecker.hs

@@ -99,40 +99,40 @@ tests :: TestTree
 tests = withResource Common.codebase (\_ -> pure ()) $ \node -> testGroup "Typechecker"
   [
     testCase "alpha equivalence (type)" $ assertEqual "const"
-      (unsafeParseType "forall a b. a -> b -> a")
+      (unsafeParseType "forall a b . a -> b -> a")
-      (unsafeParseType "forall x y. x -> y -> x")
+      (unsafeParseType "forall x y . x -> y -> x")
   , testCase "subtype (1)" $ checkSubtype
       (unsafeParseType "Number")
       (unsafeParseType "Number")
   , testCase "subtype (2)" $ checkSubtype
-      (unsafeParseType "forall a. a")
+      (unsafeParseType "forall a . a")
       (unsafeParseType "Number")
   , testCase "subtype (3)" $ checkSubtype
-      (unsafeParseType "forall a. a")
+      (unsafeParseType "forall a . a")
-      (unsafeParseType "forall a. a")
+      (unsafeParseType "forall a . a")
   , testCase "strong equivalence (type)" $ assertEqual "types were not equal"
-      (StrongEq (unsafeParseType "forall a b. a -> b -> a"))
+      (StrongEq (unsafeParseType "forall a b . a -> b -> a"))
-      (StrongEq (unsafeParseType "forall y x. x -> y -> x"))
+      (StrongEq (unsafeParseType "forall y x . x -> y -> x"))
   , testTerm "42" $ \tms -> testCase ("synthesize/check" ++ tms) $ synthesizesAndChecks node
       (unsafeParseTerm tms)
       (unsafeParseType "Number")
   , testCase "synthesize/check Term.id" $ synthesizesAndChecks node
       (unsafeParseTerm "a -> a")
-      (unsafeParseType "forall b. b -> b")
+      (unsafeParseType "forall b . b -> b")
   , testCase "synthesize/check Term.const" $ synthesizesAndChecks node
       (unsafeParseTerm "x y -> x")
-      (unsafeParseType "forall a b. a -> b -> a")
+      (unsafeParseType "forall a b . a -> b -> a")
   , testCase "synthesize/check (x y -> y)" $ synthesizesAndChecks node
       (unsafeParseTerm "x y -> y")
-      (unsafeParseType "forall a b. a -> b -> b")
+      (unsafeParseType "forall a b . a -> b -> b")
   , testCase "synthesize/check (let f = (+); f 1;;)" $ synthesizesAndChecks node
-      (unsafeParseTerm "let f = (+); f 1;;")
+      (unsafeParseTerm "let { f = (+); f 1 }")
       (T.lit T.Number --> T.lit T.Number)
-  , testCase "synthesize/check (let blank x = _; blank 1;;)" $ synthesizesAndChecks node
+  , testCase "synthesize/check (let { blank x = _; blank 1 })" $ synthesizesAndChecks node
-      (unsafeParseTerm "let blank x = _; blank 1;;")
+      (unsafeParseTerm "let { blank x = _; blank 1 }")
       (forall' ["a"] $ T.v' "a")
   , testCase "synthesize/check Term.fix" $ synthesizesAndChecks node
-      (unsafeParseTerm "let rec fix f = f (fix f); fix;;")
+      (unsafeParseTerm "let rec { fix f = f (fix f); fix }")
       (forall' ["a"] $ (T.v' "a" --> T.v' "a") --> T.v' "a")
   , testCase "synthesize/check Term.pingpong1" $ synthesizesAndChecks node
       Term.pingpong1
@@ -143,23 +143,23 @@ tests = withResource Common.codebase (\_ -> pure ()) $ \node -> testGroup "Typec
   , testTerm "[1, 2, 1 + 1]" $ \tms ->
     testCase ("synthesize/checkAt "++tms++"@[Paths.Arg, Index 2]") $ synthesizesAndChecksAt node
       [Paths.Arg, Paths.Index 2] (unsafeParseTerm tms) (T.lit T.Number)
-  , testTerm "let x = _; _;;" $ \tms ->
+  , testTerm "let { x = _; _}" $ \tms ->
     testCase ("synthesize/checkAt ("++tms++")@[Binding 0,Body]") $ synthesizesAndChecksAt node
       [Paths.Binding 0, Paths.Body] (unsafeParseTerm tms) unconstrained
   -- fails
-  , testTerm "f -> let x = (let saved = f; 42;;); 1;;" $ \tms ->
+  , testTerm "f -> let { x = let { saved = f; 42 }; 1 }" $ \tms ->
     testCase ("synthesize/check ("++tms++")") $ synthesizesAndChecks node
       (unsafeParseTerm tms)
-      (unsafeParseType "forall x. x -> Number")
+      (unsafeParseType "forall x . x -> Number")
-  , testTerm "f -> let x = (b a -> b) 42 f; 1;;" $ \tms ->
+  , testTerm "f -> let { x = (b a -> b) 42 f; 1 }" $ \tms ->
     testCase ("synthesize/check ("++tms++")") $ synthesizesAndChecks node
-      (unsafeParseTerm tms) (unsafeParseType "forall x. x -> Number")
+      (unsafeParseTerm tms) (unsafeParseType "forall x . x -> Number")
   , testTerm "f x y -> (x y -> y) f _ + _" $ \tms ->
     testCase ("synthesize/check ("++tms++")") $ do
       synthesizesAndChecks node
         (unsafeParseTerm tms)
-        (unsafeParseType "forall a b c. a -> b -> c -> Number")
+        (unsafeParseType "forall a b c . a -> b -> c -> Number")
-  , testTerm "(id -> let x = id 42; y = id \"hi\"; 43;;) : (forall a . a -> a) -> Number" $ \tms ->
+  , testTerm "(id -> let { x = id 42; y = id \"hi\"; 43 }) : (forall a . a -> a) -> Number" $ \tms ->
     testCase ("higher rank checking: " ++ tms) $
       let
         t = unsafeParseType "(forall a . a -> a) -> Number"
@@ -180,19 +180,19 @@ tests = withResource Common.codebase (\_ -> pure ()) $ \node -> testGroup "Typec
       [(_,xt), (_,yt)] <- localsAt node [Paths.Body, Paths.Body, Paths.Fn, Paths.Arg] tm
       assertEqual "xt unconstrainted" unconstrained (T.generalize xt)
       assertEqual "yt unconstrainted" unconstrained (T.generalize yt)
-  , testTerm "let x = _; _;;" $ \tms ->
+  , testTerm "let { x = _; _ }" $ \tms ->
     testCase ("locals ("++tms++")") $ do
       let tm = unsafeParseTerm tms
       [(_,xt)] <- localsAt node [Paths.Body] tm
       [] <- localsAt node [Paths.Binding 0, Paths.Body] tm
       assertEqual "xt unconstrainted" unconstrained (T.generalize xt)
-  , testTerm "let x = _; y = _; _;;" $ \tms ->
+  , testTerm "let { x = _; y = _; _ }" $ \tms ->
     testCase ("locals ("++tms++")@[Body,Body]") $ do
       let tm = unsafeParseTerm tms
       [(_,xt), (_,yt)] <- localsAt node [Paths.Body, Paths.Body] tm
       assertEqual "xt unconstrained" unconstrained (T.generalize xt)
       assertEqual "yt unconstrained" unconstrained (T.generalize yt)
-  , testTerm "let x = _; y = _; _;;" $ \tms ->
+  , testTerm "let { x = _; y = _; _ }" $ \tms ->
     -- testTerm "let x = 42; y = _; _" $ \tms ->
     -- testTerm "let x = 42; y = 43; _" $ \tms ->
     -- testTerm "let x = 42; y = 43; 4224" $ \tms ->
@@ -203,7 +203,7 @@ tests = withResource Common.codebase (\_ -> pure ()) $ \node -> testGroup "Typec
   ]
 
 unconstrained :: TType
-unconstrained = unsafeParseType "forall a. a"
+unconstrained = unsafeParseType "forall a . a"
 
 main :: IO ()
 main = defaultMain tests

shared/tests/Unison/Test/Typechecker/Components.hs

@@ -15,21 +15,21 @@ tests = withResource Common.codebase (\_ -> pure ()) $ \codebase ->
     tests =
       [
       -- simple case, no minimization done
-        t "let id x = x; g = id 42; y = id id g; y;;"
+        t "let { id x = x; g = id 42; y = id id g; y }"
-          "let id x = x; g = id 42; y = id id g; y;;"
+          "let { id x = x; g = id 42; y = id id g; y }"
       -- check that we get let generalization
-      , t "let rec id x = x; g = id 42; y = id id g; y;;"
+      , t "let rec { id x = x; g = id 42; y = id id g; y }"
-          "let id x = x; g = id 42; y = id id g; y;;"
+          "let { id x = x; g = id 42; y = id id g; y }"
       -- check that we preserve order of components as much as possible
-      , t "let rec id2 x = x; id1 x = x; id3 x = x; id3;;"
+      , t "let rec { id2 x = x; id1 x = x; id3 x = x; id3 }"
-          "let id2 x = x; id1 x = x; id3 x = x; id3;;"
+          "let { id2 x = x; id1 x = x; id3 x = x; id3 }"
       -- check that we reorder according to dependencies
-      , t "let rec g = id 42; y = id id g; id x = x; y;;"
+      , t "let rec { g = id 42; y = id id g; id x = x; y }"
-          "let id x = x; g = id 42; y = id id g; y;;"
+          "let { id x = x; g = id 42; y = id id g; y }"
       -- insane example, checks for: generalization, reordering,
       -- preservation of order when possible
-      , t "let rec g = id 42; y = id id g; ping x = pong x; pong x = id (ping x); id x = x; y;;"
+      , t "let rec { g = id 42; y = id id g; ping x = pong x; pong x = id (ping x); id x = x; y }"
-          "let id x = x; g = id 42; y = id id g ; (let rec ping x = pong x; pong x = id (ping x) ; y;;);;"
+          "let { id x = x; g = id 42; y = id id g ; (let rec { ping x = pong x; pong x = id (ping x) ; y })}"
       ]
     t before after = testCase (before ++ " ⟹  " ++ after) $ do
       (codebase, _, _, _) <- codebase

unison-src/base.u

@@ -72,6 +72,34 @@ Vector.fold-balanced plus zero vs = let rec
              go plus zero (1st p) `plus` go plus zero (2nd p)
   go plus zero vs
 
+Optional.map : ∀ a b . (a -> b) -> Optional a -> Optional b
+Optional.map f = Optional.fold None (f `and-then` Some)
+
+Optional.bind : ∀ a b . (a -> Optional b) -> Optional a -> Optional b
+Optional.bind f a = Optional.fold None f a
+
+Optional.pure : ∀ a . a -> Optional a
+Optional.pure = Some
+
+Optional.get-or : ∀ a . a -> Optional a -> a
+Optional.get-or a = Optional.fold a identity
+
+Optional.somes : ∀ a . Vector (Optional a) -> Vector a
+Optional.somes = Vector.bind (Optional.fold Vector.empty Vector.single)
+
+Optional.map2 : ∀ a b c . (a -> b -> c) -> Optional a -> Optional b -> Optional c
+Optional.map2 f a b = do Optional
+  a := a
+  b := b
+  pure (f a b)
+
+Optional.lift-or : ∀ a . (a -> a -> a) -> Optional a -> Optional a -> Optional a
+Optional.lift-or f = a1 a2 ->
+  a1 |> Optional.fold a2 (a1 -> Optional.fold None (a2 -> Some (f a1 a2)) a2)
+
+Optional.fold' : ∀ a b . (Unit -> b) -> (a -> b) -> Optional a -> Unit -> b
+Optional.fold' thunk f = Optional.fold thunk (a u -> f a)
+
 Vector.fold-balanced1 : ∀ a . (a -> a -> a) -> Vector a -> Optional a
 Vector.fold-balanced1 f v = Vector.fold-balanced (Optional.lift-or f) None (Vector.map Some v)
 
@@ -97,6 +125,12 @@ Vector.last v = Vector.at (Vector.size v - 1) v
 Vector.1st : ∀ a . Vector a -> Optional a
 Vector.1st = Vector.at 0
 
+Vector.drop-right : ∀ a . Number -> Vector a -> Vector a
+Vector.drop-right n v = Vector.take (Vector.size v - n) v
+
+Vector.take-right : ∀ a . Number -> Vector a -> Vector a
+Vector.take-right n v = Vector.drop (Vector.size v - n) v
+
 Vector.dedup-adjacent : ∀ a . (a -> a -> Boolean) -> Vector a -> Vector a
 Vector.dedup-adjacent eq v =
   Vector.fold-balanced
@@ -107,12 +141,6 @@ Vector.dedup-adjacent eq v =
     []
     (Vector.map Vector.pure v)
 
-Vector.drop-right : ∀ a . Number -> Vector a -> Vector a
-Vector.drop-right n v = Vector.take (Vector.size v - n) v
-
-Vector.take-right : ∀ a . Number -> Vector a -> Vector a
-Vector.take-right n v = Vector.drop (Vector.size v - n) v
-
 Vector.histogram : ∀ a . Order a -> Vector a -> Vector (a, Number)
 Vector.histogram o v = let
   merge-bin b1 b2 = (1st b1, 2nd b1 + 2nd b2)
@@ -151,33 +179,40 @@ Remote.map2' f a b = Remote.map2 f a b |> Remote.join
 Remote.join : ∀ a . Remote (Remote a) -> Remote a
 Remote.join = Remote.bind identity
 
-Remote.replicate : ∀ a . Number -> Remote a -> Remote (Vector a)
-Remote.replicate n r = Remote.sequence (Vector.replicate n r)
-
-Remote.replicate! : ∀ a . Number -> Remote a -> Remote Unit
-Remote.replicate! n a = let rec
-  go n =
-    if n <=_Number 0 then Remote.pure Unit
-    else Remote.bind (a -> go (n - 1)) a
-  go n
-
 Remote.unfold : ∀ s a . s -> (s -> Remote (Optional (a, s))) -> Remote (Vector a)
 Remote.unfold s f = let rec
-  go s acc = do Remote {
+  go s acc = do Remote
-    ht := f s;
+    ht := f s
     ht |> Optional.fold
       (pure acc)
       (ht -> go (2nd ht) (Vector.append (1st ht) acc))
-  }
   go s Vector.empty
 
+Remote.at' : ∀ a . Node -> Remote a -> Remote a
+Remote.at' node r = do Remote { Remote.transfer node; r }
+
+Remote.transfer : Node -> Remote Unit
+Remote.transfer node = Remote.at node unit
+
+Remote.replicate : ∀ a . Number -> Remote a -> Remote (Vector a)
+Remote.replicate n r = Remote.sequence (Vector.replicate n r)
+
+
+Remote.start : ∀ a . Duration -> Remote a -> Remote (Remote a)
+Remote.start timeout r = do Remote
+  here := Remote.here
+  c := Remote.channel
+  result := Remote.receive-async c timeout
+  Remote.fork (Remote.at' here (r |> Remote.bind (Remote.send c)))
+  pure result
+
 Remote.race : ∀ a . Duration -> Vector (Remote a) -> Remote a
 Remote.race timeout rs = do Remote
   here := Remote.here
   c := Remote.channel
   result := Remote.receive-async c timeout
   Remote.traverse
-    (r -> Remote.fork <| do Remote { a := r Remote.transfer here; Remote.send c a })
+    (r -> Remote.fork <| (do Remote { a := r; Remote.transfer here; Remote.send c a }))
     rs
   result
 
@@ -187,16 +222,15 @@ Remote.timeout : ∀ a . Duration -> Remote a -> Remote (Optional a)
 Remote.timeout timeout r =
   Remote.race (Duration.seconds 501) [
     Remote.map Some r,
-    do Remote Remote.sleep timeout pure None
+    do Remote { Remote.sleep timeout; pure None }
   ]
 
-Remote.start : ∀ a . Duration -> Remote a -> Remote (Remote a)
+Remote.replicate! : ∀ a . Number -> Remote a -> Remote Unit
-Remote.start timeout r = do Remote
+Remote.replicate! n a = let rec
-  here := Remote.here
+  go n =
-  c := Remote.channel
+    if n <=_Number 0 then Remote.pure Unit
-  result := Remote.receive-async c timeout
+    else Remote.bind (a -> go (n - 1)) a
-  Remote.fork (Remote.at' here (r |> Remote.bind (Remote.send c)))
+  go n
-  pure result
 
 Remote.traverse : ∀ a b . (a -> Remote b) -> Vector a -> Remote (Vector b)
 Remote.traverse f vs =
@@ -220,35 +254,6 @@ Remote.parallel-traverse timeout f vs = do Remote
 Remote.quorum : ∀ a b . Duration -> Number -> (a -> Remote b) -> Vector a -> Remote b
 Remote.quorum timeout n = _ -- todo
 
-Optional.map : ∀ a b . (a -> b) -> Optional a -> Optional b
-Optional.map f = Optional.fold None (f `and-then` Some)
-
-Optional.bind : ∀ a b . (a -> Optional b) -> Optional a -> Optional b
-Optional.bind f = Optional.fold None f
-
-Optional.pure : ∀ a . a -> Optional a
-Optional.pure = Some
-
-Optional.get-or : ∀ a . a -> Optional a -> a
-Optional.get-or a = Optional.fold a identity
-
-Optional.somes : ∀ a . Vector (Optional a) -> Vector a
-Optional.somes = Vector.bind (Optional.fold Vector.empty Vector.single)
-
-Optional.map2 : ∀ a b c . (a -> b -> c) -> Optional a -> Optional b -> Optional c
-Optional.map2 f a b = do Optional
-  a := a
-  b := b
-  pure (f a b)
-
-
-Optional.lift-or : ∀ a . (a -> a -> a) -> Optional a -> Optional a -> Optional a
-Optional.lift-or f = a1 a2 ->
-  a1 |> Optional.fold a2 (a1 -> Optional.fold None (a2 -> Some (f a1 a2)) a2)
-
-Optional.fold' : ∀ a b . (Unit -> b) -> (a -> b) -> Optional a -> Unit -> b
-Optional.fold' thunk f = Optional.fold thunk (a u -> f a)
-
 Either.map : ∀ a b c . (b -> c) -> Either a b -> Either a c
 Either.map f = Either.fold Left (f `and-then` Right)
 
@@ -270,9 +275,3 @@ Text.take-right n t = Text.drop (Text.length t - n) t
 Text.ends-with : Text -> Text -> Boolean
 Text.ends-with suffix overall =
   Text.take-right (Text.length suffix) overall ==_Text suffix
-
-Remote.at' : ∀ a . Node -> Remote a -> Remote a
-Remote.at' node r = do Remote { Remote.transfer node; r }
-
-Remote.transfer : Node -> Remote Unit
-Remote.transfer node = Remote.at node unit