src/Core/HindleyMilner.hs

@@ -55,11 +55,14 @@ instance IsRlpcError TypeError where
     liftRlpcError = \case
         -- todo: use anti-parser instead of show
         TyErrCouldNotUnify t u -> Text
-            [ T.pack $ printf "Could not match type `%s' with `%s'."
+            [ T.pack $ printf "Could not match type `%s` with `%s`."
                               (show t) (show u)
             , "Expected: " <> tshow t
             , "Got: " <> tshow u
             ]
+        TyErrUntypedVariable n -> Text
+            [ "Untyped (likely undefined) variable `" <> n <> "`"
+            ]
         TyErrRecursiveType t x -> Text
             [ T.pack $ printf "recursive type error lol"
             ]
@@ -157,7 +160,12 @@ gather = \g e -> runStateT (go g e) ([],0) <&> \ (t,(cs,_)) -> (t,cs) where
         Let Rec bs e -> do
             g' <- buildLetrecContext g bs
             go g' e
-
+        Lam bs e -> case bs of
+            [x] -> do
+                tx <- uniqueVar
+                let g' = (x,tx) : g
+                te <- go g' e
+                pure (tx :-> te)
         -- TODO lambda, case
 
     buildLetrecContext :: Context' -> [Binding']

src/Core/Syntax.hs

@@ -5,6 +5,7 @@ Description : Core ASTs and the like
 {-# LANGUAGE PatternSynonyms, OverloadedStrings #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE DerivingStrategies, DerivingVia #-}
 module Core.Syntax
     ( Expr(..)
     , Type(..)
@@ -45,6 +46,7 @@ import Data.HashMap.Strict          qualified as H
 import Data.Hashable
 import Data.Text                    qualified as T
 import Data.Char
+import GHC.Generics
 -- Lift instances for the Core quasiquoters
 import Language.Haskell.TH.Syntax   (Lift)
 import Lens.Micro.TH                (makeLenses)
@@ -127,7 +129,9 @@ data Program b = Program
     { _programScDefs   :: [ScDef b]
     , _programTypeSigs :: H.HashMap b Type
     }
-    deriving (Show, Lift)
+    deriving (Show, Lift, Generic)
+    deriving (Semigroup, Monoid)
+        via Generically (Program b)
 
 makeLenses ''Program
 pure []
@@ -148,11 +152,12 @@ instance IsString Type where
         | otherwise     = TyVar . fromString $ s
         where (c:_) = s
 
-instance (Hashable b) => Semigroup (Program b) where
+-- instance (Hashable b) => Semigroup (Program b) where
-    (<>) = undefined
+--     p <> q = Program
+--         { _programScDefs = _programScDefs p <> _programScDefs q }
 
-instance (Hashable b) => Monoid (Program b) where
+-- instance (Hashable b) => Monoid (Program b) where
-    mempty = Program mempty mempty
+--     mempty = Program mempty mempty
 
 ----------------------------------------------------------------------------------