Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Fixed specification of extensible parser.

  • Loading branch information...
commit 1fd1b05a3ae7ea788d1fb02dd72f6d28a60957c6 1 parent 8ac8840
@nineties authored
View
6 demo/lang/hyperlisp.ab
@@ -1,7 +1,7 @@
#!/usr/bin/amber -m
# Copyright (C) 2012 nineties
#
-# $Id: hyperlisp.ab 2013-03-06 22:56:40 nineties $
+# $Id: hyperlisp.ab 2013-03-14 20:44:04 nineties $
# Reference
# Masahiko Sato and Masami Hagiya: HyperLisp, Algorithmic Languages
@@ -19,5 +19,5 @@ open HyperLisp
# Switch to the HyperLisp interpreter.
-(eval, Parser::statement, Parser::comment)
- = (HyperLisp::hl_eval, HyperLisp::Parser::hl_expr, HyperLisp::Parser::hl_comment)
+(eval, Syntax::statement, Syntax::comment)
+ = (HyperLisp::hl_eval, HyperLisp::Syntax::hl_expr, HyperLisp::Syntax::hl_comment)
View
14 demo/lang/hyperlisp/lib/lambda.ab
@@ -1,6 +1,6 @@
# Copyright (C) 2012 nineties
#
-# $Id: hyperlisp/symbol.ab 2013-03-09 01:01:10 nineties $
+# $Id: hyperlisp/symbol.ab 2013-03-14 20:45:49 nineties $
# Reference
# Masahiko Sato and Masami Hagiya: HyperLisp, Algorithmic Languages
@@ -10,7 +10,6 @@
import core
module HyperLisp {
- module Parser {
# Metaliteral
hl_metaliteral ::= nospace( ([A-Z][A-Za-z0-9]*) )
{ `Meta{!$input.to_sym} }
@@ -22,7 +21,6 @@ module HyperLisp {
{ `Eq{!$0, !$2} }
| "." hl_expr
{ `Whole{!$1} }
- }
# Rename variables to avoid name conflict.
rename(sym): ("hyperlisp_" + sym).to_sym
@@ -220,16 +218,14 @@ module HyperLisp {
## Function definition
- module Parser {
# The symbol '#' is used for start symbol of comments in
# Amber's default syntax.
- hl_comment: C_style_comment
+ Syntax::hl_comment: Syntax::C_style_comment
hl_expr ::= <<multiline>>
"#" hl_literal hl_simple_expr "=" hl_expr ";"
{ cons_list([\Meta{Delta}, $1,
cons_list([\Meta{Lambda}, $2, $4])]) }
- }
# Extend eval and apply
eval_define(x): {
@@ -249,12 +245,10 @@ module HyperLisp {
| x@Snoc -> snoc(macro(x.car), macro(x.cdr))
| x -> x
- module Parser {
# lambda-abstraction and label-expression is just a syntax sugar.
# Therefore, they should be translated to sexp before evaluation.
- hl_expr_old: hl_expr
+ hl_expr_old: Syntax::hl_expr
hl_expr_macro ::= hl_expr_old { macro($0) }
- hl_expr = hl_expr_macro
- }
+ Syntax::hl_expr = Syntax::hl_expr_macro
}
View
4 demo/lang/hyperlisp/lib/literal.ab
@@ -1,6 +1,6 @@
# Copyright (C) 2012 nineties
#
-# $Id: hyperlisp/symbol.ab 2013-03-06 00:00:29 nineties $
+# $Id: hyperlisp/symbol.ab 2013-03-14 20:40:38 nineties $
# Reference
# Masahiko Sato and Masami Hagiya: HyperLisp, Algorithmic Languages
@@ -46,13 +46,11 @@ module HyperLisp {
(s.size == 1) ? zero : s[1..-1].to_sym
}
- module Parser {
# Extend Syntax
#
# A literal is a nonempty sequence of lowercase letters
hl_literal ::= nospace( [a-z]+ ) { $input.to_sym }
hl_simple_expr ::= hl_literal
- }
# Use Amber's default pretty-printer
}
View
4 demo/lang/hyperlisp/lib/syntax.ab
@@ -1,6 +1,6 @@
# Copyright (C) 2012 nineties
#
-# $Id: hyperlisp/syntax.ab 2013-03-08 17:44:35 nineties $
+# $Id: hyperlisp/syntax.ab 2013-03-14 20:40:46 nineties $
# Reference
# Masahiko Sato and Masami Hagiya: HyperLisp, Algorithmic Languages
@@ -10,7 +10,6 @@
import core
module HyperLisp {
- module Parser {
# Basic syntax
hl_simple_expr
::= "(" hl_expr "." hl_expr ")" { cons($1, $3) }
@@ -37,7 +36,6 @@ module HyperLisp {
::= hl_secondary_expr ":" hl_secondary_expr
{ cons_list([$0, $2]) }
| hl_secondary_expr
- }
# Pretty printing
is_cons_list
View
24 lib/amber/syntax.ab
@@ -1,10 +1,8 @@
-BeginModule{Qualified{Std, Parser}}
-
-Assign{comment, shell_style_comment}
+Assign{Qualified{Syntax,comment}, Qualified{Syntax,shell_style_comment}}
# Copyright (C) 2010 nineties
#
-# $Id: syntax.ab 2013-03-08 17:41:41 nineties $
+# $Id: syntax.ab 2013-03-14 20:36:48 nineties $
# Syntax definition of the Amber language.
# This file will be loaded first.
@@ -220,7 +218,7 @@ pattern ::= quote_expr
term ::= primary_expr
## enable use of quotation expressions for following definitions.
-Assign{expr, quote_expr}
+Assign{Qualified{Syntax,expr}, Qualified{Syntax,quote_expr}}
prefix_expr
::= "+" quote_expr { `UnaryPlus{!node1} }
@@ -310,7 +308,7 @@ assign_expr
| pattern ">>=" assign_expr { `ShiftRAssign{!node0, !node2} }
| multi_lambda_expr
-Assign{expr, assign_expr}
+Assign{Syntax::expr, Syntax::assign_expr}
### Statements
package ::= string
@@ -371,8 +369,6 @@ ReserveSymbol{not, and, or, when, open, if, else, case, of,
throw, try, catch, seq, scope
}
-EndModule{} # Std::Parser
-
## Syntax Sugars
+x => `uplus(!x)
-x => `uminus(!x)
@@ -403,16 +399,16 @@ x is not y => `(not identical(!x, !y))
x[args...] => `Apply{at, !Std::cons(x, args)}
x[args...] = e => `Apply{store, !Std::cons(x, Std::append(args, [e]))}
-module Std::Parser {
+module Syntax {
### Extend primary_expr so as to enable use $... to refer nodes
# of syntax-tree only in parser_action.
module Action {
- primary_expr ::= "$" decimal { ("node" + node1).to_sym }
- | "$input" { \input_text(parser,begin,end) }
+ primary_expr ::= "$" decimal { ("node" + node1).to_sym }
+ | "$input" { \input_text(parser,begin,end) }
}
# FIXME: This is temporary dirty hack.
- primary_expr_act : primary_expr | Action::primary_expr
+ primary_expr_act : primary_expr | Action::Syntax::primary_expr
parser_action_old: parser_action
parser_action = parser -> {
save_primary_expr: primary_expr
@@ -424,7 +420,7 @@ module Std::Parser {
### Syntax definitions which are effective only in shell-mode.
module Shell {
- primary_expr ::= "%" nospace(decimal) { `shell_outputs[!$1] }
- | "%" { `shell_outputs[0] }
+ primary_expr ::= "%" nospace(decimal) { `shell_outputs[!$1] }
+ | "%" { `shell_outputs[0] }
}
}
View
14 lib/data/table.ab
@@ -1,15 +1,13 @@
# Copyright (C) 2012 nineties
#
-# $Id: table.ab 2013-03-05 04:44:39 nineties $
+# $Id: table.ab 2013-03-14 20:38:14 nineties $
module Std {
- module Parser {
- table_entry ::= expr "=>" expr { ($0, $2) }
- postfix_expr
- ::= <<multiline>> "Table" "{" delimited(table_entry, ",") "}"
- { `Table::from_list(!$2) }
- }
-
each(tbl@Table): tbl.entries.each
reverse_each(tbl@Table): tbl.entries.reverse_each
}
+
+table_entry ::= expr "=>" expr { ($0, $2) }
+postfix_expr
+ ::= <<multiline>> "Table" "{" delimited(table_entry, ",") "}"
+ { `Table::from_list(!$2) }
View
34 lib/oop.ab
@@ -1,29 +1,25 @@
# Copyright (C) 2013 nineties
#
-# $Id: oop.ab 2013-03-05 05:41:52 nineties $
+# $Id: oop.ab 2013-03-14 16:48:06 nineties $
# Prototype-based Object-Oriented Programming
-module Std {
- module Parser {
- object_slot ::= symbol ":" expr { ($0, $2) }
- object_slots
- ::= <<multiline>> "{" delimited(object_slot, ",") "}" { $1 }
- | <<multiline>> "{" aligned(object_slot) "}" { $1 }
+object_slot ::= symbol ":" expr { ($0, $2) }
+object_slots
+ ::= <<multiline>> "{" delimited(object_slot, ",") "}" { $1 }
+ | <<multiline>> "{" aligned(object_slot) "}" { $1 }
- object_creation
- ::= <<multiline>> "make" symbol object_slots { `MakeSlots{!$1, !$2} }
+object_creation
+ ::= <<multiline>> "make" symbol object_slots { `MakeSlots{!$1, !$2} }
- prefix_expr ::= object_creation
- }
+prefix_expr ::= object_creation
- MakeSlots{head, fields} => {
- obj: gensym()
- inits: map(((x,v)) -> `set_slot(!obj, \!x, !v), fields)
- `{
- DefineVariable{!obj, MakeObject{\!head, []}}
- Seq{!inits}
- !obj
- }
+MakeSlots{head, fields} => {
+ obj: gensym()
+ inits: map(((x,v)) -> `set_slot(!obj, \!x, !v), fields)
+ `{
+ DefineVariable{!obj, MakeObject{\!head, []}}
+ Seq{!inits}
+ !obj
}
}
View
44 lib/printf.ab
@@ -1,6 +1,6 @@
# Copyright (C) 2010 nineties
#
-# $Id: printf.ab 2013-03-08 17:42:20 nineties $
+# $Id: printf.ab 2013-03-14 20:37:59 nineties $
module Std {
module Printf {
@@ -32,27 +32,25 @@ module Std {
}
}
- module Parser {
- ### Format string
- # XXX: Not good implementation (should not define new syntax)
+}
- format_string_element
- ::= "%" [sSdXobpf] { $input }
- | "%" . { throw `SyntaxError{!LOCATION,
- "Invalid format string", !($0 + $1)}
- }
- | nospace( [^%\""]+ ) { $input.unescape }
-
- format_string
- ::= nospace( ('"' format_string_element* '"') ) { $0[1] }
+### Format string
+# XXX: Not good implementation (should not define new syntax)
- postfix_expr
- ::= "printf" "(" format_string ("," expr)* ")"
- { Printf::compile_printf(\stdout, $2, map(x->x[1], $3)) }
- | "printf" "(" expr "," format_string ("," expr)* ")"
- { Printf::compile_printf($2, $4, map(x->x[1], $5)) }
- | "format" "(" format_string ("," expr)* ")"
- { Printf::compile_format($2, map(x->x[1], $3))}
- }
-
-}
+format_string_element
+ ::= "%" [sSdXobpf] { $input }
+ | "%" . { throw `SyntaxError{!LOCATION,
+ "Invalid format string", !($0 + $1)}
+ }
+ | nospace( [^%\""]+ ) { $input.unescape }
+
+format_string
+ ::= nospace( ('"' format_string_element* '"') ) { $0[1] }
+
+postfix_expr
+ ::= "printf" "(" format_string ("," expr)* ")"
+ { Std::Printf::compile_printf(\stdout, $2, map(x->x[1], $3)) }
+ | "printf" "(" expr "," format_string ("," expr)* ")"
+ { Std::Printf::compile_printf($2, $4, map(x->x[1], $5)) }
+ | "format" "(" format_string ("," expr)* ")"
+ { Std::Printf::compile_format($2, map(x->x[1], $3))}
View
14 lib/unittest.ab
@@ -1,6 +1,6 @@
# Copyright (C) 2012 nineties
#
-# $Id: UnitTest.ab 2013-03-05 04:32:29 nineties $
+# $Id: UnitTest.ab 2013-03-14 20:37:40 nineties $
#USAGE :
#
@@ -10,13 +10,11 @@
# }
# }
-module Parser {
- statement
- ::= "test" string block { `UnitTestTarget{!$1, !$2} }
- | string ":" test_code { `UnitTestItem{!$0, !$2} }
- ReserveSymbol{test}
- test_code ::= expr
-}
+statement
+ ::= "test" string block { `UnitTestTarget{!$1, !$2} }
+ | string ":" test_code { `UnitTestItem{!$0, !$2} }
+ReserveSymbol{test}
+test_code ::= expr
UnitTestTarget{target, tests} => `{
printf("=== tests of %s ===\n\n", !target)
View
6 rowl1/rowl1-compile.rlc
@@ -2,7 +2,7 @@
; rowl - 1st generation
; Copyright (C) 2010 nineties
;
-; $Id: rowl1-compile.rlc 2013-03-09 00:50:53 nineties $
+; $Id: rowl1-compile.rlc 2013-03-13 23:08:17 nineties $
;
(import "rlvm-compile")
@@ -1036,9 +1036,9 @@
(fun load_module_variable (sym node) (
(var v (car (field_get node 1)))
- (if (== v uninitialized) (do
+ (if (== v uninitialized)
(throw (undefined_var current_loc sym))
- ))
+ )
(return v)
))
View
4 rowl1/rowl1-error.rlc
@@ -2,7 +2,7 @@
; rowl - 1st generation
; Copyright (C) 2010 nineties
;
-; $Id: rowl1-node.rlc 2013-03-08 06:55:09 nineties $
+; $Id: rowl1-node.rlc 2013-03-09 12:33:05 nineties $
;
(import "rlvm-compile")
@@ -22,7 +22,7 @@
(export fun type_error (loc required actual) (
(return (make_object3 (to_sym "TypeError") loc
(make_object1 (to_sym "expected") required)
- (make_object1 (to_sym "actual") actual)
+ (make_object1 (to_sym "value") actual)
))
))
View
20 rowl1/rowl1-interp.rlc
@@ -2,7 +2,7 @@
; rowl - 1st generation
; Copyright (C) 2010 nineties
;
-; $Id: rowl1-interp.rlc 2013-03-09 02:03:33 nineties $
+; $Id: rowl1-interp.rlc 2013-03-14 20:33:34 nineties $
;
(import "rlvm-compile")
@@ -21,6 +21,8 @@
(import "rowl1-pprint")
(export var global null)
+(export var syntax null)
+
(export var current_loc null)
(export var current_mod null)
(export fun set_loc (loc) (
@@ -65,11 +67,12 @@
(return r)
))
-(export fun eval_main (file ichan argc argv) (
+(fun eval_main (file ichan argc argv) (
;(var start (gettimeofday))
- (= global (make_module 0 (to_sym "Global")))
+ (= global (make_module 0 (to_sym "Global")))
(add_module_variable global (to_sym "Global") @C_TRUE global)
+ (= syntax (create_module global Syntax))
(= module_stack (cons global 0))
@@ -79,7 +82,7 @@
(setup_globals)
(setup_builtin_compilers)
(init_stdlib)
- (open_module global (to_sym "Std"))
+ (open_module global Std)
(open_module global (qualified "Std" (to_sym "IO")))
(init_parser_funcs)
@@ -321,8 +324,15 @@
(fun eval_define_syntax (expr) (
(var sym (node_arg expr 0))
(var elm (node_arg expr 1))
+
(var stmt (compile_define_syntax sym elm))
+
+ (var syntax_mod (create_module current_mod Syntax))
+ (open_module syntax_mod (qualified "Global" Syntax))
+ (var save_current_mod current_mod)
+ (set_current_module syntax_mod)
(eval stmt)
+ (set_current_module save_current_mod)
(return @C_NIL)
))
@@ -579,7 +589,7 @@
(extern fun setup_gc)
(fun init_stdlib () (
- (var std (create_module global (to_sym "Std")))
+ (var std (create_module global Std))
(setup_pprint std)
(setup_base std)
(setup_symbol std)
View
29 rowl1/rowl1-module.rlc
@@ -2,7 +2,7 @@
; rowl - 1st generation
; Copyright (C) 2010 nineties
;
-; $Id: rowl1-module.rlc 2013-03-06 19:18:46 nineties $
+; $Id: rowl1-module.rlc 2013-03-14 20:33:36 nineties $
;
; Module
@@ -93,7 +93,7 @@
(export fun get_module_variable_disp (sym info) (
(if (!= (node_bhead info) ModuleVariable) (do
(throw (unexpected_error current_loc
- (string "module variable is required2")
+ (string "module variable is required")
info))
))
(return (node_arg info 0))
@@ -161,11 +161,11 @@
))
))
-(fun lookup_all_funcs (mod sym) (
- (return (list_reverse (lookup_all_funcs_sub (fresh_mark) mod sym 0)))
+(fun lookup_all_symbols (mod sym) (
+ (return (list_reverse (lookup_all_symbols_sub (fresh_mark) mod sym 0)))
))
-(fun lookup_all_funcs_sub (mark mod sym list) (
+(fun lookup_all_symbols_sub (mark mod sym list) (
(if (== (get_mark mod) mark) (return list))
(set_mark mod mark)
@@ -180,14 +180,14 @@
(var mods (delegatees mod))
(while mods (do
- (= list (lookup_all_funcs_sub mark (car mods) sym list))
+ (= list (lookup_all_symbols_sub mark (car mods) sym list))
(= mods (cdr mods))
))
(return list)
))
(fun update_function_entry (mod sym) (
- (var disps (lookup_all_funcs mod sym))
+ (var disps (lookup_all_symbols mod sym))
(var disp (car disps)) ; current module
(var other (cdr disps)) ; delegatees
(var fun (car disp))
@@ -292,13 +292,14 @@
sig))
)
- (var mod (lookup_symbol curmod sig @FALSE))
- (if mod (do
- (= mod (get_module_variable_value sig mod))
- (if (!= (node_type mod) @ModuleE)
- (throw (type_error current_loc (string "module") mod))
- )
- (return mod)
+ (var mod (lookup_symbol_current_module curmod sig @TRUE))
+ (if mod
+ (do
+ (= mod (get_module_variable_value sig mod))
+ (if (!= (node_type mod) @ModuleE)
+ (throw (type_error current_loc (string "module") mod))
+ )
+ (return mod)
))
(return (make_module curmod sig))
))
View
5 rowl1/rowl1-node.rlc
@@ -2,7 +2,7 @@
; rowl - 1st generation
; Copyright (C) 2010 nineties
;
-; $Id: rowl1-node.rlc 2013-03-02 11:49:44 nineties $
+; $Id: rowl1-node.rlc 2013-03-13 01:38:08 nineties $
;
(import "rlvm-compile")
@@ -131,6 +131,9 @@
(export var StringIO (to_builtin_sym "StringIO"))
(export var Module (to_builtin_sym "Module"))
+(export var Syntax (to_sym "Syntax"))
+(export var Std (to_sym "Std"))
+
; Builtin headers
(export var BSymbol (to_builtin_sym "Symbol"))
(export var BInt (to_builtin_sym "Int"))
View
107 rowl1/rowl1-packrat.rlc
@@ -2,7 +2,7 @@
; rowl - 1st generation
; Copyright (C) 2010 nineties
;
-; $Id: rowl1-packrat.rlc 2013-03-09 00:38:51 nineties $
+; $Id: rowl1-packrat.rlc 2013-03-14 02:01:23 nineties $
;
(import "rlvm-compile")
@@ -78,6 +78,9 @@
(import "rowl1-module")
(import "rowl1-error")
+(extern object global)
+(extern object syntax)
+
(array char chgroup (
0 16 16 16 16 16 16 16 16 1 1 16 16 1 16 16
16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16
@@ -1126,7 +1129,7 @@
(extern fun eval_end_module)
(export fun parse_statements (p) (
(var save_current_mod current_mod)
- (set_current_module (find_module current_mod (to_sym "Parser")))
+ (set_current_module (find_module current_mod Syntax))
(var eof (parse_statements_sub p))
(set_current_module save_current_mod)
(return eof)
@@ -1168,7 +1171,8 @@
(export fun parse_shell_statement (p) (
(var save_current_mod current_mod)
- (set_current_module (find_module current_mod (to_sym "Parser")))
+ (set_current_module syntax)
+ (set_current_module (find_module current_mod Syntax))
(var v (parse_shell_statement_sub p))
(set_current_module save_current_mod)
(return v)
@@ -1966,61 +1970,60 @@
(add_function1 mod sym (domainP Parser) func 0)
))
+(extern object global)
+(extern object syntax)
+
(export fun enable_shell_syntax () (
- (open_module
- (find_module current_mod (to_sym "Parser"))
- (to_sym "Shell"))
+ (open_module syntax (to_sym "Shell"))
))
-(extern object global)
(export fun init_parser_funcs () (
- (= parser_mod (make_module global (to_sym "Parser")))
- (add_function1 parser_mod (to_sym "%get_column") DontCare get_column 0)
- (add_function2 parser_mod (to_sym "%set_indent") DontCare DontCare set_indent 0)
- (add_function1 parser_mod (to_sym "%check_indent") DontCare check_indent 0)
- (add_function2 parser_mod (to_sym "%parsed") DontCare DontCare parsed 0)
- (add_function2 parser_mod (to_sym "%noparse") DontCare DontCare noparse 0)
- (add_function1 parser_mod (to_sym "%copy_parser_state") DontCare copy_parser_state 0)
- (add_function2 parser_mod (to_sym "%reset_parser_position") DontCare DontCare reset_parser_position 0)
- (add_function2 parser_mod (to_sym "%set_parser_state") DontCare DontCare set_parser_state 0)
- (add_function1 parser_mod (to_sym "%print_parser_state") DontCare print_parser_state 0)
- (add_function4 parser_mod (to_sym "%call_parser") DontCare DontCare DontCare DontCare call_parser 0)
- (add_function1 parser_mod (to_sym "%negate") DontCare negate 0)
- (add_function3 parser_mod (to_sym "%oneof") DontCare DontCare DontCare oneof 0)
- (add_function3 parser_mod (to_sym "%noneof") DontCare DontCare DontCare noneof 0)
- (add_function1 parser_mod (to_sym "%apply_located") DontCare apply_located 0)
- (add_function1 parser_mod (to_sym "%get_pos") DontCare get_pos 0)
+ (add_function1 syntax (to_sym "%get_column") DontCare get_column 0)
+ (add_function2 syntax (to_sym "%set_indent") DontCare DontCare set_indent 0)
+ (add_function1 syntax (to_sym "%check_indent") DontCare check_indent 0)
+ (add_function2 syntax (to_sym "%parsed") DontCare DontCare parsed 0)
+ (add_function2 syntax (to_sym "%noparse") DontCare DontCare noparse 0)
+ (add_function1 syntax (to_sym "%copy_parser_state") DontCare copy_parser_state 0)
+ (add_function2 syntax (to_sym "%reset_parser_position") DontCare DontCare reset_parser_position 0)
+ (add_function2 syntax (to_sym "%set_parser_state") DontCare DontCare set_parser_state 0)
+ (add_function1 syntax (to_sym "%print_parser_state") DontCare print_parser_state 0)
+ (add_function4 syntax (to_sym "%call_parser") DontCare DontCare DontCare DontCare call_parser 0)
+ (add_function1 syntax (to_sym "%negate") DontCare negate 0)
+ (add_function3 syntax (to_sym "%oneof") DontCare DontCare DontCare oneof 0)
+ (add_function3 syntax (to_sym "%noneof") DontCare DontCare DontCare noneof 0)
+ (add_function1 syntax (to_sym "%apply_located") DontCare apply_located 0)
+ (add_function1 syntax (to_sym "%get_pos") DontCare get_pos 0)
; Use internal version of list operations considering redefinition of them.
- (add_function2 parser_mod (to_sym "%cons") DontCare DontCare __cons 0)
- (add_function1 parser_mod (to_sym "%reverse") DontCare __reverse 0)
- (add_function1 parser_mod (to_sym "%length") DontCare __length 0)
-
- (add_function3 parser_mod (to_sym "input_text") (domainP Parser) intT intT get_input_text 0)
-
- (add_parser parser_mod (to_sym "spaces") parse_spaces)
- (add_parser parser_mod (to_sym "blanks") parse_blanks)
-
- (add_function2 parser_mod (to_sym "text") (domainP Parser) stringT parse_text 0)
- (add_parser parser_mod (to_sym "any") parse_any_char)
- (add_parser parser_mod (to_sym "blank") parse_blank)
- (add_parser parser_mod (to_sym "comment") parse_fail)
- (add_parser parser_mod (to_sym "shell_style_comment") parse_shell_style_comment)
- (add_parser parser_mod (to_sym "C_style_comment") parse_C_style_comment)
- (add_parser parser_mod (to_sym "decimal") parse_decimal)
- (add_parser parser_mod (to_sym "binary") parse_binary)
- (add_parser parser_mod (to_sym "octal") parse_octal)
- (add_parser parser_mod (to_sym "hex") parse_hex)
- (add_parser parser_mod (to_sym "integer") parse_integer)
- (add_parser parser_mod (to_sym "float") parse_float)
- (add_parser parser_mod (to_sym "string") parse_string)
- (add_parser parser_mod (to_sym "string_d") parse_string_d)
- (add_parser parser_mod (to_sym "string_s") parse_string_s)
- (add_parser parser_mod (to_sym "symbol") parse_symbol)
- (add_parser parser_mod (to_sym "atom") parse_atom)
- (add_parser parser_mod (to_sym "object") parse_object)
- (add_parser parser_mod (to_sym "expr") parse_expr)
- (add_parser parser_mod (to_sym "statement") parse_statement)
+ (add_function2 syntax (to_sym "%cons") DontCare DontCare __cons 0)
+ (add_function1 syntax (to_sym "%reverse") DontCare __reverse 0)
+ (add_function1 syntax (to_sym "%length") DontCare __length 0)
+
+ (add_function3 syntax (to_sym "input_text") (domainP Parser) intT intT get_input_text 0)
+
+ (add_parser syntax (to_sym "spaces") parse_spaces)
+ (add_parser syntax (to_sym "blanks") parse_blanks)
+
+ (add_function2 syntax (to_sym "text") (domainP Parser) stringT parse_text 0)
+ (add_parser syntax (to_sym "any") parse_any_char)
+ (add_parser syntax (to_sym "blank") parse_blank)
+ (add_parser syntax (to_sym "comment") parse_fail)
+ (add_parser syntax (to_sym "shell_style_comment") parse_shell_style_comment)
+ (add_parser syntax (to_sym "C_style_comment") parse_C_style_comment)
+ (add_parser syntax (to_sym "decimal") parse_decimal)
+ (add_parser syntax (to_sym "binary") parse_binary)
+ (add_parser syntax (to_sym "octal") parse_octal)
+ (add_parser syntax (to_sym "hex") parse_hex)
+ (add_parser syntax (to_sym "integer") parse_integer)
+ (add_parser syntax (to_sym "float") parse_float)
+ (add_parser syntax (to_sym "string") parse_string)
+ (add_parser syntax (to_sym "string_d") parse_string_d)
+ (add_parser syntax (to_sym "string_s") parse_string_s)
+ (add_parser syntax (to_sym "symbol") parse_symbol)
+ (add_parser syntax (to_sym "atom") parse_atom)
+ (add_parser syntax (to_sym "object") parse_object)
+ (add_parser syntax (to_sym "expr") parse_expr)
+ (add_parser syntax (to_sym "statement") parse_statement)
))
(export fun output_syntax_error (loc e) (
View
8 rowl1/rowl1-util.rlc
@@ -2,7 +2,7 @@
; rowl - 1st generation
; Copyright (C) 2010 nineties
;
-; $Id: rowl1-util.rlc 2013-02-09 22:48:27 nineties $
+; $Id: rowl1-util.rlc 2013-03-10 23:03:20 nineties $
;
(import "rlvm-compile")
@@ -169,6 +169,12 @@
(return ret)
))
+(export fun list_insert_uniq (val ls) (
+ (if (! ls) (return (list1 val)))
+ (if (== (car ls) val) (return ls))
+ (return (cons (car ls) (list_insert_uniq val (cdr ls))))
+ ))
+
(export fun list_member (val ls) (
(while ls (do
(if (== val (car ls)) (return @TRUE))
View
12 sample/module.ab
@@ -22,16 +22,14 @@ puts(A::x)
### module local syntax
module A {
- module Parser {
- statement ::= symbol "is" expr
- { `(!node0 : !node2) }
- }
+ statement ::= "var" symbol expr
+ { `(!node1 : !node2) }
- y is x
+ var y x
puts(y)
module C {
# you can use the syntax in innner modules
- z is 0
+ var z 0
puts(z)
}
}
@@ -39,6 +37,6 @@ module A {
module B {
# the new definitions in A is visible in its super modules
puts(y)
- z is y
+ var z y
puts(z)
}
View
14 test/matching.ab
@@ -1,14 +1,12 @@
-# $Id: matching.ab 2013-03-05 04:37:52 nineties $
+# $Id: matching.ab 2013-03-14 20:37:24 nineties $
import unittest
-module Parser {
- test_code
- ::= pattern "matches" pattern
- { `((!$0 -> true)(!$2) == true) }
- | pattern "doesn't" "match" pattern
- { `((!$0 -> true)(!$3) == undef) }
-}
+test_code
+ ::= pattern "matches" pattern
+ { `((!$0 -> true)(!$2) == true) }
+ | pattern "doesn't" "match" pattern
+ { `((!$0 -> true)(!$3) == undef) }
test "pattern-matching engine (positive check)"
"dontcare pattern": _ matches 0
Please sign in to comment.
Something went wrong with that request. Please try again.