a novice Alex question

Hi, I am trying out Alex. I copied the calculator specification file from Alex's official document and changed the wrapper type from "basic" to "monad". However, after I generated the ".hs" file from the lexical specification and compiled the ".hs" file, I got the message "Variable not in scope: `alexEOF'". I cannot find explanation about this 'alexEOF' function in the document. Can any body be kindly enough to tell me what this function is? Should I write it myself or not? My lexical code is listed as the below. Thanks a lot. { module Lex where } %wrapper "monad" $digit = 0-9 -- digits $alpha = [a-zA-Z] -- alphabetic characters tokens :- $white+ ; "--".* ; let { \s -> Let } in { \s -> In } $digit+ { \s -> Int (read s) } [\=\+\-\*\/\(\)] { \s -> Sym (head s) } $alpha [$alpha $digit \_ \']* { \s -> Var s } { -- Each action has type :: String -> Token -- The token type: data Token = Let | In | Sym Char | Var String | Int Int deriving (Eq,Show) } -- Xiong, Yingfei (熊英飞) Ph.D. Student Institute of Software School of Electronics Engineering and Computer Science Peking University Beijing, 100871, PRC. Web: http://xiong.yingfei.googlepages.com

On Aug 25, 2006, at 6:27 AM, Xiong Yingfei wrote:
Hi,
I am trying out Alex. I copied the calculator specification file from Alex's official document and changed the wrapper type from "basic" to "monad". However, after I generated the ".hs" file from the lexical specification and compiled the ".hs" file, I got the message "Variable not in scope: `alexEOF'". I cannot find explanation about this 'alexEOF' function in the document. Can any body be kindly enough to tell me what this function is? Should I write it myself or not? My lexical code is listed as the below. Thanks a lot.
You should provide alexEOF. The idea is that it is a special token representing the end of input. This is necessary because the monad wrapper doesn't deliver a list of tokens like the basic wrapper, so it needs some way to signal the end of input. The easiest thing to do is add a constructor to your token datatype, and then just set alexEOF to that constructor: data Token = .... | EOFToken alexEOF = EOFToken
{ module Lex where
}
%wrapper "monad"
$digit = 0-9 -- digits $alpha = [a-zA-Z] -- alphabetic characters
tokens :-
$white+ ; "--".* ; let { \s -> Let } in { \s -> In } $digit+ { \s -> Int (read s) } [\=\+\-\*\/\(\)] { \s -> Sym (head s) } $alpha [$alpha $digit \_ \']* { \s -> Var s }
{ -- Each action has type :: String -> Token
-- The token type: data Token = Let | In | Sym Char | Var String | Int Int deriving (Eq,Show) }
-- Xiong, Yingfei (熊英飞) Ph.D. Student Institute of Software School of Electronics Engineering and Computer Science Peking University Beijing, 100871, PRC. Web: http:// xiong.yingfei.googlepages.com_________________________________________ ______
Rob Dockins Speak softly and drive a Sherman tank. Laugh hard; it's a long way to the bank. -- TMBG

Robert Dockins wrote:
On Aug 25, 2006, at 6:27 AM, Xiong Yingfei wrote:
Hi,
I am trying out Alex. I copied the calculator specification file from Alex's official document and changed the wrapper type from "basic" to "monad". However, after I generated the ".hs" file from the lexical specification and compiled the ".hs" file, I got the message "Variable not in scope: `alexEOF'". I cannot find explanation about this 'alexEOF' function in the document. Can any body be kindly enough to tell me what this function is? Should I write it myself or not? My lexical code is listed as the below. Thanks a lot.
You should provide alexEOF. The idea is that it is a special token representing the end of input. This is necessary because the monad wrapper doesn't deliver a list of tokens like the basic wrapper, so it needs some way to signal the end of input. The easiest thing to do is add a constructor to your token datatype, and then just set alexEOF to that constructor:
data Token = .... | EOFToken
alexEOF = EOFToken
{ module Lex where
}
%wrapper "monad"
$digit = 0-9 -- digits $alpha = [a-zA-Z] -- alphabetic characters
tokens :-
$white+ ; "--".* ; let { \s -> Let } in { \s -> In } $digit+ { \s -> Int (read s) } [\=\+\-\*\/\(\)] { \s -> Sym (head s) } $alpha [$alpha $digit \_ \']* { \s -> Var s }
{ -- Each action has type :: String -> Token
-- The token type: data Token = Let | In | Sym Char | Var String | Int Int deriving (Eq,Show) }
-- Xiong, Yingfei (熊英飞) Ph.D. Student Institute of Software School of Electronics Engineering and Computer Science Peking University Beijing, 100871, PRC. Web: http://xiong.yingfei.googlepages.com________________________________________...
Rob Dockins
Speak softly and drive a Sherman tank. Laugh hard; it's a long way to the bank. -- TMBG
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
I think that you also need add a token definition like : eof {\s -> EOFToken}
participants (3)
-
ivan gomez rodriguez
-
Robert Dockins
-
Xiong Yingfei