From 4b062f1f275d568099d6ebf4c1c687c50d039b84 Mon Sep 17 00:00:00 2001
From: Brad Richardson <everythingfunctional@protonmail.com>
Date: Thu, 15 Oct 2020 10:13:35 -0500
Subject: Add constructor for Module Source

---
 bootstrap/src/BuildModel.hs | 40 ++++++++++++++++++++++++++++++++--------
 1 file changed, 32 insertions(+), 8 deletions(-)

(limited to 'bootstrap/src')

diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs
index e5291ac..db44b54 100644
--- a/bootstrap/src/BuildModel.hs
+++ b/bootstrap/src/BuildModel.hs
@@ -25,18 +25,24 @@ import           Text.ParserCombinators.ReadP   ( ReadP
                                                 , string
                                                 )
 
-data LineContents = ProgramDeclaration | ModuleUsed String | Other
+data LineContents =
+    ProgramDeclaration
+  | ModuleDeclaration String
+  | ModuleUsed String
+  | Other
 
 data RawSource = RawSource {
     rawSourceFilename :: FilePath
   , rawSourceContents :: String
 }
 
-data Source = Program {
-    programSourceFileName :: FilePath
-  , programObjectFileName :: FilePath -> FilePath
-  , programModulesUsed :: [String]
-}
+data Source =
+  Program
+    { programSourceFileName :: FilePath
+    , programObjectFileName :: FilePath -> FilePath
+    , programModulesUsed :: [String]
+    }
+  | Module {}
 
 processRawSource :: RawSource -> Source
 processRawSource rawSource =
@@ -53,7 +59,7 @@ processRawSource rawSource =
                                         <.> "o"
           , programModulesUsed    = getModulesUsed parsedContents
           }
-        else undefined
+        else if hasModuleDeclaration parsedContents then Module{} else undefined
 
 pathSeparatorsToUnderscores :: FilePath -> FilePath
 pathSeparatorsToUnderscores fileName =
@@ -73,6 +79,15 @@ hasProgramDeclaration parsedContents = case filter f parsedContents of
     ProgramDeclaration -> True
     _                  -> False
 
+hasModuleDeclaration :: [LineContents] -> Bool
+hasModuleDeclaration parsedContents = case filter f parsedContents of
+  x : _ -> True
+  _     -> False
+ where
+  f lc = case lc of
+    ModuleDeclaration{} -> True
+    _                   -> False
+
 getModulesUsed :: [LineContents] -> [String]
 getModulesUsed = mapMaybe contentToMaybeModuleName
  where
@@ -99,7 +114,8 @@ doFortranLineParse :: ReadP LineContents
 doFortranLineParse = option Other fortranUsefulContents
 
 fortranUsefulContents :: ReadP LineContents
-fortranUsefulContents = programDeclaration <|> useStatement
+fortranUsefulContents =
+  programDeclaration <|> moduleDeclaration <|> useStatement
 
 programDeclaration :: ReadP LineContents
 programDeclaration = do
@@ -109,6 +125,14 @@ programDeclaration = do
   _ <- validIdentifier
   return ProgramDeclaration
 
+moduleDeclaration :: ReadP LineContents
+moduleDeclaration = do
+  skipSpaces
+  _ <- string "module"
+  skipAtLeastOneWhiteSpace
+  moduleName <- validIdentifier
+  return $ ModuleDeclaration moduleName
+
 useStatement :: ReadP LineContents
 useStatement = do
   skipSpaces
-- 
cgit v1.2.3