unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-09-22 07:48:10 +03:00
Code Issues Projects Releases Wiki Activity

add consistent list naming

Browse Source
This commit is contained in:
ninifaroux 2021-03-03 17:26:09 +00:00 committed by nini-faroux
parent 2b83c963f4
commit f4b8e87258
23 changed files with 84 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
CONTRIBUTORS.markdown
View File

@ -49,3 +49,4 @@ The format for this list: name, GitHub handle, and then optional blurb about wha
* Hakim Cassimally (@osfameron) - vim support
* Will Badart (@wbadart)
* Sam Roberts (@samgqroberts)
* Nigel Farrelly (@nini-faroux)

2
parser-typechecker/src/Unison/Builtin.hs
View File

@ -620,7 +620,7 @@ app :: Ord v => Type v -> Type v -> Type v
app = Type.app ()
list :: Ord v => Type v -> Type v
list arg = Type.vector () `app` arg
list arg = Type.list () `app` arg
optionalt :: Ord v => Type v -> Type v
optionalt arg = DD.optionalType () `app` arg

6
parser-typechecker/src/Unison/Builtin/Decls.hs
View File

@ -270,7 +270,7 @@ builtinDataDecls = rs1 ++ rs
, ((), v "Doc.Signature", Type.termLink () `arr` var "Doc")
, ((), v "Doc.Source", Type.refId () linkRef `arr` var "Doc")
, ((), v "Doc.Evaluate", Type.termLink () `arr` var "Doc")
, ((), v "Doc.Join", Type.app () (Type.vector()) (var "Doc") `arr` var "Doc")
, ((), v "Doc.Join", Type.app () (Type.list()) (var "Doc") `arr` var "Doc")
]
link = DataDeclaration
(Unique "a5803524366ead2d7f3780871d48771e8142a3b48802f34a96120e230939c46bd5e182fcbe1fa64e9bff9bf741f3c04")
@ -292,7 +292,7 @@ pattern TuplePattern ps <- (unTuplePattern -> Just ps)
-- some pattern synonyms to make pattern matching on some of these constants more pleasant
pattern DocRef <- ((== docRef) -> True)
pattern DocJoin segs <- Term.App' (Term.Constructor' DocRef DocJoinId) (Term.Sequence' segs)
pattern DocJoin segs <- Term.App' (Term.Constructor' DocRef DocJoinId) (Term.List' segs)
pattern DocBlob txt <- Term.App' (Term.Constructor' DocRef DocBlobId) (Term.Text' txt)
pattern DocLink link <- Term.App' (Term.Constructor' DocRef DocLinkId) link
pattern DocSource link <- Term.App' (Term.Constructor' DocRef DocSourceId) link
@ -317,7 +317,7 @@ unitType, pairType, optionalType, testResultType,
:: Ord v => a -> Type v a
unitType a = Type.ref a unitRef
pairType a = Type.ref a pairRef
testResultType a = Type.app a (Type.vector a) (Type.ref a testResultRef)
testResultType a = Type.app a (Type.list a) (Type.ref a testResultRef)
optionalType a = Type.ref a optionalRef
eitherType a = Type.ref a eitherRef
ioErrorType a = Type.ref a ioErrorRef

2
parser-typechecker/src/Unison/Codebase/Editor/AuthorInfo.hs
View File

@ -31,7 +31,7 @@ createAuthorInfo a t = createAuthorInfo' . unpack <$> liftIO (getRandomBytes 32)
(Term.constructor a guidTypeRef 0)
(Term.app a
(Term.builtin a "Bytes.fromList")
(Term.seq a (map (Term.nat a . fromIntegral) bytes)))
(Term.list a (map (Term.nat a . fromIntegral) bytes)))
[(authorRef, authorTerm)] = hashAndWrangle "author" $
Term.apps

8
parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs
View File

