[PATCH] Deferred variable bindings, part 3/3

This finishes the implementation of deferred variable bindings, allowing
code like this:

Eval [
     PackageLoader fileInPackage: 'Iconv'.
     I18N.EncodedStream blahblah
]

which previously was not allowed, because I18N was not declared at the
beginning of the eval.

It is probably now time to say that implicit temporaries cost a lot in
terms of performance, and this only got worse with deferred variable
bindings:

Eval [ Time millisecondsToRun: [ 1000000 timesRepeat: [ x := 5 ]]]
918

However, you can recover performance by using a temporary inside an Eval:

Eval [ | x | Time millisecondsToRun: [ 1000000 timesRepeat: [ x := 5 ]]]
116

Using a temporary in the inner block:
Eval [ Time millisecondsToRun: [ | x | 1000000 timesRepeat: [ x := 5 ]]]
104

Using a temporary that disables compiler optimization of #timesRepeat:
Eval [ Time millisecondsToRun: [ 1000000 timesRepeat: [ | x | x := 5 ]]]
314


Note that temporaries outside Evals are ignored; otherwise the nice
behavior of temporaries persisting through different invocations would
not be possible.

Paolo

2007-08-24  Paolo Bonzini  <[hidden email]>

        * kernel/DeferBinding.st: Add path variable and #resolvePathFrom: method.

        * libgst/comp.c: Create deferred variable bindings with a path.  
        Adjust calls to _gst_find_variable_binding.
        * libgst/dict.c: Add path variable to DeferredVariableBinding.
        * libgst/dict.h: Add path variable to struct
        gst_deferred_variable_binding.
        * libgst/sym.h: Remove last parameter from
        _gst_find_variable_binding.
        * libgst/sym.c: Assume last parameter of _gst_find_variable_binding
        to be true.  Adjust call to _gst_make_deferred_binding_constant.
        * libgst/tree.h: Adjust last parameter of
        _gst_make_deferred_binding_constant.
        * libgst/tree.c: Turn last parameter of _gst_find_variable_binding
        into a tree.  Support new constant types in _gst_print_tree.

* looking for [hidden email]--2004b/smalltalk--devo--2.2--patch-534 to compare with
* comparing to [hidden email]--2004b/smalltalk--devo--2.2--patch-534
M  kernel/DeferBinding.st
M  libgst/comp.c
M  libgst/dict.c
M  libgst/sym.c
M  libgst/sym.h
M  libgst/dict.h
M  libgst/tree.c
M  libgst/tree.h

* modified files

--- orig/kernel/DeferBinding.st
+++ mod/kernel/DeferBinding.st
@@ -32,7 +32,7 @@
 
 
 LookupKey subclass: #DeferredVariableBinding
-  instanceVariableNames: 'class defaultDictionary association'
+  instanceVariableNames: 'class defaultDictionary association path'
   classVariableNames: ''
   poolDictionaries: ''
   category: 'Language-Data types'
@@ -47,24 +47,39 @@ in the scope of a given class are used.'
 
 !DeferredVariableBinding class methodsFor: 'basic'!
 
+key: aSymbol class: aClass defaultDictionary: aDictionary path: anArray
+    ^(self key: aSymbol)
+        class: aClass;
+        defaultDictionary: aDictionary;
+        path: anArray;
+ yourself!
+
 key: aSymbol class: aClass defaultDictionary: aDictionary
     ^(self key: aSymbol)
         class: aClass;
         defaultDictionary: aDictionary;
+        path: #();
  yourself! !
 
 !DeferredVariableBinding methodsFor: 'basic'!
 
 value
     "Answer a new instance of the receiver with the given key and value"
-    association isNil ifTrue: [ association := self resolveBinding ].
+    association isNil
+ ifTrue: [ association := self resolvePathFrom: self resolveBinding ].
     ^association value
 !
 
 value: anObject
     "Answer a new instance of the receiver with the given key and value"
-    association isNil ifTrue: [ association := self resolveBinding ].
+    association isNil
+ ifTrue: [ association := self resolvePathFrom: self resolveBinding ].
     association value: anObject
+!
+
+path
+    "Answer the path followed after resolving the first key."
+    ^path
 ! !
 
 
@@ -77,6 +92,25 @@ class: aClass
 defaultDictionary: aDictionary
     defaultDictionary := aDictionary!
 
