Skip to content

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

@k-okada

Description

@k-okada
1.eusgl$ eps= 0 0.0
t
2.eusgl$ eps= 1 1.0
nil

となります.これは,

EusLisp/lisp/geo/geopack.l

Lines 197 to 199 in 41c497d

(defun eps= (m n &optional (eps *epsilon*))
(declare (type float m n eps))
(< (abs (- m n)) eps))

(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

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions