This commit is contained in:
zeroflag 2021-07-03 23:17:09 +02:00
parent 7646436036
commit 7dcf22c803
7 changed files with 70 additions and 67 deletions

View file

@ -1,19 +1,19 @@
: <map> ( -- c ) 'com.vectron.fcl.types.Dic/empty' jvm-call-static ; : <map> ( -- c ) :com.vectron.fcl.types.Dic/empty jvm-call-static ;
: <list> ( -- c ) 'com.vectron.fcl.types.Lst/empty' jvm-call-static ; : <list> ( -- c ) :com.vectron.fcl.types.Lst/empty jvm-call-static ;
: size ( c -- n ) 'size' jvm-call-method ; : size ( c -- n ) :size jvm-call-method ;
: put ( c k v -- ) swap rot 'put/OO' jvm-call-method ; : put ( c k v -- ) swap rot :put/OO jvm-call-method ;
: at ( c k -- v ) swap 'at/O' jvm-call-method ; : at ( c k -- v ) swap :at/O jvm-call-method ;
: 1st ( c -- e ) 0 at ; : 1st ( c -- e ) 0 at ;
: 2nd ( c -- e ) 1 at ; : 2nd ( c -- e ) 1 at ;
: clear ( c -- ) 'clear' jvm-call-method ; : clear ( c -- ) :clear jvm-call-method ;
: add ( c v -- ) swap 'append/O' jvm-call-method ; : add ( c v -- ) swap :append/O jvm-call-method ;
: prep ( c v -- ) swap 'prep/O' jvm-call-method ; : prep ( c v -- ) swap :prep/O jvm-call-method ;
: iter ( c -- ) 'iterator' jvm-call-method ; : iter ( c -- ) :iterator jvm-call-method ;
: next? ( i -- ) 'hasNext' jvm-call-method ; : next? ( i -- ) :hasNext jvm-call-method ;
: next ( i -- o ) 'next' jvm-call-method ; : next ( i -- o ) :next jvm-call-method ;
: jvmValue ( p -- o ) 'value' jvm-call-method ; : jvmValue ( p -- o ) :value jvm-call-method ;
: reverse ( l -- l ) 'reverse' jvm-call-method ; : reverse ( l -- l ) :reverse jvm-call-method ;
: format ( l s -- s ) 'format/t' jvm-call-method ; : format ( l s -- s ) :format/t jvm-call-method ;
: each ( c q -- ) : each ( c q -- )
-> q iter -> it -> q iter -> it
@ -80,23 +80,23 @@
loop loop
result ; result ;
: sublst ( l n n -- l ) swap rot 'subList/ii' jvm-call-method ; : sublst ( l n n -- l ) swap rot :subList/ii jvm-call-method ;
: remove-at ( l n -- l ) swap 'removeAt/i' jvm-call-method ; : remove-at ( l n -- l ) swap :removeAt/i jvm-call-method ;
: remove ( l o -- l ) swap 'remove/O' jvm-call-method ; : remove ( l o -- l ) swap :remove/O jvm-call-method ;
: keys ( d -- l ) 'keys' jvm-call-method ; : keys ( d -- l ) :keys jvm-call-method ;
: values ( d -- l ) 'values' jvm-call-method ; : values ( d -- l ) :values jvm-call-method ;
: ... ( lower upper -- lst ) 'com.vectron.fcl.types.Range/create/iii' jvm-call-static ; : ... ( lower upper -- lst ) :com.vectron.fcl.types.Range/create/iii jvm-call-static ;
: .. ( lower upper -- lst ) 1 ... ; : .. ( lower upper -- lst ) 1 ... ;
: times ( q n -- ) -> n -> q n 0 do q yield loop ; : times ( q n -- ) -> n -> q n 0 do q yield loop ;
: substr ( s n n -- s ) swap rot 'substr/ii' jvm-call-method ; : substr ( s n n -- s ) swap rot :substr/ii jvm-call-method ;
: split ( str s -- s ) swap 'split/s' jvm-call-method ; : split ( str s -- s ) swap :split/s jvm-call-method ;
: upper ( s -- s ) 'upper' jvm-call-method ; : upper ( s -- s ) :upper jvm-call-method ;
: lower ( s -- s ) 'lower' jvm-call-method ; : lower ( s -- s ) :lower jvm-call-method ;
: trim ( s -- s ) 'trim' jvm-call-method ; : trim ( s -- s ) :trim jvm-call-method ;
: index-of ( s sub -- n ) swap 'indexOf/O' jvm-call-method ; : index-of ( s sub -- n ) swap :indexOf/O jvm-call-method ;
: replace ( s old new -- s ) swap rot 'replace/ss' jvm-call-method ; : replace ( s old new -- s ) swap rot :replace/ss jvm-call-method ;
: concat ( s1 s2 -- s ) swap 'concat/O' jvm-call-method ; : concat ( s1 s2 -- s ) swap :concat/O jvm-call-method ;
: >str ( o -- s ) 'asStr' jvm-call-method ; : >str ( o -- s ) :asStr jvm-call-method ;

