diff --git a/base/pop/getpoploglib/auto/restack.p b/base/pop/getpoploglib/auto/restack.p new file mode 100644 index 00000000..a458a8cd --- /dev/null +++ b/base/pop/getpoploglib/auto/restack.p @@ -0,0 +1,305 @@ +;;; Summary: syntax word for manipulating top items of stack + +compile_mode :pop11 +strict; + +section $-restack => + restack + sysRESTACK + ; + +;;; Reads a (optionally comma separated) list of ordinary variables from +;;; the input stream. +define read_variables(); + [% + repeat + quitif( proglist.null ); + lvars item = proglist.hd; + quitunless( item.isword ); + if item == "," then + readitem().erase; + nextloop; + endif; + lvars id = identprops( item ); + quitunless( + id.isnumber or + id == "undef" or + id == "procedure" or + id == "macro" + ); + readitem(); + endrepeat + %] +enddefine; + +define lconstant oops( i ); lvars i; + mishap( 'RESTACK: INTERNAL ERROR (please report)', [^i] ) +enddefine; + +define lconstant sanity_check( inputs, outputs ) -> ( arity, indexes ); + lvars inputs, outputs, arity, indexes; + 0 -> arity; + lvars i, t; + for i on inputs do + if lmember( dest( i ) ) do + mishap( 'RESTACK: input variable used twice', [% hd(i) %] ) + else + arity + 1 -> arity; + endif + endfor; + [% + for i in outputs do + if lmember( i, inputs ) ->> t then + arity - length( t ) + 1 + else + mishap( 'RESTACK: variable not in input list', [^i] ) + endif + endfor; + %] -> indexes; +enddefine; + +;;; A plan consists of a series of instructions of the form +;;; [POP n], [PUSH n], [PUSHS], [ERASE], [SWAP m n], [CHECK n] +;;; These correspond to VM instructions, with the exception of [CHECK k] +;;; whose role is to check there are at least k items on the stack. +;;; +define lconstant naive_plan( arity, indexes ); lvars arity, indexes; + [% + lvars i; + for i from arity by -1 to 1 do + [POP ^i] + endfor; + for i in indexes do + [PUSH ^i] + endfor; + %] +enddefine; + +;;; This predicate is given a list of +;;; instruction types "types" and a particular instruction "this_inst". +;;; It checks whether or not the plan consists of a series of instructions +;;; of those types & then this_inst. The instructions after that don't +;;; matter. +;;; +define lconstant up_to_inst( plan, this_inst, types ); + lvars plan, types, this_inst; + lvars inst, count = 0; + for inst in plan do + if inst = this_inst then + return( count ) + elseunless lmember( hd( inst ), types ) then + return( false ) + endif; + count + 1 -> count; + endfor; + return( false ) +enddefine; + +;;; This is a little predicate on plans. Does the plan consist of a series of +;;; POP/ERASE instructions followed by a particular instruction? It returns +;;; either the number of PUSH/ERASE instructions or false. +define lconstant pops_then_inst( plan, this_inst ); lvars plan, this_inst; + up_to_inst( plan, this_inst, [POP ERASE] ) +enddefine; + +;;; A similar predicate to the preceding. This time, does the plan consist +;;; of a series of SWAP instructions followed by a particular instruction? +;;; It returns the number of SWAP instructions or false. +define lconstant swaps_then_inst( plan, this_inst ); lvars plan, this_inst; + up_to_inst( plan, this_inst, [SWAP] ) +enddefine; + +;;; Is there a check that can be eliminated through stack counting? +;;; We know there are at least K items on the stack. +define find_check( plan, k ); lvars plan, k; + lvars n = 0; + lvars i; + for i in plan do + n + 1 -> n; + quitif( k <= 0 ); + lvars type = i.hd; + if type == "ERASE" or type == "POP" then + k - 1 -> k + elseif type == "PUSHS" or type == "PUSH" then + k + 1 -> k + elseif type == "SWAP" then + ;;; Ignore this swap. + elseif type == "CHECK" then + return( n ) + else + oops( i ); + endif; + endfor; + return( false ); +enddefine; + +;;; Try to remove superfluous CHECK instructions by counting +;;; the number of items guaranteed to be on the stack. K is the +;;; number guaranteed. +;;; +define lconstant cull_checks( plan ); lvars plan; + + define lconstant decr( n ) -> n; lvars n; + n - 1 -> n; + if n < 0 then 0 -> n endif + enddefine; + + lvars K = 0; + lvars inst; + for inst in plan do + lvars type = inst.hd; + if type == "ERASE" or type == "POP" then + decr( K ) -> K; + elseif type == "PUSHS" or type == "PUSH" then + K + 1 -> K; + elseif type == "SWAP" then + max( K, max( inst(2), inst(3) ) ) -> K; + elseif type == "CHECK" then + nextif( K >= 1 ); + 1 -> K; + else + oops( inst ); + endif; + ;;; We push every instruction apart from that of CHECK. + ;;; CHECK will sometimes skip this by calling "nextif". + inst; + endfor; +enddefine; + +;;; Peephole optimisation of restacking plan. There are several different +;;; kinds of simple improvement made in this routine. +;;; 1. Any POP n without a subsequent PUSH n becomes an ERASE +;;; 2. POP n & PUSH n without subsequent references to n --> [CHECK] +;;; 3. POP n & POP/ERASE ... & PUSH n without a subsequent reference to n +;;; improved into a SWAP. +;;; 4. POP n & SWAPS... & PUSH n --> +SWAPS... & POP n & PUSH n +;;; 5. (PUSHS | PUSH n) & ERASE --> () +;;; 6. PUSH n & PUSH n ... --> PUSH n & PUSHS ... +;;; 7. SWAP a b & SWAP a b --> () +;;; 8. CHECK & ( CHECK/PUSHS/ERASE/POP n/SWAP a b) --> ( ... ) +define lconstant improved( plan ); lvars plan, n; + until null( plan ) do + lvars inst = plan.dest -> plan; + lvars ( type, arg ) = inst.dest; + lvars next_inst = if plan.null then [DUMMY] else plan.hd endif; + lvars ( next_type, next_arg ) = next_inst.dest; + if type == "POP" then + lvars index = arg( 1 ); + lvars push = [ PUSH ^index ]; + if not( member( push, plan ) ) then + [ ERASE ] + elseif + next_inst = push and + ( null( plan ) or not( member( push, plan.tl ) ) ) + then + plan.tl -> plan; + [CHECK] + elseif + next_inst /= push and + ( pops_then_inst( plan, push ) ->> n ) and + not( member( push, applynum( plan, tl, n+1 ) ) ) + then + [SWAP 1 ^(n+1)]; ;;; insert swap + plan( n ); ;;; move last POP/ERASE to start + repeat n - 1 times + plan.dest -> plan ;;; remaining POP/ERASE + endrepeat; + plan.tl -> plan; ;;; don't reuse last POP/ERASE + plan.tl -> plan; ;;; dispose of PUSH + elseif + next_inst /= push and + ( swaps_then_inst( plan, push ) ->> n ) + then + repeat n times + lvars swap_inst = plan.dest -> plan; + [SWAP % swap_inst(2)+1, swap_inst(3)+1 %] + endrepeat; + inst; + else + inst + endif + elseif type == "PUSH" or type == "PUSHS" then + if next_type == "ERASE" then + plan.tl -> plan + elseif type == "PUSH" and next_inst = inst then + inst; + while not(plan.null) and plan.hd = inst do + [PUSHS]; + plan.tl -> plan; + endwhile; + else + inst + endif + elseif type == "SWAP" then + if inst = next_inst then + ;;; two swaps in a row ... do nothing. + plan.tl -> plan; + else + lvars n = find_check( plan, max( arg(1), arg(2) ) ); + inst + endif + elseif type == "CHECK" then + if lmember( next_type, #_< [CHECK ERASE POP PUSHS SWAP] >_# ) then + /* nothing -- eliminate this instruction */ + else + inst + endif + else + inst + endif + enduntil; +enddefine; + +define lconstant optimise( plan ); lvars plan; + repeat + lvars i_plan = [% cull_checks( [% improved( plan ) %] ) %]; + returnif( i_plan = plan )( plan ); + i_plan -> plan; + endrepeat +enddefine; + +define lconstant plant( plan ); lvars plan; + dlocal pop_new_lvar_list; + + lvars table = [].newassoc; + + define lconstant local( arg ); lvars arg; + lvars index = arg.hd; + table( index ) or + ( sysNEW_LVAR() ->> table( index ) ) + enddefine; + + lvars inst; + for inst in plan do + lvars ( type, arg ) = inst.dest; + if type == "POP" then + sysPOP( arg.local ) + elseif type == "PUSH" then + sysPUSH( arg.local ) + elseif type == "PUSHS" then + sysPUSHS( undef ) + elseif type == "ERASE" then + sysERASE( undef ) + elseif type == "SWAP" then + sysSWAP( arg.dl ) + elseif type == "CHECK" then + sysPUSHS( undef ); + sysERASE( undef ) + else + oops( inst ) + endif + endfor; +enddefine; + +define sysRESTACK( inputs, outputs ); + lvars ( arity, indexes ) = sanity_check( inputs, outputs ); + naive_plan( arity, indexes ).optimise.plant; +enddefine; + +define syntax restack; + lvars inputs = read_variables(); + pop11_need_nextreaditem( "->" ).erase; + lvars outputs = read_variables(); + sysRESTACK( inputs, outputs ) +enddefine; + +endsection; diff --git a/base/pop/getpoploglib/auto/sysRESTACK.p b/base/pop/getpoploglib/auto/sysRESTACK.p new file mode 100644 index 00000000..0059bc5c --- /dev/null +++ b/base/pop/getpoploglib/auto/sysRESTACK.p @@ -0,0 +1,2 @@ +compile_mode :pop11 +strict; +uses restack diff --git a/base/pop/getpoploglib/help/restack b/base/pop/getpoploglib/help/restack new file mode 100644 index 00000000..8386b98c --- /dev/null +++ b/base/pop/getpoploglib/help/restack @@ -0,0 +1,63 @@ +HELP RESTACK Steve Knight, Jan 1991 + +restack id ... -> id ... ; + + -- General Description + -- Basic Examples + -- Motivation + -- See also + +-- General Description ------------------------------------------------ + +The purpose of the "restack" construct is to rearrange the topmost items on +the stack. For example, you can reverse the top three items on the stack by +writing + + restack x y z -> z y x; + +The syntax of restack is + + restack -> + +where stands for a sequence of words optionally separated +by commas. All the output-words must appear in the input-words and no +input-word can occur twice. + +The effect of a restack is equivalent to writing + + procedure( ); + ; + endprocedure(); + +But using -restack- is much more efficient as it plants in-line code. + + +-- Basic Examples ----------------------------------------------------- + + 1, 2, 3; restack a b c -> c a b => + ** 3 1 2 + + ;;; You can use restack to check the number of items on the stack! + restack x -> x; ;;; with nothing on the stack! + ;;; MISHAP - STE: STACK EMPTY (missing argument? missing result?) + + +-- Motivation --------------------------------------------------------- + +In other stack-oriented programming languages, such as FORTH, there are a +variety of operators for manipulating the stack without using local variables. +And occasionally this is quite elegant to read and it is certainly quite +efficient. + +So rather than provide a collection of operators, restack is a +single syntax word that allows you to write any pure stack operation in a +convenient and efficient fashion. + +Although restack is not a feature that's likely to find everyday use, it +is an easy to use, flexible and efficient feature. + +-- See Also ----------------------------------------------------------- + +HELP * sysRESTACK a version of restack for code-planting + +----------------------------------------------------------------------- diff --git a/base/pop/getpoploglib/help/sysRESTACK b/base/pop/getpoploglib/help/sysRESTACK new file mode 100644 index 00000000..d6f7851c --- /dev/null +++ b/base/pop/getpoploglib/help/sysRESTACK @@ -0,0 +1,27 @@ +HELP sysRESTACK Steve Leach, Jan 2023 + + sysRESTACK( inputs : List, outputs: List ) + +This code-planting procedure plants code that rearranges the top items +of the stack. The inputs is a list of words that may contain no duplicates +and the outputs list must consist only of words from the inputs list. + +It is equivalent to popping all the inputs into temporary variables and +then pushing the output variables - but typically generates better code. +For example: + + sysRESTACK( [ x y ], [ y ] ) + +will generate + + SWAP 1 2 + ERASE undef + +rather than this less efficient code that will typically need an extra +temporary variable: + + POP tmp_lvar_1 + ERASE + PUSH tmp_lvar_1 + +----------------------------------------------------------------------- diff --git a/base/pop/getpoploglib/teach/restack b/base/pop/getpoploglib/teach/restack new file mode 100644 index 00000000..016ead67 --- /dev/null +++ b/base/pop/getpoploglib/teach/restack @@ -0,0 +1,212 @@ +TEACH RESTACK Steve Knight, Jan 1991 + +-- Introduction ------------------------------------------------------- + +The "restack" construct allows you to rearrange the topmost items on +the stack. For example, you can reverse the top three items on the +stack by writing + + restack x y z -> z y x; + +The syntax of restack is + + restack -> + +where and stands for a sequence of variable +names optionally separated by commas. All the output-words must appear +in the input-words and no input-word can occur twice. + +The effect of a restack is equivalent, but much more efficent, to: + + procedure( ); + ; + endprocedure(); + +Most of the time in Pop11, you don't have to be particularly interested +in the stack. In fact, many programmers try to ignore the stack +altogether. However, there are a number of interesting programming 'idioms' +or techniques that are made possible by deliberately exploiting the fact +that the stack is completely open to the programmer. + +A familiar idiom to Pop11 programmers is the use of the stack in combination +with list or vector brackets. For example, you might write the familiar +"flatten" or "fringe" function (that constructs a list of all the elements +in a tree, represented as a list of lists) like this: + + define flatten( tree ); lvars tree; + define lconstant walk_fringe( t ); lvars t; + if t.islist then + applist( t, walk_fringe ) + else + t + endif + enddefine; + [% walk_fringe( tree ) %] + enddefine; + +But there are several other ideas in this area. How can you sum the +elements in a list? Obviously you could write a "for" loop. Try thinking +about this! + + applist( 0, [2 4 6], nonop + ) => + ** 12 + +One rich source of ideas is the programming language FORTH. FORTH is a +very low-level language which, like Pop11, has an 'open' stack. Rather +remarkably, FORTH procedures have no local variables(!!) Instead, the +FORTH programmer has to learn how to carefully manipulate the stack so +that the values they want are always on top of the stack (and in the right +order) when they are needed. + +To help them, the FORTH programmer has a number of simple stack manipulation +routines. The most frequently used ones are + dup which duplicates the value on top x -> x x + drop which removes the topmost value x -> + swap which swaps the top two values x y -> y x + rot which rotates the top three stack values x y z -> z x y + rot2 equal to two rot's x y z -> y z x + over which copies the second value to the top x y -> x y x +Pop11 has the first two, which are "dup" and "erase" but not the other +four. + +Now the lack of local variables is typically a "bad thing" -- at least +from the viewpoint of conveniently writing programs. However, when you +get used to this way of writing routines, it is quite easy and SOMETIMES +it is very elegant. It is this idiom of pure stack-manipulation that +restack helps you exploit on those occasions. + + +-- General Style ------------------------------------------------------ + +Just to get a flavour of this programming style, I've written a couple of +functions in this style. These illustrate how it is _possible_ to write +in this way. + +The first is the well-known factorial function and the second finds the +roots of quadratic equations. They aren't especially pretty to look at; +their purpose is only to get you thinking in pure-stack operations and to +realise that it needs a different way of thinking. + +;;; Remember, we're not allowed to use any local variables! +define factorial(); + ;;; we want to compare the top of the stack with 0. However, we'll + ;;; need it later. This means we must take a copy using dup. + if dup() = 0 then + ;;; in this case, we don't need the input value any more. We + ;;; drop it, using erase, and then push 1 as the result. + erase(); 1 + else + ;;; we've got the input value N on top of the stack. We now + ;;; want to compute N * factorial( N - 1 ). This is especially + ;;; easy. + dup() - 1; ;;; leaves N; N-1 on the stack + factorial(); ;;; N; factorial( N - 1 ) + *; ;;; then multiply + endif +enddefine; + +Here's an even more grotesque example - finding the roots of the quadratic +equation a*x**2 + b*x +c = 0. First, we write it out in ordinary Pop11 +code. + + define roots( a, b, c ); lvars a, b, c; + lvars base = sqrt( b ** 2 - 4 * a * c ); + lvars denom = 2 * a; + (-b + base) / denom; + (-b - base) / denom; + enddefine; + +Here it is, rather perversely, done without any local variables. + + define swap( a, b ) -> ( b, a ); lvars a, b; enddefine; + define rot( a, b, c ) -> ( c, a, b ); lvars a, b, c; enddefine; + define rot2( a, b, c ) -> ( b, c, a ); lvars a, b, c; enddefine; + define over( a, b ) -> ( a, b, a ); lvars a, b; enddefine; + + define roots(); + ;;; a, b, c on the stack + rot2() * 2; ;;; b, c, denom + dup() * 2; ;;; b, c, denom, 4*a + rot2(); ;;; b, denom, 4*a, c + *; ;;; b, denom, 4*a*c + rot2(); ;;; denom, 4*a*c, b + negate(); ;;; denom, 4*a*c, -b + dup() * dup(); ;;; denom, 4*a*c, -b, b**2 + rot2() -; ;;; denom, -b, b**2 - 4*a*c + sqrt(); ;;; denom, -b, base + over(); over(); ;;; denom, -b, base, -b, base + +; ;;; denom, -b, base, -b+base + rot() -; ;;; denom, -b+base, -b-base + rot(); over(); ;;; -b-base, denom, -b+base, denom + /; ;;; -b-base, denom, root1 + rot() /; ;;; root1; root2 + enddefine; + +These examples show: + 1. writing such code requires thinking about programming + in a different way, + 2. you only need a handful of stack operators, + 3. pure stack operator code is not always appropriate! + + +-- Positive Examples -------------------------------------------------- + +Here are a few examples that illustrate pure stack operations more +positively. They are all quite simple and use the stack operators very +sparingly to create elegant solutions. + +The first example is strikingly elegant in its use of the stack. Suppose +you were asked to write a function to generate the first N fibonacci +numbers as a list. These are the numbers in the series + 1, 1, 2, 3, 5, 8, 13, ... +where each number is the sum of the previous two.) Almost everyone writes +code looking a bit like this - for simplicity of presentation, I'll assume +that N >= 2: + + define fibs( n ); lvars n; + lvars a = 1, b = 1; + [% + a; b; + repeat n-2 times + lvars c = a + b; + b -> a; + c -> b; + c; + endrepeat + %] + enddefine; + +However, all these variables simply get in the way. The pure stack based +approach brushes them aside! + + define fibs( n ); lvars n; + [% 1; 1; repeat n-2 times over() + over() endrepeat %] + enddefine; + +The second example uses "swap" to create an elegant solution. Suppose you had +a list of vectors, and you wanted the third element from all these vectors + + e.g. index( [{a b c} {d e f} {g h i}] ) => + ** [c f i] + +One might be tempted to write a "for" loop -- but that's the brute force +approach. You might write + + maplist( L, procedure( v ); lvars v; v(3) endprocedure ) + +but that's a rather bulky expression. What you could try is pure stack +manipulation: + + maplist( L, swap(% 3 %) <> apply ) + +There are many examples of this kind, where the pure stack manipulation +combines nicely with the use of functional programming. + +The third example also illustrates a similar use of "swap". Our task is +to "reverse" a list: + + define reverse( L ); lvars L; + applist( [], L, swap <> conspair ) + enddefine; + +-----------------------------------------------------------------------