python: improved docs, support for kwargs to methods and sets sys.argv

extra/python/ffi/ffi.factor

@@ -21,6 +21,7 @@ FUNCTION: c-string Py_GetVersion ( ) ;
 FUNCTION: void Py_Initialize ( ) ;
 FUNCTION: bool Py_IsInitialized ( ) ;
 FUNCTION: void Py_Finalize ( ) ;
+FUNCTION: void PySys_SetArgvEx ( int argc, c-string* argv, int updatepath ) ;
 
 ! Misc
 FUNCTION: int PyRun_SimpleString ( c-string command ) ;

extra/python/python-docs.factor

@@ -1,14 +1,6 @@
 IN: python
 USING: python help.markup help.syntax ;
 
-ARTICLE: "python" "Python binding"
-"The " { $vocab-link "python" } " vocab and its subvocabs implements a simple binding for libpython, allowing factor code to call native python."
-$nl
-"Initialization and finalization:"
-{ $subsections py-initialize py-finalize }
-"Module management:"
-{ $subsections import } ;
-
 HELP: py-initialize
 { $description "Initializes the python binding. This word must be called before any other words in the api can be used" } ;
 
@@ -26,3 +18,12 @@ HELP: >py
   }
 }
 { $see-also >factor } ;
+
+ARTICLE: "python" "Python binding"
+"The " { $vocab-link "python" } " vocab and its subvocabs implements a simple binding for libpython, allowing factor code to call native python."
+$nl
+"Initialization and finalization:"
+{ $subsections py-initialize py-finalize }
+"Module management:"
+{ $subsections import }
+"The vocab " { $vocab-link "python.syntax" } " implements a higher level factorific interface on top of the lower-level constructs in this vocab. Prefer to use that vocab most of the time." ;

extra/python/python.factor

@@ -1,12 +1,23 @@
-USING: accessors alien alien.c-types alien.data arrays assocs fry hashtables
+USING: accessors alien alien.c-types alien.data alien.strings arrays assocs
-kernel namespaces python.errors python.ffi python.objects sequences strings
+command-line fry hashtables io.encodings.utf8 kernel namespaces python.errors
-vectors ;
+python.ffi python.objects sequences specialized-arrays strings vectors ;
 IN: python
 QUALIFIED: math
 
+SPECIALIZED-ARRAY: void*
+
+! Borrowed from unix.utilities
+: strings>alien ( strings encoding -- array )
+    '[ _ malloc-string ] void*-array{ } map-as f suffix ;
+
 ! Initialization and finalization
 : py-initialize ( -- )
-    Py_IsInitialized [ Py_Initialize ] unless ;
+    Py_IsInitialized [
+        Py_Initialize
+        ! Encoding must be 8bit on Windows I think, so
+        ! native-string-encoding (utf16n) doesn't work.
+        (command-line) [ length ] [ utf8 strings>alien ] bi 0 PySys_SetArgvEx
+    ] unless ;
 
 : py-finalize ( -- )
     Py_IsInitialized [ Py_Finalize ] when ;

extra/python/syntax/syntax-docs.factor

@@ -1,5 +1,5 @@
 IN: python.syntax
-USING: python.syntax help.markup help.syntax ;
+USING: hashtables python.syntax help.markup help.syntax ;
 
 HELP: PY-FROM:
 { $syntax "PY-FROM: module => name-effects ;" }
@@ -33,3 +33,22 @@ HELP: PY-METHODS:
     "\"name-of-zip.zip\" >py \"r\" >py ZipFile namelist >factor"
   }
 } ;
