Restructuring

3 files changed, 154 insertions, 155 deletions

diff --git a/src/Fun/Compiler.hs b/src/Fun/Compiler.hs
index 4d9a67a..b53ff73 100644
--- a/src/Fun/Compiler.hs
+++ b/src/Fun/Compiler.hs
@@ -1,6 +1,7 @@
 module Fun.Compiler where
 
 import           Control.Exception
+import           Fun.Grammar
 import           Fun.Parser
 import           Fun.Tree
 import           System.Exit
diff --git a/src/Fun/Grammar.hs b/src/Fun/Grammar.hs
new file mode 100644
index 0000000..2b46418
--- /dev/null
+++ b/src/Fun/Grammar.hs
@@ -0,0 +1,153 @@
+module Fun.Grammar where
+
+import           Fun.Parser
+import           Fun.Tree
+
+tree :: Parser Tree
+tree = iterFull program >>> Tree
+
+program :: Parser Program
+program = iterFull block >>> Program <?> "program"
+
+block :: Parser Block
+block =
+  functionBlock
+    <+-> newline
+    >>>  Block
+    <|>  functionBlock
+    <+-> endOfFile
+    >>>  Block
+    <?>  "block"
+
+visibility :: Parser Visibility
+visibility =
+  (literal '+' >>> const PublicVisibility)
+    <|> (literal '-' >>> const PrivateVisibility)
+    <?> "visibility"
+
+functionBlock :: Parser FunctionBlock
+functionBlock = functionDeclaration <+> iter functionDefinition >>> build
+  where build (decl, defn) = FunctionBlock decl defn
+
+functionDeclaration :: Parser FunctionDeclaration
+functionDeclaration =
+  functionDeclarationWithoutFlags
+    <|> functionDeclarationWithFlags
+    <?> "function declaration"
+
+functionDeclarationWithoutFlags :: Parser FunctionDeclaration
+functionDeclarationWithoutFlags =
+  functionName
+    <+>  functionDeclarationDelimiter
+    <+>  functionTypes
+    <+-> newline
+    >>>  build
+    <?>  "function declaration without flags"
+  where build ((name, vis), types) = FunctionDeclaration name vis types []
+
+functionDeclarationWithFlags :: Parser FunctionDeclaration
+functionDeclarationWithFlags =
+  functionName
+    <+>  functionDeclarationDelimiter
+    <+>  functionTypes
+    <+-> space
+    <+-> functionFlagDelimiter
+    <+>  functionFlagList
+    >>>  build
+    <?>  "function declaration with flags"
+ where
+  build (((name, vis), types), flags) =
+    FunctionDeclaration name vis types flags
+
+functionDeclarationDelimiter :: Parser Visibility
+functionDeclarationDelimiter =
+  space
+    <-+> literal ':'
+    <-+> visibility
+    <+-> literal ':'
+    <+-> space
+    <?>  "function declaration delimiter"
+
+functionName :: Parser String
+functionName =
+  (special <|> letter)
+    <+> iter (special <|> alphanum)
+    >>> build
+    <?> "function name"
+  where build (first, rest) = first : rest
+
+functionTypes :: Parser [String]
+functionTypes =
+  iter (functionType <+-> space <+-> functionTypeDelimiter <+-> space)
+    <+> functionType
+    >>> build
+    <?> "function types"
+  where build (a, b) = a ++ [b]
+
+functionType :: Parser String
+functionType =
+  (letter <=> isUpper) <+> oneOrMore alphanum >>> build <?> "function type"
+  where build (first, rest) = first : rest
+
+functionTypeDelimiter :: Parser Char
+functionTypeDelimiter = literal ':' <?> "function type delimiter"
+
+functionFlagList :: Parser [FunctionFlag]
+functionFlagList =
+  (iter (space <-+> functionFlag)) <+-> newline >>> build <?> "function flags"
+  where build list = map read list
+
+functionFlagDelimiter :: Parser Char
+functionFlagDelimiter = literal '%' <?> "function flag delimiter"
+
+functionFlags :: [String]
+functionFlags = ["inline", "deprecated"]
+
+functionFlag :: Parser String
+functionFlag = letters <=> (`elem` functionFlags) <?> "function flag"
+
+functionDefinition :: Parser FunctionDefinition
+functionDefinition =
+  (functionPattern <+-> literal ':')
+    <+> functionBody
+    >>> build
+    <?> "function definition"
+  where build (pattern, body) = FunctionDefinition pattern body
+
+functionPattern :: Parser FunctionPattern
+functionPattern =
+  iter (functionPatternElement <+-> space)
+    >>> FunctionPattern
+    <?> "function pattern"
+
+functionPatternElement :: Parser FunctionPatternElement
+functionPatternElement =
+  (functionParameter >>> FunctionPatternParameter)
+    <|> (literal '_' >>> const FunctionPatternWildcard)
+    <|> (number >>> FunctionPatternNumber)
+    <|> (string >>> FunctionPatternString)
+    <?> "function pattern element"
+
+functionParameter :: Parser String
+functionParameter =
+  letters <|> (letter <+> oneOrMore alphanum) >>> build <?> "function parameter"
+  where build (a, b) = a : b
+
+functionBody :: Parser FunctionBody
+functionBody =
+  iter (space <-+> functionBodyElement)
+    <+-> newline
+    >>>  FunctionBody
+    <?>  "function body"
+
+functionBodyElement :: Parser FunctionBodyElement
+functionBodyElement =
+  statement
+    <|> (functionName >>> FunctionBodyIdentifier)
+    <|> (functionParameter >>> FunctionBodyIdentifier)
+    <|> (string >>> FunctionBodyString)
+    <|> (number >>> FunctionBodyNumber)
+    <?> "function body element"
+
+statement :: Parser FunctionBodyElement --  TODO
+statement = accept "if" >>> Statement
diff --git a/src/Fun/Parser.hs b/src/Fun/Parser.hs
index 15c5cd0..0a16bc0 100644
--- a/src/Fun/Parser.hs
+++ b/src/Fun/Parser.hs
@@ -1,7 +1,5 @@
 module Fun.Parser where
 
