# # KEHOME/src/convert.icn # Richard H. McCullough Sep/29/2005 Jul/20/2009 Aug/14/2014 Apr/21/2015 link bselist $include "keparam.h" # procedures #==========# # brace2list(format) # bracket2list(label) # delete_separator(L,sep) # dequote(s) # echange2string(echange) # enbracket(s) # enquote(s,sep) # forcequote(s,q) # get_phrase(symbol) # get_string(x,option) # list2phrase(L,sep) # list2string(L,sep,bracket) # list2value(L,sep,bracket) # List2list(x) # NullList(x) # NullString(x) # NullValue(x) # parse_bracket(s) # phrase2list(phrase) # remove_angle(x) # remove_brace(s) # remove_bracket(s) # remove_dquote(s) # remove_paren(s) # remove_quote(s) # remove_squote(s) # Set2set(x) # set2list(x) # set2string(L,sep) # set2value(L,sep) # string2charlist(x) # string2list(s) # sym2string(x,listsep,wordsep,option) # sym2value(x,listsep,wordsep) # symbol2blist(symbol,listsep,wordsep,option) # symbol2string(symbol,listsep,wordsep,option) # symbol2value(symbol,listsep,wordsep) # symbol2vlist(symbol,listsep,wordsep) # token2string(T,sep) # value2list(v) # value2set(v) #=============================================================# # NOTE: # # get_string() destroys parse info., returns nest of strings # # unparse() destroys list, returns a string # # rhm Jun/23/2002 # #=============================================================# # list procedure List2list(x) #====================# # convert mkr List to unicon list local t,st,y if ((t := type(x)) == "SYMBOL") & ((st := x.stype) == "List") then { y := x.svalue[2:-1] y := csv_list(y[1]) } else { fail } return y end # set procedure Set2set(x) #==================# # convert mkr Set to unicon set local t,st,y if ((t := type(x)) == "SYMBOL") & ((st := x.stype) == "Set") then { y := x.svalue[2:-1] y := csv_list(y[1]) } else { fail } return set(y) end # string or nested list/set procedure get_string(x,option) #============================= # grammar change: "wp" now "nvnull" in nvlist context # convert symbols to nested lists of strings # option ::= # all # keep all characters # nv # keep nv; delete separators # other # delete separators # # type()=="null" => return "" # SYMBOL("null",[]) => return "" # SYMBOL("ppnull",[]) => return "" # use PHRASE list for subject,object,value # BSE(S,B,L,E) => return get_string(L,option) local t,st,y local fdebug static prog,b,colon,yyprefix static warning initial { prog := "get_string: " b := " " colon := ":" warning := "WARNING: get_string: " } fdebug := mylog yyprefix := yylineno||colon||yywordno||b||yyformat||b||prog #----------------------------# #return unparse(x) #----------------------------# /option := "all" # return all characters case t := type(x) of { default: { write(fdebug,yyprefix,warning,"unexpected input type (",t,") x = (",showparse(x),")") return x } "null": { return "" } ("integer"|"real"): { return string(x) } "string": { case option of { "all": { return x } "nv": { return x } default: { return x } } # end case option } "list": { y := [] every put(y,get_string(!x,option)) case option of { "all": { return y } "nv": { return delete_separator(y) } default: { return delete_separator(y) } } # end case option } "set": { y := set() every insert(y,get_string(!x,option)) case option of { "all": { return y } "nv": { return delete_separator(y) } default: { return delete_separator(y) } } # end case option } "PHRASE": { return(get_string(x.pvalue,option)) } "NVPHRASE":{ return(get_string(x.novlist,option)) } "SYMBOL": { case option of { "all": { return get_string(x.svalue,option) } "nv": { case x.stype of { default: { return get_string(x.svalue,option) } "null": { return "" } "wp": { return x } "nv": { return x } "nvnull": { return SYMBOL("nv",[x.svalue,NVSEPARATOR,""]) } } # end case stype } # end "wp2nv" default: { # stip bracket, etc. case st := x.stype of { default: { write(fdebug,yyprefix,warning,"unexpected input stype (",st,") x = (",showparse(x),")") return x } "null": { return "" } "wp": { return get_string(x.svalue,option) } "nv": { return get_string(x.svalue,option) } "nvnull": { return [get_string(x.svalue,option)] } # list like nv "bracket": { return get_string(x.svalue[2],option) } "paren": { return get_string(x.svalue[2],option) } "brace": { return get_string(x.svalue[2],option) } "angle": { return get_string(x.svalue[2],option) } } # end case stype } # end default } # end case option } # end "SYMBOL" "BSE": { return( get_string(bse_list(x),option) ) } # end "BSE" "PPOBJECT": { y := PPOBJECT() y.ppat := get_string(x.ppat,option) y.ppof := get_string(x.ppof,option) y.ppwith := get_string(x.ppwith,option) y.ppout := get_string(x.ppout,option) y.ppod := get_string(x.ppod,option) y.ppfrom := get_string(x.ppfrom,option) y.ppto := get_string(x.ppto,option) return y } } # end case type end # list or set or CSV or PHRASE or PPHRASE or QPHRASE or BSE or NEST procedure delete_separator(L,sep) #================================ # delete separator used in external representation of list local t,st,nosep,x local prep,nvlist local fdebug static prog,b,c,colon,yyprefix static info,warning,ierror initial { prog := "delete_separator: " b := " " c := "," colon := ":" info := "INFO: " warning := "WARNING: " ierror := "Internal ERROR: " } fdebug := mylog yyprefix := yylineno||colon||yywordno||b||KFORMAT||b||prog /sep := c if DEBUG == "SEPARATOR" then { write(fdebug,yyprefix,"input L = (",showparse(L),")") } case t := type(L) of { default: { write(fdebug,yyprefix,"unexpected input type (",image(t),")"); nosep := L } "list": { if *L = 0 then return L nosep := [] every x := !L do if unparse(x) ~== sep then put(nosep,x) } "set": { if *L = 0 then return L nosep := set2list(L) nosep := delete_separator(nosep,sep) nosep := set(nosep) } "CSV": { if *L = 0 then return L nosep := L.csv_list nosep := delete_separator(nosep,sep) nosep := CSV(nosep) } "PHRASE": { if *L = 0 then return L nosep := L.phrase_list nosep := delete_separator(nosep,sep) nosep := PHRASE(nosep) } "PPHRASE": { if *L = 0 then return L nosep := L.pp_object nosep := delete_separator(nosep,sep) nosep := PPHRASE([pp_prep(L),nosep]) } "NVPHRASE": { if *L = 0 then return L nosep := L.nv_list nosep := delete_separator(nosep,sep) nosep := NVPHRASE(nosep) } "QPHRASE": { if *L = 0 then return L nosep := L.qphrase_list nosep := delete_separator(nosep,sep) nosep := QPHRASE(nosep) } "BSE": { if *L = 0 then return L nosep := L.bse_blist nosep := delete_separator(nosep,sep) nosep := BSE(L.bse_sep,L.bse_begin,nosep,L.bse_end) } "NEST": { if *L = 0 then return L nosep := [] every x := !L do if unparse(x) ~== sep then put(nosep,x) } } # end case t if DEBUG == "SEPARATOR" then { write(fdebug,yyprefix,"output nosep = (",showparse(nosep),")") } return nosep end #=================================================================# # convert between string/list/nest/... # enquote/dequote strings with special characters # enbracket/parse_bracket symbols ([...] SYMBOLS representing lists/sets) # string procedure NullString(x) #====================== # ignore argument; return "" return "" end # string procedure NullValue(x) #===================== # ignore argument; return "[]" return "[]" end # list procedure NullList(x) #==================== # ignore argument; return [] return [] end #=================================================================# # string procedure echange2string(echange) #================================ local s if type(echange)=="null" then fail s := sym2string(echange) return s end # list procedure symbol2blist(symbol,listsep,wordsep,option) #==================================================== local blist /listsep := "" /wordsep := " " /option := "string" # or "value" if type(symbol)=="null" then fail blist := parse_list( sym2string(symbol,listsep,wordsep,option), listsep ) return blist end # string procedure sym2string(x,listsep,wordsep,option) #============================================= # get rid of extra blank at end of string /listsep := "," # original comma removed by map_symbol() /wordsep := " " /option := "string" # or "value" if type(x)=="null" then fail return trimws( symbol2string(x,listsep,wordsep,option) ) end # string procedure symbol2string(symbol,listsep,wordsep,option) #===================================================== # bracket all list/set # leaves extra wordsep at end # WARNING: use listsep="" before delete_separator(symbol,",") # WARNING: use listsep="," after delete_separator(symbol,",") local s,t,n,sym,i local fdebug static prog,b,colon,yyprefix static ierror initial { prog := "symbol2string: " b := " " colon := ":" ierror :="Internal ERROR: " } fdebug := mylog yyprefix := yylineno||colon||yywordno||b||yyformat||b||prog /wordsep := " " /option := "string" # or "value" case t := type(symbol) of { default: { write(fdebug,yyprefix,ierror,"unexpected input type (",t,") symbol = (",showparse(symbol),")") return symbol } "SYMBOL": { return symbol2string(symbol.svalue,listsep,wordsep,option) } "string": { return symbol||wordsep } "integer": { return string(symbol)||wordsep } "real": { return string(symbol)||wordsep } ("list"|"set"): { case option of { default: { # "string" n := *symbol i := 0 s := "[" every sym := !symbol do { i +:= 1 s ||:= symbol2string(sym,listsep,wordsep,option) if i < n then s ||:= listsep } s ||:= "]" return s } # end default # "string" "value": { n := *symbol i := 0 s := "" #####if n > 1 then s ||:= "[" every sym := !symbol do { i +:= 1 s ||:= symbol2string(sym,listsep,wordsep,option) if i < n then s ||:= listsep } #####if n > 1 then s ||:= "]" return s } # end "value" } # end case option } # end "list"|"set" } # end case t end # list procedure symbol2vlist(symbol,listsep,wordsep) #============================================= local vlist,option /listsep := "," # original comma removed by map_symbol() /wordsep := " " option := "value" if type(symbol)=="null" then fail vlist := parse_list( sym2value(symbol,listsep,wordsep,option), listsep ) return vlist end # string procedure sym2value(x,listsep,wordsep) #===================================== # get rid of extra blank at end of string local value,option /listsep := "," # original comma removed by map_symbol() /wordsep := " " option := "value" if type(x)=="null" then fail value := trimws(symbol2value(x,listsep,wordsep,option)) return value end # value procedure symbol2value(symbol,listsep,wordsep) #============================================= # do NOT bracket list/set (of length 1) # leaves extra sep at end # WARNING: use listsep="" before delete_separator(symbol,",") # WARNING: use listsep="," after delete_separator(symbol,",") local value,option /listsep := "," # original comma removed by map_symbol() /wordsep := " " option := "value" if type(symbol)=="null" then fail value := symbol2string(symbol,listsep,wordsep,option) return value end procedure token2string(T,sep) #============================ local n,s,i /sep := " " if type(T)=="null" then fail n := *T s := "" every i := 1 to n do { s ||:= T[i].tvalue if i < n then s ||:= sep } return s # do NOT enquote() end # value procedure list2value(L,sep,bracket) #================================== # no bracket for list of length 1 # optional bracket for list of length > 1 /sep := "," /bracket := "" if type(L)=="null" then fail case *L of { 0: { return "" } 1: { return !L } default: { return list2string(L,sep,bracket) } } end # value procedure set2value(L,sep) #========================= # no bracket for list of length 1 if type(L)=="null" then fail return list2value(L,sep) end # string procedure list2string(L,sep,bracket) #=================================== local n,s,i,x /sep := "," /bracket := "[]" if type(L)=="null" then fail n := *L i := 0 s := bracket[1] | "" every x := !L do { i +:= 1 s ||:= x if i < n then s ||:= sep } s ||:= bracket[2] | "" return s end # string procedure set2string(L,sep) #========================== if type(L)=="null" then fail return list2string(L,sep) end procedure set2list(x) #==================== local L,y if type(x)=="null" then fail L := [] every y := ! x do put(L,y) return L end procedure string2list(s) #======================= local L static WordDef initial WordDef := &cset -- ',' if type(s)=="null" then fail L := [] s ? while tab(upto(WordDef)) do put(L,trimws(tab(many(WordDef)))) return L end #=================================================================# procedure forcequote(s,q) #======================== # make sure s is quoted -- for separator & comments local qsq static info initial { info := "INFO: forcequote: " } /q := "\"" #writes_type(mylog,s,info||"s") case type(s) of { default: { return s } "string": { qsq := q||dequote(s)||q #writes_type(mylog,qsq,info||"qsq") return qsq } } end procedure enquote(s,sep) #======================= # quote string containing separators # do not nest quote mark static ws,dquote,squote static SEPARATOR initial { SEPARATOR := '[,]{;}()<>' ws := ' \t\v\r\n\\f' dquote := "\"" squote := "\'" } /sep := SEPARATOR case type(s) of { default: { return s } "null": { fail } "string": { } } s := trim(s,ws,0) if *s = 0 then { return NullString(s) # "" } else if is_quote(s) then { # newword.icn return s # do NOT nest quote mark } else if is_bracket(s) then { # newword.icn return s # do NOT quote bracket } else if is_brace(s) then { # newword.icn return s # do NOT quote brace } else if upto(sep,s) then { return dquote||s||dquote # quote SEPARATOR } else if s==dquote then { return "dquote" # alias } else if s==squote then { return "squote" # alias } else { return dquote||s||dquote } end procedure dequote(s) #=================== return remove_quote(s) end procedure remove_quote(s) #======================== # remove quotes local t,x,y case t := type(s) of { default: { return s } "null": { fail } "string": { if is_quote(s) then return s[2:-1] else return s } "PHRASE": { x := unparse(s) y := dequote(x) return PHRASE([y]) } } # end case t end procedure remove_dquote(s) #========================= case type(s) of { default: { return s } "null": { fail } "string": { } } if is_dquote(s) then return s[2:-1] else return s end procedure remove_squote(s) #========================= case type(s) of { default: { return s } "null": { fail } "string": { } } if is_squote(s) then return s[2:-1] else return s end #=================================================================# # SYMBOL procedure enbracket(s) #===================== # [phrase,...] if type(s)=="null" then fail return SYMBOL("bracket",["[",s,"]"]) end # list or other procedure parse_bracket(s) #========================= # remove brackets from SYMBOL or list or string # parse string when brackets are removed # always return list for string input !!! local t local fdebug static prog,b,colon,yyprefix static ierror initial { prog := "parse_bracket: " b := " " colon := ":" ierror := "Internal ERROR: " } fdebug := mylog yyprefix := yylineno||colon||yywordno||b||yyformat||b||prog if type(s)=="null" then fail case t := type(s) of { default: { write(fdebug,yyprefix,ierror,"unexpected input type (",t,") s = (",showparse(s),")") return s # other } "SYMBOL": { return remove_bracket(s) } # list or SYMBOL "list": { return remove_bracket(s) } # list "string": { if *s >= 2 & s[1]=="[" & s[-1]=="]" then return parse_list( s[2:-1] ) # list else return [ s ] # list } } # end case type end # list or string or other procedure remove_bracket(s) #========================== # remove brackets from SYMBOL or list or string # do NOT parse string when brackets are removed # return list or string local x,y,z local t,stype,svalue local fdebug static prog,b,colon,yyprefix static info,ierror,warning static lsep,psep initial { prog := "remove_bracket: " b := " " colon := ":" lsep := "," psep := " " info := "INFO: " ierror := "Internal ERROR: " warning := "WARNING: " } fdebug := mylog yyprefix := yylineno||colon||yywordno||b||yyformat||b||prog if DEBUG==("BRACKET"|"BSE") then { writes_type(fdebug,s,info||"input s") } x := s if type(s)=="null" then fail if *s = 0 then return s case t := type(s) of { default: { write(fdebug,yyprefix,ierror,"unexpected input type (",t,") s = (",showparse(s),")") x := s # other } ("integer"|"real"): { return s } "SYMBOL": { stype := s.stype svalue := s.svalue case stype of { default: { write(fdebug,yyprefix,warning,"unexpected input stype (",stype,") s = (",showparse(s),")") x := s # SYMBOL } "bracket": { # SYMBOL("bracket", ["[",[aa,bb,cc],"]"] ) x := svalue[2] # remove bracket } "phrase_pplist": { y := phrase_list(svalue[1]) z := unparse(svalue[2],psep,psep) x := put(y,z) } } # end case stype } "BSE": { if bse_begin(s)=="[" then { x := bse_blist(s) } else { x := s } } "list": { if *s >= 2 & type(s[1])=="string" & s[1]=="[" & type(s[-1])=="string" & s[-1]=="]" then x := s[2:-1] # remove bracket else x := s # list } "PHRASE": { s := s.phrase_list if *s >= 2 & type(s[1])=="string" & s[1]=="[" & type(s[-1])=="string" & s[-1]=="]" then x := s[2:-1] # remove bracket else x := s # list x := PHRASE(x) } "CSV": { s := s.csv_list if *s >= 2 & type(s[1])=="string" & s[1]=="[" & type(s[-1])=="string" & s[-1]=="]" then x := s[2:-1] # remove bracket else x := s # list x := CSV(x) } "string": { if *s >= 2 & s[1]=="[" & s[-1]=="]" then x := trimws(s[2:-1]) # string else x := s # string } } # end case type if DEBUG==("BRACKET"|"BSE") then { writes_type_all(x,info||"output x") } return x end # list or string or other procedure remove_brace(s) #======================== # remove braces from SYMBOL or list or string # do NOT parse string when braces are removed # return list or string local x local t,stype,svalue local fdebug static prog,b,ws,colon,yyprefix static info,ierror initial { prog := "remove_brace: " b := " " colon := ":" ws := ' \t\v\r\n\f' info := "INFO: " ierror := "Internal ERROR: " } fdebug := mylog yyprefix := yylineno||colon||yywordno||b||yyformat||b||prog if DEBUG==("BRACE"|"BSE") then { write(fdebug,yyprefix,info,"input s = (",showparse(s),")") } x := s if type(s)=="null" then fail if *s = 0 then return s case t := type(s) of { default: { write(&errout,yyprefix,ierror,"unexpected input type (",t,") s = (",showparse(s),")") x := s # other } ("integer"|"real"): { return s } "SYMBOL": { stype := s.stype svalue := s.svalue case stype of { default: { write(fdebug,yyprefix,ierror,"unexpected input stype (",stype,") s = (",showparse(s),")") x := s # SYMBOL } "brace": { # SYMBOL("brace", ["{",[aa,bb,cc],"}"] ) x := svalue[2] # remove bracket } } # end case stype } "BSE": { if bse_begin(s)=="{" then { x := bse_blist(s) } else { x := s } } "list": { if (*s >= 2) & (type(s[1])=="string") & (s[1]=="{") & (type(s[-1])=="string") & (s[-1]=="}") then x := s[2:-1] # remove bracket else x := s # list } "string": { if (*s >= 2) & (s[1]=="{") & (s[-1]=="}") then x := trim(s[2:-1],ws,0) # string else x := s # string } } # end case type if DEBUG == ("BRACE"|"BSE") then { write(fdebug,yyprefix,"output x = (",showparse(x),")") } return x end # list or string or other procedure remove_paren(s) #======================== # remove parens from SYMBOL or list or string # do NOT parse string when parens are removed # return list or string local t,stype,svalue local fdebug static prog,b,colon,yyprefix static ierror initial { prog := "remove_paren: " b := " " colon := ":" ierror := "Internal ERROR: " } fdebug := mylog yyprefix := yylineno||colon||yywordno||b||yyformat||b||prog if type(s)=="null" then fail case t := type(s) of { default: { write(fdebug,yyprefix,ierror,"unexpected input type (",t,") s = (",showparse(s),")") return s # other } "SYMBOL": { stype := s.stype svalue := s.svalue case stype of { default: { write(fdebug,yyprefix,"unexpected input stype (",stype,") s = (",showparse(s),")") return s # SYMBOL } "List": { # SYMBOL("List", ["(",[aa,bb,cc],")"] ) return svalue[2] # remove paren } } # end case stype } "list": { if *s >= 2 & type(s[1])=="string" & s[1]=="(" & type(s[-1])=="string" & s[-1]==")" then return s[2] # remove paren else return s # list } "CSV": { return CSV(remove_paren(csv_list(s))) } "PHRASE": { return PHRASE(remove_paren(phrase_list(s))) } "string": { if *s >= 2 & s[1]=="(" & s[-1]==")" then return trimws(s[2:-1]) # string else return s # string } } # end case type end #----------------------------------------# # list procedure string2charlist(x) #=========================== local y static warning initial warning := "WARNING: string2charlist: " case type(x) of { default: { writes_type_all(x,warning||"not string type: x") y := x } "string": { y := [] every put(y,!x) } } # end case type(x) return y end # list procedure bracket2list(label) #============================ # convert bracket to list # type(label) ::= SYMBOL | list | string local lab,lablist if is_quote(label) then { lab := dequote(label) } else if is_bracket(label) then { lab := remove_bracket(label) } else { lab := label } case type(lab) of { default: { } "list": { } "string": { lab := parse_list(lab,",") } } lablist := delete_separator(lab,",") return lablist end # list procedure brace2list(format) #=========================== # convert brace to list # type(format) ::= SYMBOL | list | string local fmt,flist if is_quote(format) then { fmt := dequote(format) } else if is_brace(format) then { fmt := remove_brace(format) } else { fmt := format } case type(fmt) of { default: { } "list": { } "string": { fmt := parse_list(fmt,",") } } flist := delete_separator(fmt,",") return flist end #----------------------------------------# # list or string procedure remove_angle(x) #======================== local t,y local fdebug static prog,b,colon,yyprefix static info,ierror initial { prog := "remove_angle: " b := " " colon := ":" info := "INFO: " ierror := "Internal ERROR: " } fdebug := mylog yyprefix := yylineno||colon||yywordno||b||yyformat||b||prog if DEBUG=="ANGLE" then writes_type_all(x,info||"x") case t := type(x) of { default: { write(fdebug,yyprefix,ierror,"unexpected input type (",t,") x = (",showparse(x),")") y := x } "string": { if x[1]=="<" & x[-1]==">" then { y := x[2:-1] } else { y := x } y := trimws(y) } # end "string" "list": { if x[1]=="<" & x[-1]==">" then { y := x[2:-1] } else { y := x } } # end "list" } # end case type(x) if DEBUG=="ANGLE" then writes_type_all(y,info||"y") return y end #------------------------------------------------------- #------------------------------------------------------- #------------------------------------------------------- procedure value2set(v) #===================== if type(v)=="null" then fail return set(value2list(v)) end procedure value2list(v) #====================== # value includes external list "[...]" # value includes internal list [...] local t,w if DEBUG == "CONVERT" then write(mylog,"# INFO: value2list: value <",v,">") if type(v)=="null" then fail case t := type(v) of { default: { fail } "integer": { return [string(v)] } "real": { return [string(v)] } "list": { if *v = 1 then { return value2list(v[1]) } else { return v } } "string": { #####if is_bracket(v) then { return parse_bracket(v) #####} else { ##### return [v] #####} } } # end case t end #=================================================================# # list procedure phrase2list(phrase) #============================ if type(phrase) == "null" then fail return parse_phrase(phrase) # symbol.icn end # string procedure list2phrase(L,sep) #=========================== /sep := " " if type(L)=="null" then fail return list2string(L,sep) end #==================================================================== # string procedure get_phrase(symbol) #=========================== local phrase if type(symbol) == "null" then fail return unparse(symbol) end #