diff options
author | Gabriel Dos Reis <gdr@axiomatics.org> | 2015-12-27 08:56:15 -0800 |
---|---|---|
committer | Gabriel Dos Reis <gdr@axiomatics.org> | 2015-12-27 08:56:15 -0800 |
commit | 687bef6eb89db2a2d84ddc96bf9fb8efdf1546d7 (patch) | |
tree | 35b32cf9795bef3fe984ab3ffa4f41cbb9573711 | |
parent | ba8d29ccd1dd272f5883fe3d042b1bc38f1ce688 (diff) | |
download | open-axiom-687bef6eb89db2a2d84ddc96bf9fb8efdf1546d7.tar.gz |
Write out a functor's operation table separately in generated code stream.
-rw-r--r-- | src/ChangeLog | 8 | ||||
-rw-r--r-- | src/interp/daase.lisp | 6 | ||||
-rw-r--r-- | src/interp/define.boot | 5 | ||||
-rw-r--r-- | src/interp/lisplib.boot | 5 |
4 files changed, 21 insertions, 3 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 08edbd6d..35d1e555 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,11 @@ +2015-12-27 Gabriel Dos Reis <gdr@axiomatics.org> + + * interp/daase.lisp (DATABASE): Add new field 'optable'. + (dbOperationTable): New accessor macro. + * interp/define.boot (makeCompactDirect): Tidy. Set dbOperationTable. + * interp/lisplib.boot (writeOperationTable): New. + (finalizeLisplib): Call it. + 2015-12-26 Gabriel Dos Reis <gdr@axiomatics.org> * interp/nruncomp.boot (buildFunctor): Remove use of diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp index df27ff72..995ad0ec 100644 --- a/src/interp/daase.lisp +++ b/src/interp/daase.lisp @@ -1,6 +1,6 @@ ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. ;; All rights reserved. -;; Copyright (C) 2007-2013, Gabriel Dos Reis. +;; Copyright (C) 2007-2015, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -223,6 +223,7 @@ ; for a functor, this is the template. lookup-function ; for a functor, lookup function. For category ; constructor, default package constructor. + optable ; for a functor, operation table. ) ; database structure (deftype |%Database| nil 'database) @@ -299,6 +300,9 @@ (defmacro |dbTemplate| (db) `(database-template ,db)) +(defmacro |dbOperationTable| (db) + `(database-optable ,db)) + (defmacro |dbLookupFunction| (db) `(database-lookup-function ,db)) diff --git a/src/interp/define.boot b/src/interp/define.boot index c3813fda..b33f9f20 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -407,9 +407,10 @@ makeCompactDirect(db,u) == $byteVecAcc: local := nil [nam,[addForm,:opList]] := u --pp opList - d := [[op,y] for [op,:items] in opList | y := makeCompactDirect1(db,op,items)] + d := [:[op,y] for [op,:items] in opList + | y := makeCompactDirect1(db,op,items)] dbByteList(db) := [:dbByteList db,:"append"/reverse! $byteVecAcc] - vector("append"/d) + dbOperationTable(db) := vector d makeCompactDirect1(db,op,items) == --NOTES: creates byte codes for ops implemented by the domain diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index c0b341bc..807f752f 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -473,6 +473,10 @@ writeTemplate db == dbConstructorKind db = 'category => nil writeLoadInfo(db,dbTemplate db,'template,'dbTemplate) +writeOperationTable db == + dbConstructorKind db = 'category => nil + writeLoadInfo(db,dbOperationTable db,'optable,'dbOperationTable) + writeLookupFunction db == fun := dbLookupFunction db => writeLoadInfo(db,quote fun,'lookupFunction,'dbLookupFunction) @@ -569,6 +573,7 @@ finalizeLisplib(db,libName) == $NRTslot1PredicateList : local := [] genInitialAttributeAlist(db,rest opsAndAtts) writeSuperDomain db + writeOperationTable db writeCapsuleLevelDefinitions db writeAttributes db writePredicates db |