Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Types.inferCM doesn't stack-overflow when optimized now

  • Loading branch information...
commit ded4d716f17839b60aca0e9f12e03660fdbd6f1d 1 parent f518062
Ricardo Honorato-Zimmer authored May 25, 2012

Showing 2 changed files with 19 additions and 27 deletions. Show diff stats Hide diff stats

  1. 24  KappaParser.hs
  2. 22  Types.hs
24  KappaParser.hs
... ...
@@ -1,3 +1,5 @@
  1
+{-# LANGUAGE BangPatterns #-}
  2
+
1 3
 module KappaParser( SiteName, InternalState, BondLabel, BindingState(..), Site(..), Interface, siteName, agentName
2 4
                   , AgentName, Agent(..), KExpr, Rate, Rule(..), RuleName, RuleWithName
3 5
                   , CMBindingState(..), CMSite(..), CMIntf, CMAgent(..), CM -- CM types
@@ -162,10 +164,10 @@ rule = do lhs <- kexpr
162 164
 -- Contact Map
163 165
 data CMBindingState = CMBound AgentName SiteName
164 166
   deriving (Show, Eq)
165  
-data CMSite = CMSite SiteName [InternalState] [CMBindingState]
  167
+data CMSite = CMSite !SiteName ![InternalState] ![CMBindingState]
166 168
   deriving (Show, Eq)
167 169
 type CMIntf = [CMSite]
168  
-data CMAgent = CMAgent AgentName CMIntf
  170
+data CMAgent = CMAgent !AgentName !CMIntf
169 171
   deriving (Show, Eq)
170 172
 type CM = [CMAgent]
171 173
 
@@ -357,15 +359,15 @@ data Decl = CMDecl CM
357 359
           | VarDecl Var
358 360
 
359 361
 createModule :: [Decl] -> Module
360  
-createModule decls = foldr addDecl emptyModule decls
361  
-  where addDecl (CMDecl cm) m = m{ contactMap = cm }
362  
-        addDecl (ShapesDecl ss) m = m{ shapes = ss ++ shapes m }
363  
-        addDecl (ShapeDecl s) m = m{ shapes = s : shapes m }
364  
-        addDecl (RulesDecl rs) m = m{ rules = rs ++ rules m }
365  
-        addDecl (RuleDecl r) m = m{ rules = r : rules m }
366  
-        addDecl (InitDecl i) m = m{ inits = i : inits m }
367  
-        addDecl (ObsDecl o) m = m{ obss = o : obss m }
368  
-        addDecl (VarDecl v) m = m{ vars = v : vars m }
  362
+createModule decls = foldr (flip addDecl) emptyModule decls
  363
+  where addDecl m (CMDecl cm)     = m{ contactMap = cm }
  364
+        addDecl m (ShapesDecl ss) = m{ shapes = ss ++ shapes m }
  365
+        addDecl m (ShapeDecl s)   = m{ shapes = s : shapes m }
  366
+        addDecl m (RulesDecl rs)  = m{ rules = rs ++ rules m }
  367
+        addDecl m (RuleDecl r)    = m{ rules = r : rules m }
  368
+        addDecl m (InitDecl i)    = m{ inits = i : inits m }
  369
+        addDecl m (ObsDecl o)     = m{ obss = o : obss m }
  370
+        addDecl m (VarDecl v)     = m{ vars = v : vars m }
369 371
 
370 372
 moduleParser :: Parser Module
371 373
 moduleParser = m_whiteSpace >> kfParser <* eof
22  Types.hs
@@ -63,19 +63,20 @@ checkExpr cm kexpr = concatMap stateErrors kexpr ++ Map.fold linkErrors [] lm --
63 63
                 isSite (CMSite sn _ _) = sn == i
64 64
 
65 65
 -- Inference
  66
+-- TODO make this function stack-overflow-free when not optimized
66 67
 inferCM :: [KExpr] -> CM
67  
-inferCM kexprs = map replicateSites . toCM $ foldr addKExpr Map.empty kexprs
  68
+inferCM kexprs = toCM $ foldl' addKExpr Map.empty kexprs
68 69
   where
69  
-    addKExpr kexpr cm = foldr addAgent cm kexpr
  70
+    addKExpr cm kexpr = foldl' addAgent cm kexpr
70 71
       where
71 72
         lm = linkMap kexpr
72 73
 
73  
-        addAgent (Agent agentName intf) cm = Map.insert agentName cmIntf' cm
  74
+        addAgent cm (Agent agentName intf) = Map.insert agentName cmIntf' cm
74 75
           where
75 76
             cmIntf  = Map.findWithDefault Map.empty agentName cm
76  
-            cmIntf' = foldr addSite cmIntf intf
  77
+            cmIntf' = foldl' addSite cmIntf intf
77 78
 
78  
-            addSite (Site siteName int lnk) cmIntf = Map.insert siteName cmSite' cmIntf
  79
+            addSite cmIntf (Site siteName int lnk) = Map.insert siteName cmSite' cmIntf
79 80
               where
80 81
                 cmSite  = Map.findWithDefault (CMSite siteName [] []) siteName cmIntf
81 82
                 cmSite' = addInt int $ addLnk lnk cmSite
@@ -97,14 +98,3 @@ inferCM kexprs = map replicateSites . toCM $ foldr addKExpr Map.empty kexprs
97 98
     toCM cm = map toCMAgent $ Map.toList cm
98 99
     toCMAgent (agentName, cmIntf) = CMAgent agentName (Map.elems cmIntf)
99 100
 
100  
-    siteCount = foldr (Map.unionWith max) Map.empty $ concatMap (map countSite) kexprs
101  
-
102  
-    countSite (Agent agentName intf) = Map.fromList $ frequencies siteNames
103  
-      where siteNames = map (agentName, ) $ map siteName intf
104  
-
105  
-    replicateSites (CMAgent agentName intf) = CMAgent agentName intf'
106  
-      where intf' = foldr replicateSite [] intf
107  
-
108  
-            replicateSite site@(CMSite siteName _ _) intf = replicate count site ++ intf
109  
-              where count = Map.lookup (agentName, siteName) siteCount ? "Types.inferCM: site not found"
110  
-

0 notes on commit ded4d71

Please sign in to comment.
Something went wrong with that request. Please try again.