+path: anArray
+    path := anArray!
+
+resolvePathFrom: assoc
+    "Given the resolution of the first key, resolve the rest of the path.
+     The final element might be put in Undeclared, the ones in the middle
+     instead must exist."
+    | pathAssoc |
+    path isEmpty ifTrue: [ ^assoc ].
+    pathAssoc := assoc.
+    1 to: path size - 1 do: [ :each |
+ pathAssoc := pathAssoc value associationAt: (path at: each) ].
+    ^pathAssoc value
+ associationAt: path last
+ ifAbsent: [
+    Undeclared
+ at: path last put: nil;
+ associationAt: path last ]!
+
 resolveBinding
     "Look for a pool dictionary of class that includes the key.  If not found,
      add the variable to the defaultDictionary.  If already bound, reuse the
@@ -109,10 +143,16 @@ resolveBinding
 
 !DeferredVariableBinding methodsFor: 'storing'!
 
-storeOn: aStream
+printOn: aStream
     "Put on aStream some Smalltalk code compiling to the receiver"
-    aStream nextPut: $#.
     aStream nextPut: ${.
     aStream nextPutAll: self key.
+    self path do: [ :each | aStream nextPut: $.; nextPutAll: each ].
     aStream nextPut: $}
+!
+
+storeOn: aStream
+    "Put on aStream some Smalltalk code compiling to the receiver"
+    aStream nextPut: $#.
+    self printOn: aStream
 ! !


