Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
  • 4 commits
  • 7 files changed
  • 0 commit comments
  • 1 contributor
Commits on Mar 08, 2013
nineties Fixed a bug a0aa0e5
nineties Fixed a bug of closure-conversion.
Changed syntax of lambda_expr.
b7f8ac1
nineties Fixed a bug of for-statement. 5344490
nineties Fixed a bug of check_indent() 95f4af5
View
4 demo/lang/hyperlisp/lib/core.ab
@@ -1,6 +1,6 @@
# Copyright (C) 2012 nineties
#
-# $Id: hyperlisp/core.ab 2013-02-06 12:12:31 nineties $
+# $Id: hyperlisp/core.ab 2013-03-08 17:43:40 nineties $
# Reference
# Masahiko Sato and Masami Hagiya: HyperLisp, Algorithmic Languages
@@ -70,5 +70,5 @@ module HyperLisp {
## Recognizer
atom: x@Cons -> false
| x@Snoc -> true
- | x -> throw `UnknownExpression{!LOCATION, !x}
+ | x -> { throw `UnknownExpression{!LOCATION, !x} }
}
View
10 demo/lang/hyperlisp/lib/syntax.ab
@@ -1,6 +1,6 @@
# Copyright (C) 2012 nineties
#
-# $Id: hyperlisp/syntax.ab 2013-03-05 23:10:26 nineties $
+# $Id: hyperlisp/syntax.ab 2013-03-08 17:44:35 nineties $
# Reference
# Masahiko Sato and Masami Hagiya: HyperLisp, Algorithmic Languages
@@ -53,9 +53,9 @@ module HyperLisp {
: (io, x) when x == zero -> print(io, "0")
| (io, x) when x == one -> print(io, "1")
| (io, e@Cons) when is_cons_list(e)
- -> print(io, "("); pprint_cons_list(io, e); print(io, ")")
+ -> { print(io, "("); pprint_cons_list(io, e); print(io, ")") }
| (io, e@Snoc) when is_snoc_list(e)
- -> print(io, "["); pprint_cons_list(io, e); print(io, "]")
+ -> { print(io, "["); pprint_cons_list(io, e); print(io, "]") }
| (io, e@Cons) -> printf(io, "(%p . %p)", e.car, e.cdr)
| (io, e@Snoc) -> printf(io, "[%p . %p]", e.car, e.cdr)
@@ -64,7 +64,7 @@ module HyperLisp {
| (io, e@Cons) when e.cdr == zero -> pprint(io, e.car)
| (io, e@Snoc) when e.cdr == zero -> pprint(io, e.car)
| (io, e@Cons)
- -> pprint(io, e.car); print(io, ", "); pprint_cons_list(io, e.cdr)
+ -> { pprint(io, e.car); print(io, ", "); pprint_cons_list(io, e.cdr) }
| (io, e@Snoc)
- -> pprint(io, e.car); print(io, ", "); pprint_cons_list(io, e.cdr)
+ -> { pprint(io, e.car); print(io, ", "); pprint_cons_list(io, e.cdr) }
}
View
4 lib/amber/syntax.ab
@@ -4,7 +4,7 @@ Assign{comment, shell_style_comment}
# Copyright (C) 2010 nineties
#
-# $Id: syntax.ab 2013-03-06 22:50:53 nineties $
+# $Id: syntax.ab 2013-03-08 17:41:41 nineties $
# Syntax definition of the Amber language.
# This file will be loaded first.
@@ -289,7 +289,7 @@ argument_list
{ List{node1} }
lambda_expr
- ::= argument_list "->" block
+ ::= argument_list "->" ternary_expr
{ `Lambda{!node0, !node2} }
| ternary_expr
View
7 lib/printf.ab
@@ -1,6 +1,6 @@
# Copyright (C) 2010 nineties
#
-# $Id: printf.ab 2013-03-05 01:05:50 nineties $
+# $Id: printf.ab 2013-03-08 17:42:20 nineties $
module Std {
module Printf {
@@ -19,8 +19,9 @@ module Std {
-> loop(fs, ss, Std::cons(`pprint(!io, !s), ls))
| ([f@String, fs...], args, ls)
-> loop(fs, args, Std::cons(`print(!io, !f), ls))
- | ([f, ...], _, _)
- -> throw `Error{!LOCATION, !("argument for " + f.to_s + " is not found")}
+ | ([f, ...], _, _) -> {
+ throw `Error{!LOCATION, !("argument for " + f.to_s + " is not found")}
+ }
loop(fmt, args, [])
compile_format(fmt, args):
View
111 rowl1/rowl1-compile.rlc
@@ -2,7 +2,7 @@
; rowl - 1st generation
; Copyright (C) 2010 nineties
;
-; $Id: rowl1-compile.rlc 2013-03-08 06:36:10 nineties $
+; $Id: rowl1-compile.rlc 2013-03-08 21:38:36 nineties $
;
(import "rlvm-compile")
@@ -40,14 +40,6 @@
(compile_simple_call asm 2 trace_func)
))
-(fun defined_symbol (expr) (
- (var lhs (node_arg expr 0))
- (if (is_symbol lhs) (return lhs))
- (var hd (node_bhead lhs))
- (if (== hd Ref) (return (node_arg lhs 2)))
- (return @C_NIL)
- ))
-
(fun iter_args (f node arg level) (
(if (is_special node) (return arg))
(if (is_symbol node)
@@ -59,6 +51,11 @@
(return arg)
))
(var hd (node_bhead node))
+ (if (== hd Ref)
+ (if (== level 0)
+ (return (f (node_arg_symbol node 2) arg))
+ (return arg)
+ ))
(if (== hd Quote) (return arg))
(if (== hd QuasiQuote) (+= level 1)
(if (== hd Unquote) (-= level 1)
@@ -426,9 +423,13 @@
(return expr)
))
(if (|| (== hd DefVariable) (== hd DefFunction)) (do
- (var sym (defined_symbol expr))
- (if (! (symtable_find tbl sym)) (do
- (symtable_add tbl sym maybe)
+ (var syms (collect_args (node_arg expr 0)))
+ (while syms (do
+ (var sym (car syms))
+ (if (! (symtable_find tbl sym)) (do
+ (symtable_add tbl sym maybe)
+ ))
+ (= syms (cdr syms))
))
(node_arg_set expr 1 (scan_clsvars mod (node_arg expr 1) tbl))
(return expr)
@@ -1522,11 +1523,16 @@
(var cnd (node_arg expr 0))
(var body (node_arg expr 1))
+ (var next @C_NIL)
+ (if (== (node_size expr) 3)
+ (= next (node_arg expr 2))
+ )
(var exit_lbl (fresh_label asm))
+ (var cont_lbl (fresh_label asm))
(var head_lbl (fresh_label asm))
(= break_labels (cons (box exit_lbl) break_labels))
- (= continue_labels (cons (box head_lbl) continue_labels))
+ (= continue_labels (cons (box cont_lbl) continue_labels))
(compile asm mod cnd)
@@ -1535,6 +1541,11 @@
(compile asm mod body)
(put_drop asm)
+ (set_label asm cont_lbl)
+ (if (!= next @C_NIL) (do
+ (compile asm mod next)
+ (put_drop asm)
+ ))
(compile asm mod cnd)
(put_if_true asm head_lbl)
(set_label asm exit_lbl)
@@ -1556,10 +1567,6 @@
; }
(fun compile_for (asm mod expr) (
- (if (in_top_scope mod)
- (return (compile_function asm 0 mod 0 expr noguard @C_NIL))
- )
-
(var i (node_arg expr 0))
(var ary (node_arg expr 1))
(var body (node_arg expr 2))
@@ -1580,10 +1587,6 @@
))
(fun compile_revfor (asm mod expr) (
- (if (in_top_scope mod)
- (return (compile_function asm 0 mod 0 expr noguard @C_NIL))
- )
-
(var i (node_arg expr 0))
(var ary (node_arg expr 1))
(var body (node_arg expr 2))
@@ -1605,73 +1608,66 @@
; translate for i in a..b body to
;
-; i: {
-; i: a
-; tmp: b
-; while (i <= tmp) {
-; body
-; i += 1
-; }
-; i
+; j: a
+; n: b
+; while (j <= n) {
+; i: j
+; body
+; j += 1
; }
(fun compile_range_for (asm mod expr) (
- (if (in_top_scope mod)
- (return (compile_function asm 0 mod 0 expr noguard @C_NIL))
- )
-
(var i (node_arg expr 0))
(var rng (node_arg expr 1))
(var a (node_arg rng 0))
(var b (node_arg rng 1))
(var body (node_arg expr 2))
- (var tmp (unique_sym))
+ (var j (unique_sym))
+ (var n (unique_sym))
(compile asm mod
(block (list3
- (defvar i a)
- (defvar tmp b)
- (make_object2 While
- (apply (to_sym "le") (list2 i tmp))
+ (defvar j a)
+ (defvar n b)
+ (make_object3 While
+ (apply (to_sym "le") (list2 j n))
(seq (list2
+ (defvar i j)
body
- (assign i (apply (to_sym "add") (list2 i (box 1)))))))
+ ))
+ (assign j (apply (to_sym "add") (list2 j (box 1)))))
)))
))
; translate revfor i in a..b body to
;
-; i: {
-; i: b
-; tmp: a
-; while (i >= tmp) {
-; body
-; i -= 1
-; }
-; i
+; j: b
+; n: a
+; while (j >= n) {
+; i: j
+; body
+; j -= 1
; }
(fun compile_range_revfor (asm mod expr) (
- (if (in_top_scope mod)
- (return (compile_function asm 0 mod 0 expr noguard @C_NIL))
- )
-
(var i (node_arg expr 0))
(var rng (node_arg expr 1))
(var a (node_arg rng 0))
(var b (node_arg rng 1))
(var body (node_arg expr 2))
- (var tmp (unique_sym))
+ (var j (unique_sym))
+ (var n (unique_sym))
(compile asm mod
(block (list3
- (defvar i b)
- (defvar tmp a)
+ (defvar j b)
+ (defvar n a)
(make_object2 While
- (apply (to_sym "ge") (list2 i tmp))
+ (apply (to_sym "ge") (list2 i n))
(seq (list2
- body
- (assign i (apply (to_sym "sub") (list2 i (box 1)))))))
+ (defvar i j)
+ body))
+ (assign j (apply (to_sym "sub") (list2 j (box 1)))))
)))
))
@@ -2099,6 +2095,7 @@
(add_compiler mod (mkif DontCare DontCare) compile_if)
(add_compiler mod (ifelse DontCare DontCare DontCare) compile_ifelse)
(add_compiler mod (make_object2 While DontCare DontCare) compile_while)
+ (add_compiler mod (make_object3 While DontCare DontCare DontCare) compile_while)
(add_compiler mod (make_object3 For DontCare DontCare DontCare)
compile_for
View
5 rowl1/rowl1-error.rlc
@@ -2,7 +2,7 @@
; rowl - 1st generation
; Copyright (C) 2010 nineties
;
-; $Id: rowl1-node.rlc 2013-02-22 22:45:01 nineties $
+; $Id: rowl1-node.rlc 2013-03-08 06:55:09 nineties $
;
(import "rlvm-compile")
@@ -49,7 +49,8 @@
))
(export fun matching_failed (pat) (
- (return (make_object2 (to_sym "MatchingFailed") current_loc pat))
+ (return (make_object2 (to_sym "MatchingFailed") current_loc
+ (make_object1 (to_sym "pattern") pat)))
))
(export fun unknown_field (loc head sym) (
View
15 rowl1/rowl1-packrat.rlc
@@ -2,7 +2,7 @@
; rowl - 1st generation
; Copyright (C) 2010 nineties
;
-; $Id: rowl1-packrat.rlc 2013-03-08 05:58:20 nineties $
+; $Id: rowl1-packrat.rlc 2013-03-08 22:08:02 nineties $
;
(import "rlvm-compile")
@@ -292,12 +292,12 @@
(return (noparse_sub p msg @FALSE @TRUE))
))
-(fun noparse_quite (p msg) (
- (return (noparse_sub p msg @TRUE @FALSE))
+(fun noparse_quite (p) (
+ (return (noparse_sub p 0 @TRUE @FALSE))
))
-(fun mayparse_quiet (p msg) (
- (return (noparse_sub p msg @TRUE @TRUE))
+(fun mayparse_quiet (p) (
+ (return (noparse_sub p 0 @TRUE @TRUE))
))
(fun negate (p) (
@@ -463,8 +463,10 @@
))
(fun set_parser_state (dst src) (
- ; NB: indentation-level and error position must not be copied
+ ; NB: error message, indentation-level and error position must not be copied
+ (var msg @(ERROR dst))
(memcpy dst src (* 10 @WORD_SIZE))
+ (field_set dst 3 msg)
))
(fun clear_parser_state (p state) (
@@ -518,6 +520,7 @@
(fun check_indent (p) (
(if (field_get p 7) (return @C_TRUE))
+ (if (< (lookahead p) 0) (return @C_TRUE))
(if (<= (field_get p 9) (field_get p 10))
(return @C_FALSE)

No commit comments for this range

Something went wrong with that request. Please try again.