2006-03-21 13:14:15 +00:00
|
|
|
(*****************************************************************************
|
|
|
|
* su4sml GCG - Generic Code Generator
|
|
|
|
*
|
|
|
|
* tpl_parser.sml - template parser of a su4sml-gcg template
|
|
|
|
* Copyright (C) 2005 Raphael Eidenbenz <eraphael@student.ethz.ch>
|
|
|
|
*
|
|
|
|
* This file is part of su4sml-gcg.
|
|
|
|
*
|
|
|
|
* su4sml is free software; you can redistribute it and/or modify it under
|
|
|
|
* the terms of the GNU General Public License as published by the Free
|
|
|
|
* Software Foundation; either version 2 of the License, or (at your option)
|
|
|
|
* any later version.
|
|
|
|
*
|
|
|
|
* su4sml is distributed in the hope that it will be useful, but WITHOUT ANY
|
|
|
|
* WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
|
|
|
* FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
|
|
|
|
* details.
|
|
|
|
*
|
|
|
|
* You should have received a copy of the GNU General Public License along
|
|
|
|
* with this program; if not, write to the Free Software Foundation, Inc.,
|
|
|
|
* 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
|
|
|
******************************************************************************)
|
|
|
|
|
2006-12-08 17:16:33 +00:00
|
|
|
(** A parser for template files. *)
|
2006-04-27 14:27:16 +00:00
|
|
|
signature TPL_PARSER =
|
|
|
|
sig
|
|
|
|
|
2007-02-06 16:30:31 +00:00
|
|
|
datatype TemplateTree
|
|
|
|
= ElseNode of TemplateTree list
|
|
|
|
| EvalLeaf of TemplateTree list
|
|
|
|
| ForEachNode of string * TemplateTree list
|
|
|
|
| IfNode of string * TemplateTree list
|
|
|
|
| OpenFileLeaf of string
|
|
|
|
| OpenFileIfNotExistsLeaf of string
|
|
|
|
| RootNode of TemplateTree list
|
|
|
|
| TextLeaf of string
|
|
|
|
|
|
|
|
val printTTree : TemplateTree -> unit
|
|
|
|
val parse : string -> TemplateTree
|
2006-04-27 14:27:16 +00:00
|
|
|
|
|
|
|
end
|
|
|
|
|
|
|
|
|
2006-03-21 13:14:15 +00:00
|
|
|
structure Tpl_Parser : TPL_PARSER =
|
|
|
|
struct
|
2007-02-06 16:30:31 +00:00
|
|
|
open library
|
2006-03-21 13:14:15 +00:00
|
|
|
open Gcg_Helper
|
|
|
|
|
|
|
|
val tplStream = ref (TextIO.openString "@// dummy template\n");
|
2006-05-09 16:04:43 +00:00
|
|
|
|
2006-03-21 13:14:15 +00:00
|
|
|
fun opentFile file = (TextIO.closeIn (!tplStream) ;
|
2007-02-06 16:30:31 +00:00
|
|
|
tplStream := (TextIO.openIn file))
|
2007-02-07 19:36:31 +00:00
|
|
|
handle ex => error ("in Tpl_Parser.opentFile: \
|
|
|
|
\couldn't open preprocessed template file: "^
|
|
|
|
General.exnMessage ex)
|
2007-02-06 16:30:31 +00:00
|
|
|
|
2006-03-21 13:14:15 +00:00
|
|
|
fun cleanUp tplFile = (TextIO.closeIn (!tplStream);
|
2007-02-06 16:30:31 +00:00
|
|
|
OS.FileSys.remove tplFile)
|
2006-03-21 13:14:15 +00:00
|
|
|
|
|
|
|
fun readNextLine () = TextIO.inputLine (!tplStream)
|
2007-02-06 16:30:31 +00:00
|
|
|
|
2007-02-07 19:36:31 +00:00
|
|
|
|
|
|
|
(* FIXME: this currently uses a simple line-based template-file structure *)
|
|
|
|
(* (every line corresponds to exactly one node in this tree) *)
|
|
|
|
(* This should really be relaxed... *)
|
|
|
|
(* FIXME: add separate VariableLeaf *)
|
|
|
|
(* FIXME: merge If and Else Nodes *)
|
2007-02-06 16:30:31 +00:00
|
|
|
datatype TemplateTree = RootNode of TemplateTree list
|
|
|
|
| OpenFileLeaf of string
|
|
|
|
| OpenFileIfNotExistsLeaf of string
|
|
|
|
| EvalLeaf of TemplateTree list
|
|
|
|
| TextLeaf of string
|
|
|
|
| IfNode of string * TemplateTree list
|
|
|
|
(* FIXME: why a seperate ElseNode? should be part of IfNode *)
|
|
|
|
| ElseNode of TemplateTree list
|
|
|
|
| ForEachNode of string * TemplateTree list
|
|
|
|
|
2006-03-21 13:14:15 +00:00
|
|
|
|
|
|
|
|
2006-10-27 14:03:31 +00:00
|
|
|
(**
|
2007-02-07 19:36:31 +00:00
|
|
|
* replaceSafely (s,v,x) replaces every v that occurs unescaped in s with x.
|
|
|
|
* if v occurs escaped with "\" in s, then the "\" is removed from s.
|
2007-02-08 17:02:09 +00:00
|
|
|
* FIXME: move to stringhandling?
|
2006-03-21 13:14:15 +00:00
|
|
|
*)
|
2007-02-07 19:36:31 +00:00
|
|
|
fun replaceSafely _ _ "" = ""
|
|
|
|
| replaceSafely v x s =
|
|
|
|
let val v_size = size v
|
|
|
|
val s_size = size s
|
2007-02-06 16:30:31 +00:00
|
|
|
in
|
2007-02-07 19:36:31 +00:00
|
|
|
if String.isPrefix (str #"\\"^v) s
|
|
|
|
then v^replaceSafely v x (String.extract (s, v_size + 1, NONE))
|
2007-02-06 16:30:31 +00:00
|
|
|
else if String.isPrefix v s
|
2007-02-07 19:36:31 +00:00
|
|
|
then x^replaceSafely v x (String.extract (s, v_size, NONE))
|
|
|
|
else str (String.sub (s,0))^replaceSafely v x (String.extract (s, 1, NONE))
|
2007-02-06 16:30:31 +00:00
|
|
|
end
|
|
|
|
|
2006-03-21 13:14:15 +00:00
|
|
|
|
2007-02-07 19:36:31 +00:00
|
|
|
(** removes leading, trainling, and multiple consecutive whitespace chars. *)
|
2007-02-08 17:02:09 +00:00
|
|
|
(* FIXME: movev to StringHandling? *)
|
|
|
|
fun cleanLine s = String.concatWith " " (String.tokens Char.isSpace s)
|
2007-02-07 19:36:31 +00:00
|
|
|
|
2007-02-06 16:30:31 +00:00
|
|
|
|
2006-03-21 13:14:15 +00:00
|
|
|
(* debugging function
|
|
|
|
* prints ParseTree to stdOut
|
|
|
|
*)
|
2007-02-06 16:30:31 +00:00
|
|
|
fun printTplTree prefix (RootNode(l)) = (print (prefix^"root"^"\n"); List.app (printTplTree (prefix))l)
|
2006-03-21 13:14:15 +00:00
|
|
|
| printTplTree prefix (OpenFileLeaf(s))= print (prefix^"openfile:"^s^"\n")
|
2006-12-22 17:10:00 +00:00
|
|
|
| printTplTree prefix (OpenFileIfNotExistsLeaf(s))= print (prefix^"openfileifnotexists:"^s^"\n")
|
2007-02-06 16:30:31 +00:00
|
|
|
| printTplTree prefix (EvalLeaf(l)) = (print (prefix^"eval:\n"); List.app (printTplTree (prefix^"\t"))l)
|
|
|
|
| printTplTree prefix (TextLeaf(s)) = print (prefix^"text:"^s^"\n")
|
|
|
|
| printTplTree prefix (IfNode(s,l)) = (print (prefix^"if:"^s^"\n");List.app (printTplTree (prefix^"\t")) l)
|
|
|
|
| printTplTree prefix (ElseNode(l)) = (print (prefix^"else:"^"\n"); List.app (printTplTree (prefix^"\t")) l)
|
2006-03-21 13:14:15 +00:00
|
|
|
| printTplTree prefix (ForEachNode(s,l))=(print (prefix^"foreach:"^s^"\n");List.app (printTplTree (prefix^"\t")) l)
|
|
|
|
|
|
|
|
val printTTree = printTplTree ""
|
|
|
|
|
|
|
|
fun isComment s = (String.isPrefix "//" s)
|
|
|
|
|
2007-02-07 19:36:31 +00:00
|
|
|
(** returns the prefix of l up to the first element where f evaluates to true *)
|
|
|
|
fun takeUntil f [] = []
|
|
|
|
| takeUntil f (h::t) = if f h then [] else h::(takeUntil f t)
|
2007-02-06 16:30:31 +00:00
|
|
|
|
2007-02-07 19:36:31 +00:00
|
|
|
|
2006-04-11 16:35:32 +00:00
|
|
|
(** splits line into tokens considering handling escaped @ *)
|
2007-02-07 19:36:31 +00:00
|
|
|
fun tokenize line = let val l = joinEscapeSplitted "@" (fieldSplit #"@" line)
|
2007-02-06 16:30:31 +00:00
|
|
|
in
|
2007-02-07 19:36:31 +00:00
|
|
|
takeUntil isComment l
|
2007-02-06 16:30:31 +00:00
|
|
|
end
|
2006-03-21 13:14:15 +00:00
|
|
|
|
2006-04-24 10:19:08 +00:00
|
|
|
(**
|
|
|
|
* extracts the type of line.
|
2006-03-21 13:14:15 +00:00
|
|
|
* line type must be first token in line!
|
|
|
|
* if no control tag in line -> "text" returned
|
|
|
|
*)
|
|
|
|
fun getType l = let val sl = tokenize l
|
2007-02-06 16:30:31 +00:00
|
|
|
in
|
2007-02-07 19:36:31 +00:00
|
|
|
if (length sl = 1)
|
|
|
|
then "text" (* rather: comment *)
|
|
|
|
else hd (tokenSplit #" " (String.concat sl))
|
2007-02-06 16:30:31 +00:00
|
|
|
end
|
2006-03-21 13:14:15 +00:00
|
|
|
|
|
|
|
|
2006-04-11 16:35:32 +00:00
|
|
|
(**
|
2006-03-21 13:14:15 +00:00
|
|
|
* getContent line
|
2006-04-11 16:35:32 +00:00
|
|
|
* @return the content of a line
|
2007-02-06 16:30:31 +00:00
|
|
|
*)
|
2006-03-21 13:14:15 +00:00
|
|
|
fun getContent l = let val sl = tokenize l
|
2007-02-06 16:30:31 +00:00
|
|
|
in
|
2007-02-07 19:36:31 +00:00
|
|
|
if (length sl = 0) then ""
|
|
|
|
else if (length sl = 1) then hd sl
|
|
|
|
else String.concat (tl (fieldSplit #" " (String.concat (tl sl))))
|
2007-02-06 16:30:31 +00:00
|
|
|
end
|
2006-03-21 13:14:15 +00:00
|
|
|
|
2007-02-08 17:02:09 +00:00
|
|
|
(** cleans line, replaces nl and tabs so that no space char is left out. *)
|
2007-02-07 19:36:31 +00:00
|
|
|
fun preprocess s = replaceSafely "@tab" "\t" (replaceSafely "@nl" "\n" (cleanLine s))
|
2006-03-21 13:14:15 +00:00
|
|
|
|
|
|
|
|
2006-04-11 16:35:32 +00:00
|
|
|
(**
|
|
|
|
* builds the TemplateTree.
|
|
|
|
* @return a TemplateTree list
|
2006-03-21 13:14:15 +00:00
|
|
|
*)
|
2007-02-06 16:30:31 +00:00
|
|
|
fun buildTree (SOME line) =
|
|
|
|
let fun getNode ("text", c) = TextLeaf c :: buildTree (readNextLine())
|
|
|
|
| getNode ("foreach", c) = ForEachNode (c, buildTree (readNextLine()))
|
|
|
|
:: buildTree (readNextLine())
|
|
|
|
| getNode ("if", c) = IfNode (c, buildTree (readNextLine()))
|
|
|
|
:: buildTree (readNextLine())
|
|
|
|
| getNode ("else", _) = [ ElseNode (buildTree (readNextLine())) ]
|
|
|
|
| getNode ("elsif", c) = [ ElseNode [ IfNode (c, buildTree (readNextLine())) ]]
|
|
|
|
| getNode ("openfile", c) = OpenFileLeaf c :: buildTree (readNextLine())
|
|
|
|
| getNode ("openfileifnotexists", c) = OpenFileIfNotExistsLeaf c
|
|
|
|
:: buildTree (readNextLine())
|
|
|
|
| getNode ("eval", "") = EvalLeaf (buildTree (readNextLine()))
|
|
|
|
:: buildTree (readNextLine())
|
|
|
|
| getNode ("eval", expr) = EvalLeaf [ TextLeaf expr ]:: buildTree (readNextLine())
|
|
|
|
| getNode ("end",_) = []
|
|
|
|
| getNode (t,c) = error ("in Tpl_Parser.buildTree: error while parsing \
|
2007-02-07 19:36:31 +00:00
|
|
|
\node \""^t^"\" with content \""^c^"\".")
|
2007-02-06 16:30:31 +00:00
|
|
|
val prLine = preprocess line
|
|
|
|
in
|
|
|
|
getNode ((getType prLine),(getContent prLine))
|
|
|
|
end
|
2006-03-21 13:14:15 +00:00
|
|
|
| buildTree NONE = []
|
|
|
|
|
|
|
|
|
2007-02-06 16:30:31 +00:00
|
|
|
fun codegen_home _ = getOpt (OS.Process.getEnv "CODEGEN_HOME", su4sml_home()^"src/codegen")
|
|
|
|
|
2006-04-24 10:19:08 +00:00
|
|
|
(** calls the external cpp ( C PreProcessor).
|
2006-03-21 13:14:15 +00:00
|
|
|
* writes merged template to a file with extension .tmp instead of .tpl
|
|
|
|
* and returns this file
|
|
|
|
*)
|
2006-04-11 16:35:32 +00:00
|
|
|
fun call_cpp file =
|
2007-02-07 19:36:31 +00:00
|
|
|
let val targetFile = OS.FileSys.tmpName ()
|
2007-02-06 16:30:31 +00:00
|
|
|
val _ = OS.Process.system ("cpp -P -C "^codegen_home()^"/"^file^" "^targetFile)
|
|
|
|
in
|
|
|
|
targetFile
|
|
|
|
end
|
2006-03-21 13:14:15 +00:00
|
|
|
|
|
|
|
|
2007-02-06 16:30:31 +00:00
|
|
|
|
2006-04-24 10:19:08 +00:00
|
|
|
(** parse template-file
|
2007-02-06 16:30:31 +00:00
|
|
|
* @return the parsed template tree
|
|
|
|
*)
|
|
|
|
fun parse file = let val _ = info ("parsing template "^file)
|
|
|
|
val mergedTpl = call_cpp file;
|
2007-02-07 19:36:31 +00:00
|
|
|
val _ = opentFile mergedTpl;
|
2007-02-06 16:30:31 +00:00
|
|
|
val pt = RootNode(buildTree (readNextLine()));
|
2007-02-07 19:36:31 +00:00
|
|
|
val _ = cleanUp mergedTpl;
|
2007-02-06 16:30:31 +00:00
|
|
|
in
|
|
|
|
pt
|
|
|
|
end
|
2006-03-21 13:14:15 +00:00
|
|
|
end
|