mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +03:00
Cycles in references now ignored instead of causing an infinite loop.
This commit is contained in:
parent
d31eb5e880
commit
b164ce54f0
13
app/Main.hs
13
app/Main.hs
@ -12,6 +12,7 @@ import Types(Icon(..), Drawing(..), EdgeEnd(..))
|
||||
import Translate(translateString)
|
||||
|
||||
-- TODO Now --
|
||||
-- Fix recursive binds outside of a let.
|
||||
-- otherwise Guard special case
|
||||
|
||||
-- TODO Later --
|
||||
@ -260,7 +261,13 @@ main3 = do
|
||||
]
|
||||
|
||||
letTests = [
|
||||
-- TODO: this will cause Translate to loop "y = let x = x in x",
|
||||
"y = let {a = b; b = a; d = f a} in d",
|
||||
"y = let {a = b; b = a} in a",
|
||||
"y = let x = x in x",
|
||||
"y = let {fibs = cons 0 (cons 1 (zipWith (+) fibs (tail fibs)))} in fibs",
|
||||
"fibs = cons 0 (cons 1 (zipWith (+) fibs (tail fibs)))",
|
||||
"y = let x = f x in x",
|
||||
"y = f y",
|
||||
"y = let {a = f b; b = g a} in b",
|
||||
"y = let {a = 48; b = a + 3} in b",
|
||||
"y = let {b = a; a = 84} in f b",
|
||||
@ -307,8 +314,8 @@ otherTests = [
|
||||
]
|
||||
|
||||
testDecls = mconcat [
|
||||
letTests,
|
||||
otherTests
|
||||
letTests
|
||||
,otherTests
|
||||
]
|
||||
|
||||
translateStringToDrawing :: String -> IO (Diagram B)
|
||||
|
@ -180,12 +180,17 @@ printSelf :: (Show a) => a -> a
|
||||
printSelf a = Debug.Trace.trace (show a ++ "\n\n") a
|
||||
|
||||
-- | Recursivly find the matching reference in a list of bindings.
|
||||
-- TODO: Don't infinitly loop here if there is a cycle.
|
||||
-- TODO: Might want to present some indication if there is a reference cycle.
|
||||
lookupReference :: [(String, Reference)] -> Reference -> Reference
|
||||
lookupReference _ ref@(Right p) = ref
|
||||
lookupReference bindings ref@(Left s) = case lookup s bindings of
|
||||
Just r -> lookupReference bindings r
|
||||
Nothing -> ref
|
||||
lookupReference bindings ref@(Left originalS) = lookupHelper ref where
|
||||
lookupHelper ref@(Right p) = ref
|
||||
lookupHelper ref@(Left s)= case lookup s bindings of
|
||||
Just r -> failIfCycle r $ lookupHelper r
|
||||
Nothing -> ref
|
||||
where
|
||||
failIfCycle r@(Left newStr) res = if newStr == originalS then r else res
|
||||
failIfCycle _ res = res
|
||||
|
||||
deleteBindings :: IconGraph -> IconGraph
|
||||
deleteBindings (IconGraph a b c d _) = IconGraph a b c d mempty
|
||||
|
Loading…
Reference in New Issue
Block a user