Annotation of researchv10no/cmd/sml/src/cps/cps.sml, revision 1.1.1.1

1.1       root        1: (* Copyright 1989 by AT&T Bell Laboratories *)
                      2: signature CPS = sig
                      3: 
                      4: type lvar
                      5: exception Ctable
                      6: 
                      7: datatype const = INTconst of int | REALconst of string | STRINGconst of string
                      8: 
                      9: datatype accesspath = OFFp of int | SELp of int * accesspath
                     10: 
                     11: datatype cexp = RECORD of (lvar * accesspath) list * lvar * cexp
                     12:              | SELECT of int * lvar * lvar * cexp
                     13:              | OFFSET of int * lvar * lvar * cexp
                     14:              | APP of lvar * lvar list
                     15:              | FIX of (lvar * lvar list * cexp) list * cexp
                     16:              | SWITCH of lvar * cexp list
                     17:              | PRIMOP of Access.primop * lvar list * lvar list * cexp list
                     18: type function
                     19: val recordpath : lvar list -> (lvar * accesspath) list
                     20: val combinepaths : accesspath * accesspath -> accesspath
                     21: val lenp : accesspath -> int
                     22: 
                     23: end
                     24: 
                     25: structure CPS : CPS = struct
                     26: 
                     27: type lvar = int
                     28: exception Ctable
                     29: 
                     30: datatype const = INTconst of int | REALconst of string | STRINGconst of string
                     31: 
                     32: datatype accesspath = OFFp of int | SELp of int * accesspath
                     33: 
                     34: datatype cexp
                     35:   = RECORD of (lvar * accesspath) list * lvar * cexp
                     36:   | SELECT of int * lvar * lvar * cexp
                     37:   | OFFSET of int * lvar * lvar * cexp
                     38:   | APP of lvar * lvar list
                     39:   | FIX of function list * cexp
                     40:   | SWITCH of lvar * cexp list
                     41:   | PRIMOP of Access.primop * lvar list * lvar list * cexp list
                     42: withtype function = lvar * lvar list * cexp
                     43: 
                     44: val recordpath = map (fn v => (v,OFFp 0))
                     45: 
                     46: fun combinepaths(p,OFFp 0) = p
                     47:   | combinepaths(p,q) = 
                     48:     let val rec comb =
                     49:        fn (OFFp 0) => q
                     50:         | (OFFp i) => (case q of
                     51:                          (OFFp j) => OFFp(i+j)
                     52:                        | (SELp(j,p)) => SELp(i+j,p))
                     53:         | (SELp(i,p)) => SELp(i,comb p)
                     54:     in comb p
                     55:     end
                     56: 
                     57: fun lenp(OFFp _) = 0
                     58:   | lenp(SELp(_,p)) = 1 + lenp p
                     59: 
                     60: end

unix.superglobalmegacorp.com

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