From 29be28f5e7de2d8a3fa405d61ec63e8c8d7ea809 Mon Sep 17 00:00:00 2001
From: Brad Richardson <everythingfunctional@protonmail.com>
Date: Thu, 15 Oct 2020 11:43:20 -0500
Subject: Add constructor for Submodule Source

---
 bootstrap/src/BuildModel.hs | 22 +++++++++++++++++++++-
 1 file changed, 21 insertions(+), 1 deletion(-)

(limited to 'bootstrap/src')

diff --git a/bootstrap/src/BuildModel.hs b/bootstrap/src/BuildModel.hs
index dc57f81..f784624 100644
--- a/bootstrap/src/BuildModel.hs
+++ b/bootstrap/src/BuildModel.hs
@@ -30,6 +30,7 @@ data LineContents =
   | ModuleDeclaration String
   | ModuleUsed String
   | ModuleSubprogramDeclaration
+  | SubmoduleDeclaration
   | Other
 
 data RawSource = RawSource {
@@ -50,6 +51,7 @@ data Source =
     , moduleName :: String
     , moduleProducesSmod :: Bool
     }
+  | Submodule
 
 processRawSource :: RawSource -> Source
 processRawSource rawSource =
@@ -71,7 +73,9 @@ processRawSource rawSource =
             , moduleName           = getModuleName parsedContents
             , moduleProducesSmod = hasModuleSubprogramDeclaration parsedContents
             }
-          else undefined
+          else if hasSubmoduleDeclaration parsedContents
+            then Submodule
+            else undefined
 
 pathSeparatorsToUnderscores :: FilePath -> FilePath
 pathSeparatorsToUnderscores fileName =
@@ -100,6 +104,15 @@ hasModuleDeclaration parsedContents = case filter f parsedContents of
     ModuleDeclaration{} -> True
     _                   -> False
 
+hasSubmoduleDeclaration :: [LineContents] -> Bool
+hasSubmoduleDeclaration parsedContents = case filter f parsedContents of
+  x : _ -> True
+  _     -> False
+ where
+  f lc = case lc of
+    SubmoduleDeclaration -> True
+    _                    -> False
+
 hasModuleSubprogramDeclaration :: [LineContents] -> Bool
 hasModuleSubprogramDeclaration parsedContents = case filter f parsedContents of
   x : _ -> True
@@ -146,6 +159,7 @@ fortranUsefulContents =
   programDeclaration
     <|> moduleSubprogramDeclaration
     <|> moduleDeclaration
+    <|> submoduleDeclaration
     <|> useStatement
 
 programDeclaration :: ReadP LineContents
@@ -165,6 +179,12 @@ moduleDeclaration = do
   skipSpaceCommentOrEnd
   return $ ModuleDeclaration moduleName
 
+submoduleDeclaration :: ReadP LineContents
+submoduleDeclaration = do
+  skipSpaces
+  _ <- string "submodule"
+  return $ SubmoduleDeclaration
+
 useStatement :: ReadP LineContents
 useStatement = do
   skipSpaces
-- 
cgit v1.2.3