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

--
←　前のページに戻る

6.1. ソース全体

? <include list>;
? <include compiler>;

/********************************************************
 * Closure Basic VM(Virtual Machine) 
 ********************************************************/


::<closure
	<pc 0>;
	<code ()>;
	<type NUM>;
	<ncall 0>;
	<parm_length 0>;
	<parm_stack ()>;
	<data (0 0 0 0 0 0 0 0)>;
	// data 0 : number of parameters
	// data 1 : working variable for for...next
	// data 2 : working variable for {fun()}
>;

<debug off>;
//<debug on>;

<new_closure #n>
	::closure <cloneObj #n>
	;

<call_closure #r #closure #param>
	::#closure <setVar pc 0>
	<stack #stk>
	<setVar stack (#param :#stk)>
	::vm <start #closure>
	<stack (#r :_)>
	;

<check_closure #closure>
	( ::sys <checkObj #closure>
	 |<print "error : it is not a closure : " #closure>
	  <exit>
	)
	;

<stack ()>;

::<vm
	<start #closure>
		::#closure <code #code>
		<catch #r { <step #closure #code> } >
		(
		 ::sys <EqOR #r RETURN STOP>
		|
		 ::#closure <pc #pc>
		 ::#closure <code #code>
		 <#pc2 = #pc -1>
		 ::sys <nth #cd #code #pc2>
		 <print #r "... " #cd "[" #pc "]">
		 <throw ERROR>
		)
		;
	
	/* one step operation */
	<step #closure #code>
		::#closure <pc #pc>
		
//		(<compare #pc < ::sys <length _ #code>>
//				| <throw NOADDR>)
		::sys <nth #cd #code #pc>
		
//		<x <throw VMERROR>>
		
		<#nextpc = #pc + 1>
		::#closure <setVar pc #nextpc>

//::sys <nth #v #code #nextpc> <print #closure #pc ": " #cd #v> 
		::sys <switch #cd
			STOP   <STOP #closure>
			PUSHI  <PUSHI #closure #code #nextpc>
			PUSH   <PUSH #closure>
			POP    <POP #closure>
			DUP    <DUP #closure>
			DUP2   <DUP2 #closure>
			DROP   <DROP #closure>
			SWAP   <SWAP #closure>
			ROT    <ROT #closure>
			ADD    <ADD #closure>
			SUB    <SUB #closure>
			MUL    <MUL #closure>
			DIV    <DIV #closure>
			INV    <INV #closure>
			CMPE   <CMPE #closure>
			CMPNE  <CMPNE #closure>
			CMPGT  <CMPGT #closure>
			CMPGE  <CMPGE #closure>
			CMPLT  <CMPLT #closure>
			CMPLE  <CMPLE #closure>
			AND    <AND #closure>
			OR     <OR #closure>
			NOT    <NOT #closure>
			ADDSTR <ADDSTR #closure>
			SUBSTR <SUBSTR #closure>
			BR     <BR #closure #code>
			BRZ    <BRZ #closure #code>
			CALL   <CALL #closure #code #nextpc>
			RET    <RET #closure>
			CLR    <CLR #closure>
			BRK    <BRK #closure>
			INPUT  <INPUT #closure>
			PR     <PR #closure>
			NL     <NL #closure>
			ISNUM  <ISNUM #closure>
			SAVE   <SAVE #closure>
			RESTR  <RESTR #closure>
			RAND   <RAND #closure>
			ERR    <ERR #closure>
			#IL    <throw ILLCODE>
		>

		[<debug on> <stack #stk1>
		 (
		  <is #cd CALL> 
		  |
		  <print #pc ":" #cd #stk1 #closure >
		 )
		]

//::#closure <parm_stack #pstk1><print "[" #pstk1 "]">
//::#closure <data #data> <print data ':' #data>
		;
	
	/* memory access */	
	<get #v #area #n #closure>
		(::sys <EqOR #area code data> | <throw ILLAREA>)
		::#closure <#area #block>
		(<compare 0 <= #n> | <throw ILLADDR>)
		::sys <length #l #block>
		(<compare #n < #l> <is #area data> | 
				<brkdata #n #closure>)
		::#closure <#area #block2>
		::sys <nth #v #block2 #n>
		;
	<set #area #n #val #closure>
		(::sys <EqOR #area code data> | <throw ILLAREA>)
		::#closure <#area #block>
		(<compare 0 <= #n> | <throw ILLADDR>)
		::sys <length #l #block>
		(
		 <compare #n < #l>
		 ::sys <setnth #block2 #block #n #val>
		|
		 <#addlen = #l + 1 - #n>
		 ::sys <padding #d #addlen 0>
		 ::sys <append #block1 #block #d>
		 ::sys <setnth #block2 #block1 #n #val>
		)
		::#closure <setVar #area #block2>
		;
	<current #area #l #closure>
		(::sys <EqOR #area code data> | <throw ILLAREA>)
		::#closure <#area #block>
		::sys <length #l #block>
		;

	<add #area #l #val #closure>
		(::sys <EqOR #area code data> | <throw ILLAREA>)
		::#closure <#area #block>
		::sys <length #l #block>
		::sys <append #block2 #block (#val)>
		::#closure <setVar #area #block2>
		;

	<add #area #l #val1 #val2 #closure>
		(::sys <EqOR #area code data> | <throw ILLAREA>)
		::#closure <#area #block>
		::sys <length #l #block>
		::sys <append #block2 #block (#val1 #val2 )>
		::#closure <setVar #area #block2>
		;

	<restore 0 #closure>;
	<restore #n #closure>
		::#closure <parm_stack (#addr #cl #v : #pstk)>
		(<set data #addr #v #cl> | <throw ILLADDR>)

		::#closure <setVar parm_stack #pstk>
		<#n1 = #n - 1>
		<restore #n1 #closure>
		;
	
	/* check stack */
	<ckstk1 #closure>
		<stack #stk> 
		(<noteq #stk ()> | <throw USTKFLOW>)
		;
	<ckstk2 #closure>
		<stack #stk>
		::sys <length #l #stk>
		(<compare #l >= 2> | <throw USTKFLOW> )
		;
	<ckstk3 #closure>
		<stack #stk>
		::sys <length #l #stk>
		(<compare #l >= 3> | <throw USTKFLOW> )
		;
		
	/* instruction code */
		
	<STOP #closure>
		<throw STOP>
		;
	<PUSHI #closure #code #pc>
		::sys <nth #v #code #pc>
		
		<#nextpc = #pc + 1>
		::#closure <setVar pc #nextpc>
		
		<stack #stk>
		<setVar stack (#v :#stk)>
		;
	<PUSH #closure>
		//<ckstk2 #closure>
		(<check_closure #closure> | <throw ILLCLOSURE>)
		<stack (#addr #cl : #stk)>
		(<get #v data #addr #cl> | <throw ILLADDR>)

		<setVar stack (#v :#stk)>
		;
	<SAVE #closure>
		//<ckstk2 #closure>
		(<check_closure #closure> | <throw ILLCLOSURE>)

		  <stack (#addr #cl #newv : #stk)>
		  (<get #v data #addr #cl> | <throw ILLADDR>)
		  (<set data #addr #newv #cl> | <throw ILLADDR>)

		  ::#closure <parm_stack #pstk>
		  ::#closure <setVar parm_stack (#addr #cl #v :#pstk)>
		  <setVar stack #stk>
		;
	<RESTR #closure>
		(<check_closure #closure> | <throw ILLCLOSURE>)
		(<get #n data 0 #closure> | <throw ILLADDR>)

		<restore #n #closure>
		;
	<POP #closure>
		(<check_closure #closure> | <throw ILLCLOSURE>)
		//<ckstk3 #closure>
		<stack (#addr #cl #v : #stk)>
		(<check_closure #cl> | <throw ILLCLOSURE>)
		(<set data #addr #v #cl> | <throw ILLADDR>)

		<setVar stack #stk>
		;
	<DUP #closure>
		//<ckstk1 #closure>
		<stack (#v :#rest)>
		<setVar stack (#v #v :#rest)>
		;
	<DUP2 #closure>
		//<ckstk2 #closure>
		<stack (#v1 #v2 :#rest)>
		<setVar stack (#v1 #v2 #v1 #v2 :#rest)>
		;
	<DROP #closure>
		//<ckstk1 #closure>
		<stack (#v :#rest)>
		<setVar stack #rest>
		;
	<SWAP #closure>	
		//<ckstk2 #closure>
		<stack (#v1 #v2 :#rest)>
		<setVar stack (#v2 #v1 :#rest)>
		;
	<ROT #closure>	
		//<ckstk3 #closure>
		<stack (#v1 #v2 #v3 :#rest)>
		<setVar stack (#v2 #v3 #v1 :#rest)>
		;
	<ADD #closure>
		//<ckstk2 #closure>
		<stack (#v1 #v2 :#rest)>
		(::sys <isFloat #v1> ::sys <isFloat #v2> 
		 <letf #val = #v2 + #v1>
		 | 
		 ::sys <concat #val (#v2 #v1)>
		)
		<setVar stack (#val :#rest)>
		;
	<SUB #closure>
		//<ckstk2 #closure>
		<stack (#v1 #v2 :#rest)>
		(::sys <isFloat #v1> ::sys <isFloat #v2> 
				| <throw NOTANUM>)
		<letf #val = #v2 - #v1>
		<setVar stack (#val :#rest)>
		;
	<MUL #closure>
		//<ckstk2 #closure>
		<stack (#v1 #v2 :#rest)>
		(::sys <isFloat #v1> ::sys <isFloat #v2> 
				| <throw NOTANUM>)
		<letf #val = #v2 * #v1>
		<setVar stack (#val :#rest)>
		;
	<DIV #closure>
		//<ckstk2 #closure>
		<stack (#v1 #v2 :#rest)>
		(::sys <isFloat #v1> ::sys <isFloat #v2> 
				| <throw NOTANUM>)
		( <comparef #v1 <> 0> 
		 |
		  <throw DIVIEDEDZERO>
		)
		<letf #val = #v2 / #v1>
		<setVar stack (#val :#rest)>
		;
	<INV #closure>
		//<ckstk1 #closure>
		<stack (#v1 :#rest)>
		(::sys <isFloat #v1>
				| <throw NOTANUM>)
		<letf #val = -#v1>
		<setVar stack (#val :#rest)>
		;
	<CMPE #closure>
		//<ckstk2 #closure>
		<stack (#v1 #v2 :#rest)>
		(::sys <isFloat #v1> ::sys <isFloat #v2> 
		   (<comparef #v1=#v2> ::sys <is #val 1>
		    |::sys <is #val 0>)
		|
		 (<eq #v1 #v2> ::sys <is #val 1>
		  |::sys <is #val 0>)
		)
		<setVar stack (#val :#rest)>
		;
	<CMPNE #closure>
		//<ckstk2 #closure>
		<stack (#v1 #v2 :#rest)>
		(::sys <isFloat #v1> ::sys <isFloat #v2> 
		    (<comparef #v1 <> #v2> ::sys <is #val 1>
		     |::sys <is #val 0>)
		|
		 (<noteq #v1 #v2> ::sys <is #val 1>
		     |::sys <is #val 0>)
		)
		<setVar stack (#val :#rest)>
		;
	<CMPGT #closure>
		//<ckstk2 #closure>
		<stack (#v1 #v2 :#rest)>
		(::sys <isFloat #v1> ::sys <isFloat #v2> 
				| <throw NOTANUM>)
		(<comparef #v1<#v2> ::sys <is #val 1>
		|::sys <is #val 0>)
		<setVar stack (#val :#rest)>
		;
	<CMPGE #closure>
		//<ckstk2 #closure>
		<stack (#v1 #v2 :#rest)>
		(::sys <isFloat #v1> ::sys <isFloat #v2> 
				| <throw NOTANUM>)
		(<comparef #v1<=#v2> ::sys <is #val 1>
		|::sys <is #val 0>)
		<setVar stack (#val :#rest)>
		;
	<CMPLT #closure>
		//<ckstk2 #closure>
		<stack (#v1 #v2 :#rest)>
		(::sys <isFloat #v1> ::sys <isFloat #v2> 
				| <throw NOTANUM>)
		(<comparef #v1 > #v2> ::sys <is #val 1>
		|::sys <is #val 0>)
		<setVar stack (#val :#rest)>
		;
	<CMPLE #closure>
		//<ckstk2 #closure>
		<stack (#v1 #v2 :#rest)>
		(::sys <isFloat #v1> ::sys <isFloat #v2> 
				| <throw NOTANUM>)
		(<comparef #v1>=#v2> ::sys <is #val 1>
		|
		::sys <is #val 0>)
		<setVar stack (#val :#rest)>
		;
	<AND #closure>
		//<ckstk2 #closure>
		<stack (#v1 #v2 :#rest)>
		(::sys <isFloat #v1> ::sys <isFloat #v2> 
				| <throw NOTANUM>)
		(<compare #v1=#v2> <compare #v1=1> ::sys <is #val 1>
		|::sys <is #val 0>)
		<setVar stack (#val :#rest)>
		;
	<OR #closure>
		//<ckstk2 #closure>
		<stack (#v1 #v2 :#rest)>
		(::sys <isFloat #v1> ::sys <isFloat #v2> 
				| <throw NOTANUM>)
		(<compare #v1=1> ::sys <is #val 1>
		|<compare #v2=1> ::sys <is #val 1>
		|::sys <is #val 0>)
		<setVar stack (#val :#rest)>
		;
	<NOT #closure>
		//<ckstk1 #closure>
		<stack (#v1 :#rest)>
		(::sys <isFloat #v1>
				| <throw NOTANUM>)
		(<compare #v1=0> <is #val 1>
		|<is #val 0>)
		<setVar stack (#val :#rest)>
		;
	<ADDSTR #closure>
		//<ckstk2 #closure>
		<stack (#v1 #v2 :#rest)>
		::sys <concat #val (#v2 #v1)>
		<setVar stack (#val :#rest)>
		;
	<SUBSTR #closure>
		//<ckstk3 #closure>
		<stack (#v1 #v2 #v3 :#rest)>
		::sys <substr #str #v3 #v2 #v1>
		<setVar stack (#str :#rest)>
		;
	<BR #closure #code>
		::#closure <pc #pc>
		::sys <nth #addr #code #pc>
		
		::#closure <setVar pc #addr>
		;
	<BRZ #closure #code>
		::#closure <pc #pc>
		::sys <nth #addr #code #pc>
		
		(::sys <isInteger #addr> | <throw NOTADDR>)
		
		<#nextpc = #pc + 1>
		::#closure <setVar pc #nextpc>
		
		//<ckstk1 #closure>
		<stack (#v1 :#rest)>
		[<comparef #v1 = 0> ::#closure <setVar pc #addr>]
		<setVar stack #rest>
		;
	<CALL #closure #code #oldpc>
		//<ckstk1 #closure>
		<stack (#newclosure :#rest)>
		<setVar stack #rest>

		// check parameter length
		::#newclosure <parm_length #nparam>
		::#newclosure <data (#n : _)>

//		(<eq #nparam #n> | <print "error: parameter is not corresponding">
//			<throw EPARM>)

		::#newclosure <ncall #ncall>
		::#newclosure <setVar ncall <_=#ncall+1>>

		// call operation
//		::#closure <pc #oldpc>
//		[<debug on> <print <_=#oldpc-1> ":" CALL>]
		::#newclosure <setVar pc 0>
		::#newclosure <start #newclosure>
	
//		[<debug on> <print #oldpc ":" RET >]

		::#newclosure <setVar ncall #ncall>

		// return operation
		::#closure <setVar pc #oldpc>
		;
	<RET #closure>
		//<ckstk1 #closure>
		::#closure <throw RETURN>
		;
	<CLR #closure>
		::#closure <setVar data ()>
		;
	<brkdata #v #closure>
		::#closure <data #d1>
		::sys <length #l #d1>
		
		(<compare #v > #l> |
		 <#v1 = #v - #l + 1>
		 ::sys <padding #d2 #v1 0>
	
		 ::sys <append #d #d1 #d2>
		 ::#closure <setVar data #d>)
		;
	<BRK #closure>
		//<ckstk1 #closure>
		<stack (#v : #stk)>
		<setVar stack #stk>

		::#closure <data #d1>
		::sys <length #l #d1>
		
		(<compare #v >= #l>
		 <#v1 = #v - #l + 1>
		 ::sys <padding #d2 #v1 0>
		 ::sys <append #d #d1 #d2>
		 ::#closure <setVar data #d>
		|
		 <true>
		)
		;
	<INPUT #closure>
		::sys <getline #l (<SFNUM #w> | <WORD #w> | <is #w "">)>

		<stack #stack>
		<setVar stack (#w :#stack)>
		;
	<PR #closure>
		//<ckstk1 #closure>
		<stack (#v1 : #stack)>
		<printf #v1>
		::sys <flush>
		<setVar stack #stack>
		;
	<NL #closure>
		<print>
		;
	<ISNUM #closure>
		//<ckstk1 #closure>
		<stack (#v1 : #stack)>
		( ::sys <isFloat #v1> <is #b 1>
		 |<is #b 0>
		)
		<setVar stack (#b :#stack)>
		;
	<RAND #closure>
		//<ckstk1 #closure>
		::#closure <pc #pc>
		<stack (#n : #stack)>
		(::sys <isFloat #n>
		 | <print "error: parameter is not number">
		   <throw EPARM>
		)
		<#v = ::sys <random _> % #n>
		<setVar stack (#v :#stack)>
		;
	<ERR #closure>
		//<ckstk1 #closure>
		::#closure <pc #pc>
		<stack (#msg : #stack)>
		<print "error : [" #pc "] " #msg>
		<exit>
		;
>;



/********************************************************
 * Closure Basic compiler 
 ********************************************************/

<compile_run>
	(<print "Compiling...">
	 <loadprogram>
	 <print Run>
	 ::vm <start closure0>
	|
	 <print error stop>
	)
	;

<loadprogram>
	::sys<args #x>
	(<compare ::sys <length _ #x> = 2>
		| <errormsg "usage: descartes ClosureBasic PROGRAM">)
	::sys<nth #inputfile #x 1> 
	(::sys<openr #inputfile 
		( <ClosureBasic> |<errormsg "SYNTAX ERROR">)>
		| <errormsg "can't open file">)
	;

<ClosureBasic>
				<NewFunc #cl>
	<program> 
	( <EOF>
	 |			<errormsg "syntax error">
	)
	 			::vm <add code _ STOP #cl>
	;

<program>
	{<sentence> {":" <sentence>} }
	;

<sentence>
	(<If> | <For> | <While> | <Print> | <InputNum> | <Input> 
		| <Return> | <DefArray> | <Gosub>
		| <Assignment> | <Comment> )
	;

<If>
	"if"			<x <errormsg "syntax error: if ...">>
				<current_closure #cl>
	<Conditional>
	"then"			<x <errormsg "syntax error: if - then ...">>
				::vm <add code _ BRZ #cl>
				::vm <add code #ifaddr1 -1  #cl>
	<program>
				::vm <add code #braddr BR #cl>
				::vm <add code #ifaddr2 -1  #cl>
				::vm <current code #caddr1 #cl>
				::vm <set code #ifaddr1 #caddr1 #cl>
	{
	  "else" "if"		<x <errormsg "syntax error: if - then - else if ...">>
	  <Conditional>
	  "then"		<x <errormsg "syntax error: if - then ...">>
				::vm <add code _ BRZ #cl>
				::vm <add code #elseif_addr -1  #cl>
	  <program>
				::vm <add code _ BR #braddr #cl>
				::vm <current code #elseif_caddr #cl>
				::vm <set code #elseif_addr #elseif_caddr #cl>
	}
	[
	  "else"		<x <errormsg "syntax error: if - then - else ...">>
	  <program>
	]
	"end"
				::vm <current code #endaddr #cl>
				::vm <set code #ifaddr2 #endaddr #cl>
//				<set_caddr #caddr #endaddr>
	;

<For>
	"for"			<x <errormsg "syntax error: for ...">>
				<current_closure #cl>

	<VARIABLE #v>		::vm <add code _ DUP2 #cl>
	"="
	<Expression>		::vm <add code _ ROT #cl>
				::vm <add code _ POP #cl>
	"to"			<x <errormsg "syntax error: for ... to">>

	<Expression>
				::vm <add code #addr1 PUSHI #cl #cl>
				::vm <add code _ PUSHI 1 #cl>
				::vm <add code _ POP #cl>

				::vm <add code _ DUP2 #cl>
				::vm <add code _ PUSH #cl>

				::vm <add code _ PUSHI #cl #cl>
				::vm <add code _ PUSHI 1 #cl>
				::vm <add code _ PUSH #cl>

				::vm <add code _ CMPLE #cl>
				::vm <add code _ BRZ  #cl>
				::vm <add code #addr2 -1 #cl>

				::vm <add code _ PUSHI #cl #cl>
				::vm <add code _ PUSHI 1 #cl>
				::vm <add code _ PUSH #cl>

	<program>

	"next"
				::vm <add code _ PUSHI #cl #cl>
				::vm <add code _ PUSHI 1 #cl>
				::vm <add code _ POP #cl>

				::vm <add code _ DUP2 #cl>
				::vm <add code _ DUP2 #cl>
				::vm <add code _ PUSH #cl>

				::vm <add code _ PUSHI 1 #cl>
				::vm <add code _ ADD #cl>
				::vm <add code _ ROT #cl>
				::vm <add code _ POP #cl>

				::vm <add code _ PUSHI #cl #cl>
				::vm <add code _ PUSHI 1 #cl>
				::vm <add code _ PUSH #cl>

				::vm <add code _ BR #addr1 #cl>

				::vm <add code #addr3 DROP #cl>
				::vm <add code _ DROP #cl>
				::vm <set code #addr2 #addr3 #cl>
	;

<While>
	"while"			<x <errormsg "syntax error: while ...">>
				<current_closure #cl>
				<#addr1 = ::sys <length _ ::#cl <code _>>>
	<Conditional>
	"do"			<x <errormsg "syntax error: while - do ...">>
				::vm <add code _ BRZ #cl>
				::vm <add code #addr2 -1  #cl>
	<program>
	"end"
				::vm <add code _ BR #cl>
				::vm <add code #addr3 #addr1 #cl>
				::vm <set code #addr2 <_=#addr3+1> #cl>
	;

<Print>
	"print"			<x <errormsg "syntax error: print ...">>
				<current_closure #cl>
        (<CR>
	 			::vm <add code _ NL #cl>
	
	|
	 <Displayitem> 
	  {(","			::vm <add code _ PUSHI " " #cl>
				::vm <add code _ PR #cl>
	    ) 
	    <Displayitem>
	  } 
	  ( ";"
	   |
	 			::vm <add code _ NL #cl>
	  )
	)
	;

<Displayitem>
	[
	  <Exp_closure>
	 |
	  <Expression>		
	 |
	  <Exp_strings>
	]
				<current_closure #cl>
				::vm <add code _ PR #cl>
	;

<InputNum>
	"input#"
				<current_closure #cl>
				::vm <current code #addr1 #cl>
	[<STRINGS #str> ","	
				::vm <add code _ PUSHI #str #cl>
				::vm <add code _ PR #cl>
	]
				::vm <add code _ INPUT #cl>
				::vm <add code _ DUP #cl>
				::vm <add code _ ISNUM #cl>
				::vm <add code #addr2 BRZ -1 #cl>
				::vm <add code #addr3 BR -1 #cl>

				::vm <add code #addr4 DROP #cl>
				::vm <set code <_=#addr2+1> #addr4 #cl>
				::vm <add code _ PUSHI "redo from start" #cl>
				::vm <add code _ PR #cl>
				::vm <add code _ NL #cl>
				::vm <add code #addr5 BR #addr1 #cl>
				::vm <current code #addr6 #cl>
				::vm <set code <_=#addr3+1> #addr6 #cl>

	<VARIABLE #v>
				::vm <add code _ POP #cl>
	;

<Input>
	"input"
				<current_closure #cl>
	[<STRINGS #str> ","	::vm <add code _ PUSHI #str #cl>
				::vm <add code _ PR #cl>
	]
				::vm <add code _ INPUT #cl>
	<VARIABLE #v>
				::vm <add code _ POP #cl>
	;

<Gosub>
				<current_closure #cl>
	("gosub" | "call")
	<Expression>
				::vm <add code _ DROP #cl>
	;	

<Assignment>
	<VARIABLE #v>
	("="
	 	(
		  <Expression>
		 |
		  <Exp_strings>
		 )
				<current_closure #cl>
				::vm <add code _ ROT #cl>
				::vm <add code _ POP #cl>
	)
	;	

<Return>
	"return"
				<current_closure #cl>
	<Expression>
				::vm <add code _ RESTR #cl>
				::vm <add code _ RET #cl>
	;

<DefArray>
	"dim"			<x <errormsg "syntax error: dim ...">>
				<current_closure #cl>
	<ID #v>
	"["
				<x <errormsg "array size error">>
	<NUM #size>
				<#size1 = #size + 1>
				<GetVarAddr #closure #addr #size1 #v #addflag>
				[<is #addflag exist> <errormsg "multiple declare">]
				<#addr2=#addr+#size>
				::vm <add code _ PUSHI #addr2 #cl>
				::vm <add code _ BRK #cl>
	"]"
	{
	","
	<ID #vb>
	"["
				<x <errormsg "array size error">>
	<NUM #sizeb>
				<#sizeb1 = #sizeb + 1>
				<GetVarAddr #closureb #addrb #sizeb1 #vb #addflagb>
				[<is #addflagb exist> <errormsg "multiple declare">]
				<#addrb2=#addrb+#sizeb>
				::vm <add code _ PUSHI #addrb2 #cl>
				::vm <add code _ BRK #cl>
	"]"
	}
	;

<FunParm (#v : #v1) >
	<ID #v>			(::sys <isUnknown <CheckReserved #v>>
				| <errormsg 
					::sys<concat _ 
					  ("The reserved word cannot be used for the parameter : "
							#v)>>)
	;
<FunParm (#v : #v1)>
	<ID #v>			(::sys <isUnknown <CheckReserved #v>>
				| <errormsg 
					::sys<concat _ 
					  ("The reserved word cannot be used for the parameter : "
							#v)>>)
	","
	<FunParm #v1>
	;
<FunParm ()>
	;
	
<SetParm () #cl>;
<SetParm (#v :#vrparm) #cl>
			<AddVarAddr #cl1 #v #addr 1> 
			::vm <add code _ PUSHI #cl1 #cl>
			::vm <add code _ PUSHI #addr #cl>
			::vm <add code _ SAVE  #cl>
			<SetParm #vrparm #cl>
	;
<Fun>
	"{" 		<x <errormsg "syntax error: fun ...">>
	 "fun"
			<current_closure #cl>

	   "("
	     <FunParm #parm>
	   ")"
			::list <reverse #vrparm #parm>	
			::sys <length #nparam #vrparm>
			<NewFunc #closure>
//::sys <line #lineno> <print #closure ": " #lineno>
			::#closure <setVar parm_length #nparam>

			<SetParm #vrparm #closure>
	   <program> 
			::vm <add code _ PUSHI "ENORET" #closure>
			::vm <add code _ ERR #closure>
	"}"		<EndFunc>
			::vm <add code _ PUSHI #closure #cl>
	;

<Conditional>
	<cond_or>
	;

<cond_or>
				<current_closure #cl>
	<cond_and>
	{
		"or"
		<cond_and>	::vm <add code _ OR #cl>
	}
	;

<cond_and>
				<current_closure #cl>
	<cond>
	{
		"and"
		<cond>		::vm <add code _ AND #cl>
	}
	;

<cond>
	"("
	  <Conditional>
	")"
	|
	<Compare>
	;

<Compare>
				<current_closure #cl>
	<Expression>
	(
	"=="
		<Expression>	::vm <add code _ CMPE #cl>
	|
	"="
		<Expression>	::vm <add code _ CMPE #cl>
	|
	"!="
		<Expression>	::vm <add code _ CMPNE #cl>
	|
	"<>"
		<Expression>	::vm <add code _ CMPNE #cl>
	|
	">="
		<Expression>	::vm <add code _ CMPGE #cl>
	|
	">"
		<Expression>	::vm <add code _ CMPGT #cl>
	|
	"<="
		<Expression>	::vm <add code _ CMPLE #cl>
	|
	"<"
		<Expression>	::vm <add code _ CMPLT #cl>
	)
	;


<Exp_strings>
				<current_closure #cl>
	<StringsTerm>
	{
	  "+"
	  <StringsTerm>		::vm <add code _ ADDSTR #cl>
	}
	;

<StringsTerm>
				<current_closure #cl>
	(
	  <VARIABLE #v>		::vm <add code _ PUSH #cl>
	|
	  <STRINGS #str>	::vm <add code _ PUSHI #str #cl>
	)
	;


<Expression>
	<expradd>
	;

<expradd>
				<current_closure #cl>
	<exprmul>
	{
		"+"
		<exprmul>	::vm <add code _ ADD #cl>
	 |
		"-"
		<exprmul>	::vm <add code _ SUB #cl>
	}
	;

<exprmul>
				<current_closure #cl>
	<exprID>
	{
		"*"
		<exprID>	::vm <add code _ MUL #cl>
	 |
		"/"
		<exprID>	::vm <add code _ DIV #cl>
	}
	;

<exprID>
				<current_closure #cl>
	(
	 "+" 
		<exprterm>
	|
	 "-"
		<exprterm>	::vm <add code _ INV #cl>
	|
	 <exprterm>
	)
	;

<exprterm>
				<current_closure #cl>
	<exprterm2>
		{"("
		 		::vm <add code _ PUSHI #cl #cl>
				::vm <add code _ PUSHI 2 #cl>
				::vm <add code _ POP #cl>

		     <Parm #nparm>
		  ")"
		 		::vm <add code _ PUSHI #cl #cl>
				::vm <add code _ PUSHI 2 #cl>
				::vm <add code _ PUSH #cl>
				::vm <add code _ DUP #cl>
				::vm <add code _ PUSHI 0 #cl>
				::vm <add code _ PUSHI #nparm #cl>
				::vm <add code _ ROT #cl>
				::vm <add code _ POP #cl>
				::vm <add code _ CALL #cl>
		}
	;

<exprterm2>
				<current_closure #cl>
	(
	"("
		<Expression>
	")"
	|
		<Fun> 
	|
		<NUM #n>
				::vm <add code _ PUSHI #n #cl>
	|
		<STRINGS #str>	::vm <add code _ PUSHI #str #cl>
	|
		<Builtin>
	|
		<VARIABLE #v>	
				::vm <add code _ PUSH #cl>
	)
	;

<Builtin>
				<current_closure #cl>
	(
		"random" "(" <Expression> ")"
				::vm <add code _ RAND #cl>
	)
	;

<Parm #n>
	<Expression>
	<Parm #n1>		<#n = #n1 + 1>
	;
<Parm #n>
	"," <Expression>
	<Parm #n1>		<#n = #n1 + 1>
	;
<Parm 1>
	<Expression>
	;
<Parm 0>
	;
	
<VARIABLE #v>
	<ID #v>			
				<current_closure #cl>
				<noteq #v "next"> <noteq #v "end">
				::sys <isUnknown <CheckReserved #v>>
	("[" <Expression> "]" 	
				<GetVarAddr #closure #addr #len #v #addflag>
				::vm <add code _ DUP #cl>
				::vm <add code _ PUSHI #len #cl>
				::vm <add code _ CMPLE #cl>
				::vm <add code #addr1 BRZ #cl>
				<#addr2 = #addr1+8>
				::vm <add code _ #addr2 #cl>
				::vm <add code _ DUP #cl>
				::vm <add code _ PUSHI 0 #cl>
				::vm <add code _ CMPLT #cl>
				::vm <add code #addr3 BRZ #cl>
				<#addr4 = #addr3+5>
				::vm <add code _ #addr4 #cl>
				::vm <add code _ PUSHI "illegal index"  #cl>
				::vm <add code _ ERR #cl>
				::vm <add code _ PUSHI #addr #cl>
				::vm <add code _ ADD #cl>
				::vm <add code _ PUSHI #closure #cl>
				::vm <add code _ SWAP #cl>
	|
				<GetVarAddr #closure #addr 1 #v #addflag>
				[<is #addflag add>
				 ::vm <add code _ PUSHI #addr #cl>
				 ::vm <add code _ BRK   #cl>]
				::vm <add code _ PUSHI #closure #cl>
				::vm <add code _ PUSHI #addr #cl>
	)
	;

<Comment>
	"'" <SKIPCR>
	;

<errormsg #x>
	::sys <line #n>
	<warn "error: " #n " : " #x>
	<exit>
	;
<errormsg #n #x>
	<warn "error: " #n " : " #x>
	<exit>
	;


/********************************************************
 * Closure Basic compiler utility
 ********************************************************/

<reserved_word ("if" "then" "else" "end" "for" "to" "next" "step" 
	"while" "do" "dim" "print" "return" "fun" "random"
)>;

<closure_list ()>;
<var_list ()>;
<env_list ()>;
<addr_list ()>;
<addr_offset 8>;

<current_closure #cl>
	<closure_list (#cl :_)>
	;

<cln 0>;
<new_closure_name #cl>
	<cln #n>
	<setVar cln <_=#n+1>>
	::sys <concat #cl (closure #n)>
	;


<CheckReserved #name>
	<reserved_word #list>
	::compiler <CheckReserved #name #list>
	;

<AddVarAddr #closure #varname #addr #len>
	<addr_offset #addr>
	<var_list #var_list>

	<closure_list #cl>
	::sys <car #closure #cl>
	<var_list #var_list>
	::compiler <AddVar #v #varname (#closure #addr #len) #var_list>
	<setVar var_list #v>

	<setVar addr_offset <_=#addr+#len>>
	;

<DefArray #varname #len>
	<GetVarAddr #closure #addr #len #varname #addflag>
	;


<GetVarAddr #closure #addr #len #varname #addflag>
	(
	 <var_list #var_list>
	 ::compiler <GetVar #v #varname #var_list> 
	 ::sys <car #closure #v>
	 ::sys <cadr #addr #v>
	 ::sys <caddr #l #v> <eq #l #len>
	 <is #addflag exist>
	 |
	 <AddVarAddr #closure #varname #addr #len>
	 <is #addflag add>
	)
	;

<NewFunc #closure>
	<new_closure_name #closure>
	<cloneObj #closure closure>
	<closure_list #cl>
	<setVar closure_list (#closure :#cl)>
	<var_list #vl>
	<env_list #el>
	<is #el2 (#vl :#el)>
	::compiler <NewFunc #newel #el2>
	<setVar env_list #newel>
	<addr_offset #offset>
	<addr_list #addr_list>
	<setVar addr_list (#offset :#addr_list)>
	<setVar addr_offset 8>
	;

<EndFunc>
	<closure_list (#c :#cl)>
	<setVar closure_list #cl>
	<env_list #el>
	::compiler <EndFunc #newel #el>
	::sys <car #vl #newel>
	<setVar var_list #vl>
	::sys <cdr #el2 #newel>
	<setVar env_list #el2>
	<addr_list (#offset :#addr_list)>
	<setVar addr_list #addr_list>
	<setVar addr_offset #offset>
	;


? <compile_run>;