1(* 2 * Copyright 2014, NICTA 3 * 4 * This software may be distributed and modified according to the terms of 5 * the BSD 2-Clause license. Note that NO WARRANTY is provided. 6 * See "LICENSE_BSD2.txt" for details. 7 * 8 * @TAG(NICTA_BSD) 9 *) 10 11structure StrictCLrVals = StrictCLrValsFun(structure Token = LrParser.Token) 12 13structure StrictCLex = StrictCLexFun(structure Tokens = StrictCLrVals.Tokens); 14 15structure StrictCParser = 16 JoinWithArg(structure LrParser = LrParser 17 structure ParserData = StrictCLrVals.ParserData 18 structure Lex = StrictCLex) 19 20fun invoke pi lexstream = let 21 val (StrictCParser.Token.TOKEN (nexttok, _), strm') = StrictCParser.Stream.get lexstream 22 val tok_s = StrictCLrVals.ParserData.EC.showTerminal nexttok 23in 24 print (tok_s ^ " "); 25 if tok_s <> "EOF" then invoke pi strm' else print "\n" 26end 27 28fun lexit (includes : string list) (fname : string) = let 29 val includes_string = String.concat (map (fn s => "-I"^s^" ") includes) 30 val cpped_fname = let 31 open OS.FileSys OS.Process 32 val tmpname = tmpName() 33 in 34 if isSuccess (system ("/usr/bin/cpp " ^ includes_string ^ " -CC " ^ fname ^ 35 " > " ^ tmpname)) 36 then 37 tmpname 38 else raise Feedback.WantToExit ("cpp failed on "^fname) 39 end 40 val istream = TextIO.openIn cpped_fname 41 val lexarg = StrictCLex.UserDeclarations.new_state fname 42 val _ = Feedback.numErrors := 0 43 val lexer = StrictCParser.makeLexer (fn _ => inputLine istream) lexarg 44in 45 invoke (#source lexarg) lexer before 46 (TextIO.closeIn istream; 47 if cpped_fname <> fname then 48 OS.FileSys.remove cpped_fname 49 else ()) 50end 51 52open OS.Process 53 54fun die s = (print s; print "\n"; exit failure) 55fun warn s = (TextIO.output(TextIO.stdErr, s^"\n"); 56 TextIO.flushOut TextIO.stdErr) 57 58fun usage() = die ("Usage: "^CommandLine.name()^ " filename1 filename2 ...") 59 60 61fun handle_args acc_incs args = 62 case args of 63 [] => usage() 64 | arg::rest => let 65 in 66 if String.isPrefix "-I" arg then 67 handle_args (String.extract(arg,2,NONE) :: acc_incs) rest 68 else let 69 val incs = List.rev acc_incs 70 val num_errors = List.app (lexit incs) args 71 in 72 exit success 73 end 74 end 75 76structure Main = struct fun doit args = handle_args [] args end 77