Make "Unresolved scope in dependency" impossible
This commit is contained in:
parent
0c46b8b2d5
commit
eed0174e90
|
@ -112,8 +112,8 @@ data CFEdge =
|
||||||
|
|
||||||
-- Actions we track
|
-- Actions we track
|
||||||
data CFEffect =
|
data CFEffect =
|
||||||
CFSetProps Scope String (S.Set CFVariableProp)
|
CFSetProps (Maybe Scope) String (S.Set CFVariableProp)
|
||||||
| CFUnsetProps Scope String (S.Set CFVariableProp)
|
| CFUnsetProps (Maybe Scope) String (S.Set CFVariableProp)
|
||||||
| CFReadVariable String
|
| CFReadVariable String
|
||||||
| CFWriteVariable String CFValue
|
| CFWriteVariable String CFValue
|
||||||
| CFWriteGlobal String CFValue
|
| CFWriteGlobal String CFValue
|
||||||
|
@ -579,7 +579,7 @@ build t = do
|
||||||
|
|
||||||
T_Array _ list -> sequentially list
|
T_Array _ list -> sequentially list
|
||||||
|
|
||||||
T_Assignment {} -> buildAssignment DefaultScope t
|
T_Assignment {} -> buildAssignment Nothing t
|
||||||
|
|
||||||
T_Backgrounded id body -> do
|
T_Backgrounded id body -> do
|
||||||
start <- newStructuralNode
|
start <- newStructuralNode
|
||||||
|
@ -1031,9 +1031,9 @@ handleCommand cmd vars args literalCmd = do
|
||||||
|
|
||||||
scope isFunc =
|
scope isFunc =
|
||||||
case () of
|
case () of
|
||||||
_ | global -> GlobalScope
|
_ | global -> Just GlobalScope
|
||||||
_ | isFunc -> LocalScope
|
_ | isFunc -> Just LocalScope
|
||||||
_ -> DefaultScope
|
_ -> Nothing
|
||||||
|
|
||||||
addedProps = S.fromList $ concat $ [
|
addedProps = S.fromList $ concat $ [
|
||||||
[ CFVPArray | array ],
|
[ CFVPArray | array ],
|
||||||
|
@ -1178,7 +1178,7 @@ handleCommand cmd vars args literalCmd = do
|
||||||
|
|
||||||
regularExpansion vars args p = do
|
regularExpansion vars args p = do
|
||||||
args <- sequentially args
|
args <- sequentially args
|
||||||
assignments <- mapM (buildAssignment PrefixScope) vars
|
assignments <- mapM (buildAssignment (Just PrefixScope)) vars
|
||||||
exe <- p
|
exe <- p
|
||||||
dropAssignments <-
|
dropAssignments <-
|
||||||
if null vars
|
if null vars
|
||||||
|
@ -1198,7 +1198,7 @@ handleCommand cmd vars args literalCmd = do
|
||||||
|
|
||||||
none = newStructuralNode
|
none = newStructuralNode
|
||||||
|
|
||||||
data Scope = DefaultScope | GlobalScope | LocalScope | PrefixScope
|
data Scope = GlobalScope | LocalScope | PrefixScope
|
||||||
deriving (Eq, Ord, Show, Generic, NFData)
|
deriving (Eq, Ord, Show, Generic, NFData)
|
||||||
|
|
||||||
buildAssignment scope t = do
|
buildAssignment scope t = do
|
||||||
|
@ -1212,10 +1212,10 @@ buildAssignment scope t = do
|
||||||
let valueType = if null indices then f id value else CFValueArray
|
let valueType = if null indices then f id value else CFValueArray
|
||||||
let scoper =
|
let scoper =
|
||||||
case scope of
|
case scope of
|
||||||
PrefixScope -> CFWritePrefix
|
Just PrefixScope -> CFWritePrefix
|
||||||
LocalScope -> CFWriteLocal
|
Just LocalScope -> CFWriteLocal
|
||||||
GlobalScope -> CFWriteGlobal
|
Just GlobalScope -> CFWriteGlobal
|
||||||
DefaultScope -> CFWriteVariable
|
Nothing -> CFWriteVariable
|
||||||
write <- newNodeRange $ applySingle $ IdTagged id $ scoper var valueType
|
write <- newNodeRange $ applySingle $ IdTagged id $ scoper var valueType
|
||||||
linkRanges [expand, index, read, write]
|
linkRanges [expand, index, read, write]
|
||||||
where
|
where
|
||||||
|
|
|
@ -299,7 +299,6 @@ depsToState set = foldl insert newInternalState $ S.toList set
|
||||||
PrefixScope -> (sPrefixValues, insertPrefix)
|
PrefixScope -> (sPrefixValues, insertPrefix)
|
||||||
LocalScope -> (sLocalValues, insertLocal)
|
LocalScope -> (sLocalValues, insertLocal)
|
||||||
GlobalScope -> (sGlobalValues, insertGlobal)
|
GlobalScope -> (sGlobalValues, insertGlobal)
|
||||||
DefaultScope -> error $ pleaseReport "Unresolved scope in dependency"
|
|
||||||
|
|
||||||
alreadyExists = isJust $ vmLookup name $ mapToCheck state
|
alreadyExists = isJust $ vmLookup name $ mapToCheck state
|
||||||
in
|
in
|
||||||
|
@ -1120,34 +1119,34 @@ transferEffect ctx effect =
|
||||||
|
|
||||||
CFSetProps scope name props ->
|
CFSetProps scope name props ->
|
||||||
case scope of
|
case scope of
|
||||||
DefaultScope -> do
|
Nothing -> do
|
||||||
state <- readVariable ctx name
|
state <- readVariable ctx name
|
||||||
writeVariable ctx name $ addProperties props state
|
writeVariable ctx name $ addProperties props state
|
||||||
GlobalScope -> do
|
Just GlobalScope -> do
|
||||||
state <- readGlobal ctx name
|
state <- readGlobal ctx name
|
||||||
writeGlobal ctx name $ addProperties props state
|
writeGlobal ctx name $ addProperties props state
|
||||||
LocalScope -> do
|
Just LocalScope -> do
|
||||||
out <- readSTRef (cOutput ctx)
|
out <- readSTRef (cOutput ctx)
|
||||||
state <- readLocal ctx name
|
state <- readLocal ctx name
|
||||||
writeLocal ctx name $ addProperties props state
|
writeLocal ctx name $ addProperties props state
|
||||||
PrefixScope -> do
|
Just PrefixScope -> do
|
||||||
-- Prefix values become local
|
-- Prefix values become local
|
||||||
state <- readLocal ctx name
|
state <- readLocal ctx name
|
||||||
writeLocal ctx name $ addProperties props state
|
writeLocal ctx name $ addProperties props state
|
||||||
|
|
||||||
CFUnsetProps scope name props ->
|
CFUnsetProps scope name props ->
|
||||||
case scope of
|
case scope of
|
||||||
DefaultScope -> do
|
Nothing -> do
|
||||||
state <- readVariable ctx name
|
state <- readVariable ctx name
|
||||||
writeVariable ctx name $ removeProperties props state
|
writeVariable ctx name $ removeProperties props state
|
||||||
GlobalScope -> do
|
Just GlobalScope -> do
|
||||||
state <- readGlobal ctx name
|
state <- readGlobal ctx name
|
||||||
writeGlobal ctx name $ removeProperties props state
|
writeGlobal ctx name $ removeProperties props state
|
||||||
LocalScope -> do
|
Just LocalScope -> do
|
||||||
out <- readSTRef (cOutput ctx)
|
out <- readSTRef (cOutput ctx)
|
||||||
state <- readLocal ctx name
|
state <- readLocal ctx name
|
||||||
writeLocal ctx name $ removeProperties props state
|
writeLocal ctx name $ removeProperties props state
|
||||||
PrefixScope -> do
|
Just PrefixScope -> do
|
||||||
-- Prefix values become local
|
-- Prefix values become local
|
||||||
state <- readLocal ctx name
|
state <- readLocal ctx name
|
||||||
writeLocal ctx name $ removeProperties props state
|
writeLocal ctx name $ removeProperties props state
|
||||||
|
|
Loading…
Reference in New Issue