Skip to content

Instantly share code, notes, and snippets.

@thinkbeforecoding
Created December 6, 2022 16:05
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save thinkbeforecoding/13992750961577af7f24bea5c7ee12b3 to your computer and use it in GitHub Desktop.
Save thinkbeforecoding/13992750961577af7f24bea5c7ee12b3 to your computer and use it in GitHub Desktop.
open System
type Machine =
{ program: string
data: byte[]
ip: int
dp: int
output: string
}
let start program =
{ program = program
data = Array.zeroCreate 1024
ip = 0
dp = 0
output = ""
}
let debug machine =
let start = max 0 (machine.ip)
let end' = min machine.program.Length (machine.ip+30)
let sample = machine.program.Substring(start, end'-start )
printfn "%s" sample
for b in machine.data.[0..120] do
printf "%0x" b
printfn ""
for b in 0 .. machine.dp-1 do
printf " "
printfn "^"
let movedp offset machine =
{ machine with dp = machine.dp + offset; ip = machine.ip+1 }
let changedata offset machine =
if machine.dp < 0 || machine.dp >= machine.data.Length then
failwith "Access en dehors de la mémoire"
let newdata = machine.data.AsSpan().ToArray()
newdata.[machine.dp] <- newdata.[machine.dp] + offset
{ machine with data = newdata; ip = machine.ip+1 }
let rec findMatchingClosed (prog: string) pos openCount =
if pos >= prog.Length then
None
else
match prog.[pos] with
| '[' -> findMatchingClosed prog (pos+1) (openCount+1)
| ']' when openCount > 0 -> findMatchingClosed prog (pos+1) (openCount-1)
| ']' -> Some (pos+1)
| _ -> findMatchingClosed prog (pos+1) openCount
let rec findMatchingOpen (prog: string) pos closedCount =
if pos < 0 then
None
else
match prog.[pos] with
| ']' -> findMatchingOpen prog (pos-1) (closedCount+1)
| '[' when closedCount > 0 -> findMatchingOpen prog (pos-1) (closedCount-1)
| '[' -> Some (pos+1)
| _ -> findMatchingOpen prog (pos-1) closedCount
let step machine =
if machine.ip >= machine.program.Length then
None
else
match machine.program.[machine.ip] with
| '>' -> machine |> movedp 1
| '<' -> machine |> movedp -1
| '+' -> machine |> changedata 1uy
| '-' -> machine |> changedata 255uy
| '.' ->
let c = string (char machine.data.[machine.dp])
printf "%s" c
{ machine with
output = machine.output + c
ip = machine.ip + 1
}
| ',' ->
if machine.dp < 0 || machine.dp >= machine.data.Length then
failwith "Acces en dehors de la mémoire"
let c = Console.Read()
let newdata = machine.data.AsSpan().ToArray()
newdata.[machine.dp] <- byte c
{ machine with data = newdata; ip = machine.ip+1 }
| '[' ->
if machine.dp < 0 || machine.dp >= machine.data.Length then
failwith "Acces en dehors de la mémoire"
if machine.data.[machine.dp] = 0uy then
match findMatchingClosed machine.program (machine.ip+1) 0 with
| Some newip ->
{ machine with ip = newip }
| None ->
let start = max 0 (machine.ip-3)
let end' = min machine.program.Length (machine.ip+6)
let sample = machine.program.Substring(start, end'-start )
failwith $"[ non fermé à la position {machine.ip} : { sample } "
else
{ machine with ip = machine.ip + 1}
| ']' ->
if machine.dp < 0 || machine.dp >= machine.data.Length then
failwith "Acces en dehors de la mémoire"
if machine.data.[machine.dp] <> 0uy then
match findMatchingOpen machine.program (machine.ip-1) 0 with
| Some newip ->
{ machine with ip = newip }
| None ->
let start = max 0 (machine.ip-6)
let end' = min machine.program.Length (machine.ip+3)
let sample = machine.program.Substring(start, end'-start )
failwith $"] non ouvert à la position {machine.ip} : { sample } "
else
{ machine with ip = machine.ip + 1}
| ' ' | '\n' | '\r' -> { machine with ip = machine.ip+1}
| c -> failwith $"Instruction inconue {c}"
|> Some
let rec run machine =
match step machine with
| None -> machine
| Some next -> run next
"++++++++++[>+++++++++>++++++++++>++++++++++>+++++++++++>+++<<<<<-]>.>---.>-.>---.>+++."
|> start
|> run
"++++++++++[>+++++++++[>+>+>+>+<<<<-]>>+>+>++>+++<<<<<<-]>>.>---.>-.>---.>+++."
|> start
|> run
// addition
"++>++++[-<+>]"
|> start
|> run
"""++++
[->+>+<<]
>>
[-<<+>>]"""
|> start
|> run
let prog = "----------[++++++++++>,----------]++++++++++[<]"
prog
|> start
|> run
let mutable machine = start prog
machine <- (step machine).Value
debug machine
"----------[++++++++++>,.----------]"
|> start
|> run
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment