rename {hut => code}.sourcephile.fr

[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 0cf18e621d47fb29e16967e6f7aa450dd393a150..743f4874182530f9cc323deb8a7917afd60e9e7b 100644 (file)
--- a/src/Symantic/Parser/Machine/View.hs
+++ b/src/Symantic/Parser/Machine/View.hs
@@ -56,6 +56,7 @@ viewInstrCmd ::
 viewInstrCmd gen finalByLet (cmd, no) = Tree.Node $ (cmd
   <> "\nminReads="<>showsPrec 11 (minReads ga) ""
   <> "\nmayRaise="<>show (Map.keys (mayRaise ga))
+  <> "\nalwaysRaise="<>show (Set.toList (alwaysRaise ga))
   <> "\nfreeRegs="<>show (hideableName @sN (Set.toList (freeRegs ga)))
   , no)
   where
@@ -124,11 +125,11 @@ instance
         viewInstrCmd @sN (Right gen) lm ("raise "<>show exn, "") [] : next
     , viewGen = gen
     } where gen = raise exn
-  fail flr = ViewMachine
+  fail fs = ViewMachine
     { unViewMachine = \lm next ->
-        viewInstrCmd @sN (Right gen) lm ("fail "<>show (Set.toList flr), "") [] : next
+        viewInstrCmd @sN (Right gen) lm ("fail "<>show (Set.toList fs), "") [] : next
     , viewGen = gen
-    } where gen = fail flr
+    } where gen = fail fs
   commit exn k = ViewMachine
     { unViewMachine = \lm next ->
         viewInstrCmd @sN (Right gen) lm ("commit "<>show exn, "") [] :
@@ -138,8 +139,8 @@ instance
   catch exn ok ko = ViewMachine
     { unViewMachine = \lm next ->
         viewInstrCmd @sN (Right gen) lm ("catch "<>show exn, "")
-          [ viewInstrArg "ok" (unViewMachine ok lm [])
-          , viewInstrArg "ko" (unViewMachine ko lm [])
+          [ viewInstrArg "catchScope" (unViewMachine ok lm [])
+          , viewInstrArg ("onException "<>show exn) (unViewMachine ko lm [])
           ] : next
     , viewGen = gen
     } where gen = catch exn (viewGen ok) (viewGen ko)
@@ -196,14 +197,14 @@ instance
 instance
   HideableName sN =>
   InstrJoinable (ViewMachine sN) where
-  defJoin ln@(LetName n) j k = ViewMachine
+  defJoin ln@(LetName n) sub k = ViewMachine
     { unViewMachine = \lm next ->
         viewInstrCmd @sN (Left n) lm
           ("join", " "<>show (hideableName @sN n))
-          (unViewMachine j lm []) :
+          (unViewMachine sub lm []) :
         unViewMachine k lm next
     , viewGen = gen
-    } where gen = defJoin ln (viewGen j) (viewGen k)
+    } where gen = defJoin ln (viewGen sub) (viewGen k)
   refJoin ln@(LetName n) = ViewMachine
     { unViewMachine = \lm next ->
         viewInstrCmd @sN (Right gen) lm ("refJoin", " "<>show (hideableName @sN n)) [] : next
@@ -212,12 +213,12 @@ instance
 instance
   HideableName sN =>
   InstrInputable (ViewMachine sN) where
-  pushInput k = ViewMachine
+  saveInput k = ViewMachine
     { unViewMachine = \lm next ->
-        viewInstrCmd @sN (Right gen) lm ("pushInput", "") [] :
+        viewInstrCmd @sN (Right gen) lm ("saveInput", "") [] :
         unViewMachine k lm next
     , viewGen = gen
-    } where gen = pushInput (viewGen k)
+    } where gen = saveInput (viewGen k)
   loadInput k = ViewMachine
     { unViewMachine = \lm next ->
         viewInstrCmd @sN (Right gen) lm ("loadInput", "") [] :