Return to rsg.icn CVS log

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

Annotation of 43BSD/contrib/icon/port/rsg.icn, revision 1.1

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

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