small bug fixes

bootstrapworld · Aug 7, 2012 · b3d43c2 · b3d43c2
1 parent d817bf9
commit b3d43c2
Show file tree

Hide file tree

Showing 4 changed files with 30 additions and 43 deletions.
diff --git a/js-runtime/lib/control.js b/js-runtime/lib/control.js
@@ -871,8 +871,6 @@ var selectProcedureByArity = function(aState, n, procValue, operands) {
     if ( !types.isFunction(procValue) ) {
 	    var argStr = getArgStr('; arguments were:');
         var positionStack = state.captureCurrentContinuationMarks(aState).ref(types.symbol('moby-application-position-key'));
-
-        console.log("positionStack is ", positionStack);
 
         var locationList = positionStack[positionStack.length - 1];
         var locs = locationList;

diff --git a/js-runtime/lib/helpers.js b/js-runtime/lib/helpers.js
@@ -190,11 +190,9 @@ var helpers = {};
 					if((! (state.isState(args[i])))
 					   && 
 					   (!((args[i].name !== undefined) && args[i].name === ""))) {
-					   	if(args[i].name) console.log("args[i].name is ", args[i].name);
 						actualArgs.push(args[i]);
 					} 
 				}
-				console.log("now, actualArgs is ", actualArgs);
 				window.wtf = args[2];
 				for(i = 0; i < actualArgs.length; i++){
 					if(! (locs.isEmpty())){

diff --git a/servlet-htdocs/support.js b/servlet-htdocs/support.js
@@ -790,11 +790,9 @@ var helpers = {};
 					if((! (state.isState(args[i])))
 					   && 
 					   (!((args[i].name !== undefined) && args[i].name === ""))) {
-					   	if(args[i].name) console.log("args[i].name is ", args[i].name);
 						actualArgs.push(args[i]);
 					} 
 				}
-				console.log("now, actualArgs is ", actualArgs);
 				window.wtf = args[2];
 				for(i = 0; i < actualArgs.length; i++){
 					if(! (locs.isEmpty())){
@@ -20784,8 +20782,6 @@ var selectProcedureByArity = function(aState, n, procValue, operands) {
     if ( !types.isFunction(procValue) ) {
 	    var argStr = getArgStr('; arguments were:');
         var positionStack = state.captureCurrentContinuationMarks(aState).ref(types.symbol('moby-application-position-key'));
-
-        console.log("positionStack is ", positionStack);
 
         var locationList = positionStack[positionStack.length - 1];
         var locs = locationList;

diff --git a/src/compiler/helpers.ss b/src/compiler/helpers.ss
@@ -1,15 +1,18 @@
-#lang racket/base
+#lang s-exp "lang.ss"
 
-(require racket/local
-         racket/contract
-         (only-in racket/bool true false)
-         (only-in racket/list empty? rest first second empty third))
+(require "rbtree.ss")
 (require "../collects/moby/runtime/stx.ss")
 (require "../collects/moby/runtime/error-struct.ss")
 
+(define pair? cons?)
 
 ;; A program is a (listof (or/c defn? expr? library-require? provide-statement? require-permission?))
 
+(define (list? datum)
+  (or (empty? datum)
+      (and
+       (pair? datum)
+       (list? (rest datum)))))
 
 
 ;; symbol<: symbol symbol -> boolean
@@ -176,11 +179,11 @@
   (stx-begins-with? an-sexp 'require))
 
 
-;; java-identifiers: (hashof symbol boolean)
+;; java-identifiers: (rbtreeof symbol boolean)
 (define java-identifiers
-  (foldl (lambda (sym a-hash)
-           (hash-set a-hash sym true))
-         (make-immutable-hash)
+  (foldl (lambda (sym an-rbtree)
+           (rbtree-insert symbol< an-rbtree sym true))
+         empty-rbtree
 
          '(abstract  continue  	for  	new  	switch
                      assert 	default 	goto 	package 	synchronized
@@ -197,11 +200,11 @@
                      debugger)))
 
 
-;; special-character-mappings: (hashof char string)
+;; special-character-mappings: (rbtreeof char string)
 (define special-character-mappings
-  (foldl (lambda (ch+translation a-hash)
-           (hash-set a-hash (first ch+translation) (second ch+translation)))
-         (make-immutable-hash)
+  (foldl (lambda (ch+translation an-rbtree)
+           (rbtree-insert char<? an-rbtree (first ch+translation) (second ch+translation)))
+         empty-rbtree
          '((#\- "_dash_")
            (#\_ "_underline_")
            (#\? "_question_")
@@ -227,16 +230,16 @@
 ;; Special character mappings for identifiers.
 (define (translate-special-character ch)
   (cond
-    [(hash-has-key? special-character-mappings ch)
-     (hash-ref special-character-mappings ch)]
+    [(cons? (rbtree-lookup char<? special-character-mappings ch))
+     (second (rbtree-lookup char<? special-character-mappings ch))]
     [else
      (string ch)]))
 
 
 ;; identifier->munged-java-identifier: symbol -> symbol
 (define (identifier->munged-java-identifier an-id)
   (cond
-    [(hash-has-key? java-identifiers an-id)
+    [(cons? (rbtree-lookup symbol< java-identifiers an-id))
      (string->symbol (string-append "_" (symbol->string an-id) "_"))]
     [else
      (local [(define (maybe-prepend-hyphen chars)
@@ -274,6 +277,16 @@
   (remove-leading-whitespace/list (string->list a-str)))
 
 
+;; take: (listof X) number -> (listof X)
+;; Produces a list of the first n elmeents of a-list.
+(define (take a-list n)
+  (cond
+    [(= n 0)
+     empty]
+    [else
+     (cons (first a-list)
+           (take (rest a-list) (sub1 n)))]))
+
 
 ;; list-tail: (listof X) number -> (listof X)
 ;; Produces a list of the last n elmeents in a-list.
@@ -366,11 +379,6 @@
              (define body (third (stx-e a-definition)))]
        (f-define-values ids body))]
 
-
-
-    ;; FIXME: add more error productions as necessary to get
-    ;; reasonable error messages.
-
     [(stx-begins-with? a-definition 'define)
      (if (define-var? a-definition)
          (find-defn-var-error a-definition)
@@ -379,20 +387,6 @@
     [(stx-begins-with? a-definition 'define-struct)
      (handle-defn-struct-error a-definition)]
 
-
-    ;(raise (make-moby-error 
-    ;       (stx-loc a-definition)
-    ;      (make-moby-error-type:generic-syntactic-error
-    ;      "define expects either an identifier and a body: (define answer 42), or a function header and body: (define (double x ) (* x 2))"
-    ;     (list))))]
-    ;
-    ;[(stx-begins-with? a-definition 'define-struct)
-    ; (raise (make-moby-error
-    ;         (stx-loc a-definition)
-    ;         (make-moby-error-type:generic-syntactic-error
-    ;          "define-struct expects an identifier and a list of fields.  i.e. (define-struct pizza (dough sauce toppings))"
-    ;          (list))))]
-
     [(stx-begins-with? a-definition 'define-values)
      (handle-defn-values-error a-definition)]
 
@@ -662,6 +656,7 @@
                   [require-permission? (any/c . -> . boolean?)]
                   [library-require? (any/c . -> . boolean?)]
                   [provide-statement? (any/c . -> . boolean?)]
+                  [take ((listof any/c) number? . -> . (listof any/c))]
                   [list-tail ((listof any/c) number? . -> . (listof any/c))]
 
                   [expression<? (expression? expression? . -> . boolean?)]