compile.purs

module Main where

import qualified Prelude as P
import Debug.Trace

class Arithmetic lang where
  (+) :: lang Number -> lang Number -> lang Number
  (-) :: lang Number -> lang Number -> lang Number
  (*) :: lang Number -> lang Number -> lang Number
  (/) :: lang Number -> lang Number -> lang Number
  (<) :: lang Number -> lang Number -> lang Boolean
  (<=) :: lang Number -> lang Number -> lang Boolean
  (>) :: lang Number -> lang Number -> lang Boolean
  (>=) :: lang Number -> lang Number -> lang Boolean
  
class Logic lang where
  (&&) :: lang Boolean -> lang Boolean -> lang Boolean 
  (||) :: lang Boolean -> lang Boolean -> lang Boolean 
  ite :: forall a. lang Boolean -> lang a -> lang a -> lang a
  
class Literal lang where
  string :: String -> lang String
  
class Var lang where
  lam :: forall a b. (lang a -> lang b) -> lang (a -> b)
  app :: forall a b. lang (a -> b) -> lang a -> lang b
  
data Compiled a = Compiled (Number -> String)
  
instance literals :: Literal Compiled where
  string s = Compiled (\_ -> P.show s)
  
binOp :: forall a b c. String -> Compiled a -> Compiled b -> Compiled c
binOp op l r = Compiled \n -> "(" P.<> compile l n P.<> ") " P.<> op P.<> " (" P.<> compile r n P.<> ")"
  
instance arithmetic :: Arithmetic Compiled where
  (+) = binOp "+"
  (-) = binOp "-"
  (*) = binOp "*"
  (/) = binOp "/"
  (<) = binOp "<"
  (<=) = binOp "<="
  (>) = binOp ">"
  (>=) = binOp ">="
  
instance logic :: Logic Compiled where
  (&&) = binOp "&&"
  (||) = binOp "||"
  ite b t f = Compiled \n -> compile b n P.<> " ? " P.<> 
                             compile t n P.<> " : " P.<> 
                             compile f n

instance vars :: Var Compiled where
  lam f = Compiled \n -> let name = "v" P.<> P.show n in
                         "function(" P.<> name P.<>
                         ") { return " P.<> 
                         compile (f (Compiled (\_ -> name))) (n P.+ 1)
                         P.<> "; \n}"
  app = binOp ""

compile :: forall a. Compiled a -> Number -> String
compile (Compiled f) = f

main = trace (compile (lam \x -> lam \y -> lam \z -> ite (x < y) y z) 0)