aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog5
-rw-r--r--src/interp/compiler.boot5
-rw-r--r--src/interp/daase.lisp1
-rw-r--r--src/interp/define.boot21
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]