# # KEHOME/src/marry.icn # Oct/5/2003 Mar/19/2007 # Mar/24/2007 use rel instead of has ## automatic: 8 proposition/infon ## meaning: 5 proposition/infon # #marriagetype isa attribute # #r_marriage is relation with # arraymode=gdbm,arraykey="$1_$2", # label=[husband,wife,marriagetype,marriagedate,marriageplace, # divorcedate,divorceplace], # format=[person:1,person:2,marriagetype:3,time:4,space:5,time:6,space:7], # automatic=ISU, # meaning=procedure_marriage; ## meaning={ ## $1,$2 do $3 done; ## $1_$2 isu family with husband=$1,wife=$2; ## $1_$2 has marriagetype=$3,marriagedate=$4,marriageplace=$5, ## divorcedate=$6,divorceplace=$7; ## $1,$2 has family_spouse +=$1_$2; ## $1 has sex=male,rel spouse +=$2; ## $2 has sex=female,rel spouse +=$1; ## }; #r_divorce is relation with # label=[husband, wife, divorcedate, divorceplace], # format=[person:1, person:2, time:3, space:4], # automatic=ISU, # meaning=procedure_marriage; ## meaning={ ## $1_$2 has divorcedate=$3,divorceplace=$4; ## #$1 rel exspouse +=$2,spouse -=$2; ## #$2 rel exspouse +=$1,spouse -=$1; ## #at space=$4,time=$3 {$1,$2 do divorce;}; ## }; invocable "procedure_marriage" procedure procedure_marriage(rname,nvtab) #======================================== local d1,d2,d3,d4,d5,d6,d7 local td local qfam,f,q,cache local marriagetype,marriagedate case rname of { "r_marriage": { #=============# # initialization #--------------# d1 := unparse(nvtab["$1"]) # $1 = husband d2 := unparse(nvtab["$2"]) # $2 = wife d3 := unparse(nvtab["$3"]) # $3 = marriagetype d4 := unparse(nvtab["$4"]) # $4 = marriagedate d5 := unparse(nvtab["$5"]) # $5 = marriageplace d6 := unparse(nvtab["$6"]) # $6 = divorcedate d7 := unparse(nvtab["$6"]) # $7 = divorceplace # meaning #-------# qfam := family_name(d1,d2) f := new_family(qfam,d1,d2) # $1_$2 isu family with husband=$1,wife=$2 q := new_concept(qfam) ##td := get_mdate(d3) marriagetype := d3 marriagedate := d4 put_char("attr",qfam,"marriagetype",marriagetype,"+=") # $1_$2 has ... put_char("attr",qfam,"marriagedate",marriagedate) put_char("attr",qfam,"marriageplace",d4) put_char("attr",qfam,"divorcedate",d5) put_char("attr",qfam,"divorceplace",d6) # OLD cache scheme cache := CACHE[f] cache.marriagetype := d3 # $1_$2 has marriagetype=$3 cache.marriagedate := d4 # $1_$2 has marriagedate=$4 cache.marriageplace := d5 # $1_$2 has marriageplace=$5 cache.divorcedate := d6 # $1_$2 has divorcedate=$6 cache.divorceplace := d7 # $1_$2 has divorceplace=$7 } # end "r_marriage" "r_divorce": { #============# # initialization #--------------# d1 := unparse(nvtab["$1"]) # $1 = fid d2 := unparse(nvtab["$2"]) # $2 = husband d3 := unparse(nvtab["$3"]) # $3 = wife d4 := unparse(nvtab["$4"]) # $4 = divorcedate d5 := unparse(nvtab["$5"]) # $5 = divorceplace # meaning #-------# qfam := family_name(d1,d2) f := new_family(qfam,d1,d2) # $1_$2 isu family with husband=$1,wife=$2 q := new_concept(qfam) put_char("attr",qfam,"divorcedate",d3) put_char("attr",qfam,"divorceplace",d4) # OLD cache scheme cache := CACHE[f] cache.divorcedate := d3 # $1_$2 has divorcedate=$3 cache.divorceplace := d4 # $1_$2 has divorceplace=$4 } # end "r_divorce" } # end case rname end # typedate ::= # type/date # date # default type ::= marry # list procedure get_mdate(typedate) #============================ # typedate ::= mtype||"/"||mdate local i,td static info,sep initial { info := "INFO: get_child: " sep := "/" } typedate := unparse(typedate) if i := upto(sep,typedate) then { td := [ typedate[1:i],typedate[i+1:0] ] } else { td := [ "marry",typedate ] } if DEBUG=="MARRY" then writes_type_all(td,info||"td") return td end #