aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog4
-rw-r--r--src/interp/define.boot180
2 files changed, 93 insertions, 91 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 3e7fd485..ce3d5424 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,7 @@
+2011-11-25 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/define.boot: Rearrange order of some definitions.
+
2011-11-24 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/define.boot ($suffix): Remove toplevel declaration.
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 22cb9d29..5a0f479d 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -777,6 +777,11 @@ checkRepresentation(db,addForm,body,env) ==
env
+getSignatureFromMode(form,e) ==
+ getXmode(opOf form,e) is ['Mapping,:signature] =>
+ #form~=#signature => stackAndThrow ["Wrong number of arguments: ",form]
+ applySubst(pairList($FormalMapVariableList,form.args),signature)
+
compDefine1: (%Form,%Mode,%Env) -> %Maybe %Triple
compDefine1(form,m,e) ==
$insideExpressionIfTrue: local:= false
@@ -1040,6 +1045,16 @@ buildConstructorCondition db ==
['%exist,ASSOCRIGHT subst,mkpf(applySubst(subst,cond),'AND)]
true
+getArgumentMode: (%Form,%Env) -> %Maybe %Mode
+getArgumentMode(x,e) ==
+ string? x => x
+ m := get(x,'mode,e) => m
+ nil
+
+getArgumentModeOrMoan: (%Form, %Form, %Env) -> %Mode
+getArgumentModeOrMoan(x,form,e) ==
+ getArgumentMode(x,e) or
+ stackSemanticError(["argument ",x," of ",form," is not declared"],nil)
compDefineCategory2(form,signature,body,m,e,$prefix,$formalArgList) ==
--1. bind global variables
@@ -1701,6 +1716,74 @@ assignCapsuleFunctionSlot(db,op,sig) ==
localOperation?(op,e) ==
not symbolMember?(op,$formalArgList) and getXmode(op,e) is ['Mapping,:.]
+++ Subroutine of hasSigInTargetCategory.
+candidateSignatures(op,nmodes,slot1) ==
+ [sig for [[=op,sig,:.],:.] in slot1 | #sig = nmodes]
+
+compareMode2Arg(x,m) == null x or modeEqual(x,m)
+
+++ Subroutine of compDefineCapsuleFunction.
+++ We are compiling a capsule function definition with head given by `form'.
+++ Determine whether the function with possibly partial signature `target'
+++ is exported. Return the complete signature if yes; otherwise
+++ return nil, with diagnostic in ambiguity case.
+hasSigInTargetCategory(argl,form,target,e) ==
+ sigs := candidateSignatures($op,#form,categoryExports $domainShell)
+ cc := checkCallingConvention(sigs,#argl)
+ mList:= [(cc.i > 0 => quasiquote x; getArgumentMode(x,e))
+ for x in argl for i in 0..]
+ --each element is a declared mode for the variable or nil if none exists
+ potentialSigList :=
+ removeDuplicates [sig for sig in sigs | fn(sig,target,mList)] where
+ fn(sig,target,mList) ==
+ (target = nil or target=sig.target) and
+ "and"/[compareMode2Arg(x,m) for x in mList for m in sig.source]
+ potentialSigList is [sig] => sig
+ potentialSigList = nil => nil
+ ambiguousSignatureError($op,potentialSigList)
+ first potentialSigList
+
+++ Subroutine of compDefineCapsuleFunction.
+checkAndDeclare(argl,form,sig,e) ==
+-- arguments with declared types must agree with those in sig;
+-- those that don't get declarations put into e
+ for a in argl for m in sig.source repeat
+ isQuasiquote m => nil -- we just built m from a.
+ m1:= getArgumentMode(a,e) =>
+ not modeEqual(m1,m) =>
+ stack:= [" ",:bright a,'"must have type ",m,
+ '" not ",m1,'"%l",:stack]
+ e:= put(a,'mode,m,e)
+ if stack then
+ sayBrightly ['" Parameters of ",:bright form.op,
+ '" are of wrong type:",'"%l",:stack]
+ e
+
+++ Subroutine of compDefineCapsuleFunction.
+addArgumentConditions($body,$functionName) ==
+ $argumentConditionList =>
+ --$body is only used in this function
+ fn $argumentConditionList where
+ fn clist ==
+ clist is [[n,untypedCondition,typedCondition],:.] =>
+ ['%when,[typedCondition,fn rest clist],
+ ['%otherwise,["argumentDataError",n,
+ MKQ untypedCondition,MKQ $functionName]]]
+ null clist => $body
+ systemErrorHere ["addArgumentConditions",clist]
+ $body
+
+++ Subroutine of compDefineCapsuleFunction.
+compArgumentConditions: %Env -> %Env
+compArgumentConditions e ==
+ $argumentConditionList:=
+ [f for [n,a,x] in $argumentConditionList] where
+ f() ==
+ y:= substitute(a,'_#1,x)
+ T := [.,.,e]:= compOrCroak(y,$Boolean,e)
+ [n,x,T.expr]
+ e
+
compDefineCapsuleFunction(db,df is ['DEF,form,signature,body],
m,$e,$prefix,$formalArgList) ==
e := $e
@@ -1751,20 +1834,20 @@ compDefineCapsuleFunction(db,df is ['DEF,form,signature,body],
profileRecord('arguments,x,t)
--4. introduce needed domains into extendedEnv
- for domain in signature' repeat e:= addDomain(domain,e)
+ for domain in signature' repeat
+ e := addDomain(domain,e)
--6. compile body in environment with extended environment
rettype := resolve(signature'.target,$returnMode)
localOrExported :=
- not symbolMember?($op,$formalArgList) and
- getXmode($op,e) is ['Mapping,:.] => 'local
+ localOperation?($op,e) => 'local
'exported
formattedSig := formatUnabbreviatedSig signature'
sayBrightly ['" compiling ",localOrExported,
:bright $op,'": ",:formattedSig]
- noteCapsuleFunctionDefinition($op,signature', makePredicate $predl)
+ noteCapsuleFunctionDefinition($op,signature',makePredicate $predl)
T := CATCH('compCapsuleBody, compOrCroak(body,rettype,e))
or [$ClearBodyToken,rettype,e]
assignCapsuleFunctionSlot(db,$op,signature')
@@ -1772,14 +1855,9 @@ compDefineCapsuleFunction(db,df is ['DEF,form,signature,body],
-- see stackSemanticError
-- Build a name for the implementation.
op' :=
- opexport := false
- opmodes :=
- [sel
- for [[DC,:sig],[.,sel]] in get($op,'modemap,e) |
- DC is '$ and (opexport := true) and
- (and/[modeEqual(x,y) for x in sig for y in signature])]
localOperation?($op,e) =>
- if opexport then
+ -- object if the operation is both local and exported.
+ if or/[mm.mmDC is '$ for mm in get($op,'modemap,e)] then
userError ['"%b",$op,'"%d",'" is local and exported"]
makeSymbol strconc(encodeItem $prefix,'";",encodeItem $op)
encodeFunctionName(db,$op,signature','";",$suffix)
@@ -1798,14 +1876,6 @@ compDefineCapsuleFunction(db,df is ['DEF,form,signature,body],
--7. give operator a 'value property
[fun,['Mapping,:signature'],$e]
-getSignatureFromMode(form,e) ==
- getXmode(opOf form,e) is ['Mapping,:signature] =>
- #form~=#signature => stackAndThrow ["Wrong number of arguments: ",form]
- applySubst(pairList($FormalMapVariableList,form.args),signature)
-
-candidateSignatures(op,nmodes,slot1) ==
- [sig for [[=op,sig,:.],:.] in slot1 | #sig = nmodes]
-
domainMember(dom,domList) ==
or/[modeEqual(dom,d) for d in domList]
@@ -1845,55 +1915,6 @@ addDomain(domain,e) ==
e --is not a functor
-++ We are compiling a capsule function definition with head given by `form'.
-++ Determine whether the function with possibly partial signature `opsig'
-++ is exported. Return the complete signature if yes; otherwise
-++ return nil, with diagnostic in ambiguity case.
-hasSigInTargetCategory(argl,form,opsig,e) ==
- sigs := candidateSignatures($op,#form,categoryExports $domainShell)
- cc := checkCallingConvention(sigs,#argl)
- mList:= [(cc.i > 0 => quasiquote x; getArgumentMode(x,e))
- for x in argl for i in 0..]
- --each element is a declared mode for the variable or nil if none exists
- potentialSigList:=
- removeDuplicates
- [sig for sig in sigs |
- fn(sig,opsig,mList)] where
- fn(sig,opsig,mList) ==
- (null opsig or opsig=sig.target) and
- (and/[compareMode2Arg(x,m) for x in mList for m in sig.source])
- potentialSigList is [sig] => sig
- potentialSigList = nil => nil
- ambiguousSignatureError($op,potentialSigList)
- first potentialSigList
-
-compareMode2Arg(x,m) == null x or modeEqual(x,m)
-
-getArgumentModeOrMoan: (%Form, %Form, %Env) -> %Mode
-getArgumentModeOrMoan(x,form,e) ==
- getArgumentMode(x,e) or
- stackSemanticError(["argument ",x," of ",form," is not declared"],nil)
-
-getArgumentMode: (%Form,%Env) -> %Mode
-getArgumentMode(x,e) ==
- string? x => x
- m:= get(x,'mode,e) => m
-
-checkAndDeclare(argl,form,sig,e) ==
--- arguments with declared types must agree with those in sig;
--- those that don't get declarations put into e
- for a in argl for m in sig.source repeat
- isQuasiquote m => nil -- we just built m from a.
- m1:= getArgumentMode(a,e) =>
- not modeEqual(m1,m) =>
- stack:= [" ",:bright a,'"must have type ",m,
- '" not ",m1,'"%l",:stack]
- e:= put(a,'mode,m,e)
- if stack then
- sayBrightly ['" Parameters of ",:bright form.op,
- '" are of wrong type:",'"%l",:stack]
- e
-
getSignature(op,argModeList,$e) ==
1=#
(sigl:=
@@ -1935,29 +1956,6 @@ stripOffSubdomainConditions(margl,argl) ==
marg
x
-compArgumentConditions: %Env -> %Env
-compArgumentConditions e ==
- $argumentConditionList:=
- [f for [n,a,x] in $argumentConditionList] where
- f() ==
- y:= substitute(a,'_#1,x)
- T := [.,.,e]:= compOrCroak(y,$Boolean,e)
- [n,x,T.expr]
- e
-
-addArgumentConditions($body,$functionName) ==
- $argumentConditionList =>
- --$body is only used in this function
- fn $argumentConditionList where
- fn clist ==
- clist is [[n,untypedCondition,typedCondition],:.] =>
- ['%when,[typedCondition,fn rest clist],
- ['%otherwise,["argumentDataError",n,
- MKQ untypedCondition,MKQ $functionName]]]
- null clist => $body
- systemErrorHere ["addArgumentConditions",clist]
- $body
-
putInLocalDomainReferences (def := [opName,[lam,varl,body]]) ==
NRTputInTail CDDADR def
def