Internal functions/types

5 files changed, 41 insertions, 19 deletions

diff --git a/src/Fun/Grammar.hs b/src/Fun/Grammar.hs
index 7ec9e42..47191de 100644
--- a/src/Fun/Grammar.hs
+++ b/src/Fun/Grammar.hs
@@ -63,11 +63,16 @@ functionDeclarationDelimiter =
     <+-> space
     <?>  "function declaration delimiter"
 
+internalFunctions :: [String]
+internalFunctions = ["_start", "_asm"]
+
 functionName :: Parser String
 functionName =
   (special <|> letter)
     <+> iter (special <|> alphanum)
     >>> build
+    <|> internalWord
+    <=> (`elem` internalFunctions)
     <?> "function name"
   where build (first, rest) = first : rest
 
@@ -79,11 +84,17 @@ functionTypes =
     <?> "function types"
   where build (a, b) = a ++ [b]
 
+internalTypes :: [String]
+internalTypes = ["_void"]
+
 functionType :: Parser Type
 functionType =
   (letter <=> isUpper)
     <+>  oneOrMore alphanum
     >>>  build
+    <|>  internalWord
+    <=>  (`elem` internalTypes)
+    >>>  buildInternal
     <|>  literal '['
     <-+> functionType
     <+-> literal ']'
@@ -91,6 +102,7 @@ functionType =
     <?>  "function type"
  where
   build (first, rest) = resolveType $ first : rest
+  buildInternal t = resolveType t
   buildList t = ListType t
 
 functionTypeDelimiter :: Parser Char
@@ -105,10 +117,10 @@ functionFlagDelimiter :: Parser Char
 functionFlagDelimiter = literal '%' <?> "function flag delimiter"
 
 functionFlags :: [String]
-functionFlags = ["inline", "deprecated"]
+functionFlags = ["inline", "deprecated", "danger-void", "danger-asm"]
 
 functionFlag :: Parser String
-functionFlag = letters <=> (`elem` functionFlags) <?> "function flag"
+functionFlag = specialWord <=> (`elem` functionFlags) <?> "function flag"
 
 functionDefinition :: Parser FunctionDefinition
 functionDefinition =
@@ -155,4 +167,4 @@ functionBodyElement =
     <?> "function body element"
 
 statement :: Parser FunctionBodyElement --  TODO
-statement = accept "if" >>> Statement
+statement = acceptSpecial "if" >>> Statement
diff --git a/src/Fun/Parser.hs b/src/Fun/Parser.hs
index ff1e6bb..dbfb4f7 100644
--- a/src/Fun/Parser.hs
+++ b/src/Fun/Parser.hs
@@ -75,6 +75,13 @@ alphanum = digit <|> letter <?> "letter or digit"
 special :: Parser Char
 special = oneOf "+-*/<^>$@#&!?" <?> "special character"
 
+specialWord :: Parser String
+specialWord = oneOrMore (alphanum <|> special) <?> "special word"
+
+internalWord :: Parser String
+internalWord = literal '_' <+> specialWord >>> build <?> "special word"
+  where build (x, xs) = x : xs
+
 oneOf :: [Char] -> Parser Char
 oneOf s = char <=> (`elem` s) <?> "one of"
 
@@ -99,11 +106,8 @@ iterFull m = m <+> iterFull m >>> (\(x, y) -> x : y) <|> iterFull'
 iterFull' "" = Right ([], "")
 iterFull' _  = Left $ State [] $ Nothing
 
-token :: Parser a -> Parser a
-token = (<+-> space)
-
-accept :: String -> Parser String
-accept w = token ((oneOrMore notSpace) <=> (== w))
+acceptSpecial :: String -> Parser String
+acceptSpecial w = specialWord <=> (== w)
 
 -- Given a parser and a predicate return the parser only if it satisfies the predicate
 infix 7 <=>
diff --git a/src/Fun/Syntax.hs b/src/Fun/Syntax.hs
index 86e8100..c426a03 100644
--- a/src/Fun/Syntax.hs
+++ b/src/Fun/Syntax.hs
@@ -10,6 +10,8 @@ mergeSyntax :: [Either [SyntaxError] a] -> ([a] -> b) -> Either [SyntaxError] b
 mergeSyntax d c | any isLeft d = Left $ concat $ lefts d
                 | otherwise    = Right $ c $ rights d
 
