graph-rewriting-lambdascope 0.5.3 → 0.5.4
raw patch · 6 files changed
+83/−34 lines, 6 filesdep ~GLUTdep ~OpenGLdep ~parsecnew-component:exe:lambdascope
Dependency ranges changed: GLUT, OpenGL, parsec
Files
- GL.hs +9/−1
- Graph.hs +10/−3
- Main.hs +2/−1
- Resolver.hs +6/−1
- Rules.hs +51/−23
- graph-rewriting-lambdascope.cabal +5/−5
GL.hs view
@@ -17,6 +17,7 @@ Constant {} → sd n : [sd $ rm (alpha args*x) `mmul` sws | x <- [0..la args - 1]] Eraser {} → [sd n] Duplicator {} → [(Vector2 0 0.9, n), (Vector2 (-0.6) (-0.5), s), (Vector2 0.6 (-0.5), s)]+ Delimiter {} → [sd $ Vector2 0 0.7, sd $ Vector2 0 (-0.7)] Case {} → sd n : sd e : [sd $ rm (alpha alts * x) `mmul` sws | x <- [0..la alts - 1]] Operator {} → sd n : [sd $ rm (alpha ops*x) `mmul` sws | x <- [0..la ops - 1]] where@@ -53,7 +54,14 @@ vertex2 (0,0.9) vertex2 (-1,-0.5) vertex2 (1,-0.5)- renderString $ label node+ renderString $ show $ level node+ Delimiter {} → do+ GL.preservingMatrix $ GL.renderPrimitive GL.LineStrip $ do+ vertex2 (-0.8,-0.3)+ vertex2 (-0.8,0)+ vertex2 (0.8,0)+ vertex2 (0.8,-0.3)+ renderString $ show $ level node Case {} → drawNode ("case [" ++ foldr1 (\x y → x ++ ", " ++ y) (names node) ++ "]") Operator {} → drawNode (name node)
Graph.hs view
@@ -15,15 +15,18 @@ | Abstractor {inp, body, var ∷ Port, name ∷ String} | Constant {inp ∷ Port, args ∷ [Port], name ∷ String} | Eraser {inp ∷ Port}- | Duplicator {label ∷ String, inp, out1, out2 ∷ Port}+ | Duplicator {level ∷ Int, inp, out1, out2 ∷ Port}+ | Delimiter {level ∷ Int, inp, out ∷ Port} | Multiplexer {out ∷ Port, ins ∷ [Port]} -- only intermediate compilation result | Case {inp ∷ Port, out ∷ Port, alts ∷ [Port], names ∷ [String]} | Operator {inp ∷ Port, ops ∷ [Port], arity ∷ Int, lmop ∷ Int, function ∷ [String] → Maybe String, name ∷ String} +-- | equality as defined in the paper with only the relevant cases included instance Eq NodeLS where- Eraser {} == Eraser {} = True- Duplicator {label = l1} == Duplicator {label = l2} = l1 ≡ l2+ Eraser {} == Eraser {} = True+ Duplicator {level = l1} == Duplicator {level = l2} = l1 ≡ l2+ Delimiter {level = l1} == Delimiter {level = l2} = l1 ≡ l2 _ == _ = False instance View [Port] NodeLS where@@ -34,6 +37,7 @@ Constant {inp = i, args = as} → i:as Eraser {inp = i} → [i] Duplicator {inp = i, out1 = o1, out2 = o2} → [i,o1,o2]+ Delimiter {inp = i, out = o} → [i,o] Multiplexer {out = o, ins = is} → o:is Case {inp = i, out = o, alts = as} → i:o:as Operator {inp = i, ops = os} → i:os@@ -44,6 +48,7 @@ Constant {} → node {inp = i, args = as} where i:as = ports Eraser {} → node {inp = i} where [i] = ports Duplicator {} → node {inp = i, out1 = o1, out2 = o2} where [i,o1,o2] = ports+ Delimiter {} → node {inp = i, out = o} where [i,o] = ports Multiplexer {} → node {out = o, ins = is} where o:is = ports Case {} → node {inp = i, out = o, alts = as} where i:o:as = ports Operator {} → node {inp = i, ops = os} where i:os = ports@@ -59,6 +64,7 @@ Constant {inp = i, args = as} → i Eraser {inp = i} → i Duplicator {inp = i, out1 = o1, out2 = o2} → i+ Delimiter {inp = i, out = o} → i Multiplexer {out = o, ins = is} → o Case {inp = i, out = o, alts = as} → o Operator {lmop = i, ops = os} → inspect node !! i@@ -73,5 +79,6 @@ Constant {inp = i, args = as} → Nothing Eraser {inp = i} → Just i Duplicator {inp = i, out1 = o1, out2 = o2} → Just i+ Delimiter {inp = i, out = o} → Just i Case {inp = i, out = o, alts = as} → Just o Operator {lmop = i, ops = os} → Just $ inspect node !! i
Main.hs view
@@ -93,8 +93,9 @@ [Leaf "Beta Reduction" beta, Branch "All but Beta" [Leaf "Duplicate" duplicate,- Leaf "Eliminate" eliminateDuplicator,+ Leaf "Eliminate" (eliminateDelimiterEraser <|> eliminateDelimiterConstant <|> eliminateDuplicator), Leaf "Annihilate" annihilate,+ Leaf "Commute Delimiter" commuteDelimiter, Leaf "Erase" eraser, Leaf "Case" caseNode, Branch "Primitive"
Resolver.hs view
@@ -44,7 +44,12 @@ [ ] → void $ newNode $ fromMaybe (Constant {inp = p, name = name, args = []}) (operator name p) n:ns → if name ≡ symbol n then mergeEdges p =<< reference n- else compile ns p term+ else if boundByLambda n+ then do+ p' ← newEdge+ void $ newNode Delimiter {level = 0, inp = p', out = p}+ compile ns p' term+ else compile ns p term Term.Case exp cases → do let (pats, _) = unzip cases alts ← replicateM (length cases) newEdge -- edges going from the Case node to the CaseAlts
Rules.hs view
@@ -24,7 +24,7 @@ [i] → rewire [[o,i]] ins → let (ins1, ins2) = splitAt (length ins `div` 2) ins in replace $ do (o1,o2) ← (,) <$> byEdge <*> byEdge- byNode $ Duplicator {label = "", inp = o, out1 = o1, out2 = o2}+ byNode $ Duplicator {level = 0, inp = o, out1 = o1, out2 = o2} byNode $ Multiplexer {out = o1, ins = ins1} byNode $ Multiplexer {out = o2, ins = ins2} @@ -44,7 +44,7 @@ commute ∷ (View [Port] n, View NodeLS n) ⇒ Rule n commute = do n1 :-: n2 ← activePair- require (n1 ≢ n2)+ require (n1 ≢ n2) -- TODO: replace by linear let ports1 = inspect n1 ∷ [Port] let ports2 = inspect n2 ∷ [Port] let (pp1,pp1idx) = head [(p,i) | (p,i) ← ports1 `zip` [0..], p ≡ pp n1]@@ -57,8 +57,16 @@ edges ← replicateM (es1 * es2) byEdge let edges1 = split es1 es2 edges let edges2 = transpose' es1 edges1- mconcat [byNode $ update (insertIdx pp1idx pp1 auxs) n1 | (pp1,auxs) ← zip aux2 edges1]- mconcat [byNode $ update (insertIdx pp2idx pp2 auxs) n2 | (pp2,auxs) ← zip aux1 edges2]+ mconcat [byNode $ updateLevel n2 $ update (insertIdx pp1idx pp1 auxs) n1 | (pp1,auxs) ← zip aux2 edges1]+ mconcat [byNode $ updateLevel n1 $ update (insertIdx pp2idx pp2 auxs) n2 | (pp2,auxs) ← zip aux1 edges2]+ where updateLevel you me = case me of+ Duplicator {} → maybeLevelUp+ Delimiter {} → maybeLevelUp+ _ → me+ where maybeLevelUp = case you of+ Delimiter {} → if level you ≤ level me then me {level = level me + 1} else me+ Abstractor {} → me {level = level me + 1}+ _ → me annihilate ∷ (View [Port] n, View NodeLS n) ⇒ Rule n annihilate = do@@ -68,6 +76,25 @@ let aux2 = pp n2 `delete` inspect n2 rewire $ [[a1,a2] | (a1,a2) ← aux1 `zip` aux2] +annihilateDelimiters ∷ (View [Port] n, View NodeLS n) ⇒ Rule n+annihilateDelimiters = do+ rewrite ← annihilate+ Delimiter {} ← liftReader . inspectNode =<< previous+ return rewrite++-- This rule doesn't trigger for constants with arguments+eliminateDelimiterConstant ∷ (View [Port] n, View NodeLS n) ⇒ Rule n+eliminateDelimiterConstant = do+ c@Constant {args = as, name = n} :-: Delimiter {inp = iD} ← activePair+ require (inp c ≢ iD && as == [])+ replace $ byNode $ Constant {inp = iD, args = [], name = n}++eliminateDelimiterEraser ∷ (View [Port] n, View NodeLS n) ⇒ Rule n+eliminateDelimiterEraser = do+ c@Eraser {} :-: Delimiter {inp = iD} ← activePair+ require (inp c ≢ iD)+ replace $ byNode $ Eraser {inp = iD}+ eliminateDuplicator ∷ (View [Port] n, View NodeLS n) ⇒ Rule n eliminateDuplicator = do Eraser {inp = iE} ← node@@ -84,30 +111,24 @@ return rewrite duplicate ∷ (View [Port] n, View NodeLS n) ⇒ Rule n-duplicate = duplicateAbstractor <|> duplicateSthElse where- duplicateAbstractor = do- Duplicator {label = l, inp = di, out1 = o1, out2 = o2}- :-: Abstractor {name = n, inp = ai, body = b, var = v} ← activePair- replace $ do- (b1,v1,b2,v2) ← (,,,) <$> byEdge <*> byEdge <*> byEdge <*> byEdge- byNode Abstractor {name = n ⧺ "1", inp = o1, body = b1, var = v1}- byNode Abstractor {name = n ⧺ "2", inp = o2, body = b2, var = v2}- byNode Duplicator {label = n, inp = b, out1 = b1, out2 = b2}- byNode Duplicator {label = n, inp = v, out1 = v1, out2 = v2}- duplicateSthElse = do- rewrite ← commute- Duplicator {} ← liftReader . inspectNode =<< previous- requireFailure $ do- h ← history- Abstractor {} ← liftReader $ inspectNode (h !! 1)- return ()- return rewrite+duplicate = do+ rewrite ← commute+ Duplicator {} ← liftReader . inspectNode =<< previous+ return rewrite beta ∷ (View [Port] n, View NodeLS n) ⇒ Rule n beta = do Applicator {inp = ai, func = f, arg = a} :-: Abstractor {body = b, var = v} ← activePair- rewire [[ai,b], [a,v]]+ replace $ do+ byNode $ Delimiter {level = 0, inp = ai, out = b}+ byNode $ Delimiter {level = 0, inp = a, out = v} +commuteDelimiter ∷ (View [Port] n, View NodeLS n) ⇒ Rule n+commuteDelimiter = do+ rewrite ← commute+ Delimiter {} ← liftReader . inspectNode =<< previous+ return rewrite+ applyConstant ∷ (View [Port] n, View NodeLS n) ⇒ Rule n applyConstant = do Applicator {inp = i, arg = a} :-: Constant {name = n, args = as} ← activePair@@ -170,3 +191,10 @@ replace $ do byWire i matchingport -- Attach the alternative directly to the input of the case node mconcat [byNode $ Eraser {inp = alts !! i} | i ← filter (/= fromJust (elemIndex n names)) [0..nn-1]]++-- | Not the readback semantics as defined in the paper. Just a non semantics preserving erasure of all+-- delimiters to make the graph more readable+readback ∷ (View [Port] n, View NodeLS n) ⇒ Rule n+readback = do+ Delimiter {inp = i, out = o} ← node+ rewire [[i,o]]
graph-rewriting-lambdascope.cabal view
@@ -1,5 +1,5 @@ Name: graph-rewriting-lambdascope-Version: 0.5.3+Version: 0.5.4 Copyright: (c) 2010, Jan Rochel License: BSD3 License-File: LICENSE@@ -14,7 +14,7 @@ Cabal-Version: >= 1.6 Data-Files: examples/*.l -Executable bad-context-sharing+Executable lambdascope Main-Is: Main.hs Build-Depends: base >= 4 && < 4.6,@@ -23,9 +23,9 @@ graph-rewriting-layout >= 0.5.1 && < 0.6, graph-rewriting-gl >= 0.7.1 && < 0.8, graph-rewriting-strategies >= 0.2 && < 0.3,- parsec >= 2.1 && < 3.2,- GLUT >= 2.2 && < 2.4,- OpenGL >= 2.4 && < 2.6,+ parsec >= 2.1 && < 2.2,+ GLUT >= 2.2 && < 2.5,+ OpenGL >= 2.4 && < 2.9, IndentParser >= 0.2 && < 0.3 Extensions: UnicodeSyntax