{-# LANGUAGE DeriveDataTypeable #-}

module Language.Grammars.ZipperAG.Examples.LET.ExampleLet where

import Data.Generics
import Data.Generics.Zipper
import Language.Grammars.ZipperAG

import Let_DataTypes_Boilerplate
import Let_Bidi
import Let_Scope
import Let_Meaning_HO_NestedST_Circ

-- This Module is where all the example are presented
-- All examples are presented as the LET language, in their
-- Haskell form (a1..f1) and in their CST form (a..f)
-- The functions test_bidi, test_scope_rules and test_meaning
-- are presented
------ test_bidi - Test bidirectionality. Converts from CST to AST and back to CST
------ test_scope_rules - Applies the AG that performs name/scope analysis with references
------ test_meaning - Applies the AG that calculates the meaning of the program, through
------                an higher-order AG and then through circularity

---- 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"))

test_bidi p = do putStrLn ("**** CONCRETE -> " ++ show p)
                 let t1 = getRootC_RootA $ toZipper p
                 putStrLn ("**** ABSTRACT -> " ++ show t1)
                 let t2 = putRootA_RootC $ toZipper t1
                 putStrLn ("**** CONCRETE -> " ++ show t2)

test_scope_rules p = errs $ toZipper (getRootC_RootA $ toZipper p)

test_meaning p    = solve $ toZipper (getRootC_RootA $ toZipper p)