Skip to content

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.
  • 2 commits
  • 8 files changed
  • 0 commit comments
  • 1 contributor
Commits on Mar 25, 2013
nineties Add string times integer. 94b2504
Commits on Mar 28, 2013
nineties Working snapshot of refinement of parser. d8ad657
Showing with 147 additions and 158 deletions.
  1. +32 −29 lib/amber/syntax.ab
  2. +19 −20 lib/std/format.ab
  3. +4 −4 lib/unittest.ab
  4. +6 −15 rowl1/rowl1-interp.rlc
  5. +1 −2 rowl1/rowl1-node.rlc
  6. +67 −81 rowl1/rowl1-packrat.rlc
  7. +12 −1 rowl1/rowl1-string.rlc
  8. +6 −6 test/matching.ab
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
13 rowl1/rowl1-string.rlc
@@ -2,7 +2,7 @@
; rowl - 1st generation
; Copyright (C) 2010 nineties
;
-; $Id: rowl1-string.rlc 2013-02-23 14:39:22 nineties $
+; $Id: rowl1-string.rlc 2013-03-25 22:30:35 nineties $
;
(import "rlvm-compile")
@@ -53,6 +53,16 @@
(return (strcat a b))
))
+(fun s_mul (a n) (
+ (= n (unbox n))
+ (var m (strlen a))
+ (var s (allocate_string (* m n)))
+ (for i 0 n (do
+ (strcpy (+ s (* m i)) a)
+ ))
+ (return s)
+ ))
+
(fun s_unescape (s) (
(= s (strdup s))
(unescape_string_d s)
@@ -162,6 +172,7 @@
(add_function2 std (to_sym "add") stringT stringT s_add 0)
(add_function2 std (to_sym "add") stringT DontCare s_add2 0)
(add_function2 std (to_sym "add") DontCare stringT s_add2 0)
+ (add_function2 std (to_sym "mul") stringT intT s_mul 0)
(add_function1 std (to_sym "char") intT s_char 0)
(add_function1 std (to_sym "code") stringT s_code 0)
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

No commit comments for this range

Something went wrong with that request. Please try again.