用erlang写的一个在erlang上跑的脚本语言-LGPL协议

-module(pparser).  
-export([start/1]).  
-import(io,[fwrite/1,format/2]).
-import(sfile,[load/1,unload/1,readline/1]).
-import(string,[len/1,substr/3,to_lower/1,to_upper/1,strip/1,tokens/2,join/2]).
-import(ets,[new/2,insert/2,delete/1,lookup/2]).
-import(qsort,[qsort3/1]).
-import(lists,[reverse/1,concat/1]).
-vsn(0.1005).
-author({deepfuturelx@gmail.com}).
%解释执行源代码
%遵守LGPL协议

start(Sfilename)->%启动解释器
fwrite("Poles 0.1005 \nContact us:deepfuturelx@gmail.com\nload.....~n"),
try load(Sfilename) of
       Sf->
       prestart(Sfilename),     
       try read(Sf)
       catch
            {error,Why}->
                  format("~s~n",[Why]);
            {runerr,Runwhy}->
                  format("~s~n",[Runwhy])    
       after
          preclose(),       
          unload(Sf)
       end    
catch
    err->format("load ~s error~n",[Sfilename]) 
end.

prestart(Sfilename)->%解析前运行
     erase(),%清空符号表
     getcurln(),
     format("load ~s finished.~n",[Sfilename]).

preclose()->%关闭前运行
     erase().%清空符号表

read(Sf)->%读源代码
case readline(Sf) of
  eof->format("run finished~n",[]);  
  Data->
     begin 
        try parse(Data) 
        catch
           {error,Why}->throw({error,Why});
           {runerr,Runwhy}->throw({runerr,Runwhy})          
        end
     end,   
     read(Sf)       
end.        
  
parse(Data)->%解析一行
   inccurln(),
   Line=strip(substr(Data,1,len(Data)-1)),
   case substr(Line,1,1)=:="#" of
      true->%注释使用#
         notes(Line);
      false->%非注释，执行
          begin  
            Sline=tokens(Line,"\t"),         
            try run(Sline)           
            catch
              {error,Why}->throw({error,Why});
              {runerr,Runwhy}->throw({runerr,Runwhy}) 
            end
          end  
  end.
  
run(Spline)->%运行一行代码
   %format("~p~n",[Spline]), 
   try runinstruction(list_to_tuple(Spline)) 
   catch        
       {error,Why}->throw({error,concat([" line ",getcurln()," ~"])++join(Spline," ")++"|====>runtime error:"++Why});  
       {runerr,Runwhy}->throw({runerr,concat([" line ",getcurln()," ~"])++join(Spline," ")++"|====>run error:"++Runwhy})        
   end.
   
runinstruction(Instruction)-> %分析并执行指令 
   try Instruction of       
          {"list",Source,Target}->modisymbol({Source,list,Target,null});%列表变量声明
          {"list",Source}->modisymbol({Source,list,[],null});%列表变量赋值并声明
          {"var",Source,Target}->modisymbol({Source,var,Target,null});%标量赋值声明
          {"var",Source}->modisymbol({Source,var,null,null});%标量声明  
               
        {"mov",Source,Target}->assign({Source,Target});%赋值
          {"pushlist",Source,Target}->pushlist({Source,Target});%push 列表 列表        
          {"push",Source,Target}->push({Source,Target});%push 元素 列表
          {"qsort",Source,Target}->qsort({Source,Target});%qsort 列表
          {"pop",Source,Target}->pop({Source,Target});%pop 列表
          {"pop",Source,Target,"del"}->pop({Source,Target},del);%pop and del 列表首          
          {"say",Source}->say({Source});%带回车输出
          {"print",Source}->print({Source});%输出
          {}->{}%空行
  catch
       {error,Why}->throw({error,Why});
       {runerr,Runwhy}->throw({runerr,Runwhy})
  end.



  
notes(Sline)->Sline.   

newsysinfo(poles_symbol)->%
    new(poles_symbol,[set,named_table]).

delsysinfo(poles_symbol)->%
  delete(poles_symbol).
    
modisymbol({Name,Type,Value,Flag})->%符号表修改符号
   put(Name,{Name,Type,Value,Flag}).
   
assign({Value,Name})->%赋值
    case findsymbol(Name) of 
        false->throw({runerr,Name++" not defined"});
      {_,Type,_,SFlag}->
         Svalue=eval(Value),
         modisymbol({Name,Type,Svalue,SFlag})
    end.   

say({Name})->%带回车输出
    case findsymbol(Name) of  
        false->
            Value=eval(Name),
            format("~p~n",[Value]);
      {_,_,Value,_}->format("~p~n",[Value])
    end. 

        
print({Name})->%输出
    case findsymbol(Name) of  
        false->
            Value=eval(Name),
            format("~p",[Value]);
      {_,_,Value,_}->format("~p",[Value])
    end. 

push({Value,Name})->%在列表首加入元素
    case findsymbol(Name) of  
        false->throw({runerr,Name++" not defined"});
      {_,Type,SValue,SFlag}->modisymbol({Name,Type,[eval(Value)|SValue],SFlag})
    end.

