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: 
108: 
109: 
110: 
// 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 =   
    
    /// Bit patterns for computing the truth table in parallel
    let args = [|0b1010101010101010; 0b1100110011001100;
                 0b1111000011110000; 0b1111111100000000|]

    /// 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|]


    /// 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 acc op -> match acc with
                                 | None -> None
                                 | Some(xs) -> exec (xs,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 length radix = 
        let rec loop number =
            seq { yield number
                  yield! loop (increment (radix - 1) number)
            }

        loop (List.init length (fun _ -> 0))
        |> Seq.take (int (float radix ** float length))


    /// Populating the dictionary with the optimal functions,
    //  by testing the functions by increasing length from 1 to size
    //  the first function to generate a truth table is the shortest one.
    let createdictionary size =
        seq { 0 .. size }
        |> Seq.map (fun i -> (makenumbers i validinstructions.Length))
        |> Seq.concat
        |> Seq.map (List.map (fun n -> validinstructions.[n]))
        |> Seq.map (fun p -> (truthtables p) |> (Option.map (fun x -> (x,p))))
        |> Seq.choose id
        |> Seq.distinctBy fst
        |> Seq.fold (fun acc (a,b) -> Map.add a b acc) Map.empty 

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


    /// Display results
    let show = 
        function
        | prog,Some(result) -> if optimal.ContainsKey result = true
                               then printfn " Source:  %A" prog
                                    printfn "Optimal:  %A\n" optimal.[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]
        ]

    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 args : int []


 Bit patterns for computing the truth table in parallel
val validinstructions : ops []


 Instructions understood and used by the optimiser
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 acc : int list option
val op : ops
val xs : int list
val increment : (int -> int list -> int list)


 Increment a number in the form of a list of digits
val max : int
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 length : int
val radix : 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 init : length:int -> initializer:(int -> 'T) -> 'T list

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

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

Full name: Microsoft.FSharp.Collections.Seq.take
Multiple items
val float : value:'T -> float (requires member op_Explicit)

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

--------------------
type float = Double

Full name: Microsoft.FSharp.Core.float

--------------------
type float<'Measure> = float

Full name: Microsoft.FSharp.Core.float<_>
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
val i : int
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
val p : ops list
module Option

from Microsoft.FSharp.Core
val map : mapping:('T -> 'U) -> option:'T option -> 'U option

Full name: Microsoft.FSharp.Core.Option.map
val x : 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
val fold : folder:('State -> 'T -> 'State) -> state:'State -> source:seq<'T> -> 'State

Full name: Microsoft.FSharp.Collections.Seq.fold
val acc : Map<int list,ops list>
val a : int list
val b : ops list
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 add : key:'Key -> value:'T -> table:Map<'Key,'T> -> Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.add
val empty<'Key,'T (requires comparison)> : Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.empty
val optimal : 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
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:4 years ago
Author:Bjørn Bæverfjord
Tags: optimizer , cil , bitwise , truth table , boolean function