+-- TODO: Disallow same declarations in entire tree (w/o visibility)
+
 checkFunctionArity :: Block -> Either [SyntaxError] Block
 checkFunctionArity (FunctionBlock decl defns) =
   let declArity   = length $ dTypes decl
@@ -22,14 +24,14 @@ checkFunctionArity (FunctionBlock decl defns) =
         else Left [SyntaxError msg]
   where msg = "invalid arity in function " ++ (dName decl)
 
-checkMainExistence :: Tree -> Either [SyntaxError] Tree
-checkMainExistence tree =
-  let inProgram bs = filter (\b -> (dName . bDecl) b == "main") bs
+checkEntryExistence :: Tree -> Either [SyntaxError] Tree
+checkEntryExistence tree =
+  let inProgram bs = filter (\b -> (dName . bDecl) b == "_start") bs
       oneInProgram (Program bs) = length (inProgram bs) == 1
       inTree ps = map oneInProgram ps
       oneInTree (Tree ps) = length (filter (== True) (inTree ps)) == 1
   in  if oneInTree tree then Right tree else Left [SyntaxError msg]
-  where msg = "invalid amount of main functions"
+  where msg = "invalid amount of entry (_start) functions"
 
 checkFunctionPatternDistinguishability :: Block -> Either [SyntaxError] Block
 checkFunctionPatternDistinguishability f =
@@ -54,4 +56,4 @@ checkProgram (Program blocks) = mergeSyntax (map checkBlock blocks) Program
 
 checkTree :: Tree -> Either [SyntaxError] Tree
 checkTree (Tree programs) =
-  mergeSyntax (map checkProgram programs) Tree >>= checkMainExistence
+  mergeSyntax (map checkProgram programs) Tree >>= checkEntryExistence
diff --git a/src/Fun/Tree.hs b/src/Fun/Tree.hs
index 28434cc..26b415f 100644
--- a/src/Fun/Tree.hs
+++ b/src/Fun/Tree.hs
@@ -4,12 +4,15 @@ import           Fun.Typer
 
 data Visibility = PublicVisibility | PrivateVisibility
   deriving Show
-data FunctionFlag = FunctionInline | FunctionDeprecated | FunctionUnknown
+-- TODO: Actually enforce danger-* in syntax-check
+data FunctionFlag = FunctionInline | FunctionDeprecated | FunctionDangerVoid | FunctionDangerAsm | FunctionUnknown
   deriving Show
 instance Read FunctionFlag where
-  readsPrec _ "inline"     = [(FunctionInline, "")]
-  readsPrec _ "deprecated" = [(FunctionDeprecated, "")]
-  readsPrec _ _            = [(FunctionUnknown, "")]
+  readsPrec _ "inline"      = [(FunctionInline, "")]
+  readsPrec _ "deprecated"  = [(FunctionDeprecated, "")]
+  readsPrec _ "danger-void" = [(FunctionDangerVoid, "")]
+  readsPrec _ "danger-asm"  = [(FunctionDangerAsm, "")]
+  readsPrec _ _             = [(FunctionUnknown, "")]
 
 data Tree = Tree [Program]
   deriving Show
diff --git a/src/Fun/Typer.hs b/src/Fun/Typer.hs
index efed9cc..5d636f8 100644
--- a/src/Fun/Typer.hs
+++ b/src/Fun/Typer.hs
@@ -1,6 +1,6 @@
 module Fun.Typer where
 
-data Type = UnknownType | NormalType String | ListType Type
+data Type = UnknownType | NormalType String | InternalType String | ListType Type
   deriving Show
 -- TODO: Struct (like 'data' with mutiple), Union (like 'data' with '|')
 
@@ -17,4 +17,5 @@ sizeOfNormalType "Unsigned8"  = 8
 sizeOfNormalType _            = 0
 
 resolveType :: String -> Type
-resolveType t = NormalType t
+resolveType t@('_' : _) = InternalType t
+resolveType t           = NormalType t