Return to tuples.sml CVS log

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

Annotation of researchv10no/cmd/sml/src/basics/tuples.sml, revision 1.1

1.1     ! root        1: (* Copyright 1989 by AT&T Bell Laboratories *)
        !             2: signature TUPLES = sig
        !             3:   structure Basics : BASICS
        !             4:   val numlabel : int -> Basics.label
        !             5:   val mkTUPLEtyc : int -> Basics.tycon
        !             6:   val isTUPLEtyc : Basics.tycon -> bool
        !             7:   val mkRECORDtyc : Basics.label list -> Basics.tycon
        !             8: end
        !             9: 
        !            10: structure Tuples : TUPLES = struct
        !            11: 
        !            12: structure Basics = Basics
        !            13: 
        !            14: structure Labels =
        !            15:   struct datatype labelOpt = NOlabel | SOMElabel of Basics.label
        !            16:          datatype tyconOpt = NOtycon | SOMEtycon of Basics.tycon
        !            17:   end
        !            18: 
        !            19: open Labels Basics
        !            20: 
        !            21: structure LabelArray =
        !            22:     Dynamic (struct open Array
        !            23:               type array = Labels.labelOpt array
        !            24:               type elem = Labels.labelOpt
        !            25:             end)
        !            26: 
        !            27: structure TyconArray =
        !            28:     Dynamic (struct open Array
        !            29:               type array = Labels.tyconOpt array
        !            30:               type elem = Labels.tyconOpt
        !            31:             end)
        !            32: 
        !            33: exception New
        !            34: val tyconTable = IntStrMap.new(32,New) : tycon IntStrMap.intstrmap
        !            35: val tyconMap = IntStrMap.map tyconTable
        !            36: val tyconAdd = IntStrMap.add tyconTable
        !            37: 
        !            38: fun labelsToSymbol(labels: label list) : Symbol.symbol =
        !            39:     let fun wrap [] = ["}"]
        !            40:          | wrap [id] = [Symbol.name id, "}"]
        !            41:          | wrap (id::rest) = Symbol.name id :: "," :: wrap rest
        !            42:      in Symbol.symbol(implode("{" :: wrap labels))
        !            43:     end
        !            44: 
        !            45: fun mkRECORDtyc(labels: label list) : tycon =
        !            46:     let val recordName = labelsToSymbol labels
        !            47:         val number = Symbol.number recordName
        !            48:         val name = Symbol.name recordName
        !            49:      in tyconMap(number,name)
        !            50:        handle New =>
        !            51:          let val tycon = TYCON{stamp = Stampset.newStamp(Stampset.fixedTycStamps),
        !            52:                                arity = length labels,
        !            53:                                eq    = ref YES,
        !            54:                                path  = [recordName],
        !            55:                                kind  = RECORDtyc labels}
        !            56:           in tyconAdd(number,name,tycon);
        !            57:              tycon
        !            58:          end
        !            59:     end
        !            60: 
        !            61: val numericLabels = LabelArray.array(NOlabel)
        !            62: val tupleTycons = TyconArray.array(NOtycon)
        !            63: 
        !            64: fun numlabel i =
        !            65:     case LabelArray.sub(numericLabels,i)
        !            66:       of NOlabel =>
        !            67:           let val newlabel = Symbol.symbol(makestring i)
        !            68:            in LabelArray.update(numericLabels,i,SOMElabel(newlabel));
        !            69:               newlabel
        !            70:           end
        !            71:        | SOMElabel(label) => label
        !            72: 
        !            73: fun numlabels n =
        !            74:     let fun labels (0,acc) = acc
        !            75:          | labels (i,acc) = labels (i-1, numlabel i :: acc)
        !            76:     in labels (n,nil)
        !            77:     end
        !            78: 
        !            79: fun mkTUPLEtyc n =
        !            80:     case TyconArray.sub(tupleTycons,n)
        !            81:       of NOtycon =>
        !            82:            let val tycon = mkRECORDtyc(numlabels n)
        !            83:            in TyconArray.update(tupleTycons,n,SOMEtycon(tycon));
        !            84:               tycon
        !            85:           end
        !            86:        | SOMEtycon(tycon) => tycon
        !            87: 
        !            88: fun checklabels (2,nil) = false   (* {1:t} is not a tuple *)
        !            89:   | checklabels (n,nil) = true
        !            90:   | checklabels (n, lab::labs) = 
        !            91:        Symbol.eq(lab, numlabel n) andalso checklabels(n+1,labs)
        !            92: 
        !            93: fun isTUPLEtyc(TYCON{kind=RECORDtyc labels,...}) = checklabels(1,labels)
        !            94:   | isTUPLEtyc _ = false
        !            95:     
        !            96: end (* structure Tuples *)

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