From 7de4d0027a6cb1f35aece101275225afb57aefb7 Mon Sep 17 00:00:00 2001 From: Kamil Adam Date: Tue, 4 Aug 2020 18:05:38 +0200 Subject: [PATCH] Add EAS, Assembler of ETA --- docs/CHANGELOG.md | 4 + docs/INSTALL.md | 3 +- docs/TODO.md | 2 +- helpa.cabal | 37 +- src/main/eta/AppOptions.hs | 40 ++ .../HelVM/HelPA/Assemblers/EAS/AsmParser.hs | 99 ++++ .../HelVM/HelPA/Assemblers/EAS/Assembler.hs | 19 + .../HelPA/Assemblers/EAS/CodeGenerator.hs | 29 + .../HelVM/HelPA/Assemblers/EAS/Instruction.hs | 12 + .../eta/HelVM/HelPA/Assemblers/EAS/Linker.hs | 24 + .../eta/HelVM/HelPA/Assemblers/EAS/Reducer.hs | 55 ++ .../eta/HelVM/HelPA/Common/AsmParserUtil.hs | 67 +++ src/main/eta/HelVM/HelPA/Common/OrError.hs | 16 + src/main/eta/HelVM/HelPA/Common/Util.hs | 20 + src/main/eta/HelVM/HelPA/Common/Value.hs | 12 + src/main/eta/HelVM/HelPA/HelPA.hs | 2 + src/main/eta/Main.hs | 35 +- .../HelPA/Assemblers/EAS/AsmParserSpec.hs | 176 ++++++ .../HelPA/Assemblers/EAS/AssemblerSpec.hs | 51 ++ .../HelPA/Assemblers/EAS/CodeGeneratorSpec.hs | 42 ++ .../HelVM/HelPA/Assemblers/EAS/LinkerSpec.hs | 51 ++ .../HelVM/HelPA/Assemblers/EAS/ReducerSpec.hs | 28 + .../HelVM/HelPA/Assemblers/EAS/TestData.hs | 506 ++++++++++++++++++ src/test/eta/Spec.hs | 1 + src/test/resources/eas/README | 37 ++ src/test/resources/eas/add.eas | 11 + src/test/resources/eas/bottles.eas | 40 ++ src/test/resources/eas/euclid.eas | 26 + src/test/resources/eas/fact.eas | 30 ++ src/test/resources/eas/function.eas | 18 + src/test/resources/eas/hello.eas | 9 + src/test/resources/eas/hello2.eas | 9 + src/test/resources/eas/hello3.eas | 9 + src/test/resources/eas/hello4.eas | 9 + src/test/resources/eas/multiply.eas | 34 ++ src/test/resources/eas/pip.eas | 11 + src/test/resources/eas/pip2.eas | 2 + src/test/resources/eas/readnum.eas | 34 ++ src/test/resources/eas/reverse.eas | 14 + src/test/resources/eas/temperat.c | 20 + src/test/resources/eas/test.eas | 6 + src/test/resources/eas/true.eas | 2 + src/test/resources/eas/writenum.eas | 29 + src/test/resources/eas/writestr.eas | 16 + 44 files changed, 1683 insertions(+), 14 deletions(-) create mode 100644 src/main/eta/AppOptions.hs create mode 100644 src/main/eta/HelVM/HelPA/Assemblers/EAS/AsmParser.hs create mode 100644 src/main/eta/HelVM/HelPA/Assemblers/EAS/Assembler.hs create mode 100644 src/main/eta/HelVM/HelPA/Assemblers/EAS/CodeGenerator.hs create mode 100644 src/main/eta/HelVM/HelPA/Assemblers/EAS/Instruction.hs create mode 100644 src/main/eta/HelVM/HelPA/Assemblers/EAS/Linker.hs create mode 100644 src/main/eta/HelVM/HelPA/Assemblers/EAS/Reducer.hs create mode 100644 src/main/eta/HelVM/HelPA/Common/AsmParserUtil.hs create mode 100644 src/main/eta/HelVM/HelPA/Common/OrError.hs create mode 100644 src/main/eta/HelVM/HelPA/Common/Util.hs create mode 100644 src/main/eta/HelVM/HelPA/Common/Value.hs create mode 100644 src/main/eta/HelVM/HelPA/HelPA.hs create mode 100644 src/test/eta/HelVM/HelPA/Assemblers/EAS/AsmParserSpec.hs create mode 100644 src/test/eta/HelVM/HelPA/Assemblers/EAS/AssemblerSpec.hs create mode 100644 src/test/eta/HelVM/HelPA/Assemblers/EAS/CodeGeneratorSpec.hs create mode 100644 src/test/eta/HelVM/HelPA/Assemblers/EAS/LinkerSpec.hs create mode 100644 src/test/eta/HelVM/HelPA/Assemblers/EAS/ReducerSpec.hs create mode 100644 src/test/eta/HelVM/HelPA/Assemblers/EAS/TestData.hs create mode 100644 src/test/eta/Spec.hs create mode 100644 src/test/resources/eas/README create mode 100644 src/test/resources/eas/add.eas create mode 100644 src/test/resources/eas/bottles.eas create mode 100644 src/test/resources/eas/euclid.eas create mode 100644 src/test/resources/eas/fact.eas create mode 100644 src/test/resources/eas/function.eas create mode 100644 src/test/resources/eas/hello.eas create mode 100644 src/test/resources/eas/hello2.eas create mode 100644 src/test/resources/eas/hello3.eas create mode 100644 src/test/resources/eas/hello4.eas create mode 100644 src/test/resources/eas/multiply.eas create mode 100644 src/test/resources/eas/pip.eas create mode 100644 src/test/resources/eas/pip2.eas create mode 100644 src/test/resources/eas/readnum.eas create mode 100644 src/test/resources/eas/reverse.eas create mode 100644 src/test/resources/eas/temperat.c create mode 100644 src/test/resources/eas/test.eas create mode 100644 src/test/resources/eas/true.eas create mode 100644 src/test/resources/eas/writenum.eas create mode 100644 src/test/resources/eas/writestr.eas diff --git a/docs/CHANGELOG.md b/docs/CHANGELOG.md index 6ee0d34d..6390f329 100644 --- a/docs/CHANGELOG.md +++ b/docs/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for helpa +## 0.2.0.0 -- 2020-08-09 + +* Add EAS, Assembler of ETA + ## 0.1.0.0 -- 2020-08-08 * First version. Released on an unsuspecting world. diff --git a/docs/INSTALL.md b/docs/INSTALL.md index 1672c028..6e507287 100644 --- a/docs/INSTALL.md +++ b/docs/INSTALL.md @@ -19,7 +19,8 @@ curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s . Compile and run with `cabal`: ```bash -cabal update && cabal clean && cabal build && cabal test +cabal update +cabal clean && cabal build && cabal test cabal new-test --test-show-details=streaming cabal run helpa ``` diff --git a/docs/TODO.md b/docs/TODO.md index 9460a1ce..d636d024 100644 --- a/docs/TODO.md +++ b/docs/TODO.md @@ -4,7 +4,7 @@ Features to do: * [ ] 🌈 BrainFuck Assembler -* [ ] ❤️ ETA Assembler +* [x] ❤️ ETA Assembler * [ ] 💛 Funge Assembler * [ ] 💚 Piet Assembler * [ ] 💙 SubLeq Assembler diff --git a/helpa.cabal b/helpa.cabal index 5cb25442..9a9488a4 100644 --- a/helpa.cabal +++ b/helpa.cabal @@ -32,20 +32,20 @@ library HelVM.HelPA.Assemblers.EAS.CodeGenerator HelVM.HelPA.Assemblers.EAS.Instruction HelVM.HelPA.Assemblers.EAS.Linker - HelVM.HelPA.Assemblers.EAS.Translator - HelVM.HelPA.Assemblers.WSA.AsmParser - HelVM.HelPA.Assemblers.WSA.Instruction + HelVM.HelPA.Assemblers.EAS.Reducer + HelVM.HelPA.Common.AsmParserUtil + HelVM.HelPA.Common.OrError HelVM.HelPA.Common.Util HelVM.HelPA.Common.Value other-extensions: build-depends: base - , text , attoparsec , containers , mtl , split + , text hs-source-dirs: src/main/eta default-language: Haskell2010 ghc-options: -Wall @@ -59,14 +59,16 @@ test-suite spec HelVM.HelPA.Assemblers.EAS.CodeGeneratorSpec HelVM.HelPA.Assemblers.EAS.LinkerSpec HelVM.HelPA.Assemblers.EAS.TestData - HelVM.HelPA.Assemblers.EAS.TranslatorSpec - HelVM.HelPA.Assemblers.WSA.AsmParserSpec - HelVM.HelPA.Assemblers.WSA.TestData + HelVM.HelPA.Assemblers.EAS.ReducerSpec + other-extensions: build-depends: base - , text , attoparsec + , containers + , mtl + , split + , text , helpa , hspec , hspec-attoparsec @@ -80,15 +82,28 @@ test-suite spec executable helpa main-is: Main.hs other-modules: + AppOptions + + HelVM.HelPA.Assemblers.EAS.AsmParser + HelVM.HelPA.Assemblers.EAS.Assembler + HelVM.HelPA.Assemblers.EAS.CodeGenerator + HelVM.HelPA.Assemblers.EAS.Instruction + HelVM.HelPA.Assemblers.EAS.Linker + HelVM.HelPA.Assemblers.EAS.Reducer + + HelVM.HelPA.Common.AsmParserUtil + HelVM.HelPA.Common.OrError + HelVM.HelPA.Common.Util + HelVM.HelPA.Common.Value other-extensions: build-depends: base - , megaparsec - , parser-combinators , attoparsec + , containers + , mtl + , split , text , optparse-applicative - , pretty-simple hs-source-dirs: src/main/eta default-language: Haskell2010 ghc-options: -threaded -rtsopts -with-rtsopts=-N diff --git a/src/main/eta/AppOptions.hs b/src/main/eta/AppOptions.hs new file mode 100644 index 00000000..3b995e46 --- /dev/null +++ b/src/main/eta/AppOptions.hs @@ -0,0 +1,40 @@ +{-# Language DataKinds #-} +{-# Language ExplicitNamespaces #-} + +module AppOptions where + +import Options.Applicative + +import Text.Read + +optionParser :: Parser AppOptions +optionParser = AppOptions + <$> strOption ( long "lang" + <> short 'l' + <> metavar "[LANG]" + <> help ("Language to assembly " ++ show langs) + <> value (show HAPAPL) + <> showDefault + ) + <*> argument str ( metavar "DIR") + <*> argument str ( metavar "FILE") + + +data AppOptions = AppOptions + { lang :: String --Lang + , dir :: String + , file :: String + } + +---- + +data Lang = HAPAPL | EAS + deriving (Eq, Read, Show) + +langs :: [Lang] +langs = [HAPAPL, EAS] + +computeLang :: String -> Lang +computeLang raw = valid $ readMaybe raw where + valid (Just a) = a + valid Nothing = error ("Lang '" ++ raw ++ "' is not valid lang. Valid langs are : " ++ show langs) diff --git a/src/main/eta/HelVM/HelPA/Assemblers/EAS/AsmParser.hs b/src/main/eta/HelVM/HelPA/Assemblers/EAS/AsmParser.hs new file mode 100644 index 00000000..11c5444c --- /dev/null +++ b/src/main/eta/HelVM/HelPA/Assemblers/EAS/AsmParser.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE OverloadedStrings #-} +module HelVM.HelPA.Assemblers.EAS.AsmParser where + +import HelVM.HelPA.Assemblers.EAS.Instruction + +import HelVM.HelPA.Common.AsmParserUtil +import HelVM.HelPA.Common.Value + +import Control.Applicative +import Data.Attoparsec.Text hiding (I, D) +import Data.Char +import Data.Functor + +import qualified Data.Text as T + +parseAssembler :: T.Text -> Either String InstructionList +parseAssembler = parseOnly instructionListParser + +instructionListParser :: Parser InstructionList +instructionListParser = skipManyComment *> skipHorizontalSpace *> many (instructionParser <* skipHorizontalSpace) -- <* endOfInput + +instructionParser :: Parser Instruction +instructionParser = + try zeroOperandInstructionParser + <|> numberOperandInstructionParser + <|> rParser + <|> dParser + <|> lParser + <|> uParser + <|> commentParser + +---- + +zeroOperandInstructionParser :: Parser Instruction +zeroOperandInstructionParser = + zeroOperandInstruction E ["E", "dividE"] + <|> zeroOperandInstruction T ["T", "Transfer"] + <|> zeroOperandInstruction A ["A", "Address"] + <|> zeroOperandInstruction O ["O", "Output"] + <|> zeroOperandInstruction I ["I", "Input"] + <|> zeroOperandInstruction S ["S", "Subtract"] + <|> zeroOperandInstruction H ["H", "Halibut"] + where zeroOperandInstruction i ts = (asciiCIChoices ts *> endWordParser) $> i + +numberOperandInstructionParser :: Parser Instruction +numberOperandInstructionParser = N <$> ( + naturalValueParser + <|> (asciiCI "N" *> skipHorizontalSpace *> naturalValueParser) + <|> (asciiCI "Number" *> endWordParser *> skipHorizontalSpace *> naturalValueParser) + ) + +rParser :: Parser Instruction +rParser = (skipMany1EndLine *> skipManyComment) $> R + +dParser :: Parser Instruction +dParser = D <$> (char '*' *> fileNameParser <* char '\n') + +lParser :: Parser Instruction +lParser = L <$> (char '>' *> identifierParser <* char ':') + +uParser :: Parser Instruction +uParser = U <$> stringParser + +commentParser :: Parser Instruction +commentParser = skipComment *> rParser + +skipManyComment :: Parser [()] +skipManyComment = many (skipComment <* skipMany1EndLine) + +skipComment :: Parser () +skipComment = char commentChar *> skipAllToEndOfLine + +skipMany1EndLine :: Parser String +skipMany1EndLine = many1 (char '\n') + +---- + +endWordParser :: Parser T.Text +endWordParser = takeTill isEndWord + +isEndWord :: Char -> Bool +isEndWord c = isSpace c || (c == commentChar) + +commentChar :: Char +commentChar = '#' + +---- + +naturalValueParser :: Parser NaturalValue +naturalValueParser = labelNaturalParser <|> naturalRightParser + +labelNaturalParser :: Parser NaturalValue +labelNaturalParser = Variable <$> (char '<' *> many1 letter) + +naturalRightParser :: Parser NaturalValue +naturalRightParser = Literal <$> naturalParser + +---- + diff --git a/src/main/eta/HelVM/HelPA/Assemblers/EAS/Assembler.hs b/src/main/eta/HelVM/HelPA/Assemblers/EAS/Assembler.hs new file mode 100644 index 00000000..0c081225 --- /dev/null +++ b/src/main/eta/HelVM/HelPA/Assemblers/EAS/Assembler.hs @@ -0,0 +1,19 @@ +module HelVM.HelPA.Assemblers.EAS.Assembler where + +import HelVM.HelPA.Assemblers.EAS.AsmParser +import HelVM.HelPA.Assemblers.EAS.CodeGenerator +import HelVM.HelPA.Assemblers.EAS.Linker +import HelVM.HelPA.Assemblers.EAS.Reducer + +import Control.Monad.Except + +import qualified Data.Text as T + +assemblyIO :: String -> String -> IO (Either String String) +assemblyIO dirName fileName = runExceptT $ assembly dirName fileName + +assembly :: String -> String -> ExceptT String IO String +assembly dirName fileName = generateCode . reduce <$> link dirName fileName + +singleAssembly :: T.Text -> Either String String +singleAssembly t = generateCode . reduce <$> parseAssembler t diff --git a/src/main/eta/HelVM/HelPA/Assemblers/EAS/CodeGenerator.hs b/src/main/eta/HelVM/HelPA/Assemblers/EAS/CodeGenerator.hs new file mode 100644 index 00000000..e7bcee40 --- /dev/null +++ b/src/main/eta/HelVM/HelPA/Assemblers/EAS/CodeGenerator.hs @@ -0,0 +1,29 @@ +module HelVM.HelPA.Assemblers.EAS.CodeGenerator where + +import HelVM.HelPA.Assemblers.EAS.Instruction + +import HelVM.HelPA.Common.Util +import HelVM.HelPA.Common.Value + +import Data.List +import Numeric.Natural + +generateCode :: InstructionList -> String +generateCode il = show . WhiteInstruction =<< il + +newtype WhiteInstruction = WhiteInstruction Instruction + +instance Show WhiteInstruction where + show (WhiteInstruction (N (Literal n))) = "N" ++ showValue n ++ "e" + show (WhiteInstruction (N (Variable i))) = error $ show i + show (WhiteInstruction (D i)) = error $ show i + show (WhiteInstruction (U i)) = error $ show i + show (WhiteInstruction (L _)) = "" + show (WhiteInstruction R) = "\n" + show (WhiteInstruction i) = show i + +showValue :: Natural -> String +showValue value = naturalToChar <$> naturalToDigits7 value + +naturalToChar :: Natural -> Char +naturalToChar index = ['h', 't', 'a', 'o', 'i', 'n', 's'] `genericIndex` index diff --git a/src/main/eta/HelVM/HelPA/Assemblers/EAS/Instruction.hs b/src/main/eta/HelVM/HelPA/Assemblers/EAS/Instruction.hs new file mode 100644 index 00000000..10d57100 --- /dev/null +++ b/src/main/eta/HelVM/HelPA/Assemblers/EAS/Instruction.hs @@ -0,0 +1,12 @@ +module HelVM.HelPA.Assemblers.EAS.Instruction where + +import HelVM.HelPA.Common.Value + +data Instruction = E | T | A | O | I | N NaturalValue | S | H | R | D Identifier | L Identifier | U String + deriving (Eq, Show, Ord) + +type InstructionList = [Instruction] + +isLabel :: Instruction -> Bool +isLabel (L _) = True +isLabel _ = False diff --git a/src/main/eta/HelVM/HelPA/Assemblers/EAS/Linker.hs b/src/main/eta/HelVM/HelPA/Assemblers/EAS/Linker.hs new file mode 100644 index 00000000..ddf8f297 --- /dev/null +++ b/src/main/eta/HelVM/HelPA/Assemblers/EAS/Linker.hs @@ -0,0 +1,24 @@ +module HelVM.HelPA.Assemblers.EAS.Linker where + +import HelVM.HelPA.Assemblers.EAS.AsmParser +import HelVM.HelPA.Assemblers.EAS.Instruction + +import Control.Monad.Except + +import qualified Data.Text.IO as T + +linkIO :: String -> String -> IO (Either String InstructionList) +linkIO dirName fileName = runExceptT $ link dirName fileName + +link :: String -> String -> ExceptT String IO InstructionList +link dirName fileName = includeFiles $ ExceptT $ parseAssembler <$> T.readFile (dirName ++ "/" ++ fileName) where + + includeFiles :: ExceptT String IO InstructionList -> ExceptT String IO InstructionList + includeFiles expect = loadFiles =<< expect + + loadFiles :: InstructionList -> ExceptT String IO InstructionList + loadFiles il = concat <$> mapM loadFile il + + loadFile :: Instruction -> ExceptT String IO InstructionList + loadFile (D libName) = link dirName libName + loadFile i = pure [i] diff --git a/src/main/eta/HelVM/HelPA/Assemblers/EAS/Reducer.hs b/src/main/eta/HelVM/HelPA/Assemblers/EAS/Reducer.hs new file mode 100644 index 00000000..58fc7088 --- /dev/null +++ b/src/main/eta/HelVM/HelPA/Assemblers/EAS/Reducer.hs @@ -0,0 +1,55 @@ +module HelVM.HelPA.Assemblers.EAS.Reducer where + +import HelVM.HelPA.Assemblers.EAS.Instruction + +import HelVM.HelPA.Common.OrError +import HelVM.HelPA.Common.Util +import HelVM.HelPA.Common.Value + +import Data.List.Split +import Data.Char + +import Numeric.Natural + +import qualified Data.Map.Strict as Map + +reduce :: InstructionList -> InstructionList +reduce il = replaceStrings $ replaceLabels addresses il where addresses = addressOfLabels il + +---- + +type LabelAddresses = Map.Map String Natural + +addressOfLabels :: InstructionList -> LabelAddresses +addressOfLabels il = Map.fromList $ toList =<< zip (labelsToStrings2 il) [1..] + +labelsToStrings2 :: InstructionList -> [[String]] +labelsToStrings2 il = labelsToStrings <$> splitOn [R] il + +labelsToStrings :: InstructionList -> [String] +labelsToStrings il = labelToStrings =<< il + +labelToStrings :: Instruction -> [String] +labelToStrings (L s) = [s] +labelToStrings _ = [] + +---- + +replaceLabels :: LabelAddresses -> InstructionList -> InstructionList +replaceLabels addresses il = replaceLabel addresses <$> il + +replaceLabel :: LabelAddresses -> Instruction -> Instruction +replaceLabel addresses (N (Variable l)) = N $ Literal $ findOrError l addresses +replaceLabel _ i = i + +---- + +replaceStrings :: InstructionList -> InstructionList +replaceStrings il = replaceString =<< il + +replaceString :: Instruction -> InstructionList +replaceString (U s) = charToInstruction <$> reverse s +replaceString i = [i] + +charToInstruction :: Char -> Instruction +charToInstruction c = N $ Literal $ fromIntegral $ ord c diff --git a/src/main/eta/HelVM/HelPA/Common/AsmParserUtil.hs b/src/main/eta/HelVM/HelPA/Common/AsmParserUtil.hs new file mode 100644 index 00000000..8660a494 --- /dev/null +++ b/src/main/eta/HelVM/HelPA/Common/AsmParserUtil.hs @@ -0,0 +1,67 @@ +module HelVM.HelPA.Common.AsmParserUtil where + +import HelVM.HelPA.Common.OrError +import HelVM.HelPA.Common.Value + +import Control.Applicative +import Data.Attoparsec.Combinator +import Data.Attoparsec.Text hiding (I, D) +import Data.Char +import Numeric.Natural + +import qualified Data.Text as T + +naturalParser :: Parser Natural +naturalParser = naturalLiteralParser <|> ordCharLiteralParser + +naturalLiteralParser :: Parser Natural +naturalLiteralParser = do + n <- many1 digit + return (readOrError n::Natural) + +ordCharLiteralParser :: Integral a => Parser a +ordCharLiteralParser = fromIntegral . ord <$> (char '\'' *> anyChar) + +stringParser :: Parser String +stringParser = char '"' *> many (notChar '"') <* char '"' + +skipHorizontalSpace :: Parser () +skipHorizontalSpace = skipWhile isHorizontalSpace + +skip1HorizontalSpace :: Parser () +skip1HorizontalSpace = satisfy isHorizontalSpace *> skipWhile isHorizontalSpace + +identifierParser :: Parser Identifier +identifierParser = do + c <- letter + s <- many alphaNum_ + return $ c:s + +fileNameParser :: Parser Identifier +fileNameParser = do + c <- letter + s <- many alphaNumDot_ + return $ c:s + +alphaNum_ :: Parser Char +alphaNum_ = satisfy isAlphaNum_ + +alphaNumDot_ :: Parser Char +alphaNumDot_ = satisfy isAlphaNumDot_ + +skipAllToEndOfLine :: Parser () +skipAllToEndOfLine = skipWhile isNotEndOfLine + +---- + +asciiCIChoices :: [T.Text] -> Parser T.Text +asciiCIChoices = choice . map asciiCI + +isNotEndOfLine :: Char -> Bool +isNotEndOfLine c = not $ isEndOfLine c + +isAlphaNum_ :: Char -> Bool +isAlphaNum_ c = isAlphaNum c || '_' == c + +isAlphaNumDot_ :: Char -> Bool +isAlphaNumDot_ c = isAlphaNum c || '_' == c || '.' == c diff --git a/src/main/eta/HelVM/HelPA/Common/OrError.hs b/src/main/eta/HelVM/HelPA/Common/OrError.hs new file mode 100644 index 00000000..e3f8f824 --- /dev/null +++ b/src/main/eta/HelVM/HelPA/Common/OrError.hs @@ -0,0 +1,16 @@ +module HelVM.HelPA.Common.OrError where + +import Text.Read + +import qualified Data.Map.Strict as Map + +readOrError :: (Read a) => String -> a +readOrError raw = check $ readEither raw where + check (Right result) = result + check (Left message) = error $ message ++ " [" ++ raw ++ "]" + +findOrError :: (Show k, Ord k, Show v) => k -> Map.Map k v -> v +findOrError key hash = check $ Map.lookup key hash where + check (Just result) = result + check Nothing = error $ "key [" ++ show key ++ "] map {" ++ show hash ++ "}" + \ No newline at end of file diff --git a/src/main/eta/HelVM/HelPA/Common/Util.hs b/src/main/eta/HelVM/HelPA/Common/Util.hs new file mode 100644 index 00000000..d6ff6d61 --- /dev/null +++ b/src/main/eta/HelVM/HelPA/Common/Util.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE TupleSections #-} +module HelVM.HelPA.Common.Util where + +import Numeric.Natural + +naturalToDigits7 :: Natural -> [Natural] +naturalToDigits7 = unfoldl lambda where + lambda :: Natural -> Maybe (Natural, Natural) + lambda 0 = Nothing + lambda n = Just (n `div` 7, n `mod` 7) + +---- + +unfoldl :: (a -> Maybe (a,b)) -> a -> [b] +unfoldl lambda value = check $ lambda value where + check Nothing = [] + check (Just (a,b)) = unfoldl lambda a ++ [b] + +toList :: ([k], v) -> [(k, v)] +toList (keys, value) = (, value) <$> keys diff --git a/src/main/eta/HelVM/HelPA/Common/Value.hs b/src/main/eta/HelVM/HelPA/Common/Value.hs new file mode 100644 index 00000000..5e5a6876 --- /dev/null +++ b/src/main/eta/HelVM/HelPA/Common/Value.hs @@ -0,0 +1,12 @@ +module HelVM.HelPA.Common.Value where + +import Numeric.Natural + +data Value a = Literal a | Variable Identifier + deriving (Eq, Show, Ord) + +type NaturalValue = Value Natural + +type StringValue = Value String + +type Identifier = String diff --git a/src/main/eta/HelVM/HelPA/HelPA.hs b/src/main/eta/HelVM/HelPA/HelPA.hs new file mode 100644 index 00000000..8c789788 --- /dev/null +++ b/src/main/eta/HelVM/HelPA/HelPA.hs @@ -0,0 +1,2 @@ +module HelVM.HelPA.HelPA where + diff --git a/src/main/eta/Main.hs b/src/main/eta/Main.hs index 863b08ff..346318fd 100644 --- a/src/main/eta/Main.hs +++ b/src/main/eta/Main.hs @@ -1,4 +1,37 @@ +{-# Language NamedFieldPuns #-} + module Main where +import HelVM.HelPA.Common.Util + +import qualified HelVM.HelPA.Assemblers.EAS.Assembler as EAS + +import AppOptions + +import Options.Applicative +import System.IO + main :: IO () -main = putStrLn "Hello, Eta!" +main = run =<< execParser opts where + opts = info (optionParser <**> helper) + ( fullDesc + <> header "HelPA: Heavenly Esoteric Little Para Assembler to Esoteric Languages implemented in Haskell/Eta" + <> progDesc "" ) + +run :: AppOptions -> IO () +run AppOptions{lang, dir, file} = do + eval (computeLang lang) dir file + +eval :: Lang -> String -> String -> IO () +eval EAS dir file = putExcept $ EAS.assemblyIO dir file +eval HAPAPL dir file = hapapl dir file + +putExcept :: IO (Either String String) -> IO () +putExcept io = putStrLn =<< (output <$> io) + +output :: Either String String -> String +output (Right result) = result +output (Left message) = error message + +hapapl :: String -> String -> IO () +hapapl _ _ = putStrLn "HAPAPL is not supported now" diff --git a/src/test/eta/HelVM/HelPA/Assemblers/EAS/AsmParserSpec.hs b/src/test/eta/HelVM/HelPA/Assemblers/EAS/AsmParserSpec.hs new file mode 100644 index 00000000..3cb20c5e --- /dev/null +++ b/src/test/eta/HelVM/HelPA/Assemblers/EAS/AsmParserSpec.hs @@ -0,0 +1,176 @@ +{-# LANGUAGE OverloadedStrings #-} +module HelVM.HelPA.Assemblers.EAS.AsmParserSpec (spec) where + +import HelVM.HelPA.Assemblers.EAS.AsmParser +import HelVM.HelPA.Assemblers.EAS.Instruction + +import HelVM.HelPA.Assemblers.EAS.TestData + +import HelVM.HelPA.Common.Value + + +import Data.List + +import qualified Data.Text as T +import qualified Data.Text.IO as T + +import Test.Hspec + +spec :: Spec +spec = do + describe "empty" $ do + it "parse ''" $ do parseAssembler "" `shouldBe` Right [] + + describe "Short Commands" $ do + + it "parse 'E'" $ do parseAssembler "E" `shouldBe` Right [E] + it "parse 'E '" $ do parseAssembler "E " `shouldBe` Right [E] + it "parse ' E'" $ do parseAssembler " E" `shouldBe` Right [E] + + it "parse 'T'" $ do parseAssembler "T" `shouldBe` Right [T] + it "parse 'T '" $ do parseAssembler "T " `shouldBe` Right [T] + it "parse ' T'" $ do parseAssembler " T" `shouldBe` Right [T] + + it "parse 'A'" $ do parseAssembler "A" `shouldBe` Right [A] + it "parse 'A '" $ do parseAssembler "A " `shouldBe` Right [A] + it "parse ' A'" $ do parseAssembler " A" `shouldBe` Right [A] + + it "parse 'O'" $ do parseAssembler "O" `shouldBe` Right [O] + it "parse 'O '" $ do parseAssembler "O " `shouldBe` Right [O] + it "parse ' O'" $ do parseAssembler " O" `shouldBe` Right [O] + + it "parse 'I'" $ do parseAssembler "I" `shouldBe` Right [I] + it "parse 'I '" $ do parseAssembler "I " `shouldBe` Right [I] + it "parse ' I'" $ do parseAssembler " I" `shouldBe` Right [I] + + it "parse 'S'" $ do parseAssembler "S" `shouldBe` Right [S] + it "parse 'S '" $ do parseAssembler "S " `shouldBe` Right [S] + it "parse ' S'" $ do parseAssembler " S" `shouldBe` Right [S] + + it "parse 'H'" $ do parseAssembler "H" `shouldBe` Right [H] + it "parse 'H '" $ do parseAssembler "H " `shouldBe` Right [H] + it "parse ' H'" $ do parseAssembler " H" `shouldBe` Right [H] + + describe "Short Commands - Numbers" $ do + + it "parse 'N0'" $ do parseAssembler "N0" `shouldBe` Right [N (Literal 0)] + it "parse 'N0 '" $ do parseAssembler "N0 " `shouldBe` Right [N (Literal 0)] + it "parse ' N0'" $ do parseAssembler " N0" `shouldBe` Right [N (Literal 0)] + + it "parse 'N00'" $ do parseAssembler "N00" `shouldBe` Right [N (Literal 0)] + it "parse 'N00 '" $ do parseAssembler "N00 " `shouldBe` Right [N (Literal 0)] + it "parse ' N00'" $ do parseAssembler " N00" `shouldBe` Right [N (Literal 0)] + + it "parse 'N1'" $ do parseAssembler "N1" `shouldBe` Right [N (Literal 1)] + it "parse 'N1 '" $ do parseAssembler "N1 " `shouldBe` Right [N (Literal 1)] + it "parse ' N1'" $ do parseAssembler " N1" `shouldBe` Right [N (Literal 1)] + + it "parse 'N01'" $ do parseAssembler "N01" `shouldBe` Right [N (Literal 1)] + it "parse 'N01 '" $ do parseAssembler "N01 " `shouldBe` Right [N (Literal 1)] + it "parse ' N01'" $ do parseAssembler " N01" `shouldBe` Right [N (Literal 1)] + + it "parse 'N10'" $ do parseAssembler "N10" `shouldBe` Right [N (Literal 10)] + it "parse 'N10 '" $ do parseAssembler "N10 " `shouldBe` Right [N (Literal 10)] + it "parse ' N10'" $ do parseAssembler " N10" `shouldBe` Right [N (Literal 10)] + + it "parse 'N' ''" $ do parseAssembler "N' '" `shouldBe` Right [N (Literal 32)] + it "parse 'N''''" $ do parseAssembler "N'\''" `shouldBe` Right [N (Literal 39)] + it "parse 'N'0''" $ do parseAssembler "N'0'" `shouldBe` Right [N (Literal 48)] + it "parse 'N'N''" $ do parseAssembler "N'N'" `shouldBe` Right [N (Literal 78)] + + it "parse 'N