Commit 409108c6 authored by Laurent Le Brun's avatar Laurent Le Brun
Browse files

Initial checkin

parent 79f5ef08
Shader Minifier
===============
Shader Minifier is a tool that minifies and obfuscates shader code (GLSL
and HLSL). It's mainly target at demosceners, for writing 4k and 64k
intros.
This is the initial source release. The code compiles
with F# 2.0 and Visual Studio 2010, and has not been tested with other
versions.
The code is a bit messy, and mostly undocumented. Sorry about that. I
wanted to release it anyway by popular demand. I'll try to clean it, but
feel free to contact me if you have any question.
Slightly outdated user manual:
http://www.ctrl-alt-test.fr/?page_id=7
Some technical details
----------------------
If I remember correctly, I patched FParsec.dll as it didn't work properly
on Mono because of a bug in Mono (https://bugzilla.novell.com/show_bug.cgi?id=474154).
Because of a bug in F#, I'm targeting .NET 3.5 instead of .NET 4.0. The
bug happens when using at the same time F# powerpack and the --standalone flag.
Laurent Le Brun, aka LLB from Ctrl-Alt-Test.
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="4.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ProductVersion>8.0.30703</ProductVersion>
<SchemaVersion>2.0</SchemaVersion>
<ProjectGuid>{059c6af3-1877-4698-be34-bf7eb55d060a}</ProjectGuid>
<OutputType>Exe</OutputType>
<RootNamespace>glsl_minifier</RootNamespace>
<AssemblyName>shader_minifier</AssemblyName>
<TargetFrameworkVersion>v3.5</TargetFrameworkVersion>
<Name>Shader Minifier</Name>
<TargetFrameworkProfile />
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<DebugSymbols>true</DebugSymbols>
<DebugType>full</DebugType>
<Optimize>false</Optimize>
<Tailcalls>false</Tailcalls>
<OutputPath>bin\Debug\</OutputPath>
<DefineConstants>DEBUG;TRACE</DefineConstants>
<WarningLevel>3</WarningLevel>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<DebugType>pdbonly</DebugType>
<Optimize>true</Optimize>
<Tailcalls>true</Tailcalls>
<OutputPath>bin\Release\</OutputPath>
<DefineConstants>TRACE</DefineConstants>
<WarningLevel>3</WarningLevel>
<StartArguments>--smoothstep ../../test.in</StartArguments>
<OtherFlags>--standalone</OtherFlags>
</PropertyGroup>
<Import Project="$(MSBuildExtensionsPath32)\FSharp\1.0\Microsoft.FSharp.Targets" Condition="!Exists('$(MSBuildToolsPath)\Microsoft.Build.Tasks.v4.0.dll')" />
<Import Project="$(MSBuildExtensionsPath32)\..\Microsoft F#\v4.0\Microsoft.FSharp.Targets" Condition="Exists('$(MSBuildToolsPath)\Microsoft.Build.Tasks.v4.0.dll')" />
<ItemGroup>
<Compile Include="src\ast.fs" />
<Compile Include="src\printer.fs" />
<Compile Include="src\cGen.fs" />
<Compile Include="src\renamer.fs" />
<Compile Include="src\rewriter.fs" />
<Compile Include="src\parse.fs" />
<Compile Include="src\main.fs" />
<None Include="App.config">
<CopyToOutputDirectory>Always</CopyToOutputDirectory>
</None>
</ItemGroup>
<ItemGroup>
<Reference Include="FParsec">
<HintPath>lib\FParsec.dll</HintPath>
</Reference>
<Reference Include="FParsecCS">
<HintPath>lib\FParsecCS.dll</HintPath>
</Reference>
<Reference Include="FSharp.PowerPack">
<HintPath>lib\FSharp.PowerPack.dll</HintPath>
</Reference>
<Reference Include="mscorlib" />
<Reference Include="FSharp.Core" />
<Reference Include="System" />
<Reference Include="System.Core">
<RequiredTargetFramework>3.5</RequiredTargetFramework>
</Reference>
</ItemGroup>
<!-- To modify your build process, add your task inside one of the targets below and uncomment it.
Other similar extension points exist, see Microsoft.Common.targets.
<Target Name="BeforeBuild">
</Target>
<Target Name="AfterBuild">
</Target>
-->
</Project>
\ No newline at end of file

Microsoft Visual Studio Solution File, Format Version 11.00
# Visual Studio 2010
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Shader Minifier", "Shader Minifier.fsproj", "{059C6AF3-1877-4698-BE34-BF7EB55D060A}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
Release|Any CPU = Release|Any CPU
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
{059C6AF3-1877-4698-BE34-BF7EB55D060A}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{059C6AF3-1877-4698-BE34-BF7EB55D060A}.Debug|Any CPU.Build.0 = Debug|Any CPU
{059C6AF3-1877-4698-BE34-BF7EB55D060A}.Release|Any CPU.ActiveCfg = Release|Any CPU
{059C6AF3-1877-4698-BE34-BF7EB55D060A}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
EndGlobalSection
EndGlobal
* Get a proper test suite. Seriously.
* Update to F# 3.0 (not tried, maybe it already works).
* Update to FParsec 1.0. This requires a couple of easy changes in
parse.fs.
* Simplify the release process. Ideally, we should get a single .exe file
that works both on Microsoft .NET and on Mono.
* Some antivirus (eg. Avast) don't like Shader Minifier. No idea why.
* Performance. I suspect that using StringBuffer in the printer would
drastically improve performance.
* All the bug reports I've received. I should do some triaging.
File added
module Ast
open System.Collections.Generic
type targetOutput = Text | CHeader | CList | JS | Nasm
let version = "1.1.3" // Shader Minifer version
let debugMode = false
let mutable outputName = "shader_code.h"
let mutable targetOutput = CHeader
let mutable verbose = false
let mutable smoothstepTrick = false
let mutable fieldNames = "xyzw"
let mutable macroThreshold = 10000
let mutable preserveExternals = false
let mutable preserveAllGlobals = false
let generatedMacros = Dictionary<string, int>()
let mutable reorderDeclarations = false
let mutable reorderFunctions = false
let mutable hlsl = false
let mutable noSequence = false
let mutable noRenaming = false
let mutable noRenamingList = [ "main" ]
let mutable forbiddenNames = [ "if"; "in"; "do" ]
let addFobiddenName s = forbiddenNames <- s :: forbiddenNames
type Ident = string
type Expr =
| Int of int * string
| Float of float * string
| Var of Ident
| FunCall of Expr * Expr list
| Subscript of Expr * Expr
| Dot of Expr * Ident
| Cast of Ident * Expr // hlsl
| VectorExp of Expr list // hlsl
and TypeSpec =
| TypeName of string
| TypeStruct of string(*type*) * Ident option(*name*) * Decl list
and Type = {
name: TypeSpec // e.g. int
typeQ: string option // e.g. const, uniform
}
and DeclElt = {
name: Ident // e.g. foo
size: Expr option // e.g. [3]
semantics: Expr list // e.g. : color
init: Expr option // e.g. = f(x)
}
and Decl = Type * DeclElt list
and Instr =
| Block of Instr list
| Decl of Decl
| Expr of Expr
| If of Expr * Instr (*then*) * Instr option (*else*)
| ForD of Decl * Expr option * Expr option * Instr (*for loop starting with a declaration*)
| ForE of Expr option * Expr option * Expr option * Instr (*for loop starting with an expression*)
| While of Expr * Instr
| DoWhile of Expr * Instr
| Keyword of string * Expr option (*break, continue, return, discard*)
| Verbatim of string
and FunctionType = {
retType: Type (*return*)
fName: Ident (*name*)
args: Decl list (*args*)
semantics: Expr list (*semantics*)
}
and TopLevel =
| TLVerbatim of string
| Function of FunctionType * Instr
| TLDecl of Decl
| TypeDecl of TypeSpec // structs
let makeType name tyQ = {Type.name=name; typeQ=tyQ}
let makeDecl name size sem init = {name=name; size=size; semantics=sem; init=init}
let makeFunctionType ty name args sem =
{retType=ty; fName=name; args=args; semantics=sem}
type MapEnv = {
fExpr: MapEnv -> Expr -> Expr
fInstr: Instr -> Instr
vars: Map<Ident, Type * Expr option * Expr option >
}
let mapEnv fe fi = {fExpr = fe; fInstr = fi; vars = Map.empty}
let foldList env fct li =
let env = ref env
let res = li |> List.map ((fun i -> // FIXME: use List.fold is cleaner :)
let x = fct !env i
env := fst x
snd x) : 'a -> 'a)
!env, res
let rec mapExpr env = function
| FunCall(fct, args) ->
env.fExpr env (FunCall(mapExpr env fct, List.map (mapExpr env) args))
| Subscript(arr, ind) ->
env.fExpr env (Subscript(mapExpr env arr, mapExpr env ind))
| Dot(e, field) -> env.fExpr env (Dot(mapExpr env e, field))
| Cast(id, e) -> env.fExpr env (Cast(id, mapExpr env e))
| VectorExp(li) ->
env.fExpr env (VectorExp(List.map (mapExpr env) li))
| e -> env.fExpr env e
and mapDecl env (ty, vars) =
let aux env decl =
let env = {env with vars = env.vars.Add(decl.name, (ty, decl.size, decl.init))}
env, {decl with size=Option.map (mapExpr env) decl.size; init=Option.map (mapExpr env) decl.init}
let env, vars = foldList env aux vars
env, (ty, vars)
let rec mapInstr env i =
let aux = function
| Block b ->
let _, b = foldList env mapInstr b
env, Block b
| Expr e -> env, Expr (mapExpr env e)
| Decl d ->
let env, res = mapDecl env d
env, Decl res
| If(cond, th, el) ->
env, If (mapExpr env cond, snd (mapInstr env th), Option.map (mapInstr env >> snd) el)
| While(cond, body) ->
env, While (mapExpr env cond, snd (mapInstr env body))
| DoWhile(cond, body) ->
env, DoWhile (mapExpr env cond, snd (mapInstr env body))
| ForD(init, cond, inc, body) ->
let env', decl = mapDecl env init
let res = ForD (decl, Option.map (mapExpr env') cond,
Option.map (mapExpr env') inc, snd (mapInstr env' body))
if hlsl then env', res
else env, res
| ForE(init, cond, inc, body) ->
let res = ForE (Option.map (mapExpr env) init, Option.map (mapExpr env) cond,
Option.map (mapExpr env) inc, snd (mapInstr env body))
env, res
| Keyword(k, e) ->
env, Keyword (k, Option.map (mapExpr env) e)
| Verbatim _ as v -> env, v
let env, res = aux i
env, env.fInstr res
let mapTopLevel env li =
let env, res = li |> foldList env (fun env tl ->
match tl with
| TLDecl t ->
let env, res = mapDecl env t
env, TLDecl res
| Function(fct, body) -> env, Function(fct, snd (mapInstr env body))
| e -> env, e)
res
let countIdent code =
let count = ref 0
let add li = count := !count + List.length li
let mapInstr = function
| Decl (_, li) as e -> add li; e
| ForD((_, li), _, _, _) as e -> add li; e
| e -> e
let mapExpr _ e = e
let mapTL = function
| Function(fct, _) -> incr count; add fct.args
| TLDecl (_, li) -> add li
| _ -> ()
mapTopLevel (mapEnv mapExpr mapInstr) code |> ignore
List.iter mapTL code
!count
module CGen
open System.IO
// Values to export in the C code (uniform and attribute values)
let exportedValues = ref ([] : (string * string * string) list)
let export ty name (newName:string) =
if newName.[0] <> '0' then
exportedValues := !exportedValues |> List.map (fun (ty2, name2, newName2 as arg) ->
if ty = ty2 && name = newName2 then ty, name2, newName
else arg
)
else
exportedValues := (ty, name, newName) :: !exportedValues
let output() =
if Ast.debugMode || Ast.outputName = "" then stdout
else new StreamWriter(Ast.outputName) :> TextWriter
let printHeader data asAList =
use out = output()
let fileName =
if Ast.outputName = "" then "shader_code.h"
else Path.GetFileName Ast.outputName
let macroName = fileName.Replace(".", "_").ToUpper() + "_"
fprintfn out "/* File generated with Shader Minifier %s" Ast.version
fprintfn out " * http://www.ctrl-alt-test.fr"
fprintfn out " */"
if not asAList then
fprintfn out "#ifndef %s" macroName
fprintfn out "# define %s" macroName
for ty, name, newName in List.sort !exportedValues do
// let newName = Printer.identTable.[int newName]
if ty = "" then
fprintfn out "# define VAR_%s \"%s\"" (name.ToUpper()) newName
else
fprintfn out "# define %c_%s \"%s\"" (System.Char.ToUpper ty.[0]) (name.ToUpper()) newName
fprintfn out ""
for file, code in data do
let name = (Path.GetFileName file).Replace(".", "_")
if asAList then
fprintfn out "// %s" file
fprintfn out "\"%s\"," (Printer.print code)
else
fprintfn out "const char *%s =\r\n \"%s\";" name (Printer.print code)
fprintfn out ""
if not asAList then fprintfn out "#endif // %s" macroName
let printNoHeader data =
use out = output()
let str = [for _,code in data -> Printer.print code] |> String.concat "\n"
fprintf out "%s" str
let printJSHeader data =
use out = output()
fprintfn out "/* File generated with Shader Minifier %s" Ast.version
fprintfn out " * http://www.ctrl-alt-test.fr"
fprintfn out " */"
for ty, name, newName in List.sort !exportedValues do
if ty = "" then
fprintfn out "var var_%s = \"%s\"" (name.ToUpper()) newName
else
fprintfn out "var %c_%s = \"%s\"" (System.Char.ToUpper ty.[0]) (name.ToUpper()) newName
fprintfn out ""
for file, code in data do
let name = (Path.GetFileName file).Replace(".", "_")
fprintfn out "var %s =\r\n \"%s\"" name (Printer.print code)
fprintfn out ""
let printNasmHeader data =
use out = output()
fprintfn out "; File generated with Shader Minifier %s" Ast.version
fprintfn out "; http://www.ctrl-alt-test.fr"
for ty, name, newName in List.sort !exportedValues do
if ty = "" then
fprintfn out "_var_%s: db '%s', 0" (name.ToUpper()) newName
else
fprintfn out "_%c_%s: db '%s', 0" (System.Char.ToUpper ty.[0]) (name.ToUpper()) newName
fprintfn out ""
for file, code in data do
let name = (Path.GetFileName file).Replace(".", "_")
fprintfn out "_%s:\r\n\tdb '%s', 0" name (Printer.print code)
fprintfn out ""
let print data =
match Ast.targetOutput with
| Ast.Text -> printNoHeader data
| Ast.CHeader -> printHeader data false
| Ast.CList -> printHeader data true
| Ast.JS -> printJSHeader data
| Ast.Nasm -> printNasmHeader data
module main
open System
open System.IO
open Microsoft.FSharp.Text
// Compute table of variables names, based on frequency
let computeFrequencyIdentTable li =
let _, str = Printer.quickPrint li
let stat = Seq.countBy id str |> dict
let get c = let ok, res = stat.TryGetValue(c) in if ok then res else 0
let letters = ['a'..'z']@['A'..'Z']
// First, use most frequent letters
let table = letters |> List.sortBy get |> List.rev |> List.map string
// Then, generate identifiers with 2 letters
let score (s:string) = - (get s.[0] + get s.[1])
let table2 = [for c1 in letters do for c2 in letters do yield c1.ToString() + c2.ToString()]
|> List.sortBy score
Printer.identTable <- Array.ofList (table @ table2)
let nullOut = new StreamWriter(Stream.Null) :> TextWriter
// like printf when verbose option is set
let vprintf fmt =
let out = if Ast.verbose then stdout else nullOut
fprintf out fmt
let printSize code =
if Ast.verbose then
let n, _ = Printer.quickPrint code
printfn "Shader size is: %d" n
let rename code =
Renamer.renameMode <- Renamer.Unambiguous
Printer.printMode <- Printer.SingleChar
let code, lastIdent = Renamer.renTopLevel code
computeFrequencyIdentTable code
Renamer.computeContextTable code
Printer.printMode <- Printer.FromTable
Renamer.renameMode <- Renamer.Context
let code, lastIdent = Renamer.renTopLevel code
vprintf "%d identifiers renamed. " Renamer.numberOfUsedIdents
printSize code
code
let minify file =
vprintf "Input file size is: %d\n" (FileInfo(file).Length)
let code = Parse.runParser file
vprintf "File parsed. "; printSize code
let code = Rewriter.reorder code
let code = Rewriter.apply code
vprintf "Rewrite tricks applied. "; printSize code
let code =
if Ast.noRenaming then code
else rename code
// vprintf "Identifiers renamed. "; printSize code
// let code =
// if !Ast.macroThreshold < 10000 then
// let code, n = Rewriter.injectMacros lastIdent code
// vprintfn "%d macros added." n
// code
// else code
vprintf "Minification of '%s' finished.\n" file
code
let run files =
try
let codes = Array.map minify files
CGen.print (Array.zip files codes)
0
with
| Failure s as exn -> printfn "%s" s; 1 //; printfn "%s" exn.StackTrace
| exn -> printfn "Error: %s" exn.Message; 1 //; printfn "%s" exn.StackTrace
let printHeader () =
printfn "Shader Minifier %s (c) Laurent Le Brun 2012" Ast.version
printfn "http://www.ctrl-alt-test.fr"
printfn ""
let () =
let files = ref []
let setFile s = files := s :: !files
let setFieldNames s =
if s = "rgba" || s = "xyzw" || s = "stpq" || s = "" then
Ast.fieldNames <- s
else
printfn "'%s' is not a valid value for field-names" s
printfn "You must use 'rgba', 'xyzw', or 'stpq'."
let noRenamingFct (s:string) = Ast.noRenamingList <- [for i in s.Split([|','|]) -> i.Trim()]
let setFormat = function
| "c-variables" -> Ast.targetOutput <- Ast.CHeader
| "js" -> Ast.targetOutput <- Ast.JS
| "c-array" -> Ast.targetOutput <- Ast.CList
| "none" -> Ast.targetOutput <- Ast.Text
| "nasm" -> Ast.targetOutput <- Ast.Nasm
| s -> printfn "'%s' is not a valid format" s
let specs =
["-o", ArgType.String (fun s -> Ast.outputName <- s), "Set the output filename (default is shader_code.h)"
"-v", ArgType.Unit (fun() -> Ast.verbose<-true), "Verbose, display additional information"
"--hlsl", ArgType.Unit (fun() -> Ast.hlsl<-true), "Use HLSL (default is GLSL)"
"--format", ArgType.String setFormat, "Can be: c-variables (default), c-array, js, nasm, or none"
"--field-names", ArgType.String setFieldNames, "Choose the field names for vectors: 'rgba', 'xyzw', or 'stpq'"
"--preserve-externals", ArgType.Unit (fun() -> Ast.preserveExternals<-true), "Do not rename external values (e.g. uniform)"
"--preserve-all-globals", ArgType.Unit (fun() -> Ast.preserveAllGlobals<-true; Ast.preserveExternals<-true), "Do not rename functions and global variables"
"--no-renaming", ArgType.Unit (fun() -> Ast.noRenaming<-true), "Do not rename anything"
"--no-renaming-list", ArgType.String noRenamingFct, "Comma-separated list of functions to preserve"
"--no-sequence", ArgType.Unit (fun() -> Ast.noSequence<-true), "Do not use the comma operator trick"
"--smoothstep", ArgType.Unit (fun() -> Ast.smoothstepTrick<-true), "Use IQ's smoothstep trick"
//"--macro-threshold", ArgType.Int (fun i ->
// printfn "Macros are disabled in the release."; Ast.macroThreshold <- i), "[disabled] Use a #define macro if it can save at least <int> bytes"
//"--make-elevated2", ArgType.Unit (fun () -> printfn "Please buy the commercial version."; exit 1), "Generate the 4k intro 'Elevated 2'"
"--shader-only", ArgType.Unit (fun() -> Ast.targetOutput<-Ast.Text), "[Deprecated]"
"--js-output", ArgType.Unit (fun() -> Ast.targetOutput<-Ast.JS), "[Deprecated]"
"--", ArgType.Rest setFile, "Stop parsing command line"
] |> List.map (fun (s, f, d) -> ArgInfo(s, f, d))
ArgParser.Parse(specs, setFile)
files := List.rev !files
let myExit n =
if Ast.debugMode then System.Console.ReadLine() |> ignore
exit n
if !files = [] then
printHeader()
ArgParser.Usage(specs, usage="Please give the shader files to compress on the command line.")
myExit 1
elif List.length !files > 1 && not Ast.preserveExternals then
printfn "When compressing multiple files, you must use the --preserve-externals option."
myExit 1
else
if Ast.verbose then printHeader()
myExit (run (Array.ofList !files))
module Parse
// TODO: true, false
// TODO: switch case
open FParsec.Primitives
open FParsec.CharParsers
open FParsec.OperatorPrecedenceParser
let commentLine = parse {
do! skipString "//" // .>> noneOf "[")) // (pchar '[')) // <?> "comment, not verbatim code"
do! notFollowedBy (anyOf "[]") <?> "not a verbatim code"
do! skipManyCharsTill anyChar (followedBy newline) } |> attempt
let commentBlock = parse {
do! skipString "/*"
do! skipManyCharsTill anyChar (skipString "*/") }
let ws = (many (choice [spaces1; commentLine; commentBlock] <?> "") |>> ignore)
let ch c = skipChar c >>. ws
let str s = pstring s .>> ws
let ident =
let nonDigit = asciiLetter <|> pchar '_'
let p = pipe2 nonDigit (manyChars (nonDigit <|> digit <?> "")) (fun c s -> c.ToString() + s)
(p .>> ws) <?> "identifier"
let opp = new OperatorPrecedenceParser<_,_>()
let exprNoComma = opp.