--- orig/libgst/comp.c
+++ mod/libgst/comp.c
@@ -2065,13 +2065,26 @@ equal_constant (OOP oop,
  {
   gst_deferred_variable_binding binding =
     (gst_deferred_variable_binding) OOP_TO_OBJ (oop);
-  if (binding->key == constExpr->v_const.val.oopVal)
-    return (true);
+  gst_object path = OOP_TO_OBJ (binding->path);
+  int i, size = NUM_OOPS (path);
+  OOP *pKey;
+  tree_node varNode = constExpr->v_const.val.aVal;
+
+  /* Use <= because we test the key first.  */
+  for (i = 0, pKey = &binding->key; i <= size; pKey = &path->data[i++])
+    {
+      if (!varNode
+  || *pKey != _gst_intern_string (varNode->v_list.name))
+ return (false);
+
+      varNode = varNode->v_list.next;
+      pKey = &path->data[i];
+    }
  }
       break;
 
     case CONST_BINDING:
-      constExpr = _gst_find_variable_binding (constExpr->v_const.val.aVal,      false);
+      constExpr = _gst_find_variable_binding (constExpr->v_const.val.aVal);
       if (!constExpr)
  return (false);
 
@@ -2184,18 +2197,36 @@ _gst_make_constant_oop (tree_node constE
     case CONST_DEFERRED_BINDING:
       {
  gst_deferred_variable_binding dvb;
-        result = instantiate (_gst_deferred_variable_binding_class, &resultOOP);
-        dvb = (gst_deferred_variable_binding) result;
- dvb->key = constExpr->v_const.val.oopVal;
+ tree_node varNode = constExpr->v_const.val.aVal;
+
+        incPtr = INC_SAVE_POINTER ();
+        dvb = (gst_deferred_variable_binding)
+  instantiate (_gst_deferred_variable_binding_class, &resultOOP);
+        INC_ADD_OOP (resultOOP);
+
+ dvb->key = _gst_intern_string (varNode->v_list.name);
  dvb->class = _gst_this_class;
  dvb->defaultDictionary = _gst_get_undeclared_dictionary ();
  dvb->association = _gst_nil_oop;
+
+ varNode = varNode->v_list.next;
+ if (varNode)
+  {
+    int i, size = list_length (varNode);
+    OOP arrayOOP;
+    gst_object array =
+      instantiate_with (_gst_array_class, size, &arrayOOP);
+
+    dvb->path = arrayOOP;
+    for (i = 0; i < size; i++, varNode = varNode->v_list.next)
+      array->data[i] = _gst_intern_string (varNode->v_list.name);
+  }
+
         return (resultOOP);
       }
 
     case CONST_BINDING:
-      subexpr = _gst_find_variable_binding (constExpr->v_const.val.aVal,
-    false);
+      subexpr = _gst_find_variable_binding (constExpr->v_const.val.aVal);
       if (!subexpr)
  {
   _gst_errorf_at (constExpr->location.first_line,


--- orig/libgst/dict.c
+++ mod/libgst/dict.c
@@ -395,8 +395,8 @@ static const class_definition class_info
    "LookupKey", "key", NULL, NULL },
 
   {&_gst_deferred_variable_binding_class, &_gst_lookup_key_class,
-   ISP_FIXED, true, 3,
-   "DeferredVariableBinding", "class defaultDictionary association",
+   ISP_FIXED, true, 4,
+   "DeferredVariableBinding", "class defaultDictionary association path",
    NULL, NULL },
 
   {&_gst_association_class, &_gst_lookup_key_class,


--- orig/libgst/dict.h
+++ mod/libgst/dict.h
@@ -171,6 +171,7 @@ typedef struct gst_deferred_variable_bin
   OOP class;
   OOP defaultDictionary;
   OOP association;
+  OOP path;
 }
  *gst_deferred_variable_binding;
 


--- orig/libgst/sym.c
+++ mod/libgst/sym.c
@@ -573,7 +573,7 @@ _gst_pop_temporaries_dictionary (OOP dic
 
 
 tree_node
-_gst_find_variable_binding (tree_node list, mst_Boolean declare_temporary)
+_gst_find_variable_binding (tree_node list)
 {
   OOP symbol, root, assocOOP;
   tree_node elt;
@@ -606,10 +606,8 @@ _gst_find_variable_binding (tree_node li
   /* For temporaries, make a deferred binding so that we can try using
      a global variable.  Unlike namespaces, the temporaries dictionary
      does not know anything about Undeclared.  */
-  else if (_gst_use_undeclared == UNDECLARED_TEMPORARIES
-   && !list->v_list.next
-   && declare_temporary)
-    return _gst_make_deferred_binding_constant (&list->location, symbol);
+  else if (_gst_use_undeclared == UNDECLARED_TEMPORARIES)
+    return _gst_make_deferred_binding_constant (&list->location, list);
 
   else
     return NULL;
@@ -686,7 +684,7 @@ _gst_find_variable (symbol_entry * se,
       return (true);
     }
 
-  resolved = _gst_find_variable_binding (list, true);
+  resolved = _gst_find_variable_binding (list);
   if (!resolved)
     return (false);
 


--- orig/libgst/sym.h
+++ mod/libgst/sym.h
@@ -222,8 +222,7 @@ extern OOP _gst_make_pool_array (const c
 /* This resolves the variable binding constant expressed by the LIST parse
    tree node.  Unless DECLARE_TEMPORARY is false, temporary variables
    may be automatically declared.  */
-extern tree_node _gst_find_variable_binding (tree_node list,
-     mst_Boolean declare_temporary)
+extern tree_node _gst_find_variable_binding (tree_node list)
   ATTRIBUTE_HIDDEN;
 
 /* This returns the dictionary in which to define an undeclared variable


--- orig/libgst/tree.c
+++ mod/libgst/tree.c
@@ -342,13 +342,13 @@ _gst_make_string_constant (YYLTYPE *loca
 
 tree_node
 _gst_make_deferred_binding_constant (YYLTYPE *location,
-     OOP keyOOP)
+     tree_node varNode)
 {
   tree_node result;
 
   result = make_tree_node (location, TREE_CONST_EXPR);
   result->v_const.constType = CONST_DEFERRED_BINDING;
-  result->v_const.val.oopVal = keyOOP;
+  result->v_const.val.aVal = varNode;
 
   return (result);
 }
@@ -760,6 +760,16 @@ print_const_node (tree_node node,
       _gst_print_tree (node->v_const.val.aVal, level + 7);
       break;
 
+    case CONST_DEFERRED_BINDING:
+      printf ("deferred variable binding: ");
+      _gst_print_tree (node->v_const.val.aVal, level + 27);
+      break;
+
+    case CONST_BINDING:
+      printf ("variable binding: ");
+      _gst_print_tree (node->v_const.val.aVal, level + 18);
+      break;
+
     default:
       _gst_errorf ("Unknown constant type %d", node->v_const.constType);
     }


--- orig/libgst/tree.h
+++ mod/libgst/tree.h
@@ -336,9 +336,9 @@ extern tree_node _gst_make_string_consta
   ATTRIBUTE_HIDDEN;
 
 /* Create a const_node storing a deferred variable binding, whose key
-   is the symbol KEYOOP.  */
+   is the variable VARNODE.  */
 extern tree_node _gst_make_deferred_binding_constant (YYLTYPE *location,
-      OOP keyOOP)
+      tree_node varNode)
   ATTRIBUTE_HIDDEN;
 
 /* Create a const_node for an array whose elements are




_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk