-- INCLUDE "AbstractSyntax.ag"
-- INCLUDE "Patterns.ag"
-- INCLUDE "Expression.ag"

imports {
import VisagePatterns
import VisageSyntax
}

{
-- Maps a rule to a pair 
-- Later, I expect to map to a list of rules, because we might need to unfold.


-- Checks that a certain alias is in fact a Var in the old representation of the AG system
isVar (Alias _ _ (Underscore _)) = True
isVar _ = False

type VisageRuleMap = [(String, VisageRule)]

splitVRules :: [VisageRule] -> VisageRuleMap
splitVRules vrs = concat (map unfoldvrs vrs)

unfoldvrs :: VisageRule -> VisageRuleMap
unfoldvrs vr@(VRule attrfields _ _ _ _) = zip (map (getName . fst) attrfields) (map (copyRule vr) attrfields)

copyRule :: VisageRule -> (Name,Name) -> VisageRule
copyRule (VRule attrfields pat expr owrt rule) (field,attr) = VRule attrfields (VVar field attr) expr owrt rule

getForField :: String -> VisageRuleMap -> [VisageRule]
getForField field xs = map snd (filter ((field ==) . fst) xs)

{-
   Delivers a map from fieldname to VisageRule with all references to others underscored.
   So, (lhs.x, rt.y, loc.z) = (0,1,2) becomes something like
   [("lhs", (lhs.x,_,_) = (0,1,2)

allways :: VisageRule -> VisageRuleMap
allways vr@(VRule vrfields _ _ _ _) = zip vrfields (map (underScoreRule vr) (nub vrfields))

splitVRules :: [VisageRule] -> VisageRuleMap
splitVRules vrs = concat (map allways vrs)

underScoreRule :: VisageRule -> String -> VisageRule
underScoreRule (VRule fields pat expr owrt rule) s = VRule fields (underScore s pat) expr owrt rule

underScore :: String -> VisagePattern -> VisagePattern
underScore field (VConstr name pats) = VConstr name (map (underScore field) pats) 
underScore field (VProduct pos pats) = VProduct pos (map (underScore field) pats)
underScore field vp@(VVar vfield attr)  = 
   if (field == getName vfield) 
   then vp
   else (VUnderscore (getPos vfield))
-- Should I recurse into the pat of VAlias?
underScore field vp@(VAlias afield attr pat) =
   if (field == getName afield) 
   then vp
   else (VUnderscore (getPos afield))
underScore field vp@(VUnderscore pos) = vp
                 
-}
}


ATTR Expression Pattern Patterns Rule [ | | self : SELF ]

ATTR Grammar  [ || visage:{VisageGrammar} ]
ATTR Production  [ || vprod:{VisageProduction} ]
ATTR Productions  [ || vprods:{[VisageProduction]} ]
ATTR Alternative  [ || valt:{VisageAlternative} ]
ATTR Alternatives  [ || valts:{[VisageAlternative]} ]
ATTR Rule [ || vrule : {VisageRule} ]
ATTR Rules [ || vrules : {[VisageRule]} ]
ATTR Child    [ rulemap : {VisageRuleMap} || vchild:{VisageChild} ]
ATTR Children [ rulemap : {VisageRuleMap} || vchildren:{[VisageChild]} ]
ATTR Expression [ || vexpression:{Expression} ]
ATTR Pattern [ || vpat:{VisagePattern} ]
ATTR Patterns [ || vpats: {[VisagePattern]} ]

SEM Grammar
  | Grammar     lhs.visage = VGrammar @prods.vprods

SEM Productions
  | Cons 	lhs.vprods = @hd.vprod : @tl.vprods
  | Nil		lhs.vprods = []

SEM Production
  | Production  lhs.vprod = VProduction @nt @inh @syn @alts.valts
  
SEM Alternatives
  | Cons	lhs.valts = @hd.valt : @tl.valts
  | Nil		lhs.valts = []

SEM Alternative
  | Alternative lhs.valt         = VAlternative @con @children.vchildren @lhsrules @locrules                 
                loc.splitVRules  = splitVRules @rules.vrules
                loc.locrules     = getForField "loc" @splitVRules
                loc.lhsrules     = getForField "lhs" @splitVRules
                children.rulemap = @splitVRules
                
SEM Children
  | Cons	lhs.vchildren = @hd.vchild : @tl.vchildren
  | Nil		lhs.vchildren = []	

SEM Child
  | Child lhs.vchild = VChild @name @tp @inh @syn (getForField (getName @name) @lhs.rulemap)

SEM Rules
  | Cons	lhs.vrules = @hd.vrule : @tl.vrules
  | Nil		lhs.vrules = []

SEM Rule
  | Rule  lhs.vrule  = VRule @pattern.fieldattrs @pattern.vpat @rhs.self @owrt @self
  
SEM Expression
  | Expression  lhs.vexpression = @self
  
SEM Patterns
  | Cons	lhs.vpats = @hd.vpat : @tl.vpats
  | Nil		lhs.vpats = []

SEM Pattern
  | Constr      lhs.vpat = VConstr @name @pats.vpats
  | Product     lhs.vpat = VProduct @pos @pats.vpats
  | Alias       lhs.vpat = if (isVar @self) 
                           then VVar @field @attr
                           else VAlias @field @attr @pat.vpat
  | Underscore  lhs.vpat = VUnderscore @pos

-- All (field,attrs) in a pattern
ATTR Patterns -> Pattern [ | | fieldattrs USE { ++ } { [] } : { [(Name,Name)] } ] 

SEM Pattern
  | Alias       lhs.fieldattrs = [(@field, @attr)]