Finish adding binops, unops, testops, and relops to the type system

wasmlike/instructions.txt

@@ -105,7 +105,7 @@ Numeric Instructions
 [ ] f32.add
 [ ] f32.sub
 [ ] f32.mul
-[ ] f32.dib
+[ ] f32.div
 [ ] f32.min
 [ ] f32.max
 [ ] f32.copysign

wasmlike/wasmlike.rkt

@@ -41,6 +41,9 @@
  
 (define-spec-component wasm-like)
 
+(define (choose-random-sign) (< (random) 0.5))
+;;todo use a passed in node to assign sign distributions per type instead of blanket-wise
+
 ;; This defines the layout of the grammar.
 (add-to-grammar
  wasm-like
@@ -61,6 +64,7 @@
                         #:prop choice-weight 3]
  [LiteralFloatSixtyFour Literal ([v = (+ (random -1000 1000) (random))])
                         #:prop choice-weight 3]
+
  [Noop Expr ([expr : Expr])]
  [Binop Expr ([l : Expr] [r : Expr]) ;;Binops take a left and a right and produce the same type
         #:prop choice-weight 30      ;; as the result
@@ -74,36 +78,44 @@
  [Testop Expr ([expr : Expr]) ;;Testops take one operand but return a boolean (i32)
          #:prop choice-weight 10
          #:prop may-be-generated #f]
- [Equal Comparison ()]
- [NotEqual Comparison ()]
+
  [Addition Binop ()]
  [Subtraction Binop ()]
  [Multiplication Binop ()]
- [DivisionSigned Binop ()] ;;todo Maybe add the signedness as a field instead of a whole other instruction
-                           ;;todo After looking at the float instructions.... yup. This needs to be done
- [DivisionUnsigned Binop ()]
- [LessThanSigned Comparison ()]
- [LessThanUnsigned Comparison ()]
- [GreaterThanSigned Comparison ()]
- [GreaterThanUnsigned Comparison ()]
- [LessThanOrEqualSigned Comparison ()]
- [LessThanOrEqualUnsigned Comparison ()]
- [GreaterThanOrEqualSigned Comparison ()]
- [GreaterThanOrEqualUnsigned Comparison ()]
- [RemainderSigned Binop ()]
- [RemainderUnsigned Binop ()]
+ [Division Binop ([sign = (choose-random-sign)])] ;;These signs only matter for ints, not floats
+ [Remainder Binop ([sign = (choose-random-sign)])]
  [And Binop ()]
  [Or Binop ()]
  [Xor Binop ()]
  [ShiftLeft Binop ()]
- [ShiftRightSigned Binop ()]
- [ShiftRightUnsigned Binop ()]
+ [ShiftRight Binop ([sign = (choose-random-sign)])]
  [RotateLeft Binop ()]
  [RotateRight Binop ()]
- [EqualZero Testop ()]
+ [Min Binop ()]
+ [Max Binop ()]
+ [CopySign Binop ()]
+
+ 
+ [Equal Comparison ()]
+ [NotEqual Comparison ()]
+ [LessThan Comparison ([sign = (choose-random-sign)])]
+ [GreaterThan Comparison ([sign = (choose-random-sign)])]
+ [LessThanOrEqual Comparison ([sign = (choose-random-sign)])]
+ [GreaterThanOrEqual Comparison ([sign = (choose-random-sign)])]
+
  [CountLeadingZero Unop ()]  ;; According to the spec, these are unops, not testops
  [CountTrailingZero Unop ()]
  [NonZeroBits Unop ()]
+ [AbsoluteValue Unop ()]
+ [Negate Unop ()]
+ [SquareRoot Unop ()]
+ [Ceiling Unop ()]
+ [Floor Unop ()]
+ [Truncate Unop ()]
+ [Nearest Unop ()]
+
+ [EqualZero Testop ()]
+ 
  [IfElse Expr ([cond : Expr]
                [then : Expr]
                [else : Expr])
@@ -155,10 +167,10 @@
  [TypeConversion Expr ([expr : Expr])
                  #:prop choice-weight 20
                  #:prop may-be-generated #f]
- [Truncate TypeConversion ([sign = (< (random) 0.5)])]  ;; float -> int
- [Convert TypeConversion ([sign = (< (random) 0.5)])]   ;; int -> float
+ [TruncateFloat TypeConversion ([sign = (choose-random-sign)])]  ;; float -> int
+ [ConvertInt TypeConversion ([sign = (choose-random-sign)])]   ;; int -> float
  [Wrap TypeConversion ()]                               ;; i64 -> i32
- [Extend TypeConversion ([sign = (< (random) 0.5)])]    ;; i32 -> i64
+ [Extend TypeConversion ([sign = (choose-random-sign)])]    ;; i32 -> i64
  [Demote TypeConversion ()]                             ;; f64 -> f32
  [Promote TypeConversion ()]                            ;; f32 -> f64
  [ReinterpretIntThirtyTwo TypeConversion ()]
@@ -198,10 +210,11 @@
   ;;todo Implement these with the upcoming custom name changes  
  
   ;; Let the initial value and loop body be handled by the default
-  [ForLoop (hash 'loopvar (make-fresh-node 'GlobalSet
-                                           (hash 'val (make-fresh-node 'LiteralIntThirtyTwo) ;;dummy
-                                                 'name (binding-name (send this xsmith_get-reference-for-child! i32 #t))
-                                                 'expr (make-fresh-node 'LiteralIntThirtyTwo))))] ;;dummy
+  [ForLoop (hash 'loopvar (make-fresh-node 
+                            'GlobalSet
+                            (hash 'val (make-fresh-node 'LiteralIntThirtyTwo) ;;dummy
+                                  'name (binding-name (send this xsmith_get-reference-for-child! i32 #t))
+                                  'expr (make-fresh-node 'LiteralIntThirtyTwo))))] ;;dummy
 )
 
 (add-att-rule
@@ -231,6 +244,13 @@
 (define (no-child-types)
   (λ (n t) (hash))) 
 
+(define binop-rhs (λ (n t)
+                     (hash 'l t
+                           'r t)))
+
+(define unop-rhs (λ (n t)
+                    (hash 'expr t)))
+
 (add-prop
  wasm-like type-info
           [Program [i32
@@ -251,13 +271,34 @@
           [LiteralFloatSixtyFour [f64
                     (no-child-types)]]
           [Noop [(fresh-subtype-of number) (λ (n t) (hash 'expr t))]] ;;todo This is wierd....
-          [Binop [(fresh-subtype-of number) 
-                  (λ (n t) 
-                     (hash 'l t 
-                           'r t))]]
-          [Unop [(fresh-subtype-of number)
-                 (λ (n t)
-                    (hash 'expr t))]]
+          
+          [Binop [(fresh-subtype-of number) binop-rhs]]
+          ;; Restricted binops:
+          [Remainder [(fresh-subtype-of int) binop-rhs]]
+          [And [(fresh-subtype-of int) binop-rhs]]
+          [Or [(fresh-subtype-of int) binop-rhs]]
+          [Xor [(fresh-subtype-of int) binop-rhs]]
+          [ShiftLeft [(fresh-subtype-of int) binop-rhs]]
+          [ShiftRight [(fresh-subtype-of int) binop-rhs]]
+          [RotateLeft [(fresh-subtype-of int) binop-rhs]]
+          [RotateRight [(fresh-subtype-of int) binop-rhs]]
+          [Min [(fresh-subtype-of float) binop-rhs]]
+          [Max [(fresh-subtype-of float) binop-rhs]]
+          [CopySign [(fresh-subtype-of float) binop-rhs]]
+
+          [Unop [(fresh-subtype-of number) unop-rhs]]
+          ;; Restricted Unops
+          [CountLeadingZero [(fresh-subtype-of int) unop-rhs]]
+          [CountTrailingZero [(fresh-subtype-of int) unop-rhs]]
+          [NonZeroBits [(fresh-subtype-of int) unop-rhs]]
+          [AbsoluteValue [(fresh-subtype-of float) unop-rhs]]
+          [Negate [(fresh-subtype-of float) unop-rhs]]
+          [SquareRoot [(fresh-subtype-of float) unop-rhs]]
+          [Ceiling [(fresh-subtype-of float) unop-rhs]]
+          [Floor [(fresh-subtype-of float) unop-rhs]]
+          [Truncate [(fresh-subtype-of float) unop-rhs]]
+          [Nearest [(fresh-subtype-of float) unop-rhs]]
+          
           [Comparison [i32
                        (λ (n t) ;; The type of the children is unconstrained, they just have to be the same
                           (define child-type (fresh-subtype-of number))
@@ -275,6 +316,8 @@
                 (λ (n t)
                    (hash 'cond i32
                          'then t))]]
+
+
           [Block [(fresh-subtype-of number) (λ (n t) (hash 'expr t))]]
           [Loop [(fresh-subtype-of number) (λ (n t) (hash 'expr t))]]
           [ForLoop [(fresh-subtype-of number) (λ (n t) (hash 'initial i32
@@ -297,10 +340,10 @@
           [GlobalSet [(fresh-subtype-of number) (λ (n t) (hash 'val t
                                                            'expr t))]]
           ;;Type conversions
-          [Truncate [(fresh-subtype-of int) 
+          [TruncateFloat [(fresh-subtype-of int) 
                      (λ (n t) 
                         (hash 'expr (fresh-subtype-of float)))]]
-          [Convert [(fresh-subtype-of float) 
+          [ConvertInt [(fresh-subtype-of float) 
                     (λ (n t) 
                        (hash 'expr (fresh-subtype-of int)))]]
           [Wrap [i32 (λ (n t) 
@@ -542,12 +585,12 @@
                  ($xsmith_render-node (ast-child 'val n))
                  `(global.set ,(string->symbol (format "$~a" (ast-child 'name n))))
                  ($xsmith_render-node (ast-child 'expr n))))]
- [Truncate (λ (n)
-              (append
-                '(FIXME)))]
- [Convert (λ (n)
-             (append
-               '(FIXME)))]
+ [TruncateFloat (λ (n)
+                  (append
+                    '(FIXME)))]
+ [ConvertInt (λ (n)
+               (append
+                 '(FIXME)))]
  [Wrap (λ (n)
           (append
             '(FIXME)))]
@@ -587,37 +630,58 @@
 
 (add-att-rule
   wasm-like math-op
-  [Equal (λ (n) (prefix-type n '.eq))]
-  [NotEqual (λ (n) (prefix-type n '.ne))]
-  [EqualZero (λ (n) (prefix-type n '.eqz))]
   [Addition (λ (n) (prefix-type n '.add))]
   [Subtraction (λ (n) (prefix-type n '.sub))]
   [Multiplication (λ (n) (prefix-type n '.mul))]
-  [DivisionSigned (λ (n) (prefix-type n '.div_s))]
-  [DivisionUnsigned (λ (n) (prefix-type n '.div_u))]
-  [LessThanSigned (λ (n) (prefix-type n '.lt_s))]
-  [LessThanUnsigned (λ (n) (prefix-type n '.lt_u))]
-  [GreaterThanSigned (λ (n) (prefix-type n '.gt_s))]
-  [GreaterThanUnsigned (λ (n) (prefix-type n '.gt_u))]
-  [LessThanOrEqualSigned (λ (n) (prefix-type n '.le_s))]
-  [LessThanOrEqualUnsigned (λ (n) (prefix-type n '.le_u))]
-  [GreaterThanOrEqualSigned (λ (n) (prefix-type n '.ge_s))]
-  [GreaterThanOrEqualUnsigned (λ (n) (prefix-type n '.ge_u))]
-  [CountLeadingZero (λ (n) (prefix-type n '.clz))]
-  [CountTrailingZero (λ (n) (prefix-type n '.ctz))]
-  [NonZeroBits (λ (n) (prefix-type n '.popcnt))]
-  [RemainderSigned (λ (n) (prefix-type n '.rem_s))]
-  [RemainderUnsigned (λ (n) (prefix-type n '.rem_u))]
+  [Division (λ (n) (prefix-type n (add-signed-suffix n '.div)))]
+  [Remainder (λ (n) (prefix-type n (add-signed-suffix n '.rem)))]
   [And (λ (n) (prefix-type n '.and))]
   [Or (λ (n) (prefix-type n '.or))]
   [Xor (λ (n) (prefix-type n '.xor))]
   [ShiftLeft (λ (n) (prefix-type n '.shl))]
-  [ShiftRightSigned (λ (n) (prefix-type n '.shr_s))]
-  [ShiftRightUnsigned (λ (n) (prefix-type n '.shr_u))]
+  [ShiftRight (λ (n) (prefix-type n (add-signed-suffix n '.shr)))]
   [RotateLeft (λ (n) (prefix-type n '.rotl))]
   [RotateRight (λ (n) (prefix-type n '.rotr))]
+  [Min (λ (n) (prefix-type n '.min))]
+  [Max (λ (n) (prefix-type n '.max))]
+  [CopySign (λ (n) (prefix-type n '.copysign))]
 
+  [Equal (λ (n) (prefix-type n '.eq))]
+  [NotEqual (λ (n) (prefix-type n '.ne))]
+  [LessThan (λ (n) (prefix-type n (add-signed-suffix n '.lt)))]
+  [GreaterThan (λ (n) (prefix-type n (add-signed-suffix n '.gt)))]
+  [LessThanOrEqual (λ (n) (prefix-type n (add-signed-suffix n '.le)))]
+  [GreaterThanOrEqual (λ (n) (prefix-type n (add-signed-suffix n '.ge)))]
+
+  [CountLeadingZero (λ (n) (prefix-type n '.clz))]
+  [CountTrailingZero (λ (n) (prefix-type n '.ctz))]
+  [NonZeroBits (λ (n) (prefix-type n '.popcnt))]
+  [AbsoluteValue (λ (n) (prefix-type n '.abs))]
+  [Negate (λ (n) (prefix-type n '.neg))]
+  [SquareRoot (λ (n) (prefix-type n '.sqrt))]
+  [Ceiling (λ (n) (prefix-type n '.ceil))]
+  [Floor (λ (n) (prefix-type n '.floor))]
+  [Truncate (λ (n) (prefix-type n '.trunc))]
+  [Nearest (λ (n) (prefix-type n '.nearest))]
+ 
+  [EqualZero (λ (n) (prefix-type n '.eqz))]
 )
+
+;; Adds a sign suffix if needed. It can differentiate between float and int for 
+;; nodes like division, which only need a sign suffix on the int base-type
+(define (add-signed-suffix node instruction)
+  (let ([node-type (get-base-type-name)])
+    (cond [(or (eq? node-type 'i32) (eq? node-type 'i64))
+           (if (ast-child 'sign node)
+             (format "~a~a" instruction '_s)
+             (format "~a~a" instruction '_u))]
+          [(or (eq? node-type 'f32) (eq? node-type 'f64))
+           instruction] ;; floats don't need any suffixes
+          [else
+            (begin
+              (eprintf "Node type not a base type when adding a signed suffix")
+              'ERROR)])))
+
  
 ;; This line defines `webassembly-generate-ast`.
 (assemble-spec-components webassembly wasm-like)