flatter structure

Author: Isweet

.gitignore

@@ -0,0 +1,2 @@
+.cabal-sandbox/*
+cabal.sandbox.config

ppa.cabal

@@ -17,7 +17,7 @@ extra-source-files:  README.md
 cabal-version:       >=1.10
 
 library
-  exposed-modules:     PPA.Lang.While.Syntax PPA.Lang.While.Internal.Syntax PPA.Lang.While.Util
+  exposed-modules:     PPA.Lang.While PPA.Lang.While.Internal PPA.Lang.While.Util
 --  other-modules:
   other-extensions:    FlexibleContexts
   build-depends:       base == 4.8.*, parsec == 3.1.*, containers == 0.5.*

src/PPA/Lang/While.hs

@@ -0,0 +1,3 @@
+module PPA.Lang.While (S.Stmt, S.showL) where
+
+import PPA.Lang.While.Internal as S

src/PPA/Lang/While/Internal/Syntax.hs src/PPA/Lang/While/Internal.hs

@@ -1,13 +1,14 @@
 {-# LANGUAGE FlexibleContexts #-}
 
-module PPA.Lang.While.Internal.Syntax where
+module PPA.Lang.While.Internal where
 
 import Prelude hiding (Num, GT, LT)
+
 import Text.Parsec
-import qualified Text.ParserCombinators.Parsec.Char as Char
-import qualified Text.ParserCombinators.Parsec.Language as Language
-import qualified Text.ParserCombinators.Parsec.Token as Token
-import qualified Text.ParserCombinators.Parsec.Expr as Expr
+import qualified Text.Parsec.Char as Char
+import qualified Text.Parsec.Language as Language
+import qualified Text.Parsec.Token as Token
+import qualified Text.Parsec.Expr as Expr
 
 import qualified Data.List as List
 

src/PPA/Lang/While/Syntax.hs

@@ -4,15 +4,15 @@ import Prelude hiding (init)
 
 import qualified Data.Set as Set
 
-import PPA.Lang.While.Internal.Syntax
+import PPA.Lang.While.Internal
 
 data Block = BAssign Var AExp Lab | BSkip Lab | BBExp BExp Lab deriving (Eq, Ord)
 
 instance Show Block where
     show (BAssign x a l) = "(" ++ (show l) ++ ") " ++ (show $ SAssign x a l)
     show (BSkip l)       = "(" ++ (show l) ++ ") " ++ (show $ SSkip l)
     show (BBExp b l)     = "(" ++ (show l) ++ ") " ++ (show b)
-
+-- 2.1, p. 36
 init :: Stmt -> Lab
 init (SAssign _ _ l) = l
 init (SSkip l)       = l
@@ -23,6 +23,7 @@ init (SSeq ss)       = init s_1
 init (SIf _ l _ _)   = l
 init (SWhile _ l _)  = l
 
+-- 2.1, p. 36
 final :: Stmt -> Set.Set Lab
 final (SAssign _ _ l) = Set.singleton l
 final (SSkip l)       = Set.singleton l
@@ -33,6 +34,7 @@ final (SSeq ss)       = final s_n
 final (SIf _ _ s1 s2) = Set.unions [(final s1), (final s2)]
 final (SWhile _ l _)  = Set.singleton l
 
+-- 2.1, p. 36
 blocks :: Stmt -> Set.Set Block
 blocks (SAssign x a l) = Set.singleton $ BAssign x a l
 blocks (SSkip l)       = Set.singleton $ BSkip l
@@ -43,32 +45,15 @@ blocks (SSeq ss)       = Set.unions $ bs
 blocks (SIf b l s1 s2) = Set.unions [Set.singleton $ BBExp b l, blocks s1, blocks s2]
 blocks (SWhile b l s)  = Set.unions [Set.singleton $ BBExp b l, blocks s]
 
+-- 2.1, p. 37
 labels :: Stmt -> Set.Set Lab
 labels s = Set.map getLabel $ blocks s
     where 
         getLabel (BAssign _ _ l) = l
         getLabel (BSkip l)       = l
         getLabel (BBExp _ l)     = l
 
-fvA :: AExp -> Set.Set Var
-fvA (AVar x)       = Set.singleton x
-fvA (ANum _)       = Set.empty
-fvA (AOpA _ a1 a2) = Set.unions [fvA a1, fvA a2]
-
-fvB :: BExp -> Set.Set Var
-fvB (BTrue)        = Set.empty
-fvB (BFalse)       = Set.empty
-fvB (BNot b)       = fvB b
-fvB (BOpB _ b1 b2) = Set.unions [fvB b1, fvB b2]
-fvB (BOpR _ a1 a2) = Set.unions [fvA a1, fvA a2]
-
-fv :: Stmt -> Set.Set Var
-fv (SAssign x a _) = Set.unions [Set.singleton x, fvA a]
-fv (SSkip _)       = Set.empty
-fv (SSeq ss)       = Set.unions $ map fv ss
-fv (SIf b _ s1 s2) = Set.unions [fvB b, fv s1, fv s2]
-fv (SWhile b _ s)  = Set.unions [fvB b, fv s]
-
+-- 2.1, p. 37
 flow :: Stmt -> Set.Set (Lab, Lab)
 flow (SAssign _ _ _) = Set.empty
 flow (SSkip _)       = Set.empty
@@ -101,6 +86,29 @@ flow (SWhile _ l s) = Set.unions [subflows, bodyflows]
         bodyflows :: Set.Set (Lab, Lab)
         bodyflows = Set.unions [Set.singleton (l, init s), Set.map (\ l' -> (l', l)) $ final s]
 
+-- 2.1, p. 38
 flowReverse :: Stmt -> Set.Set (Lab, Lab)
 flowReverse s = Set.map (\ (l, l') -> (l', l)) $ flow s
 
+fvA :: AExp -> Set.Set Var
+fvA (AVar x)       = Set.singleton x
+fvA (ANum _)       = Set.empty
+fvA (AOpA _ a1 a2) = Set.unions [fvA a1, fvA a2]
+
+fvB :: BExp -> Set.Set Var
+fvB (BTrue)        = Set.empty
+fvB (BFalse)       = Set.empty
+fvB (BNot b)       = fvB b
+fvB (BOpB _ b1 b2) = Set.unions [fvB b1, fvB b2]
+fvB (BOpR _ a1 a2) = Set.unions [fvA a1, fvA a2]
+
+-- 2.1, p. 38
+-- NOTE: Referenced, but not defined
+fv :: Stmt -> Set.Set Var
+fv (SAssign x a _) = Set.unions [Set.singleton x, fvA a]
+fv (SSkip _)       = Set.empty
+fv (SSeq ss)       = Set.unions $ map fv ss
+fv (SIf b _ s1 s2) = Set.unions [fvB b, fv s1, fv s2]
+fv (SWhile b _ s)  = Set.unions [fvB b, fv s]
+
+

src/PPA/Lang/While/Util.hs

@@ -2,16 +2,16 @@ module Main (main) where
 
 import Test.Hspec
 
-import qualified PPATest.Lang.While.SyntaxSpec
-import qualified PPATest.Lang.While.UtilSpec
+import qualified PPATest.Lang.While
+import qualified PPATest.Lang.While.Internal
+import qualified PPATest.Lang.While.Util
 
-import qualified PPATest.Lang.While.Internal.SyntaxSpec
 
 main :: IO ()
 main = hspec spec
 
 spec :: Spec
 spec = do
-  describe "Lang.While.SyntaxSpec"              PPATest.Lang.While.SyntaxSpec.spec
-  describe "Lang.While.UtilSpec"                PPATest.Lang.While.UtilSpec.spec
-  describe "Lang.While.Internal.SyntaxSpec"     PPATest.Lang.While.Internal.SyntaxSpec.spec
+    describe "Lang.While"           PPATest.Lang.While.spec
+    describe "Lang.While.Internal"  PPATest.Lang.While.Internal.spec
+    describe "Lang.While.Util"      PPATest.Lang.While.Util.spec

test/Main.hs

@@ -1,5 +1,7 @@
 module PPATest.Common where
 
+
+
 -- Progs
 
 ifBasic :: String

test/PPATest/Common.hs

@@ -0,0 +1,41 @@
+module PPATest.Lang.While (spec) where
+
+import Test.Hspec
+
+import PPATest.Common
+
+import PPA.Lang.While
+
+spec :: Spec
+spec = do
+    describe "read . show" $ do
+        it "-- ifBasic" $
+            rs ifBasicS `shouldBe` ifBasicS
+        it "-- ifTwice" $
+            rs ifTwiceS `shouldBe` ifTwiceS
+        it "-- power" $
+            rs powerS `shouldBe` powerS
+        it "-- factorial" $
+            rs factorialS `shouldBe` factorialS
+        it "-- available" $
+            rs availableS `shouldBe` availableS
+                where
+
+                    rs :: Stmt -> Stmt
+                    rs = (read . show)
+
+                    ifBasicS :: Stmt
+                    ifBasicS = read ifBasic
+
+                    ifTwiceS :: Stmt
+                    ifTwiceS = read ifTwice
+
+                    powerS :: Stmt
+                    powerS = read power
+
+                    factorialS :: Stmt
+                    factorialS = read factorial
+
+                    availableS :: Stmt
+                    availableS = read available
+

test/PPATest/Lang/While.hs

@@ -0,0 +1,6 @@
+module PPATest.Lang.While.Internal (spec) where
+
+import Test.Hspec
+
+spec :: Spec
+spec = return ()

test/PPATest/Lang/While/Internal.hs

@@ -1,4 +1,4 @@
-module PPATest.Lang.While.UtilSpec (spec) where
+module PPATest.Lang.While.Util (spec) where
 
 import Prelude hiding (init)
 
@@ -8,8 +8,8 @@ import PPATest.Common
 
 import qualified Data.Set as Set
 
+import PPA.Lang.While
 import PPA.Lang.While.Util
-import PPA.Lang.While.Syntax
 
 spec :: Spec
 spec = do
@@ -24,6 +24,7 @@ spec = do
             (init $ factorialS) `shouldBe` 1
         it "-- available" $ do
             (init $ availableS) `shouldBe` 1
+
     describe "final" $ do
         it "-- ifBasic" $ do
             (final $ ifBasicS) `shouldBe` Set.fromList [2, 3]
@@ -35,6 +36,7 @@ spec = do
             (final $ factorialS) `shouldBe` Set.fromList [6]
         it "-- available" $ do
             (final $ availableS) `shouldBe` Set.fromList [3]
+
     describe "flow" $ do
         it "-- ifBasic" $
             (flow $ ifBasicS) `shouldBe` Set.fromList [(1,2), (1,3)]
@@ -44,11 +46,12 @@ spec = do
             (flow $ powerS) `shouldBe` Set.fromList [(1,2), (2,3), (3,4), (4,2)]
         it "-- factorial" $
             (flow $ factorialS) `shouldBe` Set.fromList [(1,2), (2,3), (3,4), (3,6), (4,5), (5,3)]
+
     describe "free variables (fv)" $
         it "-- factorial" $
             (fv $ factorialS) `shouldBe` Set.fromList ["x", "y", "z"]
-
                 where
+
                     ifBasicS :: Stmt
                     ifBasicS = read ifBasic
 
@@ -63,3 +66,4 @@ spec = do
 
                     availableS :: Stmt
                     availableS = read available
+