pushlist({Value,Name})->%在列表首加入列表元素
    case findsymbol(Name) of  
        false->throw({runerr,Name++" not defined"});
      {_,Type,SValue,SFlag}->modisymbol({Name,Type,eval(Value)++SValue,SFlag})
    end.
    
pop({Sname,Dname})->%在列表首取出元素
    case findsymbol(Sname) of  
        false->throw({runerr,Dname++"not defined"});
      {_,Type,[Popvalue|_Svalue],Sflag}->
            case findsymbol(Dname) of
                   false->throw({runerr,Dname++" not defined"});      
                   {_,_,_,_}->modisymbol({Dname,Type,Popvalue,Sflag})         
            end   
    end.    

pop({Sname,Dname},del)->%在列表首取出并删除元素
    case findsymbol(Sname) of  
        false ->throw({runerr,Dname++"not defined"});
      {_,Type,[Popvalue|Svalue],Sflag}->
            case findsymbol(Dname) of
                   false->throw({runerr,Dname++" not defined"});      
                   {_,_,_,_}->
                       modisymbol({Sname,Type,Svalue,Sflag}),
                       modisymbol({Dname,Type,Popvalue,Sflag})         
            end   
    end. 

    


trans(ErlTokens,Stk,NewErlTokens)->%处理表达式中的变量 
     [Stoken|Et]=ErlTokens,
     case Stoken of  
        {atom,_,Name}->%变量
              NewEtoken=[{var,1,list_to_atom(to_upper(atom_to_list(Name)))}|NewErlTokens],
              case findsymbol(atom_to_list(Name)) of
                   false->throw({runerr,atom_to_list(Name)++" not defined"}); 
                   {_Name,Type,Val,_Flag}->

                       case Type of
                            list->
                            NewVal=concat([Stk,to_upper(atom_to_list(Name)),"=",concat(io_lib:format("~p",[Val])),","]);
                             _Other->NewVal=concat([Stk,to_upper(atom_to_list(Name)),"=",Val,","])
                       end,
                       
                       trans(Et,NewVal,NewEtoken)                   
              end;
        {dot,Flag}->%结束
              NewEtoken=[{dot,Flag}|NewErlTokens],
              Etoken=reverse(NewEtoken),  
              {ok,VarEtoken,_}=erl_scan:string(Stk),%转换变量声明为erlang内部的方式VarEtoken
              EndToken=addexpress(VarEtoken,Etoken),%将erlang内部方式声明的变量加入到现有表达式中
              EndToken;
        Val->%普通运算
              NewEtoken=[Val|NewErlTokens],
              trans(Et,Stk,NewEtoken)
     end.
              
addexpress(VarEtoken,Etoken)->%将erlang内部方式声明的变量加入到现有表达式中
    case VarEtoken of
      []->Etoken;
      Val->
          EndEtoken=Val++Etoken,
          EndEtoken
    end.

    
eval(S) ->%计算表达式
    case findsymbol(S) of  
      {_,_,Value,_}->Value;
      false->
         begin
            {ok,ErlTokens,_}=erl_scan:string(S++"."),
            SErlTokens=trans(ErlTokens,[],[]),

           {ok,ErlAbsForm}=erl_parse:parse_exprs(SErlTokens),
           {value,Value,_}=erl_eval:exprs(ErlAbsForm,[]),
             Value  
         end      
    end. 
     

qsort({Sname,Dname})->%排序list
    case findsymbol(Sname) of  
        false->throw({runerr,Dname++"not defined"});
      {_,Type,Svalue,Sflag}->
            case findsymbol(Dname) of
                   false->throw({runerr,Dname++" not defined"});      
                   {_,_,_,_}->
                       Sortvalue=qsort3(Svalue),
                       modisymbol({Dname,Type,Sortvalue,Sflag})         
            end   
    end. 
   
    
getcurln()->%取得当前行号
begin
 case findsymbol(sys__line) of
      false->modisymbol({sys__line,runsys,1,null}),1;
      {sys__line,runsys,Line,null}->Line 
 end
end.

inccurln()->%当前行号++
Curline=getcurln()+1,
modisymbol({sys__line,runsys,Curline,null}).

findsymbol(Name)->%找到符号，并返回值
  case get(Name) of 
       undefined->false;
       Val->Val
  end.     

 

-module(sfile).
-export([load/1,readline/1,unload/1]). 
-import(io,[get_line/2,atom/0]). 
-import(file,[open/2,close/1]). 
-vsn(0.1001).
-author({deepfuture}).
%源代码文件操作
%load读取源文件,readline读取一行,unload关闭源文件

load(Sfilename)->
        case open(Sfilename,read) of
             {ok,Sf}->Sf;       
     		 {error,Why}->throw(err)	 
end.

readline(Sf)->get_line(Sf,"").

unload(Sf)->close(Sf).

 