+
+ARTICLE: "python.syntax" "Syntax for python calls from factor"
+"The " { $vocab-link "python.syntax" } " vocab adds syntax to factor to make calls from factor to python natural and intuitive."
+$nl
+{ $examples "Here is how you bind and call a method namelist on a ZipFile instance created by importing the zipfile module:"
+  { $code
+    "PY-FROM: zipfile => ZipFile ( name mode -- file ) ;"
+    "PY-METHODS: ZipFile => namelist ( self -- names ) ;"
+    "! Then use the declarations like this"
+    "\"name-of-zip.zip\" >py \"r\" >py ZipFile namelist >factor"
+  }
+  "In python, a method or function takes keyword arguments if its last parameter starts with \"**\". If the name of the last argument to a declared function is \"**\" then a " { $link hashtable } " can be sent to the function:"
+  { $code
+    "PY-FROM: datetime => timedelta ( ** -- timedelta ) ;"
+    "PY-METHODS: timedelta  => seconds ( self -- n ) ;"
+    "H{ { \"hours\" 99 } { \"minutes\" 33 } } >py timedelta $seconds >factor ."
+    "12780"
+    }
+} ;

extra/python/syntax/syntax-tests.factor

@@ -1,5 +1,6 @@
 USING: arrays assocs destructors fry kernel math namespaces python python.ffi
-python.objects python.syntax python.tests sequences sets tools.test ;
+python.objects python.syntax python.tests sequences sets splitting tools.test
+unicode.categories ;
 IN: python.syntax.tests
 
 ! Importing functions
@@ -25,7 +26,7 @@ PY-FROM: time => sleep ( n -- ) ;
 [ ] [ 0 >py sleep ] unit-test
 
 ! Module variables are bound as zero-arg functions
-PY-FROM: sys => path ( -- seq ) ;
+PY-FROM: sys => path ( -- seq ) argv ( -- seq ) ;
 
 [ t ] [ $path >factor sequence? ] unit-test
 
@@ -127,9 +128,22 @@ PY-FROM: sys => platform ( -- x ) ;
 ] py-test
 
 ! Support for kwargs
-
 PY-FROM: datetime => timedelta ( ** -- timedelta ) ;
 
 [ "datetime.timedelta(4, 10800)" ] [
     H{ { "hours" 99 } } >py timedelta repr >factor
 ] py-test
+
+! Kwargs in methods
+PY-FROM: argparse => ArgumentParser ( -- self ) ;
+PY-METHODS: ArgumentParser =>
+    add_argument ( self name ** -- )
+    format_help ( self -- str ) ;
+
+[ t ] [
+    [
+        ArgumentParser dup
+        "--foo" >py H{ { "help" "badger" } } >py add_argument
+        format_help >factor
+    ] with-destructors [ blank? ] trim " " split "badger" swap in?
+] py-test

extra/python/syntax/syntax.factor

@@ -17,11 +17,6 @@ SYMBOL: current-context
 : scan-definitions ( quot -- )
     scan-token current-context set "=>" expect with-each-definition ; inline
 
-: unpack-value ( alien -- * )
-    [ 0 = [ drop 0 <py-tuple> ] when ] keep
-    [ 1 = [ <1py-tuple> ] when ] keep
-    [ py-tuple>array ] dip firstn ; inline
-
 : gather-args-quot ( in-effect -- quot )
     dup ?last "**" = [
         but-last length '[ [ _ narray array>py-tuple ] dip ]
@@ -51,21 +46,19 @@ SYMBOL: current-context
     [ dup current-context get import swap getattr 2dup ] dip
     function-callable function-object ; inline
 
-: make-method-quot ( name in out -- ret )
+: make-method-quot ( name effect -- quot )
-    swapd '[
+    [ in>> 1 tail gather-args-quot ] [ out>> unpack-value-quot ] bi swapd
-        _ narray array>py-tuple swap
+    '[ @ rot _ getattr -rot call-object-full @ ] ;
-        _ getattr swap call-object
+
-        _ unpack-value
+: method-callable ( name effect -- )
-    ] ;
+    [ dup create-in swap ] dip [ make-method-quot ] keep define-inline ;
 
 : method-object ( name -- )
     [ "$" prepend create-in ] [ '[ _ getattr ] ] bi
     { "obj" } { "obj'" } <effect> define-inline ;
 
 : add-method ( name effect -- )
-    [ dup dup create-in swap ] dip
+    dupd method-callable method-object ;
-    [ [ in>> length 1 - ] [ out>> length ] bi make-method-quot ] keep
-    define-inline method-object ;
 
 PRIVATE>