Return to rsg.icn CVS log

Up to [Research Unix] / researchv10dc / cmd / icon / ipl / source

Annotation of researchv10dc/cmd/icon/ipl/source/rsg.icn, revision 1.1

1.1     ! root        1: #      RSG
        !             2: #
        !             3: #      Random sentence generation
        !             4: #
        !             5: #      Ralph E. Griswold
        !             6: #
        !             7: #      Last modified 4/29/86
        !             8: #
        !             9: 
        !            10: global defs, ifile, in, limit, tswitch, prompt
        !            11: 
        !            12: record nonterm(name)
        !            13: record charset(chars)
        !            14: record query(name)
        !            15: 
        !            16: procedure main(x)
        !            17:    local line, plist, i, s
        !            18:                                        # procedures to try on input lines
        !            19:    plist := [define,generate,grammar,source,comment,prompter,error]
        !            20:    defs := table()                     # table of definitions
        !            21:    defs["lb"] := [["<"]]               # built-in definitions
        !            22:    defs["rb"] := [[">"]]
        !            23:    defs["vb"] := [["|"]]
        !            24:    defs["nl"] := [["\n"]]
        !            25:    defs[""] := [[""]]
        !            26:    defs["&lcase"] := [[charset(&lcase)]]
        !            27:    defs["&ucase"] := [[charset(&ucase)]]
        !            28:    defs["&digit"] := [[charset('0123456789')]]
        !            29:    i := 0
        !            30:    while i < *x do {                   # process options
        !            31:       s := x[i +:= 1] | break
        !            32:       case s of {
        !            33:          "-t":   tswitch := 1
        !            34:          "-l":   limit := integer(x[i +:= 1]) | Usage()
        !            35:          "-s":   &random := integer(x[i +:= 1]) | Usage()
        !            36:          default:   Usage()
        !            37:          }
        !            38:       }
        !            39:    ifile := [&input]                   # stack of input files
        !            40:    prompt := ""
        !            41:    while in := pop(ifile) do {         # process all files
        !            42:       repeat {
        !            43:          if *prompt ~= 0 then writes(prompt)
        !            44:          line := read(in) | break
        !            45:          while line[-1] == "\\" do line := line[1:-1] || read(in) | break
        !            46:          (!plist)(line)
        !            47:          }
        !            48:       close(in)
        !            49:       }
        !            50: end
        !            51: 
        !            52: #  process alternatives
        !            53: #
        !            54: procedure alts(defn)
        !            55:    local alist
        !            56:    static nonbar
        !            57:    initial nonbar := ~'|'
        !            58:    alist := []
        !            59:    defn ? while put(alist,syms(tab(many(nonbar)))) do move(1)
        !            60:    return alist
        !            61: end
        !            62: 
        !            63: #  look for comment
        !            64: #
        !            65: procedure comment(line)
        !            66:    if line[1] == "#" then return
        !            67: end
        !            68: 
        !            69: #  look for definition
        !            70: #
        !            71: procedure define(line)
        !            72:    return line ?
        !            73:       defs[(="<",tab(find(">::=")))] := (move(4),alts(tab(0)))
        !            74: end
        !            75: 
        !            76: #  define nonterminal
        !            77: #
        !            78: procedure defnon(sym)
        !            79:    local chars, name
        !            80:    if sym ? {
        !            81:       ="'" &
        !            82:       chars := cset(tab(-1)) &
        !            83:       ="'"
        !            84:       }
        !            85:    then return charset(chars)
        !            86:    else if sym ? {
        !            87:       ="?" &
        !            88:       name := tab(0)
        !            89:       }
        !            90:    then return query(name)
        !            91:    else return nonterm(sym)
        !            92: end
        !            93: 
        !            94: #  note erroneous input line
        !            95: #
        !            96: procedure error(line)
        !            97:    write("*** erroneous line:  ",line)
        !            98:    return
        !            99: end
        !           100: 
        !           101: #  generate sentences
        !           102: #
        !           103: procedure gener(goal)
        !           104:    local pending, genstr, symbol
        !           105:    repeat {
        !           106:       pending := [nonterm(goal)]
        !           107:       genstr := ""
        !           108:       while symbol := get(pending) do {
        !           109:          if \tswitch then
        !           110:             write(&errout,genstr,symimage(symbol),listimage(pending))
        !           111:          case type(symbol) of {
        !           112:             "string":   genstr ||:= symbol
        !           113:             "charset":  genstr ||:= ?symbol.chars
        !           114:             "query":    {
        !           115:                writes("*** supply string for ",symbol.name,"  ")
        !           116:                genstr ||:= read() | {
        !           117:                   write(&errout,"*** no value for query to ",symbol.name)
        !           118:                   suspend genstr
        !           119:                   break next
        !           120:                   }
        !           121:                }
        !           122:             "nonterm":  {
        !           123:                pending := ?\defs[symbol.name] ||| pending | {
        !           124:                   write(&errout,"*** undefined nonterminal:  <",symbol.name,">")
        !           125:                   suspend genstr
        !           126:                   break next
        !           127:                   }
        !           128:                if *pending > \limit then {
        !           129:                   write(&errout,"*** excessive symbols remaining")
        !           130:                   suspend genstr
        !           131:                   break next
        !           132:                   }
        !           133:                }
        !           134:             }
        !           135:          }
        !           136:       suspend genstr
        !           137:       }
        !           138: end
        !           139: 
        !           140: #  look for generation specification
        !           141: #
        !           142: procedure generate(line)
        !           143:    local goal, count
        !           144:    if line ? {
        !           145:       ="<" &
        !           146:       goal := tab(upto('>')) \ 1 &
        !           147:       move(1) &
        !           148:       count := (pos(0) & 1) | integer(tab(0))
        !           149:       }
        !           150:    then {
        !           151:       every write(gener(goal)) \ count
        !           152:       return
        !           153:       }
        !           154:    else fail
        !           155: end
        !           156: 
        !           157: #  get right hand side of production
        !           158: #
        !           159: procedure getrhs(a)
        !           160:    local rhs
        !           161:    rhs := ""
        !           162:    every rhs ||:= listimage(!a) || "|"
        !           163:    return rhs[1:-1]
        !           164: end
        !           165: 
        !           166: #  look for request to write out grammar
        !           167: #
        !           168: procedure grammar(line)
        !           169:    local file, out, name
        !           170:    if line ? {
        !           171:       name := tab(find("->")) &
        !           172:       move(2) &
        !           173:       file := tab(0) &
        !           174:       out := if *file = 0 then &output else {
        !           175:          open(file,"w") | {
        !           176:             write(&errout,"*** cannot open ",file)
        !           177:             fail
        !           178:             }
        !           179:          }
        !           180:       }
        !           181:    then {
        !           182:       (*name = 0) | (name[1] == "<" & name[-1] == ">") | fail
        !           183:       pwrite(name,out)
        !           184:       if *file ~= 0 then close(out)
        !           185:       return
        !           186:       }
        !           187:    else fail
        !           188: end
        !           189: 
        !           190: #  produce image of list of grammar symbols
        !           191: #
        !           192: procedure listimage(a)
        !           193:    local s, x
        !           194:    s := ""
        !           195:    every x := !a do
        !           196:       s ||:= symimage(x)
        !           197:    return s
        !           198: end
        !           199: 
        !           200: #  look for new prompt symbol
        !           201: #
        !           202: procedure prompter(line)
        !           203:    if line[1] == "=" then {
        !           204:       prompt := line[2:0]
        !           205:       return
        !           206:       }
        !           207: end
        !           208: 
        !           209: #  write out grammar
        !           210: #
        !           211: procedure pwrite(name,ofile)
        !           212:    local nt, a
        !           213:    static builtin
        !           214:    initial builtin := ["lb","rb","vb","nl","","&lcase","&ucase","&digit"]
        !           215:    if *name = 0 then {
        !           216:       a := sort(defs,3)
        !           217:       while nt := get(a) do {
        !           218:          if nt == !builtin then {
        !           219:             get(a)
        !           220:             next
        !           221:             }
        !           222:          write(ofile,"<",nt,">::=",getrhs(get(a)))
        !           223:          }
        !           224:       }
        !           225:    else write(ofile,name,"::=",getrhs(\defs[name[2:-1]])) |
        !           226:       write("*** undefined nonterminal:  ",name)
        !           227: end
        !           228: 
        !           229: #  look for file with input
        !           230: #
        !           231: procedure source(line)
        !           232:    local file
        !           233:    return line ? (="@" & push(ifile,in) & {
        !           234:       in := open(file := tab(0)) | {
        !           235:          write(&errout,"*** cannot open ",file)
        !           236:          fail
        !           237:          }
        !           238:       })
        !           239: end
        !           240: 
        !           241: #  produce string image of grammar symbol
        !           242: #
        !           243: procedure symimage(x)
        !           244:    return case type(x) of {
        !           245:       "string":   x
        !           246:       "nonterm":  "<" || x.name || ">"
        !           247:       "charset":  "<'" || x.chars || "'>"
        !           248:       }
        !           249: end
        !           250: 
        !           251: #  process the symbols in an alternative
        !           252: #
        !           253: procedure syms(alt)
        !           254:    local slist
        !           255:    static nonbrack
        !           256:    initial nonbrack := ~'<'
        !           257:    slist := []
        !           258:    alt ? while put(slist,tab(many(nonbrack)) |
        !           259:       defnon(2(="<",tab(upto('>')),move(1))))
        !           260:    return slist
        !           261: end
        !           262: 
        !           263: #  stop, noting incorrect usage
        !           264: #
        !           265: procedure Usage()
        !           266:    stop("usage:  [-t] [-l n] [-s n]")
        !           267: end

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