Type constructors

src/cg/01-stdlib.cg

@@ -8,6 +8,7 @@ div : a \ a \ a;
 eq : a \ a \ Bool;
 
 Maybe a = None | Some a;
+Bool = True | False;
 
 # nth : Int \ List a \ Maybe a
 # in host at the moment, until we get typeclasses or something and this can work on strings too
@@ -17,7 +18,6 @@ Maybe a = None | Some a;
 #   | [n, [x, ...xs]] \ nth (n - 1) xs;
 
 map : (a \ b) \ List a \ List b = f list \ list
-# map : (a \ b) \ Int \ List b = f list \ list
   | [] \ []
   | [x, ...xs] \ [f x, ...map f xs];
 
@@ -34,21 +34,19 @@ index : a \ List a \ Maybe Int = x xs \
       | False \ go (i + 1) ys);
   go 0 xs;
 
-# filter 
 filter : (a \ Bool) \ List a \ List a = f list \ list
   | [] \ []
   | [x, ...xs] \ (f x
       | True \ [x, ...filter f xs]
       | False \ filter f xs);
 
-# insertAt : Int \ a \ List a
-insertAt = idx el list \ list
+insertAt : Int \ a \ List a = idx el list \ list
   | [] \ [el]
   | [x, ...xs] \ (idx
     | 0 \ [el, x, ...xs]
     | n \ [x, ...insertAt (n - 1) el xs]);
 
-insertCharAt = text pos char \
+insertCharAt : String \ Int \ String \ String = text pos char \
   before = slice text 0 pos;
   after = slice text pos (len text);
   before & char & after;
@@ -135,8 +133,7 @@ or = x y \ x
   | True \ True
   | False \ y;
 
-# not : Bool \ Bool
-not = x \ x
+not : bool \ bool = x \ x
   | True \ False
   | False \ True;
 
@@ -150,8 +147,7 @@ isNone = a \ a
   | Some _ \ False
   | _ \ True;
 
-# unwrapOr : a \ Maybe a \ a
-unwrapOr = default x \ x
+unwrapOr : a \ Maybe a \ a = default x \ x
   | Some val \ val
   | _ \ default;
 

src/compiler.ts

@@ -221,8 +221,8 @@ function compilePattern(pattern: Pattern, expr: string): { condition: string, bi
     }
 }
 
-export function compileAndRun(defs: Definition[]) {
-    typecheck(defs);
+export function compileAndRun(defs: Definition[], typeDefs: TypeDefinition[] = []) {
+    typecheck(defs, typeDefs);
 
     const compiledDefs: string[] = [];
 

src/main.ts

@@ -23,13 +23,13 @@ store.viewport = { width: window.innerWidth, height: window.innerHeight };
 try {
     const tokens = tokenize(cgCode);
     const parser = new Parser(tokens, cgCode);
-    const { definitions: defs } = parser.parse();
+    const { definitions: defs, typeDefinitions: typeDefs } = parser.parse();
     loadDefinitions();
 
     // TODO remove once we're booting from store, files are backup
     if (!store.paletteHistory) store.paletteHistory = [];
 
-    compileAndRun(defs);
+    compileAndRun(defs, typeDefs);
     saveDefinitions();
 
     runAppCompiled(canvas, store);

src/typechecker.ts

@@ -1,4 +1,4 @@
-import type { AST, TypeAST, Pattern, Definition } from './ast'
+import type { AST, TypeAST, Pattern, Definition, TypeDefinition } from './ast'
 import { prettyPrintType } from './ast'
 
 // Map type var names to their types
@@ -241,8 +241,26 @@ function bindPattern(pattern: Pattern, type: TypeAST, env: TypeEnv, subst: Subst
         case 'literal':
             return null;
         case 'constructor':
-            // TODO: look up ctor arg types
-            break;
+            // look up ctor types
+            const ctorType = env.get(pattern.name);
+            if (!ctorType) return null;
+            const fresh = freshen(ctorType, subst);
+
+            if (pattern.args.length === 0) {
+                unify(fresh, t, subst);
+                return null;
+            }
+
+            let cur = fresh;
+            for (const arg of pattern.args) {
+                if (cur.kind !== 'type-function') return null;
+                const err = bindPattern(arg, cur.param, env, subst);
+                if (err) return err;
+                cur = applySubst(cur.result, subst);
+            }
+
+            unify(cur, t, subst);
+            return null;
         case 'list':
         case 'list-spread':
             if (t.kind === 'type-apply' && t.constructor.kind === 'type-name' && t.constructor.name === 'List' && t.args.length === 1) {
@@ -274,9 +292,28 @@ function bindPattern(pattern: Pattern, type: TypeAST, env: TypeEnv, subst: Subst
     }
 }
 
-export function typecheck(defs: Definition[]) {
+export function typecheck(defs: Definition[], typeDefs: TypeDefinition[] = []) {
     const env: TypeEnv = new Map();
 
+    // Register constructors
+    for (const td of typeDefs) {
+        const resultType: TypeAST = td.params.length === 0
+            ? { kind: 'type-name', name: td.name }
+            : { kind: 'type-apply', constructor: { kind: 'type-name', name: td.name }, args: td.params.map(p => ({ kind: 'type-var', name: p })) };
+
+        for (const ctor of td.constructors) {
+            if (ctor.args.length === 0) {
+                env.set(ctor.name, resultType);
+            } else {
+                let fnType: TypeAST = resultType;
+                for (let i = ctor.args.length - 1; i >= 0; i--) {
+                    fnType = { kind: 'type-function', param: ctor.args[0], result: fnType };
+                }
+                env.set(ctor.name, fnType);
+            }
+        }
+    }
+
     // Register all annotated defs in env first so they can ref eachother
     for (const def of defs) {
         if (def.annotation) {