axel-0.0.5: examples/doNotation.axel

(importq Axel.Parse.AST AST all)

-- NOTE This will eventually be automatically defined by the Axel prelude.
(macro quasiquote ([(AST.SExpression xs)])
       (let ((quasiquoteElem (\ (x) (case x
                                      ((AST.SExpression ['unquote x])
                                       (AST.SExpression ['list x]))
                                      ((AST.SExpression ['unquoteSplicing x])
                                       (AST.SExpression ['AST.toExpressionList x]))
                                      (atom
                                       (AST.SExpression
                                        ['list
                                         (AST.SExpression ['quasiquote atom])]))))))
         (pure [(AST.SExpression ['AST.SExpression (AST.SExpression ['concat (AST.SExpression (: 'list (map quasiquoteElem xs)))])])])))
(macro quasiquote ([atom])
       (pure [(AST.SExpression ['quote atom])]))

-- NOTE This will eventually be automatically defined by the Axel prelude.
(macro fnCase (cases)
       (<$> (\ (varId)
             [`(\ (~varId) (case ~varId ~@cases))])
            AST.gensym))

-- NOTE This will eventually be automatically defined by the Axel prelude.
(macro def ((: name (: typeSig cases)))
       (pure
        (: `(:: ~name ~typeSig)
           (map (\ (x) `(= ~name ~@x))
                cases))))

(def mdo' (-> (List AST.Expression) AST.Expression)
  (((: var (: '<- (: val rest))))
   `(>>= ~val (\ (~var) ~(mdo' rest))))
  (((: val rest))
   (case rest
     ([]
      val)
     (_
      `(>> ~val ~(mdo' rest))))))

-- NOTE This will eventually be automatically defined by the Axel prelude.
(macro mdo (input)
       (pure [(mdo' input)]))

(def main (IO Unit)
  (()
   (mdo
    line <- getLine
    (putStrLn line)
    (pure unit))))