2 people like it.

Optimal bitwise CIL-like code optimizer

Prototype of a CIL code optimizer that generates optimal code for bitwise functions. Update: General improvements

  1: 
  2: 
  3: 
  4: 
  5: 
  6: 
  7: 
  8: 
  9: 
 10: 
 11: 
 12: 
 13: 
 14: 
 15: 
 16: 
 17: 
 18: 
 19: 
 20: 
 21: 
 22: 
 23: 
 24: 
 25: 
 26: 
 27: 
 28: 
 29: 
 30: 
 31: 
 32: 
 33: 
 34: 
 35: 
 36: 
 37: 
 38: 
 39: 
 40: 
 41: 
 42: 
 43: 
 44: 
 45: 
 46: 
 47: 
 48: 
 49: 
 50: 
 51: 
 52: 
 53: 
 54: 
 55: 
 56: 
 57: 
 58: 
 59: 
 60: 
 61: 
 62: 
 63: 
 64: 
 65: 
 66: 
 67: 
 68: 
 69: 
 70: 
 71: 
 72: 
 73: 
 74: 
 75: 
 76: 
 77: 
 78: 
 79: 
 80: 
 81: 
 82: 
 83: 
 84: 
 85: 
 86: 
 87: 
 88: 
 89: 
 90: 
 91: 
 92: 
 93: 
 94: 
 95: 
 96: 
 97: 
 98: 
 99: 
100: 
101: 
102: 
103: 
104: 
105: 
106: 
107: 
// This program is an optimizer that can generate optimal code
// for any bitwise function with up to 4 parameters.
// Only 65536 such functions exists so they can be precomputed
// and cached, given enough time and an efficient searcher.
//
// This F# function was not optimised by the F# 3.0 compiler:
//   let booltest a b  = (a ||| b) &&& (~~~ (a &&& b))
// It generated this CIL code:
//   [Ldarg 0; Ldarg 1; Or; Ldarg 0; Ldarg 1; And; Not; And]
// Instead of the optimal code:
//   [Ldarg 0; Ldarg 1; Xor]

open System

type ops = Ldarg of int | And | Or | Xor | Not | Dup | Pop | Ones | Zeros

[<EntryPoint>]
let main argv =

    /// Instructions understood and used by the optimiser
    let validinstructions = [|Ldarg 0; Ldarg 1; Ldarg 2; Ldarg 3;
                              And; Or; Xor; Dup; Pop; Not; Ones; Zeros|]

    /// Bit patterns for computing the truth table in parallel
    let args = [|0b1010101010101010; 0b1100110011001100;
                 0b1111000011110000; 0b1111111100000000|]


    /// Execute a single stack based instruction
    let exec = function
               | stk,Ldarg n   -> Some(args.[n]::stk)
               | x::y::stk,And -> Some((x &&& y)::stk)
               | x::y::stk,Or  -> Some((x ||| y)::stk)
               | x::y::stk,Xor -> Some((x ^^^ y)::stk)
               | x::stk,Not    -> Some((x ^^^ 0xffff)::stk)
               | x::stk,Dup    -> Some(x::x::stk)
               | x::stk,Pop    -> Some(stk)
               | stk,Ones      -> Some(0xffff::stk)
               | stk,Zeros     -> Some(0::stk)
               | _             -> None


    /// Calculate one truth table for each return value of a function
    let truthtables =
        List.fold (fun stk op ->
            stk |> Option.bind (fun s -> exec (s, op))) (Some([]))


    /// Increment a number in the form of a list of digits
    let rec increment max = function
        | x::xs when x = max -> 0::(increment max xs)
        | x::xs              -> (x + 1)::xs
        | _                  -> failwith "Empty list!"


    /// Create a list of all numbers of length and radix
    let makenumbers radix length =
        let rec loop number =
            seq { yield number
                  yield! loop (increment (radix - 1) number) }

        loop (List.replicate length 0)
        |> Seq.take (pown radix length)


    /// Populating the dictionary with the optimal functions,
    //  by testing the functions by increasing length from 0 to size
    //  the first function to generate a truth table is the shortest one.
    let createdictionary size =
        seq { 0 .. size }
        |> Seq.map (makenumbers validinstructions.Length)
        |> Seq.concat
        |> Seq.map (List.map (Array.get validinstructions))
        |> Seq.map (fun f -> truthtables f |> Option.map (fun t -> (t, f)))
        |> Seq.choose id
        |> Seq.distinctBy fst
        |> Map.ofSeq

    let optimalfunctions = createdictionary 3
    printfn "Number of optimal functions in dictionary: %A\n" optimalfunctions.Count


    /// Display results
    let show = function
        | prog,Some(result) -> if optimalfunctions.ContainsKey result
                               then printfn " Source:  %A" prog
                                    printfn "Optimal:  %A\n" optimalfunctions.[result]
                               else printfn "Not found:  %A\n" prog
        | prog,None         -> printfn "Invalid:  %A" prog


    /// Functions to be optimized
    let progs =
        [ [Ldarg 0; Ldarg 1; Or; Ldarg 0; Ldarg 1; And; Not; And]
          [Ldarg 0; Ldarg 0; Xor]
          [Ldarg 0; Pop]
          [Ldarg 0; Ldarg 1; And; Dup; Or]
          [Zeros; Not]
        ]

    // Perform optimizations and display the reults
    List.map truthtables progs
    |> List.zip progs
    |> List.iter show

    //Console.ReadKey() |> ignore
    0
namespace System
type ops =
  | Ldarg of int
  | And
  | Or
  | Xor
  | Not
  | Dup
  | Pop
  | Ones
  | Zeros

