diff options
Diffstat (limited to 'src/interp')
-rw-r--r-- | src/interp/Makefile.in | 11 | ||||
-rw-r--r-- | src/interp/br-data.boot | 5 | ||||
-rw-r--r-- | src/interp/c-util.boot | 14 | ||||
-rw-r--r-- | src/interp/daase.lisp | 10 | ||||
-rw-r--r-- | src/interp/define.boot | 6 | ||||
-rw-r--r-- | src/interp/g-util.boot | 7 | ||||
-rw-r--r-- | src/interp/property.lisp | 8 |
7 files changed, 27 insertions, 34 deletions
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index 1731f897..06a885c8 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -300,7 +300,7 @@ compiler.$(FASLEXT): msgdb.$(FASLEXT) pathname.$(FASLEXT) define.$(FASLEXT) nrunfast.$(FASLEXT): c-util.$(FASLEXT) nruncomp.$(FASLEXT): profile.$(FASLEXT) simpbool.$(FASLEXT) functor.$(FASLEXT) define.$(FASLEXT): g-error.$(FASLEXT) nruncomp.$(FASLEXT) database.$(FASLEXT) -database.$(FASLEXT): clam.$(FASLEXT) nlib.$(FASLEXT) daase.$(FASLEXT) \ +database.$(FASLEXT): clam.$(FASLEXT) nlib.$(FASLEXT) \ cattable.$(FASLEXT) compat.$(FASLEXT) g-cndata.$(FASLEXT) \ c-util.$(FASLEXT) functor.$(FASLEXT): category.$(FASLEXT) lisplib.$(FASLEXT) nrunfast.$(FASLEXT) @@ -309,9 +309,8 @@ cattable.$(FASLEXT): simpbool.$(FASLEXT) c-util.$(FASLEXT) compat.$(FASLEXT): pathname.$(FASLEXT) simpbool.$(FASLEXT): macros.$(FASLEXT) newfort.$(FASLEXT): macros.$(FASLEXT) -lisplib.$(FASLEXT): nlib.$(FASLEXT) c-util.$(FASLEXT) debug.$(FASLEXT) \ - daase.$(FASLEXT) -c-doc.$(FASLEXT): c-util.$(FASLEXT) daase.$(FASLEXT) +lisplib.$(FASLEXT): nlib.$(FASLEXT) c-util.$(FASLEXT) debug.$(FASLEXT) +c-doc.$(FASLEXT): c-util.$(FASLEXT) server.$(FASLEXT): macros.$(FASLEXT) ## @@ -360,7 +359,7 @@ bits.$(FASLEXT): boot-pkg.$(FASLEXT) dq.$(FASLEXT): types.$(FASLEXT) ## General support and utilities. -daase.$(FASLEXT): macros.$(FASLEXT) +daase.$(FASLEXT): sys-utility.$(FASLEXT) spaderror.$(FASLEXT): macros.$(FASLEXT) debug.$(FASLEXT): macros.$(FASLEXT) parsing.$(FASLEXT) spad.$(FASLEXT): bootlex.$(FASLEXT) postpar.$(FASLEXT) debug.$(FASLEXT) @@ -380,7 +379,7 @@ msgdb.$(FASLEXT): g-util.$(FASLEXT) g-error.$(FASLEXT): diagnostics.$(FASLEXT) g-util.$(FASLEXT) c-util.$(FASLEXT): g-opt.$(FASLEXT) pathname.$(FASLEXT): nlib.$(FASLEXT) -g-util.$(FASLEXT): ggreater.$(FASLEXT) macros.$(FASLEXT) sys-utility.$(FASLEXT) +g-util.$(FASLEXT): ggreater.$(FASLEXT) macros.$(FASLEXT) daase.$(FASLEXT) g-cndata.$(FASLEXT): sys-macros.$(FASLEXT) c-util.$(FASLEXT) msg.$(FASLEXT): sys-macros.$(FASLEXT) astr.$(FASLEXT) util.$(FASLEXT): parsing.$(FASLEXT) diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index e8b1ba7b..7de0092d 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -493,15 +493,14 @@ getImports conname == --called by mkUsersHashTable --============================================================================ -- Get Hierarchical Information --============================================================================ -getParentsFor(cname,formalParams,constructorCategory) == +getParentsFor(db,formalParams,constructorCategory) == --called by compDefineFunctor1 acc := nil formals := TAKE(#formalParams,$TriangleVariableList) - constructorForm := getConstructorFormFromDB cname + constructorForm := dbConstructorForm db for x in folks constructorCategory repeat x := applySubst(pairList(formals,formalParams),x) x := applySubst(pairList(formalParams,IFCDR constructorForm),x) - x := substitute('Type,'Object,x) acc := [:explodeIfs x,:acc] reverse! acc diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index ecc72c79..ad681ddc 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -1027,13 +1027,13 @@ extendsCategoryForm(domain,form,form') == domain = "$" and form = $definition => extendsCategoryForm(domain, $currentCategoryBody, form') isCategoryForm(form,$EmptyEnvironment) => - -- If we have an existing definition for this category, use it. - (db := constructorDB form.op) and loadDB db => - form' is ['SIGNATURE,op,types,:.] => assoc([op,args],dbOperations db) - form' is ['ATTRIBUTE,a] => assoc(a,dbAttributes db) - subst := pairList(dbConstructorForm(db).args,form.args) - or/[extendsCategoryForm(domain,applySubst(subst,cat),form') - for [cat,:.] in dbAncestors db] + -- -- If we have an existing definition for this category, use it. + -- (db := constructorDB form.op) and loadDB db => + -- form' is ['SIGNATURE,op,types,:.] => assoc([op,args],dbOperations db) + -- form' is ['ATTRIBUTE,a] => assoc(a,dbAttributes db) + -- subst := pairList(dbConstructorForm(db).args,form.args) + -- or/[extendsCategoryForm(domain,applySubst(subst,cat),form') + -- for [cat,:.] in dbAncestors db] -- Otherwise constructs the associated domain shell formVec:=(compMakeCategoryObject(form,$e)).expr --Must be $e to pick up locally bound domains diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp index f4fad844..1a713b05 100644 --- a/src/interp/daase.lisp +++ b/src/interp/daase.lisp @@ -200,7 +200,7 @@ ; -- tim daly -(import-module "macros") +(import-module "sys-utility") (in-package "AxiomCore") (in-package "BOOT") @@ -635,8 +635,7 @@ (dolist (item constructors) (setq item (unsqueeze item)) (setq *allconstructors* (adjoin (first item) *allconstructors*)) - (setq dbstruct (make-database)) - (setf (|constructorDB| (car item)) dbstruct) + (setq dbstruct (|makeDB| (first item))) (setf (|dbOperations| dbstruct) (second item)) (setf (|dbConstructorModemap| dbstruct) (third item)) (setf (|dbModemaps| dbstruct) (fourth item)) @@ -698,7 +697,7 @@ (format t "that is not in the interp.daase file. we cannot~%") (format t "get the database structure for this constructor and~%") (warn "will create a new one~%") - (setf (|constructorDB| (car item)) (setq dbstruct (make-database))) + (setq dbstruct (|makeDB| (first item))) (setq *allconstructors* (adjoin item *allconstructors*))) (setf (database-sourcefile dbstruct) (second item)) (setf (|dbConstructorForm| dbstruct) (third item)) @@ -1093,9 +1092,8 @@ (setq constructorform (read in)) (setq key (car constructorform)) (setq oldmaps (|getOperationModemapsFromDB| key)) - (setq dbstruct (make-database)) + (setq dbstruct (|makeDB| key)) (setq *allconstructors* (adjoin key *allconstructors*)) - (setf (|constructorDB| key) dbstruct) ; store the struct, side-effect it... (setf (|dbConstructorForm| dbstruct) constructorform) (setq *allOperations* nil) ; force this to recompute (setf (|dbModule| dbstruct) object) diff --git a/src/interp/define.boot b/src/interp/define.boot index 5331907c..f5517e3e 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -819,7 +819,7 @@ compDefine1(form,m,e) == null $form => stackAndThrow ['"bad == form ",form] newPrefix:= $prefix => makeSymbol strconc(encodeItem $prefix,'",",encodeItem $op) - getConstructorAbbreviationFromDB $op + dbAbbreviation constructorDB $op compDefineCapsuleFunction(form,m,e,newPrefix,$formalArgList) compDefineAddSignature([op,:argl],signature,e) == @@ -1057,7 +1057,7 @@ compDefineCategory2(form,signature,specialCases,body,m,e, $lisplibCategory:= formalBody if $LISPLIB then $lisplibParents := - getParentsFor($op,$FormalMapVariableList,$lisplibCategory) + getParentsFor(db,$FormalMapVariableList,$lisplibCategory) $lisplibAncestors := computeAncestorsOf($form,nil) form':=[op',:sargl] augLisplibModemapsFromCategory(form',formalBody,signature') @@ -1424,7 +1424,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body], if $LISPLIB then $lisplibCategory := modemap.mmTarget $lisplibParents := - getParentsFor($op,$FormalMapVariableList,$lisplibCategory) + getParentsFor(db,$FormalMapVariableList,$lisplibCategory) $lisplibAncestors := computeAncestorsOf($form,nil) $insideFunctorIfTrue:= false if $LISPLIB then diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index ec3afc21..c1e8e281 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -34,7 +34,7 @@ import ggreater import macros -import sys_-utility +import daase namespace BOOT module g_-util where @@ -119,7 +119,10 @@ superType: %Mode -> %Maybe %Mode superType dom == dom = "$" => superType $functorForm dom isnt [ctor,:args] => nil - [super,.] := getSuperDomainFromDB ctor or return nil + [super,.] := + (db := constructorDB ctor) and dbBeingDefined? db => + dbSuperDomain db or return nil + getSuperDomainFromDB ctor or return nil sublisFormal(args,super,$AtVariables) ++ If the domain designated by the domain form `dom' is a subdomain, diff --git a/src/interp/property.lisp b/src/interp/property.lisp index e0330995..de9719a4 100644 --- a/src/interp/property.lisp +++ b/src/interp/property.lisp @@ -1,6 +1,6 @@ ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. -;; Copyright (C) 2007-2010, Gabriel Dos Reis. +;; Copyright (C) 2007-2011, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -122,10 +122,4 @@ ;; following was in INIT LISP -(FLAG '(|Union| |Record| |Enumration| |Mapping| |Enumeration|) 'FUNCTOR) - (FLAG '(* + AND OR PROGN) 'NARY) - -(MAKEPROP 'INTEGER 'ISFUNCTION 'INTEGERP) -(MAKEPROP '|Integer| '|isFunction| '|IsInteger|) -(MAKEPROP '|Boolean| '|isFunction| '|isBoolean|) |