构建不存在的语言的解释器


18

为假的,基于堆栈的语言构建解释器,该解释器获取输入,解释输入并将结果输出为数字数组。它应该遍历每个字节并根据此表执行不同的功能:

0000(0):串联(将堆栈中的前两个数字组合起来,就好像它们是字符串一样。例如:12,5-> 125)
0001(1):递增(在堆栈顶部的数字加1)
0010 (2):递减(从堆栈顶部的数字减去一个)
0011(3):乘以(堆栈的顶部两个数字相乘)
0100(4):除(将第二个到顶部的数字除以在堆栈顶部的数字)
添加(添加顶部的堆栈两个数字上):0101(5)
0110(6):减去(减去栈顶的数目从所述一个在其下方)
0111(7):指数(计算从小数到小数到大数的乘方)
1000(8):模数:(以小数为模,找到从小到大的数)
1001(9):向右旋转(将堆栈向下移动一格。底部的数字现在位于顶部)
1010(A):向左旋转(将堆栈向上移动一格。顶部的数字现在位于底部)
1011(B):复制(复制最上面的数字,以便它出现两次。例如:4,1变成4,1,1)
1100(C):双重复制(复制堆栈上的最上面的两个数字。ex :4, 1,2变成4,1,2,1,2)
1101(D):交换(交换堆栈中的前两个数字。例如:4,1,2变成4,2,1)
1110(E):双交换(交换最上面的两个数字,下面两个交换。例如:1,2,3,4,5变成1,4,5,2,3)
1111(F):删除/弹出(删除上面的数字堆栈)

例如,包含

1 1 BC 5 C 5 B 9 5-输入(十六进制)
| | | | | | | | | |
1 2 2 2 4 4 6 6 2 8 8-堆栈
    2 2 2 2 4 6 6 6
      2 2 4 2 4 6 4
      2 2 2 2 4 2
          2 2 2

将输出[8,6,4,2]

规则:

  • 可以使用Unicode /符号,但最好使用ASCII。
  • 有创造力!短缺很重要,但是创造力很棒!
  • 如果字节太难用,请使用"$iv*/+-^%><dtsz.""0123456789ABCDEF"代替实际字节。
  • 速度!越快越好。
  • 分数基于声誉,但规模是一个很大的因素。

奖金:

尝试使用新创建的解释器来完成挑战,并且尽可能少用字符串。

注意:

与其他代码查询挑战相比,使此挑战具有挑战性的是,没有代码可与此相伴。可以说,如果您必须编写一个Brainf * ck解释器,那么您可以看看其他人的实现。有了这个,您将无法做到。


我忘记在此输入日期和结束日期。我猜我将在创建该工具后的一个月内完成。2月22日票数最高的人获胜!


1
如果您说获胜者是由投票决定的,那是一场人气竞赛,而不是一场代码高尔夫
Ry-

8
它不再不存在了,对吗?:)
Kendall Frey 2014年

1
从技术上讲,一种语言不需要解释器或编译器即可成为语言。:P
Kendall Frey 2014年

2
IIUC,我们应该从一个空堆栈开始,将下溢视为零?
John Dvorak 2014年

2
您应该从堆栈上的单个0开始(因为如果没有数字开头,则无法执行任何操作)。我会把下溢的事情留给你。随便什么。
塔科努特2014年

Answers:


14

Ruby,67行正则表达式替换

我决定使用正则表达式编写解释器,同时坚持使用高效的算法。

我本可以使用纯字节,但是使用符号使代码在我看来更具可读性。当然,如果我们可以将两个指令打包在一个字节中...

负值的连接导致十的补码行为,反映了内部表示形式。

除法是整数除法,余数永远不会为负。

subs = [
  # stack expansion
  [/^ ?([$iv*\/+\-^%dtsz.])/,  ' 0 \1'  ],
  [/^ (\d+ [$*\/+\-^%tsz])/,   ' 0 \1'  ],
  [/^ ((\d+ ){2,3}z)/,         ' 0 \1'  ],
  [/ (0|9)\1+/,                ' \1'    ],
  # concatenation
  [/ (\d+) (?:0+|9+)(\d+) \$/, ' \1\2 ' ], 
  [/ (\d+) (0|9) \$/,          ' \1\2 ' ],
  # swaps
  [/ ((?:\d+ )*)(\d+) </,      ' \2 \1' ],
  [/ (\d+)((?: \d+)*) >/,      '\2 \1 ' ],
  [/ (\d+) (\d+) s/,           ' \2 \1 '],
  [/ (\d+ \d+) (\d+ \d+) z/,   ' \2 \1 '],
  # dups
  [/ (\d+) d/,                 ' \1 \1 '],
  [/ (\d+ \d+) t/,             ' \1 \1 '],
  # pop
  [/ (\d+) \./,                ' '      ],

  # increment / decrement
  [/ (\d+) i/, ' \1I '], [/ (\d+) v/, ' \1V '],
  *(%w[0I 1I 2I 3I 4I 5I 6I 7I 8I 9I].zip [*?1..?9, 'I0']),
  *(%w[0V 1V 2V 3V 4V 5V 6V 7V 8V 9V].zip ['V9', *?0..?8]), 
  [' 1', ' 01'], [' 8', ' 98'], [' I', ' '], [' V', ' '],
  # addition, subtraction
  [/ (\d+) (\d+) \+/,                ' \1P \2P '       ], #init addition
  [/ (\d+) (\d+) \-/,                ' \1S \2S '       ], #init subtraction
  [/ ([PS](\d)\w*) (\d+[PS]\w*) /,   ' \2\1 \3 '       ], #sign extend left
  [/ (\d+[PS]\w*) ([PS](\d)\w*) /,   ' \1 \3\2 '       ], #sign extend right
  [/ (\d*)(\d)P(\S*) (\d*)0P(0*) /,  ' \1P\2\3 \4P0\5 '], #advance addition
  [/ (\d*)(\d)S(\S*) (\d*)0S(0*) /,  ' \1S\2\3 \4S0\5 '], #advance subtraction
  [/ (\d+)P(\S*) (\d*[1-5])P(0*) /,  ' \1IP\2 \3VP\4 ' ], #transfer left
  [/ (\d+)P(\S*) (\d*[6-9])P(0*) /,  ' \1VP\2 \3IP\4 ' ], #transfer right
  [/ (\d+)S(\S*) (\d*[1-5])S(0*) /,  ' \1VS\2 \3VS\4 ' ], #decrement both
  [/ (\d+)S(\S*) (\d*[6-9])S(0*) /,  ' \1IS\2 \3IS\4 ' ], #increment both
  [/ [PS](\S+) [PS]0+ /,             ' \1 '            ], #finish 

  # digitwise negation
  *(%w[9N 8N 7N 6N 5N 4N 3N 2N 1N 0N].zip [*'N0'..'N9']),
  #multiplication and division by 2
  *([*'H0'..'H9'].zip %w[0H 0F 1H 1F 2H 2F 3H 3F 4H 4F]),
  *([*'F0'..'F9'].zip %w[5H 5F 6H 6F 7H 7F 8H 8F 9H 9F]),  
  *(%w[0T 1T 2T 3T 4T 5T 6T 7T 8T 9T].zip %w[T0 T2 T4 T6 T8 TI0 TI2 TI4 TI6 TI8]), 
  ['H ', ' '], [' T', ' '],

  # sign correction for */%
  [/ (\d+) (9\d*) ([*\/%])/, ' \1NI \2NI \3'], [' N', ' '],
  # multiplication
  [/ (0+ \d+|\d+ 0+) \*/,     ' 0 '          ], #multiplication by zero
  [/ (\d+) (0\d*[02468]) \*/, ' \1T H\2 *'   ], #multiplication by an even number
  [/ (\d+) (0\d*[13579]) \*/, ' \1 \1 \2V *+'], #multiplication by an odd number
  # division / modulo
  [?/, 'r.'], [?%, 'rs.'],
  [/ (0|9)(\d*) (0\d+) r/,           ' \3 0 \1D\2 '          ], #init division
  [/ (\d+) (\d+) (0\d*)D(\d*) /,     ' \1 \2I \3SD\4 \1S '   ], #subtract divisor
  [/ (\d+) (\d+) (9\d*)D(\d)(\d*) /, ' \1 \2V0 \3P\4D\5 \1P '], #add divisor and advance
  [/ (\d+) (\d+) (9\d*)D /,          ' \2V \3P \1P '         ], #add divisor and finish  

  #exponentiation
  [/ \d+ 0+ \^/,             ' 01 '          ], # case: zeroth power
  [/ 9\d+ 9+ \^/,            ' 9 '           ], # case: reciprocal of negative
  [/ \d+ 9\d+ \^/,           ' 0 '           ], # case: high negative power
  [/ 0\d+ 9\d+ \^/,          ' 0 '           ], # case: reciprocal of positive
  [/ (\d+) 0+1 \^/,          ' \1 '          ], # case: power of one
  [/ (\d+) (\d*[02468]) \^/, ' \1 \1 *H\2 ^' ], # case: even exponent
  [/ (\d+) (\d*[13579]) \^/, ' \1 \2V ^\1 *' ], # case: odd exponent
]                                   

