~technomancy/antifennel

1e3329121ddbd137dd830824796b7dbb72617c77 — Phil Hagelberg 10 months ago dd25809
Don't allow comments to interfere with let-collapsing.
6 files changed, 66 insertions(+), 31 deletions(-)

M Makefile
M README.md
M antifennel_expected.fnl
M letter.fnl
M test.lua
M test_expected.fnl
M Makefile => Makefile +5 -5
@@ 21,7 21,7 @@ antifennel: antifennel.fnl anticompiler.fnl letter.fnl $(PARSER_FENNEL)

test: antifennel self test/fennel.lua
	diff -u antifennel_expected.fnl antifennel.fnl
	@$(LUA) antifennel.lua test.lua > test.fnl
	@$(LUA) antifennel.lua test.lua --comments > test.fnl
	diff -u test_expected.fnl test.fnl
	$(LUA) ./fennel --use-bit-lib --globals "*" test.fnl
	$(LUA) test/init.lua $(TESTS)


@@ 47,16 47,16 @@ update: update-fennel update-tests
# many times your head spins.

test/fennel.lua: fennel.lua anticompiler.fnl
	$(LUA) antifennel.lua fennel.lua > tmp-fennel.fnl
	$(LUA) antifennel.lua fennel.lua --comments > tmp-fennel.fnl
	./fennel --compile tmp-fennel.fnl > $@

antifennel.fnl: antifennel.lua
	$(LUA) antifennel.lua antifennel.lua > antifennel.fnl
antifennel.fnl: antifennel.lua anticompiler.fnl letter.fnl
	$(LUA) antifennel.lua antifennel.lua --comments > antifennel.fnl

self: $(PARSER_FENNEL)

lang/%.fnl: lang/%.lua anticompiler.fnl
	$(LUA) antifennel.lua $< > $@
	$(LUA) antifennel.lua $< --comments > $@

