diff options
| -rw-r--r-- | src/ChangeLog | 5 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 5 | ||||
| -rw-r--r-- | src/interp/daase.lisp | 1 | ||||
| -rw-r--r-- | src/interp/define.boot | 21 |
4 files changed, 22 insertions, 10 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 14cc692a..015e78ed 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,10 @@ 2013-05-27 Gabriel Dos Reis <gdr@integrable-solutions.net> + * interp/define.boot (compDefine): Take DB as first parameter. + Adjust callers. + +2013-05-27 Gabriel Dos Reis <gdr@integrable-solutions.net> + * interp/sys-utility.boot ($ERASE): Remove. 2013-05-27 Gabriel Dos Reis <gdr@integrable-solutions.net> diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 43ac6566..1bb651c2 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -168,6 +168,9 @@ comp2(x,m,e) == comp3(x,m,$e) == --returns a Triple or %else nil to signalcan't do' + db := + ctor := currentConstructor $e => constructorDB ctor + nil $e:= addDomain(m,$e) e:= $e --for debugging purposes m is ["Mapping",:.] => compWithMappingMode(x,m,e) @@ -183,6 +186,7 @@ comp3(x,m,$e) == and (T := applyMapping(x,m,e,ml)) => T op is ":" => compColon(x,m,e) op is "::" => compCoerce(x,m,e) + op is 'DEF => compDefine(db,x,m,e) t:= compExpression(x,m,e) t is [x',m',e'] and not listMember?(m',getDomainsInScope e') => [x',m',addDomain(m',e')] @@ -2832,7 +2836,6 @@ for x in [["|", :"compSuchthat"],_ ["COLLECT", :"compRepeatOrCollect"],_ ["CONS", :"compCons"],_ ["construct", :"compConstruct"],_ - ["DEF", :"compDefine"],_ ["elt", :"compElt"],_ ["Enumeration", :"compBuiltinDomain"],_ ["EnumerationCategory", :"compEnumCat"],_ diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp index 80e57d56..64541852 100644 --- a/src/interp/daase.lisp +++ b/src/interp/daase.lisp @@ -234,6 +234,7 @@ lookup-function ; for a functor, lookup function. ) ; database structure +(deftype |%Database| nil 'database) (defmacro |dbAbbreviation| (db) `(database-abbreviation ,db)) diff --git a/src/interp/define.boot b/src/interp/define.boot index dd496c09..a8983cf4 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -39,7 +39,7 @@ import database namespace BOOT module define where - compDefine: (%Form,%Mode,%Env) -> %Maybe %Triple + compDefine: (%Maybe %Database,%Form,%Mode,%Env) -> %Maybe %Triple compSubDomain: (%Form,%Mode,%Env) -> %Maybe %Triple compCapsule: (%Form, %Mode, %Env) -> %Maybe %Triple compJoin: (%Form,%Mode,%Env) -> %Maybe %Triple @@ -50,6 +50,8 @@ module define where --% +compDefine1: (%Maybe %Database,%Form,%Mode,%Env) -> %Maybe %Triple + $doNotCompileJustPrint := false ++ stack of pending capsule function definitions. @@ -748,9 +750,9 @@ checkParameterNames parms == for p in parms repeat checkVariableName p -compDefine(form,m,e) == +compDefine(db,form,m,e) == $macroIfTrue: local := false - compDefine1(form,m,e) + compDefine1(db,form,m,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 @@ -829,8 +831,7 @@ getSignatureFromMode(form,e) == #form~=#signature => stackAndThrow ["Wrong number of arguments: ",form] applySubst(pairList($FormalMapVariableList,form.args),signature) -compDefine1: (%Form,%Mode,%Env) -> %Maybe %Triple -compDefine1(form,m,e) == +compDefine1(db,form,m,e) == $insideExpressionIfTrue: local:= false --1. decompose after macro-expanding form ['DEF,lhs,signature,rhs] := form := macroExpand(form,e) @@ -841,7 +842,7 @@ compDefine1(form,m,e) == null signature.target and symbol? KAR rhs and not builtinConstructor? KAR rhs and (sig := getSignatureFromMode(lhs,e)) => -- here signature of lhs is determined by a previous declaration - compDefine1(['DEF,lhs,[sig.target,:signature.source],rhs],m,e) + compDefine1(db,['DEF,lhs,[sig.target,:signature.source],rhs],m,e) if signature.target=$Category then $insideCategoryIfTrue:= true -- RDJ (11/83): when argument and return types are all declared, @@ -864,8 +865,9 @@ compDefine1(form,m,e) == signature := [getTargetFromRhs(lhs,rhs,e),:signature.source] rhs := addEmptyCapsuleIfNecessary(signature.target,rhs) compDefineFunctor(['DEF,lhs,signature,rhs],m,e,$formalArgList) - $form = nil => stackAndThrow ['"bad == form ",form] - db := constructorDB $op + db = nil => + -- no free function in library, yet. + stackAndThrow ['"malformed definition syntax:",form] newPrefix := $prefix => makeSymbol strconc(symbolName $prefix,'",",symbolName $op) dbAbbreviation db @@ -990,7 +992,8 @@ compDefineCategory1(df is ['DEF,form,sig,body],m,e,fal) == $insideCategoryPackageIfTrue: local := true $categoryPredicateList: local := makeCategoryPredicates(form,dbCategory constructorDB form.op) - T := compDefine1(mkCategoryPackage(form,cat,categoryCapsule),$EmptyMode,e) + defaults := mkCategoryPackage(form,cat,categoryCapsule) + T := compDefine1(nil,defaults,$EmptyMode,e) or return stackSemanticError( ['"cannot compile defaults of",:bright opOf form],nil) [d,m,e] |