aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2008-04-14 16:51:37 +0000
committerdos-reis <gdr@axiomatics.org>2008-04-14 16:51:37 +0000
commit144847152d5a5e764f66d42e3fed6f64c3da6c0c (patch)
treec691004b286e736b8017ea42db45e8a636011883 /src
parentd04a3262a6f4493bd65c45ff73b4d1b8243f47a0 (diff)
downloadopen-axiom-144847152d5a5e764f66d42e3fed6f64c3da6c0c.tar.gz
* boot/tokens.boot: Don't rename NOT.
* interp/define.boot: Add declarations. * interp/types.boot (%Signature): New.
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog6
-rw-r--r--src/boot/tokens.boot6
-rw-r--r--src/interp/define.boot95
-rw-r--r--src/interp/types.boot3
4 files changed, 72 insertions, 38 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 05f44c64..e9912577 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,9 @@
+2008-04-14 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * boot/tokens.boot: Don't rename NOT.
+ * interp/define.boot: Add declarations.
+ * interp/types.boot (%Signature): New.
+
2008-04-13 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/as.boot: Remove explicit use GETDATABASE.
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index e60da82e..4dbc50ac 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -254,8 +254,7 @@ for i in [ _
["mkpf", "MKPF"] , _
["nconc", "NCONC"] , _
["nil" ,NIL ] , _
- ["not", "NULL"] , _
- ["NOT", "NULL"] , _
+ ["not", "NOT"] , _
["nreverse", "NREVERSE"] , _
["null", "NULL"] , _
["or", "OR"] , _
@@ -316,8 +315,7 @@ for i in [ _
["mkpf", "MKPF"], _
["nconc", "NCONC"], _
["nil", "NIL"], _
- ["not", "NULL"], _
- ["NOT", "NULL"], _
+ ["not", "NOT"], _
["nreverse", "NREVERSE"], _
["null", "NULL"], _
["or", "OR"], _
diff --git a/src/interp/define.boot b/src/interp/define.boot
index a9f37559..07b81a4f 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -50,7 +50,8 @@ $suffix := nil
$NRTopt := false
--% FUNCTIONS WHICH MUNCH ON == STATEMENTS
-
+
+compDefine: (%Form,%Mode,%Env) -> %Maybe %Triple
compDefine(form,m,e) ==
$tripleHits: local:= 0
$macroIfTrue: local
@@ -63,6 +64,7 @@ compDefine(form,m,e) ==
++ per: Rep -> %
++ rep: % -> Rep
++ as local functions. Note that we do not declare them as macros.
+maybeInsertViewMorphisms: %Form -> %Form
maybeInsertViewMorphisms body ==
domainRep := nil
before := nil
@@ -97,7 +99,8 @@ maybeInsertViewMorphisms body ==
[:reverse before, ["LET","Rep",domainRep],
:[repMorphism,perMorphism],:after]
-
+
+compDefine1: (%Form,%Mode,%Env) -> %Maybe %Triple
compDefine1(form,m,e) ==
$insideExpressionIfTrue: local:= false
--1. decompose after macro-expanding form
@@ -137,7 +140,8 @@ compDefine1(form,m,e) ==
$prefix => INTERN STRCONC(encodeItem $prefix,'",",encodeItem $op)
getAbbreviation($op,#rest $form)
compDefineCapsuleFunction(form,m,e,newPrefix,$formalArgList)
-
+
+compDefineAddSignature: (%Form,%Signature,%Env) -> %Env
compDefineAddSignature([op,:argl],signature,e) ==
(sig:= hasFullSignature(argl,signature,e)) and
not assoc(['$,:sig],LASSOC('modemap,getProplist(op,e))) =>
@@ -152,10 +156,12 @@ hasFullSignature(argl,[target,:ml],e) ==
u:= [m or get(x,"mode",e) or return 'failed for x in argl for m in ml]
u^='failed => [target,:u]
+addEmptyCapsuleIfNecessary: (%Form,%Form) -> %Form
addEmptyCapsuleIfNecessary(target,rhs) ==
MEMQ(KAR rhs,$SpecialDomainNames) => rhs
['add,rhs,['CAPSULE]]
-
+
+getTargetFromRhs: (%Form, %Form, %Env) -> %Form
getTargetFromRhs(lhs,rhs,e) ==
--undeclared target mode obtained from rhs expression
rhs is ['CAPSULE,:.] =>
@@ -174,14 +180,17 @@ giveFormalParametersValues(argl,e) ==
for x in argl repeat
e:= put(x,'value,[genSomeVariable(),get(x,'mode,e),nil],e)
e
-
+
+
+macroExpandInPlace: (%Form,%Env) -> %Form
macroExpandInPlace(x,e) ==
y:= macroExpand(x,e)
atom x or atom y => y
RPLACA(x,first y)
RPLACD(x,rest y)
x
-
+
+macroExpand: (%Form,%Env) -> %Form
macroExpand(x,e) == --not worked out yet
atom x => (u:= get(x,'macro,e) => macroExpand(u,e); x)
x is ['DEF,lhs,sig,spCases,rhs] =>
@@ -347,8 +356,9 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
$lisplibAbbreviation := constructor? $op
form':=[op',:sargl]
augLisplibModemapsFromCategory(form',formalBody,signature')
- [fun,'(Category),e]
-
+ [fun,$Category,e]
+
+mkConstructor: %Form -> %Form
mkConstructor form ==
atom form => ['devaluate,form]
null rest form => ['QUOTE,[first form]]
@@ -360,6 +370,16 @@ compDefineCategory(df,m,e,prefix,fal) ==
not $insideFunctorIfTrue and $LISPLIB =>
compDefineLisplib(df,m,e,prefix,fal,'compDefineCategory1)
compDefineCategory1(df,m,e,prefix,fal)
+
+
+%CatObjRes -- result of compiling a category
+ <=> cons(%Shell,cons(%Mode,cons(%Env,null)))
+
+compMakeCategoryObject: (%Form,%Env) -> %Maybe %CatObjRes
+compMakeCategoryObject(c,$e) ==
+ not isCategoryForm(c,$e) => nil
+ u:= mkEvalableCategoryForm c => [eval u,$Category,$e]
+ nil
compDefineFunctor(df,m,e,prefix,fal) ==
$domainShell: local -- holds the category of the object being compiled
@@ -911,10 +931,12 @@ hasSigInTargetCategory(argl,form,opsig,e) ==
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) ==
STRINGP x => x
m:= get(x,'mode,e) => m
@@ -982,6 +1004,7 @@ stripOffSubdomainConditions(margl,argl) ==
marg
x
+compArgumentConditions: %Env -> %Env
compArgumentConditions e ==
$argumentConditionList:=
[f for [n,a,x] in $argumentConditionList] where
@@ -1162,6 +1185,7 @@ compileConstructor1 (form:=[fn,[key,vl,:bodyl]]) ==
clearConstructorCache fn --clear cache for constructor
first u
+constructMacro: %Form -> %Form
constructMacro (form is [nam,[lam,vl,body]]) ==
^(and/[atom x for x in vl]) =>
stackSemanticError(["illegal parameters for macro: ",vl],nil)
@@ -1174,7 +1198,8 @@ listInitialSegment(u,v) ==
--returns true iff u.i=v.i for i in 1..(#u)-1
modemap2Signature [[.,:sig],:.] == sig
-
+
+uncons: %Form -> %Form
uncons x ==
atom x => x
x is ["CONS",a,b] => [a,:uncons b]
@@ -1187,7 +1212,8 @@ bootStrapError(functorForm,sourceFile) ==
['VECTOR,mkDomainConstructor functorForm,nil,nil,nil,nil,nil]],
[''T, ['systemError,['LIST,''%b,MKQ CAR functorForm,''%d,'"from", _
''%b,MKQ namestring sourceFile,''%d,'"needs to be compiled"]]]]
-
+
+compAdd: (%Form, %Mode, %Env) -> %Maybe %Triple
compAdd(['add,$addForm,capsule],m,e) ==
$bootStrapMode = true =>
if $addForm is ['Tuple,:.] then code := nil
@@ -1220,7 +1246,8 @@ compAdd(['add,$addForm,capsule],m,e) ==
compCapsule(capsule,m,e)
compTuple2Record u == ['Record,:[[":",i,x] for i in 1.. for x in rest u]]
-
+
+compCapsule: (%Form, %Mode, %Env) -> %Maybe %Triple
compCapsule(['CAPSULE,:itemList],m,e) ==
$bootStrapMode = true =>
[bootStrapError($functorForm, _/EDITFILE),m,e]
@@ -1228,6 +1255,7 @@ compCapsule(['CAPSULE,:itemList],m,e) ==
$useRepresentationHack := true
compCapsuleInner(maybeInsertViewMorphisms itemList,m,addDomain('_$,e))
+compSubDomain: (%Form,%Mode,%Env) -> %Maybe %Triple
compSubDomain(["SubDomain",domainForm,predicate],m,e) ==
$addFormLhs: local:= domainForm
$addForm: local
@@ -1404,13 +1432,16 @@ doItIf(item is [.,p,x,y],$predl,$e) ==
-- compSingleCapsuleItem(x,predl,e)
--% CATEGORY AND DOMAIN FUNCTIONS
+
+compContained: (%Form, %Mode, %Env) -> %Maybe %Triple
compContained(["CONTAINED",a,b],m,e) ==
[a,ma,e]:= comp(a,$EmptyMode,e) or return nil
[b,mb,e]:= comp(b,$EmptyMode,e) or return nil
isCategoryForm(ma,e) and isCategoryForm(mb,e) =>
(T:= [["CONTAINED",a,b],$Boolean,e]; convert(T,m))
nil
-
+
+compJoin: (%Form,%Mode,%Env) -> %Maybe %Triple
compJoin(["Join",:argl],m,e) ==
catList:= [(compForMode(x,$Category,e) or return 'failed).expr for x in argl]
catList='failed => stackSemanticError(["cannot form Join of: ",argl],nil)
@@ -1435,26 +1466,27 @@ compJoin(["Join",:argl],m,e) ==
x
T:= [wrapDomainSub(parameters,["Join",:catList']),$Category,e]
convert(T,m)
-
+
+compForMode: (%Form,%Mode,%Env) -> %Maybe %Triple
compForMode(x,m,e) ==
$compForModeIfTrue: local:= true
comp(x,m,e)
+
-compMakeCategoryObject(c,$e) ==
- not isCategoryForm(c,$e) => nil
- u:= mkEvalableCategoryForm c => [eval u,$Category,$e]
- nil
-
-quotifyCategoryArgument x == MKQ x
-
+quotifyCategoryArgument: %Form -> %Form
+quotifyCategoryArgument x ==
+ MKQ x
+
makeCategoryForm(c,e) ==
not isCategoryForm(c,e) => nil
[x,m,e]:= compOrCroak(c,$EmptyMode,e)
[x,e]
-
+
+
+compCategory: (%Form,%Mode,%Env) -> %Maybe %Triple
compCategory(x,m,e) ==
$TOP__LEVEL: local:= true
- (m:= resolve(m,["Category"]))=["Category"] and x is ['CATEGORY,
+ (m:= resolve(m,$Category))=$Category and x is ['CATEGORY,
domainOrPackage,:l] =>
$sigList: local
$atList: local
@@ -1478,13 +1510,16 @@ mkExplicitCategoryFunction(domainOrPackage,sigList,atList) ==
[[x for x in sig | IDENTP x and x^='_$]
for ["QUOTE",[[.,sig,:.],:.]] in sigList])
wrapDomainSub(parameters,body)
-
+
+wrapDomainSub: (%List, %Form) -> %Form
wrapDomainSub(parameters,x) ==
["DomainSubstitutionMacro",parameters,x]
mustInstantiate D ==
- D is [fn,:.] and ^(MEMQ(fn,$DummyFunctorNames) or GETL(fn,"makeFunctionList"))
-
+ D is [fn,:.] and not (MEMQ(fn,$DummyFunctorNames)
+ or GETL(fn,"makeFunctionList"))
+
+DomainSubstitutionFunction: (%List,%Form) -> %Form
DomainSubstitutionFunction(parameters,body) ==
--see definition of DomainSubstitutionMacro in SPAD LISP
if parameters then
@@ -1551,11 +1586,3 @@ compCategoryItem(x,predl) ==
--4. branch on a single type or a signature %with source and target
PUSH(MKQ [rest x,pred],$sigList)
-
-
-
-
-
-
-
-
diff --git a/src/interp/types.boot b/src/interp/types.boot
index 2f680568..a52a5c25 100644
--- a/src/interp/types.boot
+++ b/src/interp/types.boot
@@ -59,6 +59,9 @@ import '"boot-pkg"
%Triple <=> -- form + type + env
cons(%Code,cons(%Mode,cons(%Env,null)))
+%Signature -- signature
+ <=> cons
+
%Modemap <=> %List -- modemap
%ConstructorKind <=> -- kind of ctor instances