html-gram

这是我们参加06年全国开源软件的竞赛作品

(* html-gram
 *
 * COPYRIGHT (c) 1996 AT&T Research.
 *
 * This grammar parses HTML 3.2.  Note that it does not enforce exclusions
 * (for the content of FORM, PRE, etc).  Exclusions should be enforced as
 * a second pass over the parse tree.
 *)

fun textList [text] = text
  | textList l = HTML.TextList l

fun blockList [blk] = blk
  | blockList l = HTML.BlockList l

fun textBlock l = HTML.TextBlock(textList l)
    
(* The elements of a definition list (<DL>) are tags (<DT>) and items (<DD>).
 * To avoid shift/reduce problems, we parse them and then group them.
 *)
datatype deflist_item
  = DL_tag of HTML.text
  | DL_item of HTML.block

fun groupDefListContents [] = []
  | groupDefListContents [DL_tag tag] = [{dt=[tag], dd=HTML.BlockList[]}]
  | groupDefListContents (DL_item blk :: r) =
      {dt=[], dd=blk} :: (groupDefListContents r)
  | groupDefListContents (DL_tag tag :: r) = let
      val {dt, dd} :: r' = groupDefListContents r
      in
	{dt=tag::dt, dd=dd} :: r'
      end

(* A list of Text, paragraphs and blocks requires grouping the Text items and
 * making an implicit paragraph.  We cannot directly use TextList because of
 * conflicts.
 *)
datatype blklist_item
  = BL_text of HTML.text list
  | BL_block of HTML.block list

fun consText (txt, BL_text tl :: r) = BL_text(txt::tl) :: r
  | consText (txt, l) = BL_text[txt] :: l

fun consBlock (blk, BL_block bl :: r) = BL_block(blk::bl) :: r
  | consBlock (blk, l) = BL_block[blk] :: l

fun mkBlock blks = let
      fun f (BL_text tl) = textBlock tl
	| f (BL_block bl) = blockList bl
      in
	blockList(List.map f blks)
      end

fun mkBody blks = HTML.BODY{
	background = NONE,
	bgcolor = NONE,
	text = NONE,
	link = NONE,
	vlink = NONE,
	alink = NONE,
	content = mkBlock blks
      }

%%

(* %pure *)
%verbose

%nonterm Document of HTML.html
       | StartHTML of HTML.cdata option
       | EndHTML
       | Head of HTML.head_content list
       | StartHEAD
       | EndHEAD
       | HeadContents of HTML.head_content list
       | HeadElements of HTML.head_content list
       | HeadElement of HTML.head_content
       | Body of HTML.body
       | StartBODY
       | EndBODY
       | BodyContent of HTML.block
       | BodyContent0 of HTML.body
       | BodyContent1 of blklist_item list
       | BodyContent2 of blklist_item list
       | BodyElement of HTML.block
       | AddressContent1 of blklist_item list
       | AddressContent2 of blklist_item list
       | BlockWOIndex of HTML.block
       | Block of HTML.block
       | Paragraph of HTML.block
       | List of HTML.block
       | ListItemList of HTML.list_item list
       | ListItem of HTML.list_item
       | DLItemList of deflist_item list
       | DLItem of deflist_item
       | Flow1 of blklist_item list
       | Flow2 of blklist_item list
       | EndLI
       | EndDT
       | EndDD
       | Preformatted of HTML.block
       | optCaption of HTML.caption option
       | TableRowList of HTML.tr list
       | TableRow of HTML.tr
       | TableCellList of HTML.table_cell list
       | TableCell of HTML.table_cell
       | TextList of HTML.text
       | TextList' of HTML.text list
       | TextWOScript of HTML.text
       | Text of HTML.text
       | Font of HTML.text
       | Phrase of HTML.text
       | Special of HTML.text
       | AreaList of HTML.area list
       | Form of HTML.text
       | OptionList of HTML.select_option list
       | EndOPTION
       | PCData of HTML.pcdata
       | PCDataList of HTML.pcdata list
       | PCDataElem of HTML.pcdata

