python: support for kwarg functions

diff --git a/extra/python/syntax/syntax-tests.factor b/extra/python/syntax/syntax-tests.factor
index 1231401e58bd2a99e1737466a0509c6816e7912e..8a1828e71285d7dffcf4caaf3d0ca18ef2c82078 100644 (file)
--- a/extra/python/syntax/syntax-tests.factor
+++ b/extra/python/syntax/syntax-tests.factor
@@ -125,3 +125,11 @@ PY-FROM: sys => platform ( -- x ) ;
 [ t ] [
     $platform "sys" import "platform" "tjaba" >py setattr $platform =
 ] py-test
+
+! Support for kwargs
+
+PY-FROM: datetime => timedelta ( ** -- timedelta ) ;
+
+[ "datetime.timedelta(4, 10800)" ] [
+    H{ { "hours" 99 } } >py timedelta repr >factor
+] py-test

diff --git a/extra/python/syntax/syntax.factor b/extra/python/syntax/syntax.factor
index e4486b947d2f6b87f3ff1e821400bea3b3c867d2..19128bc7f31e940f31abdc42ce8ab887577832cb 100644 (file)
--- a/extra/python/syntax/syntax.factor
+++ b/extra/python/syntax/syntax.factor
@@ -1,4 +1,4 @@
-USING: accessors arrays effects effects.parser fry generalizations
+USING: accessors arrays combinators effects effects.parser fry generalizations
 kernel lexer math namespaces parser python python.ffi python.objects sequences
 sequences.generalizations vocabs.parser words ;
 IN: python.syntax
@@ -22,13 +22,26 @@ SYMBOL: current-context
     [ 1 = [ <1py-tuple> ] when ] keep
     [ py-tuple>array ] dip firstn ; inline
 
-: make-function-quot ( alien in out -- quot )
-    swapd '[ _ narray array>py-tuple _ swap call-object _ unpack-value ] ;
+: gather-args-quot ( in-effect -- quot )
+    dup ?last "**" = [
+        but-last length '[ [ _ narray array>py-tuple ] dip ]
+    ] [
+        length '[ _ narray array>py-tuple f ]
+    ] if ;
+
+: unpack-value-quot ( out-effect -- quot )
+    length {
+        { 0 [ [ drop ] ] }
+        { 1 [ [ ] ] }
+        [ '[ py-tuple>array _ firstn ] ]
+    } case ;
+
+: make-function-quot ( alien effect -- quot )
+    [ in>> gather-args-quot ] [ out>> unpack-value-quot ] bi
+    swapd '[ @ _ -rot call-object-full @ ] ;
 
 : function-callable ( name alien effect -- )
-    [ create-in ] 2dip
-    [ [ in>> length ] [ out>> length ] bi make-function-quot ] keep
-    define-inline ; inline
+    [ create-in ] 2dip [ make-function-quot ] keep define-inline ; inline
 
 : function-object ( name alien -- )
     [ "$" prepend create-in ] [ '[ _ ] ] bi*