MLCompiler/ParseTree/PRINT_PARSETREE.sml

66     fun printList (doPrint: 'a*FixedInt.int->pretty) (c: 'a list, separator, depth: FixedInt.int): pretty list =
67         if depth <= 0 then [PrettyString "..."]
71         |   [v]     => [doPrint (v, depth)]
75                         doPrint (v, depth),
82                 printList doPrint (vs, separator, depth - 1)
86                    depth  : FixedInt.int) : pretty = (* The number of levels to display. *)
89         and displayListWithBpts = printList (fn ((c,_), depth) => displayParsetree(c, depth))
92         fun printTypeBind (TypeBind{name, typeVars, decType, ...}, depth) =
94                 displayTypeVariables (typeVars, depth) @
105                                 displayTypeParse (t, depth, emptyTypeEnv)
111         and printDatatypeBind (DatatypeBind{name, typeVars, constrs, ...}, depth) =
113                 displayTypeVariables (typeVars, depth) @
119                         printList printConstructor (constrs, "|", depth - 1)
123         and printConstructor ({constrName, constrArg, ...}, depth) =
134                             displayTypeParse (argType, depth, emptyTypeEnv)
140       if depth <= 0 (* elide further text. *)
165                     displayParsetree (left, depth - 1),
167                     displayParsetree (f, depth), (* Just an identifier. *)
169                     displayParsetree (right, depth - 1)
176                     displayParsetree (f, depth - 1),
178                     displayParsetree (arg, depth - 1)
187                     displayParsetree (test, depth - 1),
191                     displayParsetree (thenpt, depth - 1),
195                     displayParsetree (elsept, depth - 1)
204                     displayList (fields, ",", depth - 1)
214               | printValBind (ValBind{dec, exp, isRecursive, ...} :: rest, depth) =
215                     if depth <= 0
224                                     displayParsetree (dec, depth - 1),
228                                     displayParsetree (exp, depth - 1)
235                                       PrettyBreak(1, 0) :: printValBind(rest, depth-1)
242                 (* displayTypeVariables (explicit, depth); *)
243                 printValBind (dec, depth - 1)
249             fun printfvalbind (FValBind{clauses, ...}, depth) =
250                 PrettyBlock(3, true, [], printList printClause (clauses, "|", depth - 1))
251             and printClause (FValClause{dec, exp, ...}, depth) =
254                         printDec (dec, depth - 1),
258                         displayParsetree (exp, depth - 1)
262                     { ident = { name, ... }, isInfix=true, args=[TupleTree{fields=[left, right], ...}], constraint }, depth) =
266                         displayParsetree (left, depth - 1),
270                         displayParsetree (right, depth - 1)
271                     ] @ printConstraint (constraint, depth-1)
275                       args=TupleTree{fields=[left, right], ...} :: args, constraint }, depth) =
281                         displayParsetree (left, depth - 1),
285                         displayParsetree (right, depth - 1),
288                     ] @ displayList (args, "", depth - 1) @ printConstraint(constraint, depth-2)
290             |   printDec({ ident = { name, ...}, args, constraint, ... }, depth) =
294                         displayList (args, "", depth - 1) @ printConstraint(constraint, depth-2)
297             |   printConstraint(SOME given, depth) =
302                     displayTypeParse (given, depth, emptyTypeEnv)
309                 (* displayTypeVariables (explicit, depth); *)
310                 printList printfvalbind (dec, "and", depth - 1)
321                 printList printStrName (decs, "", depth - 1)
329                 displayList (elements, ",", depth - 1) @
336                     displayParsetree (value, depth - 1),
340                     displayTypeParse (given, depth, emptyTypeEnv)
347                     displayParsetree (var, depth - 1),
351                     displayParsetree (pattern, depth - 1)
359                 printList displayMatch (matches, "|", depth - 1)
372                 displayListWithBpts (decs, ";", depth - 1) @
374                 displayListWithBpts (body, ";", depth - 1) @
390                 printList printTypeBind (ptl, "and", depth - 1)
398                 printList printDatatypeBind (typelist, "and", depth - 1) @
405                         printList printTypeBind (withtypes, "and", depth - 1)
428                 printList printDatatypeBind (typelist, "and", depth - 1) @
435                         printList printTypeBind (withtypes, "and", depth - 1) @
442                         displayListWithBpts(declist, ";", depth - 1))
451                 displayListWithBpts (ptl, ";", depth - 1) @
470                 printList (fn (name, _) => PrettyString name) (tlist, "", depth - 1)
476             fun printExBind (ExBind {name, ofType, previous, ...}, depth) =
485                             displayTypeParse (typeof, depth, emptyTypeEnv)
494                         displayParsetree (previous, depth - 1)
501                 printList printExBind (pt, "and", depth - 1)
510                     displayParsetree (pt, depth - 1)
517                     displayParsetree (exp, depth - 1),
522                         printList displayMatch (hrules, "|", depth - 1)
532                     displayParsetree (test, depth - 1),
536                     displayParsetree (body, depth - 1)
546                         displayParsetree (test, depth - 1),
552                 printList displayMatch (match, "|", depth - 1)
558                     displayParsetree (first, depth - 1),
562                     displayParsetree (second, depth - 1)
569                     displayParsetree (first, depth - 1),
573                     displayParsetree (second, depth - 1)
579             fun displayRecList (c, depth): pretty list =
580             if depth <= 0 then [PrettyString "..."]
590                                 displayParsetree (valOrPat, depth - 1)
601                                     displayParsetree (valOrPat, depth - 1)
609                     displayRecList (vs, depth - 1)
614                 displayRecList (recList, depth - 1) @
631                     displayParsetree (p, depth),
639     and displayMatch(MatchTree {vars, exp, ...}, depth) =
642                 displayParsetree (vars, depth - 1),
646                 displayParsetree (exp, depth - 1)