summaryrefslogtreecommitdiff
path: root/src/Library/alternate_multi_command.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Library/alternate_multi_command.hs')
-rw-r--r--src/Library/alternate_multi_command.hs315
1 files changed, 315 insertions, 0 deletions
diff --git a/src/Library/alternate_multi_command.hs b/src/Library/alternate_multi_command.hs
new file mode 100644
index 0000000..da49a7d
--- /dev/null
+++ b/src/Library/alternate_multi_command.hs
@@ -0,0 +1,315 @@
+multiCommands :: PGraph -> UsageMap -> [Node] -> PGraph
+multiCommands graph usemap nodeList =
+ let multiNodes = filter (\x -> nodeOutput graph x > 1) (Graph.nodes graph)
+ umap = Map.filterWithKey (\n _ -> n `elem` multiNodes) usemap
+
+ before = (\gr node edgemap arg indexList ->
+ let edges = filter (\x -> snd . thd3 . fst $ x < arg) edgemap
+
+ -- sorts and groups by which output of the command each edge is using
+ sorted = sortBy (\(a,b) (c,d) -> compare (snd . thd3 $ a) (snd . thd3 $ c)) edges
+ grouped = groupBy (\x y -> snd . thd3 . fst $ x == snd . thd3 . fst $ y) sorted
+
+ -- makes a list of pairs of (maximum, restOfList)
+ maxSplit = map (\x -> partition (\y -> y == maximumBy useSort x)) grouped
+
+ refNodeEdges = map (fst . snd) maxSplit
+ removeNodeEdges = concat (map (fst . fst) maxSplit)
+
+ usedArgs = filter (\x -> x `elem` (map (snd . thd3) removeNodeEdges)) [1..(arg-1)]
+
+ -- creates a graphpart to define and pop all the initial outputs to get to the used one in the middle
+ defGen = (\num ->
+ if (num == arg)
+ then []
+ else if (index!!num `elem` usedArgs)
+ then [index!!num, "def", "pop"] ++ defGen (num+1)
+ else ["pop"] ++ defGen (num+1))
+ defPart = genPart (defGen 0) True
+
+ -- creates graphparts for removing all the items stored in the dictionary, including node attachments
+ removeList = zip usedArgs removeNodeEdges
+ removePart = map (\(x,y) -> (genPart [index!!(x-1), "remove"] False, Nothing, [edgeToNode y])) removeList
+
+ -- creates graphparts to reference all the items stored in the dictionary, including node attachments
+ refList = zip usedArgs refNodeEdges
+ refPart = map (\(x,y) -> (genPart [index!!(x-1), "ref"] False, Nothing, (map edgeToNode y))) refList
+
+ in (defPart, refPart ++ removePart))
+
+
+ after = (\gr node edgemap arg indexList ->
+ let -- obtain edges after the cutoff argument
+ edges = filter (\x -> snd . thd3 . fst $ x > arg) edgemap
+
+ -- sort and group by which output of the command each edge is using
+ sorted = sortBy (\(a,b) (c,d) -> compare (snd . thd3 $ a) (snd . thd3 $ c)) edges
+ grouped = groupBy (\x y -> snd . thd3 . fst $ x == snd . thd3 . fst $ y) sorted
+
+ mins = map (minimumBy useSort) grouped
+ initEdge = minimumBy useSort (Map.toList edgemap)
+
+ usedArgs = filter (\x -> x `elem` (map (snd . thd3 . fst) mins)) [(arg+1)..(nodeOutput gr node)]
+ edgeToNode = (\x -> (fst3 x, fst . thd3 $ x))
+
+ -- finds the argument where you have to pop everything and store it all in the dictionary before
+ -- proceeding
+ findAttach = (\x y ->
+ if (x == [])
+ then nodeOutput gr node
+ else let allZero = all (=0) (snd . snd . head $ x)
+ headIsMin = (head x) == (minimumBy useSort x)
+ headThmLowestStrict = let testList = map (fst . snd) x
+ in all (> head testList) (tail testList)
+ nextUsedArg = snd . thd3 . fst . head . tail $ x
+ in if (allZero && headIsMin && headThmLowestStrict)
+ then findAttach (tail x) nextUsedArg
+ else y)
+
+ argToAttach = findAttach initEdge:mins arg
+
+ process = (\attach curArg modp ordp ->
+ case (compare arg argToAttach) of
+ LT ->
+ EQ ->
+ GT ->)
+
+ (modParts, ordinaryParts) = process argToAttach arg [] []
+
+ -- calculate the def/pop/ref defPart
+ afterPartInit =
+ afterPart =
+ if (argToAttach == arg)
+ then
+ else
+
+ -- calculate def nodes/parts for outputs before the argToAttach
+ defs =
+ makeDefList =
+ defPart = map (\(x,y) -> (genPart [index!!(x-1), "def"] False, Nothing, [edgeToNode y])) makeDefList
+
+ -- calculate ref and remove nodes/parts
+ maxes = map (maximumBy useSort) grouped
+ refs = map (filter (\x -> x `notElem` maxes && x `notElem` defs)) grouped
+
+ removeList = zip usedArgs maxes
+ removePart = map (\(x,y) -> (genPart [index!!(x-1), "remove"] False, Nothing, [edgeToNode y])) removeList
+
+ -- creates graphparts to reference all the items stored in the dictionary, including node attachments
+ refList = zip usedArgs refs
+ refPart = map (\(x,y) -> (genPart [index!!(x-1), "ref"] False, Nothing, (map edgeToNode y))) refList
+
+ in (modParts, ordinaryParts))
+
+ addPreserveNodeParts = (\partList graph ->
+ )
+
+ f = (\gr node edgemap ->
+ let edgeList = Map.toList edgemap
+
+ out = nodeOutput gr node
+ index = next (out + 1) gr
+
+ initEdge = fst (minimumBy useSort edgeList)
+ initArg = snd . thd3 $ initEdge
+ (defBefore, beforeParts) = before gr node edgemap initArg (take (initArg-1) index)
+ (defAfter, afterParts) = after gr node edgemap initArg (drop initArg index)
+ edgesToRemove = filter (\x -> x /= initEdge) (map fst edgeList)
+
+ gr' = addPreserveNodeParts defAfter gr
+
+ edgesRemoved = foldl' (\x y -> Graph.delLEdge y x) gr' edgesToRemove
+ partsAdded = graphAddList partList edgesRemoved
+ in partsAdded)
+
+ in foldl' (\g n -> f g n (fromJust (Map.lookup n umap))) graph multiNodes
+
+
+
+
+
+
+
+
+
+
+
+
+
+multiCommands :: PGraph -> PGraph -> UsageMap -> [Node] -> PGraph
+multiCommands graph orig usemap nodeList =
+ let process = (\gr stack dict workmap edge ->
+ let node = snd3 edge
+ label = fromJust (Graph.lab gr node)
+ in if (label == "def" || label == "ref" || label == "remove" || isNumber label)
+ then dictProcess gr stack dict workmap edge
+ else regProcess gr stack dict workmap edge
+
+
+ dictProcess = (\gr stack dict workmap edge ->
+ let node = snd3 edge
+ label = fromJust (Graph.lab gr node)
+ index = fromJust (Graph.lab gr (head (Graph.suc gr node)))
+
+ in if (label == "def")
+ then let dict' = Map.insert index (head stack) dict
+ in (gr, stack, dict', workmap)
+
+ else if (label == "ref")
+ then let stack' = (fromJust (Map.lookup index dict)):stack
+ in (gr, stack', dict, workmap)
+
+ else if (label == "remove")
+ then let stack' = (fromJust (Map.lookup index dict)):stack
+ dict' = Map.delete index dict
+ in (gr, stack', dict', workmap)
+ else -- isNumber label
+ (gr, stack, dict, workmap)
+
+
+ regProcess = (\gr stack dict workmap edge ->
+ let node = snd3 edge
+ label = fromJust (Graph.lab gr node)
+
+ io = argMap label
+ sortedIns = sortBy (\x y -> compare (fst . thd3 $ x) (fst . thd3 $ y)) (Graph.out orig node)
+ expectedInput = map (\(a,b,(c,d)) -> (b,d)) sortedIns
+
+ consume = (\(g,s,d,w) inList ->
+ if (inList == [])
+ then if (nodeOutput == 1)
+ then (g, (node,1):s, d, w)
+ else initial (g,s,d,w)
+ else let i = head inList
+ in if (head s == i)
+ then consume (g, tail s, d, w) (tail inList)
+ else store (g, s, d, w) inList)
+
+ initial = (\(g,s,d,w) inList ->
+ let edgemap = Map.toList (fromJust (Map.lookup node usemap))
+ sorted = sortBy (\(a,b) (c,d) -> compare (snd . thd3 $ a) (snd . thd3 $ b)) edgemap
+ grouped = groupBy (\x y -> (snd . thd3 . fst $ x) == (snd . thd3 . fst $ y)) sorted
+ minimals = map (minimumBy useSort) grouped
+ usedArgs = filter (\x -> x `elem` (map (snd . thd3 . fst) minimals)) [1..nodeOutput]
+ atArg = snd . thd3 $ edge
+ atArgReuse = length (filter (\x -> (snd . thd3 . fst $ x) == atArg) edgemap)
+ fromStart = fst . snd $ (head (filter (\x -> ((snd . thd3 . fst $ x) == atArg)) minimals))
+ edgesToRemove = filter (\x -> (snd . thd3 $ x) < upTo) (map fst edgemap)
+
+ upTo = let shortList = filter (\x -> (snd . thd3 . fst $ x) > atArg && (fst . snd $ x) > fromStart) minimals
+ in if (shortList == [])
+ then nodeOutput + 1
+ else let shortNum = snd . thd3 . fst . head $ shortList
+ calc = (\num ->
+ if (filter (\x -> (snd . thd3 . fst $ x) == num - 1) edgemap == [])
+ then calc (num - 1)
+ else num)
+ in calc shortNum
+ index = next upTo g
+
+ defPartGen = (\num ->
+ if (num == upTo)
+ then if (atArg + 1 < upTo)
+ then if (atArgReuse > 1)
+ then [index!!atArg, "ref"]
+ else [index!!atArg, "remove"]
+ else []
+ else if (num `elem` usedArgs)
+ then if (num + 1 == atArg &&)
+ else if (num == atArg)
+ then if (atArgReuse <= 1 && atArg + 1 == upTo)
+ then defPartGen (num+1)
+ else if (atArg + 1 < upTo)
+ then [index!!num, "def", "pop"] ++ (defPartGen (num+1))
+ else [index!!num, "def"] ++ (defPartGen (num+1))
+ else [index!!num, "def", "pop"] ++ (defPartGen (num+1))
+ else ["pop"] ++ (defPartGen (num+1)))
+ defPart = genPart (defPartGen 1) True
+
+ maxSplit = map (\x -> partition (\y -> y == maximumBy useSort x)) grouped
+ refNodeEdges = map (fst . snd) maxSplit
+ removeNodeEdges = concat (map (fst . fst) maxSplit)
+
+ removeList = zip usedArgs removeNodeEdges
+ removePart = map (\(x,y) -> (genPart [index!!(x-1), "remove"] False, Nothing, [edgeToNode y])) removeList
+
+ refList = zip usedArgs refNodeEdges
+ refPart = map (\(x,y) -> (genPart [index!!(x-1), "ref"] False, Nothing, (map edgeToNode y))) refPart
+
+ workingEdge =
+ let atArgEdges = filter (\x -> (snd . thd3 . fst $ x) == atArg) edgemap
+ initEdge = fst . head $ (filter (\x -> (snd . thd3 $ x) == atArg &&
+ (x `notElem` (delete (minimumBy useSort atArgEdges)
+ atArgEdges))) (Graph.inn g' node))
+ calc = (\e ->
+ if (fst3 e == fst3 edge)
+ then e
+ else calc (head (Graph.inn g' (fst3 e))))
+ in calc initEdge
+ w' = Map.insert node workingEdge
+
+ storedArgs = if (atArgReuse > 1 || atArg + 1 < upTo)
+ then filter (< upTo) usedArgs
+ else delete atArg (filter (< upTo) usedArgs)
+ dictAddList = map (\x -> (index!!(x-1), (node,x))) storedArgs
+ d' = foldl' (\x (y,z) -> Map.insert y z x) d dictAddList
+
+ stackArgs = atArg:(filter (>= upTo) usedArgs)
+ stackAddList = map (\x -> (node,x)) stackArgs
+ s' = stackArgs ++ s
+
+ edgesRemoved = foldl' (\x (y,z) -> Graph.delLEdge y x) g edgesToRemove
+ g' = graphAddList (defPart:(refPart ++ removePart)) edgesRemoved
+
+ in (g', s', d', w'))
+
+
+ store = (\(g,s,d,w) inList ->
+ let s' = tail s
+ (node, arg) = head s -- the thing on the stack that shouldnt be there
+ workEdge = Map.lookup node w
+ (reqNode, reqArg) = head inList -- what we want on the stack instead
+
+ index = head (next 1 g)
+ edgemap = Map.toList (Map.lookup node usemap) -- map of the edges leading into the node
+ edgesOfArg = filter (\(x,y) -> (snd . thd3 $ x) == arg) edgemap -- edges using the arg we want to get rid of
+
+ removeEdge = maximumBy useSort edgesOfArg
+ refEdgeList = delete removeEdge edgesOfArg
+
+ defPart = genPart [index, "def"] True
+ refPart = genPart [index, "ref"] False
+ removePart = genPart [index, "remove" False
+ popPart = genPart ["pop"] True
+
+ in consume (g', s', d', w') inList
+
+ in consume (gr,stack,dict,workmap) expectedInput)
+
+
+ h = (\gr st di ma edge ->
+ let node = snd3 edge
+ (gr',st',di',ma') = f gr st di ma node
+ in process gr' st' di' ma' edge)
+
+ f = (\gr st di ma no ->
+ let args = reverse [1..(nodeOutput gr no)]
+ func = (\(g,s,d,m) a ->
+ let edge = filter (\x -> fst . thd3 $ x == a) (Graph.out g no)
+ in if (edge == [])
+ then (g,s,d,m)
+ else h gr st di ma (head edge)
+ in foldl' func (gr,st,di,ma) args
+
+ stack = []
+ dictionary = Map.empty
+ workmap = Map.empty
+
+ (graph',stack',dictionary',workmap') =
+ foldl' (\(g,s,d,m) n -> f g s d m n) (graph, stack, dictionary, workmap) nodeList
+
+ in graph'
+
+
+
+ \ No newline at end of file