View file

@ -59,4 +59,4 @@ var: exit.prim ( primitive exit - in case some word needs to override )
['] lit , ['] unimplemented , ['] lit , ['] unimplemented ,
['] exec , ['] exit , ; ['] exec , ['] exit , ;
: is: ( xt -- ) ` 'longValue' jvm-call-method 1+ ! ; : is: ( xt -- ) ` :longValue jvm-call-method 1+ ! ;

View file

@ -2,19 +2,19 @@
'application/json' val: APPLICATION/JSON 'application/json' val: APPLICATION/JSON
: http-get ( u -- n b ) : http-get ( u -- n b )
'com.vectron.forthcalc.support.HttpClient/get/s' jvm-call-static -> response :com.vectron.forthcalc.support.HttpClient/get/s jvm-call-static -> response
response 'body' jvm-call-method response 'body' jvm-call-method
response 'code' jvm-call-method ; response 'code' jvm-call-method ;
: http-post ( d u -- n b ) : http-post ( d u -- n b )
-> url -> request -> url -> request
request url 'com.vectron.forthcalc.support.HttpClient/post/sM' jvm-call-static -> response request url :com.vectron.forthcalc.support.HttpClient/post/sM jvm-call-static -> response
response 'body' jvm-call-method response 'body' jvm-call-method
response 'code' jvm-call-method ; response 'code' jvm-call-method ;
: http-put ( d u -- n b ) : http-put ( d u -- n b )
-> url -> request -> url -> request
request url 'com.vectron.forthcalc.support.HttpClient/put/sM' jvm-call-static -> response request url :com.vectron.forthcalc.support.HttpClient/put/sM jvm-call-static -> response
response 'body' jvm-call-method response 'body' jvm-call-method
response 'code' jvm-call-method ; response 'code' jvm-call-method ;

View file

@ -15,5 +15,8 @@
: ms ( n -- ) 'java.lang.Thread/sleep/l' jvm-call-static ; : ms ( n -- ) 'java.lang.Thread/sleep/l' jvm-call-static ;
: tone ( hz ms -- ) swap 'com.vectron.forthcalc.support.Tone/play/di' jvm-call-static ; : tone ( hz ms -- ) swap :com.vectron.forthcalc.support.Tone/play/di jvm-call-static ;
: torch ( n -- ) 'com.vectron.forthcalc.support.Torch/toggle/O' jvm-call-static ; : torch ( n -- ) :com.vectron.forthcalc.support.Torch/toggle/O jvm-call-static ;
: draw-circle ( x y r -- ) :com.vectron.forthcalc.CanvasView/drawCircle/ddd jvm-call-static ;
: draw-rect ( left top right bottom -- ) :com.vectron.forthcalc.CanvasView/drawRect/dddd jvm-call-static ;

View file

