1 
    2 -- ==========================================================--
    3 -- === Read the lattice table.               ReadTable.hs ===--
    4 -- ==========================================================--
    5 
    6 module ReadTable where
    7 import BaseDefs
    8 import Utils
    9 import MyUtils
   10 import Parser2
   11 
   12 import Char(isDigit) -- 1.3
   13 
   14 -- ==========================================================--
   15 --
   16 rtReadTable :: String -> [(Domain, Int)]
   17 
   18 rtReadTable s
   19    = case rtTable (rtLex 1 s) of
   20         PFail [] 
   21            -> myFail "Unexpected end of lattice table"
   22         PFail ((n,t):_) 
   23            -> myFail ("Syntax error in lattice table, line " ++ show n ++ ".")
   24         POk tab [] 
   25            -> tab
   26         POk tab ((n,t):_) 
   27            -> myFail ("Syntax error in lattice table, line " ++ show n ++ ".")
   28 
   29 
   30 -- ==========================================================--
   31 --
   32 rtLex :: Int -> String -> [Token]
   33 
   34 rtLex n [] = []
   35 
   36 rtLex n ('\n':cs) = rtLex (n+1) cs
   37 rtLex n (' ':cs) = rtLex n cs
   38 rtLex n ('\t':cs) = rtLex n cs
   39 
   40 rtLex n ('(':cs) = (n, "("):rtLex n cs
   41 rtLex n (')':cs) = (n, ")"):rtLex n cs
   42 rtLex n ('[':cs) = (n, "["):rtLex n cs
   43 rtLex n (']':cs) = (n, "]"):rtLex n cs
   44 rtLex n (',':cs) = (n, ","):rtLex n cs
   45 
   46 rtLex n ('T':'w':'o':cs)          = (n, "T"):rtLex n cs
   47 rtLex n ('F':'u':'n':'c':cs)      = (n, "F"):rtLex n cs
   48 rtLex n ('L':'i':'f':'t':'1':cs)  = (n, "L"):rtLex n cs
   49 rtLex n ('L':'i':'f':'t':'2':cs)  = (n, "M"):rtLex n cs
   50 
   51 rtLex n (c:cs)
   52    | isDigit c 
   53    = (n, c:takeWhile isDigit cs):rtLex n (dropWhile isDigit cs)
   54    | otherwise 
   55    = myFail ("Illegal character " ++ show c ++
   56            " in lattice table, line " ++ show n ++ "." )
   57 
   58 
   59 -- ==========================================================--
   60 --
   61 rtPWithComma p = paThen2 (\a b -> a) p (paLit ",")
   62 
   63 -- ==========================================================--
   64 --
   65 rtListMain p
   66   = paAlts 
   67     [ ( (=="]"), 
   68         paApply (paLit "]") (const []) ),
   69 
   70       ( const True, 
   71         paThen3 (\a b c -> a ++ [b]) 
   72                (paZeroOrMore (rtPWithComma p)) p (paLit "]") ) ]
   73 
   74 -- ==========================================================--
   75 --
   76 rtList p = paThen2 (\a b -> b) (paLit "[") (rtListMain p)
   77 
   78 -- ==========================================================--
   79 --
   80 rtListDomain = rtList rtDomain
   81 
   82 -- ==========================================================--
   83 --
   84 rtDomain
   85   = paAlts
   86     [
   87        ( (=="("), paThen3 (\a b c -> b) (paLit "(") rtDomain (paLit ")") ),
   88        ( (=="T"), paApply (paLit "T") (const Two) ),
   89        ( (=="L"), paThen2 (\a b -> Lift1 b) (paLit "L") rtListDomain ),
   90        ( (=="M"), paThen2 (\a b -> Lift2 b) (paLit "M") rtListDomain ),
   91        ( (=="F"), paThen3 (\a b c -> Func b c)
   92                           (paLit "F") rtListDomain rtDomain )
   93     ]
   94 
   95 -- ==========================================================--
   96 --
   97 rtPair pa pb
   98    = paThen4 (\a b c d -> (b,d)) (paLit "(") pa (paLit ",") (
   99      paThen2 (\a b -> a)         pb (paLit ")") )
  100 
  101 -- ==========================================================--
  102 --
  103 rtTable 
  104   = rtList (rtPair rtDomain paNum)
  105 
  106 
  107 -- ==========================================================--
  108 -- === end                                   ReadTable.hs ===--
  109 -- ==========================================================--