x = gets.tr '^$iv*/+\-^%><dtsz.', ''
until x =~ /^ (\d+ )*$/
  subs.each do |sub|
    x.sub!(*sub) # && (puts x; sleep 0.1)
  end
end

至于奖金回合,我想出的最短的解决方案(13个字符)是一个干净的解决方案:

iistisii$<$<$

在我看来,您的红利解决方案缺少初始名称d(在之后ii,堆栈 包含2,没有要交换的内容),而最终旋转(好吧,至少第一个旋转,第二个只是变相的交换... )应该在左边,而不是右边。
Mormegil 2014年

@Mormegil我使用的解释是,堆栈会根据需要以零自动扩展。因此,无需复制前导零。至于旋转方向,我将重新检查...
John Dvorak 2014年

@Mormegil旋转方向固定,谢谢。
约翰·德沃夏克

哦,是的,我错过了有关下溢解释的评论,很遗憾,我的解决方案无法做到这一点。
Mormegil 2014年

11

x86程序集(在Win32上)

“ SPEED!”在这里似乎非常重要,在这方面,我们都知道没有什么比汇编语言更好。所以,让我们在组装中做到这一点!

这是x86汇编语言(采用NASM语法)的一种语言实现,直接使用本机x86堆栈将数字存储并解释为无符号的32位整数。堆栈下溢和任何算术运算(或零除)期间的溢出都是运行时错误,并以错误消息终止程序。

        global _start

        extern _GetCommandLineA@0
        extern _GetStdHandle@4
        extern _CreateFileA@28
        extern _GetFileSize@8
        extern _LocalAlloc@8
        extern _ReadFile@20
        extern _CloseHandle@4
        extern _WriteFile@20

section .text

; ---------------------------------------------------------------------------------------
; Initialization
; ---------------------------------------------------------------------------------------

_start:
        ; Retrieve command line
        CALL _GetCommandLineA@0

        ; Skip argv[0]
        MOV ESI, EAX
        XOR EAX, EAX
skipuntilspace:
        MOV AL, [ESI]
        INC ESI
        TEST EAX, EAX
        JE missingparam
        CMP EAX, ' '
        JNE skipuntilspace
        INC ESI

        ; Open the file
        PUSH 0
        PUSH 80h
        PUSH 3
        PUSH 0
        PUSH 1
        PUSH 80000000h
        PUSH ESI
        CALL _CreateFileA@28
        CMP EAX, -1
        JE  cannotopenfile

        ; Get its size
        PUSH EAX
        PUSH 0
        PUSH EAX
        CALL _GetFileSize@8

        PUSH EAX

        ; Allocate memory buffer
        PUSH EAX
        PUSH 0
        CALL _LocalAlloc@8
        TEST EAX, EAX
        MOV ESI, EAX
        JZ outofmemory

        POP ECX
        POP EAX
        PUSH EAX

        ; Store end-of-program pointer
        MOV [programend], ESI
        ADD [programend], ECX

        ; Read the file contents
        PUSH 0
        PUSH buff
        PUSH ECX
        PUSH ESI
        PUSH EAX
        CALL _ReadFile@20
        TEST EAX, EAX
        JZ cannotopenfile

        ; Close the file
        CALL _CloseHandle@4

; ---------------------------------------------------------------------------------------
; Main loop of the interpreter
; ---------------------------------------------------------------------------------------

        ; Store the end of stack into EBP
        MOV EBP, ESP

        ; Push an initial 0 onto the stack
        XOR EAX, EAX
        PUSH EAX

mainloop:
        ; Load the next opcode, if not end of program
        XOR EAX, EAX
        CMP ESI, [programend]
        MOV AL, [ESI]
        JAE endloop
        LEA ESI, [ESI+1]

        ; Check if the opcode is valid
        CMP EAX, (maxop - opcodetable) / 8
        JA  fault_invalidopcode

        ; Check for required stack space
        MOV ECX, [opcodetable + 8 * EAX + 4]
        LEA EDI, [ESP + ECX]
        CMP EDI, EBP
        JA  fault_stackunderflow

        ; Jump to the respective opcode handler
        MOV EAX, [opcodetable + 8 * EAX]
        JMP EAX

; ---------------------------------------------------------------------------------------
; Implementation of the specific operations
; ---------------------------------------------------------------------------------------

        ; ************** CAT 0000 (0): Concatenate (Combine top two numbers in a stack as if they were a string. ex: 12,5 -> 125)
op_concatenate:
        POP EBX
        POP EAX
        MOV ECX, EAX
        MOV EDI, 10
concat_loop:
        XOR EDX, EDX
        SHL EBX, 1
        DIV EDI
        LEA EBX, [4 * EBX + EBX]
        TEST EAX, EAX
        JNZ concat_loop

        ADD EBX, ECX
        PUSH EBX
        JMP mainloop

        ; ************** INC 0001 (1): Increment (Add 1 to the number on the top of the stack)
op_increment:
        POP EAX
        ADD EAX, 1
        PUSH EAX
        JNC mainloop
        JMP fault_intoverflow

        ; ************** DEC 0010 (2): Decrement (Subtract one from the number at the top of the stack)
op_decrement:
        POP EAX
        SUB EAX, 1
        PUSH EAX
        JNC mainloop
        JMP fault_intoverflow

        ; ************** MUL 0011 (3): Multiply (Multiply the top two numbers in the stack)
op_multiply:
        POP EAX
        POP EDX
        MUL EDX
        TEST EDX, EDX
        PUSH EAX
        JZ mainloop
        JMP fault_intoverflow

        ; ************** DIV 0100 (4): Divide (Divide the 2nd-to-top number by the top number on the stack)
op_divide:
        POP ECX
        TEST ECX, ECX
        POP EAX
        JZ fault_dividebyzero
        XOR EDX, EDX
        DIV ECX
        PUSH EAX
        JMP mainloop

        ; ************** MOD 0101 (5): Add (Add the top two numbers on the stack)
op_add:
        POP EAX
        ADD [ESP], EAX
        JNC mainloop
        JMP fault_intoverflow

        ; ************** SUB 0110 (6): Subtract (Subtract the top number on the stack from the one below it)
op_subtract:
        POP EAX
        SUB [ESP], EAX
        JNC mainloop
        JMP fault_intoverflow

        ; ************** EXP 0111 (7): Exponent (Calculate the second-to-top number to the power of the top number)
