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 -- ==========================================================--