From c066bdf56811f265d30029dbf5b4acdffbdcdccd Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@cs.wpi.edu>
Date: Fri, 30 Sep 2011 12:32:31 -0400
Subject: [PATCH] continuing to add primitives

---
 .../runtime-src/baselib-primitives.js         | 150 +++++++++++++-----
 lang/kernel.rkt                               |  34 ++--
 2 files changed, 127 insertions(+), 57 deletions(-)

diff --git a/js-assembler/runtime-src/baselib-primitives.js b/js-assembler/runtime-src/baselib-primitives.js
index 0d35591..9db13eb 100644
--- a/js-assembler/runtime-src/baselib-primitives.js
+++ b/js-assembler/runtime-src/baselib-primitives.js
@@ -27,6 +27,8 @@
     var isString = baselib.strings.isString;
     var isSymbol = baselib.symbols.isSymbol;
     var isBox = baselib.boxes.isBox;
+    var isStruct = baselib.structs.isStruct;
+    var isStructType = baselib.structs.isStructType;
     var equals = baselib.equality.equals;
 
     var NULL = baselib.lists.EMPTY;
@@ -79,11 +81,11 @@
     var checkInteger = baselib.check.checkInteger;
     var checkIntegerForChar = baselib.check.makeCheckArgumentType(
         function(x) {
-            return (baselib.numbers.isInteger(x) && 
-                    ((baselib.numbers.lessThanOrEqual(0, x) && 
+            return (baselib.numbers.isInteger(x) &&
+                    ((baselib.numbers.lessThanOrEqual(0, x) &&
                       baselib.numbers.lessThanOrEqual(x, 55295))
                      ||
-                     (baselib.numbers.lessThanOrEqual(57344, x) && 
+                     (baselib.numbers.lessThanOrEqual(57344, x) &&
                       baselib.numbers.lessThanOrEqual(x, 1114111))));
         },
         'integer'
@@ -927,22 +929,6 @@
         });
 
 
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
     installPrimitiveProcedure(
         'string-ci=?',
         baselib.arity.makeArityAtLeast(1),
@@ -1015,9 +1001,6 @@
         });
 
 
-
-
-
     installPrimitiveProcedure(
         'string-append',
         baselib.arity.makeArityAtLeast(0),
@@ -1102,19 +1085,99 @@
         });
 
 
-    installPrimitiveProcedure(
-        'char=?',
-        baselib.arity.makeArityAtLeast(2),
-        function(M) {
-            var s = checkChar(M, 'char=?', 0).val;
+    var makeCharComparator = function(name, cmp) {
+        return function(M) {
+            var s = checkChar(M, name, 0).val;
 	    var i;
             for (i = 1; i < M.a; i++) {
-                if (checkChar(M, 'char=?', i).val !== s) {
+                if (!(cmp(s, checkChar(M, name, i).val))) {
                     return false;
                 }
             }
             return true;
-        });
+        };
+    };
+
+    installPrimitiveProcedure(
+        'char>?',
+        baselib.arity.makeArityAtLeast(2),
+        makeCharComparator('char>?',
+                           function(x, y) {
+                               return x > y;
+                           }));
+
+    installPrimitiveProcedure(
+        'char>=?',
+        baselib.arity.makeArityAtLeast(2),
+        makeCharComparator('char>=?',
+                           function(x, y) {
+                               return x >= y;
+                           }));
+
+    installPrimitiveProcedure(
+        'char<?',
+        baselib.arity.makeArityAtLeast(2),
+        makeCharComparator('char<?',
+                           function(x, y) {
+                               return x < y;
+                           }));
+
+    installPrimitiveProcedure(
+        'char<=?',
+        baselib.arity.makeArityAtLeast(2),
+        makeCharComparator('char<=?',
+                           function(x, y) {
+                               return x <= y;
+                           }));
+
+    installPrimitiveProcedure(
+        'char=?',
+        baselib.arity.makeArityAtLeast(2),
+        makeCharComparator('char=?',
+                           function(x, y) {
+                               return x === y;
+                           }));
+
+    installPrimitiveProcedure(
+        'char-ci>?',
+        baselib.arity.makeArityAtLeast(2),
+        makeCharComparator('char-ci>?',
+                           function(x, y) {
+                               return x.toUpperCase() > y.toUpperCase();
+                           }));
+
+    installPrimitiveProcedure(
+        'char-ci>=?',
+        baselib.arity.makeArityAtLeast(2),
+        makeCharComparator('char-ci>=?',
+                           function(x, y) {
+                               return x.toUpperCase() >= y.toUpperCase();
+                           }));
+
+    installPrimitiveProcedure(
+        'char-ci<?',
+        baselib.arity.makeArityAtLeast(2),
+        makeCharComparator('char-ci<?',
+                           function(x, y) {
+                               return x.toUpperCase() < y.toUpperCase();
+                           }));
+
+    installPrimitiveProcedure(
+        'char-ci<=?',
+        baselib.arity.makeArityAtLeast(2),
+        makeCharComparator('char-ci<=?',
+                           function(x, y) {
+                               return x.toUpperCase() <= y.toUpperCase();
+                           }));
+
+    installPrimitiveProcedure(
+        'char-ci=?',
+        baselib.arity.makeArityAtLeast(2),
+        makeCharComparator('char-ci=?',
+                           function(x, y) {
+                               return x.toUpperCase() === y.toUpperCase();
+                           }));
+
 
 
     installPrimitiveProcedure(
@@ -1125,7 +1188,6 @@
             return baselib.chars.makeChar(String.fromCharCode(ch));
         });
 
-    
     installPrimitiveProcedure(
         'char-upcase',
         1,
@@ -1855,9 +1917,9 @@
                     vs.push(baselib.format.format("~e", [M.e[M.e.length - 1 - i]]));
                 }
                 raise(M, baselib.exceptions.makeExnFail(M.e[M.e.length - 1].toString() +
-                                                              ": " +
-                                                              vs.join(' '),
-                                                              M.captureContinuationMarks()));
+                                                        ": " +
+                                                        vs.join(' '),
+                                                        M.captureContinuationMarks()));
             }
 
             if (isSymbol(M.e[M.e.length - 1])) {
@@ -2017,7 +2079,6 @@
             return contMarks;
         });
 