Full name: Script.ops
union case ops.Ldarg: int -> ops
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
union case ops.And: ops
union case ops.Or: ops
union case ops.Xor: ops
union case ops.Not: ops
union case ops.Dup: ops
union case ops.Pop: ops
union case ops.Ones: ops
union case ops.Zeros: ops
Multiple items
type EntryPointAttribute =
  inherit Attribute
  new : unit -> EntryPointAttribute

Full name: Microsoft.FSharp.Core.EntryPointAttribute

--------------------
new : unit -> EntryPointAttribute
val main : argv:string [] -> int

Full name: Script.main
val argv : string []
val validinstructions : ops []


 Instructions understood and used by the optimiser
val args : int []


 Bit patterns for computing the truth table in parallel
val exec : (int list * ops -> int list option)


 Execute a single stack based instruction
val stk : int list
val n : int
union case Option.Some: Value: 'T -> Option<'T>
val x : int
val y : int
union case Option.None: Option<'T>
val truthtables : (ops list -> int list option)


 Calculate one truth table for each return value of a function
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val fold : folder:('State -> 'T -> 'State) -> state:'State -> list:'T list -> 'State

Full name: Microsoft.FSharp.Collections.List.fold
val stk : int list option
val op : ops
module Option

from Microsoft.FSharp.Core
val bind : binder:('T -> 'U option) -> option:'T option -> 'U option

Full name: Microsoft.FSharp.Core.Option.bind
val s : int list
val increment : (int -> int list -> int list)


 Increment a number in the form of a list of digits
val max : int
val xs : int list
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
val makenumbers : (int -> int -> seq<int list>)


 Create a list of all numbers of length and radix
val radix : int
val length : int
val loop : (int list -> seq<int list>)
val number : int list
Multiple items
val seq : sequence:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Core.Operators.seq

--------------------
type seq<'T> = Collections.Generic.IEnumerable<'T>

Full name: Microsoft.FSharp.Collections.seq<_>
val replicate : count:int -> initial:'T -> 'T list

Full name: Microsoft.FSharp.Collections.List.replicate
module Seq

from Microsoft.FSharp.Collections
val take : count:int -> source:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Collections.Seq.take
val pown : x:'T -> n:int -> 'T (requires member get_One and member ( * ) and member ( / ))

Full name: Microsoft.FSharp.Core.Operators.pown
val createdictionary : (int -> Map<int list,ops list>)


 Populating the dictionary with the optimal functions,
val size : int
val map : mapping:('T -> 'U) -> source:seq<'T> -> seq<'U>

Full name: Microsoft.FSharp.Collections.Seq.map
property Array.Length: int
val concat : sources:seq<#seq<'T>> -> seq<'T>

Full name: Microsoft.FSharp.Collections.Seq.concat
val map : mapping:('T -> 'U) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.map
type Array =
  member Clone : unit -> obj
  member CopyTo : array:Array * index:int -> unit + 1 overload
  member GetEnumerator : unit -> IEnumerator
  member GetLength : dimension:int -> int
  member GetLongLength : dimension:int -> int64
  member GetLowerBound : dimension:int -> int
  member GetUpperBound : dimension:int -> int
  member GetValue : [<ParamArray>] indices:int[] -> obj + 7 overloads
  member Initialize : unit -> unit
  member IsFixedSize : bool
  ...

Full name: System.Array
val get : array:'T [] -> index:int -> 'T

Full name: Microsoft.FSharp.Collections.Array.get
val f : ops list
val map : mapping:('T -> 'U) -> option:'T option -> 'U option

Full name: Microsoft.FSharp.Core.Option.map
val t : int list
val choose : chooser:('T -> 'U option) -> source:seq<'T> -> seq<'U>

Full name: Microsoft.FSharp.Collections.Seq.choose
val id : x:'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.id
val distinctBy : projection:('T -> 'Key) -> source:seq<'T> -> seq<'T> (requires equality)

Full name: Microsoft.FSharp.Collections.Seq.distinctBy
val fst : tuple:('T1 * 'T2) -> 'T1

Full name: Microsoft.FSharp.Core.Operators.fst
Multiple items
module Map

from Microsoft.FSharp.Collections

--------------------
type Map<'Key,'Value (requires comparison)> =
  interface IEnumerable
  interface IComparable
  interface IEnumerable<KeyValuePair<'Key,'Value>>
  interface ICollection<KeyValuePair<'Key,'Value>>
  interface IDictionary<'Key,'Value>
  new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
  member Add : key:'Key * value:'Value -> Map<'Key,'Value>
  member ContainsKey : key:'Key -> bool
  override Equals : obj -> bool
  member Remove : key:'Key -> Map<'Key,'Value>
  ...

Full name: Microsoft.FSharp.Collections.Map<_,_>

--------------------
new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
val ofSeq : elements:seq<'Key * 'T> -> Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.ofSeq
val optimalfunctions : Map<int list,ops list>
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
property Map.Count: int
val show : ('a * int list option -> unit)


 Display results
val prog : 'a
val result : int list
member Map.ContainsKey : key:'Key -> bool
val progs : ops list list


 Functions to be optimized
val zip : list1:'T1 list -> list2:'T2 list -> ('T1 * 'T2) list

Full name: Microsoft.FSharp.Collections.List.zip
val iter : action:('T -> unit) -> list:'T list -> unit

Full name: Microsoft.FSharp.Collections.List.iter

More information

Link:http://fssnip.net/qa
Posted:9 years ago
Author:Bjørn Bæverfjord
Tags: optimizer , cil , bitwise , truth table , boolean function