Skip to content

Commit

Permalink
Add bit-operations to nat and int, and wrapping operations to all
Browse files Browse the repository at this point in the history
Builds on top of #2324, and is extracted from #2324.

Because this should be backwards-compatible, there is still the +>>
operator. Once `WordN` is removed, we only want and need the `>>`
operator (taking the signedness from the type). Until then, `

 * `>>` is unsigned on Nat and Word, and signed on Int.
 * `+>>` is always signed
  • Loading branch information
nomeata committed Feb 9, 2021
1 parent 095b32d commit c36a8d4
Show file tree
Hide file tree
Showing 14 changed files with 335 additions and 95 deletions.
8 changes: 8 additions & 0 deletions doc/modules/language-guide/examples/grammar.txt
Original file line number Diff line number Diff line change
Expand Up @@ -87,6 +87,10 @@
'/'
'%'
'**'
'+%'
'-%'
'*%'
'**%'
'&'
'|'
'^'
Expand Down Expand Up @@ -117,6 +121,10 @@
'/='
'%='
'**-'
'+%='
'-%='
'*%='
'**%='
'&='
'|='
'^='
Expand Down
242 changes: 152 additions & 90 deletions src/codegen/compile.ml

Large diffs are not rendered by default.

8 changes: 8 additions & 0 deletions src/gen-grammar/grammar.sed
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,14 @@ s/<semicolon>/\';\'/g
s/<annot_opt>/(':' <typ>)?/g
s/<pat_opt>/<pat_plain>?/g
s/epsilon/<empty>/g
s/WRAPADDASSIGN/\'+%=\'/g
s/WRAPSUBASSIGN/\'-%=\'/g
s/WRAPMULASSIGN/\'*%=\'/g
s/WRAPPOWASSIGN/\'**%=\'/g
s/WRAPADDOP/\'+%\'/g
s/WRAPSUBOP/\'-%\'/g
s/WRAPMULOP/\'*%\'/g
s/WRAPPOWOP/\'**%\'/g
s/ANDASSIGN/\'\&=\'/g
s/ACTOR/\'actor\'/g
s/IGNORE/\'ignore\'/g
Expand Down
8 changes: 8 additions & 0 deletions src/mo_frontend/error_reporting.ml
Original file line number Diff line number Diff line change
Expand Up @@ -116,3 +116,11 @@ let terminal2token (type a) (symbol : a terminal) : token =
| T_AND -> AND
| T_ADDOP -> ADDOP
| T_ACTOR -> ACTOR
| T_WRAPADDOP -> WRAPADDOP
| T_WRAPSUBOP -> WRAPSUBOP
| T_WRAPMULOP -> WRAPMULOP
| T_WRAPPOWOP -> WRAPPOWOP
| T_WRAPADDASSIGN -> WRAPADDOP
| T_WRAPSUBASSIGN -> WRAPSUBOP
| T_WRAPMULASSIGN -> WRAPMULOP
| T_WRAPPOWASSIGN -> WRAPPOWOP
16 changes: 13 additions & 3 deletions src/mo_frontend/parser.mly
Original file line number Diff line number Diff line change
Expand Up @@ -223,12 +223,14 @@ let share_dec_field (df : dec_field) =
%token DEBUG_SHOW
%token ASSERT
%token ADDOP SUBOP MULOP DIVOP MODOP POWOP
%token WRAPADDOP WRAPSUBOP WRAPMULOP WRAPPOWOP
%token ANDOP OROP XOROP SHLOP USHROP SSHROP ROTLOP ROTROP
%token EQOP NEQOP LEOP LTOP GTOP GEOP
%token HASH
%token EQ LT GT
%token PLUSASSIGN MINUSASSIGN MULASSIGN DIVASSIGN MODASSIGN POWASSIGN CATASSIGN
%token ANDASSIGN ORASSIGN XORASSIGN SHLASSIGN USHRASSIGN SSHRASSIGN ROTLASSIGN ROTRASSIGN
%token WRAPADDASSIGN WRAPSUBASSIGN WRAPMULASSIGN WRAPPOWASSIGN
%token NULL
%token FLEXIBLE STABLE
%token<string> DOT_NUM
Expand All @@ -248,13 +250,13 @@ let share_dec_field (df : dec_field) =
%left OR
%left AND
%nonassoc EQOP NEQOP LEOP LTOP GTOP GEOP
%left ADDOP SUBOP HASH
%left MULOP DIVOP MODOP
%left ADDOP SUBOP WRAPADDOP WRAPSUBOP HASH
%left MULOP WRAPMULOP DIVOP MODOP
%left OROP
%left ANDOP
%left XOROP
%nonassoc SHLOP USHROP SSHROP ROTLOP ROTROP
%left POWOP
%left POWOP WRAPPOWOP

%type<Mo_def.Syntax.exp> exp(ob) exp_nullary(ob) exp_plain exp_obj exp_nest deprecated_exp_obj deprecated_exp_block
%type<Mo_def.Syntax.typ_item> typ_item
Expand Down Expand Up @@ -492,6 +494,10 @@ lit :
| DIVOP { DivOp }
| MODOP { ModOp }
| POWOP { PowOp }
| WRAPADDOP { WrappingAddOp }
| WRAPSUBOP { WrappingSubOp }
| WRAPMULOP { WrappingMulOp }
| WRAPPOWOP { WrappingPowOp }
| ANDOP { AndOp }
| OROP { OrOp }
| XOROP { XorOp }
Expand Down Expand Up @@ -522,6 +528,10 @@ lit :
| DIVASSIGN { DivOp }
| MODASSIGN { ModOp }
| POWASSIGN { PowOp }
| WRAPADDASSIGN { WrappingAddOp }
| WRAPSUBASSIGN { WrappingSubOp }
| WRAPMULASSIGN { WrappingMulOp }
| WRAPPOWASSIGN { WrappingPowOp }
| ANDASSIGN { AndOp }
| ORASSIGN { OrOp }
| XORASSIGN { XorOp }
Expand Down
10 changes: 9 additions & 1 deletion src/mo_frontend/printers.ml
Original file line number Diff line number Diff line change
Expand Up @@ -55,7 +55,15 @@ let string_of_symbol symbol : string =
| X (T T_PRIVATE) -> "private"
| X (T T_PRIM) -> "prim"
| X (T T_POWOP) -> binop "**"
| X (T T_POWASSIGN) -> binassign "**-"
| X (T T_WRAPADDOP) -> binop "+%"
| X (T T_WRAPSUBOP) -> binop "-%"
| X (T T_WRAPMULOP) -> binop "*%"
| X (T T_WRAPPOWOP) -> binop "**%"
| X (T T_WRAPADDASSIGN) -> binassign "+%-"
| X (T T_WRAPSUBASSIGN) -> binassign "-%="
| X (T T_WRAPMULASSIGN) -> binassign "*%="
| X (T T_WRAPPOWASSIGN) -> binassign "**%="
| X (T T_POWASSIGN) -> binassign "**="
| X (T T_PLUSASSIGN) -> unassign "+="
| X (T T_OROP) -> binop "|"
| X (T T_ORASSIGN) -> binassign "|="
Expand Down
8 changes: 8 additions & 0 deletions src/mo_frontend/source_lexer.mll
Original file line number Diff line number Diff line change
Expand Up @@ -143,6 +143,10 @@ rule token mode = parse
| "+>>" { SSHROP }
| "<<>" { ROTLOP }
| "<>>" { ROTROP }
| "+%" { WRAPADDOP }
| "-%" { WRAPSUBOP }
| "*%" { WRAPMULOP }
| "**%" { WRAPPOWOP }
| "#" { HASH }

| "==" { EQOP }
Expand All @@ -165,6 +169,10 @@ rule token mode = parse
| "+>>=" { SSHRASSIGN }
| "<<>=" { ROTLASSIGN }
| "<>>=" { ROTRASSIGN }
| "+%=" { WRAPADDASSIGN }
| "-%=" { WRAPSUBASSIGN }
| "*%=" { WRAPMULASSIGN }
| "**%=" { WRAPPOWASSIGN }
| "#=" { CATASSIGN }
| "->" { ARROW }
| "_" { UNDERSCORE }
Expand Down
24 changes: 24 additions & 0 deletions src/mo_frontend/source_token.ml
Original file line number Diff line number Diff line change
Expand Up @@ -66,6 +66,14 @@ type token =
| DIVOP
| MODOP
| POWOP
| WRAPADDOP
| WRAPSUBOP
| WRAPMULOP
| WRAPPOWOP
| WRAPADDASSIGN
| WRAPSUBASSIGN
| WRAPMULASSIGN
| WRAPPOWASSIGN
| ANDOP
| OROP
| XOROP
Expand Down Expand Up @@ -178,6 +186,14 @@ let to_parser_token :
| DIVOP -> Ok Parser.DIVOP
| MODOP -> Ok Parser.MODOP
| POWOP -> Ok Parser.POWOP
| WRAPADDOP -> Ok Parser.WRAPADDOP
| WRAPSUBOP -> Ok Parser.WRAPSUBOP
| WRAPMULOP -> Ok Parser.WRAPMULOP
| WRAPPOWOP -> Ok Parser.WRAPPOWOP
| WRAPADDASSIGN -> Ok Parser.WRAPADDOP
| WRAPSUBASSIGN -> Ok Parser.WRAPSUBOP
| WRAPMULASSIGN -> Ok Parser.WRAPMULOP
| WRAPPOWASSIGN -> Ok Parser.WRAPPOWOP
| ANDOP -> Ok Parser.ANDOP
| OROP -> Ok Parser.OROP
| XOROP -> Ok Parser.XOROP
Expand Down Expand Up @@ -290,6 +306,14 @@ let string_of_parser_token = function
| Parser.DIVOP -> "DIVOP"
| Parser.MODOP -> "MODOP"
| Parser.POWOP -> "POWOP"
| Parser.WRAPADDOP -> "WRAPADDOP"
| Parser.WRAPSUBOP -> "WRAPSUBOP"
| Parser.WRAPMULOP -> "WRAPMULOP"
| Parser.WRAPPOWOP -> "WRAPPOWOP"
| Parser.WRAPADDASSIGN -> "WRAPADDOP"
| Parser.WRAPSUBASSIGN -> "WRAPSUBOP"
| Parser.WRAPMULASSIGN -> "WRAPMULOP"
| Parser.WRAPPOWASSIGN -> "WRAPPOWOP"
| Parser.ANDOP -> "ANDOP"
| Parser.OROP -> "OROP"
| Parser.XOROP -> "XOROP"
Expand Down
2 changes: 1 addition & 1 deletion src/mo_types/typ_hash.ml
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@ a little reading advice:
* Nullary types are described a single letter, or few letters:
Nat: N
Word8: w8
Int8: i8
(): u
* Unary type constructors just prefix their type argument
Expand Down
4 changes: 4 additions & 0 deletions src/mo_values/arrange_ops.ml
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,10 @@ let binop bo = match bo with
| RotROp -> Atom "RotROp"
| CatOp -> Atom "CatOp"
| PowOp -> Atom "PowOp"
| WrappingAddOp -> Atom "WrappingAddOp"
| WrappingSubOp -> Atom "WrappingSubOp"
| WrappingMulOp -> Atom "WrappingMulOp"
| WrappingPowOp -> Atom "WrappingPowOp"

let relop ro = match ro with
| EqOp -> Atom "EqOp"
Expand Down
8 changes: 8 additions & 0 deletions src/mo_values/operator.ml
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,10 @@ type binop =
| SShROp
| RotLOp
| RotROp
| WrappingAddOp (* wrapping operators... *)
| WrappingSubOp
| WrappingMulOp
| WrappingPowOp
| CatOp (* concatenation *)

type relop =
Expand Down Expand Up @@ -130,6 +134,10 @@ let binop op t =
| SShROp -> word_binop (Word8.shr_s, Word16.shr_s, Word32.shr_s, Word64.shr_s) p
| RotLOp -> word_binop (Word8.rotl, Word16.rotl, Word32.rotl, Word64.rotl) p
| RotROp -> word_binop (Word8.rotr, Word16.rotr, Word32.rotr, Word64.rotr) p
| WrappingAddOp -> fixed_binop (Nat8.wrapping_add, Nat16.wrapping_add, Nat32.wrapping_add, Nat64.wrapping_add, Int_8.wrapping_add, Int_16.wrapping_add, Int_32.wrapping_add, Int_64.wrapping_add) (Word8.wrapping_add, Word16.wrapping_add, Word32.wrapping_add, Word64.wrapping_add) p
| WrappingSubOp -> fixed_binop (Nat8.wrapping_sub, Nat16.wrapping_sub, Nat32.wrapping_sub, Nat64.wrapping_sub, Int_8.wrapping_sub, Int_16.wrapping_sub, Int_32.wrapping_sub, Int_64.wrapping_sub) (Word8.wrapping_sub, Word16.wrapping_sub, Word32.wrapping_sub, Word64.wrapping_sub) p
| WrappingMulOp -> fixed_binop (Nat8.wrapping_mul, Nat16.wrapping_mul, Nat32.wrapping_mul, Nat64.wrapping_mul, Int_8.wrapping_mul, Int_16.wrapping_mul, Int_32.wrapping_mul, Int_64.wrapping_mul) (Word8.wrapping_mul, Word16.wrapping_mul, Word32.wrapping_mul, Word64.wrapping_mul) p
| WrappingPowOp -> fixed_binop (Nat8.wrapping_pow, Nat16.wrapping_pow, Nat32.wrapping_pow, Nat64.wrapping_pow, Int_8.wrapping_pow, Int_16.wrapping_pow, Int_32.wrapping_pow, Int_64.wrapping_pow) (Word8.wrapping_pow, Word16.wrapping_pow, Word32.wrapping_pow, Word64.wrapping_pow) p
| CatOp -> text_binop (^) p
)
| T.Non -> impossible
Expand Down
4 changes: 4 additions & 0 deletions src/mo_values/operator.mli
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,10 @@ type binop =
| SShROp
| RotLOp
| RotROp
| WrappingAddOp (* wrapping operators... *)
| WrappingSubOp
| WrappingMulOp
| WrappingPowOp
| CatOp (* concatenation *)

type relop =
Expand Down
40 changes: 40 additions & 0 deletions src/mo_values/prim.ml
Original file line number Diff line number Diff line change
Expand Up @@ -98,6 +98,14 @@ let num_conv_wrap_prim t1 t2 =
| T.Int32, T.Word32
| T.Word64, T.Int64
| T.Int64, T.Word64
| T.Nat8, T.Int8
| T.Int8, T.Nat8
| T.Nat16, T.Int16
| T.Int16, T.Nat16
| T.Nat32, T.Int32
| T.Int32, T.Nat32
| T.Nat64, T.Int64
| T.Int64, T.Nat64
->
fun v -> of_big_int_wrap t2 (as_big_int t1 v)

Expand Down Expand Up @@ -161,6 +169,14 @@ let prim =
| Word16 w -> Word16 (Word16.popcnt w)
| Word32 w -> Word32 (Word32.popcnt w)
| Word64 w -> Word64 (Word64.popcnt w)
| Nat8 w -> Nat8 (Nat8. popcnt w)
| Nat16 w -> Nat16 (Nat16.popcnt w)
| Nat32 w -> Nat32 (Nat32.popcnt w)
| Nat64 w -> Nat64 (Nat64.popcnt w)
| Int8 w -> Int8 (Int_8. popcnt w)
| Int16 w -> Int16 (Int_16.popcnt w)
| Int32 w -> Int32 (Int_32.popcnt w)
| Int64 w -> Int64 (Int_64.popcnt w)
| _ -> failwith "popcnt")

| "clz8" | "clz16" | "clz32" | "clz64" ->
Expand All @@ -170,6 +186,14 @@ let prim =
| Word16 w -> Word16 (Word16.clz w)
| Word32 w -> Word32 (Word32.clz w)
| Word64 w -> Word64 (Word64.clz w)
| Nat8 w -> Nat8 (Nat8. clz w)
| Nat16 w -> Nat16 (Nat16.clz w)
| Nat32 w -> Nat32 (Nat32.clz w)
| Nat64 w -> Nat64 (Nat64.clz w)
| Int8 w -> Int8 (Int_8. clz w)
| Int16 w -> Int16 (Int_16.clz w)
| Int32 w -> Int32 (Int_32.clz w)
| Int64 w -> Int64 (Int_64.clz w)
| _ -> failwith "clz")

| "ctz8" | "ctz16" | "ctz32" | "ctz64" ->
Expand All @@ -179,6 +203,14 @@ let prim =
| Word16 w -> Word16 (Word16.ctz w)
| Word32 w -> Word32 (Word32.ctz w)
| Word64 w -> Word64 (Word64.ctz w)
| Nat8 w -> Nat8 (Nat8. ctz w)
| Nat16 w -> Nat16 (Nat16.ctz w)
| Nat32 w -> Nat32 (Nat32.ctz w)
| Nat64 w -> Nat64 (Nat64.ctz w)
| Int8 w -> Int8 (Int_8. ctz w)
| Int16 w -> Int16 (Int_16.ctz w)
| Int32 w -> Int32 (Int_32.ctz w)
| Int64 w -> Int64 (Int_64.ctz w)
| _ -> failwith "ctz")

| "btst8" | "btst16" | "btst32" | "btst64" ->
Expand All @@ -189,6 +221,14 @@ let prim =
| Word16 y -> Word16 Word16.(and_ y (shl (of_int 1) (as_word16 a)))
| Word32 y -> Word32 Word32.(and_ y (shl (of_int 1) (as_word32 a)))
| Word64 y -> Word64 Word64.(and_ y (shl (of_int 1) (as_word64 a)))
| Nat8 y -> Nat8 Nat8. (and_ y (shl (of_int 1) (as_nat8 a)))
| Nat16 y -> Nat16 Nat16.(and_ y (shl (of_int 1) (as_nat16 a)))
| Nat32 y -> Nat32 Nat32.(and_ y (shl (of_int 1) (as_nat32 a)))
| Nat64 y -> Nat64 Nat64.(and_ y (shl (of_int 1) (as_nat64 a)))
| Int8 y -> Int8 Int_8. (and_ y (shl (of_int 1) (as_int8 a)))
| Int16 y -> Int16 Int_16.(and_ y (shl (of_int 1) (as_int16 a)))
| Int32 y -> Int32 Int_32.(and_ y (shl (of_int 1) (as_int32 a)))
| Int64 y -> Int64 Int_64.(and_ y (shl (of_int 1) (as_int64 a)))
| _ -> failwith "btst")

| "conv_Char_Text" -> fun _ v k -> let str = match as_char v with
Expand Down
48 changes: 48 additions & 0 deletions src/prelude/prelude.ml
Original file line number Diff line number Diff line change
Expand Up @@ -544,6 +544,14 @@ let intToWord32 : Int -> Word32 = intToWord32Wrap;
let natToWord64 : Nat -> Word64 = intToWord64Wrap;
let intToWord64 : Int -> Word64 = intToWord64Wrap;

func int64ToNat64(n : Int64) : Nat64 = (prim "num_wrap_Int64_Nat64" : Int64 -> Nat64) n;
func nat64ToInt64(n : Nat64) : Int64 = (prim "num_wrap_Nat64_Int64" : Nat64 -> Int64) n;
func int32ToNat32(n : Int32) : Nat32 = (prim "num_wrap_Int32_Nat32" : Int32 -> Nat32) n;
func nat32ToInt32(n : Nat32) : Int32 = (prim "num_wrap_Nat32_Int32" : Nat32 -> Int32) n;
func int16ToNat16(n : Int16) : Nat16 = (prim "num_wrap_Int16_Nat16" : Int16 -> Nat16) n;
func nat16ToInt16(n : Nat16) : Int16 = (prim "num_wrap_Nat16_Int16" : Nat16 -> Int16) n;
func int8ToNat8(n : Int8) : Nat8 = (prim "num_wrap_Int8_Nat8" : Int8 -> Nat8) n;
func nat8ToInt8(n : Nat8) : Int8 = (prim "num_wrap_Nat8_Int8" : Nat8 -> Int8) n;

// Char conversion and properties

Expand Down Expand Up @@ -580,6 +588,46 @@ func clzWord64(w : Word64) : Word64 = (prim "clz64" : Word64 -> Word64) w;
func ctzWord64(w : Word64) : Word64 = (prim "ctz64" : Word64 -> Word64) w;
func btstWord64(w : Word64, amount : Word64) : Bool = (prim "btst64" : (Word64, Word64) -> Word64) (w, amount) != (0 : Word64);

func popcntNat8(w : Nat8) : Nat8 = (prim "popcnt8" : Nat8 -> Nat8) w;
func clzNat8(w : Nat8) : Nat8 = (prim "clz8" : Nat8 -> Nat8) w;
func ctzNat8(w : Nat8) : Nat8 = (prim "ctz8" : Nat8 -> Nat8) w;
func btstNat8(w : Nat8, amount : Nat8) : Bool = (prim "btst8" : (Nat8, Nat8) -> Nat8) (w, amount) != (0 : Nat8);

func popcntNat16(w : Nat16) : Nat16 = (prim "popcnt16" : Nat16 -> Nat16) w;
func clzNat16(w : Nat16) : Nat16 = (prim "clz16" : Nat16 -> Nat16) w;
func ctzNat16(w : Nat16) : Nat16 = (prim "ctz16" : Nat16 -> Nat16) w;
func btstNat16(w : Nat16, amount : Nat16) : Bool = (prim "btst16" : (Nat16, Nat16) -> Nat16) (w, amount) != (0 : Nat16);

func popcntNat32(w : Nat32) : Nat32 = (prim "popcnt32" : Nat32 -> Nat32) w;
func clzNat32(w : Nat32) : Nat32 = (prim "clz32" : Nat32 -> Nat32) w;
func ctzNat32(w : Nat32) : Nat32 = (prim "ctz32" : Nat32 -> Nat32) w;
func btstNat32(w : Nat32, amount : Nat32) : Bool = (prim "btst32" : (Nat32, Nat32) -> Nat32) (w, amount) != (0 : Nat32);

func popcntNat64(w : Nat64) : Nat64 = (prim "popcnt64" : Nat64 -> Nat64) w;
func clzNat64(w : Nat64) : Nat64 = (prim "clz64" : Nat64 -> Nat64) w;
func ctzNat64(w : Nat64) : Nat64 = (prim "ctz64" : Nat64 -> Nat64) w;
func btstNat64(w : Nat64, amount : Nat64) : Bool = (prim "btst64" : (Nat64, Nat64) -> Nat64) (w, amount) != (0 : Nat64);

func popcntInt8(w : Int8) : Int8 = (prim "popcnt8" : Int8 -> Int8) w;
func clzInt8(w : Int8) : Int8 = (prim "clz8" : Int8 -> Int8) w;
func ctzInt8(w : Int8) : Int8 = (prim "ctz8" : Int8 -> Int8) w;
func btstInt8(w : Int8, amount : Int8) : Bool = (prim "btst8" : (Int8, Int8) -> Int8) (w, amount) != (0 : Int8);

func popcntInt16(w : Int16) : Int16 = (prim "popcnt16" : Int16 -> Int16) w;
func clzInt16(w : Int16) : Int16 = (prim "clz16" : Int16 -> Int16) w;
func ctzInt16(w : Int16) : Int16 = (prim "ctz16" : Int16 -> Int16) w;
func btstInt16(w : Int16, amount : Int16) : Bool = (prim "btst16" : (Int16, Int16) -> Int16) (w, amount) != (0 : Int16);

func popcntInt32(w : Int32) : Int32 = (prim "popcnt32" : Int32 -> Int32) w;
func clzInt32(w : Int32) : Int32 = (prim "clz32" : Int32 -> Int32) w;
func ctzInt32(w : Int32) : Int32 = (prim "ctz32" : Int32 -> Int32) w;
func btstInt32(w : Int32, amount : Int32) : Bool = (prim "btst32" : (Int32, Int32) -> Int32) (w, amount) != (0 : Int32);

func popcntInt64(w : Int64) : Int64 = (prim "popcnt64" : Int64 -> Int64) w;
func clzInt64(w : Int64) : Int64 = (prim "clz64" : Int64 -> Int64) w;
func ctzInt64(w : Int64) : Int64 = (prim "ctz64" : Int64 -> Int64) w;
func btstInt64(w : Int64, amount : Int64) : Bool = (prim "btst64" : (Int64, Int64) -> Int64) (w, amount) != (0 : Int64);

// Float operations

func floatAbs(f : Float) : Float = (prim "fabs" : Float -> Float) f;
Expand Down

0 comments on commit c36a8d4

Please sign in to comment.