packages feed

lazyboy 0.2.0.1 → 0.2.1.1

raw patch · 7 files changed

+397/−35 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

+ Lazyboy.Control: and :: Lazyboy Condition -> Lazyboy Condition -> Lazyboy Condition
+ Lazyboy.Control: class Comparable a b
+ Lazyboy.Control: equalTo :: Comparable a b => a -> b -> Lazyboy Condition
+ Lazyboy.Control: greaterThan :: Comparable a b => a -> b -> Lazyboy Condition
+ Lazyboy.Control: if' :: Lazyboy Condition -> Lazyboy a -> Lazyboy a
+ Lazyboy.Control: instance Lazyboy.Control.Comparable GHC.Word.Word8 Lazyboy.Types.Register8
+ Lazyboy.Control: instance Lazyboy.Control.Comparable Lazyboy.Types.Register8 GHC.Word.Word8
+ Lazyboy.Control: instance Lazyboy.Control.Comparable Lazyboy.Types.Register8 Lazyboy.Types.Register8
+ Lazyboy.Control: lessThan :: Comparable a b => a -> b -> Lazyboy Condition
+ Lazyboy.Control: not :: Lazyboy Condition -> Lazyboy Condition
+ Lazyboy.Control: notEqualTo :: Comparable a b => a -> b -> Lazyboy Condition
+ Lazyboy.Control: or :: Lazyboy Condition -> Lazyboy Condition -> Lazyboy Condition
+ Lazyboy.Target.ASM: AttemptedAFPCLoad :: LazyboyException
+ Lazyboy.Target.ASM: IllegalHLAddition :: LazyboyException
+ Lazyboy.Target.ASM: IllegalModification :: Register16 -> LazyboyException
+ Lazyboy.Target.ASM: IntegerBoundsViolation :: Word8 -> LazyboyException
+ Lazyboy.Target.ASM: InvalidALoad :: Register16 -> LazyboyException
+ Lazyboy.Target.ASM: InvalidRSTVector :: LazyboyException
+ Lazyboy.Target.ASM: InvalidStackOperation :: LazyboyException
+ Lazyboy.Target.ASM: Unimplemented :: LazyboyException
+ Lazyboy.Target.ASM: data LazyboyException
+ Lazyboy.Target.ASM: instance GHC.Exception.Type.Exception Lazyboy.Target.ASM.LazyboyException
+ Lazyboy.Target.ASM: instance GHC.Show.Show Lazyboy.Target.ASM.LazyboyException
+ Lazyboy.Types: instance GHC.Read.Read Lazyboy.Types.Condition
+ Lazyboy.Types: instance GHC.Show.Show Lazyboy.Types.Condition
- Lazyboy.Control: cond :: Condition -> Lazyboy () -> Lazyboy ()
+ Lazyboy.Control: cond :: Condition -> Lazyboy a -> Lazyboy a

Files

