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 (define (type-rule-int-op1 ast)
  16   (let ((t1 (expr-type (subast1 ast))))
  17     (cond ((eq? t1 'int)
  18            'int) ; TODO add support for other types
  19           (else
  20            (error "type error" ast)))))
  21
  22 (define (type-rule-int-op2 ast)
  23   (let ((t1 (expr-type (subast1 ast)))
  24         (t2 (expr-type (subast2 ast))))
  25     (cond ((and (eq? t1 'int) (eq? t2 'int)) ; TODO are there any operations that do otherwise ? add cast support also
  26            'int)
  27           (else
  28            (error "type error" ast)))))
  29
  30 (define (type-rule-int-assign ast) ;; TODO add cast support, and why the int in the name ?
  31   (let ((t1 (expr-type (subast1 ast)))
  32         (t2 (expr-type (subast2 ast))))
  33     (if (not (eq? t1 t2))
  34         (error "type error" ast))
  35     t1))
  36
  37 (define (type-rule-int-comp-op2 ast)
  38   (let ((t1 (expr-type (subast1 ast)))
  39         (t2 (expr-type (subast2 ast))))
  40     (cond ((and (eq? t1 'int) (eq? t2 'int))
  41            'bool)
  42           (else
  43            (error "type error" ast)))))
  44
  45 (define-op1 'six.!x '!x
  46   type-rule-int-op1
  47   (lambda (ast) ;; TODO implement these
  48     ast)
  49   (lambda (ast)
  50     ...))
  51
  52 (define-op1 'six.++x '++x
  53   type-rule-int-op1
  54   (lambda (ast)
  55     ast)
  56   (lambda (ast)
  57     ...))
  58
  59 (define-op1 'six.x++ 'x++
  60   type-rule-int-op1
  61   (lambda (ast)
  62     ast)
  63   (lambda (ast)
  64     ...))
  65
  66 (define-op1 'six.--x '--x
  67   type-rule-int-op1
  68   (lambda (ast)
  69     ast)
  70   (lambda (ast)
  71     ...))
  72
  73 (define-op1 'six.x-- 'x--
  74   type-rule-int-op1
  75   (lambda (ast)
  76     ast)
  77   (lambda (ast)
  78     ...))
  79
  80 (define-op1 'six.~x '~x
  81   type-rule-int-op1
  82   (lambda (ast)
  83     ast)
  84   (lambda (ast)
  85     ...))
  86
  87 (define-op2 'six.x%y 'x%y
  88   type-rule-int-op2
  89   (lambda (ast)
  90     ast)
  91   (lambda (ast)
  92     ...))
  93
  94 (define-op2 'six.x*y 'x*y
  95   type-rule-int-op2
  96   (lambda (ast)
  97     ast)
  98   (lambda (ast)
  99     ...))
 100
 101 (define-op1 'six.*x '*x
 102   (lambda (ast)
 103     ...)
 104   (lambda (ast)
 105     ast)
 106   (lambda (ast)
 107     ...))
 108
 109 (define-op2 'six.x/y 'x/y
 110   type-rule-int-op2
 111   (lambda (ast)
 112     ast)
 113   (lambda (ast)
 114     ...))
 115
 116 (define-op2 'six.x+y 'x+y
 117   type-rule-int-op2
 118   (lambda (ast)
 119     ast)
 120   (lambda (ast)
 121     ...))
 122
 123 (define-op1 'six.+x '+x
 124   type-rule-int-op1
 125   (lambda (ast)
 126     (subast1 ast))
 127   (lambda (ast)
 128     ...))
 129
 130 (define-op2 'six.x-y 'x-y
 131   type-rule-int-op2
 132   (lambda (ast)
 133     ast)
 134   (lambda (ast)
 135     ...))
 136
 137 (define-op1 'six.-x '-x
 138   type-rule-int-op1
 139   (lambda (ast)
 140     ast)
 141   (lambda (ast)
 142     ...))
 143
 144 (define-op2 'six.x<<y 'x<<y
 145   type-rule-int-op2
 146   (lambda (ast)
 147     ast)
 148   (lambda (ast)
 149     ...))
 150
 151 (define-op2 'six.x>>y 'x>>y
 152   type-rule-int-op2
 153   (lambda (ast)
 154     ast)
 155   (lambda (ast)
 156     ...))
 157
 158 (define-op2 'six.x<y 'x<y
 159   type-rule-int-comp-op2
 160   (lambda (ast)
 161     ast)
 162   (lambda (ast)
 163     ...))
 164
 165 (define-op2 'six.x<=y 'x<=y
 166   type-rule-int-comp-op2
 167   (lambda (ast)
 168     ast)
 169   (lambda (ast)
 170     ...))
 171
 172 (define-op2 'six.x>y 'x>y
 173   type-rule-int-comp-op2
 174   (lambda (ast)
 175     ast)
 176   (lambda (ast)
 177     ...))
 178
 179 (define-op2 'six.x>=y 'x>=y
 180   type-rule-int-comp-op2
 181   (lambda (ast)
 182     ...)
 183   (lambda (ast)
 184     ...))
 185
 186 (define-op2 'six.x!=y 'x!=y
 187   type-rule-int-comp-op2
 188   (lambda (ast)
 189     ast)
 190   (lambda (ast)
 191     ...))
 192
 193 (define-op2 'six.x==y 'x==y
 194   type-rule-int-comp-op2
 195   (lambda (ast)
 196     ast)
 197   (lambda (ast)
 198     ...))
 199
 200 (define-op2 'six.x&y 'x&y
 201   type-rule-int-op2
 202   (lambda (ast)
 203     ast)
 204   (lambda (ast)
 205     ...))
 206
 207 (define-op1 'six.&x '&x
 208   (lambda (ast)
 209     ...)
 210   (lambda (ast)
 211     ast)
 212   (lambda (ast)
 213     ...))
 214
 215 (define-op2 'six.x^y 'x^y
 216   type-rule-int-op2
 217   (lambda (ast)
 218     ast)
 219   (lambda (ast)
 220     ...))
 221
 222 (define-op2 '|six.x\|y| '|x\|y|
 223   type-rule-int-op2
 224   (lambda (ast)
 225     ast)
 226   (lambda (ast)
 227     ...))
 228
 229 (define-op2 'six.x&&y 'x&&y
 230   type-rule-int-op2
 231   (lambda (ast)
 232     ast)
 233   (lambda (ast)
 234     ...))
 235
 236 (define-op2 '|six.x\|\|y| '|x\|\|y|
 237   type-rule-int-op2
 238   (lambda (ast)
 239     ast)
 240   (lambda (ast)
 241     ...))
 242
 243 (define-op2 'six.x?y:z 'x?y:z
 244   (lambda (ast)
 245     ...)
 246   (lambda (ast)
 247     ast)
 248   (lambda (ast)
 249     ...))
 250
 251 (define-op2 'six.x:y 'x:y
 252   (lambda (ast)
 253     ...)
 254   (lambda (ast)
 255     ast)
 256   (lambda (ast)
 257     ...))
 258
 259 (define-op2 'six.x%=y 'x%=y
 260   type-rule-int-assign
 261   (lambda (ast)
 262     ast)
 263   (lambda (ast)
 264     ...))
 265
 266 (define-op2 'six.x&=y 'x&=y
 267   type-rule-int-assign
 268   (lambda (ast)
 269     ast)
 270   (lambda (ast)
 271     ...))
 272
 273 (define-op2 'six.x*=y 'x*=y
 274   type-rule-int-assign
 275   (lambda (ast)
 276     ast)
 277   (lambda (ast)
 278     ...))
 279
 280 (define-op2 'six.x+=y 'x+=y
 281   type-rule-int-assign
 282   (lambda (ast)
 283     ast)
 284   (lambda (ast)
 285     ...))
 286
 287 (define-op2 'six.x-=y 'x-=y
 288   type-rule-int-assign
 289   (lambda (ast)
 290     ast)
 291   (lambda (ast)
 292     ...))
 293
 294 (define-op2 'six.x/=y 'x/=y
 295   type-rule-int-assign
 296   (lambda (ast)
 297     ast)
 298   (lambda (ast)
 299     ...))
 300
 301 (define-op2 'six.x<<=y 'x<<=y
 302   type-rule-int-assign
 303   (lambda (ast)
 304     ast)
 305   (lambda (ast)
 306     ...))
 307
 308 (define-op2 'six.x=y 'x=y
 309   type-rule-int-assign
 310   (lambda (ast)
 311     ast)
 312   (lambda (ast)
 313     ...))
 314
 315 (define-op2 'six.x>>=y 'x>>=y
 316   type-rule-int-assign
 317   (lambda (ast)
 318     ast)
 319   (lambda (ast)
 320     ...))
 321
 322 (define-op2 'six.x^=y 'x^=y
 323   type-rule-int-assign
 324   (lambda (ast)
 325     ast)
 326   (lambda (ast)
 327     ...))
 328
 329 (define-op2 '|six.x\|=y| '|x\|=y|
 330   type-rule-int-assign
 331   (lambda (ast)
 332     ast)
 333   (lambda (ast)
 334     ...))
 335
 336 (define-op2 'six.x:=y 'x:=y
 337   (lambda (ast)
 338     ...)
 339   (lambda (ast)
 340     ...)
 341   (lambda (ast)
 342     ...))
 343
 344 (define-op2 '|six.x,y| '|x,y|
 345   (lambda (ast)
 346     ...)
 347   (lambda (ast)
 348     ...)
 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 (operation? source)
 361   (and (pair? source)
 362        (let ((x (car source)))
 363          (let loop ((lst operators))
 364            (cond ((null? lst)
 365                   #f)
 366                  ((eq? (op-six-id (car lst)) x)
 367                   (car lst))
 368                  (else
 369                   (loop (cdr lst))))))))