diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 4 | ||||
| -rw-r--r-- | src/interp/define.boot | 180 |
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 |