Return to rsg.icn CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / icon / src / cmd

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

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

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