0 people like it.

ICFP2011

  1: 
  2: 
  3: 
  4: 
  5: 
  6: 
  7: 
  8: 
  9: 
 10: 
 11: 
 12: 
 13: 
 14: 
 15: 
 16: 
 17: 
 18: 
 19: 
 20: 
 21: 
 22: 
 23: 
 24: 
 25: 
 26: 
 27: 
 28: 
 29: 
 30: 
 31: 
 32: 
 33: 
 34: 
 35: 
 36: 
 37: 
 38: 
 39: 
 40: 
 41: 
 42: 
 43: 
 44: 
 45: 
 46: 
 47: 
 48: 
 49: 
 50: 
 51: 
 52: 
 53: 
 54: 
 55: 
 56: 
 57: 
 58: 
 59: 
 60: 
 61: 
 62: 
 63: 
 64: 
 65: 
 66: 
 67: 
 68: 
 69: 
 70: 
 71: 
 72: 
 73: 
 74: 
 75: 
 76: 
 77: 
 78: 
 79: 
 80: 
 81: 
 82: 
 83: 
 84: 
 85: 
 86: 
 87: 
 88: 
 89: 
 90: 
 91: 
 92: 
 93: 
 94: 
 95: 
 96: 
 97: 
 98: 
 99: 
100: 
101: 
102: 
103: 
104: 
105: 
106: 
107: 
108: 
109: 
110: 
111: 
112: 
113: 
114: 
115: 
116: 
117: 
118: 
119: 
120: 
121: 
122: 
123: 
124: 
125: 
126: 
127: 
128: 
129: 
130: 
131: 
132: 
133: 
134: 
135: 
136: 
137: 
138: 
139: 
140: 
141: 
142: 
143: 
144: 
145: 
146: 
147: 
148: 
149: 
150: 
151: 
152: 
153: 
154: 
155: 
156: 
157: 
158: 
159: 
160: 
161: 
162: 
163: 
164: 
165: 
166: 
167: 
168: 
169: 
170: 
171: 
172: 
173: 
174: 
175: 
176: 
177: 
178: 
179: 
180: 
181: 
182: 
183: 
184: 
185: 
186: 
187: 
188: 
189: 
190: 
191: 
192: 
193: 
194: 
195: 
196: 
197: 
198: 
199: 
200: 
201: 
202: 
203: 
204: 
205: 
206: 
207: 
208: 
209: 
210: 
211: 
212: 
213: 
214: 
215: 
216: 
217: 
218: 
219: 
220: 
221: 
222: 
223: 
224: 
225: 
226: 
227: 
228: 
229: 
230: 
231: 
232: 
233: 
234: 
235: 
236: 
237: 
238: 
239: 
240: 
241: 
242: 
243: 
244: 
245: 
246: 
247: 
248: 
249: 
250: 
251: 
252: 
253: 
254: 
255: 
256: 
257: 
258: 
259: 
260: 
261: 
262: 
263: 
264: 
265: 
266: 
267: 
268: 
269: 
270: 
271: 
272: 
273: 
274: 
275: 
276: 
277: 
278: 
279: 
280: 
281: 
282: 
283: 
284: 
285: 
286: 
287: 
288: 
289: 
290: 
291: 
292: 
293: 
294: 
295: 
296: 
297: 
298: 
299: 
300: 
301: 
302: 

module Program

type Card = S | K | I | Zero | Succ | Dbl | Get | Put | Inc | Dec | Attack | Help | Copy | Revive | Zombie
    with
        override x.ToString() =
            match x with
            | S -> "S"
            | K -> "K"
            | I -> "I"
            | Zero -> "zero"
            | Succ -> "succ"
            | Dbl -> "dbl"
            | Get -> "get"
            | Put -> "put"
            | Inc -> "inc"
            | Dec -> "dec"
            | Attack -> "attack"
            | Help -> "help"
            | Copy -> "copy"
            | Revive -> "revive"
            | Zombie -> "zombie"
        static member Parse s =
            match s with
            | "S" -> S
            | "K" -> K
            | "I" -> I
            | "zero" -> Zero
            | "succ" -> Succ
            | "dbl" -> Dbl
            | "get" -> Get
            | "put" -> Put
            | "inc" -> Inc
            | "dec" -> Dec
            | "attack" -> Attack
            | "help" -> Help
            | "copy" -> Copy
            | "revive" -> Revive
            | "zombie" -> Zombie
            | _ -> failwith "Parse error: Invalid card type."