op_exponent:
        POP ECX
        POP EBX
        MOV EAX, 1
exploop:
        TEST ECX, 1
        JZ expnomult
        MUL EBX
        TEST EDX, EDX
        JNZ fault_intoverflow
expnomult:
        SHR ECX, 1
        JZ expdone
        XCHG EAX, EBX
        MUL EAX
        TEST EDX, EDX
        XCHG EAX, EBX
        JZ exploop
        JMP fault_intoverflow
expdone:
        PUSH EAX
        JMP mainloop

        ; ************** MOD 1000 (8): Modulus: (Find the second-to-top number modulo the top one)
op_modulus:
        POP ECX
        TEST ECX, ECX
        POP EAX
        JZ fault_dividebyzero
        XOR EDX, EDX
        IDIV ECX
        PUSH EDX
        JMP mainloop

        ; ************** ROR 1001 (9): Rotate Right (Shift the stack down one. The number on the bottom is now on the top)
op_rotright:
        MOV EAX, [EBP - 4]
        LEA ECX, [EBP - 4]
        SUB ECX, ESP
        MOV EDX, ESI
        SHR ECX, 2
        LEA EDI, [EBP - 4]
        LEA ESI, [EBP - 8]
        STD
        REP MOVSD
        MOV [ESP], EAX
        CLD
        MOV ESI, EDX
        JMP mainloop

        ; ************** ROL 1010 (A): Rotate Left (Shift the stack up one. The number on the top is now on the bottom)
op_rotleft:
        MOV EAX, [ESP]
        LEA ECX, [EBP - 4]
        SUB ECX, ESP
        MOV EDX, ESI
        SHR ECX, 2
        LEA ESI, [ESP + 4]
        MOV EDI, ESP
        REP MOVSD
        MOV [EBP - 4], EAX
        MOV ESI, EDX
        JMP mainloop

        ; ************** DUP 1011 (B): Duplicate (Copy the top number so that it appears twice. ex: 4,1 becomes 4,1,1)
op_duplicate:
        PUSH DWORD [ESP]
        JMP mainloop

        ; ************** DU2 1100 (C): Double Duplicate (Copy the top two numbers on the stack. ex: 4,1,2 becomes 4,1,2,1,2)
op_dblduplicate:
        PUSH DWORD [ESP+4]
        PUSH DWORD [ESP+4]
        JMP mainloop

        ; ************** SWP 1101 (D): Swap (Swap the top two numbers on the stack. ex: 4,1,2 becomes 4,2,1)
op_swap:
        POP EAX
        POP EDX
        PUSH EAX
        PUSH EDX
        JMP mainloop

        ; ************** SW2 1110 (E): Double Swap (Swap the top two numbers with two below them.ex: 1,2,3,4,5 becomes 1,4,5,2,3)
op_dblswap:
        POP EAX
        POP EBX
        POP ECX
        POP EDX
        PUSH EBX
        PUSH EAX
        PUSH EDX
        PUSH ECX
        JMP mainloop

        ; ************** POP 1111 (F): Delete/Pop (Remove the number at the top of the stack)
op_pop:
        POP EAX
        JMP mainloop


; ---------------------------------------------------------------------------------------
; End of the program: print out the resulting stack and exit
; ---------------------------------------------------------------------------------------

endloop:
        MOV ESI, ESP

printloop:
        CMP ESI, EBP
        JNB exit
        MOV EAX, [ESI]
        MOV EBX, ESI
        PUSH EBX
        CALL printnum
        POP EBX
        LEA ESI, [EBX + 4]
        JMP printloop

exit:
        MOV ESP, EBP
        ;POP EAX
        XOR EAX, EAX
        RET


; ---------------------------------------------------------------------------------------
; Faults
; ---------------------------------------------------------------------------------------

fault_invalidopcode:
        MOV EAX, err_invalidopcode
        JMP fault

fault_stackunderflow:
        MOV EAX, err_stackunderflow
        JMP fault

fault_dividebyzero:
        MOV EAX, err_dividebyzero
        JMP fault

fault_intoverflow:
        MOV EAX, err_intoverflow
        JMP fault

fault:
        CALL print
        MOV EAX, crlf
        CALL print

        MOV ESP, EBP
        MOV EAX, 1
        RET


missingparam:
        MOV EAX, err_missingparameter
        JMP fault

cannotopenfile:
        MOV EAX, err_cannotopenfile
        JMP fault

outofmemory:
        MOV EAX, err_outofmemory
        JMP fault

; ---------------------------------------------------------------------------------------
; Helper functions
; ---------------------------------------------------------------------------------------

printnum:
        MOV EBX, 10
        CALL printnumrec
        MOV EAX, crlf
        JMP print

printnumrec:
        PUSH EAX
        PUSH EDX
        XOR EDX, EDX
        DIV EBX
        TEST EAX, EAX
        JZ printnumend
        CALL printnumrec
printnumend:
        MOV EAX, EDX
        CALL printdigit
        POP EDX
        POP EAX
        RET


printdigit:
        ADD EAX, '0'
        MOV [printbuff], EAX
        MOV EAX, printbuff
        JMP print


print:
        MOV  ESI, EAX
        PUSH 0
        PUSH buff
        CALL strlen
        PUSH EAX
        PUSH ESI
        PUSH -11
        CALL _GetStdHandle@4
        PUSH EAX
        CALL _WriteFile@20
        RET

strlen:
        XOR ECX, ECX
strlen_loop:
        CMP BYTE [ESI+ECX], 0
        JE strlen_end
        LEA ECX, [ECX+1]
        JMP strlen_loop
strlen_end:
        MOV EAX, ECX
        RET


; ---------------------------------------------------------------------------------------
; Data
; ---------------------------------------------------------------------------------------

section .data

; Table of opcode handlers and required stack space (in bytes, i.e. 4*operands)
opcodetable:
        DD op_concatenate, 8
        DD op_increment, 4
        DD op_decrement, 4
        DD op_multiply, 8
        DD op_divide, 8
        DD op_add, 8
        DD op_subtract, 8
        DD op_exponent, 8
        DD op_modulus, 8
        DD op_rotright, 0
        DD op_rotleft, 0
        DD op_duplicate, 4
        DD op_dblduplicate, 8
        DD op_swap, 8
        DD op_dblswap, 16
        DD op_pop, 4
maxop:

crlf                    DB 13, 10, 0
err_invalidopcode       DB "Invalid opcode", 0
err_stackunderflow      DB "Stack underflow", 0
err_dividebyzero        DB "Division by zero", 0
err_intoverflow         DB "Integer overflow", 0

err_missingparameter:   DB "Missing parameter: Use nexlang file.bin", 0
err_cannotopenfile:     DB "Unable to open input file", 0
err_outofmemory:        DB "Not enough memory", 0

section .bss

programend      RESD 1
printbuff       RESD 1
buff            RESD 1

要编译此文件,请使用类似

nasm.exe -fwin32 nexlang.asm
ld -o nexlang.exe -e _start nexlang.obj -s -lkernel32

该程序在命令行上(例如nexlang.exe testprg.bin)接收包含该程序的二进制文件的名称。完成后,它将以易于理解的格式将堆栈的最终内容打印到标准输出中。

为了帮助测试,请将以下内容保存到nex.def

%define CAT DB 00h
%define INC DB 01h
%define DEC DB 02h
%define MUL DB 03h
%define DIV DB 04h
%define ADD DB 05h
%define SUB DB 06h
%define EXP DB 07h
%define MOD DB 08h
%define ROR DB 09h
%define ROL DB 0Ah
%define DUP DB 0Bh
%define DU2 DB 0Ch
%define SWP DB 0Dh
%define SW2 DB 0Eh
%define POP DB 0Fh

