ZipperAG 0.5 → 0.6
raw patch · 15 files changed
+695/−148 lines, 15 files
Files
- ZipperAG.cabal +17/−2
- src/Language/Grammars/ZipperAG/Examples/Algol68.hs +1/−24
- src/Language/Grammars/ZipperAG/Examples/BreadthFirst.hs +1/−22
- src/Language/Grammars/ZipperAG/Examples/DESK/DESK.hs +1/−16
- src/Language/Grammars/ZipperAG/Examples/DESK/DESK_HighOrder.hs +1/−9
- src/Language/Grammars/ZipperAG/Examples/DESK/DESK_circular.hs +1/−31
- src/Language/Grammars/ZipperAG/Examples/DESK/DESK_references.hs +1/−16
- src/Language/Grammars/ZipperAG/Examples/LET/ExampleLet.hs +4/−5
- src/Language/Grammars/ZipperAG/Examples/LET/Let_Bidi.hs +109/−0
- src/Language/Grammars/ZipperAG/Examples/LET/Let_DataTypes_Boilerplate.hs +198/−0
- src/Language/Grammars/ZipperAG/Examples/LET/Let_Meaning_HO_NestedST_Circ.hs +234/−0
- src/Language/Grammars/ZipperAG/Examples/LET/Let_No_Blocks.hs +55/−0
- src/Language/Grammars/ZipperAG/Examples/LET/Let_Scope.hs +70/−0
- src/Language/Grammars/ZipperAG/Examples/RepMin.hs +1/−7
- src/Language/Grammars/ZipperAG/Examples/SmartParentesis.hs +1/−16
ZipperAG.cabal view
@@ -1,5 +1,5 @@ Name: ZipperAG-Version: 0.5+Version: 0.6 Cabal-Version: >= 1.2 License: BSD3 Author: Pedro Martins <pedromartins4@gmail.com>@@ -15,7 +15,22 @@ Library Build-Depends: base >= 2 && <= 4.6.0.1, syz- Exposed-modules: Language.Grammars.ZipperAG, Language.Grammars.ZipperAG.Examples.Algol68, Language.Grammars.ZipperAG.Examples.BreadthFirst, Language.Grammars.ZipperAG.Examples.DESK.DESK_circular, Language.Grammars.ZipperAG.Examples.DESK.DESK_HighOrder, Language.Grammars.ZipperAG.Examples.DESK.DESK_references, Language.Grammars.ZipperAG.Examples.DESK.DESK, Language.Grammars.ZipperAG.Examples.HTMLTableFormatter, Language.Grammars.ZipperAG.Examples.RepMin, Language.Grammars.ZipperAG.Examples.SmartParentesis, Language.Grammars.ZipperAG.Examples.LET.ExampleLet+ Exposed-modules: Language.Grammars.ZipperAG,+ Language.Grammars.ZipperAG.Examples.Algol68,+ Language.Grammars.ZipperAG.Examples.BreadthFirst,+ Language.Grammars.ZipperAG.Examples.HTMLTableFormatter,+ Language.Grammars.ZipperAG.Examples.RepMin,+ Language.Grammars.ZipperAG.Examples.SmartParentesis+ Language.Grammars.ZipperAG.Examples.DESK.DESK_circular,+ Language.Grammars.ZipperAG.Examples.DESK.DESK_HighOrder,+ Language.Grammars.ZipperAG.Examples.DESK.DESK_references,+ Language.Grammars.ZipperAG.Examples.DESK.DESK,+ Language.Grammars.ZipperAG.Examples.LET.ExampleLet,+ Language.Grammars.ZipperAG.Examples.LET.Let_Bidi,+ Language.Grammars.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate,+ 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 hs-source-dirs: src
src/Language/Grammars/ZipperAG/Examples/Algol68.hs view
@@ -6,6 +6,7 @@ import Data.Data import Data.Generics.Zipper import Data.Maybe+import Language.Grammars.ZipperAG data Root = Root Its deriving (Typeable, Show, Data)@@ -31,33 +32,9 @@ Just (Root _) -> "Root" otherwise -> error "Naha, that production does not exist!" -(.$) :: Zipper a -> Int -> Zipper a-z .$ 1 = let d = down' z- in case d of- Just x -> x- Nothing -> error "You are going to a child that does not exist (1)!"-z .$ n = let r = right (z.$(n-1))- in case r of- Just x -> x- Nothing -> error "You are going to a child that does not exist (2)!"- value z = case (getHole z :: Maybe It) of Just (Use x) -> x Just (Decl x) -> x---- Tests if z is the n'th sibling-(.|) :: Zipper a -> Int -> Bool-z .| 1 = case (left z) of- Nothing -> False- _ -> True-z .| n = case (left z) of- Nothing -> False- Just x -> z .| (n-1)--parent z = let a = up z- in case a of- Just x -> x- Nothing -> error "You are asking for the parent of the TopMost Tree!" ---- Synthesized Attributes ---- dclo :: Zipper Root -> [(String, Int)]
src/Language/Grammars/ZipperAG/Examples/BreadthFirst.hs view
@@ -6,6 +6,7 @@ import Data.Generics.Zipper import Data.Maybe import Debug.Trace+import Language.Grammars.ZipperAG data Root = Root Tree deriving (Show, Typeable, Data)@@ -19,28 +20,6 @@ _ -> case (getHole a :: Maybe Tree) of Just (Fork _ _ _) -> "Fork" Just (Empty) -> "Empty"--(.$) :: Zipper a -> Int -> Zipper a-z .$ 1 = let d = down' z- in case d of- Just x -> x- Nothing -> error "You are going to a child that does not exist (1)!"-z .$ n = let r = right (z.$(n-1))- in case r of- Just x -> x- Nothing -> error "You are going to a child that does not exist (2)!"---- Tests if z is the n'th sibling-(.|) :: Zipper a -> Int -> Bool-z .| n = n == (aux z)- where aux z = case (left z) of- Nothing -> 1- Just _ -> 1 + aux (fromJust $ left z)--parent z = let a = up z- in case a of- Just x -> x- Nothing -> error "You are asking for the parent of the TopMost Tree!" -- Attributes slist :: Zipper Root -> [Int]
src/Language/Grammars/ZipperAG/Examples/DESK/DESK.hs view
@@ -6,6 +6,7 @@ import Data.Data import Prelude import Data.Generics.Zipper+import Language.Grammars.ZipperAG data Root = Root Program deriving (Show, Typeable, Data)@@ -60,22 +61,6 @@ otherwise -> case ( getHole a :: Maybe Root) of Just (Root _) -> "Root" _ -> "That production does not exist!"---- Gives the n'th child-(.$) :: Zipper a -> Int -> Zipper a-z .$ 1 = fromJust (down' z)-z .$ n = fromJust (right ( z.$(n-1) ))---- Tests if z is the n'th sibling-(.|) :: Zipper a -> Int -> Bool-z .| 1 = case (left z) of- Nothing -> False- _ -> True-z .| n = case (left z) of- Nothing -> False- Just x -> z .| (n-1)--parent = fromJust.up lexeme :: Zipper Root -> String lexeme t = case ( getHole t :: Maybe ConstName ) of
src/Language/Grammars/ZipperAG/Examples/DESK/DESK_HighOrder.hs view
@@ -6,6 +6,7 @@ import Data.Data import Prelude import Data.Generics.Zipper+import Language.Grammars.ZipperAG data Root = Root Program deriving (Show, Typeable, Data)@@ -76,15 +77,6 @@ otherwise -> case ( getHole a :: Maybe Root_HO ) of Just (Root_HO _) -> "Root_HO" _ -> error "Ups!!"---- Gives the n'th child-(.$) :: Zipper a -> Int -> Zipper a-z .$ 1 = fromJust (down' z)-z .$ n = fromJust (right ( z.$(n-1) ))---- Tests if z is the n'th sibling--parent = fromJust.up lexeme :: Zipper Root -> String lexeme t = case ( getHole t :: Maybe ConstName ) of
src/Language/Grammars/ZipperAG/Examples/DESK/DESK_circular.hs view
@@ -6,6 +6,7 @@ import Data.Data import Prelude import Data.Generics.Zipper+import Language.Grammars.ZipperAG data Root = Root Program deriving (Show, Typeable, Data)@@ -189,37 +190,6 @@ semantics t = putStrLn ("\n" ++ (code (toZipper t))) ---------------- -- -- Zipper-based AG supporting functions---- Gives the n'th child-(.$) :: Zipper a -> Int -> Zipper a-z .$ 1 = fromJust (down' z)-z .$ n = fromJust (right ( z.$(n-1) ))---- parent-parent = fromJust.up---- Tests if z is the n'th sibling-(.|) :: Zipper a -> Int -> Bool-z .| 1 = case (left z) of- Nothing -> False- _ -> True-z .| n = case (left z) of- Nothing -> False- Just x -> z .| (n-1) -- -- -- Boilerplate code
src/Language/Grammars/ZipperAG/Examples/DESK/DESK_references.hs view
@@ -6,6 +6,7 @@ import Data.Data import Prelude hiding (head, tail, zip) import Data.Generics.Zipper+import Language.Grammars.ZipperAG data Root = Root Program deriving (Show, Typeable, Data)@@ -60,22 +61,6 @@ otherwise -> case ( getHole a :: Maybe Root) of Just (Root _) -> "Root" _ -> "That production does not exist!"---- Gives the n'th child-(.$) :: Zipper a -> Int -> Zipper a-z .$ 1 = fromJust (down' z)-z .$ n = fromJust (right ( z.$(n-1) ))---- Tests if z is the n'th sibling-(.|) :: Zipper a -> Int -> Bool-z .| 1 = case (left z) of- Nothing -> False- _ -> True-z .| n = case (left z) of- Nothing -> False- Just x -> z .| (n-1)--parent = fromJust.up lexeme :: Zipper Root -> String lexeme t = case ( getHole t :: Maybe ConstName ) of
src/Language/Grammars/ZipperAG/Examples/LET/ExampleLet.hs view
@@ -2,14 +2,13 @@ module Language.Grammars.ZipperAG.Examples.LET.ExampleLet where -import Data.Generics import Data.Generics.Zipper import Language.Grammars.ZipperAG -import Let_DataTypes_Boilerplate-import Let_Bidi-import Let_Scope-import Let_Meaning_HO_NestedST_Circ+import Language.Grammars.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate+import Language.Grammars.ZipperAG.Examples.LET.Let_Bidi+import Language.Grammars.ZipperAG.Examples.LET.Let_Scope+import Language.Grammars.ZipperAG.Examples.LET.Let_Meaning_HO_NestedST_Circ -- This Module is where all the example are presented -- All examples are presented as the LET language, in their
+ src/Language/Grammars/ZipperAG/Examples/LET/Let_Bidi.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE DeriveDataTypeable #-}++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++-- Forward Transformation (GET)+getRootC_RootA :: Zipper a -> RootA+getRootC_RootA ag = case (constructor ag) of+ "RootC" -> RootA (getLetC_LetA $ ag.$1) (createLink ag)++getLetC_LetA :: Zipper a -> LetA+getLetC_LetA ag = case (constructor ag) of+ "LetC" -> LetA (getListC_ListA $ ag.$1) (getInC_IntA $ ag.$2) (createLink ag)++getInC_IntA :: Zipper a -> InA+getInC_IntA ag = case (constructor ag) of+ "InC" -> InA (getE_A $ ag.$1) (createLink ag)++getListC_ListA :: Zipper a -> ListA+getListC_ListA ag = case (constructor ag) of+ "ConsLetC" -> ConsLetA (lexeme_ConsLetC ag) (getLetC_LetA $ ag.$2) (getListC_ListA $ ag.$3) (createLink ag)+ "ConsAssignC" -> ConsAssignA (lexeme_ConsAssignC ag) (getE_A $ ag.$2) (getListC_ListA $ ag.$3) (createLink ag)+ "EmptyListC" -> EmptyListA (createLink ag)++getE_A :: Zipper a -> A+getE_A ag = case (constructor ag) of+ "Add" -> Plus (getE_A $ ag.$1) (getT_A $ ag.$2) (createLink ag)+ "Sub" -> Minus (getE_A $ ag.$1) (getT_A $ ag.$2) (createLink ag)+ "Et" -> getT_A $ ag.$1++getT_A :: Zipper a -> A+getT_A ag = case (constructor ag) of+ "Mul" -> Time (getT_A $ ag.$1) (getF_A $ ag.$2) (createLink ag)+ "Div" -> Divide (getT_A $ ag.$1) (getF_A $ ag.$2) (createLink ag)+ "Tf" -> getF_A $ ag.$1++getF_A :: Zipper a -> A+getF_A ag = case (constructor ag) of+ "Nest" -> getF_A $ ag.$1+ "Neg" -> Minus (Constant 0 Empty) (getF_A $ ag.$1) (createLink ag)+ "Const" -> Constant (lexeme_Const ag) (createLink ag)+ "Var" -> Variable (lexeme_Var ag) (createLink ag)++-- Backward Transformation (PUT)+putRootA_RootC :: Zipper a -> RootC+putRootA_RootC ag = case (constructor ag) of+ "RootA" -> RootC (putLetA_LetC $ ag.$1)++putLetA_LetC :: Zipper a -> LetC+putLetA_LetC ag = case (constructor ag) of+ "LetA" -> LetC (putListA_ListC $ ag.$1) (putInA_IntC $ ag.$2)++putInA_IntC :: Zipper a -> InC+putInA_IntC ag = case (constructor ag) of+ "InA" -> InC (putA_E $ ag.$1)++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)+ "EmptyListA" -> EmptyListC++putA_E :: Zipper a -> E+putA_E ag = case (getLink ag) of+ IsE e -> e+ IsT t -> Et $ t+ IsF f -> Et $ Tf $ f+ Empty -> case (constructor ag) of+ "Plus" -> Add (putA_E $ ag.$1) (putA_T $ ag.$2)+ "Minus" -> case (getHole ag :: Maybe A) of+ Just (Minus (Constant 0 _) _ _) -> Et $ Tf $ Neg (putA_F $ ag.$2)+ otherwise -> Sub (putA_E $ ag.$1) (putA_T $ ag.$2)+ "Times" -> Et $ Mul (putA_T $ ag.$1) (putA_F $ ag.$2)+ "Divide" -> Et $ Div (putA_T $ ag.$1) (putA_F $ ag.$2)+ "Constant" -> Et $ Tf $ Const (lexeme_Constant ag)+ "Variable" -> Et $ Tf $ Var (lexeme_Variable ag)++putA_T :: Zipper a -> T+putA_T ag = case (getLink ag) of+ IsE e -> Tf $ Nest $ e+ IsT t -> t+ IsF f -> Tf $ f+ Empty -> case (constructor ag) of+ "Plus" -> Tf $ Nest $ Add (putA_E $ ag.$1) (putA_T $ ag.$2)+ "Minus" -> case (getHole ag :: Maybe A) of+ Just (Minus (Constant 0 _) _ _) -> Tf $ Neg (putA_F $ ag.$2)+ otherwise -> Tf $ Nest $ Sub (putA_E $ ag.$1) (putA_T $ ag.$2)+ "Times" -> Mul (putA_T $ ag.$1) (putA_F $ ag.$2)+ "Divide" -> Div (putA_T $ ag.$1) (putA_F $ ag.$2)+ "Constant" -> Tf $ Const (lexeme_Constant ag)+ "Variable" -> Tf $ Var (lexeme_Variable ag)++putA_F :: Zipper a -> F+putA_F ag = case (getLink ag) of+ IsE e -> Nest $ e+ IsT t -> Nest $ Et $ t+ IsF f -> f+ Empty -> case (constructor ag) of+ "Plus" -> Nest $ Add (putA_E $ ag.$1) (putA_T $ ag.$2)+ "Minus" -> case (getHole ag :: Maybe A) of+ Just (Minus (Constant 0 _) _ _) -> Neg (putA_F $ ag.$2)+ otherwise -> Nest $ Sub (putA_E $ ag.$1) (putA_T $ ag.$2)+ "Times" -> Nest $ Et $ Mul (putA_T $ ag.$1) (putA_F $ ag.$2)+ "Divide" -> Nest $ Et $ Div (putA_T $ ag.$1) (putA_F $ ag.$2)+ "Constant" -> Const (lexeme_Constant ag)+ "Variable" -> Var (lexeme_Variable ag)
+ src/Language/Grammars/ZipperAG/Examples/LET/Let_DataTypes_Boilerplate.hs view
@@ -0,0 +1,198 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Language.Grammars.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate where++import Prelude+import Data.Data+import Data.Generics.Zipper+import Language.Grammars.ZipperAG++-- Links, exactly like in Silver+data Link = IsRootC RootC | IsLetC LetC | IsInC InC | IsListC ListC | IsE E | IsT T | IsF F | Empty+ deriving (Show, Data, Typeable)++-- To create the link, only the type of the+-- subtree matters, so this is a simpler,+-- type-based version of constructor+createLink :: Zipper a -> Link+createLink ag = case (getHole ag :: Maybe RootC) of+ Just (e) -> IsRootC e+ _ -> case (getHole ag :: Maybe LetC) of+ Just (t) -> IsLetC t+ _ -> case (getHole ag :: Maybe InC) of+ Just (f) -> IsInC f+ _ -> case (getHole ag :: Maybe ListC) of+ Just (f) -> IsListC f+ _ -> case (getHole ag :: Maybe E) of+ Just (e) -> IsE e+ _ -> case (getHole ag :: Maybe T) of+ Just (t) -> IsT t+ _ -> case (getHole ag :: Maybe F) of+ Just (f) -> IsF f++getLink :: Zipper a -> Link+getLink ag = case (getHole ag :: Maybe RootA) of+ Just (RootA _ link) -> link+ _ -> case (getHole ag :: Maybe LetA) of+ Just (LetA _ _ link) -> link+ _ -> case (getHole ag :: Maybe InA) of+ Just (InA _ link) -> link+ _ -> case (getHole ag :: Maybe ListA) of+ Just (ConsLetA _ _ _ link ) -> link+ Just (ConsAssignA _ _ _ link) -> link+ Just (EmptyListA link ) -> link+ _ -> case (getHole ag :: Maybe A) of+ Just (Plus _ _ link ) -> link+ Just (Minus _ _ link ) -> link+ Just (Time _ _ link ) -> link+ Just (Divide _ _ link) -> link+ Just (Constant _ link) -> link+ Just (Variable _ link) -> link++-- Concrete data type+data RootC = RootC LetC+ deriving (Show, Data, Typeable)++data LetC = LetC ListC InC+ deriving (Show, Data, Typeable)++data InC = InC E+ deriving (Show, Data, Typeable)++data ListC = ConsLetC String LetC ListC+ | ConsAssignC String E ListC+ | EmptyListC+ deriving (Show, Data, Typeable)++data E = Add E T+ | Sub E T+ | Et T+ deriving (Show, Data, Typeable)++data T = Mul T F+ | Div T F+ | Tf F+ deriving (Show, Data, Typeable)++data F = Nest E+ | Neg F+ | Var String+ | Const Int+ deriving (Show, Data, Typeable)++-- Abstract data type+data RootA = RootA LetA Link+ deriving (Show, Data, Typeable)++data LetA = LetA ListA InA Link+ deriving (Show, Data, Typeable)++data InA = InA A Link+ deriving (Show, Data, Typeable)++data ListA = ConsLetA String LetA ListA Link+ | ConsAssignA String A ListA Link+ | EmptyListA Link+ deriving (Show, Data, Typeable)++data A = Plus A A Link+ | Minus A A Link+ | Time A A Link+ | Divide A A Link+ | Variable String Link+ | Constant Int Link+ deriving (Show, Data, Typeable)++-- Ags Boilerplate Code+lexeme_ConsAssignC :: Zipper a -> String+lexeme_ConsAssignC ag = case (getHole ag :: Maybe ListC) of+ Just(ConsAssignC v _ _) -> v+ _ -> error "Error in lexeme_ConsAssignC!"++lexeme_InA :: Zipper a -> A+lexeme_InA ag = case (getHole ag :: Maybe InA) of+ Just (InA a _) -> a++lexeme_ConsLetC :: Zipper a -> String+lexeme_ConsLetC ag = case (getHole ag :: Maybe ListC) of+ Just(ConsLetC v _ _) -> v+ _ -> error "Error in lexeme_ConsLetC!"++lexeme_Var :: Zipper a -> String+lexeme_Var ag = case (getHole ag :: Maybe F) of+ Just (Var s) -> s+ _ -> error "Error in lexeme_Var!"++lexeme_Const :: Zipper a -> Int+lexeme_Const ag = case (getHole ag :: Maybe F) of+ 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_Expr :: Zipper a -> A+lexeme_ConsAssignA_Expr ag = case (getHole ag :: Maybe ListA) of+ Just(ConsAssignA _ a _ _) -> a+ _ -> error "Error in lexeme_ConsAssignA_Expr!"++lexeme_ConsLetA :: Zipper a -> String+lexeme_ConsLetA ag = case (getHole ag :: Maybe ListA) of+ Just(ConsLetA v _ _ _) -> v+ _ -> error "Error in lexeme_ConsLetA!"++lexeme_Variable :: Zipper a -> String+lexeme_Variable ag = case (getHole ag :: Maybe A) of+ Just (Variable s _) -> s+ _ -> error "Error in lexeme_Variable!"++lexeme_Constant :: Zipper a -> Int+lexeme_Constant ag = case (getHole ag :: Maybe A) of+ Just (Constant s _) -> s+ _ -> error "Error in lexeme_Constant!"++constructor :: Zipper a -> String+constructor ag = case (getHole ag :: Maybe RootC) of+ Just (RootC _) -> "RootC"+ _ -> case (getHole ag :: Maybe LetC) of+ Just (LetC _ _) -> "LetC"+ _ -> case (getHole ag :: Maybe InC) of+ Just (InC _) -> "InC"+ _ -> case (getHole ag :: Maybe ListC) of+ Just (ConsLetC _ _ _ ) -> "ConsLetC"+ Just (ConsAssignC _ _ _) -> "ConsAssignC"+ Just (EmptyListC ) -> "EmptyListC"+ _ -> case (getHole ag :: Maybe E) of+ Just (Add _ _) -> "Add"+ Just (Sub _ _) -> "Sub"+ Just (Et _ ) -> "Et"+ _ -> case (getHole ag :: Maybe T) of+ Just (Mul _ _) -> "Mul"+ Just (Div _ _) -> "Div"+ Just (Tf _ ) -> "Tf"+ _ -> case (getHole ag :: Maybe F) of+ Just (Nest _) -> "Nest"+ Just (Neg _) -> "Neg"+ Just (Const _) -> "Const"+ Just (Var _) -> "Var"+ _ -> case (getHole ag :: Maybe RootA) of+ Just (RootA _ _) -> "RootA"+ _ -> case (getHole ag :: Maybe LetA) of+ Just (LetA _ _ _) -> "LetA"+ _ -> case (getHole ag :: Maybe InA) of+ Just (InA _ _) -> "InA"+ _ -> case (getHole ag :: Maybe ListA) of+ Just (ConsLetA _ _ _ _ ) -> "ConsLetA"+ Just (ConsAssignA _ _ _ _) -> "ConsAssignA"+ Just (EmptyListA _ ) -> "EmptyListA"+ _ -> case (getHole ag :: Maybe A) of+ Just (Plus _ _ _ ) -> "Plus"+ Just (Minus _ _ _ ) -> "Minus"+ Just (Time _ _ _ ) -> "Time"+ Just (Divide _ _ _) -> "Divide"+ Just (Constant _ _) -> "Constant"+ Just (Variable _ _) -> "Variable"+ _ -> error "Error in constructor!!"+
+ src/Language/Grammars/ZipperAG/Examples/LET/Let_Meaning_HO_NestedST_Circ.hs view
@@ -0,0 +1,234 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Language.Grammars.ZipperAG.Examples.LET.Let_Meaning_HO_NestedST_Circ 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++---- Approach 1: multiple, nested symbol tables+-- Always start searching on the nested symbol table+-- Go up if nothing was found, and so on+-- Similar to how the scope rules work++solve :: Zipper RootA -> Int+solve ag = let ho_st = toZipper (createSTRoot ag)+ in pointFree ho_st isSolved calculate solveSTRoot++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++solveSTRoot :: Zipper RootHO -> Zipper RootHO+solveSTRoot ag = toZipper $ RootHO (solveST $ ag.$1) (lexeme_RootHO ag)++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)+ "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)+ "EmptyListHO" -> EmptyListHO+ "NestedListHO" -> solveST $ ag.$1++calculate :: Zipper RootHO -> Int+calculate ag = case (constructorHO ag) of+ "RootHO" -> calculate $ ag.$2+ "NestedListHO" -> calculate $ ag.$2+ "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++getVarValue :: String -> Zipper RootHO -> Int+getVarValue name ag = case (constructorHO ag) of+ "RootHO" -> auxGetVarValue name ag+ "NestedListHO" -> auxGetVarValue name ag+ _ -> getVarValue name (parent ag)++auxGetVarValue :: String -> Zipper RootHO -> Int+auxGetVarValue name ag = case (constructorHO ag) of+ "RootHO" -> auxGetVarValue name (ag.$1)+ "NestedListHO" -> auxGetVarValue name (ag.$1)+ "ConsVarHO" -> if (lexeme_ConsVarHO_Var ag == name) then (auxGetVarValue name (ag.$2))+ else (auxGetVarValue name (ag.$4))+ "ConsLetHO" -> if (lexeme_ConsLetHO_Var ag == name) then (auxGetVarValue name (ag.$2))+ else (auxGetVarValue name (ag.$4))+ "IsSolved" -> lexeme_IsSolved ag+ "EmptyListHO" -> oneUpGetVarValue name ag++oneUpGetVarValue :: String -> Zipper RootHO -> Int+oneUpGetVarValue name ag = case (constructorHO ag) of+ "NestedListHO" -> getVarValue name (parent ag)+ _ -> oneUpGetVarValue name (parent ag)++isSolved :: Zipper RootHO -> Bool+isSolved ag = case (constructorHO ag) of+ "RootHO" -> (isSolved $ ag.$1) || (isSolved $ ag.$2)+ "NestedListHO" -> isSolved $ ag.$1+ "ConsVarHO" -> (isSolved $ ag.$2) && (isSolved $ ag.$4)+ "ConsLetHO" -> (isSolved $ ag.$2) && (isSolved $ ag.$4)+ "EmptyListHO" -> True+ "IsSolved" -> True+ "NotSolved" -> False+ "Plus" -> (isSolved $ ag.$1) && (isSolved $ ag.$2)+ "Divide" -> (isSolved $ ag.$1) && (isSolved $ ag.$2)+ "Minus" -> (isSolved $ ag.$1) && (isSolved $ ag.$2)+ "Time" -> (isSolved $ ag.$1) && (isSolved $ ag.$2)+ "Variable" -> isVarSolved (lexeme_Variable ag) ag+ "Constant" -> True++isVarSolved :: String -> Zipper RootHO -> Bool+isVarSolved name ag = case (constructorHO ag) of+ "RootHO" -> auxIsVarSolved name ag+ "NestedListHO" -> auxIsVarSolved name ag+ _ -> isVarSolved name (parent ag)++auxIsVarSolved :: String -> Zipper RootHO -> Bool+auxIsVarSolved name ag = case (constructorHO ag) of+ "RootHO" -> auxIsVarSolved name (ag.$1)+ "NestedListHO" -> auxIsVarSolved name (ag.$1)+ "ConsVarHO" -> if (lexeme_ConsVarHO_Var ag == name) then (auxIsVarSolved name (ag.$2))+ else (auxIsVarSolved name (ag.$4))+ "ConsLetHO" -> if (lexeme_ConsLetHO_Var ag == name) then (auxIsVarSolved name (ag.$2))+ else (auxIsVarSolved name (ag.$4))+ "IsSolved" -> True+ "NotSolved" -> False+ "EmptyListHO" -> oneUpIsVarSolved name ag++oneUpIsVarSolved :: String -> Zipper RootHO -> Bool+oneUpIsVarSolved name ag = case (constructorHO ag) of+ "NestedListHO" -> isVarSolved name (parent ag)+ _ -> oneUpIsVarSolved name (parent ag)+++---- Creating the symbol table+createSTRoot :: Zipper RootA -> RootHO+createSTRoot ag = case (constructorHO ag) of+ "RootA" -> RootHO (createST ag) (lexeme_InA ((ag.$1).$2))++createST :: Zipper RootA -> ListHO+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)+ "EmptyListA" -> EmptyListHO++--- Higher-Order Symbol Table+data RootHO = RootHO ListHO A+ deriving (Show, Data, Typeable)++data ListHO = ConsVarHO String IsSolved A ListHO+ | ConsLetHO String IsSolved ListHO ListHO+ | NestedListHO ListHO A+ | EmptyListHO+ deriving (Show, Data, Typeable)++data IsSolved = IsSolved Int | NotSolved+ deriving (Show, Data, Typeable)++lexeme_IsSolved :: Zipper a -> Int+lexeme_IsSolved ag = case (getHole ag :: Maybe IsSolved) of+ Just (IsSolved n) -> n+ _ -> error "Error on lexeme_IsSolved!"++lexeme_RootHO :: Zipper a -> A+lexeme_RootHO ag = case (getHole ag :: Maybe RootHO) of+ Just(RootHO _ a) -> a+ _ -> error "Error on lexeme_RootHO!"++lexeme_ConsVarHO_Var :: Zipper a -> String+lexeme_ConsVarHO_Var ag = case (getHole ag :: Maybe ListHO) of+ Just(ConsVarHO v _ _ _) -> v+ _ -> error "Error on lexeme_ConsVarHO_Var!"++lexeme_ConsVarHO_isSolved :: Zipper a -> IsSolved+lexeme_ConsVarHO_isSolved ag = case (getHole ag :: Maybe ListHO) of+ Just(ConsVarHO _ v _ _) -> v+ _ -> error "Error on lexeme_ConsVarHO_isSolved!"++lexeme_ConsVarHO_A :: Zipper a -> A+lexeme_ConsVarHO_A ag = case (getHole ag :: Maybe ListHO) of+ Just(ConsVarHO _ _ v _) -> v+ _ -> error "Error on lexeme_ConsVarHO_A!"++lexeme_ConsLetHO_Var :: Zipper a -> String+lexeme_ConsLetHO_Var ag = case (getHole ag :: Maybe ListHO) of+ Just(ConsLetHO v _ _ _) -> v+ _ -> error "Error on lexeme_ConsLetHO_Var!"++lexeme_ConsLetHO_isSolved :: Zipper a -> IsSolved+lexeme_ConsLetHO_isSolved ag = case (getHole ag :: Maybe ListHO) of+ Just(ConsLetHO _ v _ _) -> v+ _ -> error "Error on lexeme_ConsLetHO_isSolved!"++lexeme_ConsLetHO_NestedST :: Zipper a -> ListHO+lexeme_ConsLetHO_NestedST ag = case (getHole ag :: Maybe ListHO) of+ Just(ConsLetHO _ _ v _) -> v+ _ -> error "Error on lexeme_ConsLetHO_NestedST!"++lexeme_NestedListHO :: Zipper a -> A+lexeme_NestedListHO ag = case (getHole ag :: Maybe ListHO) of+ Just(NestedListHO _ a) -> a+ _ -> error "Error on lexeme_NestedListHO!"++constructorHO :: Zipper a -> String+constructorHO ag = case (getHole ag :: Maybe RootHO) of+ Just(RootHO _ _) -> "RootHO"+ _ -> case (getHole ag :: Maybe ListHO) of+ Just(ConsVarHO _ _ _ _) -> "ConsVarHO"+ Just(ConsLetHO _ _ _ _) -> "ConsLetHO"+ Just(NestedListHO _ _ ) -> "NestedListHO"+ Just(EmptyListHO ) -> "EmptyListHO"+ _ -> case (getHole ag :: Maybe IsSolved) of+ Just(IsSolved _) -> "IsSolved"+ Just(NotSolved) -> "NotSolved"+ _ -> constructor ag+++++++++++++++++++++++++++++++++++++
+ src/Language/Grammars/ZipperAG/Examples/LET/Let_No_Blocks.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Language.Grammars.ZipperAG.Examples.LET.Let_No_Blocks where++import Data.Generics.Zipper+import Language.Grammars.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate+import Language.Grammars.ZipperAG.Examples.LET.Let_Bidi+import Language.Grammars.ZipperAG++---- Synthesized Attributes ----+dclo :: Zipper RootA -> [String]+dclo ag = case (constructor ag) of+ "RootA" -> dclo $ ag.$1+ "LetA" -> dclo $ ag.$1+ "ConsAssignA" -> dclo $ ag.$3+ "EmptyListA" -> dcli ag++errs :: Zipper RootA -> [String]+errs ag = case (constructor ag) of+ "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)+ "EmptyListA" -> []+ "Plus" -> (errs $ ag.$1) ++ (errs $ ag.$2)+ "Divide" -> (errs $ ag.$1) ++ (errs $ ag.$2)+ "Minus" -> (errs $ ag.$1) ++ (errs $ ag.$2)+ "Time" -> (errs $ ag.$1) ++ (errs $ ag.$2)+ "Variable" -> mBIn (lexeme_Variable ag) (env ag)+ "Constant" -> []++---- Inheritted Attributes ----+dcli :: Zipper RootA -> [String]+dcli ag = case (constructor ag) of+ "RootA" -> []+ _ -> case (constructor $ parent ag) of+ "ConsAssignA" -> (dcli $ parent ag) ++ [lexeme_ConsAssignA $ parent ag]+ _ -> dcli $ parent ag++env :: Zipper RootA -> [String]+env ag = case (constructor ag) of+ "RootA" -> dclo ag+ _ -> env $ parent ag++{- Environment lookup functions -}+mBIn :: String -> [String] -> [String]+mBIn name [] = [name]+mBIn name (n:es) = if (n==name) then [] else mBIn name es++mNBIn :: String -> [String] -> [String]+mNBIn tuple [] = [] +mNBIn a1 (a2:es) = if (a1==a2) then [a1] else mNBIn a1 es++test_scope_no_block_rules p = errs $ toZipper (getRootC_RootA $ toZipper p)+
+ src/Language/Grammars/ZipperAG/Examples/LET/Let_Scope.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Language.Grammars.ZipperAG.Examples.LET.Let_Scope where++import Data.Generics.Zipper+import Language.Grammars.ZipperAG+import Language.Grammars.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate++---- Synthesized Attributes ----+dclo :: Zipper RootA -> [(String, Zipper RootA)]+dclo ag = case (constructor ag) of+ "RootA" -> dclo $ ag.$1+ "LetA" -> dclo $ ag.$1+ "ConsLetA" -> dclo $ ag.$3+ "ConsAssignA" -> dclo $ ag.$3+ "EmptyListA" -> dcli ag++errs :: Zipper RootA -> [String]+errs ag = case (constructor ag) of+ "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)+ "EmptyListA" -> []+ "Plus" -> (errs $ ag.$1) ++ (errs $ ag.$2)+ "Divide" -> (errs $ ag.$1) ++ (errs $ ag.$2)+ "Minus" -> (errs $ ag.$1) ++ (errs $ ag.$2)+ "Time" -> (errs $ ag.$1) ++ (errs $ ag.$2)+ "Variable" -> mBIn (lexeme_Variable ag) (env ag)+ "Constant" -> []++---- Inheritted Attributes ----+dcli :: Zipper RootA -> [(String, Zipper RootA)]+dcli ag = case (constructor ag) of+ "RootA" -> []+ "LetA" -> case (constructor $ parent ag) of+ "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)]+ _ -> dcli $ parent ag++env :: Zipper RootA -> [(String, Zipper RootA)]+env ag = case (constructor ag) of+ "RootA" -> dclo ag+ "LetA" -> case (constructor $ parent ag) of+ "ConsLetA" -> dclo ag+ _ -> env $ parent ag+ -- autocopy, ow yeah+ _ -> env $ parent ag++lev :: Zipper RootA -> Int+lev ag = case (constructor ag) of+ "RootA" -> 0+ "LetA" -> case (constructor $ parent ag) of+ "ConsLetA" -> (lev $ parent ag) + 1+ _ -> 0+ _ -> lev $ parent ag++{- Environment lookup functions -}+mBIn :: String -> [(String, Zipper RootA)] -> [String]+mBIn name [] = [name]+mBIn name ((n,l):es) = if (n==name) then [] else mBIn name es++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+
src/Language/Grammars/ZipperAG/Examples/RepMin.hs view
@@ -7,6 +7,7 @@ import Data.Data import Prelude import Data.Generics.Zipper+import Language.Grammars.ZipperAG data Root = Root Tree deriving (Eq, Ord, Show, Typeable, Data)@@ -25,13 +26,6 @@ Just (Leaf _) -> "Leaf" _ -> case (getHole a :: Maybe Root ) of Just (Root _) -> "Root"---- infix (.$) 7-(.$) :: Zipper a -> Int -> Zipper a-z .$ 1 = fromJust (down' z)-z .$ n = fromJust (right ( z.$(n-1) ))--parent = fromJust.up lexeme :: Zipper Root -> Int lexeme t = let Leaf v = fromJust (getHole t :: Maybe Tree)
src/Language/Grammars/ZipperAG/Examples/SmartParentesis.hs view
@@ -7,6 +7,7 @@ import Prelude import Data.Generics.Zipper import Data.Data+import Language.Grammars.ZipperAG data Root = Root Exp deriving (Eq, Ord, Show, Typeable, Data)@@ -27,22 +28,6 @@ Just (Lit _) -> "Lit" _ -> case (getHole a :: Maybe Root ) of Just (Root _) -> "Root"---- Gives the n'th child-(.$) :: Zipper a -> Int -> Zipper a-z .$ 1 = fromJust (down' z)-z .$ n = fromJust (right ( z.$(n-1) ))---- Tests if z is the n'th sibling-(.|) :: Zipper a -> Int -> Bool-z .| 1 = case (left z) of- Nothing -> False- _ -> True-z .| n = case (left z) of- Nothing -> False- Just x -> z .| (n-1)--parent = fromJust.up lexeme :: Zipper Root -> Int lexeme t = let Lit v = fromJust (getHole t :: Maybe Exp)