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

SCM Repository

[smlnj] Diff of /sml/trunk/src/compiler/MiscUtil/print/ppdec.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/MiscUtil/print/ppdec.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 586, Thu Mar 30 05:08:07 2000 UTC revision 587, Thu Mar 30 09:01:52 2000 UTC
# Line 116  Line 116 
116                                   add_break ppstrm (1,0);                                   add_break ppstrm (1,0);
117                                   add_string ppstrm ": ";                                   add_string ppstrm ": ";
118                                   ppType static ppstrm ty)                                   ppType static ppstrm ty)
   
119                         | _ => add_string ppstrm "<PPDec.getVal failure>")                         | _ => add_string ppstrm "<PPDec.getVal failure>")
120    
121             (*** | PRIMOP _ => add_string ppstrm "<primop>" *)             (*** | PRIMOP _ => add_string ppstrm "<primop>" *)
# Line 145  Line 144 
144         and ppRvb (RVB{var, ...}) = ppVar var         and ppRvb (RVB{var, ...}) = ppVar var
145    
146         and ppTb(DEFtyc{path,...}) =         and ppTb(DEFtyc{path,...}) =
147              let val DEFtyc{path,tyfun=TYFUN{arity,body},...} = trueTycon path              let val {path,tyfun=TYFUN{arity,body},...} =
148               in begin_block ppstrm CONSISTENT 0;                      case trueTycon path of
149                            DEFtyc x => x
150                          | _ => bug "ppTb:trueTycon"
151                in
152                    begin_block ppstrm CONSISTENT 0;
153                   begin_block ppstrm INCONSISTENT 2;                   begin_block ppstrm INCONSISTENT 2;
154                    add_string ppstrm "type";                    add_string ppstrm "type";
155                    ppFormals ppstrm arity;                    ppFormals ppstrm arity;
# Line 159  Line 162 
162                   add_newline ppstrm;                   add_newline ppstrm;
163                  end_block ppstrm                  end_block ppstrm
164              end              end
165             | ppTb _ = bug "ppTb:DEFtyc"
166    
167          and ppAbsTyc(GENtyc{path, arity, eq=ref(ABS), ...}) =          and ppAbsTyc(GENtyc { path, arity, eq, ... }) =
168                (case !eq of
169                     ABS =>
170                (begin_block ppstrm CONSISTENT 0;                (begin_block ppstrm CONSISTENT 0;
171                   begin_block ppstrm INCONSISTENT 2;                   begin_block ppstrm INCONSISTENT 2;
172                   add_string ppstrm "type";                   add_string ppstrm "type";
# Line 170  Line 176 
176                   end_block ppstrm;                   end_block ppstrm;
177                 add_newline ppstrm;                 add_newline ppstrm;
178                  end_block ppstrm)                  end_block ppstrm)
179            | ppAbsTyc(GENtyc{path, arity, eq=ref _, ...}) =                 | _ =>
180                (begin_block ppstrm CONSISTENT 0;                (begin_block ppstrm CONSISTENT 0;
181                   begin_block ppstrm INCONSISTENT 2;                   begin_block ppstrm INCONSISTENT 2;
182                   add_string ppstrm "type";                   add_string ppstrm "type";
# Line 179  Line 185 
185                   ppSym ppstrm (InvPath.last path);                   ppSym ppstrm (InvPath.last path);
186                   end_block ppstrm;                   end_block ppstrm;
187                 add_newline ppstrm;                 add_newline ppstrm;
188                  end_block ppstrm)                    end_block ppstrm))
189            | ppAbsTyc _ = bug "unexpected case in ppAbsTyc"            | ppAbsTyc _ = bug "unexpected case in ppAbsTyc"
190    
191          and ppDataTyc(GENtyc{path, arity,          and ppDataTyc(GENtyc{path, arity,
192                               kind=DATATYPE{index, freetycs, family={members, ...},...}, ...}) =                                  kind = DATATYPE{index, freetycs,
193                                                    family={members, ...},...},
194                                    ... }) =
195              let fun ppDcons nil = ()              let fun ppDcons nil = ()
196                    | ppDcons (first::rest) =                    | ppDcons (first::rest) =
197                       let fun ppDcon ({name,domain,rep}) =                       let fun ppDcon ({name,domain,rep}) =
# Line 191  Line 199 
199                                case domain                                case domain
200                                  of SOME dom =>                                  of SOME dom =>
201                                      (add_string ppstrm " of ";                                      (add_string ppstrm " of ";
202                                       ppDconDomain (members,freetycs) static ppstrm dom)                                    ppDconDomain (members,freetycs)
203                                                   static ppstrm dom)
204                                   | NONE => ())                                   | NONE => ())
205                        in add_string ppstrm "= "; ppDcon first;                      in
206                            add_string ppstrm "= "; ppDcon first;
207                           app (fn d => (add_break ppstrm (1,0);                           app (fn d => (add_break ppstrm (1,0);
208                                         add_string ppstrm "| "; ppDcon d))                                         add_string ppstrm "| "; ppDcon d))
209                           rest                           rest
210                       end                       end
211                  val {tycname,dcons,...} = Vector.sub(members,index)                  val {tycname,dcons,...} = Vector.sub(members,index)
212               in begin_block ppstrm CONSISTENT 0;              in
213                    begin_block ppstrm CONSISTENT 0;
214                   begin_block ppstrm CONSISTENT 0;                   begin_block ppstrm CONSISTENT 0;
215                    add_string ppstrm "datatype";                    add_string ppstrm "datatype";
216                    ppFormals ppstrm arity;                    ppFormals ppstrm arity;
# Line 213  Line 224 
224                   add_newline ppstrm;                   add_newline ppstrm;
225                  end_block ppstrm                  end_block ppstrm
226              end              end
227              | ppDataTyc _ = bug "unexpected case in ppDataTyc"
228    
229          and ppEb(EBgen{exn=DATACON{name,...},etype,...}) =          and ppEb(EBgen{exn=DATACON{name,...},etype,...}) =
230                (begin_block ppstrm CONSISTENT 0;                (begin_block ppstrm CONSISTENT 0;
# Line 263  Line 275 
275    
276          and ppSigb sign =          and ppSigb sign =
277              let val name = case sign              let val name = case sign
278                              of M.SIG{name=SOME s, ...} => s                              of M.SIG { name, ... } => getOpt (name, anonSym)
279                               | _ => anonSym                               | _ => anonSym
280    
281               in (begin_block ppstrm CONSISTENT 0;               in (begin_block ppstrm CONSISTENT 0;

Legend:
Removed from v.586  
changed lines
  Added in v.587

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