Return to printbas.sml CVS log

Up to [Research Unix] / researchv10no / cmd / sml / src / basics

Annotation of researchv10no/cmd/sml/src/basics/printbas.sml, revision 1.1.1.1

1.1       root        1: (* Copyright 1989 by AT&T Bell Laboratories *)
                      2: (* printbasics.sml *)
                      3: 
                      4: structure PrintBasics = struct
                      5: 
                      6: local open PrintUtil Access Basics PrintType System.Control in
                      7: 
                      8: val printTuple = printClosedSequence ("(", ",", ")")
                      9: 
                     10: val printList = printClosedSequence ("[", ",", "]") (* printList not used here *)
                     11:                
                     12: fun printPath [n:int] = (print n)
                     13:   | printPath (n::p) = (printPath p; print "."; print n)
                     14:   | printPath [] = ()
                     15: 
                     16: fun printAccess a =
                     17:     if !internals then case a
                     18:            of (LVAR v) => (print "@"; print v)
                     19:             | (SLOT n) => (print "#"; print n)
                     20:             | (PATH p) => (print "$"; printPath p)
                     21:             | (INLINE p) => (print "%"; print(Prim.inLineName p))
                     22:        else ()
                     23: 
                     24: fun printRep UNDECIDED = print "UNDECIDED"
                     25:   | printRep (TAGGED i) = (print "TAGGED["; print i; print "]")
                     26:   | printRep (CONSTANT i) = (print "CONSTANT["; print i; print "]")
                     27:   | printRep TRANSPARENT = print "TRANSPARENT"
                     28:   | printRep TRANSU = print "TRANSU"
                     29:   | printRep TRANSB = print "TRANSB"
                     30:   | printRep REF = print "REF"
                     31:   | printRep (VARIABLE a) = (print "VARIABLE["; printAccess a; print "]")
                     32: 
                     33: fun printDcon (DATACON{name,rep=VARIABLE(access),...}) =
                     34:                (printSym(name); printAccess access)
                     35:   | printDcon (DATACON{name,...}) = printSym(name)
                     36: 
                     37: fun printDatacon(DATACON{name,typ,...}) =
                     38:     (printSym name; print " : "; printType(!typ))
                     39: 
                     40: fun printExn(DATACON{name,typ,...}) =
                     41:     (printSym name; print " : "; printType(!typ))
                     42: 
                     43: fun printVar (UNKNOWNvar s) = (printSym s; if !internals then print "?" else())
                     44:   | printVar (VALvar {access,name,...}) = (print(formatQid name); printAccess access)
                     45:   | printVar (OVLDvar {name,...}) = printSym(name)
                     46: 
                     47: fun printVariable(VALvar{name,access,typ}) = 
                     48:     (print(formatQid name); printAccess access;
                     49:      print " : "; printType(!typ))
                     50:   | printVariable(OVLDvar{name,...}) = (printSym name; print " : overloaded")
                     51:   | printVariable(UNKNOWNvar name) = (printSym name; print " : ?")
                     52: 
                     53: fun printStr(STRstr _) = print "STRstr"
                     54:   | printStr(INDstr _) = print "INDstr"
                     55:   | printStr(SHRstr _) = print "SHRstr"
                     56:   | printStr(NULLstr) = print "NULLstr"
                     57: 
                     58: fun printStrVar(STRvar{name,access,binding}) =
                     59:     (print(formatQid name); printAccess access;
                     60:      if !internals then (print "["; printStr binding; print "]") else ())
                     61: 
                     62: fun printBinding(VARbind(var)) = (print "val "; printVariable var)
                     63:   | printBinding(CONbind(con)) = (print "con "; printDatacon con)
                     64:   | printBinding(TYCbind(ref tycon)) = (print "type "; printTycon tycon)
                     65:   | printBinding(TYVbind v) = (print "type "; printTyvar v)
                     66:   | printBinding(SIGbind(SIGvar{name,...})) = (print "signature "; printSym name)
                     67:   | printBinding(STRbind(strVar)) = (print "structure "; printStrVar strVar)
                     68:   | printBinding(FCTbind(FCTvar{name,...})) = (print "functor "; printSym name)
                     69:   | printBinding(FIXbind(FIXvar{name,binding=NONfix})) = (print "nonfix "; printSym name)
                     70:   | printBinding(FIXbind(FIXvar{name,binding=INfix _})) = (print "infix "; printSym name)
                     71: 
                     72: fun printTable(table) =
                     73:     IntStrMap.app (fn (_,_,binding) => (printBinding(binding); newline())) table
                     74: 
                     75: fun printStructure(STRstr{stamp,table,env,...}) =
                     76:     let fun printTenv (t: tycon array) =
                     77:         let fun foreach i =
                     78:                 (print i; print " "; PrintType.printTycon(t sub i); newline();
                     79:                  foreach(i+1))
                     80:          in print "types\n";
                     81:             foreach 0
                     82:             handle Subscript => print "end types\n"
                     83:         end
                     84:      in
                     85:       (print "STRstr["; print stamp; print "]\n";
                     86:        case env
                     87:          of REL{t,...} => printTenv(t)
                     88:           | DIR => ();
                     89:        printTable table)
                     90:     end
                     91:   | printStructure(INDstr _) = ErrorMsg.impossible "printStructure: INDstr"
                     92:   | printStructure(SHRstr _) = ErrorMsg.impossible "printStructure: SHRstr"
                     93:   | printStructure(NULLstr) = ErrorMsg.impossible "printStructure: NULLstr"
                     94: 
                     95:   fun pr_path'[] = "]"
                     96:   |   pr_path'[x:int] = makestring x ^ "]"
                     97:   |   pr_path'((x:int)::rest)= makestring x ^ "," ^ pr_path' rest
                     98:   fun pr_path path = "[" ^ pr_path' path
                     99: 
                    100: end (* local *)
                    101: 
                    102: end (* PrintBasics *)

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.