euslisp / EusLisp

EusLisp is an integrated programming system for the research on intelligent robots based on Common Lisp and Object-Oriented programming. [Manual](http://euslisp.github.io/EusLisp/manual.html ) [マニュアル](http://euslisp.github.io/EusLisp/jmanual.html )
Other
56 stars 50 forks source link

(eps= 1 1.0) が nil になる #406

Open k-okada opened 4 years ago

k-okada commented 4 years ago
1.eusgl$ eps= 0 0.0
t
2.eusgl$ eps= 1 1.0
nil

となります.これは, https://github.com/euslisp/EusLisp/blob/41c497d0befb29561ab23e664a1c3a51eb17fc16/lisp/geo/geopack.l#L197-L199(declare (type float m n eps))のお陰で,通常なら

static pointer F89eps_(ctx,n,argv,env)
register context *ctx;
register int n; register pointer argv[]; pointer env;
{ register pointer *local=ctx->vsp, w, *fqv=qv;
  numunion nu;
        if (n<2) maerror();
        if (n>=3) { local[0]=(argv[2]); goto ENT159;}
        local[0]= loadglobal(fqv[16]);
ENT159:
ENT158:
        if (n>3) maerror();
        local[1]= argv[0];
        local[2]= argv[1];
        ctx->vsp=local+3;
        w=(pointer)MINUS(ctx,2,local+1); /*-*/
        local[1]= w;
        ctx->vsp=local+2;
        w=(pointer)ABS(ctx,1,local+1); /*abs*/
        local[1]= w;
        local[2]= local[0];
        ctx->vsp=local+3;
        w=(pointer)LESSP(ctx,2,local+1); /*<*/
        local[0]= w;
BLK156:
        ctx->vsp=local; return(local[0]);}

とコンパイルされるところが

static pointer F86eps2_(ctx,n,argv,env)
register context *ctx;
register int n; register pointer argv[]; pointer env;
{ register pointer *local=ctx->vsp, w, *fqv=qv;
  numunion nu;
        if (n<2) maerror();
        if (n>=3) { local[0]=(argv[2]); goto ENT135;}
        local[0]= loadglobal(fqv[16]);
ENT135:
ENT134:
        if (n>3) maerror();
        local[1]= argv[0];
        { double x,y;
                y=fltval(argv[1]); x=fltval(local[1]);
                local[1]=(makeflt(x - y));}
        local[1]= makeflt((double)fabs(fltval(local[1])));
        local[2]= local[0];
        ctx->vsp=local+3;
        w=(pointer)LESSP(ctx,2,local+1); /*<*/
        local[0]= w;
BLK132:
        ctx->vsp=local; return(local[0]);}

となっているからのようです.ちなみにこの効果がどれぐらいあるか,ですが, https://gist.github.com/k-okada/39732bdcbf44b485378612dbc39ecb9d を実行してみると1.3-1.8 倍ぐらい速くなっています.

... declare 有り
(eps= 2   2.0) ;; 0.230666[s]
(eps= 2.0 2.0) ;; 0.220226[s]
... declare 有り
(eps= 2   2.0) ;; 0.222742[s]
(eps= 2.0 2.0) ;; 0.204248[s]
... declare 無し
(eps= 2   2.0) ;; 0.36795[s]
(eps= 2.0 2.0) ;; 0.315143[s]

そもそもは型チェックをしない代わりに高速なコードを生成するのが目的なので, すこし対応としてはずれますが, エラーチェックをする,あるいは,方をチェックする,という方法ですが, https://github.com/euslisp/EusLisp/blob/master/lisp/c/eus.h#L818-L822 を使って

diff --git a/lisp/comp/trans.l b/lisp/comp/trans.l
index ab801270..5fd1775b 100644
--- a/lisp/comp/trans.l
+++ b/lisp/comp/trans.l
@@ -499,7 +499,7 @@
  (:flt-op2 (op)
     (format cfile "    { double x,y;~%")
     (format cfile 
-   "               y=fltval(~A); x=fltval(~A);~%"
+ "           y=ckfltval(~A); x=ckfltval(~A);~%"
        (send self :pop) (send self :pop))
     (format cfile
        "               local[~d]=(makeflt(x ~A y));}~%"

とすると,

;; declare 有り
(eps= 2   2.0) ;; 0.302843[s]
(eps= 2.0 2.0) ;; 0.230271[s]
;; declare 有り
(eps= 2   2.0) ;; 0.285085[s]
(eps= 2.0 2.0) ;; 0.232271[s]
;; declare 無し
(eps= 2   2.0) ;; 0.371205[s]
(eps= 2.0 2.0) ;; 0.310996[s]

となり,110-150%程時間が掛かるようです. ちゃと仕様どおり引数に実数を入れていても110%程になる,ということで, これをどう見るか?ワーニングを出すものと,型をキャストするコードにはそこまで速度は変わらず, 結局,型をキャストするかどうか?するならワーニングを出すべきか,という判断になりそうです.

diff --git a/lisp/comp/trans.l b/lisp/comp/trans.l
index ab801270..f62cb2e1 100644
--- a/lisp/comp/trans.l
+++ b/lisp/comp/trans.l
@@ -497,10 +497,14 @@
         (t (send self :error "illegal compare"))))
 ;;; floating arithemtics
  (:flt-op2 (op)
-    (format cfile "        { double x,y;~%")
-    (format cfile 
-   "               y=fltval(~A); x=fltval(~A);~%"
+    (format cfile "  { double x,y; pointer a0,a1;~%")
+    (format cfile
+ "           a0=~A; a1=~A;~%"
        (send self :pop) (send self :pop))
+    (format cfile
+ "           if(!(isflt(a0)&&isflt(a1))){fprintf(stderr,\"WARNING: float expected .. \");struct callframe *vf=(struct callframe *)(ctx->callfp);prinx(ctx,vf->form, ERROUT);flushstream(ERROUT);fprintf(stderr,\"\\n\");}~%")
+    (format cfile
+ "           y=ckfltval(a0); x=ckfltval(a1);~%")
     (format cfile
        "               local[~d]=(makeflt(x ~A y));}~%"
        pushcount
Affonso-Gui commented 1 year ago

Luckily for us the eps= is still under-optimized (why are we using LESSP even when both arguments have been declared as float?), so we can implement a solution that has both better performance and is type-safe.

/*my-eps=*/
static pointer testF1my_eps_(ctx,n,argv,env)
register context *ctx;
register int n; register pointer argv[]; pointer env;
{ register pointer *local=ctx->vsp, w, *fqv=qv;
  numunion nu;
  double x,y;
    if (n<2) maerror();
        if (n>3) maerror();
    if (n>=3) { local[0]=(argv[2]); goto testENT11;}
    local[0]= loadglobal(fqv[0]);
testENT11:
        x = fabs(ckfltval(argv[0]) - ckfltval(argv[1]));
        y = ckfltval(local[0]);
        local[0] = x<y?T:NIL;
testBLK9:
    ctx->vsp=local; return(local[0]);}
(defun foo ()
  (dotimes (i 100000000)
    (eps= 1.0 1.0)))

(defun bar ()
  (dotimes (i 100000000)
    (my-eps= 1.0 1.0)))

(defun bar-int ()
  (dotimes (i 100000000)
    (my-eps= 1 1.0)))

(defun bar-int-int ()
  (dotimes (i 100000000)
    (my-eps= 1 1)))
1.irteusgl$ (my-eps= 1 1.0)
t
2.irteusgl$ (my-eps= 1 1.1)
nil
3.irteusgl$ (bench (foo))
;; time -> 2.63216[s]
nil
4.irteusgl$ (bench (bar))
;; time -> 2.31267[s]
nil
5.irteusgl$ (bench (bar-int))
;; time -> 2.76027[s]
nil
6.irteusgl$ (bench (bar-int-int))
;; time -> 3.43548[s]
nil

The time for the optimized and unsafe code was (bench (bar)) ;; time -> 1.92481[s]. Compiling with -O3 made it even faster, with 1.93313[s] for the type-check and 1.64588[s] for the unsafe.