python now adapted to guile 3

parent fa5a6deb
......@@ -7,6 +7,7 @@ godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache
SOURCES = \
language/python/guilemod.scm \
oop/dict.scm \
oop/pf-objects.scm \
language/python/persist.scm \
language/python/exceptions.scm \
......
# generated automatically by aclocal 1.15 -*- Autoconf -*-
# generated automatically by aclocal 1.15.1 -*- Autoconf -*-
# Copyright (C) 1996-2014 Free Software Foundation, Inc.
# Copyright (C) 1996-2017 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
......@@ -296,7 +296,7 @@ AS_VAR_COPY([$1], [pkg_cv_][$1])
AS_VAR_IF([$1], [""], [$5], [$4])dnl
])dnl PKG_CHECK_VAR
# Copyright (C) 2002-2014 Free Software Foundation, Inc.
# Copyright (C) 2002-2017 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
......@@ -311,7 +311,7 @@ AC_DEFUN([AM_AUTOMAKE_VERSION],
[am__api_version='1.15'
dnl Some users find AM_AUTOMAKE_VERSION and mistake it for a way to
dnl require some minimum version. Point them to the right macro.
m4_if([$1], [1.15], [],
m4_if([$1], [1.15.1], [],
[AC_FATAL([Do not call $0, use AM_INIT_AUTOMAKE([$1]).])])dnl
])
......@@ -327,14 +327,14 @@ m4_define([_AM_AUTOCONF_VERSION], [])
# Call AM_AUTOMAKE_VERSION and AM_AUTOMAKE_VERSION so they can be traced.
# This function is AC_REQUIREd by AM_INIT_AUTOMAKE.
AC_DEFUN([AM_SET_CURRENT_AUTOMAKE_VERSION],
[AM_AUTOMAKE_VERSION([1.15])dnl
[AM_AUTOMAKE_VERSION([1.15.1])dnl
m4_ifndef([AC_AUTOCONF_VERSION],
[m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl
_AM_AUTOCONF_VERSION(m4_defn([AC_AUTOCONF_VERSION]))])
# AM_AUX_DIR_EXPAND -*- Autoconf -*-
# Copyright (C) 2001-2014 Free Software Foundation, Inc.
# Copyright (C) 2001-2017 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
......@@ -386,7 +386,7 @@ am_aux_dir=`cd "$ac_aux_dir" && pwd`
# AM_CONDITIONAL -*- Autoconf -*-
# Copyright (C) 1997-2014 Free Software Foundation, Inc.
# Copyright (C) 1997-2017 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
......@@ -417,7 +417,7 @@ AC_CONFIG_COMMANDS_PRE(
Usually this means the macro was only invoked conditionally.]])
fi])])
# Copyright (C) 1999-2014 Free Software Foundation, Inc.
# Copyright (C) 1999-2017 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
......@@ -608,7 +608,7 @@ _AM_SUBST_NOTMAKE([am__nodep])dnl
# Generate code to set up dependency tracking. -*- Autoconf -*-
# Copyright (C) 1999-2014 Free Software Foundation, Inc.
# Copyright (C) 1999-2017 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
......@@ -684,7 +684,7 @@ AC_DEFUN([AM_OUTPUT_DEPENDENCY_COMMANDS],
# Do all the work for Automake. -*- Autoconf -*-
# Copyright (C) 1996-2014 Free Software Foundation, Inc.
# Copyright (C) 1996-2017 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
......@@ -881,7 +881,7 @@ for _am_header in $config_headers :; do
done
echo "timestamp for $_am_arg" >`AS_DIRNAME(["$_am_arg"])`/stamp-h[]$_am_stamp_count])
# Copyright (C) 2001-2014 Free Software Foundation, Inc.
# Copyright (C) 2001-2017 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
......@@ -902,7 +902,7 @@ if test x"${install_sh+set}" != xset; then
fi
AC_SUBST([install_sh])])
# Copyright (C) 2003-2014 Free Software Foundation, Inc.
# Copyright (C) 2003-2017 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
......@@ -923,7 +923,7 @@ AC_SUBST([am__leading_dot])])
# Check to see how 'make' treats includes. -*- Autoconf -*-
# Copyright (C) 2001-2014 Free Software Foundation, Inc.
# Copyright (C) 2001-2017 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
......@@ -973,7 +973,7 @@ rm -f confinc confmf
# Fake the existence of programs that GNU maintainers use. -*- Autoconf -*-
# Copyright (C) 1997-2014 Free Software Foundation, Inc.
# Copyright (C) 1997-2017 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
......@@ -1012,7 +1012,7 @@ fi
# Helper functions for option handling. -*- Autoconf -*-
# Copyright (C) 2001-2014 Free Software Foundation, Inc.
# Copyright (C) 2001-2017 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
......@@ -1041,7 +1041,7 @@ AC_DEFUN([_AM_SET_OPTIONS],
AC_DEFUN([_AM_IF_OPTION],
[m4_ifset(_AM_MANGLE_OPTION([$1]), [$2], [$3])])
# Copyright (C) 1999-2014 Free Software Foundation, Inc.
# Copyright (C) 1999-2017 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
......@@ -1088,7 +1088,7 @@ AC_LANG_POP([C])])
# For backward compatibility.
AC_DEFUN_ONCE([AM_PROG_CC_C_O], [AC_REQUIRE([AC_PROG_CC])])
# Copyright (C) 2001-2014 Free Software Foundation, Inc.
# Copyright (C) 2001-2017 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
......@@ -1107,7 +1107,7 @@ AC_DEFUN([AM_RUN_LOG],
# Check to make sure that the build environment is sane. -*- Autoconf -*-
# Copyright (C) 1996-2014 Free Software Foundation, Inc.
# Copyright (C) 1996-2017 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
......@@ -1188,7 +1188,7 @@ AC_CONFIG_COMMANDS_PRE(
rm -f conftest.file
])
# Copyright (C) 2009-2014 Free Software Foundation, Inc.
# Copyright (C) 2009-2017 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
......@@ -1248,7 +1248,7 @@ AC_SUBST([AM_BACKSLASH])dnl
_AM_SUBST_NOTMAKE([AM_BACKSLASH])dnl
])
# Copyright (C) 2001-2014 Free Software Foundation, Inc.
# Copyright (C) 2001-2017 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
......@@ -1276,7 +1276,7 @@ fi
INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s"
AC_SUBST([INSTALL_STRIP_PROGRAM])])
# Copyright (C) 2006-2014 Free Software Foundation, Inc.
# Copyright (C) 2006-2017 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
......@@ -1295,7 +1295,7 @@ AC_DEFUN([AM_SUBST_NOTMAKE], [_AM_SUBST_NOTMAKE($@)])
# Check how to create a tarball. -*- Autoconf -*-
# Copyright (C) 2004-2014 Free Software Foundation, Inc.
# Copyright (C) 2004-2017 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
......
......@@ -2217,7 +2217,7 @@ empty list."
#:use-module ((guile) #:select
(@ @@ pk let* lambda call-with-values case-lambda
set! = * + - < <= > >= / pair? fluid-set!
fluid-ref
fluid-ref else
syntax-rules let-syntax abort-to-prompt))
#:use-module (language python module python)
#:use-module ((language python compile) #:select (pks))
......
......@@ -12,19 +12,24 @@
#:use-module (ice-9 format)
#:use-module (ice-9 control)
#:use-module (oop goops)
#:use-module (oop dict)
#:use-module (oop pf-objects)
#:re-export (py-get)
#:re-export (py-get dictNs dictRNs)
#:export (make-py-hashtable <py-hashtable>
py-copy py-fromkeys py-has_key py-items py-iteritems
py-iterkeys py-itervalues py-keys py-values
py-popitem py-setdefault py-update py-clear
py-hash-ref dict pyhash-listing
weak-key-dict weak-value-dict
py-hash-ref py-hash-set! dictNs dictRNs
py-hash-ref py-hash-set!
make-py-weak-key-hashtable
make-py-weak-value-hashtable
))
(define miss (list 'miss))
(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
(define (h x n) (modulo (py-hash x) n))
......@@ -95,7 +100,6 @@
(slot-set! o 'n 0)
o))
(define miss (list 'miss))
(define-method (pylist-ref (o <hashtable>) x)
(let ((r (py-hash-ref o x miss)))
(if (eq? r miss)
......@@ -103,10 +107,10 @@
r)))
(name-object <hashtable>)
(define-method (pylist-ref (o <py-hashtable>) x)
(let ((r (py-hash-ref (slot-ref o 't) x miss)))
(define-method (pylist-ref (oo <py-hashtable>) x)
(let ((r (py-hash-ref (slot-ref oo 't) x miss)))
(if (eq? r miss)
(aif it (ref o '__missing__)
(aif it (ref oo '__missing__)
(it x)
(raise KeyError x))
r)))
......@@ -596,8 +600,6 @@
(define __format___ (lambda x #f))
(define __setattr__ (@@ (oop pf-objects) __setattr__))
(define __getattribute__ (@@ (oop pf-objects) __getattribute__))
(define __init__
(letrec ((__init__
(case-lambda
......@@ -731,9 +733,9 @@
(mkwrap dictNs norm renorm)
(mkwrap dictRNs renorm norm)
(set! (@@ (oop pf-objects) dictNs) dictNs)
(set! (@@ (oop pf-objects) dictRNs) dictRNs)
(set! (@@ (oop dict) dictNs) dictNs)
(set! (@@ (oop dict) dictRNs) dictRNs)
(define-python-class weak-key-dict (<py> <py-hashtable>)
(define __init__
(letrec ((__init__
......@@ -790,7 +792,7 @@
(pylist-sort! l)
l))
(set! (@@ (oop pf-objects) hash-for-each*)
(set! (@@ (oop dict) hash-for-each*)
(lambda (f dict)
(for ((k v : dict)) ()
(f k v))))
......
......@@ -153,9 +153,8 @@
o)
(define-method (wrap-in (o <p>))
(aif it (ref o '__iter__)
(aif it (pk 'wrap-in<p> (ref (pk o) '__iter__))
(let ((x (it)))
(pk 'wrap-in o x)
(cond
((pair? x) (wrap-in x))
(else x)))
......
(define-module (language python guilemod)
#:export ())
#:use-module (system base message)
#:export (%add-to-warn-list))
(define-syntax-rule (aif it p . l) (let ((it p)) (if it . l)))
......@@ -66,7 +67,8 @@
(with-fluids (((C %in-compile ) #t )
((C %in-file ) file )
((M %dont-warn-list ) '() )
((@@ (system base message) %dont-warn-list)
'() )
((C %file-port-name-canonicalization) canonicalization )
((C %current-file% ) file))
......@@ -90,13 +92,17 @@
comp))))
;; MESSAGE (Mute some variable warnings)
(define-exp-M %add-to-warn-list
(define %add-to-warn-list
(lambda (sym)
(fluid-set! (M %dont-warn-list)
(cons sym (fluid-ref (M %dont-warn-list))))))
(cons sym
(fluid-ref
(M %dont-warn-list))))))
(define-exp-M %dont-warn-list (make-fluid '()))
(define-set-M %warning-types
(define-M %dont-warn-list (make-fluid '()))
(define-M %warning-types
;; List of known warning types.
(map (lambda (args)
(apply (M make-warning-type) args))
......@@ -135,7 +141,9 @@
(unbound-variable
"report possibly unbound variables"
,(lambda (port loc name)
(if (not (member name (fluid-ref (M %dont-warn-list))))
(if (not (member name
(fluid-ref
(M %dont-warn-list))))
(emit port
"~A: warning: possibly unbound variable `~A'~%"
loc name))))
......@@ -240,6 +248,14 @@
(else
(emit port "~A: `format' warning~%" loc)))))))))
(define-exp-M lookup-warning-type
(lambda (name)
"Return the warning type NAME or `#f' if not found."
((M find)
(lambda (wt)
(eq? name ((M warning-type-name) wt)))
(M %warning-types))))
(define pload
(let ((guile-load (@ (guile) primitive-load-path)))
......
......@@ -268,7 +268,7 @@
nontag))
f-eof))
(set! (@@ (parser stis-parser lang python3-parser) f-formatter) tag)
(set! (@@ (parser stis-parser lang python3 formatter) f-formatter) tag)
(define mk-gen
(make-generator (l)
......
......@@ -671,7 +671,7 @@
(number->string o 2))
(define-method (py-bin (o <py-int>))
(number->string (slot-ref o 'x) 2))
(define (py-bin o)
(define-method (py-bin o)
(+ "0b" (number->string (py-index o) 2)))
......
(define-module (oop dict)
#:export (procedure-property- procedure-properties- set-procedure-property!-
set-procedure-properties!- dictNs dictRNs
hash-for-each* object-method class-method
static-method))
(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
(define prophash (make-hash-table))
(define (procedure-property- o key . l)
(define ret (if (pair? l) (car l) #f))
(aif props (hashq-ref prophash o)
(aif it (assq key props)
(cdr it)
ret)
ret))
(define (procedure-properties- o)
(define ret '())
(aif props (hashq-ref prophash o)
props
ret))
(define (set-procedure-property!- o key v)
(hashq-set! prophash
o
(aif props (hashq-ref prophash o)
(cons (cons key v) props)
(list (cons key v)))))
(define (set-procedure-properties!- o l)
(hashq-set! prophash o l))
;; this is mutated by the dict class
(define dictNs (list 'dictNs))
(define dictRNs (list 'dictRNs))
;; this is mutated by the dict class
(define hash-for-each* hash-for-each)
(define (class-method f)
f)
(define (object-method f)
f)
(define (static-method f)
f)
(define-module (oop pf-objects)
#:use-module (oop goops)
#:use-module (oop dict)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
#:use-module (system base message)
#:use-module (language python guilemod)
#:use-module (ice-9 pretty-print)
#:use-module (persist persistance)
#:replace (equal?)
#:replace (equal?)
#:re-export (object-method class-method static-method)
#:export (set ref make-p <p> <py> <pf> <pyf> <property>
call with copy fset fcall put put! py-get
pcall pcall! get fset-x pyclass?
pcall pcall! get fset-x pyclass?
def-p-class mk-p-class make-p-class mk-p-class2
define-python-class define-python-class-noname
get-type py-class find-in-class
object-method class-method static-method
get-type py-class find-in-class
py-super-mac py-super py-equal?
*class* *self* pyobject? pytype?
type object pylist-set! pylist-ref tr
......@@ -21,6 +22,8 @@
ref-class fastref fastset
))
(eval-when (compile) (use-modules (language python guilemod)))
#|
Python object system is basically syntactic suger otop of a hashmap and one
this project is inspired by the python object system and what it measn when
......@@ -38,35 +41,6 @@ explicitly tell it to not update etc.
(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
;; this is mutated by the dict class
(define dictNs '(dictNs))
(define dictRNs '(dictRNs))
(define prophash (make-hash-table))
(define (procedure-property- o key . l)
(define ret (if (pair? l) (car l) #f))
(aif props (hashq-ref prophash o)
(aif it (assq key props)
(cdr it)
ret)
ret))
(define (procedure-properties- o)
(define ret #f)
(aif props (hashq-ref prophash o)
props
ret))
(define (set-procedure-property!- o key v)
(hashq-set! prophash
o
(aif props (hashq-ref prophash o)
(cons (cons key v) props)
(list (cons key v)))))
(define (set-procedure-properties!- o l)
(hashq-set! prophash o l))
#;
(define (pkk . l)
......@@ -290,17 +264,16 @@ explicitly tell it to not update etc.
(lambda (obj cls)
(lambda x (apply f cls x))))
(define (class-method f)
(set f '__get__ (mk-getter-class f))
f)
(define (object-method f)
(set f '__get__ (mk-getter-object f))
f)
(set! class-method
(lambda (f)
(set f '__get__ (mk-getter-class f))
f))
(define (static-method f)
(set f '__get__ #f)
f)
(set! object-method
(lambda (f)
(set f '__get__ (mk-getter-object f))
f))
(define (resolve-method-g g pattern)
......@@ -366,8 +339,6 @@ explicitly tell it to not update etc.
(list c object))
(cons c l))))
(define hash-for-each* hash-for-each)
(define (kw->class kw meta)
(if (memq #:functional kw)
(if (memq #:fast kw)
......@@ -1681,7 +1652,9 @@ explicitly tell it to not update etc.
(define __setattr__ (object-method *setattr*))
(define __format__ (lambda (self x) (*str* self)))
(define __reduce_ex__ (lambda x (error "not implemented")))
(define mro (lambda (self) (ref self '__mro__)))))
(define mro (begin
(object-method
(lambda (self) (ref self '__mro__)))))))
(set type '__class__ type)
(rawset type '__mro__ (list type))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment