module Label where

import ViewTypes
import List(intersperse)

data TreeLabel = Hole  |  Letter String |                 -- these two are obligatory
                 Lambda |
                 Plus | Times | Minus | Div | Mod |
                 Exp | Gr | Le | Equ |  And | Or | Not |
                 If | While | Seq | Assign | Index | Apply
                 deriving (Eq,Show,Read)


isHole :: TreeLabel -> Bool
isHole Hole = True
isHole _    = False

arity :: TreeLabel -> Int
arity Hole         = 0
arity l@(Letter _) = 0
arity Lambda       = 2 
arity Plus         = 2 
arity Times        = 2 
arity Minus        = 2 
arity Div          = 2 
arity Mod          = 2 
arity Exp          = 2 
arity Gr           = 2 
arity Le           = 2 
arity Equ          = 2 
arity And          = 2 
arity Or           = 2 
arity Not          = 1 
arity If           = 3 
arity While        = 2 
arity Seq          = 2 
arity Assign       = 2 
arity Index        = 2
arity Apply        = 2

---------------------------------------------------------------------------------------------------------------
-- precedence grammar

assl :: TreeLabel -> Bool
assl Plus  = True
assl Minus = True
assl Div   = True
assl Mod   = True
assl Times = True  
assl Seq   = True
assl Apply = True
assl _     = False

assr :: TreeLabel -> Bool
assr Plus  = True
assr Times = True  
assr Seq   = True
assr Exp   = True
assr Seq   = True
assr Index = True
assr _     = False

associative :: TreeLabel -> Bool
associative Seq   = True
associative Plus  = True
associative Times = True
associative _     = False

cap :: TreeLabel -> Bool
cap If    = True
cap While = True
cap Seq   = True
cap _     = False

prec :: TreeLabel -> Int
prec If     = -1   
prec While  = -1  
prec Not    = -1
prec Lambda = -1    
prec Plus   = 6
prec Minus  = 6
prec Mod    = 7
prec Times  = 7
prec Div    = 7
prec Exp    = 8
prec Gr     = 4
prec Le     = 4
prec Equ    = 4
prec And    = 3
prec Or     = 2
prec Seq    = 0
prec Assign = 1
prec Index  = 5
prec _      = 1000

---------------------------------------------------------------------------------------------------------------
-- scanner

commandStrings = [("\\",Lambda),
                  ("+",Plus),("*",Times),("-",Minus),("/",Div),("mod",Mod),("^",Exp),
                  (">",Gr),("<",Le),("==",Equ),("&&",And),("||",Or),("not",Not),
                  ("if",If),("while",While),(";",Seq),(":=",Assign),("[",Index),(".",Apply)]


specialChars = "\\+*-/&><=|;:[]."

----------------------------------------------------------------------------------------------------------------
-- pretty printing


viewLabel :: TreeLabel -> [TreeView] ->  TreeTag -> [TreeView]
viewLabel Hole []      lbl    = [crown "___" lbl]
viewLabel (Letter s) []  lbl  = [crown s lbl]
viewLabel Lambda [p,b]   lbl  = [stext "(\\", p, crown " -> " lbl, b, stext ")"]
viewLabel Plus   ts l         = viewbinop "+" ts  l                      
viewLabel Times  ts  l        = viewbinop "*" ts  l  
viewLabel Minus  ts  l        = viewbinop "-" ts  l  
viewLabel Div    ts  l        = viewbinop "/" ts  l   
viewLabel Mod    ts  l        = viewbinop " mod " ts  l
viewLabel Exp    ts  l        = viewbinop "^" ts  l
viewLabel Gr     ts  l        = viewbinop ">" ts  l
viewLabel Le     ts l         = viewbinop "<" ts  l
viewLabel Equ    ts  l        = viewbinop "==" ts  l
viewLabel And    ts  l        = viewbinop "&&" ts  l
viewLabel Or     ts  l        = viewbinop "||" ts  l
viewLabel Not [b]  lbl        = [crown "not " lbl,b]
viewLabel If   [c,t,e]  lbl   = [stack [ flat [crown "if " lbl, noindent 3 c ], 
                                         crown "then " lbl,
                                         indent 7 t,
                                         crown "else " lbl,
                                         indent 7 e,
                                         crown "fi" lbl ]]
viewLabel While  [c,b] lbl    = [stack [ flat [crown "while " lbl, noindent 3 c ,crown " do" lbl], 
                                        indent 7 b,
                                        crown "od" lbl]]
viewLabel Seq ss lbl          = if null ss
                                then [crown "{<EMPTY>}" lbl]
                                else [stack [crown "{" lbl,indent 3 (stack (initmap f ss)),crown "}" lbl]]
                                where f s = flat [s, crown " ; " lbl]
viewLabel Assign [l,r] lbl    = [l,crown " := " lbl, noindent 7 r]
viewLabel Index [a,i] lbl     = [a,crown "[" lbl, i, crown "]" lbl]
viewLabel Apply [f,x] lbl     = [f,crown "." lbl, x]
viewLabel lab vs lbl          = crown (show lab) lbl
                                : [stext "["] ++ intersperse (stext ",") vs ++ [stext "]"]


viewbinop x as  lbl           = [crown "(" lbl]++
                                intersperse (crown x lbl)  as++
                                [crown ")" lbl] 
    

 
ind :: (TreeLabel,[a],[a]) -> Int
ind (If,ts,_)      = if null ts then 3 else 7
ind (While,ts,_)   = if null ts then 3 else 7
ind (Assign,ts,_)  = if null ts then 0 else 7
ind (Seq,_,_)      = 3
ind _              = 0