yukigo-haskell-parser 0.1.0

package/src/prelude.ts

@@ -0,0 +1,206 @@
+import { YukigoHaskellParser } from "./index.js"
+
+export const preludeCode = `data Ordering  = LT | EQ | GT
+data Maybe a = Nothing | Just a
+(,) :: a -> b -> (a, b)
+(,) x y = (x, y)
+($) :: (a -> b) -> a -> b
+($) f x = f x
+(.) :: (b -> c) -> (a -> b) -> a -> c
+(.) f g a = (\\x -> f (g x)) a
+(:) :: a -> [a] -> [a]
+(:) x xs = x : xs
+(++) :: [a] -> [a] -> [a]
+(++) [] ys = ys
+(++) (x:xs) ys = x : (xs ++ ys)
+(&&) :: (Eq a) => a -> a -> Boolean
+(||) :: (Eq a) => a -> a -> Boolean
+(&&) x y = x && y
+(||) x y = x || y
+(==) :: (Ord a) => a -> a -> Boolean
+(/=) :: (Ord a) => a -> a -> Boolean
+(<) :: (Ord a) => a -> a -> Boolean
+(>) :: (Ord a) => a -> a -> Boolean
+(<=) :: (Ord a) => a -> a -> Boolean
+(>=) :: (Ord a) => a -> a -> Boolean
+(==) x y = x == y
+(/=) x y = x /= y
+(<) x y = x < y
+(>) x y = x > y
+(<=) x y = x <= y
+(>=) x y = x >= y
+(+) :: Num a => a -> a -> a
+(-) :: Num a => a -> a -> a
+(+) x y = x + y
+(-) x y = x - y
+(**) :: (Floating a) => a -> a -> a
+(**) x y = x ** y
+(^) :: (Num a, Integral b) => a -> b -> a
+(^) x y = x ^ y
+(^^) :: (Fractional a, Integral b) => a -> b -> a
+(^^) x y = x ^^ y
+(*) :: (Num a) => a -> a -> a
+(*) x y = x * y
+(/) :: Fractional a => a -> a -> a
+(/) _ 0 = error "Prelude./: divide by zero"
+(/) x y = x / y
+(!!) :: [a] -> Int -> a
+(!!) xs n | n < 0 = error "Prelude.!!: negative index"
+(!!) [] _ = error "Prelude.!!: index too large"
+(!!) (x:_) 0 = x
+(!!) (_:xs) n = xs !! (n - 1)
+not :: Bool -> Bool
+not True = False
+not False = True
+quot :: Integral a => a -> a -> a
+quot _ 0 = error "divide by zero"
+quot 0 _ = 0
+quot a b = let { absA = abs a; absB = abs b; result = quotPositive absA absB } in if (a < 0) == (b < 0) then result else -result
+rem :: Integral a => a -> a -> a
+rem _ 0 = error "divide by zero"
+rem 0 _ = 0
+rem a b = let { absA = abs a; absB = abs b; remainder = remPositive absA absB } in if a < 0 then -remainder else remainder
+quotPositive :: Integral a => a -> a -> a
+quotPositive n d | n < d = 0 | otherwise = 1 + quotPositive (n - d) d
+remPositive :: Integral a => a -> a -> a
+remPositive n d | n < d = n | otherwise = remPositive (n - d) d
+div :: Integral a => a -> a -> a
+div _ 0 = error "divide by zero"
+div 0 _ = 0
+div a b = let { q = quot a b; r = rem a b } in if r == 0 || (a < 0) == (b < 0) then q else q - 1
+mod :: Integral a => a -> a -> a
+mod _ 0 = error "divide by zero"
+mod 0 _ = 0
+mod a b = a - (div a b) * b
+signum :: (Num a) => a -> a
+signum x | x == 0 = 0 | x > 0 = 1 | otherwise = -1
+abs :: (Num a) => a -> a
+abs n = if n < 0 then -n else n
+sqrt :: (Num a) => a -> a
+sqrt x = x ** 0.5
+max :: a -> a -> a
+max x y = if x <= y then y else x
+min :: a -> a -> a
+min x y = if x <= y then x else y
+even :: (Integral a) => a -> Bool
+odd :: (Integral a) => a -> Bool
+even n = n \`rem\` 2 == 0
+odd n = (not . even) n
+length :: [a] -> Int
+length [] = 0
+length (_:l) = 1 + length l
+genericLength :: (Integral a) => [b] -> a
+genericLength [] = 0
+genericLength (x:xs) = 1 + genericLength xs
+null :: [a] -> Bool
+null [] = True
+null (_:_) = False
+union :: (Eq a) => [a] -> [a] -> [a]
+union xs ys = unionBy (==) xs ys
+deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]
+deleteBy eq x [] = []
+deleteBy eq x (y:ys) = if x \`eq\` y then ys else y : deleteBy eq x ys
+deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
+deleteFirstsBy eq xs ys = foldl (flip (deleteBy eq)) xs ys
+nubBy :: (a -> a -> Bool) -> [a] -> [a]
+nubBy eq [] = []
+nubBy eq (x:xs) = x : nubBy eq (filter (\\y -> not (eq x y)) xs)
+unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
+unionBy eq xs ys = xs ++ deleteFirstsBy eq (nubBy eq ys) xs
+intersect :: (Eq a) => [a] -> [a] -> [a]
+intersect xs ys = intersectBy (==) xs ys
+intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
+intersectBy eq xs ys = [x | x <- xs, any (eq x) ys]
+elem :: (Eq a) => a -> [a] -> Bool
+notElem :: (Eq a) => a -> [a] -> Bool
+elem x xs = any (\\y -> y == x) xs
+notElem x xs = all (\\y -> y /= x) xs
+maximum :: (Ord a) => [a] -> a
+minimum :: (Ord a) => [a] -> a
+maximum [] = error "Prelude.maximum: empty list"
+maximum xs = foldl1 max xs
+minimum [] = error "Prelude.minimum: empty list"
+minimum xs = foldl1 min xs
+sum :: (Num a) => [a] -> a
+product :: (Num a) => [a] -> a
+sum xs = foldl (+) 0 xs
+product xs = foldl (*) 1 xs
+concat :: [[a]] -> [a]
+concat xss = foldr (++) [] xss
+concatMap :: (a -> [b]) -> [a] -> [b]
+concatMap f xs = (concat . map) f xs
+take :: Int -> [a] -> [a]
+take n _ | n <= 0 = []
+take _ [] = []
+take n (x:xs) = x : take (n - 1) xs
+drop :: Int -> [a] -> [a]
+drop n xs | n <= 0 = xs
+drop _ [] = []
+drop n (_:xs) = drop (n - 1) xs
+head :: [a] -> a
+head (x:_) = x
+head [] = error "Prelude.head: empty list"
+tail :: [a] -> [a]
+tail (_:xs) = xs
+tail [] = error "Prelude.tail: empty list"
+last :: [a] -> a
+last [x] = x
+last (_:xs) = last xs
+last [] = error "Prelude.last: empty list"
+init :: [a] -> [a]
+init [x] = []
+init (x:xs) = x : init xs
+init [] = error "Prelude.init: empty list"
+zip :: [a] -> [b] -> [(a, b)]
+zip xs ys = zipWith (,) xs ys
+zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
+zipWith z (a:as) (b:bs) = z a b : zipWith z as bs
+zipWith _ _ _ = []
+reverse :: [a] -> [a]
+reverse xs = foldl (flip (:)) [] xs
+filter :: (a -> Bool) -> [a] -> [a]
+filter p [] = []
+filter p (x:xs) | p x = x : filter p xs | otherwise = filter p xs
+map :: (a -> b) -> [a] -> [b]
+map f [] = []
+map f (x:xs) = f x : map f xs
+any :: (a -> Bool) -> [a] -> Bool
+all :: (a -> Bool) -> [a] -> Bool
+any f (x:xs) = f x || any f xs
+all f (x:xs) = f x && all f xs
+foldl :: (a -> b -> a) -> a -> [b] -> a
+foldl f z [] = z
+foldl f z (x:xs) = foldl f (f z x) xs
+foldl1 :: (a -> a -> a) -> [a] -> a
+foldl1 f (x:xs) = foldl f x xs
+foldl1 _ [] = error "Prelude.foldl1: empty list"
+foldr :: (a -> b -> b) -> b -> [a] -> b
+foldr f z [] = z
+foldr f z (x:xs) = f x (foldr f z xs)
+foldr1 :: (a -> a -> a) -> [a] -> a
+foldr1 f [x] = x
+foldr1 f (x:xs) = f x (foldr1 f xs)
+foldr1 _ [] = error "Prelude.foldr1: empty list"
+find :: Ord a => (a -> Bool) -> [a] -> Maybe a
+find _ [] = Nothing
+find f (x:xs) | f x = Just x | otherwise = find f xs
+sort :: (Ord a) => [a] -> [a]
+sort xs = sortBy compare xs
+sortBy :: (a -> a -> Ordering) -> [a] -> [a]
+sortBy cmp xs = foldr (insertBy cmp) [] xs
+compare :: a -> a -> Ordering
+compare x y | x == y = EQ | x <= y = LT | otherwise = GT
+insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]
+insertBy cmp x [] = [x]
+insertBy cmp x ys@(y:ys') = case cmp x y of { GT -> y : insertBy cmp x ys'; _ -> x : ys }
+flip :: (a -> b -> c) -> b -> a -> c
+flip f x y = f y x
+repeat :: a -> [a]
+repeat x = x : (repeat x)
+iterate :: (a -> a) -> a -> [a]
+iterate f x = x : iterate f (f x)
+replicate :: Int -> a -> [a]
+replicate n x = take n (repeat x)
+cycle :: [a] -> [a]
+cycle [] = error "Prelude.cycle: empty list"
+cycle xs = xs ++ (cycle xs)`

