files from laura

11 files changed, 1271 insertions, 26 deletions

diff --git a/final_project/work/Makefile b/final_project/work/Makefile
new file mode 100644
index 0000000..f8e8f97
--- /dev/null
+++ b/final_project/work/Makefile
@@ -0,0 +1,43 @@
+all:
+	rm -f prhello-shim.{c,o} prhello-const.{c,o} *.bin *.so
+	make install-example
+	mit-scheme --batch-mode --load prhello.scm
+
+run:
+	rm -f prhello-shim.{c,o} prhello-const.{c,o} *.bin *.so
+	make install-example
+	mit-scheme  --load prhello.scm
+
+
+install-example: build-example
+	sudo cp -a prhello-types.bin /usr/local/lib/mit-scheme/lib/.
+	sudo cp -a  prhello-const.bin /usr/local/lib/mit-scheme/lib/.
+	sudo cp -a  prhello-shim.so /usr/local/lib/mit-scheme/lib/.
+
+build-example: prhello-shim.so prhello-types.bin prhello-const.bin
+
+prhello-shim.so: prhello-shim.o
+	$(CC) -shared -fPIC -o $@ $^ `pkg-config --libs gtk+-2.0`
+
+prhello-shim.o: prhello-shim.c
+	$(CC) -I../lib -Wall -fPIC `pkg-config --cflags gtk+-2.0` -o $@ -c $<
+
+prhello-shim.c prhello-const.c prhello-types.bin: prhello.cdecl
+	(echo "(load-option 'FFI)"; \
+	echo '(C-generate "prhello" "#include <gtk/gtk.h>")') \
+	| mit-scheme --batch-mode
+
+prhello-const.bin: prhello-const.scm
+	echo '(sf "prhello-const")' | mit-scheme --compiler --batch-mode
+
+prhello-const.scm: prhello-const
+	./prhello-const
+
+prhello-const: prhello-const.o
+	@rm -f $@
+	$(CC) $(CFLAGS) $(LDFLAGS) -o $@ $^ `pkg-config --libs gtk+-2.0`
+
+prhello-const.o: prhello-const.c
+	$(CC) `pkg-config --cflags gtk+-2.0` $(CFLAGS) -o $@ -c $<
+
+
diff --git a/final_project/work/discovery-examples.scm b/final_project/work/discovery-examples.scm
index 45ae2ea..e525252 100644
--- a/final_project/work/discovery-examples.scm
+++ b/final_project/work/discovery-examples.scm
@@ -35,34 +35,26 @@
 ;Value: .15384615384615385
 
 (discover:opers-for 6.5)
