├── examples ├── ident.dblc ├── unitType.dblc ├── kcomb.dblc ├── boolType.dblc ├── identityType.dblc ├── listType.dblc ├── 1p1e2.dblc └── helloWorld.dblc ├── README.md ├── .gitattributes ├── .gitignore └── DBLC.hs /examples/ident.dblc: -------------------------------------------------------------------------------- 1 | 01001100110010011010 -------------------------------------------------------------------------------- /examples/unitType.dblc: -------------------------------------------------------------------------------- 1 | 01100100110010101100111001001100101010 -------------------------------------------------------------------------------- /examples/kcomb.dblc: -------------------------------------------------------------------------------- 1 | 010011001001100101100101101111001001100100110010110010110110 -------------------------------------------------------------------------------- /examples/boolType.dblc: -------------------------------------------------------------------------------- 1 | 01100100110010100101101110011100100110010100101101100111001001100101001011010 -------------------------------------------------------------------------------- /examples/identityType.dblc: -------------------------------------------------------------------------------- 1 | 010011001010010110011001001100101001011001001011100110010001011100011011100100110010100000000111011010100100110010100100101100110010001011010 -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Dependently Typed Binary Lambda Calculus 2 | =================== 3 | 4 | This is an implementation of a modification of [Binary Lambda Calculus](https://en.wikipedia.org/wiki/Binary_combinatory_logic) which adds dependent types. 5 | 6 | See [here](https://esolangs.org/wiki/Dependently_Typed_Binary_Lambda_Calculus) for more information. 7 | 8 | Authors 9 | ------- 10 | 11 | Anthony Hart 12 | -------------------------------------------------------------------------------- /examples/listType.dblc: -------------------------------------------------------------------------------- 1 | 0100110011001001100100110010100100101110010111011110111001001100001110100100110010011001010010010111001011101111011001001100101001000011101100001110111001001100101001000011101100100110010100100101111100101110111100000101111100000001111011101101001001100100001110100100001110110000111011100100110010000111010010000111011001001100101001001011111001011101111000000011111011100000001111011101101010 -------------------------------------------------------------------------------- /examples/1p1e2.dblc: -------------------------------------------------------------------------------- 1 | 0110010011001010010010110111011100111001001100101001001011011100010110011100100110010100100101101110001000101100100111001001110011100100111001001110010011001010010010110111000000011111011100000001111011101101010010011001010010110011001001100101001011001001011100110010001011100011011100100110010100000000111111101101010010011001010010010110011001000101101000000001111111001110000001111110011110011110011111000000111111110011100111110 -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | 4 | # Custom for Visual Studio 5 | *.cs diff=csharp 6 | 7 | # Standard to msysgit 8 | *.doc diff=astextplain 9 | *.DOC diff=astextplain 10 | *.docx diff=astextplain 11 | *.DOCX diff=astextplain 12 | *.dot diff=astextplain 13 | *.DOT diff=astextplain 14 | *.pdf diff=astextplain 15 | *.PDF diff=astextplain 16 | *.rtf diff=astextplain 17 | *.RTF diff=astextplain 18 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Windows image file caches 2 | Thumbs.db 3 | ehthumbs.db 4 | 5 | # Folder config file 6 | Desktop.ini 7 | 8 | # Recycle Bin used on file shares 9 | $RECYCLE.BIN/ 10 | 11 | # Windows Installer files 12 | *.cab 13 | *.msi 14 | *.msm 15 | *.msp 16 | 17 | # Windows shortcuts 18 | *.lnk 19 | 20 | # ========================= 21 | # Operating System Files 22 | # ========================= 23 | 24 | # OSX 25 | # ========================= 26 | 27 | .DS_Store 28 | .AppleDouble 29 | .LSOverride 30 | 31 | # Thumbnails 32 | ._* 33 | 34 | # Files that might appear in the root of a volume 35 | .DocumentRevisions-V100 36 | .fseventsd 37 | .Spotlight-V100 38 | .TemporaryItems 39 | .Trashes 40 | .VolumeIcon.icns 41 | 42 | # Directories potentially created on remote AFP share 43 | .AppleDB 44 | .AppleDesktop 45 | Network Trash Folder 46 | Temporary Items 47 | .apdisk 48 | -------------------------------------------------------------------------------- /examples/helloWorld.dblc: -------------------------------------------------------------------------------- 1 | 01001100110010011001001100101001001011100101110111101110010011000011101001001100100110010100100101110010111011110110010011001010010000111011000011101110010011001010010000111011001001100101001001011111001011101111000001011111000000011110111011010010011001000011101001000011101100001110111001001100100001110100100001110110010011001010010010111110010111011110000000111110111000000011110111011010100110010011001010010110111001111111001001100101001011011001111111001001100101001011010000111001111111000000001111100111111100111111110000000011111001111111001111111110000000011111001111111001111111110000000011111001111111001111111100000000111110011111110011111111100000000111110011111110011111111100000000111110011111110011111111100001111001111111000011100111111100000000111110011111110011111111000000001111100111111100111111110000000011111001111111001111111110000000011111001111111001111111110000000011111001111111001111111100000000111110011111110011111111100000000111110011111110011111111000011110011111110000111001111111000000001111100111111100111111110000000011111001111111001111111100000000111110011111110011111111100000000111110011111110011111111000000001111100111111100111111110000000011111001111111001111111110000000011111001111111001111111110000111100111111100001110011111110000000011111001111111001111111100000000111110011111110011111111000000001111100111111100111111111000000001111100111111100111111110000000011111001111111001111111100000000111110011111110011111111000000001111100111111100111111110000111100111111100001110011111110000000011111001111111001111111110000000011111001111111001111111100000000111110011111110011111111100000000111110011111110011111111100000000111110011111110011111111100000000111110011111110011111111100000000111110011111110011111111100001111001111111000011100111111100000000111110011111110011111111000000001111100111111100111111111000000001111100111111100111111110000000011111001111111001111111110000000011111001111111001111111100000000111110011111110011111111000000001111100111111100111111110000111100111111100001110011111110000000011111001111111001111111100000000111110011111110011111111000000001111100111111100111111110000000011111001111111001111111110000000011111001111111001111111110000000011111001111111001111111100000000111110011111110011111111100001111001111111000011100111111100000000111110011111110011111111000000001111100111111100111111110000000011111001111111001111111110000000011111001111111001111111110000000011111001111111001111111100000000111110011111110011111111100000000111110011111110011111111100001111001111111000011100111111100000000111111001111111001111111111000000001111110011111110011111111111000000001111110011111110011111111111100000000111111001111111001111111111110000000011111100111111100111111111111100000000111111001111111001111111111111100000000111111001111111001111111111111110000000011111100111111100111111111111100000000111111001111111001111111111111111000000001111110011111110011111111111100111111111111111110 -------------------------------------------------------------------------------- /DBLC.hs: -------------------------------------------------------------------------------- 1 | module DBLC where 2 | 3 | import qualified Data.Map.Strict as Map 4 | import Control.Monad.Reader 5 | import Control.Monad.State 6 | import Control.Monad.Except 7 | import Control.Monad.Trans.Except 8 | 9 | import System.IO 10 | import System.Environment 11 | 12 | -- The proof environment monad. 13 | -- Contains a map from de bruijn levels to terms 14 | -- a context containing the types for de bruijn indices, 15 | -- and an integer representing the level. 16 | type Proof = ExceptT String (ReaderT [Term] (StateT (Map.Map Int (Term, Term)) (State Int))) 17 | 18 | runProof p = fst $ evalState (runStateT (runReaderT (runExceptT p) []) Map.empty) 0 19 | 20 | -- Basic abstract syntax 21 | infixl 9 :% 22 | data Term 23 | = Lam Term Term 24 | | Var Int 25 | | Level Int 26 | | Term :% Term 27 | | U 28 | deriving (Eq, Show) 29 | 30 | -- ======= Evaluation ======= 31 | 32 | -- Check if a variable occures freely in a term 33 | freeIn (Var x) n = x == n 34 | freeIn (d :% d1) n = freeIn d n || freeIn d1 n 35 | freeIn (Lam t tp) n = freeIn t n || freeIn tp (1 + n) 36 | freeIn _ n = False 37 | 38 | -- Increment free variables 39 | quote n (Var x) = if x >= n then Var (1 + x) else Var x 40 | quote n (Lam t d) = Lam (quote n t) (quote (1 + n) d) 41 | quote n (d :% b) = quote n d :% quote n b 42 | quote n x = x 43 | 44 | sub s n (Var x) = 45 | case x `compare` n of 46 | GT -> Var (x - 1) 47 | EQ -> s 48 | LT -> Var x 49 | sub s n (Lam t d) = Lam (sub s n t) (sub (quote 0 s) (1 + n) d) 50 | sub s n (d :% b) = sub s n d :% sub s n b 51 | sub s n x = x 52 | 53 | -- Reduce a term to weak head normal form. 54 | whnf' :: Bool -> Term -> Proof Term 55 | whnf' names ee = spine ee [] where 56 | spine :: Term -> [Term] -> Proof Term 57 | spine (f :% a) as = spine f (a:as) 58 | spine (Lam t z) (u:as) = spine (sub u 0 z) as 59 | -- Eta conversion 60 | spine (Lam t (tp :% Var 0)) [] = 61 | if freeIn tp 0 62 | then return (Lam t (tp :% Var 0)) 63 | else spine (sub (Var 0) 0 tp) [] 64 | spine (Level i) as = 65 | if names -- Should names/levels be removed 66 | then do 67 | tbl <- get 68 | case Map.lookup i tbl of 69 | Nothing -> throwError $ "Level " ++ show i ++ " not found in context (whnf)." 70 | Just t -> spine (fst t) as 71 | else app (Level i) as 72 | spine f as = app f as 73 | app f as = return $ foldl (:%) f as 74 | 75 | whnf = whnf' False 76 | nwhnf = whnf' True 77 | 78 | -- Normal Form 79 | nf' :: Term -> Proof Term 80 | nf' ee = spine ee [] where 81 | spine (f :% a) as = spine f (a:as) 82 | -- Eta conversion 83 | spine (Lam t (tp :% Var 0)) [] = 84 | if freeIn tp 0 85 | then Lam <$> nf' t <*> nf' (tp :% Var 0) 86 | else spine (sub (Var 0) 0 tp) [] 87 | spine (Lam t e) [] = Lam <$> nf' t <*> nf' e 88 | spine (Lam t e) (u:as) = spine (sub u 0 e) as 89 | spine (Level i) as = do 90 | tbl <- get 91 | case Map.lookup i tbl of 92 | Nothing -> throwError $ "Level " ++ show i ++ " not found in context." 93 | Just t -> spine (fst t) as 94 | spine f as = foldl (:%) f <$> mapM nf' as 95 | 96 | nf d = do 97 | r <- nf' d 98 | if d == r 99 | then return r 100 | else nf r 101 | 102 | -- ======= Type Checking ======= 103 | 104 | infer :: Term -> Proof Term 105 | infer t = do 106 | wt <- whnf t 107 | case wt of 108 | Level i -> do 109 | tbl <- get 110 | case Map.lookup i tbl of 111 | Nothing -> throwError $ "Level " ++ show i ++ " not found in context durring type inference." 112 | Just t -> return $ snd t 113 | Var n -> do 114 | ctx <- ask 115 | case (ctx , n) of 116 | ([], _) -> throwError $ "Cannot infer term variable in empty context." 117 | (x:g, 0) -> local tail $ do 118 | check x U 119 | return (quote 0 x) 120 | (_:g, n) -> local tail $ do 121 | ty <- infer (Var (n - 1)) 122 | return (quote 0 ty) 123 | tr1 :% tr2 -> do 124 | ty1' <- infer tr1 125 | ty1 <- nwhnf ty1' 126 | case ty1 of 127 | Lam tp1 tp2 -> do 128 | check tr2 tp1 129 | return (sub tr2 0 tp2) 130 | Lam ty1 ty2 -> do 131 | check ty1 U 132 | local (ty1:) $ do 133 | check ty2 U 134 | return U 135 | U -> return U 136 | 137 | check :: Term -> Term -> Proof () 138 | check tr ty = 139 | case tr of 140 | Level i -> do 141 | tbl <- get 142 | case Map.lookup i tbl of 143 | Nothing -> throwError $ "Level " ++ show i ++ " not found in context durring type checking." 144 | Just (_, t) -> do 145 | tnf <- nf t 146 | tynf <- nf ty 147 | if tnf == tynf 148 | then return () 149 | else throwError $ "Type didn't match durring lookup." 150 | Var n -> do 151 | ctx <- ask 152 | case (ctx , n) of 153 | ([], _) -> throwError $ "Cannot check type of variable term in an empty context." 154 | (x:g, 0) -> do 155 | xnf <- nf (quote 0 x) 156 | tynf <- nf ty 157 | if tynf == xnf 158 | then do 159 | check ty U 160 | local tail $ check x U 161 | else throwError $ "Term does not have correct type." 162 | (_:g, _) -> local tail $ check (Var (n - 1)) (sub (Var 0) 0 ty) 163 | Lam aty tr' -> do 164 | tyw <- nwhnf ty 165 | case tyw of 166 | Lam ty1 ty2 -> do 167 | ty1nf <- nf ty1 168 | atynf <- nf aty 169 | if ty1nf == atynf 170 | then local (ty1:) $ check tr' ty2 171 | else throwError $ "Type of lam annotation didn't match type annotation." 172 | U -> do 173 | check aty U 174 | local (aty:) $ check tr' U 175 | _ -> throwError $ "Lambdas can only be Lam or * types." 176 | tr1 :% tr2 -> do 177 | ity <- infer (tr1 :% tr2) 178 | tynf <- nf ty 179 | itynf <- nf ity 180 | if tynf == itynf 181 | then check ty U 182 | else throwError $ "Failed to unify at application." 183 | U -> do 184 | tyw <- nwhnf ty 185 | case tyw of 186 | U -> return () 187 | _ -> throwError $ "* can only have type *." 188 | 189 | -- ======= Concrete Syntax ======= 190 | 191 | -- Parse a string of 1s and 0s into a collection of terms 192 | data Token 193 | = PLam 194 | | PVar Int 195 | | PLevel Int 196 | | PApp 197 | | PU 198 | 199 | parse :: String -> [Token] -> [Term] -> [Term] 200 | -- Tokenize 201 | parse e@('1':_) p [] = let (i, s) = readInt e in parse s (PVar (i-1):p) [] 202 | parse ('0':'0':s) p [] = parse s (PApp:p) [] 203 | parse ('0':'1':'0':s) p [] = parse s (PLam:p) [] 204 | parse ('0':'1':'1':s) p [] = case readInt s of 205 | (0, s') -> parse s' (PU:p) [] 206 | (i, s') -> parse s' (PLevel (i-1):p) [] 207 | -- Build ASTs 208 | parse [] (PLam:p) (a:b:stk) = parse [] p (Lam a b:stk) 209 | parse [] (PU:p) stk = parse [] p (U:stk) 210 | parse [] (PApp:p) (a:b:stk) = parse [] p ((a :% b):stk) 211 | parse [] (PVar i:p) stk = parse [] p (Var i:stk) 212 | parse [] (PLevel i:p) stk = parse [] p (Level i:stk) 213 | -- Finish 214 | parse [] [] t = t 215 | 216 | readInt :: String -> (Int, String) 217 | readInt ('1':s) = let (i, s') = readInt s in (i+1, s') 218 | readInt ('0':s) = (0,s) 219 | 220 | toBin :: Term -> String 221 | toBin (Lam a b) = "010" ++ toBin a ++ toBin b 222 | toBin (a :% b) = "00" ++ toBin a ++ toBin b 223 | toBin (Var i) = numToBin i 224 | toBin (Level i) = "011" ++ numToBin i 225 | toBin U = "0110" 226 | 227 | numToBin :: Int -> String 228 | numToBin 0 = "10" 229 | numToBin i = '1' : numToBin (i-1) 230 | 231 | output :: Proof a -> String 232 | output p = case runState (runStateT (runReaderT (runExceptT p) []) Map.empty) 0 of 233 | ((_, mp'), lvl) -> case toBin <$> fst <$> Map.lookup (lvl-1) mp' of 234 | Just s -> s 235 | Nothing -> "" 236 | 237 | checkProg :: String -> Proof () 238 | checkProg s = go (parse s [] []) where 239 | go :: [Term] -> Proof () 240 | go (ty:tr:ctx) = do 241 | check tr ty 242 | lvl <- lift $ lift $ lift $ get 243 | tbl <- get 244 | modify $ Map.insert lvl (tr, ty) 245 | lift $ lift $ lift $ modify (+1) 246 | go ctx 247 | go (_:[]) = throwError $ "Type is given without implementation." 248 | go [] = return () 249 | 250 | -- ======= Input / Output ======= 251 | 252 | extention = ".dblc" 253 | 254 | endQ :: String -> Bool 255 | endQ s = extention == reverse (take (length extention) (reverse s)) 256 | 257 | proveFile :: String -> IO () 258 | proveFile f | endQ f = do 259 | fileContents <- readFile f 260 | let res = checkProg fileContents 261 | case runProof res of 262 | Right () -> do putStrLn "Checking Successful!" 263 | putStrLn $ output res 264 | Left e -> putStrLn e 265 | | otherwise = proveFile (f ++ extention) 266 | 267 | -- Main program 268 | main :: IO () 269 | main = do 270 | hSetBuffering stdout NoBuffering 271 | args <- getArgs 272 | case args of 273 | name:_ -> proveFile name 274 | _ -> putStrLn "No file provided." 275 | 276 | 277 | --------------------------------------------------------------------------------