bump version

[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 8964a32d45b7f2b4d7c0c1bc5fcf462e5aa32305..816aa6cc454a66073fccb24b1e16170691f4afe6 100644 (file)
--- a/src/Symantic/Parser/Machine/Program.hs
+++ b/src/Symantic/Parser/Machine/Program.hs
@@ -23,13 +23,13 @@ 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.Univariant.Lang as H
+import qualified Symantic.Typed.Lang as Prod
 
 import Symantic.Parser.Grammar
 import Symantic.Parser.Machine.Input
 import Symantic.Parser.Machine.Instructions
 import Symantic.Parser.Machine.Optimize
-import Symantic.Univariant.Trans
+import Symantic.Typed.Trans
 
 -- * Type 'Program'
 -- | A 'Program' is a tree of 'Instr'uctions,
@@ -151,6 +151,12 @@ joinNext (Program m) = Program $ \case
   -- If a join-node points directly to another join-node,
   -- then reuse it
   next@(Instr RefJoin{}) -> m next
+  -- If a join-node points directly to a 'jump',
+  -- then reuse it.
+  -- Because 'Jump' expects an empty 'valueStack',
+  -- a 'PopValue' has to be here to drop
+  -- the value normaly expected by the 'next' 'Instr'uction.
+  next@(Instr (PopValue (Instr Jump{}))) -> m next
   -- Terminal refJoin Optimization:
   -- If a join-node points directly to a terminal operation,
   -- then it's useless to introduce a join-node.
@@ -179,9 +185,9 @@ instance
   ) => CombFoldable (Program repr inp) where
   {-
   chainPre op p = go <*> p
-    where go = (H..) <$> op <*> go <|> pure H.id
+    where go = (Prod..) <$> op <*> go <|> pure Prod.id
   chainPost p op = p <**> go
-    where go = (H..) <$> op <*> go <|> pure H.id
+    where go = (Prod..) <$> op <*> go <|> pure Prod.id
   -}
 instance
   InstrCallable repr =>
@@ -190,7 +196,8 @@ instance
     sub' <- sub ret
     return $ defLet (HM.singleton n (SomeLet sub')) (call (LetName n) next)
   ref _isRec n = Program $ \case
-    -- Returning just after a 'call' is useless:
+    -- Tail Call Optimization:
+    -- returning just after a 'call' is useless:
     -- using 'jump' lets the 'ret' of the 'defLet'
     -- directly return where it would in two 'ret's.
     Instr Ret{} -> return $ jump (LetName n)
@@ -214,7 +221,7 @@ instance
   ) => CombLookable (Program repr inp) where
   look (Program x) = Program $ \next ->
     liftM pushInput (x (swapValue (loadInput next)))
-  eof = negLook (satisfy (H.lam1 (\_x -> H.bool True)))
+  eof = negLook (satisfy (Prod.lam1 (\_x -> Prod.bool True)))
         -- This sets a better failure message
         <|> (Program $ \_next -> return $ fail (Set.singleton (SomeFailure FailureEnd)))
   negLook (Program x) = Program $ \next ->
@@ -235,7 +242,7 @@ instance
           loadInput $ fail Set.empty)
       -- On x failure, reset the input,
       -- and go on with the next 'Instr'uctions.
-      (return $ loadInput $ pushValue H.unit next)
+      (return $ loadInput $ pushValue Prod.unit next)
 instance
   ( InstrBranchable repr
   , InstrJoinable repr