type SKITerm =
    | Card of Card
    | App of SKITerm * SKITerm
    with
        override x.ToString() =
            match x with
            | Card c -> c.ToString()
            | App(m, n) -> m.ToString() + "(" + n.ToString() + ")"

type Instr =
    | LApp of Card * int
    | RApp of int * Card

exception OutOfSpace
exception SlotNotFree

let mutable freeList = [0 .. 255]

let alloc i =
    if List.exists (fun j -> j = i) freeList then
        freeList <- List.filter (fun j -> j <> i) freeList
    else
        raise SlotNotFree

let alloc1() =
    match freeList with
        | x::xs ->
            freeList <- List.filter (fun j -> j <> x) freeList
            x
        | [] -> raise OutOfSpace

let isFree i =
    List.exists (fun j -> j = i) freeList

let free i =
    freeList <- (i::freeList) |> List.sort

type Term =
    | C of Card
    | L of Card * Term
    | R of Term * Card

let rec intToTerm n =
    if n = 0 then
        C Zero
    elif n % 2 = 0 then
        L(Dbl, intToTerm (n/2))
    else
        L(Succ, intToTerm (n-1))

let rec termToSKITerm = function
    | C c -> Card c
    | L(c, t) -> App(Card c, termToSKITerm t)
    | R(t, c) -> App(termToSKITerm t, Card c)

let intToSKITerm n = intToTerm n |> termToSKITerm

let rec flatten i = function
    | C c -> [RApp(i, c)]
    | L(c, t) -> (flatten i t) @ [LApp(c, i)]
    | R(t, c) -> (flatten i t) @ [RApp(i, c)]

let succn s i t =
    let rec helper s n =
        match n with
        | n when n = s -> []
        | 0 -> []
        | 1 -> [Succ]
        | n when n % 2 = 0 && (n/2) >= s -> Dbl :: helper s (n/2)
        | n -> Succ :: helper s (n-1)
    let rec loop l =
        match l with
        | [] -> t
        | x::xs -> R(L(S, L(K, loop xs)), x)
    helper s i |> List.rev |> loop

let apply i j loc =
    if i <= j then failwith "Bug: apply: i <= j"
    R(succn 0 j (R(L(S, succn j i (C Get)), Get)), Zero) |> flatten loc

/// Compile term into instruction list for slot i.
/// Assumes slot i is set to I.
let rec compile s = function
    | App(Card c1, Card c2) -> [RApp(s, c2); LApp(c1, s)]
    | App(Card c, t) -> (compile s t) @ [LApp(c, s)]
    | App(t, Card c) -> (compile s t) @ [RApp(s, c)]
    | App(t1, t2) ->
        let j = alloc1()
        let i = alloc1()
        if i <= j then failwith "Bug: compile: i <= j"
        let code =
            (compile j t2)
            @ (compile i t1)
            @ (R(succn 0 j (R(L(S, succn j i (C Get)), Get)), Zero) |> flatten s)
            @ [LApp(Put, i); LApp(Put, j)]  // Clear fields i, j
        free i
        free j
        code
    | Card c -> [RApp(s, c)]

let zombie3 card i j n = App(App(Card S, App(App(Card S, App(App(Card S, App(Card K, Card card)), App(Card K, intToSKITerm i))), App(Card K, intToSKITerm j))), App(Card K, intToSKITerm n))