@ -22,24 +22,24 @@
: tip1 ( n -- n ) 15 percent ; : tip1 ( n -- n ) 15 percent ;
: tip2 ( bill split -- total tip ) / dup 115 percent swap 15 percent ; : tip2 ( bill split -- total tip ) / dup 115 percent swap 15 percent ;
( trigonometry ) ( trigonometry )
: pi ( n -- n ) 'java.lang.Math/PI' jvm-static-var ; : pi ( n -- n ) :java.lang.Math/PI jvm-static-var ;
: sin ( n -- n ) 'java.lang.Math/sin/d' jvm-call-static ; : sin ( n -- n ) :java.lang.Math/sin/d jvm-call-static ;
: cos ( n -- n ) 'java.lang.Math/cos/d' jvm-call-static ; : cos ( n -- n ) :java.lang.Math/cos/d jvm-call-static ;
: tan ( n -- n ) 'java.lang.Math/tan/d' jvm-call-static ; : tan ( n -- n ) :java.lang.Math/tan/d jvm-call-static ;
: asin ( n -- n ) 'java.lang.Math/asin/d' jvm-call-static ; : asin ( n -- n ) :java.lang.Math/asin/d jvm-call-static ;
: acos ( n -- n ) 'java.lang.Math/acos/d' jvm-call-static ; : acos ( n -- n ) :java.lang.Math/acos/d jvm-call-static ;
: atan ( n -- n ) 'java.lang.Math/atan/d' jvm-call-static ; : atan ( n -- n ) :java.lang.Math/atan/d jvm-call-static ;
: sinh ( n -- n ) 'java.lang.Math/sinh/d' jvm-call-static ; : sinh ( n -- n ) :java.lang.Math/sinh/d jvm-call-static ;
: cosh ( n -- n ) 'java.lang.Math/cosh/d' jvm-call-static ; : cosh ( n -- n ) :java.lang.Math/cosh/d jvm-call-static ;
: tanh ( n -- n ) 'java.lang.Math/tanh/d' jvm-call-static ; : tanh ( n -- n ) :java.lang.Math/tanh/d jvm-call-static ;
( math ) ( math )
: e ( n -- n ) 'java.lang.Math/E' jvm-static-var ; : e ( n -- n ) :java.lang.Math/E jvm-static-var ;
: round ( n -- n ) 'java.lang.Math/round/d' jvm-call-static ; : round ( n -- n ) :java.lang.Math/round/d jvm-call-static ;
: sqrt ( n -- n ) 'java.lang.Math/sqrt/d' jvm-call-static ; : sqrt ( n -- n ) :java.lang.Math/sqrt/d jvm-call-static ;
: 10log ( n -- n ) 'java.lang.Math/log10/d' jvm-call-static ; : 10log ( n -- n ) :java.lang.Math/log10/d jvm-call-static ;
: nlog ( n n -- n ) swap 10log swap 10log / ; : nlog ( n n -- n ) swap 10log swap 10log / ;
: 2log ( n -- n ) 2.0 nlog ; : 2log ( n -- n ) 2.0 nlog ;
: elog ( n -- n ) 'java.lang.Math/log/d' jvm-call-static ; : elog ( n -- n ) :java.lang.Math/log/d jvm-call-static ;
: n! ( n -- n ) : n! ( n -- n )
dup 1 <= if dup 1 <= if
drop 1 drop 1
@ -47,7 +47,7 @@
round dup 1 do i * loop round dup 1 do i * loop
then ; then ;
: avg* ( .. -- n ) depth dup 1 < if drop else >r sum* r> / then ; : avg* ( .. -- n ) depth dup 1 < if drop else >r sum* r> / then ;
: rnd ( -- n ) 'com.vectron.fcl.interop.JvmInterOp/random' jvm-call-static ; : rnd ( -- n ) :com.vectron.fcl.interop.JvmInterOp/random jvm-call-static ;
: min* ( .. -- n ) depth 1- 0 do min loop ; : min* ( .. -- n ) depth 1- 0 do min loop ;
: max* ( .. -- n ) depth 1- 0 do max loop ; : max* ( .. -- n ) depth 1- 0 do max loop ;
( unit conversion ) ( unit conversion )
@ -79,18 +79,18 @@
: pa>b ( n -- n ) 100000 / ; : pa>b ( n -- n ) 100000 / ;
: t>pa ( n -- n ) 133.322387415 * ; : t>pa ( n -- n ) 133.322387415 * ;
: pa>t ( n -- n ) 133.322387415 / ; : pa>t ( n -- n ) 133.322387415 / ;
: uptime ( -- millis ) 'android.os.SystemClock/elapsedRealtime' jvm-call-static ; : uptime ( -- millis ) :android.os.SystemClock/elapsedRealtime jvm-call-static ;
: >num ( s -- n ) 'com.vectron.fcl.types.Num/parse/s' jvm-call-static ; : >num ( s -- n ) :com.vectron.fcl.types.Num/parse/s jvm-call-static ;
: year ( -- y ) : year ( -- y )
'java.util.Calendar/YEAR' jvm-static-var :java.util.Calendar/YEAR jvm-static-var
'java.util.Calendar/getInstance' jvm-call-static :java.util.Calendar/getInstance jvm-call-static
'get/i' jvm-call-method ; :get/i jvm-call-method ;
: month ( -- y ) : month ( -- y )
'java.util.Calendar/MONTH' jvm-static-var :java.util.Calendar/MONTH jvm-static-var
'java.util.Calendar/getInstance' jvm-call-static :java.util.Calendar/getInstance jvm-call-static
'get/i' jvm-call-method :get/i jvm-call-method
1 + ; 1 + ;
: day ( -- y ) : day ( -- y )
'java.util.Calendar/DAY_OF_MONTH' jvm-static-var :java.util.Calendar/DAY_OF_MONTH jvm-static-var
'java.util.Calendar/getInstance' jvm-call-static :java.util.Calendar/getInstance jvm-call-static
'get/i' jvm-call-method ; :get/i jvm-call-method ;

