-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. -- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are -- met: -- -- - Redistributions of source code must retain the above copyright -- notice, this list of conditions and the following disclaimer. -- -- - Redistributions in binary form must reproduce the above copyright -- notice, this list of conditions and the following disclaimer in -- the documentation and/or other materials provided with the -- distribution. -- -- - Neither the name of The Numerical ALgorithms Group Ltd. nor the -- names of its contributors may be used to endorse or promote products -- derived from this software without specific prior written permission. -- -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS -- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A -- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER -- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, -- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. import g_-util namespace BOOT --% $optimizableConstructorNames := $SystemInlinableConstructorNames ++ Return true if the domain `dom' is an instance of a functor ++ that has been nominated for inlining. optimizableDomain? dom == opOf dom in $optimizableConstructorNames ++ Register the domain `dom' for inlining. nominateForInlining dom == $optimizableConstructorNames := [opOf dom,:$optimizableConstructorNames] --% ++ return the template of the instantiating functor for ++ the domain form `dom'. getDomainTemplate dom == atom dom => nil getInfovec first dom ++ Emit code for an indirect call to domain-wide Spad function. ++ This is usually the case for exported functions. emitIndirectCall(fn,args,x) == x.first := "SPADCALL" fn.first := "getShellEntry" x.rest := [:args,fn] x --% OPTIMIZER ++ Change (%LET id expr) to (%store id expr) if `id' is being ++ updated as opposed to being defined. `vars' is the list of ++ all variable definitions in scope. changeVariableDefinitionToStore(form,vars) == atomic? form => nil form is ['%LET,v,expr] => changeVariableDefinitionToStore(expr,vars) if v in vars then form.op := '%store for x in form repeat changeVariableDefinitionToStore(x,vars) x is ['%LET,v,:.] and not (v in vars) => vars := [v,:vars] ++ Return true if `x' contains control transfer to a point outside itself. jumpToToplevel? x == atomic? x => false op := x.op op = 'SEQ => CONTAINED('THROW,x.args) op in '(EXIT THROW %leave) => true or/[jumpToToplevel? x' for x' in x] ++ Return true if `form' is just one assignment expression. singleAssignment? form == form is ['%LET,.,rhs] and not CONTAINED('%LET,rhs) ++ Turns `form' into a `%bind'-expression if it starts with a ++ a sequence of first-time variable definitions. groupVariableDefinitions form == atomic? form => form form isnt ['SEQ,:stmts,['EXIT,val]] => form defs := nil for x in stmts while singleAssignment? x repeat defs := [x.args,:defs] defs = nil or jumpToToplevel? defs => form stmts := drop(#defs,stmts) expr := stmts = nil => val ['SEQ,:stmts,['EXIT,val]] ['%bind,nreverse defs,expr] optimizeFunctionDef(def) == if $reportOptimization then sayBrightlyI bright '"Original LISP code:" pp def def' := simplifyVMForm COPY def if $reportOptimization then sayBrightlyI bright '"Intermediate VM code:" pp def' [name,[slamOrLam,args,body]] := def' body':= removeTopLevelCatch body where removeTopLevelCatch body == body is ["CATCH",g,u] => removeTopLevelCatch replaceThrowByReturn(u,g) body replaceThrowByReturn(x,g) == fn(x,g) x fn(x,g) == x is ["THROW", =g,:u] => x.first := "RETURN" x.rest := replaceThrowByReturn(u,g) atom x => nil replaceThrowByReturn(first x,g) replaceThrowByReturn(rest x,g) changeVariableDefinitionToStore(body',args) [name,[slamOrLam,args,groupVariableDefinitions body']] resetTo(x,y) == atom y => x := y EQ(x,y) => x x.first := y.first x.rest := y.rest x ++ Simplify the VM form `x' simplifyVMForm x == x = '%icst0 => 0 x = '%icst1 => 1 atomic? x => x x.op = 'CLOSEDFN => x atom x.op => x is [op,vars,body] and op in $AbstractionOperator => third(x) := simplifyVMForm body x if x.op = 'IF then resetTo(x,optIF2COND x) for args in tails x.args repeat args.first := simplifyVMForm first args opt := subrname x.op has OPTIMIZE => resetTo(x,FUNCALL(opt,x)) x for xs in tails x repeat xs.first := simplifyVMForm first xs x subrname u == IDENTP u => u COMPILED_-FUNCTION_-P u or MBPIP u => BPINAME u nil changeThrowToExit(s,g) == atom s or s.op in '(QUOTE SEQ REPEAT COLLECT %collect %loop) => nil s is ["THROW", =g,:u] => (s.first := "EXIT"; s.rest := u) changeThrowToExit(first s,g) changeThrowToExit(rest s,g) hasNoThrows(a,g) == a is ["THROW", =g,:.] => false atom a => true hasNoThrows(first a,g) and hasNoThrows(rest a,g) changeThrowToGo(s,g) == atom s or first s='QUOTE => nil s is ["THROW", =g,u] => changeThrowToGo(u,g) s.first := "PROGN" s.rest := [["%LET",second g,u],["GO",second g]] changeThrowToGo(first s,g) changeThrowToGo(rest s,g) ++ Change any `(THROW tag (%return expr))' in x to just ++ `(%return expr) since a %return-expression transfers control ++ out of the function body anyway. Similarly, transform ++ reudant `(THROW tag (THROW tag expr))' to `(THROW tag expr)'. removeNeedlessThrow x == atomic? x => x x is ['THROW,.,y] and y is ['%return,:.] => removeNeedlessThrow third y x.op := y.op x.args := y.args x is ['THROW,g,y] and y is ['THROW,=g,z] => removeNeedlessThrow z second(x.args) := z for x' in x repeat removeNeedlessThrow x' optCatch (x is ["CATCH",g,a]) == $InteractiveMode => x atom a => a removeNeedlessThrow a if a is ["SEQ",:s,["THROW", =g,u]] then changeThrowToExit(s,g) a.rest := [:s,["EXIT",u]] a := simplifyVMForm a if hasNoThrows(a,g) then resetTo(x,a) else changeThrowToGo(a,g) x.first := "SEQ" x.rest := [["EXIT",a],second g,["EXIT",second g]] x optSPADCALL(form is ['SPADCALL,:argl]) == not $InteractiveMode => form -- last arg is function/env, but may be a form argl is [:argl,fun] and fun is ["ELT",dom,slot] => optCall ['%call,['ELT,dom,slot],:argl] form optCall (x is ['%call,:u]) == u is [['XLAM,vars,body],:args] => atom vars => body #vars > #args => systemErrorHere ['optCall,x] resetTo(x,optXLAMCond SUBLIS(pairList(vars,args),body)) [fn,:a] := u atom fn => opt := fn has OPTIMIZE => resetTo(x,FUNCALL(opt,u)) resetTo(x,u) fn is ['applyFun,name] => x.first := 'SPADCALL x.rest := [:a,name] x fn is [q,R,n] and q in '(getShellEntry ELT QREFELT CONST) => not $bootStrapMode and (w := optCallSpecially(q,x,n,R)) => resetTo(x,w) q = 'CONST => ['spadConstant,R,n] emitIndirectCall(fn,a,x) systemErrorHere ['optCall,x] optCallSpecially(q,x,n,R) == optimizableDomain? R => optSpecialCall(x,R,n) (y:= get(R,"value",$e)) and optimizableDomain? y.expr => optSpecialCall(x,y.expr,n) nil optCallEval u == u is ["List",:.] => List Integer() u is ["Vector",:.] => Vector Integer() u is ["PrimitiveArray",:.] => PrimitiveArray Integer() u is ["FactoredForm",:.] => FactoredForm Integer() u is ["Matrix",:.] => Matrix Integer() eval u optCons (x is ["CONS",a,b]) == a="NIL" => b='NIL => (x.first := 'QUOTE; x.rest := ['NIL,:'NIL]; x) b is ['QUOTE,:c] => (x.first := 'QUOTE; x.rest := ['NIL,:c]; x) x a is ['QUOTE,a'] => b='NIL => (x.first := 'QUOTE; x.rest := [a',:'NIL]; x) b is ['QUOTE,:c] => (x.first := 'QUOTE; x.rest := [a',:c]; x) x x optSpecialCall(x,y,n) == yval := optCallEval y CAAAR x="CONST" => KAR yval.n = function Undef => keyedSystemError("S2GE0016",['"optSpecialCall", '"invalid constant"]) MKQ yval.n fn := getFunctionReplacement compileTimeBindingOf first yval.n => x.rest := CDAR x x.first := fn if fn is ["XLAM",:.] then x := simplifyVMForm x x is ["EQUAL",:args] => resetTo(x,DEF_-EQUAL args) --DEF-EQUAL is really an optimiser x [fn,:a]:= first x emitIndirectCall(fn,a,x) compileTimeBindingOf u == null(name:= BPINAME u) => keyedSystemError("S2OO0001",[u]) name="Undef" => MOAN "optimiser found unknown function" name optMkRecord ["mkRecord",:u] == u is [x] => ["LIST",x] #u=2 => ["CONS",:u] ["VECTOR",:u] optCond (x is ['COND,:l]) == if l is [a,[aa,b]] and aa = '%true and b is ['COND,:c] then x.rest.rest := c if l is [[p1,:c1],[p2,:c2],:.] then if (p1 is ['%not,=p2]) or (p2 is ['%not,=p1]) then l:=[[p1,:c1],['%true,:c2]] x.rest := l c1 is ['NIL] and p2 = '%true and first c2 = '%true => return optNot ['%not,p1] l is [[p1,:c1],[p2,:c2],[p3,:c3]] and p3 = '%true => EqualBarGensym(c1,c3) => optCond ['COND,[['%or,p1,['%not,p2]],:c1],['%true,:c2]] EqualBarGensym(c1,c2) => optCond ['COND,[['%or,p1,p2],:c1],['%true,:c3]] x for y in tails l repeat while y is [[a1,c1],[a2,c2],:y'] and EqualBarGensym(c1,c2) repeat a := ['%or,a1,a2] first(y).first := a y.rest := y' x AssocBarGensym(key,l) == for x in l repeat cons? x => EqualBarGensym(key,first x) => return x EqualBarGensym(x,y) == $GensymAssoc: fluid := nil fn(x,y) where fn(x,y) == x=y => true GENSYMP x and GENSYMP y => z:= assoc(x,$GensymAssoc) => y=rest z $GensymAssoc:= [[x,:y],:$GensymAssoc] true null x => y is [g] and GENSYMP g null y => x is [g] and GENSYMP g atom x or atom y => false fn(first x,first y) and fn(rest x,rest y) --Called early, to change IF to COND optIF2COND ["IF",a,b,c] == b is "%noBranch" => ["COND",[['%not,a],c]] c is "%noBranch" => ["COND",[a,b]] c is ["IF",:.] => ["COND",[a,b],:rest optIF2COND c] c is ["COND",:p] => ["COND",[a,b],:p] ["COND",[a,b],['%true,c]] optXLAMCond x == x is ["COND",u:= [p,c],:l] => (p = '%true => c; ["COND",u,:optCONDtail l]) atom x => x x.first := optXLAMCond first x x.rest := optXLAMCond rest x x optCONDtail l == null l => nil [frst:= [p,c],:l']:= l p = '%true => [['%true,c]] null rest l => [frst,['%true,["CondError"]]] [frst,:optCONDtail l'] ++ Determine whether the symbol `g' is the name of a temporary that ++ can be replaced in the form `x', if it is of linear usage and not ++ the name of a program point. The latter occurs when THROW forms ++ are changed to %LET form followed by a GO form -- see optCatch. replaceableTemporary?(g,x) == GENSYMP g and numOfOccurencesOf(g,x) < 2 and not jumpTarget?(g,x) where jumpTarget?(g,x) == atomic? x => false x is ['GO,=g] => true or/[jumpTarget?(g,x') for x' in x] optSEQ ["SEQ",:l] == tryToRemoveSEQ SEQToCOND getRidOfTemps splicePROGN l where splicePROGN l == atomic? l => l l is [["PROGN",:stmts],:l'] => [:stmts,:l'] l.rest := splicePROGN rest l getRidOfTemps l == null l => nil l is [["%LET",g,x],:r] and replaceableTemporary?(g,r) => getRidOfTemps substitute(x,g,r) first l="/throwAway" => getRidOfTemps rest l --this gets rid of unwanted labels generated by declarations in SEQs [first l,:getRidOfTemps rest l] SEQToCOND l == transform:= [[a,b] for x in l while (x is ["COND",[a,["EXIT",b]]])] before:= take(#transform,l) aft:= after(l,before) null before => ["SEQ",:aft] null aft => ["COND",:transform,'(%true (conderr))] optCond ["COND",:transform,['%true,optSEQ ["SEQ",:aft]]] tryToRemoveSEQ l == l is ["SEQ",[op,a]] and op in '(EXIT RETURN THROW) => a l optRECORDELT ["RECORDELT",name,ind,len] == len=1 => ind=0 => ['%head,name] keyedSystemError("S2OO0002",[ind]) len=2 => ind=0 => ['%head,name] ind=1 => ['%tail,name] keyedSystemError("S2OO0002",[ind]) ["QVELT",name,ind] optSETRECORDELT ["SETRECORDELT",name,ind,len,expr] == len=1 => ind=0 => ["PROGN",["RPLACA",name,expr],['%head,name]] keyedSystemError("S2OO0002",[ind]) len=2 => ind=0 => ["PROGN",['%store,['%head,name],expr],['%head,name]] ind=1 => ["PROGN",['%store,['%tail,name],expr],['%tail,name]] keyedSystemError("S2OO0002",[ind]) ["QSETVELT",name,ind,expr] optRECORDCOPY ["RECORDCOPY",name,len] == len=1 => ["LIST",['%head,name]] len=2 => ["CONS",['%head,name],['%tail,name]] ["REPLACE",["MAKE_-VEC",len],name] optSuchthat [.,:u] == ["SUCHTHAT",:u] optQSMINUS u == u is ['QSMINUS,v] => integer? v => -v u u ++ List of VM side effect free operators. $VMsideEffectFreeOperators == '(CAR CDR LENGTH SIZE EQUAL EQL EQ NOT NULL OR AND SPADfirst QVELT _+ _- _* _< _= _<_= _> _>_= ASH INTEGER_-LENGTH QEQCAR QCDR QCAR IDENTP SYMBOLP GREATERP ZEROP ODDP FLOAT_-RADIX FLOAT FLOAT_-SIGN CGREATERP GGREATERP CHAR GET BVEC_-GREATER %when %false %true %and %or %not %peq %ieq %ilt %ile %igt %ige %head %tail %integer? %beq %blt %ble %bgt %bge %bitand %bitior %bitnot %bcompl %icst0 %icst1 %imul %iadd %isub %igcd %ilcm %ipow %imin %imax %ieven? %iodd? %iinc %irem %iquo %idivide %feq %flt %fle %fgt %fge %fmul %fadd %fsub %fexp %fmin %fmax %float? %fpow %fdiv %fneg %i2f %fminval %fmaxval %fbase %fprec %ftrunc %fsin %fcos %ftan %fcot %fsec %fcsc %fatan %facot %fsinh %fcosh %ftanh %fcsch %fcoth %fsech %fasinh %facsch %nil %pair? %lconcat %llength %lfirst %lsecond %lthird %lreverse %lempty? %hash %ismall? %string? %f2s %ccst %ceq %clt %cle %cgt %cge %c2i %i2c %sname %vref %vlength %before?) ++ List of simple VM operators $simpleVMoperators == append($VMsideEffectFreeOperators, ['CONS,'LIST,'VECTOR,'STRINGIMAGE,'FUNCALL,'%gensym, '%lreverse_!, "MAKE-FULL-CVEC","BVEC-MAKE-FULL","COND"]) ++ Return true if the `form' is semi-simple with respect to ++ to the list of operators `ops'. semiSimpleRelativeTo?(form,ops) == atomic? form => true form isnt [op,:args] or not MEMQ(op,ops) => false and/[semiSimpleRelativeTo?(f,ops) for f in args] ++ Return true if `form' is a simple VM form. ++ See $simpleVMoperators for the definition of simple operators. isSimpleVMForm form == semiSimpleRelativeTo?(form,$simpleVMoperators) ++ Return true if `form' is a VM form whose evaluation does not depend ++ on the program point where it is evaluated. isFloatableVMForm: %Code -> %Boolean isFloatableVMForm form == atom form => form ~= "$" form is ["QUOTE",:.] => true MEMQ(first form, $simpleVMoperators) and "and"/[isFloatableVMForm arg for arg in rest form] ++ Return true if the VM form `form' is one that we certify to ++ evaluate to a (compile time) constant. Note that this is a ++ fairly conservative approximation of compile time constants. isVMConstantForm: %Code -> %Boolean isVMConstantForm form == integer? form or string? form => true form isnt [op,:args] => false MEMQ(op,$VMsideEffectFreeOperators) and "and"/[isVMConstantForm arg for arg in args] ++ Return the set of free variables in the VM form `form'. findVMFreeVars form == IDENTP form => [form] form isnt [op,:args] => nil op = "QUOTE" => nil vars := union/[findVMFreeVars arg for arg in args] atom op => vars union(findVMFreeVars op,vars) ++ Return true is `var' is the left hand side of an assignment ++ in `form'. varIsAssigned(var,form) == atomic? form => false form is [op,=var,:.] and op in '(%LET LETT SETQ %store) => true or/[varIsAssigned(var,f) for f in form] ++ Subroutine of optLET. Return true if the variable `var' locally ++ defined in the LET-form can be safely replaced by its initalization ++ `expr' in the `body' of the LET-form. canInlineVarDefinition(var,expr,body) == varIsAssigned(var,body) => false numOfOccurencesOf(var,body) < 2 => true atom expr and not varIsAssigned(expr,body) ++ Implement simple-minded LET-inlining. It seems we can't count ++ on Lisp implementations to do this simple transformation. ++ This transformation will probably be more effective when all ++ type informations are still around. Which is why we should ++ have a type directed compilation throughout. optLET u == -- Hands off non-simple cases. u isnt ["LET",inits,body] => u -- Inline functionally used local variables with their initializers. inits := [:newInit for (init := [var,expr]) in inits] where newInit() == canInlineVarDefinition(var,expr,body) => body := substitute(expr,var,body) nil -- remove this initialization [init] -- otherwwise keep it. null inits => body u.rest.first := inits u.rest.rest.first := body -- Avoid initialization forms that may not be floatable. not(and/[isFloatableVMForm init for [.,init] in inits]) => u -- Identity function. inits is [[=body,init]] => init -- Handle only most trivial operators. body isnt [op,:args] => u -- Well, with case-patterns, it is beneficial to try a bit harder -- with conditional forms. op = "COND" => continue := true -- shall be continue let-inlining? -- Since we do a single pass, we can't reuse the inits list -- as we may find later that we can't really inline into -- all forms due to excessive conversatism. So we build a -- substitution list ahead of time. substPairs := [[var,:init] for [var,init] in inits] for clauses in tails args while continue repeat clause := first clauses -- we do not attempt more complicated clauses yet. clause isnt [test,stmt] => continue := false -- Stop inlining at least one test is not simple not isSimpleVMForm test => continue := false clause.first := SUBLIS(substPairs,test) isSimpleVMForm stmt => clause.rest.first := SUBLIS(substPairs,stmt) continue := false continue => body u not MEMQ(op,$simpleVMoperators) => u not(and/[atomic? arg for arg in args]) => u -- Inline only if all parameters are used. Get cute later. not(and/[MEMQ(x,args) for [x,.] in inits]) => u -- Munge inits into list of dotted-pairs. Lovely Lisp. for defs in tails inits repeat def := first defs atom def => systemErrorHere ["optLET",def] -- cannot happen def.rest := second def SUBLIS(inits,body) optLET_* form == form isnt ["LET*",:.] => form ok := true while ok for [[var,.],:inits] in tails second form repeat if CONTAINED(var,inits) then ok := false not ok => form form.first := "LET" optLET form optBind form == form isnt ['%bind,inits,.] => form -- accept only simple bodies ok := true while ok and inits ~= nil repeat [var,expr] := first inits usedSymbol?(var,rest inits) => ok := false -- no dependency, please. body := third form canInlineVarDefinition(var,expr,body) and isSimpleVMForm expr => third(form) := substitute_!(expr,var,body) inits := rest inits ok := false null inits => third form -- no local var left second(form) := inits form optLIST form == form is ["LIST"] => nil form optCollectVector form == [.,eltType,:iters,body] := form fromList := false -- are we drawing from a list? vecSize := nil -- size of vector index := nil -- loop/vector index. for iter in iters while not fromList repeat [op,:.] := iter op in '(SUCHTHAT WHILE UNTIL) => fromList := true op in '(IN ON) => vecSize := [["SIZE",third iter],:vecSize] op in '(STEP ISTEP) => -- pick a loop variable that we can use as the loop index. [.,var,lo,inc,:etc] := iter if lo = 0 and inc = 1 then index := var if [hi] := etc then sz := inc = 1 => lo = 1 => hi lo = 0 => MKQSADD1 hi MKQSADD1 ["-",hi,lo] lo = 1 => ["/",hi,inc] lo = 0 => ["/",MKQSADD1 hi,inc] ["/",["-",MKQSADD1 hi, lo],inc] vecSize := [sz, :vecSize] systemErrorHere ["optCollectVector", iter] -- if we draw from a list, then just build a list and convert to vector. fromList => ["homogeneousListToVector",["getVMType",eltType], ['%collect,:iters,body]] vecSize = nil => systemErrorHere ["optCollectVector",form] -- get the actual size of the vector. vecSize := vecSize is [hi] => hi ["MIN",:nreverse vecSize] -- if no suitable loop index was found, introduce one. if index = nil then index := gensym() iters := [:iters,['STEP,index,0,1]] vec := gensym() ["LET",[[vec,["makeSimpleArray",["getVMType",eltType],vecSize]]], ['%loop,:iters,["setSimpleArrayEntry",vec,index,body],vec]] ++ Translate retraction of a value denoted by `e' to sub-domain `m' ++ defined by predicate `pred', optRetract ["%retract",e,m,pred] == atom e => cond := simplifyVMForm substitute(e,"#1",pred) cond = '%true => e ["check-subtype",cond,MKQ m,e] g := gensym() ["LET",[[g,e]],["check-subtype",substitute(g,"#1",pred),MKQ m,g]] --% Boolean expression transformers optNot(x is ['%not,a]) == a = '%true => '%false a = '%false => '%true a is ['%not,b] => b x optAnd(x is ['%and,a,b]) == a = '%true => b b = '%true => a a = '%false => '%false x optOr(x is ['%or,a,b]) == a = '%false => b b = '%false => a a = '%true => '%true x optIeq(x is ['%ieq,a,b]) == integer? a and integer? b => a = b => '%true '%false x optIlt(x is ['%ilt,a,b]) == -- 1. Don't delay if both operands are literals. integer? a and integer? b => a < b => '%true '%false -- 2. max(a,b) cannot be negative if either a or b is zero. b = 0 and a is ['%imax,:.] and (second a = 0 or third a = 0) => '%false -- 3. min(a,b) cannot be positive if either a or b is zero. a = 0 and b is ['%imin,:.] and (second b = 0 or third b = 0) => '%false x optIle(x is ['%ile,a,b]) == optNot ['%not,optIlt ['%ilt,b,a]] optIgt x == optIlt ['%ilt,third x, second x] optIge x == optNot ['%not,optIlt ['%ilt,second x,third x]] --% Byte operations optBle ['%ble,a,b] == optNot ['%not,['%blt,b,a]] optBgt ['%bgt,a,b] == ['%blt,b,a] optBge ['%bge,a,b] == optBle ['%ble,b,a] --% Integer operations optIadd(x is ['%iadd,a,b]) == integer? a and integer? b => a + b integer? a and a = 0 => b integer? b and b = 0 => a x optIsub(x is ['%isub,a,b]) == integer? a and integer? b => a - b integer? a and a = 0 => ['%ineg,b] integer? b and b = 0 => a x optImul(x is ['%imul,a,b]) == integer? a and integer? b => a * b integer? a and a = 1 => b integer? b and b = 1 => a x optIneg(x is ['%ineg,a]) == integer? a => -a x optIrem(x is ['%irem,a,b]) == integer? a and integer? b => a rem b x optIquo(x is ['%iquo,a,b]) == integer? a and integer? b => a quo b x --% --% optimizer hash table --% for x in '( (%call optCall) _ (SEQ optSEQ)_ (LET optLET)_ (LET_* optLET_*)_ (%bind optBind)_ (%not optNot)_ (%and optAnd)_ (%or optOr)_ (%ble optBle)_ (%bgt optBgt)_ (%bge optBge)_ (%ieq optIeq)_ (%ilt optIlt)_ (%ile optIle)_ (%igt optIgt)_ (%ige optIge)_ (%ineg optIneg)_ (%iadd optIadd)_ (%isub optIsub)_ (%irem optIrem)_ (%iquo optIquo)_ (%imul optImul)_ (LIST optLIST)_ (QSMINUS optQSMINUS)_ (SPADCALL optSPADCALL)_ (_| optSuchthat)_ (CATCH optCatch)_ (COND optCond)_ (%retract optRetract)_ (%CollectV optCollectVector)_ (mkRecord optMkRecord)_ (RECORDELT optRECORDELT)_ (SETRECORDELT optSETRECORDELT)_ (RECORDCOPY optRECORDCOPY)) _ repeat property(first x,'OPTIMIZE) := second x --much quicker to call functions if they have an SBC