| 1011 | | /*==========================================================================*/ |
| 1012 | | |
| 1013 | | |
| 1014 | | extern ULanguage rune_language; |
| 1015 | | |
| 1016 | | |
| 1017 | | /* |
| 1018 | | Swaps set-word!/get-word! |
| 1019 | | */ |
| 1020 | | static void _conditionBlock( const UCell* bcell ) |
| 1021 | | { |
| 1022 | | UBlock* blk; |
| 1023 | | UCell* it; |
| 1024 | | UCell* end; |
| 1025 | | |
| 1026 | | blk = ur_block(bcell); |
| 1027 | | UR_ITER_BLOCK( it, end, blk, bcell ); |
| 1028 | | while( it != end ) |
| 1029 | | { |
| 1030 | | if( ur_isABlock(it) ) |
| 1031 | | { |
| 1032 | | _conditionBlock( it ); |
| 1033 | | } |
| 1034 | | else if( ur_is(it, UT_SETWORD) ) |
| 1035 | | { |
| 1036 | | ur_type(it) = UT_GETWORD; |
| 1037 | | } |
| 1038 | | else if( ur_is(it, UT_GETWORD) ) |
| 1039 | | { |
| 1040 | | ur_type(it) = UT_SETWORD; |
| 1041 | | } |
| 1042 | | ++it; |
| | 990 | /*--------------------------------------------------------------------------*/ |
| | 991 | |
| | 992 | |
| | 993 | static UCallDef rune_calls[] = |
| | 994 | { |
| | 995 | { rc_cout, "cout" }, |
| | 996 | { rc_probe, "probe" }, |
| | 997 | { rc_func_loop, "func.loop" }, |
| | 998 | { rc_declareNatives, "declare-natives" }, |
| | 999 | { rc_quit, "quit" }, |
| | 1000 | }; |
| | 1001 | |
| | 1002 | |
| | 1003 | void rune_install( UrlanEnv* env ) |
| | 1004 | { |
| | 1005 | ur_makeCalls( env, rune_calls, sizeof(rune_calls) / sizeof(UCallDef) ); |
| | 1006 | |
| | 1007 | // Bootstrap declare-natives |
| | 1008 | { |
| | 1009 | UCell* val = ur_resolveArgPath( UT_WORD, |
| | 1010 | ur_intern(env, "declare-natives", 15), |
| | 1011 | UT_NONE ); |
| | 1012 | if( val ) |
| | 1013 | { |
| | 1014 | val->call.sigN = 0; //_funcSignature( it, &argc, &varc ); |
| | 1015 | ur_argc(val) = 1; |
| | 1016 | ur_varc(val) = 0; |
| | 1017 | val->call.fetch = 1; |
| | 1018 | } |
| 1047 | | /* |
| 1048 | | (block -- code) |
| 1049 | | */ |
| 1050 | | UR_CALL( rune_compile ) |
| 1051 | | { |
| 1052 | | if( ur_is(tos, UT_BLOCK) ) |
| 1053 | | { |
| 1054 | | //printf( "KR parse compile block\n" ); |
| 1055 | | ur_initType(tos, UT_CODE); |
| 1056 | | tos->code.langId = rune_language.langId; |
| 1057 | | //tos->code.n = tos->series.n; |
| 1058 | | |
| 1059 | | _conditionBlock( tos ); |
| 1060 | | } |
| 1061 | | else |
| 1062 | | { |
| 1063 | | ur_throwErr( UR_ERR_DATATYPE, |
| 1064 | | "Rune compiler expected block! argument" ); |
| 1065 | | } |
| 1066 | | } |
| 1067 | | |
| 1068 | | |
| 1069 | | /* |
| 1070 | | (code -- ) |
| 1071 | | */ |
| 1072 | | UR_CALL( rune_run ) |
| 1073 | | { |
| 1074 | | UR_S_DROP; |
| 1075 | | |
| 1076 | | ur_disable( ur_thread->env, UR_ENV_GC ); |
| 1077 | | rune_eval( ur_thread, tos->code.n, 0 ); |
| 1078 | | ur_enable( ur_thread->env, UR_ENV_GC ); |
| 1079 | | } |
| 1080 | | |
| 1081 | | |
| 1082 | | static void rune_codeGC( UCollector* gc, UCell* cell ) |
| 1083 | | { |
| 1084 | | //printf( "KR rune_codeGC\n" ); |
| 1085 | | ur_gcMarkBlock( gc, cell->code.n ); |
| 1086 | | } |
| 1087 | | |
| 1088 | | |
| 1089 | | ULanguage rune_language = |
| 1090 | | { |
| 1091 | | 0, 0, |
| 1092 | | rune_compile, |
| 1093 | | rune_run, |
| 1094 | | rune_codeGC |
| 1095 | | }; |
| 1096 | | |
| 1097 | | |
| 1098 | | |
| 1099 | | char rune_boot[] = |
| 1100 | | "[\n" |
| 1101 | | " 0 'nop\n" |
| 1102 | | " 1 'do\n" |
| 1103 | | " 2 does\n" |
| 1104 | | " 3 reduce\n" |
| 1105 | | " 4 'if\n" |
| 1106 | | " 5 'if.else\n" |
| 1107 | | " 6 'forever\n" |
| 1108 | | " 7 'each\n" |
| 1109 | | " 8 'each-loop\n" |
| 1110 | | " 9 'break\n" |
| 1111 | | " 10 'return\n" |
| 1112 | | " 11 +\n" |
| 1113 | | " 12 -\n" |
| 1114 | | " 13 *\n" |
| 1115 | | " 14 /\n" |
| 1116 | | " 15 >\n" |
| 1117 | | " 16 <\n" |
| 1118 | | "] make-opcodes :rune-ops\n" |
| 1119 | | "[\n" |
| 1120 | | " 0 :context\n" |
| 1121 | | " 0 :prin\n" |
| 1122 | | " 0 :print\n" |
| 1123 | | " 0 :loop\n" |
| 1124 | | " 0 :loop.to\n" |
| 1125 | | "] context :rune-ctx\n" |
| 1126 | | "[\n" |
| 1127 | | " block! verify/1 rune-ops infuse rune-ctx bind\n" |
| 1128 | | " code! swap 'rune make\n" |
| 1129 | | "] proc :runec\n" |
| 1130 | | "[runec do] proc :rune\n" |
| 1131 | | "[\n" |
| 1132 | | " add [a int!/decimal! b int!/decimal!]\n" |
| 1133 | | " sub [a int!/decimal! b int!/decimal!]\n" |
| 1134 | | " mul [a int!/decimal! b int!/decimal!]\n" |
| 1135 | | " div [a int!/decimal! b int!/decimal!]\n" |
| 1136 | | " func [sig block! body block!]\n" |
| 1137 | | " cout [val]\n" |
| 1138 | | " probe [val]\n" |
| 1139 | | " type? [val]\n" |
| 1140 | | " eq? [a b]\n" |
| 1141 | | " same? [a b]\n" |
| 1142 | | " zero? [val]\n" |
| 1143 | | " to-text [val]\n" |
| 1144 | | " reduce [val]\n" |
| 1145 | | " make [type spec]\n" |
| 1146 | | " func.loop [sig body]\n" |
| 1147 | | "] define-natives\n" |
| 1148 | | "[\n" |
| 1149 | | " context: func [spec] [make context! spec]\n" |
| 1150 | | " prin: func [val] [cout to-text val]\n" |
| 1151 | | " print: func [val] [cout to-text val cout eol]\n" |
| 1152 | | " time-blk: func [blk | s] [s: now do blk now - s]\n" |
| 1153 | | "] rune\n" |
| 1154 | | "\n" |
| 1155 | | ; |
| 1156 | | |
| 1157 | | //"time-blk: func [blk | s] [s: now do blk now - s]\n" |
| 1158 | | |
| 1159 | | static UCallDef rune_calls[] = |
| 1160 | | { |
| 1161 | | { rc_cout, "cout" }, |
| 1162 | | { rc_probe, "probe" }, |
| 1163 | | { rc_func_loop, "func.loop" }, |
| 1164 | | { rc_defNatives, "define-natives" }, |
| 1165 | | }; |
| 1166 | | |
| 1167 | | |
| 1168 | | void rune_install( UrlanEnv* env ) |
| 1169 | | { |
| 1170 | | ur_registerLanguage( env, "rune", &rune_language ); |
| 1171 | | |
| 1172 | | ur_makeCalls( env, rune_calls, sizeof(rune_calls) / sizeof(UCallDef) ); |
| 1173 | | |
| 1174 | | ur_evalCStr( env->threads, rune_boot, sizeof(rune_boot) ); |
| 1175 | | } |
| 1176 | | |
| 1177 | | |
