LexStr

module LexStr(tab,lexStr,lexChr) where

import Char

import Extra(Pos(..))
import Error(errorLC)
import Lex
import LexLow

tab :: Int -> Int
tab l = (m*8+1) where m = (l+7)`div`8

lexStr :: Int->Int->[Char] -> (Int,Int,[Char],[Char])
lexStr r c xs = pS '"' r c [] xs

lexChr :: Int->Int->[Char] -> (Int,Int,Char,[Char])
lexChr r c xs = case pS '\'' r c [] xs of
                (r',c',[ch],xs') -> (r',c',ch,xs')
                (_,_,[] ,_) -> errorLC r c "Empty character."
                (_,_,cs ,_) -> errorLC r c ("Character with length > 1 '" ++ cs ++ "'.")

---- local


pS :: Char->Int->Int->[Char]->[Char] -> (Int,Int,[Char],[Char])
pS d r c a []         = errorLC r c "Open string/character."
pS d r c a ('\\':'&':xs) = pS d r (c+2) a xs
pS d r c a ('\\':'a':xs) = pS d r (c+2) ('\a':a) xs
pS d r c a ('\\':'b':xs) = pS d r (c+2) ('\b':a) xs
pS d r c a ('\\':'f':xs) = pS d r (c+2) ('\f':a) xs
pS d r c a ('\\':'n':xs) = pS d r (c+2) ('\n':a) xs
pS d r c a ('\\':'r':xs) = pS d r (c+2) ('\r':a) xs
pS d r c a ('\\':'t':xs) = pS d r (c+2) ('\t':a) xs
pS d r c a ('\\':'v':xs) = pS d r (c+2) ('\v':a) xs
pS d r c a ('\\':'\\':xs) = pS d r (c+2) ('\\':a) xs
pS d r c a ('\\':'"':xs) = pS d r (c+2) ('"':a) xs
pS d r c a ('\\':'\'':xs)= pS d r (c+2) ('\'':a) xs
pS d r c a ('\\':'N':'U':'L':xs) = pS d r (c+4) ('\NUL':a) xs
pS d r c a ('\\':'S':'O':'H':xs) = pS d r (c+4) ('\SOH':a) xs
pS d r c a ('\\':'S':'T':'X':xs) = pS d r (c+4) ('\STX':a) xs
pS d r c a ('\\':'E':'T':'X':xs) = pS d r (c+4) ('\ETX':a) xs
pS d r c a ('\\':'E':'O':'T':xs) = pS d r (c+4) ('\EOT':a) xs
pS d r c a ('\\':'E':'N':'Q':xs) = pS d r (c+4) ('\ENQ':a) xs
pS d r c a ('\\':'A':'C':'K':xs) = pS d r (c+4) ('\ACK':a) xs
pS d r c a ('\\':'B':'E':'L':xs) = pS d r (c+4) ('\BEL':a) xs
pS d r c a ('\\':'B':'S':xs)     = pS d r (c+3) ('\BS':a) xs
pS d r c a ('\\':'H':'T':xs)     = pS d r (c+3) ('\HT':a) xs
pS d r c a ('\\':'L':'F':xs)     = pS d r (c+3) ('\LF':a) xs
pS d r c a ('\\':'V':'T':xs)     = pS d r (c+3) ('\VT':a) xs
pS d r c a ('\\':'F':'F':xs)     = pS d r (c+3) ('\FF':a) xs
pS d r c a ('\\':'C':'R':xs)     = pS d r (c+3) ('\CR':a) xs
pS d r c a ('\\':'S':'O':xs)     = pS d r (c+3) ('\SO':a) xs
pS d r c a ('\\':'S':'I':xs)     = pS d r (c+3) ('\SI':a) xs
pS d r c a ('\\':'D':'L':'E':xs) = pS d r (c+4) ('\DLE':a) xs
pS d r c a ('\\':'D':'C':'1':xs) = pS d r (c+4) ('\DC1':a) xs
pS d r c a ('\\':'D':'C':'2':xs) = pS d r (c+4) ('\DC2':a) xs
pS d r c a ('\\':'D':'C':'3':xs) = pS d r (c+4) ('\DC3':a) xs
pS d r c a ('\\':'D':'C':'4':xs) = pS d r (c+4) ('\DC4':a) xs
pS d r c a ('\\':'N':'A':'K':xs) = pS d r (c+4) ('\NAK':a) xs
pS d r c a ('\\':'S':'Y':'N':xs) = pS d r (c+4) ('\SYN':a) xs
pS d r c a ('\\':'E':'T':'B':xs) = pS d r (c+4) ('\ETB':a) xs
pS d r c a ('\\':'C':'A':'N':xs) = pS d r (c+4) ('\CAN':a) xs
pS d r c a ('\\':'E':'M':xs)     = pS d r (c+3) ('\EM':a) xs
pS d r c a ('\\':'S':'U':'B':xs) = pS d r (c+4) ('\SUB':a) xs
pS d r c a ('\\':'E':'S':'C':xs) = pS d r (c+4) ('\ESC':a) xs
pS d r c a ('\\':'F':'S':xs)     = pS d r (c+3) ('\FS':a) xs
pS d r c a ('\\':'G':'S':xs)     = pS d r (c+3) ('\GS':a) xs
pS d r c a ('\\':'R':'S':xs)     = pS d r (c+3) ('\RS':a) xs
pS d r c a ('\\':'U':'S':xs)     = pS d r (c+3) ('\US':a) xs
pS d r c a ('\\':'S':'P':xs)     = pS d r (c+3) ('\SP':a) xs
pS d r c a ('\\':'D':'E':'L':xs) = pS d r (c+4) ('\DEL':a) xs
pS d r c a ('\\':'^':x:xs) = if ox >= 64 && ox <96 then                 -- Fusk ?
                           pS d r (c+3) (toEnum (ox-64):a) xs 
                         else
                           errorLC r c ("Illegal control character '\\^" ++ [x] ++ "'.")
                             where ox = fromEnum x
