struct variable type checking, refactoring to avoid circular dependencies

src/Data/String/Ubc/Parse/FileScope.hs

@@ -1,8 +0,0 @@
-module Data.String.Ubc.Parse.FileScope
-( FileScope(..)
-)
-where
-
-data FileScope = FileScope
-        {
-        }

src/Data/String/Ubc/Parse/Struct.hs

@@ -1,72 +0,0 @@
-module Data.String.Ubc.Parse.Struct
-( Struct(..)
-, parseStruct
-)
-where
-
-import Control.Arrow
-
-import Text.Parsec
-
-import Data.Map (Map)
-import Data.String.Ubc.Parse.StructVariable (StructVariable(StructVariable))
-import Data.String.Ubc.Parse.ParserState (ParserState)
-import Data.String.Ubc.Parse.StructScope (StructScope(..))
-import Data.String.Ubc.Parse.Scope (Scope(..))
-
-import qualified Data.String.Ubc.Parse.Language as UbcLanguage
-import qualified Data.String.Ubc.Parse.StructScope as StructScope
-import qualified Data.String.Ubc.Parse.ParserState as ParserState
-import qualified Data.String.Ubc.Parse.Scope as Scope
-
-import qualified Data.Map as Map
-
-data Struct = Struct 
-        { name :: String
-        , memberVariables :: Map String StructVariable
-        }
-        deriving (Show)
-
-parseStruct :: Monad m => ParsecT String ParserState m Struct
-parseStruct = do
-        _ <- UbcLanguage.reserved "struct"
-
-        structIdentifier <- UbcLanguage.identifier
-        let structScope = StructScope
-                { structName = structIdentifier 
-                , variables = Map.empty
-                }
-
-        modifyState (ParserState.pushScope . ScopeStruct $ structScope)
-
-        _ <- UbcLanguage.braces (many structMember)
-
-        structScope <- getState >>= return . Scope.expectScopeStruct . snd . ParserState.popScope
-
-        return $ Struct (StructScope.structName structScope) (StructScope.variables structScope)
-
-structMember :: Monad m => ParsecT String ParserState m ()
-structMember = choice [ structVariableOrFunction ]
-
-structVariableOrFunction :: Monad m => ParsecT String ParserState m ()
-structVariableOrFunction = do
-        (typeName, identifier) <- try $ do
-                typeName <- UbcLanguage.identifier
-                objectIdentifier <- UbcLanguage.identifier
-                return $ (typeName, objectIdentifier)
-        choice 
-                [ lookAhead (char ';') *> parseVariable typeName identifier
-                ] -- TODO: Functions on structs
-
-parseVariable variableType variableName = do
-        _ <- UbcLanguage.semicolon
-        -- TODO: Validate type
-
-        (_, structScope) <- getState >>= return . (second Scope.expectScopeStruct) . ParserState.popScope
-        if (== Nothing) . Map.lookup variableName . StructScope.variables $ structScope
-        then do
-                -- variable is not yet defined on the struct
-                let structScope' = StructScope.modifyVariables (Map.insert variableName (StructVariable variableName variableType)) $ structScope
-                modifyState (ParserState.pushScope $ ScopeStruct structScope')
-        else do
-                unexpected $ "name: \"" ++ variableName ++ "\", this name is already defined"

src/Data/String/Ubc/Parse/StructVariable.hs

@@ -1,11 +0,0 @@
-module Data.String.Ubc.Parse.StructVariable
-( StructVariable(..)
-)
-where
-
-data StructVariable = StructVariable 
-        { name :: String
-        , typeName :: String
-        }
-        deriving (Show, Eq)
-

src/Ubc/Parse.hs

@@ -1,5 +1,6 @@
-module Data.String.Ubc.Parse
+module Ubc.Parse
 ( someFunc )
 where
 
+someFunc :: IO ()
 someFunc = putStrLn "help"

src/Ubc/Parse/Data/Struct.hs

@@ -0,0 +1,14 @@
+module Ubc.Parse.Data.Struct
+( Struct(..)
+)
+where
+
+import Data.Map (Map)
+
+import Ubc.Parse.VariableType (VariableType)
+
+data Struct = Struct 
+        { name :: String
+        , memberVariables :: Map String VariableType
+        }
+        deriving (Show)

src/Ubc/Parse/File.hs

@@ -0,0 +1,5 @@
+module Ubc.Parse.File
+(
+)
+where
+

src/Ubc/Parse/Language.hs

@@ -1,39 +1,49 @@
 {-# LANGUAGE NoMonomorphismRestriction #-}
-module Data.String.Ubc.Parse.Language
+module Ubc.Parse.Language
 ( languageDef
-, Data.String.Ubc.Parse.Language.identifier         
+, typeName
-, Data.String.Ubc.Parse.Language.reserved           
+, Ubc.Parse.Language.identifier         
-, Data.String.Ubc.Parse.Language.operator           
+, Ubc.Parse.Language.reserved           
-, Data.String.Ubc.Parse.Language.reservedOperator   
+, Ubc.Parse.Language.operator           
-, Data.String.Ubc.Parse.Language.characterLiteral   
+, Ubc.Parse.Language.reservedOperator   
-, Data.String.Ubc.Parse.Language.stringLiteral      
+, Ubc.Parse.Language.characterLiteral   
-, Data.String.Ubc.Parse.Language.natural            
+, Ubc.Parse.Language.stringLiteral      
-, Data.String.Ubc.Parse.Language.integer            
+, Ubc.Parse.Language.natural            
-, Data.String.Ubc.Parse.Language.float              
+, Ubc.Parse.Language.integer            
-, Data.String.Ubc.Parse.Language.naturalOrFloat     
+, Ubc.Parse.Language.float              
-, Data.String.Ubc.Parse.Language.decimal            
+, Ubc.Parse.Language.naturalOrFloat     
-, Data.String.Ubc.Parse.Language.hexadecimal        
+, Ubc.Parse.Language.decimal            
-, Data.String.Ubc.Parse.Language.octal              
+, Ubc.Parse.Language.hexadecimal        
-, Data.String.Ubc.Parse.Language.symbol             
+, Ubc.Parse.Language.octal              
-, Data.String.Ubc.Parse.Language.lexeme             
+, Ubc.Parse.Language.symbol             
-, Data.String.Ubc.Parse.Language.whiteSpace         
+, Ubc.Parse.Language.lexeme             
-, Data.String.Ubc.Parse.Language.parens             
+, Ubc.Parse.Language.whiteSpace         
-, Data.String.Ubc.Parse.Language.braces             
+, Ubc.Parse.Language.parens             
-, Data.String.Ubc.Parse.Language.angles             
+, Ubc.Parse.Language.braces             
-, Data.String.Ubc.Parse.Language.brackets           
+, Ubc.Parse.Language.angles             
-, Data.String.Ubc.Parse.Language.semicolon          
+, Ubc.Parse.Language.brackets           
-, Data.String.Ubc.Parse.Language.comma              
+, Ubc.Parse.Language.semicolon          
-, Data.String.Ubc.Parse.Language.colon              
+, Ubc.Parse.Language.comma              
-, Data.String.Ubc.Parse.Language.dot                
+, Ubc.Parse.Language.colon              
-, Data.String.Ubc.Parse.Language.semicolonSeparated 
+, Ubc.Parse.Language.dot                
-, Data.String.Ubc.Parse.Language.semicolonSeparated1
+, Ubc.Parse.Language.semicolonSeparated 
-, Data.String.Ubc.Parse.Language.commaSeparated     
+, Ubc.Parse.Language.semicolonSeparated1
-, Data.String.Ubc.Parse.Language.commaSeparated1    
+, Ubc.Parse.Language.commaSeparated     
+, Ubc.Parse.Language.commaSeparated1    
 )
 where
 
+import Data.Functor ( ($>) )
 import Text.Parsec
+    ( alphaNum, char, letter, oneOf, choice, (<|>), ParsecT )
 import Text.Parsec.Token
+    ( makeTokenParser,
+      GenLanguageDef(..),
+      GenTokenParser(TokenParser, identifier, reserved, operator,
+                     reservedOp, charLiteral, stringLiteral, natural, integer, float,
+                     naturalOrFloat, decimal, hexadecimal, octal, symbol, lexeme,
+                     whiteSpace, parens, braces, angles, brackets, semi, comma, colon,
+                     dot, semiSep, semiSep1, commaSep, commaSep1) )
 
 languageDef :: Monad m => GenLanguageDef String u m
 languageDef = LanguageDef {
@@ -111,3 +121,11 @@ TokenParser{
         , commaSep              = commaSeparated
         , commaSep1             = commaSeparated1
         } = tokenParser
+
+typeName :: Monad m => ParsecT String u m String
+typeName = choice
+        [ Ubc.Parse.Language.reserved "i32" $> "i32"
+        , Ubc.Parse.Language.reserved "u32" $> "u32"
+        , Ubc.Parse.Language.reserved "f32" $> "f32"
+        , Ubc.Parse.Language.identifier
+        ]

src/Ubc/Parse/ParserState.hs

@@ -1,4 +1,4 @@
-module Data.String.Ubc.Parse.ParserState
+module Ubc.Parse.ParserState
 ( ParserState(..)
 , initialState
 , pushScope
@@ -7,7 +7,7 @@ module Data.String.Ubc.Parse.ParserState
 )
 where
 
-import Data.String.Ubc.Parse.Scope (Scope)
+import Ubc.Parse.Scope (Scope)
 
 data ParserState = ParserState
         { scopes :: [Scope]
@@ -17,10 +17,10 @@ initialState :: ParserState
 initialState = ParserState []
 
 pushScope :: Scope -> ParserState -> ParserState
-pushScope scope oldState@ParserState{scopes = oldScopes} = oldState{scopes = (scope : oldScopes)}
+pushScope scope oldState@ParserState{scopes = oldScopes} = oldState{scopes = scope : oldScopes}
 
 popScope :: ParserState -> (ParserState, Scope)
 popScope oldState@ParserState{scopes = (topScope:restScopes)} = (oldState{scopes = restScopes}, topScope)
 
 modifyScope :: (Scope -> Scope) -> ParserState -> ParserState
-modifyScope f oldState@ParserState{scopes = (topScope:restScopes)} = oldState{scopes = (f topScope : restScopes)}
+modifyScope f oldState@ParserState{scopes = (topScope:restScopes)} = oldState{scopes = f topScope : restScopes}

src/Ubc/Parse/Scope.hs

@@ -1,15 +1,16 @@
-module Data.String.Ubc.Parse.Scope
+module Ubc.Parse.Scope
 ( Scope(..)
 , expectScopeStruct
 )
 where
 
-import Data.String.Ubc.Parse.FileScope (FileScope)
+import Ubc.Parse.Scope.FileScope (FileScope)
-import Data.String.Ubc.Parse.StructScope (StructScope)
+import Ubc.Parse.Scope.StructScope (StructScope)
 
 data Scope = 
           ScopeFile FileScope
         | ScopeStruct StructScope
 
+expectScopeStruct :: Scope -> StructScope
 expectScopeStruct (ScopeStruct s) = s
 expectScopeStruct _               = error "Internal Error: Top Scope is not Scope Struct"

src/Ubc/Parse/Scope/FileScope.hs

@@ -0,0 +1,11 @@
+module Ubc.Parse.Scope.FileScope
+( FileScope(..)
+)
+where
+
+import Data.Map (Map)
+import Ubc.Parse.Data.Struct (Struct)
+
+data FileScope = FileScope
+        { structs :: Map String Struct
+        }

src/Ubc/Parse/Scope/StructScope.hs

@@ -1,4 +1,4 @@
-module Data.String.Ubc.Parse.StructScope
+module Ubc.Parse.Scope.StructScope
 ( StructScope(..)
 , modifyVariables
 )
@@ -6,14 +6,14 @@ where
 
 import Data.Map (Map)
 
-import Data.String.Ubc.Parse.StructVariable (StructVariable)
+import Ubc.Parse.VariableType (VariableType)
 
 data StructScope = StructScope
         { structName :: String
-        , variables :: Map String StructVariable
+        , variables :: Map String VariableType
         }
 
-modifyVariables :: (Map String StructVariable -> Map String StructVariable) -> StructScope -> StructScope
+modifyVariables :: (Map String VariableType -> Map String VariableType) -> StructScope -> StructScope
 modifyVariables f scope@StructScope{variables = oldVariables} = scope{variables = newVariables}
         where
                 newVariables = f oldVariables

src/Ubc/Parse/Struct.hs

@@ -0,0 +1,89 @@
+module Ubc.Parse.Struct
+( Struct(..)
+, parseStruct
+)
+where
+
+import Data.Functor ( (<&>) )
+import Control.Arrow ( Arrow(second) )
+
+import Text.Parsec
+    ( char,
+      choice,
+      getState,
+      lookAhead,
+      many,
+      modifyState,
+      try,
+      unexpected,
+      ParsecT )
+
+import Ubc.Parse.ParserState (ParserState)
+import Ubc.Parse.Scope.StructScope (StructScope(..))
+import Ubc.Parse.Scope (Scope(..))
+import Ubc.Parse.Types (checkTypeValidity)
+import Ubc.Parse.Data.Struct (Struct(..))
+
+import qualified Ubc.Parse.Language as UbcLanguage
+import qualified Ubc.Parse.Scope.StructScope as StructScope
+import qualified Ubc.Parse.ParserState as ParserState
+import qualified Ubc.Parse.Scope as Scope
+import qualified Ubc.Parse.VariableType as VariableType
+
+import qualified Data.Map as Map
+
+parseStruct :: Monad m => ParsecT String ParserState m Struct
+parseStruct = do
+        _ <- UbcLanguage.reserved "struct"
+
+        structIdentifier <- UbcLanguage.identifier
+        let structScope = StructScope
+                { structName = structIdentifier 
+                , variables = Map.empty
+                }
+
+        modifyState (ParserState.pushScope . ScopeStruct $ structScope)
+
+        _ <- UbcLanguage.braces (many structMember)
+
+        structScope' <- getState <&> Scope.expectScopeStruct . snd . ParserState.popScope
+
+        return $ Struct (StructScope.structName structScope') (StructScope.variables structScope')
+
+structMember :: Monad m => ParsecT String ParserState m ()
+structMember = choice [ structVariableOrFunction ]
+
+structVariableOrFunction :: Monad m => ParsecT String ParserState m ()
+structVariableOrFunction = do
+        (typeName, identifier) <- try $ do
+                typeName <- UbcLanguage.typeName
+                objectIdentifier <- UbcLanguage.identifier
+                return (typeName, objectIdentifier)
+        choice 
+                [ lookAhead (char ';') *> parseVariable typeName identifier
+                ] -- TODO: Functions on structs
+
+parseVariable :: Monad m => String -> String -> ParsecT String ParserState m ()
+parseVariable variableType variableName = do
+        _ <- UbcLanguage.semicolon
+        -- TODO: Validate type
+
+        (_, structScope) <- getState <&> second Scope.expectScopeStruct . ParserState.popScope
+
+        -- check variable name
+        if (/= Nothing) . Map.lookup variableName . StructScope.variables $ structScope
+        then do
+                unexpected $ "variable name: \"" ++ variableName ++ "\", this name is already defined"
+        else do
+                return ()
+
+        -- check type
+        isKnownType <- checkTypeValidity variableType
+        if not isKnownType
+        then do
+                unexpected $ "variable type: \"" ++ variableType ++ "\", this type is not defined"
+        else do
+                return ()
+
+        let structScope' = StructScope.modifyVariables (Map.insert variableName (VariableType.fromString variableType)) structScope
+        modifyState (ParserState.pushScope $ ScopeStruct structScope')

src/Ubc/Parse/Types.hs

@@ -0,0 +1,20 @@
+module Ubc.Parse.Types
+( checkTypeValidity
+, getTypeNames
+)
+where
+
+import Text.Parsec
+
+import qualified Data.Set as Set
+
+import Ubc.Parse.ParserState (ParserState)
+
+checkTypeValidity :: Monad m => String -> ParsecT String ParserState m Bool
+checkTypeValidity typeName = do
+        typeNames <- getTypeNames >>= return . Set.union (Set.fromList ["i32", "u32", "f32"]) . Set.fromList
+        return $ typeName `Set.member` typeNames
+
+getTypeNames :: Monad m => ParsecT String ParserState m [String]
+getTypeNames = do
+        return []

src/Ubc/Parse/VariableType.hs

@@ -0,0 +1,14 @@
+module Ubc.Parse.VariableType
+(VariableType(..)
+, fromString
+)
+where
+
+data VariableType = BuiltInI32 | BuiltInU32 | BuiltInF32 | UserStruct String
+        deriving (Show, Eq)
+
+fromString :: String -> VariableType
+fromString "i32" = BuiltInI32
+fromString "u32" = BuiltInU32
+fromString "f32" = BuiltInF32
+fromString s     = UserStruct s

ubcc.cabal

@@ -25,14 +25,16 @@ source-repository head
 
 library
   exposed-modules:
-      Data.String.Ubc.Parse
+      Ubc.Parse
-      Data.String.Ubc.Parse.FileScope
+      Ubc.Parse.Data.Struct
-      Data.String.Ubc.Parse.Language
+      Ubc.Parse.Language
-      Data.String.Ubc.Parse.ParserState
+      Ubc.Parse.ParserState
-      Data.String.Ubc.Parse.Scope
+      Ubc.Parse.Scope
-      Data.String.Ubc.Parse.Struct
+      Ubc.Parse.Scope.FileScope
-      Data.String.Ubc.Parse.StructScope
+      Ubc.Parse.Scope.StructScope
-      Data.String.Ubc.Parse.StructVariable
+      Ubc.Parse.Struct
+      Ubc.Parse.Types
+      Ubc.Parse.VariableType
   other-modules:
       Paths_ubcc
   autogen-modules: