CheckGrammar.ag

imports
{
import qualified Data.Set as Set
import qualified Data.Map as Map
import Language.EWE.AbsSyn
import Language.EWE.Utils
}

attr Prog
   syn res      :: {Either String ()}

attr Equates
   chn idMemRef :: {Map.Map String Int}

attr Equ
   chn idMemRef :: {Map.Map String Int}
   syn res      :: {Either String ()}

attr Stmts
   chn labelDef                     :: {Set.Set String}
   inh labelFound                   :: {Set.Set String}
   inh idMemRefDef                  :: {Map.Map String Int}
   syn res use {(<-->)} {Right ()} :: {Either String ()}

attr Stmt
   chn labelDef    :: {Set.Set String}
   inh labelFound  :: {Set.Set String}
   inh idMemRefDef :: {Map.Map String Int}
   syn res         :: {Either String ()}

attr Instr
   inh labelFound  :: {Set.Set String}
   inh idMemRefDef :: {Map.Map String Int}
   syn res         :: {Either String ()}

attr Labels
   syn res      :: { Either String () }
   chn labelDef :: { Set.Set String }
   syn copy     :: self

attr MRef
   inh idMemRefDef :: { Map.Map String Int }
   syn res         :: { Either String () }

sem Equ
  | Tuple lhs.res      = { if @x1 `Map.member` @lhs.idMemRef
                           then Left $ @x1 ++ " was already defined "
                           else Right ()
                         }
             .idMemRef = { Map.insert @x1 @x2 @lhs.idMemRef }

sem Labels
  | Cons  lhs.res      = { isLabelNotDef @hd @tl.labelDef }
             .labelDef = { Set.insert @hd @tl.labelDef }
  | Nil   lhs.res      = { Right ()  }
             .labelDef = { @lhs.labelDef }

sem Prog
  | Prg stms.labelDef    = { Set.empty }
            .labelFound  = { @stms.labelDef }
            .idMemRefDef = { @equates.idMemRef }
        equates.idMemRef = { Map.empty }

sem Stmt
  | Stmt loc.res1 = {
   let f (e,er,s) lbl = if Set.member lbl s
                        then (True,
                              lbl ++ " is already defined\n" ++ er,
                              s)
                        else (e, er, Set.insert lbl s)
       (e', errs', set') = foldl f (False,"",@lhs.labelDef) @labels.copy
   in if e'
      then Left errs'
      else Right ()
                   }
          lhs.res = { @res1 <--> @instr.res }

sem MRef
  | MRefI  lhs.res = Right ()
  | MRefId lhs.res = isMemRefDef @string @lhs.idMemRefDef

sem Instr
  | IMMI  lhs.res = { @dest.res }
  | IMMS  lhs.res = { @dest.res }
  | IMRPC lhs.res = { @dest.res }
  | SPC   lhs.res = { @oper.res }
  | IMMM  lhs.res = { @dest.res <--> @oper.res }
  | IAdd  lhs.res = { @dest.res <--> @left.res <--> @right.res }
  | ISub  lhs.res = { @dest.res <--> @left.res <--> @right.res }
  | IMul  lhs.res = { @dest.res <--> @left.res <--> @right.res }
  | IDiv  lhs.res = { @dest.res <--> @left.res <--> @right.res }
  | IMod  lhs.res = { @dest.res <--> @left.res <--> @right.res }
  | IMRI  lhs.res = { @dest.res <--> @oper.res }
  | IMMR  lhs.res = { @dest.res <--> @oper.res }
  | IRI   lhs.res = { @oper.res }
  | IWI   lhs.res = { @oper.res }
  | IRS   lhs.res = { @left.res <--> @right.res }
  | IWS   lhs.res = { @oper.res }
  | IGI   lhs.res = { Right () }
  | IGS   lhs.res = { isLabelDef @string @lhs.labelFound }
  | IFI   lhs.res = { @bcond.res <--> @then.res }
  | IFS   lhs.res = { isLabelDef @string @lhs.labelFound <--> @bcond.res <--> @then.res}
  | IH    lhs.res = { Right () }
  | IB    lhs.res = { Right () }
  | INI   lhs.res = { Right () }

include "AbsSyn.ag"
include "PPProg.ag"

{
isLabelDef :: String -> Set.Set String ->  Either String ()
isLabelDef str sets
    | str `Set.member` sets = Right ()
    | otherwise             = Left $ "Label: " ++ str ++ " is not defined "

isLabelNotDef :: String -> Set.Set String ->  Either String ()
isLabelNotDef str sets
    | str `Set.member` sets =  Left $ "Label: " ++ str ++ " is already defined "
    | otherwise             = Right ()

isMemRefDef :: String -> Map.Map String Int -> Either String ()
isMemRefDef str map
    | str `Map.member` map = Right ()
    | otherwise            = Left $ "Mem Ref: " ++ str ++ " is not defined"
}