Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
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
1 change: 1 addition & 0 deletions lib/std/core/unsafe.kk
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,7 @@
module std/core/unsafe

import std/core/types
import std/core/hnd

// _Unsafe_. This function calls a function and pretends it did not have any effect at all.
// Use with utmost care as it should not be used to dismiss user-defined effects that need
Expand Down
19 changes: 10 additions & 9 deletions src/Core/OpenResolve.hs
Original file line number Diff line number Diff line change
Expand Up @@ -177,13 +177,13 @@ resOpen (Env penv gamma) eopen effFrom effTo tpFrom tpTo@(TFun targs _ tres) exp
in case lsFrom of
[] -> -- no handled effect, use cast
case lsTo of
[] -> trace (" no handled effect, in no handled effect context: use cast")
[] | matchType tlFrom tlTo -> trace (" no handled effect, in no handled effect context: use cast")
expr
_ -> trace (" no handled effect; use none: " ++ show expr) $
if (isHandlerFree expr)
then trace ("*** remove open-none") $ -- fully total with using any operations that need evidence; just leave it as is
expr
else if (n <= 4)
_ ->
trace (" different effects: " ++ show (ppType penv tlFrom) ++ ", to " ++ show (ppType penv tlTo)
++ " with effects: " ++ show (map (ppType penv) lsFrom, map (ppType penv) lsTo)) $
if isHandlerFree expr then expr
else if (n <= 4)
then wrapper (resolve (nameOpenNone n)) [] -- fails in perf1c with exceeded stack size if --optmaxdup < 500 (since it prevents a tailcall)
-- expr -- fails in nim as it evidence is not cleared
else wrapperThunk (resolve (nameOpenNone 0)) []
Expand Down Expand Up @@ -236,9 +236,10 @@ isHandlerFree expr
-> case handlerFreeFunType (typeOf vname) of
Nothing -> True
Just ok -> ok
Var vname _ -> case handlerFreeFunType (typeOf vname) of
Nothing -> True
Just ok -> ok && (isSystemCoreName (getName vname))
Var vname _ -> case handlerFreeFunType (typeOf vname) of
Nothing -> True -- Simple vars are handler free
-- We cannot assume function types are handler free (since they can use handlers internally without an effect type)
_ -> False
Con{} -> True
Lit{} -> True
_ -> False
Expand Down
13 changes: 13 additions & 0 deletions test/cgen/open-resolve.kk
Original file line number Diff line number Diff line change
@@ -0,0 +1,13 @@
import std/os/path
import std/os/env

effect val package-root: path

fun main()
println("Expecting :" ++ (cwd() / ".kokac").show)
with set-package-root(cwd())
println(package-root)

noinline fun set-package-root(root: path, f: () -> <package-root,ndet|e> a): <ndet|e> a
with val package-root = root / ".kokac"
f()
2 changes: 2 additions & 0 deletions test/cgen/open-resolve.kk.out
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
Expecting :"@@@/@kokac"
"@@@/@kokac"