-;Value 57: (#[compound-procedure 38 operator] thingaling)
+;Value 52: (inverse #[compound-procedure 49 operator])
 
 (discover:named-opers-for 6.5)
-;Value 58: (thingaling)
+;Value 53: (inverse)
 
 (discover:named-opers-for 1 2)
-;Value 81: (plus minus)
-
-;;; this stuff is just play crap
-
-(car (hash-table->alist *generic-operator-table*))
-
-(caadr (hash-table/get *generic-operator-table* inverse #f))
-
-(environment-bound-names (the-environment))
+;Value 54: (plus minus)
 
 (environment-lookup (the-environment) 'inverse)
-
-
-(inverse '( (1 2 3)
-        (0 1 2)
-        (0 0 1)))
+;Value 49: #[compound-procedure 49 operator]
 
 (hash-table/get *generic-operator-table* inverse #f)
+;Value 59: (1 (#[compound-procedure 57] . #[compound-procedure 60]) (#[compound-procedure 61] . #[compound-procedure 62]))
+
 (hash-table/get *generic-operator-table* minus #f)
+;Value 63: (2 (#[compound-procedure 56 any?] (#[compound-procedure 56 any?] . #[arity-dispatched-procedure 28])))
 
 (hash-table-size *generic-operator-table*)
-;Value: 92   ;this is for mechanics
+;Value: 6    ; for this file
+;Value: 92   ; for scmutils
 
 ;this prints all keys line by line
 (for-each
@@ -70,7 +62,6 @@
      (display x))
  (hash-table/key-list *generic-operator-table*))
 
-
 (define add1 (make-generic-operator 1 #f 'add1))
 (define sub1 (make-generic-operator 1 #f 'sub1))
 (define double (make-generic-operator 1 #f 'double))
@@ -84,17 +75,36 @@
                        (and (number? n)
                         (not (zero? n)))))
 
-(add1 4)
-;(sub1 'b)
-
 (discover:apply-all 3)
+;Value 89: (1/3 4 9 2 6)
 
 (discover:satisfy (lambda (x) (eq? x 9)) (/ 1 2))
+;Value 35: (9)
+
 (discover:satisfy-sequence (lambda (x) (eq? x 9)) (/ 1 2))
+;Value 36: (((9) square double add1) ((9) square add1 inverse))
+
 (discover:satisfy-sequence (lambda (x) (eq? x 49)) (/ 5 6))
+;Value 37: (((49) square sub1 inverse sub1))
+
+(define (prime? n)
+  (cond ((null? n) #f)
+	((not (integer? n)) #f)
+	((> 0 n) #f)
+	(else (let lp ((m 2))
+		(cond ((> m (sqrt n)) #t)
+		      ((integer? (/ n m)) #f)
+		      (else (lp (+ m 1))))))))
+
+(prime? 47)
+; #t
+
+(discover:satisfy-sequence prime? (/ 5 6))
+;Value 39: (((5) inverse sub1 inverse))
+
+(discover:satisfy-sequence prime? 923)
+;Value 44: (((1847) add1 double))
 
-(square (sqrt 2))
-(sqrt 2)
-(square 3)
+(discover:named-opers)
 
 
diff --git a/final_project/work/generic-string-opers.scm b/final_project/work/generic-string-opers.scm
new file mode 100644
index 0000000..9855793
--- /dev/null
+++ b/final_project/work/generic-string-opers.scm
@@ -0,0 +1,46 @@
+
+; STRING
+(define capitalize (make-generic-operator 1 #f 'capitalize))
+(define downcase (make-generic-operator 1 #f 'downcase))
+(define upcase (make-generic-operator 1 #f 'upcase))
+(define string-length (make-generic-operator 1 #f 'length))
+(defhandler capitalize (lambda (x) (string-capitalize x)) string?)
+(defhandler downcase (lambda (x) (string-downcase x)) string?)
+(defhandler upcase (lambda (x) (string-upcase x)) string?)
+(defhandler string-length (lambda (x) (string-length x)) string?)
+
+; STRING STRING
+(define search-forward (make-generic-operator 2 #f 'search-forward))
+(define search-backward (make-generic-operator 2 #f 'search-backward))
+(define search-all (make-generic-operator 2 #f 'search-all))
+(define is-substring (make-generic-operator 2 #f 'substring?))
+(define match (make-generic-operator 2 #f 'match))
+(defhandler match (lambda (x y) (string-match-forward x y)) string? string?)
+(defhandler search-forward (lambda (x y) (string-search-forward x y)) string? string?)
+(defhandler search-all (lambda (x y) (string-search-all x y)) string? string?)
+(defhandler search-backward (lambda (x y) (string-search-backward x y)) string? string?)
+(defhandler is-substring (lambda (x y) (substring? x y)) string? string?)
+
+; NUMBER NUMBER
+(define plus (make-generic-operator 2 #f '+))
+(define subtract (make-generic-operator 2 #f '-))
+(define mul (make-generic-operator 2 #f '*))
+(define divide (make-generic-operator 2 #f '/))
+(define are-equal (make-generic-operator 2 #f '=?))
+(defhandler plus (lambda (x y) (+ x y)) number? number?)
+(defhandler subtract (lambda (x y) (- x y)) number? number?)
+(defhandler mul (lambda (x y) (* x y)) number? number?)
+(defhandler divide (lambda (x y) (/ x y)) number? number?)
+(defhandler are-equal (lambda (x y) (= x y)) number? number?)
+
+; LIST
+(define length2 (make-generic-operator 1 #f 'length))
+(define reverse1 (make-generic-operator 1 #f 'reverse))
+(define sort1 (make-generic-operator 1 #f 'sort))
+(defhandler length2 (lambda (x) (length x)) list?)
+(defhandler reverse1 (lambda (x) (reverse x)) list?)
+(defhandler sort1 (lambda (x) (sort x <)) list?)
+
+; BOOLEAN
+(define not1 (make-generic-operator 1 #f 'not))
+(defhandler not1 (lambda (x) (not x)) boolean?)
diff --git a/final_project/work/ghelper.scm b/final_project/work/ghelper.scm
index 4e39cbe..c74426b 100644
--- a/final_project/work/ghelper.scm
+++ b/final_project/work/ghelper.scm
@@ -1,4 +1,6 @@
-;;; From 6.945 Staff, with minor edit by bnewbold (May 2009)
+;;; From 6.945 Staff, with minor edit by bnewbold (May 2009):
+;;; the optional name argument is handled in the style of
+;;; the scmutils implementation
 
 ;;;;           Most General Generic-Operator Dispatch
 
@@ -103,4 +105,4 @@
 	    (begin
 	      (if (not (null? tree))
 		  (warn "Replacing top-level handler:" tree handler))
-	      handler)))))
\ No newline at end of file
+	      handler)))))
diff --git a/final_project/work/hello.scm b/final_project/work/hello.scm
new file mode 100644
index 0000000..d28154f
--- /dev/null
+++ b/final_project/work/hello.scm
@@ -0,0 +1,27 @@
+(define (hello)
+  (let ((window (gtk-window-new 'toplevel))
+	(button (gtk-button-new))
+	(label (gtk-label-new "Hello, World!")))
+    (gtk-container-add button label)
+    (gtk-container-add window button)
+    (gtk-window-set-title window "Hello")
+    (gtk-container-set-border-width button 10)
+    (let ((counter 0))
+      (g-signal-connect window (C-callback "delete_event")
+	(lambda (w e)
+	  (outf-console ";Delete me "(- 2 counter)" times.\n")
+	  (set! counter (1+ counter))
+	  ;; Three or more is the charm.
+	  (if (> counter 2) 0 1)))
+      (g-signal-connect button (C-callback "clicked")
+	(lambda (w)
+	  (if (= counter 1)
+	      (begin
+		(outf-console "\n;Erroring in "(current-thread)"...\n")
+		(error "Testing error handling.")))
+	  (let ((text (gtk-label-get-text label)))
+	    (gtk-label-set-text
+	     label (list->string (reverse! (string->list text)))))
+	  unspecific)))
+    (gtk-widget-show-all window)
+    window))
\ No newline at end of file
diff --git a/final_project/work/numerolgist.scm b/final_project/work/numerolgist.scm
new file mode 100644
index 0000000..6553232
--- /dev/null
+++ b/final_project/work/numerolgist.scm
@@ -0,0 +1,46 @@
+
+
+; frac objects are like (number 'numerator 'denominator)
+
+; the classics; just yanked from wikipedia w/o errors or citation
+(define cgs-units-constants
+  (list
+   (list (* 2.998 (expt 10 10)) 'c) ; speed of light
+   (list (* 6.626 (expt 10 -27)) 'h) ; plank
+   (list (* 4.803 (expt 10 -10)) 'e) ; electron charge (esu)
+;   (list 3.14159268 'pi) ; pi!
+   ))
+
+(define (make-ordered-fracs primatives)
+  (sort (append primatives
+		(map (lambda (x) 
+		       (list (/ 1 (car x)) (quasiquote '(/ 1 ,(cadr x)))))
+		     primatives))
+	(lambda (a b) (< (car a) (car b)))))
+
+(make-ordered-fracs cgs-units-constants)
+
+(define (good-approximation x primatives eta)
+  (define (closest-term y ordered)
+    (cond ((null? ordered) (error "need at least one thing to check!")) 
+	  ((null? (cdr ordered)) (car ordered))
+	  ((< (abs (- y (caar ordered)))
+	      (abs (- y (caar (cdr ordered)))))
+	   (car ordered))
+	  (else (closest-term y (cdr ordered)))))
+  (define (iterate-term y ordered eta)
+    (if (< (abs y) (abs eta))
+	(begin
+	  (display y)
+	  (newline)
+	  (display (- y eta))
+	  '())
+	(begin
+	  (display "x: ") (display y) (newline)
+	  (let ((best (closest-term y ordered)))
+	    (cons (cadr best)
+		  (iterate-term (/ y (car best)) ordered eta))))))
+    (iterate-term x (make-ordered-fracs primatives) eta))
+
+(good-approximation 876259081724391234.0 cgs-units-constants 200.)
+
diff --git a/final_project/work/prhello-const.c b/final_project/work/prhello-const.c
new file mode 100644
index 0000000..4d5f3f5
--- /dev/null
+++ b/final_project/work/prhello-const.c
@@ -0,0 +1,50 @@
+/* -*-C-*- */
+
+/* Prefix */
+#include <gtk/gtk.h>
+/* End Prefix */
+
+void
+grovel_basics (FILE * out)
+{
+  fprintf (out, "   ((sizeof char) . %d)\n", sizeof (char));
+  fprintf (out, "   ((sizeof uchar) . %d)\n", sizeof (unsigned char));
+  fprintf (out, "   ((sizeof short) . %d)\n", sizeof (short));
+  fprintf (out, "   ((sizeof ushort) . %d)\n", sizeof (unsigned short));
+  fprintf (out, "   ((sizeof int) . %d)\n", sizeof (int));
+  fprintf (out, "   ((sizeof uint) . %d)\n", sizeof (unsigned int));
+  fprintf (out, "   ((sizeof long) . %d)\n", sizeof (long));
+  fprintf (out, "   ((sizeof ulong) . %d)\n", sizeof (unsigned long));
+  fprintf (out, "   ((sizeof float) . %d)\n", sizeof (float));
+  fprintf (out, "   ((sizeof double) . %d)\n", sizeof (double));
+  fprintf (out, "   ((sizeof *) . %d)\n", sizeof (void*));
+}
+
+void
+grovel_enums (FILE * out)
+{
+  fprintf (out, "   (|GTK_WINDOW_POPUP| . %ld)\n", ((long)GTK_WINDOW_POPUP));
+  fprintf (out, "   (|GTK_WINDOW_TOPLEVEL| . %ld)\n", ((long)GTK_WINDOW_TOPLEVEL));
+}
+
+int
+main (void)
+{
+  FILE * out = fopen ("prhello-const.scm", "w");
+  if (out == NULL) {
+    perror ("could not open prhello-const.scm");
+    return 1;
+  }
+  fprintf (out, "'( ;; prhello constants\n");
+  fprintf (out, "  ( ;; enum member values\n");
+  grovel_enums(out);
+  fprintf (out, "   )\n");
+  fprintf (out, "  ( ;; struct values\n");
+  grovel_basics(out);
+  fprintf (out, "   ))\n");
+  if (fclose (out)) {
+    perror ("could not close prhello-const.scm");
+    return 1;
+  }
+  return 0;
+}
diff --git a/final_project/work/prhello-shim.c b/final_project/work/prhello-shim.c
new file mode 100644
index 0000000..f8b2c7d
--- /dev/null
+++ b/final_project/work/prhello-shim.c
@@ -0,0 +1,829 @@
+/* -*-C-*- */
+
+#include <mit-scheme.h>
+
+/* Prefix */
+#include <gtk/gtk.h>
+/* End Prefix */
+
+SCM
+Scm_continue_gtk_init (void)
+{
+  /* Declare. */
+  char * tos0;
+  SCM ret0s;
+
+  /* Restore. */
+  tos0 = callout_lunseal (&Scm_continue_gtk_init);
+
+  /* Return. */
+  ret0s = unspecific();
+  callout_pop (tos0);
+  return (ret0s);
+}
+void
+Scm_gtk_init (void)
+{
+  /* Declare. */
+  int * argc;
+  char * * * argv;
+
+  /* Init. */
+  check_number_of_args (3);
+  argc = (int *) arg_pointer (2);
+  argv = (char * * *) arg_pointer (3);
+
+  /* Call. */
+  callout_seal (&Scm_continue_gtk_init);
+  gtk_init (argc, argv);
+
+  /* Save. */
+  callout_unseal (&Scm_continue_gtk_init);
+
+  callout_continue (&Scm_continue_gtk_init);
+  /* NOTREACHED */
+}
+
+SCM
+Scm_continue_gtk_window_new (void)
+{
+  /* Declare. */
+  char * tos0;
+  GtkWidget * ret0;
+  SCM ret0s;
+
+  /* Restore. */
+  tos0 = callout_lunseal (&Scm_continue_gtk_window_new);
+  CSTACK_LPOP (GtkWidget *, ret0, tos0);
+
+  /* Return. */
+  ret0s = pointer_to_scm (ret0);
+  callout_pop (tos0);
+  return (ret0s);
+}
+void
+Scm_gtk_window_new (void)
+{
+  /* Declare. */
+  GtkWidget * ret0;
+  GtkWindowType type;
+
+  /* Init. */
+  check_number_of_args (3);
+  type = arg_long (3);
+
+  /* Call. */
+  callout_seal (&Scm_continue_gtk_window_new);
+  ret0 = gtk_window_new (type);
+
+  /* Save. */
+  callout_unseal (&Scm_continue_gtk_window_new);
+  CSTACK_PUSH (GtkWidget *, ret0);
+
+  callout_continue (&Scm_continue_gtk_window_new);
+  /* NOTREACHED */
+}
+
+SCM
+Scm_continue_gtk_button_new (void)
+{
+  /* Declare. */
+  char * tos0;
+  GtkWidget * ret0;
+  SCM ret0s;
+
+  /* Restore. */
+  tos0 = callout_lunseal (&Scm_continue_gtk_button_new);
+  CSTACK_LPOP (GtkWidget *, ret0, tos0);
+
+  /* Return. */
+  ret0s = pointer_to_scm (ret0);
+  callout_pop (tos0);
+  return (ret0s);
+}
+void
+Scm_gtk_button_new (void)
+{
+  /* Declare. */
+  GtkWidget * ret0;
+
+  /* Init. */
+  check_number_of_args (2);
+
+  /* Call. */
+  callout_seal (&Scm_continue_gtk_button_new);
+  ret0 = gtk_button_new ();
+
+  /* Save. */
+  callout_unseal (&Scm_continue_gtk_button_new);
+  CSTACK_PUSH (GtkWidget *, ret0);
+
+  callout_continue (&Scm_continue_gtk_button_new);
+  /* NOTREACHED */
+}
+
+SCM
+Scm_continue_gtk_combo_box_new_text (void)
+{
+  /* Declare. */
+  char * tos0;
+  GtkWidget * ret0;
+  SCM ret0s;
+
+  /* Restore. */
+  tos0 = callout_lunseal (&Scm_continue_gtk_combo_box_new_text);
+  CSTACK_LPOP (GtkWidget *, ret0, tos0);
+
+  /* Return. */
+  ret0s = pointer_to_scm (ret0);
+  callout_pop (tos0);
+  return (ret0s);
+}
+void
+Scm_gtk_combo_box_new_text (void)
+{
+  /* Declare. */
+  GtkWidget * ret0;
+
+  /* Init. */
+  check_number_of_args (2);
+
+  /* Call. */
+  callout_seal (&Scm_continue_gtk_combo_box_new_text);
+  ret0 = gtk_combo_box_new_text ();
+
+  /* Save. */
+  callout_unseal (&Scm_continue_gtk_combo_box_new_text);
+  CSTACK_PUSH (GtkWidget *, ret0);
+
+  callout_continue (&Scm_continue_gtk_combo_box_new_text);
+  /* NOTREACHED */
+}
+
+SCM
+Scm_continue_gtk_combo_box_append_text (void)
+{
+  /* Declare. */
+  char * tos0;
+  SCM ret0s;
+
+  /* Restore. */
+  tos0 = callout_lunseal (&Scm_continue_gtk_combo_box_append_text);
+
+  /* Return. */
+  ret0s = unspecific();
+  callout_pop (tos0);
+  return (ret0s);
+}
+void
+Scm_gtk_combo_box_append_text (void)
+{
+  /* Declare. */
+  GtkComboBox * combo;
+  const char * str;
+
+  /* Init. */
+  check_number_of_args (3);
+  combo = (GtkComboBox *) arg_pointer (2);
+  str = (const char *) arg_pointer (3);
+
+  /* Call. */
+  callout_seal (&Scm_continue_gtk_combo_box_append_text);
+  gtk_combo_box_append_text (combo, str);
+
+  /* Save. */
+  callout_unseal (&Scm_continue_gtk_combo_box_append_text);
+
+  callout_continue (&Scm_continue_gtk_combo_box_append_text);
+  /* NOTREACHED */
+}
+
+SCM
+Scm_continue_gtk_combo_box_get_active (void)
+{
+  /* Declare. */
+  char * tos0;
+  gint ret0;
+  SCM ret0s;
+
+  /* Restore. */
+  tos0 = callout_lunseal (&Scm_continue_gtk_combo_box_get_active);
+  CSTACK_LPOP (gint, ret0, tos0);
+
+  /* Return. */
+  ret0s = long_to_scm (ret0);
+  callout_pop (tos0);
+  return (ret0s);
+}
+void
+Scm_gtk_combo_box_get_active (void)
+{
+  /* Declare. */
+  gint ret0;
+  GtkComboBox * combo;
+
+  /* Init. */
+  check_number_of_args (2);
+  combo = (GtkComboBox *) arg_pointer (2);
+
+  /* Call. */
+  callout_seal (&Scm_continue_gtk_combo_box_get_active);
+  ret0 = gtk_combo_box_get_active (combo);
+
+  /* Save. */
+  callout_unseal (&Scm_continue_gtk_combo_box_get_active);
+  CSTACK_PUSH (gint, ret0);
+
+  callout_continue (&Scm_continue_gtk_combo_box_get_active);
+  /* NOTREACHED */
+}
+
+SCM
+Scm_continue_gtk_label_new (void)
+{
+  /* Declare. */
+  char * tos0;
+  GtkWidget * ret0;
+  SCM ret0s;
+
+  /* Restore. */
+  tos0 = callout_lunseal (&Scm_continue_gtk_label_new);
+  CSTACK_LPOP (GtkWidget *, ret0, tos0);
+
+  /* Return. */
+  ret0s = pointer_to_scm (ret0);
+  callout_pop (tos0);
+  return (ret0s);
+}
+void
+Scm_gtk_label_new (void)
+{
+  /* Declare. */
+  GtkWidget * ret0;
+  const char * str;
+
+  /* Init. */
+  check_number_of_args (3);
+  str = (const char *) arg_pointer (3);
+
+  /* Call. */
+  callout_seal (&Scm_continue_gtk_label_new);
+  ret0 = gtk_label_new (str);
+
+  /* Save. */
+  callout_unseal (&Scm_continue_gtk_label_new);
+  CSTACK_PUSH (GtkWidget *, ret0);
+
+  callout_continue (&Scm_continue_gtk_label_new);
+  /* NOTREACHED */
+}
+
+SCM
+Scm_continue_gtk_hbox_new (void)
+{
+  /* Declare. */
+  char * tos0;
+  GtkWidget * ret0;
+  SCM ret0s;
+
+  /* Restore. */
+  tos0 = callout_lunseal (&Scm_continue_gtk_hbox_new);
+  CSTACK_LPOP (GtkWidget *, ret0, tos0);
+
+  /* Return. */
+  ret0s = pointer_to_scm (ret0);
+  callout_pop (tos0);
+  return (ret0s);
+}
+void
+Scm_gtk_hbox_new (void)
+{
+  /* Declare. */
+  GtkWidget * ret0;
+  gboolean homogeneous;
+  gint spacing;
+
+  /* Init. */
+  check_number_of_args (4);
+  homogeneous = arg_long (3);
+  spacing = arg_long (4);
+
+  /* Call. */
+  callout_seal (&Scm_continue_gtk_hbox_new);
+  ret0 = gtk_hbox_new (homogeneous, spacing);
+
+  /* Save. */
+  callout_unseal (&Scm_continue_gtk_hbox_new);
+  CSTACK_PUSH (GtkWidget *, ret0);
+
+  callout_continue (&Scm_continue_gtk_hbox_new);
+  /* NOTREACHED */
+}
+
+SCM
+Scm_continue_gtk_container_add (void)
+{
+  /* Declare. */
+  char * tos0;
+  SCM ret0s;
+
+  /* Restore. */
+  tos0 = callout_lunseal (&Scm_continue_gtk_container_add);
+
+  /* Return. */
+  ret0s = unspecific();
+  callout_pop (tos0);
+  return (ret0s);
+}
+void
+Scm_gtk_container_add (void)
+{
+  /* Declare. */
+  GtkContainer * container;
+  GtkWidget * widget;
+
+  /* Init. */
+  check_number_of_args (3);
+  container = (GtkContainer *) arg_pointer (2);
+  widget = (GtkWidget *) arg_pointer (3);
+
+  /* Call. */
+  callout_seal (&Scm_continue_gtk_container_add);
+  gtk_container_add (container, widget);
+
+  /* Save. */
+  callout_unseal (&Scm_continue_gtk_container_add);
+
+  callout_continue (&Scm_continue_gtk_container_add);
+  /* NOTREACHED */
+}
+
+SCM
+Scm_continue_gtk_window_set_title (void)
+{
+  /* Declare. */
+  char * tos0;
+  SCM ret0s;
+
+  /* Restore. */
+  tos0 = callout_lunseal (&Scm_continue_gtk_window_set_title);
+
+  /* Return. */
+  ret0s = unspecific();
+  callout_pop (tos0);
+  return (ret0s);
+}
+void
+Scm_gtk_window_set_title (void)
+{
+  /* Declare. */
+  GtkWindow * window;
+  const gchar * title;
+
+  /* Init. */
+  check_number_of_args (3);
+  window = (GtkWindow *) arg_pointer (2);
+  title = (const gchar *) arg_pointer (3);
+
+  /* Call. */
+  callout_seal (&Scm_continue_gtk_window_set_title);
+  gtk_window_set_title (window, title);
+
+  /* Save. */
+  callout_unseal (&Scm_continue_gtk_window_set_title);
+
+  callout_continue (&Scm_continue_gtk_window_set_title);
+  /* NOTREACHED */
+}
+
+SCM
+Scm_continue_gtk_container_set_border_width (void)
+{
+  /* Declare. */
+  char * tos0;
+  SCM ret0s;
+
+  /* Restore. */
+  tos0 = callout_lunseal (&Scm_continue_gtk_container_set_border_width);
+
+  /* Return. */
+  ret0s = unspecific();
+  callout_pop (tos0);
+  return (ret0s);
+}
+void
+Scm_gtk_container_set_border_width (void)
+{
+  /* Declare. */
+  GtkContainer * container;
+  guint border_width;
+
+  /* Init. */
+  check_number_of_args (3);
+  container = (GtkContainer *) arg_pointer (2);
+  border_width = arg_ulong (3);
+
+  /* Call. */
+  callout_seal (&Scm_continue_gtk_container_set_border_width);
+  gtk_container_set_border_width (container, border_width);
+
+  /* Save. */
+  callout_unseal (&Scm_continue_gtk_container_set_border_width);
+
+  callout_continue (&Scm_continue_gtk_container_set_border_width);
+  /* NOTREACHED */
+}
+
+SCM
+Scm_continue_gtk_window_resize (void)
+{
+  /* Declare. */
+  char * tos0;
+  SCM ret0s;
+
+  /* Restore. */
+  tos0 = callout_lunseal (&Scm_continue_gtk_window_resize);
+
+  /* Return. */
+  ret0s = unspecific();
+  callout_pop (tos0);
+  return (ret0s);
+}
+void
+Scm_gtk_window_resize (void)
+{
+  /* Declare. */
+  GtkWindow * window;
+  gint width;
+  gint height;
+
+  /* Init. */
+  check_number_of_args (4);
+  window = (GtkWindow *) arg_pointer (2);
+  width = arg_long (3);
+  height = arg_long (4);
+
+  /* Call. */
+  callout_seal (&Scm_continue_gtk_window_resize);
+  gtk_window_resize (window, width, height);
+
+  /* Save. */
+  callout_unseal (&Scm_continue_gtk_window_resize);
+
+  callout_continue (&Scm_continue_gtk_window_resize);
+  /* NOTREACHED */
+}
+
+SCM
+Scm_continue_gtk_widget_show_all (void)
+{
+  /* Declare. */
+  char * tos0;
+  SCM ret0s;
+
+  /* Restore. */
+  tos0 = callout_lunseal (&Scm_continue_gtk_widget_show_all);
+
+  /* Return. */
+  ret0s = unspecific();
+  callout_pop (tos0);
+  return (ret0s);
+}
+void
+Scm_gtk_widget_show_all (void)
+{
+  /* Declare. */
+  GtkWidget * widget;
+
+  /* Init. */
+  check_number_of_args (2);
+  widget = (GtkWidget *) arg_pointer (2);
+
+  /* Call. */
+  callout_seal (&Scm_continue_gtk_widget_show_all);
+  gtk_widget_show_all (widget);
+
+  /* Save. */
+  callout_unseal (&Scm_continue_gtk_widget_show_all);
+
+  callout_continue (&Scm_continue_gtk_widget_show_all);
+  /* NOTREACHED */
+}
+
+SCM
+Scm_continue_g_signal_connect (void)
+{
+  /* Declare. */
+  char * tos0;
+  SCM ret0s;
+
+  /* Restore. */
+  tos0 = callout_lunseal (&Scm_continue_g_signal_connect);
+
+  /* Return. */
+  ret0s = unspecific();
+  callout_pop (tos0);
+  return (ret0s);
+}
+void
+Scm_g_signal_connect (void)
+{
+  /* Declare. */
+  GtkObject * object;
+  gchar * name;
+  GtkSignalFunc CALLBACK;
+  gpointer ID;
+
+  /* Init. */
+  check_number_of_args (5);
+  object = (GtkObject *) arg_pointer (2);
+  name = (gchar *) arg_pointer (3);
+  CALLBACK = (GtkSignalFunc) arg_alien_entry (4);
+  ID = (gpointer) arg_long (5);
+
+  /* Call. */
+  callout_seal (&Scm_continue_g_signal_connect);
+  g_signal_connect (object, name, CALLBACK, ID);
+
+  /* Save. */
+  callout_unseal (&Scm_continue_g_signal_connect);
+
+  callout_continue (&Scm_continue_g_signal_connect);
+  /* NOTREACHED */
+}
+
+SCM
+Scm_continue_gtk_widget_destroy (void)
+{
+  /* Declare. */
+  char * tos0;
+  SCM ret0s;
+
+  /* Restore. */
+  tos0 = callout_lunseal (&Scm_continue_gtk_widget_destroy);
+
+  /* Return. */
+  ret0s = unspecific();
+  callout_pop (tos0);
+  return (ret0s);
+}
+void
+Scm_gtk_widget_destroy (void)
+{
+  /* Declare. */
+  GtkWidget * widget;
+
+  /* Init. */
+  check_number_of_args (2);
+  widget = (GtkWidget *) arg_pointer (2);
+
+  /* Call. */
+  callout_seal (&Scm_continue_gtk_widget_destroy);
+  gtk_widget_destroy (widget);
+
+  /* Save. */
+  callout_unseal (&Scm_continue_gtk_widget_destroy);
+
+  callout_continue (&Scm_continue_gtk_widget_destroy);
+  /* NOTREACHED */
+}
+
+SCM
+Scm_continue_gtk_label_get_text (void)
+{
+  /* Declare. */
+  char * tos0;
+  const gchar * ret0;
+  SCM ret0s;
+
+  /* Restore. */
+  tos0 = callout_lunseal (&Scm_continue_gtk_label_get_text);
+  CSTACK_LPOP (const gchar *, ret0, tos0);
+
+  /* Return. */
+  ret0s = pointer_to_scm (ret0);
+  callout_pop (tos0);
+  return (ret0s);
+}
+void
+Scm_gtk_label_get_text (void)
+{
+  /* Declare. */
+  const gchar * ret0;
+  GtkLabel * label;
+
+  /* Init. */
+  check_number_of_args (3);
+  label = (GtkLabel *) arg_pointer (3);
+
+  /* Call. */
+  callout_seal (&Scm_continue_gtk_label_get_text);
+  ret0 = gtk_label_get_text (label);
+
+  /* Save. */
+  callout_unseal (&Scm_continue_gtk_label_get_text);
+  CSTACK_PUSH (const gchar *, ret0);
+
+  callout_continue (&Scm_continue_gtk_label_get_text);
+  /* NOTREACHED */
+}
+
+SCM
+Scm_continue_gtk_label_set_text (void)
+{
+  /* Declare. */
+  char * tos0;
+  SCM ret0s;
+
+  /* Restore. */
+  tos0 = callout_lunseal (&Scm_continue_gtk_label_set_text);
+
+  /* Return. */
+  ret0s = unspecific();
+  callout_pop (tos0);
+  return (ret0s);
+}
+void
+Scm_gtk_label_set_text (void)
+{
+  /* Declare. */
+  GtkLabel * label;
+  const char * str;
+
+  /* Init. */
+  check_number_of_args (3);
+  label = (GtkLabel *) arg_pointer (2);
+  str = (const char *) arg_pointer (3);
+
+  /* Call. */
+  callout_seal (&Scm_continue_gtk_label_set_text);
+  gtk_label_set_text (label, str);
+
+  /* Save. */
+  callout_unseal (&Scm_continue_gtk_label_set_text);
+
+  callout_continue (&Scm_continue_gtk_label_set_text);
+  /* NOTREACHED */
+}
+
+SCM
+Scm_continue_gtk_main (void)
+{
+  /* Declare. */
+  char * tos0;
+  SCM ret0s;
+
+  /* Restore. */
+  tos0 = callout_lunseal (&Scm_continue_gtk_main);
+
+  /* Return. */
+  ret0s = unspecific();
+  callout_pop (tos0);
+  return (ret0s);
+}
+void
+Scm_gtk_main (void)
+{
+  /* Declare. */
+
+  /* Init. */
+  check_number_of_args (1);
+
+  /* Call. */
+  callout_seal (&Scm_continue_gtk_main);
+  gtk_main ();
+
+  /* Save. */
+  callout_unseal (&Scm_continue_gtk_main);
+
+  callout_continue (&Scm_continue_gtk_main);
+  /* NOTREACHED */
+}
+
+SCM
+Scm_continue_gtk_main_quit (void)
+{
+  /* Declare. */
+  char * tos0;
+  SCM ret0s;
+
+  /* Restore. */
+  tos0 = callout_lunseal (&Scm_continue_gtk_main_quit);
+
+  /* Return. */
+  ret0s = unspecific();
+  callout_pop (tos0);
+  return (ret0s);
+}
+void
+Scm_gtk_main_quit (void)
+{
+  /* Declare. */
+
+  /* Init. */
+  check_number_of_args (1);
+
+  /* Call. */
+  callout_seal (&Scm_continue_gtk_main_quit);
+  gtk_main_quit ();
+
+  /* Save. */
+  callout_unseal (&Scm_continue_gtk_main_quit);
+
+  callout_continue (&Scm_continue_gtk_main_quit);
+  /* NOTREACHED */
+}
+
+static void
+Scm_kernel_delete_event (void)
+{
+  /* Declare. */
+  GtkWidget * window;
+  GdkEventAny * event;
+  gpointer ID;
+  SCM arglist0;
+  char * tos0;
+
+  /* Init. */
+  tos0 = callback_lunseal (&Scm_kernel_delete_event);
+  CSTACK_LPOP (GtkWidget *, window, tos0);
+  CSTACK_LPOP (GdkEventAny *, event, tos0);
+  CSTACK_LPOP (gpointer, ID, tos0);
+
+  /* Construct. */
+  arglist0 = empty_list();
+  arglist0 = cons (cons_alien((void*)event), arglist0);
+  arglist0 = cons (cons_alien((void*)window), arglist0);
+  callback_run_handler ((int)ID, arglist0);
+
+  callback_return (tos0);
+}
+gboolean
+Scm_delete_event (GtkWidget * window, GdkEventAny * event, gpointer ID)
+{
+  CSTACK_PUSH (gpointer, ID);
+  CSTACK_PUSH (GdkEventAny *, event);
+  CSTACK_PUSH (GtkWidget *, window);
+  callback_run_kernel ((int)ID, (CallbackKernel)&Scm_kernel_delete_event);
+  return (long_value ());
+}
+
+static void
+Scm_kernel_changed (void)
+{
+  /* Declare. */
+  GtkComboBox * widget;
+  gpointer ID;
+  SCM arglist0;
+  char * tos0;
+
+  /* Init. */
+  tos0 = callback_lunseal (&Scm_kernel_changed);
+  CSTACK_LPOP (GtkComboBox *, widget, tos0);
+  CSTACK_LPOP (gpointer, ID, tos0);
+
+  /* Construct. */
+  arglist0 = empty_list();
+  arglist0 = cons (cons_alien((void*)widget), arglist0);
+  callback_run_handler ((int)ID, arglist0);
+
+  callback_return (tos0);
+}
+void
+Scm_changed (GtkComboBox * widget, gpointer ID)
+{
+  CSTACK_PUSH (gpointer, ID);
+  CSTACK_PUSH (GtkComboBox *, widget);
+  callback_run_kernel ((int)ID, (CallbackKernel)&Scm_kernel_changed);
+  return;
+}
+
+static void
+Scm_kernel_clicked (void)
+{
+  /* Declare. */
+  GtkWidget * widget;
+  gpointer ID;
+  SCM arglist0;
+  char * tos0;
+
+  /* Init. */
+  tos0 = callback_lunseal (&Scm_kernel_clicked);
+  CSTACK_LPOP (GtkWidget *, widget, tos0);
+  CSTACK_LPOP (gpointer, ID, tos0);
+
+  /* Construct. */
+  arglist0 = empty_list();
+  arglist0 = cons (cons_alien((void*)widget), arglist0);
+  callback_run_handler ((int)ID, arglist0);
+
+  callback_return (tos0);
+}
+void
+Scm_clicked (GtkWidget * widget, gpointer ID)
+{
+  CSTACK_PUSH (gpointer, ID);
+  CSTACK_PUSH (GtkWidget *, widget);
+  callback_run_kernel ((int)ID, (CallbackKernel)&Scm_kernel_clicked);
+  return;
+}
diff --git a/final_project/work/prhello-types.bin b/final_project/work/prhello-types.bin
new file mode 100644
index 0000000..4bfc808
--- /dev/null
+++ b/final_project/work/prhello-types.bin
diff --git a/final_project/work/prhello.cdecl b/final_project/work/prhello.cdecl
new file mode 100644
index 0000000..26b8882
--- /dev/null
+++ b/final_project/work/prhello.cdecl
@@ -0,0 +1,115 @@
+     #| -*-Scheme-*-
+     
+     C declarations for prhello.scm. |#
+     
+     
+     (typedef gint int)
+     (typedef guint uint)
+     (typedef gchar char)
+     (typedef gboolean gint)
+     (typedef gpointer (* mumble))
+     
+     (extern void
+     	gtk_init
+     	(argc (* int))
+     	(argv (* (* (* char)))))
+     
+     (extern (* GtkWidget)
+     	gtk_window_new
+     	(type GtkWindowType))
+
+     (typedef GtkWindowType
+     	 (enum
+     	  (GTK_WINDOW_TOPLEVEL)
+     	  (GTK_WINDOW_POPUP)))
+     
+     (extern (* GtkWidget)
+     	gtk_button_new)
+
+     (extern (* GtkWidget)
+     	gtk_combo_box_new_text)
+
+     (extern void
+     	gtk_combo_box_append_text
+     	(combo (* GtkComboBox))
+     	(str (* (const char))))
+
+     (extern gint
+	     gtk_combo_box_get_active     
+     	(combo (* GtkComboBox)))
+
+     (extern (* GtkWidget)
+     	gtk_label_new
+     	(str (* (const char))))
+     
+     (extern (* GtkWidget)
+     	gtk_hbox_new
+	(homogeneous gboolean)
+	(spacing gint))
+    
+
+     (extern void
+     	gtk_container_add
+     	(container (* GtkContainer))
+     	(widget    (* GtkWidget)))
+     
+     (extern void
+     	gtk_window_set_title
+     	(window (* GtkWindow))
+     	(title  (* (const gchar))))
+     
+     (extern void
+     	gtk_container_set_border_width
+     	(container (* GtkContainer))
+     	(border_width guint))
+      
+     (extern void
+     	gtk_window_resize
+     	(window (* GtkWindow))
+     	(width gint)
+     	(height gint))
+     
+     (extern void
+     	gtk_widget_show_all
+     	(widget (* GtkWidget)))
+     
+     (extern void
+     	g_signal_connect
+     	(object (* GtkObject))
+     	(name (* gchar))
+     	(CALLBACK GtkSignalFunc)
+     	(ID gpointer))
+     
+     (typedef GtkSignalFunc (* mumble))
+     
+     (callback gboolean
+     	  delete_event
+     	  (window (* GtkWidget))
+     	  (event (* GdkEventAny))
+     	  (ID gpointer))
+
+     (callback void
+     	  changed
+     	  (widget (* GtkComboBox))
+     	  (ID gpointer))
+     
+     (callback void
+     	  clicked
+     	  (widget (* GtkWidget))
+     	  (ID gpointer))
+     
+     (extern void
+     	gtk_widget_destroy
+     	(widget (* GtkWidget)))
+     
+     (extern (* (const gchar))
+     	gtk_label_get_text
+     	(label (* GtkLabel)))
+     
+     (extern void
+     	gtk_label_set_text
+     	(label (* GtkLabel))
+     	(str (* (const char))))
+     
+     (extern void gtk_main)
+     (extern void gtk_main_quit)
diff --git a/final_project/work/prhello.scm b/final_project/work/prhello.scm
new file mode 100644
index 0000000..c57f6f9
--- /dev/null
+++ b/final_project/work/prhello.scm
@@ -0,0 +1,77 @@
+     #| -*-Scheme-*-
+     
+     $Id: $
+     |#
+     
+     (declare (usual-integrations))
+
+     
+     (load "ghelper.scm")
+     (load "discovery.scm")
+     (load-option 'FFI)
+     (C-include "prhello")
+(load "generic-string-opers.scm")
+
+(define get-vals car)
+(define (get-proc-symbols input) (map car (cdr input)))
+(define (apply-ith-thunk input i) ((cadr (list-ref (cdr input) i))))
+
+
+(define (thing-to-string thing)
+ (let ((buff (open-output-string)))
+   (display thing buff)
+   (get-output-string buff)))
+
+(define (discover-gui . input)
+					;(display (discover:named-opers-for 1))
+  (C-call "gtk_init" 0 null-alien)
+  (let* ((discovered-opers (apply discover:thunklist-for input))
+	 (window (let ((alien (make-alien '|GtkWidget|)))
+		   (C-call "gtk_window_new" alien
+			   (C-enum "GTK_WINDOW_TOPLEVEL"))
+		   (if (alien-null? alien) (error "Could not create window."))
+		       alien))
+	 (hbox (let ((alien (make-alien '|GtkWidget|)))
+		 (C-call "gtk_hbox_new" alien 0 20)
+		 (if (alien-null? alien) (error "Could not create hbox."))
+		 alien))
+	 (combo (let ((alien (make-alien '|GtkWidget|)))
+		  (C-call "gtk_combo_box_new_text" alien)
+		  (if (alien-null? alien) (error "Could not create combo."))
+		  alien))
+	 (labels (map (lambda (val) 
+			(let ((alien (make-alien '|GtkWidget|)))
+			  (C-call "gtk_label_new" alien (thing-to-string val))
+			  (if (alien-null? alien) (error "Could not create label."))
+			  alien))
+		      (get-vals discovered-opers))))
+    (for-each (lambda (proc-symbol)
+		(C-call "gtk_combo_box_append_text" combo (thing-to-string proc-symbol)))
+	      (get-proc-symbols discovered-opers))
+				
+    (for-each (lambda (label) (C-call "gtk_container_add" hbox label)) labels)
+    (C-call "gtk_container_add" hbox combo)
+    (C-call "gtk_container_add" window hbox)
+    (C-call "gtk_window_set_title" window "Generic Operator Discovery")
+    (C-call "gtk_container_set_border_width" window 10)
+    (C-call "gtk_window_resize" window 250 20)
+    (C-call "g_signal_connect" combo "changed"
+	    (C-callback "changed")	;trampoline
+	    (C-callback			;callback ID
+	     (lambda (w)
+	       (let ((i (C-call "gtk_combo_box_get_active" combo)))
+		 (discover-gui (apply-ith-thunk discovered-opers i))))))
+
+    (C-call "g_signal_connect" window "delete_event"
+	    (C-callback "delete_event")	;trampoline
+	    (C-callback			;callback ID
+	     (lambda (w e)
+	       (begin
+		 (C-call "gtk_main_quit")
+		 0))))
+    (C-call "gtk_widget_show_all" window)
+    (C-call "gtk_main")
+    window))
+      
+
+