# # KEHOME/src/bselist.icn # Oct/26/2005 Feb/2/2007 # Mar/27/2007 bse_replace_pronoun() # Aug/31/2008 bse_copy() new_bse(L,B,S,E) # BSE is list of strings with begin,separator,end character # bselist captures list details which are optional in MKR language # insures input text can be recovered exactly (except blanks between symbols) # used for subject,object,value lists # e.g.: value with optional brackets # e.g.: format enclosed by [] or {} # simple BSE examples # e.g. (e.g.) # a b c => BSE([a,b,c], , , ) # phrase (not used) # a,b,c => BSE([a,b,c], ,,, ) # comma list (phrases) # a;b;c => BSE([a,b,c], ,;, ) # semicolon list (relation) # a:b:c => BSE([a,b,c], ,:, ) # colon list (PATH variable) # [a,b,c] => BSE([a,b,c],[,,,]) # comma bracket list (phrases) # [a;b;c] => BSE([a,b,c],[,;,]) # semicolon bracket list (relation) # {a;b;c} => BSE([a,b,c],{,;,}) # semicolon brace list (propositions) #--------------------------------------------------------------------- # BSE record: order matches parsing order record BSE ( bse_list, # list of string (separator can be deleted,inserted) bse_begin, # string bse_separator, # string (not in input) bse_end # string ) # BSE methods: # bse_unparse(bse) # bse_tsize(bse) # bse_map_symbol(bse) # bse_copy(bse) # bse_replace_dollar(bse) # bse_replace_pronoun(bse) # new_bse(L,B,S,E) # bad_bse(bse) # bse_separator(bse) # bse_begin(bse) # bse_list(bse) # bse_end(bse) # bse_writes(fd,bse) # bse_delete_separator(bse) # bse_insert_separator(bse) # bse_parse(line,pattern) #========================================================# procedure mbse_unparse(x) #======================== local y y := mbse2bse(x) return bse_unparse(y) end # BSE procedure mbse2bse(x) #==================== # record m_BSE() defined in symbol.icn local y if type(x) == "m_BSE" then { } else fail y := new_bse( x.mbse_list, x.mbse_begin, x.mbse_separator, x.mbse_end ) return y end # BSE procedure bse_copy(x) #==================== local y,S,B,L,E L := bse_list(x) B := bse_begin(x) S := bse_separator(x) E := bse_end(x) y := new_bse(copy_list(L),B,S,E) return y end # BSE procedure bse_replace_dollar(x) #============================== local y static info initial { info := "INFO: bse_replace_dollar: " } if DEBUG=="BSE" then { writes_type(mybug,x,info||"x") writes_type(mylog,x,info||"x") } y := new_bse( replace_dollar_symbol( bse_list(x) ), # replace.icn bse_begin(x), bse_separator(x), bse_end(x) ) if DEBUG=="BSE" then { writes_type(mybug,y,info||"y") writes_type(mylog,y,info||"y") } return y end # BSE procedure bse_replace_pronoun(x) #=============================== local y static info initial { info := "INFO: bse_replace_pronoun: " } if DEBUG=="BSE" then { writes_type(mybug,x,info||"x") writes_type(mylog,x,info||"x") } y := new_bse( replace_pronoun_symbol( bse_list(x) ), # replace.icn bse_begin(x), bse_separator(x), bse_end(x) ) if DEBUG=="BSE" then { writes_type(mybug,y,info||"y") writes_type(mylog,y,info||"y") } return y end # string procedure bse_unparse(x) #======================= # return input string for x local S,B,L,E local s,y,z,t,vL static info,ierror initial { info := "INFO: bse_unparse: " ierror := "Internal ERROR: bse_unparse: " } S := x.bse_separator B := x.bse_begin L := x.bse_list E := x.bse_end vL := bse_valid_list(L) s := *vL y := B if s > 0 then y ||:= unparse(vL,S) y ||:= E if DEBUG==("PARSE"|"UNPARSE") then write(&errout,TypeComment||info||"y=<",y,">") return y end # integer procedure bse_tsize(symbol) #========================== # called from tsize() in symbol.icn # count number of tokens in bse local L,s,B,S,E,ntoken S := symbol.bse_separator B := symbol.bse_begin L := symbol.bse_list E := symbol.bse_end ntoken := 0 # S not in input stream ntoken +:= *B ntoken +:= tsize(L) # symbol.icn ntoken +:= *E return ntoken end # BSE procedure bse_map_symbol(tsym,tok) #================================= # called from map_symbol() in symbol.icn local S,B,L,E local mB,mL,mE,newbse static info initial { info := "INFO: bse_map_symbol: " } if DEBUG=="BSE" then { writes_type(mybug,tsym,info||"tsym") writes_type(mylog,tsym,info||"tsym") } L := tsym.bse_list B := tsym.bse_begin S := tsym.bse_separator E := tsym.bse_end mB := map_symbol(B,tok) mL := map_symbol(L,tok) mE := map_symbol(E,tok) case S of { default: { } ",": { mL := delete_separator(mL,S) } } newbse := BSE(mL,mB,S,mE) if DEBUG=="BSE" then { writes_type(mybug,newbse,info||"newbse") writes_type(mylog,newbse,info||"newbse") } return newbse end #========================================================# procedure new_bse(L,B,S,E) #========================= # BSE record: S + parse order B,L,E local vL static info,warning,ierror initial { info := "INFO: new_bse: " warning := "WARNING: new_bse: " ierror := "InternalError: new_bse: " } /B := "" /S := "," /E := "" vL := bse_valid_list(L) return BSE(vL,B,S,E) end # list procedure bse_list(x) #==================== local t,y static warning,ierror initial { warning := "WARNING: bse_list: " ierror := "Internal ERROR: bse_list: " } case t := type(x) of { default: { writes_type(myerr,x,ierror||"unxpected type x") y := x } "BSE": { y := x.bse_list } "list": { writes_type(mylog,x,warning||"list not BSE x") y := x } "string": { if x == "[]" then y := [] else { writes_type(mylog,x,warning||"string not BSE x") y := x } } } return y end # string procedure bse_separator(x) #========================= return x.bse_separator end # string procedure bse_begin(x) #========================= return x.bse_begin end # string procedure bse_end(x) #========================= return x.bse_end end # integer procedure bse_writes(fd,bse) #=========================== # do NOT use writes_any for S,B,E local S,B,L,E local saveCHARFORMAT saveCHARFORMAT := CHARFORMAT; CHARFORMAT := "line" S := bse.bse_separator B := bse.bse_begin L := bse.bse_list E := bse.bse_end writes(fd,"BSE(") writes_any(fd,L) writes(fd,",",B) writes(fd,",",S) writes(fd,",",E) writes(fd,")") CHARFORMAT := saveCHARFORMAT end # list procedure bse_valid_list(L,S) #============================ # delete separators # enclose single item in list local t,vL static info,ierror,warning initial { info := "INFO: bse_valid_list: " warning := "WARNING: bse_valid_list: " ierror := "Internal ERROR: bse_valid_list: " } /S := "," case t := type(L) of { default: { writes_type(mylog,L,info||"enclose in list: L") vL := [L] } "null": { writes_type(myerr,L,ierror||"null list L") writes_type(mylog,L,ierror||"null list L") vL := ["NullList_"||new_id()] } "list": { vL := L } "set": { vL := set2list(L) } "string": { vL := bse_parse(L) } "integer": { vL := [L] } "real" : { vL := [L] } } #####vL := delete_separator(L,S) return vL end # BSE procedure bse_delete_separator(x,sep) #==================================== # delete any separators # e.g.: left from initial parsing local L,B,S,E local dL,ds static info,warning initial { info := "INFO: bse_delete_separator: " warning := "WARNING: bse_delete_separator: " } /sep := "," S := x.bse_separator B := x.bse_begin L := x.bse_list E := x.bse_end if sep ~== S then { write(mylog,TypeComment||warning,"separator mismatch sep<",sep,"> S<",S,">") } dL := delete_separator(L,S) return BSE(dL,B,S,E) end procedure bse_insert_separator(x) #================================ # insert separators local S,B,L,E local iL,n,i,y L := x.bse_list B := x.bse_begin S := x.bse_separator E := x.bse_end n := *L i := 0 iL := [] every y := !L do { i +:= 1 put(iL,y) if i < n then put(iL,S) } return BSE(iL,B,S,E) end procedure bse_size(x) #==================== return *x.bse_list end # BSE procedure bse_parse(x,pattern) #============================= # for now, everything is singleton list # x ::= string local y static info,ierror initial { info := "INFO: bse_parse: " ierror := "Internal ERROR: bse_parse: " } y := new_bse([x],"[",",","]") return y end #