mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 02:25:39 +03:00
some std lib naming tweaks, modified type parser to allow dots in identifiers
This commit is contained in:
parent
fc976fcfaa
commit
968733efb3
@ -32,10 +32,10 @@ index :: Remote.Node -> Term.Term V -> Term.Term V
|
||||
index node h = Term.ref (R.Builtin "Index") `Term.apps` [Term.node node, h]
|
||||
|
||||
linkT :: Ord v => Type v
|
||||
linkT = Type.ref (R.Builtin "Link")
|
||||
linkT = Type.ref (R.Builtin "Html.Link")
|
||||
|
||||
link :: Term.Term V -> Term.Term V -> Term.Term V
|
||||
link href description = Term.ref (R.Builtin "Link") `Term.app` href `Term.app` description
|
||||
link href description = Term.ref (R.Builtin "Html.Link") `Term.app` href `Term.app` description
|
||||
|
||||
linkToTerm :: Html.Link -> Term.Term V
|
||||
linkToTerm (Html.Link href description) = link (Term.lit $ Term.Text href)
|
||||
@ -46,7 +46,7 @@ pattern Index' node s <-
|
||||
(Term.Text' s)
|
||||
|
||||
pattern Link' href description <-
|
||||
Term.App' (Term.App' (Term.Ref' (R.Builtin "Link"))
|
||||
Term.App' (Term.App' (Term.Ref' (R.Builtin "Html.Link"))
|
||||
(Term.Text' href))
|
||||
(Term.Text' description)
|
||||
|
||||
@ -61,15 +61,15 @@ makeAPI blockStore crypto = do
|
||||
resourcePool <- RP.make 3 10 (Index.loadEncrypted blockStore crypto) Index.flush
|
||||
pure (\whnf -> map (\(r, o, t, m) -> Builtin r o t m)
|
||||
[ -- Index
|
||||
let r = R.Builtin "Index.empty!"
|
||||
let r = R.Builtin "Index.empty#"
|
||||
op [self] = do
|
||||
ident <- Note.lift nextID
|
||||
Term.Distributed' (Term.Node self) <- whnf self
|
||||
pure . index self . Term.lit . Term.Text . Index.idToText $ ident
|
||||
op _ = fail "Index.empty! unpossible"
|
||||
op _ = fail "Index.empty# unpossible"
|
||||
type' = unsafeParseType "forall k v. Node -> Index k v"
|
||||
in (r, Just (I.Primop 1 op), type', prefix "Index.empty!")
|
||||
, let r = R.Builtin "Index.lookup!"
|
||||
in (r, Just (I.Primop 1 op), type', prefix "Index.empty#")
|
||||
, let r = R.Builtin "Index.lookup#"
|
||||
op [key, indexToken] = inject g indexToken key where
|
||||
inject g indexToken key = do
|
||||
i <- whnf indexToken
|
||||
@ -81,26 +81,26 @@ makeAPI blockStore crypto = do
|
||||
flip finally cleanup $ do
|
||||
result <- atomically $ Index.lookup (SAH.hash' k) db
|
||||
case result >>= (pure . SAH.deserializeTermFromBytes . snd) of
|
||||
Just (Left s) -> fail ("Index.lookup! could not deserialize: " ++ s)
|
||||
Just (Left s) -> fail ("Index.lookup# could not deserialize: " ++ s)
|
||||
Just (Right t) -> pure $ some t
|
||||
Nothing -> pure none
|
||||
pure val
|
||||
g s k = pure $ Term.ref r `Term.app` s `Term.app` k
|
||||
op _ = fail "Index.lookup! unpossible"
|
||||
op _ = fail "Index.lookup# unpossible"
|
||||
type' = unsafeParseType "forall k v. k -> Index k v -> Optional v"
|
||||
in (r, Just (I.Primop 2 op), type', prefix "Index.lookup!")
|
||||
in (r, Just (I.Primop 2 op), type', prefix "Index.lookup#")
|
||||
, let r = R.Builtin "Index.lookup"
|
||||
op [key, index] = do
|
||||
Index' node tok <- whnf index
|
||||
pure $
|
||||
Term.builtin "Remote.map" `Term.apps` [
|
||||
Term.builtin "Index.lookup!" `Term.app` key,
|
||||
Term.builtin "Index.lookup#" `Term.app` key,
|
||||
Term.builtin "Remote.at" `Term.apps` [Term.node node, Term.text tok]
|
||||
]
|
||||
op _ = fail "Index.lookup unpossible"
|
||||
type' = unsafeParseType "forall k v. k -> Index k v -> Remote (Optional v)"
|
||||
in (r, Just (I.Primop 2 op), type', prefix "Index.lookup")
|
||||
, let r = R.Builtin "Index.insert!"
|
||||
, let r = R.Builtin "Index.insert#"
|
||||
op [k, v, index] = inject g k v index where
|
||||
inject g k v index = do
|
||||
k' <- whnf k
|
||||
@ -115,15 +115,15 @@ makeAPI blockStore crypto = do
|
||||
>>= atomically
|
||||
pure unitRef
|
||||
g k v index = pure $ Term.ref r `Term.app` k `Term.app` v `Term.app` index
|
||||
op _ = fail "Index.insert! unpossible"
|
||||
op _ = fail "Index.insert# unpossible"
|
||||
type' = unsafeParseType "forall k v. k -> v -> Index k v -> Unit"
|
||||
in (r, Just (I.Primop 3 op), type', prefix "Index.insert!")
|
||||
in (r, Just (I.Primop 3 op), type', prefix "Index.insert#")
|
||||
, let r = R.Builtin "Index.insert"
|
||||
op [key, value, index] = do
|
||||
Index' node tok <- whnf index
|
||||
pure $
|
||||
Term.builtin "Remote.map" `Term.apps` [
|
||||
Term.builtin "Index.insert!" `Term.apps` [key,value],
|
||||
Term.builtin "Index.insert#" `Term.apps` [key,value],
|
||||
Term.builtin "Remote.at" `Term.apps` [Term.node node, Term.text tok]
|
||||
]
|
||||
op _ = fail "Index.insert unpossible"
|
||||
@ -139,7 +139,7 @@ makeAPI blockStore crypto = do
|
||||
$ Html.getLinks h
|
||||
x -> Term.ref r `Term.app` x
|
||||
op _ = fail "Html.getLinks unpossible"
|
||||
in (r, Just (I.Primop 1 op), unsafeParseType "Text -> Vector Link", prefix "getLinks")
|
||||
in (r, Just (I.Primop 1 op), unsafeParseType "Text -> Vector Html.Link", prefix "Html.getLinks")
|
||||
, let r = R.Builtin "Html.getHref"
|
||||
op [link] = do
|
||||
link' <- whnf link
|
||||
@ -147,7 +147,7 @@ makeAPI blockStore crypto = do
|
||||
Link' href _ -> Term.lit (Term.Text href)
|
||||
x -> Term.ref r `Term.app` x
|
||||
op _ = fail "Html.getHref unpossible"
|
||||
in (r, Just (I.Primop 1 op), unsafeParseType "Link -> Text", prefix "getHref")
|
||||
in (r, Just (I.Primop 1 op), unsafeParseType "Html.Link -> Text", prefix "Html.getHref")
|
||||
, let r = R.Builtin "Html.getDescription"
|
||||
op [link] = do
|
||||
link' <- whnf link
|
||||
@ -155,10 +155,10 @@ makeAPI blockStore crypto = do
|
||||
Link' _ d -> Term.lit (Term.Text d)
|
||||
x -> Term.ref r `Term.app` x
|
||||
op _ = fail "Html.getDescription unpossible"
|
||||
in (r, Just (I.Primop 1 op), unsafeParseType "Link -> Text", prefix "getDescription")
|
||||
in (r, Just (I.Primop 1 op), unsafeParseType "Html.Link -> Text", prefix "Html.getDescription")
|
||||
|
||||
-- Http
|
||||
, let r = R.Builtin "Http.getURL!"
|
||||
, let r = R.Builtin "Http.getUrl#"
|
||||
op [url] = do
|
||||
url <- whnf url
|
||||
case url of
|
||||
@ -168,23 +168,23 @@ makeAPI blockStore crypto = do
|
||||
Right x -> right $ Term.text x
|
||||
Left x -> left . Term.text . Text.pack $ show x
|
||||
x -> pure $ Term.ref r `Term.app` x
|
||||
op _ = fail "Http.getURL! unpossible"
|
||||
in (r, Just (I.Primop 1 op), unsafeParseType "Text -> Either Text Text", prefix "Http.getURL!")
|
||||
, let r = R.Builtin "Http.getURL"
|
||||
op _ = fail "Http.getUrl# unpossible"
|
||||
in (r, Just (I.Primop 1 op), unsafeParseType "Text -> Either Text Text", prefix "Http.getUrl#")
|
||||
, let r = R.Builtin "Http.getUrl"
|
||||
op [url] = pure $ Term.builtin "Remote.pure" `Term.app`
|
||||
(Term.builtin "Http.getURL!" `Term.app` url)
|
||||
op _ = fail "Http.getURL unpossible"
|
||||
in (r, Just (I.Primop 1 op), unsafeParseType "Text -> Remote (Either Text Text)", prefix "Http.getURL")
|
||||
(Term.builtin "Http.getUrl#" `Term.app` url)
|
||||
op _ = fail "Http.getUrl unpossible"
|
||||
in (r, Just (I.Primop 1 op), unsafeParseType "Text -> Remote (Either Text Text)", prefix "Http.getUrl")
|
||||
|
||||
-- Hashing
|
||||
-- add erase, comparison functions
|
||||
, let r = R.Builtin "hash!"
|
||||
, let r = R.Builtin "hash#"
|
||||
op [e] = do
|
||||
e <- whnf e
|
||||
pure $ Term.builtin "Hash" `Term.app` (Term.ref $ SAH.hash e)
|
||||
op _ = fail "hash"
|
||||
t = "forall a . a -> Hash a"
|
||||
in (r, Just (I.Primop 1 op), unsafeParseType t, prefix "hash!")
|
||||
in (r, Just (I.Primop 1 op), unsafeParseType t, prefix "hash#")
|
||||
, let r = R.Builtin "Hash.erase"
|
||||
op [e] = pure e
|
||||
op _ = fail "hash"
|
||||
|
@ -15,7 +15,6 @@ import qualified Data.Text as Text
|
||||
import qualified Data.Text.IO as Text.IO
|
||||
import qualified Unison.Config as Config
|
||||
import qualified Unison.Cryptography as C
|
||||
import qualified Unison.Eval.Interpreter as I
|
||||
import qualified Unison.Node as Node
|
||||
import qualified Unison.Node.BasicNode as BasicNode
|
||||
import qualified Unison.Node.Builtin as Builtin
|
||||
|
@ -39,10 +39,10 @@ tests = testGroup "html"
|
||||
]
|
||||
|
||||
-- evaluateTerms :: [(Path, e)] -> Noted m [(Path,e,e)],
|
||||
unisonEvaluate :: TestNode -> Assertion
|
||||
unisonEvaluate testNode = do
|
||||
unisonEvaluate :: (TestNode, String -> TermV) -> Assertion
|
||||
unisonEvaluate (testNode, parse) = do
|
||||
let inputPath = [P.Fn]
|
||||
getLinksTerm = unsafeParseTerm $ "getLinks \"" ++ testHTML2 ++ "\""
|
||||
getLinksTerm = parse $ "Html.getLinks \"" ++ testHTML2 ++ "\""
|
||||
linkTerm = EB.link (Term.text "link.html") (Term.text "description")
|
||||
getLink = Term.ref (R.Builtin "Html.getHref") `Term.app` linkTerm
|
||||
getDescription = Term.ref (R.Builtin "Html.getDescription") `Term.app` linkTerm
|
||||
@ -64,8 +64,13 @@ unisonEvaluate testNode = do
|
||||
, "description match ", show (description == desiredDescription)
|
||||
]
|
||||
|
||||
nodeTests :: TestNode -> TestTree
|
||||
nodeTests :: (TestNode, String -> TermV) -> TestTree
|
||||
nodeTests testNode = testGroup "html"
|
||||
[ testCase "numlinks" numlinks
|
||||
, testCase "unisonEvaluate" (unisonEvaluate testNode)
|
||||
]
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
testNode <- makeTestNode
|
||||
defaultMain (nodeTests testNode)
|
||||
|
@ -2,6 +2,7 @@
|
||||
|
||||
module Unison.Test.NodeUtil where
|
||||
|
||||
import Control.Applicative
|
||||
import Unison.Hash (Hash)
|
||||
import Unison.Node (Node)
|
||||
import Unison.Reference (Reference)
|
||||
@ -10,13 +11,20 @@ import Unison.Symbol (Symbol)
|
||||
import Unison.Term (Term)
|
||||
import Unison.Type (Type)
|
||||
import Unison.Var (Var)
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.IO as Text.IO
|
||||
import qualified System.FilePath as FP
|
||||
import qualified Unison.ABT as ABT
|
||||
import qualified Unison.BlockStore.MemBlockStore as MBS
|
||||
import qualified Unison.Cryptography as C
|
||||
import qualified Unison.Hash as Hash
|
||||
import qualified Unison.Node as Node
|
||||
import qualified Unison.Node.BasicNode as BasicNode
|
||||
import qualified Unison.Node.Builtin as Builtin
|
||||
import qualified Unison.Node.FileStore as FS
|
||||
import qualified Unison.Node.UnisonBlockStore as UBS
|
||||
import qualified Unison.Note as Note
|
||||
import qualified Unison.Parsers as Parsers
|
||||
import qualified Unison.Reference as R
|
||||
import qualified Unison.Reference as Reference
|
||||
import qualified Unison.Runtime.ExtraBuiltins as EB
|
||||
@ -25,6 +33,7 @@ import qualified Unison.View as View
|
||||
|
||||
type DFO = View.DFO
|
||||
type V = Symbol DFO
|
||||
type TermV = Term V
|
||||
type TestNode = Node IO V R.Reference (Type V) (Term V)
|
||||
|
||||
hash :: Var v => Term.Term v -> Reference
|
||||
@ -34,11 +43,31 @@ hash t = Reference.Derived (ABT.hash t)
|
||||
makeRandomAddress :: C.Cryptography k syk sk skp s h c -> IO Address
|
||||
makeRandomAddress crypt = Address <$> C.randomBytes crypt 64
|
||||
|
||||
makeTestNode :: IO TestNode
|
||||
loadDeclarations :: FilePath -> Node IO V Reference (Type V) (Term V) -> IO ()
|
||||
loadDeclarations path node = do
|
||||
-- note - when run from repl current directory is root, but when run via stack test, current
|
||||
-- directory is the shared subdir - so we check both locations
|
||||
txt <- Text.IO.readFile path <|> Text.IO.readFile (".." `FP.combine` path)
|
||||
let str = Text.unpack txt
|
||||
_ <- Note.run $ Node.declare' Term.ref str node
|
||||
putStrLn $ "loaded file: " ++ path
|
||||
|
||||
makeTestNode :: IO (TestNode, String -> Term V)
|
||||
makeTestNode = do
|
||||
let crypto = C.noop "dummypublickey"
|
||||
putStrLn "creating block store..."
|
||||
blockStore <- MBS.make' (makeRandomAddress crypto) makeAddress
|
||||
putStrLn "created block store, creating Node store..."
|
||||
store' <- UBS.make blockStore
|
||||
keyValueOps <- EB.makeAPI blockStore crypto
|
||||
let makeBuiltins whnf = concat [Builtin.makeBuiltins whnf, keyValueOps whnf]
|
||||
BasicNode.make hash store' makeBuiltins
|
||||
-- store' <- FS.make "blockstore.file"
|
||||
putStrLn "created Node store..., building extra builtins"
|
||||
extraBuiltins <- EB.makeAPI blockStore crypto
|
||||
putStrLn "extra builtins created"
|
||||
let makeBuiltins whnf = concat [Builtin.makeBuiltins whnf, extraBuiltins whnf]
|
||||
node <- BasicNode.make hash store' makeBuiltins
|
||||
putStrLn "Node created"
|
||||
loadDeclarations "unison-src/base.u" node
|
||||
loadDeclarations "unison-src/extra.u" node
|
||||
builtins <- Note.run $ Node.allTermsByVarName Term.ref node
|
||||
let parse = Parsers.bindBuiltins builtins [] . Parsers.unsafeParseTerm
|
||||
pure (node, parse)
|
||||
|
@ -95,6 +95,20 @@ identifier' charTests stringTests = do
|
||||
guard (all ($ i) stringTests)
|
||||
pure i
|
||||
|
||||
-- a wordyId isn't all digits, and isn't all symbols
|
||||
wordyId :: [String] -> Parser String
|
||||
wordyId keywords = token $ f <$> sepBy1 dot id
|
||||
where
|
||||
dot = char '.'
|
||||
id = identifier [any (not . Char.isDigit), any Char.isAlphaNum, (`notElem` keywords)]
|
||||
f segs = intercalate "." segs
|
||||
|
||||
-- a symbolyId is all symbols
|
||||
symbolyId :: [String] -> Parser String
|
||||
symbolyId keywords = token $ identifier'
|
||||
[notReservedChar, not . Char.isSpace, \c -> Char.isSymbol c || Char.isPunctuation c]
|
||||
[(`notElem` keywords)]
|
||||
|
||||
token :: Parser a -> Parser a
|
||||
token p = p <* ignored
|
||||
|
||||
|
@ -78,6 +78,7 @@ termBuiltins = (Var.named *** Term.ref) <$> (
|
||||
, Builtin "False"
|
||||
, Builtin "()"
|
||||
, Alias "unit" "()"
|
||||
, Alias "Unit" "()"
|
||||
, Alias "Some" "Optional.Some"
|
||||
, Alias "None" "Optional.None"
|
||||
, Alias "Left" "Either.Left"
|
||||
@ -124,7 +125,7 @@ typeBuiltins = (Var.named *** Type.lit) <$>
|
||||
-- kv store
|
||||
, builtin "Index"
|
||||
-- html
|
||||
, builtin "Link"
|
||||
, builtin "Html.Link"
|
||||
-- distributed
|
||||
, builtin "Channel"
|
||||
, builtin "Future"
|
||||
|
@ -76,7 +76,7 @@ tupleOrParenthesized rec =
|
||||
-- y = 11;
|
||||
-- pure (f x);;
|
||||
effectBlock :: forall v . Var v => Parser (Term v)
|
||||
effectBlock = (token (string "do") *> wordyId) >>= go where
|
||||
effectBlock = (token (string "do") *> wordyId keywords) >>= go where
|
||||
go name = do
|
||||
bindings <- some $ asum [Right <$> binding, Left <$> action] <* semicolon
|
||||
semicolon
|
||||
@ -96,7 +96,7 @@ effectBlock = (token (string "do") *> wordyId) >>= go where
|
||||
interpretPure = ABT.subst (ABT.v' "pure") qualifiedPure
|
||||
binding :: Parser (v, Term v)
|
||||
binding = scope "binding" $ do
|
||||
lhs <- ABT.v' . Text.pack <$> token wordyId
|
||||
lhs <- ABT.v' . Text.pack <$> token (wordyId keywords)
|
||||
eff <- token $ (True <$ string ":=") <|> (False <$ string "=")
|
||||
rhs <- term
|
||||
let rhs' = if eff then interpretPure rhs
|
||||
@ -181,36 +181,22 @@ bindingEqBody p = eq *> body
|
||||
eq = token (char '=')
|
||||
body = lineErrorUnless "parse error in body of binding" p
|
||||
|
||||
-- a wordyId isn't all digits, and isn't all symbols
|
||||
wordyId :: Parser String
|
||||
wordyId = token $ f <$> id <*> optional ((:) <$> dot <*> wordyId)
|
||||
where
|
||||
dot = char '.'
|
||||
id = identifier [any (not.isDigit), any isAlphaNum, (`notElem` keywords)]
|
||||
f id rest = maybe id (id++) rest
|
||||
|
||||
-- a symbolyId is all symbols
|
||||
symbolyId :: Parser String
|
||||
symbolyId = token $ identifier'
|
||||
[notReservedChar, not . isSpace, \c -> isSymbol c || isPunctuation c]
|
||||
[(`notElem` keywords)]
|
||||
|
||||
infixVar :: Var v => Parser v
|
||||
infixVar = (Var.named . Text.pack) <$> (backticked <|> symbolyId)
|
||||
infixVar = (Var.named . Text.pack) <$> (backticked <|> symbolyId keywords)
|
||||
where
|
||||
backticked = char '`' *> wordyId <* token (char '`')
|
||||
backticked = char '`' *> wordyId keywords <* token (char '`')
|
||||
|
||||
prefixVar :: Var v => Parser v
|
||||
prefixVar = (Var.named . Text.pack) <$> prefixOp
|
||||
where
|
||||
prefixOp :: Parser String
|
||||
prefixOp = wordyId <|> (char '(' *> symbolyId <* token (char ')')) -- no whitespace w/in parens
|
||||
prefixOp = wordyId keywords <|> (char '(' *> symbolyId keywords <* token (char ')')) -- no whitespace w/in parens
|
||||
|
||||
prefixTerm :: Var v => Parser (Term v)
|
||||
prefixTerm = Term.var <$> prefixVar
|
||||
|
||||
keywords :: Set String
|
||||
keywords = Set.fromList ["do", "let", "rec", "in", "->", ":", "=", "where"]
|
||||
keywords :: [String]
|
||||
keywords = ["do", "let", "rec", "in", "->", ":", "=", "where"]
|
||||
|
||||
lam :: Var v => Parser (Term v) -> Parser (Term v)
|
||||
lam p = Term.lam'' <$> vars <* arrow <*> body
|
||||
|
@ -2,7 +2,7 @@
|
||||
|
||||
module Unison.TypeParser where
|
||||
|
||||
|
||||
import Control.Monad
|
||||
import Control.Applicative ((<|>), some, many)
|
||||
import Data.Char (isUpper, isLower, isAlpha)
|
||||
import Data.Foldable (asum)
|
||||
@ -55,10 +55,19 @@ forall rec = do
|
||||
pure $ Type.forall' (fmap Text.pack vars) t
|
||||
|
||||
varName :: Parser String
|
||||
varName = identifier [isLower.head, all isAlpha]
|
||||
varName = do
|
||||
name <- wordyId keywords
|
||||
guard (isLower . head $ name)
|
||||
pure name
|
||||
|
||||
typeName :: Parser String
|
||||
typeName = identifier [isUpper.head]
|
||||
typeName = do
|
||||
name <- wordyId keywords
|
||||
guard (isUpper . head $ name)
|
||||
pure name
|
||||
|
||||
keywords :: [String]
|
||||
keywords = ["forall", "∀"]
|
||||
|
||||
-- qualifiedTypeName :: Parser String
|
||||
-- qualifiedTypeName = f <$> typeName <*> optional more
|
||||
@ -68,9 +77,9 @@ typeName = identifier [isUpper.head]
|
||||
-- more = (:) <$> char '.' <*> qualifiedTypeName
|
||||
|
||||
literal :: Var v => Parser (Type v)
|
||||
literal =
|
||||
token $ asum [ Type.lit Type.Number <$ string "Number"
|
||||
, Type.lit Type.Text <$ string "Text"
|
||||
, Type.lit Type.Vector <$ string "Vector"
|
||||
, (Type.v' . Text.pack) <$> typeName
|
||||
]
|
||||
literal = scope "literal" . token $
|
||||
asum [ Type.lit Type.Number <$ string "Number"
|
||||
, Type.lit Type.Text <$ string "Text"
|
||||
, Type.lit Type.Vector <$ string "Vector"
|
||||
, (Type.v' . Text.pack) <$> typeName
|
||||
]
|
||||
|
@ -16,6 +16,12 @@ import qualified Unison.Type as T
|
||||
-- import Test.Tasty.SmallCheck as SC
|
||||
-- import Test.Tasty.QuickCheck as QC
|
||||
|
||||
parse' :: String -> TestTree
|
||||
parse' s = testCase ("`" ++ s ++ "`") $
|
||||
case parseTerm s of
|
||||
Fail e _ -> assertFailure $ "parse failure " ++ intercalate "\n" e
|
||||
Succeed a _ _ -> pure ()
|
||||
|
||||
parse :: (String, Term (Symbol DFO)) -> TestTree
|
||||
parse (s, expected) =
|
||||
testCase ("`" ++ s ++ "`") $
|
||||
@ -31,13 +37,17 @@ parseFail (s, reason) =
|
||||
Succeed _ n _ -> n == length s;
|
||||
|
||||
tests :: TestTree
|
||||
tests = testGroup "TermParser" $ (parse <$> shouldPass) ++ (parseFail <$> shouldFail)
|
||||
tests = testGroup "TermParser" $ (parse <$> shouldPass)
|
||||
++ (parse' <$> shouldParse)
|
||||
++ (parseFail <$> shouldFail)
|
||||
where
|
||||
shouldFail =
|
||||
[ ("+", "operator needs to be enclosed in parens or between arguments")
|
||||
, ("#V-fXHD3-N0E", "invalid base64url")
|
||||
, ("#V-f/XHD3-N0E", "invalid base64url")
|
||||
]
|
||||
shouldParse =
|
||||
[ "do Remote n1 := Remote.spawn; n2 := Remote.spawn; let rec x = 10; Remote.pure 42;;; ;" ]
|
||||
shouldPass =
|
||||
[ ("1", one)
|
||||
, ("[1,1]", vector [one, one])
|
||||
@ -88,7 +98,7 @@ tests = testGroup "TermParser" $ (parse <$> shouldPass) ++ (parseFail <$> should
|
||||
, ("let rec fix f = f (fix f); fix;;", fix) -- fix
|
||||
, ("1 + 2 + 3", num 1 `plus'` num 2 `plus'` num 3)
|
||||
, ("[1, 2, 1 + 1]", vector [num 1, num 2, num 1 `plus'` num 1])
|
||||
, ("(id -> let x = id 42; y = id \"hi\"; 43;;) : (forall a.a) -> Number", lam' ["id"] (let1'
|
||||
, ("(id -> let x = id 42; y = id \"hi\"; 43;;) : (forall a . a) -> Number", lam' ["id"] (let1'
|
||||
[ ("x", var' "id" `app` num 42),
|
||||
("y", var' "id" `app` text "hi")
|
||||
] (num 43)) `ann` (T.forall' ["a"] (T.v' "a") `T.arrow` T.lit T.Number))
|
||||
|
@ -37,7 +37,7 @@ tests = testGroup "TypeParser" $ fmap parseV strings
|
||||
, ("Vector Foo", T.vectorOf foo)
|
||||
, ("forall a . a -> a", forall_aa)
|
||||
, ("forall a. a -> a", forall_aa)
|
||||
, ("(forall a.a) -> Number", T.forall' ["a"] (T.v' "a") `T.arrow` T.lit T.Number)
|
||||
, ("(forall a . a) -> Number", T.forall' ["a"] (T.v' "a") `T.arrow` T.lit T.Number)
|
||||
]
|
||||
a = T.v' "a"
|
||||
foo = T.v' "Foo"
|
||||
|
@ -1,22 +1,32 @@
|
||||
identity : ∀ a . a -> a;
|
||||
identity a = a;
|
||||
|
||||
const x y = x;
|
||||
|
||||
then : ∀ a b c . (a -> b) -> (b -> c) -> a -> c;
|
||||
then f1 f2 x = f2 (f1 x);
|
||||
|
||||
flip : ∀ a b c . (a -> b -> c) -> b -> a -> c;
|
||||
flip f b a = f a b;
|
||||
|
||||
first : ∀ a b . Pair a b -> a;
|
||||
first p = Pair.fold const p;
|
||||
|
||||
rest : ∀ a b . Pair a b -> b;
|
||||
rest p = Pair.fold (x y -> y) p;
|
||||
|
||||
1st = first;
|
||||
2nd = rest `then` first;
|
||||
3rd = rest `then` (rest `then` first);
|
||||
4th = rest `then` (rest `then` (rest `then` first));
|
||||
5th = rest `then` (rest `then` (rest `then` (rest `then` first)));
|
||||
|
||||
Remote.transfer : Node -> Remote Unit;
|
||||
Remote.transfer node = Remote.at node unit;
|
||||
|
||||
Remote.map : ∀ a b . (a -> b) -> Remote a -> Remote b;
|
||||
Remote.map f = Remote.bind (f `then` Remote.pure);
|
||||
|
||||
Remote =
|
||||
( Remote.pure : ∀ a . a -> Remote a
|
||||
, Remote.bind : ∀ a b . (a -> Remote b) -> Remote a -> Remote b);
|
||||
|
||||
Vector.replicate : ∀ a . Number -> a -> Vector a;
|
||||
Vector.replicate n a = Vector.map (const a) (Vector.range 0 n);
|
||||
|
||||
@ -77,16 +87,3 @@ Either.bind = Either.fold Left;
|
||||
Either.swap : ∀ a b . Either a b -> Either b a;
|
||||
Either.swap e = Either.fold Right Left e;
|
||||
|
||||
const x y = x;
|
||||
|
||||
first : ∀ a b . Pair a b -> a;
|
||||
first p = Pair.fold const p;
|
||||
|
||||
rest : ∀ a b . Pair a b -> b;
|
||||
rest p = Pair.fold (x y -> y) p;
|
||||
|
||||
1st = first;
|
||||
2nd = rest `then` first;
|
||||
3rd = rest `then` (rest `then` first);
|
||||
4th = rest `then` (rest `then` (rest `then` first));
|
||||
5th = rest `then` (rest `then` (rest `then` (rest `then` first)));
|
||||
|
@ -1,4 +1,4 @@
|
||||
|
||||
Index.empty : ∀ k v . Remote (Index k v);
|
||||
Index.empty =
|
||||
Remote.map Index.unsafeEmpty Remote.here;
|
||||
Remote.map Index.empty# Remote.here;
|
||||
|
@ -1,14 +1,17 @@
|
||||
-- run from unison root directory
|
||||
-- curl -H "Content-Type: text/plain; charset=UTF-8" --data-binary @node/tests/pingpong.u http://localhost:8081/compute/dummynode909
|
||||
-- curl -H "Content-Type: text/plain; charset=UTF-8" --data-binary @unison-src/pingpong.u http://localhost:8081/compute/root
|
||||
|
||||
Remote {
|
||||
do Remote
|
||||
n1 := Remote.spawn;
|
||||
n2 := Remote.spawn;
|
||||
let rec
|
||||
ping i = Remote {
|
||||
ping i = do Remote
|
||||
i := Remote.at n2 (i + 1);
|
||||
if (i >= 5) (pure i) (pong i);
|
||||
};
|
||||
pong i = Remote { i := Remote.at n1 (i + 1); ping i; }
|
||||
in ping 0;
|
||||
}
|
||||
if (i >= 5) (pure i) (pong i);;
|
||||
;
|
||||
pong i = do Remote
|
||||
i := Remote.at n1 (i + 1);
|
||||
ping i;;
|
||||
;
|
||||
ping 0;;
|
||||
;;
|
||||
|
Loading…
Reference in New Issue
Block a user