Merge pull request #97 from objectionary/update-grammar

Fix grammar

.github/workflows/ghc.yml

@@ -36,8 +36,7 @@ jobs:
             !eo-phi-normalizer/Setup.hs
 
       - name: 🧰 Setup Stack
-        # FIXME use freckle/stack-action@v5 when https://github.com/freckle/stack-action/pull/36 is merged
-        uses: freckle/stack-action@pb/v5
+        uses: freckle/stack-action@v5
         with:
           stack-build-arguments: --${{ github.ref_name != 'master' && 'fast' || '' }} --pedantic
 
@@ -54,8 +53,7 @@ jobs:
         uses: actions/checkout@v4
 
       - name: 🧰 Setup Stack
-        # FIXME use freckle/stack-action@v5 when https://github.com/freckle/stack-action/pull/36 is merged
-        uses: freckle/stack-action@pb/v5
+        uses: freckle/stack-action@v5
         with:
           stack-build-arguments: --${{ github.ref_name != 'master' && 'fast' || '' }} --pedantic
 

eo-phi-normalizer/grammar/EO/Phi/Syntax.cf

@@ -6,7 +6,7 @@
 
 token Bytes ({"--"} | ["0123456789ABCDEF"] ["0123456789ABCDEF"] {"-"} | ["0123456789ABCDEF"] ["0123456789ABCDEF"] ({"-"} ["0123456789ABCDEF"] ["0123456789ABCDEF"])+) ;
 token Function upper (char - [" \r\n\t,.|':;!-?][}{)(⟧⟦"])* ;
-token LabelId  lower (char - [" \r\n\t,.|':;!-?][}{)(⟧⟦"])* ;
+token LabelId  lower (char - [" \r\n\t,.|':;!?][}{)(⟧⟦"])* ;
 token AlphaIndex ({"α0"} | {"α"} (digit - ["0"]) (digit)* ) ;
 token MetaId {"!"} (char - [" \r\n\t,.|':;!-?][}{)(⟧⟦"])* ;
 
@@ -15,8 +15,8 @@ Program. Program ::= "{" [Binding] "}" ;
 Formation.      Object ::= "⟦" [Binding] "⟧" ;
 Application.    Object ::= Object "(" [Binding] ")" ;
 ObjectDispatch. Object ::= Object "." Attribute ;
-GlobalDispatch. Object ::= "Φ" "." Attribute ;
-ThisDispatch.   Object ::= "ξ" "." Attribute ;
+GlobalObject.   Object ::= "Φ";
+ThisObject.     Object ::= "ξ";
 Termination.    Object ::= "⊥" ;
 MetaObject.     Object ::= MetaId ;
 

eo-phi-normalizer/src/Language/EO/Phi/Normalize.hs

@@ -80,7 +80,7 @@ normalizeObject object = do
   case object of
     -- Rule 1
     obj@(Formation _) -> rule1 obj
-    ThisDispatch a -> pure $ fromMaybe object (lookupBinding a this)
+    ObjectDispatch ThisObject a -> pure $ fromMaybe object (lookupBinding a this)
     _ -> pure object
 
 -- | Split compound object into its head and applications/dispatch actions.
@@ -89,8 +89,8 @@ peelObject = \case
   Formation bindings -> PeeledObject (HeadFormation bindings) []
   Application object bindings -> peelObject object `followedBy` ActionApplication bindings
   ObjectDispatch object attr -> peelObject object `followedBy` ActionDispatch attr
-  GlobalDispatch attr -> PeeledObject HeadGlobal [ActionDispatch attr]
-  ThisDispatch attr -> PeeledObject HeadThis [ActionDispatch attr]
+  GlobalObject -> PeeledObject HeadGlobal []
+  ThisObject -> PeeledObject HeadThis []
   Termination -> PeeledObject HeadTermination []
   MetaObject _ -> PeeledObject HeadTermination []
  where
@@ -102,12 +102,12 @@ unpeelObject (PeeledObject head_ actions) =
     HeadFormation bindings -> go (Formation bindings) actions
     HeadGlobal ->
       case actions of
-        ActionDispatch a : as -> go (GlobalDispatch a) as
-        _ -> error "impossible: global object without dispatch!"
+        ActionApplication{} : _ -> error "impossible: application for a global object!"
+        _ -> go GlobalObject actions
     HeadThis ->
       case actions of
-        ActionDispatch a : as -> go (ThisDispatch a) as
-        _ -> error "impossible: this object without dispatch!"
+        ActionApplication{} : _ -> error "impossible: application for a global object!"
+        _ -> go ThisObject actions
     HeadTermination -> go Termination actions
  where
   go = foldl applyAction

eo-phi-normalizer/src/Language/EO/Phi/Rules/Common.hs

@@ -61,8 +61,8 @@ withSubObject f root =
           , Application obj <$> withSubObjectBindings f bindings
           ]
       ObjectDispatch obj a -> ObjectDispatch <$> withSubObject f obj <*> pure a
-      GlobalDispatch{} -> []
-      ThisDispatch{} -> []
+      GlobalObject{} -> []
+      ThisObject{} -> []
       Termination -> []
       MetaObject _ -> []
 

eo-phi-normalizer/src/Language/EO/Phi/Rules/Yaml.hs

@@ -82,8 +82,8 @@ objectHasMetavars :: Object -> Bool
 objectHasMetavars (Formation bindings) = any bindingHasMetavars bindings
 objectHasMetavars (Application object bindings) = objectHasMetavars object || any bindingHasMetavars bindings
 objectHasMetavars (ObjectDispatch object attr) = objectHasMetavars object || attrHasMetavars attr