-import           Fun.Tree
-
 data Trace = StringTrace String | OrTrace [Trace] [Trace]
   deriving (Eq, Show)
 data State = State
@@ -12,8 +10,6 @@ data State = State
 type Parser a = String -> Either State (a, String)
 
 ----
--- I don't use Data.Char because of planned future reimplementation in Fun
-----
 
 lowerAlpha :: [Char]
 lowerAlpha = "abcdefghijklmnopqrstuvwxyzαβγδεζηθικλμνξοπρστυφχψω"
@@ -178,154 +174,3 @@ infix 0 <?>
 (parser <?> string) input = case parser input of
   Left  (State t l) -> Left $ State ([StringTrace string] ++ t) l
   Right a           -> Right a
-
-----
-
-tree :: Parser Tree
-tree = iterFull program >>> Tree
-
-program :: Parser Program
-program = iterFull block >>> Program <?> "program"
-
-block :: Parser Block
-block =
-  functionBlock
-    <+-> newline
-    >>>  Block
-    <|>  functionBlock
-    <+-> endOfFile
-    >>>  Block
-    <?>  "block"
-
-visibility :: Parser Visibility
-visibility =
-  (literal '+' >>> const PublicVisibility)
-    <|> (literal '-' >>> const PrivateVisibility)
-    <?> "visibility"
-
-functionBlock :: Parser FunctionBlock
-functionBlock = functionDeclaration <+> iter functionDefinition >>> build
-  where build (decl, defn) = FunctionBlock decl defn
-
-functionDeclaration :: Parser FunctionDeclaration
-functionDeclaration =
-  functionDeclarationWithoutFlags
-    <|> functionDeclarationWithFlags
-    <?> "function declaration"
-
-functionDeclarationWithoutFlags :: Parser FunctionDeclaration
-functionDeclarationWithoutFlags =
-  functionName
-    <+>  functionDeclarationDelimiter
-    <+>  functionTypes
-    <+-> newline
-    >>>  build
-    <?>  "function declaration without flags"
-  where build ((name, vis), types) = FunctionDeclaration name vis types []
-
-functionDeclarationWithFlags :: Parser FunctionDeclaration
-functionDeclarationWithFlags =
-  functionName
-    <+>  functionDeclarationDelimiter
-    <+>  functionTypes
-    <+-> space
-    <+-> functionFlagDelimiter
-    <+>  functionFlagList
-    >>>  build
-    <?>  "function declaration with flags"
- where
-  build (((name, vis), types), flags) =
-    FunctionDeclaration name vis types flags
-
-functionDeclarationDelimiter :: Parser Visibility
-functionDeclarationDelimiter =
-  space
-    <-+> literal ':'
-    <-+> visibility
-    <+-> literal ':'
-    <+-> space
-    <?>  "function declaration delimiter"
-
-functionName :: Parser String
-functionName =
-  (special <|> letter)
-    <+> iter (special <|> alphanum)
-    >>> build
-    <?> "function name"
-  where build (first, rest) = first : rest
-
-functionTypes :: Parser [String]
-functionTypes =
-  iter (functionType <+-> space <+-> functionTypeDelimiter <+-> space)
-    <+> functionType
-    >>> build
-    <?> "function types"
-  where build (a, b) = a ++ [b]
-
-functionType :: Parser String
-functionType =
-  (letter <=> isUpper) <+> oneOrMore alphanum >>> build <?> "function type"
-  where build (first, rest) = first : rest
-
-functionTypeDelimiter :: Parser Char
-functionTypeDelimiter = literal ':' <?> "function type delimiter"
-
-functionFlagList :: Parser [FunctionFlag]
-functionFlagList =
-  (iter (space <-+> functionFlag)) <+-> newline >>> build <?> "function flags"
-  where build list = map read list
-
-functionFlagDelimiter :: Parser Char
-functionFlagDelimiter = literal '%' <?> "function flag delimiter"
-
-functionFlags :: [String]
-functionFlags = ["inline", "deprecated"]
-
-functionFlag :: Parser String
-functionFlag = letters <=> (`elem` functionFlags) <?> "function flag"
-
-functionDefinition :: Parser FunctionDefinition
-functionDefinition =
-  (functionPattern <+-> literal ':')
-    <+> functionBody
-    >>> build
-    <?> "function definition"
-  where build (pattern, body) = FunctionDefinition pattern body
-
-functionPattern :: Parser FunctionPattern
-functionPattern =
-  iter (functionPatternElement <+-> space)
-    >>> FunctionPattern
-    <?> "function pattern"
-
-functionPatternElement :: Parser FunctionPatternElement
-functionPatternElement =
-  (functionParameter >>> FunctionPatternParameter)
-    <|> (literal '_' >>> const FunctionPatternWildcard)
-    <|> (number >>> FunctionPatternNumber)
-    <|> (string >>> FunctionPatternString)
-    <?> "function pattern element"
-
-functionParameter :: Parser String
-functionParameter =
-  letters <|> (letter <+> oneOrMore alphanum) >>> build <?> "function parameter"
-  where build (a, b) = a : b
-
-functionBody :: Parser FunctionBody
-functionBody =
-  iter (space <-+> functionBodyElement)
-    <+-> newline
-    >>>  FunctionBody
-    <?>  "function body"
-
-functionBodyElement :: Parser FunctionBodyElement
-functionBodyElement =
-  statement
-    <|> (functionName >>> FunctionBodyIdentifier)
-    <|> (functionParameter >>> FunctionBodyIdentifier)
-    <|> (string >>> FunctionBodyString)
-    <|> (number >>> FunctionBodyNumber)
-    <?> "function body element"
-
-statement :: Parser FunctionBodyElement --  TODO
-statement = accept "if" >>> Statement