Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

fixes #1963 #1968

Merged
merged 1 commit into from
Nov 5, 2024
Merged

fixes #1963 #1968

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
9 changes: 5 additions & 4 deletions compiler/Acton/Parser.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1366,9 +1366,9 @@ ttype = addLoc (
rword "None" *> return (S.TNone NoLoc)
<|> (S.TVar NoLoc . S.TV S.KType) <$> (S.Name <$> rwordLoc "Self" <*> return "Self")
<|> S.TOpt NoLoc <$> (qmark *> ttype)
<|> braces (do t <- ttype
mbt <- optional (colon *> ttype)
return (maybe (Builtin.tSetExist t) (Builtin.tMapping t) mbt))
-- <|> braces (do t <- ttype
-- mbt <- optional (colon *> ttype)
-- return (maybe (Builtin.tSetExist t) (Builtin.tMapping t) mbt))
<|> try (do mbfx <- optional effect
(p,k) <- parens funrows
arrow
Expand All @@ -1379,7 +1379,8 @@ ttype = addLoc (
Left (p,k) -> return (S.TTuple NoLoc p k)
Right t -> return t)
<|> parens (return (S.TTuple NoLoc S.posNil S.kwdNil))
<|> try (brackets (Builtin.tSequence <$> ttype))
-- <|> try (brackets (Builtin.tSequence <$> ttype))
<|> try (S.TVar NoLoc <$> tvar)
<|> rword "_" *> return (S.TWild NoLoc)
<|> S.TCon NoLoc <$> tcon)
<?> "type"
26 changes: 13 additions & 13 deletions compiler/Acton/Types.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -447,7 +447,7 @@ matchDefAssumption env cs def
(pos0,kwd0) = qual env dec (pos def) (kwd def) (qualWPar env q0)

match env cs eq0 def = do (cs2,eq1) <- solveScoped env0 (qbound q0) [] t1 (Cast info t1 t2 : cs)
checkNoEscape env (qbound q0)
checkNoEscape (loc def) env (qbound q0)
cs2 <- msubst cs2
return (cs2, def{ qbinds = noqual env q0, pos = pos0, kwd = kwd0, dbody = bindWits (eq0++eq1) ++ dbody def })
where t1 = tFun (dfx def) (prowOf $ pos def) (krowOf $ kwd def) (fromJust $ ann def)
Expand Down Expand Up @@ -499,7 +499,7 @@ instance InfEnv Decl where
(cs,te,b1) <- infEnv env1 b
popFX
(cs1,eq1) <- solveScoped env1 (qbound q) te tNone cs
checkNoEscape env (qbound q)
checkNoEscape l env (qbound q)
(nterms,asigs,_) <- checkAttributes [] te' te
let te1 = if notImplBody b then unSig asigs else []
te2 = te ++ te1
Expand All @@ -519,7 +519,7 @@ instance InfEnv Decl where
(cs,te,b') <- infEnv env1 b
popFX
(cs1,eq1) <- solveScoped env1 (qbound q) te tNone cs
checkNoEscape env (qbound q)
checkNoEscape l env (qbound q)
(nterms,_,sigs) <- checkAttributes [] te' te
let noself = [ n | (n, NSig sc Static) <- te, tvSelf `notElem` tyfree sc ]
when (notImplBody b) $ err0 (notImpls b) "A protocol body cannot be NotImplemented"
Expand All @@ -541,7 +541,7 @@ instance InfEnv Decl where
(cs,te,b1) <- infEnv env1 b
popFX
(cs1,eq1) <- solveScoped env1 (qbound q) te tNone cs
checkNoEscape env (qbound q)
checkNoEscape l env (qbound q)
(nterms,asigs,sigs) <- checkAttributes final te' te
when (not $ null nterms) $ err2 (dom nterms) "Method/attribute not in listed protocols:"
when (not $ null sigs) $ err2 sigs "Extension with new methods/attributes not supported"
Expand Down Expand Up @@ -602,13 +602,13 @@ solveScoped env vs te tt cs = do --traceM ("\n\n### solveScoped: " +
(cs,eq) <- simplify env te tt cs
solve env (any (`elem` vs) . tyfree) te tt eq cs

checkNoEscape env [] = return ()
checkNoEscape env vs = do fvs <- tyfree <$> msubst env
checkNoEscape _ env [] = return ()
checkNoEscape l env vs = do fvs <- tyfree <$> msubst env
let escaped = vs `intersect` fvs
when (not $ null escaped) $ do
env1 <- msubst env
--traceM ("####### env:\n" ++ prstr env1)
err2 escaped "Escaping type variable"
err l "Escaping type variable"


wellformed :: (WellFormed a) => Env -> a -> TypeM ()
Expand Down Expand Up @@ -677,7 +677,7 @@ matchActorAssumption env n0 p k te = do --traceM ("## matchActorAssumption
q = scbind sc
--traceM ("## matchActorAssumption for method " ++ prstr n ++ ": " ++ prstr c1)
(cs2,eq) <- solveScoped (defineTVars q env) (qbound q) obs tNone (c0:c1:cs0++cs1)
checkNoEscape env (qbound q)
checkNoEscape (loc n) env (qbound q)
return (cs2, eq)
where Just (NDef sc _) = lookup n te1
check1 (n, i) = return ([], [])
Expand Down Expand Up @@ -755,7 +755,7 @@ instance Check Decl where
let cst = if fallsthru b then [Cast (DfltInfo l 65 Nothing []) tNone t] else []
t1 = tFun fx' (prowOf p') (krowOf k') t
(cs1,eq1) <- solveScoped env1 tvs [] t1 (csp++csk++csb++cst)
checkNoEscape env tvs
checkNoEscape l env tvs
-- At this point, n has the type given by its def annotations.
-- Now check that this type is no less general than its recursion assumption in env.
let body = bindWits eq1 ++ defaultsP p' ++ defaultsK k' ++ b'
Expand All @@ -774,7 +774,7 @@ instance Check Decl where
(cs0,eq0) <- matchActorAssumption env1 n p' k' te
popFX
(cs1,eq1) <- solveScoped env1 (tvSelf:tvs) te tNone (csp++csk++csb++cs0)
checkNoEscape env (tvSelf:tvs)
checkNoEscape l env (tvSelf:tvs)
fvs <- tyfree <$> msubst env
let body = bindWits (eq1++eq0) ++ defaultsP p' ++ defaultsK k' ++ b'
act = Actor l n (noqual env q) (qualWPar env q p') k' body
Expand All @@ -792,7 +792,7 @@ instance Check Decl where
(csb,b') <- checkEnv (define (subst s te) env1) b
popFX
(cs1,eq1) <- solveScoped env1 (tvSelf:tvs) te tNone csb
checkNoEscape env (tvSelf:tvs)
checkNoEscape l env (tvSelf:tvs)
return (cs1, [Class l n (noqual env q) (map snd as) (abstractDefs env q eq1 b')])
where env1 = defineSelf (NoQ n) q $ defineTVars q $ setInClass env
tvs = tvSelf : qbound q
Expand All @@ -806,7 +806,7 @@ instance Check Decl where
(csb,b') <- checkEnv (define te env1) b
popFX
(cs1,eq1) <- solveScoped env1 (tvSelf:tvs) te tNone (csu++csb)
checkNoEscape env (tvSelf:tvs)
checkNoEscape l env (tvSelf:tvs)
b' <- msubst b'
return (cs1, convProtocol env n q ps eq1 wmap b')
where env1 = defineSelf (NoQ n) q $ defineTVars q $ setInClass env
Expand All @@ -823,7 +823,7 @@ instance Check Decl where
(csb,b') <- checkEnv (define (subst s te) env1) b
popFX
(cs1,eq1) <- solveScoped env1 (tvSelf:tvs) te tNone (csu++csb)
checkNoEscape env (tvSelf:tvs)
checkNoEscape l env (tvSelf:tvs)
b' <- msubst b'
return (cs1, convExtension env n' c q ps eq1 wmap b')
where env1 = defineInst c ps thisKW' $ defineSelf n q $ defineTVars q $ setInClass env
Expand Down
Loading