ExLispSrc - デカルト言語 - 並列ロジック プログラミング言語 Wiki - デカルト言語 - 並列ロジック プログラミング言語

←　前のページに戻る

ソース

Descartes Lisp/λインタプリターのソースを以下に示します。

/* Descartes Lisp/λ (c) 2010 H.Niwa  */

/*
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 */

? <include list>;

// s式の構文解析
<s_exp #r>
	 "'"
	<s_exp #r1>
	<is #r (quote #r1)>
	;
<s_exp (("λ" (#arg1 #arg2 #arg3) #sexp) #parm1 #parm2 #parm3)>
	"λ"
	<A #arg1>
	<A #arg2>
	<A #arg3>
	<s_exp #sexp>
	<s_exp #parm1>
	<s_exp #parm2>
	<s_exp #parm3>
	// <print (("λ" (#arg1 #arg2 #arg3) #sexp) #parm1 #parm2 #parm3)>
	;
<s_exp ("λ" (#arg1 #arg2 #arg3) #sexp) >
	"λ"
	<A #arg1>
	<A #arg2>
	<A #arg3>
	<s_exp #sexp>
	// <print ("λ" (#arg1 #arg2 #arg3) #sexp)>
	;
<s_exp (("λ" (#arg1 #arg2) #sexp) #parm1 #parm2)>
	"λ"
	<A #arg1>
	<A #arg2>
	<s_exp #sexp>
	<s_exp #parm1>
	<s_exp #parm2>
	// <print (("λ" (#arg1 #arg2) #sexp) #parm1 #parm2)>
	;
<s_exp ("λ" (#arg1 #arg2) #sexp) >
	"λ"
	<A #arg1>
	<A #arg2>
	<s_exp #sexp>
	// <print ("λ" (#arg1 #arg2) #sexp)>
	;
<s_exp (("λ" (#arg1) #sexp) #parm1)>
	"λ"
	<A #arg1>
	<s_exp #sexp>
	<s_exp #parm1>
	// <print (("λ" (#arg1) #sexp) #parm1)>
	;
<s_exp ("λ" (#arg1) #sexp) >
	"λ"
	<A #arg1>
	<s_exp #sexp>
	// <print ("λ" (#arg1) #sexp)>
	;
<s_exp #r>
	 <s_atom #r>
	|
	 "("
	    {#r1 
		<s_exp _>
	    }
	    (
		 ":" <s_exp #r2> ::list<append #r #r1 #r2>
	    |
	         <is #r #r1>
	    )
	 ")"
	;

<s_atom #r>
	(
	 <STRINGS #r>
	|
	 <SNUM #r>
	|
	 <WORD #r>
	|
	 (
	  "+"
	 |
	  "*"
	 |
	  "/"
	 |
	  "="
	 |
	  "<>"
	 |
	  ">="
	 |
	  ">"
	 |
	  "<="
	 |
	  "<"
	 )
	 <GETTOKEN #r>
	)
	;


// 変数の処理
<var ((T : T) (NIL : NIL))>;

<getval #r #x ((#l1 :#l2) : #var)>
	<is #x #l1>
	<is #r #l2>
	|
	<getval #r #x #var>
	;
<getval #x #x ()>
	;

<setval #var () _ #var>
	;
<setval #var3 (#x1 : #x2) (#val1 : #val2) #var>
	<is #var1 ((#x1:#val1):#var)>
	<setval #var3 #x2 #val2 #var1>
	;
<setval ((#x : #val) : #var) #x #val #var>
	;

// 組み込み関数
<built_in #l (quote #l) #var>
	;
<built_in #r (car #l) #var>
	<l_eval #l1 #l #var> <car #r #l1>
	;
<built_in #r (cdr #l) #var>
	<l_eval #l1 #l #var> <cdr #r #l1>
	;
<built_in #r (cons #l1 #l2) #var>
	<l_eval #p1 #l1 #var> 
	<l_eval #p2 #l2 #var> 
	<cons #r #p1 #p2>
	;
<built_in #r (atom #l) #var>
	<l_eval #l1 #l #var> <atom #r #l1>
	;
<built_in #r (equal #l1 #l2) #var>
	<l_eval #ll1 #l1 #var> 
	<l_eval #ll2 #l2 #var> 
	<equal #r #ll1 #ll2>
	;
<built_in NIL (print #l) #var>
	<l_eval #r1 #l #var> <print #r1>
	;
<built_in #r ("+" #l1 #l2) #var>
	<x <print "error: + ">>
	<l_eval #ll1 #l1 #var> ::sys <isInteger #ll1>
	<l_eval #ll2 #l2 #var> ::sys <isInteger #ll2>
	<#r = #ll1 + #ll2>
	;
<built_in #r ("-" #l1 #l2) #var>
	<x <print "error: - ">>
	<l_eval #ll1 #l1 #var> ::sys <isInteger #ll1>
	<l_eval #ll2 #l2 #var> ::sys <isInteger #ll2>
	<#r = #ll1 - #ll2>
	;
<built_in #r ("*" #l1 #l2) #var>
	<x <print "error: * ">>
	<l_eval #ll1 #l1 #var> ::sys <isInteger #ll1>
	<l_eval #ll2 #l2 #var> ::sys <isInteger #ll2>
	<#r = #ll1 * #ll2>
	;
<built_in #r ("/" #l1 #l2) #var>
	<x <print "error: / ">>
	<l_eval #ll1 #l1 #var> ::sys <isInteger #ll1>
	<l_eval #ll2 #l2 #var> ::sys <isInteger #ll2>
	<#r = #ll1 / #ll2>
	;
<built_in #r ("=" #l1 #l2) #var>
	<x <print "error: = ">>
	<l_eval #ll1 #l1 #var> ::sys <isInteger #ll1>
	<l_eval #ll2 #l2 #var> ::sys <isInteger #ll2>
	( <compare #ll1 == #ll2> <is #r T>
	| <is #r NIL>) 
	;
<built_in #r ("<>" #l1 #l2) #var>
	<x <print "error: <> ">>
	<l_eval #ll1 #l1 #var> ::sys <isInteger #ll1>
	<l_eval #ll2 #l2 #var> ::sys <isInteger #ll2>
	( <compare #ll1 <> #ll2> <is #r T>
	| <is #r NIL>) 
	;
<built_in #r (">" #l1 #l2) #var>
	<x <print "error: > ">>
	<l_eval #ll1 #l1 #var> ::sys <isInteger #ll1>
	<l_eval #ll2 #l2 #var> ::sys <isInteger #ll2>
	( <compare #ll1 > #ll2> <is #r T>
	| <is #r NIL>) 
	;
<built_in #r (">=" #l1 #l2) #var>
	<x <print "error: >= ">>
	<l_eval #ll1 #l1 #var> ::sys <isInteger #ll1>
	<l_eval #ll2 #l2 #var> ::sys <isInteger #ll2>
	( <compare #ll1 >= #ll2> <is #r T>
	| <is #r NIL>) 
	;
<built_in #r ("<" #l1 #l2) #var>
	<x <print "error: < ">>
	<l_eval #ll1 #l1 #var> ::sys <isInteger #ll1>
	<l_eval #ll2 #l2 #var> ::sys <isInteger #ll2>
	( <compare #ll1 < #ll2> <is #r T>
	| <is #r NIL>) 
	;
<built_in #r ("<=" #l1 #l2) #var>
	<x <print "error: <= ">>
	<l_eval #ll1 #l1 #var> ::sys <isInteger #ll1>
	<l_eval #ll2 #l2 #var> ::sys <isInteger #ll2>
	( <compare #ll1 <= #ll2> <is #r T>
	| <is #r NIL>) 
	;
<built_in #r (define (#f :#x) #val) #var>
	<setval #var2 #f (λ #x #val) #var>
	<setVar var #var2>
	<is #r (λ #x #val)>
	;
<built_in #r (define #x #val) #var>
	<setval #var2 #x #val #var>
	<setVar var #var2>
	::sys <car #f #x>
	<is #r #val>
	;
<built_in #r (cond : #l) #var>
	<cond #r #l #var>
	;


// 組み込み関数の処理
<car #r #l>
	::sys <car #r #l>
	|
	<is #r NIL>
	;
<cdr #r #l>
	::sys <cdr #r #l>
	|
	<is #r NIL>
	;
<cons (#l1 :#l2) #l1 #l2>
	;
<atom #r #n>
	::sys <isAtom #n> <is #r T>
	|
	<is #r NIL>
	;
<equal #r #l1 #l2>
	<is #l1 #l2> <is #r T>
	|
	<is #r NIL>
	;

<cond NIL ()  #var>
	;
<cond #r ((#l1 : (#l2)) :#l3) #var>
	<l_eval #r1 #l1 #var>
	<noteq #r1 NIL>
	<l_eval #r #l2 #var>
	;
<cond #r ((#l1 : (#l2)) :#l3) #var>
	<cond #r #l3 #var>
	;
<cond NIL ((#l1 : (#l2)) :#l3) #var>
        <print "error : cond " ((#l1 : (#l2)) :#l3)>
        ;


// evalの処理
<l_eval #r (("λ" #arg #prog) :#parm) #var>
	<l_evlis #parm2 #parm #var>
	<setval #var2 #arg #parm2 #var>
	<l_eval #r #prog #var2>
	|
	<print "eval error : " (("λ" #arg #prog) :#parm)>
	;
<l_eval #r #p #var>
	  ::sys <isInteger #p> 
	  <is #r #p>
	|
	  ::sys <isAtom #p>
	  <getval #r #p #var>
	|
	  <built_in #r #p #var>
	|
	  ::sys <car #f #p>
	  ::sys <cdr #arg #p>
	  <l_eval #f2 #f #var>
	  (  <is #f "λ"> <print "syntax error : λ"> <is #r NIL>
	   | <is #f2 NIL> <is #r NIL>
	   | <noteq #f #f2> <l_eval #r (#f2 :#arg) #var> 
	   | <print "error " #p> <is #r NIL>)
	;
	
<l_evlis () () #var>
	;
<l_evlis (#r1 : #r2) (#l1 : #l2) #var>
	<l_eval #r1 #l1 #var>
	<l_evlis  #r2 #l2 #var>
	;

// LISPのメイン処理
<Lisp>
	<print "Descartes Lisp/λ (c) 2010 H.Niwa">
	{
		<var #var>
		<print Ready>
		::sys <getline  #line
			( <NULLLINE>
			 |
			  <x <print "syntax error : " #line>>
			  <s_exp #list>  
			  <l_eval #r #list #var>
			  <print #r>
			)>
		|
		<print> 
	}
	;


? <Lisp>;