intcode 0.2.0.0 → 0.3.0.0

raw patch · 7 files changed

+401/−220 lines, 7 filesdep +doctestdep ~basedep ~containersdep ~primitivePVP ok

version bump matches the API change (PVP)

Dependencies added: doctest

Dependency ranges changed: base, containers, primitive

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• doctests.hs +3/−0
• intcode.cabal +16/−2
• src/Intcode.hs +96/−218
• src/Intcode/Machine.hs +130/−0
• src/Intcode/Opcode.hs +109/−0
• src/Intcode/Parse.hs +42/−0

@@ -1,5 +1,10 @@ # Revision history for intcode +## 0.3.0.0+* Split machine-state and opcodes into separate modules.+* Add `Intcode.Parse`+* Add `Intcode.hRunIO`+ ## 0.2.0.0 * Rename 'intCodeToList' to 'intcodeToList' 

@@ -0,0 +1,3 @@+import Test.DocTest+main :: IO ()+main = doctest ["-isrc", "Intcode", "Intcode.Machine", "Intcode.Opcode", "Intcode.Parse"]

@@ -1,7 +1,7 @@ cabal-version:       2.4  name:                intcode-version:             0.2.0.0+version:             0.3.0.0 synopsis:            Advent of Code 2019 intcode interpreter category:            Compilers/Interpreters license:             ISC@@ -12,7 +12,7 @@ build-type:          Simple homepage:            https://github.com/glguy/intcode bug-reports:         https://github.com/glguy/intcode/issues-tested-with:         GHC ==8.6.5, GHC ==8.8.1+tested-with:         GHC ==8.6.5, GHC ==8.8.2  description:   Implementation of the Intcode virtual machine as defined by@@ -36,8 +36,22 @@    exposed-modules:     Intcode+    Intcode.Machine+    Intcode.Opcode+    Intcode.Parse    build-depends:     base         >= 4.12 && < 4.14,     containers   ^>= 0.6,     primitive    ^>= 0.7,++test-suite doctests+  type:              exitcode-stdio-1.0+  main-is:           doctests.hs+  default-language:  Haskell2010+  ghc-options:       -threaded+  build-depends:+    base,+    containers,+    primitive,+    doctest ^>= 0.16,

