Return to gc2.icn CVS log

Up to [Research Unix] / researchv10dc / cmd / icon / tests

Annotation of researchv10dc/cmd/icon/tests/gc2.icn, revision 1.1

1.1     ! root        1: #  This program tests rt/gollect.s and rt/sweep.c
        !             2: 
        !             3: global defs, ifile, in, limit, tswitch, prompt
        !             4: 
        !             5: record nonterm(name)
        !             6: record charset(chars)
        !             7: record query(name)
        !             8: 
        !             9: procedure main(x)
        !            10:    local line, plist
        !            11:    plist := [define,generate,grammar,source,comment,prompter,error]
        !            12:    defs := table()
        !            13:    defs["lb"] := [["<"]]
        !            14:    defs["rb"] := [[">"]]
        !            15:    defs["vb"] := [["|"]]
        !            16:    defs["nl"] := [["\n"]]
        !            17:    defs[""] := [[""]]
        !            18:    defs["&lcase"] := [[charset(&lcase)]]
        !            19:    defs["&ucase"] := [[charset(&ucase)]]
        !            20:    defs["&digit"] := [[charset('0123456789')]]
        !            21:    i := 0
        !            22:    while i < *x do {
        !            23:       s := x[i +:= 1] | break
        !            24:       case s of {
        !            25:          "-t":   tswitch := 1
        !            26:          "-l":   limit := integer(x[i +:= 1]) | stop("usage: [-t] [-l n]")
        !            27:          default:   stop("usage: [-t] [-l n]")
        !            28:          }
        !            29:       }
        !            30:    ifile := [&input]
        !            31:    prompt := ""
        !            32:    test := ["<a>::=1|2|3","<a>10","->","<b>::=<a>|<a><a>|<b><b>","<b>5",
        !            33:       "<c>::=<b><b><b>","<c>100","<b>100"]
        !            34:    every line := !test do {
        !            35:       (!plist)(line)
        !            36:       collect()
        !            37:       }
        !            38: end
        !            39: 
        !            40: procedure comment(line)
        !            41:    if line[1] == "#" then return
        !            42: end
        !            43: 
        !            44: procedure define(line)
        !            45:    return line ?
        !            46:       defs[(="<",tab(find(">::=")))] := (move(4),alts(tab(0)))
        !            47: end
        !            48: 
        !            49: procedure defnon(sym)
        !            50:    if sym ? {
        !            51:       ="'" &
        !            52:       chars := cset(tab(-1)) &
        !            53:       ="'"
        !            54:       }
        !            55:    then return charset(chars)
        !            56:    else if sym ? {
        !            57:       ="?" &
        !            58:       name := tab(0)
        !            59:       }
        !            60:    then return query(name)
        !            61:    else return nonterm(sym)
        !            62: end
        !            63: 
        !            64: procedure error(line)
        !            65:    write("*** erroneous line:  ",line)
        !            66:    return
        !            67: end
        !            68: 
        !            69: procedure gener(goal)
        !            70:    local pending, genstr, symbol
        !            71:    repeat {
        !            72:       pending := [nonterm(goal)]
        !            73:       genstr := ""
        !            74:       while symbol := get(pending) do {
        !            75:          if \tswitch then write(&errout,genstr,symimage(symbol),listimage(pending))
        !            76:          case type(symbol) of {
        !            77:             "string":   genstr ||:= symbol
        !            78:             "charset":  genstr ||:= ?symbol.chars
        !            79:            "query":    {
        !            80:                writes("*** supply string for ",symbol.name,"  ")
        !            81:                genstr ||:= read() | {
        !            82:                   write(&errout,"*** no value for query to ",symbol.name)
        !            83:                   suspend genstr
        !            84:                   break next
        !            85:                   }
        !            86:                }
        !            87:             "nonterm":  {
        !            88:                pending := ?\defs[symbol.name] ||| pending | {
        !            89:                   write(&errout,"*** undefined nonterminal:  <",symbol.name,">")
        !            90:                   suspend genstr
        !            91:                   break next
        !            92:                   }
        !            93:                if *pending > \limit then {
        !            94:                   write(&errout,"*** excessive symbols remaining")
        !            95:                   suspend genstr
        !            96:                   break next
        !            97:                   }
        !            98:                }
        !            99:             }
        !           100:          }
        !           101:       suspend genstr
        !           102:       }
        !           103: end
        !           104: 
        !           105: procedure generate(line)
        !           106:    local goal, count
        !           107:    if line ? {
        !           108:       ="<" &
        !           109:       goal := tab(upto('>')) \ 1 &
        !           110:       move(1) &
        !           111:       count := (pos(0) & 1) | integer(tab(0))
        !           112:       }
        !           113:    then {
        !           114:       every write(gener(goal)) \ count
        !           115:       return
        !           116:       }
        !           117:    else fail
        !           118: end
        !           119: 
        !           120: procedure getrhs(a)
        !           121:    local rhs
        !           122:    rhs := ""
        !           123:    every rhs ||:= sform(!a) || "|"
        !           124:    return rhs[1:-1]
        !           125: end
        !           126: 
        !           127: procedure grammar(line)
        !           128:    local file, out
        !           129:    if line ? {
        !           130:       name := tab(find("->")) &
        !           131:       move(2) &
        !           132:       file := tab(0) &
        !           133:       out := if *file = 0 then &output else {
        !           134:          open(file,"w") | {
        !           135:             write(&errout,"*** cannot open ",file)
        !           136:             fail
        !           137:             }
        !           138:          }
        !           139:       }
        !           140:    then {
        !           141:       (*name = 0) | (name[1] == "<" & name[-1] == ">") | fail
        !           142:       pwrite(name,out)
        !           143:       if *file ~= 0 then close(out)
        !           144:       return
        !           145:       }
        !           146:    else fail
        !           147: end
        !           148: 
        !           149: procedure listimage(a)
        !           150:    local s, x
        !           151:    s := ""
        !           152:    every x := !a do
        !           153:       s ||:= symimage(x)
        !           154:    return s
        !           155: end
        !           156: 
        !           157: procedure alts(defn)
        !           158:    local alist
        !           159:    alist := []
        !           160:    defn ? while put(alist,syms(tab(many(~'|')))) do move(1)
        !           161:    return alist
        !           162: end
        !           163: 
        !           164: procedure prompter(line)
        !           165:    if line[1] == "=" then {
        !           166:       prompt := line[2:0]
        !           167:       return
        !           168:       }
        !           169: end
        !           170: 
        !           171: procedure pwrite(name,ofile)
        !           172:    local nt, a
        !           173:    static builtin
        !           174:    initial builtin := ["lb","rb","vb","nl","","&lcase","&ucase","&digit"]
        !           175:    if *name = 0 then {
        !           176:       a := sort(defs)
        !           177:       every nt := !a do {
        !           178:          if nt[1] == !builtin then next
        !           179:          write(ofile,"<",nt[1],">::=",getrhs(nt[2]))
        !           180:          }
        !           181:       }
        !           182:    else write(ofile,name,"::=",getrhs(\defs[name[2:-1]])) |
        !           183:       write("*** undefined nonterminal:  ",name)
        !           184: end
        !           185: 
        !           186: procedure sform(alt)
        !           187:    local s, x
        !           188:    s := ""
        !           189:    every x := !alt do
        !           190:       s ||:= case type(x) of {
        !           191:          "string":  x
        !           192:          "nonterm": "<" || x.name || ">"
        !           193:          "charset": "<'" || x.chars || "'>"
        !           194:          }
        !           195:    return s
        !           196: end
        !           197: 
        !           198: procedure source(line)
        !           199:    return line ? (="@" & push(ifile,in) & {
        !           200:       in := open(file := tab(0)) | {
        !           201:          write(&errout,"*** cannot open ",file)
        !           202:          fail
        !           203:          }
        !           204:       })
        !           205: end
        !           206: 
        !           207: procedure symimage(x)
        !           208:    return case type(x) of {
        !           209:       "string":   x
        !           210:       "nonterm":  "<" || x.name || ">"
        !           211:       "charset":  "<'" || x.chars || "'>"
        !           212:       }
        !           213: end
        !           214: 
        !           215: procedure syms(alt)
        !           216:    local slist
        !           217:    slist := []
        !           218:    alt ? while put(slist,tab(many(~'<')) |
        !           219:       defnon(2(="<",tab(upto('>')),move(1))))
        !           220:    return slist
        !           221: end
        !           222: 

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