new syntax for observables

azardilis · Sep 24, 2017 · 28915b7 · 28915b7
1 parent 2382994
commit 28915b7
Show file tree

Hide file tree

Showing 2 changed files with 49 additions and 45 deletions.
diff --git a/src/Chromar/MRuleParser.hs b/src/Chromar/MRuleParser.hs
@@ -1,16 +1,16 @@
 module Chromar.MRuleParser where
 
-import Text.Parsec
-import Data.List
-import Language.Haskell.Meta.Parse
-import Language.Haskell.TH.Syntax
-import Text.Parsec.String (Parser)
-import Text.Parsec.Language (emptyDef)
-import Text.Parsec.Token (makeTokenParser)
+import           Data.List
+import           Language.Haskell.Meta.Parse
+import           Language.Haskell.TH.Syntax
+import           Text.Parsec
+import           Text.Parsec.Language        (emptyDef)
+import           Text.Parsec.String          (Parser)
+import           Text.Parsec.Token           (makeTokenParser)
 
-import qualified Text.Parsec.Token as Tok
+import qualified Text.Parsec.Token           as Tok
 
-import qualified Chromar.RExprs as RE
+import qualified Chromar.RExprs              as RE
 
 type Var = String
 type AttrName = String
@@ -26,19 +26,19 @@ data LAgent =
            [(AttrName, Var)] deriving (Show)
 
 data ARule e = Rule
-    { rlhs :: [LAgent]
-    , rrhs :: [RAgent e]
-    , mults :: [e]  
+    { rlhs  :: [LAgent]
+    , rrhs  :: [RAgent e]
+    , mults :: [e]
     , rexpr :: RE.Er e
     , cexpr :: RE.Er e
     } deriving (Show)
 
 data SRule = SRule
-    { lexps :: [Exp]
-    , rexps :: [Exp]
+    { lexps    :: [Exp]
+    , rexps    :: [Exp]
     , multExps :: [Exp]
-    , srate :: Exp
-    , cond :: Exp
+    , srate    :: Exp
+    , cond     :: Exp
     } deriving (Show)
 
 langDef =
@@ -109,7 +109,7 @@ valDec :: (String, String) -> Dec
 valDec (nm, sexpr) = ValD (VarP $ mkName nm) (NormalB expr) []
   where
     expr = createExp sexpr
-    
+
 whereParser :: Parser [Dec]
 whereParser = do
   op "where"
@@ -138,7 +138,7 @@ parseRule = do
     op "@"
     rexpr <- many1 (noneOf ['['])
     cexpr <- option "'True'" (squares (many1 (noneOf [']'])))
-    return 
+    return
         Rule
         { rlhs = lhs
         , rrhs = ragents
@@ -148,7 +148,7 @@ parseRule = do
         }
 
 --- for testing
-contents = "A{x=x', y=ygh}, A{x=a, y=m1} --> A{x='$f$ x', y={x}} @{1 + 2} [{True}]"
+contents = "A{x=x'}--> A{x='x+1'} @'$na$'"
 
 go = case parse parseRule "rule" contents of
   (Left err) -> error (show err)

diff --git a/src/Chromar/RExprs.hs b/src/Chromar/RExprs.hs
@@ -1,31 +1,31 @@
 module Chromar.RExprs where
 
-import Language.Haskell.TH
-import Language.Haskell.TH.Quote
-import Data.Set (Set)
-import qualified Data.Set as Set
-import Text.ParserCombinators.Parsec
-import Data.List
-import Text.Parsec
-import Language.Haskell.Meta.Parse
-import Language.Haskell.TH.Syntax
-import Text.Parsec.String (Parser)
-import Text.Parsec.Language (emptyDef)
-import Text.Parsec.Token (makeTokenParser)
-import Data.Fixed
-import Data.Maybe
-
-import qualified Text.Parsec.Token as Tok
-
-import Chromar.Multiset
-import Chromar.Core
+import           Data.Fixed
+import           Data.List
+import           Data.Maybe
+import           Data.Set                      (Set)
+import qualified Data.Set                      as Set
+import           Language.Haskell.Meta.Parse
+import           Language.Haskell.TH
+import           Language.Haskell.TH.Quote
+import           Language.Haskell.TH.Syntax
+import           Text.Parsec
+import           Text.Parsec.Language          (emptyDef)
+import           Text.Parsec.String            (Parser)
+import           Text.Parsec.Token             (makeTokenParser)
+import           Text.ParserCombinators.Parsec
+
+import qualified Text.Parsec.Token             as Tok
+
+import           Chromar.Core
+import           Chromar.Multiset
 
 data ErF a b = ErF { at :: Multiset a -> Time -> b }
 
 mmod :: Real a => a -> a -> a
 mmod n m
   | m <=0 = 0
-  | otherwise = mod' n m          
+  | otherwise = mod' n m
 
 zipEr2 :: ErF a b -> ErF a c -> ErF a (b, c)
 zipEr2 e1 e2 =
@@ -209,20 +209,24 @@ repeatExpr f = do
   er2 <- parseEr f
   return $ Repeat er1 er2
 
+foldExpr :: (String -> e) -> Parser (Nm, Er e)
+foldExpr f = do
+  nm <- Tok.identifier lexer
+  Tok.symbol lexer "."
+  er <- parseEr f
+  return $ (nm, er)
+
 obsExpr :: (String -> e) -> Parser (Er e)
 obsExpr f = do
     op "select"
     lat <- lagent
     op ";"
     op "aggregate"
-    nm <-
+    (nm, er1) <-
         Text.Parsec.between
             (Tok.symbol lexer "(")
             (Tok.symbol lexer ")")
-            (Tok.identifier lexer)
-    Tok.symbol lexer "."
-    er1 <- parseEr f
-    Tok.symbol lexer ","
+            (foldExpr f)
     er2 <- parseEr f
     return $ Obs (parseP lat) nm er1 er2
 
@@ -372,7 +376,7 @@ er =
 ------------- testing
 contents = "repeatEvery '5' (when '$light$ + 1' '5' else '1')"
 
-contents' = "select Leaf{m=m}; aggregate(count).'count + m', '0'"
+contents' = "select Leaf{m=m}; aggregate (count.'count + m') '0'"
 
 go = case parse (parseEr mkExp) "er" contents' of
   (Left err) -> error (show err)