Skip to content

GitLab

Commit 8041a4b3 authored by simonmar's avatar simonmar
Browse files

[project @ 2000-06-28 14:00:36 by simonmar] 

Wave goodbye to hscpp, GHC's lexer now understands the '# \d+ \".*\"'
output from cpp.
parent b76acf56
Hide whitespace changes
Inline Side-by-side
ghc/compiler/parser/Lex.lhs
View file @ 8041a4b3
......@@ -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
......
ghc/compiler/utils/StringBuffer.lhs
View file @ 8041a4b3
......@@ -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#)
......
ghc/driver/Main.hs
View file @ 8041a4b3
......@@ -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"
......
ghc/driver/Makefile
View file @ 8041a4b3
#-----------------------------------------------------------------------------
# $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
......
ghc/mk/paths.mk
View file @ 8041a4b3
# -----------------------------------------------------------------------------
# $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
......
ghc/utils/hscpp/Makefile deleted 100644 → 0
View file @ b76acf56
#-----------------------------------------------------------------------------
# $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
ghc/utils/hscpp/hscpp.prl deleted 100644 → 0
View file @ b76acf56
#
# 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 (<INPIPE>) {
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);
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment