operators.scm

   1 ;;; operators
   2
   3 (define operators '())
   4
   5 (define (define-op1 six-id id type-rule constant-fold code-gen)
   6   (set! operators
   7         (cons (make-op1 six-id id type-rule constant-fold code-gen)
   8               operators)))
   9
  10 (define (define-op2 six-id id type-rule constant-fold code-gen)
  11   (set! operators
  12         (cons (make-op2 six-id id type-rule constant-fold code-gen)
  13               operators)))
  14
  15 ;; no need for type checks, every type sixpic supports can be casted to / from
  16 ;; ints (except void, but this is a non-issue) and promotion (by padding) and
  17 ;; truncation is done at the cfg level
  18 ;; TODO really ignore the void issue ? assigning the "result" of a void function to an int variable should be an error
  19 (define (type-rule-int-op1 ast)
  20   (expr-type (subast1 ast)))
  21
  22 (define (largest t1 t2)
  23   (let loop ((l '(int int32 int16 int8 byte))) ;; TODO FOO, use the functions type->bytes and bytes->type instead
  24     (if (null? l)
  25         (error "largest: unknown type")
  26         (let ((head (car l)))
  27           (if (or (eq? head t1)
  28                   (eq? head t2))
  29               head
  30               (loop (cdr l)))))))
  31
  32 (define (type-rule-int-op2 ast)
  33   (let ((t1 (expr-type (subast1 ast)))
  34         (t2 (expr-type (subast2 ast))))
  35     (largest t1 t2)))
  36
  37 (define (type-rule-int-assign ast) ;; TODO why the int in the name ?
  38   (let ((t1 (expr-type (subast1 ast))))
  39     ;; the type of the rhs is irrelevant, since it will be promoted
  40     ;; or truncated at the cfg level
  41     t1))
  42
  43 (define (type-rule-int-comp-op2 ast)
  44   'bool) ;; TODO why even bother ? anything can be casted to int to be used as argument here, old version is in garbage (and in version control) if needed
  45
  46 (define (type-rule-bool-op2 ast)
  47   'bool) ;; TODO same here
  48
  49 (define-op1 'six.!x '!x
  50   type-rule-int-op1
  51   (lambda (ast) ;; TODO implement these ?
  52     ast)
  53   (lambda (ast)
  54     ...))
  55
  56 (define-op1 'six.++x '++x
  57   type-rule-int-op1
  58   (lambda (ast)
  59     ast)
  60   (lambda (ast)
  61     ...))
  62
  63 (define-op1 'six.x++ 'x++
  64   type-rule-int-op1
  65   (lambda (ast)
  66     ast)
  67   (lambda (ast)
  68     ...))
  69
  70 (define-op1 'six.--x '--x
  71   type-rule-int-op1
  72   (lambda (ast)
  73     ast)
  74   (lambda (ast)
  75     ...))
  76
  77 (define-op1 'six.x-- 'x--
  78   type-rule-int-op1
  79   (lambda (ast)
  80     ast)
  81   (lambda (ast)
  82     ...))
  83
  84 (define-op1 'six.~x '~x
  85   type-rule-int-op1
  86   (lambda (ast)
  87     ast)
  88   (lambda (ast)
  89     ...))
  90
  91 (define-op2 'six.x%y 'x%y
  92   type-rule-int-op2
  93   (lambda (ast)
  94     ast)
  95   (lambda (ast)
  96     ...))
  97
  98 (define-op2 'six.x*y 'x*y
  99   ;; products can be as wide as the sum of the widths of the operands
 100   (lambda (ast)
 101     (let ((l1 (type->bytes (expr-type (subast1 ast))))
 102           (l2 (type->bytes (expr-type (subast2 ast)))))
 103       (bytes->type (+ l1 l2))))
 104   (lambda (ast)
 105     ast)
 106   (lambda (ast)
 107     ...))
 108
 109 (define-op1 'six.*x '*x
 110   (lambda (ast)
 111     'byte) ; we only have byte arrays
 112   (lambda (ast)
 113     ast)
 114   (lambda (ast)
 115     ...))
 116
 117 (define-op2 'six.index 'index
 118   (lambda (ast)
 119     'byte) ; we only have byte arrays
 120   (lambda (ast)
 121     ast)
 122   (lambda (asr)
 123     ...))
 124
 125 (define-op2 'six.x/y 'x/y
 126   type-rule-int-op2 ;; TODO really ?
 127   (lambda (ast)
 128     ast)
 129   (lambda (ast)
 130     ...))
 131
 132 (define-op2 'six.x+y 'x+y
 133   type-rule-int-op2
 134   (lambda (ast)
 135     ast)
 136   (lambda (ast)
 137     ...))
 138
 139 (define-op1 'six.+x '+x
 140   type-rule-int-op1
 141   (lambda (ast)
 142     (subast1 ast))
 143   (lambda (ast)
 144     ...))
 145
 146 (define-op2 'six.x-y 'x-y
 147   type-rule-int-op2
 148   (lambda (ast)
 149     ast)
 150   (lambda (ast)
 151     ...))
 152
 153 (define-op1 'six.-x '-x
 154   type-rule-int-op1
 155   (lambda (ast)
 156     ast)
 157   (lambda (ast)
 158     ...))
 159
 160 (define-op2 'six.x<<y 'x<<y
 161   type-rule-int-op2
 162   (lambda (ast)
 163     ast)
 164   (lambda (ast)
 165     ...))
 166
 167 (define-op2 'six.x>>y 'x>>y
 168   type-rule-int-op2
 169   (lambda (ast)
 170     ast)
 171   (lambda (ast)
 172     ...))
 173
 174 (define-op2 'six.x<y 'x<y
 175   type-rule-int-comp-op2
 176   (lambda (ast)
 177     ast)
 178   (lambda (ast)
 179     ...))
 180
 181 (define-op2 'six.x<=y 'x<=y
 182   type-rule-int-comp-op2
 183   (lambda (ast)
 184     ast)
 185   (lambda (ast)
 186     ...))
 187
 188 (define-op2 'six.x>y 'x>y
 189   type-rule-int-comp-op2
 190   (lambda (ast)
 191     ast)
 192   (lambda (ast)
 193     ...))
 194
 195 (define-op2 'six.x>=y 'x>=y
 196   type-rule-int-comp-op2
 197   (lambda (ast)
 198     ast)
 199   (lambda (ast)
 200     ...))
 201
 202 (define-op2 'six.x!=y 'x!=y
 203   type-rule-int-comp-op2
 204   (lambda (ast)
 205     ast)
 206   (lambda (ast)
 207     ...))
 208
 209 (define-op2 'six.x==y 'x==y
 210   type-rule-int-comp-op2
 211   (lambda (ast)
 212     ast)
 213   (lambda (ast)
 214     ...))
 215
 216 (define-op2 'six.x&y 'x&y
 217   type-rule-int-op2
 218   (lambda (ast)
 219     ast)
 220   (lambda (ast)
 221     ...))
 222
 223 (define-op1 'six.&x '&x
 224   (lambda (ast)
 225     ...)
 226   (lambda (ast)
 227     ast)
 228   (lambda (ast)
 229     ...))
 230
 231 (define-op2 'six.x^y 'x^y
 232   type-rule-int-op2
 233   (lambda (ast)
 234     ast)
 235   (lambda (ast)
 236     ...))
 237
 238 (define-op2 '|six.x\|y| '|x\|y|
 239   type-rule-int-op2
 240   (lambda (ast)
 241     ast)
 242   (lambda (ast)
 243     ...))
 244
 245 (define-op2 'six.x&&y 'x&&y
 246   type-rule-bool-op2
 247   (lambda (ast)
 248     ast)
 249   (lambda (ast)
 250     ...))
 251
 252 (define-op2 '|six.x\|\|y| '|x\|\|y|
 253   type-rule-bool-op2
 254   (lambda (ast)
 255     ast)
 256   (lambda (ast)
 257     ...))
 258
 259 (define-op2 'six.x?y:z 'x?y:z
 260   (lambda (ast)
 261     ...)
 262   (lambda (ast)
 263     ast)
 264   (lambda (ast)
 265     ...))
 266
 267 (define-op2 'six.x:y 'x:y
 268   (lambda (ast)
 269     ...)
 270   (lambda (ast)
 271     ast)
 272   (lambda (ast)
 273     ...))
 274
 275 (define-op2 'six.x%=y 'x%=y
 276   type-rule-int-assign
 277   (lambda (ast)
 278     ast)
 279   (lambda (ast)
 280     ...))
 281
 282 (define-op2 'six.x&=y 'x&=y
 283   type-rule-int-assign
 284   (lambda (ast)
 285     ast)
 286   (lambda (ast)
 287     ...))
 288
 289 (define-op2 'six.x*=y 'x*=y
 290   type-rule-int-assign
 291   (lambda (ast)
 292     ast)
 293   (lambda (ast)
 294     ...))
 295
 296 (define-op2 'six.x+=y 'x+=y
 297   type-rule-int-assign
 298   (lambda (ast)
 299     ast)
 300   (lambda (ast)
 301     ...))
 302
 303 (define-op2 'six.x-=y 'x-=y
 304   type-rule-int-assign
 305   (lambda (ast)
 306     ast)
 307   (lambda (ast)
 308     ...))
 309
 310 (define-op2 'six.x/=y 'x/=y
 311   type-rule-int-assign
 312   (lambda (ast)
 313     ast)
 314   (lambda (ast)
 315     ...))
 316
 317 (define-op2 'six.x<<=y 'x<<=y
 318   type-rule-int-assign
 319   (lambda (ast)
 320     ast)
 321   (lambda (ast)
 322     ...))
 323
 324 (define-op2 'six.x=y 'x=y
 325   type-rule-int-assign
 326   (lambda (ast)
 327     ast)
 328   (lambda (ast)
 329     ...))
 330
 331 (define-op2 'six.x>>=y 'x>>=y
 332   type-rule-int-assign
 333   (lambda (ast)
 334     ast)
 335   (lambda (ast)
 336     ...))
 337
 338 (define-op2 'six.x^=y 'x^=y
 339   type-rule-int-assign
 340   (lambda (ast)
 341     ast)
 342   (lambda (ast)
 343     ...))
 344
 345 (define-op2 '|six.x\|=y| '|x\|=y|
 346   type-rule-int-assign
 347   (lambda (ast)
 348     ast)
 349   (lambda (ast)
 350     ...))
 351
 352 (define-op2 'six.x:=y 'x:=y
 353   (lambda (ast)
 354     ...)
 355   (lambda (ast)
 356     ...)
 357   (lambda (ast)
 358     ...))
 359
 360 (define-op2 '|six.x,y| '|x,y|
 361   (lambda (ast)
 362     ...)
 363   (lambda (ast)
 364     ...)
 365   (lambda (ast)
 366     ...))
 367
 368 (define-op2 'six.x:-y 'x:-y
 369   (lambda (ast)
 370     ...)
 371   (lambda (ast)
 372     ...)
 373   (lambda (ast)
 374     ...))
 375
 376 (define (operation? source)
 377   (and (pair? source)
 378        (let ((x (car source)))
 379          (let loop ((lst operators))
 380            (cond ((null? lst)
 381                   #f)
 382                  ((eq? (op-six-id (car lst)) x)
 383                   (car lst))
 384                  (else
 385                   (loop (cdr lst))))))))