doc: improve a bit the ReadMe.md

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

diff --git a/src/Symantic/Parser/Machine/View.hs b/src/Symantic/Parser/Machine/View.hs
index d0d6a227a98b7a7dde00c5e5fe15c35b4653ee05..feb1a640aa7b9f6e2a5ecf89174468050705f653 100644 (file)
--- a/src/Symantic/Parser/Machine/View.hs
+++ b/src/Symantic/Parser/Machine/View.hs
@@ -11,11 +11,11 @@ import Data.Ord (Ord(..))
 import Data.Semigroup (Semigroup(..))
 import Data.String (String)
 import Data.Tuple (fst)
-import GHC.TypeLits (symbolVal)
 import Text.Show (Show(..))
 import qualified Data.HashMap.Strict as HM
 import qualified Data.List as List
 import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
 import qualified Data.Tree as Tree
 import qualified Language.Haskell.TH.Syntax as TH
 import Prelude (error)
@@ -101,25 +101,30 @@ instance InstrValuable (ViewMachine sN) where
     , viewGen = gen
     } where gen = swapValue (viewGen k)
 instance InstrExceptionable (ViewMachine sN) where
-  raiseException lbl err = ViewMachine
+  raise exn = ViewMachine
     { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("raiseException "<>show (symbolVal lbl), "") [] : next
+        viewInstrCmd (Right gen) ct lm ("raise "<>show exn, "") [] : next
     , viewGen = gen
-    } where gen = raiseException lbl err
-  popException lbl k = ViewMachine
+    } where gen = raise exn
+  fail flr = ViewMachine
     { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("popException "<>show (symbolVal lbl), "") [] :
+        viewInstrCmd (Right gen) ct lm ("fail "<>show (Set.toList flr), "") [] : next
+    , viewGen = gen
+    } where gen = fail flr
+  commit exn k = ViewMachine
+    { unViewMachine = \ct lm next ->
+        viewInstrCmd (Right gen) ct lm ("commit "<>show exn, "") [] :
         unViewMachine k ct lm next
     , viewGen = gen
-    } where gen = popException lbl (viewGen k)
-  catchException lbl ok ko = ViewMachine
+    } where gen = commit exn (viewGen k)
+  catch exn ok ko = ViewMachine
     { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("catchException "<>show (symbolVal lbl), "")
+        viewInstrCmd (Right gen) ct lm ("catch "<>show exn, "")
           [ viewInstrArg "ok" (unViewMachine ok ct lm [])
           , viewInstrArg "ko" (unViewMachine ko ct lm [])
           ] : next
     , viewGen = gen
-    } where gen = catchException lbl (viewGen ok) (viewGen ko)
+    } where gen = catch exn (viewGen ok) (viewGen ko)
 instance InstrBranchable (ViewMachine sN) where
   caseBranch l r = ViewMachine
     { unViewMachine = \ct lm next ->