CS-381/MiniLogo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add implementation of evaluator, without dynamic code loading.

Browse Source
This commit is contained in:
Danila Fedorin 2019-02-01 20:02:24 -08:00
commit bda42ad2e0
3 changed files with 393 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
elm.json Normal file
View File

@ -0,0 +1,27 @@
{
"type": "application",
"source-directories": [
"src"
],
"elm-version": "0.19.0",
"dependencies": {
"direct": {
"avh4/elm-color": "1.0.0",
"elm/browser": "1.0.1",
"elm/core": "1.0.2",
"elm/html": "1.0.0",
"elm/parser": "1.1.0",
"joakin/elm-canvas": "3.0.3"
},
"indirect": {
"elm/json": "1.1.2",
"elm/time": "1.0.0",
"elm/url": "1.0.0",
"elm/virtual-dom": "1.0.2"
}
},
"test-dependencies": {
"direct": {},
"indirect": {}
}
}

32
index.html Normal file
View File

@ -0,0 +1,32 @@
<html>
<head>
<title>MiniLogo Simulator</title>
<script src="minilogo.js"></script>
<script src="http://unpkg.com/elm-canvas/elm-canvas.js"></script>
</head>
<body>
<div id="elm-container">
</div>
<script>
var program = `
move(0, 0);
define line(x1, y1, x2, y2) {
pen up;
move(x1, y1);
pen down;
move(x2, y2);
};
define nix(x, y, width, height) {
call line (x, y, x + width, y + height);
call line (x + width, y, x, y + height);
};
call nix(0, 0, 5, 10);
`
var container = document.getElementById("elm-container");
var app = Elm.Main.init({
"flags": { initialText: program },
"node": container
});
</script>
</body>
</html>

334
src/Main.elm Normal file
View File

