Skip to content
This repository
  • 2 commits
  • 2 files changed
  • 0 comments
  • 1 contributor
43  src/compiler.ls
@@ -45,20 +45,23 @@
45 45
 (defn make-macro
46 46
   "Makes macro"
47 47
   [pattern body]
48  
-  (let [x (gensym)]
49  
-    ;; compile the macro into native code and use the host's native
50  
-    ;; eval to eval it into a function.
51  
-    (eval (compile
52  
-            (macroexpand
53  
-              ; `(fn [~x] (apply (fn ~pattern ~@body) (rest ~x)))
54  
-              (read-from-string
55  
-                "`(fn [~x] (apply (fn ~pattern ~@body) (rest ~x)))"))
56  
-            ))))
  48
+  (let [x (gensym)
  49
+        program (compile
  50
+                  (macroexpand
  51
+                    ; `(fn [~x] (apply (fn ~pattern ~@body) (rest ~x)))
  52
+                    (cons (symbol "fn")
  53
+                      (cons pattern body))))
  54
+        ;; compile the macro into native code and use the host's native
  55
+        ;; eval to eval it into a function.
  56
+        macro (eval (str "(" program ")"))
  57
+        ]
  58
+    (fn [form]
  59
+      (apply macro (list-to-vector (rest form))))))
57 60
 
58 61
 
59 62
 ;; system macros
60 63
 (install-macro
61  
- (symbol "define-macro")
  64
+ (symbol "defmacro")
62 65
  (fn [form]
63 66
    (let [signature (rest form)]
64 67
      (let [name (first signature)
@@ -66,8 +69,7 @@
66 69
            body (rest (rest signature))]
67 70
 
68 71
        ;; install it during expand-time
69  
-       (install-macro name (make-macro pattern body))
70  
-       false))))
  72
+       (install-macro name (make-macro pattern body))))))
71 73
 
72 74
 
73 75
 ;; special forms
@@ -276,7 +278,7 @@
276 278
           id (name op)]
277 279
       (cond
278 280
         (special? op) form
279  
-        (macro? op) (execute-macro op (rest form))
  281
+        (macro? op) (execute-macro op form)
280 282
         (and (symbol? op)
281 283
              (not (identical? id ".")))
282 284
           ;; (.substring s 2 5) => (. s substring 2 5)
@@ -529,6 +531,15 @@
529 531
                   (compile (second form))))    ;; method name
530 532
           (rest (rest form)))))             ;; args
531 533
 
  534
+(defn compile-apply
  535
+  [form]
  536
+  (compile
  537
+    (list (symbol ".")
  538
+          (first form)
  539
+          (symbol "apply")
  540
+          (first form)
  541
+          (second form))))
  542
+
532 543
 (install-special (symbol "set!") compile-set)
533 544
 (install-special (symbol "def") compile-def)
534 545
 (install-special (symbol "if") compile-if-else)
@@ -539,6 +550,7 @@
539 550
 (install-special (symbol "vector") compile-vector)
540 551
 (install-special (symbol "try") compile-try)
541 552
 (install-special (symbol ".") compile-method-invoke)
  553
+(install-special (symbol "apply") compile-apply)
542 554
 (install-special (symbol "::compile:invoke") compile-fn-invoke)
543 555
 
544 556
 
@@ -554,7 +566,10 @@
554 566
   (fn [form] (name (compile-reference (first form)))))
555 567
 
556 568
 (install-special (symbol "::compile:symbol")
557  
-  (fn [form] (str "\"" "\uFEFF" (name (first form)) "\"")))
  569
+  (fn [form]
  570
+    (compile
  571
+      (list (symbol "symbol") (name (first form))))))
  572
+  ;(fn [form] (str "\"" "\uFEFF" (name (first form)) "\"")))
558 573
 
559 574
 (install-special (symbol "::compile:nil")
560 575
   (fn [form] "void 0"))
4  test/compiler.ls
@@ -153,8 +153,8 @@
153 153
     (assert (identical? (transpile "(set! **macros** [])")
154 154
             "__macros__ = []")
155 155
             "**macros** => __macros__")
156  
-    (assert (identical? (transpile "(fn vector->list [v] (apply list v))")
157  
-            "function vectorToList(v) {\n  return apply(list, v);\n}")
  156
+    (assert (identical? (transpile "(fn vector->list [v] (make list v))")
  157
+            "function vectorToList(v) {\n  return make(list, v);\n}")
158 158
             "list->vector => listToVector")
159 159
     (assert (identical? (transpile "(swap! foo bar)")
160 160
             "swap(foo, bar)")

No commit comments for this range

Something went wrong with that request. Please try again.