Skip to content
Snippets Groups Projects
Commit 41d93e19 authored by ik1g19's avatar ik1g19
Browse files

add ex1 and ex2

parents
No related branches found
No related tags found
No related merge requests found
Showing
with 4348 additions and 0 deletions
zipL :: ([Int],[Int]) -> [[Int]]
zipL (xs,ys) | length xs /= length ys = [[]]
zipL ([],[]) = []
zipL (x:xs,y:ys) = [x,y] : zipL (xs,ys)
\ No newline at end of file
.stack-work/
*~
\ No newline at end of file
# Changelog for exercise2stack
## Unreleased changes
Copyright ik (c) 2021
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of ik nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
# exercise2stack
import Distribution.Simple
main = defaultMain
File added
File added
import Tokens
import System.Environment
import Control.Exception
import System.IO
main :: IO ()
main = catch main' noLex
main' = do (fileName : _ ) <- getArgs
sourceText <- readFile fileName
putStrLn ("Lexing : " ++ sourceText)
let lexedProg = alexScanTokens sourceText
putStrLn ("Lexed as " ++ (show lexedProg))
noLex :: ErrorCall -> IO ()
noLex e = do let err = show e
hPutStr stderr ("Problem with Lexing : " ++ err)
return ()
\ No newline at end of file
{
module Tokens where
}
%wrapper "basic"
$digit = 0-9
-- digits
$alpha = [a-zA-Z]
-- alphabetic characters
tokens :-
$white+ ;
"--".* ;
let { \s -> TokenLet }
in { \s -> TokenIn }
$digit+ { \s -> TokenInt (read s) }
\= { \s -> TokenEq }
\+ { \s -> TokenPlus }
\- { \s -> TokenMinus }
\* { \s -> TokenTimes }
\/ { \s -> TokenDiv }
\^ { \s -> TokenExp }
\( { \s -> TokenLParen }
\) { \s -> TokenRParen }
$alpha [$alpha $digit \_ \']* { \s -> TokenVar s }
{
-- Each action has type :: String -> Token
-- The token type:
data Token =
TokenLet |
TokenIn |
TokenInt Int |
TokenVar String |
TokenEq |
TokenPlus |
TokenMinus |
TokenTimes |
TokenDiv |
TokenExp |
TokenLParen |
TokenRParen
deriving (Eq,Show)
}
\ No newline at end of file
File added
import Tokens
import System.Environment
import Control.Exception
import System.IO
main :: IO ()
main = catch main' noLex
main' = do (fileName : _ ) <- getArgs
sourceText <- readFile fileName
putStrLn ("Lexing : " ++ sourceText)
let lexedProg = (alexScanTokens sourceText)
putStrLn ("lexed as " ++ (show lexedProg))
noLex :: ErrorCall -> IO ()
noLex e = do let err = show e
hPutStr stderr ("Problem with lexing: " ++ err)
return ()
\ No newline at end of file
{
module Tokens where
}
%wrapper "posn"
$digit = 0-9
-- digits
$alpha = [a-zA-Z]
-- alphabetic characters
tokens :-
$white+ ;
"--".* ;
let { \p s -> TokenLet p}
in { \p s -> TokenIn p }
$digit+ { \p s -> TokenInt p (read s) }
\= { \p s -> TokenEq p }
\+ { \p s -> TokenPlus p }
\- { \p s -> TokenMinus p }
\* { \p s -> TokenTimes p }
\/ { \p s -> TokenDiv p }
\^ { \p s -> TokenExp p }
\( { \p s -> TokenLParen p }
\) { \p s -> TokenRParen p }
$alpha [$alpha $digit \_ \’]* { \p s -> TokenVar p s }
{
-- Each action has type :: AlexPosn -> String -> Token
-- The token type:
data Token =
TokenLet AlexPosn |
TokenIn AlexPosn |
TokenInt AlexPosn Int |
TokenVar AlexPosn String |
TokenEq AlexPosn |
TokenPlus AlexPosn |
TokenMinus AlexPosn |
TokenTimes AlexPosn |
TokenDiv AlexPosn |
TokenExp AlexPosn |
TokenLParen AlexPosn |
TokenRParen AlexPosn
deriving (Eq,Show)
tokenPosn :: Token -> String
tokenPosn (TokenInt (AlexPn a l c) n) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenVar (AlexPn a l c) x) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenLet (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenIn (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenEq (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenPlus (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenMinus (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenTimes (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenDiv (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenExp (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenLParen (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenRParen (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
}
\ No newline at end of file
File added
{
module MDLTokens where
}
%wrapper "posn"
$digit = 0-9
-- digits
tokens :-
$white+ ;
"--".* ;
Forward { (\p s -> TokenForward p)}
Rotate { (\p s -> TokenRotate p) }
[1-9] { (\p s -> TokenDigit p (read s)) }
$digit $digit+ { (\p s -> TokenInt p (read s)) }
Check { (\p s -> TokenCheck p) }
If { (\p s -> TokenIf p) }
Then { (\p s -> TokenThen p) }
Else { (\p s -> TokenElse p) }
L { (\p s -> TokenLeft p) }
R { (\p s -> TokenRight p) }
\; { (\p s -> TokenSeq p )}
\( { (\p s -> TokenLParen p) }
\) { (\p s -> TokenRParen p) }
{
-- Each action has type :: AlexPosn -> String -> MDLToken
-- The token type:
data MDLToken =
TokenForward AlexPosn |
TokenRotate AlexPosn |
TokenDigit AlexPosn Int |
TokenInt AlexPosn Int |
TokenCheck AlexPosn |
TokenIf AlexPosn |
TokenThen AlexPosn |
TokenElse AlexPosn |
TokenLeft AlexPosn |
TokenRight AlexPosn |
TokenSeq AlexPosn |
TokenLParen AlexPosn |
TokenRParen AlexPosn
deriving (Eq,Show)
tokenPosn :: MDLToken -> String
tokenPosn (TokenForward (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenRotate (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenDigit (AlexPn a l c) _) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenInt (AlexPn a l c) _) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenCheck (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenIf (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenThen (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenElse (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenLeft (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenRight (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenSeq (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenLParen (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
tokenPosn (TokenRParen (AlexPn a l c)) = show(l) ++ ":" ++ show(c)
}
\ No newline at end of file
import MDLTokens
import System.Environment
import Control.Exception
import System.IO
main :: IO ()
main = catch main' noParse
main' = do (fileName : _ ) <- getArgs
sourceText <- readFile fileName
putStrLn ("Parsing : " ++ sourceText)
let parsedProg = parseCalc (alexScanTokens sourceText)
putStrLn ("Parsed as " ++ (show parsedProg))
noParse :: ErrorCall -> IO ()
noParse e = do let err = show e
hPutStr stderr err
return ()
\ No newline at end of file
Forward 10 ;
Rotate L ;
If (Check 3)
Then Rotate L ; Forward 1 ; Rotate R
Else Forward 3 ; Rotate L
Forward 10 ;
Rotate L ;
If (Check 3)
Then Rotate L ; Forward 1 ; Rotate R
Else Forward 3 ; Rotate L
Rotate L
module Main where
import Tokens
import System.Environment
import Control.Exception
import System.IO
main :: IO ()
main = catch main' noLex
main' = do (fileName : _) <- getArgs
sourceText <- readFile fileName
putStrLn $ "Lexing: " ++ sourceText
let lexedProg = alexScanTokens sourceText
putStrLn $ "Lexed as: " ++ (show lexedProg)
noLex :: ErrorCall -> IO ()
noLex e = do let err = show e
hPutStrLn stderr ("Problem with lexing :" ++ err)
return ()
\ No newline at end of file
{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-}
{-# LANGUAGE CPP #-}
{-# LINE 1 "Tokens.x" #-}
module Tokens where
#if __GLASGOW_HASKELL__ >= 603
#include "ghcconfig.h"
#elif defined(__GLASGOW_HASKELL__)
#include "config.h"
#endif
#if __GLASGOW_HASKELL__ >= 503
import Data.Array
#else
import Array
#endif
{-# LINE 1 "templates/wrappers.hs" #-}
-- -----------------------------------------------------------------------------
-- Alex wrapper code.
--
-- This code is in the PUBLIC DOMAIN; you may copy it freely and use
-- it for any purpose whatsoever.
import Data.Word (Word8)
import Data.Char (ord)
import qualified Data.Bits
-- | Encode a Haskell String to a list of Word8 values, in UTF8 format.
utf8Encode :: Char -> [Word8]
utf8Encode = uncurry (:) . utf8Encode'
utf8Encode' :: Char -> (Word8, [Word8])
utf8Encode' c = case go (ord c) of
(x, xs) -> (fromIntegral x, map fromIntegral xs)
where
go oc
| oc <= 0x7f = ( oc
, [
])
| oc <= 0x7ff = ( 0xc0 + (oc `Data.Bits.shiftR` 6)
, [0x80 + oc Data.Bits..&. 0x3f
])
| oc <= 0xffff = ( 0xe0 + (oc `Data.Bits.shiftR` 12)
, [0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)
, 0x80 + oc Data.Bits..&. 0x3f
])
| otherwise = ( 0xf0 + (oc `Data.Bits.shiftR` 18)
, [0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f)
, 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)
, 0x80 + oc Data.Bits..&. 0x3f
])
type Byte = Word8
-- -----------------------------------------------------------------------------
-- The input type
-- -----------------------------------------------------------------------------
-- Token positions
-- `Posn' records the location of a token in the input text. It has three
-- fields: the address (number of chacaters preceding the token), line number
-- and column of a token within the file. `start_pos' gives the position of the
-- start of the file and `eof_pos' a standard encoding for the end of file.
-- `move_pos' calculates the new position after traversing a given character,
-- assuming the usual eight character tab stops.
-- -----------------------------------------------------------------------------
-- Monad (default and with ByteString input)
-- -----------------------------------------------------------------------------
-- Basic wrapper
type AlexInput = (Char,[Byte],String)
alexInputPrevChar :: AlexInput -> Char
alexInputPrevChar (c,_,_) = c
-- alexScanTokens :: String -> [token]
alexScanTokens str = go ('\n',[],str)
where go inp__@(_,_bs,s) =
case alexScan inp__ 0 of
AlexEOF -> []
AlexError _ -> error "lexical error"
AlexSkip inp__' _ln -> go inp__'
AlexToken inp__' len act -> act (take len s) : go inp__'
alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)
alexGetByte (c,(b:bs),s) = Just (b,(c,bs,s))
alexGetByte (_,[],[]) = Nothing
alexGetByte (_,[],(c:s)) = case utf8Encode' c of
(b, bs) -> Just (b, (c, bs, s))
-- -----------------------------------------------------------------------------
-- Basic wrapper, ByteString version
-- -----------------------------------------------------------------------------
-- Posn wrapper
-- Adds text positions to the basic model.
-- -----------------------------------------------------------------------------
-- Posn wrapper, ByteString version
-- -----------------------------------------------------------------------------
-- GScan wrapper
-- For compatibility with previous versions of Alex, and because we can.
alex_tab_size :: Int
alex_tab_size = 8
alex_base :: Array Int Int
alex_base = listArray (0 :: Int, 28)
[ -8
, -147
, -76
, 0
, 37
, 0
, 165
, -121
, 293
, 549
, 485
, 0
, -1
, 731
, 939
, 1014
, -35
, 0
, 0
, -22
, 0
, 0
, 0
, 0
, 0
, 1101
, 1176
, 1263
, 1338
]
alex_table :: Array Int Int
alex_table = listArray (0 :: Int, 1593)
[ 0
, 12
, 12
, 12
, 12
, 12
, 26
, 1
, 12
, 12
, 12
, 12
, 12
, 16
, 16
, 16
, 16
, 16
, 16
, 16
, 16
, 16
, 16
, 13
, 12
, 0
, 0
, 0
, 0
, 0
, 0
, 12
, 22
, 23
, 20
, 18
, 0
, 19
, 0
, 21
, 16
, 16
, 16
, 16
, 16
, 16
, 16
, 16
, 16
, 16
, 0
, 0
, 0
, 17
, 0
, 0
, 0
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 0
, 0
, 0
, 24
, 0
, 0
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 27
, 26
, 26
, 25
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 10
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, 2
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, 8
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 9
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, 9
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 11
, 10
, 8
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 3
, 2
, 6
, 5
, 5
, 5
, 4
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 0
, 0
, 0
, 0
, 26
, 0
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 0
, 0
, 0
, 0
, 26
, 0
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 0
, 0
, 0
, 0
, 0
, 0
, 7
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 0
, 0
, 0
, 0
, 26
, 0
, 26
, 26
, 26
, 26
, 28
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 0
, 0
, 0
, 0
, 0
, 0
, 7
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 0
, 0
, 0
, 0
, 26
, 0
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 0
, 0
, 0
, 0
, 0
, 0
, 7
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 0
, 0
, 0
, 0
, 26
, 0
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 15
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 0
, 0
, 0
, 0
, 0
, 0
, 7
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 0
, 0
, 0
, 0
, 26
, 0
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 26
, 14
, 26
, 26
, 26
, 26
, 26
, 26
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 7
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 7
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
, 0
]
alex_check :: Array Int Int
alex_check = listArray (0 :: Int, 1593)
[ -1
, 9
, 10
, 11
, 12
, 13
, 153
, 128
, 9
, 10
, 11
, 12
, 13
, 48
, 49
, 50
, 51
, 52
, 53
, 54
, 55
, 56
, 57
, 45
, 32
, -1
, -1
, -1
, -1
, -1
, -1
, 32
, 40
, 41
, 42
, 43
, -1
, 45
, -1
, 47
, 48
, 49
, 50
, 51
, 52
, 53
, 54
, 55
, 56
, 57
, -1
, -1
, -1
, 61
, -1
, -1
, -1
, 65
, 66
, 67
, 68
, 69
, 70
, 71
, 72
, 73
, 74
, 75
, 76
, 77
, 78
, 79
, 80
, 81
, 82
, 83
, 84
, 85
, 86
, 87
, 88
, 89
, 90
, -1
, -1
, -1
, 94
, -1
, -1
, 97
, 98
, 99
, 100
, 101
, 102
, 103
, 104
, 105
, 106
, 107
, 108
, 109
, 110
, 111
, 112
, 113
, 114
, 115
, 116
, 117
, 118
, 119
, 120
, 121
, 122
, 191
, 192
, 193
, 194
, 195
, 196
, 197
, 198
, 199
, 200
, 201
, 202
, 203
, 204
, 205
, 206
, 207
, 208
, 209
, 210
, 211
, 212
, 213
, 214
, 215
, 216
, 217
, 218
, 219
, 220
, 221
, 222
, 223
, 224
, 225
, 226
, 227
, 228
, 229
, 230
, 231
, 232
, 233
, 234
, 235
, 236
, 237
, 238
, 239
, 240
, 241
, 242
, 243
, 244
, 245
, 246
, 247
, 248
, 249
, 250
, 251
, 252
, 253
, 254
, 255
, 143
, 144
, 145
, 146
, 147
, 148
, 149
, 150
, 151
, 152
, 153
, 154
, 155
, 156
, 157
, 158
, 159
, 160
, 161
, 162
, 163
, 164
, 165
, 166
, 167
, 168
, 169
, 170
, 171
, 172
, 173
, 174
, 175
, 176
, 177
, 178
, 179
, 180
, 181
, 182
, 183
, 184
, 185
, 186
, 187
, 188
, 189
, 190
, 191
, 192
, 193
, 194
, 195
, 196
, 197
, 198
, 199
, 200
, 201
, 202
, 203
, 204
, 205
, 206
, 207
, 208
, 209
, 210
, 211
, 212
, 213
, 214
, 215
, 216
, 217
, 218
, 219
, 220
, 221
, 222
, 223
, 224
, 225
, 226
, 227
, 228
, 229
, 230
, 231
, 232
, 233
, 234
, 235
, 236
, 237
, 238
, 239
, 240
, 241
, 242
, 243
, 244
, 245
, 246
, 247
, 248
, 249
, 250
, 251
, 252
, 253
, 254
, 255
, 128
, 129
, 130
, 131
, 132
, 133
, 134
, 135
, 136
, 137
, 138
, 139
, 140
, 141
, 142
, 143
, 144
, 145
, 146
, 147
, 148
, 149
, 150
, 151
, 152
, 153
, 154
, 155
, 156
, 157
, 158
, 159
, 160
, 161
, 162
, 163
, 164
, 165
, 166
, 167
, 168
, 169
, 170
, 171
, 172
, 173
, 174
, 175
, 176
, 177
, 178
, 179
, 180
, 181
, 182
, 183
, 184
, 185
, 186
, 187
, 188
, 189
, 190
, 191
, 192
, 193
, 194
, 195
, 196
, 197
, 198
, 199
, 200
, 201
, 202
, 203
, 204
, 205
, 206
, 207
, 208
, 209
, 210
, 211
, 212
, 213
, 214
, 215
, 216
, 217
, 218
, 219
, 220
, 221
, 222
, 223
, 224
, 225
, 226
, 227
, 228
, 229
, 230
, 231
, 232
, 233
, 234
, 235
, 236
, 237
, 238
, 239
, 240
, 241
, 242
, 243
, 244
, 245
, 246
, 247
, 248
, 249
, 250
, 251
, 252
, 253
, 254
, 255
, 128
, 129
, 130
, 131
, 132
, 133
, 134
, 135
, 136
, 137
, 138
, 139
, 140
, 141
, 142
, 143
, 144
, 145
, 146
, 147
, 148
, 149
, 150
, 151
, 152
, 153
, 154
, 155
, 156
, 157
, 158
, 159
, 160
, 161
, 162
, 163
, 164
, 165
, 166
, 167
, 168
, 169
, 170
, 171
, 172
, 173
, 174
, 175
, 176
, 177
, 178
, 179
, 180
, 181
, 182
, 183
, 184
, 185
, 186
, 187
, 188
, 189
, 190
, 191
, 192
, 193
, 194
, 195
, 196
, 197
, 198
, 199
, 200
, 201
, 202
, 203
, 204
, 205
, 206
, 207
, 208
, 209
, 210
, 211
, 212
, 213
, 214
, 215
, 216
, 217
, 218
, 219
, 220
, 221
, 222
, 223
, 224
, 225
, 226
, 227
, 228
, 229
, 230
, 231
, 232
, 233
, 234
, 235
, 236
, 237
, 238
, 239
, 240
, 241
, 242
, 243
, 244
, 245
, 246
, 247
, 248
, 249
, 250
, 251
, 252
, 253
, 254
, 255
, 0
, 1
, 2
, 3
, 4
, 5
, 6
, 7
, 8
, 9
, 10
, 11
, 12
, 13
, 14
, 15
, 16
, 17
, 18
, 19
, 20
, 21
, 22
, 23
, 24
, 25
, 26
, 27
, 28
, 29
, 30
, 31
, 32
, 33
, 34
, 35
, 36
, 37
, 38
, 39
, 40
, 41
, 42
, 43
, 44
, 45
, 46
, 47
, 48
, 49
, 50
, 51
, 52
, 53
, 54
, 55
, 56
, 57
, 58
, 59
, 60
, 61
, 62
, 63
, 64
, 65
, 66
, 67
, 68
, 69
, 70
, 71
, 72
, 73
, 74
, 75
, 76
, 77
, 78
, 79
, 80
, 81
, 82
, 83
, 84
, 85
, 86
, 87
, 88
, 89
, 90
, 91
, 92
, 93
, 94
, 95
, 96
, 97
, 98
, 99
, 100
, 101
, 102
, 103
, 104
, 105
, 106
, 107
, 108
, 109
, 110
, 111
, 112
, 113
, 114
, 115
, 116
, 117
, 118
, 119
, 120
, 121
, 122
, 123
, 124
, 125
, 126
, 127
, 192
, 193
, 194
, 195
, 196
, 197
, 198
, 199
, 200
, 201
, 202
, 203
, 204
, 205
, 206
, 207
, 208
, 209
, 210
, 211
, 212
, 213
, 214
, 215
, 216
, 217
, 218
, 219
, 220
, 221
, 222
, 223
, 224
, 225
, 226
, 227
, 228
, 229
, 230
, 231
, 232
, 233
, 234
, 235
, 236
, 237
, 238
, 239
, 240
, 241
, 242
, 243
, 244
, 245
, 246
, 247
, 248
, 249
, 250
, 251
, 252
, 253
, 254
, 255
, 10
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, 128
, 129
, 130
, 131
, 132
, 133
, 134
, 135
, 136
, 137
, 138
, 139
, 140
, 141
, 142
, 143
, 144
, 145
, 146
, 147
, 148
, 149
, 150
, 151
, 152
, 153
, 154
, 155
, 156
, 157
, 158
, 159
, 160
, 161
, 162
, 163
, 164
, 165
, 166
, 167
, 168
, 169
, 170
, 171
, 172
, 173
, 174
, 175
, 176
, 177
, 178
, 179
, 180
, 181
, 182
, 183
, 184
, 185
, 186
, 187
, 188
, 189
, 190
, 191
, 192
, 193
, 194
, 195
, 196
, 197
, 198
, 199
, 200
, 201
, 202
, 203
, 204
, 205
, 206
, 207
, 208
, 209
, 210
, 211
, 212
, 213
, 214
, 215
, 216
, 217
, 218
, 219
, 220
, 221
, 222
, 223
, 224
, 225
, 226
, 227
, 228
, 229
, 230
, 231
, 232
, 233
, 234
, 235
, 236
, 237
, 238
, 239
, 240
, 241
, 242
, 243
, 244
, 245
, 246
, 247
, 248
, 249
, 250
, 251
, 252
, 253
, 254
, 255
, 48
, 49
, 50
, 51
, 52
, 53
, 54
, 55
, 56
, 57
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, 65
, 66
, 67
, 68
, 69
, 70
, 71
, 72
, 73
, 74
, 75
, 76
, 77
, 78
, 79
, 80
, 81
, 82
, 83
, 84
, 85
, 86
, 87
, 88
, 89
, 90
, -1
, -1
, -1
, -1
, 95
, -1
, 97
, 98
, 99
, 100
, 101
, 102
, 103
, 104
, 105
, 106
, 107
, 108
, 109
, 110
, 111
, 112
, 113
, 114
, 115
, 116
, 117
, 118
, 119
, 120
, 121
, 122
, 48
, 49
, 50
, 51
, 52
, 53
, 54
, 55
, 56
, 57
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, 65
, 66
, 67
, 68
, 69
, 70
, 71
, 72
, 73
, 74
, 75
, 76
, 77
, 78
, 79
, 80
, 81
, 82
, 83
, 84
, 85
, 86
, 87
, 88
, 89
, 90
, -1
, -1
, -1
, -1
, 95
, -1
, 97
, 98
, 99
, 100
, 101
, 102
, 103
, 104
, 105
, 106
, 107
, 108
, 109
, 110
, 111
, 112
, 113
, 114
, 115
, 116
, 117
, 118
, 119
, 120
, 121
, 122
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, 48
, 49
, 50
, 51
, 52
, 53
, 54
, 55
, 56
, 57
, -1
, -1
, -1
, -1
, -1
, -1
, 226
, 65
, 66
, 67
, 68
, 69
, 70
, 71
, 72
, 73
, 74
, 75
, 76
, 77
, 78
, 79
, 80
, 81
, 82
, 83
, 84
, 85
, 86
, 87
, 88
, 89
, 90
, -1
, -1
, -1
, -1
, 95
, -1
, 97
, 98
, 99
, 100
, 101
, 102
, 103
, 104
, 105
, 106
, 107
, 108
, 109
, 110
, 111
, 112
, 113
, 114
, 115
, 116
, 117
, 118
, 119
, 120
, 121
, 122
, 48
, 49
, 50
, 51
, 52
, 53
, 54
, 55
, 56
, 57
, -1
, -1
, -1
, -1
, -1
, -1
, 226
, 65
, 66
, 67
, 68
, 69
, 70
, 71
, 72
, 73
, 74
, 75
, 76
, 77
, 78
, 79
, 80
, 81
, 82
, 83
, 84
, 85
, 86
, 87
, 88
, 89
, 90
, -1
, -1
, -1
, -1
, 95
, -1
, 97
, 98
, 99
, 100
, 101
, 102
, 103
, 104
, 105
, 106
, 107
, 108
, 109
, 110
, 111
, 112
, 113
, 114
, 115
, 116
, 117
, 118
, 119
, 120
, 121
, 122
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, 48
, 49
, 50
, 51
, 52
, 53
, 54
, 55
, 56
, 57
, -1
, -1
, -1
, -1
, -1
, -1
, 226
, 65
, 66
, 67
, 68
, 69
, 70
, 71
, 72
, 73
, 74
, 75
, 76
, 77
, 78
, 79
, 80
, 81
, 82
, 83
, 84
, 85
, 86
, 87
, 88
, 89
, 90
, -1
, -1
, -1
, -1
, 95
, -1
, 97
, 98
, 99
, 100
, 101
, 102
, 103
, 104
, 105
, 106
, 107
, 108
, 109
, 110
, 111
, 112
, 113
, 114
, 115
, 116
, 117
, 118
, 119
, 120
, 121
, 122
, 48
, 49
, 50
, 51
, 52
, 53
, 54
, 55
, 56
, 57
, -1
, -1
, -1
, -1
, -1
, -1
, 226
, 65
, 66
, 67
, 68
, 69
, 70
, 71
, 72
, 73
, 74
, 75
, 76
, 77
, 78
, 79
, 80
, 81
, 82
, 83
, 84
, 85
, 86
, 87
, 88
, 89
, 90
, -1
, -1
, -1
, -1
, 95
, -1
, 97
, 98
, 99
, 100
, 101
, 102
, 103
, 104
, 105
, 106
, 107
, 108
, 109
, 110
, 111
, 112
, 113
, 114
, 115
, 116
, 117
, 118
, 119
, 120
, 121
, 122
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, 226
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, 226
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
]
alex_deflt :: Array Int Int
alex_deflt = listArray (0 :: Int, 28)
[ -1
, -1
, 11
, 11
, 3
, 3
, -1
, -1
, -1
, 13
, 13
, 13
, -1
, 13
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
, -1
]
alex_accept = listArray (0 :: Int, 28)
[ AlexAccNone
, AlexAccNone
, AlexAccNone
, AlexAccNone
, AlexAccNone
, AlexAccNone
, AlexAccNone
, AlexAccNone
, AlexAccNone
, AlexAccNone
, AlexAccNone
, AlexAccNone
, AlexAccSkip
, AlexAccSkip
, AlexAcc 14
, AlexAcc 13
, AlexAcc 12
, AlexAcc 11
, AlexAcc 10
, AlexAcc 9
, AlexAcc 8
, AlexAcc 7
, AlexAcc 6
, AlexAcc 5
, AlexAcc 4
, AlexAcc 3
, AlexAcc 2
, AlexAcc 1
, AlexAcc 0
]
alex_actions = array (0 :: Int, 15)
[ (14,alex_action_2)
, (13,alex_action_3)
, (12,alex_action_4)
, (11,alex_action_5)
, (10,alex_action_6)
, (9,alex_action_7)
, (8,alex_action_8)
, (7,alex_action_9)
, (6,alex_action_10)
, (5,alex_action_11)
, (4,alex_action_12)
, (3,alex_action_13)
, (2,alex_action_13)
, (1,alex_action_13)
, (0,alex_action_13)
]
{-# LINE 27 "Tokens.x" #-}
-- Each action has type :: String -> Token
-- The token type:
data Token =
TokenLet |
TokenIn |
TokenInt Int |
TokenVar String |
TokenEq |
TokenPlus |
TokenMinus |
TokenTimes |
TokenDiv |
TokenExp |
TokenLParen |
TokenRParen
deriving (Eq,Show)
alex_action_2 = \s -> TokenLet
alex_action_3 = \s -> TokenIn
alex_action_4 = \s -> TokenInt (read s)
alex_action_5 = \s -> TokenEq
alex_action_6 = \s -> TokenPlus
alex_action_7 = \s -> TokenMinus
alex_action_8 = \s -> TokenTimes
alex_action_9 = \s -> TokenDiv
alex_action_10 = \s -> TokenLParen
alex_action_11 = \s -> TokenRParen
alex_action_12 = \s -> TokenExp
alex_action_13 = \s -> TokenVar s
{-# LINE 1 "templates/GenericTemplate.hs" #-}
-- -----------------------------------------------------------------------------
-- ALEX TEMPLATE
--
-- This code is in the PUBLIC DOMAIN; you may copy it freely and use
-- it for any purpose whatsoever.
-- -----------------------------------------------------------------------------
-- INTERNALS and main scanner engine
alexIndexInt16OffAddr arr off = arr ! off
alexIndexInt32OffAddr arr off = arr ! off
quickIndex arr i = arr ! i
-- -----------------------------------------------------------------------------
-- Main lexing routines
data AlexReturn a
= AlexEOF
| AlexError !AlexInput
| AlexSkip !AlexInput !Int
| AlexToken !AlexInput !Int a
-- alexScan :: AlexInput -> StartCode -> AlexReturn a
alexScan input__ (sc)
= alexScanUser undefined input__ (sc)
alexScanUser user__ input__ (sc)
= case alex_scan_tkn user__ input__ (0) input__ sc AlexNone of
(AlexNone, input__') ->
case alexGetByte input__ of
Nothing ->
AlexEOF
Just _ ->
AlexError input__'
(AlexLastSkip input__'' len, _) ->
AlexSkip input__'' len
(AlexLastAcc k input__''' len, _) ->
AlexToken input__''' len (alex_actions ! k)
-- Push the input through the DFA, remembering the most recent accepting
-- state it encountered.
alex_scan_tkn user__ orig_input len input__ s last_acc =
input__ `seq` -- strict in the input
let
new_acc = (check_accs (alex_accept `quickIndex` (s)))
in
new_acc `seq`
case alexGetByte input__ of
Nothing -> (new_acc, input__)
Just (c, new_input) ->
case fromIntegral c of { (ord_c) ->
let
base = alexIndexInt32OffAddr alex_base s
offset = (base + ord_c)
check = alexIndexInt16OffAddr alex_check offset
new_s = if (offset >= (0)) && (check == ord_c)
then alexIndexInt16OffAddr alex_table offset
else alexIndexInt16OffAddr alex_deflt s
in
case new_s of
(-1) -> (new_acc, input__)
-- on an error, we want to keep the input *before* the
-- character that failed, not after.
_ -> alex_scan_tkn user__ orig_input (if c < 0x80 || c >= 0xC0 then (len + (1)) else len)
-- note that the length is increased ONLY if this is the 1st byte in a char encoding)
new_input new_s new_acc
}
where
check_accs (AlexAccNone) = last_acc
check_accs (AlexAcc a ) = AlexLastAcc a input__ (len)
check_accs (AlexAccSkip) = AlexLastSkip input__ (len)
check_accs (AlexAccPred a predx rest)
| predx user__ orig_input (len) input__
= AlexLastAcc a input__ (len)
| otherwise
= check_accs rest
check_accs (AlexAccSkipPred predx rest)
| predx user__ orig_input (len) input__
= AlexLastSkip input__ (len)
| otherwise
= check_accs rest
data AlexLastAcc
= AlexNone
| AlexLastAcc !Int !AlexInput !Int
| AlexLastSkip !AlexInput !Int
data AlexAcc user
= AlexAccNone
| AlexAcc Int
| AlexAccSkip
| AlexAccPred Int (AlexAccPred user) (AlexAcc user)
| AlexAccSkipPred (AlexAccPred user) (AlexAcc user)
type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool
-- -----------------------------------------------------------------------------
-- Predicates on a rule
alexAndPred p1 p2 user__ in1 len in2
= p1 user__ in1 len in2 && p2 user__ in1 len in2
--alexPrevCharIsPred :: Char -> AlexAccPred _
alexPrevCharIs c _ input__ _ _ = c == alexInputPrevChar input__
alexPrevCharMatches f _ input__ _ _ = f (alexInputPrevChar input__)
--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _
alexPrevCharIsOneOf arr _ input__ _ _ = arr ! alexInputPrevChar input__
--alexRightContext :: Int -> AlexAccPred _
alexRightContext (sc) user__ _ _ input__ =
case alex_scan_tkn user__ input__ (0) input__ sc AlexNone of
(AlexNone, _) -> False
_ -> True
-- TODO: there's no need to find the longest
-- match when checking the right context, just
-- the first match will do.
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment