Skip to content
Browse files

Merge branch 'replace-ivs-with-iform' into iform

* replace-ivs-with-iform: (41 commits)
  Refine the document for IForm/IVS migration
  Replace make-local-ctx with make-local-ctx~
  Replace make-func-ctx with make-func-ctx~
  Move misc. API to a more proper module
  Remove unused API: rename-local-bindings
  Remove IVS
  ! $CALL -> / Built-in ->: Fix IForm usage
  ! Constants: Use IForm
  ! Implicit function calls: Use IForm
  ! defstmt shorthands: Use IForm
  ! Built-in set!: Use IForm
  ! Built-in function: Use IForm
  ! Built-in for: Use IForm
  ! Built-in let, let*: Use IForm
  ! Variable references: Use IForm
  Built-in cond: Use IForm
  Built-in if (expr): Use IForm
  Built-in comparison operators: Use IForm
  Built-in or, and, +, -, .., *, /, %: Use IForm
  Built-in while: Use IForm
  ...
  • Loading branch information...
2 parents b5b606a + 76c7936 commit 078d44b0fdefdc892cd7d245cd4ffe33d4552079 @kana committed
Showing with 504 additions and 789 deletions.
  1. +0 −1 Makefile.in
  2. +66 −63 README.asciidoc
  3. +18 −0 t/compiler-pass-final.t
  4. +30 −97 t/compiler.t
  5. +49 −6 t/context.t
  6. +1 −42 t/iform.t
  7. +0 −116 t/ivs.t
  8. +36 −64 t/macro.t
  9. +42 −0 t/util.t
  10. +0 −1 vim/xire.scm
  11. +132 −206 vim/xire/builtin.scm
  12. +25 −31 vim/xire/compiler.scm
  13. +3 −1 vim/xire/compiler/pass-final.scm
  14. +0 −50 vim/xire/iform.scm
  15. +0 −97 vim/xire/ivs.scm
  16. +102 −14 vim/xire/util.scm
View
1 Makefile.in
@@ -37,7 +37,6 @@ SCMFILES = $(srcdir)/vim/xire.scm \
$(srcdir)/vim/xire/compiler/pass-1.scm \
$(srcdir)/vim/xire/compiler/pass-final.scm \
$(srcdir)/vim/xire/iform.scm \
- $(srcdir)/vim/xire/ivs.scm \
$(srcdir)/vim/xire/util.scm
HEADERS =
View
129 README.asciidoc
@@ -132,16 +132,10 @@ expanded into `:if` statement in Vim script can be defined as follows:
[[example_if]]
----
(defstmt if
- [(_ $cond:expr $then:stmt)
- (IVS (S 'if $cond)
- $then
- (S 'endif))]
+ [(_ $cond:qexpr $then:qstmt)
+ `(if ,$cond ,$then (begin))]
[(_ $cond:expr $then:stmt $else:stmt)
- (IVS (S 'if $cond)
- $then
- (S 'else)
- $else
- (S 'endif))])
+ ($if $cond $then $else)])
----
Macros consist of one or more *clauses*. Macro definitions are mostly
@@ -258,7 +252,7 @@ For example, suppose that the form `(if c t e)` is expanded with
-[[ivs]]
+[[iform]]
Intermediate format of Vim script
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -268,68 +262,76 @@ that Xire script is compiled into code in *an intermediate format* of
Vim script, then resulting code in the intermediate format is finally
compiled into Vim script.
-The intermediate format is called *IVS*.
-IVS is written in S expression, and IVS is a list of *nodes*.
-The details of IVS are as follows:
+The intermediate format is called *IForm*.
+An IForm object represents a statement or an expression.
+There are the following functions to create an IForm object:
+FIXME: Add details about naming convensions.
+See `vim.xire.compiler-pass1` at the moment.
-==== Node
-A node expresses a logical part of Vim script.
-The following functions are available to create a node:
+==== Statements
-`(S node-or-atom ...)`::
- Creates a node to express a statement in Vim script.
- For example, `(S 'help 42)` creates a node which corresponds to
- `:help 42` in Vim script.
+`($def gvar expr)`::
+ Represents a statement to define a global variable.
-`(E node-or-atom ...)`::
- Creates a node to express an expression in Vim script.
- For example, `(E Answer (Q "(") (E 42) (Q ")"))` creates a node which
- corresponds to `Answer(42)` in Vim script.
+`($gset gvar expr)`::
+ Represents a statement to modify a global variable.
-`(Q atom ...)`::
- Creates a node to express tokens in Vim script.
- Unlike other functions,
- `Q` is to embed ++atom++s into resulting Vim script.
- Therefore ++atom++s are not converted
- and they are ++display++ed into resulting Vim script.
+`($let lvars stmt)`::
+ Represents a statement to define local variables.
+`($lset lvar expr)`::
+ Represents a statement to modify a local variable.
+`($begin stmts)`::
+ Groups zero or more statements as a single statement.
-==== Atom
+`($if expr then-stmt else-stmt)`::
+ Equivalent to `:if`.
-An atom is roughly corresponding to a "token" in Vim script.
-For example, numbers, strings, variable names and so on.
-Available atoms are as follows:
+`($while expr stmt)`::
+ Equivalent to `:while`.
-`<boolean>` objects::
- Correspond to boolean values in Vim script.
+`($for lvar expr stmt)`::
+ Roughly equivalent to `:for`.
-`<number>` objects::
- Correspond to number values in Vim script. Only
- exact integers are valid. It is an error to use inexact numbers and
- non-integer numbers such as real numbers, though real numbers should
- be supported later. Note that numbers in Vim script are limited in
- a range, and the range depends on how Vim executable is compiled.
- So that Xire does not check whether a given number is also valid as
- Vim script or not.
+`($break)`::
+ Equivalent to `:break`.
-`<regexp>` objects::
- Correspond to equivalent string values in Vim script (because
- there is no literal notation for regular expressions in Vim script).
+`($next)`::
+ Equivalent to `:continue`.
-`<string>` objects::
- Correspond to string values in Vim script. See also
- <<_conventions_of_string_values, conventions of string values>>.
+`($ret expr)`::
+ Equivalent to `:return`.
-`<symbol>` objects::
- Correspond to Ex command names (such as `:map`), variable names
- (such as `v:servername`), and other keywords in Vim script. When
- Vim script is generated from IVS, the names of symbols are
- normalized, then <<_normalization_of_variable_names,normalized
- names>> are embedded into resulting Vim script.
+`($func func-name args stmt)`::
+ Roughly equivalent to `:function`.
+
+`($ex obj-or-iforms)`::
+ Represents an arbitrary statement.
+
+
+
+==== Expressions
+
+`($const obj)`::
+ Represents a constant expression.
+ `obj` can be a boolean, a number, a regular expression or a string.
+
+`($gref gvar)`::
+ Represents a global variable reference.
+
+`($lref lvar)`::
+ Represents a global variable reference.
+
+`($call subr-name arg-exprs)`::
+ Represents a compound expression using an operator such as `+`.
+ See also `vim.xire.compiler.pass-final`.
+
+`($call func-expr arg-exprs)`::
+ Represents a function call.
@@ -401,10 +403,10 @@ in Xire script:
While various characters such as `$`, `!` and `%` can be used as
variable names in Scheme, variable names in Vim script must match to
`#/^[A-Za-z_][A-Za-z_0-9]*$/`. So that it is generally an error to use
-such characters for symbols in <<ivs,IVS>>.
+such characters for symbols in <<iform,IForm>>.
But, for convenience, several characters (more precisely, patterns) can
-be used for symbols in IVS.
+be used for symbols in IForm.
[options='header']
|==================================================================
@@ -465,7 +467,7 @@ There are also the following shorthands for `defstmt`:
(defstmt <name>
[(_)
- (IVS (S '<ex-command-name>))]) ; <ex-command-name> must be a symbol.
+ ($ex '(<ex-command-name>))]) ; <ex-command-name> must be a symbol.
@@ -488,7 +490,7 @@ The following Scheme API is available to define advanced Xire macros:
==== `(scheme-object->vim-script-notation x)`
A function which converts a given Scheme object into the corresponding
-Vim script notation. See also <<ivs,IVS>>.
+Vim script notation. See also <<iform,IForm>>.
@@ -504,9 +506,9 @@ according to other arguments:
`manyp`::
A boolean value which specifies the format of `form-or-forms`.
If this value is `#f`, `form-or-forms` is treated as a form,
- and this function returns a resulting Vim script in IVS.
+ and this function returns a resulting Vim script in IForm.
Otherwise, `form-or-forms` is treated as a list of forms,
- and this function returns a list of resulting Vim script in IVS.
+ and this function returns a list of resulting Vim script in IForm.
`type`::
A symbol which specifies the type of `form`. If this value is:
@@ -543,7 +545,8 @@ according to other arguments:
Built-in macros
~~~~~~~~~~~~~~~
-FIXME: Write about details of macros.
+See `vim.xire.builtin` at the moment.
+FIXME: Write about details of built-in macros.
View
18 t/compiler-pass-final.t
@@ -7,6 +7,7 @@
(use text.tree)
(use vim.xire.compiler.pass-final)
(use vim.xire.iform)
+(use vim.xire.util)
@@ -221,6 +222,23 @@
'name)))
raise? <error>) ; Non-iform arguments.
)
+ (it "should generate a valid code from $CALL of the built-in 'kbd'"
+ (expect (gen ($call 'kbd
+ (list "foo")))
+ equal? "\"foo\"")
+ (expect (gen ($call 'kbd
+ (list "\"*p")))
+ equal? "\"\\\"*p\"")
+ (expect (gen ($call 'kbd
+ (list "bar<BS>z")))
+ equal? "\"bar\\<BS>z\"")
+ (expect (gen ($call 'kbd
+ (list 1)))
+ raise? <error>) ; Invalid argument.
+ (expect (gen ($call 'kbd
+ 1))
+ raise? <error>) ; Invalid argument.
+ )
(it "should generate a valid code from $CALL of the built-in 'list'"
(expect (gen ($call 'list
(list)))
View
127 t/compiler.t
@@ -9,6 +9,9 @@
(use util.list)
(use util.match)
(use vim.xire)
+(use vim.xire.compiler.pass-1)
+(use vim.xire.compiler.pass-final)
+(use vim.xire.iform)
@@ -24,9 +27,7 @@
(xire-register-macro!
'macro
(lambda (form ctx)
- (IVS (Q "<")
- (apply Q (intersperse " " form))
- (Q ">")))
+ ($gref (string->symbol (format "<~a>" form))))
'stmt
env)
(it "should output nothing if given script is empty"
@@ -86,13 +87,22 @@
)
)
(it "should handle use of Xire macro"
- (expect (translate "(macro)") equal? "<macro>")
- (expect (translate "(macro use)") equal? "<macro use>")
- (expect (translate "(macro use test)") equal? "<macro use test>")
+ (expect (translate "(macro)") equal? "<(macro)>")
+ (expect (translate "(macro use)") equal? "<(macro use)>")
+ (expect (translate "(macro use test)") equal? "<(macro use test)>")
)
(it "should handle a compiled form"
SKIP "There is no readable external representation of compiled forms."
)
+ (it "should handle a compiled form in IForm"
+ (expect
+ (translate (format "~s" (pass-1 123 expr-ctx)))
+ equal?
+ (with-output-to-string
+ (lambda ()
+ (write-tree
+ (pass-final (list (pass-1 123 expr-ctx)))))))
+ )
)
(describe "xire-compile"
@@ -101,7 +111,7 @@
(parameterize ([xire-env env])
(with-output-to-string
(lambda ()
- (write-tree (xire-compile form ctx))))))
+ (write-tree (pass-final (list (xire-compile form ctx))))))))
(define root-ctx (make-root-ctx))
(define stmt-ctx (make-stmt-ctx root-ctx))
(define expr-ctx (make-expr-ctx root-ctx))
@@ -112,23 +122,23 @@
[(m xs)
`(,m ,xs ())]
[(m () ys)
- (IVS (apply Q `("<" ,@(intersperse " " ys) ">")))]
+ ($gref (string->symbol (format "<~a>" ys)))]
[(m (x . xs) ys)
`(,m ,xs ,(cons x ys))]))
'stmt
env)
(it "should compile Xire macros recursively"
- (expect (compile '(macro ()) stmt-ctx) equal? "<>")
- (expect (compile '(macro (x)) stmt-ctx) equal? "<x>")
- (expect (compile '(macro (x y)) stmt-ctx) equal? "<y x>")
- (expect (compile '(macro (x y z)) stmt-ctx) equal? "<z y x>")
+ (expect (compile '(macro ()) stmt-ctx) equal? "<()>")
+ (expect (compile '(macro (x)) stmt-ctx) equal? "<(x)>")
+ (expect (compile '(macro (x y)) stmt-ctx) equal? "<(y x)>")
+ (expect (compile '(macro (x y z)) stmt-ctx) equal? "<(z y x)>")
)
(it "should compile use of undefined macro in expr-ctx as function call"
(expect (compile '(MyFunc) expr-ctx) equal? "MyFunc()")
(expect (compile '(MyFunc 1 2 3) expr-ctx) equal? "MyFunc(1,2,3)")
)
(it "should return form as is if it is already compiled"
- (define compiled-form (IVS (Q 1 2 3)))
+ (define compiled-form ($const "<1 2 3>"))
(expect (xire-compile compiled-form expr-ctx) eq? compiled-form)
)
(it "should compile a Scheme object in expression context"
@@ -149,10 +159,10 @@
(define stmt-ctx (make-stmt-ctx root-ctx))
(define expr-ctx (make-expr-ctx root-ctx))
(it "should compile an expression in expression context"
- (expect (compile 'foo expr-ctx) equal? "foo")
+ (expect (compile 'foo expr-ctx) equal? (x->string ($gref 'foo)))
)
(it "should compile an expression even if a statement context is given"
- (expect (compile 'foo stmt-ctx) equal? "foo")
+ (expect (compile 'foo stmt-ctx) equal? (x->string ($gref 'foo)))
)
)
@@ -162,14 +172,16 @@
(parameterize ([xire-env env])
(with-output-to-string
(lambda ()
- (write-tree (xire-compile-forms forms ctx))))))
+ (write-tree (map (lambda (result)
+ (pass-final (list result)))
+ (xire-compile-forms forms ctx)))))))
(define root-ctx (make-root-ctx))
(define stmt-ctx (make-stmt-ctx root-ctx))
(define expr-ctx (make-expr-ctx root-ctx))
(xire-register-macro!
'macro
(lambda (form ctx)
- (IVS (apply Q `("<" ,@(intersperse " " form) ">"))))
+ ($gref (string->symbol (format "<~a>" form))))
'stmt
env)
(it "should compile list of forms in expression context"
@@ -178,86 +190,7 @@
(it "should compile list of forms in statement context"
(expect (compile '((macro 1) (macro 2) (macro 3)) stmt-ctx)
equal?
- "<macro 1><macro 2><macro 3>")
- )
- )
-
-(describe "rename-local-bindings"
- (it "should fail if form is not a variable reference"
- (define ctx (make-func-ctx (make-root-ctx) '(a b c)))
- (expect (rename-local-bindings #f ctx) raise? <error>)
- (expect (rename-local-bindings #f ctx) raise? <error>)
- (expect (rename-local-bindings #t ctx) raise? <error>)
- (expect (rename-local-bindings 123 ctx) raise? <error>)
- (expect (rename-local-bindings "foo" ctx) raise? <error>)
- (expect (rename-local-bindings #/bar/ ctx) raise? <error>)
- (expect (rename-local-bindings '(func arg) ctx) raise? <error>)
- )
- (it "should leave form as is if it is not in any local context"
- (define ctx (make-root-ctx))
- (expect (rename-local-bindings 'a ctx) eq? 'a)
- (expect (rename-local-bindings 'b ctx) eq? 'b)
- (expect (rename-local-bindings 'c ctx) eq? 'c)
- (expect (rename-local-bindings 'd ctx) eq? 'd)
- )
- (it "should rename form if it is in a local but not function context"
- (define ctx (make-local-ctx (make-root-ctx) '(x y z)))
- (expect (rename-local-bindings 'x ctx) not eq? 'x)
- (expect (rename-local-bindings 'y ctx) not eq? 'y)
- (expect (rename-local-bindings 'z ctx) not eq? 'z)
- (expect (rename-local-bindings 'g ctx) eq? 'g)
- )
- (it "should rename form if it is a reference to a function parameter"
- (define ctx (make-func-ctx (make-root-ctx) '(a b c ...)))
- (expect (rename-local-bindings 'a ctx) eq? 'a:a)
- (expect (rename-local-bindings 'b ctx) eq? 'a:b)
- (expect (rename-local-bindings 'c ctx) eq? 'a:c)
- (expect (rename-local-bindings '... ctx) eq? 'a:000)
- (expect (rename-local-bindings 'd ctx) eq? 'd)
- )
- (it "should rename form if it is a reference to a function local variable"
- (define ctx (make-local-ctx (make-func-ctx (make-root-ctx) '(a b c))
- '(x y z)))
- (expect (rename-local-bindings 'a ctx) eq? 'a:a)
- (expect (rename-local-bindings 'b ctx) eq? 'a:b)
- (expect (rename-local-bindings 'c ctx) eq? 'a:c)
- (expect (rename-local-bindings 'x ctx) not eq? 'x)
- (expect (rename-local-bindings 'y ctx) not eq? 'y)
- (expect (rename-local-bindings 'z ctx) not eq? 'z)
- (expect (rename-local-bindings 'g ctx) eq? 'g)
- )
- (it "should rename a local variable from outer context if necessary"
- ; (define (_)
- ; ; ctx0
- ; (let ([x 3]
- ; [y 2])
- ; ; ctx1
- ; (let ([x (* x y)])
- ; ; ctx2
- ; ...)))
- (define ctx0 (make-func-ctx (make-root-ctx) '()))
- (define ctx1 (make-local-ctx ctx0 '(x y)))
- (define ctx2 (make-local-ctx ctx1 '(x)))
- (expect (rename-local-bindings 'x ctx0) eq? 'x)
- (expect (rename-local-bindings 'y ctx0) eq? 'y)
- (expect (rename-local-bindings 'x ctx1) not eq? 'x)
- (expect (rename-local-bindings 'y ctx1) not eq? 'y)
- (expect (rename-local-bindings 'x ctx2) not eq? 'x)
- (expect (rename-local-bindings 'y ctx2) not eq? 'y)
- (expect (rename-local-bindings 'x ctx1)
- not eq? (rename-local-bindings 'x ctx2))
- (expect (rename-local-bindings 'y ctx1)
- eq? (rename-local-bindings 'y ctx2))
- )
- (it "should rename a function-local variable with 'L' prefix"
- (define ctx (make-local-ctx (make-func-ctx (make-root-ctx) '()) '(x)))
- (expect (symbol->string (rename-local-bindings 'x ctx)) #/^L\d+$/)
- )
- (it "should rename a script-local variable with 's:__L' prefix"
- (define ctx (make-local-ctx (make-root-ctx) '(x)))
- (expect (script-ctx? ctx) eq? #t)
- (expect (func-ctx? ctx) eq? #f)
- (expect (symbol->string (rename-local-bindings 'x ctx)) #/^s:__L\d+$/)
+ "<(macro 1)><(macro 2)><(macro 3)>")
)
)
View
55 t/context.t
@@ -93,7 +93,23 @@
(expect (ref c1 'in-funcp) eq? #f)
(expect (ref c2 'in-funcp) eq? #t)
(expect (ref c1 'func-args) equal? '())
- (expect (ref c2 'func-args) equal? '(a b c))
+ (expect (ref c2 'func-args)
+ equal?
+ (list (cons 'a
+ (make <lvar>
+ :src-name 'a
+ :new-name 'a:a
+ :arg-name 'a))
+ (cons 'b
+ (make <lvar>
+ :src-name 'b
+ :new-name 'a:b
+ :arg-name 'b))
+ (cons 'c
+ (make <lvar>
+ :src-name 'c
+ :new-name 'a:c
+ :arg-name 'c))))
(check c3 c2)
(expect (ref c2 'in-funcp) eq? (ref c3 'in-funcp))
(expect (ref c2 'func-args) equal? (ref c3 'func-args))
@@ -103,8 +119,19 @@
(describe "make-local-ctx"
(it "should make a local binding context from a given context"
(define c1 (make-stmt-ctx (make-root-ctx)))
- (define c2 (make-local-ctx c1 '(a b c)))
+ (define lvars2 (make-lvars '(a b c)
+ (list ($const "a")
+ ($const "b")
+ ($const "c"))
+ c1))
+ (define c2 (make-local-ctx c1 lvars2))
(define c3 (make-stmt-ctx c2))
+ (define lvars4 (make-lvars '(d e f)
+ (list ($const "d")
+ ($const "e")
+ ($const "f"))
+ c3))
+ (define c4 (make-local-ctx c3 lvars4))
(define (check %c1 %c2)
(define different-slot-names '(locals))
(for-each
@@ -114,12 +141,28 @@
(lambda (slot-name)
(not (memq slot-name different-slot-names)))
(map slot-definition-name (class-direct-slots <xire-ctx>)))))
+ (expect (ref c1 'locals)
+ equal?
+ '())
(check c2 c1)
- (expect (ref c1 'locals) equal? '())
- (expect (map (lambda (p) (cons (car p) '_)) (ref c2 'locals))
- equal? '((a . _) (b . _) (c . _)))
+ (expect (ref c2 'locals)
+ equal?
+ (map (lambda (v)
+ (cons (lvar-src-name v) v))
+ lvars2))
(check c3 c2)
- (expect (ref c2 'locals) equal? (ref c3 'locals))
+ (expect (ref c3 'locals)
+ eq?
+ (ref c2 'locals))
+ (check c4 c3)
+ (expect (ref c4 'locals)
+ not equal?
+ (ref c3 'locals))
+ (expect (ref c4 'locals)
+ equal?
+ (map (lambda (v)
+ (cons (lvar-src-name v) v))
+ (append lvars4 lvars2)))
)
(it "should fail to 'inherit' from non-function and non-script context"
(expect (make-local-ctx (make-root-ctx :in-scriptp #f) '(x))
View
43 t/iform.t
@@ -6,6 +6,7 @@
(use test.gasmine)
(use text.tree)
(use vim.xire.iform)
+(use vim.xire.util)
@@ -19,48 +20,6 @@
-(describe "<lvar>"
- (define (make-a-lvar)
- (make <lvar>
- :src-name 'foo
- :new-name 'bar
- :init-expr ($const #f)))
- (it "should be made with valid initial values"
- (define lvar (make-a-lvar))
- (expect (lvar-src-name lvar) eq? 'foo)
- (expect (lvar-new-name lvar) eq? 'bar)
- (expect (lvar-arg-name lvar) eq? #f)
- (expect (lvar-init-expr lvar) equal? ($const #f))
- (expect (lvar-ref-count lvar) eqv? 0)
- (expect (lvar-set-count lvar) eqv? 0)
- )
- (it "should be counted through API"
- (define lvar (make-a-lvar))
- (begin
- (expect (lvar-ref-count lvar) eqv? 0)
- (expect (lvar-set-count lvar) eqv? 0))
- (begin
- (lvar-ref++! lvar)
- (expect (lvar-ref-count lvar) eqv? 1)
- (expect (lvar-set-count lvar) eqv? 0))
- (begin
- (lvar-set++! lvar)
- (expect (lvar-ref-count lvar) eqv? 1)
- (expect (lvar-set-count lvar) eqv? 1))
- (begin
- (lvar-ref--! lvar)
- (expect (lvar-ref-count lvar) eqv? 0)
- (expect (lvar-set-count lvar) eqv? 1))
- (begin
- (lvar-set--! lvar)
- (expect (lvar-ref-count lvar) eqv? 0)
- (expect (lvar-set-count lvar) eqv? 0))
- )
- )
-
-
-
-
(describe "iform?"
(it "should distinguish a valid iform"
(expect (iform? ($const 0)) eq? #t)
View
116 t/ivs.t
@@ -1,116 +0,0 @@
-#!/usr/bin/env gosh
-
-(add-load-path ".")
-(add-load-path "./gauche-test-gasmine")
-
-(use test.gasmine)
-(use text.tree)
-(use vim.xire.ivs)
-
-
-
-
-(define (translate x)
- (call-with-output-string
- (cut write-tree x <>)))
-
-
-
-
-(describe "Q"
- (it "should be translated its content as is"
- (expect (translate (Q 123 "abc" 'foo->bar #/\<regexp\>/))
- equal?
- "123abcfoo->bar#/\\<regexp\\>/")
- )
- (it "should not be translated properly if it has any non-atom"
- (define x (Q 'x))
- (expect (translate (Q x))
- equal?
- (write-to-string x display))
- )
- (it "should be equal? to other node if both contents are equal?"
- (expect (Q (list 1 2 3))
- equal?
- (Q (list 1 2 3)))
- )
- )
-
-(describe "E"
- (it "should be translated without a trailing newline"
- (expect (translate (E 'scriptnames)) equal? "scriptnames")
- )
- (it "should be translated its content without spaces"
- (expect (translate (E 123 456 789)) equal? "123456789")
- )
- (it "should be translated its content in Vim script notation"
- (expect (translate (E 123)) equal? "123")
- (expect (translate (E "abc")) equal? "\"abc\"")
- (expect (translate (E 'foo->bar)) equal? "foo_to_bar")
- (expect (translate (E #/\<regexp\>/)) equal? "'\\<regexp\\>'")
- )
- (it "should be translated properly if its content is also a node"
- (expect (translate (E 'a? (E 'b?) 'c?)) equal? "a_pb_pc_p")
- )
- (it "should be equal? to other node if both contents are equal?"
- (expect (E (list 1 2 3))
- equal?
- (E (list 1 2 3)))
- )
- )
-
-(describe "S"
- (it "should be translated with a trailing newline"
- (expect (translate (S 'scriptnames)) equal? "scriptnames\n")
- )
- (it "should be translated its content with spaces"
- (expect (translate (S 123 456 789)) equal? "123 456 789\n")
- )
- (it "should be translated its content in Vim script notation"
- (expect (translate (S 123)) equal? "123\n")
- (expect (translate (S "abc")) equal? "\"abc\"\n")
- (expect (translate (S 'foo->bar)) equal? "foo_to_bar\n")
- (expect (translate (S #/\<regexp\>/)) equal? "'\\<regexp\\>'\n")
- )
- (it "should be translated properly if its content is also a node"
- (expect (translate (S 'a? (E 'b?) 'c?)) equal? "a_p b_p c_p\n")
- )
- (it "should be equal? to other node if both contents are equal?"
- (expect (S (list 1 2 3))
- equal?
- (S (list 1 2 3)))
- )
- )
-
-(describe "IVS"
- (it "should be translated without any addition"
- (expect (translate (IVS (S 'if (E #t))
- (S 'echo (E 'then))
- (S 'endif)))
- equal?
- (string-append
- (translate (S 'if (E #t)))
- (translate (S 'echo (E 'then)))
- (translate (S 'endif))))
- )
- (it "should be equal? to other node if both contents are equal?"
- (expect (IVS (Q (list 1 2 3)))
- equal?
- (IVS (Q (list 1 2 3))))
- )
- (it "should accept only IVS objects"
- (expect (IVS (Q)) not raise?)
- (expect (IVS (E)) not raise?)
- (expect (IVS (S)) not raise?)
- (expect (IVS (IVS (S))) not raise?)
- (expect (IVS "non-IVS objects") raise?)
- )
- )
-
-
-
-
-(run-suites)
-
-; __END__
-; vim: filetype=scheme
View
100 t/macro.t
@@ -8,6 +8,7 @@
(use text.tree)
(use util.match)
(use vim.xire)
+(use vim.xire.compiler.pass-final)
@@ -15,7 +16,7 @@
(define (compile form ctx)
(with-output-to-string
(lambda ()
- (write-tree (xire-compile form ctx)))))
+ (write-tree (pass-final (list (xire-compile form ctx)))))))
@@ -115,36 +116,28 @@
(describe "generate-match-body"
(it "should generate body with 0 slots"
(expect (generate-match-body '(syntax clear)
- '((IVS (S 'syntax 'clear))
- (IVS (S 'echo "..."))))
+ '((ex syntax clear)
+ (ex echo "...")))
equal?
'(let ()
- (IVS (S 'syntax 'clear))
- (IVS (S 'echo "..."))))
+ (ex syntax clear)
+ (ex echo "...")))
)
(it "should generate body with 1 or more slots"
(expect (generate-match-body '(if $cond:expr $then:stmt)
- '((IVS (S 'if $cond)
- $then
- (S 'endif))))
+ '(($if $cond $then ($begin '()))))
equal?
'(let ([$cond (transform-value $cond:expr #f 'expr ctx)]
[$then (transform-value $then:stmt #f 'stmt ctx)])
- (IVS (S 'if $cond)
- $then
- (S 'endif))))
+ ($if $cond $then ($begin '()))))
)
(it "should generate body with 1 or more ellipses"
(expect (generate-match-body '(when $cond:expr $then:stmt ...)
- '((IVS (S 'if $cond)
- (apply IVS $then)
- (S 'endif))))
+ '(($if $cond $then ($begin '()))))
equal?
'(let ([$cond (transform-value $cond:expr #f 'expr ctx)]
[$then (transform-value $then:stmt #t 'stmt ctx)])
- (IVS (S 'if $cond)
- (apply IVS $then)
- (S 'endif))))
+ ($if $cond $then ($begin '()))))
)
(it "should generate body with let-like pattern"
(expect (generate-match-body '(my-let ($var:expr $value:stmt) ...)
@@ -163,15 +156,9 @@
'if
'stmt
'[(if $cond:expr $then:stmt)
- (IVS (S 'if $cond)
- $then
- (S 'endif))]
+ ($if $cond $then ($begin '()))]
'[(if $cond:expr $then:stmt $else:stmt)
- (IVS (S 'if $cond)
- $then
- (S 'else)
- $else
- (S 'endif))])
+ ($if $cond $then $else)])
equal?
'(defmacro stmt (if form ctx)
(ensure-stmt-ctx form ctx)
@@ -179,18 +166,12 @@
[('if $cond:expr $then:stmt)
(let ([$cond (transform-value $cond:expr #f 'expr ctx)]
[$then (transform-value $then:stmt #f 'stmt ctx)])
- (IVS (S 'if $cond)
- $then
- (S 'endif)))]
+ ($if $cond $then ($begin '())))]
[('if $cond:expr $then:stmt $else:stmt)
(let ([$cond (transform-value $cond:expr #f 'expr ctx)]
[$then (transform-value $then:stmt #f 'stmt ctx)]
[$else (transform-value $else:stmt #f 'stmt ctx)])
- (IVS (S 'if $cond)
- $then
- (S 'else)
- $else
- (S 'endif)))])))
+ ($if $cond $then $else))])))
)
(it "shouold raise error for invalid context type"
(expect
@@ -198,15 +179,9 @@
'if
'stmttttt
'[(if $cond:expr $then:stmt)
- (IVS (S 'if $cond)
- $then
- (S 'endif))]
+ ($if $cond $then ($begin '()))]
'[(if $cond:expr $then:stmt $else:stmt)
- (IVS (S 'if $cond)
- $then
- (S 'else)
- $else
- (S 'endif))])
+ ($if $cond $then $else)])
raise?)
)
)
@@ -257,13 +232,11 @@
(it "should transform give value into equivalent 'sym'"
(define func-ctx (make-func-ctx (make-root-ctx) '(foo->bar)))
(expect (transform-value 'foo->bar #f 'sym stmt-ctx)
- equal? (xire-compile-expr 'foo->bar stmt-ctx))
+ equal? ($gref 'foo->bar))
(expect (transform-value 'foo->bar #f 'sym expr-ctx)
- equal? (xire-compile-expr 'foo->bar expr-ctx))
+ equal? ($gref 'foo->bar))
(expect (transform-value 'foo->bar #f 'sym func-ctx)
- not equal? (xire-compile-expr 'foo->bar func-ctx))
- (expect (transform-value 'foo->bar #f 'sym func-ctx)
- equal? (xire-compile-expr 'foo->bar expr-ctx))
+ equal? (xire-compile-expr 'foo->bar func-ctx))
)
(it "should raise error for invalid form with 'sym'"
(expect (transform-value '(x) #f 'sym expr-ctx)
@@ -297,13 +270,17 @@
(expect (xire-lookup-macro 'if expr-ctx (xire-env)) eq? #f)
(defexpr if
[(if $cond:expr $then:expr $else:expr)
- (IVS $cond (Q "?") $then (Q ":") $else)])
+ ($const (format "~a?~a:~a" $cond $then $else))])
(expect (xire-lookup-macro 'if stmt-ctx (xire-env)) eq? #f)
(expect (xire-lookup-macro 'if expr-ctx (xire-env)) procedure?)
(expect (compile '(if co-nd th-en el-se) stmt-ctx) raise?)
(expect (compile '(if co-nd th-en el-se) expr-ctx)
equal?
- "co_nd?th_en:el_se")
+ (compile ($const (format "~a?~a:~a"
+ ($gref 'co-nd)
+ ($gref 'th-en)
+ ($gref 'el-se)))
+ expr-ctx))
)
)
)
@@ -321,15 +298,9 @@
(defstmt return)
(defstmt if
[(if $cond:expr $then:stmt)
- (IVS (S 'if $cond)
- $then
- (S 'endif))]
+ ($const (format "~a?~a" $cond $then))]
[(if $cond:expr $then:stmt $else:stmt)
- (IVS (S 'if $cond)
- $then
- (S 'else)
- $else
- (S 'endif))])
+ ($const (format "~a?~a:~a" $cond $then $else))])
(expect (xire-lookup-macro 'if stmt-ctx (xire-env)) procedure?)
(expect (xire-lookup-macro 'if expr-ctx (xire-env)) eq? #f)
(expect (compile '(break) stmt-ctx) equal? "break\n")
@@ -337,16 +308,17 @@
(expect (compile '(if 3) expr-ctx) equal? "if(3)")
(expect (compile '(if co-nd (break)) stmt-ctx)
equal?
- (lines "if co_nd"
- "break"
- "endif"))
+ (compile ($const (format "~a?~a"
+ ($gref 'co-nd)
+ ($ex '(break))))
+ stmt-ctx))
(expect (compile '(if co-nd (break) (return)) stmt-ctx)
equal?
- (lines "if co_nd"
- "break"
- "else"
- "return"
- "endif"))
+ (compile ($const (format "~a?~a:~a"
+ ($gref 'co-nd)
+ ($ex '(break))
+ ($ex '(return))))
+ stmt-ctx))
)
)
)
View
42 t/util.t
@@ -102,6 +102,48 @@
+(describe "<lvar>"
+ (define (make-a-lvar)
+ (make <lvar>
+ :src-name 'foo
+ :new-name 'bar
+ :init-expr '($const #f)))
+ (it "should be made with valid initial values"
+ (define lvar (make-a-lvar))
+ (expect (lvar-src-name lvar) eq? 'foo)
+ (expect (lvar-new-name lvar) eq? 'bar)
+ (expect (lvar-arg-name lvar) eq? #f)
+ (expect (lvar-init-expr lvar) equal? '($const #f))
+ (expect (lvar-ref-count lvar) eqv? 0)
+ (expect (lvar-set-count lvar) eqv? 0)
+ )
+ (it "should be counted through API"
+ (define lvar (make-a-lvar))
+ (begin
+ (expect (lvar-ref-count lvar) eqv? 0)
+ (expect (lvar-set-count lvar) eqv? 0))
+ (begin
+ (lvar-ref++! lvar)
+ (expect (lvar-ref-count lvar) eqv? 1)
+ (expect (lvar-set-count lvar) eqv? 0))
+ (begin
+ (lvar-set++! lvar)
+ (expect (lvar-ref-count lvar) eqv? 1)
+ (expect (lvar-set-count lvar) eqv? 1))
+ (begin
+ (lvar-ref--! lvar)
+ (expect (lvar-ref-count lvar) eqv? 0)
+ (expect (lvar-set-count lvar) eqv? 1))
+ (begin
+ (lvar-set--! lvar)
+ (expect (lvar-ref-count lvar) eqv? 0)
+ (expect (lvar-set-count lvar) eqv? 0))
+ )
+ )
+
+
+
+
(run-suites)
; __END__
View
1 vim/xire.scm
@@ -3,7 +3,6 @@
vim.xire.builtin
vim.xire.compiler
vim.xire.iform
- vim.xire.ivs
vim.xire.util
)
)
View
338 vim/xire/builtin.scm
@@ -7,7 +7,6 @@
(use util.list)
(use vim.xire.compiler)
(use vim.xire.iform)
-(use vim.xire.ivs)
(use vim.xire.util)
@@ -19,31 +18,23 @@
;;; Helpers
;;; -------
-(define-macro (define-binary-operator name op :optional default-val)
+(define-macro (define-binary-operator name :optional default-val)
`(defexpr ,name
[(_ $val1:qexpr)
(when (undefined? ,default-val)
(errorf "Operator ~s takes two or more arguments" ',name))
`(,',name ,',default-val ,$val1)]
[(_ $val1:expr $val2:expr)
- (IVS (E (Q "(")
- $val1
- (Q ,op)
- $val2
- (Q ")")))]
+ ($call ',name (list $val1 $val2))]
[(_ $val1:qexpr $val2:qexpr $valN:qexpr ...)
`(,',name (,',name ,$val1 ,$val2)
,@$valN)]
))
-(define-macro (define-comparison-operator name op)
+(define-macro (define-comparison-operator name)
`(defexpr ,name
[(_ $val1:expr $val2:expr)
- (IVS (E (Q "(")
- $val1
- (Q ,op)
- $val2
- (Q ")")))]
+ ($call ',name (list $val1 $val2))]
[(_ $val1:qexpr $val2:qexpr $valN:qexpr ...)
`(and (,',name ,$val1 ,$val2)
(,',name ,$val2 ,@$valN))]
@@ -54,83 +45,73 @@
(defexpr if
[(_ $cond:expr $then:expr $else:expr)
- (IVS (E (Q "(")
- $cond
- (Q "?")
- $then
- (Q " ") ; To parse r?s:t as (r)?(s):(t) not (r)?(s:t).
- (Q ":")
- $else
- (Q ")")))]
+ ($call 'if (list $cond $then $else))]
)
;;; expr2
;;; -----
-(define-binary-operator or "||")
+(define-binary-operator or)
;;; expr3
;;; -----
-(define-binary-operator and "&&")
+(define-binary-operator and)
;;; expr4
;;; -----
-(define-comparison-operator != "!=")
-(define-comparison-operator !=# "!=#")
-(define-comparison-operator !=? "!=?")
-(define-comparison-operator !~ "!~")
-(define-comparison-operator !~# "!~#")
-(define-comparison-operator !~? "!~?")
-(define-comparison-operator < "<")
-(define-comparison-operator <# "<#")
-(define-comparison-operator <= "<=")
-(define-comparison-operator <=# "<=#")
-(define-comparison-operator <=? "<=?")
-(define-comparison-operator <? "<?")
-(define-comparison-operator == "==")
-(define-comparison-operator ==# "==#")
-(define-comparison-operator ==? "==?")
-(define-comparison-operator =~ "=~")
-(define-comparison-operator =~# "=~#")
-(define-comparison-operator =~? "=~?")
-(define-comparison-operator > ">")
-(define-comparison-operator ># ">#")
-(define-comparison-operator >= ">=")
-(define-comparison-operator >=# ">=#")
-(define-comparison-operator >=? ">=?")
-(define-comparison-operator >? ">?")
-(define-comparison-operator is " is ")
-(define-comparison-operator is# " is# ")
-(define-comparison-operator is? " is? ")
-(define-comparison-operator isnot " isnot ")
-(define-comparison-operator isnot# " isnot# ")
-(define-comparison-operator isnot? " isnot? ")
+(define-comparison-operator !=)
+(define-comparison-operator !=#)
+(define-comparison-operator !=?)
+(define-comparison-operator !~)
+(define-comparison-operator !~#)
+(define-comparison-operator !~?)
+(define-comparison-operator <)
+(define-comparison-operator <#)
+(define-comparison-operator <=)
+(define-comparison-operator <=#)
+(define-comparison-operator <=?)
+(define-comparison-operator <?)
+(define-comparison-operator ==)
+(define-comparison-operator ==#)
+(define-comparison-operator ==?)
+(define-comparison-operator =~)
+(define-comparison-operator =~#)
+(define-comparison-operator =~?)
+(define-comparison-operator >)
+(define-comparison-operator >#)
+(define-comparison-operator >=)
+(define-comparison-operator >=#)
+(define-comparison-operator >=?)
+(define-comparison-operator >?)
+(define-comparison-operator is)
+(define-comparison-operator is#)
+(define-comparison-operator is?)
+(define-comparison-operator isnot)
+(define-comparison-operator isnot#)
+(define-comparison-operator isnot?)
;;; expr5
;;; -----
-(define-binary-operator + "+" 0)
-(define-binary-operator - "-" 0)
-(define-binary-operator .. ".")
+(define-binary-operator + 0)
+(define-binary-operator - 0)
+(define-binary-operator ..)
;;; expr6
;;; -----
-(define-binary-operator * "*")
-(define-binary-operator / "/")
-(define-binary-operator % "%")
+(define-binary-operator *)
+(define-binary-operator /)
+(define-binary-operator %)
;;; expr7
;;; -----
(defexpr not
[(_ $val:expr)
- (IVS (E (Q "(")
- (Q "!")
- $val
- (Q ")")))]
+ ($call 'not (list $val))]
)
; Macro "-" supports both unary and binary usage.
; Macro "+" supports both unary and binary usage.
@@ -140,67 +121,37 @@
(defexpr ref
[(_ $container:expr $index:expr)
- (IVS (E (Q "(")
- $container
- (Q "[")
- $index
- (Q "]")
- (Q ")")))]
+ ($call 'ref (list $container $index))]
)
(defexpr slice
[(_ $container:expr $index-from:expr $index-to:expr)
- (IVS (E (Q "(")
- $container
- (Q "[")
- $index-from
- (Q " ") ; To parse l[s:x] as l[(s):x] not l[(s:x)].
- (Q ":")
- $index-to
- (Q "]")
- (Q ")")))]
+ ($call 'slice (list $container $index-from $index-to))]
)
(defexpr slice-until
[(_ $container:expr $index-to:expr)
- (IVS (E (Q "(")
- $container
- (Q "[")
- (Q ":")
- $index-to
- (Q "]")
- (Q ")")))]
+ ($call 'slice (list $container #f $index-to))]
)
(defexpr slice-from
[(_ $container:expr $index-from:expr)
- (IVS (E (Q "(")
- $container
- (Q "[")
- $index-from
- (Q " ") ; To parse l[s:] as l[(s):] not l[(s:)].
- (Q ":")
- (Q "]")
- (Q ")")))]
+ ($call 'slice (list $container $index-from #f))]
)
(defexpr ->
- [(_ $dict:expr $name:sym)
- (IVS (E (Q "(")
- $dict
- (Q ".")
- $name
- (Q ")")))]
+ [(_ $dict:expr $name:qsym)
+ ($call '-> (list $dict $name))]
)
-; expr8(expr1, ...) is processed by Xire-script-to-IVS layer, not macros.
+; expr8(expr1, ...) is processed by Xire-script-to-IForm layer, not macros.
;;; expr9
;;; -----
-; Number literal is processed by IVS-to-Vim-script layer.
+; Number literal is processed by IForm-to-Vim-script layer.
-; "String literal" is processed by IVS-to-Vim-script layer.
+; "String literal" is processed by IForm-to-Vim-script layer.
; 'String literal' is not supported.
;
@@ -213,59 +164,42 @@
; Supplimental notation for strings to describe key sequences.
(defexpr kbd
[(_ $string:qexpr)
- (IVS (E (Q (convert-key-sequence-conventions $string))))])
+ ($call 'kbd (list $string))]
+ )
(defexpr list
- [(_ $val:expr ...)
- (IVS (E (Q "[")
- (apply E (intersperse (Q ",") $val))
- (Q "]")))]
+ [(_ $vals:expr ...)
+ ($call 'list $vals)]
)
(defexpr dict
- [(_ ($key:expr $val:expr) ...)
- (IVS (E (Q "{")
- (apply IVS
- (map (cut E
- <>
- (Q " ") ; To parse {s:x} as {(s):x} not {(s:x)}.
- (Q ":")
- <>
- (Q ","))
- $key
- $val))
- (Q "}")))]
- [(_ $x:expr ...)
- (define (adjust-key x x:expr)
- (if (keyword? x:expr)
- (keyword->string x:expr)
+ [(_ ($keys:expr $vals:expr) ...)
+ ($call 'dict (list $keys $vals))]
+ [(_ $xs:qexpr ...)
+ (define (adjust-key x)
+ (if (keyword? x)
+ (keyword->string x)
x))
- (define (go result xs xs:expr)
+ (define (go keys vals xs)
(cond
[(null? xs)
- (reverse result)]
+ (values
+ (reverse keys)
+ (reverse vals))]
[(and (pair? xs) (pair? (cdr xs)))
- (go
- (cons (E (adjust-key (car xs) (car xs:expr))
- (Q " ") ; To parse {s:x} as {(s):x} not {(s:x)}.
- (Q ":")
- (cadr xs)
- (Q ","))
- result)
- (cddr xs)
- (cddr xs:expr))]
+ (go (cons (transform-value (adjust-key (car xs)) #f 'expr ctx) keys)
+ (cons (transform-value (cadr xs) #f 'expr ctx) vals)
+ (cddr xs))]
[else
(errorf "Invalid key-value list for dict: ~s" form)]))
- (IVS (E (Q "{")
- (apply IVS (go '() $x $x:expr))
- (Q "}")))]
+ ($call 'dict (call-with-values (lambda () (go '() '() $xs)) list))]
)
; &option is treated the same as a variable.
; (expr1) is implicitly supported by Xire script syntax.
-; Variable is processed by IVS-to-Vim-script layer, not macros.
+; Variable is processed by IForm-to-Vim-script layer, not macros.
; Var{ia}ble is not supported.
;
@@ -277,7 +211,7 @@
; @r (register content) is treated the same as a variable.
-; function(call) is processed by Xire-script-to-IVS layer, not macros.
+; function(call) is processed by Xire-script-to-IForm layer, not macros.
; fun{ct}ion(call) is not supported as var{ia}ble is not supported.
@@ -289,108 +223,91 @@
(defstmt begin
[(_ $body:stmt ...)
- (apply IVS $body)]
+ ($begin $body)]
)
(defstmt call
[(_ $application:expr)
- (IVS (S 'call $application))]
+ ($ex (list 'call $application))]
)
(defstmt cond
- [(_ [$cond:expr $then:stmt] ...)
- (let go ([cond:exprs $cond:expr]
- [conds $cond]
- [thens $then]
- [result '()])
+ [(_ [$conds:expr $thens:stmt] ...)
+ (let go ([conds:expr $conds:expr]
+ [conds $conds]
+ [thens $thens]
+ [stmts '()])
(cond
- [(null? cond:exprs)
- (if (null? result)
- (IVS)
- (apply IVS (reverse (cons (S 'endif) result))))]
+ [(null? conds:expr)
+ (if (null? stmts)
+ ($begin '())
+ ($begin (reverse (cons ($ex '(endif)) stmts))))]
[else
- (go (cdr cond:exprs)
+ (go (cdr conds:expr)
(cdr conds)
(cdr thens)
(cons (car thens)
- (cons (S (if (null? result)
- 'if
- 'elseif)
- (if (and (null? (cdr cond:exprs))
- (eq? (car cond:exprs) 'else))
- (E #t)
- (car conds)))
- result)))]))]
+ (cons ($ex (list (if (null? stmts)
+ 'if
+ 'elseif)
+ (if (and (null? (cdr conds:expr))
+ (eq? (car conds:expr) 'else))
+ ($const #t)
+ (car conds))))
+ stmts)))]))]
)
(defstmt define
; FIXME: Add tests on failure cases.
; FIXME: Detect reassignment. (run-time? or compile-time?)
- [(_ $var:sym $val:expr)
+ [(_ $var:qsym $val:expr)
(unless (not (func-ctx? ctx))
(errorf "\"define\" is available only in top-level: ~s" form))
- (IVS (S 'let $var (Q '=) $val))]
+ ($def $var $val)]
)
(defstmt echo
- [(_ $val:expr ...)
- (IVS (apply S 'echo $val))]
+ [(_ $vals:expr ...)
+ ($ex (list* 'echo $vals))]
)
(defstmt function
; FIXME: Support !.
; FIXME: Support range, abort and dict.
- ; FIXME: Check values on $name and $arg.
- [(_ ($name:qsym $arg:sym ...) $body:qstmt ...)
- (IVS
- (S 'function $name (Q "(") (apply E (intersperse (Q ",") $arg)) (Q ")"))
- (apply IVS (xire-compile-forms $body (make-func-ctx ctx $arg:sym)))
- (S 'endfunction)
- )]
+ [(_ ($func-name:qsym $arg-names:qsym ...) $body:qstmt ...)
+ (let* ([new-ctx (make-func-ctx ctx $arg-names)])
+ ($func $func-name
+ (map cdr (ref new-ctx 'func-args))
+ (transform-value `(begin ,@$body) #f 'stmt new-ctx)))]
)
(defstmt for
- [(_ $var:qsym $list:expr $body:qstmt)
- (let1 local-ctx (make-local-ctx ctx (list $var))
- (IVS (S 'for (xire-compile-expr $var local-ctx) 'in $list)
- (xire-compile $body local-ctx)
- (S 'endfor)))]
+ [(_ $name:qsym $list:expr $body:qstmt)
+ (let* ([old-ctx ctx]
+ [lvars (make-lvars (list $name) (list (undefined)) old-ctx)]
+ [new-ctx (make-local-ctx ctx lvars)])
+ ($for (car lvars)
+ $list
+ (transform-value $body #f 'stmt new-ctx)))]
[(_ $var:qsym $list:qexpr $body:qstmt ...)
`(for ,$var ,$list (begin ,@$body))]
)
(defstmt if
[(_ $cond:expr $then:stmt)
- (IVS (S 'if $cond)
- $then
- (S 'endif))]
+ ($if $cond $then ($begin '()))]
[(_ $cond:expr $then:stmt $else:stmt)
- (IVS (S 'if $cond)
- $then
- (S 'else)
- $else
- (S 'endif))]
+ ($if $cond $then $else)]
)
(defstmt let
; FIXME: Add tests on failure cases.
- [(_ (($var:qsym $val:qexpr) ...) $body:qstmt ...)
- (let ([old-ctx ctx]
- [new-ctx (make-local-ctx ctx $var)])
- `(begin
- ,@(let go ([vars $var]
- [vals $val]
- [forms '()])
- (if (null? vars)
- (reverse forms)
- (go (cdr vars)
- (cdr vals)
- (cons `(set! ,(transform-value (car vars) #f 'expr new-ctx)
- ,(transform-value (car vals) #f 'expr old-ctx))
- forms))))
- ,@(transform-value $body #t 'stmt new-ctx)
- )
- )]
+ [(_ (($names:qsym $vals:expr) ...) $body:qstmt ...)
+ (let* ([old-ctx ctx]
+ [lvars (make-lvars $names $vals old-ctx)]
+ [new-ctx (make-local-ctx ctx lvars)])
+ ($let lvars
+ (transform-value `(begin ,@$body) #f 'stmt new-ctx)))]
)
(defstmt let*
@@ -411,12 +328,19 @@
(defstmt return
[(_ $val:expr)
- (IVS (S 'return $val))]
+ ($ret $val)]
)
(defstmt set!
- [(_ $lval:expr $rval:expr)
- (IVS (S 'let $lval (Q '=) $rval))]
+ ; FIXME: Support ``:let l[i] = v'', etc.
+ [(_ $name:qsym $rval:expr)
+ (cond
+ [(or (assq $name (ref ctx 'locals))
+ (assq $name (ref ctx 'func-args)))
+ => (lambda (name&lvar)
+ ($lset (cdr name&lvar) $rval))]
+ [else
+ ($gset $name $rval)])]
)
(defstmt until
@@ -433,9 +357,11 @@
(defstmt while
[(_ $cond:expr $body:stmt)
- (IVS (S 'while $cond)
- $body
- (S 'endwhile))]
+ ($begin
+ (list
+ ($ex (list 'while $cond))
+ $body
+ ($ex (list 'endwhile))))]
[(_ $cond:qexpr $body:qstmt ...)
`(while ,$cond (begin ,@$body))]
)
View
56 vim/xire/compiler.scm
@@ -10,7 +10,6 @@
xire-compile-forms
; Not public, but exported to test.
- rename-local-bindings
; Not public, but exported to avoid some problems.
match ; See [MATCHQ].
@@ -21,7 +20,8 @@
(use text.tree)
(use util.list)
(use util.match)
-(use vim.xire.ivs)
+(use vim.xire.compiler.pass-final)
+(use vim.xire.iform)
(use vim.xire.util)
@@ -58,10 +58,15 @@
(eval `(begin ,@scheme-exprs) scheme-env)
(loop)]
[(and (name . _) form)
- (push! compiled-vim-script-tree (xire-compile form ctx))
+ (push! compiled-vim-script-tree
+ (pass-final (list (xire-compile form ctx))))
+ (loop)]
+ [(? iform? form)
+ (push! compiled-vim-script-tree
+ (pass-final (list form)))
(loop)]))))
-;; Compile a Xire script FORM then return a resulting Vim script in IVS.
+;; Compile a Xire script FORM then return a resulting Vim script in IForm.
(define (xire-compile form ctx)
(define (report-syntax-error)
(errorf "Invalid Xire form: ~s" form))
@@ -76,23 +81,26 @@
; where foo is not known as a Xire macro. This convention is to
; simplify the compiler implementation.
(if (expr-ctx? ctx)
- (IVS (E (rename-local-bindings name ctx)
- (Q "(")
- (apply E (intersperse (Q ",")
- (xire-compile-forms args ctx)))
- (Q ")")))
+ (let1 func (if-let1 name&lvar (or (assq name (ref ctx 'locals))
+ (assq name (ref ctx 'func-args)))
+ ($lref (cdr name&lvar))
+ ($gref name))
+ ($call func (xire-compile-forms args ctx)))
(report-syntax-error))])]
[(_ . _) ; FORM is already compiled.
form]
- [(? (cut is-a? <> <ivs>) form) ; FORM is already compiled.
+ [(? iform? form) ; FORM is already compiled.
form]
[_
(ensure-expr-ctx form ctx)
- (IVS (E (if (symbol? form)
- (rename-local-bindings form ctx)
- form)))]))
-
-;; Compile a Xire script EXPR then return a resulting Vim script in IVS.
+ (if (symbol? form)
+ (if-let1 name&lvar (or (assq form (ref ctx 'locals))
+ (assq form (ref ctx 'func-args)))
+ ($lref (cdr name&lvar))
+ ($gref form))
+ ($const form))]))
+
+;; Compile a Xire script EXPR then return a resulting Vim script in IForm.
;; This is an abbreviated form of xire-compile for typical use.
(define (xire-compile-expr expr ctx)
(xire-compile expr
@@ -101,24 +109,10 @@
(make-expr-ctx ctx))))
;; Compile a list of Xire script FORMS then return a resulting Vim script in
-;; IVS. This is an abbreviated form of xire-compile for typical use.
+;; IForm. This is an abbreviated form of xire-compile for typical use.
(define (xire-compile-forms forms ctx)
(map (cut xire-compile <> ctx) forms))
-;; Rename a variable reference in FORM according to CTX, if necessary.
-(define (rename-local-bindings form ctx)
- (cond
- [(not (symbol? form))
- (errorf "Error: rename-local-bindings with non-symbol value: ~s" form)]
- [(assq form (ref ctx 'locals))
- => cdr]
- [(memq form (ref ctx 'func-args))
- (if (eq? form '...)
- 'a:000
- (string->symbol #`"a:,form"))]
- [else
- form]))
-
(define (transform-value form-or-forms manyp type upper-ctx)
(define (fail detail)
(errorf "Invalid usage (~a): (transform-value ~s ~s ~s ~s)"
@@ -147,7 +141,7 @@
[(eq? type 'sym)
(when (not (symbol? form))
(fail "invalid form for this type"))
- (IVS (E form))]
+ (xire-compile-expr form upper-ctx)]
[else
(fail "invalid type")]))
(if manyp
View
4 vim/xire/compiler/pass-final.scm
@@ -151,8 +151,10 @@
(list "("
(gen dict-expr)
"."
- name
+ (convert-identifier-conventions (symbol->string name))
")")]
+ [#('$CALL 'kbd (expr))
+ (convert-key-sequence-conventions expr)]
[#('$CALL 'list (exprs ...))
(list "["
(intersperse "," (map gen exprs))
View
50 vim/xire/iform.scm
@@ -18,19 +18,8 @@
$next
$ret
$while
- <lvar>
iform-tag
iform?
- lvar-arg-name
- lvar-init-expr
- lvar-new-name
- lvar-ref++!
- lvar-ref--!
- lvar-ref-count
- lvar-set++!
- lvar-set--!
- lvar-set-count
- lvar-src-name
; Not public, but exported to test.
))
@@ -91,45 +80,6 @@
;;; stmt An iform of a statement.
-;;; Local variables
-;;; ---------------
-;;;
-;;; NB: <lvar> mostly represents a local variable, but it also represents an
-;;; argument to a function.
-
-(define-class <lvar> ()
- ((src-name ; The original name of this variable in source code.
- :init-keyword :src-name
- :getter lvar-src-name)
- (new-name ; A new name of this variable for resulting Vim script.
- :init-keyword :new-name
- :getter lvar-new-name)
- (arg-name ; A name to declare this variable as an argument to a function.
- :init-keyword :arg-name
- :getter lvar-arg-name
- :init-value #f)
- (init-expr ; An expression for the initial value of this variable.
- :init-keyword :init-expr
- :getter lvar-init-expr)
- (ref-count ; The total number of places which refer this variable.
- :init-keyword :ref-count
- :accessor lvar-ref-count
- :init-value 0)
- (set-count ; The total number of places which modify this variable.
- :init-keyword :set-count
- :accessor lvar-set-count
- :init-value 0)))
-
-(define (lvar-ref++! lvar)
- (inc! (lvar-ref-count lvar)))
-(define (lvar-ref--! lvar)
- (dec! (lvar-ref-count lvar)))
-(define (lvar-set++! lvar)
- (inc! (lvar-set-count lvar)))
-(define (lvar-set--! lvar)
- (dec! (lvar-set-count lvar)))
-
-
;;; Utilities on IForm
;;; ------------------
View
97 vim/xire/ivs.scm
@@ -1,97 +0,0 @@
-(define-module vim.xire.ivs
- (export
- ; Public API.
- <ivs>
- E
- IVS
- Q
- S
-
- ; Not public, but exported to test.
- ))
-(select-module vim.xire.ivs)
-
-(use text.tree)
-(use util.list)
-(use vim.xire.iform) ; FIXME: A temporary stuff for the IVS-IForm migration.
-(use vim.xire.util) ; FIXME: A temporary stuff for the IVS-IForm migration.
-
-
-
-
-;;; Constructors for IVS
-;;; ====================
-
-(define-class <ivs> ()
- ([nodes
- :init-keyword :nodes]
- [linedp
- :init-keyword :lined]
- [quotedp
- :init-keyword :quotedp]
- [spacedp
- :init-keyword :spacedp]))
-
-(define-method object-equal? ((a <ivs>) (b <ivs>))
- (and (equal? (ref a 'linedp) (ref b 'linedp))
- (equal? (ref a 'quotedp) (ref b 'quotedp))
- (equal? (ref a 'spacedp) (ref b 'spacedp))
- (every equal? (ref a 'nodes) (ref b 'nodes))))
-
-
-(define (IVS . nodes)
- (unless (every (cut is-a? <> <ivs>) nodes)
- (errorf "IVS takes only IVS objects, but given: ~s" nodes))
- (make <ivs>
- :nodes nodes
- :lined #f
- :quotedp #f
- :spacedp #f))
-
-(define (S . nodes)
- (make <ivs>
- :nodes nodes
- :lined #t
- :quotedp #f
- :spacedp #t))
-
-(define (E . nodes)
- (make <ivs>
- :nodes nodes
- :lined #f
- :quotedp #f
- :spacedp #f))
-
-(define (Q . atoms)
- (make <ivs>
- :nodes atoms
- :lined #f
- :quotedp #t
- :spacedp #f))
-
-
-
-
-;;; Translation API from IVS to Vim script
-;;; ======================================
-
-(define-method write-tree ((tree <ivs>) out)
- (define (writer x out)
- (cond
- [(ref tree 'quotedp)
- (display x out)]
- [(is-a? x <ivs>)
- (write-tree x out)]
- [else
- (display (scheme-object->vim-script-notation x) out)]))
- (map (cut writer <> out)
- (if (ref tree 'spacedp)
- (intersperse (Q " ") (ref tree 'nodes))
- (ref tree 'nodes)))
- (when (ref tree 'linedp)
- (newline out)))
-
-
-
-
-;;; __END__
View
116 vim/xire/util.scm
@@ -10,6 +10,7 @@
scheme-object->vim-script-notation
; Semi-public API for advanced usage.
+ <lvar>
<xire-ctx>
<xire-env>
copy-ctx
@@ -19,9 +20,20 @@
ensure-stmt-ctx
expr-ctx?
func-ctx?
+ lvar-arg-name
+ lvar-init-expr
+ lvar-new-name
+ lvar-ref++!
+ lvar-ref--!
+ lvar-ref-count
+ lvar-set++!
+ lvar-set--!
+ lvar-set-count
+ lvar-src-name
make-expr-ctx
make-func-ctx
make-local-ctx
+ make-lvars
make-root-ctx
make-stmt-ctx
script-ctx?
@@ -193,6 +205,61 @@
+;;; Local variables
+;;; ===============
+;;;
+;;; NB: <lvar> mostly represents a local variable, but it also represents an
+;;; argument to a function.
+
+(define-class <lvar> ()
+ ((src-name ; The original name of this variable in source code.
+ :init-keyword :src-name
+ :getter lvar-src-name)
+ (new-name ; A new name of this variable for resulting Vim script.
+ :init-keyword :new-name
+ :getter lvar-new-name)
+ (arg-name ; A name to declare this variable as an argument to a function.
+ :init-keyword :arg-name
+ :getter lvar-arg-name
+ :init-value #f)
+ (init-expr ; An expression for the initial value of this variable.
+ :init-keyword :init-expr
+ :getter lvar-init-expr)
+ (ref-count ; The total number of places which refer this variable.
+ :init-keyword :ref-count
+ :accessor lvar-ref-count
+ :init-value 0)
+ (set-count ; The total number of places which modify this variable.
+ :init-keyword :set-count
+ :accessor lvar-set-count
+ :init-value 0)))
+
+(define-method object-equal? ((v1 <lvar>) (v2 <lvar>))
+ (every (lambda (slot)
+ (let1 name (slot-definition-name slot)
+ (cond
+ [(and (slot-bound? v1 name)
+ (slot-bound? v2 name))
+ (equal?
+ (ref v1 name)
+ (ref v2 name))]
+ [else
+ (and (not (slot-bound? v1 name))
+ (not (slot-bound? v2 name)))])))
+ (class-slots <lvar>)))
+
+(define (lvar-ref++! lvar)
+ (inc! (lvar-ref-count lvar)))
+(define (lvar-ref--! lvar)
+ (dec! (lvar-ref-count lvar)))
+(define (lvar-set++! lvar)
+ (inc! (lvar-set-count lvar)))
+(define (lvar-set--! lvar)
+ (dec! (lvar-set-count lvar)))
+
+
+
+
;;; Environment
;;; ===========
@@ -273,26 +340,37 @@
(define new-ctx (copy-ctx ctx))
(set! (ref new-ctx 'type) 'expr)
new-ctx)
-(define (make-func-ctx ctx func-args)
+(define (make-func-ctx ctx names)
; NB: Though :function can be written in the body of a :function,
; Vim script does not have lexical scope. So that nested function
; definition is equivalent to independent function definitions.
; Therefore the compiler does not care about nested functions.
(define new-ctx (copy-ctx ctx))
(set! (ref new-ctx 'in-funcp) #t)
- (set! (ref new-ctx 'func-args) func-args)
+ (set! (ref new-ctx 'func-args)
+ (map (lambda (n)
+ (define n% (string->symbol
+ (convert-identifier-conventions
+ (symbol->string n))))
+ (cons n
+ (make <lvar>
+ :src-name n
+ :new-name (if (eq? n '...)
+ 'a:000
+ (string->symbol #`"a:,n%"))
+ :arg-name n%)))
+ names))
new-ctx)
-(define (make-local-ctx ctx vars)
- (define new-ctx (copy-ctx ctx))
- (define (generate-new-name)
+(define (make-lvars names vals ctx)
+ (define (generate-new-name ctx)
(cond ; The order of clauses is important.
- [(func-ctx? new-ctx)
+ [(func-ctx? ctx)
; Xire script doesn't provide any way to define function-local
; variables except "let" family. And it's not usual to access
; function-local variables from other context. So that it's not
; necessary to take care on name collision.
(gensym "L")]
- [(script-ctx? new-ctx)
+ [(script-ctx? ctx)
; There is a chance of name collision between variables explicitly
; defined with "define" and variables implicitly defined with "let"
; family. To avoid unexpected name collision, generate variable name
@@ -300,11 +378,21 @@
(gensym "s:__L")]
[else
(error "Lexical variables are not available in this context.")]))
- (set! (ref new-ctx 'locals)
- (append
- (map (cut cons <> (generate-new-name)) vars)
- (ref new-ctx 'locals)))
- new-ctx)
+ (map (lambda (n v)
+ (make <lvar>
+ :src-name n
+ :new-name (generate-new-name ctx)
+ :init-expr v))
+ names
+ vals))
+(define (make-local-ctx ctx lvars)
+ (rlet1 new-ctx (copy-ctx ctx)
+ (set! (ref new-ctx 'locals)
+ (append (map (lambda (v)
+ (cons (lvar-src-name v) v))
+ lvars)
+ (ref new-ctx 'locals)))
+ ))
(define (stmt-ctx? ctx)
(eq? (ref ctx 'type) 'stmt))
@@ -456,12 +544,12 @@
[(_ name cmd-name)
(defstmt name
[(_)
- (IVS (S (Q 'cmd-name)))])]
+ ($ex '(cmd-name))])]
; Shorthand for simple command like :break.
[(_ name)
(defstmt name
[(_)
- (IVS (S (Q 'name)))])]
+ ($ex '(name))])]
))

0 comments on commit 078d44b

Please sign in to comment.
Something went wrong with that request. Please try again.