diff options
-rw-r--r-- | src/cli/runtime/Var.cs | 7 | ||||
-rw-r--r-- | src/lisp/clojure.lisp | 26 | ||||
-rw-r--r-- | src/lisp/test.lisp | 15 | ||||
-rw-r--r-- | src/org/clojure/runtime/Var.java | 7 |
4 files changed, 48 insertions, 7 deletions
diff --git a/src/cli/runtime/Var.cs b/src/cli/runtime/Var.cs index 9114ae9e..46f96654 100644 --- a/src/cli/runtime/Var.cs +++ b/src/cli/runtime/Var.cs @@ -14,7 +14,12 @@ namespace org.clojure.runtime {
public class Var : Indexer
{
-public String name;
public Namespace ns;
public Cons binding;
public IFn fn; //todo, bind to throw stub?
public IFn setfn;
internal Var(String name, Namespace ns)
{
this.ns = ns;
this.name = name;
}
public String toString()
{
if(ns == null)
return "#:" + name;
return ns.name + ":" + name;
}
public Var bind(Object val)
{
if(binding == null)
binding = new Cons(val,null);
else
binding.first = val;
return this;
}
public Cons getBinding(ThreadLocalData tld)
{
Cons b = getDynamicBinding(tld);
if(b != null)
return b;
return binding;
}
public Object getValue(ThreadLocalData tld)
{
Cons binding = getBinding(tld);
if(binding != null)
return binding.first;
throw new InvalidOperationException(this.toString() + " is unbound.");
}
public Object setValue(ThreadLocalData tld, Object val)
{
Cons b = getDynamicBinding(tld);
if(b != null)
return b.first = val;
//allow global set to create binding like this?
if(binding == null)
+public String name;
public Namespace ns;
public Cons binding;
public IFn fn; //todo, bind to throw stub?
public IFn setfn;
internal Var(String name, Namespace ns)
{
this.ns = ns;
this.name = name;
}
public String toString()
{
if(ns == null)
return "#:" + name;
return ns.name + ":" + name;
}
public Var bind(Object val)
{
if(binding == null)
binding = new Cons(val,null);
else
binding.first = val;
+
+ if (val is IFn)
+ this.fn = (IFn)val;
+ else
+ this.fn = null; //todo, bind to throw stub?
return this;
}
public Cons getBinding(ThreadLocalData tld)
{
Cons b = getDynamicBinding(tld);
if(b != null)
return b;
return binding;
}
public Object getValue(ThreadLocalData tld)
{
Cons binding = getBinding(tld);
if(binding != null)
return binding.first;
throw new InvalidOperationException(this.toString() + " is unbound.");
}
public Object setValue(ThreadLocalData tld, Object val)
{
Cons b = getDynamicBinding(tld);
if(b != null)
return b.first = val;
//allow global set to create binding like this?
if(binding == null)
throw new InvalidOperationException(this.toString() + " is unbound.");
if(val is IFn)
this.fn = (IFn) val;
else
this.fn = null; //todo, bind to throw stub?
return binding.first = val;
}
public Cons getDynamicBinding(ThreadLocalData tld)
{
return (Cons) tld.dynamicBindings[this];
}
public Cons pushDynamicBinding(ThreadLocalData tld, Object val)
{
Cons ret = new Cons(val, getDynamicBinding(tld));
tld.dynamicBindings[this] = ret;
return ret;
}
public Cons popDynamicBinding(ThreadLocalData tld)
{
Cons oldb = getDynamicBinding(tld).rest;
tld.dynamicBindings[this] = oldb;
return oldb;
}
override public Object invoke(ThreadLocalData tld) /*throws Exception*/
{
return fn.invoke(tld);
}
override public Object invoke(ThreadLocalData tld, Object arg1) /*throws Exception*/
{
return fn.invoke(tld,arg1);
}
override public Object invoke(ThreadLocalData tld, Object arg1, Object arg2) /*throws Exception*/
{
return fn.invoke(tld,arg1,arg2);
}
override public Object invoke(ThreadLocalData tld, Object arg1, Object arg2, Object arg3) /*throws Exception*/
{
return fn.invoke(tld,arg1,arg2,arg3);
}
override public Object invoke(ThreadLocalData tld, Object arg1, Object arg2, Object arg3, Object arg4) /*throws Exception*/
{
return fn.invoke(tld,arg1,arg2,arg3,arg4);
}
override public Object invoke(ThreadLocalData tld, Object arg1, Object arg2, Object arg3, Object arg4, Object arg5)
/*throws Exception*/
{
return fn.invoke(tld,arg1,arg2,arg3,arg4,arg5);
}
override public Object invoke(ThreadLocalData tld, Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Cons args)
/*throws Exception*/
{
return fn.invoke(tld,arg1,arg2,arg3,arg4,arg5,args);
}
}
}
diff --git a/src/lisp/clojure.lisp b/src/lisp/clojure.lisp index b7a31cf6..e251c9ce 100644 --- a/src/lisp/clojure.lisp +++ b/src/lisp/clojure.lisp @@ -157,7 +157,7 @@ (defun accessor-member-name (symbol) (format nil "ACC__~A__~A" (munge-name (package-name (symbol-package symbol))) - (munge-name (symbol-name symbol)))) + (munge-name (subseq (symbol-name symbol) 1)))) (defun symbol-member-name (symbol) (format nil "SYM__~A" @@ -274,7 +274,7 @@ (format target "static Accessor ~A = Namespace.internAccessor(~S,~S);~%" (accessor-member-name accessor) (munge-name (package-name (symbol-package accessor))) - (munge-name (symbol-name accessor)))) + (munge-name (subseq (symbol-name accessor) 1)))) (format target "~Atry{~%" (begin-static-block class-name)) ;(format target "~%static public void __load() ~A{~%" (exception-declaration-string lang)) (dolist (var *defns*) @@ -403,6 +403,7 @@ (quote (analyze-quote context form)) (|defn*| (analyze-defn* context form)) (|def| (analyze-def context form)) + (|defmain| (analyze-defmain context form)) (|block| (analyze-block context form)) (|fn*| (analyze-fn* context form)) (|if| (analyze-if context form)) @@ -432,6 +433,7 @@ ((typep expr 'hash-table) ;objs (ccase (@ :type expr) (:defn* (emit-defn* context expr)) + (:main (emit-main context expr)) (:fn* (emit-fn* context expr)) (:binding (emit-binding context expr)) (:accessor (emit-accessor context expr)) @@ -1108,6 +1110,26 @@ (emit :statement finally-clause) (format t "}~%"))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; defmain ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun analyze-defmain (context form) + (ccase context + (:top + (register-var-reference (second form)) + (newobj :type :main + :fname (second form))))) + +(defun emit-main (context expr) + (ccase context + (:top + (format t "static public void ~A(String[] args){~%try{~%~A.fn.invoke(ThreadLocalData.get(),args);~%}~%catch(Exception ex){}~%}~%" + (main-string) (var-member-name (@ :fname expr)))))) + +(defun main-string () + (ccase *host* + (:jvm "main") + (:cli "Main"))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; defn ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun analyze-defn* (context form) diff --git a/src/lisp/test.lisp b/src/lisp/test.lisp index 171cb1aa..b5a82a98 100644 --- a/src/lisp/test.lisp +++ b/src/lisp/test.lisp @@ -1,7 +1,7 @@ (in-module "clojure") -#+:JVM(import "java.lang" '(String Class Math)) -#+:CLI(import "System, mscorlib" '(String Type Math)) +#+:JVM(import "java.lang" '(String Class Math System)) +#+:CLI(import "System, mscorlib" '(String Type Math Console)) (defn f0 ()) @@ -135,4 +135,13 @@ (if (Type.GetType "Object") (String.Intern "fred") Math.PI) - (set Math.PI 3.14))
\ No newline at end of file + (set Math.PI 3.14)) + +(defn prn (x) + #+:JVM (.println System.out x) + #+:CLI (Console.WriteLine x)) + +(defn fmain (args) + (prn "Hello World!")) + +(defmain fmain)
\ No newline at end of file diff --git a/src/org/clojure/runtime/Var.java b/src/org/clojure/runtime/Var.java index e4b3dad3..a328ceb4 100644 --- a/src/org/clojure/runtime/Var.java +++ b/src/org/clojure/runtime/Var.java @@ -40,7 +40,12 @@ public Var bind(Object val) else binding.first = val; - return this; + if(val instanceof IFn) + this.fn = (IFn) val; + else + this.fn = null; //todo, bind to throw stub? + + return this; } public Cons getBinding(ThreadLocalData tld) |