clean: ; rm -f lang/*.fnl antifennel.fnl antifennel


M README.md => README.md +2 -1
@@ 79,7 79,8 @@ assignment in Fennel.

Regular statement-comments are compiled to Fennel comments; multi-line
comments are currently not supported, nor are comments inside tables
and argument lists.
and argument lists. Sometimes comments which should go on the end of
an existing line get placed on their own line.

## Integration


M antifennel_expected.fnl => antifennel_expected.fnl +9 -3
@@ 2,15 2,20 @@

(set debug.traceback fennel.traceback)

;; our lexer was written for luajit; let's add a compatibility shim for PUC

(when (not (pcall require :ffi))
  (set package.loaded.ffi {})
  (set package.loaded.ffi.typeof (fn [] (fn [] (error "requires luajit"))))
  ;; have to use load here since the parser will barf in luajit
  (local ___band___ ((load "return function(a, b) return a & b end")))
  (local ___rshift___ ((load "return function(a, b) return a >> b end")))
  (set _G.bit {:band ___band___ :rshift ___rshift___}))

(if (os.getenv :FNL) (table.insert (or package.loaders package.searchers) 1
                                   fennel.searcher)
(if (os.getenv :FNL) (do
                       ;; prefer Fennel to Lua when both exist
                       (table.insert (or package.loaders package.searchers) 1
                                     fennel.searcher))
    (table.insert (or package.loaders package.searchers) fennel.searcher))

(local lex-setup (require :lang.lexer))


@@ 50,7 55,8 @@
    (letter (compiler nil ast-tree))))

(if (and (and debug debug.getinfo) (= (debug.getinfo 3) nil))
    (let [filename (or (and (= (. arg 1) "-") :/dev/stdin) (. arg 1))]
    (let [;; run as a script
          filename (or (and (= (. arg 1) "-") :/dev/stdin) (. arg 1))]
      (var comments false)
      (each [_ a (ipairs arg)] (when (= a :--comments) (set comments true)))
      (local f (and filename (io.open filename)))

M letter.fnl => letter.fnl +20 -11
@@ 16,21 16,27 @@ When f returns a truthy value, recursively walks the children."
  (walk (or custom-iterator pairs) nil nil root)
  root)

(fn local? [node]
  (and (= :table (type node)) (= :local (tostring (. node 1)))))

(fn locals-to-bindings [node bindings]
  (let [maybe-local (. node 3)]
    (when (and (= :table (type maybe-local))
               (= :local (tostring (. maybe-local 1))))
    (when (or (local? maybe-local)
              (and (fennel.comment? maybe-local)
                   (local? (. node 4))))
      (table.remove node 3)
      (table.insert bindings (. maybe-local 2))
      (table.insert bindings (. maybe-local 3))
      (if (fennel.comment? maybe-local)
          (table.insert bindings maybe-local)
          (do
            (table.insert bindings (. maybe-local 2))
            (table.insert bindings (. maybe-local 3))))
      (locals-to-bindings node bindings))))

(fn move-body [fn-node do-node do-loc]
  (for [i (# fn-node) do-loc -1]
  (for [i (length fn-node) do-loc -1]
    (table.insert do-node 2 (table.remove fn-node i))))

(fn transform-do [node]
  ;; TODO: move initial comment to inside `let`
  (let [bindings []]
    (table.insert node 2 bindings)
    (tset node 1 (fennel.sym :let))


@@ 48,17 54,20 @@ When f returns a truthy value, recursively walks the children."
    (move-body node do-node do-loc)
    (table.insert node do-loc do-node)))

(fn only-before-local? [node i pred]
  (if (local? (. node i)) true
      (pred (. node i)) (only-before-local? node (+ i 1) pred)
      false))

(fn do-local-node? [node]
  (and (= :table (type node)) (= :do (tostring (. node 1)))
       (= :table (type (. node 2))) (= :local (tostring (. node 2 1)))))
       (only-before-local? node 2 fennel.comment?)))

(fn fn-local-node? [node]
  (and (= :table (type node)) (= :fn (tostring (. node 1)))
       (let [first-body (. node (body-start node))]
         (and (= :table (type first-body))
              (= :local (tostring (. first-body 1)))))))
       (only-before-local? node (body-start node) fennel.comment?)))

(fn letter [idx node]
(fn letter [_idx node]
  (when (fn-local-node? node)
    (transform-fn node))
  (when (do-local-node? node)

M test.lua => test.lua +5 -3
@@ 1,4 1,6 @@
local function _()
   -- haha
   local abc = "hi"
   body[#body + 1] = stmt
   scope.symmeta[parts[1]].used = true
   scope.symmeta[1] = true


@@ 33,6 35,7 @@ end
f = 59

do
   -- here
   local boo, twenty = "hoo", 20
   local fifteen = 15
   noprint(boo, twenty+fifteen)


@@ 125,9 128,8 @@ assert (59 >> (2 << 127) == 59)
assert (50 << 2 << 1 == 400)
assert ((50 << 2) << 1 == 400)
assert (50 << (2 << 1) == 800)
-- TODO: re-enable once https://todo.sr.ht/~technomancy/fennel/156 is fixed
-- assert ((~ 1) == -2)
-- assert ((1 + (~ 1)) == -1)
assert ((~ 1) == -2)
assert ((1 + (~ 1)) == -1)
assert (1 | 2 | 3 == 3)
assert (1 | (2 | 3) == 3)
assert (1 | 2 | 3 | 4 == 7)

M test_expected.fnl => test_expected.fnl +25 -8
@@ 1,9 1,11 @@
(fn _ []
  (tset body (+ (length body) 1) stmt)
  (tset (. scope.symmeta (. parts 1)) :used true)
  (tset scope.symmeta 1 true)
  (global foo bar)
  (tset ids k (ast:var_declare (. vlist k))))
  (let [;; haha
        abc :hi]
    (tset body (+ (length body) 1) stmt)
    (tset (. scope.symmeta (. parts 1)) :used true)
    (tset scope.symmeta 1 true)
    (global foo bar)
    (tset ids k (ast:var_declare (. vlist k)))))

(fn noprint [])



@@ 22,14 24,23 @@

(noprint (.. (or base "") "_" append "_"))

(fn f [x y] (var (z zz) (values 9 8)) (local b 99) (set-forcibly! x 5)
(fn f [x y] (var (z zz) (values 9 8)) ;; mutable local, immutable local
  (local b 99)
  ;; immutable local
  (set-forcibly! x 5)
  ;; changing function params
  (set z 0)
  ;; changing mutable local
  (global a 1)
  (set y.y false))
  ;; setting a global
  (set y.y false)
  ;; table setter
  )

(set-forcibly! f 59)

(let [(boo twenty) (values :hoo 20)
(let [;; here
      (boo twenty) (values :hoo 20)
      fifteen 15]
  (noprint boo (+ twenty fifteen)))



@@ 44,6 55,8 @@

(fn bcd [...]
  (let [t {1 :bcd 2 ... :a :value}]
    ;; TODO: this doesn't work.
    ;; assert(t[3] == "three", t[3])
    (when true
      (let [___antifnl_rtn_1___ (letter)
            ___antifnl_rtns_2___ [(f123 :a)]]


@@ 127,6 140,10 @@

(assert (= (lshift 50 (lshift 2 1)) 800))

(assert (= (bnot 1) (- 2)))

(assert (= (+ 1 (bnot 1)) (- 1)))

(assert (= (bor 1 2 3) 3))

(assert (= (bor 1 2 3) 3))