[UPDATE] I fit some examples with binding-check

diff --git a/example/bool.scm b/example/bool.scm
index 7483e42..cbef108 100644 (file)
--- a/example/bool.scm
+++ b/example/bool.scm
@@ -1,4 +1,6 @@
 ;;; big
+(external <)
+(external print)
 (print (if (< 1 42)
           "big"
           "small"))

diff --git a/example/class.scm b/example/class.scm
index 8a2b135..4cd607b 100644 (file)
--- a/example/class.scm
+++ b/example/class.scm
@@ -5,7 +5,8 @@
 ;;; 10
 ;;; 10
 ;;; [object Foo]
-
+(external print)
+(external-class Object ())
 
 (define-class Foo (Object) (x y))
 (define-method init ([self Foo] x)

diff --git a/example/dup.scm b/example/dup.scm
deleted file mode 100644 (file)
index 0993a20..0000000
--- a/example/dup.scm
+++ /dev/null
@@ -1,10 +0,0 @@
-;;; [class A]
-;;; [class B]
-;;; [class C]
-
-(define-class A (Object) ())
-(define-class B (Object) ())
-(define-class C (Object) ())
-(print A)
-(print B)
-(print C)
\ No newline at end of file

diff --git a/example/expr.scm b/example/expr.scm
index 66e6786..676048e 100644 (file)
--- a/example/expr.scm
+++ b/example/expr.scm
@@ -3,6 +3,12 @@
 ;;; 54
 ;;; 0.3333333333333333
 ;;; 3.2
+(external +)
+(external +.)
+(external -)
+(external *)
+(external /)
+(external print)
 
 (print (+ -1 2))
 (print (- 4 (+ 1 2)))

diff --git a/example/hello.scm b/example/hello.scm
index f324724..ac78545 100644 (file)
--- a/example/hello.scm
+++ b/example/hello.scm
@@ -2,4 +2,5 @@
 ;;
 ;; expect output:
 ;;; Hello,world!!
+(external print)
 (print "Hello,world!!")
\ No newline at end of file

diff --git a/example/lambda.scm b/example/lambda.scm
index e3e62ca..bbb4943 100644 (file)
--- a/example/lambda.scm
+++ b/example/lambda.scm
@@ -1,5 +1,8 @@
 ;;; 3
 ;;; 2
+(external +)
+(external print)
+
 (let ((inc (lambda (x) (+ 1 x))))
   (print (inc 2)))
 

diff --git a/example/let.scm b/example/let.scm
index ba22745..d0c3718 100644 (file)
--- a/example/let.scm
+++ b/example/let.scm
@@ -1,5 +1,7 @@
 ;;; inner scope: 10
 ;;; outer scope: 42
+(external print)
+
 (let ((x 42))
   (let ((x 10))
     (print "inner scope:" x))

diff --git a/example/list.scm b/example/list.scm
index 9a39b32..9cb82dc 100644 (file)
--- a/example/list.scm
+++ b/example/list.scm
@@ -1,6 +1,7 @@
 ;;; 1
 ;;; 2
 ;;; 3
+(external-class Object ())
 
 (define-class List (Object) ())
 (define-class Cons (List) (head tail))

diff --git a/example/literal.scm b/example/literal.scm
index 83ff52b..e45660f 100644 (file)
--- a/example/literal.scm
+++ b/example/literal.scm
@@ -3,6 +3,7 @@
 ;;; true
 ;;; false
 ;;; 42.5
+(external print)
 (print 42)
 (print "Thanks for all the fish")
 (print #t)

diff --git a/example/rec.scm b/example/rec.scm
index 6baccd1..a31880f 100644 (file)
--- a/example/rec.scm
+++ b/example/rec.scm
@@ -4,6 +4,14 @@
 ;;;  3628800
 ;;;  3628800
 
+(external *)
+(external +)
+(external -)
+(external print)
+(external =)
+(external <=)
+
+
 ;; check if not recursion
 (let ([f (lambda (n) (print "not rec"))])
   (let ([f (lambda (n) (if (= n 0)

diff --git a/example/slot_ref.scm b/example/slot_ref.scm
index 34df389..68afe79 100644 (file)
--- a/example/slot_ref.scm
+++ b/example/slot_ref.scm
@@ -2,6 +2,8 @@
 ;;; 42
 ;;; 10
 ;;; 1
+(external-class Object ())
+(external print)
 (define-class Foo (Object) (x y z))
 
 (define foo (new Foo))

diff --git a/src/closTrans.ml b/src/closTrans.ml
index 747c0f6..6253793 100644 (file)
--- a/src/closTrans.ml
+++ b/src/closTrans.ml
@@ -68,8 +68,8 @@ let trans program =
 
 let to_string =
   function
-      #Ast.stmt as stmt ->
-       Ast.to_string_stmt stmt
+    | #BindCheck.stmt as stmt ->
+       BindCheck.to_string_stmt stmt
     | `DefineClass (name,super,attrs) ->
        Printf.sprintf "Class (%s,%s,%s)"
          (Node.to_string id name)
@@ -81,5 +81,4 @@ let to_string =
          Printf.sprintf "Metod (%s,((%s %s) %s),%s)" 
          (show f) (show self) (show klass) 
          (string_of_list (List.map show args)) (Ast.to_string body)
-    | _ ->
-       ""
+

diff --git a/test/astUtil.ml b/test/astUtil.ml
index aad9b1c..a3914db 100644 (file)
--- a/test/astUtil.ml
+++ b/test/astUtil.ml
@@ -76,6 +76,11 @@ let eq_clos a b =
          eq_ident obj obj' &&
          (List.for_all2 eq_ident args args') &&
          eq_expr body body'
+       
+    | `External name , `External name' ->
+       eq_ident name name'
+    | `ExternalClass ({value=name},methods), `ExternalClass ({value=name'},methods') ->
+       name = name' && List.for_all2 eq_ident methods methods'
     | a,b ->
        eq_stmt a b
 

diff --git a/test/test_clostrans.ml b/test/test_clostrans.ml
index 5f495e5..29633e1 100644 (file)
--- a/test/test_clostrans.ml
+++ b/test/test_clostrans.ml
@@ -95,6 +95,12 @@ let _ =
            trans [define_class  "Foo" ("bar","Baz") [];
                   define_method "f" "self" "Foo" ["x"] (int 42);
                   `Expr (`Call [var "f";var "obj";int 10])]);
+     "invoke" >::
+       (fun () ->
+         ok [`ExternalClass (node ("","Foo"),[node "f"]);
+             `Expr (`Invoke (var "obj",node "f",[int 10]))] @@
+           trans [`ExternalClass (node ("","Foo"),[node "f"]);            
+                  `Expr (`Call [var "f";var "obj";int 10])]);
      "invoke deep" >::
        (fun () ->
          ok [`Expr (`If (`Invoke (var "obj",node "f",[int 10]),

diff --git a/test/test_lisp.ml b/test/test_lisp.ml
index c1469d7..c3e1ebd 100644 (file)
--- a/test/test_lisp.ml
+++ b/test/test_lisp.ml
@@ -214,6 +214,13 @@ let _ =
          ok [`Define (node "f",`Lambda ([node "x"],
                                         `Block [int 42]))] 
            "(define (f x) 42)");
+     "external" >::
+       (fun () ->
+         ok [`External (node "x")] "(external x)");
+     "external-class" >::
+       (fun () ->
+         ok [`ExternalClass (node ("","X"),[node "f"; node "g"; node "h"])] 
+           "(external-class X (f g h))");
      "bug()" >::
        (fun () ->
          ok [`Expr (int 10);