ChangeLog.md view
@@ -1,5 +1,12 @@ # Changelog for Lazyboy +# 0.2.1.1+- Added a lot of instruction tests and fix some bugs.++# 0.2.1.0+- Added compound conditionals, including boolean AND, OR support.+- Added tests for conditionals.+ # 0.2.0.0 - Started versioning. - Formatted as a library package.@@ -7,6 +14,9 @@ ## 0.2.0.1 - Removed some useless instances of Show and Read. - Refactored most of the documentation.++## 0.2.0.2+ - Changed ASM.hs to use custom exception types instead of just `error`.  # 0.1.0.0 - Initial version.
README.md view
@@ -1,6 +1,7 @@ ![LAZYBOY](meta/logo.png) [![Build Status](https://travis-ci.org/ix/lazyboy.svg?branch=master)](https://travis-ci.org/ix/lazyboy) [![Coverage Status](https://coveralls.io/repos/github/ix/lazyboy/badge.svg?branch=master)](https://coveralls.io/github/ix/lazyboy?branch=master)+[![Hackage](https://img.shields.io/hackage/v/lazyboy.svg?color=mediumpurple)](https://hackage.haskell.org/package/lazyboy) ---  An embedded domain-specific language + compiler written in Haskell for producing code to run on the Nintendo Game Boy.
lazyboy.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: adf7789c9ad4079eecaed83a9a636259d71db49774524381e2019d335985207e+-- hash: 4e2f866c2ce7b498a6ca6022a042bf2cacb83928127a1e6c802abd72499ef0d8  name:           lazyboy-version:        0.2.0.1+version:        0.2.1.1 synopsis:       An EDSL for programming the Game Boy. description:    An EDSL for programming the Nintendo Game Boy. <https://github.com/ix/lazyboy#readme> category:       DSL, Compiler
src/Lazyboy/Control.hs view
@@ -10,6 +10,8 @@     This module defines methods of controlling the flow of execution for Lazyboy. -} +{-# LANGUAGE MultiParamTypeClasses #-}+ module Lazyboy.Control where  import           Control.Monad.Trans.RWS@@ -19,7 +21,7 @@ -- | Get a label, and in the process increment the counter used to track labels. -- this provides a safe interface to label retrieval and utilization. getLabel :: Lazyboy Integer-getLabel = do +getLabel = do   label <- get   modify (+ 1)   return label@@ -42,7 +44,7 @@ -- | Execute an action within a local label and pass the action the label. withLocalLabel :: (Label -> Lazyboy ()) -> Lazyboy () withLocalLabel block = do-  label <- getLocalLabel +  label <- getLocalLabel   tell [LABEL label]   block label @@ -50,7 +52,7 @@ -- A jump over the block of data is added to prevent the image data being executed. embedFile :: FilePath -> Lazyboy Label embedFile file = do-    label <- getGlobalLabel +    label <- getGlobalLabel     skipLabel <- getGlobalLabel     tell [JP $ Name skipLabel]     tell [LABEL label, INCLUDE file]@@ -79,9 +81,89 @@   tell [JP $ Name label]  -- | Executes the given action provided condition flag is set.-cond :: Condition -> Lazyboy () -> Lazyboy ()+cond :: Condition -> Lazyboy a -> Lazyboy a cond condition block = do-  label <- getLocalLabel +  label <- getLocalLabel   tell [JPif condition (Name label)]-  block+  a <- block   tell [LABEL label]+  return a ++-- | A typeclass for comparisons between registers and values.+class Comparable a b where+  equalTo     :: a -> b -> Lazyboy Condition -- ^ Check the equality of two items.+  notEqualTo  :: a -> b -> Lazyboy Condition -- ^ Check the inequality of two items.+  greaterThan :: a -> b -> Lazyboy Condition -- ^ Check whether `a` is greater than `b`.+  lessThan    :: a -> b -> Lazyboy Condition -- ^ Check whether `a` is less than `b`.++-- | An instance for comparing two 8-bit registers.+instance Comparable Register8 Register8 where+  equalTo A r      = tell [CPr r]            >> return NonZero+  equalTo r r'     = tell [LDrr A r, CPr r'] >> return NonZero+  notEqualTo A r   = equalTo A r             >> return Zero+  notEqualTo r r'  = equalTo r r'            >> return Zero+  greaterThan A r  = equalTo A r             >> return NoCarry+  greaterThan r r' = equalTo r r'            >> return NoCarry+  lessThan A r     = equalTo A r             >> return Carry+  lessThan r r'    = equalTo r r'            >> return Carry++-- | An instance for comparing an 8-bit register and a Word8.+instance Comparable Register8 Word8 where+  equalTo A n      = tell [CPn n]            >>  return NonZero  +  equalTo r n      = tell [LDrr A r, CPn n]  >>  return NonZero  +  notEqualTo A n   = equalTo A n             >>  return Zero  +  notEqualTo r n   = equalTo r n             >>  return Zero  +  greaterThan A n  = equalTo A n             >>  return NoCarry  +  greaterThan r n  = equalTo r n             >>  return NoCarry  +  lessThan A n     = equalTo A n             >>  return Carry  +  lessThan r n     = equalTo r n             >>  return Carry ++-- | An instance for comparing a Word8 and an 8-bit register (this is an alias).+instance Comparable Word8 Register8 where+  equalTo = flip equalTo+  notEqualTo = flip notEqualTo+  greaterThan = flip greaterThan+  lessThan = flip lessThan++-- | Executes an action which returns a condition flag, then conditionally executes+-- another action baed on the state of that condition flag.+if' :: Lazyboy Condition -> Lazyboy a -> Lazyboy a+if' condition block = do+  flag <- condition +  cond flag block++-- | Boolean NOT operation for inverting Condition flags.+not :: Lazyboy Condition -> Lazyboy Condition+not action = do+  flag <- action+  return $ case flag of+    Zero    -> NonZero+    NonZero -> Zero+    Carry   -> NoCarry+    NoCarry -> Carry++-- | Assign boolean values to two registers based on the result flags of +-- some conditions and then AND them and return the result.+and :: Lazyboy Condition -> Lazyboy Condition -> Lazyboy Condition+and a b = do+  a' <- a+  cond a' $ do+    tell [LDrn L 1]+  b' <- b+  cond b' $ do+    tell [LDrn A 1]+  tell [ANDr L]+  return Zero++-- | Assign boolean values to two registers based on the result flags of+-- some conditions and then OR them and return the result.+or :: Lazyboy Condition -> Lazyboy Condition -> Lazyboy Condition+or a b = do+  a' <- a+  cond a' $ do+    tell [LDrn L 1]+  b' <- b+  cond b' $ do+    tell [LDrn A 1]+  tell [ORr L]+  return Zero
src/Lazyboy/Target/ASM.hs view
@@ -14,17 +14,45 @@ {-# LANGUAGE OverloadedStrings #-} module Lazyboy.Target.ASM where +import           Control.Exception import           Control.Monad.Trans.RWS.Lazy import           Data.Aeson import           Data.Char                    (toLower) import           Data.List                    (intercalate) import           Data.Text.Lazy               (Text) import qualified Data.Text.Lazy.IO            as T+import           Data.Word+import           Debug.Trace import           Lazyboy.Types import           Paths_lazyboy import           Text.Microstache import           Text.Printf +-- | Lazyboy exception type.+data LazyboyException =+    InvalidStackOperation+  | InvalidALoad Register16+  | AttemptedAFPCLoad+  | InvalidRSTVector+  | IllegalHLAddition+  | IllegalModification Register16+  | IntegerBoundsViolation Word8+  | Unimplemented++-- | An instance of Show for printing exception messages.+instance Show LazyboyException where+    show InvalidStackOperation  = printf "You cannot push or pop the program counter or stack pointer onto/from the stack."+    show (InvalidALoad r) =  printf "You cannot perform loads between the 16 bit register '%s' and A." r+    show AttemptedAFPCLoad = printf "You cannot load a 16 bit value directly into AF or the program counter."+    show InvalidRSTVector = "Invalid RST vector specified!"+    show IllegalHLAddition = "Cannot add the given the 16 bit register to HL."+    show (IllegalModification r) = printf "Cannot increment or decrement the given 16 bit register '%s'." r+    show (IntegerBoundsViolation v) = printf "Value '%d' given to an instruction expecting a 3-bit value." v+    show Unimplemented = "Use of an unimplemented instruction."++-- | An instance of Exception itself for LazyboyException.+instance Exception LazyboyException where+ -- | A custom Show instance which formats Instructions as assembly. instance Show Instruction where     show (LDrr r1 r2) = printf "ld %s, %s" r1 r2@@ -35,11 +63,11 @@     show (LDArr BC)   = printf "ld A, [BC]"     show (LDArr DE)   = printf "ld A, [DE]"     show (LDArr HL)   = printf "ld A, [HL]"-    show (LDArr r1)   = error "16 bit register '%s' cannot be loaded into A" r1+    show (LDArr r1)   = throw $ InvalidALoad r1     show (LDrrA BC)   = printf "ld [BC], A"     show (LDrrA DE)   = printf "ld [DE], A"     show (LDrrA HL)   = printf "ld [HL], A"-    show (LDrrA r1)   = error "A cannot be loaded into 16 bit register '%s'" r1+    show (LDrrA r1)   = throw $ InvalidALoad r1     show (LDAnn v1)   = printf "ld A, [%s]" v1     show (LDnnA v1)   = printf "ld [%s], A" v1     show (LDAIO v1)   = printf "ldh A, [$FF00+$%X]" v1@@ -50,19 +78,19 @@     show (LDAHLI)     = printf "ld A, [HL+]"      -- handle some special cases for ld rr,nn-    show (LDrrnn AF _) = error "You cannot load a 16 bit value directly into the register AF"-    show (LDrrnn PC _) = error "You cannot load a 16 bit value directly into the program counter"+    show (LDrrnn AF _) = throw AttemptedAFPCLoad+    show (LDrrnn PC _) = throw AttemptedAFPCLoad     show (LDrrnn r1 v1)  = printf "ld %s, %s" r1 v1 -    show (LDSPHL) = printf "%ld SP, HL"+    show (LDSPHL) = printf "ld SP, HL"      -- stack manipulation-    show (PUSH SP) = error "You cannot push the stack pointer onto the stack"-    show (PUSH PC) = error "You cannot push the program counter onto the stack"+    show (PUSH SP) = throw InvalidStackOperation+    show (PUSH PC) = throw InvalidStackOperation     show (PUSH r1) = printf "PUSH %s" r1 -    show (POP SP) = error "You cannot pop the stack pointer from the stack"-    show (POP PC) = error "You cannot pop the program counter from the stack"+    show (POP SP) = throw InvalidStackOperation+    show (POP PC) = throw InvalidStackOperation     show (POP r1) = printf "POP %s" r1      -- jumps@@ -75,8 +103,8 @@     show (JPif c v1@(Name (Local _))) = printf "jr %s, %s" c v1      -- call and return-    show (CALL v1) = printf "call $%X" v1-    show (CALLif c v1) = printf "call %s, $%X" c v1+    show (CALL v1) = printf "call %s" v1+    show (CALLif c v1) = printf "call %s, %s" c v1     show (RET) = printf "ret"     show (RETif c) = printf "ret %s" c     show (RETi) = printf "reti"@@ -89,7 +117,7 @@     show (RST 0x28) = printf "RST $28"     show (RST 0x30) = printf "RST $30"     show (RST 0x38) = printf "RST $38"-    show (RST _) = error "Invalid RST vector specified!"+    show (RST _) = throw InvalidRSTVector      -- arithmetic and comparisons     show (ADDAr r1) = printf "add A, %s" r1@@ -127,17 +155,17 @@     show (ADDHLrr DE) = printf "add HL, DE"     show (ADDHLrr HL) = printf "add HL, HL"     show (ADDHLrr SP) = printf "add HL, SP"-    show (ADDHLrr r1) = error "Cannot add the given the 16 bit register to HL"+    show (ADDHLrr r1) = throw IllegalHLAddition     show (INCrr BC) = printf "inc BC"     show (INCrr DE) = printf "inc DE"     show (INCrr HL) = printf "inc HL"     show (INCrr SP) = printf "inc SP"-    show (INCrr r1) = error "Cannot increment the given 16 bit register"+    show (INCrr r1) = throw $ IllegalModification r1     show (DECrr BC) = printf "dec BC"     show (DECrr DE) = printf "dec DE"     show (DECrr HL) = printf "dec HL"     show (DECrr SP) = printf "dec SP"-    show (DECrr r1) = error "Cannot decrement the given 16 bit register"+    show (DECrr r1) = throw $ IllegalModification r1      -- Rotate & shift     show (RLCA) = printf "rlca"@@ -173,29 +201,29 @@     -- Bit manipulation     show (BITnr v r1)         | v >= 0 && v <= 7 = printf "bit %d, %s" v r1-        | otherwise        = error "invalid value provided to an instruction expecting a 3-bit value"+        | otherwise        = throw $ IntegerBoundsViolation v     show (BITnHL v)         | v >= 0 && v <= 7 = printf "bit %d, HL" v-        | otherwise        = error "invalid value provided to an instruction expecting a 3-bit value"+        | otherwise        = throw $ IntegerBoundsViolation v     show (SETnr v r1)         | v >= 0 && v <= 7 = printf "set %d, %s" v r1-        | otherwise        = error "invalid value provided to an instruction expecting a 3-bit value"+        | otherwise        = throw $ IntegerBoundsViolation v     show (SETnHL v)         | v >= 0 && v <= 7 = printf "set %d, HL" v-        | otherwise        = error "invalid value provided to an instruction expecting a 3-bit value"+        | otherwise        = throw $ IntegerBoundsViolation v     show (RESnr v r1)         | v >= 0 && v <= 7 = printf "res %d, %s" v r1-        | otherwise        = error "invalid value provided to an instruction expecting a 3-bit value"+        | otherwise        = throw $ IntegerBoundsViolation v     show (RESnHL v)         | v >= 0 && v <= 7 = printf "res %d, HL" v-        | otherwise        = error "invalid value provided to an instruction expecting a 3-bit value"+        | otherwise        = throw $ IntegerBoundsViolation v      -- RGBASM specific stuff     show (LABEL l) = printf "%s:" l     show (INCLUDE file) = printf "INCBIN \"%s\"" file     show (BYTES bytes) = printf "db " ++ intercalate "," (map (printf "$%X") bytes) -    show _            = error "Use of unimplemented instruction"+    show _            = throw Unimplemented  -- | Instances of PrintfArg instance PrintfArg Register16 where@@ -215,11 +243,11 @@     formatArg (Global v) = formatString $ "L" ++ show v  instance PrintfArg Location where-    formatArg (Address v) = formatString $ (printf "$%X" v :: String)+    formatArg (Address v)  = formatString $ (printf "$%X" v :: String)     formatArg (Name label) = formatString $ (printf "%s" label :: String) --- | Compiles an action to an assembly source file. --- This function makes use of a "bare" template, which +-- | Compiles an action to an assembly source file.+-- This function makes use of a "bare" template, which -- sets up an appropriate start location for the body of the program -- and defines an entry point label 'main'. compileROM :: Lazyboy a -> IO Text
src/Lazyboy/Types.hs view
@@ -36,7 +36,7 @@  -- | A type representing Condition flags on the hardware. data Condition = Zero | NonZero | Carry | NoCarry-  deriving (Eq)+  deriving (Read, Show, Eq)  -- | Named 8-bit registers. data Register8 = A | B | C | D | E | H | L
test/Spec.hs view
@@ -11,6 +11,7 @@ -}  import           Control.Exception  (evaluate)+import           Data.Word import           Lazyboy import           Lazyboy.Target.ASM import           Test.Hspec@@ -34,6 +35,29 @@                 pack (BackgroundPalette White White White White) `shouldBe` 0             it "correctly packs other BackgroundPalettes" $ do                 pack (BackgroundPalette White Light White White) `shouldBe` 16+        describe "disableLCD" $ do +            it "turns off the lcd" $ do+                let program = map show $ execLazyboy disableLCD+                program `shouldBe` ["ld HL, $FF40", "ld [HL], 0"]+        describe "setLCDControl" $ do+            it "sets the lcd status" $ do+                let program = map show $ execLazyboy $ setLCDControl $ defaultLCDControl { lcdBackgroundEnable = True }+                program `shouldBe` ["ld HL, $FF40", "ld [HL], 1"]+        describe "byte" $ do+            it "writes a byte into a register" $ do+                let program = map show $ execLazyboy $ byte A 90+                program `shouldBe` ["ld A, 90"] +        describe "setBackgroundPalette" $ do+            it "sets the background palette" $ do+                let def = map show $ execLazyboy $ setBackgroundPalette defaultPalette+                let alt = map show $ execLazyboy $ setBackgroundPalette $ BackgroundPalette White Light Dark Black+                def `shouldBe` ["ld HL, $FF47", "ld [HL], 228"]+                alt `shouldBe` ["ld HL, $FF47", "ld [HL], 27"]+        describe "onVblank" $ do+            it "waits for vblank before calling some code" $ do+                let program = map show $ execLazyboy $ onVblank $ return ()+                program `shouldBe` [".L1:", "ld A, [$FF44]", "cp A, 145", "jr nz, .L1"]+                      describe "Lazyboy.Types.execLazyboy" $ do         it "compiles nested sequences in order" $ do@@ -61,7 +85,7 @@                                 , HALT                                 , JP $ Name $ Global 3                                 , LABEL $ Local 2-                                , LABEL $ Local 1 +                                , LABEL $ Local 1                                 ]         describe "withLabel" $ do             it "creates an appropriately formatted global label" $ do@@ -89,6 +113,84 @@             it "defines a raw sequence of bytes" $ do                 let program = execLazyboy $ embedBytes [0x00, 0x01, 0x02]                 program `shouldBe` [JP $ Name $ Global 2, LABEL $ Global 1, BYTES [0x00, 0x01, 0x02], LABEL $ Global 2]+        describe "not" $ do+            it "inverts a given condition flag" $ do+                let flags = map ((\f -> fst $ evalRWS f () 1) . Lazyboy.not . return) [Zero, NonZero, Carry, NoCarry]+                flags `shouldBe` [NonZero, Zero, NoCarry, Carry]+        describe "equalTo" $ do+            it "checks equality between two values" $ do+                let ab = map show $ execLazyboy $ A `equalTo` B+                let bc = map show $ execLazyboy $ B `equalTo` C+                let an = map show $ execLazyboy $ A `equalTo` (5 :: Word8)+                let nc = map show $ execLazyboy $ (100 :: Word8) `equalTo` C+                ab `shouldBe` ["cp A, B"]+                bc `shouldBe` ["ld A, B", "cp A, C"]+                an `shouldBe` ["cp A, 5"]+                nc `shouldBe` ["ld A, C", "cp A, 100"]+        describe "notEqualTo" $ do+            it "checks inequality between two values" $ do+                let ab = map show $ execLazyboy $ A `notEqualTo` B+                let bc = map show $ execLazyboy $ B `notEqualTo` C+                let an = map show $ execLazyboy $ A `notEqualTo` (5 :: Word8)+                let nc = map show $ execLazyboy $ (100 :: Word8) `notEqualTo` C+                ab `shouldBe` ["cp A, B"]+                bc `shouldBe` ["ld A, B", "cp A, C"]+                an `shouldBe` ["cp A, 5"]+                nc `shouldBe` ["ld A, C", "cp A, 100"]+        describe "greaterThan" $ do+            it "checks greater of two values" $ do+                let ab = map show $ execLazyboy $ A `greaterThan` B+                let bc = map show $ execLazyboy $ B `greaterThan` C+                let an = map show $ execLazyboy $ A `greaterThan` (5 :: Word8)+                let nc = map show $ execLazyboy $ (100 :: Word8) `greaterThan` C+                ab `shouldBe` ["cp A, B"]+                bc `shouldBe` ["ld A, B", "cp A, C"]+                an `shouldBe` ["cp A, 5"]+                nc `shouldBe` ["ld A, C", "cp A, 100"]+        describe "lessThan" $ do+            it "checks lesser of two values" $ do+                let ab = map show $ execLazyboy $ A `lessThan` B+                let bc = map show $ execLazyboy $ B `lessThan` C+                let an = map show $ execLazyboy $ A `lessThan` (5 :: Word8)+                let nc = map show $ execLazyboy $ (100 :: Word8) `lessThan` C+                ab `shouldBe` ["cp A, B"]+                bc `shouldBe` ["ld A, B", "cp A, C"]+                an `shouldBe` ["cp A, 5"]+                nc `shouldBe` ["ld A, C", "cp A, 100"]+        describe "if'" $ do+            it "provides conditional execution for more complex conditions" $ do+                let program = map show $ execLazyboy $ if' (A `lessThan` B) $ return ()+                program `shouldBe` ["cp A, B", "jr c, .L1", ".L1:"]+        describe "and" $ do+            it "implements boolean AND for conditionals" $ do+                let program = map show $ execLazyboy $ if' ((B `greaterThan` C) `Lazyboy.and` (A `equalTo` B)) $ return ()+                program `shouldBe` [ "ld A, B"+                                   , "cp A, C"+                                   , "jr nc, .L1"+                                   , "ld L, 1" +                                   , ".L1:"+                                   , "cp A, B" +                                   , "jr nz, .L2"+                                   , "ld A, 1"+                                   , ".L2:"+                                   , "and A, L"+                                   , "jr z, .L3"+                                   , ".L3:" ]+        describe "or" $ do+            it "implements boolean OR for conditionals" $ do+                let program = map show $ execLazyboy $ if' ((C `greaterThan` (5 :: Word8)) `Lazyboy.or` (A `equalTo` C)) $ return ()+                program `shouldBe` [ "ld A, C"+                                   , "cp A, 5"+                                   , "jr nc, .L1"+                                   , "ld L, 1" +                                   , ".L1:"+                                   , "cp A, C" +                                   , "jr nz, .L2"+                                   , "ld A, 1"+                                   , ".L2:"+                                   , "or A, L"+                                   , "jr z, .L3"+                                   , ".L3:" ]      describe "Lazyboy.Target.ASM" $ do         describe "show" $ do@@ -135,3 +237,142 @@             it "formats embedded byte sequences correctly" $ do                 let program = map show $ execLazyboy $ tell [BYTES [97, 98]]                 program `shouldBe` ["db $61,$62" ]+            it "formats all other instructions correctly" $ do+                show (LDrr A B) `shouldBe` "ld A, B"+                show (LDrn C 5) `shouldBe` "ld C, 5"+                show (LDrHL A) `shouldBe` "ld A, [HL]"+                show (LDHLr B) `shouldBe` "ld [HL], B"+                show (LDHLn 1) `shouldBe` "ld [HL], 1"+                show (LDArr BC) `shouldBe` "ld A, [BC]"+                show (LDArr DE) `shouldBe` "ld A, [DE]"+                show (LDArr HL) `shouldBe` "ld A, [HL]"+                show (LDrrA BC) `shouldBe` "ld [BC], A"+                show (LDrrA DE) `shouldBe` "ld [DE], A"+                show (LDrrA HL) `shouldBe` "ld [HL], A"+                show (LDAnn (Address 55)) `shouldBe` "ld A, [$37]" +                show (LDnnA (Address 55)) `shouldBe` "ld [$37], A"+                show (LDAIO 0) `shouldBe` "ldh A, [$FF00+$0]"+                show (LDIOA 1) `shouldBe` "ldh [$FF00+$1], A"+                show (LDAIOC) `shouldBe` "ldh A, [$FF00+C]"+                show (LDIOCA) `shouldBe` "ldh [$FF00+C], A"+                show (LDHLAI) `shouldBe` "ld [HL+], A"+                show (LDAHLI) `shouldBe` "ld A, [HL+]"+                show (LDrrnn BC (Address 7)) `shouldBe` "ld BC, $7"+                show (LDSPHL) `shouldBe` "ld SP, HL"+                show (PUSH BC) `shouldBe` "PUSH BC"+                show (POP HL) `shouldBe` "POP HL"+                show (JP (Address 43)) `shouldBe` "jp $2B"+                show (JP (Name (Global 1))) `shouldBe` "jp L1"+                show (JP (Name (Local 40))) `shouldBe` "jr .L40"+                show (JPHL) `shouldBe` "jp HL"+                show (JPif Zero (Address 100)) `shouldBe` "jp z, $64"+                show (JPif NoCarry (Name (Global 20))) `shouldBe` "jp nc, L20"+                show (JPif NonZero (Name (Local 4))) `shouldBe` "jr nz, .L4"+                show (CALL (Address 50)) `shouldBe` "call $32"+                show (CALLif Zero (Address 50)) `shouldBe` "call z, $32"+                show (RET) `shouldBe` "ret"+                show (RETif NonZero) `shouldBe` "ret nz"+                show (RETi) `shouldBe` "reti"+                show (ADDAr C) `shouldBe` "add A, C"+                show (ADDAn 25) `shouldBe` "add A, 25"+                show (ADDHL) `shouldBe` "add A, [HL]"+                show (ADCAr L) `shouldBe` "adc A, L"+                show (ADCAn 4) `shouldBe` "adc A, 4"+                show (ADCHL) `shouldBe` "adc A, [HL]"+                show (SUBAr A) `shouldBe` "sub A, A"+                show (SUBAn 9) `shouldBe` "sub A, 9"+                show (SUBHL) `shouldBe` "sub A, [HL]"+                show (SBCAr B) `shouldBe` "sbc A, B"+                show (SBCAn 3) `shouldBe` "sbc A, 3"+                show (SBCAHL) `shouldBe` "sbc A, [HL]"+                show (ANDr C) `shouldBe` "and A, C"+                show (ANDn 1) `shouldBe` "and A, 1"+                show (ANDHL) `shouldBe` "and A, [HL]"+                show (XORr A) `shouldBe` "xor A, A"+                show (XORn 1) `shouldBe` "xor A, 1"+                show (XORHL) `shouldBe` "xor A, [HL]"+                show (ORr C) `shouldBe` "or A, C"+                show (ORn 10) `shouldBe` "or A, 10"+                show (ORHL) `shouldBe` "or A, [HL]"+                show (CPr B) `shouldBe` "cp A, B"+                show (CPn 9) `shouldBe` "cp A, 9"+                show (CPHL) `shouldBe` "cp A, [HL]"+                show (INCr A) `shouldBe` "inc A" +                show (INCHL) `shouldBe` "inc [HL]"+                show (DECr C) `shouldBe` "dec C"+                show (DECHL) `shouldBe` "dec [HL]"+                show (DAA) `shouldBe` "daa"+                show (CPL) `shouldBe` "cpl"+                show (ADDHLrr BC) `shouldBe` "add HL, BC"+                show (ADDHLrr DE) `shouldBe` "add HL, DE"+                show (ADDHLrr HL) `shouldBe` "add HL, HL"+                show (ADDHLrr SP) `shouldBe` "add HL, SP"+                show (INCrr BC) `shouldBe` "inc BC"+                show (INCrr DE) `shouldBe` "inc DE"+                show (INCrr HL) `shouldBe` "inc HL"+                show (INCrr SP) `shouldBe` "inc SP"+                show (DECrr BC) `shouldBe` "dec BC"+                show (DECrr DE) `shouldBe` "dec DE"+                show (DECrr HL) `shouldBe` "dec HL"+                show (DECrr SP) `shouldBe` "dec SP"+                show (RLCA) `shouldBe` "rlca"+                show (RLA) `shouldBe` "rla"+                show (RRCA) `shouldBe` "rrca"+                show (RRA) `shouldBe` "rra"+                show (RLC A) `shouldBe` "rlc A"+                show (RLCHL) `shouldBe` "rlc [HL]"+                show (RL C) `shouldBe` "rl C"+                show (RLHL) `shouldBe` "rl [HL]"+                show (RRC A) `shouldBe` "rrc A"+                show (RRCHL) `shouldBe` "rrc [HL]"+                show (RR B) `shouldBe` "rr B"+                show (RRHL) `shouldBe` "rr [HL]"+                show (SLA B) `shouldBe` "sla B"+                show (SLAHL) `shouldBe` "sla [HL]"+                show (SWAP B) `shouldBe` "swap B"+                show (SWAPHL) `shouldBe` "swap [HL]"+                show (SRA B) `shouldBe` "sra B"+                show (SRAHL) `shouldBe` "sra [HL]"+                show (SRL B) `shouldBe` "srl B"+                show (SRLHL) `shouldBe` "srl [HL]"+                show (CCF) `shouldBe` "ccf"+                show (SCF) `shouldBe` "scf"+                show (NOP) `shouldBe` "nop"+                show (HALT) `shouldBe` "halt"+                show (STOP) `shouldBe` "stop"+                show (DI) `shouldBe` "di"+                show (EI) `shouldBe` "ei"++                -- these throw+                disallow $ show $ LDArr AF+                disallow $ show $ LDrrA AF+                disallow $ show $ LDrrnn AF $ Address 0+                disallow $ show $ LDrrnn PC $ Name $ Local 1+                disallow $ show $ PUSH SP+                disallow $ show $ PUSH PC+                disallow $ show $ POP SP+                disallow $ show $ POP PC+                disallow $ show $ ADDHLrr AF+                disallow $ show $ INCrr AF+                disallow $ show $ DECrr AF++    describe "Lazyboy.Constants" $ do+        it "has valid constants" $ do+            wram0 `shouldBe` 0xC000+            wram1 `shouldBe` 0xD000+            joypad `shouldBe` 0xFF00+            lcdc `shouldBe` 0xFF40+            lcdstate `shouldBe` 0xFF41+            scx `shouldBe` 0xFF42+            scy `shouldBe` 0xFF43+            ly `shouldBe` 0xFF44+            lyc `shouldBe` 0xFF45+            dma `shouldBe` 0xFF46+            bgp `shouldBe` 0xFF47+            vram `shouldBe` 0x8000+            background1 `shouldBe` 0x9800+            background2 `shouldBe` 0x9C00+            hram `shouldBe` 0xFF80+            oam `shouldBe` 0xFE00+            screenWidth `shouldBe` 160+            screenHeight `shouldBe` 144