-
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
9403517
commit 9dc649f
Showing
29 changed files
with
1,191 additions
and
51 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -27,3 +27,5 @@ cabal.project.local~ | |
|
|
||
| Gemfile.lock | ||
| _site | ||
|
|
||
| .hlint-*/ | ||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,96 @@ | ||
| {-# LANGUAGE OverloadedStrings #-} | ||
| module HelVM.HelPA.Assemblers.WSA.AsmParser (parseAssembler) where | ||
|
|
||
| import HelVM.HelPA.Assemblers.WSA.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.Maybe | ||
|
|
||
| import qualified Data.Text as T | ||
|
|
||
| parseAssembler :: T.Text -> Either String InstructionList | ||
| parseAssembler = parseOnly instructionListParser | ||
|
|
||
| instructionListParser :: Parser InstructionList | ||
| instructionListParser = catMaybes <$> many maybeInstructionParser | ||
|
|
||
| maybeInstructionParser :: Parser (Maybe Instruction) | ||
| maybeInstructionParser = | ||
| Just <$> (skipSpace *> instructionParser <* skipHorizontalSpace <* optional skipComment) | ||
| <|> (Nothing <$ (skipSpace *> skipComment)) | ||
|
|
||
| ---- | ||
|
|
||
| instructionParser :: Parser Instruction | ||
| instructionParser = | ||
| try pushSParser | ||
| <|> maybeOperandInstructionParser | ||
| <|> identifierOperandInstructionParser | ||
| <|> zeroOperandInstructionParser | ||
| <|> pushParser | ||
| <|> testParser | ||
|
|
||
| zeroOperandInstructionParser :: Parser Instruction | ||
| zeroOperandInstructionParser = | ||
| parser Pop "pop" | ||
| <|> parser Dup "doub" | ||
| <|> parser Swap "swap" | ||
| <|> parser Return "ret" | ||
| <|> parser End "exit" | ||
| <|> parser OutputNum "outn" | ||
| <|> parser OutputChar "outc" | ||
| <|> parser InputNum "inn" | ||
| <|> parser InputChar "inc" | ||
| where parser i t = i <$ (asciiCI t *> endWordParser) | ||
|
|
||
| maybeOperandInstructionParser :: Parser Instruction | ||
| maybeOperandInstructionParser = | ||
| parser Add "add" | ||
| <|> parser Sub "sub" | ||
| <|> parser Mul "mul" | ||
| <|> parser Div "div" | ||
| <|> parser Mod "mod" | ||
| <|> parser Store "store" | ||
| <|> parser Load "retrive" | ||
| where parser f t = f <$> (asciiCI t *> optional (Literal <$> (skip1HorizontalSpace *> integerParser))) | ||
|
|
||
| identifierOperandInstructionParser :: Parser Instruction | ||
| identifierOperandInstructionParser = | ||
| parser Mark "label" | ||
| <|> parser Call "call" | ||
| <|> parser Branch "jump" | ||
| <|> parser BranchZ "jumpZ" | ||
| <|> parser BranchN "jumpN" | ||
| <|> parser BranchP "jumpP" | ||
| <|> parser BranchNZ "jumpNZ" | ||
| <|> parser BranchPZ "jumpPZ" | ||
| <|> parser Include "include" | ||
| where parser f t = f <$> (asciiCI t *> skip1HorizontalSpace *> identifierParser) | ||
|
|
||
| testParser :: Parser Instruction | ||
| testParser = Test <$> (asciiCI "test" *> skipHorizontalSpace *> integerParser) | ||
|
|
||
| pushParser :: Parser Instruction | ||
| pushParser = Push . Literal <$> (asciiCI "push" *> skip1HorizontalSpace *> integerParser) | ||
|
|
||
| pushSParser :: Parser Instruction | ||
| pushSParser = PushS . Literal <$> (asciiCI "pushs" *> skipHorizontalSpace *> stringParser) | ||
|
|
||
| ---- | ||
|
|
||
| skipComment :: Parser () | ||
| skipComment = char commentChar *> skipAllToEndOfLine | ||
|
|
||
| endWordParser :: Parser T.Text | ||
| endWordParser = takeTill isEndWord | ||
|
|
||
| isEndWord :: Char -> Bool | ||
| isEndWord c = isSpace c || (commentChar == c) | ||
|
|
||
| commentChar :: Char | ||
| commentChar = ';' |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,19 @@ | ||
| module HelVM.HelPA.Assemblers.WSA.Assembler where | ||
|
|
||
| import HelVM.HelPA.Assemblers.WSA.AsmParser | ||
| import HelVM.HelPA.Assemblers.WSA.CodeGenerator | ||
| import HelVM.HelPA.Assemblers.WSA.Linker | ||
| import HelVM.HelPA.Assemblers.WSA.Reducer | ||
|
|
||
| import Control.Monad.Except | ||
|
|
||
| import qualified Data.Text as T | ||
|
|
||
| assemblyIO :: Bool -> String -> String -> IO (Either String String) | ||
| assemblyIO debug dirPath filePath = runExceptT $ assembly debug dirPath filePath | ||
|
|
||
| assembly :: Bool -> String -> String -> ExceptT String IO String | ||
| assembly debug dirPath filePath = generateCode debug . reduce <$> link dirPath filePath | ||
|
|
||
| singleAssembly :: Bool -> T.Text -> Either String String | ||
| singleAssembly debug code = generateCode debug . reduce <$> parseAssembler code |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,86 @@ | ||
| module HelVM.HelPA.Assemblers.WSA.CodeGenerator where | ||
|
|
||
| import HelVM.HelPA.Assemblers.WSA.Instruction | ||
| import HelVM.HelPA.Assemblers.WSA.Token | ||
|
|
||
| import HelVM.HelPA.Common.Util | ||
| import HelVM.HelPA.Common.Value | ||
|
|
||
| import Data.Char | ||
| import Numeric.Natural | ||
|
|
||
| generateCode :: Bool -> InstructionList -> String | ||
| generateCode debug il = showTL $ generateTL debug il | ||
|
|
||
| showTL :: TokenList -> String | ||
| showTL tl = show =<< tl | ||
|
|
||
| generateTL :: Bool -> InstructionList -> TokenList | ||
| generateTL debug il = generateTLForInstruction debug =<< il | ||
|
|
||
| generateTLForInstruction :: Bool -> Instruction -> TokenList | ||
| -- Stack instructions | ||
| generateTLForInstruction _ (Push (Literal value)) = [S,S] ++ integerToTL value | ||
| generateTLForInstruction _ Pop = [S,S,N] | ||
| generateTLForInstruction _ Dup = [S,N,S] | ||
| generateTLForInstruction _ Swap = [S,N,T] | ||
| --Arithmetic | ||
| generateTLForInstruction _ (Add Nothing) = [T,S,S,S] | ||
| generateTLForInstruction _ (Sub Nothing) = [T,S,S,T] | ||
| generateTLForInstruction _ (Mul Nothing) = [T,S,S,N] | ||
| generateTLForInstruction _ (Div Nothing) = [T,S,T,S] | ||
| generateTLForInstruction _ (Mod Nothing) = [T,S,T,T] | ||
| -- Heap access | ||
| generateTLForInstruction _ (Store Nothing) = [T,T,S] | ||
| generateTLForInstruction _ (Load Nothing) = [T,T,T] | ||
| -- Control | ||
| generateTLForInstruction _ (Mark label) = [N,S,S] ++ stringToTL label | ||
| generateTLForInstruction _ (Call label) = [N,S,T] ++ stringToTL label | ||
| generateTLForInstruction _ (Branch label) = [N,S,N] ++ stringToTL label | ||
| generateTLForInstruction _ (BranchZ label) = [N,T,S] ++ stringToTL label | ||
| generateTLForInstruction _ (BranchN label) = [N,T,T] ++ stringToTL label | ||
| generateTLForInstruction _ Return = [N,T,N] | ||
| generateTLForInstruction _ End = [N,N,N] | ||
| -- IO instructions | ||
| generateTLForInstruction _ OutputChar = [T,N,S,S] | ||
| generateTLForInstruction _ OutputNum = [T,N,S,T] | ||
| generateTLForInstruction _ InputChar = [T,N,T,S] | ||
| generateTLForInstruction _ InputNum = [T,N,T,T] | ||
| -- Other instructions | ||
| generateTLForInstruction _ Noop = [] | ||
| generateTLForInstruction True DebugPrintStack = [N,N,S,S,S] | ||
| generateTLForInstruction True DebugPrintHeap = [N,N,S,S,T] | ||
| generateTLForInstruction False DebugPrintStack = [] | ||
| generateTLForInstruction False DebugPrintHeap = [] | ||
| generateTLForInstruction _ i = error $ "Can not handle instruction " ++ show i | ||
|
|
||
| valueToTL :: Integer -> TokenList | ||
| valueToTL value = integerToTL value ++ [N] | ||
|
|
||
| integerToTL :: Integer -> TokenList | ||
| integerToTL value | ||
| | 0 <= value = S : naturalToTL (fromIntegral value) | ||
| | otherwise = T : naturalToTL (fromIntegral (- value)) | ||
|
|
||
| naturalToTL :: Natural -> TokenList | ||
| naturalToTL value = bitToToken <$> naturalToDigits2 value | ||
|
|
||
| stringToTL :: String -> TokenList | ||
| stringToTL value = (charToTL =<< value) ++ [N] | ||
|
|
||
| charToTL :: Char -> TokenList | ||
| charToTL value = bitToToken <$> toBits8 (ord value `mod` 256) | ||
|
|
||
| toBits8 :: Int -> [Natural] | ||
| toBits8 = toBitsBySize 8 | ||
|
|
||
| toBitsBySize :: Int -> Int -> [Natural] | ||
| toBitsBySize 0 _ = [] | ||
| toBitsBySize size 0 = [0 | _ <- [1..size]] | ||
| toBitsBySize size x | ||
| | k == 0 = 0 : toBitsBySize size' x | ||
| | otherwise = 1 : toBitsBySize size' (x - k*m) | ||
| where | ||
| size' = size - 1 | ||
| m = 2 ^ size' | ||
| k = x `div` m |
Oops, something went wrong.