type Program() =
//    let init() =
//        List.iter alloc [0; 1; 2; 4]
//        (5556 |> intToTerm |> flatten 0)
//        @ (0 |> intToTerm |> flatten 1)
//        @ (128 |> intToTerm |> flatten 2)
//        @ [RApp(4, Attack)]
//    let attacker i =
//        List.iter alloc [3; 5; 6; 7; 8]
//        
//        let code =
//            (i |> intToTerm |> flatten 3)
//
//            @ (apply 4 1 5)
//            @ (apply 5 3 6)
//            @ (apply 6 0 7)
//
//            @ [LApp(Put, 5)]
//            @ [LApp(Put, 6)]
//
//            @ [RApp(7, Zero)]
//            @ [LApp(Put, 7)]
//
//            @ (apply 4 2 5)
//            @ (apply 5 3 6)
//            @ (apply 6 0 8)
//
//            @ [LApp(Put, 3)]
//
//            @ [LApp(Put, 5)]
//            @ [LApp(Put, 6)]
//
//            @ [RApp(8, Zero)]
//            @ [LApp(Put, 8)]
//
//            @ [LApp(Succ, 1)]
//            @ [LApp(Succ, 2)]
//
//        List.iter free [3; 5; 6; 7; 8]
//        code

    let init() =
        List.iter alloc [0; 1; 2; 4; 9]
        (5556 |> intToTerm |> flatten 0)
        @ (0 |> intToTerm |> flatten 1)
        @ (128 |> intToTerm |> flatten 2)
        @ [RApp(4, Attack)]

        // Zombie
        @ [RApp(9, Zombie)]
    let attacker i =
        List.iter alloc [3; 5; 6; 7; 8; 11; 12]
        
        let code =
            (i |> intToTerm |> flatten 3)

            @ (apply 4 1 5)
            @ (apply 5 3 6)
            @ (apply 6 0 7)

            @ [LApp(Put, 5)]
            @ [LApp(Put, 6)]

            @ [RApp(7, Zero)]
            @ [LApp(Put, 7)]

            @ (apply 4 2 5)
            @ (apply 5 3 6)
            @ (apply 6 0 8)

            @ [LApp(Put, 5)]
            @ [LApp(Put, 6)]

            @ [RApp(8, Zero)]
            @ [LApp(Put, 8)]

            // Zombie
            @ ((zombie3 Help i i 10000) |> compile 10)
            @ (apply 9 3 11)
            @ (apply 11 10 12)
            @ [LApp(Put, 10)]
            @ [LApp(Put, 11)]
            @ [RApp(12, Zero)]
            @ [LApp(Put, 12)]
            // End Zombie

            @ [LApp(Put, 3)]

            @ [LApp(Succ, 1)]
            @ [LApp(Succ, 2)]

        List.iter free [3; 5; 6; 7; 8; 11; 12]
        code

    let mutable code = init()
    let mutable i = 0
    let mutable strategy = 0

    member x.NextInstr() =
        match code with
        | x::xs -> code <- xs; x
        | [] ->
            if strategy = 0 then
                code <- attacker i
                if i = 255 then strategy <- strategy + 1
                i <- i + 1
            if strategy = 1 then
                code <- [RApp(0, I)]
            x.NextInstr()

module IO =
    let readInt() =
        try
            System.Console.ReadLine().Trim() |> System.Int32.Parse
        with _ -> exit 0

    let readCard() =
        try
            System.Console.ReadLine().Trim() |> Card.Parse
        with _ -> exit 0

    let readInstr() =
        match readInt() with
        | 1 ->
            let card = readCard()
            let slot = readInt()
            LApp(card, slot)
        | 2 ->
            let slot = readInt()
            let card = readCard()
            RApp(slot, card)
        | _ -> failwith "Invalid left/right-application specifier."

    let writeInstr = function
        | LApp(card, slot) ->
            System.Console.WriteLine(1)
            System.Console.WriteLine(card)
            System.Console.WriteLine(slot)
        | RApp(slot, card) ->
            System.Console.WriteLine(2)
            System.Console.WriteLine(slot)
            System.Console.WriteLine(card)

let prog = Program()

let rec player() =
    prog.NextInstr() |> IO.writeInstr
    opponent()

and opponent() =
    let instr = IO.readInstr()
    player()

[<EntryPoint>]
let main _ =
    let arg1 = System.Environment.GetCommandLineArgs().[1] |> System.Int32.Parse
    match arg1 with
    | 0 -> player()
    | 1 -> opponent()
    | _ -> failwith "Invalid argument."
module Program
type Card =
  | S
  | K
  | I
  | Zero
  | Succ
  | Dbl
  | Get
  | Put
  | Inc
  | Dec
  ...
  override ToString : unit -> string
  static member Parse : s:string -> Card

