Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Working snapshot of refinement of parser.

  • Loading branch information...
commit d8ad657c17ce003877891cf82b13366da97384d0 1 parent 94b2504
nineties authored
View
61 lib/amber/syntax.ab
@@ -1,8 +1,10 @@
-Assign{Qualified{Syntax,comment}, Qualified{Syntax,shell_style_comment}}
+BeginModule{Std}
+
+Assign{parse_comment, parse_shell_style_comment}
# Copyright (C) 2010 nineties
#
-# $Id: syntax.ab 2013-03-25 14:09:21 nineties $
+# $Id: syntax.ab 2013-03-28 16:49:10 nineties $
# Syntax definition of the Amber language.
# This file will be loaded first.
@@ -215,7 +217,7 @@ pattern ::= quote_expr
term ::= quote_expr
## enable use of quotation expressions for following definitions.
-Assign{Qualified{Syntax,expr}, Qualified{Syntax,quote_expr}}
+Assign{parse_expr, parse_quote_expr}
prefix_expr
::= "+" quote_expr { `UnaryPlus{!node1} }
@@ -313,7 +315,7 @@ assign_expr
| pattern ">>=" assign_expr { `ShiftRAssign{!node0, !node2} }
| multi_lambda_expr
-Assign{Syntax::expr, Syntax::assign_expr}
+Assign{parse_expr, parse_assign_expr}
### Statements
package ::= string
@@ -436,32 +438,33 @@ x != y => `(not equal(!x, !y))
x is y => `identical(!x, !y)
x is not y => `(not identical(!x, !y))
-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) }
+### Extend primary_expr so as to enable use $... to refer nodes
+# of syntax-tree only in parser_action.
+parser_action_ext ::= "$" decimal { ("node" + node1).to_sym }
+ | "$input" { \input_text(parser,begin,end) }
+
+# Enable the syntax `parser_action_ext' only during parsing
+# `parser_action'.
+# FIXME: This is temporary dirty hack.
+parse_parser_action = {
+ parse_primary_expr_act: parse_primary_expr | parse_parser_action_ext
+ parse_parser_action_old: parse_parser_action
+
+ parser -> {
+ save_parse_primary_expr: parse_primary_expr
+ parse_primary_expr = parse_primary_expr_act
+ ret: parse_parser_action_old(parser)
+ parse_primary_expr = save_parse_primary_expr
+ return ret
}
+}
- # FIXME: This is temporary dirty hack.
- primary_expr_act : primary_expr | Action::Syntax::primary_expr
- parser_action_old: parser_action
- parser_action = parser -> {
- save_primary_expr: primary_expr
- primary_expr = primary_expr_act
- r: parser_action_old(parser)
- primary_expr = save_primary_expr
- r
- }
+### Syntax definitions which are effective only in shell-mode.
+shell_ext ::= "%" nospace(decimal) { `shell_outputs[!$1] }
+ | "%" { `shell_outputs[0] }
- ### Syntax definitions which are effective only in shell-mode.
- module Shell {
- primary_expr ::= "%" nospace(decimal) { `shell_outputs[!$1] }
- | "%" { `shell_outputs[0] }
- }
-
- enable_shell_syntax(): {
- primary_expr = primary_expr | Shell::Syntax::primary_expr
- }
+enable_shell_syntax(): {
+ parse_primary_expr = parse_primary_expr | parse_shell_ext
}
+
+EndModule{} # Std
View
39 lib/std/format.ab
@@ -1,6 +1,6 @@
# Copyright (C) 2010 nineties
#
-# $Id: format.ab 2013-03-17 22:57:44 nineties $
+# $Id: format.ab 2013-03-28 16:51:14 nineties $
module Std {
module Format {
@@ -32,25 +32,24 @@ module Std {
}
}
-}
-
-### Format string
-# XXX: Not good implementation (should not define new syntax)
+ ### 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_element
+ ::= "%" [sSdXobpf] { $input }
+ | "%" . { throw `SyntaxError{!LOCATION,
+ "Invalid format string", !($0 + $1)}
+ }
+ | nospace( [^%\""]+ ) { $input.unescape }
-format_string
- ::= nospace( ('"' format_string_element* '"') ) { $0[1] }
+ format_string
+ ::= nospace( ('"' format_string_element* '"') ) { $0[1] }
-postfix_expr
- ::= "printf" "(" format_string ("," expr)* ")"
- { Std::Format::compile_printf(\stdout, $2, map(x->x[1], $3)) }
- | "printf" "(" expr "," format_string ("," expr)* ")"
- { Std::Format::compile_printf($2, $4, map(x->x[1], $5)) }
- | "format" "(" format_string ("," expr)* ")"
- { Std::Format::compile_format($2, map(x->x[1], $3))}
+ postfix_expr
+ ::= "printf" "(" format_string ("," expr)* ")"
+ { Std::Format::compile_printf(\stdout, $2, map(x->x[1], $3)) }
+ | "printf" "(" expr "," format_string ("," expr)* ")"
+ { Std::Format::compile_printf($2, $4, map(x->x[1], $5)) }
+ | "format" "(" format_string ("," expr)* ")"
+ { Std::Format::compile_format($2, map(x->x[1], $3))}
+}
View
8 lib/unittest.ab
@@ -1,6 +1,6 @@
# Copyright (C) 2012 nineties
#
-# $Id: unittest.ab 2013-03-17 18:18:06 nineties $
+# $Id: unittest.ab 2013-03-28 16:52:46 nineties $
#USAGE :
#
@@ -10,9 +10,9 @@
# }
# }
-statement
- ::= "test" string block { `UnitTestTarget{!$1, !$2} }
- | string ":" test_code { `UnitTestItem{!$0, !$2} }
+statement ::= "test" string block { `UnitTestTarget{!$1, !$2} }
+ | string ":" test_code { `UnitTestItem{!$0, !$2} }
+
ReserveSymbol{test}
test_code ::= expr
View
21 rowl1/rowl1-interp.rlc
@@ -2,7 +2,7 @@
; rowl - 1st generation
; Copyright (C) 2010 nineties
;
-; $Id: rowl1-interp.rlc 2013-03-23 22:57:06 nineties $
+; $Id: rowl1-interp.rlc 2013-03-28 14:09:11 nineties $
;
(import "rlvm-compile")
@@ -21,7 +21,7 @@
(import "rowl1-pprint")
(export var global null)
-(export var syntax null)
+(export var std null)
(export var current_loc null)
(export var current_mod null)
@@ -70,9 +70,9 @@
(fun eval_main (file ichan argc argv) (
;(var start (gettimeofday))
- (= global (make_module 0 (to_sym "Global")))
+ (= global (make_module 0 (to_sym "Global")))
+ (= std (create_module global Std))
(add_module_variable global (to_sym "Global") @C_TRUE global)
- (= syntax (create_module global Syntax))
(= module_stack (cons global 0))
@@ -326,15 +326,7 @@
(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)
+ (eval (compile_define_syntax sym elm))
(return @C_NIL)
))
@@ -548,7 +540,7 @@
(add_module_variable global (to_sym "shell_mode") @C_FALSE @C_FALSE)
)
- (add_function1 global Rewrite (domainP Located) rewrite_located 0)
+ (add_function1 std Rewrite (domainP Located) rewrite_located 0)
(add_function1 global Eval DontCare default_eval 0)
(add_function1 global Eval (domainP Located) eval_located 0)
(add_function1 global Eval (make_object1 Open DontCare) eval_open 0)
@@ -592,7 +584,6 @@
(extern fun setup_gc)
(fun init_stdlib () (
- (var std (create_module global Std))
(setup_pprint std)
(setup_base std)
(setup_symbol std)
View
3  rowl1/rowl1-node.rlc
@@ -2,7 +2,7 @@
; rowl - 1st generation
; Copyright (C) 2010 nineties
;
-; $Id: rowl1-node.rlc 2013-03-17 11:56:31 nineties $
+; $Id: rowl1-node.rlc 2013-03-28 06:00:49 nineties $
;
(import "rlvm-compile")
@@ -131,7 +131,6 @@
(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
View
148 rowl1/rowl1-packrat.rlc
@@ -2,7 +2,7 @@
; rowl - 1st generation
; Copyright (C) 2010 nineties
;
-; $Id: rowl1-packrat.rlc 2013-03-25 14:05:45 nineties $
+; $Id: rowl1-packrat.rlc 2013-03-28 14:10:13 nineties $
;
(import "rlvm-compile")
@@ -64,7 +64,8 @@
`(do
(do . @(map (lambda (f)
`(do
- (if (== (parse @(tos f) @p) @C_TRUE) (goto @end_lbl))
+ (if (== (parse @(++ "parse_" (tos f)) @p) @C_TRUE)
+ (goto @end_lbl))
)) ps))
(label @end_lbl)
)))
@@ -233,6 +234,10 @@
)))
))
+(fun toparse (sym) (
+ (return (to_sym (strcat "parse_" (symbol_name sym))))
+ ))
+
(export fun set_shell_mode () (
(= shell_mode_p @TRUE)
))
@@ -849,8 +854,8 @@
(fun parse_blanks_ (p) (
(var pos (get_pos p))
- (var blank (lookup_func current_mod (to_sym "blank")))
- (var comment (lookup_func current_mod (to_sym "comment")))
+ (var blank (lookup_func current_mod (to_sym "parse_blank")))
+ (var comment (lookup_func current_mod (to_sym "parse_comment")))
(while @TRUE (do
(byterun blank p)
(if @(PARSED p) continue)
@@ -867,8 +872,8 @@
(fun parse_spaces_ (p) (
(var pos (get_pos p))
- (var blank (lookup_func current_mod (to_sym "blank")))
- (var comment (lookup_func current_mod (to_sym "comment")))
+ (var blank (lookup_func current_mod (to_sym "parse_blank")))
+ (var comment (lookup_func current_mod (to_sym "parse_comment")))
(while @TRUE (do
(byterun blank p)
(if @(PARSED p) continue)
@@ -1040,7 +1045,7 @@
(var args 0)
(if (!= (lookahead p) '}') (do
(while (> (lookahead p) 0) (do
- (parse "expr" p)
+ (parse "parse_expr" p)
@(CHECK p)
(= args (cons @(TOKEN p) args))
(parse_spaces p)
@@ -1098,7 +1103,7 @@
@(MEMOIZE expr)
(fun parse_statement_ (p) (
- (return (parse "expr" p))
+ (return (parse "parse_expr" p))
))
@(MEMOIZE statement)
@@ -1106,7 +1111,7 @@
(var state (copy_parser_state p))
(parse_text p "module")
(parse_spaces p)
- (parse "qualified_symbol" p)
+ (parse "parse_qualified_symbol" p)
@(CHECK p)
(var mod @(TOKEN p))
(parse_spaces p)
@@ -1119,23 +1124,13 @@
(if (lookahead_text p "module") (do
(if (== (parse_begin_module p) @C_TRUE) (return @C_TRUE))
))
- (parse "statement" p)
+ (parse "parse_statement" p)
(if @(PARSED p) return)
(if (== (parse_char p '}') @C_FALSE) return)
(parsed p (make_object0 EndModule))
))
-(extern fun eval_begin_module)
-(extern fun eval_end_module)
(export fun parse_statements (p) (
- (var save_current_mod current_mod)
- (set_current_module (find_module current_mod Syntax))
- (var eof (parse_statements_sub p))
- (set_current_module save_current_mod)
- (return eof)
- ))
-
-(fun parse_statements_sub (p) (
(if (== (lookahead p) @EOF) (return @TRUE))
(parse_spaces p)
(if (== (lookahead p) @EOF) (return @TRUE))
@@ -1170,15 +1165,6 @@
))
(export fun parse_shell_statement (p) (
- (var save_current_mod current_mod)
- (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)
- ))
-
-(fun parse_shell_statement_sub (p) (
(print_prompt p "> ")
(reserve p)
(var state (copy_parser_state p))
@@ -1236,7 +1222,7 @@
))
(fun gen_parse_spaces () (
- (return (apply (to_sym "spaces") (list1 PVar)))
+ (return (apply (to_sym "parse_spaces") (list1 PVar)))
))
(fun gen_get_token () (
@@ -1283,11 +1269,11 @@
(var hd (node_bhead pat))
(if (== hd BSymbol)
(return (parse_with_check
- (apply pat (list1 PVar)) ws))
+ (apply (toparse pat) (list1 PVar)) ws))
)
(if (== hd BString)
(return (parse_with_check
- (apply (to_sym "text") (list2 PVar pat)) ws)))
+ (apply (to_sym "parse_text") (list2 PVar pat)) ws)))
(if (== hd List)
(return (compile_seq pat ws))
)
@@ -1952,7 +1938,7 @@
(var parser (apply (to_sym "%call_parser")
(list4 PVar (quote sym) (quote key) parser_body)))
(+= key_idx 1)
- (return (make_object2 DefFunction sym
+ (return (make_object2 DefFunction (toparse sym)
(lambda (make_object2 When
(list1 (make_object2 Domain PVar Parser)) parser)
@C_TRUE)))
@@ -1971,59 +1957,59 @@
))
(extern object global)
-(extern object syntax)
+(extern object std)
(export fun enable_shell_syntax () (
- (call0 (qualified "Syntax" (to_sym "enable_shell_syntax")))
+ (call0 (to_sym "enable_shell_syntax"))
))
(export fun init_parser_funcs () (
- (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 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)
+ (add_function1 global (to_sym "%get_column") DontCare get_column 0)
+ (add_function2 global (to_sym "%set_indent") DontCare DontCare set_indent 0)
+ (add_function1 global (to_sym "%check_indent") DontCare check_indent 0)
+ (add_function2 global (to_sym "%parsed") DontCare DontCare parsed 0)
+ (add_function2 global (to_sym "%noparse") DontCare DontCare noparse 0)
+ (add_function1 global (to_sym "%copy_parser_state") DontCare copy_parser_state 0)
+ (add_function2 global (to_sym "%reset_parser_position") DontCare DontCare reset_parser_position 0)
+ (add_function2 global (to_sym "%set_parser_state") DontCare DontCare set_parser_state 0)
+ (add_function1 global (to_sym "%print_parser_state") DontCare print_parser_state 0)
+ (add_function4 global (to_sym "%call_parser") DontCare DontCare DontCare DontCare call_parser 0)
+ (add_function1 global (to_sym "%negate") DontCare negate 0)
+ (add_function3 global (to_sym "%oneof") DontCare DontCare DontCare oneof 0)
+ (add_function3 global (to_sym "%noneof") DontCare DontCare DontCare noneof 0)
+ (add_function1 global (to_sym "%apply_located") DontCare apply_located 0)
+ (add_function1 global (to_sym "%get_pos") DontCare get_pos 0)
+
+ ; Use internal globaln of list operations considering redefinition of them.
+ (add_function2 global (to_sym "%cons") DontCare DontCare __cons 0)
+ (add_function1 global (to_sym "%reverse") DontCare __reverse 0)
+ (add_function1 global (to_sym "%length") DontCare __length 0)
+
+ (add_function3 std (to_sym "input_text") (domainP Parser) intT intT get_input_text 0)
+
+ (add_parser std (to_sym "parse_spaces") parse_spaces)
+ (add_parser std (to_sym "parse_blanks") parse_blanks)
+
+ (add_function2 std (to_sym "parse_text") (domainP Parser) stringT parse_text 0)
+ (add_parser std (to_sym "parse_any") parse_any_char)
+ (add_parser std (to_sym "parse_blank") parse_blank)
+ (add_parser std (to_sym "parse_comment") parse_fail)
+ (add_parser std (to_sym "parse_shell_style_comment") parse_shell_style_comment)
+ (add_parser std (to_sym "parse_C_style_comment") parse_C_style_comment)
+ (add_parser std (to_sym "parse_decimal") parse_decimal)
+ (add_parser std (to_sym "parse_binary") parse_binary)
+ (add_parser std (to_sym "parse_octal") parse_octal)
+ (add_parser std (to_sym "parse_hex") parse_hex)
+ (add_parser std (to_sym "parse_integer") parse_integer)
+ (add_parser std (to_sym "parse_float") parse_float)
+ (add_parser std (to_sym "parse_string") parse_string)
+ (add_parser std (to_sym "parse_string_d") parse_string_d)
+ (add_parser std (to_sym "parse_string_s") parse_string_s)
+ (add_parser std (to_sym "parse_symbol") parse_symbol)
+ (add_parser std (to_sym "parse_atom") parse_atom)
+ (add_parser std (to_sym "parse_object") parse_object)
+ (add_parser std (to_sym "parse_expr") parse_expr)
+ (add_parser std (to_sym "parse_statement") parse_statement)
))
(export fun output_syntax_error (loc e) (
View
12 test/matching.ab
@@ -1,12 +1,12 @@
-# $Id: matching.ab 2013-03-14 20:37:24 nineties $
+# $Id: matching.ab 2013-03-28 16:52:40 nineties $
import unittest
-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.