ZipperAG 0.9 → 1.0.0

raw patch · 39 files changed

+2458/−2419 lines, 39 filesdep +sybdep ~syzsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: syb

Dependency ranges changed: syz

API changes (from Hackage documentation)

Files

• LICENSE +28/−9
• README +0/−25
• README.md +4/−0
• Setup.hs +0/−2
• ZipperAG.cabal +31/−26
• src/Language/Grammars/ZipperAG.hs +0/−31
• src/Language/Grammars/ZipperAG/Examples/Algol68.hs +0/−114
• src/Language/Grammars/ZipperAG/Examples/BreadthFirst.hs +0/−50
• src/Language/Grammars/ZipperAG/Examples/DESK/DESK.hs +0/−139
• src/Language/Grammars/ZipperAG/Examples/DESK/DESK_HighOrder.hs +0/−182
• src/Language/Grammars/ZipperAG/Examples/DESK/DESK_circular.hs +0/−264
• src/Language/Grammars/ZipperAG/Examples/DESK/DESK_references.hs +0/−143
• src/Language/Grammars/ZipperAG/Examples/HTMLTableFormatter.hs +0/−315
• src/Language/Grammars/ZipperAG/Examples/LET/ExampleLet.hs +0/−155
• src/Language/Grammars/ZipperAG/Examples/LET/Let_Bidi.hs +0/−109
• src/Language/Grammars/ZipperAG/Examples/LET/Let_Circular_Flatening.hs +0/−132
• src/Language/Grammars/ZipperAG/Examples/LET/Let_DataTypes_Boilerplate.hs +0/−209
• src/Language/Grammars/ZipperAG/Examples/LET/Let_Meaning_HO_NestedST_Circ.hs +0/−236
• src/Language/Grammars/ZipperAG/Examples/LET/Let_No_Blocks.hs +0/−55
• src/Language/Grammars/ZipperAG/Examples/LET/Let_Scope.hs +0/−74
• src/Language/Grammars/ZipperAG/Examples/RepMin.hs +0/−56
• src/Language/Grammars/ZipperAG/Examples/SmartParentesis.hs +0/−93
• src/Language/ZipperAG.hs +69/−0
• src/Language/ZipperAG/Examples/Algol68.hs +114/−0
• src/Language/ZipperAG/Examples/BreadthFirst.hs +50/−0
• src/Language/ZipperAG/Examples/DESK/DESK.hs +139/−0
• src/Language/ZipperAG/Examples/DESK/DESK_HighOrder.hs +182/−0
• src/Language/ZipperAG/Examples/DESK/DESK_circular.hs +264/−0
• src/Language/ZipperAG/Examples/DESK/DESK_references.hs +143/−0
• src/Language/ZipperAG/Examples/HTMLTableFormatter.hs +315/−0
• src/Language/ZipperAG/Examples/LET/ExampleLet.hs +155/−0
• src/Language/ZipperAG/Examples/LET/Let_Bidi.hs +109/−0
• src/Language/ZipperAG/Examples/LET/Let_Circular_Flatening.hs +132/−0
• src/Language/ZipperAG/Examples/LET/Let_DataTypes_Boilerplate.hs +209/−0
• src/Language/ZipperAG/Examples/LET/Let_Meaning_HO_NestedST_Circ.hs +236/−0
• src/Language/ZipperAG/Examples/LET/Let_No_Blocks.hs +55/−0
• src/Language/ZipperAG/Examples/LET/Let_Scope.hs +74/−0
• src/Language/ZipperAG/Examples/RepMin.hs +56/−0
• src/Language/ZipperAG/Examples/SmartParentesis.hs +93/−0

@@ -1,9 +1,28 @@-Copyright (c) 2013, Pedro Martins-All rights reserved.--Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:--Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.-Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.-Neither the name of the <ORGANIZATION> nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+BSD 3-Clause License
+
+Copyright (c) 2025, José Nuno Macedo
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this
+   list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright notice,
+   this list of conditions and the following disclaimer in the documentation
+   and/or other materials provided with the distribution.
+
+3. Neither the name of the copyright holder nor the names of its
+   contributors may be used to endorse or promote products derived from
+   this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -1,25 +0,0 @@-This source code complements the paper-Zipper-based Attribute Grammars and their Extensions. Pedro Martins, João Paulo Fernandes and João Saraiva. In the proceedings of the 17th Brazilian Symposium on Programming Languages (SBLP’13), September 29 - October 4, Brasilia, Brasil. LNCS--To run all the examples, the Scrap Your Zipper Haskell (syz) package-is necessary, which can be easily installed with:--$ cabal install syz--The examples run with:--$ghci (name_of_file)--To run the AGs, one must write in ghci:--for the files DESK*-$ semantics program--for the file HTMLTableFormatter.hs-$ semantics table--for the file RepMin.hs-$ semantics tree--for the file SmartParentesis.hs-$ semantics expr

@@ -0,0 +1,4 @@+This source code complements the paper
+**Zipper-based Attribute Grammars and their Extensions.** 
+Pedro Martins, João Paulo Fernandes and João Saraiva. 
+In the *Proceedings of the 17th Brazilian Symposium on Programming Languages (SBLP’13), September 29 - October 4, Brasilia, Brasil. LNCS*

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,37 +1,42 @@+Cabal-Version: 3.0 Name:		   ZipperAG-Version:	   0.9-Cabal-Version: >= 1.6-License:	   BSD3-Author:		   Pedro Martins <pedromartins4@gmail.com>-Maintainer:    Pedro Martins <pedromartins4@gmail.com>+Version:	   1.0.0+License:	   BSD-3-Clause+Author:		   Pedro Martins <pedromartins4@gmail.com>, José Nuno Macedo <zenunomacedo@gmail.com>+Maintainer:    José Nuno Macedo <zenunomacedo@gmail.com> Homepage:	   www.di.uminho.pt/~prmartins Category:	   Experimental-Synopsis:	   An implementationg of Attribute Grammars using Functional Zippers-Description:   An implementationg of Attribute Grammars using Functional Zippers+Synopsis:	   An implementation of Attribute Grammars using Functional Zippers+Description:   An implementation of Attribute Grammars using Functional Zippers, includes some usage examples. For more information, refer to works such as "Zipper-based Attribute Grammars and their Extensions".  build-type:    Simple Copyright:     Pedro Martins-Extra-source-files: README+Extra-source-files: README.md license-file:  LICENSE +source-repository head+  type:     git+  location: https://github.com/SLE-Laboratory/ZipperAG+ Library-  Build-Depends:	base == 4.*, syz-  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-                    Language.Grammars.ZipperAG.Examples.LET.Let_Circular_Flatening+  Build-Depends:	base == 4.*, syz == 0.2.0.0, syb < 1.0+  default-language: Haskell2010+  Exposed-modules:  Language.ZipperAG,+                    Language.ZipperAG.Examples.Algol68,+                    Language.ZipperAG.Examples.BreadthFirst,+                    Language.ZipperAG.Examples.HTMLTableFormatter,+                    Language.ZipperAG.Examples.RepMin,+                    Language.ZipperAG.Examples.SmartParentesis,+                    Language.ZipperAG.Examples.DESK.DESK_circular,+                    Language.ZipperAG.Examples.DESK.DESK_HighOrder,+                    Language.ZipperAG.Examples.DESK.DESK_references,+                    Language.ZipperAG.Examples.DESK.DESK,+                    Language.ZipperAG.Examples.LET.ExampleLet,+                    Language.ZipperAG.Examples.LET.Let_Bidi,+                    Language.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate,+                    Language.ZipperAG.Examples.LET.Let_Meaning_HO_NestedST_Circ,+                    Language.ZipperAG.Examples.LET.Let_No_Blocks,+                    Language.ZipperAG.Examples.LET.Let_Scope,+                    Language.ZipperAG.Examples.LET.Let_Circular_Flatening   hs-source-dirs:   src   

@@ -1,31 +0,0 @@--- |--- Module      :  ZipperAG--- Copyright   :  2013 Pedro Martins--- License     :  BSD3------ Maintainer  :  Pedro Martins <pedromartins4@gmail.com>--- Stability   :  Experimental--- Portability :  Portable------ Zipper-based AG supporting functions-module Language.Grammars.ZipperAG where--import Data.Generics.Zipper-import Data.Maybe---- |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)

