diff --git a/ZipperAG.cabal b/ZipperAG.cabal --- a/ZipperAG.cabal +++ b/ZipperAG.cabal @@ -1,5 +1,5 @@ Name: ZipperAG -Version: 0.6 +Version: 0.7 Cabal-Version: >= 1.2 License: BSD3 Author: Pedro Martins @@ -31,6 +31,7 @@ Language.Grammars.ZipperAG.Examples.LET.Let_Meaning_HO_NestedST_Circ, Language.Grammars.ZipperAG.Examples.LET.Let_No_Blocks, Language.Grammars.ZipperAG.Examples.LET.Let_Scope + Language.Grammars.ZipperAG.Examples.LET.Let_Circular_Flatening hs-source-dirs: src diff --git a/src/Language/Grammars/ZipperAG/Examples/LET/ExampleLet.hs b/src/Language/Grammars/ZipperAG/Examples/LET/ExampleLet.hs --- a/src/Language/Grammars/ZipperAG/Examples/LET/ExampleLet.hs +++ b/src/Language/Grammars/ZipperAG/Examples/LET/ExampleLet.hs @@ -1,3 +1,4 @@ + {-# LANGUAGE DeriveDataTypeable #-} module Language.Grammars.ZipperAG.Examples.LET.ExampleLet where @@ -6,19 +7,17 @@ import Language.Grammars.ZipperAG import Language.Grammars.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate -import Language.Grammars.ZipperAG.Examples.LET.Let_Bidi +import Language.Grammars.ZipperAG.Examples.LET.Let_No_Blocks import Language.Grammars.ZipperAG.Examples.LET.Let_Scope -import Language.Grammars.ZipperAG.Examples.LET.Let_Meaning_HO_NestedST_Circ +import Language.Grammars.ZipperAG.Examples.LET.Let_Circular_Flatening +import Language.Grammars.ZipperAG.Examples.LET.Let_Meaning_HO_NestedST_Circ hiding (calculate) -- This Module is where all the example are presented -- All examples are presented as the LET language, in their -- Haskell form (a1..f1) and in their CST form (a..f) --- The functions test_bidi, test_scope_rules and test_meaning --- are presented ------- test_bidi - Test bidirectionality. Converts from CST to AST and back to CST ------- test_scope_rules - Applies the AG that performs name/scope analysis with references ------- test_meaning - Applies the AG that calculates the meaning of the program, through ------- an higher-order AG and then through circularity +-- To run the examples, just choose one of the functions +-- in the end and use as argument a CST. For example: +-- -> "scope_with_blocks a" ---- Examples ---- a1 = let a = b + 3 @@ -35,8 +34,8 @@ -- w = let z = a * b $ ConsLetC "w" ( LetC ( ConsAssignC "z" (Et $ Mul (Tf $ Var "a") (Var "b")) EmptyListC) -- in z * b - $ InC (Et $ Mul (Tf $ Var "z") (Var "b")) - ) + $ InC (Et $ Mul (Tf $ Var "z") (Var "b")) + ) -- b = (c * 3) - c $ ConsAssignC "b" (Sub (Et $ (Mul (Tf $ Var "c") (Const 3))) (Tf $ Var "c")) EmptyListC @@ -134,18 +133,16 @@ -- in c * w - a $ InC (Sub (Et $ Mul (Tf $ Var "c") (Var "w")) (Tf $ Var "a")) -test_bidi p = do putStrLn ("**** CONCRETE -> " ++ show p) - let t1 = getRootC_RootA $ toZipper p - putStrLn ("**** ABSTRACT -> " ++ show t1) - let t2 = putRootA_RootC $ toZipper t1 - putStrLn ("**** CONCRETE -> " ++ show t2) - -test_scope_rules p = errs $ toZipper (getRootC_RootA $ toZipper p) +scope_no_blocks ag = Language.Grammars.ZipperAG.Examples.LET.Let_No_Blocks.test_scope_no_block_rules ag -test_meaning p = solve $ toZipper (getRootC_RootA $ toZipper p) +scope_with_blocks ag = Language.Grammars.ZipperAG.Examples.LET.Let_Scope.test_scope_block_rules ag +flatten ag = getHole (Language.Grammars.ZipperAG.Examples.LET.Let_Circular_Flatening.flatten_Let ag) :: Maybe RootA +solve_after_flattening ag = let ata = Language.Grammars.ZipperAG.Examples.LET.Let_Circular_Flatening.flatten_Let ag + in calculate ata +solve_circ_plus_ho ag = Language.Grammars.ZipperAG.Examples.LET.Let_Meaning_HO_NestedST_Circ.solve_ho_plus_circularity ag diff --git a/src/Language/Grammars/ZipperAG/Examples/LET/Let_Bidi.hs b/src/Language/Grammars/ZipperAG/Examples/LET/Let_Bidi.hs --- a/src/Language/Grammars/ZipperAG/Examples/LET/Let_Bidi.hs +++ b/src/Language/Grammars/ZipperAG/Examples/LET/Let_Bidi.hs @@ -3,8 +3,8 @@ module Language.Grammars.ZipperAG.Examples.LET.Let_Bidi where import Data.Generics.Zipper -import Language.Grammars.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate import Language.Grammars.ZipperAG +import Language.Grammars.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate -- Forward Transformation (GET) getRootC_RootA :: Zipper a -> RootA @@ -59,8 +59,8 @@ putListA_ListC :: Zipper a -> ListC putListA_ListC ag = case (constructor ag) of - "ConsLetA" -> ConsLetC (lexeme_ConsLetA ag) (putLetA_LetC $ ag.$2) (putListA_ListC $ ag.$3) - "ConsAssignA" -> ConsAssignC (lexeme_ConsAssignA ag) (putA_E $ ag.$2) (putListA_ListC $ ag.$3) + "ConsLetA" -> ConsLetC (lexeme_ConsLetA_1 ag) (putLetA_LetC $ ag.$2) (putListA_ListC $ ag.$3) + "ConsAssignA" -> ConsAssignC (lexeme_ConsAssignA_1 ag) (putA_E $ ag.$2) (putListA_ListC $ ag.$3) "EmptyListA" -> EmptyListC putA_E :: Zipper a -> E diff --git a/src/Language/Grammars/ZipperAG/Examples/LET/Let_Circular_Flatening.hs b/src/Language/Grammars/ZipperAG/Examples/LET/Let_Circular_Flatening.hs new file mode 100644 --- /dev/null +++ b/src/Language/Grammars/ZipperAG/Examples/LET/Let_Circular_Flatening.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE DeriveDataTypeable#-} + +module Language.Grammars.ZipperAG.Examples.LET.Let_Circular_Flatening where + +import Data.Generics.Zipper +import Language.Grammars.ZipperAG +import Data.Data + +import Language.Grammars.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate +import Language.Grammars.ZipperAG.Examples.LET.Let_Scope +import Language.Grammars.ZipperAG.Examples.LET.Let_Bidi + +data VarList = VarList String VarList + | NoVar + +pointFree :: Zipper a -> (Zipper a -> Bool) -> (Zipper a -> b) -> (Zipper a -> Zipper a) -> b +pointFree ag cond calc incre = if cond ag + then calc ag + else pointFree (incre ag) cond calc incre + +solve :: Zipper RootA -> Zipper RootA +solve ag = pointFree ag isSolved id (toZipper . flatAG) + +isSolved :: Zipper RootA -> Bool +isSolved ag = case (constructor ag) of + "RootA" -> isSolved $ ag.$1 + "LetA" -> (isSolved $ ag.$1) || (isSolved $ ag.$2) + "InA" -> isConstant $ ag.$1 + "ConsAssignA" -> (isConstant $ ag.$2) && (isSolved $ ag.$3) + "ConsLetA" -> False + "EmptyListA" -> True + +isSolvable :: Zipper RootA -> Bool +isSolvable ag = case (constructor ag) of + "Plus" -> (isSolvable $ ag.$1) && (isSolvable $ ag.$2) + "Divide" -> (isSolvable $ ag.$1) && (isSolvable $ ag.$2) + "Minus" -> (isSolvable $ ag.$1) && (isSolvable $ ag.$2) + "Time" -> (isSolvable $ ag.$1) && (isSolvable $ ag.$2) + "Variable" -> isVarSolved (lexeme_Variable ag) ag + "Constant" -> True + +flatAG :: Zipper RootA -> RootA +flatAG ag = case (constructor ag) of + "RootA" -> RootA (flatLetAG $ ag.$1) Empty + +flatLetAG :: Zipper RootA -> LetA +flatLetAG ag = case (constructor ag) of + "LetA" -> LetA (flatListAG $ ag.$1) (lexme_LetA_2 ag) Empty + +flatListAG :: Zipper RootA -> ListA +flatListAG ag = case (constructor ag) of + "ConsLetA" -> if (isSolved $ ag.$2) + then ConsAssignA (lexeme_ConsLetA_1 ag) (Constant (calculate $ ag.$2) Empty) (flatListAG $ ag.$3) Empty + else ConsLetA (lexeme_ConsLetA_1 ag) (flatLetAG $ ag.$2) (flatListAG $ ag.$3) Empty + "ConsAssignA" -> if ((not . isConstant $ ag.$2) && (isSolvable $ ag.$2)) + then ConsAssignA (lexeme_ConsAssignA_1 ag) (Constant (calculate $ ag.$2) Empty) (flatListAG $ ag.$3) Empty + else ConsAssignA (lexeme_ConsAssignA_1 ag) (lexeme_ConsAssignA_2 ag) (flatListAG $ ag.$3) Empty + "EmptyListA" -> EmptyListA Empty + +isConstant :: Zipper RootA -> Bool +isConstant ag = case (constructor ag) of + "Constant" -> True + _ -> False + +calculate :: Zipper RootA -> Int +calculate ag = case (constructor ag) of + "RootA" -> calculate $ ag.$1 + "LetA" -> calculate $ ag.$2 + "InA" -> calculate $ ag.$1 + "Plus" -> (calculate $ ag.$1) + (calculate $ ag.$2) + "Divide" -> (calculate $ ag.$1) `div` (calculate $ ag.$2) + "Minus" -> (calculate $ ag.$1) - (calculate $ ag.$2) + "Time" -> (calculate $ ag.$1) * (calculate $ ag.$2) + "Variable" -> getVarValue (lexeme_Variable ag) ag + "Constant" -> lexeme_Constant ag + +------- AUX's ------- + +getVarValue :: String -> Zipper RootA -> Int +getVarValue name ag = case (constructor ag) of + "RootA" -> auxGetVarValue name ag + "ConsLetA" -> auxGetVarValue name (ag.$2) + _ -> getVarValue name (parent ag) + +auxGetVarValue :: String -> Zipper RootA -> Int +auxGetVarValue name ag = case (constructor ag) of + "RootA" -> auxGetVarValue name (ag.$1) + "LetA" -> auxGetVarValue name (ag.$1) + "ConsAssignA" -> if (lexeme_ConsAssignA_1 ag == name) then (lexeme_Constant $ ag.$2) + else (auxGetVarValue name (ag.$3)) + "ConsLetA" -> auxGetVarValue name (ag.$3) + "EmptyListA" -> oneUpGetVarValue name ag + +oneUpGetVarValue :: String -> Zipper RootA -> Int +oneUpGetVarValue name ag = case (constructor ag) of + "ConsLetA" -> getVarValue name (parent ag) + _ -> oneUpGetVarValue name (parent ag) + +isVarSolved :: String -> Zipper RootA -> Bool +isVarSolved name ag = case (constructor ag) of + "RootA" -> auxIsVarSolved name ag + "ConsLetA" -> auxIsVarSolved name ag + _ -> isVarSolved name (parent ag) + +auxIsVarSolved :: String -> Zipper RootA -> Bool +auxIsVarSolved name ag = case (constructor ag) of + "RootA" -> auxIsVarSolved name (ag.$1) + "LetA" -> auxIsVarSolved name (ag.$1) + "ConsAssignA" -> if (lexeme_ConsAssignA_1 ag == name) then (isConstant $ ag.$2) + else (auxIsVarSolved name (ag.$3)) + "ConsLetA" -> if (lexeme_ConsLetA_1 ag == name) then False + else (auxIsVarSolved name (ag.$3)) + "EmptyListA" -> oneUpIsVarSolved name ag + +oneUpIsVarSolved :: String -> Zipper RootA -> Bool +oneUpIsVarSolved name ag = case (constructor ag) of + "ConsLetA" -> isVarSolved name (parent ag) + _ -> oneUpIsVarSolved name (parent ag) + +flatten_Let p = solve $ toZipper (getRootC_RootA $ toZipper p) + + + + + + + + + + + + diff --git a/src/Language/Grammars/ZipperAG/Examples/LET/Let_DataTypes_Boilerplate.hs b/src/Language/Grammars/ZipperAG/Examples/LET/Let_DataTypes_Boilerplate.hs --- a/src/Language/Grammars/ZipperAG/Examples/LET/Let_DataTypes_Boilerplate.hs +++ b/src/Language/Grammars/ZipperAG/Examples/LET/Let_DataTypes_Boilerplate.hs @@ -1,3 +1,4 @@ + {-# LANGUAGE DeriveDataTypeable #-} module Language.Grammars.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate where @@ -109,6 +110,11 @@ Just(ConsAssignC v _ _) -> v _ -> error "Error in lexeme_ConsAssignC!" +lexme_LetA_2 :: Zipper a -> InA +lexme_LetA_2 ag = case (getHole ag :: Maybe LetA) of + Just(LetA _ i _) -> i + _ -> error "Error in lexme_LetA_2!" + lexeme_InA :: Zipper a -> A lexeme_InA ag = case (getHole ag :: Maybe InA) of Just (InA a _) -> a @@ -128,20 +134,25 @@ Just (Const s) -> s _ -> error "Error in lexeme_Const!" -lexeme_ConsAssignA :: Zipper a -> String -lexeme_ConsAssignA ag = case (getHole ag :: Maybe ListA) of - Just(ConsAssignA v _ _ _) -> v - _ -> error "Error in lexeme_ConsAssignA!" +lexeme_ConsAssignA_1 :: Zipper a -> String +lexeme_ConsAssignA_1 ag = case (getHole ag :: Maybe ListA) of + Just(ConsAssignA v _ _ _) -> v + _ -> error "Error in lexeme_ConsAssignA_1!" -lexeme_ConsAssignA_Expr :: Zipper a -> A -lexeme_ConsAssignA_Expr ag = case (getHole ag :: Maybe ListA) of +lexeme_ConsAssignA_2 :: Zipper a -> A +lexeme_ConsAssignA_2 ag = case (getHole ag :: Maybe ListA) of Just(ConsAssignA _ a _ _) -> a - _ -> error "Error in lexeme_ConsAssignA_Expr!" + _ -> error "Error in lexeme_ConsAssignA_2!" -lexeme_ConsLetA :: Zipper a -> String -lexeme_ConsLetA ag = case (getHole ag :: Maybe ListA) of - Just(ConsLetA v _ _ _) -> v - _ -> error "Error in lexeme_ConsLetA!" +lexeme_ConsLetA_1 :: Zipper a -> String +lexeme_ConsLetA_1 ag = case (getHole ag :: Maybe ListA) of + Just(ConsLetA v _ _ _) -> v + _ -> error "Error in lexeme_ConsLetA!" + +lexeme_ConsLetA_2 :: Zipper a -> LetA +lexeme_ConsLetA_2 ag = case (getHole ag :: Maybe ListA) of + Just(ConsLetA _ leta _ _) -> leta + _ -> error "Error in lexeme_ConsLetA!" lexeme_Variable :: Zipper a -> String lexeme_Variable ag = case (getHole ag :: Maybe A) of diff --git a/src/Language/Grammars/ZipperAG/Examples/LET/Let_Meaning_HO_NestedST_Circ.hs b/src/Language/Grammars/ZipperAG/Examples/LET/Let_Meaning_HO_NestedST_Circ.hs --- a/src/Language/Grammars/ZipperAG/Examples/LET/Let_Meaning_HO_NestedST_Circ.hs +++ b/src/Language/Grammars/ZipperAG/Examples/LET/Let_Meaning_HO_NestedST_Circ.hs @@ -1,3 +1,4 @@ + {-# LANGUAGE DeriveDataTypeable #-} module Language.Grammars.ZipperAG.Examples.LET.Let_Meaning_HO_NestedST_Circ where @@ -8,6 +9,7 @@ import Language.Grammars.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate import Language.Grammars.ZipperAG.Examples.LET.Let_Scope +import Language.Grammars.ZipperAG.Examples.LET.Let_Bidi ---- Approach 1: multiple, nested symbol tables -- Always start searching on the nested symbol table @@ -29,13 +31,13 @@ solveST :: Zipper RootHO -> ListHO solveST ag = case (constructorHO ag) of "ConsVarHO" -> if ((not $ isSolved $ ag.$2) && (isSolved $ ag.$3)) - then ConsVarHO (lexeme_ConsVarHO_Var ag) (IsSolved $ calculate $ ag.$3) (lexeme_ConsVarHO_A ag) (solveST $ ag.$4) - else ConsVarHO (lexeme_ConsVarHO_Var ag) (lexeme_ConsVarHO_isSolved ag) (lexeme_ConsVarHO_A ag) (solveST $ ag.$4) + then ConsVarHO (lexeme_ConsVarHO_Var ag) (IsSolved $ calculate $ ag.$3) (lexeme_ConsVarHO_A ag) (solveST $ ag.$4) + else ConsVarHO (lexeme_ConsVarHO_Var ag) (lexeme_ConsVarHO_isSolved ag) (lexeme_ConsVarHO_A ag) (solveST $ ag.$4) "ConsLetHO" -> if ((not $ isSolved $ ag.$2) && (isSolved $ ag.$3)) - then ConsLetHO (lexeme_ConsLetHO_Var ag) (IsSolved $ calculate $ ag.$3) (lexeme_ConsLetHO_NestedST ag) (solveST $ ag.$4) - else let nested_ST = ag.$3 - new_ST = NestedListHO (solveST $ nested_ST.$1) (lexeme_NestedListHO $ nested_ST) - in ConsLetHO (lexeme_ConsLetHO_Var ag) (lexeme_ConsLetHO_isSolved ag) (new_ST) (solveST $ ag.$4) + then ConsLetHO (lexeme_ConsLetHO_Var ag) (IsSolved $ calculate $ ag.$3) (lexeme_ConsLetHO_NestedST ag) (solveST $ ag.$4) + else let nested_ST = ag.$3 + new_ST = NestedListHO (solveST $ nested_ST.$1) (lexeme_NestedListHO $ nested_ST) + in ConsLetHO (lexeme_ConsLetHO_Var ag) (lexeme_ConsLetHO_isSolved ag) (new_ST) (solveST $ ag.$4) "EmptyListHO" -> EmptyListHO "NestedListHO" -> solveST $ ag.$1 @@ -121,8 +123,8 @@ createST ag = case (constructorHO ag) of "RootA" -> createST $ ag.$1 "LetA" -> createST $ ag.$1 - "ConsAssignA" -> ConsVarHO (lexeme_ConsAssignA ag) (NotSolved) (lexeme_ConsAssignA_Expr ag) (createST $ ag.$3) - "ConsLetA" -> ConsLetHO (lexeme_ConsLetA ag) (NotSolved) (NestedListHO (createST $ ag.$2) (lexeme_InA $ (ag.$2).$2)) (createST $ ag.$3) + "ConsAssignA" -> ConsVarHO (lexeme_ConsAssignA_1 ag) (NotSolved) (lexeme_ConsAssignA_2 ag) (createST $ ag.$3) + "ConsLetA" -> ConsLetHO (lexeme_ConsLetA_1 ag) (NotSolved) (NestedListHO (createST $ ag.$2) (lexeme_InA $ (ag.$2).$2)) (createST $ ag.$3) "EmptyListA" -> EmptyListHO --- Higher-Order Symbol Table @@ -196,7 +198,7 @@ Just(NotSolved) -> "NotSolved" _ -> constructor ag - +solve_ho_plus_circularity p = solve $ toZipper (getRootC_RootA $ toZipper p) diff --git a/src/Language/Grammars/ZipperAG/Examples/LET/Let_No_Blocks.hs b/src/Language/Grammars/ZipperAG/Examples/LET/Let_No_Blocks.hs --- a/src/Language/Grammars/ZipperAG/Examples/LET/Let_No_Blocks.hs +++ b/src/Language/Grammars/ZipperAG/Examples/LET/Let_No_Blocks.hs @@ -20,7 +20,7 @@ "RootA" -> errs $ ag.$1 "LetA" -> (errs $ ag.$1) ++ (errs $ ag.$2) "InA" -> (errs $ ag.$1) - "ConsAssignA" -> mNBIn (lexeme_ConsAssignA ag) (dcli ag) ++ (errs $ ag.$2) ++ (errs $ ag.$3) + "ConsAssignA" -> mNBIn (lexeme_ConsAssignA_1 ag) (dcli ag) ++ (errs $ ag.$2) ++ (errs $ ag.$3) "EmptyListA" -> [] "Plus" -> (errs $ ag.$1) ++ (errs $ ag.$2) "Divide" -> (errs $ ag.$1) ++ (errs $ ag.$2) @@ -34,7 +34,7 @@ dcli ag = case (constructor ag) of "RootA" -> [] _ -> case (constructor $ parent ag) of - "ConsAssignA" -> (dcli $ parent ag) ++ [lexeme_ConsAssignA $ parent ag] + "ConsAssignA" -> (dcli $ parent ag) ++ [lexeme_ConsAssignA_1 $ parent ag] _ -> dcli $ parent ag env :: Zipper RootA -> [String] diff --git a/src/Language/Grammars/ZipperAG/Examples/LET/Let_Scope.hs b/src/Language/Grammars/ZipperAG/Examples/LET/Let_Scope.hs --- a/src/Language/Grammars/ZipperAG/Examples/LET/Let_Scope.hs +++ b/src/Language/Grammars/ZipperAG/Examples/LET/Let_Scope.hs @@ -1,3 +1,4 @@ + {-# LANGUAGE DeriveDataTypeable #-} module Language.Grammars.ZipperAG.Examples.LET.Let_Scope where @@ -5,6 +6,7 @@ import Data.Generics.Zipper import Language.Grammars.ZipperAG import Language.Grammars.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate +import Language.Grammars.ZipperAG.Examples.LET.Let_Bidi ---- Synthesized Attributes ---- dclo :: Zipper RootA -> [(String, Zipper RootA)] @@ -20,8 +22,8 @@ "RootA" -> errs $ ag.$1 "LetA" -> (errs $ ag.$1) ++ (errs $ ag.$2) "InA" -> (errs $ ag.$1) - "ConsAssignA" -> mNBIn (lexeme_ConsAssignA ag, ag) (dcli ag) ++ (errs $ ag.$2) ++ (errs $ ag.$3) - "ConsLetA" -> mNBIn (lexeme_ConsLetA ag, ag) (dcli ag) ++ (errs $ ag.$2) ++ (errs $ ag.$3) + "ConsAssignA" -> mNBIn (lexeme_ConsAssignA_1 ag, ag) (dcli ag) ++ (errs $ ag.$2) ++ (errs $ ag.$3) + "ConsLetA" -> mNBIn (lexeme_ConsLetA_1 ag, ag) (dcli ag) ++ (errs $ ag.$2) ++ (errs $ ag.$3) "EmptyListA" -> [] "Plus" -> (errs $ ag.$1) ++ (errs $ ag.$2) "Divide" -> (errs $ ag.$1) ++ (errs $ ag.$2) @@ -38,8 +40,8 @@ "RootA" -> dcli $ parent ag "ConsLetA" -> env $ parent ag _ -> case (constructor $ parent ag) of - "ConsAssignA" -> (dcli $ parent ag) ++ [(lexeme_ConsAssignA $ parent ag, parent ag)] - "ConsLetA" -> (dcli $ parent ag) ++ [(lexeme_ConsLetA $ parent ag, parent ag)] + "ConsAssignA" -> (dcli $ parent ag) ++ [(lexeme_ConsAssignA_1 $ parent ag, parent ag)] + "ConsLetA" -> (dcli $ parent ag) ++ [(lexeme_ConsLetA_1 $ parent ag, parent ag)] _ -> dcli $ parent ag env :: Zipper RootA -> [(String, Zipper RootA)] @@ -67,4 +69,6 @@ mNBIn :: (String, Zipper RootA) -> [(String, Zipper RootA)] -> [String] mNBIn tuple [] = [] mNBIn (a1,r1) ((a2,r2):es) = if (a1==a2) && (lev r1 == lev r2) then [a1] else mNBIn (a1,r1) es + +test_scope_block_rules p = errs $ toZipper (getRootC_RootA $ toZipper p)