Tim,
This bug is now on Issue Tracker, #370.
The MACROEXPAND fix as detailed in a prior email seems workable. I
have tested the change but wish to continue with some more tests. I
propose the attached patches for testing.
The original `fix', checking that a free variable is bound in the
environment, might still be useful. The compiler is surely lacking in
assertions and self checks. Will incorporate the change into my own
branches and possibly submit a patch in the future.
Steve
--- changelog 2007-07-07 20:53:37.000000000 -0400
+++ changelog.sxw 2007-07-08 14:33:16.000000000 -0400
@@ -1,3 +1,4 @@
+20070708 sxw fix issue #370, document
20070705 wxh src/algebra/draw.spad clip myTrap1, myTrap2 range to SF (545)
20070705 gdr remove execute bit from files (svn 651)
20070704 tpd zips/tla-1.1.tar.gz svn propset mime-type binary/data
--- buildom.boot.pamphlet 2007-07-07 20:53:40.000000000 -0400
+++ buildom.boot.pamphlet.sxw 2007-07-08 14:34:27.000000000 -0400
@@ -9,6 +9,249 @@
\eject
\tableofcontents
\eject
+\section{[[makeFunctionList]] Operations}
+
+In {\tt src/interp/property.lisp.pamphlet} the primitive constructor
+names [[Record]], [[Union]], [[Mapping]] and [[Enumeration]] have
+their plists augmented to include an association between the key
+[[makeFunctionList]] and a function. These functions are defined
+here, the common goal being to construct a list of exports admitted by
+instances of the given type.
+
+To understand the results, it is useful to simply compare the lists
+generated by the following routines and the output of the
+corresponding interpreter command such as
+[[)show Union(int: Integer, str: String)]].
+
+\subsection{[[mkNewUnionFunList]] and [[mkUnionFunlist]]}
+
+The exports provided by a Union type differ depending on if the
+branches are labeled (a so-called {\em new union}), or are unlabeled.
+A labeled [[Union]] branch is represented as a binding form
+[[(|:| <tag> <type>)]], where [[<tag>]] is a symbol
+labeling the branch and [[<type>]] denotes the corresponding type.
+When a branch is labeled, the function [[mkNewUnionFunList]] processes
+the forms, otherwise [[mkUnionFunList]] handles the task.
+
+<<check for new union>>=
+first listOfEntries is [":",.,.] => mkNewUnionFunList(op,form,e)
+@
+
+Recall that the general form for a map type is
+[[(<target> <arg1> ... <argn>)]] where [[<target>]]
+denotes the return type of the map and [[<argk>]] denotes the k'th
+argument type. The general form for an exported function is
+[[(<name> <type> <body>)]].
+
+A [[Union]] type always exports a equality operator [[=]] and a
+coercion the the type bound by the global variable [[$Expression]].
+It is almost certain that [[$Expression]] is always an alias for
+[[OutputForm]].
+
+<<default old-union exports>>=
+['_=,[['Boolean],g ,g],['ELT,op,6]],
+['coerce,[$Expression,g],['ELT,op,7]]
+@
+
+The remaining exports are dependent on the number of branches in the
+[[Union]]. For each branch, we export four functions.
+\begin{itemize}
+\item [[autoCoerce]], denoting automatic (unchecked) coercions
+too/from the [[Union]] type and the branch type.
+\item [[coerce]], denoting explicit (checked) coercions from the
+[[Union]] type to the branch type.
+\item [[case]], a [[Boolean]] valued infix operator allowing one to
+test if access to a particular branch is valid.
+\end{itemize}
+
+We iterate over each branch component in [[listOfEntries]] and collect
+the four generated exports into the final list. Note that [[g]] is
+bound to a [[GENSYM]], which is a place-holder for latter substitution
+of the name denoting the [[Union]] type.
+
+<<old-union branch exports>>=
+("append"/
+ [[['autoCoerce,[g,t],upFun],
+ ['coerce,[t,g],cdownFun],
+ ['autoCoerce,[t,g],downFun], --this should be removed eventually
+ ['case,['(Boolean),g,t],typeFun]]
+ for p in predList for t in listOfEntries])
+@
+
+The implementation of the export bodies themselves require more
+documentation. The implementation is segregated to hopefully ease
+future documentation efforts.
+
+<<old-union export implementations>>=
+<<[[upFun]]>>
+<<[[cdownFun]]>>
+<<[[downFun]]>>
+<<[[typeFun]]>>
+@
+
+[[cdownFun]] implements coercions from a [[Union]] type to a branch
+type. The generated call to [[|check-union|]] (see {\tt
+src/interp/macros.lisp.pamphlet}) needs special mention. This call
+simply asserts that its predicate, denoted by [[q]] here, returns
+true. Otherwise a message is generated indicating the coercion
+failed. Note in particular the need to call [[MACROEXPAND]] on the
+type form [[t]]. This is required as type expressions are often
+represented as macros. When appearing in generated code, the expansion
+of a type expression is amenable to further analysis by by the
+compiler, but an unexpanded form is not. Compare the representation
+of a [[Record]] type verses its expansion (see the [[|Record|]] macro
+in {\tt src/interp/macros.lisp.pamphlet}).
+
+<<[[cdownFun]]>>=
+cdownFun() ==
+ gg:=GENSYM()
+ if p is ['EQCAR,x,n] then
+ ref:=['QCDR,gg]
+ q:= ['QEQCAR, gg, n]
+ else
+ ref:=gg
+ q:= substitute(gg,"#1",p)
+ ['XLAM,["#1"],['PROG2,['LET,gg,"#1"],ref,
+ ['check_-union,q,MACROEXPAND t,gg]]]
+@
+
+[[upFun]] handles the auto-coercion from a branch type to the [[Union]]
+type.
+
+<<[[upFun]]>>=
+upFun() ==
+ p is ['EQCAR,x,n] => ['XLAM,["#1"],['CONS,n,"#1"]]
+ ['XLAM,["#1"],"#1"]
+@
+
+[[downFun]] handles the auto-coercion from a [[Union]] type to a branch
+type.
+<<[[downFun]]>>=
+downFun() ==
+ p is ['EQCAR,x,.] =>
+ ['XLAM,["#1"],['QCDR,"#1"]]
+ ['XLAM,["#1"],"#1"]
+@
+
+[[typeFun]] implements the [[case]] operation.
+<<[[typeFun]]>>=
+typeFun() ==
+ p is ['EQCAR,x,n] =>
+ ['XLAM,["#1"],['QEQCAR,x,n]]
+ ['XLAM,["#1"],p]
+@
+
+This is the final implementation of [[mkUnionFunList]].
+
+<<mkUnionFunList>>=
+mkUnionFunList(op,form is ['Union,:listOfEntries],e) ==
+ <<check for new union>>
+ -- following call to order is a bug, but needs massive recomp to fix
+ listOfEntries:= orderUnionEntries listOfEntries
+ --1. create representations of subtypes
+ predList:= mkPredList listOfEntries
+ g:=GENSYM()
+ --2. create coercions from subtypes to subUnion
+ cList:=
+ [<<default old-union exports>>,:
+ <<old-union branch exports>>] where
+ <<old-union export implementations>>
+ op:=
+ op='Rep => '$
+ op
+ cList:= substitute(op,g,cList)
+ [cList,e]
+
+@
+
+[[mkNewUnionFunList]] follows effectively the same strategy as
+[[mkUnionFunList]]. The default equality and coercion to
+[[OutputForm]] remain, however the branch specific exports differ.
+For each branch, we generate the following:
+\begin{itemize}
+\item [[construct]], from the branch type to the [[Union]] type,
+denoted in Spad code as the bracket operator `[[[]]]'.
+\item [[elt]], a checked accessor for a tagged branch, denoted in
+Spad code as the `[[.]]' operator.
+\item [[case]], this operator now operates over tags rather than
+types.
+\end{itemize}
+
+<<mkNewUnionFunList>>=
+mkNewUnionFunList(name,form is ['Union,:listOfEntries],e) ==
+ dc := name
+ if name = 'Rep then name := '$
+ --2. create coercions from subtypes to subUnion
+ cList:=
+ [['_=,[['Boolean],name ,name],['ELT,dc,6]],
+ ['coerce,[$Expression,name],['ELT,dc,7]],:
+ ("append"/
+ [[['construct,[name,type],['XLAM,["#1"],['CONS,i,"#1"]]],
+ ['elt,[type,name,tag],cdownFun],
+ ['case,['(Boolean),name,tag],
+ ['XLAM,["#1"],['QEQCAR,"#1",i]]]]
+ for [.,tag,type] in listOfEntries for i in 0..])] where
+ cdownFun() ==
+ gg:=GENSYM()
+ $InteractiveMode =>
+ ['XLAM,["#1"],['PROG1,['QCDR,"#1"],
+ ['check_-union,['QEQCAR,"#1",i],type,"#1"]]]
+ ['XLAM,["#1"],['PROG2,['LET,gg,"#1"],['QCDR,gg],
+ ['check_-union,['QEQCAR,gg,i],MACROEXPAND type,gg]]]
+ [cList,e]
+
+@
+\subsection{[[Record]], [[Mapping]], [[Enumeration]]}
+
+The remaining procedures follow the general style as described for the
+[[Union]] case above.
+
+<<mkMappingFunList>>=
+mkMappingFunList(nam,mapForm,e) ==
+ dc := GENSYM()
+ sigFunAlist:=
+ [['_=,[['Boolean],nam ,nam],['ELT,dc,6]],
+ ['coerce,[$Expression,nam],['ELT,dc,7]]]
+ [substitute(nam,dc,substitute("$",'Rep,sigFunAlist)),e]
+
+@
+<<mkRecordFunList>>=
+mkRecordFunList(nam,['Record,:Alist],e) ==
+ len:= #Alist
+-- for (.,a,.) in Alist do
+-- if getmode(a,e) then MOAN("Symbol: ",a,
+-- " must not be both a variable and literal")
+-- e:= put(a,"isLiteral","true",e)
+ dc := GENSYM()
+ sigFunAlist:=
+ --:((a,(A,nam),('XLAM,("$1","$2"),('RECORDELT,"$1",i,len)))
+ -- for i in 0..,(.,a,A) in Alist),
+ [['construct,[nam,:[A for [.,a,A] in Alist]],'mkRecord],
+ ['_=,[['Boolean],nam ,nam],['ELT,dc,6]],
+ ['coerce,[$Expression,nam],['ELT,dc,7]],:
+ [['elt,[A,nam,PNAME a],['XLAM,["$1","$2"],['RECORDELT,"$1",i,len]]]
+ for i in 0.. for [.,a,A] in Alist],:
+ [['setelt,[A,nam,PNAME a,A],['XLAM,["$1","$2","$3"],
+ ['SETRECORDELT,"$1",i, len,"$3"]]]
+ for i in 0.. for [.,a,A] in Alist],:
+ [['copy,[nam,nam],['XLAM,["$1"],['RECORDCOPY,
+ "$1",len]]]]]
+ [substitute(nam,dc,substitute("$",'Rep,sigFunAlist)),e]
+
+@
+<<mkEnumerationFunList>>=
+mkEnumerationFunList(nam,['Enumeration,:SL],e) ==
+ len:= #SL
+ dc := nam
+ cList :=
+ [nil,
+ ['_=,[['Boolean],nam ,nam],['ELT,dc,6]],
+ ['_^_=,[['Boolean],nam ,nam],['ELT,dc,7]],
+ ['coerce,[nam, ['Symbol]], ['ELT, dc, 8]],
+ ['coerce,[['OutputForm],nam],['ELT,dc, 9]]]
+ [substitute(nam, dc, cList),e]
+
+@
\section{License}
<<license>>=
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
@@ -42,7 +285,6 @@
-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-@
<<*>>=
<<license>>
@@ -267,114 +509,11 @@
cat.(0):= title
cat
---mkMappingFunList(nam,mapForm,e) == [[],e]
-mkMappingFunList(nam,mapForm,e) ==
- dc := GENSYM()
- sigFunAlist:=
- [['_=,[['Boolean],nam ,nam],['ELT,dc,6]],
- ['coerce,[$Expression,nam],['ELT,dc,7]]]
- [substitute(nam,dc,substitute("$",'Rep,sigFunAlist)),e]
-
-mkRecordFunList(nam,['Record,:Alist],e) ==
- len:= #Alist
-
--- for (.,a,.) in Alist do
--- if getmode(a,e) then MOAN("Symbol: ",a,
--- " must not be both a variable and literal")
--- e:= put(a,"isLiteral","true",e)
- dc := GENSYM()
- sigFunAlist:=
- --:((a,(A,nam),('XLAM,("$1","$2"),('RECORDELT,"$1",i,len)))
- -- for i in 0..,(.,a,A) in Alist),
-
- [['construct,[nam,:[A for [.,a,A] in Alist]],'mkRecord],
- ['_=,[['Boolean],nam ,nam],['ELT,dc,6]],
- ['coerce,[$Expression,nam],['ELT,dc,7]],:
- [['elt,[A,nam,PNAME a],['XLAM,["$1","$2"],['RECORDELT,"$1",i,len]]]
- for i in 0.. for [.,a,A] in Alist],:
- [['setelt,[A,nam,PNAME a,A],['XLAM,["$1","$2","$3"],
- ['SETRECORDELT,"$1",i, len,"$3"]]]
- for i in 0.. for [.,a,A] in Alist],:
- [['copy,[nam,nam],['XLAM,["$1"],['RECORDCOPY,
- "$1",len]]]]]
- [substitute(nam,dc,substitute("$",'Rep,sigFunAlist)),e]
-
-mkNewUnionFunList(name,form is ['Union,:listOfEntries],e) ==
- dc := name
- if name = 'Rep then name := '$
- --2. create coercions from subtypes to subUnion
- cList:=
- [['_=,[['Boolean],name ,name],['ELT,dc,6]],
- ['coerce,[$Expression,name],['ELT,dc,7]],:
- ("append"/
- [[['construct,[name,type],['XLAM,["#1"],['CONS,i,"#1"]]],
- ['elt,[type,name,tag],cdownFun],
- ['case,['(Boolean),name,tag],
- ['XLAM,["#1"],['QEQCAR,"#1",i]]]]
- for [.,tag,type] in listOfEntries for i in 0..])] where
- cdownFun() ==
- gg:=GENSYM()
- $InteractiveMode =>
- ['XLAM,["#1"],['PROG1,['QCDR,"#1"],
- ['check_-union,['QEQCAR,"#1",i],type,"#1"]]]
- ['XLAM,["#1"],['PROG2,['LET,gg,"#1"],['QCDR,gg],
- ['check_-union,['QEQCAR,gg,i],type,gg]]]
- [cList,e]
-
-mkEnumerationFunList(nam,['Enumeration,:SL],e) ==
- len:= #SL
- dc := nam
- cList :=
- [nil,
- ['_=,[['Boolean],nam ,nam],['ELT,dc,6]],
- ['_^_=,[['Boolean],nam ,nam],['ELT,dc,7]],
- ['coerce,[nam, ['Symbol]], ['ELT, dc, 8]],
- ['coerce,[['OutputForm],nam],['ELT,dc, 9]]]
- [substitute(nam, dc, cList),e]
-
-mkUnionFunList(op,form is ['Union,:listOfEntries],e) ==
- first listOfEntries is [":",.,.] => mkNewUnionFunList(op,form,e)
- -- following call to order is a bug, but needs massive recomp to fix
- listOfEntries:= orderUnionEntries listOfEntries
- --1. create representations of subtypes
- predList:= mkPredList listOfEntries
- g:=GENSYM()
- --2. create coercions from subtypes to subUnion
- cList:=
- [['_=,[['Boolean],g ,g],['ELT,op,6]],
- ['coerce,[$Expression,g],['ELT,op,7]],:
- ("append"/
- [[['autoCoerce,[g,t],upFun],
- ['coerce,[t,g],cdownFun],
- ['autoCoerce,[t,g],downFun], --this should be removed eventually
- ['case,['(Boolean),g,t],typeFun]]
- for p in predList for t in listOfEntries])] where
- upFun() ==
- p is ['EQCAR,x,n] => ['XLAM,["#1"],['CONS,n,"#1"]]
- ['XLAM,["#1"],"#1"]
- cdownFun() ==
- gg:=GENSYM()
- if p is ['EQCAR,x,n] then
- ref:=['QCDR,gg]
- q:= ['QEQCAR, gg, n]
- else
- ref:=gg
- q:= substitute(gg,"#1",p)
- ['XLAM,["#1"],['PROG2,['LET,gg,"#1"],ref,
- ['check_-union,q,t,gg]]]
- downFun() ==
- p is ['EQCAR,x,.] =>
- ['XLAM,["#1"],['QCDR,"#1"]]
- ['XLAM,["#1"],"#1"]
- typeFun() ==
- p is ['EQCAR,x,n] =>
- ['XLAM,["#1"],['QEQCAR,x,n]]
- ['XLAM,["#1"],p]
- op:=
- op='Rep => '$
- op
- cList:= substitute(op,g,cList)
- [cList,e]
+<<mkUnionFunList>>
+<<mkNewUnionFunList>>
+<<mkMappingFunList>>
+<<mkRecordFunList>>
+<<mkEnumerationFunList>>
@
\eject
_______________________________________________
Axiom-developer mailing list
Axiom-developer@nongnu.org
http://lists.nongnu.org/mailman/listinfo/axiom-developer