Full name: Program.Card
union case Card.S: Card
union case Card.K: Card
union case Card.I: Card
union case Card.Zero: Card
union case Card.Succ: Card
union case Card.Dbl: Card
union case Card.Get: Card
union case Card.Put: Card
union case Card.Inc: Card
union case Card.Dec: Card
union case Card.Attack: Card
union case Card.Help: Card
union case Card.Copy: Card
union case Card.Revive: Card
union case Card.Zombie: Card
val x : Card
override Card.ToString : unit -> string

Full name: Program.Card.ToString
static member Card.Parse : s:string -> Card

Full name: Program.Card.Parse
val s : string
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
type SKITerm =
  | Card of Card
  | App of SKITerm * SKITerm
  override ToString : unit -> string

Full name: Program.SKITerm
Multiple items
union case SKITerm.Card: Card -> SKITerm

--------------------
type Card =
  | S
  | K
  | I
  | Zero
  | Succ
  | Dbl
  | Get
  | Put
  | Inc
  | Dec
  ...
  override ToString : unit -> string
  static member Parse : s:string -> Card

Full name: Program.Card
union case SKITerm.App: SKITerm * SKITerm -> SKITerm
val x : SKITerm
override SKITerm.ToString : unit -> string

Full name: Program.SKITerm.ToString
val c : Card
override Card.ToString : unit -> string
val m : SKITerm
val n : SKITerm
override SKITerm.ToString : unit -> string
type Instr =
  | LApp of Card * int
  | RApp of int * Card

Full name: Program.Instr
union case Instr.LApp: Card * int -> Instr
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
union case Instr.RApp: int * Card -> Instr
exception OutOfSpace

Full name: Program.OutOfSpace
exception SlotNotFree

Full name: Program.SlotNotFree
val mutable freeList : int list

Full name: Program.freeList
val alloc : i:int -> unit