然后使用上面定义的助记符编写您的NEX(“不存在”,如问题标题中所述)程序,并使用类似

nasm.exe -p nex.def -o prg.bin prg.nex

例如,对于原始测试用例,请使用以下命令prg.nex

INC     ; 1
INC     ; 2
INC     ; 3
INC     ; 4
DUP     ; 4 4
DU2     ; 4 4 4 4
ADD     ; 8 4 4
DU2     ; 8 4 8 4 4
ADD     ; 12 8 4 4
DUP     ; 12 12 8 4 4
ROR     ; 4 12 12 8 4
ADD     ; 16 12 8 4

最后,对于“ 2014”挑战,请使用以下14字节的NEX程序:

DUP     ; 0 0
DUP     ; 0 0 0
INC     ; 1 0 0
INC     ; 2 0 0
SWP     ; 0 2 0
CAT     ; 20 0
SWP     ; 0 20
INC     ; 1 20
DUP     ; 1 1 20
INC     ; 2 1 20
INC     ; 3 1 20
INC     ; 4 1 20
CAT     ; 14 20
CAT     ; 2014

为什么LEA ESI, [ESI+1]而不是INC ESI
2014年

实际上,最终结果没有真正的原因;通常,速度/大小/受影响的标志可能很重要。但是我并没有真正优化结果,基本上只是第一次尝试。
Mormegil 2014年

1
这绝对是最酷的。我玩的很开心:)。
塔科努特2014年

9

GolfScript,64个字符

好,所以我决定尝试打高尔夫球。还有什么比GolfScript更好的高尔夫语言?

方便地,GolfScript本身已经是具有单字节命令的基于堆栈的语言,并且碰巧,您的16个命令中有11个直接映射到内置的GolfScript命令。因此,我真正需要解释您的语言的就是在GolfScript中实现其余五个命令并构建一个转换表:

0\{'`+~
)
(
*
/
+
-
?
%
](+~
])\~
.
1$1$
\
[@]\+~\
;'n%=~}/]-1%`

该代码看起来有点分散,因为我使用换行符作为转换表的定界符。初始值0\将零压入堆栈,并将其移至输入程序下方。{ }/包含大部分代码的循环将输入程序从堆栈中移出,并在其每个字符上循环循环主体,最后]-1%`将堆栈收集到数组中,并对其进行反转(因为示例输出从数组的顶部开始)堆栈)并对其进行字符串化。

循环体以16行单引号字符串开头。 n%在换行符处拆分此字符串,=查找与输入字符对应的子字符串,并将~该子字符串评估为GolfScript代码。

最后,这是16个命令的GolfScript实现:

  • 0 = `+~:将两个数字连接为字符串
  • 1 = ):增量
  • 2 = (:递减
  • 3 = *:相乘
  • 4 = /:除
  • 5 = +:添加
  • 6 = -:减
  • 7 = ?:加油
  • 8 = %:模量
  • 9 = ](+~:向右旋转堆栈
  • A = ])\~:向左旋转堆栈
  • B = .:重复
  • C = 1$1$:重复两次
  • D = \:互换
  • E = [@]\+~\:两次互换
  • F = ;:流行

我对双重交换感到不满意–它很丑陋,而且比其他任何命令都长。感觉应该有一个更好的方法,但是如果是这样,我还没有找到它。尽管如此,至少它能起作用。

例如,在输入上运行上述程序(作为GolfScript / Ruby / Perl / Python /等双引号字符串):

"\x01\x01\x0B\x0C\x05\x0C\x05\x0B\x09\x05"

产生输出:

[8 6 4 2]

编辑:我设法使用转换表的更紧凑的编码来保存另外两个字符,总计62个字符。但是,它牺牲了可读性:

0\{(')(*/+-?%'1/'](+~
])\~
.
1$1$
\
[@]\+~\
;
`+~'n/+=~}/]-1%`

此版本的显着功能包括(循环开头的,将命令索引从0..15更改为-1..14,这样我就可以将较长的单字符命令序列从1改为8。的桌子。这使我可以将它们存储在单独的字符串中,并消除界定它们的八行换行符;,,额外的复杂性使我在其他地方损失了六个字符。


您可以+参加])\+~
John Dvorak 2014年

@JanDvorak:是的,这应该很明显。谢谢!
Ilmari Karonen 2014年

8

哈斯克尔

只是为了好玩,我提出了一个不使用任何变量,仅将函数组合在一起的解决方案。

import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.Function

type SM = State [Int]

pop :: SM Int
pop = state ((,) <$> head <*> tail)

push :: Int -> SM ()
push = modify . (:)

popN :: Int -> SM [Int]
popN = sequence . flip replicate pop

pushN :: [Int] -> SM ()
pushN = mapM_ push

rotL, rotR :: Int -> [a] -> [a]
rotL = (uncurry (flip (++)) .) . splitAt
rotR = (reverse .) . flip (flip rotL . reverse)

step :: Int -> SM ()
step 0x00 = push =<< ((read .) . on (++) show) <$> pop <*> pop
step 0x01 = push . (+ 1) =<< pop
step 0x02 = push . subtract 1 =<< pop
step 0x03 = push =<< (*) <$> pop <*> pop
step 0x04 = push =<< flip div <$> pop <*> pop
step 0x05 = push =<< (+) <$> pop <*> pop
step 0x06 = push =<< flip (-) <$> pop <*> pop
step 0x07 = push =<< flip (^) <$> pop <*> pop
step 0x08 = push =<< flip mod <$> pop <*> pop
step 0x09 = modify $ (:) <$> last <*> init
step 0x0A = modify $ rotL 1
step 0x0B = pop >>= pushN . replicate 2
step 0x0C = popN 2 >>= pushN . concat . replicate 2
step 0x0D = popN 2 >>= pushN . rotL 1
step 0x0E = popN 4 >>= pushN . rotL 2
step 0x0F = void pop

run :: [Int] -> [Int]
run = flip execState [0] . mapM_ step

6

红宝石,330 316个字符

我决定打高尔夫球。(因为这总是很有趣。)

s=[0]
o=->c{t=s.pop;s.push s.pop.send(c,t)}
gets.chop.each_char{|c|eval %w[t=s.pop;s.push"#{s.pop}#{t}".to_i s[-1]+=1 s[-1]-=1 o[:*] o[:/] o[:+] o[:-] o[:**] o[:%] s.rotate! s.rotate!(-1) s.push(s[-1]) s.concat(s[-2..-1]) s[-1],s[-2]=s[-2],s[-1] s[-1],s[-2],s[-3],s[-4]=s[-4],s[-3],s[-1],s[-2] s.pop][c.to_i 16]}
p s

主要部分是这样的:

gets.chop.each_char{|c|eval [(huge array of strings)][c.to_i 16]}

它将每个十六进制数字转换为以10为底的整数,然后使用[(huge array of strings)]来查找代表该命令的正确字符串。然后就是eval那个字符串。

请注意,这%w[x y z]等效于['x','y','z']

我也喜欢如何在那条线上找到笑脸!他们之中有一些是

  • :*
  • :/
  • :-]
  • :%

样品运行:

c:\a\ruby>random_cg_lang
11BC5C5B95
[2, 4, 6, 8]

4

C- 642634个字符

$iv*/+-^%><dtsz.仅适用于方言(q与一起作为结尾字符添加0):

