diff options
| -rwxr-xr-x | configure | 18 | ||||
| -rw-r--r-- | configure.ac | 2 | ||||
| -rw-r--r-- | configure.ac.pamphlet | 2 | ||||
| -rw-r--r-- | src/ChangeLog | 7 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 4 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 4 | ||||
| -rw-r--r-- | src/interp/define.boot | 129 | ||||
| -rw-r--r-- | src/interp/g-opt.boot | 3 | ||||
| -rw-r--r-- | src/interp/wi2.boot | 3 |
9 files changed, 99 insertions, 73 deletions
@@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.60 for OpenAxiom 1.3.0-2008-12-08. +# Generated by GNU Autoconf 2.60 for OpenAxiom 1.3.0-2008-12-17. # # Report bugs to <open-axiom-bugs@lists.sf.net>. # @@ -713,8 +713,8 @@ SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. PACKAGE_NAME='OpenAxiom' PACKAGE_TARNAME='openaxiom' -PACKAGE_VERSION='1.3.0-2008-12-08' -PACKAGE_STRING='OpenAxiom 1.3.0-2008-12-08' +PACKAGE_VERSION='1.3.0-2008-12-17' +PACKAGE_STRING='OpenAxiom 1.3.0-2008-12-17' PACKAGE_BUGREPORT='open-axiom-bugs@lists.sf.net' ac_unique_file="src/Makefile.pamphlet" @@ -1405,7 +1405,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures OpenAxiom 1.3.0-2008-12-08 to adapt to many kinds of systems. +\`configure' configures OpenAxiom 1.3.0-2008-12-17 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1475,7 +1475,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of OpenAxiom 1.3.0-2008-12-08:";; + short | recursive ) echo "Configuration of OpenAxiom 1.3.0-2008-12-17:";; esac cat <<\_ACEOF @@ -1579,7 +1579,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -OpenAxiom configure 1.3.0-2008-12-08 +OpenAxiom configure 1.3.0-2008-12-17 generated by GNU Autoconf 2.60 Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, @@ -1593,7 +1593,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by OpenAxiom $as_me 1.3.0-2008-12-08, which was +It was created by OpenAxiom $as_me 1.3.0-2008-12-17, which was generated by GNU Autoconf 2.60. Invocation command line was $ $0 $@ @@ -26424,7 +26424,7 @@ exec 6>&1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by OpenAxiom $as_me 1.3.0-2008-12-08, which was +This file was extended by OpenAxiom $as_me 1.3.0-2008-12-17, which was generated by GNU Autoconf 2.60. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -26473,7 +26473,7 @@ Report bugs to <bug-autoconf@gnu.org>." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ -OpenAxiom config.status 1.3.0-2008-12-08 +OpenAxiom config.status 1.3.0-2008-12-17 configured by $0, generated by GNU Autoconf 2.60, with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" diff --git a/configure.ac b/configure.ac index cb06bee1..f151da66 100644 --- a/configure.ac +++ b/configure.ac @@ -1,6 +1,6 @@ sinclude(config/open-axiom.m4) sinclude(config/aclocal.m4) -AC_INIT([OpenAxiom], [1.3.0-2008-12-08], +AC_INIT([OpenAxiom], [1.3.0-2008-12-17], [open-axiom-bugs@lists.sf.net]) AC_CONFIG_AUX_DIR(config) diff --git a/configure.ac.pamphlet b/configure.ac.pamphlet index 5e11f7a3..baf2ef9c 100644 --- a/configure.ac.pamphlet +++ b/configure.ac.pamphlet @@ -1126,7 +1126,7 @@ information: <<Autoconf init>>= sinclude(config/open-axiom.m4) sinclude(config/aclocal.m4) -AC_INIT([OpenAxiom], [1.3.0-2008-12-08], +AC_INIT([OpenAxiom], [1.3.0-2008-12-17], [open-axiom-bugs@lists.sf.net]) @ diff --git a/src/ChangeLog b/src/ChangeLog index 73a444be..2d3cd507 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2008-12-19 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/define.boot (insertViewMorphisms): New. + (checkRepresentation): Rename from maybeInsertViewMorphisms. Tidy. + (compDefineFunctor1): Tidy. + (doIt): Insert view morphisms if appropriate. + 2008-12-14 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/compiler.boot (compFormWithModemap): Tidy. diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index c7274eb8..bec24a42 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -1005,6 +1005,10 @@ replaceSimpleFunctions form == NBUTLAST form -- 2.2. the substitution case. fun' is ["XLAM",parms,body] => + -- Inline almost constant functions. + null parms => body + -- Identity function toos. + parms is [=body] => first args -- conservatively approximate eager semantics and/[isAtomicForm first as for as in tails args] => -- alpha rename before substitution. diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 49d99f9a..6885ba74 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -220,12 +220,14 @@ applyMapping([op,:argl],m,e,ml) == T() == [.,.,e]:= comp(x,m',e) or return "failed" if argl'="failed" then return nil form:= - atom op and not(op in $formalArgList) and not get(op,"value",e) => + atom op and not(op in $formalArgList) and null (u := get(op,"value",e)) => nprefix := $prefix or -- following needed for referencing local funs at capsule level getAbbreviation($op,#rest $form) [op',:argl',"$"] where op':= INTERN STRCONC(encodeItem nprefix,";",encodeItem op) + -- Compiler synthetized operators are inline. + u ^= nil and u.expr is ["XLAM",:.] => ["call",u.expr,:argl'] ['call,['applyFun,op],:argl'] pairlis:= [[v,:a] for a in argl' for v in $FormalMapVariableList] convert([form,SUBLIS(pairlis,first ml),e],m) diff --git a/src/interp/define.boot b/src/interp/define.boot index 06b181a9..5145d76b 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -62,9 +62,6 @@ $mutableDomain := false ++ when non nil, holds the declaration number of a function in a capsule. $suffix := nil --- ??? turns off buggy code -$NRTopt := false - $doNotCompileJustPrint := false ++ stack of pending capsule function definitions. @@ -76,7 +73,6 @@ $functorStats := nil $lisplibCategory := nil $lisplibAncestors := nil $lisplibAbbreviation := nil -$LocalDomainAlist := [] $CheckVectorList := [] $setelt := nil $pairlis := [] @@ -169,45 +165,72 @@ compDefine(form,m,e) == $macroIfTrue: local := false compDefine1(form,m,e) -++ We are about to process the body of a capsule. If the capsule defines -++ `Rep' as a constant, then implicitly insert the view morphisms +++ Activate synthetized pair concretization and abstraction +++ view morphisms for domains. +insertViewMorphisms: (%Mode,$Env) -> %Env +insertViewMorphisms(t,e) == + $useRepresentationHack => e + g := GENSYM() + repType := ["Mapping",t,"$"] + perType := ["Mapping","$",t] + e := put("rep","value",[["XLAM",[g],g],repType,nil],e) + put("per","value",[["XLAM",[g],g],perType,nil],e) + +++ We are about to process the body of a capsule. Check the form of +++ `Rep' definition, and whether it is appropriate to activate the +++ implicitly generated morphisms ++ per: Rep -> % ++ rep: % -> Rep -++ as local functions. Note that we do not declare them as macros. -maybeInsertViewMorphisms: %Form -> %Form -maybeInsertViewMorphisms body == +++ as local inline functions. +checkRepresentation: %Form -> %Form +checkRepresentation body == domainRep := nil - before := nil - - while null domainRep for [stmt,:after] in tails body repeat - stmt isnt ["DEF",["Rep",:args],sig,nils,domainRep] => - before := [stmt,:before] - if args then - userError [:bright '"Rep",'"cannot take arguments"] - if first sig then - userError [:bright '"Rep", "cannot have type sepcification"] - - null domainRep => body - -- Make sure we don't implicitly convert from `Rep' to `%'. - $useRepresentationHack := false - -- Reject user-defined view morphisms - for stmt in after repeat - stmt is ["DEF",["rep",:.],:.] - or stmt is ["DEF",["per",:.],:.] => - -- ??? We may actually want to stop processing now. - stackSemanticError(['"Cannot define",:bright "per"],nil) - - -- OK, insert synthetized view morphisms - g := GENSYM() - repMorphism := ["DEF",["rep",g],[domainRep,"$"],[nil,nil], - ["pretend",g,domainRep]] - perMorphism := ["DEF",["per",g],["$",domainRep],[nil,nil], - ["pretend",g,"$"]] + hasAssignRep := false -- assume code does not assign to Rep. + viewFuns := nil + + null body => body -- Don't be too hard on nothing. - -- Trick the rest of the compiler into believing that - -- that `Rep' was defined the old way, for the purpose of lookup. - [:reverse before, ["%LET","Rep",domainRep], - :[repMorphism,perMorphism],:after] + -- Locate possible Rep definition + for [stmt,:.] in tails body repeat + stmt is ["%LET","Rep",.] => + domainRep ^= nil => + stackAndThrow('"You cannot assign to constant domain %1b",["Rep"]) + return hasAssignRep := true + stmt is ["MDEF",["Rep",:.],:.] => + stackWarning('"Consider using == definition for %1b",["Rep"]) + return hasAssignRep := true + stmt is ["IF",.,:l] or stmt is ["SEQ",:l] or stmt is ["exit",:l] => + checkRepresentation l + $useRepresentationHack => return hasAssignRep := true + stmt isnt ["DEF",[op,:args],sig,.,val] => nil -- skip for now. + op in '(rep per) => + domainRep ^= nil => + stackAndThrow('"You cannot define implicitly generated %1b",[op]) + viewFuns := [op,:viewFuns] + op ^= "Rep" => nil -- we are only interested in Rep definition + domainRep := val + viewFuns ^= nil => + stackAndThrow('"You cannot define both %1b and %2b",["Rep",:viewFuns]) + -- A package has no "%". + $functorKind = "package" => + stackAndThrow('"You cannot define %1b in a package",["Rep"]) + -- It is a mistake to define Rep in category defaults + $insideCategoryPackageIfTrue => + stackAndThrow('"You cannot define %1b in category defaults",["Rep"]) + if args ^= nil then + stackAndThrow('"%1b does take arguments",["Rep"]) + if first sig ^= nil then + stackAndThrow('"You cannot specify type for %1b",["Rep"]) + -- Now, trick the rest of the compiler into believing that + -- `Rep' was defined the Old Way, for lookup purpose. + rplac(first stmt,"%LET") + rplac(rest stmt,["Rep",domainRep]) + $useRepresentationHack := false -- Don't confuse `Rep' and `%'. + + -- Shall we perform the dirty tricks? + if hasAssignRep then + $useRepresentationHack := true + body compDefine1: (%Form,%Mode,%Env) -> %Maybe %Triple @@ -556,7 +579,6 @@ compDefineFunctor1(df is ['DEF,form,signature,$functorSpecialCases,body], $functorTarget: local := nil $Representation: local := nil --Set in doIt, accessed in the compiler - compNoStacking - $LocalDomainAlist: local := [] --set in doIt, accessed in genDeltaEntry $functorForm: local := nil $functorLocalParameters: local := nil SETQ($myFunctorBody, body) @@ -581,6 +603,9 @@ compDefineFunctor1(df is ['DEF,form,signature,$functorSpecialCases,body], modemap2Signature getModemap($form,$e) target:= first signature' $functorTarget:= target + $functorKind: local := + $functorTarget is ["CATEGORY",key,:.] => key + "domain" $e:= giveFormalParametersValues(argl,$e) [ds,.,$e]:= compMakeCategoryObject(target,$e) or return stackAndThrow('" cannot produce category object: %1pb",[target]) @@ -610,20 +635,8 @@ compDefineFunctor1(df is ['DEF,form,signature,$functorSpecialCases,body], -- generate slots for arguments first, then for $NRTaddForm in compAdd for x in argl repeat NRTgetLocalIndex x [.,.,$e]:= compMakeDeclaration([":",'_$,target],m,$e) - --The following loop sees if we can economise on ADDed operations - --by using those of Rep, if that is the same. Example: DIRPROD if not $insideCategoryPackageIfTrue then - if body is ['add,ab:=[fn,:.],['CAPSULE,:cb]] and MEMQ(fn,'(List Vector)) - and FindRep(cb) = ab - where FindRep cb == - u:= - while cb repeat - ATOM cb => return nil - cb is [["%LET",'Rep,v,:.],:.] => return (u:=v) - cb:=CDR cb - u - then $e:= augModemapsFromCategoryRep('_$,ab,cb,target,$e) - else $e:= augModemapsFromCategory('_$,'_$,'_$,target,$e) + $e:= augModemapsFromCategory('_$,'_$,'_$,target,$e) $signature:= signature' parSignature:= SUBLIS($pairlis,signature') parForm:= SUBLIS($pairlis,form) @@ -673,8 +686,6 @@ compDefineFunctor1(df is ['DEF,form,signature,$functorSpecialCases,body], $insideFunctorIfTrue:= false if $LISPLIB then $lisplibKind:= -------->This next line prohibits changing the KIND once given ---------kk:=getConstructorKindFromDB $op => kk $functorTarget is ["CATEGORY",key,:.] and key^="domain" => 'package 'domain $lisplibForm:= form @@ -1409,7 +1420,7 @@ compCapsule(['CAPSULE,:itemList],m,e) == $insideExpressionIfTrue: local:= false $useRepresentationHack := true clearCapsuleFunctionTable() - compCapsuleInner(maybeInsertViewMorphisms itemList,m,addDomain('_$,e)) + compCapsuleInner(checkRepresentation itemList,m,addDomain('_$,e)) compSubDomain(["SubDomain",domainForm,predicate],m,e) == $addFormLhs: local:= domainForm @@ -1500,10 +1511,8 @@ doIt(item,$predl) == if lhs="Rep" then $Representation:= (get("Rep",'value,$e)).expr --$Representation bound by compDefineFunctor, used in compNoStacking - if $NRTopt = true - then NRTgetLocalIndex $Representation - $LocalDomainAlist:= --see genDeltaEntry - [[lhs,:SUBLIS($LocalDomainAlist,(get(lhs,'value,$e)).0)],:$LocalDomainAlist] + -- Activate view morphisms if appropriate + $e := insertViewMorphisms($Representation,$e) code is ["%LET",:.] => RPLACA(item,"setShellEntry") rhsCode := rhs' diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 52f54d3f..f19a4d69 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -381,7 +381,8 @@ optEQ u == $simpleVMoperators == '(CONS CAR CDR LENGTH SIZE EQUAL EQL EQ NOT NULL OR AND - QEQCAR QCDR QCAR INTEGERP FLOATP STRINGP IDENTP SYMBOLP) + SPADfirst QVELT _+ _- _* _< _= + QEQCAR QCDR QCAR INTEGERP FLOATP STRINGP IDENTP SYMBOLP) isSimpleVMForm form == isAtomicForm form => true diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot index cc1d843b..8b3967f5 100644 --- a/src/interp/wi2.boot +++ b/src/interp/wi2.boot @@ -36,6 +36,9 @@ import macros import define namespace BOOT +-- ??? turns off buggy code +$NRTopt := false + compDefineFunctor1(df, m,$e,$prefix,$formalArgList) == ['DEF,form,signature,$functorSpecialCases,body] := df signature := markKillAll signature |