Full name: Program.alloc
val i : int
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val exists : predicate:('T -> bool) -> list:'T list -> bool

Full name: Microsoft.FSharp.Collections.List.exists
val j : int
val filter : predicate:('T -> bool) -> list:'T list -> 'T list

Full name: Microsoft.FSharp.Collections.List.filter
val raise : exn:System.Exception -> 'T

Full name: Microsoft.FSharp.Core.Operators.raise
val alloc1 : unit -> int

Full name: Program.alloc1
val x : int
val xs : int list
val isFree : i:int -> bool

Full name: Program.isFree
val free : i:int -> unit

Full name: Program.free
val sort : list:'T list -> 'T list (requires comparison)

Full name: Microsoft.FSharp.Collections.List.sort
type Term =
  | C of Card
  | L of Card * Term
  | R of Term * Card

Full name: Program.Term
union case Term.C: Card -> Term
union case Term.L: Card * Term -> Term
union case Term.R: Term * Card -> Term
val intToTerm : n:int -> Term

Full name: Program.intToTerm
val n : int
val termToSKITerm : _arg1:Term -> SKITerm

Full name: Program.termToSKITerm
val t : Term
val intToSKITerm : n:int -> SKITerm

Full name: Program.intToSKITerm
val flatten : i:int -> _arg1:Term -> Instr list

Full name: Program.flatten
val succn : s:int -> i:int -> t:Term -> Term

Full name: Program.succn
val s : int
val helper : (int -> int -> Card list)
val loop : (Card list -> Term)
val l : Card list
val xs : Card list
val rev : list:'T list -> 'T list

Full name: Microsoft.FSharp.Collections.List.rev
val apply : i:int -> j:int -> loc:int -> Instr list

Full name: Program.apply
val loc : int
val compile : s:int -> _arg1:SKITerm -> Instr list

Full name: Program.compile


 Compile term into instruction list for slot i.
 Assumes slot i is set to I.
val c1 : Card
val c2 : Card
val t : SKITerm
val t1 : SKITerm
val t2 : SKITerm
val code : Instr list
val zombie3 : card:Card -> i:int -> j:int -> n:int -> SKITerm

Full name: Program.zombie3
val card : Card
Multiple items
type Program =
  new : unit -> Program
  member NextInstr : unit -> Instr

Full name: Program.Program

--------------------
new : unit -> Program
val init : (unit -> Instr list)
val iter : action:('T -> unit) -> list:'T list -> unit

Full name: Microsoft.FSharp.Collections.List.iter
val attacker : (int -> Instr list)
val mutable code : Instr list
val mutable i : int
val mutable strategy : int
val x : Program
member Program.NextInstr : unit -> Instr

Full name: Program.Program.NextInstr
val x : Instr
val xs : Instr list
member Program.NextInstr : unit -> Instr
val readInt : unit -> int

Full name: Program.IO.readInt
namespace System
type Console =
  static member BackgroundColor : ConsoleColor with get, set
  static member Beep : unit -> unit + 1 overload
  static member BufferHeight : int with get, set
  static member BufferWidth : int with get, set
  static member CapsLock : bool
  static member Clear : unit -> unit
  static member CursorLeft : int with get, set
  static member CursorSize : int with get, set
  static member CursorTop : int with get, set
  static member CursorVisible : bool with get, set
  ...

Full name: System.Console
System.Console.ReadLine() : string
type Int32 =
  struct
    member CompareTo : value:obj -> int + 1 overload
    member Equals : obj:obj -> bool + 1 overload
    member GetHashCode : unit -> int
    member GetTypeCode : unit -> TypeCode
    member ToString : unit -> string + 3 overloads
    static val MaxValue : int
    static val MinValue : int
    static member Parse : s:string -> int + 3 overloads
    static member TryParse : s:string * result:int -> bool + 1 overload
  end

Full name: System.Int32
System.Int32.Parse(s: string) : int
System.Int32.Parse(s: string, provider: System.IFormatProvider) : int
System.Int32.Parse(s: string, style: System.Globalization.NumberStyles) : int
System.Int32.Parse(s: string, style: System.Globalization.NumberStyles, provider: System.IFormatProvider) : int
val exit : exitcode:int -> 'T

Full name: Microsoft.FSharp.Core.Operators.exit
val readCard : unit -> Card

Full name: Program.IO.readCard
static member Card.Parse : s:string -> Card
val readInstr : unit -> Instr

Full name: Program.IO.readInstr
val slot : int
val writeInstr : _arg1:Instr -> unit

Full name: Program.IO.writeInstr
System.Console.WriteLine() : unit
   (+0 other overloads)
System.Console.WriteLine(value: string) : unit
   (+0 other overloads)
System.Console.WriteLine(value: obj) : unit
   (+0 other overloads)
System.Console.WriteLine(value: uint64) : unit
   (+0 other overloads)
System.Console.WriteLine(value: int64) : unit
   (+0 other overloads)
System.Console.WriteLine(value: uint32) : unit
   (+0 other overloads)
System.Console.WriteLine(value: int) : unit
   (+0 other overloads)
System.Console.WriteLine(value: float32) : unit
   (+0 other overloads)
System.Console.WriteLine(value: float) : unit
   (+0 other overloads)
System.Console.WriteLine(value: decimal) : unit
   (+0 other overloads)
val prog : Program

Full name: Program.prog
val player : unit -> 'a

Full name: Program.player
module IO

from Program
val opponent : unit -> 'a

Full name: Program.opponent
val instr : Instr
Multiple items
type EntryPointAttribute =
  inherit Attribute
  new : unit -> EntryPointAttribute

Full name: Microsoft.FSharp.Core.EntryPointAttribute

--------------------
new : unit -> EntryPointAttribute
val main : string [] -> int

Full name: Program.main
val arg1 : int
type Environment =
  static member CommandLine : string
  static member CurrentDirectory : string with get, set
  static member Exit : exitCode:int -> unit
  static member ExitCode : int with get, set
  static member ExpandEnvironmentVariables : name:string -> string
  static member FailFast : message:string -> unit + 1 overload
  static member GetCommandLineArgs : unit -> string[]
  static member GetEnvironmentVariable : variable:string -> string + 1 overload
  static member GetEnvironmentVariables : unit -> IDictionary + 1 overload
  static member GetFolderPath : folder:SpecialFolder -> string + 1 overload
  ...
  nested type SpecialFolder
  nested type SpecialFolderOption

Full name: System.Environment
System.Environment.GetCommandLineArgs() : string []
Raw view Test code New version

More information

Link:http://fssnip.net/5Q
Posted:14 years ago
Author:
Tags:

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.