(define-module (language python python)
  #:use-module (language python parser)
  #:use-module (language python expr)
  #:use-module (ice-9    match)
  #:export (compile-python-string compile-python-file))

;;; VARIABLES ----------------------------------------------------------------
(define (find-global-variables vars tree)
  (define (for-each* f l)
    (match l
      ((x . l)
       (f x)
       (for-each* f l))
      (x
       (f x))))

  (define (local tree)
    (match tree
      ((#:global l)
       (for-each* 
        (lambda (x) (hash-set! vars x #t)) l))
      ((x . l) 
       (for-each* local tree))
      (_       
       #t)))

  (define (collect tree)
    (match tree
      ((#:lambdef . _)
       #t)
      ((#:identifier . l)
       (hash-set! vars tree #t))
      ((_ . _)
       (for-each* collect tree))
      (_
       #t)))

  (let lp ((tree tree))
    (match tree
      ((#:def . l)
       (for-each* local l))
      ((#:lambdef . l)
       (for-each* local l))
      ((#:class  . l)
       (for-each* local l))
      ((#:expr-stmt
        a (#:assign x ... e))
       (collect a)
       (collect x))
      ((x . l)
       (for-each* lp tree))
      (_
       #t))))
;; COMPILATION

(define (expr stx out tree)
  (define (expr-lhs tree)
    (match tree
      ((#:test (#:power (#:identifier v . _)))
       (datum->syntax stx (string->symbol v)))))


  (define (expr-rhs tree)
    (define (comp-tr op)
      (match op
        ("notin" #'py-notin)
        ("isnot" #'py-isnot)
        ("=="    #'py_==)
        (">="    #'py_>=)
        ("<="    #'py_<=)
        ("<>"    #'py_<>)
        ("!="    #'py_!=)
        ("in"    #'py_in)
        ("is"    #'py_is)
        ("<"     #'py_< )
        (">"     #'py_> )))

    (let lp ((tree tree))
      (match tree
        ((#:test x #f)
         (lp x))
        ((#:test x (a b))
         #`(if #,(py-true? (lp a)) #,(lp x) #,(lp b)))
        ((#:or x . y)
         #`(py-or #,(lp x) #,@(map lp y)))
        ((#:and x y)
         #`(py-and #,(lp x) #,@(map lp y)))
        ((#:not x)
         #`(py-not #,(lp x)))
        ((#:comp x)
         (lp x))
        ((#:comp x (op . y) . l)
         #'(#,(comp-tr op) #,(lp x) #,(lp (cons* #:comp y l))))
        ((#:bor x y)
         #`(py-bor #,(lp x) #,@(map lp y)))
        ((#:bxor x y)
         #`(py-bxor #,(lp x) #,@(map lp y)))
        ((#:xand x y)
         #`(py-band #,(lp x) #,@(map lp y)))
        ((#:<< x y)
         #`(py-<< #,(lp x) #,@(map lp y)))
        ((#:>> x y)
         #`(py->> #,(lp x) #,@(map lp y)))
        ((#:+ x y)
         #`(py-+ #,(lp x) #,@(map lp y)))
        ((#:- x y)
         #`(py-- #,(lp x) #,@(map lp y)))
        ((#:* x y)
         #`(py-* #,(lp x) #,@(map lp y)))
        ((#:/ x y)
         #`(py-/ #,(lp x) #,@(map lp y)))
        ((#:// x y)
         #`(py-// #,(lp x) #,@(map lp y)))
        ((#:% x y)
         #`(py-% #,(lp x) #,@(map lp y)))
        ((#:u+ x)
         #`(py-u+ #,(lp x)))
        ((#:u- x)
         #`(py-u- #,(lp x)))
        ((#:u~ x)
         #`(py-u~ #,(lp x)))
        ((#:power x trailer . #f)
         (compile-trailer trailer (lp x)))
        ((#:power x trailer . l)
         #'(py-power ,#(compile-trailer trailer (lp x)) #,(lp l)))
        ((#:identifier x . _)
         (datum->syntax stx (string->symbol x)))
        ((not (_ . _))
         tree))))
        
        

  (lambda (tree)
    (match tree
      ((test1 (#:assign))
       (expr-rhs test1))
      ((test1 (#:assign tests ... last))
       (with-syntax (((rhs ...)       (map expr-rhs last))
                     ((lhs1 ...)      (map expr-lhs test1))
                     (((lhs ...) ...) (reverse (map (lambda (l) 
                                                      (map expr-lhs l))
                                                    tests))))
	  (with-syntax (((v ...) (generate-temporaries #'(lhs1 ...))))
	     (out #'(call-with-values (lambda () (values rhs ...))
                      (lambda (v ...)
                        (begin
                          (set! lhs v) ...)
                        ...
                        (set! lhs1 v) ...)))))))))
             

(define (compile-outer state out tree)
  (define (compile-stmt state tree)    
    (match tree
      ((#:expr-stmt l)
       (compile-expr l))

      ((#:del       l)
       (compile-del l))
      
      (#:pass 
       (out #'(if #f #f)))
      
      (#:break
       (break out))      
      
      (#:continue
       (continue out))
      
      ((#:return . l)
       (compile-return state l))
      
      ((#:raise . l)
       (compile-raise state l))
      
      ((#:import l)
       (compile-import state l))

      ((#:global . _)
       #t)
      
      ((#:nonlocal . _)
       #t)
         
      ((#:assert . l)
       (compile-assert state l))))
    
  (match tree
    ((#:stmt x)
     (for-each* compile-stmt tree))
    ((#:if . l)
     (compile-if state l))
    ((#:while . l)
     (compile-while state l))
    ((#:for  . l)
     (compile-for state l))
    ((#:try  . l)
     (compile-try state l))
    ((#:with . l)
     (compile-with state l))
    ((#:def  . l)
     (compile-def state l))
    ((#:decorated . l)
     (compile-decorated state l))))


(define (compile-python0 stx tree output)
  (define global-variables (make-hash-table))
  
  (find-global-variables global-variables tree)
  (set! all-variables 
        (hash-fold
         (lambda (k v e)
           (match k
             ((_ v . _)
              (cons (datum->syntax stx (string->symbol v)) e))))
         '() global-variables))
  (set! all-globals
        (hash-fold
         (lambda (k v e)
           (match k
	     ((_ v)
              (cons (datum->syntax stx (string->symbol v)) e))))
         '() global-variables))

  (output (with-syntax (((v ...) all-variables))
	   #'(begin (define v (if #f #f)) ...)))
  
  (output (with-syntax (((v ...) all-globals))
            #'(export v ...)))

  (output #`(begin #,@(compile-outer))))
  

(define (compile-python1 stx tree)
  (let ((out '()))
    (define (out x) (set! out (cons x out)))
    (compile-python0 stx tree out)
    (cons* #'begin (reverse out))))

(define-syntax compile-python-string
  (lambda (x)
    (syntax-case x ()
      ((_ y)
       (if (string? (syntax->datum #'y))
	   (compile-python1 x (python-parser (syntax->datum #'y))))))))

(define-syntax compile-python-file
  (lambda (x)
    (syntax-case x ()
      ((_ y)
       (if (string? (syntax->datum #'y))
	   (with-input-from-file (syntax->datum #'y)
	     (lambda () (compile-python1 x (python-parser))))
	   #f)))))