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     ! 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.