-- ==========================================================--
-- === Read the lattice table.               ReadTable.hs ===--
-- ==========================================================--

module ReadTable where
import BaseDefs
import Utils
import MyUtils
import Parser2

import Char(isDigit) -- 1.3

-- ==========================================================--
--
rtReadTable :: String -> [(Domain, Int)]

rtReadTable s
   = case rtTable (rtLex 1 s) of
        PFail [] 
           -> myFail "Unexpected end of lattice table"
        PFail ((n,t):_) 
           -> myFail ("Syntax error in lattice table, line " ++ show n ++ ".")
        POk tab [] 
           -> tab
        POk tab ((n,t):_) 
           -> myFail ("Syntax error in lattice table, line " ++ show n ++ ".")


-- ==========================================================--
--
rtLex :: Int -> String -> [Token]

rtLex n [] = []

rtLex n ('\n':cs) = rtLex (n+1) cs
rtLex n (' ':cs) = rtLex n cs
rtLex n ('\t':cs) = rtLex n cs

rtLex n ('(':cs) = (n, "("):rtLex n cs
rtLex n (')':cs) = (n, ")"):rtLex n cs
rtLex n ('[':cs) = (n, "["):rtLex n cs
rtLex n (']':cs) = (n, "]"):rtLex n cs
rtLex n (',':cs) = (n, ","):rtLex n cs

rtLex n ('T':'w':'o':cs)          = (n, "T"):rtLex n cs
rtLex n ('F':'u':'n':'c':cs)      = (n, "F"):rtLex n cs
rtLex n ('L':'i':'f':'t':'1':cs)  = (n, "L"):rtLex n cs
rtLex n ('L':'i':'f':'t':'2':cs)  = (n, "M"):rtLex n cs

rtLex n (c:cs)
   | isDigit c 
   = (n, c:takeWhile isDigit cs):rtLex n (dropWhile isDigit cs)
   | otherwise 
   = myFail ("Illegal character " ++ show c ++
           " in lattice table, line " ++ show n ++ "." )


-- ==========================================================--
--
rtPWithComma p = paThen2 (\a b -> a) p (paLit ",")

-- ==========================================================--
--
rtListMain p
  = paAlts 
    [ ( (=="]"), 
        paApply (paLit "]") (const []) ),

      ( const True, 
        paThen3 (\a b c -> a ++ [b]) 
               (paZeroOrMore (rtPWithComma p)) p (paLit "]") ) ]

-- ==========================================================--
--
rtList p = paThen2 (\a b -> b) (paLit "[") (rtListMain p)

-- ==========================================================--
--
rtListDomain = rtList rtDomain

-- ==========================================================--
--
rtDomain
  = paAlts
    [
       ( (=="("), paThen3 (\a b c -> b) (paLit "(") rtDomain (paLit ")") ),
       ( (=="T"), paApply (paLit "T") (const Two) ),
       ( (=="L"), paThen2 (\a b -> Lift1 b) (paLit "L") rtListDomain ),
       ( (=="M"), paThen2 (\a b -> Lift2 b) (paLit "M") rtListDomain ),
       ( (=="F"), paThen3 (\a b c -> Func b c)
                          (paLit "F") rtListDomain rtDomain )
    ]

-- ==========================================================--
--
rtPair pa pb
   = paThen4 (\a b c d -> (b,d)) (paLit "(") pa (paLit ",") (
     paThen2 (\a b -> a)         pb (paLit ")") )

-- ==========================================================--
--
rtTable 
  = rtList (rtPair rtDomain paNum)


-- ==========================================================--
-- === end                                   ReadTable.hs ===--
-- ==========================================================--