implementation module Sil.Syntax

from StdFunc import o
import StdOverloaded
import StdString
import StdTuple

import Data.List
import Text

import Sil.Types
import Sil.Util.Parser
import Sil.Util.Printer

instance toString Statement
where
	toString (Declaration _ n a)  = n <+ " := " <+ a <+ ";"
	toString (Application _ e)    = toString e <+ ";"
	toString (Return _ ?None)     = "return;"
	toString (Return _ (?Just a)) = "return " <+ a <+ ";"
	toString (If _ bs e)          = "if ..."
	toString (MachineStm _ s)     = "|~" <+ s
	toString _                    = "<<unimplemented Statement>>"

instance toString Arg where toString arg = arg.arg_type <+ " " <+ arg.arg_name

instance toString Expression
where
	toString (Name _ n)               = n
	toString (Literal _ lit)          = toString lit
	toString (App _ n args)           = n <+ "(" <+ printersperse ", " args <+ ")"
	toString (BuiltinApp _ op e)      = op <+ "(" <+ e <+ ")"
	toString (BuiltinApp2 _ e1 op e2) = "(" <+ e1 <+ ") " <+ op <+ " (" <+ e2 <+ ")"
	toString (Tuple _ _ es)           = "(" <+ printersperse ", " es <+ ")"
	toString (List _ (?Just t) [])    = "[" <+ t <+ "]"
	toString (List _ (?Just t) es)    = "[" <+ t <+ ":" <+ printersperse ", " es <+ "]"
	toString (List _ ?None es)        = "[" <+ printersperse ", " es <+ "]"
	toString (Field _ f e)            = "(" <+ e <+ ")." <+ f

instance toString Op1
where
	toString Neg = "~"
	toString Not = "!"

instance toString Op2
where
	toString Add      = "+"
	toString Sub      = "-"
	toString Mul      = "*"
	toString Div      = "/"
	toString Rem      = "%"
	toString Equals   = "=="
	toString Unequals = "<>"
	toString CmpLe    = "<="
	toString CmpGe    = ">="
	toString CmpLt    = "<"
	toString CmpGt    = ">"
	toString LogOr    = "||"
	toString LogAnd   = "&&"
	toString Cons     = ":"

instance toString Literal
where
	toString (BLit b) = toString b
	toString (ILit i) = toString i

instance getPos Function where getPos f = f.f_pos
instance getPos Initialisation where getPos i = i.init_pos

instance getPos Statement
where
	getPos (Declaration p _ _) = p
	getPos (Application p _)   = p
	getPos (Return      p _)   = p
	getPos (If          p _ _) = p
	getPos (While       p _ _) = p
	getPos (MachineStm  p _)   = p

instance getPos Expression
where
	getPos (Name        p _)     = p
	getPos (Literal     p _)     = p
	getPos (App         p _ _)   = p
	getPos (BuiltinApp  p _ _)   = p
	getPos (BuiltinApp2 p _ _ _) = p
	getPos (Tuple       p _ _)   = p
	getPos (List        p _ _)   = p
	getPos (Field       p _ _)   = p

instance allStatements Program
where allStatements p = concatMap allStatements p.p_funs

instance allStatements Function
where allStatements f = allStatements f.f_code

instance allStatements CodeBlock
where allStatements cb = concatMap allStatements cb.cb_content

instance allStatements Statement
where
	allStatements st=:(Declaration _ _ _) = [st]
	allStatements st=:(Application _ _)   = [st]
	allStatements st=:(Return _ _)        = [st]
	allStatements st=:(If _ bs ?None)     = [st:concatMap (allStatements o snd) bs]
	allStatements st=:(If _ bs (?Just e)) = [st:allStatements e ++ concatMap (allStatements o snd) bs]
	allStatements st=:(While _ _ cb)      = [st:allStatements cb]
	allStatements st=:(MachineStm _ _)    = [st]

instance allCodeBlocks Function where allCodeBlocks f = allCodeBlocks f.f_code

instance allCodeBlocks CodeBlock
where allCodeBlocks cb = [cb:concatMap allCodeBlocks cb.cb_content]

instance allCodeBlocks Statement
where
	allCodeBlocks (If _ bs ?None)     = concatMap (allCodeBlocks o snd) bs
	allCodeBlocks (If _ bs (?Just e)) = [e:concatMap (allCodeBlocks o snd) bs]
	allCodeBlocks (While _ _ cb)      = [cb]
	allCodeBlocks _                   = []

instance allLocals Function
where
	allLocals f = [(a.arg_type, a.arg_name) \\ a <- f.f_args] ++
		allLocals f.f_code

instance allLocals CodeBlock
where allLocals cb = [(i.init_type, i.init_name) \\ i <- cb.cb_init]