package/src/typechecker/DeclarationCollector.ts

@@ -0,0 +1,104 @@
+import {
+  ASTNode,
+  Record,
+  TypeAlias,
+  TypeSignature,
+  Visitor,
+} from "yukigo-ast";
+import {
+  functionType,
+  Type,
+  TypeConstructor,
+  TypeScheme,
+  TypeVar,
+} from "./checker.js";
+import { CoreHM } from "./core.js";
+import { TypeBuilder } from "./TypeBuilder.js";
+
+const builder = new TypeBuilder(new CoreHM());
+
+export class DeclarationCollectorVisitor implements Visitor<void> {
+  constructor(
+    private errors: string[],
+    private typeAliasMap: Map<string, Type>,
+    private recordMap: Map<string, Type>,
+    private signatureMap: Map<string, TypeScheme>,
+    private coreHM: CoreHM
+  ) {}
+
+  visitTypeAlias(node: TypeAlias) {
+    const typeAliasIdentifier = node.identifier.value;
+    if (
+      this.typeAliasMap.has(typeAliasIdentifier) ||
+      this.recordMap.has(typeAliasIdentifier)
+    ) {
+      this.errors.push(`Multiple declaration of '${typeAliasIdentifier}'.`);
+      return;
+    }
+
+    const { type, constraints } = builder.build(node.value);
+    this.typeAliasMap.set(typeAliasIdentifier, type);
+  }
+  visitRecord(node: Record) {
+    const recordIdentifier = node.name.value;
+    if (
+      this.typeAliasMap.has(recordIdentifier) ||
+      this.recordMap.has(recordIdentifier)
+    ) {
+      this.errors.push(`Multiple declaration of '${recordIdentifier}'.`);
+      return;
+    }
+
+    // Save the record type itself
+    const recordType: TypeConstructor = {
+      type: "TypeConstructor",
+      name: recordIdentifier,
+      args: [],
+    };
+    this.recordMap.set(recordIdentifier, recordType);
+
+    // Add constructors to signature map as type schemes
+    for (const cons of node.contents) {
+      if (this.signatureMap.has(cons.name.value)) {
+        this.errors.push(`Constructor '${cons.name}' is already defined`);
+        continue;
+      }
+      const paramTypes = cons.fields.map((field) => builder.build(field.value));
+      const returnType: TypeConstructor = {
+        type: "TypeConstructor",
+        name: recordIdentifier,
+        args: paramTypes.map(() => this.coreHM.freshVar()),
+      };
+
+      const funcType: Type = paramTypes.reduceRight(
+        (acc, param) => functionType(param.type, acc),
+        returnType
+      );
+
+      // Generalize all free variables in the constructor type
+      const scheme = this.coreHM.generalize(new Map(), funcType);
+      this.signatureMap.set(cons.name.value, scheme);
+    }
+  }
+  visitTypeSignature(node: TypeSignature) {
+    const functionName = node.identifier.value;
+    if (this.signatureMap.has(functionName)) {
+      this.errors.push(
+        `Function '${functionName}' has multiple type signatures`
+      );
+      return;
+    }
+    const typeVarMap = new Map<string, TypeVar>();
+    const { type, constraints } = builder.build(node.body, typeVarMap);
+    const quantifiers = Array.from(typeVarMap.values()).map((tv) => tv.id);
+    this.signatureMap.set(functionName, {
+      type: "TypeScheme",
+      quantifiers,
+      body: type,
+      constraints,
+    });
+  }
+  visit(node: ASTNode): void {
+    node.accept(this);
+  }
+}

