# <![CDATA[
# KEHOME/src/convert.icn
# Sep/29/2005
# Aug/31/2008 BSE(L,B,S,E)
#=============================================================#
# NOTE: #
# get_string() destroys parse info., returns nest of strings #
# unparse() destroys list, returns a string #
# rhm Jun/23/2002 #
#=============================================================#
# 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(L,B,S,E) => return get_string(L,option)
local y
static warning
initial {
warning := "WARNING: get_string: "
}
#----------------------------#
#return unparse(x)
#----------------------------#
/option := "all" # return all characters
case type(x) of {
default: {
writes_type(mylog,x,warning||"unexpected type of 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 x.stype of {
default: {
writes_type(mylog,x,warning||"unexpected stype of 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 BSE
procedure delete_separator(L,sep)
#================================
# delete separator used in external representation of list
local nosep,t,st,x
local prep,nvlist
static info,warning,ierror
initial {
info := "INFO: delete_separator: "
warning := "WARNING: delete_separator: "
ierror := "Internal ERROR: delete_separator: "
}
/sep := ","
if DEBUG=="SEPARATOR" then {
writes_type_all(L,info||"input L")
}
nosep := L
case t := type(L) of {
default: { writes_type(mylog,L,ierror||"unexpected type L") }
"null": { writes_type(mylog,L,ierror||"unexpected null L") }
"string": {
if DEBUG==("NULL"|"EMPTY"|"LIST") then {
# get lots of strings
writes_type(mybug,L,warning||"unexpected type L")
writes_type(mylog,L,warning||"unexpected type L")
}
}
"integer": { writes_type(mylog,L,warning||"unexpected type L") }
"real": { writes_type(mylog,L,warning||"unexpected type L") }
"BSE": { nosep := bse_delete_separator(L,sep) }
"SYMBOL": {
case st := L.stype of {
"null": {
# get lots of null symbols
if DEBUG==("NULL"|"EMPTY"|"LIST") then {
writes_type(mybug,L,warning||"unexpected type L")
writes_type(mylog,L,warning||"unexpected type L")
}
}
"pp": { # SYMBOL("pp",[[prep],nvlist])
prep := L.svalue[1]
nvlist := L.svalue[2]
nvlist := delete_separator(nvlist)
return SYMBOL("pp",[prep,nvlist])
}
"nvobject": { # SYMBOL("nvobject",nvlist)
nvlist := L.svalue
nvlist := delete_separator(nvlist)
return SYMBOL("nvobject",nvlist)
}
"subject": { # SYMBOL("subject",nvlist)
nvlist := L.svalue
nvlist := delete_separator(nvlist)
return SYMBOL("subject",nvlist)
}
} # end case st
} # end "SYMBOL"
("list"|"set"): {
nosep := []
every x := !L do {
if type(x)=="string" & x==sep then {
} else {
put(nosep,x)
}
} # end every x
} # end "list"|"set"
}
if DEBUG=="SEPARATOR" then {
writes_type_all(nosep,info||"output 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
/wordsep := " "
/option := "string" # or "value"
case t := type(symbol) of {
default: {
writes_type(mylog,symbol,"Internal ERROR: symbol2string: "||
"unexpected type of 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_all(s,info||"s")
case type(s) of {
default: { return s }
"string": {
qsq := q||dequote(s)||q
#writes_type_all(qsq,info||"qsq")
return qsq
}
}
end
procedure enquote(s,sep)
#=======================
# quote string containing separators
# do not nest quote mark
static dquote,squote
initial {
dquote := "\""
squote := "\'"
}
/sep := SEPARATOR # -- NVSEPARATOR
case type(s) of {
default: { return s }
"null": { fail }
"string": { }
}
s := trimws(s) # word.icn
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 contains_separator(s,sep) then { # newword.icn
return dquote||s||dquote # quote SEPARATOR
} else if s==dquote then {
return "dquote" # alias
} else if s==squote then {
return "squote" # alias
} else {
return s
}
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
} # end "string"
"PHRASE": {
x := phrase_unparse(s)
y := dequote(x)
return PHRASE([y])
} # end "PHRASE"
} # 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
if type(s)=="null" then fail
case t := type(s) of {
default: {
writes_any(mylog,s,,"# Internal ERROR: parse_bracket: unexpected type <"||
t||"> of s <",">\n")
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
local t,stype,svalue
static info,ierror,warning
initial {
info := "INFO: remove_bracket: "
ierror := "Internal ERROR: remove_bracket: "
warning := "WARNING: remove_bracket: "
}
if DEBUG==("BRACKET"|"BSE") then {
writes_type_all(s,info||"input s")
}
x := s
if type(s)=="null" then fail
if *s = 0 then return s
case t := type(s) of {
default: {
writes_type(mylog,s,ierror||"unexpected s")
x := s # other
}
("integer"|"real"): { return s }
"SYMBOL": {
stype := s.stype
svalue := s.svalue
case stype of {
default: {
writes_type(mylog,s,warning||"unexpected s")
x := s # SYMBOL
}
"bracket": {
# SYMBOL("bracket", ["[",[aa,bb,cc],"]"] )
x := svalue[2] # remove bracket
}
} # end case stype
}
"BSE": {
if bse_begin(s)=="[" then {
x := bse_list(s)
} else {
x := s
}
}
"list": {
if *s >= 2 &
type(s[1])=="string" & s[1]=="[" &
type(s[-1])=="string" & s[-1]=="]"
then
x := s[2] # remove bracket
else
x := s # list
}
"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
static info,ierror
initial {
info := "INFO: remove_brace: "
ierror := "Internal ERROR: remove_brace: "
}
if DEBUG==("BRACE"|"BSE") then {
writes_type_all(s,info||"input s")
}
x := s
if type(s)=="null" then fail
if *s = 0 then return s
case t := type(s) of {
default: {
writes_type(mylog,s,ierror||"unexpected s")
x := s # other
}
("integer"|"real"): { return s }
"SYMBOL": {
stype := s.stype
svalue := s.svalue
case stype of {
default: {
writes_type(mylog,s,ierror||"unexpected 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_list(s)
} else {
x := s
}
}
"list": {
if *s >= 2 &
type(s[1])=="string" & s[1]=="{" &
type(s[-1])=="string" & s[-1]=="}"
then
x := s[2] # remove bracket
else
x := s # list
}
"string": {
if *s >= 2 &
s[1]=="{" &
s[-1]=="}"
then
x := trimws(s[2:-1]) # string
else
x := s # string
}
} # end case type
if DEBUG==("BRACE"|"BSE") then {
writes_type_all(x,info||"output 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
static ierror
initial {
ierror := "Internal ERROR: remove_paren: "
}
if type(s)=="null" then fail
case t := type(s) of {
default: {
writes_type(mylog,s,ierror||"unexpected s")
return s # other
}
"SYMBOL": {
stype := s.stype
svalue := s.svalue
case stype of {
default: {
writes_type(mylog,s,ierror||"unexpected s")
return s # SYMBOL
}
"paren": {
# SYMBOL("paren", ["(",[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
}
"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 y
static info,ierror
initial {
info := "INFO: remove_angle: "
ierror := "Internal ERROR: remove_angle: "
}
if DEBUG=="ANGLE" then
writes_type_all(x,info||"x")
case type(x) of {
default: {
writes_type(mylog,x,ierror||"unexpected type: 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(mybug,"# 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 phrase_parse(phrase) # symbol.icn
end
# string
procedure list2phrase(L,sep)
#===========================
/sep := PSEPARATOR
if type(L)=="null" then fail
return list2string(L,sep)
end
#====================================================================
# list
procedure get_plist(symbol)
#==========================
# get word list of a phrase
local plist, t, st
static head; initial { head := "# Internal ERROR: get_plist: unexpected " }
if type(symbol)=="null" then fail
plist := []
case t := type(symbol) of {
default: { writes_any(mylog,symbol,,head||"type: symbol <",">\n") }
"list": {
symbol := delete_separator(symbol,",")
every plist |||:= get_plist(!symbol)
}
"SYMBOL": {
case st := symbol.stype of {
default: { writes_any(mylog,symbol,,head||"subtype: symbol <",">\n") }
"wp": { put(plist,symbol.svalue) }
"nv": { put(plist,list2string(symbol.svalue,"")) }
"bracket": { plist |||:= get_plist(symbol.svalue[2]) }
"paren": { put(plist,sym2string(symbol.svalue," ")) }
"conjunction": { put(plist,symbol.svalue[1]) }
}
}
"string": {
put(plist,symbol)
}
}
return plist
end
# string
procedure get_phrase(symbol)
#===========================
local plist, phrase
if type(symbol)=="null" then fail
plist := get_plist(symbol)
phrase := list2string(plist," ")
return phrase
end
#====================================================================
# quote input/output phrase
# string or list
procedure kmap(x)
#================
# quote x
# called by interp_ho() in sentence.icn with x ::= string
# called by do_relation() in relation.icn with x ::= list
local y,z
static squote,dquote,ierror
initial {
squote := "\'"
dquote := "\""
ierror := "Internal ERROR: kmap: "
}
case type(x) of {
default: {
writes_type(mylog,x,ierror||"unexpected type: x")
return x
}
"list": {
z := []
every put(z,kmap(!x))
return z
}
"string": { } # continue below
} # end case type()
if is_quote(x) then
return x
y := x
case KQUOTE of {
default: { }
"none": { }
"squote": {
if upto(squote,x) then
y := dquote||x||dquote
else
y := squote||x||squote
}
"dquote": {
if upto(dquote,x) then
y := squote||x||squote
else
y := dquote||x||dquote
}
} # end case KQUOTE
return y
end
# string or list
procedure hmap(x)
#================
# quote output x
# called by xxx() in yyy.icn
local y
static squote,dquote
initial {
squote := "\'"
dquote := "\""
}
y := x
case KQUOTE of {
default: { }
"none": { }
"squote": { y := squote||x||squote }
"dquote": { y := dquote||x||dquote }
} # end case KQUOTE
return x
end
# ]]>