2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[Lexical analysis]{Lexical analysis}
7 #include "HsVersions.h"
11 isLexCon, isLexVar, isLexId, isLexSym,
12 isLexConId, isLexConSym, isLexVarId, isLexVarSym,
13 mkTupNameStr, ifaceParseErr,
16 IfaceToken(..), lexIface, SYN_IE(IfM), thenIf, returnIf, happyError,
22 IMPORT_1_3(Char(isDigit, isAlpha, isAlphanum, isUpper))
24 IMPORT_DELOOPER(IdLoop) -- get the CostCentre type&constructors from here
26 import CmdLineOpts ( opt_IgnoreIfacePragmas )
27 import Demand ( Demand(..) {- instance Read -} )
28 import UniqFM ( UniqFM, listToUFM, lookupUFM)
29 --import FiniteMap ( FiniteMap, listToFM, lookupFM )
30 import Maybes ( Maybe(..), MaybeErr(..) )
32 import CharSeq ( CSeq )
36 import ErrUtils ( Error(..) )
37 import Outputable ( Outputable(..) )
38 import PprStyle ( PprStyle(..) )
39 import Util ( nOfThem, panic )
48 %************************************************************************
50 \subsection{Lexical categories}
52 %************************************************************************
54 These functions test strings to see if they fit the lexical categories
55 defined in the Haskell report. Normally applied as in e.g. @isCon
59 isLexCon, isLexVar, isLexId, isLexSym, isLexConId, isLexConSym,
60 isLexVarId, isLexVarSym :: FAST_STRING -> Bool
62 isLexCon cs = isLexConId cs || isLexConSym cs
63 isLexVar cs = isLexVarId cs || isLexVarSym cs
65 isLexId cs = isLexConId cs || isLexVarId cs
66 isLexSym cs = isLexConSym cs || isLexVarSym cs
72 | cs == SLIT("[]") = True
73 | c == '(' = True -- (), (,), (,,), ...
74 | otherwise = isUpper c || isUpperISO c
80 | otherwise = isLower c || isLowerISO c
86 | otherwise = c == ':'
93 | otherwise = isSymbolASCII c
99 isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
100 isSymbolISO c = ord c `elem` (0xd7 : 0xf7 : [0xa1 .. 0xbf])
101 isUpperISO (C# c#) = c# `geChar#` '\xc0'# && c# `leChar#` '\xde'# && c# `neChar#` '\xd7'#
102 --0xc0 <= oc && oc <= 0xde && oc /= 0xd7 where oc = ord c
103 isLowerISO (C# c#) = c# `geChar#` '\xdf'# && c# `leChar#` '\xff'# && c# `neChar#` '\xf7'#
104 --0xdf <= oc && oc <= 0xff && oc /= 0xf7 where oc = ord c
108 %************************************************************************
110 \subsection{Tuple strings -- ugh!}
112 %************************************************************************
115 mkTupNameStr 0 = SLIT("()")
116 mkTupNameStr 1 = panic "Name.mkTupNameStr: 1 ???"
117 mkTupNameStr 2 = _PK_ "(,)" -- not strictly necessary
118 mkTupNameStr 3 = _PK_ "(,,)" -- ditto
119 mkTupNameStr 4 = _PK_ "(,,,)" -- ditto
120 mkTupNameStr n = _PK_ ("(" ++ nOfThem (n-1) ',' ++ ")")
125 %************************************************************************
127 \subsection{Data types}
129 %************************************************************************
131 The token data type, fairly un-interesting except from two constructors,
132 @ITidinfo@ and @ITtype@, which are used to lazily lex id info (arity,
133 strictness, unfolding etc) and types for id decls.
135 The Idea/Observation here is that the renamer needs to scan through
136 all of an interface file before it can continue. But only a fraction
137 of the information contained in the file turns out to be useful, so
138 delaying as much as possible of the scanning and parsing of an
139 interface file Makes Sense (Heap profiles of the compiler
140 show at a reduction in heap usage by at least a factor of two,
143 Hence, the interface file lexer spots when value declarations are
144 being scanned and return the @ITidinfo@ and @ITtype@ constructors
145 for the type and any other id info for that binding (unfolding, strictness
146 etc). These constructors are applied to the result of lexing these sub-chunks.
148 The lexing of the type and id info is all done lazily, of course, so
149 the scanning (and subsequent parsing) will be done *only* on the ids the
150 renamer finds out that it is interested in. The rest will just be junked.
151 Laziness, you know it makes sense :-)
155 = ITinterface -- keywords
175 | ITbang -- magic symbols
190 | ITvarid FAST_STRING
191 | ITconid FAST_STRING
192 | ITvarsym FAST_STRING
193 | ITconsym FAST_STRING
194 | ITqvarid (FAST_STRING,FAST_STRING)
195 | ITqconid (FAST_STRING,FAST_STRING)
196 | ITqvarsym (FAST_STRING,FAST_STRING)
197 | ITqconsym (FAST_STRING,FAST_STRING)
199 | ITidinfo [IfaceToken] -- lazily return the stream of tokens for
200 -- the info attached to an id.
201 | ITtysig [IfaceToken] -- lazily return the stream of tokens for
202 -- the info attached to an id.
203 -- Stuff for reading unfoldings
204 | ITarity | ITstrict | ITunfold
205 | ITdemand [Demand] | ITbottom
206 | ITlam | ITbiglam | ITcase | ITprim_case | ITlet | ITletrec | ITin | ITof
207 | ITcoerce_in | ITcoerce_out | ITatsign
208 | ITccall (Bool,Bool) -- (is_casm, may_gc)
210 | ITchar Char | ITstring FAST_STRING
211 | ITinteger Integer | ITdouble Double
212 | ITinteger_lit | ITfloat_lit | ITrational_lit | ITaddr_lit | ITlit_lit | ITstring_lit
213 | ITunknown String -- Used when the lexer can't make sense of it
214 deriving Text -- debugging
216 instance Text CostCentre -- cheat!
220 %************************************************************************
222 \subsection{The lexical analyser}
224 %************************************************************************
227 lexIface :: StringBuffer -> [IfaceToken]
230 -- if bufferExhausted buf then
233 -- _trace ("Lexer: "++[C# (currentChar# buf)]) $
234 case currentChar# buf of
235 -- whitespace and comments, ignore.
236 ' '# -> lexIface (stepOn buf)
237 '\t'# -> lexIface (stepOn buf)
238 '\n'# -> lexIface (stepOn buf)
240 -- Numbers and comments
242 case lookAhead# buf 1# of
243 '-'# -> lex_comment (stepOnBy# buf 2#)
246 then lex_num (negate) (ord# c -# ord# '0'#) (incLexeme (incLexeme buf))
249 -- Leave out nested comments for now; danger of finding { and - juxtaposed by mistake?
250 -- '{' : '-' : cs -> lex_nested_comment 1{-one seen-} cs
253 case prefixMatch (stepOn buf) "..)" of
254 Just buf' -> ITdotdot : lexIface (stepOverLexeme buf')
256 case lookAhead# buf 1# of
257 ','# -> lex_tuple Nothing (stepOnBy# buf 2#)
258 ')'# -> ITconid SLIT("()") : lexIface (stepOnBy# buf 2#)
259 _ -> IToparen : lexIface (stepOn buf)
261 '{'# -> ITocurly : lexIface (stepOn buf)
262 '}'# -> ITccurly : lexIface (stepOn buf)
263 ')'# -> ITcparen : lexIface (stepOn buf)
265 case lookAhead# buf 1# of
266 ']'# -> ITconid SLIT("[]") : lexIface (stepOnBy# buf 2#)
267 _ -> ITobrack : lexIface (stepOn buf)
268 ']'# -> ITcbrack : lexIface (stepOn buf)
269 ','# -> ITcomma : lexIface (stepOn buf)
270 ':'# -> case lookAhead# buf 1# of
271 ':'# -> ITdcolon : lexIface (stepOnBy# buf 2#)
272 _ -> lex_id (incLexeme buf)
273 ';'# -> ITsemi : lexIface (stepOn buf)
274 '\"'# -> case untilEndOfString# (stepOn buf) of
276 -- the string literal does *not* include the dquotes
277 case lexemeToFastString buf' of
278 v -> ITstring v : lexIface (stepOn (stepOverLexeme buf'))
281 -- untilEndOfChar# extends the current lexeme until
282 -- it hits a non-escaped single quote. The lexeme of the
283 -- StringBuffer returned does *not* include the closing quote,
284 -- hence we augment the lexeme and make sure to add the
285 -- starting quote, before `read'ing the string.
287 case untilEndOfChar# (stepOn buf) of
288 buf' -> case reads ('\'':lexemeToString (incLexeme buf')) of
289 [ (ch, rest)] -> ITchar ch : lexIface (stepOverLexeme (incLexeme buf'))
291 -- ``thingy'' form for casm
293 case lookAhead# buf 1# of
294 '`'# -> lex_cstring (stepOnBy# buf 2#) -- remove the `` and go.
295 _ -> lex_id (incLexeme buf) -- add ` to lexeme and assume
296 -- scanning an id of some sort.
299 case lookAhead# buf 1# of
300 'S'# -> case lookAhead# buf 2# of
302 lex_demand (stepOnUntil (not . isSpace)
303 (stepOnBy# buf 3#)) -- past _S_
304 's'# -> case prefixMatch (stepOnBy# buf 2#) "cc_" of
305 Just buf' -> lex_scc (stepOnUntil (not . isSpace)
306 (stepOverLexeme buf'))
307 Nothing -> lex_keyword (stepOnBy# buf 1#) -- drop the '_' and assume
309 _ -> lex_keyword (stepOn buf)
312 if bufferExhausted (stepOn buf) then
317 if isDigit (C# c) then
318 lex_num (id) (ord# c -# ord# '0'#) (incLexeme buf)
323 -- _trace ("comment: "++[C# (currentChar# buf)]) $
324 case untilChar# buf '\n'# of {buf' -> lexIface (stepOverLexeme buf')}
328 -- _trace ("demand: "++[C# (currentChar# buf)]) $
329 case read_em [] buf of { (ls,buf') -> ITdemand ls : lexIface (stepOverLexeme buf')}
331 -- code snatched from Demand.lhs
333 -- _trace ("read_em: "++[C# (currentChar# buf)]) $
334 case currentChar# buf of
335 'L'# -> read_em (WwLazy False : acc) (stepOn buf)
336 'A'# -> read_em (WwLazy True : acc) (stepOn buf)
337 'S'# -> read_em (WwStrict : acc) (stepOn buf)
338 'P'# -> read_em (WwPrim : acc) (stepOn buf)
339 'E'# -> read_em (WwEnum : acc) (stepOn buf)
340 ')'# -> (reverse acc, stepOn buf)
341 'U'# -> do_unpack True acc (stepOnBy# buf 2#)
342 'u'# -> do_unpack False acc (stepOnBy# buf 2#)
343 _ -> (reverse acc, buf)
345 do_unpack wrapper_unpacks acc buf
346 = case read_em [] buf of
347 (stuff, rest) -> read_em (WwUnpack wrapper_unpacks stuff : acc) rest
351 -- _trace ("scc: "++[C# (currentChar# buf)]) $
352 case currentChar# buf of
355 case prefixMatch (stepOn buf) "NO_CC\"" of
356 Just buf' -> ITscc noCostCentre : lexIface (stepOverLexeme buf')
358 case prefixMatch (stepOn buf) "CURRENT_CC\"" of
359 Just buf' -> ITscc useCurrentCostCentre : lexIface (stepOverLexeme buf')
361 case prefixMatch (stepOn buf) "OVERHEAD\"" of
362 Just buf' -> ITscc overheadCostCentre : lexIface (stepOverLexeme buf')
364 case prefixMatch (stepOn buf) "DONT_CARE\"" of
365 Just buf' -> ITscc dontCareCostCentre : lexIface (stepOverLexeme buf')
367 case prefixMatch (stepOn buf) "SUBSUMED\"" of
368 Just buf' -> ITscc subsumedCosts : lexIface (stepOverLexeme buf')
370 case prefixMatch (stepOn buf) "CAFs_in_...\"" of
371 Just buf' -> ITscc preludeCafsCostCentre : lexIface (stepOverLexeme buf')
373 case prefixMatch (stepOn buf) "CC_CAFs_in_..." of
375 case untilChar# (stepOverLexeme buf') '\"'# of
376 buf'' -> ITscc (mkAllCafsCC ({-module-}lexemeToFastString buf'') _NIL_):
377 lexIface (stepOverLexeme buf'')
379 case prefixMatch (stepOn buf) "DICTs_in_...\"" of
380 Just buf' -> ITscc (preludeDictsCostCentre True) : lexIface (stepOverLexeme buf')
382 case prefixMatch (stepOn buf) "CC_DICTs_in_..." of
384 case untilChar# (stepOverLexeme buf') '\"'# of
385 buf'' -> ITscc (mkAllDictsCC (lexemeToFastString buf'') _NIL_ True):
386 lexIface (stepOverLexeme buf'')
388 case prefixMatch (stepOn buf) "CAF:" of
390 case untilChar# (stepOverLexeme buf') '\"'# of
391 buf'' -> ITscc (cafifyCC (mkUserCC (lexemeToFastString buf'') _NIL_ _NIL_)):
392 lexIface (stepOverLexeme buf'')
394 case untilChar# (stepOn buf) '\"'# of
395 buf' -> ITscc (mkUserCC (lexemeToFastString buf') _NIL_ _NIL_):
396 lexIface (stepOverLexeme buf')
397 c -> ITunknown [C# c] : lexIface (stepOn buf)
401 lex_num :: (Int -> Int) -> Int# -> StringBuffer -> [IfaceToken]
402 lex_num minus acc# buf =
403 -- _trace ("lex_num: "++[C# (currentChar# buf)]) $
404 case scanNumLit (I# acc#) buf of
406 case currentChar# buf' of
408 -- this case is not optimised at all, as the
409 -- presence of floating point numbers in interface
410 -- files is not that common. (ToDo)
411 case expandWhile (isDigit) (incLexeme buf') of
412 buf'' -> -- points to first non digit char
413 case reads (lexemeToString buf'') of
414 [(v,_)] -> ITdouble v : lexIface (stepOverLexeme buf'')
415 _ -> ITinteger (fromInt (minus acc')) : lexIface (stepOverLexeme buf')
417 -- case reads (lexemeToString buf') of
418 -- [(i,_)] -> ITinteger i : lexIface (stepOverLexeme buf')
422 -- _trace ("lex_keyword: "++[C# (currentChar# buf)]) $
423 case currentChar# buf of
424 ':'# -> case lookAhead# buf 1# of
425 '_'# -> -- a binding, type (and other id-info) follows,
426 -- to make the parser ever so slightly, we push
428 lex_decl (stepOnBy# buf 2#)
429 v# -> ITunknown (['_',':',C# v#]) : lexIface (stepOnBy# buf 2#)
431 case expandWhile (is_kwd_char) buf of
433 let kw = lexemeToFastString buf' in
434 -- _trace ("kw: "++lexemeToString buf') $
435 case lookupUFM ifaceKeywordsFM kw of
436 Nothing -> ITunknown (_UNPK_ kw) : -- (minor) sigh
437 lexIface (stepOverLexeme buf')
438 Just xx -> xx : lexIface (stepOverLexeme buf')
441 case expandUntilMatch buf ";;" of
443 -- _trace (show (lexemeToString buf')) $
444 case currentChar# buf' of
445 '\n'# -> -- newline, no id info.
446 ITtysig (lexIface (lexemeToBuffer (decLexeme buf'))) :
447 lexIface (stepOverLexeme buf')
448 '\r'# -> -- just to be sure for those Win* boxes..
449 ITtysig (lexIface (lexemeToBuffer (decLexeme buf'))) :
450 lexIface (stepOverLexeme buf')
452 ITtysig (lexIface (lexemeToBuffer (decLexeme buf'))) :
453 lexIface (stepOverLexeme buf')
454 c -> -- run all over the id info
455 case expandUntilMatch (stepOverLexeme buf') ";;" of
457 --_trace ((C# c):show (lexemeToString (decLexeme buf'))) $
458 --_trace (show (lexemeToString (decLexeme buf''))) $
459 ITtysig (lexIface (lexemeToBuffer (decLexeme buf'))):
460 let ls = lexIface (stepOverLexeme buf'') in
461 if opt_IgnoreIfacePragmas then
464 let is = lexIface (lexemeToBuffer (decLexeme buf'')) in
469 is_kwd_char c@(C# c#) =
470 isAlphanum c || -- OLD: c `elem` "_@/\\"
482 -- _trace ("lex_cstring: "++[C# (currentChar# buf)]) $
483 case expandUntilMatch buf "\'\'" of
484 buf' -> ITstring (lexemeToFastString (setCurrentPos# buf' (negateInt# 2#))) :
485 lexIface (stepOverLexeme buf')
488 lex_tuple module_dot buf =
489 -- _trace ("lex_tuple: "++[C# (currentChar# buf)]) $
493 case currentChar# buf of
494 ','# -> go (n+1) (stepOn buf)
495 ')'# -> end_lex_id module_dot (ITconid (mkTupNameStr n)) (stepOn buf)
496 _ -> ITunknown ("tuple " ++ show n) : lexIface buf
498 -- Similarly ' itself is ok inside an identifier, but not at the start
500 id_arr :: _ByteArray Int
502 unsafePerformPrimIO (
503 newCharArray (0,255) `thenPrimIO` \ barr ->
505 loop 256# = returnPrimIO ()
507 if isAlphanum (C# (chr# i#)) || is_sym (chr# i#) then
508 writeCharArray barr (I# i#) '\1' `seqPrimIO`
511 writeCharArray barr (I# i#) '\0' `seqPrimIO`
515 unsafeFreezeByteArray barr)
519 _ByteArray _ arr# = id_arr
521 case ord# (indexCharArray# arr# (ord# c#)) of
525 --is_id_char c@(C# c#) = isAlphanum c || is_sym c#
529 ':'# -> True; '_'# -> True; '\''# -> True; '!'# -> True;
530 '#'# -> True; '$'# -> True; ':'# -> True; '%'# -> True;
531 '&'# -> True; '*'# -> True; '+'# -> True; '.'# -> True;
532 '/'# -> True; '<'# -> True; '='# -> True; '>'# -> True;
533 '?'# -> True; '\\'# -> True; '^'# -> True; '|'# -> True;
534 '-'# -> True; '~'# -> True; _ -> False }
536 --isAlphanum c || c `elem` ":_'!#$%&*+./<=>?@\\^|-~" -- ToDo: add ISOgraphic
539 mod_arr :: _ByteArray Int
541 unsafePerformPrimIO (
542 newCharArray (0,255) `thenPrimIO` \ barr ->
544 loop 256# = returnPrimIO ()
546 if isAlphanum (C# (chr# i#)) || i# ==# (ord# '_'#) || i# ==# (ord# '\''#) then
547 writeCharArray barr (I# i#) '\1' `seqPrimIO`
550 writeCharArray barr (I# i#) '\0' `seqPrimIO`
554 unsafeFreezeByteArray barr)
557 is_mod_char (C# c#) =
559 _ByteArray _ arr# = mod_arr
561 case ord# (indexCharArray# arr# (ord# c#)) of
565 --isAlphanum c || c == '_' || c== '\'' --`elem` "_'"
569 case _scc_ "lex_id.span" my_span' (is_mod_char) cs of
573 [] -> lex_id2 Nothing cs
574 _ -> lex_id3 Nothing len xs cs
578 [] -> lex_id2 Nothing cs
581 pk_str = _PK_ (xs::String)
582 len = lengthPS pk_str
585 error "Well, I never!"
587 lex_id2 (Just pk_str) cs''
589 [] -> lex_id2 Nothing cs
590 _ -> lex_id3 Nothing len xs cs'
595 -- _trace ("lex_id: "++[C# (currentChar# buf)]) $
596 case expandWhile (is_mod_char) buf of
598 case currentChar# buf' of
600 if not (emptyLexeme buf') then
601 -- _trace ("lex_id: "++(C# (currentChar# (stepOverLexeme buf'))):show (lexemeToFastString buf')) $
602 case lexemeToFastString buf' of
603 l@(FastString u# l# ba#) -> lex_id2 (Just (FastString u# l# ba#))
604 (stepOn (stepOverLexeme buf'))
607 _ -> lex_id2 Nothing buf'
609 -- Dealt with the Module.part
610 lex_id2 module_dot buf =
611 -- _trace ("lex_id2: "++[C# (currentChar# buf)]) $
612 case currentChar# buf of
614 case lookAhead# buf 1# of
615 ']'# -> end_lex_id module_dot (ITconid SLIT("[]")) (stepOnBy# buf 2#)
616 _ -> lex_id3 module_dot buf
618 case lookAhead# buf 1# of
619 ')'# -> end_lex_id module_dot (ITconid SLIT("()")) (stepOnBy# buf 2#)
620 ','# -> lex_tuple module_dot (stepOnBy# buf 2#)
621 _ -> lex_id3 module_dot buf
622 ':'# -> lex_id3 module_dot (incLexeme buf)
623 _ -> lex_id3 module_dot buf
627 -- Dealt with [], (), : special cases
629 lex_id3 module_dot buf =
630 -- _trace ("lex_id3: "++[C# (currentChar# buf)]) $
631 case expandWhile (is_id_char) buf of
635 end_lex_id module_dot (mk_var_token lexeme) (stepOverLexeme buf')
637 case _scc_ "Lex.haskellKeyword" lookupUFM haskellKeywordsFM lexeme of
638 Just kwd_token -> kwd_token : lexIface new_buf
639 Nothing -> mk_var_token lexeme : lexIface new_buf
641 lexeme = lexemeToFastString buf'
642 new_buf = stepOverLexeme buf'
646 lex_id2 module_dot [] ('[': ']': cs) = end_lex_id module_dot (ITconid SLIT("[]")) cs
647 lex_id2 module_dot [] ('(': ')': cs) = end_lex_id module_dot (ITconid SLIT("()")) cs
648 lex_id2 module_dot [] ('(': ',': cs) = lex_tuple module_dot cs
649 lex_id2 module_dot [] (':' : cs) = lex_id3 module_dot [':'] cs
650 lex_id2 module_dot xs cs = lex_id3 module_dot xs cs
654 -- Dealt with [], (), : special cases
657 lex_id3 module_dot len_xs xs cs =
658 case my_span' (is_id_char) cs of
659 (xs1,len_xs1,rest) ->
661 Just m -> end_lex_id (Just m) (mk_var_token rxs) rest --OLD:_PK_ (reverse xs))) rest
663 case _scc_ "Lex.haskellKeyword" lookupUFM haskellKeywordsFM rxs of
664 Just kwd_token -> kwd_token : lexIface rest
665 other -> token : lexIface cs end_lex_id Nothing (mk_var_token rxs) rest
667 rxs = packNChars (len_xs+len_xs1) (xs++xs1) -- OLD: _PK_ (reverse xs)
669 mk_var_token pk_str =
674 -- These tests assume a non- ISO-8859-1 impl of isUpper&isLower,
675 -- remove the second half of disjunction when using a 1.3 prelude.
677 if isUpper f then ITconid pk_str
678 else if isLower f then ITvarid pk_str
679 else if f == ':' then ITconsym pk_str
680 else if isLowerISO f then ITvarid pk_str
681 else if isUpperISO f then ITconid pk_str
685 mk_var_token xs@(f:_) | isUpper f || isUpperISO f = ITconid n
686 | f == ':' = ITconsym n
687 | isAlpha f = ITvarid n
688 | otherwise = ITvarsym n
693 end_lex_id Nothing token buf = token : lexIface buf
694 end_lex_id (Just m) token buf =
696 ITconid n -> ITqconid (m,n) : lexIface buf
697 ITvarid n -> ITqvarid (m,n) : lexIface buf
698 ITconsym n -> ITqconsym (m,n) : lexIface buf
699 ITvarsym n -> ITqvarsym (m,n) : lexIface buf
700 ITbang -> ITqvarsym (m,SLIT("!")) : lexIface buf
701 _ -> ITunknown (show token) : lexIface buf
704 ifaceKeywordsFM :: UniqFM IfaceToken
705 ifaceKeywordsFM = listToUFM $
706 map (\ (x,y) -> (_PK_ x,y))
709 ,("interface_", ITinterface)
710 ,("usages_", ITusages)
711 ,("versions_", ITversions)
712 ,("exports_", ITexports)
713 ,("instance_modules_", ITinstance_modules)
714 ,("instances_", ITinstances)
715 ,("fixities_", ITfixities)
716 ,("declarations_", ITdeclarations)
717 ,("pragmas_", ITpragmas)
718 ,("forall_", ITforall)
721 ,("coerce_in_", ITcoerce_in)
722 ,("coerce_out_", ITcoerce_out)
724 ,("integer_", ITinteger_lit)
725 ,("rational_", ITrational_lit)
726 ,("addr_", ITaddr_lit)
727 ,("float_", ITfloat_lit)
728 ,("string_", ITstring_lit)
729 ,("litlit_", ITlit_lit)
730 ,("ccall_", ITccall (False, False))
731 ,("ccall_GC_", ITccall (False, True))
732 ,("casm_", ITccall (True, False))
733 ,("casm_GC_", ITccall (True, True))
736 haskellKeywordsFM = listToUFM $
737 map (\ (x,y) -> (_PK_ x,y))
740 ,("newtype", ITnewtype)
743 ,("instance", ITinstance)
744 ,("infixl", ITinfixl)
745 ,("infixr", ITinfixr)
748 ,("case#", ITprim_case)
752 ,("letrec", ITletrec)
753 ,("deriving", ITderiving)
764 -- doDiscard rips along really fast looking for a double semicolon,
765 -- indicating the end of the pragma we're skipping
767 case currentChar# buf of
769 case lookAhead# buf 1# of
770 ';'# -> stepOnBy# buf 2#
771 _ -> doDiscard (stepOn buf)
772 _ -> doDiscard (stepOn buf)
777 my_span :: (a -> Bool) -> [a] -> ([a],[a])
778 my_span p xs = go [] xs
780 go so_far (x:xs') | p x = go (x:so_far) xs'
781 go so_far xs = (reverse so_far, xs)
783 my_span' :: (a -> Bool) -> [a] -> ([a],Int,[a])
784 my_span' p xs = go [] 0 xs
786 go so_far n (x:xs') | p x = go (x:so_far) (n+1) xs'
787 go so_far n xs = (reverse so_far,n, xs)
791 %************************************************************************
793 \subsection{Other utility functions
795 %************************************************************************
798 type IfM a = MaybeErr a Error
800 returnIf :: a -> IfM a
801 thenIf :: IfM a -> (a -> IfM b) -> IfM b
802 happyError :: Int -> [IfaceToken] -> IfM a
804 returnIf a = Succeeded a
806 thenIf (Succeeded a) k = k a
807 thenIf (Failed err) _ = Failed err
809 happyError ln toks = Failed (ifaceParseErr ln toks)
811 -----------------------------------------------------------------
813 ifaceParseErr ln toks sty
814 = ppCat [ppPStr SLIT("Interface-file parse error: line"), ppInt ln, ppPStr SLIT("toks="), ppStr (show (take 10 toks))]