package/src/typechecker/TypeBuilder.ts

@@ -0,0 +1,148 @@
+import {
+  SimpleType,
+  TypeVar as ASTTypeVar,
+  ListType,
+  TupleType,
+  ParameterizedType,
+  TypeApplication,
+  Constraint,
+  Type as YukigoType,
+  ConstrainedType,
+  ASTNode,
+} from "yukigo-ast";
+import { typeMappings } from "../utils/types.js";
+import { CoreHM } from "./core.js";
+import { functionType, Type, TypeConstructor, TypeVar } from "./checker.js";
+
+export class TypeBuilder {
+  constructor(private coreHM: CoreHM) {}
+
+  build(
+    node: YukigoType,
+    typeVarMap: Map<string, TypeVar> = new Map()
+  ): { type: Type; constraints: Map<number, string[]> } {
+    const constraintsMap = new Map<number, string[]>();
+
+    // Local visitor to walk Yukigo type AST
+    const visitor = {
+      visitSimpleType: (n: SimpleType): Type => {
+        if (/^[a-z]/.test(n.value)) {
+          // Lowercase = type variable
+          if (!typeVarMap.has(n.value)) {
+            typeVarMap.set(n.value, {
+              type: "TypeVar",
+              ...this.coreHM.freshVar(),
+              name: n.value,
+            });
+          }
+          // Collect constraints on this type var
+          for (const constraint of n.constraints) {
+            this.processConstraint(constraint, typeVarMap, constraintsMap);
+          }
+          return typeVarMap.get(n.value)!;
+        }
+
+        // Uppercase = type constructor (e.g., Int, Bool, List)
+        const primitive = typeMappings[n.value] || n.value;
+        return {
+          type: "TypeConstructor",
+          name: primitive,
+          args: [],
+        };
+      },
+
+      visitTypeVar: (n: ASTTypeVar): Type => {
+        // Same as SimpleType for type variables
+        if (!typeVarMap.has(n.value)) {
+          typeVarMap.set(n.value, {
+            type: "TypeVar",
+            ...this.coreHM.freshVar(),
+            name: n.value,
+          });
+        }
+        for (const constraint of n.constraints) {
+          this.processConstraint(constraint, typeVarMap, constraintsMap);
+        }
+        return typeVarMap.get(n.value)!;
+      },
+
+      visitListType: (n: ListType): Type => {
+        const elementType = n.values.accept(visitor);
+        return {
+          type: "TypeConstructor",
+          name: "List",
+          args: [elementType],
+        };
+      },
+
+      visitTupleType: (n: TupleType): Type => {
+        const elementTypes = n.values.map((v) => v.accept(visitor));
+        return {
+          type: "TypeConstructor",
+          name: "Tuple",
+          args: elementTypes,
+        };
+      },
+
+      visitTypeApplication: (n: TypeApplication): Type => {
+        return this.coreHM.freshVar();
+      },
+
+      visitParameterizedType: (n: ParameterizedType): Type => {
+        // This represents function types with constraints, e.g.:
+        // (a, b) => c with Eq a
+        const returnType = n.returnType.accept(visitor);
+        const paramTypes = n.inputs.map((input) => input.accept(visitor));
+
+        // Build function type: a -> b -> c
+        const funcType = paramTypes.reduceRight(
+          (acc, param) => functionType(param, acc),
+          returnType
+        );
+
+        // Process constraints
+        for (const constraint of n.constraints) {
+          this.processConstraint(constraint, typeVarMap, constraintsMap);
+        }
+
+        return funcType;
+      },
+
+      visitConstrainedType: (n: ConstrainedType): Type => {
+        // This is unusual at top level; usually constraints appear on type vars or signatures
+        // For now, ignore or throw
+        throw new Error("ConstrainedType not expected in this context");
+      },
+      visit(node: ASTNode): Type {
+        return node.accept(visitor);
+      },
+    };
+
+    const type = node.accept(visitor);
+    return { type, constraints: constraintsMap };
+  }
+
+  private processConstraint(
+    constraint: Constraint,
+    typeVarMap: Map<string, { type: "TypeVar"; id: number }>,
+    constraintsMap: Map<number, string[]>
+  ): void {
+    // Assume constraint is of form `Eq a`, so first param is a type var
+    if (constraint.parameters.length === 0) return;
+
+    const firstParam = constraint.parameters[0];
+    // Only handle if it's a type variable
+    if (
+      (firstParam instanceof SimpleType || firstParam instanceof ASTTypeVar) &&
+      /^[a-z]/.test(firstParam.value)
+    ) {
+      const tv = typeVarMap.get(firstParam.value);
+      if (tv) {
+        if (!constraintsMap.has(tv.id)) {
+          constraintsMap.set(tv.id, []);
+        }
+        constraintsMap.get(tv.id)!.push(constraint.name);
+      }
+    }
+  }
+}