#define P s=*t;a=realloc(a,--w<<2);t=a+w-1;
#define H(n)a=realloc(a,(w+=n)<<2);
#define B(n)break;case n:
*a,*t,s,w=1,i;main(){t=a=calloc(4,1);while((i=getchar())&&i^'q')switch(i){B(36)P*t*=pow(10,((
int)log10(s))+1);*t+=s;B(105)++*t;B(118)--*t;B(42)P*t*=s;B(47)P*t/=s;B(43)P*t+=s;B(45)P*t-=s;
B(94)P*t=pow(*t,s);B(37)P*t%=s;B(62)s=*a;memcpy(a,a+1,(w-1)<<2);*t=s;B(60)s=*t;memcpy(a+1,a,(
w-1)<<2);*a=s;B(100)H(1)t=a+w-2;s=*t;t++;*t=s;B(116)H(2)t=a+w-1;t[-1]=t[-3];*t=t[-2];B(115)s=
*t;*t=t[-1];t[-1]=s;B(122)s=*t;*t=t[-2];t[-2]=s;s=t[-1];t[-1]=t[-3];t[-3]=s;B(46)P}putchar('[
');putchar(32);while(w)printf("%i ",a[--w]);putchar(']');}

2014年挑战的解决方案:dididiizs>


我认为你会输free(a);。而且,不应该<<2realloc通话中吗?
luser droog 2014年

@luserdroog是的,谢谢。我只是习惯free()记忆:P
Oberon 2014年

3

k,228

(,0){({(-7h$,/$2#x),2_x};@[;0;+;1];@[;0;-;1];{.[*;|2#x],2_x};{.[%;|2#x],2_x};
{.[+;|2#x],2_x};{.[-;|2#x],2_x};{.[xexp;|2#x],2_x};{.[mod;|2#x],2_x};{(*|x),-1_x};
{(1_x),*x};{(*x),x};{(2#x),x};{(|2#x),2_x};{,/(|2 2#x),4_x};1_)[y]x}/
0x01010b0c050c050b0905

8 4 6 2

在执行类似指令时有很多重复,可以在某种程度上进行重复设计。


我不断发现我的观点是正确的。
luser droog 2014年

3

C 924 882 622 603 587 569 562个字符

删除明显的换行符(保留可读性)。

#define A sbrk(8);signal(11,S);
#define W(x)write(1,x,1);
#define P (t>s?*--t:0)
#define U *t++
#define B(x,y)else if(b==(w=w+1 x)){w=P;y;U=w;}
*t,*s,w,a,d;char b;S(x){A}
p(x){if(x<0){W("-")x=-x;}if(x>9)p(x/10);b=48+x%10;W(&b)}
main(c){t=s=A U=0;
while(read(0,&b,1))if(!(w=47));
B(,w+=P*pow(10,w?ceil(log10(w)):1))
B(,++w)
B(,--w)
B(,w*=P)
B(,w=P/w)
B(,w+=P)
B(,w=P-w)
B(,w=pow(P,w))
B(,w=P%w)
B(,w=*s;memmove(s,s+1,t-s<<2))
B(+7,memmove(s+1,s,t++-s<<2);*s=w;w=P)
B(,U=w)
B(,a=P;U=a;U=w;U=a)
B(,a=P;U=w;w=a)
B(,a=P;c=P;d=P;U=a;U=w;U=c;w=d)
B(,w=P)
for(W("[")t>s;)p(P),W(" ")
W("]")}

这实现了Jan Dvorak的评论中的“下溢推零”解释。

在这里,高尔夫的版本与非高尔夫版本相比实际上发生了很大变化,这是在Oberon好的回答的(受欢迎)压力下。

我发现用... 链代替switch语句使我能够从案件中排除所有数字。而是将变量初始化为47,因此将其递增一次将其递增为48(== ascii ),然后每种情况递增,直到我们需要跳到这一点为止,我们使用几乎为空的第一个宏参数,该参数会额外增加7到“ A”。未发布版本确实显示了我的最爱/ 技巧,无需进一步分配即可获得“空闲”内存。ifelsew'0'w'A'sbrkSIGSEGV

#include<math.h>
#include<signal.h>
void S(int x){signal(SIGSEGV,S);sbrk(8*8*8);}
int*s,*t,*i,w,a,c,d;    //stack top index working accumulator count data
u(x){*t++=x;}           //push()
o(){return t>s?*--t:0;} //pop()
#define W(x)write(1,&x,1);  //output a byte
p(x){                   //print()
    if(x<0){    //negative?
        W(*"-") //output '-'
        x=-x;   //negate
    }
    if(x>9)     //more than one digit?
        p(x/10); //recurse after integer-divide
    b=48+x%10;   //isolate and convert single digit to ascii
    W(b)         //output ascii digit
}
main(){
    char b[1];
    signal(SIGSEGV,S);  //auto-allocate memory for stack
    t=s=sbrk(8*8*8);  //get start of memory and allocate
    while(read(0,b,1)){
        write(1,b,1); //for debugging: echo the command being executed
        switch(*b){
            case '0': w=o(); a=o(); for(c=ceil(log10(w));c>0;c--) a*=10; u(a+w); break;
            case '1': u(o()+1); break;
            case '2': u(o()-1); break;
            case '3': w=o(); u(o()*w); break;
            case '4': w=o(); u(o()/w); break;
            case '5': u(o()+o()); break;
            case '6': w=o(); u(o()-w); break;
            case '7': c=o();a=1; for(w=o();c>0;c--) a*=w; u(a); break;
            case '8': w=o(); u(o()%w); break;
            case '9': w=*s; memmove(s,s+1,4*(t-s-1)); t[-1]=w; break;
            case 'A': w=t[-1]; memmove(s+1,s,4*(t-s-1)); *s=w; break;
            case 'B': w=o(); u(w); u(w); break;
            case 'C': w=o(); a=o(); u(a); u(w); u(a); u(w); break;
            case 'D': w=o(); a=o(); u(w); u(a); break;
            case 'E': w=o(); a=o(); c=o(); d=o(); u(a); u(w); u(d); u(c); break;
            case 'F': o(); break;
        }
    }
    write(1,"\n[",2);   //dump the stack
    i=t;
    do {
        p(*--i);
    } while(i>s && write(1,",",1));
    write(1,"]\n",2);
}

废话!我没有在串联中考虑负面因素。我认为log甚至没有定义。
luser droog 2014年

高尔夫版本一旦碰到页面边界,就会有很大的减速,它将反复进行段错误处理,在处理程序中分配8字节,重试内存访问,针对每个8字节范围反复进行段错误处理,直到内存变为有效。非高尔夫选手使用一个较大的常数,并且不应那么慢,但是算法是相同的。
luser droog 2014年

1

R,428个字符

f=function(I){s=0;for(i in strsplit(I,"")[[1]]){r=s[-(1:2)];s=switch(i,'0'=c(as.integer(paste0(s[2],s[1])),r),'1'=c(s[1]+1,s[-1]),'2'=c(s[1]-1,s[-1]),'3'=c(s[1]*s[2],r),'4'=c(s[2]%/%s[1],r),'5'=c(s[1]+s[2],r),'6'=c(s[1]-s[2],r),'7'=c(s[2]^s[1],r),'8'=c(s[2]%%s[1],r),'9'=c(s[length(s)],s[-length(s)]),'A'=c(s[-1],s[1]),'B'=c(rep(s[1],2),s[-1]),'C'=c(rep(s[1:2],2),r),'D'=c(s[2:1],r),'E'=c(s[3:4],s[1:2],s[-(1:4)]),'F'=s[-1])};s}

缩进:

f=function(I){
    s=0
    for(i in strsplit(I,"")[[1]]){
        r=s[-(1:2)]
        s=switch(i,
                '0'=c(as.integer(paste0(s[2],s[1])),r),
                '1'=c(s[1]+1,s[-1]),
                '2'=c(s[1]-1,s[-1]),
                '3'=c(s[1]*s[2],r),
                '4'=c(s[2]%/%s[1],r),
                '5'=c(s[1]+s[2],r),
                '6'=c(s[1]-s[2],r),
                '7'=c(s[2]^s[1],r),
                '8'=c(s[2]%%s[1],r),
                '9'=c(s[length(s)],s[-length(s)]),
                'A'=c(s[-1],s[1]),
                'B'=c(rep(s[1],2),s[-1]),
                'C'=c(rep(s[1:2],2),r),
                'D'=c(s[2:1],r),
                'E'=c(s[3:4],s[1:2],s[-(1:4)]),
                'F'=s[-1])
        }
    s
    }

实际上:

> f('11BC5C5B95')
[1] 8 6 4 2

1

JavaScript 685

非高尔夫版本(gist):

var Token = {
  Concatenate: '0',
  Increment: '1',
  Decrement: '2',
  Multiply: '3',
  Divide: '4',
  Add: '5',
  Subtract: '6',
  Exponent: '7',
  Modulus: '8',
  RotateRight: '9',
  RotateLeft: 'A',
  Duplicate: 'B',
  DoubleDuplicate: 'C',
  Swap: 'D',
  DoubleSwap: 'E',
  Delete: 'F'
};

function parse(input, mem) {
  var a, b, c, d;
  var stack = mem ? mem.slice() : [0];
  for (var i = 0, n = input.length; i < n; i++) {
    switch (input[i]) {
      case Token.Concatenate:
        a = stack.pop();
        b = stack.pop();
        stack.push(parseInt([b] + a));
        break;

      case Token.Increment:
        a = stack.pop();
        stack.push(a + 1);
        break;

      case Token.Decrement:
        a = stack.pop();
        stack.push(a - 1);
        break;

      case Token.Multiply:
        a = stack.pop();
        b = stack.pop();
        stack.push(b * a);
        break;

      case Token.Divide:
        a = stack.pop();
        b = stack.pop();
        stack.push(b / a | 0);
        break;

      case Token.Add:
        a = stack.pop();
        b = stack.pop();
        stack.push(b + a);
        break;

      case Token.Subtract:
        a = stack.pop();
        b = stack.pop();
        stack.push(b - a);
        break;

      case Token.Exponent:
        a = stack.pop();
        b = stack.pop();
        stack.push(Math.pow(b, a));
        break;

      case Token.Modulus:
        a = stack.pop();
        b = stack.pop();
        stack.push(b % a);
        break;

      case Token.RotateRight:
        a = stack.shift();
        stack.push(a);
        break;

      case Token.RotateLeft:
        a = stack.pop();
        stack.unshift(a);
        break;

      case Token.Duplicate:
        a = stack[stack.length - 1];
        stack.push(a);
        break;

      case Token.DoubleDuplicate:
        a = stack[stack.length - 1];
        b = stack[stack.length - 2];
        stack.push(b, a);
        break;

      case Token.Swap:
        a = stack.pop();
        b = stack.pop();
        stack.push(a, b);
        break;

      case Token.DoubleSwap:
        a = stack.pop();
        b = stack.pop();
        c = stack.pop();
        d = stack.pop();
        stack.push(b, a, d, c);
        break;

      case Token.Delete:
        stack.pop();
        break;

      default:
        throw new SynxtaxError('Invalid token "' + input[i] + '"');
    }
  }

  return stack.reverse();
}

exports.Token = Token;
exports.parse = parse;

高尔夫球版:

function f(c){var b,d,e,f,a=[i=0],g=c.length;a.a=a.pop;for(a.b=a.push;i<g;i++)switch(c[i])
{case"0":b=a.a();a.b(parseInt([a.a()]+b));break;case"1":a[a.length-1]++;break;case"2":
a[a.length-1]--;break;case"3":a.b(a.a()*a.a());break;case"4":b=a.a();a.b(a.a()/b|0);break;
case"5":a.b(a.a()+a.a());break;case"6":b=a.a();a.b(a.a()-b);break;case"7":b=a.a();
a.b(Math.pow(a.a(),b));break;case"8":b=a.a();a.b(a.a()%b);break;case"9":a.b(a.shift());break;
case"A":a.a();a.unshift(a.a());break;case"B":a.b(a[a.length-1]);break;case"C":
a.b(a[a.length-2],a[a.length-1]);break;case"D":b=a.a();a.b(b,a.a());break;case"E":b=a.a();
d=a.a();e=a.a();f=a.a();a.b(d,b,f,e);break;case"F":a.a()}return a.reverse()}

例:

> f('11BC5C5B95')
[ 8, 6, 4, 2]

1

哈斯克尔

import Data.List (elemIndex)

type Stack = [Integer]

u :: (Integer -> Integer) -> Stack -> Stack
u p (x:t) = p x : t -- unary operation

b :: (Integer -> Integer -> Integer) -> Stack -> Stack
b p (x:y:t) = p x y : t -- binary operation

encoding :: String
encoding = "$iv*/+-^%><dtsz."
-- encoding = "0123456789ABCDEF"

-- list of operations
ops :: [Stack -> Stack]
ops = [
 b (\x y -> read (show x ++ show y)),-- concatenation
 u (+1), -- increment
 u (subtract 1), -- decrement
 b (*), -- multiplication
 b div, -- division
 b (+), -- addition
 b (-), -- subtraction
 b (^), -- exponent
 b mod, -- modulus
 (\s -> last s : init s), -- rotate right
 (\(x:t) -> t ++ [x]), -- rotate left
 (\(x:t) -> x:x:t), -- duplicate
 (\(x:y:t) -> x:y:x:y:t), -- double duplicate
 (\(x:y:t) -> y:x:t), -- swap
 (\(x:y:x':y':t) -> x':y':x:y:t), -- double swap
 tail] -- pop

run :: String -> Maybe Stack
run code = run' code [0] where
  run' [] stack = Just stack
  run' (x:t) stack = elemIndex x encoding >>= run' t . ($stack) . (ops!!)

跑步

λ: run "diidt^svz"
Just [2,0,1,4]

“对于2014年的挑战,这显然是不可能的,因为我们只能通过AF操作在堆栈中获取零的副本” – WAT吗?递增零会产生...非零,不是吗?
约翰·德沃夏克

@JanDvorak但是我们需要写“ 1”来增加,数字被禁止了,对吧?
2014年

那就是选择编码的悲剧。如果您映射标点符号较重的集合(可能带有tr?),则有可能。
luser droog

1

普通Lisp-589

接受不带空格的十六进制输入。

(setf w'(0))(defmacro u(&rest b)`(let((a(pop w))(b(pop w))),@b))(defmacro v(s)`(u(push(funcall ,s b a)w)))(setf i(list'(u(push(parse-integer(append(write-to-string b)(write-to-string a)))w))'(incf(car w))'(decf(car w))'(v #'*)'(v #'/)'(v #'+)'(v #'-)'(v #'expt)'(v #'%)'(let((a (car(last w))))(nbutlast w)(push a w))'(let((a(pop w)))(nconc w(list a)))'(push(car w)w)'(progn(push(cadr w)w)(push(cadr w)w))'(u(push a w)(push b w))'(u(push a(cdr(nthcdr 2 w)))(push b(cdr(nthcdr 2 w))))'(pop w)))(mapcar(coerce(read-line)'list)(lambda(a)(eval(nth(parse-integer(string a):radix 16)i)))(print w)

取消高尔夫:

(defparameter *stack* '(0))

(defmacro topvalues (&rest body)
    `(let ((top1 (pop *stack*))
           (top2 (pop *stack*))) ,@body))

(defmacro simple-op (opsym &rest body)
    `(topvalues 
        (push (funcall ,opsym top2 top1) *stack* )))

(defparameter *ops*
    (list
        ;concatenate
        '(topvalues
            (push 
                (parse-integer (append (write-to-string b) (write-to-string a)))
                *stack*))

        ;increment
        '(incf (first *stack*)) 

        ;decrement
        '(decf (first *stack*)) 

        ;multiply
        '(simple-op #'*)

        ;divide
        '(simple-op #'/)

        ;add
        '(simple-op #'+)

        ;subtract 
        '(simple-op #'-)

        ;exponent
        '(simple-op #'expt)

        ;modulus
        '(simple-op #'%)

        ;rotate right
        '(let ((a (car (last *stack*))))
            (nbutlast *stack*)
            (push a *stack*))

        ;rotate left
        '(let ((a (pop *stack*)))
            (nconc *stack* (list a)))

        ;duplicate
        '(push (first *stack*) *stack*)

        ;double duplicate
        '(progn 
            (push (second *stack*) *stack*)
            (push (second *stack*) *stack*))

        ;swap
        '(topvalues
            (push top1 *stack*)
            (push top2 *stack*))

        ;double swap
        '(topvalues 
            (push top1 (cdr (nthcdr 2 *stack*)))
            (push top2 (cdr (nthcdr 2 *stack*))))

        ;delete/pop
        '(pop *stack*)))

