build: cleanup Makefile

[haskell/symantic-parser.git] / src / Symantic / Parser / Machine / Program.hs

diff --git a/src/Symantic/Parser/Machine/Program.hs b/src/Symantic/Parser/Machine/Program.hs
index 7ca32e7aa1081932173a34ebbeac2c560eaabc57..5e3ca80a518bf2166daa83007306891d03fac762 100644 (file)
--- a/src/Symantic/Parser/Machine/Program.hs
+++ b/src/Symantic/Parser/Machine/Program.hs
@@ -9,22 +9,23 @@
 -- those generated (see for instance 'joinNext').
 module Symantic.Parser.Machine.Program where
 
-import Control.Monad (Monad(..), (<=<), (=<<), liftM, liftM2, sequence)
-import Data.Function (($))
-import System.IO (IO)
-import Type.Reflection (Typeable)
 import Control.DeepSeq (NFData)
+import Control.Monad (Monad(..), (<=<), (=<<), liftM, liftM2, sequence)
 import Data.Bool (Bool(..))
 import Data.Eq (Eq)
+import Data.Function (($))
 import Data.Function ((.))
 import Data.Ord (Ord)
+import Data.Semigroup (Semigroup(..))
+import System.IO (IO)
 import Text.Show (Show(..))
+import Type.Reflection (Typeable)
 import qualified Data.Functor as Functor
 import qualified Data.Set as Set
 import qualified Data.Traversable as Traversable
 import qualified Language.Haskell.TH as TH
 import qualified Language.Haskell.TH.Syntax as TH
-import qualified Symantic.Lang as Prod
+import qualified Symantic.Class as Prod
 
 import Symantic.Derive
 import Symantic.Parser.Grammar
@@ -78,6 +79,7 @@ type Machinable tok repr =
 instance
   ( Cursorable (Cursor inp)
   , InstrBranchable repr
+  , InstrComment repr
   , InstrExceptionable repr
   , InstrInputable repr
   , InstrJoinable repr
@@ -93,7 +95,7 @@ instance
   try (Program x) = Program $ \next ->
     liftM2 (catch ExceptionFailure)
       (x (commit ExceptionFailure next))
-      -- On exception, reset the input, and propagate the failure.
+      -- On 'ExceptionFailure', reset the input, and propagate the failure.
       (return $ loadInput $ fail Set.empty)
 
 -- | @(raiseAgainIfConsumed exn ok)@
@@ -105,6 +107,7 @@ instance
 raiseAgainIfConsumed ::
   Cursorable (Cursor inp) =>
   InstrBranchable repr =>
+  InstrComment repr =>
   InstrExceptionable repr =>
   InstrInputable repr =>
   InstrValuable repr =>
@@ -112,7 +115,8 @@ raiseAgainIfConsumed ::
   SomeInstr repr inp vs ret ->
   SomeInstr repr inp (Cursor inp ': vs) ret
 raiseAgainIfConsumed exn ok =
-  pushInput $
+  comment "raiseAgainIfConsumed" $
+  saveInput $
   lift2Value (splice sameOffset) $
   ifBranch ok $
     case exn of
@@ -165,6 +169,7 @@ instance
   ( Cursorable (Cursor inp)
   , InstrBranchable repr
   , InstrCallable repr
+  , InstrComment repr
   , InstrExceptionable repr
   , InstrInputable repr
   , InstrIterable repr
@@ -233,7 +238,7 @@ instance
   ) => CombLookable (Program repr inp) where
   look (Program x) = Program $ \next ->
     liftM (comment "look") $
-    liftM pushInput (x (swapValue (loadInput next)))
+    liftM saveInput (x (swapValue (loadInput next)))
   eof =
     negLook (satisfy (Prod.const Prod..@ Prod.bool True))
       -- This sets a better failure message
@@ -255,7 +260,7 @@ instance
       --   and (negLook x) fail.
       (
         liftM (comment "negLook.ahead") $
-        liftM pushInput $ x $
+        liftM saveInput $ x $
         popValue $ commit ExceptionFailure $
           loadInput $ fail Set.empty
       )
@@ -280,7 +285,7 @@ instance
   ) => CombSatisfiable tok (Program repr inp) where
   satisfyOrFail fs p = Program $ \next ->
     return $
-      comment "satisfy" $
+      comment ("satisfy "<>showsPrec 11 (prodCode p) "") $
       read fs (prodCode p) next
 instance
   ( InstrBranchable repr