GLML
A ML for fragment shaders
GLML (OpenGL Meta Language) is a small functional language aimed at signed-distance fields, raymarchers, and procedural coloring. It brings Hindley-Milner inference, algebraic data types, closures, recursion, ad-hoc polymorphism; all of the features from classic ML languages like OCaml to shaders. GLML compiles to GLSL, with the ML features erased at compile time.
Quick links
- Try the Playground in the browser, with examples provided!
- For those familiar with ML syntax, Overview and Type System cover new material, but the browsing the playground’s examples are the quickest way to learn (for now)
- Install and Source
Overview
Note: We assume some familiarity with GLSL and ML terminology
A GLML program is a single pure function from a vec2 pixel coordinate to a vec4 color:
let main (coord : vec2) = [0.6, 0.2, 0.8, 1.0]
The host pipes in uniforms with #extern, builtins are prefixed with #, and the rest of the language looks like a small ML, with the classic let, let rec, match, fun, records, variants, and Hindley–Milner inference. GLML supports first class functions/closures and recursion. The compiler lowers it to a fragment shader that runs anywhere WebGL2 or GLES 3.0 runs, but is primarily designed for quick Shadertoy-like development.
Example: Mandelbrot Shader
Here is the classic Mandelbrot shader, which can be written as a terse and typesafe recursive function without any annotations:
#extern vec2 u_resolution
#extern float u_time
type option['a] = Some of 'a | None
let mandelbrot c =
let rec mandel z i =
if i > 150 then None
else if #length z > 4 then
let nu = #log2 (#log2 (#length z)) in
Some ((i - nu) / 150)
else
let zx = z.0 * z.0 - z.1 * z.1 in
let zy = 2 * z.0 * z.1 in
mandel ([zx, zy] + c) (i + 1)
in
mandel [0, 0] 0
let main (coord : vec2) =
let uv =
let top = 2 * coord - u_resolution in
let bot = #min u_resolution.0 u_resolution.1 in
top / bot
in
let zoom = #exp (#sin (u_time * 0.4) * 4.5 + 3.5) in
let seahorse_valley = [-0.7453, 0.1127] + uv / zoom in
let col =
match mandelbrot seahorse_valley with
| None -> [0, 0, 0]
| Some n -> #sin (n * [10, 20, 30] + u_time) * 0.5 + 0.5
in
[col.0, col.1, col.2, 1.0]
Compiled GLSL
#version 300 es
precision highp float;
out vec4 fragColor;
struct option {
int tag;
float Some_0;
};
option mandel_0(vec2 c, vec2 z, int i) {
int _iter = 0;
while (true) {
bool _lim_cond = (_iter < 1000);
if (_lim_cond) {
bool anf = (i > 150);
if (anf) {
return option(1, 0.);
} else {
float anf_0 = length(z);
bool anf_1 = (anf_0 > 4.);
if (anf_1) {
float anf_2 = length(z);
float anf_3 = log2(anf_2);
float nu = log2(anf_3);
float anf_4 = float(i);
float anf_5 = (anf_4 - nu);
float anf_6 = (anf_5 / 150.);
return option(0, anf_6);
} else {
float anf_7 = z[0];
float anf_8 = z[0];
float anf_9 = (anf_7 * anf_8);
float anf_10 = z[1];
float anf_11 = z[1];
float anf_12 = (anf_10 * anf_11);
float zx = (anf_9 - anf_12);
float anf_13 = z[0];
float anf_14 = (2. * anf_13);
float anf_15 = z[1];
float zy = (anf_14 * anf_15);
vec2 anf_16 = vec2(zx, zy);
vec2 anf_17 = (anf_16 + c);
int anf_18 = (i + 1);
int _iter_inc = (_iter + 1);
_iter = _iter_inc;
z = anf_17;
i = anf_18;
continue;
}
}
} else {
option _zero = option(0, 0.);
return _zero;
}
}
}
uniform vec2 u_resolution;
uniform float u_time;
void main() {
vec2 coord = gl_FragCoord.xy;
vec2 anf_20 = (2. * coord);
vec2 top = (anf_20 - u_resolution);
float anf_21 = u_resolution[0];
float anf_22 = u_resolution[1];
float bot = min(anf_21, anf_22);
vec2 uv = (top / bot);
float anf_23 = (u_time * 0.4);
float anf_24 = sin(anf_23);
float anf_25 = (anf_24 * 4.5);
float anf_26 = (anf_25 + 3.5);
float zoom = exp(anf_26);
vec2 anf_27 = vec2(-0.7453, 0.1127);
vec2 anf_28 = (uv / zoom);
vec2 seahorse_valley = (anf_27 + anf_28);
vec2 anf_19_0 = vec2(0., 0.);
option _lv_scrut = mandel_0(seahorse_valley, anf_19_0, 0);
int _lv_tag = _lv_scrut.tag;
vec3 col;
switch (_lv_tag) {
case 1: {
col = vec3(0., 0., 0.);
break;
}
default: {
float _lv_Some_0 = _lv_scrut.Some_0;
vec3 anf_29 = vec3(10., 20., 30.);
vec3 anf_30 = (_lv_Some_0 * anf_29);
vec3 anf_31 = (anf_30 + u_time);
vec3 anf_32 = sin(anf_31);
vec3 anf_33 = (anf_32 * 0.5);
col = (anf_33 + 0.5);
break;
}
}
float anf_34 = col[0];
float anf_35 = col[1];
float anf_36 = col[2];
fragColor = vec4(anf_34, anf_35, anf_36, 1.);
}
Example: GLSL vs GLML
The following is the same scene in both GLSL and GLML, where we define a SDF of a circle and rectangle.
// kind 0 = circle (a = radius), kind 1 = rect (a, b)
struct Shape { int kind; float a; float b; };
float sdShape(Shape s, vec2 p) {
if (s.kind == 0) return length(p) - s.a;
if (s.kind == 1) {
vec2 d = abs(p) - vec2(s.a, s.b);
return length(max(d, 0.0)) + min(max(d.x, d.y), 0.0);
}
return 1.0;
}
float scene(vec2 p) {
Shape c; c.kind = 0; c.a = 0.3;
Shape r; r.kind = 1; r.a = 0.7; r.b = 0.1;
return min(sdShape(c, p), sdShape(r, p));
}
type shape = Circle of float | Rect of float * float
let sdf_shape (s : shape) = fun p ->
match s with
| Circle r -> #length p - r
| Rect (w, h) ->
let d = #abs p - [w, h] in
#length (#max d [0, 0]) + #min (#max d.0 d.1) 0
let union f g = fun p -> #min (f p) (g p)
let scene = union (sdf_shape (Circle 0.3)) (sdf_shape (Rect (0.7, 0.1)))
In the GLSL version, the compiler can’t check you handled every kind of shape. In the GLML version, shape is a typed variant. match is exhaustive, each constructor carries its own typed payload, and union is a function that returns a function.
Unlike most ML languages that don’t provide any form of ad-hoc polymorphism, GLML provides a limited set of constraints (broadcasting over vectors and scalars, promotion of integers to floats) that enables classic HM inference without the burden of having explicit operators over various shapes.
Example: Optimization
Each ML feature has a corresponding lowering pass that erases it before GLSL is emitted
- Variants become discriminated structs of plain scalars
- Records become bundles of locals
- Closures are defunctionalized into tagged dispatch
- Polymorphic functions are monomorphized to one specialized copy per concrete use
- Recursion is rewritten to a
whileloop
By the time the program reaches the GPU, it is straight GLSL with no allocation, no function pointers, and no runtime tag dispatch beyond what the algorithm actually needs.
Below is GLML code rendering a simple union of two SDFs (open the optimized GLSL that is generated, the code before vec3 base; is all that is needed to represent the SDF!)
#extern vec2 u_resolution
#extern vec2 u_mouse
type sdf = vec2 -> float
type shape =
| Circle of float
| Rect of float * float
let sdf_shape (s : shape) : sdf =
fun p ->
match s with
| Circle r -> #length p - r
| Rect (w, h) ->
let d = #abs p - [w, h] in
#length (#max d [0, 0]) + #min (#max d.0 d.1) 0
let union (f : sdf) (g : sdf) : sdf = fun p -> #min (f p) (g p)
let scene = union (sdf_shape (Circle 0.3)) (sdf_shape (Rect (0.7, 0.1)))
let uv coord =
(2 * coord - u_resolution) / #min u_resolution.0 u_resolution.1
let main (coord : vec2) =
let p = uv coord in
let m = uv u_mouse in
let d = scene p in
let base = if d > 0 then [0.9, 0.6, 0.3, 1] else [0.65, 0.85, 1.0, 1] in
let shade = (1 - #exp (-6 * #abs d)) * (0.8 + 0.2 * #cos (150 * d)) in
let edge = 1 - #smoothstep 0 0.01 (#abs d) in
let dm = #length (p - m) in
let ds = #abs (dm - #abs (scene m)) in
let mouse = 1 - #smoothstep 0 0.005 (#min (ds - 0.0025) (dm - 0.015)) in
let col = base * shade in
let col = #mix col [1, 1, 1, 1] edge in
let col = #mix col [1, 1, 0, 1] mouse in
[col.0, col.1, col.2, 1.0]
Compiled GLSL
#version 300 es
precision highp float;
out vec4 fragColor;
uniform vec2 u_mouse;
uniform vec2 u_resolution;
vec2 uv_m(vec2 coord) {
vec2 anf_20 = (2. * coord);
vec2 anf_21 = (anf_20 - u_resolution);
float anf_22 = u_resolution[0];
float anf_23 = u_resolution[1];
float anf_24 = min(anf_22, anf_23);
return (anf_21 / anf_24);
}
void main() {
vec2 coord_0 = gl_FragCoord.xy;
vec2 p_1 = uv_m(coord_0);
vec2 m = uv_m(u_mouse);
float anf_2_6 = length(p_1);
float anf_18_2 = (anf_2_6 - 0.3);
vec2 anf_3_5 = abs(p_1);
vec2 anf_4_5 = vec2(0.7, 0.1);
vec2 d_6 = (anf_3_5 - anf_4_5);
vec2 anf_5_5 = vec2(0., 0.);
vec2 anf_6_5 = max(d_6, anf_5_5);
float anf_7_5 = length(anf_6_5);
float anf_8_5 = d_6[0];
float anf_9_5 = d_6[1];
float anf_10_5 = max(anf_8_5, anf_9_5);
float anf_11_5 = min(anf_10_5, 0.);
float anf_19_2 = (anf_7_5 + anf_11_5);
float d_0 = min(anf_18_2, anf_19_2);
bool anf_25 = (d_0 > 0.);
vec4 base;
if (anf_25) {
base = vec4(0.9, 0.6, 0.3, 1.);
} else {
base = vec4(0.65, 0.85, 1., 1.);
}
float anf_26 = abs(d_0);
float anf_27 = (-6. * anf_26);
float anf_28 = exp(anf_27);
float anf_29 = (1. - anf_28);
float anf_30 = (150. * d_0);
float anf_31 = cos(anf_30);
float anf_32 = (0.2 * anf_31);
float anf_33 = (0.8 + anf_32);
float shade = (anf_29 * anf_33);
float anf_34 = abs(d_0);
float anf_35 = smoothstep(0., 0.01, anf_34);
float edge = (1. - anf_35);
vec2 anf_36 = (p_1 - m);
float dm = length(anf_36);
float anf_2_2 = length(m);
float anf_18_1 = (anf_2_2 - 0.3);
vec2 anf_3_1 = abs(m);
vec2 anf_4_1 = vec2(0.7, 0.1);
vec2 d_2 = (anf_3_1 - anf_4_1);
vec2 anf_5_1 = vec2(0., 0.);
vec2 anf_6_1 = max(d_2, anf_5_1);
float anf_7_1 = length(anf_6_1);
float anf_8_1 = d_2[0];
float anf_9_1 = d_2[1];
float anf_10_1 = max(anf_8_1, anf_9_1);
float anf_11_1 = min(anf_10_1, 0.);
float anf_19_1 = (anf_7_1 + anf_11_1);
float anf_37 = min(anf_18_1, anf_19_1);
float anf_38 = abs(anf_37);
float anf_39 = (dm - anf_38);
float ds = abs(anf_39);
float anf_40 = (ds - 0.0025);
float anf_41 = (dm - 0.015);
float anf_42 = min(anf_40, anf_41);
float anf_43 = smoothstep(0., 0.005, anf_42);
float mouse = (1. - anf_43);
vec4 col = (base * shade);
vec4 anf_44 = vec4(1., 1., 1., 1.);
vec4 col_0 = mix(col, anf_44, edge);
vec4 anf_45 = vec4(1., 1., 0., 1.);
vec4 col_1 = mix(col_0, anf_45, mouse);
float anf_46 = col_1[0];
float anf_47 = col_1[1];
float anf_48 = col_1[2];
fragColor = vec4(anf_46, anf_47, anf_48, 1.);
}
Overall, we get the elegance of a functional language that is performant enough for shaders!
Motivation
The short answer: I wanted to learn more about painting with signed distance functions, and the yak was shaved too much. On the bright side, I got to render some nice volumetric clouds.
The long answer:
Ad-hoc Polymorphism
The language leans in on ad-hoc polymorphism, arithmetic operators are overloaded across scalars, vectors, and matrices. Built-in math functions like #sin, #min, and #length accept anything that broadcasts up to a float-shaped thing. Integer literals are coerced into floats. All of these are features unavailable in most ML languages but are essential to shaders.
let get_uv coord =
let top = 2 * coord - u_resolution in
let bot = #min u_resolution.0 u_resolution.1 in
top / bot
No annotations. 2 * coord mixes an integer and a vec2, and top / bot divides a vector by a scalar. Each of these would need a constructor call or a different operator in OCaml. In GLML they just work because the typechecker emits a constraint (Broadcast, MulBroadcast, Coerce) rather than pattern-matching the operand shapes directly. The solver picks the overload and promotes the literals.
The result is that GLML feels almost untyped for the kind of code shaders are usually made of, and only asserts itself when you do something it can actually catch (a missing match case, a vec2 + vec3, etc).
Signed Distance Functions
An SDF is a function vec2 -> float, mapping a position to its distance to the object boundary defined by the SDF. In raymarchers, scenes are compositions of these, operations that act on functions. In GLML we can treat it as a type alias and a few combinators:
type sdf = vec2 -> float
let union (f : sdf) (g : sdf) : sdf = fun p -> #min (f p) (g p)
let scale s (f : sdf) : sdf = fun p -> f (p / s)
let translate o (f : sdf) : sdf = fun p -> f (p - o)
You write each combinator once and reuse it across every scene. This makes writing raymarchers elegant.
Closeness to GLSL
GLML fundamentally needed to be a language close to GLSL, it doesn’t try to be a new platform. The runtime model is unchanged, and the existing GLSL stays useful. The plan is for GLSL to be easily interop-able with GLML, dropping GLML into an existing fragment shader shouldn’t be difficult.
Features
This is a list of highlighted features you may not have expected to see from an ML language and/or GLSL, not an exhaustive list of features. See Syntax for proper reference.
Bounded-Loop Recursion
let rec is lowered to a while loop with a hard 1000-iteration cap (Note: can be disabled, but I enjoy having my GPU not lock up).
let rec mandel z i =
if i > 150 then None
else if #length z > 4 then Some i
else mandel (square z + c) (i + 1)
Broadcasting and Overloading
Arithmetic operators are overloaded across scalars, vectors, and matrices
2 * [1.0, 2.0, 3.0] // [2.0, 4.0, 6.0]
rotate u_time * uv // mat2 * vec2 -> vec2
#sin (wave + [0, 2, 4]) * 0.3 + 0.7 // rainbow
Integer Literals Promote to Float
In a context that expects a float, ints are promoted automatically (int <: float subtyping).
let top = 2 * coord - n // 2 promotes, result vec(_, float)
let v = [some_int, 2.0, 4] // vec3 of float, not int (some_int is an int)
Exhaustive Pattern Matching
match is exhaustive by default. Forget a case and you get a compile error pointing at the missing constructor. A catch-all _ opts out for the cases it absorbs.
match s with
| Circle r -> ...
| Rect (w, h) -> ...
// ERROR: missing case `Empty`
First-Class Functions
The compiler defunctionalizes first class functions into a tag plus a capturing the minimal environment struct. The combinator pattern that makes SDF composition pleasant has zero runtime cost, since the optimizer can aggressively remove these kinds of expressions.
let union (f : sdf) (g : sdf) : sdf = fun p -> #min (f p) (g p)
let scale s (f : sdf) : sdf = fun p -> f (p / s)
Type Classes and Constraints
Functions are typed by inference, but there are seven built-in classes (GenType, GenIType, GenBType, MatType, Numeric, Comparable, Equatable) that are not extendable. The classes describe the same types as GLSL’s overload sets.
let add a b = a + b
// ^^^ inferred: `'a -> 'b -> 'r where ('a + 'b -> 'r)`
// works on int+int, float+float, vec3+vec3, vec2+float, mat2+mat2
+, - : 'a -> 'b -> 'r where Broadcast('a, 'b, 'r)
*, / : 'a -> 'b -> 'r where MulBroadcast('a, 'b, 'r)
(#sin x) : 'a -> 'b where Broadcast('a, float, 'b), GenType('b)
Syntax
//// Uniforms
// declared at the top level with `#extern`; supplied by the host
#extern vec2 u_resolution
#extern vec2 u_mouse
#extern float u_time
//// Top-level constants
let pi = 3.14159
let sky = [0.65, 0.85, 1.0]
//// Type declarations
// records
type point = { x: float, y: float }
type ray = { ro: vec3, rd: vec3 }
type box['a] = { value: 'a }
// variants
type shape =
| Circle of float
| Rect of float * float
| Empty
type option['a] = Some of 'a | None
// type aliases
type sdf = vec2 -> float
type boxed = box[float]
//// Top-level functions
let double x = 2 * x
let double = fun x -> 2 * x // Same as above
let add x y = x + y
// argument and return annotations are optional
let rotate (angle : float) : mat2 =
let s = #sin angle in
let c = #cos angle in
[[c, -s], [s, c]]
// recursion
let rec gcd a b =
if b = 0 then a
else gcd b (a - b * #floor (a / b))
//// Vector and matrix literals
let v = [1.0, 2.0, 3.0] // vec3
let m = [[1.0, 0.0], [0.0, 1.0]] // mat2
let m = [[1, 0, 0], [0, 1, 0], [0, 0, 1]] // mat3 (ints promote)
//// Component access
let a = v.0 + v.1 + v.2
let b = { x = 1.0, y = 2.0 }.x
//// Operators
let _ = 1 + 2 // int + int
let _ = 2 * [1.0, 2.0] // scalar broadcasts over vector
let _ = rotate u_time * v3 // mat * vec
let _ = [1, 2] = [1, 2] // equality (returns bool)
let _ = u_time > 0.5 // comparison
let _ = true && false // logical
// `x |> f` is sugar for `f x`
let _ =
sky
|> #max 0
|> #min [1, 1, 1]
//// Local bindings
let example coord =
let aspect = u_resolution.0 / u_resolution.1 in
let uv = coord / u_resolution in
let [x, y] = uv in
let centered = uv - [0.5, 0.5] in
[x * aspect, y, 0.0]
//// Conditionals
let band d =
if d < 0.0 then sky
else if d < 0.5 then [0.4, 0.3, 0.2]
else [1.0, 1.0, 1.0]
//// Constructing variants and records
let s = Circle 0.3
let s = Rect (0.7, 0.1)
let s = Empty
let r : ray = { ro = [0, 0, 0], rd = [0, 0, 1] }
let b = { value = [1, 2, 3] }
let o = Some [1.0, 2.0, 3.0]
let o = None
//// Pattern matching
let area s =
match s with
| Circle r -> 3.14 * r * r
| Rect (w, h) -> w * h
| _ -> true
//// Higher-order functions
let scale s = fun v -> v * s
let union f g = fun p -> #min (f p) (g p)
let twice f x = f (f x) // ('a -> 'a) -> 'a -> 'a inferred
//// User-written constraints (optional, encourage to leave out to be inferred)
let add (x : 'a) (y : 'b) : 'c = x + y
where ('a + 'b -> 'c)
// forms:
// Num 't -> Numeric (float, int, vec, mat)
// 'a + 'b -> 'r -> Broadcasting (Addition)
// 'a * 'b -> 'r -> Broadcasting (Multiplication)
//// GLSL Builtins (any `#name`)
let _ = #sin u_time
let _ = #length [3.0, 4.0]
let _ = #min 0.5 1.0
let _ = #mix [1, 0, 0] [0, 0, 1] 0.5
let _ = #cross [1, 0, 0] [0, 1, 0]
let _ = #float 2
//// Entry point must be `main : vec2 -> vec4`
let main (coord : vec2) =
let uv = coord / u_resolution in
let d = #length (uv - [0.5, 0.5]) - 0.3 in
if d < 0.0 then [1.0, 0.5, 0.2, 1.0] else sky
CLI
Install with Nix
Run directly from the flake without cloning:
nix run github:glml-lang/glml -- build <example.glml>
Or build the CLI locally:
nix build github:glml-lang/glml
./result/bin/glml build example.glml
git clone https://github.com/glml-lang/glml
nix run ".#glml" -- build <example.glml>
For development, clone and enter the dev shell:
git clone https://github.com/glml-lang/glml
cd glml
nix develop
Install with opam
Requires OCaml 5.3.0+:
git clone https://github.com/glml-lang/glml
cd glml
opam switch create . 5.3.0
opam install . --deps-only
eval $(opam env)
Usage
# binary by default built in `./_build/default/bin/main.exe`
make bin
glml build example.glml # output to stdout
glml build example.glml -o shader.glsl # output to file
glml build example.glml -p all # dump all passes to stdout
glml build example.glml -p typecheck # one pass
glml build example.glml -p all -d /tmp/passes # to files
# Disable inlining / constant folding / deadcode elim
glml build example.glml -no-optimize
# List available passes to dump
glml list-passes
Tests
make test # run all expect tests
dune promote # accept new output after intentional changes
Information Dump
This page contains a dump of current TODO items and unorganized thoughts and tasks. This will likely stay a mess.
Tasks
- Inline/fold effectful while loops
- Inline
main_purefunction intomainpotentially vec<_, float>syntax for size polymorphism- Type annotations for arbitrary terms
- Add builtin GLSL function callers or GLSL extern libraries
uintBitsToFloatinstead of fat structs to represent variants, instead storing as uvec4 in raw bits- Reuse fields with same type for structs / defunctionalization
- static arrays
whenclause for match statements- Potentially some kind of recursive types like
type list['a] = Nil | Cons of 'a * list['a] - Mutual recursion
- Add a guide or overview to playground
- Add common GLSL builtins:
#radians/#degrees,#refract,#faceforward,#dFdx,#dFdy,#fwidth,#matrixCompMult,#transpose,#inverse,#determinant - Caching the intermediary values for “const” 0 arg functions for lift_consts
Example Ideas
- Raymarched volumetric clouds
- Buffer passing uses (e.g. Game of Life)
- Lava lamp-like example
- Example storing functions and hotswapping functions during executions to justify DFns in variants
- Pathtracing
- Make logo with GLML (finish beaver)
Long Term Tasks
- Update GLML screenshot
- Implicit error field added to every function to propagate error color back
- Add support for LSP hover or something, at least a simple [inspect] for the playground
- Size dependent types
- Swizzle syntax or some kind of rank polymorphism
- Doc strings or emission of helpful comments
- Better benchmarking tests
- Add sliders in playground to change values
- Update blog posts
- Set up Neovim/Emacs/Treesitter plugins
- Set up Github organization
Potentially Interesting Thoughts
wasm_of_ocamlbuild?Coreseems to causeError: Base_am_testing not implemented- Emit on compilation what data needs to be passed from host
- Indexing vectors by arbitrary terms?
- Differentiate int and float division explicitly
- WebGPU backend for computer shaders and SSBOs?
- Export to shadertoy?
Resources
- Janet to GLSL Compiler
- Articles on SDFs
- Size-Dependent Types
- Futhark In-place Records
- Futhark Size-Dependent Types
- Writing Nix Derivations
- Typing Haskell in Haskell
- Type Inference with Constrained Types
- Demystifying Typeclasses
- Compiling Pattern Matching to Good Decision Trees
- Compiler Pattern Matching
- Sparse Conditional Constant Propagation