Fri Jan 20 10:55:20 WET 2006 Miguel Vilaca <jmvilaca@di.uminho.pt>
* Generation of equations from Interaction Nets
Interaction Nets can be represented by equations as presented in works from Ian Mackie, Jorge Sousa Pinto and Maribel Fern?ndez.
This improves the system with a representation of such equations and automatically generates those equations for the nets graphically edited in the tool.
{
addfile ./src/AuxNet.hs
hunk ./src/AuxNet.hs 1
+module AuxNet [_$_]
+ (
+ Net (..)
+ , printNetEquations
+ , printSimplifiedNetEquations
+ , saveNetEquations
+ , saveSimplifiedNetEquations
+ )where
+
+import Operations
+import Network
+import Constants
+import SafetyNet
+import qualified IntMap as IM
+import Data.Maybe
+import Data.Char
+import Data.List
+import Graphics.UI.WXCore
+
+
+
+type Edge' = EdgeNr
+type AgentName = String
+type Agent = (AgentName -- ^
+ , Int -- ^ the agent arity, this is, the number of ports
+ -- excludind the principal one
+ )
+type Interface = [EqSide]
+
+data Net = Net { agents :: [Agent] -- ^ the list of agents and its arities
+ , equations :: [Equation] -- ^ the equations
+ , interface :: Interface -- ^ the interface of the net
+ -- [_$_]
+ , rules :: [Rule] -- ^ rules
+ } deriving (Eq)
+
+type Rule = (NodeApl, NodeApl)
+type EqSide = Either Edge' NodeApl
+type Equation = (EqSide, EqSide)
+type NodeApl = (AgentName, [NodeApl'])
+data NodeApl' = End Edge' | Nested NodeApl deriving (Show, Eq, Ord)
+
+
+
+instance Show Net where
+ show = jspRepresentation
+
+{-
+generalRepresentation :: Net -> String
+generalRepresentation = unlines . map showEquation . equations
+ where showEquation (edge, info) = (showEdge edge) ++ " = " ++ showNodeApl info ++ " ;"
+ showNodeApl (node, edges) = [_$_]
+ showNode node ++ if null edges
+ then ""
+ else "(" ++ showNodeApl' (head edges) [_$_]
+ ++ showTail (tail edges)
+ ++ ")"
+ showEdge edge = [toEnum (edge + fromEnum 'a' -1)] [_$_]
+ showNode node = filter (not . isSpace) node
+ showNodeApl' (End edge) = showEdge edge
+ showNodeApl' (Nested nodeApl) = showNodeApl nodeApl
+ showTail = concatMap (\a -> ", " ++ showNodeApl' a)
+-}
+
+-- | Creates the string with the representation of a 'Net' [_$_]
+-- in the format of JSP IN transformation tool
+jspRepresentation :: Net -> String
+jspRepresentation net =
+ unlines ( [_$_]
+ [ "/* Automatically generated by " ++ toolName ++ " */"
+ , ""
+ , "agents"
+ , "" [_$_]
+ ] ++ map showAgent (agents net) ++ [_$_]
+ [ ""
+ , "rules"
+ , ""
+ -- ] ++ map showRule (rules net) ++ [[_^I_][_$_]
+ , ""
+ , "net"
+ , ""
+ ] ++ map showEquation (equations net) ++
+ [ ""
+ , "interface"
+ , ""
+ ] ++ map showEdge2 (interface net) ++ [_$_]
+ [ ""
+ , ""
+ , "end"
+ ])
+ where showAgent :: Agent -> String
+ showAgent (name, arity) = sl name "\t" $ show arity
+
+ showEquation :: Equation -> String
+ showEquation (lhs, rhs) = sl (showEqSide lhs) " = " $ showEqSide rhs
+ [_$_]
+ showEqSide = either showEdge showNodeApl
+ showNodeApl (node, edges) = [_$_]
+ showNode node ++ if null edges
+ then ""
+ else "(" ++ showNodeApl' (head edges) [_$_]
+ ++ showTail (tail edges)
+ ++ ")" [_$_]
+ showNode node = filter (not . isSpace) node
+ showNodeApl' (End edge) = showEdge edge
+ showNodeApl' (Nested nodeApl) = showNodeApl nodeApl
+ showTail = concatMap (\a -> ", " ++ showNodeApl' a)
+
+ showEdge :: Edge' -> String
+ showEdge edge = [toEnum (edge + fromEnum 'a' -1)]
+ [_$_]
+ showEdge2 = either (\e -> showEdge e ++ ";") showNodeApl
+
+ sl arg1 sep arg2 = '\t' : arg1 ++ sep ++ arg2 ++ [';']
+ [_$_]
+
+
+
+
+
+network2net :: IM.IntMap (Node n) -> IM.IntMap (Edge e) -> Net
+network2net nodeMap edgeMap = [_$_]
+ Net { agents = delete ("interface",0) . nub [_$_]
+ . map getAgent . IM.elems $ nodeMap
+ , equations = sort eqs'
+ , interface = map fst inter
+ , rules = [] [_$_]
+ }
+ where [_$_]
+ net = Net { agents = delete ("interface",0) . nub [_$_]
+ . map getAgent . IM.elems $ nodeMap
+ , equations = sort eqs'
+ , interface = map fst inter
+ , rules = [] [_$_]
+ }
+ eqs = catMaybes $ IM.foldWithKey f [] nodeMap
+ (eqs', inter) = partition test eqs
+ f nodeNr node r = (node2net nodeNr node) : r
+ node2net :: NodeNr -> Node n -> Maybe Equation
+ node2net nr node = [_$_]
+ do (pPort:otherPorts) <- getPorts node
+ pEdge <- edgeConnectedOnPort edgeMap nr pPort
+ let otherEdges = catMaybes $ map (edgeConnectedOnPort edgeMap nr) otherPorts
+ return (Left pEdge, Right (getName' node, map End otherEdges))
+ test :: Equation -> Bool
+ test (Left x, Right ("interface", [])) = False
+ test _ = True
+ getAgent :: Node n -> (AgentName, Int)
+ getAgent node = (getName' node, agentArity node)
+ agentArity :: Node n -> Int
+ agentArity node = length (maybe []id $ getPorts node) - 1
+ getName' :: Node n -> AgentName
+ getName' = either id undefined . getShape
+
+
+
+simplify :: Net -> Net
+simplify net = Net { agents = agents net
+ , equations = eqs''
+ , interface = inter'
+ , rules = rules net }
+ where inter = interface net
+ eqs' = simp [] (equations net)
+ (eqs'', inter') = simp2 inter eqs'
+
+ -- | @ simp @ removes equations of form @ a = X @ [_$_]
+ -- for something as @ X @ and for any @ a @ [_$_]
+ -- that don't belong to the interface,
+ -- substituting the unique occurence of @ a @ [_$_]
+ -- in the others equations.
+ simp :: [Equation] -- ^ the equations already folded
+ -> [Equation] -- ^ the equations to fold [_$_]
+ -> [Equation] -- ^ the result
+ simp eqsB [] = eqsB
+ simp eqsB (eq@(Right x, a) : eqsA) = simp (eqsB ++ [eq]) eqsA
+ simp eqsB (eq@(Left x , a) : eqsA) [_$_]
+ | Left x `elem` inter = simp (eqsB ++ [eq]) eqsA
+ | otherwise = simp eqsBS eqsAS
+ where (eqsBS, eqsAS) = subst2 (Left x) a eqsB eqsA
+
+ -- | @ simp2 @ removes the equations of form @ a = X @ [_$_]
+ -- for something as @ X @ and for any @ a @ [_$_]
+ -- that belong to the interface, [_$_]
+ -- substituting @ a @ by @ X @ in the interface.
+ simp2 :: Interface -> [Equation] -> ([Equation], Interface)
+ simp2 i = foldl f2 ([],i)
+ f2 :: ([Equation], Interface) -> Equation -> ([Equation], Interface)
+ f2 (eqsB, i) eq@(Left x , a)
+ | Left x `elem` i = (eqsB, a : delete (Left x) i)
+ | otherwise = error "unexpected case in the simplification of a net: free edge don't belong to the interface"
+ f2 (eqsB, i) eq = (eqsB ++ [eq], i)
+
+ -- | It´s known that exactly one occurency of the edge will be found [_$_]
+ -- in the equations (eqsB ++ eqsA).
+ -- In the future the function will be optimize for this invariant.
+ -- Now it simply transverse the all tree and replaces in the right place.
+ subst2 :: EqSide -> EqSide -> [Equation] -> [Equation] [_$_]
+ -> ([Equation], [Equation])
+ subst2 (Right x) z y a = error "unexpected case"
+ subst2 (Left x) rhs eqsB eqsA = (subst eqsB, subst eqsA)
+ where subst :: [Equation] -> [Equation]
+ subst = map substEq
+ substEq (lhs, rhs) = (substEqS lhs, substEqS rhs)
+ [_$_]
+ substEqS = either f4 (Right . substNA)
+ f4 a | a == x = rhs
+ | otherwise = Left a
+ [_$_]
+ substNA (agent, args) = (agent, map substNA' args)
+ substNA' (End e) | e == x = Nested . either undefined id $ rhs
+ | otherwise = End e
+ substNA' (Nested args) = Nested $ substNA args
+
+-----------------------------------------------------------------------------
+
+printNetEquations, printSimplifiedNetEquations :: IOOp g n e
+printNetEquations = auxPrintNet False
+printSimplifiedNetEquations = auxPrintNet True
+
+auxPrintNet :: Bool -> IOOp g n e
+auxPrintNet b (g, nodeMap, edgeMap) _ = [_$_]
+ do logMessage "printing Net"
+ logMessage (show net)
+ print net
+ where net = simp $ network2net nodeMap edgeMap
+ simp = if b then simplify else id
+
+
+saveNetEquations, saveSimplifiedNetEquations :: IOOp g n e
+saveNetEquations = auxSaveNetEquations False
+saveSimplifiedNetEquations = auxSaveNetEquations True
+
+auxSaveNetEquations :: Bool -> IOOp g n e
+auxSaveNetEquations b (g, nodeMap, edgeMap) w = [_$_]
+ safetyNet w $
+ do mf <- fileSaveDialog w [_$_]
+ rememberCurrentDir overwritePrompt [_$_]
+ "Save net equations"
+ [("Any file", ["*"])] [_$_]
+ directory filename
+ case mf of
+ Nothing -> return ()
+ Just fn -> writeFile fn . show . simp $ network2net nodeMap edgeMap
+ where rememberCurrentDir = True
+ overwritePrompt = True
+ directory = "" [_$_]
+ filename = "" [_$_]
+ simp = if b then simplify else id
+
hunk ./src/Main.hs 15
+import AuxNet
+
+
hunk ./src/Main.hs 36
- , ioOps = [] }
+ , ioOps = [ ("generate equations from interaction net"
+ , printNetEquations)
+ , ("generate simplified equations from interaction net"
+ , printSimplifiedNetEquations)
+ , ("save equations to file"
+ , saveNetEquations)
+ , ("save simplified equations to file"
+ , saveSimplifiedNetEquations)
+ ] }
}