@@ -1,4 +1,4 @@-{-# Language DeriveTraversable, Trustworthy #-}+{-# Language Safe #-} {-| Module      : Intcode Description : Intcode interpreter@@ -6,56 +6,70 @@ License     : ISC Maintainer  : emertens@gmail.com -This Intcode interpreter is defined across multiple Advent of Code days:--* <https://adventofcode.com/2019/day/2>-* <https://adventofcode.com/2019/day/5>-* <https://adventofcode.com/2019/day/7>-* <https://adventofcode.com/2019/day/9>+Intcode is a virtual machine environment defined to have some arithmetic,+conditional jumps, and simple input and output facilities. -This implementation works with the following passes:+The instruction set is designed with independently selectable address modes for+each of its input and output parameters. The architecture is designed to be+simple to implement while powerful enough to write interesting programs+efficiently. The addition of a /relative base pointer/ makes it easy to+implement function calls in the language. -  1. Parse input text file into a list of numbers-  2. Execute op codes to single-step input/output effects.-  3. Execute single-stop effects into big-step effects.+This Intcode architecture is defined across multiple+<https://adventofcode.com/2019/about Advent of Code 2019> tasks:+<https://adventofcode.com/2019/day/2 2>,+<https://adventofcode.com/2019/day/5 5>,+<https://adventofcode.com/2019/day/7 7>, and+<https://adventofcode.com/2019/day/9 9>  Common use modes: -* List functions: 'intcodeToList'-* Individual machine step processing: 'Step', 'new', 'step'-* Input/output interpretation: 'Effect', 'new', 'run'+* Machine construction: 'new'+* List functions: 'intcodeToList', 'effectList'+* Individual machine step processing: 'Step', 'step'+* Input/output interpretation: 'Effect', 'run' +Submodules:++* "Intcode.Machine" exposes the implementation details of the interpreter state.+* "Intcode.Parse" provides a parser for intcode text files.+* "Intcode.Opcode" provides types and the decoder for opcodes.+ -} module Intcode   (-  -- * Simple interface+  -- * Simple list interface   intcodeToList,-  runIO,    -- * Machine state-  Machine(..), (!), new, set, memoryList,+  Machine, (!), new, set, memoryList, -  -- * Effects-  Effect(..), run, (>>>), effectList, followedBy, feedInput,+  -- * Big-step semantics+  Effect(..), run, -  -- * Small-step-  Step(..), step,+  -- * Effect operations+  (>>>), followedBy, feedInput, effectList, -  -- * Opcodes-  Mode(..), Opcode(..), decode,+  -- * Small-step semantics+  Step(..), step,    -- * Exceptions-  IntcodeFault(..)+  IntcodeFault(..),++  -- * ASCII I/O interface+  runIO, hRunIO,+   ) where -import           Control.Exception (Exception(..), throwIO, throw)-import           Data.Char         (chr, ord)-import           Data.IntMap       (IntMap)-import           Data.Traversable  (mapAccumL)-import qualified Data.IntMap as IntMap-import qualified Data.Primitive.PrimArray as P-import           Text.Show.Functions ()+import Control.Exception   (Exception(..), throw, throwIO)+import Data.Char           (chr, ord)+import Data.Traversable    (mapAccumL)+import System.IO           (Handle, hGetChar, hPutChar, hPutStrLn, stdin, stdout)+import Text.Show.Functions () +import Intcode.Machine     (Machine(..), (!), addRelBase, jmp, memoryList, new, set)+import Intcode.Opcode      (Mode(..), Opcode(..), decode)+ ------------------------------------------------------------------------ -- ASCII I/O ------------------------------------------------------------------------@@ -63,16 +77,32 @@ -- | Run intcode program using stdio. Non-ASCII outputs are printed as -- integers. --+-- Note that input and output is affected by handle buffering modes.+-- -- >>> runIO (run (new [104,72,104,101,104,108,104,108,104,111,104,33,104,10,99])) -- Hello!+--+-- >>> runIO (run (new [104,-50,104,1000,99]))+-- <<-50>>+-- <<1000>> runIO :: Effect -> IO ()-runIO (Output o e)-  | 0 <= o, o < 0x80  = putChar (chr (fromIntegral o))    >> runIO e-  | otherwise         = putStrLn ("<<" ++ show o ++ ">>") >> runIO e-runIO (Input f)       = runIO . f . fromIntegral . ord =<< getChar-runIO Halt            = return ()-runIO Fault           = throwIO IntcodeFault+runIO = hRunIO stdin stdout +-- | 'runIO' generalized to an arbitrary input and output handle.+hRunIO ::+  Handle {- ^ input handle  -} ->+  Handle {- ^ output handle -} ->+  Effect {- ^ effect        -} ->+  IO ()+hRunIO inH outH = go+  where+    go (Output o e)+      | 0 <= o, o < 0x80 = hPutChar outH (chr (fromIntegral o)) >> go e+      | otherwise        = hPutStrLn outH ("<<" ++ show o ++ ">>") >> go e+    go (Input f)         = go . f . fromIntegral . ord =<< hGetChar inH+    go Halt              = return ()+    go Fault             = throwIO IntcodeFault+ ------------------------------------------------------------------------ -- High-level interface ------------------------------------------------------------------------@@ -114,90 +144,13 @@   [Int]  {- ^ outputs        -} effectList effect inputs =   case effect of-    Input f | x:xs <- inputs -> effectList (f x) xs-            | otherwise      -> throw IntcodeFault-    Output o e               -> o : effectList e inputs-    Halt                     -> []-    Fault                    -> throw IntcodeFault----------------------------------------------------------------------------- Machine state----------------------------------------------------------------------------- | Machine state.-data Machine = Machine-  { pc      :: !Int          -- ^ program counter-  , relBase :: !Int          -- ^ relative base pointer-  , memory  :: !(IntMap Int) -- ^ memory updates-  , image   :: {-# Unpack #-} !(P.PrimArray Int) -- ^ initial memory-  }-  deriving (Eq, Ord, Show)---- | Value stored in initial memory image at given index.-indexImage ::-  Machine {- ^ machine  -} ->-  Int     {- ^ position -} ->-  Int     {- ^ value    -}-indexImage m i-  | a `seq` True, 0 <= i, i < P.sizeofPrimArray a = P.indexPrimArray a i-  | otherwise                                     = 0-  where-    a = image m-{-# INLINE indexImage #-}---- | Memory lookup from 0-based index.-(!) ::-  Machine {- ^ machine  -} ->-  Int     {- ^ position -} ->-  Int     {- ^ value    -}-m ! i = IntMap.findWithDefault (indexImage m i) i (memory m)---- | Construct machine from a list of initial values starting--- at address 0. Program counter and relative base start at 0.-new ::-  [Int]   {- ^ initial memory -} ->-  Machine {- ^ new machine    -}-new initialValues = Machine-  { pc      = 0-  , relBase = 0-  , memory  = IntMap.empty-  , image   = P.primArrayFromList initialValues-  }---- | Update the value stored at a given location in memory.-set ::-  Int {- ^ position  -} ->-  Int {- ^ new value -} ->-  Machine -> Machine-set i v m-  | v == o    = m { memory = IntMap.delete i   (memory m) }-  | otherwise = m { memory = IntMap.insert i v (memory m) }-  where-    o = indexImage m i---- | Update the relative base pointer by adding an offset to it.-adjustRelBase :: Int {- ^ offset -} -> Machine -> Machine-adjustRelBase i mach = mach { relBase = relBase mach + i }---- | Set program counter to a new address.-jmp ::-  Int {- ^ program counter -} ->-  Machine -> Machine-jmp i mach = mach { pc = i }---- | Generate a list representation of memory starting from--- zero. This can get big for sparsely filled memory using--- large addresses. Returned values start at position 0.------ >>> memoryList (set 8 10 (new [1,2,3]))--- [1,2,3,0,0,0,0,0,10]-memoryList :: Machine -> [Int]-memoryList mach-  | IntMap.null (memory mach) = P.primArrayToList (image mach)-  | otherwise                 = [mach ! i | i <- [0 .. top]]-  where-    top = max (P.sizeofPrimArray (image mach) - 1)-              (fst (IntMap.findMax (memory mach)))+    Fault      -> throw IntcodeFault+    Halt       -> []+    Output o e -> o : effectList e inputs+    Input f    ->+      case inputs of+        x:xs -> effectList (f x) xs+        []   -> throw IntcodeFault  ------------------------------------------------------------------------ -- Big-step semantics@@ -238,13 +191,15 @@ -- >>> effectList (mult 3 >>> add 1) [4] -- [13] (>>>) :: Effect -> Effect -> Effect-x          >>> Output o y = Output o (x >>> y)-_          >>> Halt       = Halt-_          >>> Fault      = Fault-Output o x >>> Input f    = x >>> f o-Halt       >>> Input _    = Fault-Fault      >>> Input _    = Fault-Input f    >>> y          = Input (\i -> f i >>> y)+_ >>> Fault      = Fault+_ >>> Halt       = Halt+x >>> Output o e = Output o (x >>> e)+x >>> Input g    = input x+  where+    input Fault        = Fault+    input Halt         = Fault+    input (Output o e) = e >>> g o+    input (Input f)    = Input (input . f)  infixl 9 >>> @@ -252,24 +207,32 @@ -- -- >>> Output 1 Halt `followedBy` Output 2 Halt -- Output 1 (Output 2 Halt)+--+-- >>> Output 1 Halt `followedBy` Fault+-- Output 1 Fault+--+-- >>> Fault `followedBy` undefined+-- Fault followedBy :: Effect -> Effect -> Effect followedBy Halt         y = y followedBy Fault        _ = Fault followedBy (Output o x) y = Output o (followedBy x y)-followedBy (Input  f  ) y = Input (\i -> followedBy (f i) y)+followedBy (Input f)    y = Input (\i -> followedBy (f i) y)  -- | Provide an input to the first occurrence of an input request -- in a program effect. It is considered a fault if a program -- terminates before using the input. ----- >>> let mult n = Input (\i -> Output (i*n) Halt)--- >>> feedInput [6] (mult 5)+-- >>> feedInput [5,6] (Input (\x -> Input (\y -> Output (x*y) Halt))) -- Output 30 Halt+--+-- >>> feedInput [7] Halt+-- Fault feedInput :: [Int] {- ^ inputs -} -> Effect -> Effect feedInput []     e            = e feedInput xs     (Output o e) = Output o (feedInput xs e) feedInput (x:xs) (Input f)    = feedInput xs (f x)-feedInput _ _                 = Fault+feedInput _      _            = Fault  ------------------------------------------------------------------------ -- Small-step semantics@@ -315,7 +278,7 @@     Jz  a b   -> Step    (if at a == 0 then jmp (at b) m else m)     Lt  a b c -> Step    (set c (if at a <  at b then 1 else 0) m)     Eq  a b c -> Step    (set c (if at a == at b then 1 else 0) m)-    Arb a     -> Step    (adjustRelBase (at a) m)+    Arb a     -> Step    (addRelBase (at a) m)     Hlt       -> StepHalt   where     at i = m ! i@@ -323,91 +286,6 @@ mapWithIndex :: (Int -> a -> b) -> Int -> Opcode a -> (Int, Opcode b) mapWithIndex f = mapAccumL (\i a -> (i+1, f i a)) {-# INLINE mapWithIndex #-}----------------------------------------------------------------------------- Opcode decoder----------------------------------------------------------------------------- | Parameter modes-data Mode-  = Abs -- ^ absolute position-  | Imm -- ^ immediate-  | Rel -- ^ relative position-  deriving (Eq, Ord, Read, Show)---- | Opcodes parameterized over argument representations.-data Opcode a-  = Add !a !a !a -- ^ addition:        @c = a + b@-  | Mul !a !a !a -- ^ multiplication:  @c = a * b@-  | Inp !a       -- ^ input:           @a = input()@-  | Out !a       -- ^ output:          @output(a)@-  | Jnz !a !a    -- ^ jump-if-true:    @if a then goto b@-  | Jz  !a !a    -- ^ jump-if-false:   @if !a then goto b@-  | Lt  !a !a !a -- ^ less-than:       @c = a < b@-  | Eq  !a !a !a -- ^ equals:          @c = a == b@-  | Arb !a       -- ^ adjust-rel-base: @rel += a@-  | Hlt          -- ^ halt-  deriving (Eq, Ord, Read, Show, Functor, Foldable)---- | Decode an instruction to determine the opcode and parameter modes.------ >>> decode 1002--- Just (Mul Abs Imm Abs)-decode :: Int {- ^ opcode -} -> Maybe (Opcode Mode)-decode n =-  case n `rem` 100 of-    1  -> fill (Add 1 2 3)-    2  -> fill (Mul 1 2 3)-    3  -> fill (Inp 1)-    4  -> fill (Out 1)-    5  -> fill (Jnz 1 2)-    6  -> fill (Jz  1 2)-    7  -> fill (Lt  1 2 3)-    8  -> fill (Eq  1 2 3)-    9  -> fill (Arb 1)-    99 -> fill Hlt-    _  -> Nothing-  where-    fill = traverse (parameter n)---- | Compute the parameter mode for an argument at a given position.-parameter ::-  Int {- ^ opcode   -} ->-  Int {- ^ position -} ->-  Maybe Mode-parameter n i =-  case digit (i+1) n of-    0 -> Just Abs-    1 -> Just Imm-    2 -> Just Rel-    _ -> Nothing---- | Arguments visited from left to right.-instance Traversable Opcode where-  {-# INLINE traverse #-}-  traverse f o =-    case o of-      Add x y z -> Add <$> f x <*> f y <*> f z-      Mul x y z -> Mul <$> f x <*> f y <*> f z-      Inp x     -> Inp <$> f x-      Out x     -> Out <$> f x-      Jnz x y   -> Jnz <$> f x <*> f y-      Jz  x y   -> Jz  <$> f x <*> f y-      Lt  x y z -> Lt  <$> f x <*> f y <*> f z-      Eq  x y z -> Eq  <$> f x <*> f y <*> f z-      Arb x     -> Arb <$> f x-      Hlt       -> pure Hlt---- | Extract the ith digit from a number.------ >>> digit 0 2468--- 8--- >>> digit 3 2468--- 2--- >>> digit 4 2468--- 0-digit :: Int {- ^ position -} -> Int {- ^ number -} -> Int {- ^ digit -}-digit i x = x `quot` (10^i) `rem` 10  ------------------------------------------------------------------------ -- Exceptions

@@ -0,0 +1,130 @@+{-# Language Trustworthy #-}+{-|+Module      : Intcode.Machine+Description : Intcode machine representation+Copyright   : (c) Eric Mertens, 2019+License     : ISC+Maintainer  : emertens@gmail.com++The module implements the representation of the intcode machine state.++The 'Machine' type stores the initial memory image in an array and+only stores changes to that initial image. This allows for more efficient+comparisons of machine states for equality when there are few changes to+memory.++This implementation of the machine supports negative memory addresses.+These are defined not to be used in the Advent of Code problems.++This implementation stores machine-sized 'Int' values in memory.++-}+module Intcode.Machine+  (+  -- * Machine state+  Machine(..), new,++  -- * Register operations+  jmp, addRelBase,++  -- * Memory operations+  (!), set, memoryList,+  )+ where++import           Data.IntMap (IntMap)+import qualified Data.IntMap as IntMap+import qualified Data.Primitive.PrimArray as P++-- | Machine state is comprised of the program counter, relative base+-- pointer, and memory.+--+-- * Interact with registers using: 'jmp', 'addRelBase'+-- * Interact with memory using: ('!'), 'set'+-- * Build new machines with: 'new'+--+-- Updates to memory are stored separately from the initial values+-- which can enable equality comparisons to be relatively efficient.+-- This efficiency comes from being able to compare the inital memory+-- using only pointer equality when two machines are created by the+-- same call to 'new'.+data Machine = Machine+  { pc         :: !Int          -- ^ program counter+  , relBase    :: !Int          -- ^ relative base pointer+  , memUpdates :: !(IntMap Int) -- ^ memory updates+  , memInitial :: {-# Unpack #-} !(P.PrimArray Int) -- ^ initial memory+  }+  deriving (Eq, Ord, Show)++-- | Value stored in initial memory image at given index.+indexImage ::+  Machine {- ^ machine  -} ->+  Int     {- ^ position -} ->+  Int     {- ^ value    -}+indexImage m i+  | i < P.sizeofPrimArray a, 0 <= i = P.indexPrimArray a i+  | otherwise                       = 0+  where+    a = memInitial m+{-# INLINE indexImage #-}++-- | Memory lookup.+(!) ::+  Machine {- ^ machine  -} ->+  Int     {- ^ position -} ->+  Int     {- ^ value    -}+m ! i = IntMap.findWithDefault (indexImage m i) i (memUpdates m)+{-# INLINE (!) #-}++-- | Construct machine from a list of initial values starting+-- at address 0. Program counter and relative base start at 0.+new ::+  [Int] {- ^ initial memory -} ->+  Machine+new initialValues = Machine+  { pc         = 0+  , relBase    = 0+  , memUpdates = IntMap.empty+  , memInitial = P.primArrayFromList initialValues+  }++-- | Store value at given memory position.+set ::+  Int {- ^ position -} ->+  Int {- ^ value    -} ->+  Machine -> Machine+set i v m+  | v == o    = m { memUpdates = IntMap.delete i   (memUpdates m) }+  | otherwise = m { memUpdates = IntMap.insert i v (memUpdates m) }+  where+    o = indexImage m i++-- | Add offset to relative base pointer.+addRelBase ::+  Int {- ^ offset -} ->+  Machine -> Machine+addRelBase i mach = mach { relBase = relBase mach + i }+{-# INLINE addRelBase #-}++-- | Set program counter to a new address.+jmp ::+  Int {- ^ program counter -} ->+  Machine -> Machine+jmp i mach = mach { pc = i }+{-# INLINE jmp #-}++-- | Generate a list representation of memory starting from+-- zero. This can get big for sparsely filled memory using+-- large addresses. Returned values start at position 0.+--+-- >>> memoryList (set 8 10 (new [1,2,3]))+-- [1,2,3,0,0,0,0,0,10]+memoryList ::+  Machine ->+  [Int] {- ^ memory values -}+memoryList mach+  | IntMap.null (memUpdates mach) = P.primArrayToList (memInitial mach)+  | otherwise                  = [mach ! i | i <- [0 .. top]]+  where+    top = max (P.sizeofPrimArray (memInitial mach) - 1)+              (fst (IntMap.findMax (memUpdates mach)))

@@ -0,0 +1,109 @@+{-# Language DeriveTraversable, Safe #-}+{-|+Module      : Intcode.Opcode+Description : Intcode opcodes+Copyright   : (c) Eric Mertens, 2019+License     : ISC+Maintainer  : emertens@gmail.com++This module provides a representation of the intcode machine's opcodes.++Opcodes are parameterized over their parameters. This allows the+implementation to store both parameter modes and resolved parameter+pointers in the same constructors.++-}+module Intcode.Opcode+  (+  -- * Types+  Opcode(..), Mode(..),++  -- * Decoder+  decode,+  ) where++------------------------------------------------------------------------+-- Opcode decoder+------------------------------------------------------------------------++-- | Parameter modes+data Mode+  = Abs -- ^ absolute position+  | Imm -- ^ immediate+  | Rel -- ^ relative position+  deriving (Eq, Ord, Read, Show)++-- | Opcodes parameterized over argument representations.+data Opcode a+  = Add !a !a !a -- ^ __addition:__        @c = a + b@+  | Mul !a !a !a -- ^ __multiplication:__  @c = a * b@+  | Inp !a       -- ^ __input:__           @a = input()@+  | Out !a       -- ^ __output:__          @output(a)@+  | Jnz !a !a    -- ^ __jump-if-true:__    @if a then goto b@+  | Jz  !a !a    -- ^ __jump-if-false:__   @if !a then goto b@+  | Lt  !a !a !a -- ^ __less-than:__       @c = a < b@+  | Eq  !a !a !a -- ^ __equals:__          @c = a == b@+  | Arb !a       -- ^ __adjust-rel-base:__ @rel += a@+  | Hlt          -- ^ __halt__+  deriving (Eq, Ord, Read, Show, Functor, Foldable)++-- | Decode an instruction to determine the opcode and parameter modes.+--+-- >>> decode 1002+-- Just (Mul Abs Imm Abs)+decode :: Int {- ^ opcode -} -> Maybe (Opcode Mode)+decode n =+  case n `rem` 100 of+    1  -> fill (Add 1 2 3)+    2  -> fill (Mul 1 2 3)+    3  -> fill (Inp 1    )+    4  -> fill (Out 1    )+    5  -> fill (Jnz 1 2  )+    6  -> fill (Jz  1 2  )+    7  -> fill (Lt  1 2 3)+    8  -> fill (Eq  1 2 3)+    9  -> fill (Arb 1    )+    99 -> fill Hlt+    _  -> Nothing+  where+    fill = traverse (parameter n)+{-# INLINABLE decode #-}++-- | Compute the parameter mode for an argument at a given position.+parameter ::+  Int {- ^ opcode   -} ->+  Int {- ^ position -} ->+  Maybe Mode+parameter n i =+  case digit (i+1) n of+    0 -> Just Abs+    1 -> Just Imm+    2 -> Just Rel+    _ -> Nothing++-- | Arguments visited from left to right.+instance Traversable Opcode where+  {-# INLINE traverse #-}+  traverse f o =+    case o of+      Add x y z -> Add <$> f x <*> f y <*> f z+      Mul x y z -> Mul <$> f x <*> f y <*> f z+      Inp x     -> Inp <$> f x+      Out x     -> Out <$> f x+      Jnz x y   -> Jnz <$> f x <*> f y+      Jz  x y   -> Jz  <$> f x <*> f y+      Lt  x y z -> Lt  <$> f x <*> f y <*> f z+      Eq  x y z -> Eq  <$> f x <*> f y <*> f z+      Arb x     -> Arb <$> f x+      Hlt       -> pure Hlt++-- | Extract the ith digit from a number.+--+-- >>> digit 0 2468+-- 8+-- >>> digit 3 2468+-- 2+-- >>> digit 4 2468+-- 0+digit :: Int {- ^ position -} -> Int {- ^ number -} -> Int {- ^ digit -}+digit i x = x `quot` (10^i) `rem` 10

@@ -0,0 +1,42 @@+{-# Language Safe #-}+{-|+Module      : Intcode.Parse+Description : Intcode source file parser+Copyright   : (c) Eric Mertens, 2019+License     : ISC+Maintainer  : emertens@gmail.com++This module implements a parser for the simple comma, separated format+used in the Advent of Code input files.++-}+module Intcode.Parse (parseInts) where++-- | Parse a list of comma separated integers.+--+-- >>> parseInts "1, - 2, 3,-4"+-- Just [1,-2,3,-4]+--+-- >>> parseInts " "+-- Just []+--+-- >>> parseInts "1,2,3,x"+-- Nothing+parseInts ::+  String      {- ^ parser input    -} ->+  Maybe [Int] {- ^ parsed integers -}+parseInts str+  | [(i,str1)] <- reads str = parseInts' [i] str1+  | [("","")]  <- lex str   = Just []+  | otherwise               = Nothing++-- | Helper function for 'parseInts'+parseInts' ::+  [Int]       {- ^ reversed accumulator -} ->+  String      {- ^ parser input         -} ->+  Maybe [Int] {- ^ parsed integers      -}+parseInts' xs str =+  case lex str of+    [(",",str1)] | [(x,str2)] <- reads str1 -> parseInts' (x:xs) str2+    [("","")]                               -> Just (reverse xs)+    _                                       -> Nothing