@ -0,0 +1,334 @@
import Html exposing (Html, div, text)
import Html.Attributes exposing (class)
import Browser exposing (element)
import Canvas exposing (Shape)
import Dict exposing (Dict)
import Parser exposing (Parser, (|.), (|=), variable, succeed, symbol, int, spaces, map, oneOf, lazy, sequence, Trailing(..), keyword, run, backtrackable)
import Color
import Canvas exposing (Point, path, lineTo, circle, shapes, stroke, lineWidth)
import Set
{-
======= Syntax Definitions =======
-}
type LogoPenMode = Up | Down
type LogoExpr = Variable String
| Number Int
| Sum LogoExpr LogoExpr
type LogoCmd = Pen LogoPenMode
| Move LogoExpr LogoExpr
| Define String (List String) LogoProg
| Call String (List LogoExpr)
type alias LogoProg = List LogoCmd
{-
======= Semantics Definitions ====
-}
type alias Coord = (Int, Int)
type alias Line = (Coord, Coord)
type alias Function = (List String, LogoProg)
type Scope = Child Scope (Dict String Function) (Dict String Int) | End
type alias Board = List Line
type alias State =
{ penMode : LogoPenMode
, pos : Coord
, scope : Scope
}
type alias Step a = State -> Result String (a, State)
{-
======= Type Definitions =======
-}
type alias Flags =
{ initialText : String
}
type alias Model =
{ programText : String
}
type Msg
= Run
{-
======= Syntax Code
-}
parseInt : Parser LogoExpr
parseInt = map Number int
parseVarName : Parser String
parseVarName = variable
{ start = Char.isAlphaNum
, inner = Char.isAlphaNum
, reserved = Set.fromList [ "move", "pen", "define", "call" ]
}
parseVar : Parser LogoExpr
parseVar = map Variable parseVarName
parseSum : Parser LogoExpr
parseSum = succeed Sum
|= oneOf [ backtrackable parseVar, backtrackable parseInt ]
|. spaces
|. symbol "+"
|. spaces
|= parseExpr
parseExpr : Parser LogoExpr
parseExpr = oneOf [ lazy (\_ -> backtrackable parseSum), backtrackable parseInt, backtrackable parseVar ]
parseProg : Parser LogoProg
parseProg = sequence
{ start = ""
, separator = ";"
, end = ""
, spaces = spaces
, item = lazy (\_ -> parseCmd)
, trailing = Mandatory
}
parseCmd : Parser LogoCmd
parseCmd = oneOf [ parseDefine, parseCall, parseMove, parsePen ]
parseDefine : Parser LogoCmd
parseDefine = succeed Define
|. keyword "define"
|. spaces
|= parseVarName
|. spaces
|= sequence
{ start = "("
, separator = ","
, end = ")"
, spaces = spaces
, item = parseVarName
, trailing = Forbidden
}
|. spaces
|. symbol "{"
|. spaces
|= parseProg
|. spaces
|. symbol "}"
parseCall : Parser LogoCmd
parseCall = succeed Call
|. keyword "call"
|. spaces
|= parseVarName
|. spaces
|= sequence
{ start = "("
, separator = ","
, end = ")"
, spaces = spaces
, item = parseExpr
, trailing = Forbidden
}
parsePenMode : Parser LogoPenMode
parsePenMode = oneOf
[ succeed Up |. keyword "up"
, succeed Down |. keyword "down"
]
parsePen : Parser LogoCmd
parsePen = succeed Pen
|. keyword "pen"
|. spaces
|= parsePenMode
parseMove : Parser LogoCmd
parseMove = succeed Move
|. keyword "move"
|. spaces
|. symbol "("
|= parseExpr
|. spaces
|. symbol ","
|. spaces
|= parseExpr
|. symbol ")"
{-
======= Semantics Code =======
-}
initialScope : Scope
initialScope = Child End Dict.empty Dict.empty
initialState : State
initialState =
{ penMode = Up
, pos = (0, 0)
, scope = initialScope
}
unit : a -> Step a
unit a state = Ok (a, state)
bind : Step a -> (a -> Step b) -> Step b
bind sa f state = case sa state of
Ok (a, newState) -> f a newState
Err e -> Err e
rbind : (a -> Step b) -> Step a -> Step b
rbind f sa = bind sa f
updatePosition : Coord -> Board -> Step Board
updatePosition c b state =
let
newBoard = case state.penMode of
Up -> b
Down -> (state.pos, c)::b
in
Ok (newBoard, { state | pos = c })
registerFunction : String -> Function -> Step ()
registerFunction s f state = Ok ((), { state | scope = setScopeFunction s f state.scope })
registerVariable : String -> Int -> Step ()
registerVariable s v state = Ok ((), { state | scope = setScopeVariable s v state.scope })
setPenMode : LogoPenMode -> Step ()
setPenMode m state = Ok ((), { state | penMode = m})
upScope : Step ()
upScope state = Ok ((), { state | scope = Child state.scope Dict.empty Dict.empty })
downScope : Step ()
downScope state =
let
newScope = case state.scope of
End -> End
Child p _ _ -> p
in
Ok ((), { state | scope = newScope })
setScopeFunction : String -> Function -> Scope -> Scope
setScopeFunction s f scope = case scope of
End -> setScopeFunction s f initialScope
Child p fs vs -> Child p (Dict.insert s f fs) vs
setScopeVariable : String -> Int -> Scope -> Scope
setScopeVariable s v scope = case scope of
End -> setScopeVariable s v initialScope
Child p fs vs -> Child p fs (Dict.insert s v vs)
scopeFunction : String -> Scope -> Maybe Function
scopeFunction s scope = case scope of
End -> Nothing
Child p fs _ -> case Dict.get s fs of
Just f -> Just f
Nothing -> scopeFunction s p
scopeVariable : String -> Scope -> Maybe Int
scopeVariable s scope = case scope of
End -> Nothing
Child p _ vs -> case Dict.get s vs of
Just i -> Just i
Nothing -> scopeVariable s p
lookupFunction : String -> Step Function
lookupFunction s state = case scopeFunction s state.scope of
Just f -> Ok (f, state)
Nothing -> Err ("No function with name " ++ s)
lookupVariable : String -> Step Int
lookupVariable s state = case scopeVariable s state.scope of
Just i -> Ok (i, state)
Nothing -> Err ("No variable with name " ++ s)
evaluateExp : LogoExpr -> Step Int
evaluateExp le = case le of
Number i -> unit i
Variable v -> lookupVariable v
Sum l r -> evaluateExp l |> rbind (\vl -> evaluateExp r |> rbind (\vr -> unit (vl + vr)))
evaluateAllExps : List LogoExpr -> Step (List Int)
evaluateAllExps = List.foldr (\x acc -> acc |> rbind (\vs -> evaluateExp x |> rbind (\v -> unit (v::vs)))) (unit [])
registerAllVariables : List (String, Int) -> Step ()
registerAllVariables = List.foldl (\(s, i) m -> bind m (\_ -> registerVariable s i)) (unit ())
zip : List a -> List b -> List (a, b)
zip la lb = case (la, lb) of
(a::lat, b::lbt) -> (a, b)::zip lat lbt
_ -> []
evaluateCmd : LogoCmd -> Board -> Step Board
evaluateCmd c b = case c of
Move l r -> evaluateExp l |> rbind (\x -> evaluateExp r |> rbind (\y -> updatePosition (x, y) b))
Define n xs prg -> registerFunction n (xs, prg) |> rbind (\_ -> unit b)
Pen mode -> setPenMode mode |> rbind (\_ -> unit b)
Call n args -> lookupFunction n
|> rbind (\(ns, prg) -> evaluateAllExps args
|> rbind (\vs -> upScope
|> rbind (\_ -> registerAllVariables (zip ns vs)
|> rbind (\_ -> evaluateAll prg b
|> rbind (\nb -> downScope
|> rbind (\_ -> unit nb))))))
evaluateAll : LogoProg -> Board -> Step Board
evaluateAll prg board = List.foldl rbind (unit board) <| List.map evaluateCmd prg
{-
======= Drawing Stuff =====
-}
transformCoord : Coord -> Point
transformCoord (x, y) = (toFloat x * 25, 500 - toFloat y * 25)
lineShape : Line -> Shape
lineShape (c1, c2) = path (transformCoord c1) [ lineTo (transformCoord c2) ]
pointerShape : Coord -> Shape
pointerShape c = circle (transformCoord c) 5
allShapes : (Board, State) -> List Shape
allShapes (b, s) = pointerShape s.pos :: List.map lineShape b
canvas : (Board, State) -> Html Msg
canvas dat = Canvas.toHtml (500, 500) []
[ shapes [ stroke Color.blue, lineWidth 5] (allShapes dat)
]
{-
======= Elm Architecture =======
-}
init : Flags -> (Model, Cmd Msg)
init fs =
let
model =
{ programText = fs.initialText
}
cmd = Cmd.none
in
(model, cmd)
view : Model -> Html Msg
view m =
let
dat = Result.withDefault ([], initialState)
<| Result.withDefault (Err "Couldn't parse program")
<| Result.map (\prg -> evaluateAll prg [] initialState) (run parseProg m.programText)
in
canvas dat
update : Msg -> Model -> (Model, Cmd Msg)
update msg m = (m, Cmd.none)
subscriptions : Model -> Sub Msg
subscriptions m = Sub.none
main = element
{ init = init
, view = view
, update = update
, subscriptions = subscriptions
}