Permalink
Browse files

further improvements to the parser

  • Loading branch information...
1 parent fc2ec94 commit b515216c350f718e3892c351bce9c89ff60bdbc2 Patrick Thomson committed Apr 11, 2012
Showing with 41 additions and 21 deletions.
  1. +2 −1 hs-dcpu.cabal
  2. +14 −1 src/Core.hs
  3. +24 −18 src/Parser.hs
  4. +1 −1 src/Pretty.hs
View
@@ -17,13 +17,14 @@ Executable hdasm
Ghc-options: -fwarn-tabs -Wall
Hs-source-dirs: src
Main-is: dcpu.hs
+ Default-extensions: OverloadedStrings, TypeSynonymInstances, FlexibleInstances
Build-depends: array >= 0.3,
attoparsec >= 0.10.1.0,
base >= 4.2,
+ bytestring >= 0.9.2,
mtl >= 2,
pretty == 1.0.1.2,
parsec >= 3
- Extensions: OverloadedStrings
Default-language: Haskell2010
Test-suite test-dcpu:
View
@@ -36,4 +36,17 @@ where
| PC
| SP
| OF
- deriving (Show, Eq, Ord, Enum, Ix)
+ deriving (Eq, Ord, Enum, Ix)
+
+ instance Show Register where
+ show RA = "A"
+ show RB = "B"
+ show RC = "C"
+ show RX = "X"
+ show RY = "Y"
+ show RZ = "Z"
+ show RI = "I"
+ show RJ = "J"
+ show PC = "PC"
+ show SP = "SP"
+ show OF = "O"
View
@@ -4,19 +4,26 @@ module Parser
where
import Core
+ import Data.Attoparsec.ByteString (parseTest)
import Data.Attoparsec.ByteString.Char8
- import Data.Attoparsec.Types hiding (Parser)
-
+ import Data.ByteString.Char8 (ByteString, pack)
+ import qualified Data.ByteString.Char8 as B
data Instruction =
Instruction Opcode Operand Operand
deriving (Show, Eq)
+ instruction :: Parser Instruction
+ instruction = Instruction <$> opcode <*> operand <*> operand
+
data Opcode
= SET | ADD | SUB | MUL | DIV | MOD
| AND | BOR | XOR | IFE | IFN | IFG | IFB
deriving (Show, Eq, Ord, Enum)
+ opcode :: Parser Opcode
+ opcode = valueParser [ SET .. IFB ]
+
-- Since all the leaves of this ADT are different, maybe this would be a
-- good place to try coproducts?
data Operand
@@ -26,28 +33,23 @@ module Parser
| AsmLabel String
deriving (Show, Eq)
- label, register, reference, literal, operand :: Parser Operand
- label = AsmLabel <$> identifier
- register = AsmRegister <$> choice [ stringCI token *> pure reg | (token, reg) <- zip tokens regs]
- where
- tokens = [ "A", "B", "C", "X", "Y", "Z", "I", "J", "O", "PC", "SP"]
- regs = [ RA, RB, RC, RX, RY, RZ, RI, RJ, OF, PC, SP]
+ register :: Parser Operand
+ register = AsmRegister <$> valueParser [ RA .. OF ]
+ literal :: Parser Operand
+ literal = AsmLiteral <$> ((string "0x" *> hexadecimal) <|> decimal)
+
+ reference :: Parser Operand
reference = AsmReference <$> (char '[' *> skipSpace *> operand <* skipSpace <* char ']')
- literal = AsmLiteral <$> (string "0x" *> hexadecimal)
- operand = skipSpace *> choice [ reference, register, label, literal ]
- instruction :: Parser Instruction
- instruction = Instruction <$> opcode <*> operand <*> operand
+ label, reference, literal, operand :: Parser Operand
+ label = AsmLabel <$> identifier
+
+ operand = skipSpace *> choice [ reference, register, label, literal ]
assemble :: FilePath -> Either String RAM
assemble = undefined
- opcode :: Parser Opcode
- opcode = choice
- [ s "set" *> pure SET
- , s "add" *> pure ADD ] where s = stringCI
-
identifier = undefined
brackets = undefined
@@ -59,4 +61,8 @@ module Parser
line :: Parser Instruction
line = skipSpace *> instruction <* skipComments <* (endOfLine <|> endOfInput)
-
+
+ valueParser cs = choice $ do
+ let tokens = pack <$> show <$> cs
+ (value, token) <- zip cs tokens
+ return $! stringCI token *> pure value
View
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeSynonymInstances #-} -- get rid of this
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} -- get rid of this
module Pretty where

0 comments on commit b515216

Please sign in to comment.