/* Sample program #2 for Project Rosetta Stone Coded by Barry L. Wolman on 9 December 1972 The form used to represent the tree should be self-explanatory */ d: derivative: procedure(f) returns(ptr); dcl f ptr; dcl null builtin; dcl 1 operator aligned based(f), 2 type char(4) init("oper"), 2 opcode char(4), 2 (left,right) ptr; dcl 1 constant aligned based(f), 2 type char(4) init("cons"), 2 value float binary; dcl 1 variable aligned based(f), 2 type char(4) init("vari"); dcl node_type char(4) aligned based(f); if node_type = "cons" then return(mc(0.0e0)); if node_type = "vari" then return(mc(1.0e0)); if opcode = "+ " | opcode = "- " then return(mo(opcode,d(left),d(right))); if opcode = "* " then return(mo("+",mo("*",left,d(right)),mo("*",d(left),right))); if opcode = "/ " then return(mo("/", mo("-",mo("*",d(left),right),mo("*",left,d(right))), mo("pow",right,mc(2.0e0)))); if opcode = "ln " then return(mo("/",d(left),left)); if opcode = "pow " then return(mo("+",mo("*",mo("*",d(left),right),mo("pow",left, mo("-",right,mc(1.0e0)))),mo("*",mo("*",mo("ln",left,null), d(right)),mo("pow",left,right)))); return(null); mc: make_constant: proc(v) returns(ptr); dcl v float bin, p ptr; allocate constant set(p); p -> value = v; return(p); end; mo: make_operator: proc(o,l,r) returns(ptr); dcl o char(4) aligned, (l,r) ptr; dcl p ptr; allocate operator set(p); p -> opcode = o; p -> left = l; p -> right = r; return(p); end; end;