-
     installPrimitiveClosure(
         'make-struct-type',
         makeList(4, 5, 6, 7, 8, 9, 10, 11),
@@ -2113,6 +2174,19 @@
                 });
         });
 
+    installPrimitiveClosure(
+        'struct?',
+        1,
+        function(M) {
+            return isStruct(M.e[M.e.length - 1]);
+        });
+
+    installPrimitiveClosure(
+        'struct-type?',
+        1,
+        function(M) {
+            return isStructType(M.e[M.e.length - 1]);
+        });
 
     installPrimitiveProcedure(
         'current-inspector',
@@ -2217,7 +2291,7 @@
 
     installPrimitiveProcedure(
         'srcloc',
-            5,
+        5,
         function(M) {
             var source = M.e[M.e.length - 1];
             var line = checkNatural(M, 'srcloc', 1);
@@ -2313,12 +2387,6 @@
             return baselib.contmarks.DEFAULT_CONTINUATION_PROMPT_TAG;
         });
 
-
-
-
-
-
-
     exports['Primitives'] = Primitives;
     exports['installPrimitiveProcedure'] = installPrimitiveProcedure;
     exports['installPrimitiveClosure'] = installPrimitiveClosure;
diff --git a/lang/kernel.rkt b/lang/kernel.rkt
index d95b7fa..e12cb70 100644
--- a/lang/kernel.rkt
+++ b/lang/kernel.rkt
@@ -185,7 +185,13 @@
          srcloc-line
          srcloc-column
          srcloc-position
-         srcloc-span)
+         srcloc-span
+
+
+         make-struct-type
+         make-struct-field-accessor
+         make-struct-field-mutator
+         struct-type?)
 
 
 (define (-identity x) x)
@@ -217,10 +223,6 @@
 ;;  continuation-mark-set?
 ;;  continuation-mark-set->list
 
-;;  make-struct-type
-;;  make-struct-field-accessor
-;;  make-struct-field-mutator
-;;  struct-type?
 ;;  struct-constructor-procedure?
 ;;  struct-predicate-procedure?
 ;;  struct-accessor-procedure?
@@ -313,7 +315,7 @@ string?
 char?
 boolean?
 vector?
-;;  struct?
+struct?
 ;;  eof-object?
 ;;  bytes?
 ;;  byte?
@@ -435,16 +437,16 @@ symbol->string
   vector->list
   list->vector
 ;;  build-vector
-char=?
-;;  char<?
-;;  char>?
-;;  char<=?
-;;  char>=?
-;;  char-ci=?
-;;  char-ci<?
-;;  char-ci>?
-;;  char-ci<=?
-;;  char-ci>=?
+  char=?
+  char<?
+  char>?
+  char<=?
+  char>=?
+  char-ci=?
+  char-ci<?
+  char-ci>?
+  char-ci<=?
+  char-ci>=?
 ;;  char-alphabetic?
 ;;  char-numeric?
 ;;  char-whitespace?