@@ -1,114 +0,0 @@--{-# LANGUAGE DeriveDataTypeable #-}--module Language.Grammars.ZipperAG.Examples.Algol68 where--import Data.Data-import Data.Generics.Zipper-import Data.Maybe-import Language.Grammars.ZipperAG--data Root = Root Its-          deriving (Typeable, Show, Data)--data Its = ConsIts It Its-         | NilIts-       deriving (Show, Typeable, Data)--data It = Decl String-        | Use String-        | Block Its-        deriving (Show, Typeable, Data)--constructor :: (Typeable a) => Zipper a -> String-constructor a = case ( getHole a :: Maybe Its ) of-				 Just (ConsIts _ _) -> "ConsIts"-				 Just (NilIts) -> "NilIts"-				 otherwise -> case ( getHole a :: Maybe It ) of-								Just (Decl _) -> "Decl"-								Just (Use _) -> "Use"-								Just (Block _) -> "Block"-								otherwise -> case ( getHole a :: Maybe Root) of -															Just (Root _) -> "Root"-															otherwise -> error "Naha, that production does not exist!"--value z = case (getHole z :: Maybe It) of-							Just (Use x) -> x-							Just (Decl x) -> x------ Synthesized Attributes -----dclo :: Zipper Root -> [(String, Int)]-dclo z = case (constructor z) of-					"ConsIts" -> dclo $ z.$2-					"NilIts" -> dcli z-					"Use" -> dcli z-					"Decl" -> (value z,lev z) : (dcli z)-					"Block" -> dcli z--errs :: Zipper Root -> [String]-errs z = case (constructor z) of-					"Root" -> errs $ z.$1	-					"NilIts" -> []-					"ConsIts" -> (errs $ z.$1) ++ (errs $ z.$2)-					"Use" -> mBIn (value z) (env z)-					"Decl" -> mNBIn (value z,lev z) (dcli z)-					"Block" -> errs $ z.$1------ Inheritted Attributes -----dcli :: Zipper Root -> [(String, Int)] -dcli z = case (constructor z) of-					"Root" -> []-					"NilIts" -> case (constructor $ parent z) of-									"ConsIts" -> dclo $ (parent z).$1-									"Block" -> env $ parent z-									"Root" -> []-					"ConsIts" -> case (constructor $ parent z) of-									"ConsIts" -> dclo $ (parent z).$1-									"Block" -> env $ parent z-									"Root" -> []-					"Block" -> dcli $ parent z-					"Use" -> dcli $ parent z-					"Decl" -> dcli $ parent z--lev :: Zipper Root -> Int-lev z = case (constructor z) of-				"Root" -> 0-				"NilIts" -> case (constructor $ parent z) of-								"Block" -> (lev $ parent z) + 1-								"ConsIts" -> lev $ parent z-								"Root" -> 0-				"ConsIts" -> case (constructor $ parent z) of-								"Block" -> (lev $ parent z) + 1-								"ConsIts" -> lev $ parent z-								"Root" -> 0-				"Block" -> lev $ parent z-				"Use" -> lev $ parent z-				"Decl" -> lev $ parent z--env :: Zipper Root -> [(String, Int)]-env z = case (constructor z) of-					"NilIts" -> case (constructor $ parent z) of-												"Block" -> dclo z-												"ConsIts" -> env $ parent z-												"Root" -> dclo z-					"ConsIts" -> case (constructor $ parent z) of-												"Block" -> dclo z-												"ConsIts" -> env $ parent z-												"Root" -> dclo z-					"Block" -> env $ parent z-					"Use" -> env $ parent z-					"Decl" -> env $ parent z-					"Root" -> dclo z----program = [Decl "y", Decl "x", Block [Decl "y", Use "y", Use "w"], Decl "x", Use "y"]-block = Block (ConsIts (Decl "x") (ConsIts (Use "y") (ConsIts (Use "w") (NilIts))))-program = ConsIts (Decl "y") (ConsIts (Decl "x") (ConsIts (block) (ConsIts (Decl "x") (ConsIts (Use "y") (NilIts)))))--{- Environment lookup functions -}-mBIn name [] = [name]-mBIn name ((n,l):es) = if (n==name) then [] else mBIn name es--mNBIn tuple [] = [] -mNBIn pair (pl:es) = if pair==pl then [fst pair] else mNBIn pair es--semantics t = errs $ toZipper $ Root t

@@ -1,50 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--module Language.Grammars.ZipperAG.Examples.BreadthFirst where--import Data.Data-import Data.Generics.Zipper-import Data.Maybe-import Debug.Trace-import Language.Grammars.ZipperAG--data Root = Root Tree-	deriving (Show, Typeable, Data)--data Tree = Fork Int Tree Tree | Empty-	deriving (Show, Typeable, Data)--constructor :: (Typeable a) => Zipper a -> String-constructor a = case ( getHole a :: Maybe Root) of-	 				Just (Root _) -> "Root"-	 				_ -> case (getHole a :: Maybe Tree) of-	 						Just (Fork _ _ _) -> "Fork"-	 						Just (Empty) -> "Empty"---- Attributes-slist :: Zipper Root -> [Int]-slist z = case (constructor z) of-			"Fork" -> (head (ilist z) + 1) : (slist $ z.$3)-			"Empty" -> ilist z--replace :: Zipper Root -> Tree-replace z = case (constructor z) of-			"Empty" -> Empty-			"Fork"  -> Fork (head $ ilist z) (replace $ z.$2) (replace $ z.$3)-			"Root" -> replace $ z.$1--ilist :: Zipper Root -> [Int]-ilist z = case (constructor $ parent z) of-			"Root" -> [1] ++ (slist z)-			_ -> case (z.|3) of -- If it is the third child, it is the rightmost one-					True -> slist (fromJust (left z))-					False -> tail (ilist $ parent z)--tree = Fork 4 (Fork 8 Empty Empty) (Fork 2 (Fork 4 Empty Empty) Empty)--semantics = replace $ toZipper (Root tree)-----

@@ -1,139 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--module Language.Grammars.ZipperAG.Examples.DESK.DESK where--import Data.Maybe-import Data.Data-import Prelude-import Data.Generics.Zipper-import Language.Grammars.ZipperAG--data Root = Root Program-			   deriving (Show, Typeable, Data)--data Program = PRINT Expression ConstPart-			   deriving (Show, Typeable, Data)--{- Keeping it simple by just having sums -}-data Expression = Add Expression Factor-				| Fact Factor-			   deriving (Show, Typeable, Data)--data Factor = Name ConstName-			| Number String-			   deriving (Show, Typeable, Data)--data ConstName = Id String-			   deriving (Show, Typeable, Data)-{-----------------------------------------}-data ConstPart = EmptyConstPart-			   | WHERE ConstDefList-			   deriving (Show, Typeable, Data)--data ConstDefList = Comma ConstDefList ConstDef-				  | Def ConstDef-			   deriving (Show, Typeable, Data)--data ConstDef = Equal ConstName String-			   deriving (Show, Typeable, Data)--type SymbolTable = [(String,String)]--constructor :: Zipper Root -> String-constructor a = case ( getHole a :: Maybe Program ) of-				   Just (PRINT _ _) -> "PRINT"-				   otherwise -> case ( getHole a :: Maybe Expression ) of-				   				Just (Add _ _) -> "Add"-				   				Just (Fact _) -> "Fact"-				   				otherwise -> case ( getHole a :: Maybe Factor ) of-				   							 Just (Name _) -> "Name"-				   							 Just (Number _) -> "Number"-				   							 otherwise -> case ( getHole a :: Maybe ConstName ) of-				   										  Just (Id _) -> "Id"-				   										  otherwise -> case ( getHole a :: Maybe ConstPart ) of-				   													   Just (EmptyConstPart) -> "EmptyConstPart"-				   													   Just (WHERE _) -> "WHERE"-				   													   otherwise -> case ( getHole a :: Maybe ConstDefList ) of-				   													   				Just (Comma _ _) -> "Comma"-				   													   				Just (Def _) -> "Def"-				   													   				otherwise -> case ( getHole a :: Maybe ConstDef ) of-				   													   							 Just (Equal _ _) -> "Equal"-				   													   							 otherwise -> case ( getHole a :: Maybe Root) of-				   													   							 	Just (Root _) -> "Root"-				   													   							 	_ -> "That production does not exist!"--lexeme :: Zipper Root -> String-lexeme t = case ( getHole t :: Maybe ConstName ) of-              Just (Id x) -> x-              _ -> case( getHole t :: Maybe ConstDef ) of-                   Just (Equal _ x) -> x-                   _ -> case ( getHole t :: Maybe Factor ) of-                         Just (Number x) -> x------ AG ---------- Inherited ------envi t = case (constructor t) of-			"PRINT" -> envs ( t.$2 )-			_ -> envi (parent t)------ Synthesized -----code :: Zipper Root -> String-code t = case (constructor t) of-			"Root" -> code ( t.$1 )-			"PRINT" -> if ok ( t.$2 )-						then code ( t.$1 ) ++ "PRINT, 0\n" ++ "HALT,  0\n"-						else "HALT,  0\n"-			"Add" -> if (ok ( t.$2 ))-						then code ( t.$1 ) ++ "ADD,   " ++ value ( t.$2 ) ++ "\n"-						else "HALT,  0\n"-			"Fact" -> if (ok ( t.$1 ))-			 		   then "LOAD,  " ++ value ( t.$1 ) ++ "\n"-			 		   else "HALT,  0\n"--value :: Zipper Root -> String-value t = case (constructor t) of-			"Name" -> getValue (name ( t.$1 )) (envi t)-			"Number" -> lexeme t-			"Equal" -> lexeme t--ok :: Zipper Root -> Bool-ok t = case (constructor t) of-		"Name" -> isInST (name ( t.$1 )) (envi t)-		"Number" -> True-		"EmptyConstPart" -> True-		"WHERE" -> ok ( t.$1 )-		"Comma" -> ok ( t.$1 ) && (not (isInST (name ( t.$2 )) (envs ( t.$1 ))) )-		"Def" -> True--name :: Zipper Root -> String-name t = case (constructor t) of-			"Id" -> lexeme t-			"Equal" -> name $ (t.$1)--envs :: Zipper Root -> SymbolTable            -envs t = case (constructor t) of-			"EmptyConstPart" -> []-			"WHERE" -> envs( t.$1 )-			"Comma" -> envs( t.$1 ) ++ [(name ( t.$2 ), value ( t.$2 ))]-			"Def" -> [( name ( t.$1 ), value ( t.$1) )]--{-Semantic Functions-}-isInST :: String -> SymbolTable -> Bool-isInST _ [] = False -isInST c ((a,b):xs) = if (c==a) then True else isInST c xs--getValue :: String -> SymbolTable -> String-getValue c ((a,b):xs) = if (c==a) then b else (getValue c xs)--{---------------Tests---------------}-expr = Add (Add (Fact (Name (Id "x"))) (Name (Id "y"))) (Number "1")-deflst = WHERE (Comma (Def (Equal (Id "x") ("2"))) (Equal (Id "y") ("3")))-program = Root (PRINT expr deflst)----PRINT x + y + 1 WHERE y = 2, x = 3--semantics t = putStrLn ("\n" ++ (code (toZipper t)))---

@@ -1,182 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--module Language.Grammars.ZipperAG.Examples.DESK.DESK_HighOrder where--import Data.Maybe-import Data.Data-import Prelude-import Data.Generics.Zipper-import Language.Grammars.ZipperAG--data Root = Root Program-			   deriving (Show, Typeable, Data)--data Program = PRINT Expression ConstPart-			   deriving (Show, Typeable, Data)--{- Keeping it simple by just having sums -}-data Expression = Add Expression Factor-				| Fact Factor-			   deriving (Show, Typeable, Data)--data Factor = Name ConstName-			| Number String-			   deriving (Show, Typeable, Data)--data ConstName = Id String-			   deriving (Show, Typeable, Data)-{-----------------------------------------}-data ConstPart = EmptyConstPart-			   | WHERE ConstDefList-			   deriving (Show, Typeable, Data)--data ConstDefList = Comma ConstDefList ConstDef-				  | Def ConstDef-			   deriving (Show, Typeable, Data)--data ConstDef = Equal ConstName String-			   deriving (Show, Typeable, Data)---- HO Symbol Table-data SymbolTable = NilST-				 | ConsST Tuple SymbolTable-				 deriving (Show, Typeable, Data)--data Tuple = Tuple String String-		    deriving (Show, Typeable, Data)--constructor :: Zipper Root -> String-constructor a = case ( getHole a :: Maybe Program ) of-				   Just (PRINT _ _) -> "PRINT"-				   otherwise -> case ( getHole a :: Maybe Expression ) of-				   				Just (Add _ _) -> "Add"-				   				Just (Fact _) -> "Fact"-				   				otherwise -> case ( getHole a :: Maybe Factor ) of-				   							 Just (Name _) -> "Name"-				   							 Just (Number _) -> "Number"-				   							 otherwise -> case ( getHole a :: Maybe ConstName ) of-				   										  Just (Id _) -> "Id"-				   										  otherwise -> case ( getHole a :: Maybe ConstPart ) of-				   													   Just (EmptyConstPart) -> "EmptyConstPart"-				   													   Just (WHERE _) -> "WHERE"-				   													   otherwise -> case ( getHole a :: Maybe ConstDefList ) of-				   													   				Just (Comma _ _) -> "Comma"-				   													   				Just (Def _) -> "Def"-				   													   				otherwise -> case ( getHole a :: Maybe ConstDef ) of-				   													   							 Just (Equal _ _) -> "Equal"-				   													   							 otherwise -> case ( getHole a :: Maybe Root) of-				   													   							 	Just (Root _) -> "Root"-				   													   							 	_ -> "That production does not exist!"--constructor_HO :: Zipper Root_HO -> String-constructor_HO a = case ( getHole a :: Maybe SymbolTable) of-					Just (NilST) -> "NilST"-					Just (ConsST _ _) -> "ConsST"-					otherwise -> case ( getHole a :: Maybe Tuple) of-									Just (Tuple _ _) -> "Tuple"-									otherwise -> case ( getHole a :: Maybe Root_HO ) of-													Just (Root_HO _) -> "Root_HO"-													_ -> error "Ups!!"--lexeme :: Zipper Root -> String-lexeme t = case ( getHole t :: Maybe ConstName ) of-              Just (Id x) -> x-              _ -> case( getHole t :: Maybe ConstDef ) of-                   Just (Equal _ x) -> x-                   _ -> case ( getHole t :: Maybe Factor ) of-                         Just (Number x) -> x------- AG ---------- Inherited ------envi :: Zipper Root -> SymbolTable-envi t = case (constructor t) of-			"PRINT" -> envs ( t.$2 )-			_ -> envi (parent t)------ Synthesized -----code :: Zipper Root -> String-code t = case (constructor t) of-			"Root" -> code ( t.$1 )-			"PRINT" -> if ok ( t.$2 )-						then code ( t.$1 ) ++ "PRINT, 0\n" ++ "HALT,  0\n"-						else "HALT,  0\n"-			"Add" -> if (ok ( t.$2 ))-						then code ( t.$1 ) ++ "ADD,   " ++ value ( t.$2 ) ++ "\n"-						else "HALT,  0\n"-			"Fact" -> if (ok ( t.$1 ))-			 		   then "LOAD,  " ++ value ( t.$1 ) ++ "\n"-			 		   else "HALT,  0\n"--value :: Zipper Root -> String-value t = case (constructor t) of-			"Name" -> getValue (name $ t.$1 ) (toZipper ( Root_HO (envi t)  ))-			"Number" -> lexeme t-			"Equal" -> lexeme t--ok :: Zipper Root -> Bool-ok t = case (constructor t) of-       "Name" -> isInST (name $ t.$1) (toZipper (Root_HO (envi t) ))-       "Number" -> True-       "EmptyConstPart" -> True-       "WHERE" -> ok ( t.$1 )-       "Comma" -> ok ( t.$1 ) && (not (isInST (name $ t.$2) (toZipper ( Root_HO (envs $ t.$1) ) ) ) )-       "Def" -> True--name :: Zipper Root -> String-name t = case (constructor t) of-			"Id" -> lexeme t-			"Equal" -> name ( t.$1 )--envs :: Zipper Root -> SymbolTable-envs t = case (constructor t) of-			"EmptyConstPart" -> NilST-			"WHERE" -> envs( t.$1 )-			"Comma" -> ConsST (Tuple (name $ t.$2) (value $ t.$2) ) (envs $ t.$1)-			"Def"   -> ConsST (Tuple (name $ t.$1) (value $ t.$1) ) NilST--{- High Order Symbol Table -}--data Root_HO = Root_HO SymbolTable-			 deriving (Data, Show, Typeable)--lexeme_Tuple_name :: Zipper Root_HO -> String-lexeme_Tuple_name z = case ( getHole z :: Maybe Tuple ) of-						Just(Tuple a b) -> a--lexeme_Tuple_value :: Zipper Root_HO -> String-lexeme_Tuple_value z = case ( getHole z :: Maybe Tuple ) of-						Just(Tuple a b) -> b--isInST :: String -> Zipper Root_HO -> Bool-isInST name z = case (constructor_HO z) of-                 "Root_HO" -> isInST name (z.$1)-                 "NilST"   -> False-                 "ConsST"  -> (isInST name (z.$1)) || (isInST name (z.$2))-                 "Tuple"   -> lexeme_Tuple_name z == name---- It won't ever happen to ask for the getValue Attr when it--- does not exist, because we have tested it before with the Attr ok-getValue :: String -> Zipper Root_HO -> String-getValue name z = case (constructor_HO z) of-				    "Root_HO" -> getValue name (z.$1)-				    "ConsST" -> if   ((lexeme_Tuple_name (z.$1)) == (name)) -							    then (lexeme_Tuple_value $ z.$1) -							    else (getValue name (z.$2))--{---------------Tests---------------}--expr = Add (Add (Fact (Name (Id "x"))) (Name (Id "y"))) (Number "1")-deflst = WHERE (Comma (Def (Equal (Id "x") ("2"))) (Equal (Id "y") ("3")))-program = Root (PRINT expr deflst)----PRINT x + y + 1 WHERE y = 2, x = 3--semantics t = putStrLn ("\n" ++ (code (toZipper t)))------

@@ -1,264 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--module Language.Grammars.ZipperAG.Examples.DESK.DESK_circular where--import Data.Maybe-import Data.Data-import Prelude-import Data.Generics.Zipper-import Language.Grammars.ZipperAG--data Root = Root Program-			   deriving (Show, Typeable, Data)--data Program = PRINT Expression ConstPart-			   deriving (Show, Typeable, Data)--{- Keeping it simple by just having sums -}-data Expression = Add Expression Factor-				| Fact Factor-			   deriving (Show, Typeable, Data)--data Factor = Name ConstName-			| Number Int-			   deriving (Show, Typeable, Data)--data ConstName = Id String-			   deriving (Show, Typeable, Data)-{-----------------------------------------}-data ConstPart = EmptyConstPart-			   | WHERE ConstDefList-			   deriving (Show, Typeable, Data)--data ConstDefList = Comma ConstDefList ConstDef-				  | Def ConstDef-			   deriving (Show, Typeable, Data)--data ConstDef = EqualInt    ConstName Int-              | EqualString ConstName String-			   deriving (Show, Typeable, Data)------ AG --------- Inherited -------- Defined as autocopy in Silver-envi :: Zipper Root -> Zipper Root_HO-envi t = case (constructor t) of-			"PRINT"  -> let h_o = toZipper (Root_HO (envs $ t.$2) )-			            in  solve h_o-			autocopy -> envi (parent t)------ Synthesized -----code :: Zipper Root -> String-code t = case (constructor t) of-			"Root"  -> code ( t.$1 )-			"PRINT" -> if ok ( t.$2 )-						then code ( t.$1 ) ++ "PRINT, 0\n" ++ "HALT,  0\n"-						else "HALT,  0\n"-			"Add"   -> if (ok ( t.$2 ))-						then code ( t.$1 ) ++ "ADD,   " ++ show (value ( t.$2 )) ++ "\n"-						else "HALT,  0\n"-			"Fact"  -> if (ok ( t.$1 ))-			 		   then "LOAD,  " ++ show (value ( t.$1 )) ++ "\n"-			 		   else "HALT,  0\n"--value :: Zipper Root -> Int-value t = case (constructor t) of-			"Name"   -> getValue (name $ t.$1) (envi t)-			"Number" -> lexeme_Number t--ok :: Zipper Root -> Bool-ok t = case (constructor t) of-		"Name"           -> isInST (name $ t.$1) (envi t)-		"Number"         -> True-		"EmptyConstPart" -> True-		"WHERE"          -> ok ( t.$1 )-		"Comma"          -> ok ( t.$1 ) && not ( isInST (name $ t.$2) (toZipper ( Root_HO (envs $ t.$1)) ) )-		"Def"            -> True--name :: Zipper Root -> String-name t = case (constructor t) of-			"Id"          -> lexeme_Id t-			"EqualInt"    -> name ( t.$1 )-			"EqualString" -> name ( t.$1 )--envs :: Zipper Root -> SymbolTable            -envs t = case (constructor t) of-			"EmptyConstPart" -> NilST-			"WHERE"          -> envs( t.$1 )-			"Comma"          -> ConsST (extract $ t.$2) (envs $ t.$1)-			"Def"            -> ConsST (extract $ t.$1) NilST--extract :: Zipper Root -> Tuple-extract t = case (constructor t) of-			"EqualInt"    -> TupleInt    (name $ t.$1) (lexeme_Equal_Int t)-			"EqualString" -> TupleString (name $ t.$1) (lexeme_Equal_String t)--{- High Order Symbol Table -}-data Root_HO = Root_HO SymbolTable-			 deriving (Data, Show, Typeable)--data SymbolTable = NilST-				 | ConsST Tuple SymbolTable-				 deriving (Show, Typeable, Data)--data Tuple = TupleInt    String Int-           | TupleString String String-		     deriving (Show, Typeable, Data)---- The Attr isInST depends on the Attr solve, which means it will never--- work with an unsolved symbol table---isInST :: String -> Zipper a -> Bool-isInST :: String -> Zipper Root_HO -> Bool-isInST var z = case (constructor_HO z) of-			    "Root_HO"     -> isInST var (z.$1)-			    "NilST"       -> False-			    "ConsST"      -> (isInST var (z.$1)) || (isInST var (z.$2))-			    "TupleInt"    -> lexeme_Tuple_name z == var-			    "TupleString" -> lexeme_Tuple_name z == var---- The Attr isInST depends on the Attr solve, which means it will never--- work with an unsolved symbol table			--- We'll never ask for the getValue Attr if it does not--- exist, because we have tested it before with the Attr ok-getValue :: String -> Zipper Root_HO -> Int-getValue var z = case (constructor_HO z) of-				  "Root_HO" -> getValue var (z.$1)-				  "ConsST"  -> if   (lexeme_Tuple_name $ z.$1) == var -							   then (lexeme_Tuple_Int_Value $ z.$1) -							   else getValue (var) (z.$2)---- circular attribute-solve :: Zipper Root_HO -> Zipper Root_HO-solve z = case (constructor_HO z) of -          "Root_HO" -> if   (isSolved z)-                       then z-                       else solve $ toZipper ( Root_HO (auxSolve $ z.$1))-          autocopy  -> solve $ parent z--auxSolve :: Zipper Root_HO -> SymbolTable-auxSolve z = case (constructor_HO z) of-               "Root_HO" -> auxSolve $ z.$1-               "NilST"   -> NilST-               "ConsST"  -> ConsST (check $ z.$1) (auxSolve $ z.$2)--check :: Zipper Root_HO -> Tuple-check z = case (constructor_HO z) of-              "TupleInt"    -> lexeme_Tuple_Int z-              "TupleString" -> apply (solvedSymbols z) (lexeme_Tuple_String z)---- Auxiliary function apply-apply :: [(String, Int)] -> Tuple -> Tuple-apply [] t                                   = t-apply ((a,b):xs) t@(TupleString name assign) = if   (a == assign)-                                               then (TupleInt name b)-                                               else apply xs t---- There are two attributes to get the solved symbols, because--- this way we have the warantee the result comes from a full traverse-solvedSymbols :: Zipper Root_HO -> [(String, Int)]-solvedSymbols z = case (constructor_HO z) of-			"Root_HO" -> auxSolvedSymbols $ z.$1-			autocopy  -> solvedSymbols $ parent z--auxSolvedSymbols :: Zipper Root_HO -> [(String, Int)]-auxSolvedSymbols z = case (constructor_HO z) of-			        "ConsST"      -> auxSolvedSymbols (z.$1) ++ auxSolvedSymbols (z.$2)-			        "NilST"       -> []-			        "TupleInt"    -> [(lexeme_Tuple_name z, lexeme_Tuple_Int_Value z)]-			        "TupleString" -> []---- There are two attributes to see if the symbol table is solved, because--- this way we have the warantee the result comes from a full traverse			-isSolved :: Zipper Root_HO -> Bool-isSolved z = case (constructor_HO z) of-			"Root_HO" -> auxIsSolved $ z.$1-			autocopy  -> isSolved $ parent z--auxIsSolved :: Zipper Root_HO -> Bool-auxIsSolved z = case (constructor_HO z) of-             "Root_HO"     -> auxIsSolved $ z.$1-             "ConsST"      -> (auxIsSolved $ z.$1) && (auxIsSolved $ z.$2)-             "NilST"       -> True-             "TupleInt"    -> True-             "TupleString" -> False-{---------------Tests---------------}--expr    = Add (Add (Fact (Name (Id "x"))) (Name (Id "y"))) (Number 1)-deflst  = WHERE (Comma (Comma (Def ((EqualString (Id "x") "y"))) (EqualInt (Id "z") 2)) (EqualString (Id "y") "z"))-program = Root (PRINT expr deflst)---PRINT x + y + 1 WHERE x = y, z = 2, y = z--semantics t = putStrLn ("\n" ++ (code (toZipper t)))------ -- -- Boilerplate code-constructor :: (Typeable a) => Zipper a -> String-constructor a = case ( getHole a :: Maybe Program ) of-				   Just (PRINT _ _) -> "PRINT"-				   otherwise -> case ( getHole a :: Maybe Expression ) of-				   				Just (Add _ _) -> "Add"-				   				Just (Fact _) -> "Fact"-				   				otherwise -> case ( getHole a :: Maybe Factor ) of-				   							 Just (Name _) -> "Name"-				   							 Just (Number _) -> "Number"-				   							 otherwise -> case ( getHole a :: Maybe ConstName ) of-				   										  Just (Id _) -> "Id"-				   										  otherwise -> case ( getHole a :: Maybe ConstPart ) of-				   													   Just (EmptyConstPart) -> "EmptyConstPart"-				   													   Just (WHERE _) -> "WHERE"-				   													   otherwise -> case ( getHole a :: Maybe ConstDefList ) of-				   													   				Just (Comma _ _) -> "Comma"-				   													   				Just (Def _) -> "Def"-				   													   				otherwise -> case ( getHole a :: Maybe ConstDef ) of-				   													   							 Just (EqualInt    _ _) -> "EqualInt"-				   													   							 Just (EqualString _ _) -> "EqualString"-				   													   							 otherwise -> case ( getHole a :: Maybe Root) of-				   													   							 	Just (Root _) -> "Root"-				   													   							 	_ -> "That production does not exist!"---lexeme_Id t = case ( getHole t :: Maybe ConstName ) of-					Just (Id x) -> x--lexeme_Number t = case ( getHole t :: Maybe Factor ) of-					Just (Number x) -> x--lexeme_Equal_Int t = case ( getHole t :: Maybe ConstDef ) of-						Just (EqualInt _ x) -> x--lexeme_Equal_String t = case ( getHole t :: Maybe ConstDef ) of-						Just (EqualString _ x) -> x---- boilerplate code for the high order attr-constructor_HO :: (Typeable a) => Zipper a -> String-constructor_HO a = case ( getHole a :: Maybe SymbolTable) of-					Just (NilST) -> "NilST"-					Just (ConsST _ _) -> "ConsST"-					otherwise -> case ( getHole a :: Maybe Tuple) of-									Just (TupleInt    _ _) -> "TupleInt"-									Just (TupleString _ _) -> "TupleString"-									otherwise -> case ( getHole a :: Maybe Root_HO ) of-													Just (Root_HO _) -> "Root_HO"-													_ -> error "Ups!!"--lexeme_Root z = case ( getHole z :: Maybe Root_HO ) of-						Just(Root_HO a) -> a-													-lexeme_Tuple_name z = case ( getHole z :: Maybe Tuple ) of-						Just(TupleInt    a b) -> a-						Just(TupleString a b) -> a--lexeme_Tuple_Int z = case ( getHole z :: Maybe Tuple ) of-						Just(TupleInt a b) -> TupleInt a b-					-lexeme_Tuple_String z = case ( getHole z :: Maybe Tuple ) of-						Just(TupleString a b) -> TupleString a b-						-lexeme_Tuple_Int_Value z = case ( getHole z :: Maybe Tuple ) of-						Just(TupleInt a b) -> b--lexeme_Tuple_String_Value z = case ( getHole z :: Maybe Tuple ) of-						Just(TupleString a b) -> b--

@@ -1,143 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}--module Language.Grammars.ZipperAG.Examples.DESK.DESK_references where--import Data.Maybe-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)--data Program = PRINT Expression ConstPart-			   deriving (Show, Typeable, Data)--{- Keeping it simple by just having sums -}-data Expression = Add Expression Factor-				| Fact Factor-			   deriving (Show, Typeable, Data)--data Factor = Name ConstName-			| Number String-			   deriving (Show, Typeable, Data)--data ConstName = Id String-			   deriving (Show, Typeable, Data)-{-----------------------------------------}-data ConstPart = EmptyConstPart-			   | WHERE ConstDefList-			   deriving (Show, Typeable, Data)--data ConstDefList = Comma ConstDefList ConstDef-				  | Def ConstDef-			   deriving (Show, Typeable, Data)--data ConstDef = Equal ConstName String-			   deriving (Show, Typeable, Data)--type SymbolTable = [(String,Zipper Root)]--constructor :: Zipper Root -> String-constructor a = case ( getHole a :: Maybe Program ) of-				   Just (PRINT _ _) -> "PRINT"-				   otherwise -> case ( getHole a :: Maybe Expression ) of-				   				Just (Add _ _) -> "Add"-				   				Just (Fact _) -> "Fact"-				   				otherwise -> case ( getHole a :: Maybe Factor ) of-				   							 Just (Name _) -> "Name"-				   							 Just (Number _) -> "Number"-				   							 otherwise -> case ( getHole a :: Maybe ConstName ) of-				   										  Just (Id _) -> "Id"-				   										  otherwise -> case ( getHole a :: Maybe ConstPart ) of-				   													   Just (EmptyConstPart) -> "EmptyConstPart"-				   													   Just (WHERE _) -> "WHERE"-				   													   otherwise -> case ( getHole a :: Maybe ConstDefList ) of-				   													   				Just (Comma _ _) -> "Comma"-				   													   				Just (Def _) -> "Def"-				   													   				otherwise -> case ( getHole a :: Maybe ConstDef ) of-				   													   							 Just (Equal _ _) -> "Equal"-				   													   							 otherwise -> case ( getHole a :: Maybe Root) of-				   													   							 	Just (Root _) -> "Root"-				   													   							 	_ -> "That production does not exist!"--lexeme :: Zipper Root -> String-lexeme t = case ( getHole t :: Maybe ConstName ) of-              Just (Id x) -> x-              _ -> case( getHole t :: Maybe ConstDef ) of-                   Just (Equal _ x) -> x-                   _ -> case ( getHole t :: Maybe Factor ) of-                         Just (Number x) -> x------- AG ---------- Inherited ------envi :: Zipper Root -> SymbolTable-envi t = case (constructor t) of-			"PRINT" -> envs ( t.$2 )-			_ -> envi (parent t)------ Synthesized -----code :: Zipper Root -> String-code t = case (constructor t) of-			"Root" -> code ( t.$1 )-			"PRINT" -> if ok ( t.$2 )-						then code ( t.$1 ) ++ "PRINT, 0\n" ++ "HALT,  0\n"-						else "HALT,  0\n"-			"Add" -> if (ok ( t.$2 ))-						then code ( t.$1 ) ++ "ADD,   " ++ value ( t.$2 ) ++ "\n"-						else "HALT,  0\n"-			"Fact" -> if (ok ( t.$1 ))-			 		   then "LOAD,  " ++ value ( t.$1 ) ++ "\n"-			 		   else "HALT,  0\n"--value :: Zipper Root -> String                 -value t = case (constructor t) of-			"Name" -> getValue (name ( t.$1 )) (envi t)-			"Number" -> lexeme t-			"Equal" -> lexeme t--ok :: Zipper Root -> Bool                 -ok t = case (constructor t) of-		"Name" -> isInST (name ( t.$1 )) (envi t)-		"Number" -> True-		"EmptyConstPart" -> True-		"WHERE" -> ok ( t.$1 )-		"Comma" -> ok ( t.$1 ) && (not (isInST (name ( t.$2 )) (envs ( t.$1 ))) )-		"Def" -> True--name :: Zipper Root -> String                 -name t = case (constructor t) of-			"Id" -> lexeme t-			"Equal" -> name ( t.$1 )--envs :: Zipper Root -> SymbolTable                 -envs t = case (constructor t) of-			"EmptyConstPart" -> []-			"WHERE" -> envs( t.$1 )-			"Comma" -> envs( t.$1 ) ++ [(name ( t.$2 ), t.$2 )]-			"Def" -> [( name ( t.$1 ), t.$1 )]--{-Semantic Function-}-isInST :: String -> SymbolTable -> Bool-isInST _ [] = False -isInST c ((a,b):xs) = if (c==a) then True else isInST c xs--getValue :: String -> SymbolTable -> String-getValue c ((a,b):xs) = if (c==a) then (value b) else (getValue c xs)--{---------------Tests---------------}--expr = Add (Add (Fact (Name (Id "x"))) (Name (Id "y"))) (Number "1")-deflst = WHERE (Comma (Def (Equal (Id "x") ("2"))) (Equal (Id "y") ("3")))-program = Root (PRINT expr deflst)----PRINT x + y + 1 WHERE y = 2, x = 3--semantics t = putStrLn ("\n" ++ (code (toZipper t)))----

