From 687bef6eb89db2a2d84ddc96bf9fb8efdf1546d7 Mon Sep 17 00:00:00 2001
From: Gabriel Dos Reis <gdr@axiomatics.org>
Date: Sun, 27 Dec 2015 08:56:15 -0800
Subject: Write out a functor's operation table separately in generated code
 stream.

---
 src/ChangeLog           | 8 ++++++++
 src/interp/daase.lisp   | 6 +++++-
 src/interp/define.boot  | 5 +++--
 src/interp/lisplib.boot | 5 +++++
 4 files changed, 21 insertions(+), 3 deletions(-)

(limited to 'src')

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
-- 
cgit v1.2.3