% Copyright (c) 2010 the authors listed at the following URL, and/or
% the authors of referenced articles or incorporated external code:
% http://en.literateprograms.org/Quicksort_(Erlang)?action=history&offset=20060711142841
% 
% Permission is hereby granted, free of charge, to any person obtaining
% a copy of this software and associated documentation files (the
% "Software"), to deal in the Software without restriction, including
% without limitation the rights to use, copy, modify, merge, publish,
% distribute, sublicense, and/or sell copies of the Software, and to
% permit persons to whom the Software is furnished to do so, subject to
% the following conditions:
% 
% The above copyright notice and this permission notice shall be
% included in all copies or substantial portions of the Software.
% 
% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
% IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
% CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
% TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
% SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
% 
% Retrieved from: http://en.literateprograms.org/Quicksort_(Erlang)?oldid=6960

-module(qsort).
-export([qsort1/1, qsort2/1, qsort3/1]).

qsort1([]) ->
    [];
qsort1([H | T]) -> 
    qsort1([ X || X <- T, X < H ]) ++ [H] ++ qsort1([ X || X <- T, X >= H ]).

qsort2([]) ->
    [];
qsort2([H | T]) ->
    {Less, Equal, Greater} = part(H, T, {[], [H], []}),
    qsort2(Less) ++ Equal ++ qsort2(Greater).

part(_, [], {L, E, G}) ->
    {L, E, G};
part(X, [H | T], {L, E, G}) ->
    if
        H < X ->
            part(X, T, {[H | L], E, G});
        H > X ->
            part(X, T, {L, E, [H | G]});
        true ->
            part(X, T, {L, [H | E], G})
    end.


qsort3([]) ->
    [];
qsort3([H | T]) ->
    qsort3_acc([H | T], []).

qsort3_acc([], Acc) ->
    Acc;

qsort3_acc([H | T], Acc) ->
    part_acc(H, T, {[], [H], []}, Acc).

part_acc(_, [], {L, E, G}, Acc) ->
    qsort3_acc(L, (E ++ qsort3_acc(G, Acc)));
part_acc(X, [H | T], {L, E, G}, Acc) ->
    if
        H < X ->
            part_acc(X, T, {[H | L], E, G}, Acc);
        H > X ->
            part_acc(X, T, {L, E, [H | G]}, Acc);
        true ->
            part_acc(X, T, {L, [H | E], G}, Acc)
    end.

 

 

 

 一、将代码开源(遵守LGPL协议)

当前版本的语言规范

代码以三指令和四指令为主，以TAB分割每行代码的元素
list 变量名 声明列表变量
var 变量名 声明单变量
push 表达式 列表变量 为将表达式的值放入列表首部
pop 列表变量 变量  为获得列表首部的值并放入变量
pop 列表变量 变量 del 为将列表首部的变量弹出放入变量
以#开头表示注释，注释必须单独占一行
pushlist 列表变量 列表变量 为将列表放入列表首部
say 表达式 带回车输出
print 表达式 输出
mov 表达式 变量 赋值到变量
表达式计算支持erlang格式的标准表达式，包括列表计算，不支持表达式直接调用erlang的函数
四、脚本代码示例

#test2.po
#代码以三指令和四指令为主，以TAB分割每行代码的元素
list a
list b

pushlist [88,89] a
#取余
push 5 rem 2 b
#a++[90,91]和a--[89]完成2个列表的计算
pushlist a++[90,91] b
pushlist a--[89] b

say "===="
say b

任务

1、调试和完善现在指令

2、增加部分顺序执行指令

3、尝试编写对条件语句的解析

4、完成函数

5、继续并行计算架构代码

三、当前版本的语言规范

代码以三指令和四指令为主，以TAB分割每行代码的元素
list 变量名 声明列表变量
var 变量名 声明单变量
push 表达式 列表变量 为将表达式的值放入列表首部
pop 列表变量 变量  为获得列表首部的值并放入变量
pop 列表变量 变量 del 为将列表首部的变量弹出放入变量
以#开头表示注释，注释必须单独占一行
pushlist 列表变量 列表变量 为将列表放入列表首部
say 表达式 带回车输出
print 表达式 输出
mov 表达式 变量 赋值到变量
表达式计算支持erlang格式的标准表达式，包括列表计算，不支持表达式直接调用erlang的函数
四、脚本代码示例
1、
#test2.po
#代码以三指令和四指令为主，以TAB分割每行代码的元素
list a
list b

pushlist [88,89] a
#取余
push 5 rem 2 b
#a++[90,91]和a--[89]完成2个列表的计算
pushlist a++[90,91] b
pushlist a--[89] b

say "===="
say b

2、
进入erlang，将pparser.beam等目录下的beam文件列入erlang的搜索目录，然后运行脚本
pparser:start("脚本文件名称").
比如：
1>pparser:start("test2.po").
Poles 0.1005
Contact us:deepfuturelx@gmail.com
load.....
load ../test/test2.po finished.
"===="
[88,88,89,90,91,1]
run finished
ok