@@ -1,315 +0,0 @@--{-# LANGUAGE DeriveDataTypeable #-}--module Language.Grammars.ZipperAG.Examples.HTMLTableFormatter where--import Data.Data-import Data.Generics.Zipper-import Data.Maybe------ ABSTRACT SYNTAX GRAMMAR -----data R = RootR Table-	deriving (Typeable, Show, Data)--data Table = RootTable Rows-	deriving (Typeable, Show, Data)--data Rows = NoRow-		  | ConsRow Row Rows-	deriving (Typeable, Show, Data)--data Row = OneRow Elems-	deriving (Typeable, Show, Data)--data Elems = NoElem-		   | ConsElem Elem Elems-	deriving (Typeable, Show, Data)--data Elem = TableText String-		  | NestedTable Table-	deriving (Typeable, Show, Data)--constructor :: Zipper R -> String-constructor a = case ( getHole a :: Maybe R ) of-				 Just (RootR _) -> "RootR"-				 otherwise -> case ( getHole a :: Maybe Table ) of-								Just (RootTable _) -> "RootTable"-				   				otherwise -> case ( getHole a :: Maybe Rows ) of-				   							 Just (NoRow) -> "NoRow"-				   							 Just (ConsRow _ _) -> "ConsRow"-				   							 otherwise -> case ( getHole a :: Maybe Row ) of-				   										  Just (OneRow _) -> "OneRow"-				   										  otherwise -> case ( getHole a :: Maybe Elems ) of-				   													   Just (NoElem) -> "NoElem"-				   													   Just (ConsElem _ _) -> "ConsElem"-				   													   otherwise -> case ( getHole a :: Maybe Elem ) of-				   													   				Just (TableText _) -> "TableText"-				   													   				Just (NestedTable _) -> "NestedTable"-				   													   				otherwise -> error "Naha, that production does not exist!"---- Gives the n'th child-(.$) :: 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 .| 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!"---value t = case ( getHole t :: Maybe Elem ) of-				Just (TableText x) -> x-				_ -> error "You should not be asking for that value!"---- ata is used to implement High Order-(.#.) :: Data a => (t -> a) -> t -> Zipper a-highorder_attr .#. zipper = toZipper (highorder_attr zipper) ------ AG --------- Computing the number of elems per row -----n_Syn z = case (constructor z) of-			"RootR" -> n_Syn $ z.$1-			"RootTable" -> maxList ( ns_Syn $ z.$1 )-			"OneRow" -> n_Syn $ z.$1-			"NoElem" -> 0-			"ConsElem" -> 1 + (n_Syn $ z.$2)--ns_Syn z = case (constructor z) of-			"NoRow" -> []-			"ConsRow" -> (n_Syn $ z.$1) : (ns_Syn $ z.$2)------ Passing down the number of elements per row -----ane_Inh z = case (constructor z) of-			"RootTable" -> n_Syn z-			"NoRow" -> case (constructor $ parent z) of-						"RootTable" -> n_Syn $ parent z-						"NoRow" -> ane_Inh $ parent z-						"ConsRow" -> ane_Inh $ parent z-			"ConsRow" -> case (constructor $ parent z) of-							"RootTable" -> n_Syn $ parent z-							"OneRow" -> ane_Inh $ parent z-							"ConsRow" -> ane_Inh $ parent z-			"OneRow" -> ane_Inh $ parent z-			"NoElem" -> case (constructor $ parent z) of-							"OneRow" -> ane_Inh $ parent z-							"ConsElem" -> (ane_Inh $ parent z) - 1-							"NoElem" -> (ane_Inh $ parent z) - 1-			"ConsElem" -> case (constructor $ parent z) of-							"OneRow" -> ane_Inh $ parent z-							"ConsElem" -> (ane_Inh $ parent z) - 1-							"NoElem" -> (ane_Inh $ parent z) - 1------ Constructing the new table -----r2 z = RootR (r2_table $ z.$1)--r2_table z = RootTable (r2_rows $ z.$1)--r2_rows z = case (constructor z) of-				"NoRow" -> NoRow-				"ConsRow" -> ConsRow (r2_row $ z.$1) (r2_rows $ z.$2)--r2_row z = OneRow (r2_elems $ z.$1)--r2_elems z = case (constructor z) of-				"NoElem" -> add_elems (ane_Inh z)-				"ConsElem" -> ConsElem (r2_elem $ z.$1) (r2_elems $ z.$2)--r2_elem z = case (constructor z) of-				"TableText" -> TableText (value z)-				"NestedTable" -> NestedTable (r2_table $ z.$1)------ Computing the minimal height of each construct -----mh_Syn z = case (constructor z) of-			"RootR" -> mh_Syn $ z.$1-			"RootTable" -> mh_Syn $ z.$1-			"NoRow" -> 0-			"ConsRow" -> (mh_Syn $ z.$1) + 1 + (mh_Syn $ z.$2)-			"OneRow" -> mh_Syn $ z.$1-			"ConsElem" -> max (mh_Syn $ z.$1) (mh_Syn $ z.$2)-			"NoElem" -> 0-			"TableText" -> 1-			"NestedTable" -> (mh_Syn $ z.$1 ) + 1------ Computing the minimal width of each construct -----mw_Syn z = case (constructor z) of-			"RootR" -> mw_Syn $ z.$1-			"RootTable" -> lmw_Local z -- Local attr, as defined in LRC-			"TableText" -> length (value z)-			"NestedTable" -> (mw_Syn $ z.$1) + 2--mws_Syn z = case (constructor z) of-				"NoRow" -> []-				"ConsRow" -> eq_zipwith_max (mws_Syn $ z.$1) (mws_Syn $ z.$2)-				"OneRow" -> mws_Syn $ z.$1-				"ConsElem" -> (mw_Syn $ z.$1) : (mws_Syn $ z.$2)-				"NoElem" -> []------ LOCAL ATTRIBUTE -----lmw_Local z = case (constructor z) of-					"RootTable" -> (sumList (mws_Syn $ z.$1)) + (lengthList (mws_Syn $ z.$1)) - 1-					"ConsRow" -> (sumList (aws_Inh z)) + (lengthList (aws_Inh z)) - 1------ Passing down the available heights and widths -----ah_Inh z = case (constructor z) of-			"RootR" -> mh_Syn $ z-			"RootTable" -> case (constructor $ parent z) of-							"RootR" -> ah_Inh $ parent z-							"OneElem" -> ah_Inh $ parent z-							"ConsElem" -> ah_Inh $ parent z-			"ConsElem" ->case (constructor $ parent z) of-							"OneRow" -> mh_Syn z-							"ConsElem" -> ah_Inh $ parent z-			"NoElem" -> case (constructor $ parent z) of-							"OneRow" -> mh_Syn z-							"ConsElem" -> ah_Inh $ parent z-			"TableText" -> ah_Inh $ parent z-			"NestedTable" -> ah_Inh $ parent z--aws_Inh z = case (constructor z) of-				"ConsRow" ->case (constructor $ parent z) of-								"RootTable" -> mws_Syn z-								"ConsRow" -> aws_Inh $ parent z-				"NoRow" -> case (constructor $ parent z) of-								"RootTable" -> mws_Syn z-								"ConsRow" -> aws_Inh $ parent z-				"OneRow" -> aws_Inh $ parent z-				"ConsElem" -> case (constructor $ parent z) of-								"OneRow" -> aws_Inh $ parent z-								"ConsElem" -> tailList (aws_Inh $ parent z)-				"NoElem" -> case (constructor $ parent z) of-								"OneRow" -> aws_Inh $ parent z-								"ConsElem" -> tailList (aws_Inh $ parent z)--aw_Inh z = case (constructor z) of-			"RootR" -> mw_Syn z-			"RootTable" -> case (constructor $ parent z) of-							"RootR" -> ah_Inh $ parent z---							"TableText" -> aw_Inh $ parent z-							"NestedTable" -> aw_Inh $ parent z-			"TableText" -> headList (aws_Inh $ parent z)-			"NestedTable" -> headList (aws_Inh $ parent z)------ Computing Formatted Table -----lines_Syn t = let z = t-			  in case (constructor z) of-					"RootR" -> lines_Syn $ z.$1-					"RootTable" -> (add_sepline (lmw_Local z)) ++ (lines_Syn $ z.$1) ++ (add_sepline (lmw_Local z))-					"NoRow" -> []-					"ConsRow" -> add_sep_line (lmw_Local z) (lines_Syn $ z.$1) (lines_Syn $ z.$2)-					"OneRow" -> add_border_line (lines_Syn $ z.$1)-					"NoElem" -> []-					"ConsElem" -> let ag = addglue (aw_Inh $ z.$1) (mw_Syn $ z.$1) (ah_Inh $ z.$1) (mh_Syn $ z.$1) (lines_Syn $ z.$1) ("align")-								  in eq_zipwith_cat ag (lines_Syn $ z.$2)-					"TableText" -> value z : []-					"NestedTable" -> lines_Syn $ z.$1------ Semantics Functions -----sumList = sum--lengthList = length--eq_zeros = []--eq_zipwith_max :: [Int] -> [Int] -> [Int]-eq_zipwith_max [] l2 = l2-eq_zipwith_max l1 [] = l1-eq_zipwith_max (l1:l1s) (l2:l2s) = (max l1 l2) : (eq_zipwith_max l1s l2s)--maxList :: [Int] -> Int-maxList [] = 0-maxList (x:xs) = max x (maxList xs)--headList :: [Int] -> Int-headList [] = 0-headList (x:xs) = x--tailList :: [a] -> [a]-tailList [] = []-tailList (x:xs) = xs--eq_zipwith_cat :: [String] -> [String] -> [String]-eq_zipwith_cat l1 [] = l1-eq_zipwith_cat [] l2 = l2-eq_zipwith_cat (l11:l11s) (l22:l22s) = (l11 ++ "|" ++ l22) : (eq_zipwith_cat l11s l22s)--add_border_line :: [String] -> [String]-add_border_line [] = []-add_border_line (x:xs) = ("|" ++ x ++ "|") : (add_border_line xs)----add_noborder_line :: [String] -> [String]--addglue :: Int -> Int -> Int -> Int -> [String] -> String -> [String]-addglue aw mw ah mh lineS a = (glue_horizontal aw mw lineS a) ++ (glue_vertical_new (ah-mh) (add_vertical aw))--glue_horizontal :: Int -> Int -> [String] -> String -> [String]-glue_horizontal _ _ [] _ = []-glue_horizontal aw mw (l:ls) a = (add_hor l (aw-mw) a) : (glue_horizontal aw mw ls a)--add_hor :: String -> Int -> String -> String-add_hor l aw "left" = l ++ (hor_spaces aw)-add_hor l aw "right" = (hor_spaces aw) ++ l-add_hor l aw "center" = let y = (div aw 2)-						in (hor_spaces y) ++ l ++ (hor_spaces y)-add_hor l aw _ = l ++ (hor_spaces aw)--hor_spaces :: Int -> String-hor_spaces i = if (i <= 0) then "" else (repeatChar ' ' i)--glue_vertical_new :: Int -> [String] -> [String]-glue_vertical_new n l = if (n <= 0) then [] else l ++ (glue_vertical_new (n-1) l)--add_vertical :: Int -> [String]-add_vertical aw = if (aw <= 0) then [] else (repeatChar ' ' aw) : []--add_sepline :: Int -> [String]-add_sepline aw = if (aw <= 0)-				then []-				else ["|" ++ (repeatChar '-' aw) ++ "|"]--add_sep_line :: Int -> [String] -> [String] -> [String]-add_sep_line mw l [] = l-add_sep_line mw l rest = l ++ (add_sepline mw) ++ rest--add_elems :: Int -> Elems-add_elems 0 = NoElem-add_elems n = ConsElem (TableText " ") (add_elems (n-1))--repeatChar :: Char -> Int -> String-repeatChar _ 0 = []-repeatChar c i = c : (repeatChar c (i-1)) ------ table2nestedtable : Table -> Table------ Tests-nestedtable = RootTable (ConsRow (OneRow (ConsElem (TableText "Some more random text!") (NoElem))) (NoRow))-elem1 = TableText "This is some text on a table!"-elem2 = TableText "And even more random text!"-row1 = ConsRow (OneRow (ConsElem (TableText "This is a big phrase etc etc.") NoElem)) (NoRow)-elem3 = ConsElem (TableText "This is a big phrase just to make sure this HTML AG etc etc.") (NoElem)--table = RootR (RootTable (ConsRow (OneRow (ConsElem (elem1) (ConsElem (NestedTable nestedtable) (NoElem)))) (ConsRow (OneRow (ConsElem (elem2) (elem3))) (row1))))--printTable :: [String] -> String-printTable [] = ""-printTable (x:xs) = x ++ "\n" ++ (printTable xs)--ata z = toZipper (r2 z)--semantics t = putStrLn $ printTable $ lines_Syn $ ata $ (toZipper t)-

@@ -1,155 +0,0 @@--{-# LANGUAGE DeriveDataTypeable #-}--module Language.Grammars.ZipperAG.Examples.LET.ExampleLet where--import Data.Generics.Zipper-import Language.Grammars.ZipperAG--import Language.Grammars.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate-import Language.Grammars.ZipperAG.Examples.LET.Let_No_Blocks-import Language.Grammars.ZipperAG.Examples.LET.Let_Scope-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)--- 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-         c = 8-         w = let  z = a * b-             in   z * b   -         b = (c * 3) - c-     in  c * w - a-a = RootC $-      -- let a = b + 3-      LetC ( ConsAssignC "a" (Add (Et $ Tf $ Var "b") (Tf $ Const 3))-      -- c = 8-           $ ConsAssignC "c" (Et $ Tf $ Const 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"))-                          )-      -- b = (c * 3) - c-           $ ConsAssignC "b" (Sub (Et $ (Mul (Tf $ Var "c") (Const 3))) (Tf $ Var "c"))-      EmptyListC-           )-      -- in  c * w - a-      $ InC (Sub (Et $ Mul (Tf $ Var "c") (Var "w")) (Tf $ Var "a"))--b1 = let c = 1-         a = let b = c-             in  b-     in  a + c-b = RootC $-      -- c = 1-      LetC ( ConsAssignC "c" (Et $ Tf $ Const 1)-      -- a = let b = 7-             $ ConsLetC "a" ( LetC ( ConsAssignC "b" (Et $ Tf $ Var "c") EmptyListC)-      --     in   b-                            $ InC (Et $ Tf $ Var "b")-                            )-             EmptyListC-           )-      -- in  a + c-      $ InC (Add (Et $ Tf $ Var "a") (Tf $ Var "c"))--c1 = let a = 5-         b = a-     in  b-c = RootC $-      -- let a = 5-      LetC ( ConsAssignC "a" (Et $ Tf $ Const 5)-      --     b = a-             $ ConsAssignC "b" (Et $ Tf $ Var "a")-               EmptyListC-           )-      -- in  b-      $ InC (Et $ Tf $ Var "b")--d1 = let a = b+3-         c = 8-         b = c*3 - c-     in  c*5 - a-d = RootC $-      -- let a = b + 3 (19)-      LetC ( ConsAssignC "a" (Add (Et $ Tf $ Var "b") (Tf $ Const 3))-      -- c = 8-           $ ConsAssignC "c" (Et $ Tf $ Const 8)-      -- b = c * 3 - c (16)-           $ ConsAssignC "b" (Sub (Et $ (Mul (Tf $ Var "c") (Const 3))) (Tf $ Var "c"))-      EmptyListC-           )-      -- in  c * 5 - a (21)-      $ InC (Sub (Et $ Mul (Tf $ Var "c") (Const 5)) (Tf $ Var "a"))---- Exemplo de circularidade do Paakki-e1 = let x = y-         y = z-         z = 2-     in  x-e = RootC $-      -- let x = y-      LetC ( ConsAssignC "x" (Et $ Tf $ Var "y")-      -- y = z-           $ ConsAssignC "y" (Et $ Tf $ Var "z")-      -- z = 2-           $ ConsAssignC "z" (Et $ Tf $ Const 2)-      EmptyListC-           )-      -- in  x-      $ InC (Et $ Tf $ Var "x")--f1 = let a = b + 3-         c = 8-         w = let  z = a * b-             in   z * b   -         b = let  c = 1-             in   c + 4-     in  c * w - a-f = RootC $-      -- let a = b + 3-      LetC ( ConsAssignC "a" (Add (Et $ Tf $ Var "b") (Tf $ Const 3))-      -- c = 8-           $ ConsAssignC "c" (Et $ Tf $ Const 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"))-                          )-      -- b = let c = 1-           $ ConsLetC "b" ( LetC ( ConsAssignC "c" (Et $ Tf $ Const 1) EmptyListC)-      --     in  c + 4-                            $ InC (Add (Et $ Tf $ Var "c") (Tf $ Const 4))-                          )-      EmptyListC-           )-      -- in  c * w - a-      $ InC (Sub (Et $ Mul (Tf $ Var "c") (Var "w")) (Tf $ Var "a"))--scope_no_blocks ag = Language.Grammars.ZipperAG.Examples.LET.Let_No_Blocks.test_scope_no_block_rules ag--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----------

@@ -1,109 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--module Language.Grammars.ZipperAG.Examples.LET.Let_Bidi where--import Data.Generics.Zipper-import Language.Grammars.ZipperAG-import Language.Grammars.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate---- 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_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-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)

@@ -1,132 +0,0 @@-{-# 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)------------

@@ -1,209 +0,0 @@--{-# 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!"--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--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_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_2 :: Zipper a -> A-lexeme_ConsAssignA_2 ag = case (getHole ag :: Maybe ListA) of-                              Just(ConsAssignA _ a _ _) -> a-                              _ -> error "Error in lexeme_ConsAssignA_2!"--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-                       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!!"-

@@ -1,236 +0,0 @@--{-# 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-import Language.Grammars.ZipperAG.Examples.LET.Let_Bidi------ 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_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-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--solve_ho_plus_circularity p = solve $ toZipper (getRootC_RootA $ toZipper p)-----------------------------------

@@ -1,55 +0,0 @@-{-# 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_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)-           "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_1 $ 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)-

@@ -1,74 +0,0 @@--{-# 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-import Language.Grammars.ZipperAG.Examples.LET.Let_Bidi------ 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_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)-           "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_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)]-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--test_scope_block_rules p = errs $ toZipper (getRootC_RootA $ toZipper p)-

@@ -1,56 +0,0 @@--{-# LANGUAGE DeriveDataTypeable#-}--module Language.Grammars.ZipperAG.Examples.RepMin where--import Data.Maybe-import Data.Data-import Prelude-import Data.Generics.Zipper-import Language.Grammars.ZipperAG--data Root = Root Tree-       deriving (Eq, Ord, Show, Typeable, Data)--data Tree = Leaf Int-          | Fork Tree Tree-       deriving (Eq, Ord, Show, Typeable, Data)--tree = Root $ Fork (Leaf 1) -             (Fork (Leaf 4)-                   (Leaf 7))--constructor :: Zipper Root -> String-constructor a = case (getHole a :: Maybe Tree) of-				   Just (Fork _ _) -> "Fork"-				   Just (Leaf _) -> "Leaf"-				   _ -> case (getHole a :: Maybe Root ) of-				   			Just (Root _) -> "Root"--lexeme :: Zipper Root -> Int-lexeme t = let Leaf v = fromJust (getHole t :: Maybe Tree)-			      in v------ Inherited -----globmin :: Zipper Root -> Int-globmin t = case constructor t of-							"Root" -> locmin t-							"Leaf" -> globmin $ parent t-							"Fork" -> globmin $ parent t------ Synthesized -----locmin :: Zipper Root -> Int-locmin t =  case constructor t of                   -						  "Root" -> locmin $ t.$1-						  "Leaf" -> lexeme t-						  "Fork" -> min (locmin $ t.$1 ) (locmin $ t.$2 )--replace :: Zipper Root -> Tree-replace t = case constructor t of                   -						  "Root" -> replace ( t.$1 )-						  "Leaf" -> Leaf (globmin t)-						  "Fork" -> Fork (replace $ t.$1 ) (replace $ t.$2 )---semantics :: Root -> Tree-semantics t = replace (toZipper t)

@@ -1,93 +0,0 @@--{-# LANGUAGE DeriveDataTypeable #-}-module Language.Grammars.ZipperAG.Examples.SmartParentesis where--import Data.Maybe-import Data.Data-import Prelude-import Data.Generics.Zipper-import Data.Data-import Language.Grammars.ZipperAG--data Root = Root Exp-	deriving (Eq, Ord, Show, Typeable, Data)--data Exp = Add Exp Exp-         | Mul Exp Exp-         | Div Exp Exp-         | Sub Exp Exp-         | Lit Int-           deriving (Eq, Ord, Show, Typeable, Data)--constructor :: Zipper Root -> String-constructor a = case (getHole a :: Maybe Exp) of-				   Just (Add _ _) -> "Add"-				   Just (Mul _ _) -> "Mul"-				   Just (Div _ _) -> "Div"-				   Just (Sub _ _) -> "Sub"-				   Just (Lit _) -> "Lit"-				   _ -> case (getHole a :: Maybe Root ) of-				   			Just (Root _) -> "Root"--lexeme :: Zipper Root -> Int-lexeme t = let Lit v = fromJust (getHole t :: Maybe Exp)-	      in v------ AG --------- Inherited Attributes -----enclosingOpPrecedence :: Zipper Root -> Int-enclosingOpPrecedence t = case (constructor t) of-							"Root" -> 0-							"Add" -> 1-							"Sub" -> 1-							"Mul" -> 2-							"Div" -> 2--leftOrRight :: Zipper Root -> String-leftOrRight t = case (constructor t) of-							"Root" -> "none"-							"Add" -> case t.|1 of-										True -> "left"-										False -> "right"-							"Sub" -> case t.|1 of-										True -> "left"-										False -> "right"-							"Mul" -> case t.|1 of-										True -> "left"-										False -> "right"-							"Div" -> "left"--bpp :: Zipper Root -> String-bpp t = case (constructor t) of-			  "Root" -> bpp (t.$1)-			  "Lit" -> show (lexeme t)-		  	  "Add" -> if (wrapInParens (enclosingOpPrecedence t) 1 (leftOrRight t) "left") -		  	   			 then "(" ++ (bpp ( t.$1 )) ++ "+" ++ (bpp ( t.$2 )) ++ ")"-		  	   			 else (bpp ( t.$1 )) ++ "+" ++ (bpp ( t.$2 ))-			  "Sub" -> if (wrapInParens (enclosingOpPrecedence t) 1 (leftOrRight t) "left")-		      			 then "(" ++ (bpp ( t.$1 )) ++ "-" ++ (bpp ( t.$2 )) ++ ")"-		      			 else (bpp ( t.$1 )) ++ "-" ++ (bpp ( t.$2 ))-			  "Mul" -> if (wrapInParens (enclosingOpPrecedence t) 2 (leftOrRight t) "left") -		     			 then "(" ++ (bpp ( t.$1 )) ++ "*" ++ (bpp ( t.$2 )) ++ ")"-		      			 else (bpp ( t.$1 )) ++ "*" ++ (bpp ( t.$2 ))-			  "Div" -> if (wrapInParens (enclosingOpPrecedence t) 2 (leftOrRight t) "left") -		      			 then "(" ++ (bpp ( t.$1 )) ++ "/" ++ (bpp ( t.$2 )) ++ ")"-		      			 else (bpp ( t.$1 )) ++ "/" ++ (bpp ( t.$2 ))---- SEMANTIC FUNCTIONS ---wrapInParens enclosingP thisP thisPos opAssoc = (enclosingP > thisP) || ((enclosingP == thisP) && (thisPos /= opAssoc))--{- Simple PrettyPrinting for Exp -}-exp2str :: Exp -> String-exp2str (Add a b) = "(" ++ exp2str(a) ++ " + " ++ exp2str(b) ++ ")"-exp2str (Mul a b) = "(" ++ exp2str(a) ++ " * " ++ exp2str(b) ++ ")"-exp2str (Div a b) = "(" ++ exp2str(a) ++ " / " ++ exp2str(b) ++ ")"-exp2str (Sub a b) = "(" ++ exp2str(a) ++ " - " ++ exp2str(b) ++ ")"-exp2str (Lit f) = show f--{- Tests -}-expr = Root $ Mul (Sub (Div (Lit 5) (Lit 5)) (Lit 10)) (Add (Lit 4) (Lit 5))--semantics z = bpp (toZipper z)--

@@ -0,0 +1,69 @@+{-|
+Module      : ZipperAG
+Description : Zipper-based Attribute Grammars in Haskell 
+Copyright   : (c) Pedro Martins, 2013
+                  José Nuno Macedo, 2020
+License     : BSD3
+Maintainer  : José Nuno Macedo <zenunomacedo@gmail.com>
+Stability   : Experimental
+Portability : Portable
+-}
+module Language.ZipperAG where
+
+import Data.Generics.Zipper
+import Data.Generics.Aliases (mkQ)
+import Data.Maybe
+import Data.Data (Data)
+
+-- |Navigate to the n'th child
+(.$) :: Zipper a -> Int -> Zipper a
+z .$ 1 = fromJust (down' z)
+z .$ n = fromJust (right ( z.$(n-1) ))
+
+-- |Navigate to the parent node
+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 ->  x .| (n-1)
+
+-- |Move N positions to the right on the zipper
+(.$>) :: Zipper a -> Int -> Zipper a
+zipper .$> n = let current = arity zipper
+               in  (parent zipper).$(current+n)
+
+-- |Move N positions to the left on the zipper
+(.$<) :: Zipper a -> Int -> Zipper a
+zipper .$< n = let current = arity zipper
+               in  (parent zipper).$(current-n)
+
+-- |Computes the arity of a zipper node. 
+-- Arity refers to its position amongst its siblings. 
+-- For example, the first sibling, with no nodes to the left, has arity 1. Move to the right once with @.$>1@ and its arity is now 2. 
+arity :: Zipper a -> Int 
+arity m = arity' m 1
+ where arity' :: Zipper a -> Int -> Int
+       arity' m n = case left m of
+                     Nothing  -> n                     
+                     Just m'  -> arity' m' (n+1)
+
+-- |Prepare data for Attribute-Grammar manipulation. Alias for 'toZipper'. 
+mkAG :: Data x => x -> Zipper x
+mkAG = toZipper
+
+-- |compute attribute __f__ of parent of zipper __z__ 
+(.^) :: (Zipper a -> b) -> Zipper a -> b 
+(.^) f z = f $ parent z 
+
+-- |compute attribute __f__ at the root of zipper __z__ 
+(.^^) :: (Zipper a -> b) -> Zipper a -> b
+(.^^) f z = moveQ up (f z) (f.^^) z
+
+-- |compute attribute __f__ of node navigating upwards in zipper __z__. Traverses upwards in the zipper and queries the first node that satisfies __p__
+inherit :: Data n => (n -> Bool) -> (Zipper a -> b) -> Zipper a -> b 
+inherit p f z = if query (mkQ False p) z then f z else (inherit p f).^ z

@@ -0,0 +1,114 @@++{-# LANGUAGE DeriveDataTypeable #-}++module Language.ZipperAG.Examples.Algol68 where++import Data.Data+import Data.Generics.Zipper+import Data.Maybe+import Language.ZipperAG++data Root = Root Its+          deriving (Typeable, Show, Data)++data Its = ConsIts It Its+         | NilIts+       deriving (Show, Typeable, Data)++data It = Decl String+        | Use String+        | Block Its+        deriving (Show, Typeable, Data)++constructor :: (Typeable a) => Zipper a -> String+constructor a = case ( getHole a :: Maybe Its ) of+                 Just (ConsIts _ _) -> "ConsIts"+                 Just (NilIts) -> "NilIts"+                 otherwise -> case ( getHole a :: Maybe It ) of+                                Just (Decl _) -> "Decl"+                                Just (Use _) -> "Use"+                                Just (Block _) -> "Block"+                                otherwise -> case ( getHole a :: Maybe Root) of +                                                            Just (Root _) -> "Root"+                                                            otherwise -> error "Naha, that production does not exist!"++value z = case (getHole z :: Maybe It) of+                            Just (Use x) -> x+                            Just (Decl x) -> x++---- Synthesized Attributes ----+dclo :: Zipper Root -> [(String, Int)]+dclo z = case (constructor z) of+                    "ConsIts" -> dclo $ z.$2+                    "NilIts" -> dcli z+                    "Use" -> dcli z+                    "Decl" -> (value z,lev z) : (dcli z)+                    "Block" -> dcli z++errs :: Zipper Root -> [String]+errs z = case (constructor z) of+                    "Root" -> errs $ z.$1+                    "NilIts" -> []+                    "ConsIts" -> (errs $ z.$1) ++ (errs $ z.$2)+                    "Use" -> mBIn (value z) (env z)+                    "Decl" -> mNBIn (value z,lev z) (dcli z)+                    "Block" -> errs $ z.$1++---- Inheritted Attributes ----+dcli :: Zipper Root -> [(String, Int)] +dcli z = case (constructor z) of+                    "Root" -> []+                    "NilIts" -> case (constructor $ parent z) of+                                    "ConsIts" -> dclo $ (parent z).$1+                                    "Block" -> env $ parent z+                                    "Root" -> []+                    "ConsIts" -> case (constructor $ parent z) of+                                    "ConsIts" -> dclo $ (parent z).$1+                                    "Block" -> env $ parent z+                                    "Root" -> []+                    "Block" -> dcli $ parent z+                    "Use" -> dcli $ parent z+                    "Decl" -> dcli $ parent z++lev :: Zipper Root -> Int+lev z = case (constructor z) of+                "Root" -> 0+                "NilIts" -> case (constructor $ parent z) of+                                "Block" -> (lev $ parent z) + 1+                                "ConsIts" -> lev $ parent z+                                "Root" -> 0+                "ConsIts" -> case (constructor $ parent z) of+                                "Block" -> (lev $ parent z) + 1+                                "ConsIts" -> lev $ parent z+                                "Root" -> 0+                "Block" -> lev $ parent z+                "Use" -> lev $ parent z+                "Decl" -> lev $ parent z++env :: Zipper Root -> [(String, Int)]+env z = case (constructor z) of+                    "NilIts" -> case (constructor $ parent z) of+                                                "Block" -> dclo z+                                                "ConsIts" -> env $ parent z+                                                "Root" -> dclo z+                    "ConsIts" -> case (constructor $ parent z) of+                                                "Block" -> dclo z+                                                "ConsIts" -> env $ parent z+                                                "Root" -> dclo z+                    "Block" -> env $ parent z+                    "Use" -> env $ parent z+                    "Decl" -> env $ parent z+                    "Root" -> dclo z++--program = [Decl "y", Decl "x", Block [Decl "y", Use "y", Use "w"], Decl "x", Use "y"]+block = Block (ConsIts (Decl "x") (ConsIts (Use "y") (ConsIts (Use "w") (NilIts))))+program = ConsIts (Decl "y") (ConsIts (Decl "x") (ConsIts (block) (ConsIts (Decl "x") (ConsIts (Use "y") (NilIts)))))++{- Environment lookup functions -}+mBIn name [] = [name]+mBIn name ((n,l):es) = if (n==name) then [] else mBIn name es++mNBIn tuple [] = [] +mNBIn pair (pl:es) = if pair==pl then [fst pair] else mNBIn pair es++semantics t = errs $ toZipper $ Root t

@@ -0,0 +1,50 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Language.ZipperAG.Examples.BreadthFirst where++import Data.Data+import Data.Generics.Zipper+import Data.Maybe+import Debug.Trace+import Language.ZipperAG++data Root = Root Tree+    deriving (Show, Typeable, Data)++data Tree = Fork Int Tree Tree | Empty+    deriving (Show, Typeable, Data)++constructor :: (Typeable a) => Zipper a -> String+constructor a = case ( getHole a :: Maybe Root) of+                     Just (Root _) -> "Root"+                     _ -> case (getHole a :: Maybe Tree) of+                             Just (Fork _ _ _) -> "Fork"+                             Just (Empty) -> "Empty"++-- Attributes+slist :: Zipper Root -> [Int]+slist z = case (constructor z) of+            "Fork" -> (head (ilist z) + 1) : (slist $ z.$3)+            "Empty" -> ilist z++replace :: Zipper Root -> Tree+replace z = case (constructor z) of+            "Empty" -> Empty+            "Fork"  -> Fork (head $ ilist z) (replace $ z.$2) (replace $ z.$3)+            "Root" -> replace $ z.$1++ilist :: Zipper Root -> [Int]+ilist z = case (constructor $ parent z) of+            "Root" -> [1] ++ (slist z)+            _ -> case (z.|3) of -- If it is the third child, it is the rightmost one+                    True -> slist (fromJust (left z))+                    False -> tail (ilist $ parent z)++tree = Fork 4 (Fork 8 Empty Empty) (Fork 2 (Fork 4 Empty Empty) Empty)++semantics = replace $ toZipper (Root tree)+++++

@@ -0,0 +1,139 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Language.ZipperAG.Examples.DESK.DESK where++import Data.Maybe+import Data.Data+import Prelude+import Data.Generics.Zipper+import Language.ZipperAG++data Root = Root Program+               deriving (Show, Typeable, Data)++data Program = PRINT Expression ConstPart+               deriving (Show, Typeable, Data)++{- Keeping it simple by just having sums -}+data Expression = Add Expression Factor+                | Fact Factor+               deriving (Show, Typeable, Data)++data Factor = Name ConstName+            | Number String+               deriving (Show, Typeable, Data)++data ConstName = Id String+               deriving (Show, Typeable, Data)+{-----------------------------------------}+data ConstPart = EmptyConstPart+               | WHERE ConstDefList+               deriving (Show, Typeable, Data)++data ConstDefList = Comma ConstDefList ConstDef+                  | Def ConstDef+               deriving (Show, Typeable, Data)++data ConstDef = Equal ConstName String+               deriving (Show, Typeable, Data)++type SymbolTable = [(String,String)]++constructor :: Zipper Root -> String+constructor a = case ( getHole a :: Maybe Program ) of+                   Just (PRINT _ _) -> "PRINT"+                   otherwise -> case ( getHole a :: Maybe Expression ) of+                                   Just (Add _ _) -> "Add"+                                   Just (Fact _) -> "Fact"+                                   otherwise -> case ( getHole a :: Maybe Factor ) of+                                                Just (Name _) -> "Name"+                                                Just (Number _) -> "Number"+                                                otherwise -> case ( getHole a :: Maybe ConstName ) of+                                                             Just (Id _) -> "Id"+                                                             otherwise -> case ( getHole a :: Maybe ConstPart ) of+                                                                          Just (EmptyConstPart) -> "EmptyConstPart"+                                                                          Just (WHERE _) -> "WHERE"+                                                                          otherwise -> case ( getHole a :: Maybe ConstDefList ) of+                                                                                          Just (Comma _ _) -> "Comma"+                                                                                          Just (Def _) -> "Def"+                                                                                          otherwise -> case ( getHole a :: Maybe ConstDef ) of+                                                                                                       Just (Equal _ _) -> "Equal"+                                                                                                       otherwise -> case ( getHole a :: Maybe Root) of+                                                                                                           Just (Root _) -> "Root"+                                                                                                           _ -> "That production does not exist!"++lexeme :: Zipper Root -> String+lexeme t = case ( getHole t :: Maybe ConstName ) of+              Just (Id x) -> x+              _ -> case( getHole t :: Maybe ConstDef ) of+                   Just (Equal _ x) -> x+                   _ -> case ( getHole t :: Maybe Factor ) of+                         Just (Number x) -> x++---- AG ----++---- Inherited -----+envi t = case (constructor t) of+            "PRINT" -> envs ( t.$2 )+            _ -> envi (parent t)++---- Synthesized ----+code :: Zipper Root -> String+code t = case (constructor t) of+            "Root" -> code ( t.$1 )+            "PRINT" -> if ok ( t.$2 )+                        then code ( t.$1 ) ++ "PRINT, 0\n" ++ "HALT,  0\n"+                        else "HALT,  0\n"+            "Add" -> if (ok ( t.$2 ))+                        then code ( t.$1 ) ++ "ADD,   " ++ value ( t.$2 ) ++ "\n"+                        else "HALT,  0\n"+            "Fact" -> if (ok ( t.$1 ))+                        then "LOAD,  " ++ value ( t.$1 ) ++ "\n"+                        else "HALT,  0\n"++value :: Zipper Root -> String+value t = case (constructor t) of+            "Name" -> getValue (name ( t.$1 )) (envi t)+            "Number" -> lexeme t+            "Equal" -> lexeme t++ok :: Zipper Root -> Bool+ok t = case (constructor t) of+        "Name" -> isInST (name ( t.$1 )) (envi t)+        "Number" -> True+        "EmptyConstPart" -> True+        "WHERE" -> ok ( t.$1 )+        "Comma" -> ok ( t.$1 ) && (not (isInST (name ( t.$2 )) (envs ( t.$1 ))) )+        "Def" -> True++name :: Zipper Root -> String+name t = case (constructor t) of+            "Id" -> lexeme t+            "Equal" -> name $ (t.$1)++envs :: Zipper Root -> SymbolTable            +envs t = case (constructor t) of+            "EmptyConstPart" -> []+            "WHERE" -> envs( t.$1 )+            "Comma" -> envs( t.$1 ) ++ [(name ( t.$2 ), value ( t.$2 ))]+            "Def" -> [( name ( t.$1 ), value ( t.$1) )]++{-Semantic Functions-}+isInST :: String -> SymbolTable -> Bool+isInST _ [] = False +isInST c ((a,b):xs) = if (c==a) then True else isInST c xs++getValue :: String -> SymbolTable -> String+getValue c ((a,b):xs) = if (c==a) then b else (getValue c xs)++{---------------Tests---------------}+expr = Add (Add (Fact (Name (Id "x"))) (Name (Id "y"))) (Number "1")+deflst = WHERE (Comma (Def (Equal (Id "x") ("2"))) (Equal (Id "y") ("3")))+program = Root (PRINT expr deflst)++--PRINT x + y + 1 WHERE y = 2, x = 3++semantics t = putStrLn ("\n" ++ (code (toZipper t)))+++

@@ -0,0 +1,182 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Language.ZipperAG.Examples.DESK.DESK_HighOrder where++import Data.Maybe+import Data.Data+import Prelude+import Data.Generics.Zipper+import Language.ZipperAG++data Root = Root Program+               deriving (Show, Typeable, Data)++data Program = PRINT Expression ConstPart+               deriving (Show, Typeable, Data)++{- Keeping it simple by just having sums -}+data Expression = Add Expression Factor+                | Fact Factor+               deriving (Show, Typeable, Data)++data Factor = Name ConstName+            | Number String+               deriving (Show, Typeable, Data)++data ConstName = Id String+               deriving (Show, Typeable, Data)+{-----------------------------------------}+data ConstPart = EmptyConstPart+               | WHERE ConstDefList+               deriving (Show, Typeable, Data)++data ConstDefList = Comma ConstDefList ConstDef+                  | Def ConstDef+               deriving (Show, Typeable, Data)++data ConstDef = Equal ConstName String+               deriving (Show, Typeable, Data)++-- HO Symbol Table+data SymbolTable = NilST+                 | ConsST Tuple SymbolTable+                 deriving (Show, Typeable, Data)++data Tuple = Tuple String String+            deriving (Show, Typeable, Data)++constructor :: Zipper Root -> String+constructor a = case ( getHole a :: Maybe Program ) of+                   Just (PRINT _ _) -> "PRINT"+                   otherwise -> case ( getHole a :: Maybe Expression ) of+                                   Just (Add _ _) -> "Add"+                                   Just (Fact _) -> "Fact"+                                   otherwise -> case ( getHole a :: Maybe Factor ) of+                                                Just (Name _) -> "Name"+                                                Just (Number _) -> "Number"+                                                otherwise -> case ( getHole a :: Maybe ConstName ) of+                                                             Just (Id _) -> "Id"+                                                             otherwise -> case ( getHole a :: Maybe ConstPart ) of+                                                                          Just (EmptyConstPart) -> "EmptyConstPart"+                                                                          Just (WHERE _) -> "WHERE"+                                                                          otherwise -> case ( getHole a :: Maybe ConstDefList ) of+                                                                                          Just (Comma _ _) -> "Comma"+                                                                                          Just (Def _) -> "Def"+                                                                                          otherwise -> case ( getHole a :: Maybe ConstDef ) of+                                                                                                       Just (Equal _ _) -> "Equal"+                                                                                                       otherwise -> case ( getHole a :: Maybe Root) of+                                                                                                           Just (Root _) -> "Root"+                                                                                                           _ -> "That production does not exist!"++constructor_HO :: Zipper Root_HO -> String+constructor_HO a = case ( getHole a :: Maybe SymbolTable) of+                    Just (NilST) -> "NilST"+                    Just (ConsST _ _) -> "ConsST"+                    otherwise -> case ( getHole a :: Maybe Tuple) of+                                    Just (Tuple _ _) -> "Tuple"+                                    otherwise -> case ( getHole a :: Maybe Root_HO ) of+                                                    Just (Root_HO _) -> "Root_HO"+                                                    _ -> error "Ups!!"++lexeme :: Zipper Root -> String+lexeme t = case ( getHole t :: Maybe ConstName ) of+              Just (Id x) -> x+              _ -> case( getHole t :: Maybe ConstDef ) of+                   Just (Equal _ x) -> x+                   _ -> case ( getHole t :: Maybe Factor ) of+                         Just (Number x) -> x+++---- AG ----++---- Inherited -----+envi :: Zipper Root -> SymbolTable+envi t = case (constructor t) of+            "PRINT" -> envs ( t.$2 )+            _ -> envi (parent t)++---- Synthesized ----+code :: Zipper Root -> String+code t = case (constructor t) of+            "Root" -> code ( t.$1 )+            "PRINT" -> if ok ( t.$2 )+                        then code ( t.$1 ) ++ "PRINT, 0\n" ++ "HALT,  0\n"+                        else "HALT,  0\n"+            "Add" -> if (ok ( t.$2 ))+                        then code ( t.$1 ) ++ "ADD,   " ++ value ( t.$2 ) ++ "\n"+                        else "HALT,  0\n"+            "Fact" -> if (ok ( t.$1 ))+                        then "LOAD,  " ++ value ( t.$1 ) ++ "\n"+                        else "HALT,  0\n"++value :: Zipper Root -> String+value t = case (constructor t) of+            "Name" -> getValue (name $ t.$1 ) (toZipper ( Root_HO (envi t)  ))+            "Number" -> lexeme t+            "Equal" -> lexeme t++ok :: Zipper Root -> Bool+ok t = case (constructor t) of+       "Name" -> isInST (name $ t.$1) (toZipper (Root_HO (envi t) ))+       "Number" -> True+       "EmptyConstPart" -> True+       "WHERE" -> ok ( t.$1 )+       "Comma" -> ok ( t.$1 ) && (not (isInST (name $ t.$2) (toZipper ( Root_HO (envs $ t.$1) ) ) ) )+       "Def" -> True++name :: Zipper Root -> String+name t = case (constructor t) of+            "Id" -> lexeme t+            "Equal" -> name ( t.$1 )++envs :: Zipper Root -> SymbolTable+envs t = case (constructor t) of+            "EmptyConstPart" -> NilST+            "WHERE" -> envs( t.$1 )+            "Comma" -> ConsST (Tuple (name $ t.$2) (value $ t.$2) ) (envs $ t.$1)+            "Def"   -> ConsST (Tuple (name $ t.$1) (value $ t.$1) ) NilST++{- High Order Symbol Table -}++data Root_HO = Root_HO SymbolTable+             deriving (Data, Show, Typeable)++lexeme_Tuple_name :: Zipper Root_HO -> String+lexeme_Tuple_name z = case ( getHole z :: Maybe Tuple ) of+                        Just(Tuple a b) -> a++lexeme_Tuple_value :: Zipper Root_HO -> String+lexeme_Tuple_value z = case ( getHole z :: Maybe Tuple ) of+                        Just(Tuple a b) -> b++isInST :: String -> Zipper Root_HO -> Bool+isInST name z = case (constructor_HO z) of+                 "Root_HO" -> isInST name (z.$1)+                 "NilST"   -> False+                 "ConsST"  -> (isInST name (z.$1)) || (isInST name (z.$2))+                 "Tuple"   -> lexeme_Tuple_name z == name++-- It won't ever happen to ask for the getValue Attr when it+-- does not exist, because we have tested it before with the Attr ok+getValue :: String -> Zipper Root_HO -> String+getValue name z = case (constructor_HO z) of+                    "Root_HO" -> getValue name (z.$1)+                    "ConsST" -> if   ((lexeme_Tuple_name (z.$1)) == (name)) +                                then (lexeme_Tuple_value $ z.$1) +                                else (getValue name (z.$2))++{---------------Tests---------------}++expr = Add (Add (Fact (Name (Id "x"))) (Name (Id "y"))) (Number "1")+deflst = WHERE (Comma (Def (Equal (Id "x") ("2"))) (Equal (Id "y") ("3")))+program = Root (PRINT expr deflst)++--PRINT x + y + 1 WHERE y = 2, x = 3++semantics t = putStrLn ("\n" ++ (code (toZipper t)))++++++

@@ -0,0 +1,264 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Language.ZipperAG.Examples.DESK.DESK_circular where++import Data.Maybe+import Data.Data+import Prelude+import Data.Generics.Zipper+import Language.ZipperAG++data Root = Root Program+               deriving (Show, Typeable, Data)++data Program = PRINT Expression ConstPart+               deriving (Show, Typeable, Data)++{- Keeping it simple by just having sums -}+data Expression = Add Expression Factor+                | Fact Factor+               deriving (Show, Typeable, Data)++data Factor = Name ConstName+            | Number Int+               deriving (Show, Typeable, Data)++data ConstName = Id String+               deriving (Show, Typeable, Data)+{-----------------------------------------}+data ConstPart = EmptyConstPart+               | WHERE ConstDefList+               deriving (Show, Typeable, Data)++data ConstDefList = Comma ConstDefList ConstDef+                  | Def ConstDef+               deriving (Show, Typeable, Data)++data ConstDef = EqualInt    ConstName Int+              | EqualString ConstName String+               deriving (Show, Typeable, Data)++---- AG ----+---- Inherited -----+-- Defined as autocopy in Silver+envi :: Zipper Root -> Zipper Root_HO+envi t = case (constructor t) of+            "PRINT"  -> let h_o = toZipper (Root_HO (envs $ t.$2) )+                        in  solve h_o+            autocopy -> envi (parent t)++---- Synthesized ----+code :: Zipper Root -> String+code t = case (constructor t) of+            "Root"  -> code ( t.$1 )+            "PRINT" -> if ok ( t.$2 )+                        then code ( t.$1 ) ++ "PRINT, 0\n" ++ "HALT,  0\n"+                        else "HALT,  0\n"+            "Add"   -> if (ok ( t.$2 ))+                        then code ( t.$1 ) ++ "ADD,   " ++ show (value ( t.$2 )) ++ "\n"+                        else "HALT,  0\n"+            "Fact"  -> if (ok ( t.$1 ))+                        then "LOAD,  " ++ show (value ( t.$1 )) ++ "\n"+                        else "HALT,  0\n"++value :: Zipper Root -> Int+value t = case (constructor t) of+            "Name"   -> getValue (name $ t.$1) (envi t)+            "Number" -> lexeme_Number t++ok :: Zipper Root -> Bool+ok t = case (constructor t) of+        "Name"           -> isInST (name $ t.$1) (envi t)+        "Number"         -> True+        "EmptyConstPart" -> True+        "WHERE"          -> ok ( t.$1 )+        "Comma"          -> ok ( t.$1 ) && not ( isInST (name $ t.$2) (toZipper ( Root_HO (envs $ t.$1)) ) )+        "Def"            -> True++name :: Zipper Root -> String+name t = case (constructor t) of+            "Id"          -> lexeme_Id t+            "EqualInt"    -> name ( t.$1 )+            "EqualString" -> name ( t.$1 )++envs :: Zipper Root -> SymbolTable            +envs t = case (constructor t) of+            "EmptyConstPart" -> NilST+            "WHERE"          -> envs( t.$1 )+            "Comma"          -> ConsST (extract $ t.$2) (envs $ t.$1)+            "Def"            -> ConsST (extract $ t.$1) NilST++extract :: Zipper Root -> Tuple+extract t = case (constructor t) of+            "EqualInt"    -> TupleInt    (name $ t.$1) (lexeme_Equal_Int t)+            "EqualString" -> TupleString (name $ t.$1) (lexeme_Equal_String t)++{- High Order Symbol Table -}+data Root_HO = Root_HO SymbolTable+             deriving (Data, Show, Typeable)++data SymbolTable = NilST+                 | ConsST Tuple SymbolTable+                 deriving (Show, Typeable, Data)++data Tuple = TupleInt    String Int+           | TupleString String String+             deriving (Show, Typeable, Data)++-- The Attr isInST depends on the Attr solve, which means it will never+-- work with an unsolved symbol table+--isInST :: String -> Zipper a -> Bool+isInST :: String -> Zipper Root_HO -> Bool+isInST var z = case (constructor_HO z) of+                "Root_HO"     -> isInST var (z.$1)+                "NilST"       -> False+                "ConsST"      -> (isInST var (z.$1)) || (isInST var (z.$2))+                "TupleInt"    -> lexeme_Tuple_name z == var+                "TupleString" -> lexeme_Tuple_name z == var++-- The Attr isInST depends on the Attr solve, which means it will never+-- work with an unsolved symbol table			+-- We'll never ask for the getValue Attr if it does not+-- exist, because we have tested it before with the Attr ok+getValue :: String -> Zipper Root_HO -> Int+getValue var z = case (constructor_HO z) of+                  "Root_HO" -> getValue var (z.$1)+                  "ConsST"  -> if   (lexeme_Tuple_name $ z.$1) == var +                               then (lexeme_Tuple_Int_Value $ z.$1) +                               else getValue (var) (z.$2)++-- circular attribute+solve :: Zipper Root_HO -> Zipper Root_HO+solve z = case (constructor_HO z) of +          "Root_HO" -> if   (isSolved z)+                       then z+                       else solve $ toZipper ( Root_HO (auxSolve $ z.$1))+          autocopy  -> solve $ parent z++auxSolve :: Zipper Root_HO -> SymbolTable+auxSolve z = case (constructor_HO z) of+               "Root_HO" -> auxSolve $ z.$1+               "NilST"   -> NilST+               "ConsST"  -> ConsST (check $ z.$1) (auxSolve $ z.$2)++check :: Zipper Root_HO -> Tuple+check z = case (constructor_HO z) of+              "TupleInt"    -> lexeme_Tuple_Int z+              "TupleString" -> apply (solvedSymbols z) (lexeme_Tuple_String z)++-- Auxiliary function apply+apply :: [(String, Int)] -> Tuple -> Tuple+apply [] t                                   = t+apply ((a,b):xs) t@(TupleString name assign) = if   (a == assign)+                                               then (TupleInt name b)+                                               else apply xs t++-- There are two attributes to get the solved symbols, because+-- this way we have the warantee the result comes from a full traverse+solvedSymbols :: Zipper Root_HO -> [(String, Int)]+solvedSymbols z = case (constructor_HO z) of+            "Root_HO" -> auxSolvedSymbols $ z.$1+            autocopy  -> solvedSymbols $ parent z++auxSolvedSymbols :: Zipper Root_HO -> [(String, Int)]+auxSolvedSymbols z = case (constructor_HO z) of+                    "ConsST"      -> auxSolvedSymbols (z.$1) ++ auxSolvedSymbols (z.$2)+                    "NilST"       -> []+                    "TupleInt"    -> [(lexeme_Tuple_name z, lexeme_Tuple_Int_Value z)]+                    "TupleString" -> []++-- There are two attributes to see if the symbol table is solved, because+-- this way we have the warantee the result comes from a full traverse			+isSolved :: Zipper Root_HO -> Bool+isSolved z = case (constructor_HO z) of+            "Root_HO" -> auxIsSolved $ z.$1+            autocopy  -> isSolved $ parent z++auxIsSolved :: Zipper Root_HO -> Bool+auxIsSolved z = case (constructor_HO z) of+             "Root_HO"     -> auxIsSolved $ z.$1+             "ConsST"      -> (auxIsSolved $ z.$1) && (auxIsSolved $ z.$2)+             "NilST"       -> True+             "TupleInt"    -> True+             "TupleString" -> False+{---------------Tests---------------}++expr    = Add (Add (Fact (Name (Id "x"))) (Name (Id "y"))) (Number 1)+deflst  = WHERE (Comma (Comma (Def ((EqualString (Id "x") "y"))) (EqualInt (Id "z") 2)) (EqualString (Id "y") "z"))+program = Root (PRINT expr deflst)+--PRINT x + y + 1 WHERE x = y, z = 2, y = z++semantics t = putStrLn ("\n" ++ (code (toZipper t)))++++-- -- -- Boilerplate code+constructor :: (Typeable a) => Zipper a -> String+constructor a = case ( getHole a :: Maybe Program ) of+                   Just (PRINT _ _) -> "PRINT"+                   otherwise -> case ( getHole a :: Maybe Expression ) of+                                   Just (Add _ _) -> "Add"+                                   Just (Fact _) -> "Fact"+                                   otherwise -> case ( getHole a :: Maybe Factor ) of+                                                Just (Name _) -> "Name"+                                                Just (Number _) -> "Number"+                                                otherwise -> case ( getHole a :: Maybe ConstName ) of+                                                             Just (Id _) -> "Id"+                                                             otherwise -> case ( getHole a :: Maybe ConstPart ) of+                                                                          Just (EmptyConstPart) -> "EmptyConstPart"+                                                                          Just (WHERE _) -> "WHERE"+                                                                          otherwise -> case ( getHole a :: Maybe ConstDefList ) of+                                                                                          Just (Comma _ _) -> "Comma"+                                                                                          Just (Def _) -> "Def"+                                                                                          otherwise -> case ( getHole a :: Maybe ConstDef ) of+                                                                                                       Just (EqualInt    _ _) -> "EqualInt"+                                                                                                       Just (EqualString _ _) -> "EqualString"+                                                                                                       otherwise -> case ( getHole a :: Maybe Root) of+                                                                                                           Just (Root _) -> "Root"+                                                                                                           _ -> "That production does not exist!"+++lexeme_Id t = case ( getHole t :: Maybe ConstName ) of+                    Just (Id x) -> x++lexeme_Number t = case ( getHole t :: Maybe Factor ) of+                    Just (Number x) -> x++lexeme_Equal_Int t = case ( getHole t :: Maybe ConstDef ) of+                        Just (EqualInt _ x) -> x++lexeme_Equal_String t = case ( getHole t :: Maybe ConstDef ) of+                        Just (EqualString _ x) -> x++-- boilerplate code for the high order attr+constructor_HO :: (Typeable a) => Zipper a -> String+constructor_HO a = case ( getHole a :: Maybe SymbolTable) of+                    Just (NilST) -> "NilST"+                    Just (ConsST _ _) -> "ConsST"+                    otherwise -> case ( getHole a :: Maybe Tuple) of+                                    Just (TupleInt    _ _) -> "TupleInt"+                                    Just (TupleString _ _) -> "TupleString"+                                    otherwise -> case ( getHole a :: Maybe Root_HO ) of+                                                    Just (Root_HO _) -> "Root_HO"+                                                    _ -> error "Ups!!"++lexeme_Root z = case ( getHole z :: Maybe Root_HO ) of+                        Just(Root_HO a) -> a+                                                    +lexeme_Tuple_name z = case ( getHole z :: Maybe Tuple ) of+                        Just(TupleInt    a b) -> a+                        Just(TupleString a b) -> a++lexeme_Tuple_Int z = case ( getHole z :: Maybe Tuple ) of+                        Just(TupleInt a b) -> TupleInt a b+                    +lexeme_Tuple_String z = case ( getHole z :: Maybe Tuple ) of+                        Just(TupleString a b) -> TupleString a b+                        +lexeme_Tuple_Int_Value z = case ( getHole z :: Maybe Tuple ) of+                        Just(TupleInt a b) -> b++lexeme_Tuple_String_Value z = case ( getHole z :: Maybe Tuple ) of+                        Just(TupleString a b) -> b++

@@ -0,0 +1,143 @@+{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}++module Language.ZipperAG.Examples.DESK.DESK_references where++import Data.Maybe+import Data.Data+import Prelude hiding (head, tail, zip)+import Data.Generics.Zipper+import Language.ZipperAG++data Root = Root Program+               deriving (Show, Typeable, Data)++data Program = PRINT Expression ConstPart+               deriving (Show, Typeable, Data)++{- Keeping it simple by just having sums -}+data Expression = Add Expression Factor+                | Fact Factor+               deriving (Show, Typeable, Data)++data Factor = Name ConstName+            | Number String+               deriving (Show, Typeable, Data)++data ConstName = Id String+               deriving (Show, Typeable, Data)+{-----------------------------------------}+data ConstPart = EmptyConstPart+               | WHERE ConstDefList+               deriving (Show, Typeable, Data)++data ConstDefList = Comma ConstDefList ConstDef+                  | Def ConstDef+               deriving (Show, Typeable, Data)++data ConstDef = Equal ConstName String+               deriving (Show, Typeable, Data)++type SymbolTable = [(String,Zipper Root)]++constructor :: Zipper Root -> String+constructor a = case ( getHole a :: Maybe Program ) of+                   Just (PRINT _ _) -> "PRINT"+                   otherwise -> case ( getHole a :: Maybe Expression ) of+                                   Just (Add _ _) -> "Add"+                                   Just (Fact _) -> "Fact"+                                   otherwise -> case ( getHole a :: Maybe Factor ) of+                                                Just (Name _) -> "Name"+                                                Just (Number _) -> "Number"+                                                otherwise -> case ( getHole a :: Maybe ConstName ) of+                                                             Just (Id _) -> "Id"+                                                             otherwise -> case ( getHole a :: Maybe ConstPart ) of+                                                                          Just (EmptyConstPart) -> "EmptyConstPart"+                                                                          Just (WHERE _) -> "WHERE"+                                                                          otherwise -> case ( getHole a :: Maybe ConstDefList ) of+                                                                                          Just (Comma _ _) -> "Comma"+                                                                                          Just (Def _) -> "Def"+                                                                                          otherwise -> case ( getHole a :: Maybe ConstDef ) of+                                                                                                       Just (Equal _ _) -> "Equal"+                                                                                                       otherwise -> case ( getHole a :: Maybe Root) of+                                                                                                           Just (Root _) -> "Root"+                                                                                                           _ -> "That production does not exist!"++lexeme :: Zipper Root -> String+lexeme t = case ( getHole t :: Maybe ConstName ) of+              Just (Id x) -> x+              _ -> case( getHole t :: Maybe ConstDef ) of+                   Just (Equal _ x) -> x+                   _ -> case ( getHole t :: Maybe Factor ) of+                         Just (Number x) -> x+++---- AG ----++---- Inherited -----+envi :: Zipper Root -> SymbolTable+envi t = case (constructor t) of+            "PRINT" -> envs ( t.$2 )+            _ -> envi (parent t)++---- Synthesized ----+code :: Zipper Root -> String+code t = case (constructor t) of+            "Root" -> code ( t.$1 )+            "PRINT" -> if ok ( t.$2 )+                        then code ( t.$1 ) ++ "PRINT, 0\n" ++ "HALT,  0\n"+                        else "HALT,  0\n"+            "Add" -> if (ok ( t.$2 ))+                        then code ( t.$1 ) ++ "ADD,   " ++ value ( t.$2 ) ++ "\n"+                        else "HALT,  0\n"+            "Fact" -> if (ok ( t.$1 ))+                        then "LOAD,  " ++ value ( t.$1 ) ++ "\n"+                        else "HALT,  0\n"++value :: Zipper Root -> String                 +value t = case (constructor t) of+            "Name" -> getValue (name ( t.$1 )) (envi t)+            "Number" -> lexeme t+            "Equal" -> lexeme t++ok :: Zipper Root -> Bool                 +ok t = case (constructor t) of+        "Name" -> isInST (name ( t.$1 )) (envi t)+        "Number" -> True+        "EmptyConstPart" -> True+        "WHERE" -> ok ( t.$1 )+        "Comma" -> ok ( t.$1 ) && (not (isInST (name ( t.$2 )) (envs ( t.$1 ))) )+        "Def" -> True++name :: Zipper Root -> String                 +name t = case (constructor t) of+            "Id" -> lexeme t+            "Equal" -> name ( t.$1 )++envs :: Zipper Root -> SymbolTable                 +envs t = case (constructor t) of+            "EmptyConstPart" -> []+            "WHERE" -> envs( t.$1 )+            "Comma" -> envs( t.$1 ) ++ [(name ( t.$2 ), t.$2 )]+            "Def" -> [( name ( t.$1 ), t.$1 )]++{-Semantic Function-}+isInST :: String -> SymbolTable -> Bool+isInST _ [] = False +isInST c ((a,b):xs) = if (c==a) then True else isInST c xs++getValue :: String -> SymbolTable -> String+getValue c ((a,b):xs) = if (c==a) then (value b) else (getValue c xs)++{---------------Tests---------------}++expr = Add (Add (Fact (Name (Id "x"))) (Name (Id "y"))) (Number "1")+deflst = WHERE (Comma (Def (Equal (Id "x") ("2"))) (Equal (Id "y") ("3")))+program = Root (PRINT expr deflst)++--PRINT x + y + 1 WHERE y = 2, x = 3++semantics t = putStrLn ("\n" ++ (code (toZipper t)))++++

@@ -0,0 +1,315 @@++{-# LANGUAGE DeriveDataTypeable #-}++module Language.ZipperAG.Examples.HTMLTableFormatter where++import Data.Data+import Data.Generics.Zipper+import Data.Maybe++---- ABSTRACT SYNTAX GRAMMAR ----+data R = RootR Table+    deriving (Typeable, Show, Data)++data Table = RootTable Rows+    deriving (Typeable, Show, Data)++data Rows = NoRow+          | ConsRow Row Rows+    deriving (Typeable, Show, Data)++data Row = OneRow Elems+    deriving (Typeable, Show, Data)++data Elems = NoElem+           | ConsElem Elem Elems+    deriving (Typeable, Show, Data)++data Elem = TableText String+          | NestedTable Table+    deriving (Typeable, Show, Data)++constructor :: Zipper R -> String+constructor a = case ( getHole a :: Maybe R ) of+                 Just (RootR _) -> "RootR"+                 otherwise -> case ( getHole a :: Maybe Table ) of+                                Just (RootTable _) -> "RootTable"+                                otherwise -> case ( getHole a :: Maybe Rows ) of+                                                Just (NoRow) -> "NoRow"+                                                Just (ConsRow _ _) -> "ConsRow"+                                                otherwise -> case ( getHole a :: Maybe Row ) of+                                                             Just (OneRow _) -> "OneRow"+                                                             otherwise -> case ( getHole a :: Maybe Elems ) of+                                                                          Just (NoElem) -> "NoElem"+                                                                          Just (ConsElem _ _) -> "ConsElem"+                                                                          otherwise -> case ( getHole a :: Maybe Elem ) of+                                                                                          Just (TableText _) -> "TableText"+                                                                                          Just (NestedTable _) -> "NestedTable"+                                                                                          otherwise -> error "Naha, that production does not exist!"++-- Gives the n'th child+(.$) :: 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 .| 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!"+++value t = case ( getHole t :: Maybe Elem ) of+                Just (TableText x) -> x+                _ -> error "You should not be asking for that value!"++-- ata is used to implement High Order+(.#.) :: Data a => (t -> a) -> t -> Zipper a+highorder_attr .#. zipper = toZipper (highorder_attr zipper) ++---- AG ----+---- Computing the number of elems per row ----+n_Syn z = case (constructor z) of+            "RootR" -> n_Syn $ z.$1+            "RootTable" -> maxList ( ns_Syn $ z.$1 )+            "OneRow" -> n_Syn $ z.$1+            "NoElem" -> 0+            "ConsElem" -> 1 + (n_Syn $ z.$2)++ns_Syn z = case (constructor z) of+            "NoRow" -> []+            "ConsRow" -> (n_Syn $ z.$1) : (ns_Syn $ z.$2)++---- Passing down the number of elements per row ----+ane_Inh z = case (constructor z) of+            "RootTable" -> n_Syn z+            "NoRow" -> case (constructor $ parent z) of+                        "RootTable" -> n_Syn $ parent z+                        "NoRow" -> ane_Inh $ parent z+                        "ConsRow" -> ane_Inh $ parent z+            "ConsRow" -> case (constructor $ parent z) of+                            "RootTable" -> n_Syn $ parent z+                            "OneRow" -> ane_Inh $ parent z+                            "ConsRow" -> ane_Inh $ parent z+            "OneRow" -> ane_Inh $ parent z+            "NoElem" -> case (constructor $ parent z) of+                            "OneRow" -> ane_Inh $ parent z+                            "ConsElem" -> (ane_Inh $ parent z) - 1+                            "NoElem" -> (ane_Inh $ parent z) - 1+            "ConsElem" -> case (constructor $ parent z) of+                            "OneRow" -> ane_Inh $ parent z+                            "ConsElem" -> (ane_Inh $ parent z) - 1+                            "NoElem" -> (ane_Inh $ parent z) - 1++---- Constructing the new table ----+r2 z = RootR (r2_table $ z.$1)++r2_table z = RootTable (r2_rows $ z.$1)++r2_rows z = case (constructor z) of+                "NoRow" -> NoRow+                "ConsRow" -> ConsRow (r2_row $ z.$1) (r2_rows $ z.$2)++r2_row z = OneRow (r2_elems $ z.$1)++r2_elems z = case (constructor z) of+                "NoElem" -> add_elems (ane_Inh z)+                "ConsElem" -> ConsElem (r2_elem $ z.$1) (r2_elems $ z.$2)++r2_elem z = case (constructor z) of+                "TableText" -> TableText (value z)+                "NestedTable" -> NestedTable (r2_table $ z.$1)++---- Computing the minimal height of each construct ----+mh_Syn z = case (constructor z) of+            "RootR" -> mh_Syn $ z.$1+            "RootTable" -> mh_Syn $ z.$1+            "NoRow" -> 0+            "ConsRow" -> (mh_Syn $ z.$1) + 1 + (mh_Syn $ z.$2)+            "OneRow" -> mh_Syn $ z.$1+            "ConsElem" -> max (mh_Syn $ z.$1) (mh_Syn $ z.$2)+            "NoElem" -> 0+            "TableText" -> 1+            "NestedTable" -> (mh_Syn $ z.$1 ) + 1++---- Computing the minimal width of each construct ----+mw_Syn z = case (constructor z) of+            "RootR" -> mw_Syn $ z.$1+            "RootTable" -> lmw_Local z -- Local attr, as defined in LRC+            "TableText" -> length (value z)+            "NestedTable" -> (mw_Syn $ z.$1) + 2++mws_Syn z = case (constructor z) of+                "NoRow" -> []+                "ConsRow" -> eq_zipwith_max (mws_Syn $ z.$1) (mws_Syn $ z.$2)+                "OneRow" -> mws_Syn $ z.$1+                "ConsElem" -> (mw_Syn $ z.$1) : (mws_Syn $ z.$2)+                "NoElem" -> []++---- LOCAL ATTRIBUTE ----+lmw_Local z = case (constructor z) of+                    "RootTable" -> (sumList (mws_Syn $ z.$1)) + (lengthList (mws_Syn $ z.$1)) - 1+                    "ConsRow" -> (sumList (aws_Inh z)) + (lengthList (aws_Inh z)) - 1++---- Passing down the available heights and widths ----+ah_Inh z = case (constructor z) of+            "RootR" -> mh_Syn $ z+            "RootTable" -> case (constructor $ parent z) of+                            "RootR" -> ah_Inh $ parent z+                            "OneElem" -> ah_Inh $ parent z+                            "ConsElem" -> ah_Inh $ parent z+            "ConsElem" ->case (constructor $ parent z) of+                            "OneRow" -> mh_Syn z+                            "ConsElem" -> ah_Inh $ parent z+            "NoElem" -> case (constructor $ parent z) of+                            "OneRow" -> mh_Syn z+                            "ConsElem" -> ah_Inh $ parent z+            "TableText" -> ah_Inh $ parent z+            "NestedTable" -> ah_Inh $ parent z++aws_Inh z = case (constructor z) of+                "ConsRow" ->case (constructor $ parent z) of+                                "RootTable" -> mws_Syn z+                                "ConsRow" -> aws_Inh $ parent z+                "NoRow" -> case (constructor $ parent z) of+                                "RootTable" -> mws_Syn z+                                "ConsRow" -> aws_Inh $ parent z+                "OneRow" -> aws_Inh $ parent z+                "ConsElem" -> case (constructor $ parent z) of+                                "OneRow" -> aws_Inh $ parent z+                                "ConsElem" -> tailList (aws_Inh $ parent z)+                "NoElem" -> case (constructor $ parent z) of+                                "OneRow" -> aws_Inh $ parent z+                                "ConsElem" -> tailList (aws_Inh $ parent z)++aw_Inh z = case (constructor z) of+            "RootR" -> mw_Syn z+            "RootTable" -> case (constructor $ parent z) of+                            "RootR" -> ah_Inh $ parent z+--							"TableText" -> aw_Inh $ parent z+                            "NestedTable" -> aw_Inh $ parent z+            "TableText" -> headList (aws_Inh $ parent z)+            "NestedTable" -> headList (aws_Inh $ parent z)++---- Computing Formatted Table ----+lines_Syn t = let z = t+              in case (constructor z) of+                    "RootR" -> lines_Syn $ z.$1+                    "RootTable" -> (add_sepline (lmw_Local z)) ++ (lines_Syn $ z.$1) ++ (add_sepline (lmw_Local z))+                    "NoRow" -> []+                    "ConsRow" -> add_sep_line (lmw_Local z) (lines_Syn $ z.$1) (lines_Syn $ z.$2)+                    "OneRow" -> add_border_line (lines_Syn $ z.$1)+                    "NoElem" -> []+                    "ConsElem" -> let ag = addglue (aw_Inh $ z.$1) (mw_Syn $ z.$1) (ah_Inh $ z.$1) (mh_Syn $ z.$1) (lines_Syn $ z.$1) ("align")+                                  in eq_zipwith_cat ag (lines_Syn $ z.$2)+                    "TableText" -> value z : []+                    "NestedTable" -> lines_Syn $ z.$1++---- Semantics Functions ----+sumList = sum++lengthList = length++eq_zeros = []++eq_zipwith_max :: [Int] -> [Int] -> [Int]+eq_zipwith_max [] l2 = l2+eq_zipwith_max l1 [] = l1+eq_zipwith_max (l1:l1s) (l2:l2s) = (max l1 l2) : (eq_zipwith_max l1s l2s)++maxList :: [Int] -> Int+maxList [] = 0+maxList (x:xs) = max x (maxList xs)++headList :: [Int] -> Int+headList [] = 0+headList (x:xs) = x++tailList :: [a] -> [a]+tailList [] = []+tailList (x:xs) = xs++eq_zipwith_cat :: [String] -> [String] -> [String]+eq_zipwith_cat l1 [] = l1+eq_zipwith_cat [] l2 = l2+eq_zipwith_cat (l11:l11s) (l22:l22s) = (l11 ++ "|" ++ l22) : (eq_zipwith_cat l11s l22s)++add_border_line :: [String] -> [String]+add_border_line [] = []+add_border_line (x:xs) = ("|" ++ x ++ "|") : (add_border_line xs)++--add_noborder_line :: [String] -> [String]++addglue :: Int -> Int -> Int -> Int -> [String] -> String -> [String]+addglue aw mw ah mh lineS a = (glue_horizontal aw mw lineS a) ++ (glue_vertical_new (ah-mh) (add_vertical aw))++glue_horizontal :: Int -> Int -> [String] -> String -> [String]+glue_horizontal _ _ [] _ = []+glue_horizontal aw mw (l:ls) a = (add_hor l (aw-mw) a) : (glue_horizontal aw mw ls a)++add_hor :: String -> Int -> String -> String+add_hor l aw "left" = l ++ (hor_spaces aw)+add_hor l aw "right" = (hor_spaces aw) ++ l+add_hor l aw "center" = let y = (div aw 2)+                        in (hor_spaces y) ++ l ++ (hor_spaces y)+add_hor l aw _ = l ++ (hor_spaces aw)++hor_spaces :: Int -> String+hor_spaces i = if (i <= 0) then "" else (repeatChar ' ' i)++glue_vertical_new :: Int -> [String] -> [String]+glue_vertical_new n l = if (n <= 0) then [] else l ++ (glue_vertical_new (n-1) l)++add_vertical :: Int -> [String]+add_vertical aw = if (aw <= 0) then [] else (repeatChar ' ' aw) : []++add_sepline :: Int -> [String]+add_sepline aw = if (aw <= 0)+                then []+                else ["|" ++ (repeatChar '-' aw) ++ "|"]++add_sep_line :: Int -> [String] -> [String] -> [String]+add_sep_line mw l [] = l+add_sep_line mw l rest = l ++ (add_sepline mw) ++ rest++add_elems :: Int -> Elems+add_elems 0 = NoElem+add_elems n = ConsElem (TableText " ") (add_elems (n-1))++repeatChar :: Char -> Int -> String+repeatChar _ 0 = []+repeatChar c i = c : (repeatChar c (i-1)) ++---- table2nestedtable : Table -> Table++---- Tests+nestedtable = RootTable (ConsRow (OneRow (ConsElem (TableText "Some more random text!") (NoElem))) (NoRow))+elem1 = TableText "This is some text on a table!"+elem2 = TableText "And even more random text!"+row1 = ConsRow (OneRow (ConsElem (TableText "This is a big phrase etc etc.") NoElem)) (NoRow)+elem3 = ConsElem (TableText "This is a big phrase just to make sure this HTML AG etc etc.") (NoElem)++table = RootR (RootTable (ConsRow (OneRow (ConsElem (elem1) (ConsElem (NestedTable nestedtable) (NoElem)))) (ConsRow (OneRow (ConsElem (elem2) (elem3))) (row1))))++printTable :: [String] -> String+printTable [] = ""+printTable (x:xs) = x ++ "\n" ++ (printTable xs)++ata z = toZipper (r2 z)++semantics t = putStrLn $ printTable $ lines_Syn $ ata $ (toZipper t)+

@@ -0,0 +1,155 @@++{-# LANGUAGE DeriveDataTypeable #-}++module Language.ZipperAG.Examples.LET.ExampleLet where++import Data.Generics.Zipper+import Language.ZipperAG++import Language.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate+import Language.ZipperAG.Examples.LET.Let_No_Blocks+import Language.ZipperAG.Examples.LET.Let_Scope+import Language.ZipperAG.Examples.LET.Let_Circular_Flatening+import Language.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)+-- 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+         c = 8+         w = let  z = a * b+             in   z * b   +         b = (c * 3) - c+     in  c * w - a+a = RootC $+      -- let a = b + 3+      LetC ( ConsAssignC "a" (Add (Et $ Tf $ Var "b") (Tf $ Const 3))+      -- c = 8+           $ ConsAssignC "c" (Et $ Tf $ Const 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"))+                          )+      -- b = (c * 3) - c+           $ ConsAssignC "b" (Sub (Et $ (Mul (Tf $ Var "c") (Const 3))) (Tf $ Var "c"))+      EmptyListC+           )+      -- in  c * w - a+      $ InC (Sub (Et $ Mul (Tf $ Var "c") (Var "w")) (Tf $ Var "a"))++b1 = let c = 1+         a = let b = c+             in  b+     in  a + c+b = RootC $+      -- c = 1+      LetC ( ConsAssignC "c" (Et $ Tf $ Const 1)+      -- a = let b = 7+             $ ConsLetC "a" ( LetC ( ConsAssignC "b" (Et $ Tf $ Var "c") EmptyListC)+      --     in   b+                            $ InC (Et $ Tf $ Var "b")+                            )+             EmptyListC+           )+      -- in  a + c+      $ InC (Add (Et $ Tf $ Var "a") (Tf $ Var "c"))++c1 = let a = 5+         b = a+     in  b+c = RootC $+      -- let a = 5+      LetC ( ConsAssignC "a" (Et $ Tf $ Const 5)+      --     b = a+             $ ConsAssignC "b" (Et $ Tf $ Var "a")+               EmptyListC+           )+      -- in  b+      $ InC (Et $ Tf $ Var "b")++d1 = let a = b+3+         c = 8+         b = c*3 - c+     in  c*5 - a+d = RootC $+      -- let a = b + 3 (19)+      LetC ( ConsAssignC "a" (Add (Et $ Tf $ Var "b") (Tf $ Const 3))+      -- c = 8+           $ ConsAssignC "c" (Et $ Tf $ Const 8)+      -- b = c * 3 - c (16)+           $ ConsAssignC "b" (Sub (Et $ (Mul (Tf $ Var "c") (Const 3))) (Tf $ Var "c"))+      EmptyListC+           )+      -- in  c * 5 - a (21)+      $ InC (Sub (Et $ Mul (Tf $ Var "c") (Const 5)) (Tf $ Var "a"))++-- Exemplo de circularidade do Paakki+e1 = let x = y+         y = z+         z = 2+     in  x+e = RootC $+      -- let x = y+      LetC ( ConsAssignC "x" (Et $ Tf $ Var "y")+      -- y = z+           $ ConsAssignC "y" (Et $ Tf $ Var "z")+      -- z = 2+           $ ConsAssignC "z" (Et $ Tf $ Const 2)+      EmptyListC+           )+      -- in  x+      $ InC (Et $ Tf $ Var "x")++f1 = let a = b + 3+         c = 8+         w = let  z = a * b+             in   z * b   +         b = let  c = 1+             in   c + 4+     in  c * w - a+f = RootC $+      -- let a = b + 3+      LetC ( ConsAssignC "a" (Add (Et $ Tf $ Var "b") (Tf $ Const 3))+      -- c = 8+           $ ConsAssignC "c" (Et $ Tf $ Const 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"))+                          )+      -- b = let c = 1+           $ ConsLetC "b" ( LetC ( ConsAssignC "c" (Et $ Tf $ Const 1) EmptyListC)+      --     in  c + 4+                            $ InC (Add (Et $ Tf $ Var "c") (Tf $ Const 4))+                          )+      EmptyListC+           )+      -- in  c * w - a+      $ InC (Sub (Et $ Mul (Tf $ Var "c") (Var "w")) (Tf $ Var "a"))++scope_no_blocks ag = Language.ZipperAG.Examples.LET.Let_No_Blocks.test_scope_no_block_rules ag++scope_with_blocks ag = Language.ZipperAG.Examples.LET.Let_Scope.test_scope_block_rules ag++flatten ag = getHole (Language.ZipperAG.Examples.LET.Let_Circular_Flatening.flatten_Let ag) :: Maybe RootA++solve_after_flattening ag = let ata = Language.ZipperAG.Examples.LET.Let_Circular_Flatening.flatten_Let ag+                            in  calculate ata ++solve_circ_plus_ho ag = Language.ZipperAG.Examples.LET.Let_Meaning_HO_NestedST_Circ.solve_ho_plus_circularity ag++++++++++

@@ -0,0 +1,109 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Language.ZipperAG.Examples.LET.Let_Bidi where++import Data.Generics.Zipper+import Language.ZipperAG+import Language.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate++-- 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_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+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)

@@ -0,0 +1,132 @@+{-# LANGUAGE DeriveDataTypeable#-}++module Language.ZipperAG.Examples.LET.Let_Circular_Flatening where++import Data.Generics.Zipper+import Language.ZipperAG+import Data.Data++import Language.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate+import Language.ZipperAG.Examples.LET.Let_Scope+import Language.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)++++++++++++

@@ -0,0 +1,209 @@++{-# LANGUAGE DeriveDataTypeable #-}++module Language.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate where++import Prelude+import Data.Data+import Data.Generics.Zipper+import Language.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!"++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++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_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_2 :: Zipper a -> A+lexeme_ConsAssignA_2 ag = case (getHole ag :: Maybe ListA) of+                              Just(ConsAssignA _ a _ _) -> a+                              _ -> error "Error in lexeme_ConsAssignA_2!"++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+                       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!!"+

@@ -0,0 +1,236 @@++{-# LANGUAGE DeriveDataTypeable #-}++module Language.ZipperAG.Examples.LET.Let_Meaning_HO_NestedST_Circ where++import Data.Generics.Zipper+import Language.ZipperAG+import Data.Data++import Language.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate+import Language.ZipperAG.Examples.LET.Let_Scope+import Language.ZipperAG.Examples.LET.Let_Bidi++---- 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 (calculate (ag.$2))+                                          else (auxGetVarValue name (ag.$4))+                           "ConsLetHO" -> if (lexeme_ConsLetHO_Var ag == name) then (calculate (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_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+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++solve_ho_plus_circularity p = solve $ toZipper (getRootC_RootA $ toZipper p)+++++++++++++++++++++++++++++++++++

@@ -0,0 +1,55 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Language.ZipperAG.Examples.LET.Let_No_Blocks where++import Data.Generics.Zipper+import Language.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate+import Language.ZipperAG.Examples.LET.Let_Bidi+import Language.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_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)+           "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_1 $ 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)+

@@ -0,0 +1,74 @@++{-# LANGUAGE DeriveDataTypeable #-}++module Language.ZipperAG.Examples.LET.Let_Scope where++import Data.Generics.Zipper+import Language.ZipperAG+import Language.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate+import Language.ZipperAG.Examples.LET.Let_Bidi++---- 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_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)+           "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_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)]+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++test_scope_block_rules p = errs $ toZipper (getRootC_RootA $ toZipper p)+

@@ -0,0 +1,56 @@++{-# LANGUAGE DeriveDataTypeable#-}++module Language.ZipperAG.Examples.RepMin where++import Data.Maybe+import Data.Data+import Prelude+import Data.Generics.Zipper+import Language.ZipperAG++data Root = Root Tree+       deriving (Eq, Ord, Show, Typeable, Data)++data Tree = Leaf Int+          | Fork Tree Tree+       deriving (Eq, Ord, Show, Typeable, Data)++tree = Root $ Fork (Leaf 1) +             (Fork (Leaf 4)+                   (Leaf 7))++constructor :: Zipper Root -> String+constructor a = case (getHole a :: Maybe Tree) of+                   Just (Fork _ _) -> "Fork"+                   Just (Leaf _) -> "Leaf"+                   _ -> case (getHole a :: Maybe Root ) of+                               Just (Root _) -> "Root"++lexeme :: Zipper Root -> Int+lexeme t = let Leaf v = fromJust (getHole t :: Maybe Tree)+                  in v++---- Inherited ----+globmin :: Zipper Root -> Int+globmin t = case constructor t of+                            "Root" -> locmin t+                            "Leaf" -> globmin $ parent t+                            "Fork" -> globmin $ parent t++---- Synthesized ----+locmin :: Zipper Root -> Int+locmin t =  case constructor t of                   +                          "Root" -> locmin $ t.$1+                          "Leaf" -> lexeme t+                          "Fork" -> min (locmin $ t.$1 ) (locmin $ t.$2 )++replace :: Zipper Root -> Tree+replace t = case constructor t of                   +                          "Root" -> replace ( t.$1 )+                          "Leaf" -> Leaf (globmin t)+                          "Fork" -> Fork (replace $ t.$1 ) (replace $ t.$2 )+++semantics :: Root -> Tree+semantics t = replace (toZipper t)

@@ -0,0 +1,93 @@++{-# LANGUAGE DeriveDataTypeable #-}+module Language.ZipperAG.Examples.SmartParentesis where++import Data.Maybe+import Data.Data+import Prelude+import Data.Generics.Zipper+import Data.Data+import Language.ZipperAG++data Root = Root Exp+    deriving (Eq, Ord, Show, Typeable, Data)++data Exp = Add Exp Exp+         | Mul Exp Exp+         | Div Exp Exp+         | Sub Exp Exp+         | Lit Int+           deriving (Eq, Ord, Show, Typeable, Data)++constructor :: Zipper Root -> String+constructor a = case (getHole a :: Maybe Exp) of+                   Just (Add _ _) -> "Add"+                   Just (Mul _ _) -> "Mul"+                   Just (Div _ _) -> "Div"+                   Just (Sub _ _) -> "Sub"+                   Just (Lit _) -> "Lit"+                   _ -> case (getHole a :: Maybe Root ) of+                               Just (Root _) -> "Root"++lexeme :: Zipper Root -> Int+lexeme t = let Lit v = fromJust (getHole t :: Maybe Exp)+          in v++---- AG ----+---- Inherited Attributes ----+enclosingOpPrecedence :: Zipper Root -> Int+enclosingOpPrecedence t = case (constructor t) of+                            "Root" -> 0+                            "Add" -> 1+                            "Sub" -> 1+                            "Mul" -> 2+                            "Div" -> 2++leftOrRight :: Zipper Root -> String+leftOrRight t = case (constructor t) of+                            "Root" -> "none"+                            "Add" -> case t.|1 of+                                        True -> "left"+                                        False -> "right"+                            "Sub" -> case t.|1 of+                                        True -> "left"+                                        False -> "right"+                            "Mul" -> case t.|1 of+                                        True -> "left"+                                        False -> "right"+                            "Div" -> "left"++bpp :: Zipper Root -> String+bpp t = case (constructor t) of+              "Root" -> bpp (t.$1)+              "Lit" -> show (lexeme t)+              "Add" -> if (wrapInParens (enclosingOpPrecedence t) 1 (leftOrRight t) "left") +                              then "(" ++ (bpp ( t.$1 )) ++ "+" ++ (bpp ( t.$2 )) ++ ")"+                              else (bpp ( t.$1 )) ++ "+" ++ (bpp ( t.$2 ))+              "Sub" -> if (wrapInParens (enclosingOpPrecedence t) 1 (leftOrRight t) "left")+                           then "(" ++ (bpp ( t.$1 )) ++ "-" ++ (bpp ( t.$2 )) ++ ")"+                           else (bpp ( t.$1 )) ++ "-" ++ (bpp ( t.$2 ))+              "Mul" -> if (wrapInParens (enclosingOpPrecedence t) 2 (leftOrRight t) "left") +                          then "(" ++ (bpp ( t.$1 )) ++ "*" ++ (bpp ( t.$2 )) ++ ")"+                           else (bpp ( t.$1 )) ++ "*" ++ (bpp ( t.$2 ))+              "Div" -> if (wrapInParens (enclosingOpPrecedence t) 2 (leftOrRight t) "left") +                           then "(" ++ (bpp ( t.$1 )) ++ "/" ++ (bpp ( t.$2 )) ++ ")"+                           else (bpp ( t.$1 )) ++ "/" ++ (bpp ( t.$2 ))++-- SEMANTIC FUNCTIONS --+wrapInParens enclosingP thisP thisPos opAssoc = (enclosingP > thisP) || ((enclosingP == thisP) && (thisPos /= opAssoc))++{- Simple PrettyPrinting for Exp -}+exp2str :: Exp -> String+exp2str (Add a b) = "(" ++ exp2str(a) ++ " + " ++ exp2str(b) ++ ")"+exp2str (Mul a b) = "(" ++ exp2str(a) ++ " * " ++ exp2str(b) ++ ")"+exp2str (Div a b) = "(" ++ exp2str(a) ++ " / " ++ exp2str(b) ++ ")"+exp2str (Sub a b) = "(" ++ exp2str(a) ++ " - " ++ exp2str(b) ++ ")"+exp2str (Lit f) = show f++{- Tests -}+expr = Root $ Mul (Sub (Div (Lit 5) (Lit 5)) (Lit 10)) (Add (Lit 4) (Lit 5))++semantics z = bpp (toZipper z)++