Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

* add sample/module.ab

* fix management of local variable index.
* enable to use qualified identifier for lookup_symbol.
  • Loading branch information...
commit 00a28f69ca33e8627540c7c6b165e18ac6360476 1 parent 9d55a7e
@nineties authored
View
38 rowl1/rowl1-compile.rlc
@@ -2,7 +2,7 @@
; rowl - 1st generation
; Copyright (C) 2010 nineties
;
-; $Id: rowl1-compile.rlc 2012-01-26 02:32:02 nineties $
+; $Id: rowl1-compile.rlc 2012-01-26 11:49:54 nineties $
;
(import "rlvm-compile")
@@ -268,6 +268,7 @@
(compile_simple_call asm 2 make_expr_user)
))
+(var max_lvar_idx 0)
(fun compile_function (asm mod args body) (
; XXX: do closure conversion
;(var fv (free_variables body))
@@ -288,10 +289,16 @@
;(collect_args vtbl args)
;(close vtbl body)
+ (var save_max_lvar_idx max_lvar_idx)
+ (= max_lvar_idx 0)
+ (reset_variable_count mod)
+
(compile asm mod body)
(put_ireturn asm)
- (put_operand_byte asm (+ cnt_addr 1) (count_local_variable mod))
+ (put_operand_byte asm (+ cnt_addr 1) (+ max_lvar_idx 1))
(pop_varscope mod)
+
+ (= max_lvar_idx save_max_lvar_idx)
))
(fun setup_args (tbl args) (
@@ -399,7 +406,10 @@
(put_setcar asm)
)
(do
- (var idx (count_local_variable mod))
+ (var idx (get_variable_count mod))
+ (if (> idx max_lvar_idx) (= max_lvar_idx idx))
+ (incr_variable_count mod)
+
(compile asm mod val)
(put_store_lvar asm idx)
(add_symbol mod sym (make_lvar idx))
@@ -571,21 +581,24 @@
(fun compile_block (asm mod expr) (
(var exprs (expr_args expr))
+ (push_varscope mod)
(if (in_top_scope mod)
(do
- (push_varscope mod)
+ (var save_max_lvar_idx max_lvar_idx)
+ (= max_lvar_idx 0)
+ (reset_variable_count mod)
+
(var cnt_addr (get_address asm))
(put_allocate asm 0)
(compile_block_body asm mod exprs)
- (put_operand_byte asm (+ cnt_addr 1) (count_local_variable mod))
- (pop_varscope mod)
+ (put_operand_byte asm (+ cnt_addr 1) (+ max_lvar_idx 2))
+
+ (= max_lvar_idx save_max_lvar_idx)
)
(do
- (push_varscope mod)
(compile_block_body asm mod exprs)
- (pop_varscope mod)
- )
- )
+ ))
+ (pop_varscope mod)
))
(fun put_if_true (asm lbl) (
@@ -755,7 +768,7 @@
))
(fun compile_assign (asm mod expr) (
- (var lhs (expr_arg_symbol expr 0))
+ (var lhs (expr_arg expr 0))
(var rhs (expr_arg expr 1))
(compile asm mod rhs)
(var v (lookup_symbol mod lhs))
@@ -960,6 +973,7 @@
(add_compiler mod (make_expr DefPostfix (list3 symT stringT intT)) do_nothing)
(add_compiler mod (make_expr DefConstr (list2 symT stringT)) do_nothing)
(add_compiler mod (make_expr DefCommand (list2 symT stringT)) do_nothing)
+ (add_compiler mod (make_expr Import (list1 DontCare)) do_nothing)
(add_compiler mod (make_expr Qualified (list2 symT DontCare)) compile_qualified)
@@ -982,7 +996,7 @@
(add_compiler mod (make_expr (to_sym "Return") (list1 DontCare)) compile_return)
(add_compiler mod (make_expr (to_sym "Equal") (list2 DontCare DontCare)) compile_eq)
(add_compiler mod (make_expr (to_sym "NotEqual") (list2 DontCare DontCare)) compile_ne)
- (add_compiler mod (make_expr Assign (list2 symT DontCare)) compile_assign)
+ (add_compiler mod (make_expr Assign (list2 DontCare DontCare)) compile_assign)
(add_compiler mod (make_expr Lambda (list2 DontCare DontCare)) compile_lambda_1arg)
(add_compiler mod (make_expr Lambda (list2 tupleT DontCare)) compile_lambda)
(add_compiler mod (make_expr Bind (list2 DontCare DontCare)) compile_bind)
View
8 rowl1/rowl1-interp.rlc
@@ -2,7 +2,7 @@
; rowl - 1st generation
; Copyright (C) 2010 nineties
;
-; $Id: rowl1-interp.rlc 2012-01-19 23:01:18 nineties $
+; $Id: rowl1-interp.rlc 2012-01-26 08:23:08 nineties $
;
(import "rlvm-compile")
@@ -37,7 +37,7 @@
(setup_builtin_functions current_mod)
(setup_builtin_compilers current_mod)
(init_stdlib current_mod)
- (import_module current_mod (to_sym "std"))
+ (import_module current_loc current_mod (to_sym "std"))
(var ichan (open_in path))
(init_parser path ichan)
@@ -45,9 +45,9 @@
(add_include_dir "./")
(add_include_dir "/usr/lib/amber/")
(include_file "amber/syntax.ab")
- (import_module current_mod (qualified "std" (to_sym "syntax")))
+ (import_module current_loc current_mod (qualified "std" (to_sym "syntax")))
(include_file "amber/io.ab")
- (import_module current_mod (qualified "std" (to_sym "io")))
+ (import_module current_loc current_mod (qualified "std" (to_sym "io")))
(interpret)
(close_in ichan)
View
77 rowl1/rowl1-module.rlc
@@ -2,21 +2,22 @@
; rowl - 1st generation
; Copyright (C) 2010 nineties
;
-; $Id: rowl1-module.rlc 2012-01-26 02:01:13 nineties $
+; $Id: rowl1-module.rlc 2012-01-26 11:39:03 nineties $
;
; Module can be considered as a re-entrant scope.
; rowl (Amber) has a two kinds of modules; named module and anonymous module.
;
; Fields:
-; - sym : name of the module (nil for anonymous module)
-; - super : a link to module where this module is defined.
-; - imports : list of imported modules.
-; - children : sub-modules in module hierarchy.
-; - vtbl : variable table
-; - optbl : operator table (string representation -> operator)
-; - rptbl : operator table (operator head -> string representation)
-; - mark : visited mark
+; - sym : name of the module (nil for anonymous module)
+; - super : a link to module where this module is defined.
+; - imports : list of imported modules.
+; - children : sub-modules in module hierarchy.
+; - vtbl : variable table
+; - optbl : operator table (string representation -> operator)
+; - rptbl : operator table (operator head -> string representation)
+; - count : local variable index counter
+; - mark : visited mark
(import "rlvm-compile")
(import "rowl1-types")
@@ -30,7 +31,7 @@
(extern object current_loc)
(export fun make_module (sym super) (
- (var mod (variant @ModuleE 7
+ (var mod (variant @ModuleE 8
sym
super
0 ; list of imported modules
@@ -38,6 +39,7 @@
(make_symtable 10) ; variable table
(make_idtable) ; string represtation -> operator
(make_symtable 10) ; head -> string representation of operator
+ (list1 (box 0)) ; local variable index counter
0 ; visited-mark
))
(if super (do
@@ -65,8 +67,8 @@
(field_set curmod 3 (cons mod (list_delete mod (field_get curmod 3))))
))
-(export fun import_module (curmod sig) (
- (var mod (find_module current_loc curmod sig @FALSE))
+(export fun import_module (loc curmod sig) (
+ (var mod (find_module loc curmod sig @FALSE))
(add_module curmod mod)
))
@@ -74,15 +76,24 @@
(symtable_add (field_get mod 5) sym v)
))
-(export fun lookup_symbol (mod sym) (
- (return (lookup_symbol_iter (fresh_mark) mod sym))
+(export fun lookup_symbol (mod sig) (
+ (var hd (expr_head sig))
+ (if (== hd Symbol)
+ (return (lookup_symbol_iter (fresh_mark) mod sig))
+ (if (== hd Qualified)
+ (return (lookup_symbol
+ (find_module current_loc mod (expr_arg sig 0) @FALSE) (expr_arg sig 1)))
+ ))
+ (output_error stderr current_loc)
+ (output_string stderr "invalid argument for lookup_symbol\n")
+ (exit 1)
))
(fun lookup_symbol_iter (mark mod sym) (
(while mod (do
; check visited-mark
- (if (== (field_get mod 8) mark) break)
- (field_set mod 8 mark)
+ (if (== (field_get mod 9) mark) break)
+ (field_set mod 9 mark)
; First, lookup variable table.
(var tbl (field_get mod 5))
@@ -112,12 +123,28 @@
(return (symtable_find tbl sym))
))
+(export fun get_variable_count (mod) (
+ (return (unbox (car (field_get mod 8))))
+ ))
+
+(export fun reset_variable_count (mod) (
+ (setcar (field_get mod 8) (box 0))
+ ))
+
+(export fun incr_variable_count (mod) (
+ (var counters (field_get mod 8))
+ (setcar counters (+ (car counters) 2)) ; counters are boxed
+ ))
+
(export fun push_varscope (mod) (
(symtable_push (field_get mod 5))
+ (var counters (field_get mod 8))
+ (field_set mod 8 (cons (car counters) counters))
))
(export fun pop_varscope (mod) (
(symtable_pop (field_get mod 5))
+ (field_set mod 8 (cdr (field_get mod 8)))
))
; add definition of module variable `sym' to `mod'.
@@ -161,8 +188,8 @@
))
(fun update_display_iter (mark mod sym box) (
- (if (== (field_get mod 8) mark) return)
- (field_set mod 8 mark)
+ (if (== (field_get mod 9) mark) return)
+ (field_set mod 9 mark)
(var vtbl (field_get mod 5))
(var display (symtable_find_global vtbl sym))
(if (&& display (== (expr_arg display 1) false))
@@ -178,7 +205,7 @@
(export fun find_module (loc curmod sig createp) (
(var hd (expr_head sig))
(if (== hd Symbol) (do
- (var mod (lookup_symbol_local curmod sig))
+ (var mod (lookup_symbol curmod sig))
(if (&& mod (!= (node_type mod) @ModuleE)) (do
(output_loc stderr loc)
(output_string stderr "variable ")
@@ -222,10 +249,6 @@
(return (field_get mod 5))
))
-(export fun count_local_variable (mod) (
- (return (symtable_count_local (field_get mod 5)))
- ))
-
(export fun add_operator (mod repr head op) (
(var optbl (field_get mod 6))
(var rptbl (field_get mod 7))
@@ -240,8 +263,8 @@
(fun lookup_operator_iter (mark mod repr) (
(while mod (do
; check visited-mark
- (if (== (field_get mod 8) mark) break)
- (field_set mod 8 mark)
+ (if (== (field_get mod 9) mark) break)
+ (field_set mod 9 mark)
; First, lookup local operator table.
(var tbl (field_get mod 6))
@@ -268,8 +291,8 @@
(fun lookup_operator_from_head_iter (mark mod head) (
(while mod (do
; check visited-mark
- (if (== (field_get mod 8) mark) break)
- (field_set mod 8 mark)
+ (if (== (field_get mod 9) mark) break)
+ (field_set mod 9 mark)
; First, lookup local operator table.
(var tbl (field_get mod 7))
View
16 rowl1/rowl1-parse.rlc
@@ -2,7 +2,7 @@
; rowl - 1st generation
; Copyright (C) 2010 nineties
;
-; $Id: rowl1-parse.rlc 2012-01-26 07:18:11 nineties $
+; $Id: rowl1-parse.rlc 2012-01-26 07:57:07 nineties $
;
(import "rlvm-compile")
@@ -65,16 +65,18 @@
))
(fun parse_expr_top (tok offs) (
+ (var e 0)
(if (== tok @TOK_COMMAND) (do
(var op (get_token_boxed))
(var head (field_get op 1))
(= tok (lex_sub offs))
(if (== tok @TOK_END)
- (return (make_expr_user head 0))
- (return (make_expr_user head (list1 (parse_expr tok offs @FALSE))))
+ (= e (make_expr_user head 0))
+ (= e (make_expr_user head (list1 (parse_expr tok offs @FALSE))))
)
- ))
- (var e (parse_expr tok offs @FALSE))
+ )
+ (= e (parse_expr tok offs @FALSE))
+ )
(evaluate_parser_command e)
(return e)
))
@@ -93,7 +95,9 @@
(add_constr (expr_arg_symbol e 0) (expr_arg_string e 1))
(if (== ty DefCommand)
(add_command (expr_arg_symbol e 0) (expr_arg_string e 1))
- ))))))
+ (if (== ty Import)
+ (import_module (get_loc) current_mod (expr_arg e 0))
+ )))))))
))
(fun parse_expr (tok offs in_seq) (
View
6 rowl1/rowl1-symtable.rlc
@@ -2,7 +2,7 @@
; rowl - 1st generation
; Copyright (C) 2010 nineties
;
-; $Id: rowl1-symtable.rlc 2012-01-24 01:28:29 nineties $
+; $Id: rowl1-symtable.rlc 2012-01-26 08:32:52 nineties $
;
(import "rlvm-compile")
@@ -274,7 +274,9 @@
(var entry (vector_at entries i))
(if (! entry) continue)
(pretty_print ochan (field_get entry 0))
- (output_string ochan " => ")
+ (output_char ochan '(')
+ (output_int ochan (field_get entry 4))
+ (output_string ochan ") => ")
(pretty_print ochan (field_get entry 1))
(output_char ochan '\n')
))
View
52 sample/module.ab
@@ -0,0 +1,52 @@
+### definition of a module
+module A {
+ x: 0
+}
+
+# access by qualified identifier
+puts(A::x)
+A::x = 1
+puts(A::x)
+
+# access by import
+module B {
+ import A
+ puts(x)
+}
+
+# re-opening of the module
+module A {
+ x = 2
+}
+
+### module local syntax
+module A {
+ infixl Define "is" 19
+
+ y is x
+ puts(y)
+
+ module C {
+ # you can use the syntax in innner module
+ z is 0
+ puts(z)
+ }
+}
+# you can't use the syntax in outer module
+# z is 0 (invalid)
+
+module B {
+ # the new definitions in A is visible in B
+ puts(y)
+ z is y
+ puts(z)
+}
+
+### anonymous scope
+# you can import some module to anonymous scope
+f(): {
+ a : 1
+ b : 2
+ return a + b
+}
+puts(f())
Please sign in to comment.
Something went wrong with that request. Please try again.