-objectHasMetavars (GlobalDispatch attr) = attrHasMetavars attr
-objectHasMetavars (ThisDispatch attr) = attrHasMetavars attr
+objectHasMetavars GlobalObject = False
+objectHasMetavars ThisObject = False
 objectHasMetavars Termination = False
 objectHasMetavars (MetaObject _) = True
 
@@ -172,10 +172,8 @@ applySubst subst@Subst{..} = \case
     Application (applySubst subst obj) (applySubstBindings subst bindings)
   ObjectDispatch obj a ->
     ObjectDispatch (applySubst subst obj) (applySubstAttr subst a)
-  GlobalDispatch a ->
-    GlobalDispatch (applySubstAttr subst a)
-  ThisDispatch a ->
-    ThisDispatch (applySubstAttr subst a)
+  GlobalObject -> GlobalObject
+  ThisObject -> ThisObject
   obj@(MetaObject x) -> fromMaybe obj $ lookup x objectMetas
   obj -> obj
 

eo-phi-normalizer/test/Language/EO/PhiSpec.hs

@@ -8,6 +8,8 @@
 module Language.EO.PhiSpec where
 
 import Control.Monad (forM_)
+import Data.Char (isSpace)
+import Data.List (dropWhileEnd)
 import Data.String.Interpolate (i)
 import Language.EO.Phi
 import Language.EO.Phi.Rules.Common (Context (..), Rule)
@@ -24,7 +26,7 @@ applyRule rule = \case
 
 spec :: Spec
 spec = do
-  describe "Pre-defined rules unit tests" $
+  describe "Pre-defined rules" $
     forM_ ([(1, rule1), (6, rule6)] :: [(Int, Rule)]) $
       \(idx, rule) -> do
         PhiTestGroup{..} <- runIO (fileTests [i|test/eo/phi/rule-#{idx}.yaml|])
@@ -33,3 +35,18 @@ spec = do
             \PhiTest{..} ->
               it name $
                 applyRule (rule (Context [])) input `shouldBe` [normalized]
+  describe "Programs translated from EO" $ do
+    phiTests <- runIO (allPhiTests "test/eo/phi/from-eo/")
+    forM_ phiTests $ \PhiTestGroup{..} ->
+      describe title $
+        forM_ tests $
+          \PhiTest{..} -> do
+            describe "normalize" $
+              it name $
+                normalize input `shouldBe` normalized
+            describe "pretty-print" $
+              it name $
+                printTree input `shouldBe` trim prettified
+
+trim :: String -> String
+trim = dropWhileEnd isSpace

eo-phi-normalizer/test/eo/phi/from-eo/as-phi.yaml

@@ -0,0 +1,9 @@
+title: Processing terms generated from EO
+tests:
+  - name: "A program that prints itself"
+    input: |
+      {org ↦ ⟦eolang ↦ ⟦prints-itself ↦ ⟦φ ↦ Φ.org.eolang.as-phi(α0 ↦ ξ).length.gt(α0 ↦ Φ.org.eolang.int(α0 ↦ Φ.org.eolang.bytes(Δ ⤍ 00-00-00-00-00-00-00-00)))⟧, prints-itself-to-console ↦ ⟦x ↦ Φ.org.eolang.int(α0 ↦ Φ.org.eolang.bytes(Δ ⤍ 00-00-00-00-00-00-00-2A)), φ ↦ Φ.org.eolang.io.stdout(α0 ↦ Φ.org.eolang.as-phi(α0 ↦ ξ))⟧, λ ⤍ Package⟧, λ ⤍ Package⟧}
+    normalized: |
+      { ν ↦ ⟦ Δ ⤍ 04- ⟧, org ↦ ⟦ ν ↦ ⟦ Δ ⤍ 03- ⟧, eolang ↦ ⟦ ν ↦ ⟦ Δ ⤍ 02- ⟧, prints-itself ↦ ⟦ ν ↦ ⟦ Δ ⤍ 00- ⟧, φ ↦ Φ.org.eolang.as-phi (α0 ↦ ξ).length.gt (α0 ↦ Φ.org.eolang.int (α0 ↦ Φ.org.eolang.bytes (Δ ⤍ 00-00-00-00-00-00-00-00))) ⟧, prints-itself-to-console ↦ ⟦ ν ↦ ⟦ Δ ⤍ 01- ⟧, x ↦ Φ.org.eolang.int (α0 ↦ Φ.org.eolang.bytes (Δ ⤍ 00-00-00-00-00-00-00-2A)), φ ↦ Φ.org.eolang.io.stdout (α0 ↦ Φ.org.eolang.as-phi (α0 ↦ ξ)) ⟧, λ ⤍ Package ⟧, λ ⤍ Package ⟧ }
+    prettified: |
+      { org ↦ ⟦ eolang ↦ ⟦ prints-itself ↦ ⟦ φ ↦ Φ.org.eolang.as-phi (α0 ↦ ξ).length.gt (α0 ↦ Φ.org.eolang.int (α0 ↦ Φ.org.eolang.bytes (Δ ⤍ 00-00-00-00-00-00-00-00))) ⟧, prints-itself-to-console ↦ ⟦ x ↦ Φ.org.eolang.int (α0 ↦ Φ.org.eolang.bytes (Δ ⤍ 00-00-00-00-00-00-00-2A)), φ ↦ Φ.org.eolang.io.stdout (α0 ↦ Φ.org.eolang.as-phi (α0 ↦ ξ)) ⟧, λ ⤍ Package ⟧, λ ⤍ Package ⟧ }