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

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.