Return to gc2.icn CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / icon / port

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

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