modules/language/python/python.scm

   1 (define-module (language python python)
   2   #:use-module (language python parser)
   3   #:use-module (language python expr)
   4   #:use-module (ice-9    match)
   5   #:export (compile-python-string compile-python-file))
   6
   7 ;;; VARIABLES ----------------------------------------------------------------
   8 (define (find-global-variables vars tree)
   9   (define (for-each* f l)
  10     (match l
  11       ((x . l)
  12        (f x)
  13        (for-each* f l))
  14       (x
  15        (f x))))
  16
  17   (define (local tree)
  18     (match tree
  19       ((#:global l)
  20        (for-each*
  21         (lambda (x) (hash-set! vars x #t)) l))
  22       ((x . l)
  23        (for-each* local tree))
  24       (_
  25        #t)))
  26
  27   (define (collect tree)
  28     (match tree
  29       ((#:lambdef . _)
  30        #t)
  31       ((#:identifier . l)
  32        (hash-set! vars tree #t))
  33       ((_ . _)
  34        (for-each* collect tree))
  35       (_
  36        #t)))
  37
  38   (let lp ((tree tree))
  39     (match tree
  40       ((#:def . l)
  41        (for-each* local l))
  42       ((#:lambdef . l)
  43        (for-each* local l))
  44       ((#:class  . l)
  45        (for-each* local l))
  46       ((#:expr-stmt
  47         a (#:assign x ... e))
  48        (collect a)
  49        (collect x))
  50       ((x . l)
  51        (for-each* lp tree))
  52       (_
  53        #t))))
  54 ;; COMPILATION
  55
  56 (define (expr stx out tree)
  57   (define (expr-lhs tree)
  58     (match tree
  59       ((#:test (#:power (#:identifier v . _)))
  60        (datum->syntax stx (string->symbol v)))))
  61
  62
  63   (define (expr-rhs tree)
  64     (define (comp-tr op)
  65       (match op
  66         ("notin" #'py-notin)
  67         ("isnot" #'py-isnot)
  68         ("=="    #'py_==)
  69         (">="    #'py_>=)
  70         ("<="    #'py_<=)
  71         ("<>"    #'py_<>)
  72         ("!="    #'py_!=)
  73         ("in"    #'py_in)
  74         ("is"    #'py_is)
  75         ("<"     #'py_< )
  76         (">"     #'py_> )))
  77
  78     (let lp ((tree tree))
  79       (match tree
  80         ((#:test x #f)
  81          (lp x))
  82         ((#:test x (a b))
  83          #`(if #,(py-true? (lp a)) #,(lp x) #,(lp b)))
  84         ((#:or x . y)
  85          #`(py-or #,(lp x) #,@(map lp y)))
  86         ((#:and x y)
  87          #`(py-and #,(lp x) #,@(map lp y)))
  88         ((#:not x)
  89          #`(py-not #,(lp x)))
  90         ((#:comp x)
  91          (lp x))
  92         ((#:comp x (op . y) . l)
  93          #'(#,(comp-tr op) #,(lp x) #,(lp (cons* #:comp y l))))
  94         ((#:bor x y)
  95          #`(py-bor #,(lp x) #,@(map lp y)))
  96         ((#:bxor x y)
  97          #`(py-bxor #,(lp x) #,@(map lp y)))
  98         ((#:xand x y)
  99          #`(py-band #,(lp x) #,@(map lp y)))
 100         ((#:<< x y)
 101          #`(py-<< #,(lp x) #,@(map lp y)))
 102         ((#:>> x y)
 103          #`(py->> #,(lp x) #,@(map lp y)))
 104         ((#:+ x y)
 105          #`(py-+ #,(lp x) #,@(map lp y)))
 106         ((#:- x y)
 107          #`(py-- #,(lp x) #,@(map lp y)))
 108         ((#:* x y)
 109          #`(py-* #,(lp x) #,@(map lp y)))
 110         ((#:/ x y)
 111          #`(py-/ #,(lp x) #,@(map lp y)))
 112         ((#:// x y)
 113          #`(py-// #,(lp x) #,@(map lp y)))
 114         ((#:% x y)
 115          #`(py-% #,(lp x) #,@(map lp y)))
 116         ((#:u+ x)
 117          #`(py-u+ #,(lp x)))
 118         ((#:u- x)
 119          #`(py-u- #,(lp x)))
 120         ((#:u~ x)
 121          #`(py-u~ #,(lp x)))
 122         ((#:power x trailer . #f)
 123          (compile-trailer trailer (lp x)))
 124         ((#:power x trailer . l)
 125          #'(py-power ,#(compile-trailer trailer (lp x)) #,(lp l)))
 126         ((#:identifier x . _)
 127          (datum->syntax stx (string->symbol x)))
 128         ((not (_ . _))
 129          tree))))
 130
 131
 132
 133   (lambda (tree)
 134     (match tree
 135       ((test1 (#:assign))
 136        (expr-rhs test1))
 137       ((test1 (#:assign tests ... last))
 138        (with-syntax (((rhs ...)       (map expr-rhs last))
 139                      ((lhs1 ...)      (map expr-lhs test1))
 140                      (((lhs ...) ...) (reverse (map (lambda (l)
 141                                                       (map expr-lhs l))
 142                                                     tests))))
 143           (with-syntax (((v ...) (generate-temporaries #'(lhs1 ...))))
 144              (out #'(call-with-values (lambda () (values rhs ...))
 145                       (lambda (v ...)
 146                         (begin
 147                           (set! lhs v) ...)
 148                         ...
 149                         (set! lhs1 v) ...)))))))))
 150
 151
 152 (define (compile-outer state out tree)
 153   (define (compile-stmt state tree)
 154     (match tree
 155       ((#:expr-stmt l)
 156        (compile-expr l))
 157
 158       ((#:del       l)
 159        (compile-del l))
 160
 161       (#:pass
 162        (out #'(if #f #f)))
 163
 164       (#:break
 165        (break out))
 166
 167       (#:continue
 168        (continue out))
 169
 170       ((#:return . l)
 171        (compile-return state l))
 172
 173       ((#:raise . l)
 174        (compile-raise state l))
 175
 176       ((#:import l)
 177        (compile-import state l))
 178
 179       ((#:global . _)
 180        #t)
 181
 182       ((#:nonlocal . _)
 183        #t)
 184
 185       ((#:assert . l)
 186        (compile-assert state l))))
 187
 188   (match tree
 189     ((#:stmt x)
 190      (for-each* compile-stmt tree))
 191     ((#:if . l)
 192      (compile-if state l))
 193     ((#:while . l)
 194      (compile-while state l))
 195     ((#:for  . l)
 196      (compile-for state l))
 197     ((#:try  . l)
 198      (compile-try state l))
 199     ((#:with . l)
 200      (compile-with state l))
 201     ((#:def  . l)
 202      (compile-def state l))
 203     ((#:decorated . l)
 204      (compile-decorated state l))))
 205
 206
 207 (define (compile-python0 stx tree output)
 208   (define global-variables (make-hash-table))
 209
 210   (find-global-variables global-variables tree)
 211   (set! all-variables
 212         (hash-fold
 213          (lambda (k v e)
 214            (match k
 215              ((_ v . _)
 216               (cons (datum->syntax stx (string->symbol v)) e))))
 217          '() global-variables))
 218   (set! all-globals
 219         (hash-fold
 220          (lambda (k v e)
 221            (match k
 222              ((_ v)
 223               (cons (datum->syntax stx (string->symbol v)) e))))
 224          '() global-variables))
 225
 226   (output (with-syntax (((v ...) all-variables))
 227            #'(begin (define v (if #f #f)) ...)))
 228
 229   (output (with-syntax (((v ...) all-globals))
 230             #'(export v ...)))
 231
 232   (output #`(begin #,@(compile-outer))))
 233
 234
 235 (define (compile-python1 stx tree)
 236   (let ((out '()))
 237     (define (out x) (set! out (cons x out)))
 238     (compile-python0 stx tree out)
 239     (cons* #'begin (reverse out))))
 240
 241 (define-syntax compile-python-string
 242   (lambda (x)
 243     (syntax-case x ()
 244       ((_ y)
 245        (if (string? (syntax->datum #'y))
 246            (compile-python1 x (python-parser (syntax->datum #'y))))))))
 247
 248 (define-syntax compile-python-file
 249   (lambda (x)
 250     (syntax-case x ()
 251       ((_ y)
 252        (if (string? (syntax->datum #'y))
 253            (with-input-from-file (syntax->datum #'y)
 254              (lambda () (compile-python1 x (python-parser))))
 255            #f)))))
 256
 257
 258
 259
 260
 261
 262
 263
 264
 265