%term EOF
  (* tags in alphabetical order *)
    | START_A of HTMLAttrVals.attrs | END_A
    | START_ADDRESS | END_ADDRESS
    | START_APPLET of HTMLAttrVals.attrs | END_APPLET
    | TAG_AREA of HTMLAttrVals.attrs
    | START_B | END_B
    | TAG_BASE of HTMLAttrVals.attrs
    | START_BIG | END_BIG
    | START_BLOCKQUOTE | END_BLOCKQUOTE
    | START_BODY of HTMLAttrVals.attrs | END_BODY
    | TAG_BR of HTMLAttrVals.attrs
    | START_CAPTION of HTMLAttrVals.attrs | END_CAPTION
    | START_CENTER | END_CENTER
    | START_CITE | END_CITE
    | START_CODE | END_CODE
    | START_DD | END_DD
    | START_DFN | END_DFN
    | START_DIR of HTMLAttrVals.attrs | END_DIR
    | START_DIV of HTMLAttrVals.attrs | END_DIV
    | START_DL of HTMLAttrVals.attrs | END_DL
    | START_DT | END_DT
    | START_EM | END_EM
    | START_FONT of HTMLAttrVals.attrs | END_FONT
    | START_BASEFONT of HTMLAttrVals.attrs | END_BASEFONT
    | START_FORM of HTMLAttrVals.attrs | END_FORM
    | START_H1 of HTMLAttrVals.attrs | END_H1
    | START_H2 of HTMLAttrVals.attrs | END_H2
    | START_H3 of HTMLAttrVals.attrs | END_H3
    | START_H4 of HTMLAttrVals.attrs | END_H4
    | START_H5 of HTMLAttrVals.attrs | END_H5
    | START_H6 of HTMLAttrVals.attrs | END_H6
    | START_HEAD | END_HEAD
    | TAG_HR of HTMLAttrVals.attrs
    | START_HTML | END_HTML
    | START_I | END_I
    | TAG_IMG of HTMLAttrVals.attrs
    | TAG_INPUT of HTMLAttrVals.attrs
    | TAG_ISINDEX of HTMLAttrVals.attrs
    | START_KBD | END_KBD
    | START_LI of HTMLAttrVals.attrs | END_LI
    | TAG_LINK of HTMLAttrVals.attrs
    | START_MAP of HTMLAttrVals.attrs | END_MAP
    | START_MENU of HTMLAttrVals.attrs | END_MENU
    | TAG_META of HTMLAttrVals.attrs
    | START_OL of HTMLAttrVals.attrs | END_OL
    | START_OPTION of HTMLAttrVals.attrs | END_OPTION
    | START_P of HTMLAttrVals.attrs | END_P
    | TAG_PARAM of HTMLAttrVals.attrs
    | START_PRE of HTMLAttrVals.attrs | END_PRE
    | START_SAMP | END_SAMP
    | START_SCRIPT | END_SCRIPT
    | START_SELECT of HTMLAttrVals.attrs | END_SELECT
    | START_SMALL | END_SMALL
    | START_STRIKE | END_STRIKE
    | START_STRONG | END_STRONG
    | START_STYLE | END_STYLE
    | START_SUB | END_SUB
    | START_SUP | END_SUP
    | START_TABLE of HTMLAttrVals.attrs | END_TABLE
    | START_TD of HTMLAttrVals.attrs | END_TD
    | START_TEXTAREA of HTMLAttrVals.attrs | END_TEXTAREA
    | START_TH of HTMLAttrVals.attrs | END_TH
    | START_TITLE | END_TITLE
    | START_TR of HTMLAttrVals.attrs | END_TR
    | START_TT | END_TT
    | START_U | END_U
    | START_UL of HTMLAttrVals.attrs | END_UL
    | START_VAR | END_VAR
  (* raw text data *)
    | PCDATA of string
    | CHAR_REF of string	(* &#dd; *)
    | ENTITY_REF of string	(* &#name; *)

%pure
%pos int
%name HTML
%start Document

%header (
  functor HTMLLrValsFn (
    structure Token : TOKEN
    structure HTMLAttrs : HTML_ATTRS))

%arg (ctx) : int -> HTMLAttrs.context

%eop EOF
%noshift EOF  (* avoids infinite loop in error recovery *)

(** Some error-correction support **)
%value START_A ([])
%value START_APPLET ([
    ("CODE", HTMLAttrs.NAME ""),
    ("WIDTH", HTMLAttrs.NAME ""),
    ("HEIGHT", HTMLAttrs.NAME "")
  ])
%value TAG_AREA ([("ALT", HTMLAttrs.NAME "")])
%value TAG_BASE ([("URL", HTMLAttrs.NAME "")])
%value START_BODY ([])
%value TAG_BR ([])
%value START_CAPTION ([])
%value START_DIR ([])
%value START_DIV ([])
%value START_DL ([])
%value START_FONT ([])
%value START_BASEFONT ([])
%value START_FORM ([])
%value START_H1 ([])
%value START_H2 ([])
%value START_H3 ([])
%value START_H4 ([])
%value START_H5 ([])
%value START_H6 ([])
%value TAG_HR ([])
%value TAG_IMG ([("SRC", HTMLAttrs.NAME "")])
%value TAG_INPUT ([])
%value TAG_ISINDEX ([])
%value TAG_LINK ([])
%value START_MAP ([])
%value START_MENU ([])
%value TAG_META ([("CONTENT", HTMLAttrs.NAME "")])
%value START_OL ([])
%value START_OPTION ([])
%value START_P ([])
%value TAG_PARAM ([("NAME", HTMLAttrs.NAME "")])
%value START_PRE ([])
%value START_SELECT ([("NAME", HTMLAttrs.NAME "")])
%value START_TABLE ([])
%value START_TD ([])
%value START_TEXTAREA ([
    ("NAME", HTMLAttrs.NAME ""),
    ("ROWS", HTMLAttrs.NAME "0"),
    ("COLS", HTMLAttrs.NAME "0")
  ])
%value START_TH ([])
%value START_TR ([])
%value START_UL ([])

%%

Document
	: StartHTML Head Body EndHTML
		(HTML.HTML{version=StartHTML, head=Head, body=Body})

StartHTML
	: (* empty *)		(NONE)
	| START_HTML		(NONE)

EndHTML
	: (* empty *)		()
	| END_HTML		()


(*** Head markup ***)

Head
	: StartHEAD HeadContents EndHEAD
		(HeadContents)

StartHEAD
	: (* empty *)		()
	| START_HEAD 		()
EndHEAD
	: (* empty *)		()
	| END_HEAD 		()

HeadContents
	: HeadElements START_TITLE PCData END_TITLE HeadElements
		(HeadElements1 @ (HTML.Head_TITLE PCData :: HeadElements2))

HeadElements
	: (* empty *)
		([])
	| HeadElement HeadElements
		(HeadElement :: HeadElements)

HeadElement
	: TAG_META
		(HTMLAttrs.mkMETA(ctx TAG_METAleft, TAG_META))
	| TAG_LINK
		(HTMLAttrs.mkLINK(ctx TAG_LINKleft, TAG_LINK))
	| TAG_ISINDEX
		(let val stuff =
		    HTMLAttrs.mkISINDEX (ctx TAG_ISINDEXleft, TAG_ISINDEX)
		  in HTML.Head_ISINDEX stuff end
		)
	| TAG_BASE
		(HTMLAttrs.mkBASE(ctx TAG_BASEleft, TAG_BASE))
	| START_STYLE PCData END_STYLE
		(HTML.Head_STYLE(PCData))
	| START_SCRIPT PCData END_SCRIPT
		(HTML.Head_SCRIPT(PCData))


(*** Body content ***)

Body
	: BodyContent0 EndBODY
		(BodyContent0)

EndBODY
	: (* empty *)		()
	| END_BODY		()

BodyContent
	: BodyContent1
		(mkBlock BodyContent1)

BodyContent0
	: START_BODY BodyContent
		(HTMLAttrs.mkBODY(ctx START_BODYleft, START_BODY, BodyContent))
	| TextWOScript BodyContent1
		(mkBody(consText(TextWOScript, BodyContent1)))
	| BodyElement BodyContent1
		(mkBody(consBlock(BodyElement, BodyContent1)))
	| BlockWOIndex BodyContent1
		(mkBody(consBlock(BlockWOIndex, BodyContent1)))
	| Paragraph END_P BodyContent1
		(mkBody(consBlock(Paragraph, BodyContent1)))
	| Paragraph BodyContent2
		(mkBody(consBlock(Paragraph, BodyContent2)))

BodyContent1