View file

@ -1,6 +1,6 @@
: <q> ( adr sfp -- c ) 'com.vectron.fcl.types.Quot/create/ii' jvm-call-static ; : <q> ( adr sfp -- c ) :com.vectron.fcl.types.Quot/create/ii jvm-call-static ;
: qt.adr ( q -- a ) 'address' jvm-call-method ; : qt.adr ( q -- a ) :address jvm-call-method ;
: qt.sfp ( q -- a ) 'stackFrame' jvm-call-method ; : qt.sfp ( q -- a ) :stackFrame jvm-call-method ;
: { immediate : { immediate
frame.allocated @ not if ( We need to have a PSP up front for <q>, because quotations might have its own locals ) frame.allocated @ not if ( We need to have a PSP up front for <q>, because quotations might have its own locals )

View file

@ -391,12 +391,12 @@ public class FclTest {
assertEquals(1.1752, evalPop("1 sinh").doubleValue(), 0.001); assertEquals(1.1752, evalPop("1 sinh").doubleValue(), 0.001);
assertEquals(1.5430, evalPop("1 cosh").doubleValue(), 0.001); assertEquals(1.5430, evalPop("1 cosh").doubleValue(), 0.001);
assertEquals(0.7616, evalPop("1 tanh").doubleValue(), 0.001); assertEquals(0.7616, evalPop("1 tanh").doubleValue(), 0.001);
assertEquals(1, evalPop("1.3 'intValue' jvm-call-method").doubleValue(), 0.01); assertEquals(1, evalPop("1.3 :intValue jvm-call-method").doubleValue(), 0.01);
assertFalse(evalPop("1.3 'nosuch' jvm-has-method").boolValue()); assertFalse(evalPop("1.3 'nosuch' jvm-has-method").boolValue());
assertTrue(evalPop("1.3 'round' jvm-has-method").boolValue()); assertTrue(evalPop("1.3 'round' jvm-has-method").boolValue());
assertTrue(evalPop("[ 1 2 ] 'iterator' jvm-has-method").boolValue()); assertTrue(evalPop("[ 1 2 ] 'iterator' jvm-has-method").boolValue());
assertTrue(evalPop("[ 1 2 ] 'append/O' jvm-has-method").boolValue()); assertTrue(evalPop("[ 1 2 ] 'append/O' jvm-has-method").boolValue());
assertFalse(evalPop("[ 1 2 ] 'append/i' jvm-has-method").boolValue()); assertFalse(evalPop("[ 1 2 ] :append/i jvm-has-method").boolValue());
assertFalse(evalPop("[ 1 2 ] 'append/OO' jvm-has-method").boolValue()); assertFalse(evalPop("[ 1 2 ] 'append/OO' jvm-has-method").boolValue());
} }