pS d r c a ('\\':'o':xs) = pS d r c' (toEnum (fromInteger n):a) xs' where (c',n,xs') = lexInteger  8 (c+2) xs
pS d r c a ('\\':'x':xs) = pS d r c' (toEnum (fromInteger n):a) xs' where (c',n,xs') = lexInteger (8+8) (c+2) xs
pS d r c a ('\\':' ':xs)  = pS d r' c' a xs' where (r',c',xs') = pW r (c+2) xs
pS d r c a ('\\':'\t':xs) = pS d r' c' a xs' where (r',c',xs') = pW r (tab(c+1)) xs
pS d r c a ('\\':'\n':xs) = pS d r' c' a xs' where (r',c',xs') = pW (r+1) 1 xs
pS d r c a ('\\':x:xs) = if isDigit x then
                       case lexInteger 10 (c+1) (x:xs) of
			 (c',i,xs') -> pS d r c' (toEnum (fromInteger i):a) xs'
                     else
                       errorLC r c ("Illegal escape character '" ++ x: "'.")
pS d r c a (x:xs)    = if d == x then
                      (r,c+1,reverse a,xs)
                    else
                      pS d r (c+1) (x:a) xs

pW :: Int -> Int -> [Char] -> (Int,Int,[Char])
pW r c [] =    errorLC r c "End of file in string gap."
pW r c ('\\':xs) = (r,c+1,xs)
pW r c (' ':xs) =  pW r (c+1) xs
pW r c ('\t':xs) = pW r (tab c) xs
pW r c ('\n':xs) = pW (r+1) 1 xs
pW r c ('\f':xs) = pW (r+1) 1 xs
pW r c ('\v':xs) = pW (r+1) 1 xs
pW r c (x:xs) = errorLC r c ("Illegal character in string gap '" ++ x:"'.")