@ -1469,12 +1469,12 @@ loop = do
testRefs = Set.fromList [ r | Referent.Ref r <- toList testTerms ]
oks results =
[ (r, msg)
| (r, Term.Sequence' ts) <- Map.toList results
| (r, Term.List' ts) <- Map.toList results
, Term.App' (Term.Constructor' ref cid) (Term.Text' msg) <- toList ts
, cid == DD.okConstructorId && ref == DD.testResultRef ]
fails results =
[ (r, msg)
| (r, Term.Sequence' ts) <- Map.toList results
| (r, Term.List' ts) <- Map.toList results
, Term.App' (Term.Constructor' ref cid) (Term.Text' msg) <- toList ts
, cid == DD.failConstructorId && ref == DD.testResultRef ]
cachedTests <- fmap Map.fromList . eval $ LoadWatches UF.TestWatch testRefs
@ -1556,12 +1556,12 @@ loop = do
oks results =
[ (r, msg)
| (r, Term.Sequence' ts) <- results
| (r, Term.List' ts) <- results
, Term.App' (Term.Constructor' ref cid) (Term.Text' msg) <- toList ts
, cid == DD.okConstructorId && ref == DD.testResultRef ]
fails results =
[ (r, msg)
| (r, Term.Sequence' ts) <- results
| (r, Term.List' ts) <- results
, Term.App' (Term.Constructor' ref cid) (Term.Text' msg) <- toList ts
, cid == DD.failConstructorId && ref == DD.testResultRef ]

2
parser-typechecker/src/Unison/Codebase/MainTerm.hs
View File

@ -75,7 +75,7 @@ builtinMain a =
-- [Result]
resultArr :: Ord v => a -> Type.Type v a
resultArr a = Type.app a (Type.ref a Type.vectorRef) (Type.ref a DD.testResultRef)
resultArr a = Type.app a (Type.ref a Type.listRef) (Type.ref a DD.testResultRef)
-- {IO} [Result]
ioResultArr :: Ord v => a -> Type.Type v a

4
parser-typechecker/src/Unison/Codebase/Serialization/V1.hs
View File

@ -512,7 +512,7 @@ putTerm putVar putA = putABT putVar putA go where
-> putWord8 9 *> putChild f *> putChild arg
Term.Ann e t
-> putWord8 10 *> putChild e *> putType putVar putA t
Term.Sequence vs
Term.List vs
-> putWord8 11 *> putFoldable putChild vs
Term.If cond t f
-> putWord8 12 *> putChild cond *> putChild t *> putChild f
@ -554,7 +554,7 @@ getTerm getVar getA = getABT getVar getA go where
8 -> Term.Handle <$> getChild <*> getChild
9 -> Term.App <$> getChild <*> getChild
10 -> Term.Ann <$> getChild <*> getType getVar getA
11 -> Term.Sequence . Sequence.fromList <$> getList getChild
11 -> Term.List . Sequence.fromList <$> getList getChild
12 -> Term.If <$> getChild <*> getChild <*> getChild
13 -> Term.And <$> getChild <*> getChild
14 -> Term.Or <$> getChild <*> getChild

2
parser-typechecker/src/Unison/Codecs.hs
View File

@ -103,7 +103,7 @@ serializeTerm x = do
putWord8 6
serializeBoolean b
incPosition
Sequence v -> do
List v -> do
elementPositions <- traverse serializeTerm v
putTag
putWord8 7

4
parser-typechecker/src/Unison/CommandLine/OutputMessages.hs
View File

@ -1902,7 +1902,7 @@ watchPrinter src ppe ann kind term isHit =
P.lines
[ fromString (show lineNum) <> " | " <> P.text line
, case (kind, term) of
(UF.TestWatch, Term.Sequence' tests) -> foldMap renderTest tests
(UF.TestWatch, Term.List' tests) -> foldMap renderTest tests
_ -> P.lines
[ fromString (replicate lineNumWidth ' ')
<> fromString extra
@ -2020,7 +2020,7 @@ prettyRepoBranch (RemoteRepo.GitRepo url treeish) =
isTestOk :: Term v Ann -> Bool
isTestOk tm = case tm of
Term.Sequence' ts -> all isSuccess ts where
Term.List' ts -> all isSuccess ts where
isSuccess (Term.App' (Term.Constructor' ref cid) _) =
cid == DD.okConstructorId &&
ref == DD.testResultRef

8
parser-typechecker/src/Unison/Runtime/ANF.hs
View File

@ -80,7 +80,7 @@ import Data.Functor.Compose (Compose(..))
import Data.List hiding (and,or)
import Prelude hiding (abs,and,or,seq)
import qualified Prelude
import Unison.Term hiding (resolve, fresh, float, Text, Ref)
import Unison.Term hiding (resolve, fresh, float, Text, Ref, List)
import Unison.Var (Var, typed)
import Unison.Util.EnumContainers as EC
import Unison.Util.Bytes (Bytes)
@ -469,9 +469,9 @@ fromTerm liftVar t = ANF_ (go $ lambdaLift liftVar t) where
go (Let1Named' v b e) = let1' False [(v, go b)] (go e)
-- top = False because we don't care to emit typechecker notes about TLDs
go (LetRecNamed' bs e) = letRec' False (fmap (second go) bs) (go e)
go e@(Sequence' vs) =
go e@(List' vs) =
if all isLeaf vs then e
else fixup (ABT.freeVars e) (seq (ann e)) (toList vs)
else fixup (ABT.freeVars e) (list (ann e)) (toList vs)
go e@(Ann' tm typ) = Term.ann (ann e) (go tm) typ
go e = error $ "ANF.term: I thought we got all of these\n" <> show e
@ -1162,7 +1162,7 @@ anfBlock (Blank' _) = do
, pure $ TPrm EROR [ev])
anfBlock (TermLink' r) = pure (mempty, pure . TLit $ LM r)
anfBlock (TypeLink' r) = pure (mempty, pure . TLit $ LY r)
anfBlock (Sequence' as) = fmap (pure . TPrm BLDS) <$> anfArgs tms
anfBlock (List' as) = fmap (pure . TPrm BLDS) <$> anfArgs tms
where
tms = toList as
anfBlock t = error $ "anf: unhandled term: " ++ show t

11
parser-typechecker/src/Unison/Runtime/Decompile.hs
View File

@ -6,17 +6,16 @@
module Unison.Runtime.Decompile
( decompile ) where
import Prelude hiding (seq)
import Unison.Prelude
import Unison.ABT (absChain, substs, pattern AbsN')
import Unison.Term
( Term
, nat, int, char, float, boolean, constructor, app, apps', text, ref
, seq, seq', builtin, termLink, typeLink
, list, list', builtin, termLink, typeLink
)
import Unison.Type
( natRef, intRef, charRef, floatRef, booleanRef, vectorRef
( natRef, intRef, charRef, floatRef, booleanRef, listRef
, termLinkRef, typeLinkRef, anyRef
)
import Unison.Var (Var)
@ -110,16 +109,16 @@ decompileForeign topTerms f
| Just l <- maybeUnwrapForeign typeLinkRef f
= Right $ typeLink () l
| Just s <- unwrapSeq f
= seq' () <$> traverse (decompile topTerms) s
= list' () <$> traverse (decompile topTerms) s
decompileForeign _ _ = err "cannot decompile Foreign"
decompileBytes :: Var v => By.Bytes -> Term v ()
decompileBytes
= app () (builtin () $ fromString "Bytes.fromList")
. seq () . fmap (nat () . fromIntegral) . By.toWord8s
. list () . fmap (nat () . fromIntegral) . By.toWord8s
decompileHashAlgorithm :: Var v => HashAlgorithm -> Term v ()
decompileHashAlgorithm (HashAlgorithm r _) = ref () r
unwrapSeq :: Foreign -> Maybe (Seq Closure)
unwrapSeq = maybeUnwrapForeign vectorRef
unwrapSeq = maybeUnwrapForeign listRef

8
parser-typechecker/src/Unison/Runtime/IR.hs
View File

@ -512,7 +512,7 @@ compile0 env bound t =
msg = "The program being compiled referenced this definition " <>
show r <> "\nbut the compilation environment has no compiled form for this reference."
Just ir -> ir
Term.Sequence' vs -> MakeSequence . toList . fmap (toZ "sequence" t) $ vs
Term.List' vs -> MakeSequence . toList . fmap (toZ "sequence" t) $ vs
_ -> error $ "TODO - don't know how to compile this term:\n"
<> (CT.toPlain . P.render 80 . TP.pretty mempty $ void t)
where
@ -616,13 +616,13 @@ decompileImpl v = case v of
T t -> pure $ Term.text () t
C c -> pure $ Term.char () c
Bs bs -> pure $ Term.builtin() "Bytes.fromList" `Term.apps'` [bsv] where
bsv = Term.seq'() . Sequence.fromList $
bsv = Term.list'() . Sequence.fromList $
[ Term.nat() (fromIntegral w8) | w8 <- Bytes.toWord8s bs ]
Lam _ f _ -> decompileUnderapplied f
Data r cid args ->
Term.apps' <$> pure (Term.constructor() r cid)
<*> traverse decompileImpl (toList args)
Sequence vs -> Term.seq' () <$> traverse decompileImpl vs
Sequence vs -> Term.list' () <$> traverse decompileImpl vs
Ref id symbol ioref -> do
seen <- gets snd
symbol <- pure $ Var.freshenId (fromIntegral id) symbol
@ -809,7 +809,7 @@ decompileIR stack = \case
body' <- decompileIR stack' body
pure $ Term.letRec' False bs' body'
MakeSequence args ->
Term.seq() <$> traverse decompileZ args
Term.list() <$> traverse decompileZ args
Apply lam args ->
Term.apps' <$> decompileIR stack lam <*> traverse decompileZ args
Construct r cid args ->

4
parser-typechecker/src/Unison/Runtime/Machine.hs
View File

@ -1508,7 +1508,7 @@ reflectValue rty = goV
= pure (ANF.Text t)
| Just b <- maybeUnwrapBuiltin f
= pure (ANF.Bytes b)
| Just s <- maybeUnwrapForeign Rf.vectorRef f
| Just s <- maybeUnwrapForeign Rf.listRef f
= ANF.List <$> traverse goV s
| Just l <- maybeUnwrapForeign Rf.termLinkRef f
= pure (ANF.TmLink l)
@ -1569,7 +1569,7 @@ reifyValue0 (rty, rtm) = goV
<$> (goIx gr) <*> goK k
goL (ANF.Text t) = pure . Foreign $ Wrap Rf.textRef t
goL (ANF.List l) = Foreign . Wrap Rf.vectorRef <$> traverse goV l
goL (ANF.List l) = Foreign . Wrap Rf.listRef <$> traverse goV l
goL (ANF.TmLink r) = pure . Foreign $ Wrap Rf.termLinkRef r
goL (ANF.TyLink r) = pure . Foreign $ Wrap Rf.typeLinkRef r
goL (ANF.Bytes b) = pure . Foreign $ Wrap Rf.bytesRef b

8
parser-typechecker/src/Unison/Runtime/Pattern.hs
View File

@ -431,7 +431,7 @@ splitMatrixSeq v (PM rs)
ms = decideSeqPat $ take 1 . dropWhile ((/=v).loc) . matches =<< rs
hint m vrs
| m `elem` [E,C,S] = vrs
| otherwise = (fmap.fmap) (const $ PData Rf.vectorRef) vrs
| otherwise = (fmap.fmap) (const $ PData Rf.listRef) vrs
cases = ms <&> \m ->
let frs = rs >>= splitRowSeq v m
(vrs, pm) = buildMatrix frs
@ -569,7 +569,7 @@ compile spec ctx m@(PM (r:rs))
Nothing -> body r
Just g -> iff mempty g (body r) $ compile spec ctx (PM rs)
| PData rf <- ty
, rf == Rf.vectorRef
, rf == Rf.listRef
= match () (var () v)
$ buildCaseBuiltin spec ctx
<$> splitMatrixSeq v m
@ -716,8 +716,8 @@ determineType = foldMap f
f P.Boolean{} = PData Rf.booleanRef
f P.Text{} = PData Rf.textRef
f P.Char{} = PData Rf.charRef
f P.SequenceLiteral{} = PData Rf.vectorRef
f P.SequenceOp{} = PData Rf.vectorRef
f P.SequenceLiteral{} = PData Rf.listRef
f P.SequenceOp{} = PData Rf.listRef
f (P.Constructor _ r _ _) = PData r
f (P.EffectBind _ r _ _ _) = PReq $ Set.singleton r
f P.EffectPure{} = PReq mempty

8
parser-typechecker/src/Unison/Runtime/Stack.hs
View File

@ -189,8 +189,8 @@ universalCompare frn = cmpc False
<> cmpl compare us1 us2
<> cmpl (cmpc True) bs1 bs2
cmpc tyEq (Foreign fl) (Foreign fr)
| Just sl <- maybeUnwrapForeign Ty.vectorRef fl
, Just sr <- maybeUnwrapForeign Ty.vectorRef fr
| Just sl <- maybeUnwrapForeign Ty.listRef fl
, Just sr <- maybeUnwrapForeign Ty.listRef fr
= comparing Sq.length sl sr <> fold (Sq.zipWith (cmpc tyEq) sl sr)
| otherwise = frn fl fr
cmpc _ c d = comparing closureNum c d
@ -502,11 +502,11 @@ peekOffS bstk i =
{-# inline peekOffS #-}
pokeS :: Stack 'BX -> Seq Closure -> IO ()
pokeS bstk s = poke bstk (Foreign $ Wrap Ty.vectorRef s)
pokeS bstk s = poke bstk (Foreign $ Wrap Ty.listRef s)
{-# inline pokeS #-}
pokeOffS :: Stack 'BX -> Int -> Seq Closure -> IO ()
pokeOffS bstk i s = pokeOff bstk i (Foreign $ Wrap Ty.vectorRef s)
pokeOffS bstk i s = pokeOff bstk i (Foreign $ Wrap Ty.listRef s)
{-# inline pokeOffS #-}
unull :: Seg 'UN

14
parser-typechecker/src/Unison/TermParser.hs
View File

@ -323,8 +323,8 @@ boolean :: Var v => TermP v
boolean = ((\t -> Term.boolean (ann t) True) <$> reserved "true") <|>
((\t -> Term.boolean (ann t) False) <$> reserved "false")
seq :: Var v => TermP v -> TermP v
seq = Parser.seq Term.seq
list :: Var v => TermP v -> TermP v
list = Parser.seq Term.list
hashQualifiedPrefixTerm :: Var v => TermP v
hashQualifiedPrefixTerm = resolveHashQualified =<< hqPrefixId
@ -357,7 +357,7 @@ termLeaf =
, link
, tupleOrParenthesizedTerm
, keywordBlock
, seq term
, list term
, delayQuote
, bang
, docBlock
@ -369,7 +369,7 @@ docBlock = do
segs <- many segment
closeTok <- closeBlock
let a = ann openTok <> ann closeTok
pure . docNormalize $ Term.app a (Term.constructor a DD.docRef DD.docJoinId) (Term.seq a segs)
pure . docNormalize $ Term.app a (Term.constructor a DD.docRef DD.docJoinId) (Term.list a segs)
where
segment = blob <|> linky
blob = do
@ -459,7 +459,7 @@ docNormalize :: (Ord v, Show v) => Term v a -> Term v a
docNormalize tm = case tm of
-- This pattern is just `DD.DocJoin seqs`, but exploded in order to grab
-- the annotations. The aim is just to map `normalize` over it.
a@(Term.App' c@(Term.Constructor' DD.DocRef DD.DocJoinId) s@(Term.Sequence' seqs))
a@(Term.App' c@(Term.Constructor' DD.DocRef DD.DocJoinId) s@(Term.List' seqs))
-> join (ABT.annotation a)
(ABT.annotation c)
(ABT.annotation s)
@ -657,7 +657,7 @@ docNormalize tm = case tm of
blob aa ac at txt =
Term.app aa (Term.constructor ac DD.docRef DD.docBlobId) (Term.text at txt)
join aa ac as segs =
Term.app aa (Term.constructor ac DD.docRef DD.docJoinId) (Term.seq' as segs)
Term.app aa (Term.constructor ac DD.docRef DD.docJoinId) (Term.list' as segs)
mapBlob :: Ord v => (Text -> Text) -> Term v a -> Term v a
-- this pattern is just `DD.DocBlob txt` but exploded to capture the annotations as well
mapBlob f (aa@(Term.App' ac@(Term.Constructor' DD.DocRef DD.DocBlobId) at@(Term.Text' txt)))
@ -913,7 +913,7 @@ bytes = do
b <- bytesToken
let a = ann b
pure $ Term.app a (Term.builtin a "Bytes.fromList")
(Term.seq a $ Term.nat a . fromIntegral <$> Bytes.toWord8s (L.payload b))
(Term.list a $ Term.nat a . fromIntegral <$> Bytes.toWord8s (L.payload b))
number'
:: Ord v

6
parser-typechecker/src/Unison/TermPrinter.hs
View File

@ -218,7 +218,7 @@ pretty0
paren (p >= 11) $ (fmt S.DelayForceChar $ l "!") <> pretty0 n (ac 11 Normal im doc) x
LamNamed' v x | (Var.name v) == "()" ->
paren (p >= 11) $ (fmt S.DelayForceChar $ l "'") <> pretty0 n (ac 11 Normal im doc) x
Sequence' xs -> PP.group $
List' xs -> PP.group $
(fmt S.DelimiterChar $ l "[") <> optSpace
<> intercalateMap ((fmt S.DelimiterChar $ l ",") <> PP.softbreak <> optSpace <> optSpace)
(pretty0 n (ac 0 Normal im doc))
@ -828,7 +828,7 @@ suffixCounterTerm n = \case
suffixCounterType :: Var v => PrettyPrintEnv -> Type v a -> PrintAnnotation
suffixCounterType n = \case
Type.Var' v -> countHQ $ HQ.unsafeFromVar v
Type.Ref' r | noImportRefs r || r == Type.vectorRef -> mempty
Type.Ref' r | noImportRefs r || r == Type.listRef -> mempty
Type.Ref' r -> countHQ $ PrettyPrintEnv.typeName n r
_ -> mempty
@ -1196,7 +1196,7 @@ unLamsMatch' t = case unLamsUntilDelay' t of
pattern Bytes' bs <- (toBytes -> Just bs)
toBytes :: Term3 v PrintAnnotation -> Maybe [Word64]
toBytes (App' (Builtin' "Bytes.fromList") (Sequence' bs)) =
toBytes (App' (Builtin' "Bytes.fromList") (List' bs)) =
toList <$> traverse go bs
where go (Nat' n) = Just n
go _ = Nothing

4
parser-typechecker/src/Unison/TypeParser.hs
View File

@ -67,7 +67,7 @@ type2 = do
tl <- many (effectList <|> valueTypeLeaf)
pure $ foldl' (\a b -> Type.app (ann a <> ann b) a b) hd tl
-- ex : {State Text, IO} (Sequence Int)
-- ex : {State Text, IO} (List Int)
effect :: Var v => TypeP v
effect = do
es <- effectList
@ -87,7 +87,7 @@ sequenceTyp = do
t <- valueType
close <- reserved "]"
let a = ann open <> ann close
pure $ Type.app a (Type.vector a) t
pure $ Type.app a (Type.list a) t
tupleOrParenthesizedType :: Var v => TypeP v -> TypeP v
tupleOrParenthesizedType rec = tupleOrParenthesized rec DD.unitType pair

24
parser-typechecker/src/Unison/Typechecker/Context.hs
View File

@ -831,7 +831,7 @@ vectorConstructorOfArity :: (Var v, Ord loc) => loc -> Int -> M v loc (Type v lo
vectorConstructorOfArity loc arity = do
let elementVar = Var.named "elem"
args = replicate arity (loc, Type.var loc elementVar)
resultType = Type.app loc (Type.vector loc) (Type.var loc elementVar)
resultType = Type.app loc (Type.list loc) (Type.var loc elementVar)
vt = Type.forall loc elementVar (Type.arrows args resultType)
pure vt
@ -912,7 +912,7 @@ synthesize e = scope (InSynthesize e) $
ctx <- getContext
(vs, ft) <- ungeneralize' ft
scope (InFunctionCall vs f ft args) $ synthesizeApps (apply ctx ft) args
go (Term.Sequence' v) = do
go (Term.List' v) = do
ft <- vectorConstructorOfArity (loc e) (Foldable.length v)
case Foldable.toList v of
[] -> pure ft
@ -1095,7 +1095,7 @@ checkPattern scrutineeType0 p =
let vt = existentialp loc v
appendContext [existential v]
-- ['a] <: scrutineeType, where 'a is fresh existential
subtype (Type.app loc (Type.vector loc) vt) scrutineeType
subtype (Type.app loc (Type.list loc) vt) scrutineeType
applyM vt
join <$> traverse (checkPattern vt) ps
Pattern.SequenceOp loc l op r -> do
@ -1104,20 +1104,20 @@ checkPattern scrutineeType0 p =
v <- freshenVar Var.inferOther
let vt = existentialp loc v
appendContext [existential v]
-- todo: `Type.vector loc` is super-probably wrong;
-- todo: `Type.list loc` is super-probably wrong;
-- I'm thinking it should be Ann.Intrinsic, but we don't
-- have access to that here.
subtype (Type.app loc (Type.vector loc) vt) scrutineeType
subtype (Type.app loc (Type.list loc) vt) scrutineeType
applyM vt
case op of
Pattern.Cons -> do
lvs <- checkPattern vt l
-- todo: same `Type.vector loc` thing
rvs <- checkPattern (Type.app locR (Type.vector locR) vt) r
-- todo: same `Type.list loc` thing
rvs <- checkPattern (Type.app locR (Type.list locR) vt) r
pure $ lvs ++ rvs
Pattern.Snoc -> do
-- todo: same `Type.vector loc` thing
lvs <- checkPattern (Type.app locL (Type.vector locL) vt) l
-- todo: same `Type.list loc` thing
lvs <- checkPattern (Type.app locL (Type.list locL) vt) l
rvs <- checkPattern vt r
pure $ lvs ++ rvs
Pattern.Concat ->
@ -1125,11 +1125,11 @@ checkPattern scrutineeType0 p =
(p, _) | isConstLen p -> f
(_, p) | isConstLen p -> f
(_, _) -> lift . failWith $
ConcatPatternWithoutConstantLength loc (Type.app loc (Type.vector loc) vt)
ConcatPatternWithoutConstantLength loc (Type.app loc (Type.list loc) vt)
where
f = liftA2 (++) (g locL l) (g locR r)
-- todo: same `Type.vector loc` thing
g l p = checkPattern (Type.app l (Type.vector l) vt) p
-- todo: same `Type.list loc` thing
g l p = checkPattern (Type.app l (Type.list l) vt) p
-- Only pertains to sequences, returns False if not a sequence
isConstLen :: Pattern loc -> Bool

8
unison-core/src/Unison/Paths.hs
View File

@ -96,9 +96,9 @@ focus1 e = ABT.Path go'
)
go Bound (Type (T.ForallNamed' v body)) = Just
(Var v, \v -> Type <$> (T.forall () <$> asVar v <*> pure (wt body)), [])
go (Index i) (Term (E.Sequence' vs)) | i < Sequence.length vs && i >= 0 = Just
go (Index i) (Term (E.List' vs)) | i < Sequence.length vs && i >= 0 = Just
( Term (vs `Sequence.index` i)
, \e -> (\e -> Term $ E.seq' () $ Sequence.update i e (fmap w vs)) <$> asTerm e
, \e -> (\e -> Term $ E.list' () $ Sequence.update i e (fmap w vs)) <$> asTerm e
, []
)
go (Binding i) (Term (E.Let1NamedTop' top v b body)) | i <= 0 = Just
@ -164,9 +164,9 @@ insertTerm at ctx = do
let at' = init at
(parent,set,_) <- focus at' (Term ctx)
case parent of
Term (E.Sequence' vs) -> do
Term (E.List' vs) -> do
i <- listToMaybe [i | Index i <- toList (lastMay at)]
let v2 = E.seq'() ((E.vmap ABT.Bound <$> Sequence.take (i+1) vs) `mappend`
let v2 = E.list'() ((E.vmap ABT.Bound <$> Sequence.take (i+1) vs) `mappend`
pure (E.blank ()) `mappend`
(E.vmap ABT.Bound <$> Sequence.drop (i+1) vs))
asTerm =<< set (Term v2)

4
unison-core/src/Unison/Pattern.hs
View File

@ -147,8 +147,8 @@ generalizedDependencies literalType dataConstructor dataType effectConstructor e
EffectPure _ _ -> [effectType Type.effectRef]
EffectBind _ r cid _ _ ->
[effectType Type.effectRef, effectType r, effectConstructor r cid]
SequenceLiteral _ _ -> [literalType Type.vectorRef]
SequenceOp {} -> [literalType Type.vectorRef]
SequenceLiteral _ _ -> [literalType Type.listRef]
SequenceOp {} -> [literalType Type.listRef]
Boolean _ _ -> [literalType Type.booleanRef]
Int _ _ -> [literalType Type.intRef]
Nat _ _ -> [literalType Type.natRef]

22
unison-core/src/Unison/Term.hs
View File

@ -72,7 +72,7 @@ data F typeVar typeAnn patternAnn a
| Handle a a
| App a a
| Ann a (Type typeVar typeAnn)
| Sequence (Seq a)
| List (Seq a)
| If a a a
| And a a
| Or a a
@ -246,7 +246,7 @@ extraMap vtf atf apf = \case
Handle x y -> Handle x y
App x y -> App x y
Ann tm x -> Ann tm (ABT.amap atf (ABT.vmap vtf x))
Sequence x -> Sequence x
List x -> List x
If x y z -> If x y z
And x y -> And x y
Or x y -> Or x y
@ -434,7 +434,7 @@ pattern BinaryApps' apps lastArg <- (unBinaryApps -> Just (apps, lastArg))
pattern BinaryAppsPred' apps lastArg <- (unBinaryAppsPred -> Just (apps, lastArg))
-- end pretty-printer helper patterns
pattern Ann' x t <- (ABT.out -> ABT.Tm (Ann x t))
pattern Sequence' xs <- (ABT.out -> ABT.Tm (Sequence xs))
pattern List' xs <- (ABT.out -> ABT.Tm (List xs))
pattern Lam' subst <- ABT.Tm' (Lam (ABT.Abs' subst))
pattern LamNamed' v body <- (ABT.out -> ABT.Tm (Lam (ABT.Term _ _ (ABT.Abs v body))))
pattern LamsNamed' vs body <- (unLams' -> Just (vs, body))
@ -540,11 +540,11 @@ and a x y = ABT.tm' a (And x y)
or :: Ord v => a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
or a x y = ABT.tm' a (Or x y)
seq :: Ord v => a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
seq a es = seq' a (Sequence.fromList es)
list :: Ord v => a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
list a es = list' a (Sequence.fromList es)
seq' :: Ord v => a -> Seq (Term2 vt at ap v a) -> Term2 vt at ap v a
seq' a es = ABT.tm' a (Sequence es)
list' :: Ord v => a -> Seq (Term2 vt at ap v a) -> Term2 vt at ap v a
list' a es = ABT.tm' a (List es)
apps
:: Ord v
@ -866,7 +866,7 @@ generalizedDependencies termRef typeRef literalType dataConstructor dataType eff
f t@(Float _) = Writer.tell [literalType Type.floatRef] $> t
f t@(Boolean _) = Writer.tell [literalType Type.booleanRef] $> t
f t@(Text _) = Writer.tell [literalType Type.textRef] $> t
f t@(Sequence _) = Writer.tell [literalType Type.vectorRef] $> t
f t@(List _) = Writer.tell [literalType Type.listRef] $> t
f t@(Constructor r cid) =
Writer.tell [dataType r, dataConstructor r cid] $> t
f t@(Request r cid) =
@ -1016,7 +1016,7 @@ instance Var v => Hashable1 (F v a p) where
error "handled above, but GHC can't figure this out"
App a a2 -> [tag 3, hashed (hash a), hashed (hash a2)]
Ann a t -> [tag 4, hashed (hash a), hashed (ABT.hash t)]
Sequence as -> tag 5 : varint (Sequence.length as) : map
List as -> tag 5 : varint (Sequence.length as) : map
(hashed . hash)
(toList as)
Lam a -> [tag 6, hashed (hash a)]
@ -1067,7 +1067,7 @@ instance (ABT.Var vt, Eq at, Eq a) => Eq (F vt at p a) where
Handle h b == Handle h2 b2 = h == h2 && b == b2
App f a == App f2 a2 = f == f2 && a == a2
Ann e t == Ann e2 t2 = e == e2 && t == t2
Sequence v == Sequence v2 = v == v2
List v == List v2 = v == v2
If a b c == If a2 b2 c2 = a == a2 && b == b2 && c == c2
And a b == And a2 b2 = a == a2 && b == b2
Or a b == Or a2 b2 = a == a2 && b == b2
@ -1091,7 +1091,7 @@ instance (Show v, Show a) => Show (F v a0 p a) where
go p (Ann t k) = showParen (p > 1) $ shows t <> s ":" <> shows k
go p (App f x) = showParen (p > 9) $ showsPrec 9 f <> s " " <> showsPrec 10 x
go _ (Lam body ) = showParen True (s "λ " <> shows body)
go _ (Sequence vs ) = showListWith shows (toList vs)
go _ (List vs ) = showListWith shows (toList vs)
go _ (Blank b ) = case b of
B.Blank -> s "_"
B.Recorded (B.Placeholder _ r) -> s ("_" ++ r)

8
unison-core/src/Unison/Type.hs
View File

@ -206,14 +206,14 @@ derivedBase32Hex r a = ref a r
-- derivedBase58' :: Text -> Reference
-- derivedBase58' base58 = Reference.derivedBase58 base58 0 1
intRef, natRef, floatRef, booleanRef, textRef, charRef, vectorRef, bytesRef, effectRef, termLinkRef, typeLinkRef :: Reference
intRef, natRef, floatRef, booleanRef, textRef, charRef, listRef, bytesRef, effectRef, termLinkRef, typeLinkRef :: Reference
intRef = Reference.Builtin "Int"
natRef = Reference.Builtin "Nat"
floatRef = Reference.Builtin "Float"
booleanRef = Reference.Builtin "Boolean"
textRef = Reference.Builtin "Text"
charRef = Reference.Builtin "Char"
vectorRef = Reference.Builtin "Sequence"
listRef = Reference.Builtin "Sequence"
bytesRef = Reference.Builtin "Bytes"
effectRef = Reference.Builtin "Effect"
termLinkRef = Reference.Builtin "Link.Term"
@ -300,8 +300,8 @@ builtinIO a = ref a builtinIORef
socket :: Ord v => a -> Type v a
socket a = ref a socketRef
vector :: Ord v => a -> Type v a
vector a = ref a vectorRef
list :: Ord v => a -> Type v a
list a = ref a listRef
bytes :: Ord v => a -> Type v a
bytes a = ref a bytesRef