From: handa Date: Thu, 17 Sep 2009 13:14:54 +0000 (+0000) Subject: *** empty log message *** X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=d03a372c57dcd3011c23ffe6f433441d5638a3ed;p=m17n%2Fm17n-lib-cs.git *** empty log message *** --- diff --git a/XmlExpr.cs b/XmlExpr.cs index 99ef8d5..ea2ebd3 100644 --- a/XmlExpr.cs +++ b/XmlExpr.cs @@ -426,19 +426,31 @@ namespace System.Xml.Expression } public void DefSubr (Builtin builtin, string str, - int min_arg, int max_arg) + int min_arg, int max_arg, params string[] aliases) { Name name = str; - functions[name] - = new Function.Subroutine (builtin, name, min_arg, max_arg); + Function func = new Function.Subroutine (builtin, name, + min_arg, max_arg); + functions[name] = func; + foreach (string a in aliases) + functions[(Name) a] = func; } public void DefSpecial (Builtin builtin, string str, - int min_arg, int max_arg) + int min_arg, int max_arg, + params string[] aliases) { Name name = str; - functions[name] - = new Function.SpecialForm (builtin, name, min_arg, max_arg); + Function func = new Function.SpecialForm (builtin, name, + min_arg, max_arg); + functions[name] = func; + foreach (string a in aliases) + functions[(Name) a] = func; + } + + public void DefAlias (string alias, string str) + { + functions[(Name) alias] = functions[(Name) str]; } internal Function.Lambda RegisterFunction (XmlNode node) @@ -598,68 +610,41 @@ namespace System.Xml.Expression static Xexpression () { - basic.DefSubr (set_value, "set", 2, 2); - basic.DefSubr (set_value, "=", 2, 2); - basic.DefSpecial (and, "and", 1, -1); - basic.DefSpecial (and, "&&", 1, -1); - basic.DefSpecial (or, "or", 1, -1); - basic.DefSpecial (or, "||", 1, -1); - basic.DefSubr (not, "not", 1, 1); - basic.DefSubr (not, "!", 1, 1); - basic.DefSubr (add, "add", 2, -1); - basic.DefSubr (add, "+", 2, -1); - basic.DefSubr (mul, "mul", 2, -1); - basic.DefSubr (mul, "*", 2, -1); - basic.DefSubr (sub, "sub", 1, -1); - basic.DefSubr (sub, "-", 1, -1); - basic.DefSubr (div, "div", 2, -1); - basic.DefSubr (div, "/", 2, -1); - basic.DefSubr (mod, "mod", 2, 2); - basic.DefSubr (mod, "%", 2, 2); - basic.DefSubr (logior, "logior", 2, -1); - basic.DefSubr (logior, "|", 2, -1); - basic.DefSubr (logand, "logand", 2, -1); - basic.DefSubr (logand, "&", 2, -1); - basic.DefSubr (add_set, "add-set", 2, -1); - basic.DefSubr (add_set, "+=", 2, -1); - basic.DefSubr (mul_set, "mul-set", 2, -1); - basic.DefSubr (mul_set, "*=", 2, -1); - basic.DefSubr (sub_set, "sub-set", 2, -1); - basic.DefSubr (sub_set, "-=", 2, -1); - basic.DefSubr (div_set, "div-set", 2, -1); - basic.DefSubr (div_set, "/=", 2, -1); - basic.DefSubr (mod_set, "mod-set", 2, 2); - basic.DefSubr (mod_set, "%=", 2, 2); - basic.DefSubr (logior_set, "logior-set", 2, -1); - basic.DefSubr (logior_set, "|=", 2, -1); - basic.DefSubr (logand_set, "logand-set", 2, -1); - basic.DefSubr (logand_set, "&=", 2, -1); - basic.DefSubr (lsh, "lsh", 2, 2); - basic.DefSubr (lsh, "<<", 2, 2); - basic.DefSubr (rsh, "rsh", 2, 2); - basic.DefSubr (rsh, ">>", 2, 2); - basic.DefSubr (lsh_set, "lsh-set", 2, 2); - basic.DefSubr (lsh_set, "<<=", 2, 2); - basic.DefSubr (rsh_set, "rsh-set", 2, 2); - basic.DefSubr (rsh_set, ">>=", 2, 2); - basic.DefSubr (eq, "eq", 2, -1); - basic.DefSubr (eq, "==", 2, -1); - basic.DefSubr (noteq, "noteq", 2, 2); - basic.DefSubr (noteq, "!=", 2, 2); - basic.DefSubr (less_than, "lt", 2, -1); - basic.DefSubr (less_than, "<", 2, -1); - basic.DefSubr (less_eq, "le", 2, -1); - basic.DefSubr (less_eq, "<=", 2, -1); - basic.DefSubr (greater_than, "gt", 2, -1); - basic.DefSubr (greater_than, ">", 2, -1); - basic.DefSubr (greater_eq, "ge", 2, -1); - basic.DefSubr (greater_eq, ">=", 2, -1); + basic.DefSubr (set_value, "set", 2, 2, "="); + basic.DefSpecial (and, "and", 1, -1, "&&"); + basic.DefSpecial (or, "or", 1, -1, "||"); + basic.DefSubr (not, "not", 1, 1, "!"); + basic.DefSubr (add, "add", 2, -1, "+"); + basic.DefSubr (mul, "mul", 2, -1, "*"); + basic.DefSubr (sub, "sub", 1, -1, "-"); + basic.DefSubr (div, "div", 2, -1, "/"); + basic.DefSubr (mod, "mod", 2, 2, "%"); + basic.DefSubr (logior, "logior", 2, -1, "|"); + basic.DefSubr (logand, "logand", 2, -1, "&"); + basic.DefSubr (add_set, "add-set", 2, -1, "+="); + basic.DefSubr (mul_set, "mul-set", 2, -1, "*="); + basic.DefSubr (sub_set, "sub-set", 2, -1, "-="); + basic.DefSubr (div_set, "div-set", 2, -1, "/="); + basic.DefSubr (mod_set, "mod-set", 2, 2, "%="); + basic.DefSubr (logior_set, "logior-set", 2, -1, "|="); + basic.DefSubr (logand_set, "logand-set", 2, -1, "&="); + basic.DefSubr (lsh, "lsh", 2, 2, "<<"); + basic.DefSubr (rsh, "rsh", 2, 2, ">>"); + basic.DefSubr (lsh_set, "lsh-set", 2, 2, "<<="); + basic.DefSubr (rsh_set, "rsh-set", 2, 2, ">>="); + basic.DefSubr (eq, "eq", 2, -1, "=="); + basic.DefSubr (noteq, "noteq", 2, 2, "!="); + basic.DefSubr (less_than, "lt", 2, -1, "<"); + basic.DefSubr (less_eq, "le", 2, -1, "<="); + basic.DefSubr (greater_than, "gt", 2, -1, ">"); + basic.DefSubr (greater_eq, "ge", 2, -1, ">="); basic.DefSubr (copy, "copy", 1, 1); - basic.DefSubr (append, "append", 1, -1); - basic.DefSpecial (quote_clause, "quote", 1, 1); + basic.DefSubr (append, "append", 0, -1); + basic.DefSubr (concat, "concat", 0, -1); + basic.DefSubr (nth, "nth", 2, 2); basic.DefSubr (eval_clause, "eval", 1, 1); - basic.DefSpecial (progn_clause, "progn", 0, -1); - basic.DefSpecial (progn_clause, "expr", 0, -1); + basic.DefSpecial (quote_clause, "quote", 1, 1); + basic.DefSpecial (progn_clause, "progn", 0, -1, "expr"); basic.DefSpecial (if_clause, "if", 2, -1); basic.DefSpecial (when_clause, "when", 1, -1); basic.DefSpecial (while_clause, "while", 1, -1); @@ -946,22 +931,58 @@ namespace System.Xml.Expression private static Term append (Domain domain, Term[] args) { - object obj = args[0].objval; - if (obj is string) + List list = new List (); + Term result; + + foreach (Term arg in args) { - string str = ""; - foreach (Term arg in args) - str += arg; - return new Term (str); + if (arg.IsList) + list.AddRange ((List) arg.objval); + else + list.Add (arg); } - else if (obj is List) + result.intval = 0; + result.objval = list; + return result; + } + + private static Term concat (Domain domain, Term[] args) + { + string str = ""; + Term result; + + foreach (Term arg in args) { - List list = new List (); - foreach (Term arg in args) - list.AddRange ((List) arg.objval); - return new Term (list); + if (arg.IsStr) + str += (string) arg.objval; + else if (arg.IsList) + foreach (Term term in (List) arg.objval) + str += (char) term.Intval; + else + str += (char) arg.Intval; + } + result.intval = 0; + result.objval = str; + return result; + } + + private static Term nth (Domain domain, Term[] args) + { + Term result; + + if (args[1].IsStr) + { + result.intval = ((string) args[1].objval)[args[0].Intval]; + result.objval = null; + } + else if (args[1].IsList) + { + result.intval = 0; + result.objval = ((List) args[1].objval)[args[0].Intval]; } - throw new Exception ("Invalid term to append: " + obj); + else + throw new Exception ("Term is not enumelable: " + args[1]); + return result; } private static Term quote_clause (Domain domain, Term[] args) @@ -1107,6 +1128,14 @@ namespace System.Xml.Expression } } + public int Intval { + get { + if (objval != null) + throw new Exception ("term is not integer: " + this); + return intval; + } + } + public bool IsTrue { get { return (objval == null @@ -1116,6 +1145,9 @@ namespace System.Xml.Expression : true); } } + public bool IsInt { get { return (objval == null); } } + public bool IsStr { get { return (objval is string); } } + public bool IsList { get { return (objval is List); } } public Term Eval (Domain domain) { @@ -1267,10 +1299,7 @@ namespace System.Xml.Expression if (n.Name == Ndefun) domain.Defun (n); else if (n.Name != Ndefvar) - { - terms[i]= new Term (n, domain); - Console.WriteLine ("term="+terms[i]); - } + terms[i++]= new Term (n, domain); } } @@ -1279,16 +1308,17 @@ namespace System.Xml.Expression Term result = Zero; domain.depth = 0; - for (int i = 0; i < terms.Length; i++) - Console.WriteLine (terms[i]); - foreach (Term term in terms) - { - Console.WriteLine (term); - result = term.Eval (domain); - Console.WriteLine ("=>" + result); - } + result = term.Eval (domain); return result; } + + public override string ToString () + { + string str = ""; + for (int i = 0; i < terms.Length; i++) + str += terms[i]; + return str; + } } } diff --git a/xex.cs b/xex.cs index 610b1b5..09f5669 100644 --- a/xex.cs +++ b/xex.cs @@ -11,7 +11,8 @@ public class Test Xexpression.Domain domain = new Xexpression.Domain (null); Xexpression xex = new Xexpression ("xex.xml", domain); - Xexpression.debug_level = 3; + Xexpression.debug_level = 0; + Console.WriteLine (xex); Console.WriteLine (xex.Eval (domain)); } } diff --git a/xex.txt b/xex.txt index 950fa79..7e947af 100644 --- a/xex.txt +++ b/xex.txt @@ -1,9 +1,7 @@ EXPR = '' [ DEFUN | DEFMACRO | DEFVAR | TERM ] * '' -TERM = [ VAR | DIRECT | FUNCALL ] - -TYPE = 'integer' | 'string' | 'boolean' | 'symbol' | 'list' +TERM = [ VAR | INT | STRING | SYMBOL | LIST | FUNCALL ] DEFUN = '' @@ -24,7 +22,7 @@ REST = BODY = '' TERM * '' -DEFVAR = DEFVAR-INT DEFVAR-STR DEFVAR-BOOL +DEFVAR = DEFVAR-INT DEFVAR-STR DEFVAR-INT = '' @@ -40,35 +38,22 @@ DEFVAR-STR = STR * '' -DEFVAR-BOOL = - '' - DESCRIPTION ? - BOOL ? - '' - DESCRIPTION = - '' TEXT '' + '' [ TEXT | GETTEXT ] '' + +GETTEXT = + '' TEXT '' VAR = '' - -DIRECT = INT STR BOOL SYMBOL LIST - INT = '' INTEGER '' STR = '' STRING '' -BOOL = - '' [ 'true' | 'false' ] SYMBOL = '' NAME '' LIST = '' TERM * '' | -TYPE = - '' - [ 'integer' | 'string' | 'boolean' | 'symbol' | 'list' - | 'variable' | 'funcall' ] - '' FUNCALL = '' TERM * '' @@ -83,13 +68,10 @@ PREDEFINED-FUNC-SYMBOL = | 'add-set' | 'sub-set' | 'mul-set' | 'div-set' | 'mod-set' | 'logand' | 'logior' | 'logxor' | 'lsh' | 'logand-set' | 'logior-set' | 'logxor-set' | 'lsh-set' - | 'tolist' | 'tostring' - | 'copy' | 'append' - | 'ins' | 'del' - | 'cons' | 'car' | 'cdr' | 'nth' + | 'append' | 'concat' | 'nth' | 'copy' | 'ins' | 'del' | 'case' | 'cond' | 'if' | 'progn' | 'when' | 'while' | 'for' | 'foreach' - | 'typeof' + | 'type' PREDEFINED-FUNC-NAME = PREDEFINED-FUNC-SYMBOL @@ -101,24 +83,15 @@ PREDEFINED-FUNC-NAME = | '+=' | '-=' | '*=' | '/=' | '%=' | '&=' | '|=' | '~=' | '<<=' | '>>=' -(set SYMBOL TERM) -(and TERM *) (or TERM *) (not TERM) - -ARITH = - 'add' | 'sub' | 'mul' | 'div' | 'mod' | 'add' | 'sub' | 'mul' | 'div' | 'mod' - | 'logand' | 'logior' | 'logxor' | 'lsh' - -ARITH-SET = - 'add-set' | 'sub-set' | 'mul-set' | 'div-set' | 'mod-set' - | 'logand-set' | 'logior-set' | 'logxor-set' | 'lsh-set' - -ARITH-ARG = [ INT | VAR | FUNCALL ] - -(lt ARITH-ARG *) (le ARITH-ARG *) (eq ARITH-ARG *) - (ge ARITH-ARG *) (gt ARITH-ARG *) -(add ARITH-ARG *) (sub ARITH-ARG *) (mul ARITH-ARG *) (div ARITH-ARG *) - (mod ARITH-ARG *) -(add-set SYMBOL ARITH-ARG *) (sub-set SYMBOL ARITH-ARG *) - (mul-set SYMBOL ARITH-ARG *) (div-set SYMBOL ARITH-ARG *) - (mod-set SYMBOL ARITH-ARG *) -(logand ARITH-ARG +TRUE = + '0' +FALSE = + '1' + +;; TERM can be evaluated and the value is TERM. +;; INT is evaluated to itself. +;; STRING is evaluated to itself. +;; SYMBOL is evaluated to itself. +;; LIST is evaluated to itself. +;; VAR is evaluated to TERM that is set to that variable. +;; FUNCALL is evaluated to TERM returned by that function. diff --git a/xex.xml b/xex.xml index 3d1cf35..956c2ed 100644 --- a/xex.xml +++ b/xex.xml @@ -26,17 +26,19 @@ x10 - + strABC + sym sym sym - - 1 - - 2 + 1 + + + 0x400x41 + + - 3