(mapcar 
(lambda (a)
    (eval (nth (parse-integer (string a) :radix 16) *ops*)))
(coerce (read-line) 'list))

1

的PHP

它不是最漂亮的,但是可以。

从shell运行,期望文件名作为第一个参数。它接受3种方言(甚至混合)中的任何一种

未定义否定或缺少索引的行为

<?php
$f[0] = $f[48] = $f[36] = function(&$s){$v=array_shift($s);$s[0] .= $v;};
$f[1] = $f[49] = $f[105] = function(&$s){$s[0]++;};
$f[2] = $f[50] = $f[118] = function(&$s){$s[0]--;};
$f[3] = $f[51] = $f[42] = function(&$s){$v = array_shift($s); $s[0] *= $v;};
$f[4] = $f[52] = $f[47] = function(&$s){$v = array_shift($s); $s[0] = intval(floor($s[0] / $v));};
$f[5] = $f[53] = $f[43] = function(&$s){$v = array_shift($s); $s[0] += $v;};
$f[6] = $f[54] = $f[45] = function(&$s){$v = array_shift($s); $s[0] -= $v;};
$f[7] = $f[55] = $f[94] = function(&$s){$v = array_shift($s); $s[0] = pow($s[0], $v);};
$f[8] = $f[56] = $f[37] = function(&$s){$v = array_shift($s); $s[0] %= $v;};
$f[9] = $f[57] = $f[62] = function(&$s){$v = array_pop($s); array_unshift($s, $v);};
$f[10] = $f[65] = $f[60] = function(&$s){$v = array_shift($s); array_push($s, $v);};
$f[11] = $f[66] = $f[100] = function(&$s){array_unshift($s, $s[0]);};
$f[12] = $f[67] = $f[116] = function(&$s){$v = [$s[0], $s[1]]; array_unshift($s, $v[0], $v[1]);};
$f[13] = $f[68] = $f[115] = function(&$s){$v = $s[0]; $s[0] = $s[1]; $s[1] = $v;};
$f[14] = $f[69] = $f[122] = function(&$s){$v = $s[0]; $s[0] = $s[2]; $s[2] = $v; $v = $s[1]; $s[1] = $s[3]; $s[3] = $v;};
$f[15] = $f[70] = $f[46] = function(&$s){array_unshift($s);};

$stack = [0];
$file = fopen($argv[1], 'rb');
$size = filesize($argv[1]);
while($size--){
    $f[ord(fread($file, 1))]($stack);
}
fclose($file);
echo '['.implode(',',$stack)."]\n";

1

PureBasic- 2821 891个字符

这是一个交互式解释器-无文件,您只需输入0-9,AF给出的代码,它将执行该命令,并在示例帖子中显示它。

使用“ X”或“ Q”退出。

这真的很有趣:)

Global NewList ProgramStack.q()
Global Num1.q, Num2.q

Macro Push(Value)
  LastElement(ProgramStack())
  AddElement(ProgramStack())
  ProgramStack() = Value
EndMacro

Macro Pop(Variable)
  LastElement(ProgramStack())
  Variable = ProgramStack()
  DeleteElement(ProgramStack())
EndMacro

Macro Peek(Variable)
  LastElement(ProgramStack())
  Variable = ProgramStack()
EndMacro

Push(0)

Procedure Concatenate()
  Pop(Num1)
  Pop(Num2)

  Push(Val( Str(Num2) + Str(Num1) ))
EndProcedure

Procedure Increment()
  LastElement(ProgramStack())
  ProgramStack() + 1
EndProcedure

Procedure Decrement()
  LastElement(ProgramStack())
  ProgramStack() - 1
EndProcedure

Procedure Multiply()
  Pop(Num1)
  Pop(Num2)

  Push( Num2 * Num1 )
EndProcedure

Procedure Divide()
  Pop(Num1)
  Pop(Num2)

  Push( Num2 / Num1 )
EndProcedure

Procedure Add()
  Pop(Num1)
  Pop(Num2)

  Push( Num2 + Num1 )
EndProcedure

Procedure Subtract()
  Pop(Num1)
  Pop(Num2)

  Push( Num2 - Num1 )
EndProcedure

Procedure Exponent()
  Pop(Num1)
  Pop(Num2)

  Push( Pow(Num2, Num1) )
EndProcedure

Procedure Modulus()
  Pop(Num1)
  Pop(Num2)

  Push( Mod(Num2, Num1) )
EndProcedure

Procedure RotateRight()
  FirstElement(ProgramStack())
  Num1 = ProgramStack()
  DeleteElement(ProgramStack(),1)
  Push(Num1)
EndProcedure

Procedure RotateLeft()
  Pop(Num1)
  FirstElement(ProgramStack())
  InsertElement(ProgramStack())
  ProgramStack() = Num1
EndProcedure

Procedure Duplicate()
  Peek(Num1)
  Push(Num1)
EndProcedure

Procedure DoubleDuplicate()
  Pop(Num1)
  Pop(Num2)
  Push(Num2)
  Push(Num1)
  Push(Num2)
  Push(Num1)
EndProcedure

Procedure SingleSwap()
  Pop(Num1)
  Pop(Num2)
  Push(Num1)
  Push(Num2)
EndProcedure

Procedure DoubleSwap()
  Protected Num3.q, Num4.q
  Pop(Num1)
  Pop(Num2)
  Pop(Num3)
  Pop(Num4)
  Push(Num2)
  Push(Num1)
  Push(Num4)
  Push(Num3)
EndProcedure

Procedure Delete()
  Pop(Num1)
EndProcedure

OpenConsole()
EnableGraphicalConsole(1)

Position = 0
Repeat
  ConsoleLocate(Position, 0)

  e.s = UCase( Inkey() )

  Select e
    Case "0"
      Concatenate()
    Case "1"
      Increment()
    Case "2"
      Decrement()
    Case "3"
      Multiply()
    Case "4"
      Divide()
    Case "5"
      Add()
    Case "6"
      Subtract()
    Case "7"
      Exponent()
    Case "8"
      Modulus()
    Case "9"
      RotateRight()
    Case "A"
      RotateLeft()
    Case "B"
      Duplicate()
    Case "C"
      DoubleDuplicate()
    Case "D"
      SingleSwap()
    Case "E"
      DoubleSwap()
    Case "F"
      Delete()
  EndSelect

  If e <> ""
    Print(e)
    ConsoleLocate(Position, 1)
    Print("|")
    yLoc.i = ListSize(ProgramStack()) + 1

    ForEach ProgramStack()
      ConsoleLocate(Position, yLoc)
      Print(Str(ProgramStack()))
      yLoc - 1
    Next

    Position + 2
  EndIf
Until e = "X" Or e = "Q"

编辑:入睡后,我想我会打高尔夫球-尽管我保留了可读版本,以供参考。

除了我退出Q或X退出,一切都一样,只是关闭窗口退出:

NewList S()
Macro P
Print
EndMacro
Macro G
ConsoleLocate
EndMacro
Macro LE
LastElement(S())  
EndMacro
Macro U(V)
LE
AddElement(S())
S()=V
EndMacro
Macro O(V)
LE
V=S()
DeleteElement(S())
EndMacro
U(0)
OpenConsole()
EnableGraphicalConsole(1)
X=0
Repeat
G(X,0)
e.s=UCase(Inkey())
Select e
Case"0"
O(H)
O(J)
U(Val(Str(J)+Str(H)))
Case"1"
LE
S()+1
Case"2"
LE
S()-1
Case"3"
O(H)
O(J)
U(J*H)
Case"4"
O(H)
O(J)
U(J/H)
Case"5"
O(H)
O(J)
U(J+H)
Case"6"
O(H)
O(J)
U(J-H)
Case"7"
O(H)
O(J)
U(Pow(J,H))
Case"8"
O(H)
O(J)
U(Mod(J,H))
Case"9"
FirstElement(S())
H=S()
DeleteElement(S(),1)
U(H)
Case"A"
O(H)
FirstElement(S())
InsertElement(S())
S()=H
Case"B"
O(H)
U(H)
U(H)
Case"C"
O(H)
O(J)
U(J)
U(H)
U(J)
U(H)
Case"D"
O(H)
O(J)
U(H)
U(J)
Case"E"
O(H)
O(J)
O(K)
O(L)
U(J)
U(H)
U(L)
U(K)
Case"F"
O(H)
EndSelect
If e<>""
P(e)
G(X,1)
Y=ListSize(S())+1
ForEach S()
G(X,Y)
P(Str(S()))
Y-1
Next
X+2
EndIf
ForEver

1

普通Lisp-586

(defmacro n(s)(with-gensyms($)(labels((?()`(pop,$))(!(x)`(push,x,$))(@(~)(!(list ~(?)(?))))(r@(~)(@`(lambda(x y)(,~ y x)))))`(let((,$`(,0))),@(loop for p below(length s)collect(case(parse-integer s :start p :end(1+ p):radix 16)(0(@'(lambda(a b)(+(* a(expt 10(if(> b 0)(ceiling(log b 10))1)))b))))(1`(incf(car,$)))(2`(decf(car,$)))(3(@'*))(4(@'/)) (5(@'+))(6(@'-))(7(r@'expt))(8(r@'mod))(9`(setf,$(#1=rotate,$)))(10`(setf,$(#1#,$ -1)))(11`(push(car,$),$))(12`(setf,$(nconc(#2=subseq,$ 0 2),$)))(13`(reversef(#2#,$ 0 2)))(14`(setf,$(append(#1#(#2#,$ 0 4)2)(#2#,$ 4))))(15`(pop,$)))),$))))

不打高尔夫球

用词法在宏扩展代码中绑定一个新堆栈:不引用全局变量。同样,它被编译为机器代码。

(ql:quickload :alexandria)
(mapc #'use-package '(cl alexandria))
(defmacro n(s)
  (with-gensyms($)
    (labels ((?()`(pop,$))
             (!(x)`(push,x,$))
             (bop(op)(!(list op(?)(?))))
             (rbop(op)(bop`(lambda(x y)(,op y x)))))
      `(let((,$`(,0)))
         ,@(loop for p below(length s)
                 collect(case(parse-integer s :start p :end(1+ p):radix 16)
                           (#x0(bop'(lambda(a b)(+(* a(expt 10(if(> b 0)(ceiling(log b 10))1)))b))))
                           (#x1`(incf(car,$)))                    
                           (#x2`(decf(car,$)))
                           (#x3(bop'*))                    
                           (#x4(bop'/))
                           (#x5(bop'+))                    
                           (#x6(bop'-))
                           (#x7(rbop'expt))
                           (#x8(rbop'mod))
                           (#x9`(setf,$(rotate,$)))
                           (#xA`(setf,$(rotate,$ -1)))
                           (#xB`(push(car,$),$))
                           (#xC`(setf,$(nconc(subseq,$ 0 2),$)))
                           (#xD`(reversef(subseq ,$ 0 2)))
                           (#xE`(setf,$(append(rotate(subseq,$ 0 4)2)(subseq,$ 4))))
                           (#xF`(pop,$))))
         ,$))))

   (n "11bc5c5b95")
   => macroexpands into (8 6 4 2)

1

Python 2,508字节

s,d=[0],lambda:s.pop(1)
for C in raw_input():
 D=int(C,16)
 if D<1:s[0]=int(`s[0]`+`d()`)
 if D==1:s[0]+=1
 if D==2:s[0]-=1
 if D==3:s[0]*=d()
 if D==4:s[0]=d()/s[0]
 if D==5:s[0]+=d()
 if D==6:s[0]-=d()
 if D==7:s[0]=d()**s[0]
 if D==8:s[0]=d()%s[0]
 if D==9:s=s[-1:]+s[:-1]
 if D==10:s=s[1:]+s[:1]
 if D==11:s=s[:1]+s
 if D==12:s=s[0:2]+s
 if D==13:s=s[1:2]+s[:1]+s[2:]
 if D==14:s=s[2:4]+s[0:2]+s[4:]
 if D>14:s=s[1:]
print s

使用“ 0123456789ABCDEF”编码。我真的为这一结果感到自豪。它不读取文件,而是从STDIN获取输入,但是如果有问题,可以轻松进行更改。

2014年问题的2种解决方案:

B11CB3A1AED0A0016 15字节)-通用连接器。

BB102CD11B513B3622E20 19个字节)-更酷-评估为(5 *(10-1))^ 2-11


0

Python 2,955字节

import sys
global s
s=[0]
c=lambda x: x.append(str(x.pop())+str(x.pop()))
i=lambda x: x.append(x.pop()+1)
v=lambda x: x.append(x.pop()-1)
x=lambda x: x.append(x.pop()*x.pop())
q=lambda x: x.append(x.pop(-2)/x.pop())
a=lambda x: x.append(x.pop()+x.pop())
w=lambda x: x.append(x.pop(-2)-x.pop())
e=lambda x: x.append(x.pop(-2)**x.pop())
m=lambda x: x.append(x.pop(-2)%x.pop())
r=lambda x: x.append(x.pop(0))
l=lambda x: x.insert(0,x.pop())
d=lambda x: x.append(x[-1])
t=lambda x: x.extend(x[-2:])
s=lambda x: x.insert(-2,x.pop())
def z(x):
    for y in [0,1]:
        s.insert(-3,s.pop())
k={'$':c,'i':i,'v':v,'*':x,'/':q,'+':a,'-':w,'^':e,'%':m,'>':r,'<':l,'d':d,
   't':t,'s':s,'z':z,'.':lambda x: x.pop()}
if __name__=='__main__':
    with open(sys.argv[1],'r') as f:
        while 1:
            b=f.read(1)
            if not b or b not in k.keys():
                break
            else:
                n=k[b](s)
                for x in s: print s,

每个功能做什么

  • c:连接($)
  • i:增量(i)
  • v:减量(v)
  • x:乘(*)
  • q:除(/)
  • 答:加(+)
  • w:减(-)
  • e:指数(^)
  • m:取模(%)
  • r:右移(>)
  • l:左移(<)
  • d:重复(d)
  • t:重复两次(t)
  • s:交换前2个值(s)
  • z:两次互换(z)

既然这不是代码高尔夫(这是一场流行性竞赛),并且您的代码几乎没有打高尔夫,我认为您不需要包括字节数。
FlipTack

@FlipTack我只包含字节数,因为有人可能想知道。
ckjbgames
By using our site, you acknowledge that you have read and understand our Cookie Policy and Privacy Policy.
Licensed under cc by-sa 3.0 with attribution required.