From ce9e429eeb87642842a360b70b890bb24a9d6ae0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= <georges.duperon@gmail.com>
Date: Tue, 7 Aug 2018 23:43:23 +0200
Subject: [PATCH] First attempt at a type-level function DSL

---
 deques.ml | 46 ++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 46 insertions(+)

diff --git a/deques.ml b/deques.ml
index 5a6d09c..4d5e03a 100644
--- a/deques.ml
+++ b/deques.ml
@@ -194,6 +194,52 @@ module DequesColorsStack = struct
 end
 open DequesColorsStack
 
+module TypeLevelFunctions1 = struct
+  (* TODO: bundle together the stack and an on-demand infinite stack of free variables *)
+  (* This should not be exported in the sig. *)
+  module Private = struct
+    (* stack of type-level operands *)
+    type start = ()
+    type ('head, 'tail) stk    = Stk of 'head * 'tail (* constraint 'tail = ('a,'b) stk *)
+
+    (* internal: quote a type and place it on the stack *)
+    type 't _typ = Typ of 't
+  end
+  open Private
+
+  (* unwrap the single element on the stack *)
+  type 'stk return = 'returned constraint 'stk = (start, 'returned _typ) stk
+
+  (* quote a type and place it on the stack *)
+  type ('stk, 't) typ  = ('stk, 't _typ) stk
+
+  (* type-level booleans *)
+  type ('stk, 'freevar) tru  = ('stk, ('a * 'b * 'b)) stk constraint 'freevar = 'a * 'b
+  type ('stk, 'freevar) fals = ('stk, ('a * 'b * 'b)) stk constraint 'freevar = 'a * 'b
+
+  (* type-level conditional *)
+  type 'stk tif = ('tail, 'tresult) stk
+  constraint 'tcondition = 'tthen * 'telse * 'tresult
+  constraint 'stk = ((('tail, 'tcondition) stk, 'tthen) stk, 'telse) stk
+
+  (* type-level duplication of a boolean
+
+     We prefer not to allow duplication of a quoted type, as there would be no
+     way to avoid using the same polymorphic variables in both occurrences. *)
+  (* TODO: use if to duplicate! *)
+  type 'stk dup = ('stk, 'head) stk constraint 'stk = ('tail, 'head) stk
+
+  (* type 'x push = 'a * 'b constraint 'x = 'a * 'b *)
+  (* type ('tcondition, 'tthen, 'telse) tif = 'tresult constraint 'tcondition = 'tthen * 'telse * 'tresult *)
+  
+  type s = ((((start, 't) tru, string) typ), int) typ tif return
+end
+
+
+
+
+
+