[OpenJade] defining primitives in scheme

[Matthias Clasen <clasen@xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx>]

OK, you voted for seeing the Jade-technical discussions, now
get it :-) 

Here is an experimental patch (against stock jade-1.2.1) for 
supporting scheme primitives in Jade. This is not completely 
trivial, since the standard demands that any primitives can be 
redefined in stylesheets. But this must not influence their 
behaviour when used to implement primitives in scheme. 

The patch below achieves this by making Identifiers potentially
have two values, a builtin one and a redefined one. If the
value of a scheme primitive is computed, the builtin definition
is used, even if it has been overriden by a redefinition for 
normal uses. 

This is definitively not production quality (see FIXME's in the 
code), but it seems to work for me on simple examples. If you want 
to try it, put a file "derived.dsl" containing dsssl definitions 
to be preloaded into the current directory.


A simple test:

-------- derived.dsl --------------

(define cde car)
(define abc cde)

-------- test.sgml -----------------

<!doctype foo [ <!element foo  - o any> ]> <foo>

-------- test.dsssl ------------------

<!DOCTYPE style-sheet PUBLIC "-//James Clark//DTD DSSSL Style Sheet//EN" []>

<style-sheet>

(define cde cdr)
(define car cdr)

(element foo (make sequence 
               (literal (abc (cons "a" "b")))   ;; expected output: "a"
               (literal (cde (cons "a" "b")))   ;; expected output: "b"
             ))

</style-sheet>

----------------------------------------



--- Interpreter.h.orig	Tue Jun 15 20:14:12 1999
+++ Interpreter.h	Tue Jun 15 20:20:25 1999
@@ -194,6 +194,9 @@
   ConstPtr<InheritedC> inheritedC_;
   unsigned inheritedCPart_;
   Location inheritedCLoc_;
+  void maybeSaveBuiltin();
+  Identifier *builtin_;
+  static int preferBuiltin_;
 };
 
 class Unit : public Named {
@@ -365,6 +368,7 @@
   void installPortNames();
   void installCValueSymbols();
   void installPrimitives();
+  void installDerived();
   void installPrimitive(const char *s, PrimitiveObj *value);
   void installXPrimitive(const char *s, PrimitiveObj *value);
   void installUnits();
--- Interpreter.cxx.orig	Tue Jun 15 20:14:23 1999
+++ Interpreter.cxx	Tue Jun 15 20:25:51 1999
@@ -100,6 +100,8 @@
   for (size_t i = 0; i < SIZEOF(lexCategories); i++)
     for (const char *s = lexCategories[i]; *s; s++)
       lexCategory_.setChar(*s, i);
+  // can't do this before installing lexical categories
+  installDerived();
   initialProcessingMode_.setDefined();
 }
 
@@ -413,6 +415,36 @@
   }
 }
 
+void Interpreter::installDerived()
+{
+  StringC str;
+  int c;
+  // FIXME: this is not the proper way to turn a filename
+  // into an InputSource. The name should be configurable
+  // and maybe overridable by an envvar or catalog entry. 
+  FILE *f = fopen("derived.dsl", "r");
+  if (f == NULL)
+    return;
+
+  while ((c = getc(f)) != EOF)
+    str += c;
+
+  fclose(f);
+
+  Text text_;
+  text_.clear();
+  text_.addChars(str, Location());
+  TextInputSourceOrigin *origin = new TextInputSourceOrigin(text_);
+
+  Owner<InputSource> in;
+  in = new InternalInputSource(origin->text().string(), origin);
+
+  SchemeParser scm(*this, in);
+  partIndex_ = unsigned(-1);
+  scm.parse();
+  partIndex_ = 1;
+}
+
 bool Interpreter::sdataMap(GroveString name, GroveString, GroveChar &c) const
 {
   StringC tem(name.data(), name.size());
@@ -1542,15 +1574,30 @@
   return h;
 }
 
+int Identifier::preferBuiltin_ = 0;
+
 Identifier::Identifier(const StringC &name)
-: Named(name), value_(0), syntacticKey_(notKey), beingComputed_(0), flowObj_(0)
+: Named(name), value_(0), syntacticKey_(notKey), beingComputed_(0), 
+  flowObj_(0), builtin_(0), defPart_(0) 
 {
 }
 
+void Identifier::maybeSaveBuiltin()
+{
+  if (defPart_ == unsigned(-1) && !builtin_) {
+    builtin_ = new Identifier(name());
+    if (value_)
+      builtin_->setValue(value_, defPart_);
+    else
+      builtin_->setDefinition(def_, defPart_, defLoc_);
+  }
+}
+
 void Identifier::setDefinition(Owner<Expression> &expr,
 			       unsigned part,
 			       const Location &loc)
 {
+  maybeSaveBuiltin();
   def_.swap(expr);
   defPart_ = part;
   defLoc_ = loc;
@@ -1559,6 +1606,7 @@
 
 void Identifier::setValue(ELObj *value, unsigned partIndex)
 {
+  maybeSaveBuiltin();
   value_ = value;
   // Built in functions have lowest priority.
   defPart_ = partIndex;
@@ -1575,8 +1623,12 @@
 
 ELObj *Identifier::computeValue(bool force, Interpreter &interp) const
 {
+  if (builtin_ && preferBuiltin_)
+    return builtin_->computeValue(force, interp);
   if (value_)
     return value_;
+  if (defPart_ == unsigned(-1))
+    preferBuiltin_++;
   ASSERT(def_);
   if (beingComputed_) {
     if (force) {
@@ -1600,6 +1652,8 @@
     }
     ((Identifier *)this)->beingComputed_ = 0;
   }
+  if (defPart_ == unsigned(-1))
+    preferBuiltin_--;
   return value_;
 }
 


-- 
Matthias Clasen, 
Tel. 0761/203-5606
Email: clasen@xxxxxxxxxxxxxxxxxxxxxxxxxx
Mathematisches Institut, Albert-Ludwigs-Universitaet Freiburg


 DSSSList info and archive:  http://www.mulberrytech.com/dsssl/dssslist