Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /smlnj-lib/branches/rt-transition/HTML4/tests/smldec-to-html.sml
ViewVC logotype

Annotation of /smlnj-lib/branches/rt-transition/HTML4/tests/smldec-to-html.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4071 - (view) (download)

1 : jhr 4071 (* ______________________________________________________________________
2 :     smldec-to-html.sml
3 :     ______________________________________________________________________ *)
4 :    
5 :     structure Test = struct
6 :    
7 :     structure H4U = HTML4Utils
8 :    
9 :     structure H4T = HTML4Tokens
10 :    
11 :     structure H4TU = HTML4TokenUtils
12 :    
13 :     structure H4P = HTML4Parser
14 :    
15 :     (* ____________________________________________________________ *)
16 :     (* Most of the following set of functions were automatically
17 :     generated, with additional pattern matching and recursion added in an
18 :     ad hoc fashion to arrive at a string H4U.parsetree that approximately
19 :     shows a structure and the functions it defines.
20 :     *)
21 :    
22 :     local
23 :     open Ast
24 :     in
25 :     fun handleFixitem (handleItem : 'a -> string H4U.parsetree)
26 :     ({item, fixity, region} : 'a fixitem) =
27 :     H4U.Nd(Atom.atom "fixity",
28 :     [H4U.Lf (case fixity of SOME sym => Symbol.name sym
29 :     | NONE => "NONE"),
30 :     handleItem item])
31 :    
32 :     fun handleSigConst _ NoSig = H4U.Nd(Atom.atom "NoSig", nil)
33 :     | handleSigConst handleElem (Opaque elem) =
34 :     H4U.Nd(Atom.atom "Opaque", [handleElem elem])
35 :     | handleSigConst handleElem (Transparent elem) =
36 :     H4U.Nd(Atom.atom "Transparent", [handleElem elem])
37 :     and handleExp (AndalsoExp _) = H4U.Nd(Atom.atom "AndalsoExp", nil)
38 :     | handleExp (AppExp _) = H4U.Nd(Atom.atom "AppExp", nil)
39 :     | handleExp (CaseExp _) = H4U.Nd(Atom.atom "CaseExp", nil)
40 :     | handleExp (CharExp _) = H4U.Nd(Atom.atom "CharExp", nil)
41 :     | handleExp (ConstraintExp _) = H4U.Nd(Atom.atom "ConstraintExp", nil)
42 :     | handleExp (FlatAppExp exps) =
43 :     H4U.Nd(Atom.atom "FlatAppExp", map (handleFixitem handleExp) exps)
44 :     | handleExp (FnExp _) = H4U.Nd(Atom.atom "FnExp", nil)
45 :     | handleExp (HandleExp _) = H4U.Nd(Atom.atom "HandleExp", nil)
46 :     | handleExp (IfExp _) = H4U.Nd(Atom.atom "IfExp", nil)
47 :     | handleExp (IntExp _) = H4U.Nd(Atom.atom "IntExp", nil)
48 :     | handleExp (LetExp _) = H4U.Nd(Atom.atom "LetExp", nil)
49 :     | handleExp (ListExp _) = H4U.Nd(Atom.atom "ListExp", nil)
50 :     | handleExp (MarkExp (theexp, _)) = H4U.Nd(Atom.atom "MarkExp",
51 :     [handleExp theexp])
52 :     | handleExp (OrelseExp _) = H4U.Nd(Atom.atom "OrelseExp", nil)
53 :     | handleExp (RaiseExp _) = H4U.Nd(Atom.atom "RaiseExp", nil)
54 :     | handleExp (RealExp _) = H4U.Nd(Atom.atom "RealExp", nil)
55 :     | handleExp (RecordExp _) = H4U.Nd(Atom.atom "RecordExp", nil)
56 :     | handleExp (SelectorExp _) = H4U.Nd(Atom.atom "SelectorExp", nil)
57 :     | handleExp (SeqExp _) = H4U.Nd(Atom.atom "SeqExp", nil)
58 :     | handleExp (StringExp _) = H4U.Nd(Atom.atom "StringExp", nil)
59 :     | handleExp (TupleExp _) = H4U.Nd(Atom.atom "TupleExp", nil)
60 :     | handleExp (VarExp _) = H4U.Nd(Atom.atom "VarExp", nil)
61 :     | handleExp (VectorExp _) = H4U.Nd(Atom.atom "VectorExp", nil)
62 :     | handleExp (WhileExp _) = H4U.Nd(Atom.atom "WhileExp", nil)
63 :     | handleExp (WordExp _) = H4U.Nd(Atom.atom "WordExp", nil)
64 :     and handleRule (Rule _) = H4U.Nd(Atom.atom "Rule", nil)
65 :     and handlePat (AppPat _) = H4U.Nd(Atom.atom "AppPat", nil)
66 :     | handlePat (CharPat _) = H4U.Nd(Atom.atom "CharPat", nil)
67 :     | handlePat (ConstraintPat _) = H4U.Nd(Atom.atom "ConstraintPat", nil)
68 :     | handlePat (FlatAppPat _) = H4U.Nd(Atom.atom "FlatAppPat", nil)
69 :     | handlePat (IntPat _) = H4U.Nd(Atom.atom "IntPat", nil)
70 :     | handlePat (LayeredPat _) = H4U.Nd(Atom.atom "LayeredPat", nil)
71 :     | handlePat (ListPat _) = H4U.Nd(Atom.atom "ListPat", nil)
72 :     | handlePat (MarkPat _) = H4U.Nd(Atom.atom "MarkPat", nil)
73 :     | handlePat (OrPat _) = H4U.Nd(Atom.atom "OrPat", nil)
74 :     | handlePat (RecordPat _) = H4U.Nd(Atom.atom "RecordPat", nil)
75 :     | handlePat (StringPat _) = H4U.Nd(Atom.atom "StringPat", nil)
76 :     | handlePat (TuplePat _) = H4U.Nd(Atom.atom "TuplePat", nil)
77 :     | handlePat (VarPat _) = H4U.Nd(Atom.atom "VarPat", nil)
78 :     | handlePat (VectorPat _) = H4U.Nd(Atom.atom "VectorPat", nil)
79 :     | handlePat WildPat = H4U.Nd(Atom.atom "WildPat", nil)
80 :     | handlePat (WordPat _) = H4U.Nd(Atom.atom "WordPat", nil)
81 :     and handleStrexp (AppStr _) = H4U.Nd(Atom.atom "AppStr", nil)
82 :     | handleStrexp (AppStrI _) = H4U.Nd(Atom.atom "AppStrI", nil)
83 :     | handleStrexp (BaseStr thedec) = H4U.Nd(Atom.atom "BaseStr",
84 :     [handleDec thedec])
85 :     | handleStrexp (ConstrainedStr _) = H4U.Nd(Atom.atom "ConstrainedStr",
86 :     nil)
87 :     | handleStrexp (LetStr _) = H4U.Nd(Atom.atom "LetStr", nil)
88 :     | handleStrexp (MarkStr (thestr, _)) = H4U.Nd(Atom.atom "MarkStr",
89 :     [handleStrexp thestr])
90 :     | handleStrexp (VarStr _) = H4U.Nd(Atom.atom "VarStr", nil)
91 :     and handleFctexp (AppFct _) = H4U.Nd(Atom.atom "AppFct", nil)
92 :     | handleFctexp (BaseFct _) = H4U.Nd(Atom.atom "BaseFct", nil)
93 :     | handleFctexp (LetFct _) = H4U.Nd(Atom.atom "LetFct", nil)
94 :     | handleFctexp (MarkFct _) = H4U.Nd(Atom.atom "MarkFct", nil)
95 :     | handleFctexp (VarFct _) = H4U.Nd(Atom.atom "VarFct", nil)
96 :     and handleWherespec (WhStruct _) = H4U.Nd(Atom.atom "WhStruct", nil)
97 :     | handleWherespec (WhType _) = H4U.Nd(Atom.atom "WhType", nil)
98 :     and handleSigexp (AugSig _) = H4U.Nd(Atom.atom "AugSig", nil)
99 :     | handleSigexp (BaseSig _) = H4U.Nd(Atom.atom "BaseSig", nil)
100 :     | handleSigexp (MarkSig _) = H4U.Nd(Atom.atom "MarkSig", nil)
101 :     | handleSigexp (VarSig _) = H4U.Nd(Atom.atom "VarSig", nil)
102 :     and handleFsigexp (BaseFsig _) = H4U.Nd(Atom.atom "BaseFsig", nil)
103 :     | handleFsigexp (MarkFsig _) = H4U.Nd(Atom.atom "MarkFsig", nil)
104 :     | handleFsigexp (VarFsig _) = H4U.Nd(Atom.atom "VarFsig", nil)
105 :     and handleSpec (DataSpec _) = H4U.Nd(Atom.atom "DataSpec", nil)
106 :     | handleSpec (ExceSpec _) = H4U.Nd(Atom.atom "ExceSpec", nil)
107 :     | handleSpec (FctSpec _) = H4U.Nd(Atom.atom "FctSpec", nil)
108 :     | handleSpec (IncludeSpec _) = H4U.Nd(Atom.atom "IncludeSpec", nil)
109 :     | handleSpec (MarkSpec _) = H4U.Nd(Atom.atom "MarkSpec", nil)
110 :     | handleSpec (ShareStrSpec _) = H4U.Nd(Atom.atom "ShareStrSpec", nil)
111 :     | handleSpec (ShareTycSpec _) = H4U.Nd(Atom.atom "ShareTycSpec", nil)
112 :     | handleSpec (StrSpec _) = H4U.Nd(Atom.atom "StrSpec", nil)
113 :     | handleSpec (TycSpec _) = H4U.Nd(Atom.atom "TycSpec", nil)
114 :     | handleSpec (ValSpec _) = H4U.Nd(Atom.atom "ValSpec", nil)
115 :     and handleDec (AbsDec _) = H4U.Nd(Atom.atom "AbsDec", nil)
116 :     | handleDec (AbstypeDec _) = H4U.Nd(Atom.atom "AbstypeDec", nil)
117 :     | handleDec (DatatypeDec _) = H4U.Nd(Atom.atom "DatatypeDec", nil)
118 :     | handleDec (ExceptionDec _) = H4U.Nd(Atom.atom "ExceptionDec", nil)
119 :     | handleDec (FctDec _) = H4U.Nd(Atom.atom "FctDec", nil)
120 :     | handleDec (FixDec _) = H4U.Nd(Atom.atom "FixDec", nil)
121 :     | handleDec (FsigDec _) = H4U.Nd(Atom.atom "FsigDec", nil)
122 :     | handleDec (FunDec (fbs, tyvars)) =
123 :     H4U.Nd(Atom.atom "FunDec", [H4U.Nd(Atom.atom "fbs", map handleFb fbs),
124 :     H4U.Nd(Atom.atom "tyvars",
125 :     map handleTyvar tyvars)])
126 :     | handleDec (LocalDec (dec1, dec2)) =
127 :     H4U.Nd(Atom.atom "LocalDec", [handleDec dec1, handleDec dec2])
128 :     | handleDec (MarkDec (thedec, _)) = H4U.Nd(Atom.atom "MarkDec",
129 :     [handleDec thedec])
130 :     | handleDec (OpenDec _) = H4U.Nd(Atom.atom "OpenDec", nil)
131 :     | handleDec (OvldDec _) = H4U.Nd(Atom.atom "OvldDec", nil)
132 :     | handleDec (SeqDec decs) = H4U.Nd(Atom.atom "SeqDec",
133 :     map handleDec decs)
134 :     | handleDec (SigDec sigbs) = H4U.Nd(Atom.atom "SigDec",
135 :     map handleSigb sigbs)
136 :     | handleDec (StrDec strbs) = H4U.Nd(Atom.atom "StrDec",
137 :     map handleStrb strbs)
138 :     | handleDec (TypeDec _) = H4U.Nd(Atom.atom "TypeDec", nil)
139 :     | handleDec (ValDec _) = H4U.Nd(Atom.atom "ValDec", nil)
140 :     | handleDec (ValrecDec _) = H4U.Nd(Atom.atom "ValrecDec", nil)
141 :     and handleVb (MarkVb _) = H4U.Nd(Atom.atom "MarkVb", nil)
142 :     | handleVb (Vb _) = H4U.Nd(Atom.atom "Vb", nil)
143 :     and handleRvb (MarkRvb _) = H4U.Nd(Atom.atom "MarkRvb", nil)
144 :     | handleRvb (Rvb _) = H4U.Nd(Atom.atom "Rvb", nil)
145 :     and handleFb (Fb (clauses, flag)) =
146 :     H4U.Nd(Atom.atom "Fb", (map handleClause clauses) @
147 :     [if flag then H4U.Lf "true"
148 :     else H4U.Lf "false"])
149 :     | handleFb (MarkFb (thefb, _)) = H4U.Nd(Atom.atom "MarkFb",
150 :     [handleFb thefb])
151 :     and handleClause (Clause {exp, pats, resultty}) =
152 :     H4U.Nd(Atom.atom "Clause", [
153 :     H4U.Nd (Atom.atom "pats", map (handleFixitem handlePat) pats),
154 :     H4U.Nd (Atom.atom "exp", [handleExp exp]),
155 :     H4U.Nd (Atom.atom "resultty", [
156 :     case resultty of SOME tyast => handleTy tyast
157 :     | NONE => H4U.Lf "NONE"])
158 :     ])
159 :     and handleTb (MarkTb _) = H4U.Nd(Atom.atom "MarkTb", nil)
160 :     | handleTb (Tb _) = H4U.Nd(Atom.atom "Tb", nil)
161 :     and handleDb (Db _) = H4U.Nd(Atom.atom "Db", nil)
162 :     | handleDb (MarkDb _) = H4U.Nd(Atom.atom "MarkDb", nil)
163 :     and handleDbrhs (Constrs _) = H4U.Nd(Atom.atom "Constrs", nil)
164 :     | handleDbrhs (Repl _) = H4U.Nd(Atom.atom "Repl", nil)
165 :     and handleEb (EbDef _) = H4U.Nd(Atom.atom "EbDef", nil)
166 :     | handleEb (EbGen _) = H4U.Nd(Atom.atom "EbGen", nil)
167 :     | handleEb (MarkEb _) = H4U.Nd(Atom.atom "MarkEb", nil)
168 :     and handleStrb (MarkStrb (thestrb, _)) = H4U.Nd(Atom.atom "MarkStrb",
169 :     [handleStrb thestrb])
170 :     | handleStrb (Strb {name, constraint, def}) =
171 :     H4U.Nd(Atom.atom "Strb",
172 :     [H4U.Nd(Atom.atom "name", [H4U.Lf (Symbol.name name)]),
173 :     H4U.Nd(Atom.atom "constraint", [handleSigConst handleSigexp
174 :     constraint]),
175 :     H4U.Nd(Atom.atom "def", [handleStrexp def])])
176 :     and handleFctb (Fctb _) = H4U.Nd(Atom.atom "Fctb", nil)
177 :     | handleFctb (MarkFctb _) = H4U.Nd(Atom.atom "MarkFctb", nil)
178 :     and handleSigb (MarkSigb _) = H4U.Nd(Atom.atom "MarkSigb", nil)
179 :     | handleSigb (Sigb _) = H4U.Nd(Atom.atom "Sigb", nil)
180 :     and handleFsigb (Fsigb _) = H4U.Nd(Atom.atom "Fsigb", nil)
181 :     | handleFsigb (MarkFsigb _) = H4U.Nd(Atom.atom "MarkFsigb", nil)
182 :     and handleTyvar (MarkTyv (thetyv, _)) = H4U.Nd(Atom.atom "MarkTyv",
183 :     [handleTyvar thetyv])
184 :     | handleTyvar (Tyv _) = H4U.Nd(Atom.atom "Tyv", nil)
185 :     and handleTy (ConTy _) = H4U.Nd(Atom.atom "ConTy", nil)
186 :     | handleTy (MarkTy _) = H4U.Nd(Atom.atom "MarkTy", nil)
187 :     | handleTy (RecordTy _) = H4U.Nd(Atom.atom "RecordTy", nil)
188 :     | handleTy (TupleTy _) = H4U.Nd(Atom.atom "TupleTy", nil)
189 :     | handleTy (VarTy _) = H4U.Nd(Atom.atom "VarTy", nil)
190 :     end
191 :    
192 :     (* ____________________________________________________________ *)
193 :    
194 :     val tokIsSpace = H4P.tokIsSpace
195 :    
196 :     fun filterSpaceFromParseStream strm =
197 :     let fun pred (H4U.VisitT tok) = not (tokIsSpace tok)
198 :     | pred _ = true
199 :     in H4U.stream_filter pred strm end
200 :    
201 :     fun tokIsOpenTag tok = String.isPrefix "START" (HTML4Tokens.toString tok)
202 :    
203 :     fun tokIsCloseTag tok = String.isPrefix "END" (HTML4Tokens.toString tok)
204 :    
205 :     (* ____________________________________________________________ *)
206 :    
207 :     val templateStream =
208 :     let val instrm = TextIO.openIn "template.html"
209 :     val template_pt_opt = HTML4Parser.parseStream instrm
210 :     in
211 :     TextIO.closeIn instrm;
212 :     case template_pt_opt of
213 :     SOME (H4U.Nd(_, children)) =>
214 :     H4U.stream_concatl (map H4U.parsetreeToVisitationStream children)
215 :     | _ => H4U.StreamNil
216 :     end handle ex => H4U.StreamNil
217 :    
218 :     (* ____________________________________________________________ *)
219 :    
220 :     exception IllFormedHTMLParseStream of H4T.token H4U.parsevisitation H4U.stream
221 :    
222 :     fun outputHTMLParseStream (istrm, ostrm) =
223 :     let fun visit (H4U.EnterNT _, indent) = indent ^ " "
224 :     | visit (H4U.ExitNT _, indent) = String.extract(indent, 1, NONE)
225 :     | visit (H4U.VisitT tok, indent) =
226 :     (TextIO.output(ostrm,
227 :     String.concat [indent, H4TU.tokToString tok, "\n"]);
228 :     indent)
229 :     val _ = H4U.stream_foldl visit "" istrm
230 :     in () end
231 :    
232 :     structure PP = PrettyPrint
233 :    
234 :     fun ppHTMLParseStream ppstrm istrm =
235 :     let fun visit (H4U.EnterNT _) =
236 :     PP.openHVBox ppstrm (PP.Rel 2)
237 :     | visit (H4U.ExitNT _) =
238 :     PP.closeBox ppstrm
239 :     | visit (H4U.VisitT tok) =
240 :     (PP.string ppstrm (H4TU.tokToString tok);
241 :     PP.cut ppstrm)
242 :     val _ = H4U.stream_app visit istrm
243 :     in () end
244 :    
245 :     (* __________________________________________________ *)
246 :    
247 :     (* The following was an attempt at a fancier pretty printer, but it
248 :     was not meant to be. *)
249 :    
250 :     fun ppHTMLParseStream' ppstrm istrm =
251 :     let exception BadStream
252 :     fun do_closes 0 = ()
253 :     | do_closes n = (PP.closeBox ppstrm; do_closes (n - 1))
254 :     fun visit (H4U.EnterNT _, (opens, openstk)) =
255 :     (PP.openHVBox ppstrm (PP.Rel 1); (1, opens::openstk))
256 :     | visit (H4U.ExitNT _, (opens, opens'::openstk)) =
257 :     (do_closes opens; (opens', openstk))
258 :     | visit (H4U.ExitNT _, (_, [])) = raise BadStream
259 :     | visit (H4U.VisitT tok, (opens, openstk)) =
260 :     let val opens' = ref opens
261 :     in
262 :     if tokIsCloseTag tok then (
263 :     PP.closeBox ppstrm;
264 :     PP.newline ppstrm;
265 :     opens' := (!opens') - 1)
266 :     else ();
267 :     PP.string ppstrm (H4TU.tokToString tok);
268 :     if tokIsOpenTag tok then (
269 :     PP.newline ppstrm;
270 :     PP.openHVBox ppstrm (PP.Rel 1);
271 :     opens' := (!opens') + 1)
272 :     else PP.space ppstrm 1;
273 :     (!opens', openstk)
274 :     end
275 :     val _ = H4U.stream_foldl visit (0,[]) istrm
276 :     handle BadStream => raise IllFormedHTMLParseStream istrm
277 :     in () end
278 :    
279 :     (* ____________________________________________________________ *)
280 :    
281 :     exception NotPossible
282 :    
283 :     structure CommentMap = ListMapFn(struct
284 :     type ord_key = String.string
285 :     val compare = String.compare
286 :     end)
287 :    
288 :     fun commentFilter commentMap =
289 :     let fun guard (HTML4Tokens.COMMENT comStr) =
290 :     CommentMap.inDomain(commentMap, comStr)
291 :     | guard _ = false
292 :     fun mapper (HTML4Tokens.COMMENT comStr) =
293 :     CommentMap.lookup (commentMap, comStr)
294 :     | mapper _ = raise NotPossible
295 :     in H4U.parsetreeStreamMapTStream(guard, mapper) end
296 :    
297 :     (* ____________________________________________________________ *)
298 :    
299 :     fun parseFile filename =
300 :     let val stream = TextIO.openIn filename
301 :     val source = Source.newSource(filename, 1, stream, false,
302 :     ErrorMsg.defaultConsumer())
303 :     val result = SmlFile.parse source
304 :     in Source.closeSource source; result end
305 :    
306 :     (* ____________________________________________________________ *)
307 :    
308 :     val aEm = Atom.atom "em"
309 :     val aUl = Atom.atom "ul"
310 :     val aLi = Atom.atom "li"
311 :    
312 :     (* Here is a "simple" "little" example of many to many stream transduction. *)
313 :    
314 :     fun scrubEmptyULs (orig as H4U.StreamCons(orig_enter as H4U.EnterNT ntAtom,
315 :     tl_thunk)) =
316 :     if Atom.same(aUl, ntAtom) then let
317 :     val thunk_val = tl_thunk ()
318 :     in case thunk_val of
319 :     H4U.StreamCons(orig_start as H4U.VisitT (H4T.STARTUL _),
320 :     tl_thunk') =>
321 :     let val thunk_val' = tl_thunk' ()
322 :     in case thunk_val' of
323 :     H4U.StreamCons(H4U.VisitT H4T.ENDUL, tl_thunk'') =>
324 :     let val thunk_val'' = tl_thunk'' ()
325 :     in case thunk_val'' of
326 :     H4U.StreamCons(H4U.ExitNT ntAtom, tl_thunk''') =>
327 :     if Atom.same(aUl, ntAtom)
328 :     then scrubEmptyULs (tl_thunk'''())
329 :     else raise IllFormedHTMLParseStream orig
330 :     | _ => raise IllFormedHTMLParseStream orig
331 :     end
332 :     | _ => let
333 :     fun new_thunk' () = scrubEmptyULs thunk_val'
334 :     fun new_thunk () = H4U.StreamCons(orig_start,
335 :     new_thunk')
336 :     in H4U.StreamCons(orig_enter, new_thunk) end
337 :     end
338 :     | _ => raise IllFormedHTMLParseStream orig
339 :     end
340 :     else H4U.StreamCons(orig_enter, fn () => scrubEmptyULs (tl_thunk ()))
341 :     | scrubEmptyULs (H4U.StreamCons (orig, tl_thunk)) =
342 :     H4U.StreamCons(orig, fn () => scrubEmptyULs (tl_thunk ()))
343 :     | scrubEmptyULs (orig as H4U.StreamNil) = orig
344 :    
345 :     (* ____________________________________________________________ *)
346 :    
347 :     fun handleFile filename =
348 :     let val intree = parseFile filename
349 :     val decStrm = H4U.parsetreeToVisitationStream (handleDec intree)
350 :     fun ptStrmToHTMLPtStrm _ (H4U.EnterNT ntAtom) =
351 :     H4U.stream_fromList [
352 :     H4U.EnterNT aLi,
353 :     H4U.VisitT (H4T.STARTLI("<li>", [])),
354 :     H4U.EnterNT aEm,
355 :     H4U.VisitT (H4T.STARTEM("<em>", [])),
356 :     H4U.VisitT (H4T.PCDATA (Atom.toString ntAtom)),
357 :     H4U.VisitT H4T.ENDEM,
358 :     H4U.ExitNT aEm,
359 :     H4U.EnterNT aUl,
360 :     H4U.VisitT (H4T.STARTUL("<ul>", []))
361 :     ]
362 :     | ptStrmToHTMLPtStrm _ (H4U.ExitNT ntAtom) =
363 :     H4U.stream_fromList [
364 :     H4U.VisitT H4T.ENDUL,
365 :     H4U.ExitNT aUl,
366 :     H4U.VisitT H4T.ENDLI,
367 :     H4U.ExitNT aLi
368 :     ]
369 :     | ptStrmToHTMLPtStrm tokToString (H4U.VisitT tok) =
370 :     H4U.stream_fromList [
371 :     H4U.EnterNT aLi,
372 :     H4U.VisitT (H4T.STARTLI("<li>", [])),
373 :     H4U.VisitT (H4T.PCDATA (tokToString tok)),
374 :     H4U.VisitT H4T.ENDLI,
375 :     H4U.ExitNT aLi
376 :     ]
377 :     val decHTMLStrm =
378 :     H4U.stream_concatl [
379 :     H4U.stream_fromList [H4U.EnterNT aUl,
380 :     H4U.VisitT (H4T.STARTUL ("<ul", []))],
381 :     scrubEmptyULs (H4U.stream_maps (ptStrmToHTMLPtStrm (fn x => x))
382 :     decStrm),
383 :     H4U.stream_fromList [H4U.VisitT H4T.ENDUL,
384 :     H4U.ExitNT aUl]]
385 :     val commentMap =
386 :     foldl CommentMap.insert' CommentMap.empty
387 :     [("<!--title-->",
388 :     H4U.stream_singleton (H4U.VisitT (HTML4Tokens.PCDATA
389 :     filename))),
390 :     ("<!--filename-->",
391 :     H4U.stream_singleton (H4U.VisitT (HTML4Tokens.PCDATA
392 :     filename))),
393 :     ("<!--pt-->", decHTMLStrm)
394 :     ]
395 :     val filterTemplate =
396 :     (commentFilter commentMap) o filterSpaceFromParseStream
397 :     val outstream = TextIO.openOut (filename ^ ".html")
398 :     val _ = outputHTMLParseStream(filterTemplate templateStream, outstream)
399 :     in TextIO.closeOut outstream end
400 :    
401 :     (* ____________________________________________________________
402 :     Main routine.
403 :     *)
404 :    
405 :     fun main (_, args) = (List.app handleFile args; OS.Process.success)
406 :     handle ex => OS.Process.failure
407 :    
408 :     end
409 :    
410 :     (* ______________________________________________________________________
411 :     End of smldec-to-html.sml
412 :     ______________________________________________________________________ *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0