lex.icl

   1 implementation module lex
   2
   3 import Data.Either
   4 import Data.List
   5 import StdString
   6 import System.CommandLine
   7 import StdFile
   8 import StdMisc
   9 from StdFunc import id, const
  10 import Data.Maybe
  11 import Control.Applicative
  12 import Control.Monad
  13 import Control.Monad.State
  14 import Data.Functor
  15 from Data.Func import $
  16 from Text import class Text, instance Text String
  17 import qualified Text
  18
  19 lexer :: [Char] -> LexerOutput [Token]
  20 lexer _ = undef
  21
  22 // Misschien moeten we hier continuation style van maken
  23 instance toString (LexerOutput [Token]) where
  24         toString (Left l) = "Error: " +++ l
  25         toString (Right x) = 'Text'.concat (print 0 x)
  26
  27 print :: Int [Token] -> [String]
  28 print i [(IdentToken l):rest] = [tab i:toString l:print i rest]
  29 print i [(NumberToken j):rest] = [tab i:toString j:print i rest]
  30 print i [(CharToken c):rest] = [tab i:"'":toString c:"'":print i rest]
  31 print i [VarToken:rest] = [tab i:"var":print i rest]
  32 print i [VoidToken:rest] = [tab i:"Void":print i rest]
  33 print i [ReturnToken:rest] = [tab i:"return":print i rest]
  34 print i [IfToken:rest] = [tab i:"if":print i rest]
  35 print i [ElseToken:rest] = [tab i:"else":print i rest]
  36 print i [WhileToken:rest] = [tab i:"while":print i rest]
  37 print i [TrueToken:rest] = [tab i:"True":print i rest]
  38 print i [FalseToken:rest] = [tab i:"False":print i rest]
  39 print i [BraceOpenToken:rest] = [tab i:"(":print i rest]
  40 print i [BraceCloseToken:rest] = [tab i:")":print i rest]
  41 print i [CBraceOpenToken:rest] = [tab i:"{\n":print (i+1) rest]
  42 print i [CBraceCloseToken:rest] = [tab i:"}\n":print (i-1) rest]
  43 print i [SquareOpenToken:rest] = [tab i:"[":print i rest]
  44 print i [SquareCloseToken:rest] = [tab i:"]":print i rest]
  45 print i [CommaToken:rest] = [tab i:", ":print i rest]
  46 print i [ColonToken:rest] = [tab i:":":print i rest]
  47 print i [SColonToken:rest] = [tab i:";\n":print i rest]
  48 print i [DotToken:rest] = [tab i:".":print i rest]
  49 print i [PlusToken:rest] = [tab i:" + ":print i rest]
  50 print i [DashToken:rest] = [tab i:" - ":print i rest]
  51 print i [StarToken:rest] = [tab i:" * ":print i rest]
  52 print i [SlashToken:rest] = [tab i:" / ":print i rest]
  53 print i [PercentToken:rest] = [tab i:" % ":print i rest]
  54 print i [AssignmentToken:rest] = [tab i:" = ":print i rest]
  55 print i [LesserToken:rest] = [tab i:" < ":print i rest]
  56 print i [BiggerToken:rest] = [tab i:" > ":print i rest]
  57 print i [ExclamationToken:rest] = [tab i:"!":print i rest]
  58 print i [DoubleColonToken:rest] = [tab i:" :: ":print i rest]
  59 print i [LesserEqToken:rest] = [tab i:" <= ":print i rest]
  60 print i [GreaterEqToken:rest] = [tab i:" >= ":print i rest]
  61 print i [EqualsToken:rest] = [tab i:" == ":print i rest]
  62 print i [AmpersandsToken:rest] = [tab i:" && ":print i rest]
  63 print i [PipesToken:rest] = [tab i:" || ":print i rest]
  64 print i [ArrowToken:rest] = [tab i:" -> ":print i rest]
  65
  66 tab :: Int -> String
  67 tab 0 = ""
  68 tab i = "\t" +++ tab (i-1)
  69
  70 lex :: [Char] -> LexerOutput [Token]
  71 lex ['v':'a':'r':rest] = undef
  72 lex ['V':'o':'i':'d':rest] = undef
  73 lex ['r':'e':'t':'u':'r':'n':rest] = undef
  74 lex ['i':'f':rest] = undef
  75 lex ['e':'l':'s':'e':rest] = undef
  76 lex ['w':'h':'i':'l':'e':rest] = undef
  77 lex ['T':'r':'u':'e':rest] = undef
  78 lex ['F':'a':'l':'s':'e':rest] = undef
  79 lex [':':':':rest] = undef
  80 lex ['<':'=':rest] = undef
  81 lex ['>':'=':rest] = undef
  82 lex ['=':'=':rest] = undef
  83 lex ['&':'&':rest] = undef
  84 lex ['|':'|':rest] = undef
  85 lex ['-':'>':rest] = undef
  86 lex ['(':rest] = undef
  87 lex [')':rest] = undef
  88 lex ['{':rest] = undef
  89 lex ['{':rest] = undef
  90 lex ['[':rest] = undef
  91 lex [':rest]':rest] = undef
  92 lex [',':rest] = undef
  93 lex [':':rest] = undef
  94 lex [';':rest] = undef
  95 lex ['.':rest] = undef
  96 lex ['+':rest] = undef
  97 lex ['-':rest] = undef
  98 lex ['*':rest] = undef
  99 lex ['/':rest] = undef
 100 lex ['%':rest] = undef
 101 lex ['=':rest] = undef
 102 lex ['<':rest] = undef
 103 lex ['>':rest] = undef
 104 lex ['!':rest] = undef
 105 lex ['\'':'\\':x'\'':rest] = case x of
 106         'a' = undef // (CharToken '\a')
 107         'b' = undef // (CharToken '\b')
 108         'f' = undef // (CharToken '\f')
 109         'n' = undef // (CharToken '\n')
 110         'r' = undef // (CharToken '\r')
 111         't' = undef // (CharToken '\t')
 112         'v' = undef // (CharToken '\v')
 113         _ = Left ("Illegal escape: \\" +++ x)
 114 lex ['\'':x:'\'':rest] = undef
 115 lex [x:xs]
 116 | isSpace x = lex xs
 117 | isDigit x = undef //Parse Int
 118 | isAlpha x = undef //Parse ident
 119 | otherwise = Left ("Unexpected character: " +++ toString x)
 120
 121 Start = "Hi"
 122
 123 //:: LexerOutput a :== Either String a
 124 //
 125 //
 126 //runParser :: (Parser a) [Char] -> (LexerOutput a, [Char])
 127 //runParser (Parser p) s = p s
 128 //
 129 //lexer :: [Char] -> LexerOutput [Token]
 130 //
 131 ////lexer functions
 132 //identT  = alpha >>= \a -> many (char '_' <|> alphaNum) >>= \as -> return $ IdentToken [a:as]
 133 //numberT = optional (char '-') >>= \sign -> (some digit) >>= \n -> case sign of
 134 //            Nothing -> return $ NumberToken $ 5  //fromString n
 135 //            _       -> return $ NumberToken $ -5 //(fromString n) * -1
 136 //charLT  = CharToken <$> (char '\'' *> item <* char '\'')
 137 //char2T  = item >>= \c1 -> case c1 of
 138 //            ':' = char ':' >>| return DoubleColonToken
 139 //            '<' = char '=' >>| return LesserEqToken
 140 //            '>' = char '=' >>| return GreaterEqToken
 141 //            '=' = char '=' >>| return EqualsToken
 142 //            '&' = char '&' >>| return AmpersandsToken
 143 //            '|' = char '|' >>| return PipesToken
 144 //            '-' = char '>' >>| return ArrowToken
 145 //            _   = zero
 146 //char1T  = item >>= \c1 -> findT c1 charTokenMap
 147 //varT    = string (fromString "var") >>| return VarToken
 148 //voidT   = string (fromString "Void") >>| return VoidToken
 149 //returnT = string (fromString "return") >>| return ReturnToken
 150 //ifT     = string (fromString "if") >>| return IfToken
 151 //elseT   = string (fromString "else") >>| return ElseToken
 152 //whileT  = string (fromString "while") >>| return WhileToken
 153 //trueT   = string (fromString "True") >>| return TrueToken
 154 //falseT  = string (fromString "False") >>| return FalseToken
 155 ////note, for the anyToken parser the order matters!
 156 //anyT    = char2T <|> char1T <|> varT <|> voidT <|> returnT <|> ifT <|> elseT <|> whileT <|>
 157 //          trueT <|> falseT <|> numberT <|> identT <|> charLT
 158 //
 159 //Start :: *World -> *World
 160 //Start w
 161 //# (args, w) = getCommandLine w // We lezen nu nog standaard van stdin
 162 //# (out, w) = stdio w
 163 //# (toparse, out) = readEntireFile out
 164 //# out = out <<< toString (lexer toparse)
 165 //# (b, w) = fclose out w
 166 //| not b = setReturnCode 1 w
 167 //= w
 168 //      where
 169 //              readEntireFile :: *File -> *([Char], *File)
 170 //              readEntireFile f
 171 //              # (b, c, f) = freadc f
 172 //              | not b = ([], f)
 173 //              # (cs, f) = readEntireFile f
 174 //              = ([c:cs], f)
 175 //
 176 //
 177 //
 178 //charTokenMap =  [('(', BraceOpenToken)
 179 //                ,(')', BraceCloseToken)
 180 //                ,('{', CBraceOpenToken)
 181 //                ,('}', CBraceCloseToken)
 182 //                ,('[', SquareOpenToken)
 183 //                ,(']', SquareCloseToken)
 184 //                ,(',', CommaToken)
 185 //                ,(':', ColonToken)
 186 //                ,(';', SColonToken)
 187 //                ,('.', DotToken)
 188 //                ,('+', PlusToken)
 189 //                ,('-', DashToken)
 190 //                ,('*', StarToken)
 191 //                ,('/', SlashToken)
 192 //                ,('%', PercentToken)
 193 //                ,('=', AssignmentToken)
 194 //                ,('<', LesserToken)
 195 //                ,('>', BiggerToken)
 196 //                ,('!', ExclamationToken)]
 197 //findT c []           = fail "Unrecognized character"
 198 //findT c [(k,v):xs]   = if (c==k) (return v) (findT c xs)
 199 //
 200 //
 201 //// Clean adaption of Yard, a parsec like parser combinator
 202 //:: Parser a = Parser ([Char] -> (LexerOutput a, [Char]))
 203 //
 204 //runParser :: (Parser a) [Char] -> (LexerOutput a, [Char])
 205 //runParser (Parser p) s = p s
 206 //
 207 //instance Functor Parser where
 208 //    fmap f s    = liftM f s
 209 //
 210 //instance Applicative Parser where
 211 //    pure a      = Parser $ \s -> (Right a, s)
 212 //    (<*>) sf s  = ap sf s
 213 //
 214 //instance Monad Parser where
 215 //    bind p f    = Parser $ \s -> let (out, rest) = runParser p s in case out of
 216 //                    Left e  = (Left e, rest)
 217 //                    Right t = runParser (f t) rest
 218 //
 219 ////gives us some, many and optional
 220 //instance Alternative Parser where
 221 //    empty       = zero
 222 //    (<|>) p1 p2 = Parser $ \s -> let (out, rest) = runParser p1 s in case out of
 223 //                    Left e  = runParser p2 s
 224 //                    Right t = (Right t, rest)
 225 //
 226 ////parser that fails with error
 227 //fail :: String -> Parser a
 228 //fail e = Parser $ \s -> (Left e, s)
 229 //
 230 ////parser that always fails
 231 //zero :: Parser a
 232 //zero = fail "Zero parser"
 233 //
 234 ////matches exactly one Char
 235 //item :: Parser Char
 236 //item = Parser $ \s -> case s of
 237 //        []      = (Left "Unexpected empty input", s)
 238 //        [x:xs]  = (Right x, xs)
 239 //
 240 ////matches any char which satisfies f
 241 //satisfy :: (Char -> Bool) -> Parser Char
 242 //satisfy f = item >>= (\r -> if (f r) (return r) zero)
 243 //
 244 ////tries a parser, if it fails returns a default value
 245 //optionalDef :: a (Parser a) -> Parser a
 246 //optionalDef def p = p <|> return def
 247 //
 248 ////matched given char
 249 //char :: Char -> Parser Char
 250 //char c = satisfy (\i -> c==i) //I hate that we can't do: satisfy (==c)
 251 //
 252 //alpha :: Parser Char
 253 //alpha = satisfy isAlpha
 254 //
 255 //digit :: Parser Char
 256 //digit = satisfy isDigit
 257 //
 258 //alphaNum :: Parser Char
 259 //alphaNum = alpha <|> digit
 260 //
 261 ////matches a given String
 262 //string :: [Char] -> Parser [Char]
 263 //string s = mapM_ char s >>| return s