aboutsummaryrefslogtreecommitdiff
path: root/source/lux/meta/macro.lux
blob: 22aeaf874edf0934e3c237961f56909ddf4abc6b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
##   Copyright (c) Eduardo Julian. All rights reserved.
##   The use and distribution terms for this software are covered by the
##   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
##   which can be found in the file epl-v10.html at the root of this distribution.
##   By using this software in any fashion, you are agreeing to be bound by
##   the terms of this license.
##   You must not remove this notice, or any other, from this software.

(;import lux)

## [Utils]
(def (_meta x)
  (-> (Syntax' (Meta Cursor)) Syntax)
  (#;Meta [["" -1 -1] x]))

## [Syntax]
(def #export (defmacro tokens state)
  Macro
  (case tokens
    (#;Cons [(#;Meta [_ (#;FormS (#;Cons [name args]))]) (#;Cons [body #;Nil])])
    (#;Right [state (#;Cons [(` ((~ (_meta (#;SymbolS ["lux" "def"]))) ((~ name) (~@ args))
                                 (~ (_meta (#;SymbolS ["lux" "Macro"])))
                                 (~ body)))
                             (#;Cons [(` ((~ (_meta (#;SymbolS ["" "_lux_declare-macro"]))) (~ name)))
                                      #;Nil])])])

    (#;Cons [(#;Meta [_ (#;TagS ["" "export"])]) (#;Cons [(#;Meta [_ (#;FormS (#;Cons [name args]))]) (#;Cons [body #;Nil])])])
    (#;Right [state (#;Cons [(` ((~ (_meta (#;SymbolS ["lux" "def"]))) (~ (_meta (#;TagS ["" "export"]))) ((~ name) (~@ args))
                                 (~ (_meta (#;SymbolS ["lux" "Macro"])))
                                 (~ body)))
                             (#;Cons [(` ((~ (_meta (#;SymbolS ["" "_lux_declare-macro"]))) (~ name)))
                                      #;Nil])])])

    _
    (#;Left "Wrong syntax for defmacro")))
(_lux_declare-macro defmacro)

## [Functions]
(do-template [<name> <type> <tag>]
  [(def #export (<name> x)
     (-> <type> Syntax)
     (#;Meta [["" -1 -1] (<tag> x)]))]
  
  [bool$   Bool                     #;BoolS]
  [int$    Int                      #;IntS]
  [real$   Real                     #;RealS]
  [char$   Char                     #;CharS]
  [text$   Text                     #;TextS]
  [symbol$ Ident                    #;SymbolS]
  [tag$    Ident                    #;TagS]
  [form$   (List Syntax)            #;FormS]
  [tuple$  (List Syntax)            #;TupleS]
  [record$ (List (, Syntax Syntax)) #;RecordS]
  )