$include "defs.icn" $include "global_vars.icn" #DJDSTOP # # # define DEBUG # # undef DEBUG # # include "parm.h" # # # include # # # include "stree/ststructs.mh" # # extern FILE * unparse_file; # # # ifdef BAD # extern boolean BADflag; # # endif # # NODE * cor_cond(); # # NODE * cand_cond(); # # NODE ** outermost_op(); # # /* # * mkappl2(h,t) # * # * input: A denotation represented as an array of pointers to primaries. # * h points to the start of the array, t to the end. The array # * should not be empty. # * # * output: a tree of applications and conditionals (which reflect the # * precedence of operations in the denotation), in the form of # * an arg list for a higher level application. # * The outermost node always has a ref count of zero. # */ # # NODE * mkappl2(h,t) # NODE ** h, # ** t; # { # NODE ** op, /* "outermost" operator (i.e. the operation performed # last) in the denotation */ # * result, # * left_arg, /* a tree of applications which is the left arg of op */ # * right_arg, # ** rest = t+1; /* start of arguments for next applications */ # # # # ifdef DEBUG # /* test for empty array */ # if ( h == t + 1 ) { # dbgmsg("\nmkappl2: empty array - %o, %o\n", h, t); # abort(); # } # # endif # # # /* If there is just a single primary, convert it into # an arg list and return. */ # if ( h == t ) { # /* is it already a list? */ # if ( is_list(*h) ) { # /* Copy it and return the copy. */ # return ( copylist(*h) ); # } else { # return ( mklist(*h, -1) ); # } # } # # # /* Find the "outermost" operator and assume its args are # the sequences of primaries to its right and left. # Build a tree representing the application of that operator # to it args. */ # # /* Find the outermost operator */ # op = outermost_op( h,t ); # # if( op == NIL ) { # /* Couldn't find a reasonable one */ # if (!is_list(*h)) { # /* Interpret it as curried application */ # rest = h+2; # right_arg = mkappl2( h+1, h+1); # lock(right_arg); # left_arg = emptylist(); # lock(left_arg); # op = h; # } else { # /* no way to deal with this mess */ # yyperror("Improperly bracketed expression"); # return( mklist(emptylist(), -1) ); # } # } else { # # /* Construct the left argument tree */ # if ( op == h ) # left_arg = emptylist(); # else # left_arg = mkappl2( h, op-1 ); # lock(left_arg); # # /* Construct the right argument tree */ # if ( op == t ) # right_arg = emptylist(); # else # right_arg = mkappl2( op+1, t ); # lock(right_arg); # } # # /* Construct the application of op to args, # or conditional in the case of "cand" and "cor" */ # switch ( (*op) -> kind ) { # case WORDCAND: # /* Check that there are only two args */ # single_arg(left_arg); single_arg(right_arg); # result = cand_cond(left_arg, right_arg); # vfree(unlock(left_arg)); vfree(unlock(right_arg)); # break; # case WORDCOR: # /* Check that there are only two args */ # single_arg(left_arg); single_arg(right_arg); # result = cor_cond(left_arg, right_arg); # vfree(unlock(left_arg)); vfree(unlock(right_arg)); # break; # default: # unlock(left_arg); unlock(right_arg); # result = mknode(APPLICATION, *op, conc(left_arg,right_arg)); # /* add curried applications */ # while (rest <= t) { # result = mknode(APPLICATION, result, # mkappl2( rest, rest )); # rest++; # } # } # # # # ifdef BAD # if (BADflag) # flcheck(0,0); # else # flcheck(0,1); # # endif # /* Make it into an arg list and return it */ # return ( mklist(result, -1) ); # } # #DJDSTART # # mkappl2(a,h,t) # # input: A denotation represented as an array of pointers to primaries. # h points to the start of the array, t to the end. The array # should not be empty. # output: a tree of applications and conditionals (which reflect the # precedence of operations in the denotation), in the form of # an arg list for a higher level application. # The outermost node always has a ref count of zero. # procedure mkappl2(array,head,tail) local op,result,left_arg, right_arg,rest rest := tail + 1 # was + 1 yyinfo("mkappl2 head = " || head || " tail = " || tail) # If there is just a single primary, convert it into # an arg list and return. if ( head = tail ) then { # is it already a list? if ( is_list(array[head]) ) then { # Copy it and return the copy. return ( copylist(array[head]) ) } else { return ( mklist([array[head]]) ) # CHG DJD # return ( mklist([array[head],end_of_args]) ) } } # Find the "outermost" operator and assume its args are # the sequences of primaries to its right and left. # Build a tree representing the application of that operator # to it args. # Find the outermost operator op := outermost_op(array, head,tail ) if( /op ) then { # Couldn't find a reasonable one if (not(is_list(array[head]))) then { # Interpret it as curried application rest := head+2 right_arg := mkappl2(array, head+1, head+1) lock(right_arg) left_arg := emptylist() lock(left_arg) op := head } else { # no way to deal with this mess yyperror("Improperly bracketed expression") return( mklist([emptylist()]) ) } } else { # Construct the left argument tree if ( op = head ) then left_arg := emptylist() else left_arg := mkappl2(array, head, op-1 ) lock(left_arg) # Construct the right argument tree if ( op = tail ) then right_arg := emptylist() else right_arg := mkappl2(array, op+1, tail ) lock(right_arg) } # Construct the application of op to args, # or conditional in the case of "cand" and "cor" case ( array[op].kind ) of { WORDCAND: { # Check that there are only two args single_arg(left_arg) single_arg(right_arg) result := cand_cond(left_arg, right_arg) vfree(unlock(left_arg)) vfree(unlock(right_arg)) } WORDCOR: { # Check that there are only two args single_arg(left_arg) single_arg(right_arg) result := cor_cond(left_arg, right_arg) vfree(unlock(left_arg)) vfree(unlock(right_arg)) } default: { unlock(left_arg) unlock(right_arg) result := mknode([APPLICATION,array[op], conc(left_arg,right_arg)]) # add curried applications while (rest <= tail) do { result := mknode([APPLICATION, result, mkappl2(array, rest, rest )]) rest +:= 1 } } } # Make it into an arg list and return it return ( mklist([result] )) # return ( mklist([result, end_of_args) ) # CHG DJD end