diff options
| -rw-r--r-- | fun.cabal | 1 | ||||
| -rw-r--r-- | lib.fun | 2 | ||||
| -rwxr-xr-x | run | 2 | ||||
| -rw-r--r-- | src/Fun.hs | 4 | ||||
| -rw-r--r-- | src/Fun/Compiler.hs | 36 | ||||
| -rw-r--r-- | src/Fun/Generator.hs | 13 | ||||
| -rw-r--r-- | src/Fun/Syntax.hs | 2 | ||||
| -rw-r--r-- | src/Fun/Tree.hs | 16 | ||||
| -rw-r--r-- | src/Fun/Typer.hs | 2 | ||||
| -rw-r--r-- | test.fun | 11 |
10 files changed, 68 insertions, 21 deletions
@@ -25,6 +25,7 @@ library exposed-modules: Fun Fun.Compiler + Fun.Generator Fun.Grammar Fun.Parser Fun.Syntax @@ -0,0 +1,2 @@ +_start :+: _void % danger-void danger-asm +: _asm "xor ebx, ebx\nxor eax, eax\nmov al, 0x1\nint 0x80" @@ -1,3 +1,3 @@ #!/bin/sh -stack build && stack exec -- fun-exe test.fun +stack build && stack exec -- fun-exe lib.fun test.fun @@ -10,5 +10,5 @@ run :: IO () run = do args <- getArgs case args of - [path] -> compile path - _ -> usage + [] -> usage + paths -> compile paths diff --git a/src/Fun/Compiler.hs b/src/Fun/Compiler.hs index 6a4f8e1..563f039 100644 --- a/src/Fun/Compiler.hs +++ b/src/Fun/Compiler.hs @@ -1,12 +1,15 @@ +{-# LANGUAGE ScopedTypeVariables #-} module Fun.Compiler where import Control.Exception +import Fun.Generator import Fun.Grammar import Fun.Parser import Fun.Syntax import Fun.Tree import System.Exit import System.IO +import Text.Read traceBranch :: Int -> Trace -> String traceBranch c (StringTrace t) = "\n" ++ (replicate c ' ') ++ t @@ -24,8 +27,8 @@ traceTree c ts = foldr join "" $ map (traceBranch c) ts genTrace :: [Trace] -> String genTrace ts = "Trace of expectance:\n" ++ traceTree 0 ts -parse :: String -> Either String Tree -parse s = case tree s of +parse :: String -> Either String Program +parse s = case program s of Left a -> Left $ "Parse error!\n" ++ case a of State [] Nothing -> "No context available" State t Nothing -> genTrace t @@ -40,13 +43,24 @@ check t = case checkTree t of where join = foldr (\(SyntaxError a) b -> a ++ if b == "" then b else "\n" ++ b) "" -compile :: String -> IO () -compile path = do - file <- try $ readFile path - case file of +generate :: Tree -> Either String String +generate t = case generateAsm t of + Left (GenerateError a) -> Left $ "Error while generating ASM!\n" ++ a + Right a -> Right a + +failExit :: String -> IO () +failExit err = do + hPutStrLn stderr err + exitWith (ExitFailure 1) + +compile :: [String] -> IO () +compile paths = do + files <- sequence + $ map (\p -> try $ readFile p :: IO (Either IOError String)) paths + case sequence files of -- TODO: Improve this left/right chain Left exception -> print (exception :: IOError) - Right file -> case parse file >>= check of - Left err -> do - hPutStrLn stderr err - exitWith (ExitFailure 1) - Right block -> putStrLn . show $ block + Right files -> case sequence $ map parse files of + Left err -> failExit err + Right ps -> case check (Tree ps) >>= generate of + Left err -> failExit err + Right gen -> putStrLn gen diff --git a/src/Fun/Generator.hs b/src/Fun/Generator.hs new file mode 100644 index 0000000..17f47e3 --- /dev/null +++ b/src/Fun/Generator.hs @@ -0,0 +1,13 @@ +module Fun.Generator where + +import Fun.Tree +import Fun.Typer + +-- TODO: 'Merge' syntax for danger-asm: _merge (_asm ..) main (_asm ..) + +data GenerateError = GenerateError String + +generateAsm :: Tree -> Either GenerateError String +-- generateAsm (Tree t) = Right $ show t +generateAsm t = + Left $ GenerateError $ show $ getFunction t "_start" [InternalType "_void"] diff --git a/src/Fun/Syntax.hs b/src/Fun/Syntax.hs index c426a03..1c4846c 100644 --- a/src/Fun/Syntax.hs +++ b/src/Fun/Syntax.hs @@ -10,7 +10,7 @@ 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) +-- TODO: Overloading only if first element is different checkFunctionArity :: Block -> Either [SyntaxError] Block checkFunctionArity (FunctionBlock decl defns) = diff --git a/src/Fun/Tree.hs b/src/Fun/Tree.hs index 26b415f..817a077 100644 --- a/src/Fun/Tree.hs +++ b/src/Fun/Tree.hs @@ -26,10 +26,12 @@ data Block = FunctionBlock } -- | DataBlock .. TODO deriving Show +type FunctionSignature = [Type] + data FunctionDeclaration = FunctionDeclaration { dName :: String , dVisibility :: Visibility - , dTypes :: [Type] + , dTypes :: FunctionSignature , dFlags :: [FunctionFlag] } deriving Show @@ -55,3 +57,15 @@ data FunctionBody = FunctionBody data FunctionBodyElement = Statement String | FunctionBodyIdentifier String | FunctionBodyParameter String | FunctionBodyString String | FunctionBodyNumber Integer deriving Show + +---- + +-- TODO: This can be optimized +getFunction :: Tree -> String -> FunctionSignature -> Maybe Block +getFunction (Tree ps) f sig = + let fromProgram (Program bs) = + filter (\b -> (dName . bDecl) b == f && (dTypes . bDecl) b == sig) bs + fromTree = filter (\b -> length b == 1) (map fromProgram ps) + in case fromTree of + [[f]] -> Just f + _ -> Nothing diff --git a/src/Fun/Typer.hs b/src/Fun/Typer.hs index 5d636f8..656d56b 100644 --- a/src/Fun/Typer.hs +++ b/src/Fun/Typer.hs @@ -1,7 +1,7 @@ module Fun.Typer where data Type = UnknownType | NormalType String | InternalType String | ListType Type - deriving Show + deriving (Show, Eq) -- TODO: Struct (like 'data' with mutiple), Union (like 'data' with '|') -- TODO: Handle primary types as normal non-primary types? @@ -1,8 +1,11 @@ -test :-: u32 : u32 : u32 -a b : * a b ++ :+: Unsigned32 : Unsigned32 : Unsigned32 % inline +b : 5 ab "baum" -text :-: [u8] +test :+: Unsigned32 : Unsigned32 : Unsigned32 % inline +ab 123 : bab 5 + +text :-: [Unsigned8] : "hallo" -main :+: IO +main :+: Unsigned32 : log text |