Axel.axel

(pragma "OPTIONS_GHC -Wno-incomplete-patterns")

(module Axel)

(import Axel.Prelude all)
(import Axel.Parse [hygenisizeIdentifier])
(importq Axel.Sourcemap SM all)
(import Axel.Utils.FilePath [takeFileName])
(import Data.IORef [IORef modifyIORef newIORef readIORef])
(importq Data.Text T all)
(import System.IO.Unsafe [unsafePerformIO])

(=macro applyInfix [op x] (pure [`(flip ~op ~x)]))

(=macro applyInfix [x op y] (pure [`(~op ~x ~y)]))

(=macro defmacro {name : cases}
        (pure (map (\ [(AST.SExpression _ {args : body})]
                      `(=macro ~name ~args ~@body)) cases)))

(defmacro def
          ({name : {typeSig : cases}}
           (pure
            (:
             `(:: ~name ~@typeSig)
             (map
              (\
               [(AST.SExpression
                 _
                 {(AST.SExpression _ {(AST.Symbol _ "list") : args}) : xs})]
               `(= (~name ~@args) ~@xs))
              cases)))))

(def if ([] {Bool -> {a -> {a -> a}}})
     ([True x _] x) ([False _ x] x))

(=macro syntaxQuote [x]
        (pure
         [(AST.quoteExpression (const (AST.Symbol Nothing "_")) x)]))

(def expandDo ([] {([] SM.Expression) -> SM.Expression})
     ([{(AST.SExpression _ [(syntaxQuote <-) var val]) : rest}]
      `(>>= ~val (\ [~var] ~(expandDo rest))))
     ([{(AST.SExpression _ {(syntaxQuote let) : bindings}) : rest}]
      `(let [~@bindings] ~(expandDo rest)))
     ([{val : rest}]
      (case rest ([] val) (_ `(>> ~val ~(expandDo rest))))))

(defmacro do (input (pure [(expandDo input)])))

(:: gensymCounter [] (IORef Int))

(= gensymCounter (unsafePerformIO (newIORef 0)))

(pragma "NOINLINE gensymCounter")

(:: gensym [] (IO SM.Expression))

(= gensym (do
           (<- suffix (readIORef gensymCounter))
           (let (identifier
                 {"aXEL_AUTOGENERATED_IDENTIFIER_" <> (showText suffix)}))
           (modifyIORef gensymCounter succ)
           (pure (AST.Symbol Nothing (T.unpack identifier)))))

(=macro \case cases
        (fmap (\ [varId] [`(\ [~varId] (case ~varId ~@cases))])
              gensym))

(=macro | cases
        (pure
         [(foldr
           (\ [(AST.SExpression _ [cond x]) acc] `(if ~cond ~x ~acc))
           'undefined
           cases)]))

(:: isPrelude [] {FilePath -> Bool})

(= isPrelude {(== (FilePath "Axel.axel")) . takeFileName})

(:: preludeMacros [] ([] Text))

(= preludeMacros (map {T.pack . hygenisizeIdentifier} ["|"
                                                       "applyInfix"
                                                       "defmacro"
                                                       "def"
                                                       "do"
                                                       "\\case"
                                                       "syntaxQuote"]))