Skip to content

Instantly share code, notes, and snippets.

@lotz84
Last active February 20, 2021 17:07
Show Gist options
  • Save lotz84/9d6a7926d6b1c9fff6729f615eb86f2b to your computer and use it in GitHub Desktop.
Save lotz84/9d6a7926d6b1c9fff6729f615eb86f2b to your computer and use it in GitHub Desktop.
Haskell Type-level Mini Interpreter
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
import Data.Type.Bool (If)
import Data.Type.Equality (type (==))
import GHC.TypeLits
import Data.Symbol.Ascii
type family Reverse (xs :: [k]) :: [k] where
Reverse xs = Reverse1 '[] xs
type family Reverse1 (reversed :: [k]) (xs :: [k]) where
Reverse1 reversed '[] = reversed
Reverse1 reversed (x ': xs) = Reverse1 (x ': reversed) xs
type family Tokenize (sym :: Symbol) :: [Symbol] where
Tokenize sym = Tokenize1 '[] "" (ToList sym)
type family Tokenize1 (tokens :: [Symbol]) (digits :: Symbol) (syms :: [Symbol]) :: [Symbol] where
Tokenize1 tokens digits '[] = Reverse (If (digits == "") tokens (digits ': tokens))
Tokenize1 tokens digits (" " ': syms) = Tokenize1 (If (digits == "") tokens (digits ': tokens)) "" syms
Tokenize1 tokens digits ("+" ': syms) = Tokenize1 (If (digits == "") ("+" ': tokens) ("+" ': digits ': tokens)) "" syms
Tokenize1 tokens digits ("*" ': syms) = Tokenize1 (If (digits == "") ("*" ': tokens) ("*" ': digits ': tokens)) "" syms
Tokenize1 tokens digits ("(" ': syms) = Tokenize1 (If (digits == "") ("(" ': tokens) ("(" ': digits ': tokens)) "" syms
Tokenize1 tokens digits (")" ': syms) = Tokenize1 (If (digits == "") (")" ': tokens) (")" ': digits ': tokens)) "" syms
Tokenize1 tokens digits (sym ': syms) = Tokenize1 tokens (AppendSymbol digits sym) syms
type family EvalRPN (syms :: [Symbol]) :: Nat where
EvalRPN syms = EvalRPN1 '[] syms
type family EvalRPN1 (stack :: [Nat]) (syms :: [Symbol]) :: Nat where
EvalRPN1 (x ': stack) '[] = x
EvalRPN1 (x ': y ': stack) ("+" ': syms) = EvalRPN1 (x + y ': stack) syms
EvalRPN1 (x ': y ': stack) ("*" ': syms) = EvalRPN1 (x * y ': stack) syms
EvalRPN1 stack (sym ': syms) = EvalRPN1 (ReadNat sym ': stack) syms
type family ShuntingYard (xs :: [Symbol]) :: [Symbol] where
ShuntingYard xs = ShuntingYard1 '[] '[] xs
type family ShuntingYard1 (output :: [Symbol]) (operators :: [Symbol]) (input :: [Symbol]) :: [Symbol] where
ShuntingYard1 output '[] '[] = Reverse output
ShuntingYard1 output (sym ': operators) '[] = ShuntingYard1 (sym ': output) operators '[]
ShuntingYard1 output ("*" ': operators) ("+" ': input) = ShuntingYard1 ("*" ': output) operators ("+" ': input)
ShuntingYard1 output ("+" ': operators) ("+" ': input) = ShuntingYard1 ("+" ': output) operators ("+" ': input)
ShuntingYard1 output operators ("+" ': input) = ShuntingYard1 output ("+" ': operators) input
ShuntingYard1 output operators ("*" ': input) = ShuntingYard1 output ("*" ': operators) input
ShuntingYard1 output operators ("(" ': input) = ShuntingYard1 output ("(" ': operators) input
ShuntingYard1 output ("(" ': operators) (")" ': input) = ShuntingYard1 output operators input
ShuntingYard1 output (sym ': operators) (")" ': input) = ShuntingYard1 (sym ': output) operators (")" ': input)
ShuntingYard1 output operators (sym ': input) = ShuntingYard1 (sym ': output) operators input
type Calc xs = EvalRPN (ShuntingYard (Tokenize xs))
@lotz84
Copy link
Author

lotz84 commented Feb 20, 2021

> :kind! Calc "(1 + 20) * 300"
Calc "(1 + 20) * 300" :: Nat
= 6300

> :kind! Calc "(1 + 1) * (2 + 0) + 10"
Calc "(1 + 1) * (2 + 0) + 10" :: Nat
= 14

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment