\documentclass{article} \usepackage{open-axiom} \title{src/algebra mkfunc.spad} \author{Manuel Bronstein} \begin{document} \maketitle \begin{abstract} \end{abstract} \tableofcontents \eject \section{domain INFORM InputForm} <>= )abbrev domain INFORM InputForm ++ Parser forms ++ Author: Manuel Bronstein ++ Date Created: ??? ++ Date Last Updated: October 14, 2008 ++ Description: ++ Domain of parsed forms which can be passed to the interpreter. ++ This is also the interface between algebra code and facilities ++ in the interpreter. InputForm(): Join(SExpressionCategory(String,Symbol,Integer,DoubleFloat,OutputForm), ConvertibleTo SExpression) with interpret: % -> Any ++ interpret(f) passes f to the interpreter. convert : SExpression -> % ++ convert(s) makes s into an input form. binary : (%, List %) -> % ++ \spad{binary(op, [a1,...,an])} returns the input form ++ corresponding to \spad{a1 op a2 op ... op an}. function : (%, List Symbol, Symbol) -> % ++ \spad{function(code, [x1,...,xn], f)} returns the input form ++ corresponding to \spad{f(x1,...,xn) == code}. lambda : (%, List Symbol) -> % ++ \spad{lambda(code, [x1,...,xn])} returns the input form ++ corresponding to \spad{(x1,...,xn) +-> code} if \spad{n > 1}, ++ or to \spad{x1 +-> code} if \spad{n = 1}. + : (%, %) -> % ++ \spad{a + b} returns the input form corresponding to \spad{a + b}. * : (%, %) -> % ++ \spad{a * b} returns the input form corresponding to \spad{a * b}. / : (%, %) -> % ++ \spad{a / b} returns the input form corresponding to \spad{a / b}. ** : (%, NonNegativeInteger) -> % ++ \spad{a ** b} returns the input form corresponding to \spad{a ** b}. ** : (%, Integer) -> % ++ \spad{a ** b} returns the input form corresponding to \spad{a ** b}. 0 : constant -> % ++ \spad{0} returns the input form corresponding to 0. 1 : constant -> % ++ \spad{1} returns the input form corresponding to 1. flatten : % -> % ++ flatten(s) returns an input form corresponding to s with ++ all the nested operations flattened to triples using new ++ local variables. ++ If s is a piece of code, this speeds up ++ the compilation tremendously later on. unparse : % -> String ++ unparse(f) returns a string s such that the parser ++ would transform s to f. ++ Error: if f is not the parsed form of a string. parseString: String -> % ++ parseString is the inverse of unparse. It parses a ++ string to InputForm. declare : List % -> Symbol ++ declare(t) returns a name f such that f has been ++ declared to the interpreter to be of type t, but has ++ not been assigned a value yet. ++ Note: t should be created as \spad{devaluate(T)$Lisp} where T is the ++ actual type of f (this hack is required for the case where ++ T is a mapping type). compile : (Symbol, List %) -> Symbol ++ \spad{compile(f, [t1,...,tn])} forces the interpreter to compile ++ the function f with signature \spad{(t1,...,tn) -> ?}. ++ returns the symbol f if successful. ++ Error: if f was not defined beforehand in the interpreter, ++ or if the ti's are not valid types, or if the compiler fails. == SExpression add strsym : % -> String tuplify : List Symbol -> % flatten0 : (%, Symbol, NonNegativeInteger) -> Record(lst: List %, symb:%) 0 == convert(0::Integer) 1 == convert(1::Integer) convert(x:%):SExpression == rep x convert(x:SExpression):% == per x conv(ll : List %): % == per convert(ll pretend List SExpression)$SExpression lambda(f,l) == conv([convert("+->"::Symbol),tuplify l,f]$List(%)) interpret x == v := interpret(x)$Lisp objNew(unwrap(objVal(v)$Lisp)$Lisp, objMode(v)$Lisp)$Lisp convert(x:DoubleFloat):% == zero? x => 0 one? x => 1 convert(x) flatten s == -- will not compile if I use 'or' atom? s => s every?(atom?,destruct s)$List(%) => s sy := new()$Symbol n:NonNegativeInteger := 0 l := destruct s l2 := [flatten0(x, sy, n := n + 1) for x in rest l] conv(concat(convert("SEQ"::Symbol)@%, concat(concat [u.lst for u in l2], conv( [convert("exit"::Symbol)@%, 1$%, conv(concat(first l, [u.symb for u in l2]))@%]$List(%))@%)))@% flatten0(s, sy, n) == atom? s => [nil(), s] a := convert(concat(string sy, string n)::Symbol)@% l := destruct s l2 := [flatten0(x, sy, n := n+1) for x in rest l] [concat(concat [u.lst for u in l2], conv([convert( "%LET"::Symbol)@%, a, conv(concat(first l, [u.symb for u in l2]))@%]$List(%))@%), a] strsym s == string? s => string s symbol? s => string symbol s error ["strsym: form", s, "is neither a string or symbol"] unparse x == inputForm2String(x)$Lisp parseString x == ncParseFromString(x)$Lisp declare signature == declare(name := new()$Symbol, signature)$Lisp name compile(name, types) == name' := convert(name)@% symbol car cdr car selectLocalMms(mkAtreeForToken(name')$Lisp, name', types, nil$List(%))$Lisp binary(op, args) == (n := #args) < 2 => error "Need at least 2 arguments" n = 2 => convert([op, first args, last args]$List(%)) convert([op, first args, binary(op, rest args)]$List(%)) tuplify l == empty? l => convert(nil$List(%)) empty? rest l => convert first l conv concat(convert("tuple"::Symbol), [convert x for x in l]$List(%)) function(f, l, name) == nn := convert(new(1 + #l, convert(nil()$List(%)))$List(%))@% conv([convert("DEF"::Symbol), conv(cons(convert(name)@%, [convert(x)@% for x in l])), nn, nn, f]$List(%)) s1 + s2 == s1 = 0 => s2 s2 = 0 => s1 conv [convert("+"::Symbol), s1, s2]$List(%) s1 * s2 == s1 = 0 or s2 = 0 => 0 s1 = 1 => s2 s2 = 1 => s1 conv [convert("*"::Symbol), s1, s2]$List(%) s1:% ** n:Integer == s1 = 0 and positive? n => 0 s1 = 1 or zero? n => 1 one? n => s1 conv [convert("**"::Symbol), s1, convert n]$List(%) s1:% ** n:NonNegativeInteger == s1 ** (n::Integer) s1 / s2 == s2 = 1 => s1 conv [convert("/"::Symbol), s1, s2]$List(%) -- A displayed form of an InputForm should be suitable as -- input to the interpreter parser. coerce(x: %): OutputForm == inputForm2OutputForm(x)$Lisp @ \section{package INFORM1 InputFormFunctions1} <>= )abbrev package INFORM1 InputFormFunctions1 ++ Tools for manipulating input forms ++ Author: Manuel Bronstein ++ Date Created: ??? ++ Date Last Updated: 19 April 1991 ++ Description: Tools for manipulating input forms. InputFormFunctions1(R:Type):with packageCall: Symbol -> InputForm ++ packageCall(f) returns the input form corresponding to f$R. interpret : InputForm -> R ++ interpret(f) passes f to the interpreter, and transforms ++ the result into an object of type R. == add Rname := devaluate(R)$Lisp :: InputForm packageCall name == convert([convert("$elt"::Symbol), Rname, convert name]$List(InputForm))@InputForm interpret form == retract(interpret(convert([convert("@"::Symbol), form, Rname]$List(InputForm))@InputForm)$InputForm)$AnyFunctions1(R) @ \section{package MKFUNC MakeFunction} <>= )abbrev package MKFUNC MakeFunction ++ Tools for making interpreter functions from top-level expressions ++ Author: Manuel Bronstein ++ Date Created: 22 Nov 1988 ++ Date Last Updated: 8 Jan 1990 ++ Description: transforms top-level objects into interpreter functions. MakeFunction(S:ConvertibleTo InputForm): Exports == Implementation where SY ==> Symbol Exports ==> with function: (S, SY ) -> SY ++ function(e, foo) creates a function \spad{foo() == e}. function: (S, SY, SY) -> SY ++ function(e, foo, x) creates a function \spad{foo(x) == e}. function: (S, SY, SY, SY) -> SY ++ function(e, foo, x, y) creates a function \spad{foo(x, y) = e}. function: (S, SY, List SY) -> SY ++ \spad{function(e, foo, [x1,...,xn])} creates a function ++ \spad{foo(x1,...,xn) == e}. Implementation ==> add function(s, name) == function(s, name, nil()) function(s:S, name:SY, x:SY) == function(s, name, [x]) function(s, name, x, y) == function(s, name, [x, y]) function(s:S, name:SY, args:List SY) == interpret function(convert s, args, name)$InputForm name @ \section{package MKUCFUNC MakeUnaryCompiledFunction} <>= import Type import Symbol import ConvertibleTo InputForm )abbrev package MKUCFUNC MakeUnaryCompiledFunction ++ Tools for making compiled functions from top-level expressions ++ Author: Manuel Bronstein ++ Date Created: 1 Dec 1988 ++ Date Last Updated: 5 Mar 1990 ++ Description: transforms top-level objects into compiled functions. MakeUnaryCompiledFunction(S, D, I): Exports == Implementation where S: ConvertibleTo InputForm D, I: Type SY ==> Symbol DI ==> devaluate(D -> I)$Lisp Exports ==> with unaryFunction : SY -> (D -> I) ++ unaryFunction(a) is a local function compiledFunction: (S, SY) -> (D -> I) ++ compiledFunction(expr, x) returns a function \spad{f: D -> I} ++ defined by \spad{f(x) == expr}. ++ Function f is compiled and directly ++ applicable to objects of type D. Implementation ==> add import MakeFunction(S) func: (SY, D) -> I func(name: SY, x: D): I == %funcall(name, x, %nil$Foreign(Builtin))$Foreign(Builtin) unaryFunction name == func(name, #1) compiledFunction(e:S, x:SY) == t := [convert([devaluate(D)$Lisp]$List(InputForm)) ]$List(InputForm) unaryFunction compile(function(e, declare DI, x), t) @ \section{package MKBCFUNC MakeBinaryCompiledFunction} <>= import Type import CoercibleTo InputForm import Symbol )abbrev package MKBCFUNC MakeBinaryCompiledFunction ++ Tools for making compiled functions from top-level expressions ++ Author: Manuel Bronstein ++ Date Created: 1 Dec 1988 ++ Date Last Updated: 5 Mar 1990 ++ Description: transforms top-level objects into compiled functions. MakeBinaryCompiledFunction(S, D1, D2, I):Exports == Implementation where S: ConvertibleTo InputForm D1, D2, I: Type SY ==> Symbol DI ==> devaluate((D1, D2) -> I)$Lisp Exports ==> with binaryFunction : SY -> ((D1, D2) -> I) ++ binaryFunction(s) is a local function compiledFunction: (S, SY, SY) -> ((D1, D2) -> I) ++ compiledFunction(expr,x,y) returns a function \spad{f: (D1, D2) -> I} ++ defined by \spad{f(x, y) == expr}. ++ Function f is compiled and directly ++ applicable to objects of type \spad{(D1, D2)} Implementation ==> add import MakeFunction(S) func(name: SY, x: D1, y: D2): I == %funcall(name, x, y, %nil$Foreign(Builtin))$Foreign(Builtin) binaryFunction name == func(name, #1, #2) compiledFunction(e, x, y) == t := [devaluate(D1)$Lisp, devaluate(D2)$Lisp]$List(InputForm) binaryFunction compile(function(e, declare DI, x, y), t) @ \section{package MKFLCFN MakeFloatCompiledFunction} <>= )abbrev package MKFLCFN MakeFloatCompiledFunction ++ Tools for making compiled functions from top-level expressions ++ Author: Manuel Bronstein ++ Date Created: 2 Mar 1990 ++ Date Last Updated: 2 Dec 1996 (MCD) ++ Description: ++ MakeFloatCompiledFunction transforms top-level objects into ++ compiled Lisp functions whose arguments are Lisp floats. ++ This by-passes the \Language{} compiler and interpreter, ++ thereby gaining several orders of magnitude. MakeFloatCompiledFunction(S): Exports == Implementation where S: ConvertibleTo InputForm INF ==> InputForm SF ==> DoubleFloat DI1 ==> devaluate(SF -> SF)$Lisp DI2 ==> devaluate((SF, SF) -> SF)$Lisp Exports ==> with makeFloatFunction: (S, Symbol) -> (SF -> SF) ++ makeFloatFunction(expr, x) returns a Lisp function ++ \spad{f: \axiomType{DoubleFloat} -> \axiomType{DoubleFloat}} ++ defined by \spad{f(x) == expr}. ++ Function f is compiled and directly ++ applicable to objects of type \axiomType{DoubleFloat}. makeFloatFunction: (S, Symbol, Symbol) -> ((SF, SF) -> SF) ++ makeFloatFunction(expr, x, y) returns a Lisp function ++ \spad{f: (\axiomType{DoubleFloat}, \axiomType{DoubleFloat}) -> \axiomType{DoubleFloat}} ++ defined by \spad{f(x, y) == expr}. ++ Function f is compiled and directly ++ applicable to objects of type \spad{(\axiomType{DoubleFloat}, \axiomType{DoubleFloat})}. Implementation ==> add import MakeUnaryCompiledFunction(S, SF, SF) import MakeBinaryCompiledFunction(S, SF, SF, SF) streq? : (INF, String) -> Boolean streqlist?: (INF, List String) -> Boolean gencode : (String, List INF) -> INF mkLisp : INF -> Union(INF, "failed") mkLispList: List INF -> Union(List INF, "failed") mkDefun : (INF, List INF) -> INF mkLispCall: INF -> INF mkPretend : INF -> INF mkCTOR : INF -> INF lsf := convert([convert("DoubleFloat"::Symbol)@INF]$List(INF))@INF streq?(s, st) == s = convert(st::Symbol)@INF gencode(s, l) == convert(concat(convert(s::Symbol)@INF, l))@INF streqlist?(s, l) == member?(string symbol s, l) quote(f: INF): INF == gencode("QUOTE",[f]) coerceToSF(f: INF): INF == gencode("COERCE",[f, quote getVMType(SF)$Foreign(Builtin)]) -- return true if the form `x' is contained in `y' contained?(x: INF, y: INF): Boolean == atom? y => x = y contained?(x, car y) or contained?(x, cdr y) mkPretend form == convert([convert("pretend"::Symbol), form, lsf]$List(INF))@INF mkCTOR form == convert([convert("C-TO-R"::Symbol), form]$List(INF))@INF mkLispCall name == convert([convert("$elt"::Symbol), convert("Lisp"::Symbol), name]$List(INF))@INF mkDefun(s, lv) == name := convert(new()$Symbol)@INF body := coerceToSF mkCTOR s unusedParms := [ p for p in lv | not contained?(p,s)] stmts := null unusedParms => [body] [gencode("DECLARE",[gencode("IGNORE", unusedParms)]),body] stmts := concat(gencode("DECLARE",[gencode("FLOAT",lv)]), stmts) header := [convert("DEFUN"::Symbol), name, convert lv] fun := convert append(header,stmts) EVAL(fun)$Lisp if _$compileDontDefineFunctions$Lisp then COMPILE(name)$Lisp name makeFloatFunction(f, x, y) == (u := mkLisp(convert(f)@INF)) case "failed" => compiledFunction(f, x, y) name := mkDefun(u::INF, [ix := convert x, iy := convert y]) t := [lsf, lsf]$List(INF) spadname := declare DI2 spadform:=mkPretend convert([mkLispCall name,ix,iy]$List(INF))@INF interpret function(spadform, [x, y], spadname) binaryFunction compile(spadname, t) makeFloatFunction(f, var) == (u := mkLisp(convert(f)@INF)) case "failed" => compiledFunction(f, var) name := mkDefun(u::INF, [ivar := convert var]) t := [lsf]$List(INF) spadname := declare DI1 spadform:= mkPretend convert([mkLispCall name,ivar]$List(INF))@INF interpret function(spadform, [var], spadname) unaryFunction compile(spadname, t) mkLispList l == ans := nil()$List(INF) for s in l repeat (u := mkLisp s) case "failed" => return "failed" ans := concat(u::INF, ans) reverse! ans mkLisp s == atom? s => s op := first(l := destruct s) (u := mkLispList rest l) case "failed" => "failed" ll := u::List(INF) streqlist?(op, ["+","*","/","-"]) => convert(concat(op, ll))@INF streq?(op, "**") => gencode("EXPT", ll) streqlist?(op, ["exp","sin","cos","tan","atan", "log", "sinh","cosh","tanh","asinh","acosh","atanh","sqrt"]) => gencode(upperCase string symbol op, ll) streq?(op, "nthRoot") => second ll = convert(2::Integer)@INF =>gencode("SQRT",[first ll]) gencode("EXPT", concat(first ll, [1$INF / second ll])) streq?(op, "float") => a := ll.1 e := ll.2 b := ll.3 _*(a, EXPT(b, e)$Lisp)$Lisp pretend INF "failed" @ \section{License} <>= --Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. --All rights reserved. --Copyright (C) 2007-2009, 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. @ <<*>>= <> <> <> <> <> <> <> @ \eject \begin{thebibliography}{99} \bibitem{1} nothing \end{thebibliography} \end{document}