From: simonmar Date: Wed, 28 Jun 2000 14:00:37 +0000 (+0000) Subject: [project @ 2000-06-28 14:00:36 by simonmar] X-Git-Tag: Approximately_9120_patches~4128 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=8041a4b3e8340f09770035f03dc84de9ee1403df;p=ghc-hetmet.git [project @ 2000-06-28 14:00:36 by simonmar] Wave goodbye to hscpp, GHC's lexer now understands the '# \d+ \".*\"' output from cpp. --- diff --git a/ghc/compiler/parser/Lex.lhs b/ghc/compiler/parser/Lex.lhs index 4283c32..1f8765c 100644 --- a/ghc/compiler/parser/Lex.lhs +++ b/ghc/compiler/parser/Lex.lhs @@ -33,30 +33,26 @@ module Lex ( #include "HsVersions.h" -import Char ( ord, isSpace, toUpper ) +import Char ( isSpace, toUpper ) import List ( isSuffixOf ) -import IdInfo ( InlinePragInfo(..), CprInfo(..) ) -import Name ( isLowerISO, isUpperISO ) +import IdInfo ( InlinePragInfo(..) ) import PrelNames ( mkTupNameStr ) -import CmdLineOpts ( opt_IgnoreIfacePragmas, opt_HiVersion, opt_NoHiCheck ) +import CmdLineOpts ( opt_HiVersion, opt_NoHiCheck ) import Demand ( Demand(..) {- instance Read -} ) -import UniqFM ( UniqFM, listToUFM, lookupUFM) +import UniqFM ( listToUFM, lookupUFM ) import BasicTypes ( NewOrData(..), Boxity(..) ) import SrcLoc ( SrcLoc, incSrcLine, srcLocFile, srcLocLine, replaceSrcLine, mkSrcLoc ) -import Maybes ( MaybeErr(..) ) import ErrUtils ( Message ) import Outputable import FastString import StringBuffer import GlaExts -import ST ( runST ) import Ctype import Char ( chr ) -import Addr import PrelRead ( readRational__ ) -- Glasgow non-std \end{code} @@ -401,9 +397,8 @@ lexer cont buf s@(PState{ if next `eqChar#` '-'# then trundle (n +# 1#) else if is_symbol next || n <# 2# then is_a_token - else case untilChar# (stepOnBy# buf n) '\n'# of - { buf' -> tab y bol atbol (stepOverLexeme buf') - } + else tab y bol atbol + (stepOnUntilChar# (stepOnBy# buf n) '\n'#) in trundle 1# -- comments and pragmas. We deal with LINE pragmas here, @@ -419,14 +414,21 @@ lexer cont buf s@(PState{ let lexeme = mkFastString -- ToDo: too slow (map toUpper (lexemeToString buf2)) in case lookupUFM pragmaKeywordsFM lexeme of - Just ITline_prag -> line_prag (lexer cont) buf2 s' + Just ITline_prag -> + line_prag skip_to_end buf2 s' Just other -> is_a_token - Nothing -> skip_to_end (stepOnBy# buf 2#) + Nothing -> skip_to_end (stepOnBy# buf 2#) s' }} - - else skip_to_end (stepOnBy# buf 2#) + + else skip_to_end (stepOnBy# buf 2#) s' where - skip_to_end buf = nested_comment (lexer cont) buf s' + skip_to_end = nested_comment (lexer cont) + + -- special GHC extension: we grok cpp-style #line pragmas + '#'# | lexemeIndex buf ==# bol -> -- the '#' must be in column 0 + line_prag next_line (stepOn buf) s' + where + next_line buf = lexer cont (stepOnUntilChar# buf '\n'#) -- tabs have been expanded beforehand c | is_space c -> tab y bol atbol (stepOn buf) @@ -440,23 +442,27 @@ lexer cont buf s@(PState{ | otherwise = lexToken cont glaexts buf s' -- {-# LINE .. #-} pragmas. yeuch. -line_prag cont buf = +line_prag cont buf s@PState{loc=loc} = case expandWhile# is_space buf of { buf1 -> case scanNumLit 0 (stepOverLexeme buf1) of { (line,buf2) -> -- subtract one: the line number refers to the *following* line. let real_line = line - 1 in case fromInteger real_line of { i@(I# l) -> + -- ToDo, if no filename then we skip the newline.... d'oh case expandWhile# is_space buf2 of { buf3 -> case currentChar# buf3 of '\"'#{-"-} -> case untilEndOfString# (stepOn (stepOverLexeme buf3)) of { buf4 -> - let file = lexemeToFastString buf4 in - \s@PState{loc=loc} -> skipToEnd buf4 s{loc = mkSrcLoc file i} + let + file = lexemeToFastString buf4 + new_buf = stepOn (stepOverLexeme buf4) + in + if nullFastString file + then cont new_buf s{loc = replaceSrcLine loc l} + else cont new_buf s{loc = mkSrcLoc file i} } - other -> \s@PState{loc=loc} -> skipToEnd buf3 s{loc = replaceSrcLine loc l} + _other -> cont (stepOverLexeme buf3) s{loc = replaceSrcLine loc l} }}}} - where - skipToEnd buf = nested_comment cont buf nested_comment :: P a -> P a nested_comment cont buf = loop buf @@ -872,7 +878,8 @@ lex_ip cont buf = where lexeme = lexemeToFastString buf' lex_id cont glaexts buf = - case expandWhile# is_ident buf of { buf1 -> + let buf1 = expandWhile# is_ident buf in + seq buf1 $ case (if flag glaexts then expandWhile# (eqChar# '#'#) buf1 -- slurp trailing hashes @@ -885,7 +892,7 @@ lex_id cont glaexts buf = cont kwd_token buf'; Nothing -> - let var_token = cont (mk_var_token lexeme) buf' in + let var_token = cont (ITvarid lexeme) buf' in if not (flag glaexts) then var_token @@ -895,7 +902,7 @@ lex_id cont glaexts buf = Just kwd_token -> cont kwd_token buf'; Nothing -> var_token - }}}} + }}} lex_sym cont buf = case expandWhile# is_symbol buf of diff --git a/ghc/compiler/utils/StringBuffer.lhs b/ghc/compiler/utils/StringBuffer.lhs index fd4e21e..f84311b 100644 --- a/ghc/compiler/utils/StringBuffer.lhs +++ b/ghc/compiler/utils/StringBuffer.lhs @@ -37,6 +37,7 @@ module StringBuffer stepOnBy#, -- :: StringBuffer -> Int# -> StringBuffer stepOnTo#, -- :: StringBuffer -> Int# -> StringBuffer stepOnUntil, -- :: (Char -> Bool) -> StringBuffer -> StringBuffer + stepOnUntilChar#, -- :: StringBuffer -> Char# -> StringBuffer stepOverLexeme, -- :: StringBuffer -> StringBuffer scanNumLit, -- :: Int -> StringBuffer -> (Int, StringBuffer) squeezeLexeme, -- :: StringBuffer -> Int# -> StringBuffer @@ -51,7 +52,6 @@ module StringBuffer -- matching prefixMatch, -- :: StringBuffer -> String -> Bool untilEndOfString#, -- :: StringBuffer -> Int# - untilChar#, -- :: StringBuffer -> Char# -> Int# -- conversion lexemeToString, -- :: StringBuffer -> String @@ -486,13 +486,13 @@ untilEndOfString# (StringBuffer fo l# s# c#) = _ -> loop (c# +# 1#) -untilChar# :: StringBuffer -> Char# -> StringBuffer -untilChar# (StringBuffer fo l# s# c#) x# = +stepOnUntilChar# :: StringBuffer -> Char# -> StringBuffer +stepOnUntilChar# (StringBuffer fo l# s# c#) x# = loop c# where loop c# | c# >=# l# || indexCharOffAddr# fo c# `eqChar#` x# - = StringBuffer fo l# s# c# + = StringBuffer fo l# c# c# | otherwise = loop (c# +# 1#) diff --git a/ghc/driver/Main.hs b/ghc/driver/Main.hs index 0a06293..02783f9 100644 --- a/ghc/driver/Main.hs +++ b/ghc/driver/Main.hs @@ -755,7 +755,7 @@ way_details = GLOBAL_VAR(pgm_dep, findFile "mkdependHS" cGHC_MKDEPENDHS, String) GLOBAL_VAR(pgm_L, findFile "unlit" cGHC_UNLIT, String) -GLOBAL_VAR(pgm_P, findFile "hscpp" cGHC_HSCPP, String) +GLOBAL_VAR(pgm_P, cRAWCPP, String) GLOBAL_VAR(pgm_C, findFile "hsc" cGHC_HSC, String) GLOBAL_VAR(pgm_c, cGCC, String) GLOBAL_VAR(pgm_m, findFile "ghc-asm" cGHC_MANGLER, String) @@ -1225,11 +1225,11 @@ run_phase Unlit basename input_fn output_fn = do unlit <- readIORef pgm_L unlit_flags <- getOpts opt_L run_something "Literate pre-processor" - ("echo '{-# LINE 1 \"" ++input_fn++"\" -}' > "++output_fn++" && " + ("echo '# 1 \"" ++input_fn++"\"' > "++output_fn++" && " ++ unlit ++ ' ':input_fn ++ " - >> " ++ output_fn) ------------------------------------------------------------------------------- --- HsCpp phase +-- Cpp phase run_phase Cpp basename input_fn output_fn = do src_opts <- getOptionsFromSource input_fn @@ -1255,7 +1255,7 @@ run_phase Cpp basename input_fn output_fn ++ include_paths ++ hs_src_cpp_opts ++ hscpp_opts - ++ [ input_fn, ">>", output_fn ] + ++ [ "-x", "c", input_fn, ">>", output_fn ] )) else do run_something "Inefective C pre-processor" diff --git a/ghc/driver/Makefile b/ghc/driver/Makefile index dce770c..2ee5731 100644 --- a/ghc/driver/Makefile +++ b/ghc/driver/Makefile @@ -1,5 +1,5 @@ #----------------------------------------------------------------------------- -# $Id: Makefile,v 1.37 2000/06/25 19:17:58 panne Exp $ +# $Id: Makefile,v 1.38 2000/06/28 14:00:37 simonmar Exp $ # TOP=.. @@ -45,7 +45,6 @@ Config.hs : $(FPTOOLS_TOP)/mk/config.mk Makefile @echo "cLeadingUnderscore = \"$(LeadingUnderscore)\"" >> Config.hs @echo "cGHC_MKDEPENDHS = \"$(GHC_MKDEPENDHS)\"" >> Config.hs @echo "cGHC_UNLIT = \"$(GHC_UNLIT)\"" >> Config.hs - @echo "cGHC_HSCPP = \"$(GHC_HSCPP)\"" >> Config.hs @echo "cGHC_HSC = \"$(GHC_HSC)\"" >> Config.hs @echo "cGHC_MANGLER = \"$(GHC_MANGLER)\"" >> Config.hs @echo "cGHC_SPLIT = \"$(GHC_SPLIT)\"" >> Config.hs @@ -65,6 +64,7 @@ Config.hs : $(FPTOOLS_TOP)/mk/config.mk Makefile @echo "cbindir = \"$(bindir)\"" >> Config.hs @echo "cTMPDIR = \"$(TMPDIR)\"" >> Config.hs @echo "cFPTOOLS_TOP_ABS = \"$(FPTOOLS_TOP_ABS)\"" >> Config.hs + @echo "cRAWCPP = \"$(RAWCPP)\"" >> Config.hs @echo done. CLEAN_FILES += Config.hs diff --git a/ghc/mk/paths.mk b/ghc/mk/paths.mk index 5ed8c8f..ae42b08 100644 --- a/ghc/mk/paths.mk +++ b/ghc/mk/paths.mk @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: paths.mk,v 1.21 2000/06/14 10:10:03 simonmar Exp $ +# $Id: paths.mk,v 1.22 2000/06/28 14:00:36 simonmar Exp $ # # ghc project specific make variables # @@ -26,7 +26,6 @@ GHC_UTILS_DIR := $(TOP)/utils GHC_INTERPRETER_DIR := $(TOP)/interpreter GHC_MKDEPENDHS_DIR := $(GHC_UTILS_DIR)/mkdependHS -GHC_HSCPP_DIR := $(GHC_UTILS_DIR)/hscpp GHC_HSC_DIR := $(GHC_COMPILER_DIR) GHC_UNLIT_DIR := $(GHC_UTILS_DIR)/unlit GHC_MANGLER_DIR := $(GHC_DRIVER_DIR)/mangler @@ -34,7 +33,6 @@ GHC_SPLIT_DIR := $(GHC_DRIVER_DIR)/split GHC_STAT_DIR := $(GHC_DRIVER_DIR)/stats GHC_INPLACE = $(GHC_DRIVER_DIR)/ghc-inplace -GHC_HSCPP = $(GHC_HSCPP_DIR)/hscpp GHC_MKDEPENDHS = $(GHC_MKDEPENDHS_DIR)/mkdependHS-inplace GHC_HSC = $(GHC_HSC_DIR)/hsc UNLIT = $(GHC_UNLIT_DIR)/unlit diff --git a/ghc/utils/hscpp/Makefile b/ghc/utils/hscpp/Makefile deleted file mode 100644 index 65835ea..0000000 --- a/ghc/utils/hscpp/Makefile +++ /dev/null @@ -1,22 +0,0 @@ -#----------------------------------------------------------------------------- -# $Id: Makefile,v 1.11 1999/10/05 10:30:33 simonmar Exp $ -# -# hscpp doesn't depend on any of the install paths, so we don't need to -# play the same tricks we play with mkdependHS and the GHC driver script. - -TOP=../.. -include $(TOP)/mk/boilerplate.mk - -SCRIPT_PROG=hscpp -SCRIPT_OBJS=hscpp.prl -SCRIPT_SUBST_VARS= RAWCPP - -INTERP=perl - -# -# install setup -# -INSTALL_LIB_SCRIPTS+=$(SCRIPT_PROG) -INSTALL_LIBEXECS=$(C_PROG) - -include $(TOP)/mk/target.mk diff --git a/ghc/utils/hscpp/hscpp.prl b/ghc/utils/hscpp/hscpp.prl deleted file mode 100644 index 03a8398..0000000 --- a/ghc/utils/hscpp/hscpp.prl +++ /dev/null @@ -1,48 +0,0 @@ -# -# reads CPP output and turns #line things into appropriate Haskell -# pragmas -# -# considered to be GHC-project specific -# -# -# NOTE: this script needs RAWCPP set in order to do something -# useful: -# - -$Verbose = 0; -$file = ''; -@args = (); - -$Cpp = ${RAWCPP}; - -while (@ARGV) { - $_ = $ARGV[0]; - /^-v$/ && do { $Verbose = 1; shift(@ARGV); next; }; - /^[^-]/ && $#ARGV == 0 && do { $file = $_; shift(@ARGV); next; }; - push @args, $_; - shift(@ARGV); -} - -die "usage: hscpp [arg...] file" if ($file eq ''); - -print STDERR "hscpp:CPP invoked: $Cpp @args - <$file\n" if $Verbose; -open(INPIPE, "$Cpp @args - <$file |") - || die "Can't open C pre-processor pipe\n"; - -while () { - - s/^#\s*line\s+(\d+)\s+\"\"$/\{\-# LINE \1 \"$file\" \-\}/; - s/^#\s*(\d+)\s+\"\".*/\{\-# LINE \1 \"$file\" \-\}/; - -# line directives come in flavo[u]rs: - -# s/^#\s*line\s+\d+$/\{\-# LINE \-\}/; IGNORE THIS ONE FOR NOW - s/^#\s*line\s+(\d+)\s+(\".+\")$/\{\-# LINE \1 \2 \-\}/; - s/^#\s*(\d+)\s+(\".*\").*/\{\-# LINE \1 \2 \-\}/; - - print $_; -} - -close(INPIPE) || exit(1); # exit is so we reflect any errors. - -exit(0);